interpreter 2 (1).scm

(require "simpleParser.scm")

;--------------------------------------------------------------------------------------------------------
;---------------------------Interpreter Implementation---------------------------------------------------

; definign a function that takes an input file to be executed and returns a value
(define interpret
  (lambda (filename)
    (cond
      ((not (string? filename)) (error "File name must be a string!"))
      (else (lookupvar 'M_state_return 
          (call/cc (lambda (return) (run (parser filename) M_state_nullState return '() '() '()))))))))


; abstractions
(define getFirst car)
(define getAfterFirst cdr)
(define getSecond cadr)
(define getAfterSecond cddr)
(define getThird caddr)
(define getAfterThird cdddr)
(define getFourth cadddr)

(define addlayer cons)
(define emptyLayer '())
(define poplayer cdr)
(define topLayer car)
(define key car)
(define value getSecond)
(define M_state_nullState '(()))
(define addBinding cons)
(define bind list)

; defining a function for variable declaration so that it returns the state after the declaration statement
(define M_state_declaration
  (lambda (dec state)
    (cond
      ((null? (getAfterSecond dec)) (M_state_Declaration_updateBinding (getAfterFirst dec) state))
      (else (M_state_Declaration_updateBinding (bind (getSecond dec) (M_value (getThird dec) state)) state)))))

; defining a function that returns the value of an expression
(define M_value
  (lambda (exp state)
    (cond
      ((number? exp) exp)
      ((eq? exp '#t) 'true)
      ((eq? exp '#f) 'false)
      ((symbol? exp) (lookupvar exp state))
      ((and (null? (getAfterSecond exp)) (eq? (getFirst exp) '-)) (- 0 (M_value (getSecond exp) state)))
      ((eq? (getFirst exp) '+) (+ (M_value (getSecond exp) state) (M_value (getThird exp) state)))
      ((eq? (getFirst exp) '-) (- (M_value (getSecond exp) state) (M_value (getThird exp) state)))
      ((eq? (getFirst exp) '*) (* (M_value (getSecond exp) state) (M_value (getThird exp) state)))
      ((eq? (getFirst exp) '/) (quotient (M_value (getSecond exp) state) (M_value (getThird exp) state)))
      ((eq? (getFirst exp) '%) (modulo (M_value (getSecond exp) state) (M_value (getThird exp) state)))
      ((or (eq? (getFirst exp) '==)
           (or (eq? (getFirst exp) '<)
               (or (eq? (getFirst exp) '>)
                   (or (eq? (getFirst exp) '<=)
                       (or (eq? (getFirst exp) '>=)
                           (or (eq? (getFirst exp) '!=)
                               (or (eq? (getFirst exp) '&&)
                                   (or (eq? (getFirst exp) '||)
                                       (or (eq? (getFirst exp) '!)))))))))) (M_value (M_bool exp state) state))
      (else (error "unknown operator")))))

; defining a function for assignment so that it returns a state after the assignment
(define M_state_assignment
  (lambda (asg state)
    (M_state_Assignment_updateBinding (bind (getSecond asg) (M_value (getThird asg) state)) state)))

; defining a function for the return whileReturn throwReturn statement that returns the value of the expression being returned
(define M_state_return
  (lambda (stmt state)
    (cond
      ((null? (getSecond stmt)) (error "Nothing to M_state_return"))
      (else (M_state_Declaration_updateBinding (bind 'M_state_return (M_value (getSecond stmt) state)) state)))))

; defining a function for throw so that returns a state after throw
(define M_state_throw
  (lambda (stmt state)
    (cond
      ((null? (getSecond stmt)) (error "Nothing to M_state_throw"))
      (else (M_state_Assignment_updateBinding (bind 'throw (M_value (getSecond stmt) state)) state)))))


; defining a function that returns a boolean based on the input statement
(define M_bool
  (lambda (stmt state)
    (cond
      ((null? stmt) (error "Conditional statement needed!"))
      ((eq? stmt 'true) '#t)
      ((eq? stmt 'false) '#f)
      ((symbol? stmt) (M_bool (lookupvar stmt state) state))
      ((eq? (getFirst stmt) '==) (= (M_value (getSecond stmt) state) (M_value (getThird stmt) state)))
      ((eq? (getFirst stmt) '<) (< (M_value (getSecond stmt) state) (M_value (getThird stmt) state)))
      ((eq? (getFirst stmt) '>) (> (M_value (getSecond stmt) state) (M_value (getThird stmt) state)))
      ((eq? (getFirst stmt) '>=) (>= (M_value (getSecond stmt) state) (M_value (getThird stmt) state)))
      ((eq? (getFirst stmt) '<=) (<= (M_value (getSecond stmt) state) (M_value (getThird stmt) state)))
      ((eq? (getFirst stmt) '!=) (not (= (M_value (getSecond stmt) state) (M_value (getThird stmt) state))))
      ((eq? (getFirst stmt) '&&) (and (M_bool (getSecond stmt) state) (M_bool (getThird stmt) state)))
      ((eq? (getFirst stmt) '||) (or (M_bool (getSecond stmt) state) (M_bool (getThird stmt) state)))
      ((eq? (getFirst stmt) '!) (not (M_bool (getSecond stmt) state)))
      (else (error "Invalid conditional statement!")))))

; defining a function that returns a state after an if statement
(define M_state_if
  (lambda (stmt state return whileReturn throwReturn breakReturn)
    (cond
      ((M_bool (getSecond stmt) state) (M_state (getThird stmt) state return whileReturn throwReturn breakReturn))
      ((null? (getAfterThird stmt)) state)
      (else (M_state (getFourth stmt) state return whileReturn throwReturn breakReturn)))))

; defining a function that takes an initial state and a list of statements and returns the final state after runing the statements in the list
(define run-cps
  (lambda (stmtlis state return whileReturn throwReturn breakReturn cpsreturn)
    (cond
      ((null? stmtlis) (cpsreturn state))
      ((null? (getAfterFirst stmtlis)) (cpsreturn (M_state (getFirst stmtlis) state return whileReturn throwReturn breakReturn)))
      (else (cpsreturn (run-cps (getAfterFirst stmtlis) (M_state (getFirst stmtlis) state return whileReturn throwReturn breakReturn) return whileReturn throwReturn breakReturn cpsreturn))))))

; defining a wrapper for run-cps
(define run
  (lambda (stmtlis state return whileReturn throwReturn breakReturn)
    (run-cps stmtlis state return whileReturn throwReturn breakReturn (lambda (v) v))))


;defining a function that returns a state after a while statement
(define M_state_while-cps
  (lambda (stmt state return whileReturn throwReturn breakReturn cpsreturn)
    (cond
      ((definedInTopBinding (bind 'gotype 'break) state) (cpsreturn state))
      ((M_bool (getSecond stmt) state) (cpsreturn (M_state_while-cps stmt (run (getAfterSecond stmt) state return whileReturn throwReturn breakReturn) return whileReturn throwReturn breakReturn cpsreturn)))
      (else (cpsreturn state)))))

;defining a wrapper for while-cps
(define M_state_while
  (lambda (stmt state return whileReturn throwReturn breakReturn)
    (M_state_while-cps stmt state return whileReturn throwReturn breakReturn (lambda (v) v))))

(define returnit (lambda(v) v))
;defining a function that returns a state after a statement
(define M_state
  (lambda (stmt state return whileReturn throwReturn breakReturn)
    (cond
      ((null? stmt) state)
      ((eq? (getFirst stmt) 'var) (M_state_declaration stmt state))
      ((eq? (getFirst stmt) '=) (M_state_assignment stmt state))
      ((eq? (getFirst stmt) 'return) (return (M_state_return stmt state)))
      ((eq? (getFirst stmt) 'throw)  (if (null? throwReturn) (error "Error: throw not in try block") (throwReturn (M_state_throw stmt state ))))
      ((eq? (getFirst stmt) 'if) (M_state_if stmt state return whileReturn throwReturn breakReturn))
      ((eq? (getFirst stmt) 'while) (returnit (call/cc (lambda (breakReturn) (M_state_while stmt (M_state_Declaration_updateBinding (bind 'gotype 0) state) return whileReturn throwReturn breakReturn)))))
      ((eq? (getFirst stmt) 'begin)  (poplayer (call/cc (lambda (whileReturn) (run (getAfterFirst stmt) (addlayer emptyLayer state) return whileReturn throwReturn breakReturn)))))
      ((eq? (getFirst stmt) 'continue) (whileReturn (M_state_Assignment_updateBinding (bind 'gotype 'continue) state)))
      ((eq? (getFirst stmt) 'break) (breakReturn (poplayer (M_state_Assignment_updateBinding (bind 'gotype 'break) state))))
      ((eq? (getFirst stmt) 'try) (M_state_try stmt state return whileReturn throwReturn breakReturn))
      (else (error "Invalid statements")))))

; abstraction
(define tryBody getSecond)
(define catchBody getThird)
(define finalBody cadddr)

; defining a function for catch so that returns a state after catch
(define M_state_catch
  (lambda (stmt state return whileReturn throwReturn breakReturn)
     (if (null? stmt) state
        (if (equal? (lookupvar 'throw state) 'none)
            state
            (run (catchBody stmt) 
                (M_state_Declaration_updateBinding (bind (catchVar stmt) (lookupvar 'throw state)) state)
                return whileReturn throwReturn breakReturn)))))

; abstraction
(define finalStmt getSecond)
(define catchVar caadr)
(define catchStmt getThird)

; defining a function for finally so that returns a state after finally
(define M_state_final
  (lambda (stmt state return whileReturn throwReturn breakReturn)
      (if (null? stmt) state
        (run (finalStmt stmt) state return whileReturn throwReturn breakReturn))))

; defining a function for try statement so that it returns a state after try statement
(define M_state_try
  (lambda (stmt state return whileReturn throwReturn breakReturn)
    (M_state_final (finalBody stmt)
    (M_state_catch (catchBody stmt)   (call/cc (lambda (throwReturn) 
                   (run (tryBody stmt) (M_state_Declaration_updateBinding (bind 'throw 'none) state) return whileReturn throwReturn breakReturn)))
                   return whileReturn throwReturn breakReturn)
             return whileReturn throwReturn breakReturn)))




;----------------------------------------------------------------------------------------------------
;------------------------------------State Implementation--------------------------------------------
; the following are functions written to hide state implementation from the rest of interpreter

; This implementation of the state is a list of list of pairs, each list of pairs is a layer,
; each pair contains a variable name and its value

; defining a function that updates the bindings in a given state in a delaration statement
(define M_state_Declaration_updateBinding
  (lambda (binding state)
    (cond
       ((assq (key binding) (topLayer state)) (error "Variable already declared"))
       (else (cons (addBinding binding (topLayer state)) (getAfterFirst state))))))

; defining a function that updates the bindings in a given state in a assignment statement
(define M_state_Assignment_updateBinding-cps
  (lambda (binding state cpsreturn)
    (cond
       ((null? state) (cpsreturn (error "Variable not declared")))
       ((assq (key binding) (topLayer state)) (cpsreturn (cons (addBinding binding (topLayer state)) (getAfterFirst state))))
       (else (M_state_Assignment_updateBinding-cps binding (getAfterFirst state) (lambda (v) (cpsreturn (cons (topLayer state) v))))))))

; defining a wrapper for M_State_Assignment_updateBinding-cps
(define M_state_Assignment_updateBinding
  (lambda (binding state)
    (M_state_Assignment_updateBinding-cps binding state (lambda(v) v))))


; defining a function that returns a value of a variable if initialized or an error message if not
(define lookupvar
  (lambda (var state)
     (if (findvar var state) (value (findvar var state)) ((error "Variable not declared!")))))


; defining a function that returns boolean indicating whether the binding defined in top layer
(define definedInTopBinding
  (lambda (binding state)
   (equal? (assq (key binding) (topLayer state)) binding)))

; defining a function that adds a binding to state
(define addBind
  (lambda (binding state)
    (cons (addBinding binding (topLayer state)) (getAfterFirst state))))

; defining a function that finds the variable in state
(define findvar-cps
  (lambda (var state cpsreturn)
    (cond
       ((null? state) (cpsreturn #f))
       ((assq var (topLayer state)) (cpsreturn (assq var (topLayer state))))
       (else (cpsreturn (findvar-cps var (getAfterFirst state) cpsreturn))))))

; defining a wrapper for findvar-cps
(define findvar
  (lambda (var state)
    (findvar-cps var state (lambda(v) v))))