module Evaluator (evaluate)
where
	
import Node
import Uniqs

evaluate		:: Node -> Node
evaluate x		= eval x--stripBreaks (eval x)

                                            	
eval											:: Node  -> Node
eval (Cons a b)									= Cons (eval a) (eval b)
eval (Function a b c) 							= Function (eval a) (eval b) (eval c)
eval (Application (Function a b c) d) 			= 	if patternMatch a d then
															eval (application a b d)
														else
															eval (Application c d)
eval (Application Nil _)						= Nil
eval (Application (Cons a b) d)					= eval (Cons (Application a d) (Application b d))
eval (Application y@(Application _ _) d) 		= eval (Application (eval y) d)
eval (Application y@(Break _) d) 				= eval (Application (eval y) d)
eval (Break x)									= eval x
eval x											= x


stripBreaks						:: Node -> Node
stripBreaks (Break a)			= stripBreaks a
stripBreaks (Function a b c)	= Function (stripBreaks a) (stripBreaks b) (stripBreaks c)
stripBreaks (Application a b)	= Application (stripBreaks a) (stripBreaks b)
stripBreaks (Cons a b)			= Cons (stripBreaks a) (stripBreaks b)
stripBreaks x					= x



patternMatch											:: Node -> Node -> Bool
patternMatch (Symbol _)	_								= True
patternMatch Nil Nil									= True
patternMatch (Cons a1 d1) (Cons a2 d2) 					= (patternMatch a1 a2) && (patternMatch d1 d2)
-- patternMatch (Function a1 d1 c1) (Function a2 d2 c2)	= (patternMatch a1 a2) && (patternMatch d1 d2) && (patternMatch e1 e2)
patternMatch a@(Application _ _ ) b						= patternMatch (eval a) b
patternMatch a b@(Application _ _ )						= patternMatch a (eval a)
patternMatch (Break a) b								= patternMatch a b
patternMatch a (Break b)								= patternMatch a b
patternMatch _ _										= False

application						:: Node -> Node -> Node -> Node
application patrn func arg		= applyList func (applicationList patrn arg)

applyList							:: Node -> [(Uniqs, Node)] -> Node
applyList (Symbol y) list			= getNodeForSymbol y list
applyList (Cons a d) list			= Cons (applyList a list) (applyList d list)
applyList (Function a b c) list		= Function (applyList a list) (applyList b list) (applyList c list)
applyList (Application a b) list	= Application (applyList a list) (applyList b list)
applyList (Break a)	_				= Break a
applyList Nil _						= Nil

getNodeForSymbol				:: Uniqs -> [(Uniqs, Node)] -> Node
getNodeForSymbol s tab			= case (lookup s tab) of
									Just (Break a)	-> Break a
									Just a			-> Break a
									Nothing 		-> Symbol s



applicationList 								:: Node -> Node -> [(Uniqs, Node)]
applicationList (Symbol y) x					= [(y,x)]
applicationList Nil Nil							= []
applicationList	(Cons a1 d1) (Cons a2 d2)		= (applicationList a1 a2) ++ (applicationList d1 d2)
applicationList a@(Application _ _ ) b			= applicationList (eval a) b
applicationList a b@(Application _ _ )			= applicationList a (eval a)
applicationList (Break a) b						= applicationList a b
applicationList a (Break b)						= applicationList a b