;;;;;; Problem 1 ;;;;;;

(define-datatype value value?
  (val-char (x char?))
  (val-integer (x integer?))
  (val-string (x string?))
  (val-double (x integer?) (y integer?))
  (val-boolean (x symbol?))
  (val-list (x list?))
  (val-env (x env?))
  (val-letexp (x let-exp?))
  (val-letprog (x let-prog?))
  (val-letlist (x let-list?))
  (val-proc (x proc?)))

(define scanner-1
  '((white-sp (whitespace) skip)
    (comment (";" (arbno (not #\newline))) skip)
    (identifier (letter (arbno (or letter digit))) symbol)
    (number (digit (arbno digit)) number)))

(define-datatype env env?
  (empty-env)
  (extend-env (var symbol?) (val value?) (e env?)))

(define apply-env
  (lambda (e x)
    (e x)))

(define empty-env
  (lambda ()
    (lambda (x)
      (report-not-found x))))

(define extend-env
  (lambda(var val e)
    (lambda (x)
      (if (eqv? x var)
          val
          (apply-env e x)))))

(define report-no-binding-found
  (lambda (search-var)
    (eopl:error 'apply-env "No binding for ~s" search-var)))

(define report-invalid-env
  (lambda (env)
    (eopl:error 'apply-env "Bad environment: ~s" env)))

(define empty-env? (lambda (e)
                     (cases env e
        (empty-env () #t)
         (extend-env (x y z) #f) )))

(define grammar-env
  '((env () empty-env)
    (env ("[" identifier "=" number "]" env) extend-env)))

(define scan&parse-env (sllgen:make-string-parser scanner-1 grammar-env))

;;;;;;;; Problem 3 ;;;;;;;

(define-datatype let-exp let-exp?
  (let-int (i integer?))
  (let-id (id symbol?))
  (let-minus (e1 let-exp?) (e2 let-exp?))
  (let-zero (e1 let-exp?))
  (let-ifelse (e1 let-exp?) (e2 let-exp?) (e3 let-exp?))
  (let-constr (id symbol?) (e1 let-exp?) (e2 let-exp?))
  (let-emptylist)
  (let-cons (l1 let-exp?) (l2 let-exp?))
  (let-car (l1 let-exp?))
  (let-cdr (l1 let-exp?))
  (let-null (l1 let-exp?))
  )
  
(define-datatype let-prog let-prog?
  (prog (e1 let-exp?)))

(define scanner-1
  '((white-sp (whitespace) skip)
    (comment (";" (arbno (not #\newline))) skip)
    (identifier (letter (arbno (or letter digit))) symbol)
    (number (digit (arbno digit)) number)))

(define parsar-let
  '((let-exp (number) let-int)
    (let-exp (identifier) let-id)
    (let-exp ("-(" let-exp "," let-exp ")") let-minus)
    (let-exp ("(zero?" let-exp ")") let-zero)
    (let-exp ("if" let-exp "then" let-exp "else" let-exp) let-ifelse)
    (let-exp ("let" identifier "=" let-exp "in" let-exp) let-constr)
    (let-prog (let-exp) prog)
    (let-exp ("emptylist") let-emptylist)
    (let-exp ("cons(" let-exp "," let-exp ")") let-cons) 
    (let-exp ("car(" let-exp ")") let-car)
    (let-exp ("cdr(" let-exp ")") let-cdr)
    (let-exp ("null?(" let-exp ")") let-null)
     ))

(define scan&parse-let (sllgen:make-string-parser scanner-1 parsar-let))

(define value-of-prog (lambda (program env)
  (cases let-prog program
   (prog (x) (value-of x (env))))))

(define value-of (lambda (exp env)
                   (cases let-exp exp
                     (let-int (x) x)
                     (let-id (x) (apply-env env x))
                     (let-minus (x y) 
                             (- (value-of x env) (value-of y env)))
                     (let-zero (x)
                                 (if (zero? (value-of x env))
                                 #t
                                 #f))
                     (let-ifelse (x y z)
                               (if (value-of x env)
                                     (value-of y env)
                                     (value-of z env)))
                     (let-constr (x y z)
                                 (let ((val1 (value-of y env)))
                                   (value-of z (extend-env x val1 env))))
                     (let-emptylist () (let-emptylist))
                     (let-cons (x y) (append (list (value-of x env)) (list (value-of y env))))
                     (let-car (x) (car (list (value-of x env))))
                     (let-cdr (x) (cdr (list (value-of x env))))
                     (let-null (x) (if (null? (value-of x env)) #t
                                       #f))
                     )))


;;;;;;;; Problem 4 ;;;;;;;
(define-datatype proc proc?
  (proc-int (i integer?))
  (proc-id (id symbol?))
  (proc-dif (e1 proc?) (e2 proc?))
  (proc-zero (e1 proc?))
  (proc-ifelse (e1 proc?) (e2 proc?) (e3 proc?))
  (proc-constr (id symbol?) (e1 proc?) (e2 proc?))
  (proc-def (id symbol?) (body proc?))
  (proc-app (rator proc?) (rand proc?)))

(define-datatype proc-prog proc-prog?
  (prog-proc (e1 proc?)))

(define grammar-proc
  '((proc-exp (number) proc-int)
    (proc-exp (identifier) proc-id)
    (proc-exp ("-(" proc-exp "," proc-exp ")") proc-dif)
    (proc-exp ("(zero?" proc-exp ")") proc-zero)
    (proc-exp ("if" proc-exp "then" proc-exp "else" proc-exp) proc-ifelse)
    (proc-exp ("let" identifier "=" proc-exp "in" proc-exp) proc-constr)
    (proc-exp ("proc (" identifier ")" proc-exp) proc-def)
    (proc-exp ("(" proc-exp proc-exp ")") proc-app)
    (proc-prog (proc-exp) prog-proc)))

(define scan&parse-proc (sllgen:make-string-parser scanner-1 grammar-proc))

(define procedure
  (lambda (var body env)
    (lambda (val) 
      (value-of-proc body (extend-env var val env)))))

(define apply-procedure 
  (lambda (proc1 val)
    (proc1 val)))

(define value-of-proc (lambda (exp env)
                   (cases proc exp
                     (proc-int (i) i)
                     (proc-id (id) (apply-env env id))
                     (proc-dif (e1 e2) 
                             (- (value-of-proc e1 env) (value-of-proc e2 env)))
                     (proc-zero (e1)
                                 (if (zero? (value-of-proc e1 env))
                                 #t
                                 #f))
                     (proc-ifelse (e1 e2 e3)
                                (if (value-of e1 env)
                                     (value-of e2 env)
                                     (value-of e3 env)))
                     (proc-constr (id e1 e2)
                                 (let ((val1 (value-of-proc e1 env)))
                                   (value-of-proc e2 (extend-env id val1 env))))
                     (proc-def (id body) (procedure id body env))
                     (proc-app (operator operand) 
                               (let ((proc (value-of-proc operator env))
                                     (arg (value-of-proc operand env)))
                                 (apply-procedure proc arg))))))

(define c (lambda (exp env)
            (value-of-proc (scan&parse-proc exp) env)
            ))


;;;;;; tests;;;;;
(define test (scan&parse-let "let x = 10 in -(x, 5)")) 
(define test2 (scan&parse-let "let x = 4 in cons(x, cons(cons(-(x,1),emptylist),emptylist))"))
(define test-env (extend-env 'x 1 (empty-env)))
(value-of test empty-env) 
(value-of test2 test-env) 
(define test3 (scan&parse-proc "let x = 200 in let f = proc (z) -(z,x) in let x = 100 in let g = proc (z) -(z,x) in -((f 1), (g 1))"))
(value-of-proc test3 test-env)
(define test4 (scan&parse-let "if (zero? a) then 12 else 10 "))
(define env1 (scan&parse-env "[ a = 5 ]"))
(define env2 (scan&parse-env "[ a = 4 ] [b = 3]"))
(value-of test4 env1)
(define test5 "-(a,-(0,b))")
(c test5 env2)