;;; Rib cage implementation using:
;;; A list of symbols and
;;; A list of values
		
(define proc?
	(lambda (el)
		(case (car el)
			((closure-record) #t)
			((closure-record-nolist) #t)
			((closure-record-improper) #t)
			((primitive) #t)
			(else #f))))
		
(define closure-record
	(lambda (id body env)
		(list 'closure-record id body env))
	)
(define closure-record-nolist
	(lambda (id body env)
		(list 'closure-record-nolist id body env))
	)
(define closure-record-improper
	(lambda (id body env)
		(list 'closure-record-improper id body env))
	)
(define primitive
	(lambda (id)
		(list 'primitive id))
	)


(define empty-env
  (lambda ()
    '()))

(define extend-env
  (lambda (syms vals env)
    (cons (list syms vals) env)))

(define extend-env-recur
	(lambda (syms vals env)
		(let ((new-env (cons (cons syms vals) env)))
			(for-each (lambda (item)
				(if (proc? item)
					(list-set! (cadar new-env) (find-position item (caar new-env))
						(case (car item)
							((primitive) (cadr item))
							((closure-record)
								(closure-record (cadr item) (caddr item) new-env))
							((closure-record-nolist)
								(closure-record-nolist (cadr item) (caddr item) new-env))
							((closure-record-improper)
								(closure-record-improper (cadr item) (caddr item) new-env))))))
			new-env))))

(define apply-global-env
	(lambda (env sym)
		(if (null? env)
			(begin (display "Exception: ") (display sym) (read)) ;; This is bound to throw an error 11
			;(eopl:error 'apply-env "No binding for ~s" sym)
			(let ((syms (car (car env)))
				(vals (cadr (car env)))
				(env (cdr env)))
				(let ((pos (find-position sym syms)))
					(if (number? pos)
						(if (atom? syms)
							vals
							(if (list? vals)
								(if (and (not (list? syms)) (equal? sym (get-last syms)))
									(get-all pos vals)
									(list-ref vals pos))
								vals))
						(apply-global-env env sym)))))))

(define extend-global-env
	(lambda (syms vals)
		(let ((newGlob (extend-env syms vals global-env)))
			(set! global-env newGlob))))

(define apply-env
  (lambda (env sym)
    (if (null? env)
	(apply-global-env global-env sym)
	(let ((syms (car (car env)))
      (vals (cadr (car env)))
	  (env (cdr env)))
	 	(let ((pos (find-position sym syms)))
	    (if (number? pos)
			(if (atom? syms)
				vals
				(if (list? vals)
					(if (and (not (list? syms)) (equal? sym (get-last syms)))
						(get-all pos vals)
						(list-ref vals pos))
					vals))
			(apply-env env sym)))))))

(define get-all
	(lambda (count vals)
		(if (= count 0)
			vals
			(get-all (- count 1) (cdr vals)))))

(define change-env
  (lambda (env sym val)
    (if (null? env)
		(change-env-global global-env sym val)
	(let ((syms (caar env))
	      (vals (cadar env))
	      (env (cdr env)))
	  (let ((pos (find-position sym syms)))
	    (if (number? pos)
		(list-set! vals pos val)
		(change-env env sym val)))))))

(define change-env-global
  (lambda (env sym val)
    (if (null? env)
	(begin (display "Exception: ") (display sym) (read)) ;; also gunna throw an error 11
	;;(eopl:error 'apply-env "No binding for ~s" sym)
	(let ((syms (caar env))
	      (vals (cadar env))
	      (env (cdr env)))
	  (let ((pos (find-position sym syms)))
	    (if (number? pos)
		(list-set! vals pos val)
		(change-env env sym val)))))))

(define define-env-extend
	(lambda (env sym val)
		(if (null? env)
			(set! env (list (list (list sym) (list val))))
			(set-car! env (list (cons sym (caar env)) (cons val (cadar env)))))))
			
(define find-position
  (lambda (sym ls)
    (cond ((null? ls) #f)
      ((atom? ls)
      	(if (eq? sym ls) 0 #f))
	  ((eq? sym (car ls)) 0)
	  (else (let ((index (find-position sym (cdr ls))))
		  (if (number? index)
		      (+ index 1)
		      #f))))))

(define list-set! 
	(lambda (list k val)
    (if (zero? k)
        (set-car! list val)
        (list-set! (cdr list) (- k 1) val))))


(define primatives '(max + - * / = <= => < > cons eq? null? display newline list car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr vector? zero? atom? not length list->vector list? pair? vector->list make-vector vector-ref number? symbol? set! set-car! set-cdr! vector-set! map apply assq assv append exit contains load call-with-input-file eof-object? read write pretty-print string? boolean? list-ref equal? eval-one-exp reset-global-env open-input-file close-port member))


(define init-env
  (lambda ()
    (extend-env primatives
		(map primitive primatives)
		(empty-env))))

(define global-env
	(init-env))

(define reset-global-env
	(lambda ()
		(set! global-env (init-env))))