* [potluck dish] Extremely simple Recursive Descent Parser
@ 2016-02-15 23:28 Panicz Maciej Godek
0 siblings, 0 replies; only message in thread
From: Panicz Maciej Godek @ 2016-02-15 23:28 UTC (permalink / raw)
To: guile-user@gnu.org
[-- Attachment #1: Type: text/plain, Size: 5512 bytes --]
Sorry that I didn't have time to prepare anything better, but here's a
little appetizer.
It is my implementation of recursive descent parser. Perhaps it isn't as
expressive as bison or yacc, but it is considerably shorter :)
It implements backtracking through the mechanism of exceptions. The code is
so small that I'm pasting it here, along with example usages. It uses the
srfi-1 module as well as my (ice-9 nice-9) module to annoy Taylan a little
;]
https://github.com/panicz/pamphlet/blob/master/libraries/ice-9/nice-9.scm
Here it is:
(use-modules (srfi srfi-1) (ice-9 nice-9))
(define ((in? l) x)
(match l
((h . t)
(or (eq? x h)
((in? t) x)))
(_
#f)))
(define (non-terminals grammar)
(delete-duplicates
(map (λ ((non-terminal => . production))
non-terminal)
grammar)))
(define (terminals grammar)
(let ((non-terminals (non-terminals grammar))
(productions (append-map (λ ((non-terminal => . production))
production)
grammar)))
(delete-duplicates (lset-difference eq? productions non-terminals))))
(define ((recursive-descent-parser grammar) input)
(let ((non-terminals (non-terminals grammar))
(terminals (terminals grammar))
(((initial-rule => . _) . _) grammar))
(define (initial-match? rule input)
(let* ((prefix _ (span (in? terminals) rule))
(prefix-length (length prefix)))
(and (>= (length input) prefix-length)
(equal? prefix (take input prefix-length)))))
(define (match-rule rule input)
(match rule
(()
(values
'()
input))
(((? (in? terminals) t) . next)
(let (((token . input) input))
(if (eq? token t)
(let ((rest input (match-rule next input)))
(values
`(,token . ,rest)
input))
(throw 'parse-error input))))
(((? (in? non-terminals) A) . next)
(let* ((parsed input (parse-rule A input))
(rest input (match-rule next input)))
(values
`(,parsed . ,rest)
input)))))
(define (parse-rule rule-name input)
(let try ((variants (filter (λ ((name => . rule))
(and (eq? name rule-name)
(initial-match? rule input)))
grammar)))
(catch 'parse-error
(λ ()
(match variants
(((A => . first-rule) . _)
(let ((parsed input (match-rule first-rule input)))
(values
`(,A . ,parsed)
input)))
(_
(throw 'parse-error input))))
(λ errors
(match variants
((failed . remaining)
(try remaining))
(_
(throw 'parse-error input)))))))
(parse-rule initial-rule input)))
;; for example:
((recursive-descent-parser '((A => a A b)
(A => c)))
'(a a a c b b b))
;; => (A a (A a (A a (A c) b) b) b)
((recursive-descent-parser '((<S> => a <S> d)
(<S> => <B>)
(<B> => b <B> c)
(<B> => e)))
'(a a b b e c c d d))
; => (<S> a (<S> a (<S> (<B> b (<B> b (<B> e) c) c)) d) d)
((recursive-descent-parser '((<S> => <A> <B>)
(<A> => a <A>)
(<A> => x)
(<B> => b <B>)
(<B> => x)))
'(a a a a x b b x))
; => (<S> (<A> a (<A> a (<A> a (<A> a (<A> x))))) (<B> b (<B> b (<B>
x))))
;; note that the parser doesn''t always work;
;; it only works for the so-called LL grammars
;; for instance, the following grammar will result
;; in stack overflow:
((recursive-descent-parser '((<A> => <A> + <B>)
(<A> => <B>)
(<B> => a)
(<B> => c)))
'(a + c + a + c + a + a))
;; ~~~> <boom!>
;; However, the grammar can be transformed to an equivalent form:
((recursive-descent-parser '((<A> => <B> +<B>*)
(+<B>* => + <B> +<B>*)
(+<B>* => )
(<B> => a)
(<B> => c)))
'(a + c + a + c + a + a))
;; but then, some strange non-terminal symbols appear:
;=> (<A> (<B> a) (+<B>* + (<B> c)
; (+<B>* + (<B> a) (+<B>* + (<B> c)
; (+<B>* + (<B> a)
; (+<B>* + (<B> a) (+<B>*)))))))
; We need to introduce additional transformation on the ouput:
(define (eliminate+<B>* tree)
(match tree
(('<A> <B> +<B>*)
`(<A> ,<B> . ,(eliminate+<B>* +<B>*)))
(('+<B>* '+ <B> +<B>*)
`(+ ,<B> . ,(eliminate+<B>* +<B>*)))
(('+<B>*)
'())
(_
tree)))
(eliminate+<B>*
((recursive-descent-parser '((<A> => <B> +<B>*)
(+<B>* => + <B> +<B>*)
(+<B>* => )
(<B> => a)
(<B> => c)))
'(a + c + a + c + a + a)))
;=> (<A> (<B> a) + (<B> c) + (<B> a) + (<B> c) + (<B> a) + (<B>
a))
Happy birthday, Guile!
[-- Attachment #2: Type: text/html, Size: 8400 bytes --]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2016-02-15 23:28 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-02-15 23:28 [potluck dish] Extremely simple Recursive Descent Parser Panicz Maciej Godek
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).