(define eval-one-exp
  (lambda (exp)
    (let* ((parse-tree (parse-expression exp))
		(syntax (expand-syntax parse-tree))
	   (initial-environment (init-env))
	   (result (top-level-eval syntax)))
      result)))

(define top-level-eval
  (lambda (form)
    (case (car form)
	   ((define-exp)
	     (extend-global-env (list (cadr form)) (list (eval-expression (caddr form) (empty-env)))))
	   (else (eval-expression form (empty-env))))))

(define interpret
	(lambda (datum)
		(eval-one-exp datum)))

(define eval-cond
	(lambda (bodies env)
		(cond ((null? bodies) #f)
			  (else
			  	(let ((condit (car bodies)))
			  		(if (eval-expression (cadr condit) env)
			  			(eval-expression (caddr condit) env)
			  			(eval-cond (cdr bodies) env)))))))

(define eval-expression
	(lambda (exp env)
		(case (car exp)
			((num-exp) (cadr exp))
			((var-exp) (apply-env env (cadr exp)))
			((lambda-exp)
		       (make-closure (cadr exp) (caddr exp) env))
		    ((lambda-exp-improper)
		    	(make-closure (cadr exp) (caddr exp) env))
		    ((lambda-exp-nolist)
		    	(make-closure (cadr exp) (caddr exp) env))
			((app-exp)
		    	(let ((procedure (eval-expression (cadr exp) env))
			 	 (arg (map (eval-expression-env env) (caddr exp))))
		     	 (apply-proc procedure arg env)))
			((set-exp)
				(let ((the-val (eval-expression (caddr exp) env)))
					(change-env env
						(cadr exp)
						the-val)))
		    ((lit-exp) (cadr exp))
		    ((if-exp)
		    	(if (eval-expression (cadr exp) env)
		    		(eval-expression (caddr exp) env)))
		    ((if-else-exp)
		    	(if (eval-expression (cadr exp) env)
		    		(eval-expression (caddr exp) env)
		    		(eval-expression (cadddr exp) env)))
		    ((begin-exp)
		    	(begin-run (cadr exp) env))
		    ((while-exp)
				(let ((test (eval-expression (cadr exp) env)))
					(if test
						(let ((body (begin-run (caddr exp) env)))
							(eval-expression exp env)))))
			((define-exp)
				(define-env-extend env (cadr exp) (eval-expression (caddr exp) env)))
			(else (exception exp))
			)))

(define begin-run
	(lambda (bodies env)
		(cond
			((null? bodies) #t)
			(else
				(let* ( (exp (car bodies))
					(res 
						(case (car exp)
							((define-exp) (top-level-eval exp))
							(else (eval-expression exp env))))
					(next (begin-run (cdr bodies) env)))
					(if (equal? #t next)
						res
						next))))))

(define eval-expression-env
	(lambda (env)
		(lambda (exp)
			(eval-expression exp env))))

(define list-of
	(lambda (proc)
		(lambda (ls)
			(cond
				((null? ls) #t)
				((proc (car ls)) ((list-of proc) (cdr ls)))
				(else #f)))))
				
			
(define make-closure
  (lambda (id body env)
    (if ((list-of symbol?) id)
    	(closure-record id body env)
    	(if (atom? id)
    		(closure-record-nolist id body env)
    		(closure-record-improper id body env)))))

(define apply-proc
  (lambda (proc arg env)
    (if (proc? proc)
		(case (car proc)
			((closure-record)
			       (get-last (left-map (eval-expression-env (extend-env (cadr proc) arg (cadddr proc))) (caddr proc))))
			((closure-record-nolist)
			       (get-last (left-map (eval-expression-env (extend-env (cadr proc) arg (cadddr proc))) (caddr proc))))
			((closure-record-improper)
			       (get-last (left-map (eval-expression-env (extend-env (cadr proc) arg (cadddr proc))) (caddr proc))))
			((primitive)
					(apply-primitive-proc (cadr proc) arg env))
				   )
		(proc arg))))

(define left-map
	(lambda (func ls)
		(if (null? ls)
			'()
			(let ((res (func (car ls))))
				(cons res (left-map func (cdr ls)))))))
			;(cons (func (car ls)) (left-map func (cdr ls))))))
	
(define apply-primitive-proc
  (lambda (name args env)
      (case name
	((+) (apply + args))
	((-) (apply - args))
	((*) (apply * args))
	((/) (apply / args))
	((=) (apply = args))
	((<=) (apply < args))
	((=>) (apply > args))
	((<) (apply < args))
	((>) (apply > args))
	((cons) (apply cons args))
	((eq?) (apply eq? args))
	((null?) (apply null? args))
	((display) (apply display args))
	((newline) (newline))
	((list) (apply list args))
	
	((car) (apply car args))
	((cdr) (apply cdr args))
	((caar) (apply caar args))
	((cadr) (apply cadr args))
	((cdar) (apply cdar args))
	((cddr) (apply cddr args))
	((caaar) (apply caaar args))
	((caadr) (apply caadr args))
	((cadar) (apply cadar args))
	((caddr) (apply  caddr args))
	((cdaar) (apply cdaar args))
	((cdadr) (apply cdadr args))
	((cddar) (apply cddar args))
	((cdddr) (apply cdddr args))
	
	((caaaar) (apply caaaar args))
	((caaadr) (apply caaadr args))
	((caadar) (apply caadar args))
	((caaddr) (apply caaddr args))
	((cadaar) (apply cadaar args))
	((cadadr) (apply cadadr args))
	((caddar) (apply caddar args))
	((cadddr) (apply cadddr args))
	
	((cdaaar) (apply cdaaar args))
	((cdaadr) (apply cdaadr args))
	((cdadar) (apply cdadar args))
	((cdaddr) (apply cdaddr args))
	((cddaar) (apply cddaar args))
	((cddadr) (apply cddadr args))
	((cdddar) (apply cdddar args))
	((cddddr) (apply cddddr args))
	
	((vector?) (apply vector? args))
	((zero?) (apply zero? args))
	((atom?) (apply atom? args))
	((not) (apply not args))
	((length) (apply length args))
	((list->vector) (apply list->vector args))
	((list?) (apply list? args))
	((pair?) (apply pair? args))
	((vector->list) (apply vector->list args))
	((make-vector) (apply make-vector args))
	((vector-ref) (apply vector-ref args))
	((number?) (apply number? args))
	((symbol?) (apply symbol? args))
	((set-car!) (apply set-car! args))
	((set-cdr!) (apply set-cdr! args))
	((vector-set!) (apply vector-set! args))
	
	;;map apply assq assv append
	((map) (custom-map (car args) (cadr args) env))
	((apply) (apply-proc (car args) (cadr args) env))
	((assq) (apply assq args))
	((assv) (apply assv args))
	((append) (apply append args))
	((exit) (exit))
	((contains) (apply member args))
	((member) (apply member args))

	;;max
	((max) (let ((a (car args))
				(b (cadr args)))
			(if (> a b) a b)))
	((load) (let ([p (open-input-file (car args))])
				(let f ([x (read p)])
					(if (eof-object? x)
						(begin
						  (close-port p)
						  '())
						(begin (eval-one-exp x) (f (read p)))))))
	((close-port) (apply close-port args))
	((open-input-file) (apply open-input-file args))
	((eof-object?) (apply eof-object? args))
	((read) (apply read args)) ;; Maybe should be (list (read))
	((write) (begin (display (car args)) (newline)))
	((pretty-print) (begin (display (car args) ) (newline)))
	((string?) (string? (car args)))
	((boolean?) (boolean? (car args)))
	((list-ref) (list-ref (car args) (cadr args)))
	((equal?) (equal? (car args) (cadr args)))
	((eval-one-exp) (eval-one-exp (car args)))
	((reset-global-env) #f);(reset-global-env))
	
	
	)))
	
	
(define atom?
	(lambda (atom)
		(not (pair? atom))))
	
	
(define containsVal
	(lambda (e ls)
		(cond
			((null? ls) #f)
			((equal? (car ls) e) e)
			(else
				(containsVal e (cdr ls))))))
	
(define custom-map
	(lambda (proc ls env)
		(cond
			((null? ls) '())
			((pair? ls) (cons (apply-proc proc (list (car ls)) env) (custom-map proc (cdr ls) env)))
			(else '())
			)))

(define get-last
	(lambda (ls)
		(if (or (atom? ls) (null? (cdr ls)))
			(if (atom? ls)
				ls
				(car ls))
			(get-last (cdr ls)))))


(define eval-rands
	(lambda (rands env)
		(map (lambda (x) (eval-rand x env)) rands)))

(define eval-rand
	(lambda (rand env)
		(eval-expression rand env)))


(define scheme-value? (lambda (ls) #t))