miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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 [].

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-03 00:56:07 -04:00
parent dc712060cd
commit c96f20c80e
4 changed files with 143 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
fungll.kp Normal file
View File

@@ -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<pair<int, int>, set<Pending>>()
;var P = map<pair<int,int>, set<int>>()
;var Y = set<BS>()
; discriptor is a triple of grammer-slot and 2 indicies of t-string
; corresponding to process
; <X::= a.b,l,k>
; 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 <s::=.d,k,k>
;
; 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 <<X,k> -> <g,l>> in G, with a new are is combined to form
; discriptor <g,l,r> and BSR <g,l,k,r> whenever k,r are discovered for X
; Note we haven't finished things with the above P, since some subs of the form
; <s::=.d,k,k> or descriptors that follow them may not have been processed
; yet. When new Right extants are discovered, we must add descriptors
; <Y::=a's.b',l',r_j> and <X::as.b,l,rj> to R (if not in U) and add
; BSR elements <Y::=a's.b',l',k,r_j> and <X::=as.b,l,k,r_j> 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 <empty> 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)
)))

3
prelude.kp
View File

@@ -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*

7
rb.kp
View File

@@ -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)
))

66
rb_test.kp
View File

@@ -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))