1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-16 02:09:56 +00:00

Make loop macro more expressive

This commit is contained in:
Calvin Rose 2018-05-26 13:46:27 -04:00
parent 8bcb5e0019
commit 4dc51915a9
2 changed files with 26 additions and 9 deletions

1
.gitignore vendored
View File

@ -9,6 +9,7 @@ dst
# Generated files # Generated files
*.gen.h *.gen.h
*.gen.c
# Generate test files # Generate test files
*.out *.out

View File

@ -68,6 +68,7 @@
(defn fiber? [x] (= (type x) :fiber)) (defn fiber? [x] (= (type x) :fiber))
(defn string? [x] (= (type x) :string)) (defn string? [x] (= (type x) :string))
(defn symbol? [x] (= (type x) :symbol)) (defn symbol? [x] (= (type x) :symbol))
(defn keyword? [x] (if (not= (type x) :symbol) nil (= 58 (get x 0))))
(defn buffer? [x] (= (type x) :buffer)) (defn buffer? [x] (= (type x) :buffer))
(defn function? [x] (= (type x) :function)) (defn function? [x] (= (type x) :function))
(defn cfunction? [x] (= (type x) :cfunction)) (defn cfunction? [x] (= (type x) :cfunction))
@ -224,46 +225,61 @@ value."
(def head1 (ast.unwrap1 head)) (def head1 (ast.unwrap1 head))
(def len (length head1)) (def len (length head1))
(defn doone (defn doone
[i] [i preds]
(default preds @['and])
(if (>= i len) (if (>= i len)
(tuple.prepend body 'do) (tuple.prepend body 'do)
(do (do
(def bindings (get head1 i)) (def bindings (get head1 i))
(def ubindings (ast.unwrap1 bindings))
(def verb (ast.unwrap1 (get head1 (+ i 1)))) (def verb (ast.unwrap1 (get head1 (+ i 1))))
(def object (ast.unwrap1 (get head1 (+ i 2)))) (def object (ast.unwrap1 (get head1 (+ i 2))))
(if (= (ast.unwrap1 bindings) :where) (if (keyword? ubindings)
(tuple 'if verb (doone (+ i 2))) (switch
ubindings
:while (do
(array.push preds verb)
(doone (+ i 2) preds))
:let (tuple 'let verb (doone (+ i 2)))
:when (tuple 'if verb (doone (+ i 2)))
(error ("unexpected loop predicate: " verb)))
(switch (switch
verb verb
:range (do :range (do
(def [start end _inc] (ast.unwrap1 object)) (def [start end _inc] (ast.unwrap1 object))
(def inc (if _inc _inc 1)) (def inc (if _inc _inc 1))
(def endsym (gensym)) (def endsym (gensym))
(def preds @['and (tuple < bindings endsym)])
(def subloop (doone (+ i 3) preds))
(tuple 'do (tuple 'do
(tuple 'var bindings start) (tuple 'var bindings start)
(tuple 'def endsym end) (tuple 'def endsym end)
(tuple 'while (tuple < bindings endsym) (tuple 'while (apply1 tuple preds)
(doone (+ i 3)) subloop
(tuple ':= bindings (tuple + bindings inc))))) (tuple ':= bindings (tuple + bindings inc)))))
:keys (do :keys (do
(def $dict (gensym "dict")) (def $dict (gensym "dict"))
(def preds @['and (tuple not= nil bindings)])
(def subloop (doone (+ i 3) preds))
(tuple 'do (tuple 'do
(tuple 'def $dict object) (tuple 'def $dict object)
(tuple 'var bindings (tuple next $dict nil)) (tuple 'var bindings (tuple next $dict nil))
(tuple 'while (tuple not= nil bindings) (tuple 'while (apply1 tuple preds)
(doone (+ i 3)) subloop
(tuple ':= bindings (tuple next $dict bindings))))) (tuple ':= bindings (tuple next $dict bindings)))))
:in (do :in (do
(def $len (gensym "len")) (def $len (gensym "len"))
(def $i (gensym "i")) (def $i (gensym "i"))
(def $indexed (gensym "indexed")) (def $indexed (gensym "indexed"))
(def preds @['and (tuple < $i $len)])
(def subloop (doone (+ i 3) preds))
(tuple 'do (tuple 'do
(tuple 'def $indexed object) (tuple 'def $indexed object)
(tuple 'def $len (tuple length $indexed)) (tuple 'def $len (tuple length $indexed))
(tuple 'var $i 0) (tuple 'var $i 0)
(tuple 'while (tuple < $i $len) (tuple 'while (apply1 tuple preds)
(tuple 'def bindings (tuple get $indexed $i)) (tuple 'def bindings (tuple get $indexed $i))
(doone (+ i 3)) subloop
(tuple ':= $i (tuple + 1 $i))))) (tuple ':= $i (tuple + 1 $i)))))
(error ("unexpected loop verb: " verb))))))) (error ("unexpected loop verb: " verb)))))))
(doone 0)) (doone 0))