1 files changed, 95 insertions, 0 deletions
diff --git a/Intermediate.hs b/Intermediate.hs
new file mode 100644
index 0000000..c72e81c
--- /dev/null
+++ b/Intermediate.hs
@@ -0,0 +1,95 @@
+module Intermediate where
+
+import Data.List
+import qualified Data.Map.Strict as Map
+
+import AST
+
+
+data IRProgram =
+    IRProgram [BB]
+              (Map.Map Name GlobFuncDef)
+              [Value]  -- data table
+
+data GlobFuncDef =
+    GlobFuncDef Int  -- BB id of implementation
+                Int  -- number of arguments
+                [Name]  -- closure slots
+
+data BB = BB Int [Instruction] Terminator
+
+type Instruction = (Ref, InsCode)
+
+data Ref
+    = RConst Int
+    | RTemp Int
+    | RSClo Name  -- static closure object of a function
+    | RNone
+  deriving Eq
+
+data InsCode
+    = IAssign Ref
+    | IParam Int
+    | IClosure Int
+    | IData Int
+    | ICallC Ref [Ref]
+    | IAllocClo Name [Ref]
+    | IDiscard Ref
+  deriving Eq
+
+data Terminator
+    = IBr Ref Int Int
+    | IJmp Int
+    | IRet Ref
+    | IExit
+    | IUnknown
+  deriving Eq
+
+
+bidOf :: BB -> Int
+bidOf (BB i _ _) = i
+
+termOf :: BB -> Terminator
+termOf (BB _ _ t) = t
+
+
+instance Show IRProgram where
+    show (IRProgram bbs gfds datas) = intercalate "\n" $
+        ["IRPROGRAM", "Data Table:"] ++ map (("- " ++) . show) datas ++
+        ["Global functions:"] ++ map (\(n, gfd) -> "- " ++ n ++ ": " ++ show gfd) (Map.assocs gfds) ++
+        ["Blocks:"] ++ [intercalate "\n" (map show bbs)]
+
+instance Show GlobFuncDef where
+    show (GlobFuncDef bbid na []) = "BB " ++ show bbid ++ " (" ++ show na ++ ")"
+    show (GlobFuncDef bbid na cs) =
+        "BB " ++ show bbid ++ " (" ++ show na ++ ") (closure slots: " ++ intercalate ", " cs ++ ")"
+
+instance Show BB where
+    show (BB i inss term) =
+        "BB " ++ show i ++
+        concatMap (\(r, ic) -> case r of
+            RNone -> "\n  " ++ show ic
+            _ -> "\n  " ++ show r ++ " <- " ++ show ic) inss ++
+        "\n  " ++ show term
+
+instance Show Ref where
+    show (RConst n) = show n
+    show (RTemp n) = "t" ++ show n
+    show (RSClo name) = "SC(\"" ++ name ++ "\")"
+    show RNone = "<<NONE>>"
+
+instance Show InsCode where
+    show (IAssign r) = "assign " ++ show r
+    show (IParam n) = "param " ++ show n
+    show (IClosure n) = "closure " ++ show n
+    show (IData n) = "data " ++ show n
+    show (ICallC r as) = "callc " ++ show r ++ " " ++ show as
+    show (IAllocClo name vs) = "alloc-closure \"" ++ name ++ "\" " ++ show vs
+    show (IDiscard r) = "discard " ++ show r
+
+instance Show Terminator where
+    show (IBr r b1 b2) = "br " ++ show r ++ " " ++ show b1 ++ " " ++ show b2
+    show (IJmp b) = "jmp " ++ show b
+    show (IRet r) = "ret " ++ show r
+    show IExit = "exit"
+    show IUnknown = "<<UNKNOWN>>"