mirror of https://github.com/janet-lang/janet
Update loop macro and replace pretty printer
with C implementation.
This commit is contained in:
Calvin Rose
parent
1532697b37
commit
71e1584e72
|
|
@ -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*)))
|
||||
|
|
@ -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"))
|
||||
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue