From b83325c4b5c324a42acfe366cf58b455f8aa941f Mon Sep 17 00:00:00 2001
From: Matthew Hall <hallmatthew314@gmail.com>
Date: Thu, 16 Feb 2023 23:05:24 +1300
Subject: Big file-structure refactor

---
 DSL/Util.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 DSL/Util.hs

(limited to 'DSL/Util.hs')

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"
+
-- 
cgit v1.2.1