blob: 67435a243dfc7cf46b090c4d3b2ec2f0ca880227 (
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
|
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
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"
|
