; This file contains function definitions for CS 152,
;   Fall 2006, Assignment 5.


; To enable tracing, uncomment out the following line

; (require (lib "trace.ss"))


#|

    This program contains an "evaluate" function that interprets
    programs in the simple functional language defined by the grammar
    given below.  In case of syntactic or semantic error, the function  
    will return a string that contains an appropriate error message. 
           
    The program representation is as a string of tokens separated
    by whitespace characters as recognized by the 
    <code>Character.isWhitespace</code> predicate.
                  
    The grammar for boolean expressions has start symbol "Program" and rules
      Program := Def* E
      E := ( Fname E E )
      E := Number
      E := Id
      Def := define Id ( Id Id ) Def* E end
      Fname := Id | + | *
      Id := Letter+
      Number := Digit+
    
    Note that recursive descent parsing is appropriate for this grammar. 

    The error messages still need improvement.

|#



;;;;;;;;;;;;;;;;;;;;;;  STRUCTURES  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; Structures to represent parsed program segments and environment 
;   frames.  Environments are not themselves represented as 
;   structures, but simply as lists of frames with the top frame
;   first.

; In each case, the component names are identical with the names
;   of their structure types.

; For programs, the components represent
;   1.  a list of the local definitions (each being a "def")
;   2.  the body of the program

(define-struct program (defs expr))

 
; For function definitions, the components represent
;   1.  the function name (with a string value)
;   2.  the first parameter (with an integer value)
;   3.  the second parameter (with an integer value)
;   4.  a list of the local definitions (each being a "def")
;   5.  the body of the function

(define-struct def (name param1 param2 defs expr))


; For expressions, the components represent
;   1.  the function name 
;        (an integer, for atomic expressions -- a string otherwise)
;   2.  the first subexpression (#f for atomic expressions)
;   3.  the first subexpression (#f for atomic expressions)

(define-struct expr (fname expr1 expr2))


; For frames, the components represent
;   1&2.  The name and value of the first formal parameter
;   3&4.  The name and value of the second formal parameter
;   5.    The list of "def" structures corresponding to the
;           immediately nested function definitions
;   The components 1-4 have dummy values #f for bottommost frames

(define-struct frame (param1 value1 param2 value2 defs))



;;;;;;;;;;;;;;;;;;  FUNCTIONS FOR EVALUATION  ;;;;;;;;;;;;;;;;;;;


; Evaluates the input string by parsing the input to get a program
;   structure, and then evaluating the program

(define (evaluate input)
  (let ((parsed-prog (parse input)))
    (if (error? parsed-prog) 
        parsed-prog
        (evaluate-prog parsed-prog))))
         
         
; Evalate a given parsed program (a program structure)
;   by augmenting the environment to contain the program's
;   function definition, and then evaluating the program's
;   expression in that augmented environment)

(define (evaluate-prog prog)
  (evaluate-expr (program-expr prog) 
                 (build-environment (program-defs prog)) 
                 "main-program"))


; Takes a parsed definition (a def structure), two integers
;   representing arguments, and an environment, and applies the 
;   defintion to those arguments in that environment.
; Specifically, it augments the environment by adding a frame
;   in which the definition's formal parameters are bound to
;   the given integer arguments, and then evaluates the body
;   of the definition in the augmented environment.

(define (apply-def d arg1 arg2 env)
  (evaluate-expr (def-expr d)
                 (add-frame env (def-param1 d) arg1 
                                (def-param2 d) arg2 (def-defs d))
                 "caller")) 


; Evaluates a given expression in a given environment.  A third
;   argument, a string representing the name of the caller, is
;   made available for use in error messages.
; Integer literals evaluate to themselves, whether represented
;   as integers or as expression trees with one numeric node.  
; The other cases are:
;   for expressions with + or * as top-level operators,
;     the arguments are evaluted recursively and the operator applied
;     with errors propagated as necessary
;   for expressions with other functions at the top level
;     the function name is looked up applied to the arguments
;   for expressions consisting of a single variable, the variable
;     name is looked up in the current environment

(define (evaluate-expr exp env caller)
  (cond ((number? exp) exp)
        (else (let ((fname (expr-fname exp)))
                (cond ((number? fname) fname) 
                      ((or (equal? fname "+") (equal? fname "*"))
                       (let ((val1 
                              (evaluate-expr (expr-expr1 exp) env "*")))
                         (if (error? val1)
                             val1
                             (let ((val2 
                                    (evaluate-expr (expr-expr2 exp)
                                                   env "*")))
                               (if (error? val2)
                                   val2
                                   (eval (list (string->symbol fname)
                                               val1 val2)))))))
                      ; if the first argument is not #f, 
                      ; fname is a user-defined function
                      ((expr-expr1 exp)
                       (let ((d (get-def fname env)))
                         (if d 
                             (apply-def d
                                        (evaluate-expr (expr-expr1 exp)
                                                       env fname)
                                        (evaluate-expr (expr-expr2 exp)
                                                       env fname)
                                        env)
                         (string-append "no value found for " fname 
                                        " in " caller))))
                      (else (let ((val (get-value fname env)))
                              (if val
                                  val
                                  (string-append 
                                   "no value found for " fname 
                                   " in " caller)))))))))
  

; Builds an initial environment for a program, given a list of its
;   internal definitions (each represented by a def structure).

(define (build-environment defs)
  (list (make-frame #f #f #f #f defs)))


; Adds a frame to a given environment, given formal parameters p1 and p2,
;   their values a1 and a2, and a list of definitions for the frame.

(define (add-frame env p1 a1 p2 a2 defs)
  (cons (make-frame p1 a1 p2 a2 defs) env))


; returns the defintion (def structure) associated with
;   a given fname (a string) in the current environment.
; Returns #f if there is no binding in the environment
;   for the given function name.
; Simply searches each frame downward from the top of the stack
;   for the given function name.

(define (get-def fname env)
  (cond ((null? env) #f)
        ((get-def-binding fname (frame-defs (car env))))
        (else (get-def fname (cdr env)))))
         
  
; returns the integer value associated with a given 
;   variable name in a given environment.
; Returns #f if there is no binding in the environment
;   for the given variable name.
; Simply searches each frame downward from the top of the stack
;   for the given function name.

(define (get-value atom env)
  (cond ((null? env) #f)
        ((get-var-binding atom (car env)))
        (else (get-value atom (cdr env)))))


; Searches for the definition matching the given function name
;   within a list of definitions 
; Returns #f if there is no match

(define (get-def-binding fname defs)
  (cond ((null? defs) #f)
        ((equal? (def-name (car defs)) fname) (car defs))
        (else (get-def-binding fname (cdr defs)))))
         

; Returns the integer bound to given variable name
;   within a frame.
; Returns #f if there is no binding within the frame

(define (get-var-binding atom fr)
  (cond ((equal? atom (frame-param1 fr)) (frame-value1 fr))
        ((equal? atom (frame-param2 fr)) (frame-value2 fr))
        (else #f)))

        
;;;;;;;;;;;;;;;;;;  FUNCTIONS FOR PARSING  ;;;;;;;;;;;;;;;;;;;


; A structure to repesent the state of a parser.
; The components are
;   the next token in the input
;   a list of unconsumed tokens in the input
;     (excluding the previous component)
;   the parse tree so far.

(define-struct parser-state (lookahead tokenlist result))


; Updates the given parser-state when the next input
;   token is read.  Returns the new state.
; If there are no more tokens, the dummy values #f
;   and () are given to the first two components.

(define (consume-token state)
  (if (null? (parser-state-tokenlist state))
      (make-parser-state #f
                         null
                         (parser-state-result state))
      (make-parser-state (car (parser-state-tokenlist state))
                         (cdr (parser-state-tokenlist state))
                         (parser-state-result state))))
       

; A predicate for recognizing that a parsing error has 
;   been found.  Parsing errors are represented by
;   result components that are strings.

(define error? string?)


; Converts a string to a list of tokens, assuming that
;   whitespace between tokens consists of those characters
;   that satisfy the char-whitespace? predicate.
; A helper function maintains the list of unconsumed
;   characters, the characters of the current token
;   and the list of tokens recognized so far.  
; The second and third of these lists are constructed
;   in reverse order, so they need to be reversed
;   when they are completed.
; The algorithm for the helper is:
;   if no input characters remain,
;     return the reversed tokenlist, first adding
;       the (reversed) current token if there is one.
;   else if the next character is whitespace, 
;     move the current token to the tokenlist
;       (if there is one), and continue
;   else add the current character to the current token
;     and continue

(define (string->tokenlist input)
  (define (helper charlist current-token tokenlist)
    (if (null? charlist) 
        (if (null? current-token) 
            (reverse tokenlist)
            (reverse (cons (list->string (reverse current-token)) tokenlist)))
        (if (char-whitespace? (car charlist)) 
            (if (null? current-token)
                (helper (cdr charlist) null tokenlist)
                (helper (cdr charlist) 
                        null 
                        (cons (list->string (reverse current-token))
                              tokenlist)))
            (helper (cdr charlist) 
                    (cons (car charlist) current-token)
                    tokenlist))))
  (helper (string->list input) null null))
        

; Parses the given input string as a program.  
; Returns a program structure if the input is well-formed
; Returns a string representing an error message otherwise.

; Parsing is done by recursive descent.

(define (parse input) 
  (let ((tokenlist (string->tokenlist input)))
    (if (null? tokenlist)
        "empty program"
        (let ((result (parse-program (make-parser-state (car tokenlist) (cdr tokenlist) null))))
          (cond ((error? result) result)
                ((not (parser-state-lookahead result)) 
                 (parser-state-result result))
                (else "extra symbols after program"))))))


;;;;;;;;;;  FUNCTIONS FOR PARSING PARTICULAR NONTERMINALS ;;;;;;;;;;

; All the functions below assume that recursive descent parsing is in use.


; Parses a sequence of definitions.  The argument is the current state
;   of the parser; its last component is a list of the parsed defs
;   seen so far
; Continues adding def structures to the (result component of) the state
;   as long as the lookahead token is "define".

(define (parse-defs state)
  (cond ((equal? (parser-state-lookahead state) "define") 
         (let ((new-state (parse-def state)))
           (if (error? new-state) 
               new-state
               (parse-defs (make-parser-state 
                            (parser-state-lookahead new-state)
                            (parser-state-tokenlist new-state)
                            (cons (parser-state-result new-state)
                                  (parser-state-result state)))))))
        (else state)))


; Parses a program.  The argument is the current state
;   of the parser.
; Returns a program-state whose result component is a program structure 
;   if the input is well-formed
;   and a string representing an error message otherwise.
  
(define (parse-program state)
  (let ((state1 (parse-defs state)))
    (if (error? state1)
        state1
        (let ((state2 (parse-expr state1)))
          (if (error? state2)
              state2
              (make-parser-state    
               (parser-state-lookahead state2)
               (parser-state-tokenlist state2)
               (make-program (parser-state-result state1)
                             (parser-state-result state2))))))))
  
  
; Parses a def.  The argument is the current state
;   of the parser.
; Returns a program-state whose result component is a def structure 
;   if the input is well-formed
;   and a string representing an error message otherwise.
; Intermediate parser states state1-state6 are used to find & save
;   components of the def structure to be returned.

(define (parse-def state)
  (let ((state1 (parse-id (consume-token state))))
    (if 
     (error? state1)
     state1
     (let ((lookahead (parser-state-lookahead state1)))
       (if 
        (not lookahead)
        "unexpected end of input"
        (if 
         (equal? (parser-state-lookahead state1) "(")
         (let ((state2 
                (parse-id (consume-token state1))))
           (if 
            (error? state2)
            state2
            (let ((state3 (parse-id state2)))
              (if 
               (error? state3)
               state3
               (let ((lookahead (parser-state-lookahead state3)))
                 (if 
                  (not lookahead)
                  "unexpected end of input"
                  (if 
                   (equal? (parser-state-lookahead state3) ")")
                   (let* ((tempstate (consume-token state3))
                          (temp-lookahead (parser-state-lookahead tempstate)))
                     (if (not temp-lookahead)
                          "unexpected end of input"
                          (let ((state4 (parse-defs 
                                         (make-parser-state 
                                          (parser-state-lookahead tempstate)
                                          (parser-state-tokenlist tempstate)
                                          null)))) 
                                          ; null since no defs seen so far
                            (if 
                             (error? state4)
                             state4
                             (let ((state5 (parse-expr state4)))
                               (if 
                                (error? state5)
                                state5
                                (let ((lookahead (parser-state-lookahead state5)))
                                  (if 
                                   (equal? lookahead "end")
                                   (let ((state6 (consume-token state5)))
                                     (if 
                                      (error? state6)
                                      state6
                                      (make-parser-state
                                       (parser-state-lookahead state6)
                                       (parser-state-tokenlist state6)
                                       (make-def (parser-state-result state1)
                                                 (parser-state-result state2)
                                                 (parser-state-result state3)
                                                 (parser-state-result state4)
                                                 (parser-state-result state5)))))
                                   (string-append "end expected -- "
                                                  "??1"
                                                  " found")))))))) 
                     (string-append ") expected -- "
                                    "??2"
                                    " found"))))))))
         (string-append "( expected -- "
                        "??3"
                        " found")))
        )))))
        
   
; Parses an expression (nonterminal symbol: E).  
;   The argument is the current state of the parser.
; Returns a program-state whose result component is an expr structure 
;   if the input is well-formed
;   and a string representing an error message otherwise.
; The first 3 cases of the outer "cond" correspond to the 3 E rules.
  
(define (parse-expr state)
  (let ((lookahead (parser-state-lookahead state)))
    (cond ((not lookahead) "unexpected end of input")
          ((equal? lookahead "(")
           (let ((state1 (parse-function-name
                          (consume-token state))))
             (if (error? state1)
                 state1
                 (let ((state2 (parse-expr state1)))
                   (if (error? state2)
                       state2
                       (let ((state3 (parse-expr state2)))
                         (if (error? state3)
                             state3
                             (let ((lookahead 
                                    (parser-state-lookahead state3)))
                               (if (not lookahead)
                                   "unexpected end of input"
                                   (if (equal? 
                                        (parser-state-lookahead state3) 
                                        ")")
                                       (let ((state4 
                                              (consume-token state3)))
                                         (if (error? state4)
                                             state4
                                             (make-parser-state
                                              (parser-state-lookahead 
                                               state4)
                                              (parser-state-tokenlist 
                                               state4)
                                              (make-expr 
                                               (parser-state-result state1)
                                               (parser-state-result state2)
                                               (parser-state-result state3)))))
                                       ") expected ??"))))))))))
        ((char-numeric? (string-ref lookahead 0))
         (let ((state5 (parse-number state)))
           (if (error? state5)
               state5
               (make-parser-state (parser-state-lookahead state5)
                                  (parser-state-tokenlist state5)
                                  (make-expr (parser-state-result state5)
                                             #f #f)))))
        ((char-alphabetic? (string-ref lookahead 0))
         (let ((state5 (parse-id state)))
           (if (error? state5)
               state5
               (make-parser-state (parser-state-lookahead state5)
                                  (parser-state-tokenlist state5)
                                  (make-expr (parser-state-result state5) #f #f)))))
        (else "( expected ??"))))

; Parses an Id.  The argument is the current state of the parser.
; Returns a program-state whose result component is a string
;   representing an identifier if the input is well-formed
;   and a string representing an error message otherwise.

(define (parse-id state)
  (let ((lookahead (parser-state-lookahead state)))
    (cond ((not lookahead) "unexpected end of input")
          ((member #f (map char-alphabetic? 
                           (string->list lookahead)))
           (string-append "illegal character in identifier " lookahead))
          (else
           (let ((state1 (consume-token state)))
             (make-parser-state (parser-state-lookahead state1)
                                 (parser-state-tokenlist state1)
                                 lookahead)))))) 


; Parses a Number.  The argument is the current state of the parser.
; Returns a program-state whose result component is a number
;   if the input is well-formed
;   and a string representing an error message otherwise.

(define (parse-number state)
  (let ((lookahead (parser-state-lookahead state)))
    (cond ((not lookahead) "unexpected end of input")
          ((member #f (map char-numeric? 
                           (string->list (parser-state-lookahead state))))
           (string-append "illegal character in number " 
                     (parser-state-lookahead state)))
          (else (let ((lookahead (parser-state-lookahead state)))
                  (let ((state1 (consume-token state)))
                    (make-parser-state (parser-state-lookahead state1)
                                       (parser-state-tokenlist state1)
                                       (string->number lookahead))))))))
  

; Parses a Fname.  The argument is the current state of the parser.
; Returns a program-state whose result component is a string
;   representing a function name if the input is well-formed
;   and a string representing an error message otherwise.

(define (parse-function-name state)
  (let ((fname (parser-state-lookahead state)))
    (cond ((not fname)  "unexpected end of input")
          ((or (equal? fname "+") (equal? fname "*"))
           (let ((state1 (consume-token state)))
             (make-parser-state  (parser-state-lookahead state1)
                                 (parser-state-tokenlist state1)
                                 fname)))
          (else (parse-id state)))))