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

Bugfix & added an extra lambda wrapping around term/nterm so that their value can be made recursive with let-rec, and with that the parser works! On the other hand, it takes 38 seconds to parse 'a,a,a' with the grammer A='a'|'a' ',' A .... so that could be a lot better.

Browse Source
This commit is contained in:
Nathan Braswell
2021-08-05 00:39:56 -04:00
parent c8c876e1bc
commit ae82af6636
2 changed files with 20 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
fungll.kp
View File

@@ -38,10 +38,16 @@
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_parser (lambda (t [X b i] l k c) (lambda (sigma)
(let (this_term (idx b (- i 1)))
(if (= this_term (slice t k (+ k (len this_term)))) ((c [[X b i] l (+ (len this_term) k)]) sigma)
(let (this_term (idx b (- i 1))
_ (println "term parser looking for " this_term " at position " k " in " t)
)
(if (and (<= (+ k (len this_term)) (len t)) (= this_term (slice t k (+ k (len this_term))))) ((c [[X b i] l (+ (len this_term) k)]) sigma)
sigma))))
term (lambda (s) [ s term_parser ])
; the extra lambda layer of indirection is so that
; recursive nonterminals can be made with rec-let, which
; only works on functions. So both term types get wrapped in
; an extra function which is evaluated in seqOp and parse
term (lambda (s) (lambda () [ s term_parser ]))
continue (lambda (BSR_element c) (lambda ([U G P Y])
(let (
@@ -54,10 +60,12 @@
) (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 (
seqOp (lambda (p s_q) (lambda (t X b l c0) (let (
; see term discussion about extra lambda wrap
[s q] (s_q)
c1 (lambda ([[X b i] l k]) (let (
c2 (lambda ([slot l r]) (continue [slot l k r] c0))
) (q t slot l k c2)))
) (q t [X b (+ 1 i)] 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 (
@@ -72,9 +80,12 @@
) (if (= 0 (size R)) ((p t s k (cont_for s p)) sigmap)
(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)
; see term discussion about extra lambda wrap
nterm (lambda (s p) (lambda () [ s (nterm_parser p) ]))
parse (lambda (s_f) (lambda (t)
(let (
; see term discussion about extra lambda wrap
[s f] (s_f)
X '__FUNGLL_UNIQUE_START_SYMBOL__
sigma [ set-empty multimap-empty multimap-empty set-empty ]
c (lambda (descriptor) (lambda (sigma) sigma))

2
fungll_test.kp
View File

@@ -35,7 +35,7 @@
_ (println "The a|a,A parser")
just_aa_parser (let-rec (
As (nterm 'A (altOp (altOp altStart (seqOp seqStart (term "a"))) (seqOp (seqOp seqStart (term ",")) As)))
As (nterm 'A (altOp (altOp altStart (seqOp seqStart (term "a"))) (seqOp (seqOp (seqOp seqStart (term "a")) (term ",")) As)))
) (parse As))
_ (println "parse result for a " (just_aa_parser "a"))
_ (println "parse result for b " (just_aa_parser "b"))