From c96f20c80e781c231b670b9800cca4267e88bc45 Mon Sep 17 00:00:00 2001 From: Nathan Braswell Date: Tue, 3 Aug 2021 00:56:07 -0400 Subject: [PATCH] Add lcompose to prelude, size to rb, and sketch out fungll. Still haven't figured out the exact datatype for grammer_slots and have decided to implement [] destrucuring in lambda params, and change let destructuring to use []. --- fungll.kp | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++++ prelude.kp | 3 ++ rb.kp | 7 +++- rb_test.kp | 66 +++++++++++++++++----------------- 4 files changed, 143 insertions(+), 34 deletions(-) create mode 100644 fungll.kp diff --git a/fungll.kp b/fungll.kp new file mode 100644 index 0000000..d1091c6 --- /dev/null +++ b/fungll.kp @@ -0,0 +1,101 @@ + +(with_import "./collections.kp" +(with_import "./rb.kp" +(let ( + + ; 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 + ; + ; I previously had this as nonterminal, rule-idx, idx into rule, l,r + + ; U - discriptors added to (worklist?), makes sure no duplicates added to "list" + ; P - binary relation between pairs of commencments and right extants + ; makes sure that later discoveries that use a sub-non-terminal that has already + ; been processed can be completed since the sub-non-terminal won't be + ; re-descended at the same index + ; + ; a commencement is a pair of a nonterminal and a left extent (the arguemnts to + ; descend, since that's what we're skipping) to a set of right extants + ; G - binary relation between commencments and continuations, modified to include + ; actional continuation. + ; The normal continuation is a pair of as slot and a left extent. + ; So < -> > in G, with a new are is combined to form + ; discriptor and BSR whenever k,r are discovered for X + ; Note we haven't finished things with the above P, since some subs of the form + ; or descriptors that follow them may not have been processed + ; yet. When new Right extants are discovered, we must add descriptors + ; and to R (if not in U) and add + ; BSR elements and to Y + ; Y - Our result BSR set! + + ; 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) + 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 + (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) + 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) + (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] + ) (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)) + )))) + 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 +) +(provide) +))) diff --git a/prelude.kp b/prelude.kp index 069554b..93490b5 100644 --- a/prelude.kp +++ b/prelude.kp @@ -27,6 +27,8 @@ (let ( print_through (lambda (x) (do (println x) x)) + lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args))))) + rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se)) if (vau de (con than & else) (cond (eval con de) (eval than de) @@ -210,6 +212,7 @@ not lapply vapply + lcompose Y vY Y* diff --git a/rb.kp b/rb.kp index 04e670c..65ef665 100644 --- a/rb.kp +++ b/rb.kp @@ -16,6 +16,10 @@ E empty EE ['BB nil nil nil] + size (rec-lambda recurse (t) (match t + ~E 0 + [c a x b] (+ 1 (recurse a) (recurse 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) @@ -110,5 +114,6 @@ map-remove (lambda (t k) (generic-delete t map-cmp [k nil])) ) (provide set-empty 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) + map-empty map-insert map-contains-key? map-get map-get-or-default map-get-with-default map-remove + size) )) diff --git a/rb_test.kp b/rb_test.kp index 4ccf32a..c278670 100644 --- a/rb_test.kp +++ b/rb_test.kp @@ -1,49 +1,49 @@ (with_import "./rb.kp" (let ( first set-empty - _ (println first " set-contains? " 1 " ? " (set-contains? first 1)) + _ (println first " set-contains? " 1 " ? " (set-contains? first 1) " size " (size first)) second (set-insert first 1) - _ (println second " set-contains? " 1 " ? " (set-contains? second 1)) + _ (println second " set-contains? " 1 " ? " (set-contains? second 1) " size " (size second)) third (set-insert second 2) - _ (println third " set-contains? " 1 " ? " (set-contains? third 1)) - _ (println third " set-contains? " 2 " ? " (set-contains? third 2)) + _ (println third " set-contains? " 1 " ? " (set-contains? third 1) " size " (size third)) + _ (println third " set-contains? " 2 " ? " (set-contains? third 2) " size " (size third)) fourth (set-insert third 3) - _ (println fourth " set-contains? " 1 " ? " (set-contains? fourth 1)) - _ (println fourth " set-contains? " 2 " ? " (set-contains? fourth 2)) - _ (println fourth " set-contains? " 3 " ? " (set-contains? fourth 3)) - _ (println fourth " set-contains? " 4 " ? " (set-contains? fourth 4)) + _ (println fourth " set-contains? " 1 " ? " (set-contains? fourth 1) " size " (size fourth)) + _ (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)) fifth (set-remove fourth 1) - _ (println fifth " set-contains? " 1 " ? " (set-contains? fifth 1)) - _ (println fifth " set-contains? " 2 " ? " (set-contains? fifth 2)) - _ (println fifth " set-contains? " 3 " ? " (set-contains? fifth 3)) - _ (println fifth " set-contains? " 4 " ? " (set-contains? fifth 4)) + _ (println fifth " set-contains? " 1 " ? " (set-contains? fifth 1) " size " (size fifth)) + _ (println fifth " set-contains? " 2 " ? " (set-contains? fifth 2) " size " (size fifth)) + _ (println fifth " set-contains? " 3 " ? " (set-contains? fifth 3) " size " (size fifth)) + _ (println fifth " set-contains? " 4 " ? " (set-contains? fifth 4) " size " (size fifth)) sixth (set-remove fifth 3) - _ (println sixth " set-contains? " 1 " ? " (set-contains? sixth 1)) - _ (println sixth " set-contains? " 2 " ? " (set-contains? sixth 2)) - _ (println sixth " set-contains? " 3 " ? " (set-contains? sixth 3)) - _ (println sixth " set-contains? " 4 " ? " (set-contains? sixth 4)) + _ (println sixth " set-contains? " 1 " ? " (set-contains? sixth 1) " size " (size sixth)) + _ (println sixth " set-contains? " 2 " ? " (set-contains? sixth 2) " size " (size sixth)) + _ (println sixth " set-contains? " 3 " ? " (set-contains? sixth 3) " size " (size sixth)) + _ (println sixth " set-contains? " 4 " ? " (set-contains? sixth 4) " size " (size sixth)) seventh (set-remove sixth 2) - _ (println seventh " set-contains? " 1 " ? " (set-contains? seventh 1)) - _ (println seventh " set-contains? " 2 " ? " (set-contains? seventh 2)) - _ (println seventh " set-contains? " 3 " ? " (set-contains? seventh 3)) - _ (println seventh " set-contains? " 4 " ? " (set-contains? seventh 4)) + _ (println seventh " set-contains? " 1 " ? " (set-contains? seventh 1) " size " (size seventh)) + _ (println seventh " set-contains? " 2 " ? " (set-contains? seventh 2) " size " (size seventh)) + _ (println seventh " set-contains? " 3 " ? " (set-contains? seventh 3) " size " (size seventh)) + _ (println seventh " set-contains? " 4 " ? " (set-contains? seventh 4) " size " (size seventh)) first map-empty - _ (println first " map-contains-key? " 1 " ? " (map-contains-key? first 1)) + _ (println first " map-contains-key? " 1 " ? " (map-contains-key? first 1) " size " (size first)) second (map-insert first 1 "hello") - _ (println second " map-contains-key? " 1 " ? " (map-contains-key? second 1)) - _ (println second " map-get " 1 " ? " (map-get second 1)) + _ (println second " map-contains-key? " 1 " ? " (map-contains-key? second 1) " size " (size second)) + _ (println second " map-get " 1 " ? " (map-get second 1) " size " (size second)) third (map-insert second 1 "goodbye") - _ (println third " map-contains-key? " 1 " ? " (map-contains-key? third 1)) - _ (println third " map-get " 1 " ? " (map-get third 1)) + _ (println third " map-contains-key? " 1 " ? " (map-contains-key? third 1) " size " (size third)) + _ (println third " map-get " 1 " ? " (map-get third 1) " size " (size third)) fourth (map-insert third 2 "hmmm") - _ (println fourth " map-contains-key? " 2 " ? " (map-contains-key? fourth 2)) - _ (println fourth " map-get " 2 " ? " (map-get fourth 2)) - _ (println fourth " map-contains-key? " 1 " ? " (map-contains-key? fourth 1)) - _ (println fourth " map-get " 1 " ? " (map-get fourth 1)) - _ (println fourth " map-contains-key? " 3 " ? " (map-contains-key? fourth 3)) - _ (println fourth " map-get-or-default " 3 " 'hi ? " (map-get-or-default fourth 3 'hi)) - _ (println fourth " map-get-with-default " 3 " (lambda () 'bye) ? " (map-get-with-default fourth 3 (lambda () 'bye))) + _ (println fourth " map-contains-key? " 2 " ? " (map-contains-key? fourth 2) " size " (size fourth)) + _ (println fourth " map-get " 2 " ? " (map-get fourth 2) " size " (size fourth)) + _ (println fourth " map-contains-key? " 1 " ? " (map-contains-key? fourth 1) " size " (size fourth)) + _ (println fourth " map-get " 1 " ? " (map-get fourth 1) " size " (size fourth)) + _ (println fourth " map-contains-key? " 3 " ? " (map-contains-key? fourth 3) " size " (size fourth)) + _ (println fourth " map-get-or-default " 3 " 'hi ? " (map-get-or-default fourth 3 'hi) " size " (size fourth)) + _ (println fourth " map-get-with-default " 3 " (lambda () 'bye) ? " (map-get-with-default fourth 3 (lambda () 'bye)) " size " (size fourth)) fifth (map-remove fourth 2) - _ (println fifth " map-contains-key? " 2 " ? " (map-contains-key? fifth 2)) + _ (println fifth " map-contains-key? " 2 " ? " (map-contains-key? fifth 2) " size " (size fifth)) ) nil))