Big file-structure refactor

1 files changed, 27 insertions, 0 deletions

diff --git a/DSL/Util.hs b/DSL/Util.hs
new file mode 100644
index 0000000..67435a2
--- /dev/null
+++ b/DSL/Util.hs
@@ -0,0 +1,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"
+