2021-08-01 20:21:14 -04:00
|
|
|
(with_import "./collections.kp"
|
|
|
|
|
(let (
|
|
|
|
|
|
|
|
|
|
match (vau de (x & cases) (let (
|
|
|
|
|
x (eval x de)
|
|
|
|
|
evaluate_case (rec-lambda recurse (name_dict x c) (cond
|
|
|
|
|
; an explicit nil name_dict case allows us to simply fold over recurse in the array case later
|
|
|
|
|
(nil? name_dict) nil
|
|
|
|
|
(symbol? c) (put name_dict c x)
|
|
|
|
|
(and (int? x) (int? c) (= x c)) name_dict
|
|
|
|
|
(and (string? x) (string? c) (= x c)) name_dict
|
|
|
|
|
(and (bool? x) (bool? c) (= x c)) name_dict
|
|
|
|
|
(and (combiner? x) (combiner? c) (= x c)) name_dict
|
|
|
|
|
; check for invocation of quote directly
|
|
|
|
|
; not necessarily ideal if they define their own quote or something
|
|
|
|
|
(and (symbol? x) (array? c) (= 2 (len c)) (= quote (idx c 0)) (= x (idx c 1))) name_dict
|
2021-08-01 23:48:41 -04:00
|
|
|
; ditto with above, but with unquote to allow matching against the *value* of variables
|
|
|
|
|
(and (array? c) (= 2 (len c)) (= 'unquote (idx c 0)) (= x (eval (idx c 1) de))) name_dict
|
|
|
|
|
; ditto with above, but with array. Also note this means you have to use '[' and ']' as calling
|
|
|
|
|
; array explicitly will give you the symbol array instead...
|
2021-08-01 20:21:14 -04:00
|
|
|
(and (array? x) (array? c) (= (+ 1 (len x)) (len c)) (= array (idx c 0))) (foldl recurse name_dict x (slice c 1 -1))
|
|
|
|
|
true nil
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
iter (rec-lambda recurse (x i cases) (if (>= i (len cases)) (error "none of match arms matched!")
|
|
|
|
|
(let ( mapping (evaluate_case empty_dict x (idx cases i)))
|
|
|
|
|
(if (!= nil mapping) (eval (idx cases (+ i 1)) (add-dict-to-env de mapping))
|
|
|
|
|
(recurse x (+ i 2) cases)))))
|
|
|
|
|
) (iter x 0 cases)))
|
|
|
|
|
)
|
|
|
|
|
(provide match)
|
|
|
|
|
))
|