diff --git a/examples/assembly.dst b/examples/assembly.dst index d027e935..ef72766f 100644 --- a/examples/assembly.dst +++ b/examples/assembly.dst @@ -4,12 +4,10 @@ (def fibasm (asm '{ arity 1 bytecode [ - (ldi 1 0x2) # $1 = 2 + (ldi 1 0x2) # $1 = 2 (lt 1 0 1) # $1 = $0 < $1 - (jmpn 1 :recursive) # if (not $1) goto :recursive - (ret 0) # return $0 - :recursive - (lds 1) # $1 = self + (jmpi 1 :done) # if ($1) goto :done + (lds 1) # $1 = self (addim 0 0 -0x1) # $0 = $0 - 1 (push 0) # push($0) (call 2 1) # $2 = call($1) @@ -17,6 +15,7 @@ (push 0) # push($0) (call 0 1) # $0 = call($1) (addi 0 0 2) # $0 = $0 + $2 (integers) + :done (ret 0) # return $0 ] })) diff --git a/examples/lazyseqs.dst b/examples/lazyseqs.dst index f90090dd..5d7052ee 100644 --- a/examples/lazyseqs.dst +++ b/examples/lazyseqs.dst @@ -17,7 +17,7 @@ (defmacro delay "Macro for lazy evaluation" - [& forms] (tuple mem0 (apply tuple (array-concat ['fn []] forms)))) + [& forms] (tuple mem0 (apply1 tuple (array-concat ['fn []] forms)))) # Use tuples instead of structs to save memory (def HEAD :private 0) @@ -56,7 +56,7 @@ "Return a sequence of integers [start, end)." [start end] (if (< start end) - (cons start (range (+ 1 start) end)) + (cons start (range2 (+ 1 start) end)) empty-seq)) (defn range @@ -85,7 +85,7 @@ [n s] (delay (def x (s)) - (if (s) (if (zero? n) s (drop (- n 1) (tail s))) empty-seq)) + (if (s) (if (zero? n) s (drop (- n 1) (tail s))) empty-seq))) (defn take "Returns at most the first n values of s." @@ -97,5 +97,9 @@ (defn take-while "Returns a sequence of values until the predicate is false." [pred s] - (delay (if (s) ))) + (delay + (def x (s)) + (when x + (def thehead (get HEAD x)) + (if thehead (tuple thehead (take-while pred (get TAIL x))))))) diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 19740463..0e0ac9a2 100644 --- a/src/compiler/boot.dst +++ b/src/compiler/boot.dst @@ -13,7 +13,7 @@ (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])) - (apply tuple formargs))) + (apply1 tuple formargs))) (def defmacro :macro "Define a macro." @@ -21,18 +21,18 @@ (def defn* (get (get _env 'defn) 'value)) (fn [name & more] (def args (array-concat [] name :macro more)) - (apply defn* args)))) + (apply1 defn* args)))) (defmacro defmacro- "Define a private macro that will not be exported." [name & more] - (apply tuple (array-concat + (apply1 tuple (array-concat ['defmacro name :private] more))) (defmacro defn- "Define a private function that will not be exported." [name & more] - (apply tuple (array-concat + (apply1 tuple (array-concat ['defn name :private] more))) (defn even? [x] (== 0 (% x 2))) @@ -91,6 +91,11 @@ are matched. If there are no matches, return nil." [sym] (tuple doc* '_env sym)) +(def apply + (fn [f & args] + (def last (- (length args) 1)) + (apply1 f (array-concat (array-slice args 0 -2) (get args last))))) + (defmacro select "Select the body that equals the dispatch value. When pairs has an odd number of arguments, the last is the default expression. @@ -210,7 +215,7 @@ If no match is found, returns nil" (get head (+ 1 i)))) (varset! i (+ i 2))) (array-push accum (tuple-prepend body 'do)) - (apply tuple accum)) + (apply1 tuple accum)) (defn pairs [x] (var lastkey (next x nil)) @@ -265,7 +270,7 @@ If no match is found, returns nil" [(get n 0) (array-slice n 1)] [n []])) (def parts (array-concat [h last] t)) - (apply tuple parts)) + (apply1 tuple parts)) (reduce fop x forms)) (defmacro ->> @@ -276,7 +281,7 @@ If no match is found, returns nil" [(get n 0) (array-slice n 1)] [n []])) (def parts (array-concat [h] t [last])) - (apply tuple parts)) + (apply1 tuple parts)) (reduce fop x forms)) # Start pretty printer @@ -380,7 +385,10 @@ onvalue." (select (fiber-status chars) :new (parser-byte p (resume chars)) :pending (parser-byte p (resume chars)) - (varset! going false))))))) + (varset! going false)))) + (when (not= :root (parser-status p)) + (onerr "parse" "unexpected end of source")) + nil))) (defn more [] (if temp true (do (varset! temp true) @@ -427,13 +435,13 @@ onvalue." (def newenv (require path)) (def { :prefix prefix - } (apply table args)) + } (apply1 table args)) (foreach (pairs newenv) (fn [[k v]] (when (not (get v :private)) (put env (symbol (if prefix prefix "") k) v))))) (defmacro import [path & args] - (apply tuple (array-concat [import* '_env path] args))) + (apply1 tuple (array-concat [import* '_env path] args))) (defn repl [getchunk] (def newenv (make-env)) diff --git a/src/compiler/stl.c b/src/compiler/stl.c index f8486d21..89f67bfc 100644 --- a/src/compiler/stl.c +++ b/src/compiler/stl.c @@ -89,7 +89,7 @@ DstTable *dst_stl_env() { dst_env_cfuns(env, cfuns); dst_env_def(env, "error", dst_wrap_function(dst_quick_asm(1, 0, 1, error_asm, sizeof(error_asm)))); - dst_env_def(env, "apply", dst_wrap_function(dst_quick_asm(2, 0, 2, apply_asm, sizeof(apply_asm)))); + dst_env_def(env, "apply1", dst_wrap_function(dst_quick_asm(2, 0, 2, apply_asm, sizeof(apply_asm)))); dst_env_def(env, "yield", dst_wrap_function(dst_quick_asm(1, 0, 2, yield_asm, sizeof(yield_asm)))); dst_env_def(env, "resume", dst_wrap_function(dst_quick_asm(2, 0, 2, resume_asm, sizeof(resume_asm))));