content: module PGF.ByteCode(Literal(..),
                      CodeLabel, Instr(..), IVal(..), TailInfo(..),
                      ppLit, ppCode, ppInstr
                     ) where
  import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
  import PGF.CId
  import Text.PrettyPrint
  
  data Literal =
     LStr String                      -- ^ string constant
   | LInt Int                         -- ^ integer constant
   | LFlt Double                      -- ^ floating point constant
   deriving (Eq,Ord,Show)
  
  type CodeLabel = Int
  
  data Instr
    = CHECK_ARGS {-# UNPACK #-} !Int
    | CASE CId  {-# UNPACK #-} !CodeLabel
    | CASE_LIT Literal  {-# UNPACK #-} !CodeLabel
    | SAVE {-# UNPACK #-} !Int
    | ALLOC  {-# UNPACK #-} !Int
    | PUT_CONSTR CId
    | PUT_CLOSURE   {-# UNPACK #-} !CodeLabel
    | PUT_LIT Literal
    | SET IVal
    | SET_PAD
    | PUSH_FRAME
    | PUSH IVal
    | TUCK IVal {-# UNPACK #-} !Int
    | EVAL IVal TailInfo
    | DROP {-# UNPACK #-} !Int
    | JUMP {-# UNPACK #-} !CodeLabel
    | FAIL
    | PUSH_ACCUM Literal
    | POP_ACCUM
    | ADD
  
  data IVal
    = HEAP     {-# UNPACK #-} !Int
    | ARG_VAR  {-# UNPACK #-} !Int
    | FREE_VAR {-# UNPACK #-} !Int
    | GLOBAL   CId
    deriving Eq
  
  data TailInfo
    = RecCall
    | TailCall {-# UNPACK #-} !Int
    | UpdateCall
  
  ppLit (LStr s) = text (show s)
  ppLit (LInt n) = int n
  ppLit (LFlt d) = double d
  
  ppCode :: Int -> [[Instr]] -> Doc
  ppCode l []       = empty
  ppCode l (is:iss) = ppLabel l <+> vcat (map ppInstr is) $$ ppCode (l+1) iss
  
  ppInstr (CHECK_ARGS    n) = text "CHECK_ARGS " <+> int n
  ppInstr (CASE id l      ) = text "CASE       " <+> ppCId id <+> ppLabel l
  ppInstr (CASE_LIT lit l ) = text "CASE_LIT   " <+> ppLit lit <+> ppLabel l
  ppInstr (SAVE          n) = text "SAVE       " <+> int n
  ppInstr (ALLOC         n) = text "ALLOC      " <+> int n
  ppInstr (PUT_CONSTR   id) = text "PUT_CONSTR " <+> ppCId id
  ppInstr (PUT_CLOSURE   l) = text "PUT_CLOSURE" <+> ppLabel l
  ppInstr (PUT_LIT lit    ) = text "PUT_LIT    " <+> ppLit lit
  ppInstr (SET           v) = text "SET        " <+> ppIVal v
  ppInstr (SET_PAD        ) = text "SET_PAD"
  ppInstr (PUSH_FRAME     ) = text "PUSH_FRAME"
  ppInstr (PUSH          v) = text "PUSH       " <+> ppIVal v
  ppInstr (EVAL       v ti) = text "EVAL       " <+> ppIVal v <+> ppTailInfo ti
  ppInstr (TUCK v n       ) = text "TUCK       " <+> ppIVal v <+> int n
  ppInstr (DROP n         ) = text "DROP       " <+> int n
  ppInstr (JUMP l         ) = text "JUMP       " <+> ppLabel l
  ppInstr (FAIL           ) = text "FAIL"
  ppInstr (PUSH_ACCUM  lit) = text "PUSH_ACCUM " <+> ppLit lit
  ppInstr (POP_ACCUM      ) = text "POP_ACCUM"
  ppInstr (ADD            ) = text "ADD"
  
  ppIVal (HEAP     n) = text "hp"  <> parens (int n)
  ppIVal (ARG_VAR  n) = text "stk" <> parens (int n)
  ppIVal (FREE_VAR n) = text "env" <> parens (int n)
  ppIVal (GLOBAL  id) = ppCId id
  
  ppTailInfo RecCall      = empty
  ppTailInfo (TailCall n) = text "tail" <> parens (int n)
  ppTailInfo UpdateCall   = text "update"
  
  ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)
  