diff options
Diffstat (limited to 'Intermediate.hs')
| -rw-r--r-- | Intermediate.hs | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/Intermediate.hs b/Intermediate.hs new file mode 100644 index 0000000..5f3a9f2 --- /dev/null +++ b/Intermediate.hs @@ -0,0 +1,174 @@ +module Intermediate where + +import Data.Bits +import Data.List + +import AST +import Defs +import Pretty + + +data BB = BB Id [IRIns] IRTerm + deriving (Show, Eq) + +data Ref = Temp Size Int | Argument Size Name | Global Size Name | Constant Size Value + deriving (Show, Eq, Ord) + +data IRProgram = IRProgram [DVar] [IRFunc] + deriving (Show, Eq) + +data IRFunc = IRFunc (Maybe Type) Name [(Type, Name)] [BB] Id + deriving (Show, Eq) + +data IRIns + = IMov Ref Ref + | IStore Ref Ref + | ILoad Ref Ref + | IAri ArithType Ref Ref + | ICall Name [Ref] + | ICallr Ref Name [Ref] + | IResize Ref Ref + | INop + deriving (Show, Eq) + +data IRTerm + = IJcc CmpType Ref Ref Id Id -- Id Id == if-yes if-no + | IJmp Id + | IRet + | IRetr Ref + | ITermNone + deriving (Show, Eq) + +data ArithType + = AAdd | ASub | AMul | ADiv | AMod + | AAnd | AOr | AXor + | AEq | ANeq | AGt | ALt | AGeq | ALeq + deriving (Show, Eq) + +data CmpType + = CEq | CNeq | CGt | CLt | CGeq | CLeq + deriving (Show, Eq) + + +refSize :: Ref -> Size +refSize (Temp sz _) = sz +refSize (Argument sz _) = sz +refSize (Global sz _) = sz +refSize (Constant sz _) = sz + + +instance Pretty BB where + prettyI i (BB bid inss term) = + "{{{(" ++ show bid ++ ")\n" ++ indent (i+1) ++ + intercalate ("\n" ++ indent (i+1)) (map pretty inss) ++ + (if null inss then "" else "\n" ++ indent (i+1)) ++ + pretty term ++ + "\n" ++ indent i ++ "}}}" + where + indent n = replicate (2*n) ' ' + +instance Pretty Ref where + prettyI _ (Temp sz k) = "t" ++ show k ++ pretty_sizeSuffix sz + prettyI _ (Argument sz n) = "a" ++ n ++ pretty_sizeSuffix sz + prettyI _ (Global sz n) = "g" ++ n ++ pretty_sizeSuffix sz + prettyI _ (Constant sz n) = show n ++ pretty_sizeSuffix sz + +pretty_sizeSuffix :: Size -> String +pretty_sizeSuffix 1 = "B" +pretty_sizeSuffix 2 = "W" +pretty_sizeSuffix 4 = "D" +pretty_sizeSuffix 8 = "Q" +pretty_sizeSuffix sz = "<" ++ show sz ++ ">" + +instance Pretty IRProgram where + prettyI i (IRProgram vars funcs) = + intercalate ("\n" ++ indent i) (map (prettyI i) vars) ++ + "\n" ++ indent i ++ + intercalate ("\n" ++ indent i) (map (prettyI (i+1)) funcs) ++ + "\n" + where + indent n = replicate (2*n) ' ' + +instance Pretty IRFunc where + prettyI i (IRFunc mt n al bbs sid) = + "irfunc" ++ maybe "" ((' ' :) . prettyI i) mt ++ " " ++ n ++ "(" ++ + intercalate "," + (map (\(at,an) -> prettyI i at ++ " " ++ an) al) ++ + ")\n" ++ indent i ++ + intercalate ("\n" ++ indent i) (map (prettyI i) sorted) + where + indent n' = replicate (2*n') ' ' + + sorted = uncurry (++) $ partition (\(BB bid _ _) -> bid == sid) bbs + +instance Pretty IRIns where + prettyI _ (IMov d s) = "mov " ++ pretty d ++ " <- " ++ pretty s + prettyI _ (IStore d s) = "store *" ++ pretty d ++ " <- " ++ pretty s + prettyI _ (ILoad d s) = "load " ++ pretty d ++ " <- *" ++ pretty s + prettyI _ (IAri at d s) = + pretty at ++ " " ++ pretty d ++ ", " ++ pretty s + prettyI _ (ICall n al) = + "call " ++ n ++ " (" ++ intercalate ", " (map pretty al) ++ ")" + prettyI _ (ICallr d n al) = + "call " ++ pretty d ++ " <- " ++ n ++ " (" ++ intercalate ", " (map pretty al) ++ ")" + prettyI _ (IResize d s) = "resize " ++ pretty d ++ " <- " ++ pretty s + prettyI _ INop = "nop" + +instance Pretty IRTerm where + prettyI _ (IJcc ct s1 s2 did1 did2) = + pretty ct ++ " " ++ pretty s1 ++ ", " ++ pretty s2 ++ " -> " ++ show did1 ++ " | " ++ show did2 + prettyI _ (IJmp did) = "jmp " ++ show did + prettyI _ IRet = "ret" + prettyI _ (IRetr ref) = "retr " ++ pretty ref + prettyI _ ITermNone = "?NONE?" + +instance Pretty ArithType where + prettyI _ AAdd = "add" + prettyI _ ASub = "sub" + prettyI _ AMul = "mul" + prettyI _ ADiv = "div" + prettyI _ AMod = "mod" + prettyI _ AAnd = "and" + prettyI _ AOr = "or" + prettyI _ AXor = "xor" + prettyI _ AEq = "eq" + prettyI _ ANeq = "neq" + prettyI _ AGt = "gt" + prettyI _ ALt = "lt" + prettyI _ AGeq = "geq" + prettyI _ ALeq = "leq" + +instance Pretty CmpType where + prettyI _ CEq = "jeq" + prettyI _ CNeq = "jne" + prettyI _ CGt = "jg" + prettyI _ CLt = "jl" + prettyI _ CGeq = "jge" + prettyI _ CLeq = "jle" + + +evaluateArith :: ArithType -> Value -> Value -> Value +evaluateArith at a b = case at of + AAdd -> a + b + ASub -> a - b + AMul -> a * b + ADiv -> if b == 0 then error "Division by zero detected" else a `div` b + AMod -> if b == 0 then error "Modulo by zero detected" else a `mod` b + AAnd -> a .&. b + AOr -> a .|. b + AXor -> a `xor` b + AEq -> if a == b then 1 else 0 + ANeq -> if a /= b then 1 else 0 + AGt -> if a > b then 1 else 0 + ALt -> if a < b then 1 else 0 + AGeq -> if a >= b then 1 else 0 + ALeq -> if a <= b then 1 else 0 + +evaluateCmp :: CmpType -> Value -> Value -> Bool +evaluateCmp ct a b = case ct of + CEq -> a == b + CNeq -> a /= b + CGt -> a > b + CLt -> a < b + CGeq -> a >= b + CLeq -> a <= b |