diff --git a/examples/primes.dst b/examples/primes.dst index 24d6bcd6..5c5d58c6 100644 --- a/examples/primes.dst +++ b/examples/primes.dst @@ -3,12 +3,12 @@ (defn primes "Returns a list of prime numbers less than n." [n] - (def list []) + (def list @[]) (for [i 2 n] (var isprime? true) (def len (length list)) (for [j 0 len] (def trial (get list j)) - (if (zero? (% i trial)) (varset! isprime? false))) + (if (zero? (% i trial)) (:= isprime? false))) (if isprime? (array-push list i))) list) diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 9dae4faa..310f4158 100644 --- a/src/compiler/boot.dst +++ b/src/compiler/boot.dst @@ -16,7 +16,7 @@ (if (if tuple? tuple? array?) i (recur (+ i 1))))) (def start (fstart 0)) (def fnbody (tuple-prepend (tuple-prepend (tuple-slice more start) name) 'fn)) - (def formargs (array-concat ['def name] (array-slice more 0 start) [fnbody])) + (def formargs (array-concat @['def name] (array-slice more 0 start) @[fnbody])) (apply1 tuple formargs))) (def defmacro :macro @@ -24,20 +24,20 @@ (do (def defn* (get (get _env 'defn) :value)) (fn [name & more] - (def args (array-concat [] name :macro more)) + (def args (array-concat @[] name :macro more)) (apply1 defn* args)))) (defmacro defmacro- "Define a private macro that will not be exported." [name & more] (apply1 tuple (array-concat - ['defmacro name :private] more))) + @['defmacro name :private] more))) (defmacro defn- "Define a private function that will not be exported." [name & more] (apply1 tuple (array-concat - ['defn name :private] more))) + @['defn name :private] more))) # Basic predicates (defn even? [x] (== 0 (% x 2))) @@ -199,7 +199,7 @@ If no match is found, returns nil" (defn iter2array [itr] (def {:more more :next next} (iter itr)) - (def a []) + (def a @[]) (while (more) (array-push a (next))) a) @@ -235,7 +235,8 @@ If no match is found, returns nil" (def head (ast-unwrap1 bindings)) (when (odd? (length head)) (error "expected even number of bindings to let")) (def len (length head)) - (var [i accum] [0 ['do]]) + (var i 0) + (var accum @['do]) (while (< i len) (array-push accum (tuple 'def (get head i) @@ -276,7 +277,7 @@ If no match is found, returns nil" (defn partial [f & more] (if (zero? (length more)) f - (fn [& r] (apply1 f (array-concat [] more r))))) + (fn [& r] (apply1 f (array-concat @[] more r))))) (defmacro for [head & body] (def head (ast-unwrap1 head)) @@ -297,27 +298,27 @@ If no match is found, returns nil" [& funs] (def len (length funs)) (fn [& args] - (def ret []) + (def ret @[]) (for [i 0 len] (array-push ret (apply1 (get funs i) args))) (apply1 tuple ret))) (defmacro juxt [& funs] - (def parts ['tuple]) + (def parts @['tuple]) (def $args (gensym)) (for [i 0 (length funs)] (array-push parts (tuple apply1 (get funs i) $args))) - (tuple 'fn ['& $args] (apply1 tuple parts))) + (tuple 'fn (tuple '& $args) (apply1 tuple parts))) (defmacro -> [x & forms] (defn fop [last nextform] (def n (ast-unwrap1 nextform)) (def [h t] (if (= :tuple (type n)) - [(get n 0) (array-slice n 1)] - [n []])) - (def parts (array-concat [h last] t)) + [tuple (get n 0) (array-slice n 1)] + [tuple n @[]])) + (def parts (array-concat @[h last] t)) (apply1 tuple parts)) (reduce fop x forms)) @@ -326,9 +327,9 @@ If no match is found, returns nil" (defn fop [last nextform] (def n (ast-unwrap1 nextform)) (def [h t] (if (= :tuple (type n)) - [(get n 0) (array-slice n 1)] - [n []])) - (def parts (array-concat [h] t [last])) + [tuple (get n 0) (array-slice n 1)] + [tuple n @[]])) + (def parts (array-concat @[h] t @[last])) (apply1 tuple parts)) (reduce fop x forms)) @@ -336,7 +337,7 @@ If no match is found, returns nil" "Reverses the order of the elements in a given array or tuple and returns a new array." [t] (var n (dec (length t))) - (var reversed []) + (var reversed @[]) (while (>= n 0) (array-push reversed (get t n)) (-- n)) @@ -386,7 +387,7 @@ If no match is found, returns nil" (tuple 'when (and (get head 1) (if (get head 2) (get head 3) true)) - (apply1 tuple (array-concat ['do] (ast-unwrap1 body)))))) + (apply1 tuple (array-concat @['do] (ast-unwrap1 body)))))) (defn comp "Takes multiple functions and returns a function that is the composition @@ -400,7 +401,7 @@ If no match is found, returns nil" 4 (let [[f g h i] functions] (fn [x] (f (g (h (i x)))))) (let [[f g h i j] functions] (apply comp (fn [x] (f (g (h (i (j x)))))) - (array-slice functions 5 -1))))) + (tuple-slice functions 5 -1))))) (defn zipcoll "Creates an table or tuple from two arrays/tuples. Result is table if no @@ -419,7 +420,7 @@ third argument is given" "Accepts a key argument and passes its associated value to a function. The key, then is associated to that value" [coll a-key a-function & args] - (def old-value (get coll a-key) ) + (def old-value (get coll a-key)) (put coll a-key (apply a-function old-value args))) (defn merge @@ -470,7 +471,7 @@ third argument is given" buf) (def printers :private { - :array (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]" true)) + :array (fn [pp seen buf x] (pp-seq pp seen buf x "@[" "]" true)) :tuple (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")")) :table (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}" true)) :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}")) @@ -499,7 +500,7 @@ third argument is given" (defn doarray [a] (def len (length a)) - (def newa []) + (def newa @[]) (for [i 0 len] (array-push newa (macroexpand1 (get a i)))) newa) @@ -577,11 +578,10 @@ third argument is given" (:= current (macroexpand1 current))) current) -(defn make-env [parent safe] +(defn make-env [parent] (def parent (if parent parent _env)) (def newenv (setproto @{} parent)) - (if (not safe) - (put newenv '_env @{:value newenv})) + (put newenv '_env @{:value newenv :private true}) newenv) (def run-context diff --git a/src/compiler/compile.c b/src/compiler/compile.c index 0d89cbf4..d3c0e16a 100644 --- a/src/compiler/compile.c +++ b/src/compiler/compile.c @@ -830,6 +830,10 @@ recur: x = dst_resume(f, dst_tuple_length(tup) - 1, tup + 1); dst_gcunlock(lock); if (f->status == DST_FIBER_ERROR || f->status == DST_FIBER_DEBUG) { + dst_puts(dst_unwrap_string(x)); + printf("\n"); + dst_puts(dst_unwrap_string(headval)); + printf("\n"); dstc_cerror(c, ast, "error in macro expansion"); } /* Tail recur on the value */ diff --git a/src/mainclient/init.dst b/src/mainclient/init.dst index 6a184c81..ffcb0a83 100644 --- a/src/mainclient/init.dst +++ b/src/mainclient/init.dst @@ -1,5 +1,5 @@ -(var should-repl false) -(var no-file true) +(var *should-repl* false) +(var *no-file* true) # Flag handlers (def handlers { @@ -11,7 +11,7 @@ (print " -r Enter the repl after running all scripts") (exit 0)) "v" (fn [] (print VERSION) (exit 0)) - "r" (fn [] (:= should-repl true)) + "r" (fn [] (:= *should-repl* true)) }) (defn dohandler [n] @@ -25,9 +25,9 @@ (if (= "-" (string-slice arg 0 1)) (dohandler (string-slice arg 1 2)) (do - (:= no-file false) + (:= *no-file* false) (import arg)))) -(when (or should-repl no-file) +(when (or *should-repl* *no-file*) (print (string "Dst " VERSION " Copyright (C) 2017-2018 Calvin Rose")) (repl getline)) diff --git a/src/parser/parse.c b/src/parser/parse.c index 24f67f7d..8956a8aa 100644 --- a/src/parser/parse.c +++ b/src/parser/parse.c @@ -157,6 +157,7 @@ struct DstParseState { #define PFLAG_CONTAINER 1 #define PFLAG_BUFFER 2 +#define PFLAG_SQRBRACKETS 4 static void pushstate(DstParser *p, Consumer consumer, int flags) { DstParseState s; @@ -336,7 +337,9 @@ static int comment(DstParser *p, DstParseState *state, uint8_t c) { static int root(DstParser *p, DstParseState *state, uint8_t c); static int dotuple(DstParser *p, DstParseState *state, uint8_t c) { - if (c == ')') { + if (state->flags & PFLAG_SQRBRACKETS + ? c == ']' + : c == ')') { int32_t i; Dst *ret = dst_tuple_begin(state->argn); for (i = state->argn - 1; i >= 0; i--) { @@ -349,7 +352,9 @@ static int dotuple(DstParser *p, DstParseState *state, uint8_t c) { } static int doarray(DstParser *p, DstParseState *state, uint8_t c) { - if (c == ']') { + if (state->flags & PFLAG_SQRBRACKETS + ? c == ']' + : c == ')') { int32_t i; DstArray *array = dst_array(state->argn); for (i = state->argn - 1; i >= 0; i--) { @@ -405,12 +410,21 @@ static int dotable(DstParser *p, DstParseState *state, uint8_t c) { static int ampersand(DstParser *p, DstParseState *state, uint8_t c) { (void) state; dst_v_pop(p->states); - if (c == '{') { + switch (c) { + case '{': pushstate(p, dotable, PFLAG_CONTAINER); return 1; - } else if (c == '"') { + case '"': pushstate(p, stringchar, PFLAG_BUFFER); return 1; + case '[': + pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_SQRBRACKETS); + return 1; + case '(': + pushstate(p, doarray, PFLAG_CONTAINER); + return 1; + default: + break; } pushstate(p, tokenchar, 0); dst_v_push(p->buf, '@'); /* Push the leading ampersand that was dropped */ @@ -448,7 +462,7 @@ static int root(DstParser *p, DstParseState *state, uint8_t c) { pushstate(p, dotuple, PFLAG_CONTAINER); return 1; case '[': - pushstate(p, doarray, PFLAG_CONTAINER); + pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_SQRBRACKETS); return 1; case '{': pushstate(p, dostruct, PFLAG_CONTAINER); diff --git a/test/suite0.dst b/test/suite0.dst index 1517ae13..4d342cf0 100644 --- a/test/suite0.dst +++ b/test/suite0.dst @@ -178,11 +178,11 @@ (def vargf (fn [more] (apply + more))) -(assert (= 0 (vargf [])) "var arg no arguments") -(assert (= 1 (vargf [1])) "var arg no packed arguments") -(assert (= 3 (vargf [1 2])) "var arg tuple size 1") -(assert (= 10 (vargf [1 2 3 4])) "var arg tuple size 3") -(assert (= 110 (vargf [1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple") +(assert (= 0 (vargf @[])) "var arg no arguments") +(assert (= 1 (vargf @[1])) "var arg no packed arguments") +(assert (= 3 (vargf @[1 2])) "var arg tuple size 1") +(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args") +(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple") # Higher order functions @@ -205,7 +205,7 @@ (assert (= (string "🐼" 🦊 🐮) "🐼:fox:cow") "emojis 🙉 :)") (assert (not= 🦊 :🦊) "utf8 strings are not symbols and vice versa") -# Symbols with @ symbol +# Symbols with @ character (def @ 1) (assert (= @ 1) "@ symbol") @@ -218,7 +218,7 @@ # Imperative merge sort merge (def merge (fn [xs ys] - (def ret []) + (def ret @[]) (def xlen (length xs)) (def ylen (length ys)) (var i 0) @@ -242,10 +242,10 @@ (:= j (+ j 1))) ret)) -(assert (apply <= (merge [1 3 5] [2 4 6])) "merge sort merge 1") -(assert (apply <= (merge [1 2 3] [4 5 6])) "merge sort merge 2") -(assert (apply <= (merge [1 3 5] [2 4 6 6 6 9])) "merge sort merge 3") -(assert (apply <= (merge '(1 3 5) [2 4 6 6 6 9])) "merge sort merge 4") +(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1") +(assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2") +(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3") +(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4") # Gensym tests @@ -262,8 +262,8 @@ # Let (assert (= (let [a 1 b 2] (+ a b)) 3), "simple let") -(assert (= (let [[a b] [1 2]] (+ a b)) 3), "destructured let") -(assert (= (let [[a [c d] b] [1 (tuple 4 3) 2]] (+ a b c d)) 10), "double destructured let") +(assert (= (let [[a b] @[1 2]] (+ a b)) 3), "destructured let") +(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10), "double destructured let") # Macros @@ -275,14 +275,15 @@ (do (var i 0) (when true - (:= i (+ i 1)) - (:= i (+ i 1)) - (:= i (+ i 1)) - (:= i (+ i 1)) - (:= i (+ i 1)) - (:= i (+ i 1))) + (++ i) + (++ i) + (++ i) + (++ i) + (++ i) + (++ i)) (assert (= i 6) "when macro")) + # report (print "\n" num-tests-passed " of " num-tests-run " tests passed\n") diff --git a/test/suite1.dst b/test/suite1.dst index f93cdc54..d6d40e1e 100644 --- a/test/suite1.dst +++ b/test/suite1.dst @@ -33,10 +33,10 @@ (print " \e[31m✘\e[0m " e) x)))) -(if (not= 400.0 (sqrt 160000)) (error "sqrt(160000)=400")) -(if (not= (real 400) (sqrt 160000)) (error "sqrt(160000)=400")) +(assert (= 400.0 (sqrt 160000)) "sqrt(160000)=400") +(assert (= (real 400) (sqrt 160000)) "sqrt(160000)=400") -(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het [1 2 3 4 5]}) +(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]}) (assert (= (get test-struct 'def) 1) "struct get") (assert (= (get test-struct 'bork) 2) "struct get") (assert (= (get test-struct 'sam) 3) "struct get")