1
0
mirror of https://github.com/janet-lang/janet synced 2024-12-25 07:50:27 +00:00

Update loop macro and replace pretty printer

with C implementation.
This commit is contained in:
Calvin Rose 2018-11-19 02:15:21 -05:00
parent 1532697b37
commit 71e1584e72
3 changed files with 192 additions and 97 deletions

47
examples/life.janet Normal file
View File

@ -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*)))

View File

@ -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 "<cycle ")
(buffer.push-string buf (string id))
(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"))

View File

@ -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, "<cycle ");
integer_to_string_b(S->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}
};