blob: 7767b4b109b288c769719266d1a2ef98e0609cd3 (
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
|
module DSL.Util where
import DSL.Types
tAny :: TypeCheck
tAny = const True
tBool :: TypeCheck
tBool (StackBool _) = True
tBool _ = False
tInt :: TypeCheck
tInt (StackInt _) = True
tInt _ = False
tString :: TypeCheck
tString (StackString _) = True
tString _ = False
runChecks :: [TypeCheck] -> Stack -> Maybe String
runChecks fs s
| length fs > length s = Just "stack underflow"
| not (and $ zipWith id fs s) = Just "type mis-match"
| otherwise = Nothing
hcf :: Machine -> String -> IO Machine
hcf m msg = putStrLn msg >> return m{ ok=False }
unreachable :: a
unreachable = error "this branch should be unreachable"
|
