blob: acec5b4d335fda0adcf3f6de03072ea7f9b9e97d (
plain)
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
module Core
( Term(..)
, isNumericVal
, isVal
, eval
) where
data Term = TmTrue
| TmFalse
| TmIf Term Term Term
| TmZero
| TmSucc Term
| TmPred Term
| TmIsZero Term
instance Show Term where
show TmTrue = "true"
show TmFalse = "false"
show (TmIf t1 t2 t3) = "if " ++ show t1 ++ " then " ++ show t2 ++ " else " ++ show t3
show TmZero = "0"
show (TmSucc t) = "succ " ++ show t
show (TmPred t) = "pred " ++ show t
show (TmIsZero t) = "iszero " ++ show t
isNumericVal :: Term -> Bool
isNumericVal TmZero = True
isNumericVal (TmSucc t1) = isNumericVal t1
isNumericVal _ = False
isVal :: Term -> Bool
isVal TmTrue = True
isVal TmFalse = True
isVal t = isNumericVal t
eval1 :: Term -> Maybe Term
eval1 (TmIf TmTrue t2 t3) = Just t2
eval1 (TmIf TmFalse t2 t3) = Just t3
eval1 (TmIf t1 t2 t3) = do
t1' <- eval1 t1
return $ TmIf t1' t2 t3
eval1 (TmSucc t1) = do
t1' <- eval1 t1
return $ TmSucc t1'
eval1 (TmPred TmZero) = Just $ TmZero
eval1 (TmPred (TmSucc nv1)) | isNumericVal nv1 = Just nv1
eval1 (TmPred t1) = do
t1' <- eval1 t1
return $ TmPred t1'
eval1 (TmIsZero TmZero) = Just $ TmTrue
eval1 (TmIsZero (TmSucc nv1)) | isNumericVal nv1 = Just $ TmFalse
eval1 (TmIsZero t1) = do
t1' <- eval1 t1
return $ TmIsZero t1'
eval1 _ = Nothing
eval :: Term -> Term
eval t = case eval1 t of
Just t' -> eval t'
Nothing -> t
|
