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"