Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ; 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)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement