{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveAnyClass     #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Defines the target language for first-order L1 language with C code
-- generator for it.

module Gibbon.L4.Syntax
    ( Var, Tag, Tail(..), Triv(..), Ty(..), Prim(..), FunDecl(..)
    , Alts(..), Prog(..), MainExp(..), Label, SymTable
    , InfoTable, TyConInfo, DataConInfo(..)
    , L3.Scalar(..), mkScalar, scalarToTy

    -- * Utility functions
    , withTail, fromL3Ty, voidTy, inlineTrivL4, typeOfTriv
    ) where

import           Control.DeepSeq
import           Control.Monad.State.Strict
import           Data.Int
import           Data.Maybe
import qualified Data.Map as M
import           Data.Word (Word8, Word16)
import           GHC.Generics (Generic)
import           Prelude hiding (init)
import           Text.PrettyPrint.GenericPretty (Out (..))

import           Gibbon.Language (Tag, TyCon)
import           Gibbon.Common
import qualified Gibbon.Language  as L
import qualified Gibbon.L2.Syntax as L2
import qualified Gibbon.L3.Syntax as L3


--------------------------------------------------------------------------------
-- * AST definition

data Prog = Prog
  { Prog -> InfoTable
infoTable :: InfoTable
  , Prog -> SymTable
symbolTable :: SymTable
  , Prog -> [FunDecl]
fundefs     :: [FunDecl]
  , Prog -> Maybe MainExp
mainExp     :: Maybe MainExp
  } deriving (Int -> Prog -> ShowS
[Prog] -> ShowS
Prog -> String
(Int -> Prog -> ShowS)
-> (Prog -> String) -> ([Prog] -> ShowS) -> Show Prog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prog -> ShowS
showsPrec :: Int -> Prog -> ShowS
$cshow :: Prog -> String
show :: Prog -> String
$cshowList :: [Prog] -> ShowS
showList :: [Prog] -> ShowS
Show, Eq Prog
Eq Prog
-> (Prog -> Prog -> Ordering)
-> (Prog -> Prog -> Bool)
-> (Prog -> Prog -> Bool)
-> (Prog -> Prog -> Bool)
-> (Prog -> Prog -> Bool)
-> (Prog -> Prog -> Prog)
-> (Prog -> Prog -> Prog)
-> Ord Prog
Prog -> Prog -> Bool
Prog -> Prog -> Ordering
Prog -> Prog -> Prog
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Prog -> Prog -> Ordering
compare :: Prog -> Prog -> Ordering
$c< :: Prog -> Prog -> Bool
< :: Prog -> Prog -> Bool
$c<= :: Prog -> Prog -> Bool
<= :: Prog -> Prog -> Bool
$c> :: Prog -> Prog -> Bool
> :: Prog -> Prog -> Bool
$c>= :: Prog -> Prog -> Bool
>= :: Prog -> Prog -> Bool
$cmax :: Prog -> Prog -> Prog
max :: Prog -> Prog -> Prog
$cmin :: Prog -> Prog -> Prog
min :: Prog -> Prog -> Prog
Ord, Prog -> Prog -> Bool
(Prog -> Prog -> Bool) -> (Prog -> Prog -> Bool) -> Eq Prog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prog -> Prog -> Bool
== :: Prog -> Prog -> Bool
$c/= :: Prog -> Prog -> Bool
/= :: Prog -> Prog -> Bool
Eq, (forall x. Prog -> Rep Prog x)
-> (forall x. Rep Prog x -> Prog) -> Generic Prog
forall x. Rep Prog x -> Prog
forall x. Prog -> Rep Prog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prog -> Rep Prog x
from :: forall x. Prog -> Rep Prog x
$cto :: forall x. Rep Prog x -> Prog
to :: forall x. Rep Prog x -> Prog
Generic, Prog -> ()
(Prog -> ()) -> NFData Prog
forall a. (a -> ()) -> NFData a
$crnf :: Prog -> ()
rnf :: Prog -> ()
NFData, Int -> Prog -> Doc
[Prog] -> Doc
Prog -> Doc
(Int -> Prog -> Doc)
-> (Prog -> Doc) -> ([Prog] -> Doc) -> Out Prog
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Prog -> Doc
docPrec :: Int -> Prog -> Doc
$cdoc :: Prog -> Doc
doc :: Prog -> Doc
$cdocList :: [Prog] -> Doc
docList :: [Prog] -> Doc
Out)

data MainExp
  = PrintExp Tail
      -- ^ Evaluate the expression and print the result. Type of the
      -- expression must will eventually be anything, but not all
      -- types support printing currently [2017.01.03].

  deriving (Int -> MainExp -> ShowS
[MainExp] -> ShowS
MainExp -> String
(Int -> MainExp -> ShowS)
-> (MainExp -> String) -> ([MainExp] -> ShowS) -> Show MainExp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MainExp -> ShowS
showsPrec :: Int -> MainExp -> ShowS
$cshow :: MainExp -> String
show :: MainExp -> String
$cshowList :: [MainExp] -> ShowS
showList :: [MainExp] -> ShowS
Show, Eq MainExp
Eq MainExp
-> (MainExp -> MainExp -> Ordering)
-> (MainExp -> MainExp -> Bool)
-> (MainExp -> MainExp -> Bool)
-> (MainExp -> MainExp -> Bool)
-> (MainExp -> MainExp -> Bool)
-> (MainExp -> MainExp -> MainExp)
-> (MainExp -> MainExp -> MainExp)
-> Ord MainExp
MainExp -> MainExp -> Bool
MainExp -> MainExp -> Ordering
MainExp -> MainExp -> MainExp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MainExp -> MainExp -> Ordering
compare :: MainExp -> MainExp -> Ordering
$c< :: MainExp -> MainExp -> Bool
< :: MainExp -> MainExp -> Bool
$c<= :: MainExp -> MainExp -> Bool
<= :: MainExp -> MainExp -> Bool
$c> :: MainExp -> MainExp -> Bool
> :: MainExp -> MainExp -> Bool
$c>= :: MainExp -> MainExp -> Bool
>= :: MainExp -> MainExp -> Bool
$cmax :: MainExp -> MainExp -> MainExp
max :: MainExp -> MainExp -> MainExp
$cmin :: MainExp -> MainExp -> MainExp
min :: MainExp -> MainExp -> MainExp
Ord, MainExp -> MainExp -> Bool
(MainExp -> MainExp -> Bool)
-> (MainExp -> MainExp -> Bool) -> Eq MainExp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MainExp -> MainExp -> Bool
== :: MainExp -> MainExp -> Bool
$c/= :: MainExp -> MainExp -> Bool
/= :: MainExp -> MainExp -> Bool
Eq, (forall x. MainExp -> Rep MainExp x)
-> (forall x. Rep MainExp x -> MainExp) -> Generic MainExp
forall x. Rep MainExp x -> MainExp
forall x. MainExp -> Rep MainExp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MainExp -> Rep MainExp x
from :: forall x. MainExp -> Rep MainExp x
$cto :: forall x. Rep MainExp x -> MainExp
to :: forall x. Rep MainExp x -> MainExp
Generic, MainExp -> ()
(MainExp -> ()) -> NFData MainExp
forall a. (a -> ()) -> NFData a
$crnf :: MainExp -> ()
rnf :: MainExp -> ()
NFData, Int -> MainExp -> Doc
[MainExp] -> Doc
MainExp -> Doc
(Int -> MainExp -> Doc)
-> (MainExp -> Doc) -> ([MainExp] -> Doc) -> Out MainExp
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> MainExp -> Doc
docPrec :: Int -> MainExp -> Doc
$cdoc :: MainExp -> Doc
doc :: MainExp -> Doc
$cdocList :: [MainExp] -> Doc
docList :: [MainExp] -> Doc
Out)

data Triv
    = VarTriv Var
    | IntTriv Int64
    | CharTriv Char
    | FloatTriv Double
    | BoolTriv Bool
    | TagTriv Tag
    | SymTriv Word16    -- ^ An index into the symbol table.
    | ProdTriv [Triv]   -- ^ Tuples
    | ProjTriv Int Triv -- ^ Projections
  deriving (Int -> Triv -> ShowS
[Triv] -> ShowS
Triv -> String
(Int -> Triv -> ShowS)
-> (Triv -> String) -> ([Triv] -> ShowS) -> Show Triv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Triv -> ShowS
showsPrec :: Int -> Triv -> ShowS
$cshow :: Triv -> String
show :: Triv -> String
$cshowList :: [Triv] -> ShowS
showList :: [Triv] -> ShowS
Show, Eq Triv
Eq Triv
-> (Triv -> Triv -> Ordering)
-> (Triv -> Triv -> Bool)
-> (Triv -> Triv -> Bool)
-> (Triv -> Triv -> Bool)
-> (Triv -> Triv -> Bool)
-> (Triv -> Triv -> Triv)
-> (Triv -> Triv -> Triv)
-> Ord Triv
Triv -> Triv -> Bool
Triv -> Triv -> Ordering
Triv -> Triv -> Triv
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Triv -> Triv -> Ordering
compare :: Triv -> Triv -> Ordering
$c< :: Triv -> Triv -> Bool
< :: Triv -> Triv -> Bool
$c<= :: Triv -> Triv -> Bool
<= :: Triv -> Triv -> Bool
$c> :: Triv -> Triv -> Bool
> :: Triv -> Triv -> Bool
$c>= :: Triv -> Triv -> Bool
>= :: Triv -> Triv -> Bool
$cmax :: Triv -> Triv -> Triv
max :: Triv -> Triv -> Triv
$cmin :: Triv -> Triv -> Triv
min :: Triv -> Triv -> Triv
Ord, Triv -> Triv -> Bool
(Triv -> Triv -> Bool) -> (Triv -> Triv -> Bool) -> Eq Triv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Triv -> Triv -> Bool
== :: Triv -> Triv -> Bool
$c/= :: Triv -> Triv -> Bool
/= :: Triv -> Triv -> Bool
Eq, (forall x. Triv -> Rep Triv x)
-> (forall x. Rep Triv x -> Triv) -> Generic Triv
forall x. Rep Triv x -> Triv
forall x. Triv -> Rep Triv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Triv -> Rep Triv x
from :: forall x. Triv -> Rep Triv x
$cto :: forall x. Rep Triv x -> Triv
to :: forall x. Rep Triv x -> Triv
Generic, Triv -> ()
(Triv -> ()) -> NFData Triv
forall a. (a -> ()) -> NFData a
$crnf :: Triv -> ()
rnf :: Triv -> ()
NFData, Int -> Triv -> Doc
[Triv] -> Doc
Triv -> Doc
(Int -> Triv -> Doc)
-> (Triv -> Doc) -> ([Triv] -> Doc) -> Out Triv
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Triv -> Doc
docPrec :: Int -> Triv -> Doc
$cdoc :: Triv -> Doc
doc :: Triv -> Doc
$cdocList :: [Triv] -> Doc
docList :: [Triv] -> Doc
Out)

typeOfTriv :: M.Map Var Ty -> Triv -> Ty
typeOfTriv :: Map Var Ty -> Triv -> Ty
typeOfTriv Map Var Ty
env Triv
trv =
  case Triv
trv of
    VarTriv Var
v   -> Map Var Ty
env Map Var Ty -> Var -> Ty
forall k a. Ord k => Map k a -> k -> a
M.! Var
v
    IntTriv{}   -> Ty
IntTy
    CharTriv{}  -> Ty
CharTy
    FloatTriv{} -> Ty
FloatTy
    BoolTriv{}  -> Ty
BoolTy
    TagTriv{}   -> Ty
TagTyPacked
    SymTriv{}   -> Ty
SymTy
    ProdTriv [Triv]
ts -> [Ty] -> Ty
ProdTy ((Triv -> Ty) -> [Triv] -> [Ty]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Ty -> Triv -> Ty
typeOfTriv Map Var Ty
env) [Triv]
ts)
    ProjTriv Int
i Triv
trv1 -> case Map Var Ty -> Triv -> Ty
typeOfTriv Map Var Ty
env Triv
trv1 of
                         ProdTy [Ty]
tys -> [Ty]
tys [Ty] -> Int -> Ty
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
                         Ty
ty -> String -> Ty
forall a. HasCallStack => String -> a
error (String -> Ty) -> String -> Ty
forall a b. (a -> b) -> a -> b
$ String
"typeOfTriv: expected ProdTy, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ty -> String
forall a. Out a => a -> String
sdoc Ty
ty

-- | Switch alternatives.
data Alts
  = TagAlts [(Tag, Tail)]
      -- ^ Casing on tags.
  | IntAlts [(Int64, Tail)]
      -- ^ Casing on integers.
  deriving (Int -> Alts -> ShowS
[Alts] -> ShowS
Alts -> String
(Int -> Alts -> ShowS)
-> (Alts -> String) -> ([Alts] -> ShowS) -> Show Alts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alts -> ShowS
showsPrec :: Int -> Alts -> ShowS
$cshow :: Alts -> String
show :: Alts -> String
$cshowList :: [Alts] -> ShowS
showList :: [Alts] -> ShowS
Show, Eq Alts
Eq Alts
-> (Alts -> Alts -> Ordering)
-> (Alts -> Alts -> Bool)
-> (Alts -> Alts -> Bool)
-> (Alts -> Alts -> Bool)
-> (Alts -> Alts -> Bool)
-> (Alts -> Alts -> Alts)
-> (Alts -> Alts -> Alts)
-> Ord Alts
Alts -> Alts -> Bool
Alts -> Alts -> Ordering
Alts -> Alts -> Alts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Alts -> Alts -> Ordering
compare :: Alts -> Alts -> Ordering
$c< :: Alts -> Alts -> Bool
< :: Alts -> Alts -> Bool
$c<= :: Alts -> Alts -> Bool
<= :: Alts -> Alts -> Bool
$c> :: Alts -> Alts -> Bool
> :: Alts -> Alts -> Bool
$c>= :: Alts -> Alts -> Bool
>= :: Alts -> Alts -> Bool
$cmax :: Alts -> Alts -> Alts
max :: Alts -> Alts -> Alts
$cmin :: Alts -> Alts -> Alts
min :: Alts -> Alts -> Alts
Ord, Alts -> Alts -> Bool
(Alts -> Alts -> Bool) -> (Alts -> Alts -> Bool) -> Eq Alts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alts -> Alts -> Bool
== :: Alts -> Alts -> Bool
$c/= :: Alts -> Alts -> Bool
/= :: Alts -> Alts -> Bool
Eq, (forall x. Alts -> Rep Alts x)
-> (forall x. Rep Alts x -> Alts) -> Generic Alts
forall x. Rep Alts x -> Alts
forall x. Alts -> Rep Alts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Alts -> Rep Alts x
from :: forall x. Alts -> Rep Alts x
$cto :: forall x. Rep Alts x -> Alts
to :: forall x. Rep Alts x -> Alts
Generic, Alts -> ()
(Alts -> ()) -> NFData Alts
forall a. (a -> ()) -> NFData a
$crnf :: Alts -> ()
rnf :: Alts -> ()
NFData, Int -> Alts -> Doc
[Alts] -> Doc
Alts -> Doc
(Int -> Alts -> Doc)
-> (Alts -> Doc) -> ([Alts] -> Doc) -> Out Alts
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Alts -> Doc
docPrec :: Int -> Alts -> Doc
$cdoc :: Alts -> Doc
doc :: Alts -> Doc
$cdocList :: [Alts] -> Doc
docList :: [Alts] -> Doc
Out)

instance Out Int64 where
  doc :: Int64 -> Doc
doc Int64
w = Integer -> Doc
forall a. Out a => a -> Doc
doc (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
w :: Integer)
  docPrec :: Int -> Int64 -> Doc
docPrec Int
n Int64
w = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
w :: Integer)

instance Out Word8 where
  doc :: Tag -> Doc
doc Tag
w = Integer -> Doc
forall a. Out a => a -> Doc
doc (Tag -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tag
w :: Integer)
  docPrec :: Int -> Tag -> Doc
docPrec Int
n Tag
w = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Tag -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Tag
w :: Integer)

instance Out Word16 where
  doc :: Word16 -> Doc
doc Word16
w = Integer -> Doc
forall a. Out a => a -> Doc
doc (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w :: Integer)
  docPrec :: Int -> Word16 -> Doc
docPrec Int
n Word16
w = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w :: Integer)

type Label = Var

type SymTable = M.Map Word16 String

type InfoTable = (M.Map L.TyCon TyConInfo)
type TyConInfo = M.Map L.DataCon DataConInfo

data DataConInfo = DataConInfo
  { DataConInfo -> Tag
dcon_tag :: Tag
  , DataConInfo -> Int
scalar_bytes :: Int
  , DataConInfo -> Int
num_shortcut :: Int
  , DataConInfo -> Int
num_scalars :: Int
  , DataConInfo -> Int
num_packed :: Int
  , DataConInfo -> [Ty3]
field_tys :: [L3.Ty3]
  }
  deriving (Int -> DataConInfo -> ShowS
[DataConInfo] -> ShowS
DataConInfo -> String
(Int -> DataConInfo -> ShowS)
-> (DataConInfo -> String)
-> ([DataConInfo] -> ShowS)
-> Show DataConInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataConInfo -> ShowS
showsPrec :: Int -> DataConInfo -> ShowS
$cshow :: DataConInfo -> String
show :: DataConInfo -> String
$cshowList :: [DataConInfo] -> ShowS
showList :: [DataConInfo] -> ShowS
Show, Eq DataConInfo
Eq DataConInfo
-> (DataConInfo -> DataConInfo -> Ordering)
-> (DataConInfo -> DataConInfo -> Bool)
-> (DataConInfo -> DataConInfo -> Bool)
-> (DataConInfo -> DataConInfo -> Bool)
-> (DataConInfo -> DataConInfo -> Bool)
-> (DataConInfo -> DataConInfo -> DataConInfo)
-> (DataConInfo -> DataConInfo -> DataConInfo)
-> Ord DataConInfo
DataConInfo -> DataConInfo -> Bool
DataConInfo -> DataConInfo -> Ordering
DataConInfo -> DataConInfo -> DataConInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DataConInfo -> DataConInfo -> Ordering
compare :: DataConInfo -> DataConInfo -> Ordering
$c< :: DataConInfo -> DataConInfo -> Bool
< :: DataConInfo -> DataConInfo -> Bool
$c<= :: DataConInfo -> DataConInfo -> Bool
<= :: DataConInfo -> DataConInfo -> Bool
$c> :: DataConInfo -> DataConInfo -> Bool
> :: DataConInfo -> DataConInfo -> Bool
$c>= :: DataConInfo -> DataConInfo -> Bool
>= :: DataConInfo -> DataConInfo -> Bool
$cmax :: DataConInfo -> DataConInfo -> DataConInfo
max :: DataConInfo -> DataConInfo -> DataConInfo
$cmin :: DataConInfo -> DataConInfo -> DataConInfo
min :: DataConInfo -> DataConInfo -> DataConInfo
Ord, DataConInfo -> DataConInfo -> Bool
(DataConInfo -> DataConInfo -> Bool)
-> (DataConInfo -> DataConInfo -> Bool) -> Eq DataConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataConInfo -> DataConInfo -> Bool
== :: DataConInfo -> DataConInfo -> Bool
$c/= :: DataConInfo -> DataConInfo -> Bool
/= :: DataConInfo -> DataConInfo -> Bool
Eq, (forall x. DataConInfo -> Rep DataConInfo x)
-> (forall x. Rep DataConInfo x -> DataConInfo)
-> Generic DataConInfo
forall x. Rep DataConInfo x -> DataConInfo
forall x. DataConInfo -> Rep DataConInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataConInfo -> Rep DataConInfo x
from :: forall x. DataConInfo -> Rep DataConInfo x
$cto :: forall x. Rep DataConInfo x -> DataConInfo
to :: forall x. Rep DataConInfo x -> DataConInfo
Generic, DataConInfo -> ()
(DataConInfo -> ()) -> NFData DataConInfo
forall a. (a -> ()) -> NFData a
$crnf :: DataConInfo -> ()
rnf :: DataConInfo -> ()
NFData, Int -> DataConInfo -> Doc
[DataConInfo] -> Doc
DataConInfo -> Doc
(Int -> DataConInfo -> Doc)
-> (DataConInfo -> Doc)
-> ([DataConInfo] -> Doc)
-> Out DataConInfo
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> DataConInfo -> Doc
docPrec :: Int -> DataConInfo -> Doc
$cdoc :: DataConInfo -> Doc
doc :: DataConInfo -> Doc
$cdocList :: [DataConInfo] -> Doc
docList :: [DataConInfo] -> Doc
Out)

data Tail
    = RetValsT [Triv] -- ^ Only in tail position, for returning from a function.

    | EndOfMain -- ^ A marker for an end of the main expression.

    | AssnValsT { Tail -> [(Var, Ty, Triv)]
upd       :: [(Var,Ty,Triv)]
                , Tail -> Maybe Tail
bod_maybe :: Maybe Tail
                }

    -- ^ INTERNAL ONLY: used for assigning instead of returning.

    | LetCallT { Tail -> Bool
async :: Bool, -- ^ Whether this call should be executed asynchronously (cilk_spawn).
                 Tail -> [(Var, Ty)]
binds :: [(Var,Ty)],
                 Tail -> Var
rator :: Var,
                 Tail -> [Triv]
rands :: [Triv],
                 Tail -> Tail
bod   :: Tail }
    | LetPrimCallT { binds :: [(Var,Ty)],
                     Tail -> Prim
prim  :: Prim,
                     rands :: [Triv],
                     bod   :: Tail }

    -- Ugh, we should not strictly need this if we simplify everything in the right way:
    | LetTrivT { Tail -> (Var, Ty, Triv)
bnd :: (Var,Ty,Triv)
               , bod :: Tail }

    -- A control-flow join point; an If on the RHS of LeT:
    | LetIfT { binds :: [(Var,Ty)]
             , Tail -> (Triv, Tail, Tail)
ife :: (Triv,Tail,Tail)
             , bod :: Tail
             }

    | LetUnpackT { binds :: [(Var,Ty)]
                 , Tail -> Var
ptr :: Var -- ^ Var pointing to a PtrTy
                 , bod :: Tail }
    -- ^ Unpack a struct pointer (variable of PtrTy) into local fields.

    | LetAllocT { Tail -> Var
lhs  :: Var -- ^ Var to bind to PtrTy
                , Tail -> [(Ty, Triv)]
vals :: [(Ty,Triv)] -- ^ Fields of allocated struct
                , bod  :: Tail }
    -- ^ Allocate storage for a struct of the given type,
    --   Initialize all fields Return PtrTy.

    | LetAvailT { Tail -> [Var]
vars :: [Var]
                , bod :: Tail }

    | IfT { Tail -> Triv
tst  :: Triv,
            Tail -> Tail
con  :: Tail,
            Tail -> Tail
els  :: Tail }
    | ErrT String

    | LetTimedT { Tail -> Bool
isIter :: Bool   -- ^ Run the RHS multiple times, if true.
                , binds  :: [(Var,Ty)]
                , Tail -> Tail
timed  :: Tail
                , bod    :: Tail } -- ^ This is like a one-armed if.  It needs a struct return.

    | Switch Label Triv Alts (Maybe Tail) -- TODO: remove maybe on default case
    -- ^ For casing on numeric tags or integers.
    | TailCall Var [Triv]
    | Goto Label

    -- Allocate an arena for non-packed data
    | LetArenaT { lhs :: Var
                , bod  :: Tail
                }
  deriving (Int -> Tail -> ShowS
[Tail] -> ShowS
Tail -> String
(Int -> Tail -> ShowS)
-> (Tail -> String) -> ([Tail] -> ShowS) -> Show Tail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tail -> ShowS
showsPrec :: Int -> Tail -> ShowS
$cshow :: Tail -> String
show :: Tail -> String
$cshowList :: [Tail] -> ShowS
showList :: [Tail] -> ShowS
Show, Eq Tail
Eq Tail
-> (Tail -> Tail -> Ordering)
-> (Tail -> Tail -> Bool)
-> (Tail -> Tail -> Bool)
-> (Tail -> Tail -> Bool)
-> (Tail -> Tail -> Bool)
-> (Tail -> Tail -> Tail)
-> (Tail -> Tail -> Tail)
-> Ord Tail
Tail -> Tail -> Bool
Tail -> Tail -> Ordering
Tail -> Tail -> Tail
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tail -> Tail -> Ordering
compare :: Tail -> Tail -> Ordering
$c< :: Tail -> Tail -> Bool
< :: Tail -> Tail -> Bool
$c<= :: Tail -> Tail -> Bool
<= :: Tail -> Tail -> Bool
$c> :: Tail -> Tail -> Bool
> :: Tail -> Tail -> Bool
$c>= :: Tail -> Tail -> Bool
>= :: Tail -> Tail -> Bool
$cmax :: Tail -> Tail -> Tail
max :: Tail -> Tail -> Tail
$cmin :: Tail -> Tail -> Tail
min :: Tail -> Tail -> Tail
Ord, Tail -> Tail -> Bool
(Tail -> Tail -> Bool) -> (Tail -> Tail -> Bool) -> Eq Tail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tail -> Tail -> Bool
== :: Tail -> Tail -> Bool
$c/= :: Tail -> Tail -> Bool
/= :: Tail -> Tail -> Bool
Eq, (forall x. Tail -> Rep Tail x)
-> (forall x. Rep Tail x -> Tail) -> Generic Tail
forall x. Rep Tail x -> Tail
forall x. Tail -> Rep Tail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tail -> Rep Tail x
from :: forall x. Tail -> Rep Tail x
$cto :: forall x. Rep Tail x -> Tail
to :: forall x. Rep Tail x -> Tail
Generic, Tail -> ()
(Tail -> ()) -> NFData Tail
forall a. (a -> ()) -> NFData a
$crnf :: Tail -> ()
rnf :: Tail -> ()
NFData, Int -> Tail -> Doc
[Tail] -> Doc
Tail -> Doc
(Int -> Tail -> Doc)
-> (Tail -> Doc) -> ([Tail] -> Doc) -> Out Tail
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Tail -> Doc
docPrec :: Int -> Tail -> Doc
$cdoc :: Tail -> Doc
doc :: Tail -> Doc
$cdocList :: [Tail] -> Doc
docList :: [Tail] -> Doc
Out)

data Ty
    = IntTy        -- ^ 8 byte integers.
    | CharTy       -- ^ 4 byte characters.
    | FloatTy      -- ^ 8 byte floating point numbers
    | BoolTy       -- ^ 1 byte integers.
    | TagTyPacked  -- ^ A single byte / Word8.  Used in PACKED mode.
    | TagTyBoxed   -- ^ A tag used in the UNPACKED, boxed, pointer-based, graph-of-structs representation.
                   --   This can usually be the same as TagTy, but needn't necessarily be.

    | SymTy    -- ^ Symbols used in writing compiler passes.
               --   It's an alias for Int, an index into a symbol table.

    | CursorTy -- ^ A byte-indexing pointer.  This is always a pointer to a raw buffer of
               -- bytes that does not contain pointers.

    | PtrTy   -- ^ A machine word.  Same width as IntTy.  Untyped.
              -- This is a pointer to a struct value which may contain other pointers.
    | RegionTy -- ^ Region start and a refcount
    | ChunkTy  -- ^ Start and end pointers

-- TODO: Make Ptrs more type safe like this:
--    | StructPtrTy { fields :: [Ty] } -- ^ A pointer to a struct containing the given fields.

    | ProdTy [Ty]
    | SymDictTy Var Ty
      -- ^ We allow built-in dictionaries from symbols to a value type.
    | ArenaTy
    | PDictTy Ty Ty
    | VectorTy Ty
    | ListTy Ty
    | SymSetTy
    | SymHashTy
    | IntHashTy
  deriving (Int -> Ty -> ShowS
[Ty] -> ShowS
Ty -> String
(Int -> Ty -> ShowS)
-> (Ty -> String) -> ([Ty] -> ShowS) -> Show Ty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ty -> ShowS
showsPrec :: Int -> Ty -> ShowS
$cshow :: Ty -> String
show :: Ty -> String
$cshowList :: [Ty] -> ShowS
showList :: [Ty] -> ShowS
Show, Eq Ty
Eq Ty
-> (Ty -> Ty -> Ordering)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Ty)
-> (Ty -> Ty -> Ty)
-> Ord Ty
Ty -> Ty -> Bool
Ty -> Ty -> Ordering
Ty -> Ty -> Ty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ty -> Ty -> Ordering
compare :: Ty -> Ty -> Ordering
$c< :: Ty -> Ty -> Bool
< :: Ty -> Ty -> Bool
$c<= :: Ty -> Ty -> Bool
<= :: Ty -> Ty -> Bool
$c> :: Ty -> Ty -> Bool
> :: Ty -> Ty -> Bool
$c>= :: Ty -> Ty -> Bool
>= :: Ty -> Ty -> Bool
$cmax :: Ty -> Ty -> Ty
max :: Ty -> Ty -> Ty
$cmin :: Ty -> Ty -> Ty
min :: Ty -> Ty -> Ty
Ord, Ty -> Ty -> Bool
(Ty -> Ty -> Bool) -> (Ty -> Ty -> Bool) -> Eq Ty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ty -> Ty -> Bool
== :: Ty -> Ty -> Bool
$c/= :: Ty -> Ty -> Bool
/= :: Ty -> Ty -> Bool
Eq, (forall x. Ty -> Rep Ty x)
-> (forall x. Rep Ty x -> Ty) -> Generic Ty
forall x. Rep Ty x -> Ty
forall x. Ty -> Rep Ty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ty -> Rep Ty x
from :: forall x. Ty -> Rep Ty x
$cto :: forall x. Rep Ty x -> Ty
to :: forall x. Rep Ty x -> Ty
Generic, Ty -> ()
(Ty -> ()) -> NFData Ty
forall a. (a -> ()) -> NFData a
$crnf :: Ty -> ()
rnf :: Ty -> ()
NFData, Int -> Ty -> Doc
[Ty] -> Doc
Ty -> Doc
(Int -> Ty -> Doc) -> (Ty -> Doc) -> ([Ty] -> Doc) -> Out Ty
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Ty -> Doc
docPrec :: Int -> Ty -> Doc
$cdoc :: Ty -> Doc
doc :: Ty -> Doc
$cdocList :: [Ty] -> Doc
docList :: [Ty] -> Doc
Out)

data Prim
    = AddP | SubP | MulP
    | DivP | ModP
    | EqP | LtP | GtP | LtEqP | GtEqP
    | EqSymP
    | EqBenchProgP String
    | ExpP
    | RandP
    | FRandP
    | FSqrtP
    | FTanP
    | FloatToIntP
    | IntToFloatP
    | SizeParam
    | OrP | AndP
    | DictInsertP Ty -- ^ takes k,v,dict
    | DictLookupP Ty -- ^ takes k,dict, errors if absent
    | DictEmptyP Ty
    | DictHasKeyP Ty
    | SymSetEmpty
    | SymSetContains
    | SymSetInsert
    | SymHashEmpty
    | SymHashInsert
    | SymHashLookup
    | SymHashContains
    | IntHashEmpty
    | IntHashInsert
    | IntHashLookup
    -- Operations on vectors
    | VAllocP Ty
    | VFreeP Ty
    | VFree2P Ty
    | VLengthP Ty
    | VNthP Ty
    | VSliceP Ty
    | InplaceVUpdateP Ty
    | VConcatP Ty
    | VSortP Ty
    | InplaceVSortP Ty
    | VMergeP Ty
    -- Thread safe dictionaries
    | PDictAllocP  Ty Ty
    | PDictInsertP Ty Ty
    | PDictLookupP Ty Ty
    | PDictHasKeyP Ty Ty
    | PDictForkP Ty Ty
    | PDictJoinP Ty Ty
    -- Linked Lists.
    | LLAllocP Ty
    | LLIsEmptyP Ty
    | LLConsP Ty
    | LLHeadP Ty
    | LLTailP Ty
    | LLFreeP Ty
    | LLFree2P Ty
    | LLCopyP Ty

    | GetNumProcessors
    | ReadPackedFile (Maybe FilePath) TyCon
    | WritePackedFile FilePath TyCon
    | ReadArrayFile (Maybe (FilePath, Int)) Ty

    | NewBuffer L2.Multiplicity
    -- ^ Allocate a new buffer, return a cursor.

    | NewParBuffer L2.Multiplicity
    -- ^ Allocate a new buffer for parallel allocations, return a cursor.

    | ScopedBuffer L2.Multiplicity
    -- ^ Returns a pointer to a buffer, with the invariant that data written
    -- to this region is no longer used after the enclosing function returns.
    -- I.e. this can be stack allocated data.

    | ScopedParBuffer L2.Multiplicity
    -- ^ Like ScopedBuffer, but for parallel allocations.

    | EndOfBuffer L2.Multiplicity

    | MMapFileSize Var

    | ReadTag
    -- ^ Read one byte from the cursor and advance it.

    | WriteTag
    -- ^ Write a static tag value, takes a cursor to target.

    | TagCursor
    -- ^ Create a tagged a cursor

    | ReadTaggedCursor

    | WriteTaggedCursor

    | ReadCursor
    -- ^ Read and return a cursor

    | WriteCursor

    | ReadScalar L3.Scalar
    | WriteScalar L3.Scalar

    | ReadList
    | WriteList

    | ReadVector
    | WriteVector

    | BoundsCheck

    | IndirectionBarrier TyCon

    | BumpArenaRefCount

    | FreeBuffer

    | SizeOfPacked
    -- ^ Take start and end cursors and return size of data they represent
    -- This could be represented as (end - start) / (sizeof(Int))

    | SizeOfScalar
    -- ^ Takes in a variable, and returns an int, sizeof(var)

    | GetFirstWord -- ^ takes a PtrTy, returns IntTy containing the (first) word pointed to.

    | PrintInt    -- ^ Print an integer to stdout.
    | PrintChar   -- ^ Print a character to stdout.
    | PrintFloat  -- ^ Print a floating point number to stdout.
    | PrintBool   -- ^ Print a boolean to stdout.
    | PrintSym    -- ^ Fetch a symbol from the symbol table, and print it.
    | PrintString String -- ^ Print a constant string to stdout.
                         -- TODO: add string values to the language.
    | PrintRegionCount   -- ^ Call print_global_region_count() defined in the RTS.

    | ReadInt

    | ParSync          -- ^ cilk_sync
    | GetCilkWorkerNum -- ^ Runs  __cilkrts_get_worker_number()
    | IsBig

    | Gensym

    | FreeSymTable

    | SSPush SSModality TyCon
    | SSPop SSModality
    | Assert

  deriving (Int -> Prim -> ShowS
[Prim] -> ShowS
Prim -> String
(Int -> Prim -> ShowS)
-> (Prim -> String) -> ([Prim] -> ShowS) -> Show Prim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prim -> ShowS
showsPrec :: Int -> Prim -> ShowS
$cshow :: Prim -> String
show :: Prim -> String
$cshowList :: [Prim] -> ShowS
showList :: [Prim] -> ShowS
Show, Eq Prim
Eq Prim
-> (Prim -> Prim -> Ordering)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Bool)
-> (Prim -> Prim -> Prim)
-> (Prim -> Prim -> Prim)
-> Ord Prim
Prim -> Prim -> Bool
Prim -> Prim -> Ordering
Prim -> Prim -> Prim
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Prim -> Prim -> Ordering
compare :: Prim -> Prim -> Ordering
$c< :: Prim -> Prim -> Bool
< :: Prim -> Prim -> Bool
$c<= :: Prim -> Prim -> Bool
<= :: Prim -> Prim -> Bool
$c> :: Prim -> Prim -> Bool
> :: Prim -> Prim -> Bool
$c>= :: Prim -> Prim -> Bool
>= :: Prim -> Prim -> Bool
$cmax :: Prim -> Prim -> Prim
max :: Prim -> Prim -> Prim
$cmin :: Prim -> Prim -> Prim
min :: Prim -> Prim -> Prim
Ord, Prim -> Prim -> Bool
(Prim -> Prim -> Bool) -> (Prim -> Prim -> Bool) -> Eq Prim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prim -> Prim -> Bool
== :: Prim -> Prim -> Bool
$c/= :: Prim -> Prim -> Bool
/= :: Prim -> Prim -> Bool
Eq, (forall x. Prim -> Rep Prim x)
-> (forall x. Rep Prim x -> Prim) -> Generic Prim
forall x. Rep Prim x -> Prim
forall x. Prim -> Rep Prim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prim -> Rep Prim x
from :: forall x. Prim -> Rep Prim x
$cto :: forall x. Rep Prim x -> Prim
to :: forall x. Rep Prim x -> Prim
Generic, Prim -> ()
(Prim -> ()) -> NFData Prim
forall a. (a -> ()) -> NFData a
$crnf :: Prim -> ()
rnf :: Prim -> ()
NFData, Int -> Prim -> Doc
[Prim] -> Doc
Prim -> Doc
(Int -> Prim -> Doc)
-> (Prim -> Doc) -> ([Prim] -> Doc) -> Out Prim
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Prim -> Doc
docPrec :: Int -> Prim -> Doc
$cdoc :: Prim -> Doc
doc :: Prim -> Doc
$cdocList :: [Prim] -> Doc
docList :: [Prim] -> Doc
Out)

data FunDecl = FunDecl
  { FunDecl -> Var
funName  :: Var
  , FunDecl -> [(Var, Ty)]
funArgs  :: [(Var,Ty)]
  , FunDecl -> Ty
funRetTy :: Ty
  , FunDecl -> Tail
funBody  :: Tail
  , FunDecl -> Bool
isPure   :: Bool
  } deriving (Int -> FunDecl -> ShowS
[FunDecl] -> ShowS
FunDecl -> String
(Int -> FunDecl -> ShowS)
-> (FunDecl -> String) -> ([FunDecl] -> ShowS) -> Show FunDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunDecl -> ShowS
showsPrec :: Int -> FunDecl -> ShowS
$cshow :: FunDecl -> String
show :: FunDecl -> String
$cshowList :: [FunDecl] -> ShowS
showList :: [FunDecl] -> ShowS
Show, Eq FunDecl
Eq FunDecl
-> (FunDecl -> FunDecl -> Ordering)
-> (FunDecl -> FunDecl -> Bool)
-> (FunDecl -> FunDecl -> Bool)
-> (FunDecl -> FunDecl -> Bool)
-> (FunDecl -> FunDecl -> Bool)
-> (FunDecl -> FunDecl -> FunDecl)
-> (FunDecl -> FunDecl -> FunDecl)
-> Ord FunDecl
FunDecl -> FunDecl -> Bool
FunDecl -> FunDecl -> Ordering
FunDecl -> FunDecl -> FunDecl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunDecl -> FunDecl -> Ordering
compare :: FunDecl -> FunDecl -> Ordering
$c< :: FunDecl -> FunDecl -> Bool
< :: FunDecl -> FunDecl -> Bool
$c<= :: FunDecl -> FunDecl -> Bool
<= :: FunDecl -> FunDecl -> Bool
$c> :: FunDecl -> FunDecl -> Bool
> :: FunDecl -> FunDecl -> Bool
$c>= :: FunDecl -> FunDecl -> Bool
>= :: FunDecl -> FunDecl -> Bool
$cmax :: FunDecl -> FunDecl -> FunDecl
max :: FunDecl -> FunDecl -> FunDecl
$cmin :: FunDecl -> FunDecl -> FunDecl
min :: FunDecl -> FunDecl -> FunDecl
Ord, FunDecl -> FunDecl -> Bool
(FunDecl -> FunDecl -> Bool)
-> (FunDecl -> FunDecl -> Bool) -> Eq FunDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunDecl -> FunDecl -> Bool
== :: FunDecl -> FunDecl -> Bool
$c/= :: FunDecl -> FunDecl -> Bool
/= :: FunDecl -> FunDecl -> Bool
Eq, (forall x. FunDecl -> Rep FunDecl x)
-> (forall x. Rep FunDecl x -> FunDecl) -> Generic FunDecl
forall x. Rep FunDecl x -> FunDecl
forall x. FunDecl -> Rep FunDecl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunDecl -> Rep FunDecl x
from :: forall x. FunDecl -> Rep FunDecl x
$cto :: forall x. Rep FunDecl x -> FunDecl
to :: forall x. Rep FunDecl x -> FunDecl
Generic, FunDecl -> ()
(FunDecl -> ()) -> NFData FunDecl
forall a. (a -> ()) -> NFData a
$crnf :: FunDecl -> ()
rnf :: FunDecl -> ()
NFData, Int -> FunDecl -> Doc
[FunDecl] -> Doc
FunDecl -> Doc
(Int -> FunDecl -> Doc)
-> (FunDecl -> Doc) -> ([FunDecl] -> Doc) -> Out FunDecl
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> FunDecl -> Doc
docPrec :: Int -> FunDecl -> Doc
$cdoc :: FunDecl -> Doc
doc :: FunDecl -> Doc
$cdocList :: [FunDecl] -> Doc
docList :: [FunDecl] -> Doc
Out)

voidTy :: Ty
voidTy :: Ty
voidTy = [Ty] -> Ty
ProdTy []

mkScalar :: Ty -> L3.Scalar
mkScalar :: Ty -> Scalar
mkScalar Ty
IntTy  = Scalar
L3.IntS
mkScalar Ty
SymTy  = Scalar
L3.SymS
mkScalar Ty
BoolTy = Scalar
L3.BoolS
mkScalar Ty
ty = String -> Scalar
forall a. HasCallStack => String -> a
error (String -> Scalar) -> String -> Scalar
forall a b. (a -> b) -> a -> b
$ String
"mkScalar: Not a scalar type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ty -> String
forall a. Out a => a -> String
sdoc Ty
ty

scalarToTy :: L3.Scalar -> Ty
scalarToTy :: Scalar -> Ty
scalarToTy Scalar
L3.IntS  = Ty
IntTy
scalarToTy Scalar
L3.CharS = Ty
CharTy
scalarToTy Scalar
L3.SymS  = Ty
SymTy
scalarToTy Scalar
L3.BoolS = Ty
BoolTy
scalarToTy Scalar
L3.FloatS = Ty
FloatTy

-- | Extend the tail of a Tail.  Take the return values from a Tail
-- expression and do some more computation.
--
-- WARNING: presently this may invoke the given function more than
-- once and duplicate code.
withTail :: MonadState Int m => (Tail,Ty) -> ([Triv] -> Tail) -> m Tail
withTail :: forall (m :: * -> *).
MonadState Int m =>
(Tail, Ty) -> ([Triv] -> Tail) -> m Tail
withTail (Tail
tl0,Ty
retty) [Triv] -> Tail
fn =
  let go :: Tail -> m Tail
go Tail
x = (Tail, Ty) -> ([Triv] -> Tail) -> m Tail
forall (m :: * -> *).
MonadState Int m =>
(Tail, Ty) -> ([Triv] -> Tail) -> m Tail
withTail (Tail
x,Ty
retty) [Triv] -> Tail
fn in -- Warning: assumes same type.
  case Tail
tl0 of
    Goto{} -> Tail -> m Tail
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Tail
tl0
    EndOfMain{} -> Tail -> m Tail
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Tail
tl0
    RetValsT [Triv]
ls -> Tail -> m Tail
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tail -> m Tail) -> Tail -> m Tail
forall a b. (a -> b) -> a -> b
$ [Triv] -> Tail
fn [Triv]
ls
    (ErrT String
x)    -> Tail -> m Tail
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tail -> m Tail) -> Tail -> m Tail
forall a b. (a -> b) -> a -> b
$ String -> Tail
ErrT String
x
    (AssnValsT [(Var, Ty, Triv)]
_ Maybe Tail
_) -> String -> m Tail
forall a. HasCallStack => String -> a
error (String -> m Tail) -> String -> m Tail
forall a b. (a -> b) -> a -> b
$ String
"withTail: expected tail expression returning values, not: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Tail -> String
forall a. Show a => a -> String
show Tail
tl0
    (LetCallT { Bool
async :: Tail -> Bool
async :: Bool
async, [(Var, Ty)]
binds :: Tail -> [(Var, Ty)]
binds :: [(Var, Ty)]
binds, Var
rator :: Tail -> Var
rator :: Var
rator, [Triv]
rands :: Tail -> [Triv]
rands :: [Triv]
rands, Tail
bod :: Tail -> Tail
bod :: Tail
bod }) -> Bool -> [(Var, Ty)] -> Var -> [Triv] -> Tail -> Tail
LetCallT Bool
async [(Var, Ty)]
binds Var
rator [Triv]
rands (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetPrimCallT { [(Var, Ty)]
binds :: Tail -> [(Var, Ty)]
binds :: [(Var, Ty)]
binds, Prim
prim :: Tail -> Prim
prim :: Prim
prim, [Triv]
rands :: Tail -> [Triv]
rands :: [Triv]
rands, Tail
bod :: Tail -> Tail
bod :: Tail
bod }) -> [(Var, Ty)] -> Prim -> [Triv] -> Tail -> Tail
LetPrimCallT [(Var, Ty)]
binds Prim
prim [Triv]
rands (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetTrivT { (Var, Ty, Triv)
bnd :: Tail -> (Var, Ty, Triv)
bnd :: (Var, Ty, Triv)
bnd, Tail
bod :: Tail -> Tail
bod :: Tail
bod })                    -> (Var, Ty, Triv) -> Tail -> Tail
LetTrivT   (Var, Ty, Triv)
bnd                (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetIfT { [(Var, Ty)]
binds :: Tail -> [(Var, Ty)]
binds :: [(Var, Ty)]
binds, (Triv, Tail, Tail)
ife :: Tail -> (Triv, Tail, Tail)
ife :: (Triv, Tail, Tail)
ife, Tail
bod :: Tail -> Tail
bod :: Tail
bod })               -> [(Var, Ty)] -> (Triv, Tail, Tail) -> Tail -> Tail
LetIfT     [(Var, Ty)]
binds (Triv, Tail, Tail)
ife          (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetUnpackT { [(Var, Ty)]
binds :: Tail -> [(Var, Ty)]
binds :: [(Var, Ty)]
binds, Var
ptr :: Tail -> Var
ptr :: Var
ptr, Tail
bod :: Tail -> Tail
bod :: Tail
bod })           -> [(Var, Ty)] -> Var -> Tail -> Tail
LetUnpackT [(Var, Ty)]
binds Var
ptr          (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetAllocT { Var
lhs :: Tail -> Var
lhs :: Var
lhs, [(Ty, Triv)]
vals :: Tail -> [(Ty, Triv)]
vals :: [(Ty, Triv)]
vals, Tail
bod :: Tail -> Tail
bod :: Tail
bod })             -> Var -> [(Ty, Triv)] -> Tail -> Tail
LetAllocT  Var
lhs   [(Ty, Triv)]
vals         (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetTimedT { Bool
isIter :: Tail -> Bool
isIter :: Bool
isIter, [(Var, Ty)]
binds :: Tail -> [(Var, Ty)]
binds :: [(Var, Ty)]
binds, Tail
timed :: Tail -> Tail
timed :: Tail
timed, Tail
bod :: Tail -> Tail
bod :: Tail
bod })  -> Bool -> [(Var, Ty)] -> Tail -> Tail -> Tail
LetTimedT Bool
isIter [(Var, Ty)]
binds Tail
timed  (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetArenaT { Var
lhs :: Tail -> Var
lhs :: Var
lhs, Tail
bod :: Tail -> Tail
bod :: Tail
bod })                   -> Var -> Tail -> Tail
LetArenaT Var
lhs                 (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod
    (LetAvailT { [Var]
vars :: Tail -> [Var]
vars :: [Var]
vars, Tail
bod :: Tail -> Tail
bod :: Tail
bod })                  -> [Var] -> Tail -> Tail
LetAvailT [Var]
vars                (Tail -> Tail) -> m Tail -> m Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
bod

    -- We could DUPLICATE code in both branches or just let-bind the result instead:
    (IfT { Triv
tst :: Tail -> Triv
tst :: Triv
tst, Tail
con :: Tail -> Tail
con :: Tail
con, Tail
els :: Tail -> Tail
els :: Tail
els }) -> Triv -> Tail -> Tail -> Tail
IfT Triv
tst (Tail -> Tail -> Tail) -> m Tail -> m (Tail -> Tail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> m Tail
go Tail
con m (Tail -> Tail) -> m Tail -> m Tail
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tail -> m Tail
go Tail
els
        -- LetIfT _vr (tst,con,els)  $ fn [VarTriv _vr]

    -- Uh oh, here we don't have a LetSwitch form... duplicate code.
    (Switch Var
lbl Triv
trv Alts
alts Maybe Tail
mlast) -> Var -> Triv -> Alts -> Maybe Tail -> Tail
Switch Var
lbl Triv
trv (Alts -> Maybe Tail -> Tail) -> m Alts -> m (Maybe Tail -> Tail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tail -> m Tail) -> Alts -> m Alts
forall {f :: * -> *}. Monad f => (Tail -> f Tail) -> Alts -> f Alts
mapAltsM Tail -> m Tail
go Alts
alts m (Maybe Tail -> Tail) -> m (Maybe Tail) -> m Tail
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (m Tail) -> m (Maybe Tail)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence ((Tail -> m Tail) -> Maybe Tail -> Maybe (m Tail)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tail -> m Tail
go Maybe Tail
mlast)
    (TailCall Var
x1 [Triv]
x2)        -> do [(Var, Ty)]
bnds <- Ty -> m [(Var, Ty)]
forall {f :: * -> *}. MonadState Int f => Ty -> f [(Var, Ty)]
genTmps Ty
retty
                                  Tail -> m Tail
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tail -> m Tail) -> Tail -> m Tail
forall a b. (a -> b) -> a -> b
$ Bool -> [(Var, Ty)] -> Var -> [Triv] -> Tail -> Tail
LetCallT Bool
False [(Var, Ty)]
bnds Var
x1 [Triv]
x2 (Tail -> Tail) -> Tail -> Tail
forall a b. (a -> b) -> a -> b
$ [Triv] -> Tail
fn (((Var, Ty) -> Triv) -> [(Var, Ty)] -> [Triv]
forall a b. (a -> b) -> [a] -> [b]
map (Var -> Triv
VarTriv (Var -> Triv) -> ((Var, Ty) -> Var) -> (Var, Ty) -> Triv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, Ty) -> Var
forall a b. (a, b) -> a
fst) [(Var, Ty)]
bnds)
 where
   mapAltsM :: (Tail -> f Tail) -> Alts -> f Alts
mapAltsM Tail -> f Tail
f (TagAlts [(Tag, Tail)]
ls) = [(Tag, Tail)] -> Alts
TagAlts ([(Tag, Tail)] -> Alts) -> f [(Tag, Tail)] -> f Alts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Tag, Tail)] -> f [(Tag, Tail)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ (Tag
tg,) (Tail -> (Tag, Tail)) -> f Tail -> f (Tag, Tail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> f Tail
f Tail
tl | (Tag
tg,Tail
tl) <- [(Tag, Tail)]
ls ]
   mapAltsM Tail -> f Tail
f (IntAlts [(Int64, Tail)]
ls) = [(Int64, Tail)] -> Alts
IntAlts ([(Int64, Tail)] -> Alts) -> f [(Int64, Tail)] -> f Alts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Int64, Tail)] -> f [(Int64, Tail)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ (Int64
tg,) (Tail -> (Int64, Tail)) -> f Tail -> f (Int64, Tail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tail -> f Tail
f Tail
tl | (Int64
tg,Tail
tl) <- [(Int64, Tail)]
ls ]

   genTmps :: Ty -> f [(Var, Ty)]
genTmps (ProdTy [Ty]
ls) = ([Var] -> [Ty] -> [(Var, Ty)]) -> [Ty] -> [Var] -> [(Var, Ty)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Var] -> [Ty] -> [(Var, Ty)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty]
ls ([Var] -> [(Var, Ty)]) -> f [Var] -> f [(Var, Ty)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f Var] -> f [Var]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> f Var -> [f Var]
forall a. Int -> a -> [a]
replicate ([Ty] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ty]
ls) (Var -> f Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym (Var -> f Var) -> Var -> f Var
forall a b. (a -> b) -> a -> b
$ String -> Var
toVar String
"tctmp"))
   genTmps Ty
ty          = do Var
t <- Var -> f Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym (String -> Var
toVar String
"tctmp"); [(Var, Ty)] -> f [(Var, Ty)]
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Var
t,Ty
ty)]

fromL3Ty :: L3.Ty3 -> Ty
fromL3Ty :: Ty3 -> Ty
fromL3Ty Ty3
ty =
  case Ty3
ty of
    Ty3
L.IntTy   -> Ty
IntTy
    Ty3
L.CharTy  -> Ty
CharTy
    Ty3
L.FloatTy -> Ty
FloatTy
    Ty3
L.SymTy   -> Ty
SymTy
    Ty3
L.BoolTy  -> Ty
BoolTy
    L.ProdTy [Ty3]
tys -> [Ty] -> Ty
ProdTy ([Ty] -> Ty) -> [Ty] -> Ty
forall a b. (a -> b) -> a -> b
$ (Ty3 -> Ty) -> [Ty3] -> [Ty]
forall a b. (a -> b) -> [a] -> [b]
map Ty3 -> Ty
fromL3Ty [Ty3]
tys
    L.SymDictTy (Just Var
var) Ty3
t -> Var -> Ty -> Ty
SymDictTy Var
var (Ty -> Ty) -> Ty -> Ty
forall a b. (a -> b) -> a -> b
$ Ty3 -> Ty
fromL3Ty Ty3
t
    Ty3
L.ArenaTy    -> Ty
ArenaTy
    Ty3
L.PtrTy      -> Ty
PtrTy
    Ty3
L.CursorTy   -> Ty
CursorTy
    -- L.PackedTy{} -> error "fromL3Ty: Cannot convert PackedTy"
    L.VectorTy Ty3
el_ty  -> Ty -> Ty
VectorTy (Ty3 -> Ty
fromL3Ty Ty3
el_ty)
    Ty3
_ -> Ty
IntTy -- [2019.06.10]: CSK, Why do we need this?


inlineTrivL4 :: Prog -> Prog
inlineTrivL4 :: Prog -> Prog
inlineTrivL4 (Prog InfoTable
info_tbl SymTable
sym_tbl [FunDecl]
fundefs Maybe MainExp
mb_main) =
  InfoTable -> SymTable -> [FunDecl] -> Maybe MainExp -> Prog
Prog InfoTable
info_tbl SymTable
sym_tbl ((FunDecl -> FunDecl) -> [FunDecl] -> [FunDecl]
forall a b. (a -> b) -> [a] -> [b]
map FunDecl -> FunDecl
inline_fun [FunDecl]
fundefs) (MainExp -> MainExp
inline_main (MainExp -> MainExp) -> Maybe MainExp -> Maybe MainExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MainExp
mb_main)

  where
    inline_fun :: FunDecl -> FunDecl
inline_fun fn :: FunDecl
fn@FunDecl{Tail
funBody :: FunDecl -> Tail
funBody :: Tail
funBody} = FunDecl
fn { funBody :: Tail
funBody = Map Var Triv -> Tail -> Tail
inline_tail Map Var Triv
forall k a. Map k a
M.empty Tail
funBody }

    inline_main :: MainExp -> MainExp
inline_main (PrintExp Tail
bod) = Tail -> MainExp
PrintExp (Map Var Triv -> Tail -> Tail
inline_tail Map Var Triv
forall k a. Map k a
M.empty Tail
bod)

    inline_tail :: M.Map Var Triv -> Tail -> Tail
    inline_tail :: Map Var Triv -> Tail -> Tail
inline_tail Map Var Triv
env Tail
tl =
      case Tail
tl of
        Tail
EndOfMain                -> Tail
tl
        RetValsT [Triv]
trvs            -> [Triv] -> Tail
RetValsT ((Triv -> Triv) -> [Triv] -> [Triv]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env) [Triv]
trvs)
        AssnValsT [(Var, Ty, Triv)]
assns Maybe Tail
mb_bod   -> [(Var, Ty, Triv)] -> Maybe Tail -> Tail
AssnValsT
                                      (((Var, Ty, Triv) -> (Var, Ty, Triv))
-> [(Var, Ty, Triv)] -> [(Var, Ty, Triv)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
v,Ty
ty,Triv
trv) -> (Var
v,Ty
ty,Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
trv)) [(Var, Ty, Triv)]
assns)
                                      (Tail -> Tail
go (Tail -> Tail) -> Maybe Tail -> Maybe Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tail
mb_bod)
        LetCallT{[Triv]
rands :: Tail -> [Triv]
rands :: [Triv]
rands,Tail
bod :: Tail -> Tail
bod :: Tail
bod}      -> Tail
tl { rands :: [Triv]
rands = (Triv -> Triv) -> [Triv] -> [Triv]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env) [Triv]
rands
                                       , bod :: Tail
bod   = Tail -> Tail
go Tail
bod }
        LetPrimCallT{[Triv]
rands :: Tail -> [Triv]
rands :: [Triv]
rands,Tail
bod :: Tail -> Tail
bod :: Tail
bod}  -> Tail
tl { rands :: [Triv]
rands = (Triv -> Triv) -> [Triv] -> [Triv]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env) [Triv]
rands
                                       , bod :: Tail
bod   = Tail -> Tail
go Tail
bod }
        LetTrivT (Var
v,Ty
_ty,Triv
trv) Tail
bod ->
          case Triv
trv of
            VarTriv Var
w -> case Var -> Map Var Triv -> Maybe Triv
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
w Map Var Triv
env of
                           Maybe Triv
Nothing -> Map Var Triv -> Tail -> Tail
inline_tail (Var -> Triv -> Map Var Triv -> Map Var Triv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Triv
trv Map Var Triv
env) Tail
bod
                           Just Triv
pr -> Map Var Triv -> Tail -> Tail
inline_tail (Var -> Triv -> Map Var Triv -> Map Var Triv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Triv
pr Map Var Triv
env) Tail
bod
            Triv
_         -> Map Var Triv -> Tail -> Tail
inline_tail (Var -> Triv -> Map Var Triv -> Map Var Triv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Triv
trv Map Var Triv
env) Tail
bod
        LetIfT{(Triv, Tail, Tail)
ife :: Tail -> (Triv, Tail, Tail)
ife :: (Triv, Tail, Tail)
ife,Tail
bod :: Tail -> Tail
bod :: Tail
bod} -> Tail
tl { ife :: (Triv, Tail, Tail)
ife = (\(Triv
a,Tail
b,Tail
c) -> (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
a,
                                                    Tail -> Tail
go Tail
b,
                                                    Tail -> Tail
go Tail
c))
                                      (Triv, Tail, Tail)
ife
                              , bod :: Tail
bod = Tail -> Tail
go Tail
bod }
        LetUnpackT{Tail
bod :: Tail -> Tail
bod :: Tail
bod} -> Tail
tl { bod :: Tail
bod = Tail -> Tail
go Tail
bod }
        LetAllocT{[(Ty, Triv)]
vals :: Tail -> [(Ty, Triv)]
vals :: [(Ty, Triv)]
vals,Tail
bod :: Tail -> Tail
bod :: Tail
bod} -> Tail
tl { vals :: [(Ty, Triv)]
vals = ((Ty, Triv) -> (Ty, Triv)) -> [(Ty, Triv)] -> [(Ty, Triv)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ty
a,Triv
b) -> (Ty
a, Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
b)) [(Ty, Triv)]
vals
                                  , bod :: Tail
bod  = Tail -> Tail
go Tail
bod }
        LetAvailT{Tail
bod :: Tail -> Tail
bod :: Tail
bod}   -> Tail
tl { bod :: Tail
bod = Tail -> Tail
go Tail
bod }
        IfT{Triv
tst :: Tail -> Triv
tst :: Triv
tst,Tail
con :: Tail -> Tail
con :: Tail
con,Tail
els :: Tail -> Tail
els :: Tail
els} -> Triv -> Tail -> Tail -> Tail
IfT (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
tst) (Tail -> Tail
go Tail
con) (Tail -> Tail
go Tail
els)
        ErrT{} -> Tail
tl
        LetTimedT{Tail
timed :: Tail -> Tail
timed :: Tail
timed,Tail
bod :: Tail -> Tail
bod :: Tail
bod} -> Tail
tl { timed :: Tail
timed = Tail -> Tail
go Tail
timed
                                   , bod :: Tail
bod = Tail -> Tail
go Tail
bod }
        Switch Var
lbl Triv
trv Alts
alts Maybe Tail
mb_tail ->
          let alts' :: Alts
alts' = case Alts
alts of
                        TagAlts [(Tag, Tail)]
as -> [(Tag, Tail)] -> Alts
TagAlts ([(Tag, Tail)] -> Alts) -> [(Tag, Tail)] -> Alts
forall a b. (a -> b) -> a -> b
$ ((Tag, Tail) -> (Tag, Tail)) -> [(Tag, Tail)] -> [(Tag, Tail)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Tag
a,Tail
b) -> (Tag
a, Tail -> Tail
go Tail
b)) [(Tag, Tail)]
as
                        IntAlts [(Int64, Tail)]
as -> [(Int64, Tail)] -> Alts
IntAlts ([(Int64, Tail)] -> Alts) -> [(Int64, Tail)] -> Alts
forall a b. (a -> b) -> a -> b
$ ((Int64, Tail) -> (Int64, Tail))
-> [(Int64, Tail)] -> [(Int64, Tail)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int64
a,Tail
b) -> (Int64
a, Tail -> Tail
go Tail
b)) [(Int64, Tail)]
as
          in Var -> Triv -> Alts -> Maybe Tail -> Tail
Switch Var
lbl (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
trv) Alts
alts' (Tail -> Tail
go (Tail -> Tail) -> Maybe Tail -> Maybe Tail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tail
mb_tail)
        TailCall Var
v [Triv]
trvs -> Var -> [Triv] -> Tail
TailCall Var
v ((Triv -> Triv) -> [Triv] -> [Triv]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Triv -> Triv -> Triv
inline Map Var Triv
env) [Triv]
trvs)
        LetArenaT{Tail
bod :: Tail -> Tail
bod :: Tail
bod}  -> Tail
tl { bod :: Tail
bod = Tail -> Tail
go Tail
bod }
        Goto{}          -> Tail
tl
      where
        go :: Tail -> Tail
go = Map Var Triv -> Tail -> Tail
inline_tail Map Var Triv
env

    inline :: Map Var Triv -> Triv -> Triv
inline Map Var Triv
env Triv
trv =
      case Triv
trv of
        VarTriv Var
v -> case Var -> Map Var Triv -> Maybe Triv
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var Triv
env of
                       Just Triv
trv' -> Triv
trv'
                       Maybe Triv
_ -> Triv
trv
        Triv
_         -> Triv
trv