; Israel Hill idh
; Michael Rosenfield mer95
; Sarah Whelan slw96

; Part 3

(load "classParser.scm")
(load "lex.scm")

;main interpret function
(define interpret
  (lambda (filename classname)
    (lookup 'return (stateFunctionCall '(funcall main) (lookup (string->symbol classname) (interpretClasses (parser filename) (initialEmpty))) (lambda (v) v)))))

(define interpretClasses
  (lambda (l state)
    (cond
      ((null? l) state)
      ((eq? (car l) 'class)(Add (className l) (decideStateClass (classBody l) (makeClass l)  (lambda (v) v) (lambda (v) (v)) (lambda (v) v) (lambda (v) v)) state))
      (else (interpretClasses (cdr l) (interpretClasses (car l) state))))))

(define initialEmpty
  (lambda ()
    '(()())))

(define makeClass
  (lambda (l)
    (cond
      ((null? (classHeader l)) (cons (classHeader l) (cons (initialEmpty) (cons (initialEmpty) (cons (initialEmpty) '())))))
      (else (cons (car (cdr (classHeader l)))  (cons (initialEmpty) (cons (initialEmpty) (cons (initialEmpty) '()))))))))

(define decideStateClass
  (lambda (l state return continue break exit)
    (cond
     ((null? l) (return state))
     ((list? (operator l)) (decideStateClass (operator l) state (lambda (v) (decideStateClass (cdr l) v return continue break exit)) continue break exit))
     ((eq? (operator l) 'function) (cons (classParent state) (cons (classFields state) (cons (stateFunction l (classMethods state) return continue break exit) (classInitials state)))))
     ;((eq? (operator l) 'static-function) (cons (classParent state) (cons (classFields state) (cons (stateFunction l (classMethods state) return continue break exit) (classInitials state)))))
     ((eq? (operator l) 'static-function) (stateFunction l (classMethods state) (lambda (v) (cons (classParent state) (cons (classFields state) (cons v (classInitials state))))) continue break exit))
     ((eq? (operator l) 'static-var) (cons (classParent state) (cons (stateDeclaration l (classFields state) return continue break exit) (cons (classMethods state) (classInitials state)))))
     ((eq? (operator l) 'var) (cons (classParent state) (cons (classFields state) (cons (classMethods state) (stateDeclaration l (classInitials state) return break continue exit)))))
     (else (return state)))))

(define parserOutput
  (lambda (filename classname)
    (parser filename)))

;adds global variables and creates functions
(define interpretOuter
  (lambda (l)
    (decideStateOuter l (initialStateWithReturn) (lambda (v) v) (lambda (v) (v)) (lambda (v) v) (lambda (v) v))))

;the default state
(define initialStateWithReturn
  (lambda ()
    (cons '(true false return) (cons (cons (box #t) (cons (box #f)(cons (box 'noReturnValueSet) '()))) '()))))

;the additonal layer for each function call
(define initialState
  (lambda ()
    (cons '(true false) (cons (cons (box #t) (cons (box #f) '())) '()))))

;;;;;; Interpret Each Class

;only allows variables and functions
(define decideStateOuter
  (lambda (l state return continue break exit)
    (cond
     ((null? l) (return state))
     ((list? (operator l)) (decideStateOuter (operator l) state (lambda (v) (decideStateOuter (cdr l) v return continue break exit)) continue break exit))
     ((eq? (operator l) 'function) (stateFunction l state return continue break exit))
     ((eq? (operator l) 'var) (stateDeclaration l state return continue break exit))
     ((eq? (operator l) '=) (stateAssign l state return continue break exit))
     (else (return state)))))

;;;;;; Interpret Function

;decide state determines and changes the state of a statement
(define decideState
  (lambda (l state return continue break exit)
    (cond
     ((null? l) (return state))
     ((atom? l) (return state))
     ((list? (operator l)) (decideState (operator l) state (lambda (v) (decideState (cdr l) v return continue break exit)) continue break exit))
     ((eq? (operator l) 'return) (stateReturn l state return continue break exit))
     ((eq? (operator l) 'while) (stateWhile l state return continue (lambda (v) (return (removeLayer v))) exit))
     ((eq? (operator l) 'function) (stateFunction l state return continue break exit))
     ((eq? (operator l) 'funcall) (stateFunctionCall l state return))
     ((eq? (operator l) 'var) (stateDeclaration l state return continue break exit))
     ((eq? (operator l) 'if) (stateIf l state return continue break exit))
     ((eq? (operator l) 'break) (break state))
     ((eq? (operator l) 'begin) (stateBlock l (addLayer state) return continue break exit))
     ((eq? (operator l) 'continue) (continue (removeLayer state)))
     ((eq? (operator l) '=) (stateAssign l state return continue break exit))
     (else (return state))
     )))

;handles return statements by exiting to the beginning of the program (using the exit continuation set at the inital call of stateDecide)
(define stateReturn
  (lambda (l state return continue break exit)
    (cond
      ((eq? (getValue (cdr l) state) '#t) (exit (Update 'return 'true state)))
      ((eq? (getValue (cdr l) state) '#f) (exit (Update 'return 'false state)))
      (else (exit (Update 'return (getValue (cdr l) state) state))))))

;handles variable declarations
(define stateDeclaration
  (lambda (l state return continue break exit)
    (cond
      ((not (null? (lookup (leftoperand l) (topLayer state)))) (error 'variableAlreadyDeclared))
      ((null? (cdr (cdr l))) (return (Add (leftoperand l) 'declared state)))
      (else (return (Add (leftoperand l) (getValue (rightoperand l) state) state))))))

;handles variable assignments
(define stateAssign
  (lambda (l state return continue break exit)
    (let ([variable (lookup (leftoperand l) state)])
      (cond
      ((null? variable) (error 'usingBeforeDeclaringOrOutOfScope))
      ((or (eq? variable 'declared) (atom? variable)) (return (Update (leftoperand l) (getValue (rightoperand l) state) state)))
      (else (return (Add (leftoperand l)(getValue (rightoperand l) state) state)))))))

;handles if statements
(define stateIf
  (lambda (l state return continue break exit)
    (cond
      ((getTruth (condition l) state) (decideState (ifBody l) state return continue break exit))
      ((null? (elseBody l))(return state))
      (else (decideState (elseBody l) state return continue break exit)))))

;handles blocks
(define stateBlock
  (lambda (l state return continue break exit)
    (cond
      ((null? l) (return (removeLayer state)))
      (else (decideState (front l) state (lambda (v)
                                         (stateBlock (remaining l) v return continue break exit)) (lambda (v) (return v)) break exit)))))

;handles while loops
(define stateWhile
  (lambda (l state return continue break exit)
    (cond
      ((null? l) state)
      ((getTruth (leftoperand l) state) (decideState (leftoperand l) state (lambda (v1)
        (decideState (rightoperand l) v1 (lambda (v2)(decideState l v2 return continue break exit)) continue break exit)) continue break exit))
      (else (decideState (leftoperand l) state return continue break exit)))))

;handles function definitions
(define stateFunction
  (lambda (l state return continue break exit)
    (return (Add (functionName l) (makeClosure (functionBody l) (functionParamList l) state) state))))

;evaluate a functioncall
(define stateFunctionCall
  (lambda (l state return)
    (cond
      ((eq? (lookup (functionCallName l) state) '()) (error 'illegalFunctionCall))
      (else (let ([closure (lookup (functionCallName l) state)])(decideState (functionClosureBody closure)
                         (copyParams (functionCallParamList l) state (functionClosureParamList closure)
                                     (addLayer (getLastN state (getFunctionClosureLayerNum closure)))
                                     )
                         (lambda (v) (return state))
                         (lambda (v) (return state)) (lambda (v) (return state)) (lambda (v) (return state))))))))

;;;;;; Value

;returns the value of an expression
(define getValue
  (lambda (expression state)
       (cond
         ((number? expression) expression)
         ((and (atom? expression) (eq? (lookup expression state) 'declared)) (error 'usingBeforeAssigning))
         ((and (atom? expression) (eq? (lookup expression state) '())) (error 'usingBeforeDeclaringOrOutOfScope))
         ((atom? expression) (lookup expression state))
         ((eq? (operator expression) 'funcall) (lookup 'return (stateFunctionCall expression state (lambda (v) v))))

         ((eq? '+ (operator expression)) (+ (getValue (leftoperand expression) state)
                                            (getValue (rightoperand expression) state)))
         ((eq? '/ (operator expression)) (quotient (getValue (leftoperand expression) state)
                                                   (getValue (rightoperand expression) state)))
         ((eq? '% (operator expression)) (remainder (getValue (leftoperand expression) state)
                                                    (getValue (rightoperand expression) state)))
         ((eq? '* (operator expression)) (* (getValue (leftoperand expression) state)
                                            (getValue (rightoperand expression) state)))
         ((and (eq? '- (operator expression))(not (null? (cdr (cdr expression)))))
          (- (getValue (leftoperand expression) state)(getValue (rightoperand expression) state)))
         ((eq? '- (operator expression)) (- (getValue (leftoperand expression) state)))
         ((eq? '= (operator expression)) (getValue (leftoperand expression)(Update (leftoperand expression) (getValue (rightoperand expression) state) state)))
         ((eq? 'var (operator expression)) (getValue (rightoperand expression) state))

         ((eq? '!= (operator expression))  (getTruth expression state))
         ((eq? '== (operator expression))  (getTruth expression state))
         ((eq? '<= (operator expression))  (getTruth expression state))
         ((eq? '>= (operator expression))  (getTruth expression state))
         ((eq? '< (operator expression))  (getTruth expression state))
         ((eq? '> (operator expression))  (getTruth expression state))
         ((eq? '! (operator expression))  (getTruth expression state))
         ((eq? '&& (operator expression))  (getTruth expression state))
         ((eq? '|| (operator expression))  (getTruth expression state))
         ((null? (cdr expression)) (getValue (operator expression) state))
        (else (error 'illegalExpression)))
       ))

;evaluates boolean result of an expression
(define getTruth
  (lambda (expression state)
    (cond
      ((number? expression) expression)
      ((not (pair? expression)) (lookup expression state))
      ((eq? '< (operator expression)) (< (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '> (operator expression)) (> (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '<= (operator expression)) (<= (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '>= (operator expression)) (>= (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '== (operator expression)) (eq? (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '!= (operator expression)) (not(eq? (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state))))
      ((eq? '&& (operator expression)) (and (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '|| (operator expression)) (or (getValue (leftoperand expression) state)
                                         (getValue (rightoperand expression) state)))
      ((eq? '! (operator expression))  (not(getValue (leftoperand expression)state)))
      ((eq? (operator expression) 'funcall) (lookup 'return (stateFunctionCall expression state (lambda (v) v))))
      ((eq? '= (operator expression)) (getValue (leftoperand expression) (Update (leftoperand expression) (getValue (rightoperand expression) state) state)))
      )))

;;;;;; Function Helpers

;make a function closure to store in the environment
(define makeClosure
  (lambda (body params state)
    (cons params (cons body (cons (getNumLayers state) '())))))

;copy the actual paramters into the formal parameters
(define copyParams
  (lambda (actual state formal stateFromClosure)
    (cond
      ((not (equalNumElements? actual formal)) (error 'mismatchParameters))
      ((null? actual) stateFromClosure)
      (else (copyParams (remaining actual) state (remaining formal) (Add (front formal) (getValue (front actual) state) stateFromClosure))))))

;a check for equal number of parameters
(define equalNumElements?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((and (null? l1) (not (null? l2))) #f)
      ((and (null? l2) (not (null? l1))) #f)
      (else (equalNumElements? (cdr l1) (cdr l2))))))

;get the number of layers in the state to store with each function
(define getNumLayers
  (lambda (l)
    (cond
      ((null? l) 0)
      ((atom? (singleLayerTest l)) 1)
      (else (+ 1 (getNumLayers (cdr l)))))))

;get the last 'n' number of layers
(define getLastN
  (lambda (l1 n)
    (cond
      ((and (eq? 1 n) (atom? (singleLayerTest l1))) l1)
      (else (getLastNInner l1 '() n)))))

;getLastN helper
(define getLastNInner
  (lambda (l1 l2 n)
    (cond
      ((null? l1) l2)
      ((and (zero? n) (null? (cdr l2))) (car l2))
      ((zero? n) l2)
      (else (getLastNInner (removeLast l1) (cons (getLast l1) l2) (- n 1))))))

;getLastNInner helper
(define getLast
  (lambda (l)
    (cond
      ((null? (cdr l)) (car l))
      (else (getLast (cdr l))))))

;getLastNInner helper
(define removeLast
  (lambda (l)
    (cond
      ((null? (cdr l)) '())
      (else (cons (car l) (removeLast (cdr l)))))))

;;;;;; Environment

;looks up the value of a variable handles multiple layers
(define lookup
  (lambda (name state)
    (cond
      ((null? state) '())
      ((atom? (singleLayerTest state))(lookup-helper name state))
      ((and (list? (singleLayerTest state)) (not (null? (lookup-helper name (variableList state))))) (lookup-helper name (variableList state)))
      (else (lookup name (removeLayer state))))))

;lookup a variable's value in the layer it is given
(define lookup-helper
  (lambda (name state)
    (cond
     ((null? (variableList state)) '())
     ((eq? (firstVariable state) name) (unbox(firstValue state)))
     (else (lookup-helper name (cons (remainingVariables state) (cons(remainingValues state) '())))))))

;updates the value of a variable in the state handles multiple layers
(define Update
 (lambda (name value state)
  (cond
     ((null? state) '())
      ((and (atom? (singleLayerTest state)) (not (null? (lookup-helper name state)))) (Update-helper name value state))
      ((and (list? (singleLayerTest state)) (not (null? (lookup-helper name (variableList state))))) (cons (Update-helper name value (variableList state)) (cdr state)))
      (else (cons (variableList state) (Update name value (removeLayer state)))))))

;updates the value of a variable in the layer it was given
(define Update-helper
  (lambda (name value state)
    (cond
      ((null? (variableList state)) '())
      ((eq? (firstVariable state) name) (begin (set-box! (firstValue state) value) state))
      (else (cons
             (cons (firstVariable state) (variableList (Update-helper name value (cons (remainingVariables state) (cons(remainingValues state) '()))) ))
             (cons
              (cons (firstValue state) (valueList (Update-helper name value (cons (remainingVariables state) (cons(remainingValues state) '())))))
              '()))))))

;add a variable to the state handles multiple layers
(define Add
  (lambda (name value state)
    (cond
      ((or (null? (car state))(atom? (singleLayerTest state)))(Add-helper name value state))
      ((list? (variableList state))(cons (Add-helper name value (variableList state)) (remaining state)))
      (else (Add-helper name value state)))))

;adds a variable to the layer it is given
(define Add-helper
  (lambda (name value state)
    (cond
     ((null? (variableList state))
             (cons (append (variableList state) (cons name '()))
                   (cons
                    (append (valueList state) (cons (box value) '()))'())))
     (else (cons
             (cons (firstVariable state) (variableList (Add-helper name value (cons (remainingVariables state) (cons(remainingValues state) '()))) ))
             (cons
             (cons (firstValue state) (valueList (Add-helper name value (cons (remainingVariables state) (cons(remainingValues state) '())))))
             '()))))))

;adds a layer to the current state
(define addLayer
  (lambda (state)
    (cond
    ((not (list? (singleLayerTest state)))(cons (initialState)(cons state '())))
    (else (cons (initialState) state)))))

;remove a layer from the current state
(define removeLayer cdr)

;get the top layer of the environment
(define topLayer
  (lambda (state)
    (cond
      ((null? (variableList state)) state)
      ((atom? (singleLayerTest state)) state)
      (else (variableList state)))))

;;;;;; Abstraction

(define front car)
(define remaining cdr)

;abstraction of operators
(define operator car)
(define leftoperand cadr)
(define rightoperand caddr)

;checks if the input is an atom
(define atom? (lambda (x) (and (not (pair? x)) (not (null? x)))))

;get all but the first variable in the state
(define remainingVariables cdar)
;get all but the first associated variable in the state
(define remainingValues cdadr)
;get the first variable in the state
(define firstVariable caar)
;get the first associated value in the state
(define firstValue caadr)
;get all the current variables in the state
(define variableList car)
;get all the current values of the associated variables in the state
(define valueList cadr)

;abstractions for the function definition passed by the parser
(define functionName cadr)
(define functionBody cadddr)
(define functionParamList caddr)

;abstractions for the function closures
(define functionClosureBody cadr)
(define functionClosureParamList car)
(define getFunctionClosureLayerNum caddr)

;abstractions for the function calls
(define functionCallName cadr)
(define functionCallParamList cddr)

;abstractions for if statements
(define condition cadr)
(define ifBody caddr)
(define elseBody cdddr)

;a way to tell if the state has more than one layer
(define singleLayerTest caar)

;class closure
(define parent car)
(define classFields cadr)
(define classMethods caddr)
(define classInitials cadddr)

;class parser
(define className cadr)
(define classHeader caddr)
(define classBody cadddr)