summaryrefslogtreecommitdiff
path: root/src/K/Eval.hs
blob: a7ebcba43bc2cc56060e8ff922ca10bf5dfb3cd5 (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
module K.Eval where

import K.Ast
import K.Parsing
import Data.Maybe

isNum Zero = True
isNum (Succ t) = isNum t
isNum _ = False

isVal :: Expr -> Bool
isVal Tru = True
isVal Fals = True
isVal t | isNum t = True
isVal _ = False

eval' x = case x of
    IsZero Zero               -> Just Tru
    IsZero (Succ t) | isNum t -> Just Fals
    IsZero t                  -> IsZero <$> eval' t

    Succ t                    -> Succ <$> eval' t

    Pred Zero                 -> Just Zero
    Pred (Succ t) | isNum t   -> Just t
    Pred t                    -> Pred <$> eval' t

    If Tru t _                -> Just t
    If Fals _ f               -> Just f
    If c t f                  -> (\c' -> If c' t f) <$> eval' c

    _                         -> Nothing

nf x = fromMaybe x (nf <$> eval' x)

eval :: Expr -> Maybe Expr
eval t = case nf t of
    nft | isVal nft -> Just nft
        | otherwise -> Nothing