(define num-exp
	(lambda (num)
		(list 'num-exp num)))
		
(define lit-exp
	(lambda (ls)
		(list 'lit-exp ls)))
		
(define var-exp
	(lambda (var)
		(list 'var-exp var)))
	
(define app-exp
	(lambda (op rands)
		(list 'app-exp op rands)))
		
(define lambda-exp
	(lambda (id bodies)
		(list 'lambda-exp id bodies)))
		
(define lambda-exp-improper
	(lambda (id bodies)
		(list 'lambda-exp-improper id bodies)))
		
(define lambda-exp-nolist
	(lambda (id bodies)
		(list 'lambda-exp-nolist id bodies)))
	
(define let-exp
	(lambda (ids vals bodies)
		(list 'let-exp ids vals bodies)))
		
(define letrec-exp
	(lambda (ids vals bodies)
		(list 'letrec-exp ids vals bodies)))
		
(define if-exp
	(lambda (condition if-true)
		(list 'if-exp condition if-true)))
		
(define if-else-exp
	(lambda (condition if-true if-false)
		(list 'if-else-exp condition if-true if-false)))
		
(define begin-exp
	(lambda (bodies)
		(list 'begin-exp bodies)))
		
(define conditional-exp
	(lambda (bodies)
		(list 'conditional-exp bodies)))
		
(define and-exp
	(lambda (bodies)
		(list 'and-exp bodies)))
		
(define or-exp
	(lambda (bodies)
		(list 'or-exp bodies)))
		
(define set-exp
	(lambda (id val)
		(list 'set-exp id val)))
		
(define while-exp
	(lambda (test-exp bodies)
		(list 'while-exp test-exp bodies)))
		
(define case-exp
	(lambda (key bodies else-val)
		(list 'case-exp key bodies else-val)))
		
(define define-exp
	(lambda (id body)
		(list 'define-exp id body)))
		
		
;;---		

(define case-body-exp
	(lambda (values bodies)
		(list 'case-body-exp values bodies)))
		
(define parse-conditional
	(lambda (datum)
		(if (equal? 'else (car datum))
			(condition-pair
				(parse-expression #t)
				(parse-expression (cadr datum)))
			(condition-pair
				(parse-expression (car datum))
				(parse-expression (cadr datum))))))

(define condition-pair
	(lambda (boolConstraint body)
		(list 'condition-pair boolConstraint body)))

(define parse-expression
	(lambda (datum)
		(cond
			[(null? datum)
				(lit-exp datum)]
			[(number? datum)
				(num-exp datum)]
			[(symbol? datum)
				(var-exp datum)]
			[(string? datum)
				(lit-exp datum)]
			[(vector? datum)
				(lit-exp datum)]
			[(boolean? datum)
				(lit-exp datum)]
			[(pair? datum)
				(cond
					[(eq? (car datum) 'set!)
						(set-exp (cadr datum) (parse-expression (caddr datum)))]
					[(equal? 'quote (car datum))
						(lit-exp (cadr datum))]
					[(equal? 'begin (car datum))
						(begin-exp
							(map parse-expression (cdr datum)))]
					[(equal? 'if (car datum))
						(let ([num (count datum)])
							(cond 
								[(= num 4)
									(if-else-exp (parse-expression (cadr datum))
										(parse-expression (caddr datum))
										(parse-expression (cadddr datum)))]
								[(= num 3)
									(if-exp (parse-expression (cadr datum))
										(parse-expression (caddr datum)))]))]
					[(equal? 'cond (car datum))
						(conditional-exp (map parse-conditional (cdr datum)))]
					[(equal? 'lambda (car datum))
						(cond
							[(list? (cadr datum))
								(lambda-exp (cadr datum)
			      				(map parse-expression (cddr datum)))]
			      			[(atom? (cadr datum))
			      				(lambda-exp-nolist (cadr datum)
			      				(map parse-expression (cddr datum)))]
			      			[else
			      				(lambda-exp-improper (cadr datum)
			      				(map parse-expression (cddr datum)))]
			      		)
					]
					[(equal? 'let (car datum))
						(let ([pairs (cadr datum)]
							  [bindings (caddr datum)])
							(if (not (symbol? pairs))
								(let-exp (map car pairs)
										(map (lambda (x) (parse-expression (cadr x))) pairs)
										(map parse-expression (cddr datum)))
								;(named-let-exp pairs
								;	(map car (caddr datum))
								;	(map (lambda (x) (parse-expression (cadr x))) (caddr datum))
								;	(parse-expression (cadddr datum)))))]
								;(let-exp (map car bindings)
										;(map (lambda (x) (parse-expression (cadr x))) bindings)
										;(list (let-exp (list pairs)
											;(list (parse-expression (cadddr datum)))
											;(list (begin-exp (list (set-exp pairs (parse-expression (cadddr datum))) (app-exp (var-exp pairs) (map parse-expression (map car bindings)))))))))))]
								;; Old Caleb Code
								;;(let-exp (append (list pairs) (map car bindings))
								;;		(append (list (parse-expression (caddr datum))) (map (lambda (x) (parse-expression (cadr x))) bindings))
								;;		(list (set-exp pairs (parse-expression (caddr datum))) (app-exp (parse-expression pairs) (map parse-expression bindings))))))]
								
								;; named-let
								;;((_ f ((x v) ...) e1 e2 ...)
								;;	((letrec ([f (lambda (x ...) e1 e2 ...)])
								;;			f)
								;;		v ...))
								;; >> (app-exp 
								
								;;))
								;; My head hurts.
								;; This was not fun
								;; I need a better way to convert code into parsed code
								(let (	[name (cadr datum)]
										[named-pairs (caddr datum)]
										[named-body (cdddr datum)])
								(parse-expression (append (list  (list 'letrec (list (list name (append (list 'lambda (map car named-pairs)) named-body)))
																	name))
															(map cadr named-pairs)))
																		)))]
								
					[(equal? 'letrec (car datum))
						(let ([pairs (cadr datum)])
							(letrec-exp (map car pairs)
											(map (lambda (x) (parse-expression (cadr x))) pairs)
											(map parse-expression (cddr datum))))]
					;; Old caleb code
						;(let ([pairs (cadr datum)])
							;(let-exp (map car pairs)
							;	(map (lambda (x) (lit-exp '())) pairs)
							;	(append (map (lambda (x) (set-exp (car x) (parse-expression (cadr x)))) pairs) (map parse-expression (cddr datum)))))]
					[(equal? 'and (car datum))
						(and-exp (map parse-expression (cdr datum)))]
					[(equal? 'or (car datum))
						(or-exp (map parse-expression (cdr datum)))]
					[(equal? 'let* (car datum))
						(car (parse-let* (cdr datum)))]
					[(equal? 'while (car datum))
						(while-exp (parse-expression (cadr datum))
							(map parse-expression (cddr datum)))]
					[(equal? 'case (car datum))
						(case-exp (parse-expression (cadr datum))
							(parse-case-bodies (cddr datum))
							(map parse-expression (cdr (get-last-else datum))))]
					[(equal? 'define (car datum))
						(define-exp (cadr datum) (parse-expression (caddr datum)))]
					[else
						(app-exp (parse-expression (car datum))
							(map parse-expression (cdr datum)))]
				)
			]
			)
		))

(define parse-case-bodies
	(lambda (ls)
		(if (or (null? ls) (equal? 'else (caar ls)))
			'()
			(cons (case-body-exp (lit-exp (caar ls)) (map parse-expression (cdar ls))) (parse-case-bodies (cdr ls))))))

(define get-last-else
	(lambda (ls)
		(if (null? ls)
			'()
			(if (null? (cdr ls))
				(if (equal? 'else (car ls))
					ls
					'())
				(get-last (cdr ls))))))

(define parse-let*
	(lambda (vals)
		(let ([bindings (car vals)])
			(if (null? bindings)
				(map parse-expression (cdr vals))
				(list (let-exp (list (caar bindings)) (list (parse-expression (cadar bindings)))
					(parse-let* (cons (cdr bindings) (cdr vals)))))))))

(define count
	(lambda (ls)
		(if (null? ls)
			0
			(if (pair? ls)
				(+ 1 (count (cdr ls)))
				1))))