#! /usr/bin/env mzscheme
#lang scheme  ;tested in PLT Scheme 4.1
;;
;; om.scm -- OMeta parser generator script
;;

(require mzlib/defmacro)
(require mzlib/compat)  ;1+ 1-
(require mzlib/string)  ;read-from-string

(include "om-core.scm")


;; -----------------------------------------------
;; OMeta grammar definition

;(include "handwritten-ometa.scm")
(include "generated9.scm")


;; XXX: These two functions don't quite belong here.
;; They're part of the OMeta grammar definition, NOT this parser generator.
(define (declare-locals n rs a)
  (let ((locals `(let ,(append
                        '((__start *i*))
                        (map (lambda (n) (list n #f))
                             (extract-locals rs)) )) ))
    (when a (set! rs (append rs (list a))))
    `(define (,n) ,(append locals (list rs))) ))

(define (extract-locals e)
  "Find all variables assigned by SETFs in 'e'.
   Returns a possibly-empty list of symbols.

   NOTE: We're taking shortcuts because 'e' is generated code where
         all SETFs are relevant.  This is NOT reusable code!"
  (if (pair? e)
      (case (car e)
        ((setf)   (list (cadr e)))
        (else     (remove-duplicates
                   (flatten
                    (filter pair? (map extract-locals (cdr e)) ))) ))
      '() ))



;; -----------------------------------------------
;; This is basically I/O plumbing....

(define (transform-grammar input-file output-file)
  ;(when (>= *LOGLEVEL* 2)
  ;  (printf ";GIVEN:~%~a~%" *s*)
  ;  (printf ";PARSING...~%") )
  
  (let* ((output (parse-from-file input-file))
         (outfile (open-output-file output-file #:exists 'replace)))
    (pretty-print-columns 80)
    (for-each
     (lambda (expr)
       (pretty-print expr outfile) (newline outfile))
     output) )
  
  (let ((remaining (substring *s* *i*)))
    (if (equal? remaining "")
        (when (>= *LOGLEVEL* 1) (printf "~%All input was parsed.~%"))
        (printf "~%WARNING: UNPARSED INPUT REMAINING:~%~a~%" remaining) ))
  )

     
;; -----------------------------------------------
;; Command line interface
;; (This is PLT-Scheme-specific; also, R6RS offers a command-line parser)
;;
(define verbosity  (make-parameter 0))
(define includes   (make-parameter null))

(command-line
 #:multi
 [("-v" "--verbose") "Verbose messages (-vv, -vvv for voluminous debug messages)"
                     (verbosity (1+ (verbosity)))]
 
 ; I don't think this is really necessary... and besides, I don't think
 ; (include) works at runtime; we'd have to (load) all the interdependent
 ; parser parts, or deal with namespaces...
 [("-i" "--include") scheme-file
                     "Include <scheme-file> ..."
                     (includes (cons scheme-file (includes)))]
 
 #:args
 (input-grammar-file output-scheme-file)

 (begin
   (set! *LOGLEVEL* (verbosity))
   (transform-grammar input-grammar-file output-scheme-file)
   ))