content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  Core.Lang
  -- Copyright   :  (c) Luigi D. C. Soares 2020
  -- License     :  GPL-3
  --
  -- Maintainer  :  luigidcsoares@gmail.com
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- This module contains the definition of the language.
  ----------------------------------------------------------------------------
  module Core.Lang
      ( Label
      , Const
      , Var
      , Value(..)
      , Expr(..)
      , Inst(..)
      , Stm
      , Prog
      , IVar(..)
      , isControl
      , labelFrom
      , showStm
      , showProg
      , prefix
      , next
      , defs
      )
  where
  
  import           Prelude                 hiding ( and )
  import           Data.List                      ( transpose )
  
  type Label = String
  type Const = Integer
  type Var = String
  
  data Value = Const Const | Var Var deriving (Eq, Ord)
  instance Show Value where
      show (Const n) = show n
      show (Var   x) = x
  
  data Expr = Value Value
            | Neg Value
            | Not Value
            | BitNot Value
            | Value :+: Value
            | Value :-: Value
            | Value :*: Value
            | Value :&: Value
            | Value :|: Value
            | Value :>>: Value
            | Value :<<: Value
            | Value :=: Value
            | Value :!=: Value
            | Value :<: Value
            | Value :>: Value
            | Value :<=: Value
            | Value :>=: Value
            deriving (Eq, Ord)
  
  instance Show Expr where
      show (Value  v  ) = show v
      show (Neg    v  ) = "-" ++ show v
      show (Not    v  ) = "!" ++ show v
      show (BitNot v  ) = "~" ++ show v
      show (v1 :+:  v2) = show v1 ++ " + " ++ show v2
      show (v1 :-:  v2) = show v1 ++ " - " ++ show v2
      show (v1 :*:  v2) = show v1 ++ " * " ++ show v2
      show (v1 :&:  v2) = show v1 ++ " & " ++ show v2
      show (v1 :|:  v2) = show v1 ++ " | " ++ show v2
      show (v1 :>>: v2) = show v1 ++ " >> " ++ show v2
      show (v1 :<<: v2) = show v1 ++ " << " ++ show v2
      show (v1 :=:  v2) = show v1 ++ " = " ++ show v2
      show (v1 :!=: v2) = show v1 ++ " != " ++ show v2
      show (v1 :<:  v2) = show v1 ++ " < " ++ show v2
      show (v1 :>:  v2) = show v1 ++ " > " ++ show v2
      show (v1 :<=: v2) = show v1 ++ " <= " ++ show v2
      show (v1 :>=: v2) = show v1 ++ " >= " ++ show v2
  
  data Inst = Alloc Var Expr
            | Mov Var Expr
            | Load Var Var Value
            | Store Value Var Value
            | Phi  Var [(Label, Value)]
            | Jmp  Label
            | Br  Value Label Label
            | Out Expr
            deriving (Eq, Ord)
  
  instance Show Inst where
      show (Alloc x e   ) = "alloc(" ++ x ++ ", " ++ show e ++ ")"
      show (Mov   x e   ) = "mov(" ++ x ++ ", " ++ show e ++ ")"
      show (Load x m idx) = "load(" ++ x ++ ", " ++ m ++ ", " ++ show idx ++ ")"
      show (Store v m idx) =
          "store(" ++ show v ++ ", " ++ m ++ ", " ++ show idx ++ ")"
      show (Phi x selectors) =
          "phi(" ++ x ++ ", " ++ showSelectors selectors ++ ")"
        where
          showSelectors :: [(Label, Value)] -> String
          showSelectors [(l, v)] = show v ++ ": " ++ l
          showSelectors ((l, v) : selectors) =
              show v ++ ": " ++ l ++ ", " ++ showSelectors selectors
      show (Jmp l     ) = "jmp(" ++ l ++ ")"
      show (Br e l1 l2) = "br(" ++ show e ++ ", " ++ l1 ++ ", " ++ l2 ++ ")"
      show (Out e     ) = "out(" ++ show e ++ ")"
  
  type Stm = (Maybe Label, Inst)
  type Prog = [Stm]
  
  -- | Implicit var, generated by the interpreter.
  newtype IVar = IVar Int deriving Eq
  instance Show IVar where
      show (IVar n) = prefix ++ show n
  
  isControl :: Inst -> Bool
  isControl i@Jmp{} = True
  isControl i@Br{}  = True
  isControl _       = False
  
  labelFrom :: [Inst] -> [Label]
  labelFrom []                  = []
  labelFrom ((Jmp l     ) : is) = l : labelFrom is
  labelFrom ((Br _ l1 l2) : is) = l1 : l2 : labelFrom is
  labelFrom (_            : is) = labelFrom is
  
  showStm :: Stm -> String
  showStm (Nothing, i) = show i ++ "\n"
  showStm (Just l , i) = l ++ ": " ++ show i ++ "\n"
  
  showProg :: Prog -> String
  showProg = concatMap showStm
  
  -- | Prefix added to labels/vars generated by the interpreter.
  prefix :: String
  prefix = "%"
  
  next :: IVar -> IVar
  next (IVar t) = IVar $ t + 1
  
  -- | The set of variables defined by a list of instructions.
  defs :: [Inst] -> [Value]
  defs []                 = []
  defs (Alloc id _  : is) = Var id : defs is
  defs (Mov   id _  : is) = Var id : defs is
  defs (Load id _ _ : is) = Var id : defs is
  defs (Phi id _    : is) = Var id : defs is
  defs (_           : is) = defs is
  