Fix compiler optimization for if.

Add pattern matching library.
This commit is contained in:
Calvin Rose 2018-12-07 23:57:19 -05:00
parent f2743aca36
commit b7d44ba742
3 changed files with 61 additions and 2 deletions

49
lib/match.janet Normal file
View File

@ -0,0 +1,49 @@
# Sentinel value bad matches
(def- sentinel ~',(gensym))
(defn- match-1
[pattern expr onmatch seen]
(cond
(and (symbol? pattern) (not (keyword? pattern)))
(if (get seen pattern)
~(if (= ,pattern ,expr) ,onmatch ,sentinel)
(do
(put seen pattern true)
~(if (= nil (def ,pattern ,expr)) ,sentinel ,onmatch)))
(indexed? pattern)
(do
(def len (length pattern))
(def $arr (gensym))
(defn aux [i]
(if (= i len)
onmatch
(match-1 pattern.i ~(get ,$arr ,i) (aux (+ i 1)) seen)))
~(do (def ,$arr ,expr) ,(aux 0)))
(dictionary? pattern)
(do
(def $dict (gensym))
(defn aux [key]
(if (= key nil)
onmatch
(match-1 (get pattern key) ~(get ,$dict ,key) (aux (next pattern key)) seen)))
~(do (def ,$dict ,expr) ,(aux (next pattern nil))))
:else ~(if (= ,pattern ,expr) ,onmatch ,sentinel)))
(defmacro match
"Pattern matching."
[x & cases]
(if (not (atomic? x))
(do (def $x (gensym)) ~(do (def ,$x ,x) ,(match $x ;cases)))
(do
(def len (length cases))
(def len-1 (dec len))
(defn aux [i]
(cond
(= i len-1) (get cases i)
(< i len-1) (do
(def $res (gensym))
~(if (= ,sentinel (def ,$res ,(match-1 cases.i x (get cases (inc i)) @{})))
,(aux (+ 2 i))
,$res))))
(aux 0))))

View File

@ -60,7 +60,7 @@
(defmacro def-
"Define a private value that will not be exported."
[name & more]
~(def name :private ,;more))
~(def ,name :private ,;more))
(defn defglobal
"Dynamically create a global def."
@ -614,6 +614,16 @@
(array/push res item)))
res)
(defn count
"Count the number of items in ind for which (pred item)
is true."
[pred ind]
(var counter 0)
(loop [item :in ind]
(if (pred item)
(++ counter)))
counter)
(defn keep
"Given a predicate, take only elements from an array or tuple for
which (pred element) is truthy. Returns a new array of truthy predicate results."

View File

@ -359,8 +359,8 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
janetc_scope(&tempscope, c, 0, "if-body");
target = janetc_value(bodyopts, truebody);
janetc_popscope(c);
janetc_popscope(c);
janetc_throwaway(bodyopts, falsebody);
janetc_popscope(c);
return target;
}