;
; Bootstrapping a parser generator
;
; This defines a parser for the BNF-based syntax used here.
;

grammar =   prod*
;grammar =   prod_debug*

prod_debug = {prod:p}  ->
    (begin
     (when (>= *LOGLEVEL* 2)
       (printf "~%;>>> ~a~%" (read-parsed-text))
       (pretty-print p) )
     p)

prod =      comments name:n [ws '=' rules:rs] [action:a]  ->
    (declare-locals n rs a)

rules =     seq:s {ws '|' seq}*:ss   ->
    (if (empty? ss) s (cons 'or (cons s ss)))

seq =       rule:r rule*:rs          ->
    (if (empty? rs) r (cons 'and (cons r rs)))

rule =      {group | option | scheme | lit | atom}:item [{'+' | '*'}]:repeat [':' name:var]    ->
    (let ((x
           (cond
            ((equal? repeat "+") `(r+ ,item))
            ((equal? repeat "*") `(r* ,item))
            (else item) )))
      (if var `(setf ,var ,x) x))

group =     ws '{' rules:rs ws '}'   ->  `(and ,rs)
option =    ws '[' rules:rs ws ']'   ->  `(or ,rs #t)
; scheme = ws '(' ... ')'

comments =  {comment | nl}*
comment =   ';' not_nl* nl

action =    ws '->' ws atext
atext =     {nl {ws_ line}* | line}  ->
    (read-parsed-text)
;    (read-from-string (substring *s* __start *i*))

; Match everything to end of line
line =      not_nl* nl

; Match a grammatical atom 'name' -- return it as (name)
atom =      {name:n}  ->  (list n)

test = { (list '  (foo bar)):x }  ->  (car x)