module DSL.Types where

import DSL.BaseParsers (Parser(..))

data StackData
  = StackInt Integer
  | StackBool Bool
  | StackString String
    deriving (Eq)

instance Show StackData where
  show (StackInt x)      = show x
  show (StackBool True)  = "true"
  show (StackBool False) = "false"
  show (StackString s)   = show s

type TypeCheck = StackData -> Bool

type Stack = [StackData]

data Intrinsic
  -- core stack operations
  = I_DUMP
  | I_DROP
  | I_SWAP
  | I_DUP
  | I_OVER
  | I_ROT
  -- core arithmetic operations
  | I_PLUS
  | I_MINUS
  | I_TIMES
  | I_DIVMOD
  -- core boolean operations
  | I_NOT
  | I_AND
  | I_OR
  | I_XOR
  -- core string operations
  | I_STRCAT
  -- core logical operations
  | I_EQUAL
  | I_LESSTHAN
  | I_GREATERTHAN
    deriving (Show, Eq)

type ProcName = String

data Operation
  = OpPushData StackData
  | OpIntrinsic Intrinsic
  | OpCall ProcName
    deriving (Show)

data StackModifier = StackModifier { smName :: String
                                   , smTypes :: [TypeCheck]
                                   , smFunc :: Stack -> IO Stack
                                   }

data Block
  = BLinear [Operation]
  | BIf [Block] [Block] [Block]
  | BWhile [Block] [Block]
    deriving (Show)

type ProcSpec = (ProcName, [Block])

type Program = [Block]

data Machine = Machine { ok :: Bool
                       , stack :: Stack
                       , pTable :: [(ProcName, [Block])]
                       }

data TokenTag
  = T_WHITESPACE
  | T_COMMENT
  | T_PROC
  | T_IF
  | T_ELIF
  | T_ELSE
  | T_WHILE
  | T_DO
  | T_END
  | T_INT_LITERAL
  | T_BOOL_LITERAL
  | T_STRING_LITERAL
  | T_INTRINSIC Intrinsic
  | T_IDENTIFIER
    deriving (Show, Eq)

data Token = Token { tStr :: String -- original text
                   , tTag :: TokenTag -- actual data
                   } deriving (Show)

type DSLLexer  = Parser Char Token
type DSLParser = Parser Token