From 5a61d5f90c099c6fcf8596a7eeba8bc4ec94ded5 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Wed, 4 Aug 2021 00:56:04 -0400 Subject: [PATCH] Added destructuring lambda/rec-lambda, changed let to use the same [] array destructuring syntax, added basic multiset & set-foldl. Fixed a bunch of bugs in fungll, hopefully close to working, but just realized that < is only defined for ints, while it's how the RB-Tree set/map sort their values/keys, so I'll need to extend it like = for all types. Tomorrow! --- fungll.kp | 95 ++++++++++++++++++++------------------------------ fungll_test.kp | 6 ++++ k_prime.krak | 2 +- prelude.kp | 13 ++++++- rb.kp | 17 +++++++-- rb_test.kp | 1 + 6 files changed, 72 insertions(+), 62 deletions(-) create mode 100644 fungll_test.kp diff --git a/fungll.kp b/fungll.kp index 3d15975..359977f 100644 --- a/fungll.kp +++ b/fungll.kp @@ -7,21 +7,6 @@ ; by L. Thomas van Binsbergena, Elizabeth Scott, Adrian Johnstone ; retrived from from http://ltvanbinsbergen.nl/publications/jcola-fgll.pdf - ; quick recognizer sketch - ;nterm(X,p)(t,k,c) = p(t,k,c) - ;term(lt)(t,k,c) =(if (= lt t[k]) (c (+ k 1)) - false) - ;seqStart(t,k,c) = c(k) - ;seqOp(p,q)(t,k,c) = p(t,k, (lambda (r) q(t,r,c)) ) - ;altStart(t,k,c) = false - ;altOp(p,q)(t,k,c) = p(t,k,c) or q(t,k,c) - ;recognize(p)(t) = p(t,0, (lambda (r) (= r (len t))) - - - ;var G = map, set>() - ;var P = map, set>() - ;var Y = set() - ; discriptor is a triple of grammer-slot and 2 indicies of t-string ; corresponding to process ; @@ -49,57 +34,51 @@ ; I've decided, a slot is [X [stff] int-for-dot] - id (lambda (sigma) sigma) altStart (lambda (t s k c) id) - altOp (lambda (p q) (lambda (t s k c) (lcompose (p t s k c) (q t s k c)))) - term (lambda (s) [ s term_parser ]) - term_parser (lambda (t gram_slot l k c) (lambda (sigma) - (if (= (get-s gram_slot) (idx t k)) ((c [gram_slot l (+ 1 k)]) sigma) + altOp (lambda (p q) (lambda (t s k c) (lcompose (p t s k c) (q t s [] k c)))) + term_parser (lambda (t [X b i] l k c) (lambda (sigma) + (if (= (idx b (- i 1)) (idx t k)) ((c [[X b i] l (+ 1 k)]) sigma) sigma))) - seqStart (lambda (t X b l c0) (continue [X::=.b,l,l,l] c0) - seqOp (lambda (p [s q]) (lambda (t X b l c0) (let ( - c2 (lambda ([slot l r]) (continue [slot l k r] c0)) - c1 (lambda ([slot l k]) (q t slot l k c2)) - ) (p t X sb l c1))))) - continue (lambda (descriptor? c) (lambda (sigma) - (if (set-contains? U descriptor?) sigma + term (lambda (s) [ s term_parser ]) + + continue (lambda (BSR_element c) (lambda ([U G P Y]) (let ( - [U G P Y] sigma - (slot l r) descriptor? - (X rhs i) slot - BSR_element [slot l k r] - Yp (if (or (= 0 i) (= (len rhs) i)) (set-insert Y BSR_element) - Y) + [slot l k r] BSR_element + descriptor [slot l r] + (X b i) slot + Yp (if (or (!= 0 i) (= (len rhs) i)) (set-insert Y BSR_element) + Y) Up (set-insert U descriptor) - ) ((c BSR_element) [Up G P Yp])) - ))) - cont_for (lambda (s p) (lambda (descriptor?) (lambda (sigma) (let ( - [U G P Y] sigma - sigmap [U G (set-insert P [[s k] r]) Y] - composed (foldl (lambda (cp [g l c]) (compose cp (c [g l r]))) id (map-get-or-default G [s k] [])) - ) (composed sigmap))))) - nterm (lambda (s p) [ s (nterm_parser p) ]) - nterm_parser (lambda (p) (lambda (t gram_slot l k c) (lambda (sigma) + ) (if (set-contains? U descriptor) [U G P Yp] + ((c descriptor) [Up G P Yp]))))) + seqStart (lambda (t X b l c0) (continue [[X b 0] l l l] c0)) + seqOp (lambda (p [s q]) (lambda (t X b l c0) (let ( + c1 (lambda ([slot l k]) (let ( + c2 (lambda ([slot l r]) (continue [slot l k r] c0)) + ) (q t slot l k c2))) + ) (p t X (cons s b) l c1)))) + + cont_for (lambda (s p) (lambda ([[s d i] k r]) (lambda ([U G P Y]) (let ( + composed (set-foldl (lambda (cp [g l c]) (lcompose cp (c [g l r]))) id (multimap-get G [s k])) + ) (composed [U G (multimap-insert P [s k] r) Y]))))) + nterm_parser (lambda (p) (lambda (t gram_slot l k c) (lambda ([U G P Y]) (let ( - R (map-get-or-default P [s k] []) - [U G P Y] sigma - sigmap [U (map-insert G [s k] [gram_slot l c]) Y] + [X b i] gram_slot + s (idx b (- i 1)) + R (multimap-get P [s k]) + sigmap [U (multimap-insert G [s k] [gram_slot l c]) P Y] ) (if (= 0 (size R)) ((p t s k (cont_for s p)) sigmap) - (foldl (lambda (cp r) (compose cp (c [gram_slot l r]))) id R)) - )))) + (set-foldl (lambda (cp r) (lcompose cp (c [gram_slot l r]))) id R) + ))))) + nterm (lambda (s p) [ s (nterm_parser p) ]) parse (lambda ([s f]) (lambda (t) (let ( - X (fresh) - sigma [ empty empty empty empty ] - c (lambda (bsr_element) (lambda (sigma) sigma)) - [U G P Y] ((f t X::=s. 0 0 c) sigma) - ) Y))) - - ; Big notes - ; - haven't figured out exactly how grammer slots are going to work, also if s is already a vector - ; - also need to add [] destructuring to parameter lists & change let desturcturing to [] - ; - much more I'm sure I'm quite tired + X '__FUNGLL_UNIQUE_START_SYMBOL__ + sigma [ set-empty multimap-empty multimap-empty set-empty ] + c (lambda (descriptor) (lambda (sigma) sigma)) + [U G P Y] ((f t ['X [s] 1] 0 0 c) sigma) + ) (set-foldl cons [] Y)))) ) -(provide) +(provide altStart altOp term seqStart seqOp nterm parse) ))) diff --git a/fungll_test.kp b/fungll_test.kp new file mode 100644 index 0000000..60ec7d6 --- /dev/null +++ b/fungll_test.kp @@ -0,0 +1,6 @@ +(with_import "./fungll.kp" +(let ( + just_a_parser (parse (nterm 'A (altOp altStart (seqOp seqStart (term (idx "a" 0)))))) + parse_result (just_a_parser "a") + _ (println "parse result " parse_result) +) nil)) diff --git a/k_prime.krak b/k_prime.krak index 427125e..b1b13e9 100644 --- a/k_prime.krak +++ b/k_prime.krak @@ -1115,7 +1115,7 @@ fun main(argc: int, argv: **char): int { if params.size <= 1 { return make_pair(null(), KPResult::Err(kpString(str("Need 2 or more params to <")))) } - if !params[0].is_int() { return make_pair(null(), KPResult::Err(kpString(str("called < with first not an int ") + pr_str(params[0], true)))); } + if !params[0].is_int() { return make_pair(null(), KPResult::Err(kpString(str("called < with first not an int ") + pr_str(params[0], true) + "\nenv was\n" + dynamic_env->to_string()))); } for (var i = 0; i < params.size - 1; i++;) { if !params[i+1].is_int() { return make_pair(null(), KPResult::Err(kpString(str("called < with param ") + (i+1) + " not an int " + pr_str(params[i+1], true)))); } if !(params[i].get_int() < params[i+1].get_int()) { diff --git a/prelude.kp b/prelude.kp index 93490b5..642bdd3 100644 --- a/prelude.kp +++ b/prelude.kp @@ -114,12 +114,23 @@ destructure_helper (rec-lambda recurse (vs i r) (cond (= (len vs) i) r (array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i))) - new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i)) + new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (slice (idx vs i) 1 -1)) ) (recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1)))))) true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2)))) ))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de))) + ; and a destructuring-capable lambda! + lambda (vau se (p b) (let ( + sym_params (map (lambda (param) (if (symbol? param) param + (str-to-symbol (str param)))) p) + body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b) + ) (wrap (eval (array vau (quote _) sym_params body) se)))) + + ; and rec-lambda - yes it's the same definition again + rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) + + is_pair? (lambda (x) (and (array? x) (> (len x) 0))) quasiquote (vY (lambda (recurse) (vau de (x) diff --git a/rb.kp b/rb.kp index 65ef665..d6615c2 100644 --- a/rb.kp +++ b/rb.kp @@ -20,6 +20,10 @@ ~E 0 [c a x b] (+ 1 (recurse a) (recurse b)))) + generic-foldl (rec-lambda recurse (f z t) (match t + ~E z + [c a x b] (recurse f (f (recurse f z a) x) b))) + generic-contains? (rec-lambda recurse (t cmp v found not-found) (match t ~E (not-found) [c a x b] (match (cmp v x) '< (recurse a cmp v found not-found) @@ -87,15 +91,17 @@ ['B ~E x ~E] (match (cmp v x) '= EE _ t) [c a x b] (match (cmp v x) '< (rotate [c (del a v) x b]) - '= (let ((vp bp) (min_delete b)) + '= (let ([vp bp] (min_delete b)) (rotate [c a vp bp])) '> (rotate [c a x (del b v)])))) ) (del (redden t) v))) + set-cmp (lambda (a b) (cond (< a b) '< (= a b) '= true '>)) set-empty empty + set-foldl generic-foldl set-insert (lambda (t x) (generic-insert t set-cmp x false)) set-contains? (lambda (t x) (generic-contains? t set-cmp x (lambda (f) true) (lambda () false))) set-remove (lambda (t x) (generic-delete t set-cmp x)) @@ -112,8 +118,15 @@ map-get-or-default (lambda (t k d) (generic-contains? t map-cmp [k nil] (lambda (f) (idx f 1)) (lambda () d))) map-get-with-default (lambda (t k d) (generic-contains? t map-cmp [k nil] (lambda (f) (idx f 1)) (lambda () (d)))) map-remove (lambda (t k) (generic-delete t map-cmp [k nil])) + + ; This could be 2x as efficent by being implmented on generic instead of map, + ; as we wouldn't have to traverse once to find and once to insert + multimap-empty map-empty + multimap-insert (lambda (t k v) (map-insert t k (set-insert (map-get-or-default t k set-empty) v))) + multimap-get (lambda (t k) (map-get-or-default t k set-empty)) ) - (provide set-empty set-insert set-contains? set-remove + (provide set-empty set-foldl set-insert set-contains? set-remove map-empty map-insert map-contains-key? map-get map-get-or-default map-get-with-default map-remove + multimap-empty multimap-insert multimap-get size) )) diff --git a/rb_test.kp b/rb_test.kp index c278670..a9b5003 100644 --- a/rb_test.kp +++ b/rb_test.kp @@ -12,6 +12,7 @@ _ (println fourth " set-contains? " 2 " ? " (set-contains? fourth 2) " size " (size fourth)) _ (println fourth " set-contains? " 3 " ? " (set-contains? fourth 3) " size " (size fourth)) _ (println fourth " set-contains? " 4 " ? " (set-contains? fourth 4) " size " (size fourth)) + _ (println fourth " foldl with + " (set-foldl + 0 fourth)) fifth (set-remove fourth 1) _ (println fifth " set-contains? " 1 " ? " (set-contains? fifth 1) " size " (size fifth)) _ (println fifth " set-contains? " 2 " ? " (set-contains? fifth 2) " size " (size fifth))