;;; Data definitions and arithmetic-exp parser for mp3.

(module mp3-data-structures (lib "eopl.ss" "eopl")
  (require "drscheme-init.scm")

  (provide prefix-exp prefix-exp? const-exp diff-exp)

  (provide arithmetic-exp arithmetic-exp?
           constant-exp addition-exp subtraction-exp multiplication-exp
           var-exp
           scan&parse)

  ;; For tasks 2 and 3

  (define-datatype arithmetic-exp arithmetic-exp?
    (constant-exp
      (num integer?))
    (addition-exp
      (operand1 arithmetic-exp?)
      (operand2 arithmetic-exp?))
    (subtraction-exp
      (operand1 arithmetic-exp?)
      (operand2 arithmetic-exp?))
    (multiplication-exp
      (operand1 arithmetic-exp?)
      (operand2 arithmetic-exp?))
    (var-exp
      (id symbol?)))

  ;; For task 4 (EoPL exercise 2.31)

  (define-datatype prefix-exp prefix-exp?
    (const-exp
      (num integer?))
    (diff-exp
      (operand1 prefix-exp?)
      (operand2 prefix-exp?)))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; The following scan&parse procedure may make it easier to
  ;; construct tests for tasks 2 and 3.

  ;; scan&parse: String -> arithmetic-exp
  ;; usage: (scan&parse s) returns the abstract syntax tree for s,
  ;;     provided s is generated by the following grammar:
  ;;
  ;; E  -->  T  |  E + T  |  E - T
  ;; T  -->  F  |  T * F
  ;; F  -->  N  |  I  |  ( E )
  ;; N  -->  0  |  1  |  ...
  ;; I  -->  x  |  y  |  ...

  (define scan&parse
    (lambda (expression-string)
      (parsetree->arithmetic-exp
       (private-parse
        (private-scan expression-string)))))

  ;; parsetree->arithmetic-exp: ParseTree -> arithmetic-exp
  ;; usage: (parsetree->arithmetic-exp t) returns the arithmetic
  ;;     expression for t, where t is generated by the grammar
  ;;
  ;; t  -->  N  |  I  |  (+ t t)  |  (- t t)  |  (* t t)

  (define parsetree->arithmetic-exp
    (lambda (t)
      (cond ((number? t)
             (constant-exp t))
            ((symbol? t)
             (var-exp t))
            (else
             (let ((op (car t))
                   (exp1 (parsetree->arithmetic-exp (cadr t)))
                   (exp2 (parsetree->arithmetic-exp (caddr t))))
               (cond ((equal? op '+)
                      (addition-exp exp1 exp2))
                     ((equal? op '-)
                      (subtraction-exp exp1 exp2))
                     ((equal? op '*)
                      (multiplication-exp exp1 exp2))
                     (else
                      (eopl:error 'scan&parse "parser bug"))))))))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;; Help procedures used by parser.
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; private-scan: String -> Listof[Token]
  ;; usage: (private-scan s) returns the list of tokens in s,
  ;;     provided s is generated by the grammar above.
  ;; A token is one of:
  ;; - an integer
  ;; - a symbol made up of English letters
  ;; - one of the three symbols + - *
  ;; - one of the two characters #\( #\)

  (define private-scan
    (lambda (s)
      (private-scan-loop (string->list s) '() 'none '())))

  ;; private-scan-loop: Listof[Char] * Listof[Token] * Symbol * Listof[Char]
  ;; usage: (private-scan-loop input tokens state chars)
  ;;     returns the given tokens (in reverse order)
  ;;     followed by the current token being built up in chars
  ;;     of the kind specified by the current state
  ;;     followed by any remaining tokens found in the input

  (define private-scan-loop
    (lambda (input tokens state chars)
      (case state
       ((none)
        (cond ((null? input)
               (reverse tokens))
              ((is-digit? (car input))
               (private-scan-loop (cdr input)
                                  tokens
                                  'integer
                                  (list (car input))))
              ((is-letter? (car input))
               (private-scan-loop (cdr input)
                                  tokens
                                  'identifier
                                  (list (car input))))
              ((char=? (car input) #\+)
               (private-scan-loop (cdr input)
                                  (cons '+ tokens)
                                  'none '()))
              ((char=? (car input) #\-)
               (private-scan-loop (cdr input)
                                  (cons '- tokens)
                                  'none '()))
              ((char=? (car input) #\*)
               (private-scan-loop (cdr input)
                                  (cons '* tokens)
                                  'none '()))
              ((char=? (car input) #\()
               (private-scan-loop (cdr input)
                                  (cons #\( tokens)
                                  'none '()))
              ((char=? (car input) #\))
               (private-scan-loop (cdr input)
                                  (cons #\) tokens)
                                  'none '()))
              (else
               ;; ignore whitespace
               (private-scan-loop (cdr input) tokens state '()))))
       ((integer)
        (cond ((null? input)
               (private-scan-loop (cons #\space input) tokens state chars))
              ((is-digit? (car input))
               (private-scan-loop (cdr input)
                                  tokens
                                  'integer
                                  (cons (car input) chars)))
              (else
               (private-scan-loop (cdr input)
                                  (cons (string->number
                                         (list->string (reverse chars)))
                                        tokens)
                                  'none '()))))
       ((identifier)
        (cond ((null? input)
               (private-scan-loop (cons #\space input) tokens state chars))
              ((is-letter? (car input))
               (private-scan-loop (cdr input)
                                  tokens
                                  'identifier
                                  (cons (car input) chars)))
              (else
               (private-scan-loop (cdr input)
                                  (cons (string->symbol
                                         (list->string (reverse chars)))
                                        tokens)
                                  'none '()))))
       (else
        (eopl:error 'private-scan-loop "parser bug")))))

  ;; is-digit?: Char -> Bool
  ;; usage: (is-digit? c) returns true if and only if c is a digit

  (define is-digit?
    (lambda (c)
      (and (memv c digits)
           #t)))

  ;; is-letter?: Char -> Bool
  ;; usage: (is-letter? c) returns true if and only if c is an English letter

  (define is-letter?
    (lambda (c)
      (and (memv c letters)
           #t)))

  ;; digits: Listof[Char]
  ;; digits is a list of the ten characters that represent decimal digits

  (define digits (string->list "0123456789"))

  ;; letters: Listof[Char]
  ;; letters is a list of the 52 English letters

  (define letters
    (string->list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))

  ;; private-parse: Listof[Token] -> LL1ParseTree
  ;; usage: (private-parse tokens) returns one of:
  ;;     #f if the tokens are not generated by the LL(1) grammar below
  ;;     a concrete LL(1) parse tree for the tokens
  ;;         represented as (label tree ...)
  ;;         where the label identifies a production and tree ...
  ;;         corresponds to the right hand side of production n
  ;;
  ;; LL(1) grammar:
  ;;                            label:
  ;; E  -->  T E2                 e
  ;; E2 -->  <empty>              e2empty
  ;;      |  + T E2               e2+
  ;;      |  - T E2               e2-
  ;; T  -->  F T2                 t
  ;; T2 -->  <empty>              t2empty
  ;;      |  * F T2               t2*
  ;; F  -->  N                    n
  ;;      |  I                    i
  ;;      |  ( E )                p

  (define private-parse
    (lambda (tokens)
      (call-with-current-continuation
       (lambda (k)
         (set! exit-from-parser (lambda args (k #f)))
         (set! scanner-input tokens)
         (parse-pgm)))))

  ;; exit-from-parser: -> Bool
  ;; usage: (exit-from-parser) exits from the parser, returning #f

  (define exit-from-parser (lambda () #f))

  ;; parse-error: Symbol * Listof[Symbol] ->
  ;; usage: (parse-error nonterminal expected) reports an error
  ;;     and then exits from the parser, returning #f

  (define parse-error
    (lambda (nonterminal expected)
      (write (list 'parse-error: nonterminal expected (next-token)))
      (newline)
      (exit-from-parser)))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;; The parser expects an imperative scanner of this form.
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; next-token: -> Symbol
  ;; usage: (next-token) returns a symbol naming the kind of the
  ;;     current token

  (define next-token
    (lambda ()
      (cond ((null? scanner-input) 'eof)
            ((eq? (car scanner-input) '+) 'plus)
            ((eq? (car scanner-input) '-) 'minus)
            ((eq? (car scanner-input) '*) 'times)
            ((symbol? (car scanner-input)) 'id)
            ((number? (car scanner-input)) 'number)
            ((eqv? (car scanner-input) #\() 'lparen)
            ((eqv? (car scanner-input) #\)) 'rparen)
            (else 'eof))))

  ;; consume-token!: ->
  ;; usage: (consume-token!) consumes the current token and goes
  ;;     on to the next

  (define consume-token!
    (lambda ()
      (cond ((null? scanner-input)
             (set! token-value 'eof))
            (else
             (set! token-value (car scanner-input))
             (set! scanner-input (cdr scanner-input))))))

  ;; scanner-input: Listof[Token]
  ;; scanner-input is the list of tokens that have not yet been
  ;;     consumed; it is assigned by FIXME

  (define scanner-input '())

  ;; token-value: Number+Symbol
  ;; token-value is the numerical or symbolic value of the
  ;;     current token

  (define token-value 0)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;; The following action procedures are called by the parser.
  ;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;; identity: Val -> Val
  ;; usage: (identity x) returns x

  (define identity (lambda (x) x))

  ;; makeEmpty: -> TemporaryParseTree
  ;; usage: (makeEmpty) returns the empty list,
  ;;     which is a temporary parse tree

  (define makeEmpty
    (lambda () '()))

  ;; makeSum: ParseTree * TemporaryParseTree -> TemporaryParseTree

  (define makeSum
    (lambda (t1 t2)
      (list 'temporary '+ t1 t2)))

  ;; makeDiff: ParseTree * TemporaryParseTree -> TemporaryParseTree

  (define makeDiff
    (lambda (t1 t2)
      (list 'temporary '- t1 t2)))

  ;; makeMult: ParseTree * TemporaryParseTree -> TemporaryParseTree

  (define makeMult
    (lambda (t1 t2)
      (list 'temporary '* t1 t2)))

  ;; makeTerm: ParseTree * TemporaryParseTree -> ParseTree
  ;; usage: (makeTerm t1 t2) returns a properly rotated parse tree

  (define makeTerm
    (lambda (t1 t2)
      (makeExp t1 t2)))

  ;; makeExp: ParseTree * TemporaryParseTree -> ParseTree
  ;; usage: (makeExp t1 t2) returns a properly rotated parse tree

  (define makeExp
    (lambda (t1 t2)
      (cond ((null? t2) t1)
            (else (makeExp (list (cadr t2) t1 (caddr t2))
                           (cadddr t2))))))

  ;; makeNum: -> ParseTree
  ;; usage: (makeNum) returns the value of the previous token

  (define makeNum
    (lambda () token-value))

  ;; makeVar: -> ParseTree
  ;; usage: (makeVar) returns the value of the previous token

  (define makeVar
    (lambda () token-value))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The following parser was generated by ParseGen from the
;;; grammar in mp3-grammar.pg
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (parse-pgm)
  (case (next-token)
    ((number id lparen)
     (let ((ast1 (parse-exp)))
       (if (eq? (next-token) 'eof)
           (begin (consume-token!) (identity ast1))
           (parse-error '<pgm> '(eof)))))
    (else (parse-error '<pgm> '(id lparen number)))))

(define (parse-exp)
  (case (next-token)
    ((lparen id number)
     (let ((ast1 (parse-term)))
       (let ((ast2 (parse-exp2))) (makeExp ast1 ast2))))
    (else (parse-error '<exp> '(id lparen number)))))

(define (parse-exp2)
  (case (next-token)
    ((minus)
     (begin
       (consume-token!)
       (let ((ast1 (parse-term)))
         (let ((ast2 (parse-exp2))) (makeDiff ast1 ast2)))))
    ((plus)
     (begin
       (consume-token!)
       (let ((ast1 (parse-term)))
         (let ((ast2 (parse-exp2))) (makeSum ast1 ast2)))))
    ((rparen eof) (makeEmpty))
    (else
     (parse-error '<exp2> '(eof minus plus rparen)))))

(define (parse-term)
  (case (next-token)
    ((number id lparen)
     (let ((ast1 (parse-factor)))
       (let ((ast2 (parse-term2))) (makeTerm ast1 ast2))))
    (else (parse-error '<term> '(id lparen number)))))

(define (parse-term2)
  (case (next-token)
    ((times)
     (begin
       (consume-token!)
       (let ((ast1 (parse-factor)))
         (let ((ast2 (parse-term2))) (makeMult ast1 ast2)))))
    ((minus plus eof rparen) (makeEmpty))
    (else
     (parse-error
       '<term2>
       '(eof minus plus rparen times)))))

(define (parse-factor)
  (case (next-token)
    ((lparen)
     (begin
       (consume-token!)
       (let ((ast1 (parse-exp)))
         (if (eq? (next-token) 'rparen)
             (begin (consume-token!) (identity ast1))
             (parse-error '<factor> '(rparen))))))
    ((id) (begin (consume-token!) (makeVar)))
    ((number) (begin (consume-token!) (makeNum)))
    (else
     (parse-error '<factor> '(id lparen number)))))


)