|
996
|
1 module Evaluator (evaluate)
|
|
|
2 where
|
|
|
3
|
|
|
4 import Node
|
|
|
5 import Uniqs
|
|
|
6
|
|
|
7 evaluate :: Node -> Node
|
|
|
8 evaluate x = eval x--stripBreaks (eval x)
|
|
|
9
|
|
|
10
|
|
|
11 eval :: Node -> Node
|
|
|
12 eval (Cons a b) = Cons (eval a) (eval b)
|
|
|
13 eval (Function a b c) = Function (eval a) (eval b) (eval c)
|
|
|
14 eval (Application (Function a b c) d) = if patternMatch a d then
|
|
|
15 eval (application a b d)
|
|
|
16 else
|
|
|
17 eval (Application c d)
|
|
|
18 eval (Application Nil _) = Nil
|
|
|
19 eval (Application (Cons a b) d) = eval (Cons (Application a d) (Application b d))
|
|
|
20 eval (Application y@(Application _ _) d) = eval (Application (eval y) d)
|
|
|
21 eval (Application y@(Break _) d) = eval (Application (eval y) d)
|
|
|
22 eval (Break x) = eval x
|
|
|
23 eval x = x
|
|
|
24
|
|
|
25
|
|
|
26 stripBreaks :: Node -> Node
|
|
|
27 stripBreaks (Break a) = stripBreaks a
|
|
|
28 stripBreaks (Function a b c) = Function (stripBreaks a) (stripBreaks b) (stripBreaks c)
|
|
|
29 stripBreaks (Application a b) = Application (stripBreaks a) (stripBreaks b)
|
|
|
30 stripBreaks (Cons a b) = Cons (stripBreaks a) (stripBreaks b)
|
|
|
31 stripBreaks x = x
|
|
|
32
|
|
|
33
|
|
|
34
|
|
|
35 patternMatch :: Node -> Node -> Bool
|
|
|
36 patternMatch (Symbol _) _ = True
|
|
|
37 patternMatch Nil Nil = True
|
|
|
38 patternMatch (Cons a1 d1) (Cons a2 d2) = (patternMatch a1 a2) && (patternMatch d1 d2)
|
|
|
39 -- patternMatch (Function a1 d1 c1) (Function a2 d2 c2) = (patternMatch a1 a2) && (patternMatch d1 d2) && (patternMatch e1 e2)
|
|
|
40 patternMatch a@(Application _ _ ) b = patternMatch (eval a) b
|
|
|
41 patternMatch a b@(Application _ _ ) = patternMatch a (eval a)
|
|
|
42 patternMatch (Break a) b = patternMatch a b
|
|
|
43 patternMatch a (Break b) = patternMatch a b
|
|
|
44 patternMatch _ _ = False
|
|
|
45
|
|
|
46 application :: Node -> Node -> Node -> Node
|
|
|
47 application patrn func arg = applyList func (applicationList patrn arg)
|
|
|
48
|
|
|
49 applyList :: Node -> [(Uniqs, Node)] -> Node
|
|
|
50 applyList (Symbol y) list = getNodeForSymbol y list
|
|
|
51 applyList (Cons a d) list = Cons (applyList a list) (applyList d list)
|
|
|
52 applyList (Function a b c) list = Function (applyList a list) (applyList b list) (applyList c list)
|
|
|
53 applyList (Application a b) list = Application (applyList a list) (applyList b list)
|
|
|
54 applyList (Break a) _ = Break a
|
|
|
55 applyList Nil _ = Nil
|
|
|
56
|
|
|
57 getNodeForSymbol :: Uniqs -> [(Uniqs, Node)] -> Node
|
|
|
58 getNodeForSymbol s tab = case (lookup s tab) of
|
|
|
59 Just (Break a) -> Break a
|
|
|
60 Just a -> Break a
|
|
|
61 Nothing -> Symbol s
|
|
|
62
|
|
|
63
|
|
|
64
|
|
|
65 applicationList :: Node -> Node -> [(Uniqs, Node)]
|
|
|
66 applicationList (Symbol y) x = [(y,x)]
|
|
|
67 applicationList Nil Nil = []
|
|
|
68 applicationList (Cons a1 d1) (Cons a2 d2) = (applicationList a1 a2) ++ (applicationList d1 d2)
|
|
|
69 applicationList a@(Application _ _ ) b = applicationList (eval a) b
|
|
|
70 applicationList a b@(Application _ _ ) = applicationList a (eval a)
|
|
|
71 applicationList (Break a) b = applicationList a b
|
|
|
72 applicationList a (Break b) = applicationList a b
|
