{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Terminator
-- Copyright   : [2015..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module LLVM.AST.Type.Terminator
  where

import LLVM.AST.Type.Constant
import LLVM.AST.Type.Name
import LLVM.AST.Type.Operand
import LLVM.AST.Type.Downcast

import qualified LLVM.AST.Instruction                               as LLVM


-- | <http://llvm.org/docs/LangRef.html#terminators>
--
-- TLM: well, I don't think the types of these terminators make any sense. When
--      we branch, we are not propagating a particular value, just moving the
--      program counter, and anything we have declared already is available for
--      later computations. Maybe, we can make some of this explicit in the
--      @phi@ node?
--
data Terminator a where
  -- <http://llvm.org/docs/LangRef.html#ret-instruction>
  --
  Ret           :: Terminator ()

  -- <http://llvm.org/docs/LangRef.html#ret-instruction>
  --
  RetVal        :: Operand a
                -> Terminator a

  -- <http://llvm.org/docs/LangRef.html#br-instruction>
  --
  Br            :: Label
                -> Terminator ()

  -- <http://llvm.org/docs/LangRef.html#br-instruction>
  --
  CondBr        :: Operand Bool
                -> Label
                -> Label
                -> Terminator ()

  -- <http://llvm.org/docs/LangRef.html#switch-instruction>
  --
  Switch        :: Operand a
                -> Label
                -> [(Constant a, Label)]
                -> Terminator ()


-- | Convert to llvm-hs
--
instance Downcast (Terminator a) LLVM.Terminator where
  downcast :: Terminator a -> Terminator
downcast = \case
    Terminator a
Ret           -> Maybe Operand -> InstructionMetadata -> Terminator
LLVM.Ret Maybe Operand
forall a. Maybe a
Nothing InstructionMetadata
md
    RetVal Operand a
x      -> Maybe Operand -> InstructionMetadata -> Terminator
LLVM.Ret (Operand -> Maybe Operand
forall a. a -> Maybe a
Just (Operand a -> Operand
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Operand a
x)) InstructionMetadata
md
    Br Label
l          -> Name -> InstructionMetadata -> Terminator
LLVM.Br (Label -> Name
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Label
l) InstructionMetadata
md
    CondBr Operand Bool
p Label
t Label
f  -> Operand -> Name -> Name -> InstructionMetadata -> Terminator
LLVM.CondBr (Operand Bool -> Operand
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Operand Bool
p) (Label -> Name
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Label
t) (Label -> Name
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Label
f) InstructionMetadata
md
    Switch Operand a
p Label
d [(Constant a, Label)]
a  -> Operand
-> Name -> [(Constant, Name)] -> InstructionMetadata -> Terminator
LLVM.Switch (Operand a -> Operand
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Operand a
p) (Label -> Name
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Label
d) ([(Constant a, Label)] -> [(Constant, Name)]
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast [(Constant a, Label)]
a) InstructionMetadata
md
    where
      md :: LLVM.InstructionMetadata
      md :: InstructionMetadata
md = []