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>>"