From 71e1584e7208cd5772e8b5ea194116aa6902bad6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Mon, 19 Nov 2018 02:15:21 -0500 Subject: [PATCH] Update loop macro and replace pretty printer with C implementation. --- examples/life.janet | 47 ++++++++++++++++ src/core/core.janet | 113 ++++++-------------------------------- src/core/string.c | 129 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 192 insertions(+), 97 deletions(-) create mode 100644 examples/life.janet diff --git a/examples/life.janet b/examples/life.janet new file mode 100644 index 00000000..c3c7a879 --- /dev/null +++ b/examples/life.janet @@ -0,0 +1,47 @@ +# A game of life implementation + +(def- windows + (fora [x :range [-1 2] + y :range [-1 2] + :when (not (and (zero? x) (zero? y)))] + (tuple x y))) + +(defn- neighbors + [[x y]] + (mapa (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) windows)) + +(defn tick + "Get the next state in the Game Of Life." + [state] + (def neighbor-set (frequencies (mapcat neighbors (keys state)))) + (def next-state @{}) + (loop [coord :keys neighbor-set + :let [count (get neighbor-set coord)]] + (if (if (get state coord) + (or (= count 2) (= count 3)) + (= count 3)) + (put next-state coord true))) + next-state) + +(defn draw + "Draw cells in the game of life from (x1, y1) to (x2, y2)" + [state x1 y1 x2 y2] + (loop [:before (print "+" (string.repeat "--" (inc (- y2 y1))) "+") + :after (print "+" (string.repeat "--" (inc (- y2 y1))) "+") + x :range [x1 (+ 1 x2)] + :before (file.write stdout "|") + :after (file.write stdout "|\n") + y :range [y1 (+ 1 y2)]] + (file.write stdout (if (get state (tuple x y)) "X " ". "))) + (print)) + +# +# Run the example +# + +(var *state* {'(0 0) true '(-1 0) true '(1 0) true '(1 1) true '(0 2) true}) + +(loop [i :range [0 20]] + (print "generation " i) + (draw *state* -7 -7 7 7) + (:= *state* (tick *state*))) diff --git a/src/core/core.janet b/src/core/core.janet index cc4fa516..ca933e59 100644 --- a/src/core/core.janet +++ b/src/core/core.janet @@ -37,7 +37,8 @@ (def arglen (length args)) (def buf (buffer "(" name)) (while (< index arglen) - (buffer.push-string buf " " (get args index)) + (buffer.push-string buf " ") + (string.pretty (get args index) 4 buf) (:= index (+ index 1))) (array.push modifiers (string buf ")\n\n" docstr)) # Build return value @@ -259,7 +260,7 @@ (defmacro loop "A general purpose loop macro. - The head of the loop shoud be a tuple that contains a sequence of + The head of the loop shoud be a tuple that contains a sequence of either bindings or conditionals. A binding is a sequence of three values that define someting to loop over. They are formatted like:\n\n \tbinding :verb object/expression\n\n @@ -277,10 +278,14 @@ :modifier can be one of:\n\n \t:while expression - breaks from the loop if expression is falsey.\n \t:let bindings - defines bindings inside the loop as passed to the let macro.\n + \t:before form - evaluates a form for a side effect before of the next inner loop.\n + \t:after form - same as :befor, but the side effect happens after the next inner loop.\n \t:when condition - only evaluates the loop body when condition is true.\n\n The loop macro always evaluates to nil." [head & body] (def len (length head)) + (if (not= :tuple (type head)) + (error "expected tuple for loop head")) (defn doone @[i preds] (default preds @['and]) @@ -299,6 +304,8 @@ (doone (+ i 2) preds)) :let (tuple 'let verb (doone (+ i 2))) :when (tuple 'if verb (doone (+ i 2))) + :before (tuple 'do verb (doone (+ i 2))) + :after (tuple 'do (doone (+ i 2)) verb) (error ("unexpected loop predicate: " verb))) (case verb :iterate (do @@ -835,95 +842,6 @@ value, one key will be ignored." (array.push res (get (get cols ci) i))))) res) -### -### -### Pretty Printer -### -### - -(defn pp - "Pretty print a value. Displays values inside collections, and is safe - to call on any table. Does not print table prototype information." - @[x file] - - (default file stdout) - (def buf @"") - (def indent @"\n") - (def seen @{}) - (var nextid 0) - - # Forward declaration - (var recur nil) - - (defn do-ds - [y start end checkcycle dispatch] - (def id (get seen y)) - (if (and checkcycle id) - (do - (buffer.push-string buf "")) - (do - (put seen y (++ nextid)) - (buffer.push-string buf start) - (dispatch y) - (buffer.push-string buf end)))) - - (defn pp-seq [y] - (def len (length y)) - (if (< len 5) - (do - (loop [i :range [0 len]] - (when (not= i 0) (buffer.push-string buf " ")) - (recur (get y i)))) - (do - (buffer.push-string indent " ") - (loop [i :range [0 len]] - (when (not= i len) (buffer.push-string buf indent)) - (recur (get y i))) - (buffer.popn indent 2) - (buffer.push-string buf indent)))) - - (defn pp-dict-nested [y] - (buffer.push-string indent " ") - (loop [[k v] :in (sort (pairs y))] - (buffer.push-string buf indent) - (recur k) - (buffer.push-string buf " ") - (recur v)) - (buffer.popn indent 2) - (buffer.push-string buf indent)) - - (defn pp-dict-simple [y] - (var i -1) - (loop [[k v] :in (sort (pairs y))] - (if (pos? (++ i)) (buffer.push-string buf " ")) - (recur k) - (buffer.push-string buf " ") - (recur v))) - - (defn pp-dict [y] - (def complex? (> (length y) 4)) - ((if complex? pp-dict-nested pp-dict-simple) y)) - - (def printers - {:array (fn [y] (do-ds y "@[" "]" true pp-seq)) - :tuple (fn [y] (do-ds y "(" ")" false pp-seq)) - :table (fn [y] (do-ds y "@{" "}" true pp-dict)) - :struct (fn [y] (do-ds y "{" "}" false pp-dict))}) - - (:= recur (fn [y] - (def p (get printers (type y))) - (if p - (p y) - (buffer.push-string buf (describe y))))) - - (recur x) - (buffer.push-string buf "\n") - - (file.write file buf) - nil) - ### ### ### Documentation @@ -1209,11 +1127,10 @@ value, one key will be ignored." (defn default-error-handler @[source t x f] - (file.write stderr (string t " error in " source ": ")) - (if (bytes? x) - (do (file.write stderr x) - (file.write stderr "\n")) - (pp x stderr)) + (file.write stderr + (string t " error in " source ": ") + (if (bytes? x) x (string.pretty x)) + "\n") (when f (def st (fiber.stack f)) (loop @@ -1395,9 +1312,11 @@ value, one key will be ignored." (def newenv (make-env)) (default getchunk (fn @[buf] (file.read stdin :line buf))) + (def buf @"") (default onvalue (fn [x] (put newenv '_ @{:value x}) - (pp x))) + (print (string.pretty x 4 buf)) + (buffer.clear buf))) (default onerr default-error-handler) (run-context newenv getchunk onvalue onerr "repl")) diff --git a/src/core/string.c b/src/core/string.c index 77643b7b..acacb14e 100644 --- a/src/core/string.c +++ b/src/core/string.c @@ -469,6 +469,113 @@ const uint8_t *janet_to_string(Janet x) { } } +/* Hold state for pretty printer. */ +struct pretty { + JanetBuffer *buffer; + int depth; + JanetTable seen; +}; + +/* Helper for pretty printing */ +static void janet_pretty_one(struct pretty *S, Janet x) { + /* Add to seen */ + switch (janet_type(x)) { + case JANET_NIL: + case JANET_INTEGER: + case JANET_REAL: + case JANET_SYMBOL: + case JANET_TRUE: + case JANET_FALSE: + break; + default: + { + Janet seenid = janet_table_get(&S->seen, x); + if (janet_checktype(seenid, JANET_INTEGER)) { + janet_buffer_push_cstring(S->buffer, "buffer, janet_unwrap_integer(x)); + janet_buffer_push_u8(S->buffer, '>'); + return; + } else { + janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count)); + break; + } + } + } + + switch (janet_type(x)) { + default: + janet_description_b(S->buffer, x); + return; + case JANET_ARRAY: + case JANET_TUPLE: + { + int isarray = janet_checktype(x, JANET_ARRAY); + janet_buffer_push_cstring(S->buffer, isarray ? "@[" : "("); + S->depth--; + if (S->depth == 0) { + janet_buffer_push_cstring(S->buffer, "..."); + } else { + int32_t i, len; + const Janet *arr; + janet_indexed_view(x, &arr, &len); + for (i = 0; i < len; i++) { + if (i) janet_buffer_push_u8(S->buffer, ' '); + janet_pretty_one(S, arr[i]); + } + } + S->depth++; + janet_buffer_push_u8(S->buffer, isarray ? ']' : ')'); + break; + } + case JANET_STRUCT: + case JANET_TABLE: + { + int istable = janet_checktype(x, JANET_TABLE); + janet_buffer_push_cstring(S->buffer, istable ? "@{" : "}"); + S->depth--; + if (S->depth == 0) { + janet_buffer_push_cstring(S->buffer, "..."); + } else { + int32_t i, len, cap; + int first_kv_pair = 1; + const JanetKV *kvs; + janet_dictionary_view(x, &kvs, &len, &cap); + for (i = 0; i < cap; i++) { + if (!janet_checktype(kvs[i].key, JANET_NIL)) { + if (first_kv_pair) { + first_kv_pair = 0; + } else { + janet_buffer_push_cstring(S->buffer, ", "); + } + janet_pretty_one(S, kvs[i].key); + janet_buffer_push_u8(S->buffer, ' '); + janet_pretty_one(S, kvs[i].value); + } + } + } + S->depth++; + janet_buffer_push_u8(S->buffer, '}'); + break; + } + } + return; +} + +/* Helper for printing a janet value in a pretty form. Not meant to be used + * for serialization or anything like that. */ +JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) { + struct pretty S; + if (NULL == buffer) { + buffer = janet_buffer(0); + } + S.buffer = buffer; + S.depth = depth; + janet_table_init(&S.seen, 10); + janet_pretty_one(&S, x); + janet_table_deinit(&S.seen); + return S.buffer; +} + /* Helper function for formatting strings. Useful for generating error messages and the like. * Similiar to printf, but specialized for operating with janet. */ const uint8_t *janet_formatc(const char *format, ...) { @@ -542,6 +649,10 @@ const uint8_t *janet_formatc(const char *format, ...) { janet_description_b(bufp, va_arg(args, Janet)); break; } + case 'p': + { + janet_pretty(bufp, 4, va_arg(args, Janet)); + } } } } @@ -1039,6 +1150,19 @@ static int cfun_number(JanetArgs args) { JANET_RETURN_CSTRING(args, buf); } +static int cfun_pretty(JanetArgs args) { + JanetBuffer *buffer = NULL; + int32_t depth = 4; + JANET_MINARITY(args, 1); + JANET_MAXARITY(args, 3); + if (args.n > 1) + JANET_ARG_INTEGER(depth, args, 1); + if (args.n > 2) + JANET_ARG_BUFFER(buffer, args, 2); + buffer = janet_pretty(buffer, depth, args.v[0]); + JANET_RETURN_BUFFER(args, buffer); +} + static const JanetReg cfuns[] = { {"string.slice", cfun_slice, "(string.slice bytes [,start=0 [,end=(length str)]])\n\n" @@ -1131,6 +1255,11 @@ static const JanetReg cfuns[] = { "and the precision (number of places after decimal) in the output number. " "Returns a string representation of x." }, + {"string.pretty", cfun_pretty, + "(string.pretty x [,depth=4 [,buffer=@\"\"]])\n\n" + "Pretty prints a value to a buffer. Optionally allwos setting max " + "recursion depth, as well as writing to a buffer. Returns the buffer." + }, {NULL, NULL, NULL} };