(let ((time-stamp "Time-stamp: <2000-12-06 01:01:01 cdutchyn@cs.ubc.ca>"))
  (eopl:printf "app-a.scm: code for EOPL Appendix A ~a~%"
               (substring time-stamp 13 29)))

;;;   This is the sequence of examples contained in Essentials of Programming
;;; Languages (2ed) Appendix A - The SLLGEN Parsing System.
;;;   It defines the scanner, grammars, and demonstrates correct parsing
;;; of the examples given in the Appendix.  It also contains a simple
;;; grammar to solve exercise A.1, and an interpreter to solve exercise
;;; A.3.
;;;                                     Chris Dutchyn, (cdutchyn@cs.ubc.ca)


;;; EOPL 2ed Appendix A

(define scanner-spec-a
  '((white-sp
     (whitespace)                       skip)
    (comment
     ("%" (arbno (not #\newline)))      skip)
    (identifier
     (letter (arbno (or letter digit))) symbol)
    (number
     (digit (arbno digit))              number)))

;;; Grammar A1
;;;;;;;;;;;;;;
(define grammar-a1
  '((statement
     ("{" statement ";" statement "}" )   compound-statement)
    (statement
     ("while" expression "do" statement)  while-statement)
    (statement
     (identifier ":=" expression)         assign-statement)
    (expression
     (identifier)                         var-exp)
    (expression
     ("(" expression "+" expression ")")  sum-exp)))

(newline)
(display "SLLGEN - datatypes for grammar A1")
(newline)
(print (sllgen:list-define-datatypes scanner-spec-a grammar-a1))
(newline)
(newline)
(display "SLLGEN - parse \"{x := foo; while x do y:= (x + bar)}\" in grammar A1")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-a1)
        "{x := foo; while x do y:= (x + bar)}"))
(newline)
(newline)

;;; Grammar A2
;;;;;;;;;;;;;;
(define grammar-a2
  '((statement
     ("{" (arbno statement ";") "}" )     compound-statement)
    (statement
     ("while" expression "do" statement)  while-statement)
    (statement
     (identifier ":=" expression)         assign-statement)
    (expression
     (identifier)                         var-exp)
    (expression
     ("(" expression "+" expression ")")  sum-exp)))

(display "SLLGEN - parse \"{x := foo; y:= bar; z := uu;}\" in grammar A2")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-a2)
        "{x := foo; y:= bar; z := uu;}"))
(newline)
(newline)

;;; Grammar A3
;;;;;;;;;;;;;;
(define grammar-a3
  '((expression
     (identifier)                                              var-exp)
    (expression
     ("let" (arbno identifier "=" expression) "in" expression) let-exp)))

(display "SLLGEN - parse \"(let x = y u = v in z)\" in grammar A3")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-a3)
        "let x = y u = v in z"))
(newline)
(newline)

;;; Grammar A4
;;;;;;;;;;;;;;
(define grammar-a4
  '((statement
     ("{" (separated-list statement ";") "}" ) compound-statement)
    (statement
     ("while" expression "do" statement)       while-statement)
    (statement
     (identifier ":=" expression)              assign-statement)
    (expression
     (identifier)                              var-exp)
    (expression
     ("(" expression "+" expression ")")       sum-exp)))

(display "SLLGEN - parse \"{x := y; u := v; z := t}\" in grammar A4")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-a4)
        "{x := y; u := v; z := t}"))
(newline)
(newline)

;;; Grammar A5
;;;;;;;;;;;;;;
(define grammar-a5
  '((statement
     ("{"
      (separated-list 
       (separated-list identifier ",")
       ":="
       (separated-list expression ",")
       ";")
      "}")                                compound-statement)
    (expression
     (number)                             lit-exp)
    (expression
     (identifier)                         var-exp)))

(display "SLLGEN - parse \"{x,y := u,v; z := 4; t1, t2 := 5, 6 }\" in grammar A5")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-a5)
        "{x,y := u,v; z := 4; t1, t2 := 5, 6 }"))
(newline)
(newline)

;;; Grammar for Exercise A.1
;;;;;;;;;;;;;;
(define grammar-ex1
  '((arith-expr
     (arith-term (arbno add-op arith-term))      add-expr)
    (arith-term
     (arith-factor (arbno mult-op arith-factor)) mult-expr)
    (arith-factor
     (number)                                    num-factor)
    (arith-factor
     ("(" arith-expr ")")                        paren-factor)
    (add-op
     ("+")                                       sum-op)
    (add-op
     ("-")                                       diff-op)
    (mult-op
     ("*")                                       times-op)
    (mult-op
     ("/")                                       div-op)))

(display "SLLGEN - parse \"3+2*66-5\" in the grammar for exercise A.1")
(newline)
(print ((sllgen:make-string-parser scanner-spec-a grammar-ex1)
        "3+2*66-5"))
(newline)
(newline)

;;; Evaluator for exercise A.3
;;;;;;;;;;;;;;
(define eval-arith-expr
  (lambda (expr)
    (cases arith-expr expr
           (add-expr (term oplist exprlist)
                     (eval-add-expr (eval-arith-term term)
                                    oplist
                                    exprlist)))))

(define eval-arith-term
  (lambda (term)
    (cases arith-term term
           (mult-expr (factor oplist exprlist)
                      (eval-mult-expr (eval-arith-factor factor)
                                      oplist
                                      exprlist)))))

(define eval-arith-factor
  (lambda (factor)
    (cases arith-factor factor
           (num-factor   (num)  num)
           (paren-factor (expr) (eval-arith-expr expr)))))

(define eval-mult-op
  (lambda (mop)
    (cases mult-op mop
           (times-op () *)
           (div-op   () /))))

(define eval-add-op
  (lambda (aop)
    (cases add-op aop
           (sum-op  () +)
           (diff-op () -))))

(define eval-mult-expr
  (lambda (val oplist exprlist)
    (if (null? oplist)
        val
        (eval-mult-expr ((eval-mult-op (car oplist))
                         val
                         (eval-arith-factor (car exprlist)))
                        (cdr oplist)
                        (cdr exprlist)))))

(define eval-add-expr
  (lambda (val oplist exprlist)
    (if (null? oplist)
        val
        (eval-add-expr ((eval-add-op (car oplist))
                        val
                        (eval-arith-term (car exprlist)))
                       (cdr oplist)
                       (cdr exprlist)))))

(display "SLLGEN - evaluate \"3+2*66-5\" for exercise A.3")
(newline)
(sllgen:make-define-datatypes scanner-spec-a grammar-ex1)
(print (eval-arith-expr ((sllgen:make-string-parser scanner-spec-a grammar-ex1)
                         "3+2*66-5")))
(newline)
(newline)