module DSL.Util where

import Data.Map.Strict (empty, member, insert, toList)

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 }

appendProcTable :: [ProcSpec] -> ProcTable -> Either String ProcTable
appendProcTable x y = go x
  where
    go []           = Right y
    go ((n, bs):ps) = go ps >>= f
      where
        f acc
          | member n acc = Left $ "Duplicate PROC definition: " ++ n
          | otherwise    = Right $ insert n bs acc

mergeProcTables :: ProcTable -> ProcTable -> Either String ProcTable
mergeProcTables x = appendProcTable $ toList x

buildProcTable :: [ProcSpec] -> Either String ProcTable
buildProcTable ps = appendProcTable ps empty

unreachable :: a
unreachable = error "This branch should be unreachable. If you can read this, something has gone EXTREMELY  wrong."