mirror of
https://github.com/janet-lang/janet
synced 2025-01-12 16:40:27 +00:00
Fix compiler optimization for if.
Add pattern matching library.
This commit is contained in:
parent
f2743aca36
commit
b7d44ba742
49
lib/match.janet
Normal file
49
lib/match.janet
Normal 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))))
|
@ -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."
|
||||
|
@ -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;
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user