Xuqw12nasd92qkewq

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
module UntypedLambda1 where
data Lam = Literal String
| Abstr String Lam
| Apply Lam Lam
getStr (Literal var) = var
getStr (Abstr var1 term2) = "Lam " ++ (var1) ++ " . " ++ (getStr term2)
getStr (Apply var1 term2) = "(" ++ (getStr var1) ++ ") (" ++ (getStr term2) ++ ")"
eval (Literal var) = Literal var
eval (Abstr var body) = Abstr var (body)
eval (Apply (Abstr var body) term2) = eval (passLits (Abstr var body) var term2)
eval (Apply var1 term2) = eval (Apply (eval var1) (term2))
eval t = t
passLits (Abstr var1 term) var term1 | var1 == var = (passLits (term) var (replaceVar term var term1))
passLits (Abstr var1 term) var term1 | otherwise = Abstr (var1) (passLits (term) var (rename term1 var1))
passLits (Apply t1 t2) var term1 = Apply (passLits t1 var term1) (passLits t2 var term1)
passLits (Literal var1) var term1 | var1 == var = term1
passLits (Literal var1) _ _ | otherwise = Literal var1
replaceVar (Literal lit) var term | lit == var = term
replaceVar (Literal lit) var term | otherwise = (Literal lit)
replaceVar (Abstr var1 term) var term1 = Abstr var1 (replaceVar term var term1)
replaceVar (Apply t1 t2) var term = Apply (replaceVar t1 var term) (replaceVar t2 var term)
rename term name = rename' term name 1
where rename' (Literal name1) name i | name1 == name = Literal (show i)
rename' (Literal name1) _ _ | otherwise = Literal (name1)
rename' (Apply t1 t2) name i = Apply (rename' t1 name i) (rename' t1 name i)
rename' (Abstr name1 t) name i | name1 == name = Abstr ((show (i+1))) (rename' t name (i+1))
rename' (Abstr name1 t) name i | otherwise = Abstr (name1) (rename' t name (i))