commit 271b63cd5491c24beceb5141e524925238169500
parent 6d7d7d57fb97ac6a6e5bf3cfac2fcad1ea756c1f
Author: Ed van Bruggen <edvb@uw.edu>
Date: Wed, 15 Apr 2020 19:06:36 -0700
Use display to print type formated values
Have println and displayln to add newlines instead
Diffstat:
5 files changed, 61 insertions(+), 62 deletions(-)
diff --git a/test.c b/test.c
@@ -53,8 +53,8 @@ char *tests[][2] = {
{ "1/-2", "-1/2" },
{ "-6/3", "-2" },
{ "-6/-3", "2" },
- { "\"foo\"", "\"foo\"" },
- { "\"foo bar\"", "\"foo bar\"" },
+ { "\"foo\"", "foo" },
+ { "\"foo bar\"", "foo bar" },
{ "t", "t" },
{ "()", "nil" },
{ "nil", "nil" },
@@ -71,7 +71,7 @@ char *tests[][2] = {
{ "quote", NULL },
{ "(quote 1)", "1" },
{ "(quote 9234)", "9234" },
- { "(quote \"foo\")", "\"foo\"" },
+ { "(quote \"foo\")", "foo" },
{ "(quote bar)", "bar" },
{ "(quote (1 2 3 4))", "(1 2 3 4)" },
{ "(quote (quote 1))", "(quote 1)" },
@@ -80,13 +80,13 @@ char *tests[][2] = {
{ "'foo", "foo" },
{ "'(1 2 3 4)", "(1 2 3 4)" },
- { "cons", NULL },
- { "(cons 1 2)", "(1 . 2)" },
- { "(cons 1 (cons 2 3))", "(1 2 . 3)" },
- { "(cons 1 (cons 2 (cons 3 4)))", "(1 2 3 . 4)" },
- { "(cons \"foo\" \"bar\")", "(\"foo\" . \"bar\")" },
- { "(cons (+ 1 2) 3)", "(3 . 3)" },
- { "(cons (cons 1 2) (cons 3 4))", "((1 . 2) 3 . 4)" },
+ { "cons", NULL },
+ { "(cons 1 2)", "(1 . 2)" },
+ { "(cons 1 (cons 2 3))", "(1 2 . 3)" },
+ { "(cons 1 (cons 2 (cons 3 4)))", "(1 2 3 . 4)" },
+ { "(cons \"foo\" \"bar\")", "(foo . bar)" },
+ { "(cons (+ 1 2) 3)", "(3 . 3)" },
+ { "(cons (cons 1 2) (cons 3 4))", "((1 . 2) 3 . 4)" },
{ "cxr", NULL },
{ "(car (cons 1 2))", "1" },
@@ -111,7 +111,7 @@ char *tests[][2] = {
{ "eval", NULL },
{ "(eval ''hey)", "hey" },
- { "(eval \"sup\")", "\"sup\"" },
+ { "(eval \"sup\")", "sup" },
{ "(eval (+ 1 2))", "3" },
{ "(eval '(- 4 3))", "1" },
{ "(eval ''(mod 9 3))", "(mod 9 3)" },
@@ -201,8 +201,8 @@ char *tests[][2] = {
{ "(add2 2)", "4" },
{ "(set! add2 2)", "2" },
{ "add2", "2" },
- { "(set! add2 \"2\")", "\"2\"" },
- { "add2", "\"2\"" },
+ { "(set! add2 \"2\")", "2" },
+ { "add2", "2" },
{ "lambda", NULL },
{ "((lambda (x) x) 3)", "3" },
@@ -252,7 +252,7 @@ char *tests[][2] = {
{ "(list 1 2 3)", "(1 2 3)" },
{ "(list (* 2 2) (+ 2 3))", "(4 5)" },
{ "(list 'a 'b 'c 'd 'e 'f)", "(a b c d e f)" },
- { "(list \"foo\")", "(\"foo\")" },
+ { "(list \"foo\")", "(foo)" },
{ "(list)", "nil" },
{ "(list 1/2 2/8 . 1/8)", "(1/2 1/4 . 1/8)" },
{ "(list* .5 .25 .125)", "(0.5 0.25 . 0.125)" },
@@ -306,46 +306,48 @@ char *tests[][2] = {
{ "((compose -) 5/3)", "-5/3" },
{ "((compose - +) 5 6)", "-11" },
{ "((compose sqrt integer *) 4.5 2)", "3" },
-
- { "list mod", NULL },
- { "(reverse '(1 2 3 4 5))", "(5 4 3 2 1)" },
- { "(reverse (list -20 5/2 .398))", "(0.398 5/2 -20)" },
- { "(reverse '(a b))", "(b a)" },
- { "(reverse (list \"foo\" \"bar\" \"baz\"))", "(\"baz\" \"bar\" \"foo\")" },
- { "(reverse (cons 1/2 nil))", "(1/2)" },
- { "(reverse ())", "nil" },
- { "(append '(1 2 3) '(4 5 6))", "(1 2 3 4 5 6)" },
- { "(append (list (+ 1 2) 4) '(a b c))", "(3 4 a b c)" },
+ /* { "(foldr + 0 '(1 2 4 5))", "12" }, */
+ /* { "(foldr list 0 '(1 2 3 4))", "((((0 1) 2) 3) 4)" }, */
+
+ { "list mod", NULL },
+ { "(reverse '(1 2 3 4 5))", "(5 4 3 2 1)" },
+ { "(reverse (list -20 5/2 .398))", "(0.398 5/2 -20)" },
+ { "(reverse '(a b))", "(b a)" },
+ { "(reverse (list \"foo\" \"bar\" \"baz\"))", "(baz bar foo)" },
+ { "(reverse (cons 1/2 nil))", "(1/2)" },
+ { "(reverse ())", "nil" },
+ { "(append '(1 2 3) '(4 5 6))", "(1 2 3 4 5 6)" },
+ { "(append (list (+ 1 2) 4) '(a b c))", "(3 4 a b c)" },
{ "assoc", NULL },
{ "(zip '(1 2 3 4) '(a b c d))",
"((1 . a) (2 . b) (3 . c) (4 . d))" },
{ "(zip (list 'ricky 'lahey) (list \"julian\" \"randy\"))",
- "((ricky . \"julian\") (lahey . \"randy\"))" },
+ "((ricky . julian) (lahey . randy))" },
{ "(assoc 'baz '((foo . 3) (bar . 8) (baz . 14)))", "(baz . 14)" },
{ "(assoc 'a '((a b) (3 2.1) (3.2 4/3) (3.2 3.2)))", "(a b)" },
{ "(assoc 3 '((1 b)))", "nil" },
{ "(assoc 4/3 (list (list 1 pi) (list 4/3 1/2 3) (list 2 3)))", "(4/3 1/2 3)" },
- { "member", NULL },
- { "(memp even? (list 1 3 19 4 7 8 2))", "(4 7 8 2)" },
- { "(memp negative? (list 1/3 pi 3.2e-9 0 4 -7 2))", "(-7 2)" },
- { "(memp (lambda (x) (> x 8)) '(1/3 1/2 5/3 8 9))", "(9)" },
+ { "member", NULL },
+ { "(memp even? (list 1 3 19 4 7 8 2))", "(4 7 8 2)" },
+ { "(memp negative? (list 1/3 pi 3.2e-9 0 4 -7 2))", "(-7 2)" },
+ { "(memp (lambda (x) (> x 8)) '(1/3 1/2 5/3 8 9))", "(9)" },
{ "(memp (lambda (x) (= x \"fry\")) "
- "'(\"fry\" \"nibbler\" \"prof\"))", "(\"fry\" \"nibbler\" \"prof\")" },
- { "(member 'foo '(foo bar baz))", "(foo bar baz)" },
- { "(member 'bar '(foo bar baz))", "(bar baz)" },
- { "(member 4 '(12 38 4 8))", "(4 8)" },
- { "(member 3.2 '(4/3 2 8 2 3.14 3.2))", "(3.2)" },
- { "(member \"quux\" (list 4.2 3 'quux))", "nil" },
- { "(member 'qux '(foo bar baz))", "nil" },
+ "'(\"fry\" \"nibbler\" \"prof\"))", "(fry nibbler prof)" },
+ { "(member 'foo '(foo bar baz))", "(foo bar baz)" },
+ { "(member 'bar '(foo bar baz))", "(bar baz)" },
+ { "(member 4 '(12 38 4 8))", "(4 8)" },
+ { "(member 3.2 '(4/3 2 8 2 3.14 3.2))", "(3.2)" },
+ { "(member \"quux\" (list 4.2 3 'quux))", "nil" },
+ { "(member 'qux '(foo bar baz))", "nil" },
{ "quasiquote", NULL },
{ "`7.2", "7.2" },
{ "`cory", "cory" },
{ "`,foo", "9" },
{ "`(1 2 3)", "(1 2 3)" },
- { "`(\"sunnyvale\")", "(\"sunnyvale\")" },
+ { "`(\"sunnyvale\")", "(sunnyvale)" },
{ "`(1/2 . 2/1)", "(1/2 . 2)" },
{ "`(cory trevor)", "(cory trevor)" },
{ "`(foo bar quax)", "(foo bar quax)" },
@@ -354,15 +356,15 @@ char *tests[][2] = {
{ "`(,foo . ,bar)", "(9 . 4)" },
{ "`(foo bar ,foo fry)", "(foo bar 9 fry)" },
- { "stack", NULL },
- { "(peek '(1 2 3 4 5 6))", "1" },
- { "(peek (list 'a 'b 'c))", "a" },
- { "(pop (list 1/2 1/4))", "(1/4)" },
- { "(pop '(\"foo\" \"bar\" \"baz\"))", "(\"bar\" \"baz\")" },
- { "(push '(6 3 5/3 .38) .5)", "(0.5 6 3 5/3 0.38)" },
- { "(push (list \"ni\" 'shrubbery) (* 3 2))", "(6 \"ni\" shrubbery)" },
- { "(swap '(1 2 3 5 7 11))", "(2 1 3 5 7 11)" },
- { "(swap (list 1/2 1/4 1/9 1/16))", "(1/4 1/2 1/9 1/16)" },
+ { "stack", NULL },
+ { "(peek '(1 2 3 4 5 6))", "1" },
+ { "(peek (list 'a 'b 'c))", "a" },
+ { "(pop (list 1/2 1/4))", "(1/4)" },
+ { "(pop '(\"foo\" \"bar\" \"baz\"))", "(bar baz)" },
+ { "(push '(6 3 5/3 .38) .5)", "(0.5 6 3 5/3 0.38)" },
+ { "(push (list \"ni\" 'shrubbery) (* 3 2))", "(6 ni shrubbery)" },
+ { "(swap '(1 2 3 5 7 11))", "(2 1 3 5 7 11)" },
+ { "(swap (list 1/2 1/4 1/9 1/16))", "(1/4 1/2 1/9 1/16)" },
{ "stack!", NULL },
{ "(define s '(1 2 3 4 5))", "#<void>" },
diff --git a/tibs/io.c b/tibs/io.c
@@ -54,10 +54,7 @@ prim_write(Tsp st, Hash env, Val args)
"or symbol stdout/stderr");
for (v = cddr(v); !nilp(v); v = cdr(v))
- if (car(v)->t & STRING) /* don't print quotes around string */
- fprintf(f, "%s", car(v)->v.s);
- else
- tisp_print(f, car(v));
+ tisp_print(f, car(v));
if (f == stdout || f == stderr)
fflush(f);
else
diff --git a/tibs/lib.tsp b/tibs/lib.tsp
@@ -377,12 +377,14 @@
(if (or (nil? file) (nil? (cdr file)))
(write (car (or file '(stdout))) file "\n")
(error 'newline "only zero or one file can be given")))
-(define (disp . str) (apply print str) (newline))
-; TODO rename displayln, also quote syms and lists
-(define (disp-string . str)
+
+(define (display . str)
(map (lambda (s)
- (if (string? s)
- (print "\"" s "\"")
- (print s)))
- str)
- (newline))
+ (cond
+ ((string? s) (print "\"" s "\""))
+ ((symbol? s) (print "'" s))
+ ((pair? s) (print "'" s))
+ (else (print s))))
+ str))
+(define (displayln . str) (apply display str) (newline))
+(define (println . str) (apply print str) (newline))
diff --git a/tibs/repl.tsp b/tibs/repl.tsp
@@ -5,7 +5,7 @@
; TODO push! ans to stack of outputs
(let ((ans (eval expr)))
(unless (void? ans)
- (disp-string ans))
+ (displayln ans))
(repl)))))
;; simple repl, only requires io c library
diff --git a/tisp.c b/tisp.c
@@ -787,8 +787,6 @@ tisp_print(FILE *f, Val v)
fprintf(f, "%d/%d", (int)num(v), (int)den(v));
break;
case STRING:
- fprintf(f, "\"%s\"", v->v.s);
- break;
case SYMBOL:
fputs(v->v.s, f);
break;
@@ -942,7 +940,7 @@ prim_get(Tsp st, Hash env, Val args)
break;
case FUNCTION:
case MACRO:
- if (!strncmp(prop->v.s, "name", 4))
+ if (!strncmp(prop->v.s, "name", 4)) /* TODO fix seg fault on anon proc */
return mk_sym(st, v->v.f.name);
if (!strncmp(prop->v.s, "body", 4))
return v->v.f.body;
