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

Update apply to be variadic, and keep non variadic form as apply1

This commit is contained in:
Calvin Rose 2018-03-16 15:45:24 -04:00
parent 72d8e74a71
commit 110c780747
4 changed files with 31 additions and 20 deletions

View File

@ -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
]
}))

View File

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

View File

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

View File

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