;; -------------------------------------------------
;; OMeta grammar translated to Scheme by hand....

; grammar = prod*
;(define (grammar)
;  (r* (prod)) )

; Debugging version
;(define (grammar)
;  (r* (dprint "" (prod))) )

; Improved debugging
(define (grammar)
  (r*
   (let* ((__start *i*)
          (p (prod))
          (src (substring *s* __start *i*)) )  ; src = input text, including trailing '\n'
     (when (and
            p 
            (>= *LOGLEVEL* 2))
       (printf "~%;>>> ~a" src)
       (pretty-print p) )
     p) ))


; prod = ws name:n [ws '=' rules:rs] [ws '->' action:a]  ->  (define (n) (rs)  (a)) .....
(define (prod)
  (let ((n #f)
        (rs #f)
        (a #f) )

    (and (ws) (setf n (name))
         (or (and (ws) (literal "=")
                  (setf rs (rules)) )
             #t)
         (or (and (ws) (literal "->")
                  (setf a (action)) )
             #t)
         (nl)
         
         ; the action
         (declare-locals n rs a)
         )))

; rules = seq:s ( ws '|' seq )*:ss  -> (if (empty? ss) s (cons 'or (cons s ss)))
(define (rules)
  ;; NOTE: not in the generated form (no SETFs)
  (let* ((s (seq))
         (ss (r* (and (ws) (literal "|") (seq)))) )
;    (dprint ";s=" s)
;    (dprint ";ss=" ss)
    ;; NOTE: (r*) always returns #t, so we have to test for '()
;    (if (empty? ss) s `(RULES-or ,@s ,@ss))
    (if (empty? ss) s (cons 'or (cons s ss)))
    ) )

; seq = rule:r rule*:rs          -> (if (empty? rs) r (cons 'and (cons r rs)))
(define (seq)
  ;; NOTE: not in the generated form (no SETFs)
  (let* ((r (rule))
         (rs (r* (rule))) )
;    (dprint ";r=" r)
;    (dprint ";rs=" rs)
    ;; NOTE: (r*) always returns #t, so we have to test for '()
;    (if (empty? rs) r `(SEQ-and ,@r ,@rs))
    (if (empty? rs) r (cons 'and (cons r rs)))
    ) )

;rule = (group | option | lit | name):item
;       [('+' | '*')]:repeat
;       [':' name:var]
;     -> item etc
(define (rule)
  (let ((item #f)
        (repeat #f)
        (var #f))
    (and
     (setf item   (or (group) (option) (lit) (atom)))
     (or (setf repeat (or (literal "+") (literal "*"))) #t)
     (or (setf var    (and (literal ":") (name))) #t)
;     (dprint ";item=" item)
     
; DEBUGGING INFO
;     (or (when (or var repeat)  (printf ";RULE: ~a:~a~a~%" item (or var "") (or repeat "")) ) #t)  ;XXX

     ; action
     (let ((x (cond
                    ((equal? repeat "+") `(r+ ,item))
                    ((equal? repeat "*") `(r* ,item))
                    (else                 item)
                    ) ) )
;       (dprint ";x="
               (if var `(setf ,var ,x) x)
;               )
       ) ) ) )

; group = ws '(' rules:rs ws ')'                     -> (group rs)
(define (group)
  (let ((r #f))
    (and (ws) (literal "(")
         (setf r (rules))
         (ws) (literal ")")
;         (dprint ";group_rules=" r)
;         `(GROUP-and ,r)
         `(and ,r)
         ) ) )
           
; option = ws '[' rules:rs ws ']'                     -> (option rs)
; Translate to (or rs #t) or something like that?
(define (option)
  (let ((r #f))
    (and (ws) (literal "[")
         (setf r (rules))
         (ws) (literal "]")
;         `(OPTION-or ,r #t)
         `(or ,r #t)
         ) ) )