{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE TemplateHaskell            #-}

module Gibbon.Language.Syntax
  (
    -- * Datatype definitions
    DDefs, DataCon, TyCon, Tag, IsBoxed, DDef(..)
  , lookupDDef, getConOrdering, getTyOfDataCon, lookupDataCon, lkp
  , lookupDataCon', insertDD, emptyDD, fromListDD, isVoidDDef

    -- * Function definitions
  , FunctionTy(..), FunDefs, FunDef(..), FunMeta(..), FunRec(..), FunInline(..)
  , insertFD, fromListFD, initFunEnv

    -- * Programs
  , Prog(..), progToEnv, getFunTy

    -- * Environments
  , TyEnv, Env2(..), emptyEnv2
  , extendVEnv, extendsVEnv, lookupVEnv, extendFEnv, lookupFEnv

    -- * Expresssions and thier types
  , PreExp(..), Prim(..), UrTy(..)

    -- * Functors for recursion-schemes
  , PreExpF(..), PrimF(..), UrTyF(..)

    -- * Generic operations
  , FreeVars(..), Expression(..), Binds, Flattenable(..)
  , Simplifiable(..), SimplifiableExt(..), Typeable(..)
  , Substitutable(..), SubstitutableExt(..), Renamable(..)

    -- * Helpers for writing instances
  , HasSimplifiable, HasSimplifiableExt, HasSubstitutable, HasSubstitutableExt
  , HasRenamable, HasOut, HasShow, HasEq, HasGeneric, HasNFData

  , -- * Interpreter
    Interp(..), InterpExt(..), InterpProg(..), Value(..), ValEnv, InterpLog,
    InterpM, runInterpM, execAndPrint

  ) where

import           Control.DeepSeq
import           Control.Monad.State
import           Control.Monad.Writer
#if !MIN_VERSION_base(4,13,0)
-- https://downloads.haskell.org/ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html
import           Control.Monad.Fail(MonadFail(..))
#endif
import qualified Data.Map as M
import qualified Data.List as L
import qualified Data.Set as S
import           Data.Word ( Word8 )
import           Data.Kind ( Type )
import           Text.PrettyPrint.GenericPretty
import           Data.Functor.Foldable.TH
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.ByteString.Builder (Builder)
import           System.IO.Unsafe (unsafePerformIO)

import           Gibbon.Common

--------------------------------------------------------------------------------
-- Data type definitions
--------------------------------------------------------------------------------

type DDefs a = M.Map Var (DDef a)

type DataCon = String
type TyCon   = String
type Tag     = Word8

type IsBoxed = Bool

-- | Data type definitions.
--
-- Monomorphism: In the extreme case we can strip packed datatypes of
-- all type parameters, or we can allow them to retain type params but
-- require that they always be fully instantiated to monomorphic types
-- in the context of our monomorphic programs.
--
-- Here we allow individual to be marked with whether or not they
-- should be boxed.  We say that a regular, pointer-based datatype has
-- all-boxed fields, whereas a fully serialized datatype has no boxed
-- fields.
data DDef a = DDef { forall a. DDef a -> Var
tyName   :: Var
                   , forall a. DDef a -> [TyVar]
tyArgs   :: [TyVar]
                   , forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons :: [(DataCon,[(IsBoxed,a)])] }
  deriving (ReadPrec [DDef a]
ReadPrec (DDef a)
Int -> ReadS (DDef a)
ReadS [DDef a]
(Int -> ReadS (DDef a))
-> ReadS [DDef a]
-> ReadPrec (DDef a)
-> ReadPrec [DDef a]
-> Read (DDef a)
forall a. Read a => ReadPrec [DDef a]
forall a. Read a => ReadPrec (DDef a)
forall a. Read a => Int -> ReadS (DDef a)
forall a. Read a => ReadS [DDef a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (DDef a)
readsPrec :: Int -> ReadS (DDef a)
$creadList :: forall a. Read a => ReadS [DDef a]
readList :: ReadS [DDef a]
$creadPrec :: forall a. Read a => ReadPrec (DDef a)
readPrec :: ReadPrec (DDef a)
$creadListPrec :: forall a. Read a => ReadPrec [DDef a]
readListPrec :: ReadPrec [DDef a]
Read, Int -> DDef a -> ShowS
[DDef a] -> ShowS
DDef a -> DataCon
(Int -> DDef a -> ShowS)
-> (DDef a -> DataCon) -> ([DDef a] -> ShowS) -> Show (DDef a)
forall a. Show a => Int -> DDef a -> ShowS
forall a. Show a => [DDef a] -> ShowS
forall a. Show a => DDef a -> DataCon
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> DDef a -> ShowS
showsPrec :: Int -> DDef a -> ShowS
$cshow :: forall a. Show a => DDef a -> DataCon
show :: DDef a -> DataCon
$cshowList :: forall a. Show a => [DDef a] -> ShowS
showList :: [DDef a] -> ShowS
Show, DDef a -> DDef a -> IsBoxed
(DDef a -> DDef a -> IsBoxed)
-> (DDef a -> DDef a -> IsBoxed) -> Eq (DDef a)
forall a. Eq a => DDef a -> DDef a -> IsBoxed
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: forall a. Eq a => DDef a -> DDef a -> IsBoxed
== :: DDef a -> DDef a -> IsBoxed
$c/= :: forall a. Eq a => DDef a -> DDef a -> IsBoxed
/= :: DDef a -> DDef a -> IsBoxed
Eq, Eq (DDef a)
Eq (DDef a)
-> (DDef a -> DDef a -> Ordering)
-> (DDef a -> DDef a -> IsBoxed)
-> (DDef a -> DDef a -> IsBoxed)
-> (DDef a -> DDef a -> IsBoxed)
-> (DDef a -> DDef a -> IsBoxed)
-> (DDef a -> DDef a -> DDef a)
-> (DDef a -> DDef a -> DDef a)
-> Ord (DDef a)
DDef a -> DDef a -> IsBoxed
DDef a -> DDef a -> Ordering
DDef a -> DDef a -> DDef a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (DDef a)
forall a. Ord a => DDef a -> DDef a -> IsBoxed
forall a. Ord a => DDef a -> DDef a -> Ordering
forall a. Ord a => DDef a -> DDef a -> DDef a
$ccompare :: forall a. Ord a => DDef a -> DDef a -> Ordering
compare :: DDef a -> DDef a -> Ordering
$c< :: forall a. Ord a => DDef a -> DDef a -> IsBoxed
< :: DDef a -> DDef a -> IsBoxed
$c<= :: forall a. Ord a => DDef a -> DDef a -> IsBoxed
<= :: DDef a -> DDef a -> IsBoxed
$c> :: forall a. Ord a => DDef a -> DDef a -> IsBoxed
> :: DDef a -> DDef a -> IsBoxed
$c>= :: forall a. Ord a => DDef a -> DDef a -> IsBoxed
>= :: DDef a -> DDef a -> IsBoxed
$cmax :: forall a. Ord a => DDef a -> DDef a -> DDef a
max :: DDef a -> DDef a -> DDef a
$cmin :: forall a. Ord a => DDef a -> DDef a -> DDef a
min :: DDef a -> DDef a -> DDef a
Ord, (forall a b. (a -> b) -> DDef a -> DDef b)
-> (forall a b. a -> DDef b -> DDef a) -> Functor DDef
forall a b. a -> DDef b -> DDef a
forall a b. (a -> b) -> DDef a -> DDef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DDef a -> DDef b
fmap :: forall a b. (a -> b) -> DDef a -> DDef b
$c<$ :: forall a b. a -> DDef b -> DDef a
<$ :: forall a b. a -> DDef b -> DDef a
Functor, (forall x. DDef a -> Rep (DDef a) x)
-> (forall x. Rep (DDef a) x -> DDef a) -> Generic (DDef a)
forall x. Rep (DDef a) x -> DDef a
forall x. DDef a -> Rep (DDef a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DDef a) x -> DDef a
forall a x. DDef a -> Rep (DDef a) x
$cfrom :: forall a x. DDef a -> Rep (DDef a) x
from :: forall x. DDef a -> Rep (DDef a) x
$cto :: forall a x. Rep (DDef a) x -> DDef a
to :: forall x. Rep (DDef a) x -> DDef a
Generic)

instance NFData a => NFData (DDef a) where

instance Out a => Out (DDef a)

-- | Lookup a ddef in its entirety
lookupDDef :: Out a => DDefs a -> TyCon -> DDef a
lookupDDef :: forall a. Out a => DDefs a -> DataCon -> DDef a
lookupDDef DDefs a
mp DataCon
tycon =
    case Var -> DDefs a -> Maybe (DDef a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DataCon -> Var
toVar DataCon
tycon) DDefs a
mp of
      Just DDef a
x -> DDef a
x
      Maybe (DDef a)
Nothing -> DataCon -> DDef a
forall a. HasCallStack => DataCon -> a
error (DataCon -> DDef a) -> DataCon -> DDef a
forall a b. (a -> b) -> a -> b
$ DataCon
"lookupDDef failed on symbol: "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
tycon DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
"\nDDefs: "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DDefs a -> DataCon
forall a. Out a => a -> DataCon
sdoc DDefs a
mp

-- | Get the canonical ordering for data constructors, currently based
-- on ordering in the original source code.  Takes a TyCon as argument.
getConOrdering :: Out a => DDefs a -> TyCon -> [DataCon]
getConOrdering :: forall a. Out a => DDefs a -> DataCon -> [DataCon]
getConOrdering DDefs a
dd DataCon
tycon = ((DataCon, [(IsBoxed, a)]) -> DataCon)
-> [(DataCon, [(IsBoxed, a)])] -> [DataCon]
forall a b. (a -> b) -> [a] -> [b]
L.map (DataCon, [(IsBoxed, a)]) -> DataCon
forall a b. (a, b) -> a
fst [(DataCon, [(IsBoxed, a)])]
dataCons
  where DDef{[(DataCon, [(IsBoxed, a)])]
dataCons :: forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons :: [(DataCon, [(IsBoxed, a)])]
dataCons} = DDefs a -> DataCon -> DDef a
forall a. Out a => DDefs a -> DataCon -> DDef a
lookupDDef DDefs a
dd DataCon
tycon

-- | Lookup the name of the TyCon that goes with a given DataCon.
--   Must be unique!
getTyOfDataCon :: Out a => DDefs a -> DataCon -> TyCon
getTyOfDataCon :: forall a. Out a => DDefs a -> ShowS
getTyOfDataCon DDefs a
dds DataCon
con = (Var -> DataCon
fromVar (Var -> DataCon)
-> ((Var, (DataCon, [(IsBoxed, a)])) -> Var)
-> (Var, (DataCon, [(IsBoxed, a)]))
-> DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, (DataCon, [(IsBoxed, a)])) -> Var
forall a b. (a, b) -> a
fst) ((Var, (DataCon, [(IsBoxed, a)])) -> DataCon)
-> (Var, (DataCon, [(IsBoxed, a)])) -> DataCon
forall a b. (a -> b) -> a -> b
$ DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a.
Out a =>
DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
lkp DDefs a
dds DataCon
con

-- | Lookup the arguments to a data contstructor.
lookupDataCon :: Out a => DDefs a -> DataCon -> [a]
lookupDataCon :: forall a. Out a => DDefs a -> DataCon -> [a]
lookupDataCon DDefs a
dds DataCon
con =
    -- dbgTrace 5 ("lookupDataCon -- "++sdoc(dds,con)) $
    ((IsBoxed, a) -> a) -> [(IsBoxed, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
L.map (IsBoxed, a) -> a
forall a b. (a, b) -> b
snd ([(IsBoxed, a)] -> [a]) -> [(IsBoxed, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ (DataCon, [(IsBoxed, a)]) -> [(IsBoxed, a)]
forall a b. (a, b) -> b
snd ((DataCon, [(IsBoxed, a)]) -> [(IsBoxed, a)])
-> (DataCon, [(IsBoxed, a)]) -> [(IsBoxed, a)]
forall a b. (a -> b) -> a -> b
$ (Var, (DataCon, [(IsBoxed, a)])) -> (DataCon, [(IsBoxed, a)])
forall a b. (a, b) -> b
snd ((Var, (DataCon, [(IsBoxed, a)])) -> (DataCon, [(IsBoxed, a)]))
-> (Var, (DataCon, [(IsBoxed, a)])) -> (DataCon, [(IsBoxed, a)])
forall a b. (a -> b) -> a -> b
$ DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a.
Out a =>
DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
lkp DDefs a
dds DataCon
con

-- | Like 'lookupDataCon' but lookup arguments to a data contstructor for a
-- specific instance of a datatype.
--
--     lookupDataCon' (Maybe Int) Just = [Int]
lookupDataCon' :: Out a => DDef a -> DataCon -> [a]
lookupDataCon' :: forall a. Out a => DDef a -> DataCon -> [a]
lookupDataCon' ddf :: DDef a
ddf@DDef{[(DataCon, [(IsBoxed, a)])]
dataCons :: forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons :: [(DataCon, [(IsBoxed, a)])]
dataCons} DataCon
con =
   case ((DataCon, [(IsBoxed, a)]) -> IsBoxed)
-> [(DataCon, [(IsBoxed, a)])] -> [(DataCon, [(IsBoxed, a)])]
forall a. (a -> IsBoxed) -> [a] -> [a]
L.filter ((DataCon -> DataCon -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== DataCon
con) (DataCon -> IsBoxed)
-> ((DataCon, [(IsBoxed, a)]) -> DataCon)
-> (DataCon, [(IsBoxed, a)])
-> IsBoxed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataCon, [(IsBoxed, a)]) -> DataCon
forall a b. (a, b) -> a
fst) [(DataCon, [(IsBoxed, a)])]
dataCons of
     []    -> DataCon -> [a]
forall a. HasCallStack => DataCon -> a
error(DataCon -> [a]) -> DataCon -> [a]
forall a b. (a -> b) -> a -> b
$ DataCon
"lookupDataCon': could not find constructor " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> DataCon
show DataCon
con
              DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
", in datatype:\n  " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DDef a -> DataCon
forall a. Out a => a -> DataCon
sdoc DDef a
ddf
     [(DataCon, [(IsBoxed, a)])
hit] -> ((IsBoxed, a) -> a) -> [(IsBoxed, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
L.map (IsBoxed, a) -> a
forall a b. (a, b) -> b
snd ((DataCon, [(IsBoxed, a)]) -> [(IsBoxed, a)]
forall a b. (a, b) -> b
snd (DataCon, [(IsBoxed, a)])
hit)
     [(DataCon, [(IsBoxed, a)])]
_     -> DataCon -> [a]
forall a. HasCallStack => DataCon -> a
error(DataCon -> [a]) -> DataCon -> [a]
forall a b. (a -> b) -> a -> b
$ DataCon
"lookupDataCon': found multiple occurences of constructor "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> DataCon
show DataCon
con
              DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
", in datatype:\n  " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DDef a -> DataCon
forall a. Out a => a -> DataCon
sdoc DDef a
ddf

-- | Lookup a Datacon.  Return (TyCon, (DataCon, [flds]))
lkp :: Out a => DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed,a)]))
lkp :: forall a.
Out a =>
DDefs a -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
lkp DDefs a
dds DataCon
con =
   -- Here we try to lookup in ALL datatypes, assuming unique datacons:
  case [ (Var
tycon,(DataCon, [(IsBoxed, a)])
variant)
       | (Var
tycon, DDef{[(DataCon, [(IsBoxed, a)])]
dataCons :: forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons :: [(DataCon, [(IsBoxed, a)])]
dataCons}) <- DDefs a -> [(Var, DDef a)]
forall k a. Map k a -> [(k, a)]
M.toList DDefs a
dds
       , (DataCon, [(IsBoxed, a)])
variant <- ((DataCon, [(IsBoxed, a)]) -> IsBoxed)
-> [(DataCon, [(IsBoxed, a)])] -> [(DataCon, [(IsBoxed, a)])]
forall a. (a -> IsBoxed) -> [a] -> [a]
L.filter ((DataCon -> DataCon -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
==DataCon
con)(DataCon -> IsBoxed)
-> ((DataCon, [(IsBoxed, a)]) -> DataCon)
-> (DataCon, [(IsBoxed, a)])
-> IsBoxed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataCon, [(IsBoxed, a)]) -> DataCon
forall a b. (a, b) -> a
fst) [(DataCon, [(IsBoxed, a)])]
dataCons ] of
    [] -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a. HasCallStack => DataCon -> a
error(DataCon -> (Var, (DataCon, [(IsBoxed, a)])))
-> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a b. (a -> b) -> a -> b
$ DataCon
"lookupDataCon: could not find constructor "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> DataCon
show DataCon
con
          DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
", in datatypes:\n  "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DDefs a -> DataCon
forall a. Out a => a -> DataCon
sdoc DDefs a
dds
    [(Var, (DataCon, [(IsBoxed, a)]))
hit] -> (Var, (DataCon, [(IsBoxed, a)]))
hit
    [(Var, (DataCon, [(IsBoxed, a)]))]
_ -> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a. HasCallStack => DataCon -> a
error(DataCon -> (Var, (DataCon, [(IsBoxed, a)])))
-> DataCon -> (Var, (DataCon, [(IsBoxed, a)]))
forall a b. (a -> b) -> a -> b
$ DataCon
"lookupDataCon: found multiple occurences of constructor "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
forall a. Show a => a -> DataCon
show DataCon
con
          DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
", in datatypes:\n  "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DDefs a -> DataCon
forall a. Out a => a -> DataCon
sdoc DDefs a
dds


insertDD :: DDef a -> DDefs a -> DDefs a
insertDD :: forall a. DDef a -> DDefs a -> DDefs a
insertDD DDef a
d = (DDef a -> DDef a -> DDef a)
-> Var -> DDef a -> Map Var (DDef a) -> Map Var (DDef a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith DDef a -> DDef a -> DDef a
err' (DDef a -> Var
forall a. DDef a -> Var
tyName DDef a
d) DDef a
d
  where
   err' :: DDef a -> DDef a -> DDef a
err' = DataCon -> DDef a -> DDef a -> DDef a
forall a. HasCallStack => DataCon -> a
error (DataCon -> DDef a -> DDef a -> DDef a)
-> DataCon -> DDef a -> DDef a -> DDef a
forall a b. (a -> b) -> a -> b
$ DataCon
"insertDD: data definition with duplicate name: "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show (DDef a -> Var
forall a. DDef a -> Var
tyName DDef a
d)

emptyDD :: DDefs a
emptyDD :: forall a. DDefs a
emptyDD  = Map Var (DDef a)
forall k a. Map k a
M.empty

fromListDD :: [DDef a] -> DDefs a
fromListDD :: forall a. [DDef a] -> DDefs a
fromListDD = (DDef a -> DDefs a -> DDefs a) -> DDefs a -> [DDef a] -> DDefs a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr DDef a -> DDefs a -> DDefs a
forall a. DDef a -> DDefs a -> DDefs a
insertDD DDefs a
forall k a. Map k a
M.empty

-- | Is this an empty type (like 'data Void' in Haskell) ?
isVoidDDef :: DDef a -> Bool
isVoidDDef :: forall a. DDef a -> IsBoxed
isVoidDDef DDef{[(DataCon, [(IsBoxed, a)])]
dataCons :: forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons :: [(DataCon, [(IsBoxed, a)])]
dataCons} = [(DataCon, [(IsBoxed, a)])] -> IsBoxed
forall a. [a] -> IsBoxed
forall (t :: * -> *) a. Foldable t => t a -> IsBoxed
L.null [(DataCon, [(IsBoxed, a)])]
dataCons

--------------------------------------------------------------------------------
-- Function definitions
--------------------------------------------------------------------------------

-- | A type family describing function types.
class (Out (ArrowTy ty), Show (ArrowTy ty)) => FunctionTy ty where
  type ArrowTy ty
  inTys :: ArrowTy ty -> [ty]
  outTy :: ArrowTy ty -> ty

-- | A set of top-level recursive function definitions.
type FunDefs ex = M.Map Var (FunDef ex)

data FunRec = Rec | NotRec | TailRec
  deriving (ReadPrec [FunRec]
ReadPrec FunRec
Int -> ReadS FunRec
ReadS [FunRec]
(Int -> ReadS FunRec)
-> ReadS [FunRec]
-> ReadPrec FunRec
-> ReadPrec [FunRec]
-> Read FunRec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FunRec
readsPrec :: Int -> ReadS FunRec
$creadList :: ReadS [FunRec]
readList :: ReadS [FunRec]
$creadPrec :: ReadPrec FunRec
readPrec :: ReadPrec FunRec
$creadListPrec :: ReadPrec [FunRec]
readListPrec :: ReadPrec [FunRec]
Read, Int -> FunRec -> ShowS
[FunRec] -> ShowS
FunRec -> DataCon
(Int -> FunRec -> ShowS)
-> (FunRec -> DataCon) -> ([FunRec] -> ShowS) -> Show FunRec
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunRec -> ShowS
showsPrec :: Int -> FunRec -> ShowS
$cshow :: FunRec -> DataCon
show :: FunRec -> DataCon
$cshowList :: [FunRec] -> ShowS
showList :: [FunRec] -> ShowS
Show, FunRec -> FunRec -> IsBoxed
(FunRec -> FunRec -> IsBoxed)
-> (FunRec -> FunRec -> IsBoxed) -> Eq FunRec
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: FunRec -> FunRec -> IsBoxed
== :: FunRec -> FunRec -> IsBoxed
$c/= :: FunRec -> FunRec -> IsBoxed
/= :: FunRec -> FunRec -> IsBoxed
Eq, Eq FunRec
Eq FunRec
-> (FunRec -> FunRec -> Ordering)
-> (FunRec -> FunRec -> IsBoxed)
-> (FunRec -> FunRec -> IsBoxed)
-> (FunRec -> FunRec -> IsBoxed)
-> (FunRec -> FunRec -> IsBoxed)
-> (FunRec -> FunRec -> FunRec)
-> (FunRec -> FunRec -> FunRec)
-> Ord FunRec
FunRec -> FunRec -> IsBoxed
FunRec -> FunRec -> Ordering
FunRec -> FunRec -> FunRec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunRec -> FunRec -> Ordering
compare :: FunRec -> FunRec -> Ordering
$c< :: FunRec -> FunRec -> IsBoxed
< :: FunRec -> FunRec -> IsBoxed
$c<= :: FunRec -> FunRec -> IsBoxed
<= :: FunRec -> FunRec -> IsBoxed
$c> :: FunRec -> FunRec -> IsBoxed
> :: FunRec -> FunRec -> IsBoxed
$c>= :: FunRec -> FunRec -> IsBoxed
>= :: FunRec -> FunRec -> IsBoxed
$cmax :: FunRec -> FunRec -> FunRec
max :: FunRec -> FunRec -> FunRec
$cmin :: FunRec -> FunRec -> FunRec
min :: FunRec -> FunRec -> FunRec
Ord, (forall x. FunRec -> Rep FunRec x)
-> (forall x. Rep FunRec x -> FunRec) -> Generic FunRec
forall x. Rep FunRec x -> FunRec
forall x. FunRec -> Rep FunRec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunRec -> Rep FunRec x
from :: forall x. FunRec -> Rep FunRec x
$cto :: forall x. Rep FunRec x -> FunRec
to :: forall x. Rep FunRec x -> FunRec
Generic, FunRec -> ()
(FunRec -> ()) -> NFData FunRec
forall a. (a -> ()) -> NFData a
$crnf :: FunRec -> ()
rnf :: FunRec -> ()
NFData, Int -> FunRec -> Doc
[FunRec] -> Doc
FunRec -> Doc
(Int -> FunRec -> Doc)
-> (FunRec -> Doc) -> ([FunRec] -> Doc) -> Out FunRec
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> FunRec -> Doc
docPrec :: Int -> FunRec -> Doc
$cdoc :: FunRec -> Doc
doc :: FunRec -> Doc
$cdocList :: [FunRec] -> Doc
docList :: [FunRec] -> Doc
Out)

data FunInline = Inline | NoInline | Inlineable
  deriving (ReadPrec [FunInline]
ReadPrec FunInline
Int -> ReadS FunInline
ReadS [FunInline]
(Int -> ReadS FunInline)
-> ReadS [FunInline]
-> ReadPrec FunInline
-> ReadPrec [FunInline]
-> Read FunInline
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FunInline
readsPrec :: Int -> ReadS FunInline
$creadList :: ReadS [FunInline]
readList :: ReadS [FunInline]
$creadPrec :: ReadPrec FunInline
readPrec :: ReadPrec FunInline
$creadListPrec :: ReadPrec [FunInline]
readListPrec :: ReadPrec [FunInline]
Read, Int -> FunInline -> ShowS
[FunInline] -> ShowS
FunInline -> DataCon
(Int -> FunInline -> ShowS)
-> (FunInline -> DataCon)
-> ([FunInline] -> ShowS)
-> Show FunInline
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunInline -> ShowS
showsPrec :: Int -> FunInline -> ShowS
$cshow :: FunInline -> DataCon
show :: FunInline -> DataCon
$cshowList :: [FunInline] -> ShowS
showList :: [FunInline] -> ShowS
Show, FunInline -> FunInline -> IsBoxed
(FunInline -> FunInline -> IsBoxed)
-> (FunInline -> FunInline -> IsBoxed) -> Eq FunInline
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: FunInline -> FunInline -> IsBoxed
== :: FunInline -> FunInline -> IsBoxed
$c/= :: FunInline -> FunInline -> IsBoxed
/= :: FunInline -> FunInline -> IsBoxed
Eq, Eq FunInline
Eq FunInline
-> (FunInline -> FunInline -> Ordering)
-> (FunInline -> FunInline -> IsBoxed)
-> (FunInline -> FunInline -> IsBoxed)
-> (FunInline -> FunInline -> IsBoxed)
-> (FunInline -> FunInline -> IsBoxed)
-> (FunInline -> FunInline -> FunInline)
-> (FunInline -> FunInline -> FunInline)
-> Ord FunInline
FunInline -> FunInline -> IsBoxed
FunInline -> FunInline -> Ordering
FunInline -> FunInline -> FunInline
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunInline -> FunInline -> Ordering
compare :: FunInline -> FunInline -> Ordering
$c< :: FunInline -> FunInline -> IsBoxed
< :: FunInline -> FunInline -> IsBoxed
$c<= :: FunInline -> FunInline -> IsBoxed
<= :: FunInline -> FunInline -> IsBoxed
$c> :: FunInline -> FunInline -> IsBoxed
> :: FunInline -> FunInline -> IsBoxed
$c>= :: FunInline -> FunInline -> IsBoxed
>= :: FunInline -> FunInline -> IsBoxed
$cmax :: FunInline -> FunInline -> FunInline
max :: FunInline -> FunInline -> FunInline
$cmin :: FunInline -> FunInline -> FunInline
min :: FunInline -> FunInline -> FunInline
Ord, (forall x. FunInline -> Rep FunInline x)
-> (forall x. Rep FunInline x -> FunInline) -> Generic FunInline
forall x. Rep FunInline x -> FunInline
forall x. FunInline -> Rep FunInline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunInline -> Rep FunInline x
from :: forall x. FunInline -> Rep FunInline x
$cto :: forall x. Rep FunInline x -> FunInline
to :: forall x. Rep FunInline x -> FunInline
Generic, FunInline -> ()
(FunInline -> ()) -> NFData FunInline
forall a. (a -> ()) -> NFData a
$crnf :: FunInline -> ()
rnf :: FunInline -> ()
NFData, Int -> FunInline -> Doc
[FunInline] -> Doc
FunInline -> Doc
(Int -> FunInline -> Doc)
-> (FunInline -> Doc) -> ([FunInline] -> Doc) -> Out FunInline
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> FunInline -> Doc
docPrec :: Int -> FunInline -> Doc
$cdoc :: FunInline -> Doc
doc :: FunInline -> Doc
$cdocList :: [FunInline] -> Doc
docList :: [FunInline] -> Doc
Out)

data FunMeta = FunMeta
  { FunMeta -> FunRec
funRec    :: FunRec
  , FunMeta -> FunInline
funInline :: FunInline
    -- Whether the transitive closure of this function can trigger GC.
  , FunMeta -> IsBoxed
funCanTriggerGC :: Bool
  }
  deriving (ReadPrec [FunMeta]
ReadPrec FunMeta
Int -> ReadS FunMeta
ReadS [FunMeta]
(Int -> ReadS FunMeta)
-> ReadS [FunMeta]
-> ReadPrec FunMeta
-> ReadPrec [FunMeta]
-> Read FunMeta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FunMeta
readsPrec :: Int -> ReadS FunMeta
$creadList :: ReadS [FunMeta]
readList :: ReadS [FunMeta]
$creadPrec :: ReadPrec FunMeta
readPrec :: ReadPrec FunMeta
$creadListPrec :: ReadPrec [FunMeta]
readListPrec :: ReadPrec [FunMeta]
Read, Int -> FunMeta -> ShowS
[FunMeta] -> ShowS
FunMeta -> DataCon
(Int -> FunMeta -> ShowS)
-> (FunMeta -> DataCon) -> ([FunMeta] -> ShowS) -> Show FunMeta
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunMeta -> ShowS
showsPrec :: Int -> FunMeta -> ShowS
$cshow :: FunMeta -> DataCon
show :: FunMeta -> DataCon
$cshowList :: [FunMeta] -> ShowS
showList :: [FunMeta] -> ShowS
Show, FunMeta -> FunMeta -> IsBoxed
(FunMeta -> FunMeta -> IsBoxed)
-> (FunMeta -> FunMeta -> IsBoxed) -> Eq FunMeta
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: FunMeta -> FunMeta -> IsBoxed
== :: FunMeta -> FunMeta -> IsBoxed
$c/= :: FunMeta -> FunMeta -> IsBoxed
/= :: FunMeta -> FunMeta -> IsBoxed
Eq, Eq FunMeta
Eq FunMeta
-> (FunMeta -> FunMeta -> Ordering)
-> (FunMeta -> FunMeta -> IsBoxed)
-> (FunMeta -> FunMeta -> IsBoxed)
-> (FunMeta -> FunMeta -> IsBoxed)
-> (FunMeta -> FunMeta -> IsBoxed)
-> (FunMeta -> FunMeta -> FunMeta)
-> (FunMeta -> FunMeta -> FunMeta)
-> Ord FunMeta
FunMeta -> FunMeta -> IsBoxed
FunMeta -> FunMeta -> Ordering
FunMeta -> FunMeta -> FunMeta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FunMeta -> FunMeta -> Ordering
compare :: FunMeta -> FunMeta -> Ordering
$c< :: FunMeta -> FunMeta -> IsBoxed
< :: FunMeta -> FunMeta -> IsBoxed
$c<= :: FunMeta -> FunMeta -> IsBoxed
<= :: FunMeta -> FunMeta -> IsBoxed
$c> :: FunMeta -> FunMeta -> IsBoxed
> :: FunMeta -> FunMeta -> IsBoxed
$c>= :: FunMeta -> FunMeta -> IsBoxed
>= :: FunMeta -> FunMeta -> IsBoxed
$cmax :: FunMeta -> FunMeta -> FunMeta
max :: FunMeta -> FunMeta -> FunMeta
$cmin :: FunMeta -> FunMeta -> FunMeta
min :: FunMeta -> FunMeta -> FunMeta
Ord, (forall x. FunMeta -> Rep FunMeta x)
-> (forall x. Rep FunMeta x -> FunMeta) -> Generic FunMeta
forall x. Rep FunMeta x -> FunMeta
forall x. FunMeta -> Rep FunMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunMeta -> Rep FunMeta x
from :: forall x. FunMeta -> Rep FunMeta x
$cto :: forall x. Rep FunMeta x -> FunMeta
to :: forall x. Rep FunMeta x -> FunMeta
Generic, FunMeta -> ()
(FunMeta -> ()) -> NFData FunMeta
forall a. (a -> ()) -> NFData a
$crnf :: FunMeta -> ()
rnf :: FunMeta -> ()
NFData, Int -> FunMeta -> Doc
[FunMeta] -> Doc
FunMeta -> Doc
(Int -> FunMeta -> Doc)
-> (FunMeta -> Doc) -> ([FunMeta] -> Doc) -> Out FunMeta
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> FunMeta -> Doc
docPrec :: Int -> FunMeta -> Doc
$cdoc :: FunMeta -> Doc
doc :: FunMeta -> Doc
$cdocList :: [FunMeta] -> Doc
docList :: [FunMeta] -> Doc
Out)

-- | A function definiton indexed by a type and expression.
data FunDef ex = FunDef { forall ex. FunDef ex -> Var
funName   :: Var
                        , forall ex. FunDef ex -> [Var]
funArgs   :: [Var]
                        , forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy     :: ArrowTy (TyOf ex)
                        , forall ex. FunDef ex -> ex
funBody   :: ex
                        , forall ex. FunDef ex -> FunMeta
funMeta   :: FunMeta
                        }

deriving instance (Read ex, Read (ArrowTy (TyOf ex))) => Read (FunDef ex)
deriving instance (Show ex, Show (ArrowTy (TyOf ex))) => Show (FunDef ex)
deriving instance (Eq ex, Eq (ArrowTy (TyOf ex))) => Eq (FunDef ex)
deriving instance (Ord ex, Ord (ArrowTy (TyOf ex))) => Ord (FunDef ex)
deriving instance Generic (FunDef ex)
deriving instance (Generic (ArrowTy (TyOf ex)), NFData ex, NFData (ArrowTy (TyOf ex))) => NFData (FunDef ex)
deriving instance (Generic (ArrowTy (TyOf ex)), Out ex, Out (ArrowTy (TyOf ex))) =>  Out (FunDef ex)

-- | Insert a 'FunDef' into 'FunDefs'.
-- Raise an error if a function with the same name already exists.
insertFD :: FunDef ex -> FunDefs ex -> FunDefs ex
insertFD :: forall ex. FunDef ex -> FunDefs ex -> FunDefs ex
insertFD FunDef ex
d = (FunDef ex -> FunDef ex -> FunDef ex)
-> Var -> FunDef ex -> Map Var (FunDef ex) -> Map Var (FunDef ex)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith FunDef ex -> FunDef ex -> FunDef ex
err' (FunDef ex -> Var
forall ex. FunDef ex -> Var
funName FunDef ex
d) FunDef ex
d
  where
   err' :: FunDef ex -> FunDef ex -> FunDef ex
err' = DataCon -> FunDef ex -> FunDef ex -> FunDef ex
forall a. HasCallStack => DataCon -> a
error (DataCon -> FunDef ex -> FunDef ex -> FunDef ex)
-> DataCon -> FunDef ex -> FunDef ex -> FunDef ex
forall a b. (a -> b) -> a -> b
$ DataCon
"insertFD: function definition with duplicate name: "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show (FunDef ex -> Var
forall ex. FunDef ex -> Var
funName FunDef ex
d)

-- |
fromListFD :: [FunDef ex] -> FunDefs ex
fromListFD :: forall ex. [FunDef ex] -> FunDefs ex
fromListFD = (FunDef ex -> FunDefs ex -> FunDefs ex)
-> FunDefs ex -> [FunDef ex] -> FunDefs ex
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr FunDef ex -> FunDefs ex -> FunDefs ex
forall ex. FunDef ex -> FunDefs ex -> FunDefs ex
insertFD FunDefs ex
forall k a. Map k a
M.empty

-- |
initFunEnv :: FunDefs a -> TyEnv (ArrowTy (TyOf a))
initFunEnv :: forall a. FunDefs a -> TyEnv (ArrowTy (TyOf a))
initFunEnv FunDefs a
fds = (FunDef a -> ArrowTy (TyOf a))
-> FunDefs a -> Map Var (ArrowTy (TyOf a))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map FunDef a -> ArrowTy (TyOf a)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDefs a
fds

--------------------------------------------------------------------------------
-- Programs
--------------------------------------------------------------------------------

-- | Complete programs include datatype definitions:
--
-- For evaluating a complete program, main's type will be an Int or a
-- datatype.  For running a pass benchmark, main will be Nothing and
-- we will expect a "benchmark" function definition which consumes an
-- appropriate packed AST datatype.
data Prog ex = Prog { forall ex. Prog ex -> DDefs (TyOf ex)
ddefs   :: DDefs (TyOf ex)
                    , forall ex. Prog ex -> FunDefs ex
fundefs :: FunDefs ex
                    , forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp :: Maybe (ex, (TyOf ex))
                    }

-- Since 'FunDef' is defined using a type family, we cannot use the deriving clause.
-- Ryan Scott recommended using singletons-like alternative outlined here:
-- https://lpaste.net/365181
--
deriving instance (Read (TyOf ex), Read ex, Read (ArrowTy (TyOf ex))) => Read (Prog ex)
deriving instance (Show (TyOf ex), Show ex, Show (ArrowTy (TyOf ex))) => Show (Prog ex)
deriving instance (Eq (TyOf ex), Eq ex, Eq (ArrowTy (TyOf ex))) => Eq (Prog ex)
deriving instance (Ord (TyOf ex), Ord ex, Ord (ArrowTy (TyOf ex))) => Ord (Prog ex)
deriving instance Generic (Prog ex)
deriving instance (NFData (TyOf ex), NFData (ArrowTy (TyOf ex)), NFData ex, Generic (ArrowTy (TyOf ex))) => NFData (Prog ex)

-- | Abstract some of the differences of top level program types, by
--   having a common way to extract an initial environment.  The
--   initial environment has types only for functions.
progToEnv :: Prog a -> Env2 (TyOf a)
progToEnv :: forall a. Prog a -> Env2 (TyOf a)
progToEnv Prog{FunDefs a
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs :: FunDefs a
fundefs} = TyEnv (TyOf a) -> TyEnv (ArrowTy (TyOf a)) -> Env2 (TyOf a)
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv (TyOf a)
forall k a. Map k a
M.empty (FunDefs a -> TyEnv (ArrowTy (TyOf a))
forall a. FunDefs a -> TyEnv (ArrowTy (TyOf a))
initFunEnv FunDefs a
fundefs)

-- | Look up the input/output type of a top-level function binding.
getFunTy :: Var -> Prog ex -> ArrowTy (TyOf ex)
getFunTy :: forall ex. Var -> Prog ex -> ArrowTy (TyOf ex)
getFunTy Var
fn Prog{FunDefs ex
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs :: FunDefs ex
fundefs} =
    case Var -> FunDefs ex -> Maybe (FunDef ex)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
fn FunDefs ex
fundefs of
      Just FunDef ex
f -> FunDef ex -> ArrowTy (TyOf ex)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDef ex
f
      Maybe (FunDef ex)
Nothing -> DataCon -> ArrowTy (TyOf ex)
forall a. HasCallStack => DataCon -> a
error (DataCon -> ArrowTy (TyOf ex)) -> DataCon -> ArrowTy (TyOf ex)
forall a b. (a -> b) -> a -> b
$ DataCon
"getFunTy: L1 program does not contain binding for function: "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show Var
fn

instance (Generic (ArrowTy (TyOf ex)), Out (ArrowTy (TyOf ex)),
          Out (TyOf ex), Out ex) => Out (Prog ex)

--------------------------------------------------------------------------------
-- Environments
--------------------------------------------------------------------------------

-- | A simple type environment
type TyEnv a = M.Map Var a

emptyTyEnv :: TyEnv a
emptyTyEnv :: forall a. TyEnv a
emptyTyEnv = Map Var a
forall k a. Map k a
M.empty

-- | A common currency for a two part environment consisting of
-- function bindings and regular value bindings.
data Env2 a = Env2 { forall a. Env2 a -> TyEnv a
vEnv :: TyEnv a
                   , forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv :: TyEnv (ArrowTy a) }


deriving instance (Show (TyOf a), Show a, Show (ArrowTy a)) => Show (Env2 a)
deriving instance (Read (TyOf a), Read a, Read (ArrowTy a)) => Read (Env2 a)
deriving instance (Eq (TyOf a), Eq a, Eq (ArrowTy a)) => Eq (Env2 a)
-- deriving instance (Ord (TyOf a), Ord a, Ord (ArrowTy a)) => Ord (Env2 a)
deriving instance Generic (Env2 a)
instance (Out a, Out (ArrowTy a)) => Out (Env2 a)

emptyEnv2 :: Env2 a
emptyEnv2 :: forall a. Env2 a
emptyEnv2 = Env2 { vEnv :: TyEnv a
vEnv = TyEnv a
forall a. TyEnv a
emptyTyEnv
                 , fEnv :: TyEnv (ArrowTy a)
fEnv = TyEnv (ArrowTy a)
forall k a. Map k a
M.empty }

-- | Extend non-function value environment.
extendVEnv :: Var -> a -> Env2 a -> Env2 a
extendVEnv :: forall a. Var -> a -> Env2 a -> Env2 a
extendVEnv Var
v a
t (Env2 TyEnv a
ve TyEnv (ArrowTy a)
fe) = TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 (Var -> a -> TyEnv a -> TyEnv a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v a
t TyEnv a
ve) TyEnv (ArrowTy a)
fe

-- | Extend multiple times in one go.
extendsVEnv :: M.Map Var a -> Env2 a -> Env2 a
extendsVEnv :: forall a. Map Var a -> Env2 a -> Env2 a
extendsVEnv Map Var a
mp (Env2 Map Var a
ve TyEnv (ArrowTy a)
fe) = Map Var a -> TyEnv (ArrowTy a) -> Env2 a
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 (Map Var a -> Map Var a -> Map Var a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Var a
mp Map Var a
ve) TyEnv (ArrowTy a)
fe

lookupVEnv :: Out a => Var -> Env2 a -> a
lookupVEnv :: forall a. Out a => Var -> Env2 a -> a
lookupVEnv Var
v Env2 a
env2 = (Env2 a -> TyEnv a
forall a. Env2 a -> TyEnv a
vEnv Env2 a
env2) TyEnv a -> Var -> a
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v

mblookupVEnv :: Var -> Env2 a -> Maybe a
mblookupVEnv :: forall a. Var -> Env2 a -> Maybe a
mblookupVEnv Var
cur Env2 a
env2 = Var -> Map Var a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
cur (Env2 a -> Map Var a
forall a. Env2 a -> TyEnv a
vEnv Env2 a
env2)

lookupVEnv' :: Var -> Env2 a -> Maybe a
lookupVEnv' :: forall a. Var -> Env2 a -> Maybe a
lookupVEnv' Var
v (Env2 TyEnv a
ve TyEnv (ArrowTy a)
_) = Var -> TyEnv a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TyEnv a
ve

-- | Extend function type environment.
extendFEnv :: Var -> ArrowTy a -> Env2 a -> Env2 a
extendFEnv :: forall a. Var -> ArrowTy a -> Env2 a -> Env2 a
extendFEnv Var
v ArrowTy a
t (Env2 TyEnv a
ve TyEnv (ArrowTy a)
fe) = TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv a
ve (Var -> ArrowTy a -> TyEnv (ArrowTy a) -> TyEnv (ArrowTy a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v ArrowTy a
t TyEnv (ArrowTy a)
fe)

lookupFEnv :: Out (ArrowTy a) => Var -> Env2 a -> ArrowTy a
lookupFEnv :: forall a. Out (ArrowTy a) => Var -> Env2 a -> ArrowTy a
lookupFEnv Var
v Env2 a
env2 = (Env2 a -> Map Var (ArrowTy a)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 a
env2) Map Var (ArrowTy a) -> Var -> ArrowTy a
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v


--------------------------------------------------------------------------------
-- Expressions
--------------------------------------------------------------------------------

-- Shorthand to make the below definition more readable.
-- I.e., this covers all the verbose recursive fields.
#define EXP (PreExp ext loc dec)

-- | The source language.  It has pointer-based sums and products, as
-- well as packed algebraic datatypes.
--
-- (1) It is parameterized by an a potential extension point.
--
-- (2) It is parameterized by 'loc', the type of locations.
--
-- (3) It is parameterized by a decoration, d, attached to every binder.
--
data PreExp (ext :: Type -> Type -> Type) loc dec =
     VarE Var              -- ^ Variable reference
   | LitE Int              -- ^ Numeric literal
   | CharE Char            -- ^ A character literal
   | FloatE Double         -- ^ Floating point literal
   | LitSymE Var           -- ^ A quoted symbol literal
   | AppE Var [loc] [EXP]
     -- ^ Apply a top-level / first-order function.  Instantiate
     -- its type schema by providing location-variable arguments,
     -- if applicable.
   | PrimAppE (Prim dec) [EXP]
     -- ^ Primitive applications don't manipulate locations.
   | LetE (Var,[loc],dec, EXP) -- binding
          EXP                  -- body
    -- ^ One binding at a time.  Allows binding a list of
    -- implicit *location* return vales from the RHS, plus a single "real" value.
    -- This list of implicit returnsb

   | IfE EXP EXP EXP

   -- TODO: eventually tuples will just be a wired-in datatype.
   | MkProdE   [EXP] -- ^ Tuple construction
   | ProjE Int EXP   -- ^ Tuple projection.

     -- in L0, loc carries the type of the corresponding var
     -- as there is no location information
   | CaseE EXP [(DataCon, [(Var,loc)], EXP)]
     -- ^ Case on a datatype.  Each bound, unpacked variable lives at
     -- a fixed, read-only location.

   | DataConE loc DataCon [EXP]
     -- ^ Construct data that may unpack some fields.  The location
     -- argument, if applicable, is the byte location at which to
     -- write the tag for the sum type.

   | TimeIt EXP dec Bool
    -- ^ The boolean being true indicates this TimeIt is really (iterate _)
    -- This iterate form is used for criterion-style benchmarking.

   | WithArenaE Var EXP

   | SpawnE Var [loc] [EXP]
   | SyncE

   -- Limited list handling:
   -- TODO: RENAME to "Array".
   -- TODO: Replace with Generate, add array reference.
   | MapE  (Var,dec, EXP) EXP
   | FoldE { forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> (Var, dec, PreExp ext loc dec)
initial  :: (Var,dec,EXP)
           , forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> (Var, dec, PreExp ext loc dec)
iterator :: (Var,dec,EXP)
           , forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> PreExp ext loc dec
body     :: EXP }

   ----------------------------------------
  | Ext (ext loc dec) -- ^ Extension point for downstream language extensions.

  deriving (Int -> PreExp ext loc dec -> ShowS
[PreExp ext loc dec] -> ShowS
PreExp ext loc dec -> DataCon
(Int -> PreExp ext loc dec -> ShowS)
-> (PreExp ext loc dec -> DataCon)
-> ([PreExp ext loc dec] -> ShowS)
-> Show (PreExp ext loc dec)
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
Int -> PreExp ext loc dec -> ShowS
forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
[PreExp ext loc dec] -> ShowS
forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
PreExp ext loc dec -> DataCon
$cshowsPrec :: forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
Int -> PreExp ext loc dec -> ShowS
showsPrec :: Int -> PreExp ext loc dec -> ShowS
$cshow :: forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
PreExp ext loc dec -> DataCon
show :: PreExp ext loc dec -> DataCon
$cshowList :: forall (ext :: * -> * -> *) loc dec.
(Show loc, Show dec, Show (ext loc dec)) =>
[PreExp ext loc dec] -> ShowS
showList :: [PreExp ext loc dec] -> ShowS
Show, ReadPrec [PreExp ext loc dec]
ReadPrec (PreExp ext loc dec)
Int -> ReadS (PreExp ext loc dec)
ReadS [PreExp ext loc dec]
(Int -> ReadS (PreExp ext loc dec))
-> ReadS [PreExp ext loc dec]
-> ReadPrec (PreExp ext loc dec)
-> ReadPrec [PreExp ext loc dec]
-> Read (PreExp ext loc dec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadPrec [PreExp ext loc dec]
forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadPrec (PreExp ext loc dec)
forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
Int -> ReadS (PreExp ext loc dec)
forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadS [PreExp ext loc dec]
$creadsPrec :: forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
Int -> ReadS (PreExp ext loc dec)
readsPrec :: Int -> ReadS (PreExp ext loc dec)
$creadList :: forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadS [PreExp ext loc dec]
readList :: ReadS [PreExp ext loc dec]
$creadPrec :: forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadPrec (PreExp ext loc dec)
readPrec :: ReadPrec (PreExp ext loc dec)
$creadListPrec :: forall (ext :: * -> * -> *) loc dec.
(Read loc, Read dec, Read (ext loc dec)) =>
ReadPrec [PreExp ext loc dec]
readListPrec :: ReadPrec [PreExp ext loc dec]
Read, PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
(PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> (PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> Eq (PreExp ext loc dec)
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
forall (ext :: * -> * -> *) loc dec.
(Eq loc, Eq dec, Eq (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$c== :: forall (ext :: * -> * -> *) loc dec.
(Eq loc, Eq dec, Eq (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
== :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$c/= :: forall (ext :: * -> * -> *) loc dec.
(Eq loc, Eq dec, Eq (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
/= :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
Eq, Eq (PreExp ext loc dec)
Eq (PreExp ext loc dec)
-> (PreExp ext loc dec -> PreExp ext loc dec -> Ordering)
-> (PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> (PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> (PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> (PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed)
-> (PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec)
-> (PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec)
-> Ord (PreExp ext loc dec)
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
PreExp ext loc dec -> PreExp ext loc dec -> Ordering
PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ext :: * -> * -> *} {loc} {dec}.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
Eq (PreExp ext loc dec)
forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> Ordering
forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
$ccompare :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> Ordering
compare :: PreExp ext loc dec -> PreExp ext loc dec -> Ordering
$c< :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
< :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$c<= :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
<= :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$c> :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
> :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$c>= :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
>= :: PreExp ext loc dec -> PreExp ext loc dec -> IsBoxed
$cmax :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
max :: PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
$cmin :: forall (ext :: * -> * -> *) loc dec.
(Ord loc, Ord dec, Ord (ext loc dec)) =>
PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
min :: PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
Ord, (forall x. PreExp ext loc dec -> Rep (PreExp ext loc dec) x)
-> (forall x. Rep (PreExp ext loc dec) x -> PreExp ext loc dec)
-> Generic (PreExp ext loc dec)
forall x. Rep (PreExp ext loc dec) x -> PreExp ext loc dec
forall x. PreExp ext loc dec -> Rep (PreExp ext loc dec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (ext :: * -> * -> *) loc dec x.
Rep (PreExp ext loc dec) x -> PreExp ext loc dec
forall (ext :: * -> * -> *) loc dec x.
PreExp ext loc dec -> Rep (PreExp ext loc dec) x
$cfrom :: forall (ext :: * -> * -> *) loc dec x.
PreExp ext loc dec -> Rep (PreExp ext loc dec) x
from :: forall x. PreExp ext loc dec -> Rep (PreExp ext loc dec) x
$cto :: forall (ext :: * -> * -> *) loc dec x.
Rep (PreExp ext loc dec) x -> PreExp ext loc dec
to :: forall x. Rep (PreExp ext loc dec) x -> PreExp ext loc dec
Generic, PreExp ext loc dec -> ()
(PreExp ext loc dec -> ()) -> NFData (PreExp ext loc dec)
forall a. (a -> ()) -> NFData a
forall (ext :: * -> * -> *) loc dec.
(NFData loc, NFData dec, NFData (ext loc dec)) =>
PreExp ext loc dec -> ()
$crnf :: forall (ext :: * -> * -> *) loc dec.
(NFData loc, NFData dec, NFData (ext loc dec)) =>
PreExp ext loc dec -> ()
rnf :: PreExp ext loc dec -> ()
NFData, (forall a b. (a -> b) -> PreExp ext loc a -> PreExp ext loc b)
-> (forall a b. a -> PreExp ext loc b -> PreExp ext loc a)
-> Functor (PreExp ext loc)
forall a b. a -> PreExp ext loc b -> PreExp ext loc a
forall a b. (a -> b) -> PreExp ext loc a -> PreExp ext loc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (ext :: * -> * -> *) loc a b.
Functor (ext loc) =>
a -> PreExp ext loc b -> PreExp ext loc a
forall (ext :: * -> * -> *) loc a b.
Functor (ext loc) =>
(a -> b) -> PreExp ext loc a -> PreExp ext loc b
$cfmap :: forall (ext :: * -> * -> *) loc a b.
Functor (ext loc) =>
(a -> b) -> PreExp ext loc a -> PreExp ext loc b
fmap :: forall a b. (a -> b) -> PreExp ext loc a -> PreExp ext loc b
$c<$ :: forall (ext :: * -> * -> *) loc a b.
Functor (ext loc) =>
a -> PreExp ext loc b -> PreExp ext loc a
<$ :: forall a b. a -> PreExp ext loc b -> PreExp ext loc a
Functor, (forall m. Monoid m => PreExp ext loc m -> m)
-> (forall m a. Monoid m => (a -> m) -> PreExp ext loc a -> m)
-> (forall m a. Monoid m => (a -> m) -> PreExp ext loc a -> m)
-> (forall a b. (a -> b -> b) -> b -> PreExp ext loc a -> b)
-> (forall a b. (a -> b -> b) -> b -> PreExp ext loc a -> b)
-> (forall b a. (b -> a -> b) -> b -> PreExp ext loc a -> b)
-> (forall b a. (b -> a -> b) -> b -> PreExp ext loc a -> b)
-> (forall a. (a -> a -> a) -> PreExp ext loc a -> a)
-> (forall a. (a -> a -> a) -> PreExp ext loc a -> a)
-> (forall a. PreExp ext loc a -> [a])
-> (forall a. PreExp ext loc a -> IsBoxed)
-> (forall a. PreExp ext loc a -> Int)
-> (forall a. Eq a => a -> PreExp ext loc a -> IsBoxed)
-> (forall a. Ord a => PreExp ext loc a -> a)
-> (forall a. Ord a => PreExp ext loc a -> a)
-> (forall a. Num a => PreExp ext loc a -> a)
-> (forall a. Num a => PreExp ext loc a -> a)
-> Foldable (PreExp ext loc)
forall a. Eq a => a -> PreExp ext loc a -> IsBoxed
forall a. Num a => PreExp ext loc a -> a
forall a. Ord a => PreExp ext loc a -> a
forall m. Monoid m => PreExp ext loc m -> m
forall a. PreExp ext loc a -> IsBoxed
forall a. PreExp ext loc a -> Int
forall a. PreExp ext loc a -> [a]
forall a. (a -> a -> a) -> PreExp ext loc a -> a
forall m a. Monoid m => (a -> m) -> PreExp ext loc a -> m
forall b a. (b -> a -> b) -> b -> PreExp ext loc a -> b
forall a b. (a -> b -> b) -> b -> PreExp ext loc a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> IsBoxed)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> IsBoxed)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Eq a) =>
a -> PreExp ext loc a -> IsBoxed
forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Num a) =>
PreExp ext loc a -> a
forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Ord a) =>
PreExp ext loc a -> a
forall (ext :: * -> * -> *) loc m.
(Foldable (ext loc), Monoid m) =>
PreExp ext loc m -> m
forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> IsBoxed
forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> Int
forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> [a]
forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
(a -> a -> a) -> PreExp ext loc a -> a
forall (ext :: * -> * -> *) loc m a.
(Foldable (ext loc), Monoid m) =>
(a -> m) -> PreExp ext loc a -> m
forall (ext :: * -> * -> *) loc b a.
Foldable (ext loc) =>
(b -> a -> b) -> b -> PreExp ext loc a -> b
forall (ext :: * -> * -> *) loc a b.
Foldable (ext loc) =>
(a -> b -> b) -> b -> PreExp ext loc a -> b
$cfold :: forall (ext :: * -> * -> *) loc m.
(Foldable (ext loc), Monoid m) =>
PreExp ext loc m -> m
fold :: forall m. Monoid m => PreExp ext loc m -> m
$cfoldMap :: forall (ext :: * -> * -> *) loc m a.
(Foldable (ext loc), Monoid m) =>
(a -> m) -> PreExp ext loc a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PreExp ext loc a -> m
$cfoldMap' :: forall (ext :: * -> * -> *) loc m a.
(Foldable (ext loc), Monoid m) =>
(a -> m) -> PreExp ext loc a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PreExp ext loc a -> m
$cfoldr :: forall (ext :: * -> * -> *) loc a b.
Foldable (ext loc) =>
(a -> b -> b) -> b -> PreExp ext loc a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PreExp ext loc a -> b
$cfoldr' :: forall (ext :: * -> * -> *) loc a b.
Foldable (ext loc) =>
(a -> b -> b) -> b -> PreExp ext loc a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PreExp ext loc a -> b
$cfoldl :: forall (ext :: * -> * -> *) loc b a.
Foldable (ext loc) =>
(b -> a -> b) -> b -> PreExp ext loc a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PreExp ext loc a -> b
$cfoldl' :: forall (ext :: * -> * -> *) loc b a.
Foldable (ext loc) =>
(b -> a -> b) -> b -> PreExp ext loc a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PreExp ext loc a -> b
$cfoldr1 :: forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
(a -> a -> a) -> PreExp ext loc a -> a
foldr1 :: forall a. (a -> a -> a) -> PreExp ext loc a -> a
$cfoldl1 :: forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
(a -> a -> a) -> PreExp ext loc a -> a
foldl1 :: forall a. (a -> a -> a) -> PreExp ext loc a -> a
$ctoList :: forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> [a]
toList :: forall a. PreExp ext loc a -> [a]
$cnull :: forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> IsBoxed
null :: forall a. PreExp ext loc a -> IsBoxed
$clength :: forall (ext :: * -> * -> *) loc a.
Foldable (ext loc) =>
PreExp ext loc a -> Int
length :: forall a. PreExp ext loc a -> Int
$celem :: forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Eq a) =>
a -> PreExp ext loc a -> IsBoxed
elem :: forall a. Eq a => a -> PreExp ext loc a -> IsBoxed
$cmaximum :: forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Ord a) =>
PreExp ext loc a -> a
maximum :: forall a. Ord a => PreExp ext loc a -> a
$cminimum :: forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Ord a) =>
PreExp ext loc a -> a
minimum :: forall a. Ord a => PreExp ext loc a -> a
$csum :: forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Num a) =>
PreExp ext loc a -> a
sum :: forall a. Num a => PreExp ext loc a -> a
$cproduct :: forall (ext :: * -> * -> *) loc a.
(Foldable (ext loc), Num a) =>
PreExp ext loc a -> a
product :: forall a. Num a => PreExp ext loc a -> a
Foldable, Functor (PreExp ext loc)
Foldable (PreExp ext loc)
Functor (PreExp ext loc)
-> Foldable (PreExp ext loc)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PreExp ext loc a -> f (PreExp ext loc b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PreExp ext loc (f a) -> f (PreExp ext loc a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PreExp ext loc a -> m (PreExp ext loc b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PreExp ext loc (m a) -> m (PreExp ext loc a))
-> Traversable (PreExp ext loc)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PreExp ext loc (m a) -> m (PreExp ext loc a)
forall (f :: * -> *) a.
Applicative f =>
PreExp ext loc (f a) -> f (PreExp ext loc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreExp ext loc a -> m (PreExp ext loc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreExp ext loc a -> f (PreExp ext loc b)
forall {ext :: * -> * -> *} {loc}.
Traversable (ext loc) =>
Functor (PreExp ext loc)
forall {ext :: * -> * -> *} {loc}.
Traversable (ext loc) =>
Foldable (PreExp ext loc)
forall (ext :: * -> * -> *) loc (m :: * -> *) a.
(Traversable (ext loc), Monad m) =>
PreExp ext loc (m a) -> m (PreExp ext loc a)
forall (ext :: * -> * -> *) loc (f :: * -> *) a.
(Traversable (ext loc), Applicative f) =>
PreExp ext loc (f a) -> f (PreExp ext loc a)
forall (ext :: * -> * -> *) loc (m :: * -> *) a b.
(Traversable (ext loc), Monad m) =>
(a -> m b) -> PreExp ext loc a -> m (PreExp ext loc b)
forall (ext :: * -> * -> *) loc (f :: * -> *) a b.
(Traversable (ext loc), Applicative f) =>
(a -> f b) -> PreExp ext loc a -> f (PreExp ext loc b)
$ctraverse :: forall (ext :: * -> * -> *) loc (f :: * -> *) a b.
(Traversable (ext loc), Applicative f) =>
(a -> f b) -> PreExp ext loc a -> f (PreExp ext loc b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PreExp ext loc a -> f (PreExp ext loc b)
$csequenceA :: forall (ext :: * -> * -> *) loc (f :: * -> *) a.
(Traversable (ext loc), Applicative f) =>
PreExp ext loc (f a) -> f (PreExp ext loc a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PreExp ext loc (f a) -> f (PreExp ext loc a)
$cmapM :: forall (ext :: * -> * -> *) loc (m :: * -> *) a b.
(Traversable (ext loc), Monad m) =>
(a -> m b) -> PreExp ext loc a -> m (PreExp ext loc b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PreExp ext loc a -> m (PreExp ext loc b)
$csequence :: forall (ext :: * -> * -> *) loc (m :: * -> *) a.
(Traversable (ext loc), Monad m) =>
PreExp ext loc (m a) -> m (PreExp ext loc a)
sequence :: forall (m :: * -> *) a.
Monad m =>
PreExp ext loc (m a) -> m (PreExp ext loc a)
Traversable, Int -> PreExp ext loc dec -> Doc
[PreExp ext loc dec] -> Doc
PreExp ext loc dec -> Doc
(Int -> PreExp ext loc dec -> Doc)
-> (PreExp ext loc dec -> Doc)
-> ([PreExp ext loc dec] -> Doc)
-> Out (PreExp ext loc dec)
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
Int -> PreExp ext loc dec -> Doc
forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
[PreExp ext loc dec] -> Doc
forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
PreExp ext loc dec -> Doc
$cdocPrec :: forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
Int -> PreExp ext loc dec -> Doc
docPrec :: Int -> PreExp ext loc dec -> Doc
$cdoc :: forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
PreExp ext loc dec -> Doc
doc :: PreExp ext loc dec -> Doc
$cdocList :: forall (ext :: * -> * -> *) loc dec.
(Out loc, Out dec, Out (ext loc dec)) =>
[PreExp ext loc dec] -> Doc
docList :: [PreExp ext loc dec] -> Doc
Out)


--------------------------------------------------------------------------------
-- Primitives
--------------------------------------------------------------------------------

-- | Some of these primitives are (temporarily) tagged directly with
-- their return types.
data Prim ty
          = AddP | SubP | MulP -- ^ May need more numeric primitives...
          | DivP | ModP        -- ^ Integer division and modulus
          | ExpP               -- ^ Exponentiation
          | RandP              -- ^ Generate a random number.
                               --   Translates to 'rand()' in C.
          | EqIntP             -- ^ Equality on Int
          | LtP | GtP          -- ^ (<) and (>) for Int's
          | LtEqP | GtEqP      -- ^ <= and >=
          | FAddP | FSubP | FMulP | FDivP | FExpP | FRandP | EqFloatP | EqCharP | FLtP | FGtP | FLtEqP | FGtEqP | FSqrtP | IntToFloatP | FloatToIntP
          | FTanP              -- ^ Translates to 'tan()' in C.
          | EqSymP             -- ^ Equality on Sym
          | EqBenchProgP String
          | OrP | AndP
          | MkTrue  -- ^ Zero argument constructor.
          | MkFalse -- ^ Zero argument constructor.

          | ErrorP String ty
              -- ^ crash and issue a static error message.
              --   To avoid needing inference, this is labeled with a return type.

          | SizeParam

          | IsBig   -- ^ Check the size of constructors with size.
          | GetNumProcessors -- ^ Return the number of processors

          | PrintInt   -- ^ Print an integer to standard out
          | PrintChar   -- ^ Print a character to standard out
          | PrintFloat -- ^ Print a floating point number to standard out
          | PrintBool  -- ^ Print a boolean to standard out
          | PrintSym   -- ^ Print a symbol to standard out
          | ReadInt  -- ^ Read an int from standard in

          -- Dictionaries.

          | DictInsertP ty     -- ^ takes dict, k,v; annotated with element type
          | DictLookupP ty     -- ^ takes dict,k errors if absent; annotated with element type
          | DictEmptyP  ty     -- ^ annotated with element type to avoid ambiguity
          | DictHasKeyP ty     -- ^ takes dict,k; returns a Bool, annotated with element type

          | SymSetEmpty    -- ^ Creates an empty set
          | SymSetInsert   -- ^ Inserts a symbol into a set of symbols
          | SymSetContains -- ^ Queries if a symbol is in a set

          | SymHashEmpty   -- ^ Create empty hash table of symbols
          | SymHashInsert  -- ^ Insert a symbol into a hash table
          | SymHashLookup  -- ^ Look up a symbol in a hash table (takes default symbol)
          | SymHashContains -- ^ Queries if a symbol is in a hash

          | IntHashEmpty   -- ^ Create empty hash table of integers
          | IntHashInsert  -- ^ Insert an integer into a hash table
          | IntHashLookup  -- ^ Look up a integer in a hash table (takes default integer)

          -- Thread safe dictionaries.
          | PDictAllocP  ty ty -- ^ annotated with element type to avoid ambiguity
          | PDictInsertP ty ty -- ^ takes dict, k, v; annotated with element type
          | PDictLookupP ty ty -- ^ takes dict, k. errors if absent; annotated with element type
          | PDictHasKeyP ty ty -- ^ takes dict,k; returns a Bool, annotated with element type
          | PDictForkP ty ty   -- ^ takes dict; returns thread safe safe dicts.
          | PDictJoinP ty ty   -- ^ takes 2 dicts; returns a merged dict.

          -- Linked Lists.
          | LLAllocP ty
          | LLIsEmptyP ty
          | LLConsP ty
          | LLHeadP ty
          | LLTailP ty
          | LLFreeP ty    -- ^ Free the list, and it's data.
          | LLFree2P ty   -- ^ Free list struct, but not it's data.
          | LLCopyP ty    -- ^ Copy the list node.

          -- Operations on vectors
          | VAllocP ty   -- ^ Allocate a vector
          | VFreeP ty    -- ^ Free a vector, and it's data.
          | VFree2P ty   -- ^ Free the vector struct, but not it's data.
          | VLengthP ty -- ^ Length of the vector
          | VNthP ty    -- ^ Fetch the nth element
          | VSliceP ty         -- ^ An efficient slice operation
          | InplaceVUpdateP ty -- ^ Update ith element of the vector
          | VConcatP ty        -- ^ Flatten a vector
          | VSortP ty          -- ^ A sort primop that accepts a function pointer
          | InplaceVSortP ty   -- ^ A sort primop that sorts the array in place
          | VMergeP ty         -- ^ ASSUMPTION: the vectors being merged have the same
                               --   underlying mutable array. This assumption is checked
                               --   at the type level with a Rank-2 type variable. But this
                               --   evidence is erased (by the desugarer) by the time we get
                               --   to L0.

          | Write3dPpmFile FilePath

          | ReadPackedFile (Maybe FilePath) TyCon (Maybe Var) ty
            -- ^ Read (mmap) a binary file containing packed data.  This must be annotated with the
            -- type of the file being read.  The `Ty` tracks the type as the program evolvels
            -- (first PackedTy then CursorTy).  The TyCon tracks the original type name.
            -- The variable represents the region that this file will be mapped to, and is
            -- set by InferLocations.

          | WritePackedFile FilePath ty
            -- ^ Write a packed value to a file.
            -- To enable re-reading this packed value with Gibbon, this primitive gets rid
            -- of any absolute pointers in the value. First, it inlines (by copying) any
            -- regions pointed to by the packed value. Next, random access nodes are eliminated.
            -- We could change them to relative pointers (numeric offsets),
            -- but for a first version we can simplify things by getting rid of them completely.

          | ReadArrayFile (Maybe (FilePath, Int)) ty
            -- ^ Parse a file into a Vector. This is decorated with the
            -- element type. If the element type is a struct,
            -- like (Int, Int) for example, each line must contain 2 numbers
            -- separated by a space. The Int is the number of lines in the
            -- file.    
  | RequestEndOf
          -- ^ Conveys a demand for the "end of" some packed value, which is
          -- fulfilled by Cursorize. N.B. the argument must be a VarE that
          -- refers to a packed value.

          | RequestSizeOf
          -- ^ Like 'RequestEndOf' but gets the size of a packed value. Assume
          -- that the value is written in a contiguous region, and size = end_v - v.

          | Gensym

  deriving (ReadPrec [Prim ty]
ReadPrec (Prim ty)
Int -> ReadS (Prim ty)
ReadS [Prim ty]
(Int -> ReadS (Prim ty))
-> ReadS [Prim ty]
-> ReadPrec (Prim ty)
-> ReadPrec [Prim ty]
-> Read (Prim ty)
forall ty. Read ty => ReadPrec [Prim ty]
forall ty. Read ty => ReadPrec (Prim ty)
forall ty. Read ty => Int -> ReadS (Prim ty)
forall ty. Read ty => ReadS [Prim ty]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall ty. Read ty => Int -> ReadS (Prim ty)
readsPrec :: Int -> ReadS (Prim ty)
$creadList :: forall ty. Read ty => ReadS [Prim ty]
readList :: ReadS [Prim ty]
$creadPrec :: forall ty. Read ty => ReadPrec (Prim ty)
readPrec :: ReadPrec (Prim ty)
$creadListPrec :: forall ty. Read ty => ReadPrec [Prim ty]
readListPrec :: ReadPrec [Prim ty]
Read, Int -> Prim ty -> ShowS
[Prim ty] -> ShowS
Prim ty -> DataCon
(Int -> Prim ty -> ShowS)
-> (Prim ty -> DataCon) -> ([Prim ty] -> ShowS) -> Show (Prim ty)
forall ty. Show ty => Int -> Prim ty -> ShowS
forall ty. Show ty => [Prim ty] -> ShowS
forall ty. Show ty => Prim ty -> DataCon
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ty. Show ty => Int -> Prim ty -> ShowS
showsPrec :: Int -> Prim ty -> ShowS
$cshow :: forall ty. Show ty => Prim ty -> DataCon
show :: Prim ty -> DataCon
$cshowList :: forall ty. Show ty => [Prim ty] -> ShowS
showList :: [Prim ty] -> ShowS
Show, Prim ty -> Prim ty -> IsBoxed
(Prim ty -> Prim ty -> IsBoxed)
-> (Prim ty -> Prim ty -> IsBoxed) -> Eq (Prim ty)
forall ty. Eq ty => Prim ty -> Prim ty -> IsBoxed
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: forall ty. Eq ty => Prim ty -> Prim ty -> IsBoxed
== :: Prim ty -> Prim ty -> IsBoxed
$c/= :: forall ty. Eq ty => Prim ty -> Prim ty -> IsBoxed
/= :: Prim ty -> Prim ty -> IsBoxed
Eq, Eq (Prim ty)
Eq (Prim ty)
-> (Prim ty -> Prim ty -> Ordering)
-> (Prim ty -> Prim ty -> IsBoxed)
-> (Prim ty -> Prim ty -> IsBoxed)
-> (Prim ty -> Prim ty -> IsBoxed)
-> (Prim ty -> Prim ty -> IsBoxed)
-> (Prim ty -> Prim ty -> Prim ty)
-> (Prim ty -> Prim ty -> Prim ty)
-> Ord (Prim ty)
Prim ty -> Prim ty -> IsBoxed
Prim ty -> Prim ty -> Ordering
Prim ty -> Prim ty -> Prim ty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ty}. Ord ty => Eq (Prim ty)
forall ty. Ord ty => Prim ty -> Prim ty -> IsBoxed
forall ty. Ord ty => Prim ty -> Prim ty -> Ordering
forall ty. Ord ty => Prim ty -> Prim ty -> Prim ty
$ccompare :: forall ty. Ord ty => Prim ty -> Prim ty -> Ordering
compare :: Prim ty -> Prim ty -> Ordering
$c< :: forall ty. Ord ty => Prim ty -> Prim ty -> IsBoxed
< :: Prim ty -> Prim ty -> IsBoxed
$c<= :: forall ty. Ord ty => Prim ty -> Prim ty -> IsBoxed
<= :: Prim ty -> Prim ty -> IsBoxed
$c> :: forall ty. Ord ty => Prim ty -> Prim ty -> IsBoxed
> :: Prim ty -> Prim ty -> IsBoxed
$c>= :: forall ty. Ord ty => Prim ty -> Prim ty -> IsBoxed
>= :: Prim ty -> Prim ty -> IsBoxed
$cmax :: forall ty. Ord ty => Prim ty -> Prim ty -> Prim ty
max :: Prim ty -> Prim ty -> Prim ty
$cmin :: forall ty. Ord ty => Prim ty -> Prim ty -> Prim ty
min :: Prim ty -> Prim ty -> Prim ty
Ord, (forall x. Prim ty -> Rep (Prim ty) x)
-> (forall x. Rep (Prim ty) x -> Prim ty) -> Generic (Prim ty)
forall x. Rep (Prim ty) x -> Prim ty
forall x. Prim ty -> Rep (Prim ty) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ty x. Rep (Prim ty) x -> Prim ty
forall ty x. Prim ty -> Rep (Prim ty) x
$cfrom :: forall ty x. Prim ty -> Rep (Prim ty) x
from :: forall x. Prim ty -> Rep (Prim ty) x
$cto :: forall ty x. Rep (Prim ty) x -> Prim ty
to :: forall x. Rep (Prim ty) x -> Prim ty
Generic, Prim ty -> ()
(Prim ty -> ()) -> NFData (Prim ty)
forall ty. NFData ty => Prim ty -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall ty. NFData ty => Prim ty -> ()
rnf :: Prim ty -> ()
NFData, (forall a b. (a -> b) -> Prim a -> Prim b)
-> (forall a b. a -> Prim b -> Prim a) -> Functor Prim
forall a b. a -> Prim b -> Prim a
forall a b. (a -> b) -> Prim a -> Prim b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Prim a -> Prim b
fmap :: forall a b. (a -> b) -> Prim a -> Prim b
$c<$ :: forall a b. a -> Prim b -> Prim a
<$ :: forall a b. a -> Prim b -> Prim a
Functor, (forall m. Monoid m => Prim m -> m)
-> (forall m a. Monoid m => (a -> m) -> Prim a -> m)
-> (forall m a. Monoid m => (a -> m) -> Prim a -> m)
-> (forall a b. (a -> b -> b) -> b -> Prim a -> b)
-> (forall a b. (a -> b -> b) -> b -> Prim a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prim a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prim a -> b)
-> (forall a. (a -> a -> a) -> Prim a -> a)
-> (forall a. (a -> a -> a) -> Prim a -> a)
-> (forall a. Prim a -> [a])
-> (forall a. Prim a -> IsBoxed)
-> (forall a. Prim a -> Int)
-> (forall a. Eq a => a -> Prim a -> IsBoxed)
-> (forall a. Ord a => Prim a -> a)
-> (forall a. Ord a => Prim a -> a)
-> (forall a. Num a => Prim a -> a)
-> (forall a. Num a => Prim a -> a)
-> Foldable Prim
forall a. Eq a => a -> Prim a -> IsBoxed
forall a. Num a => Prim a -> a
forall a. Ord a => Prim a -> a
forall m. Monoid m => Prim m -> m
forall a. Prim a -> IsBoxed
forall a. Prim a -> Int
forall a. Prim a -> [a]
forall a. (a -> a -> a) -> Prim a -> a
forall m a. Monoid m => (a -> m) -> Prim a -> m
forall b a. (b -> a -> b) -> b -> Prim a -> b
forall a b. (a -> b -> b) -> b -> Prim a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> IsBoxed)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> IsBoxed)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Prim m -> m
fold :: forall m. Monoid m => Prim m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Prim a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Prim a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Prim a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Prim a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Prim a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Prim a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Prim a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Prim a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Prim a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Prim a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Prim a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Prim a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Prim a -> a
foldr1 :: forall a. (a -> a -> a) -> Prim a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Prim a -> a
foldl1 :: forall a. (a -> a -> a) -> Prim a -> a
$ctoList :: forall a. Prim a -> [a]
toList :: forall a. Prim a -> [a]
$cnull :: forall a. Prim a -> IsBoxed
null :: forall a. Prim a -> IsBoxed
$clength :: forall a. Prim a -> Int
length :: forall a. Prim a -> Int
$celem :: forall a. Eq a => a -> Prim a -> IsBoxed
elem :: forall a. Eq a => a -> Prim a -> IsBoxed
$cmaximum :: forall a. Ord a => Prim a -> a
maximum :: forall a. Ord a => Prim a -> a
$cminimum :: forall a. Ord a => Prim a -> a
minimum :: forall a. Ord a => Prim a -> a
$csum :: forall a. Num a => Prim a -> a
sum :: forall a. Num a => Prim a -> a
$cproduct :: forall a. Num a => Prim a -> a
product :: forall a. Num a => Prim a -> a
Foldable, Functor Prim
Foldable Prim
Functor Prim
-> Foldable Prim
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Prim a -> f (Prim b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Prim (f a) -> f (Prim a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Prim a -> m (Prim b))
-> (forall (m :: * -> *) a. Monad m => Prim (m a) -> m (Prim a))
-> Traversable Prim
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Prim (m a) -> m (Prim a)
forall (f :: * -> *) a. Applicative f => Prim (f a) -> f (Prim a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Prim a -> m (Prim b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Prim a -> f (Prim b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Prim a -> f (Prim b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Prim a -> f (Prim b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Prim (f a) -> f (Prim a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Prim (f a) -> f (Prim a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Prim a -> m (Prim b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Prim a -> m (Prim b)
$csequence :: forall (m :: * -> *) a. Monad m => Prim (m a) -> m (Prim a)
sequence :: forall (m :: * -> *) a. Monad m => Prim (m a) -> m (Prim a)
Traversable, Int -> Prim ty -> Doc
[Prim ty] -> Doc
Prim ty -> Doc
(Int -> Prim ty -> Doc)
-> (Prim ty -> Doc) -> ([Prim ty] -> Doc) -> Out (Prim ty)
forall ty. Out ty => Int -> Prim ty -> Doc
forall ty. Out ty => [Prim ty] -> Doc
forall ty. Out ty => Prim ty -> Doc
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: forall ty. Out ty => Int -> Prim ty -> Doc
docPrec :: Int -> Prim ty -> Doc
$cdoc :: forall ty. Out ty => Prim ty -> Doc
doc :: Prim ty -> Doc
$cdocList :: forall ty. Out ty => [Prim ty] -> Doc
docList :: [Prim ty] -> Doc
Out)


--------------------------------------------------------------------------------
-- Types
--------------------------------------------------------------------------------

-- | Types include boxed/pointer-based products as well as unpacked
-- algebraic datatypes.  This data is parameterized to allow
-- annotation on Packed types later on.
data UrTy loc
  = IntTy
  | CharTy
  | FloatTy
  | SymTy -- ^ Symbols used in writing compiler passes.
  | BoolTy
  | ProdTy [UrTy loc] -- ^ An N-ary tuple
  | SymDictTy (Maybe Var) (UrTy ()) -- ^ A map from SymTy to Ty
          -- ^ We allow built-in dictionaries from symbols to a value type.
  | PackedTy TyCon loc -- ^ No type arguments to TyCons for now.  (No polymorphism.)
  | VectorTy (UrTy loc) -- ^ Vectors are decorated with the types of their elements;
                             -- which can only include scalars or flat products of scalars.
  | PDictTy (UrTy loc) (UrTy loc) -- ^ Thread safe dictionaries decorated with
                                    -- key and value type.
  | ListTy (UrTy loc) -- ^ Linked lists are decorated with the types of their elements;
                          -- which can only include scalars or flat products of scalars.

        | ArenaTy -- ^ Collection of allocated, non-packed values

        | SymSetTy -- ^ Set of symbols

        | SymHashTy  -- ^ Hash table of symbols

        | IntHashTy -- ^ Hash table of integers

        ---------- These are not used initially ----------------
        -- (They could be added by a later IR instead:)

        | PtrTy -- ^ A machine pointer tvo a complete value in memory.
                -- This is decorated with the region it points into, which
                -- may affect the memory layout.

        | CursorTy -- ^ A cursor for reading or writing, which may point
                   -- to an unkwown type or to a fraction of a complete value.
                   -- It is a machine pointer that can point to any byte.

  deriving (Int -> UrTy loc -> ShowS
[UrTy loc] -> ShowS
UrTy loc -> DataCon
(Int -> UrTy loc -> ShowS)
-> (UrTy loc -> DataCon)
-> ([UrTy loc] -> ShowS)
-> Show (UrTy loc)
forall loc. Show loc => Int -> UrTy loc -> ShowS
forall loc. Show loc => [UrTy loc] -> ShowS
forall loc. Show loc => UrTy loc -> DataCon
forall a.
(Int -> a -> ShowS) -> (a -> DataCon) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall loc. Show loc => Int -> UrTy loc -> ShowS
showsPrec :: Int -> UrTy loc -> ShowS
$cshow :: forall loc. Show loc => UrTy loc -> DataCon
show :: UrTy loc -> DataCon
$cshowList :: forall loc. Show loc => [UrTy loc] -> ShowS
showList :: [UrTy loc] -> ShowS
Show, ReadPrec [UrTy loc]
ReadPrec (UrTy loc)
Int -> ReadS (UrTy loc)
ReadS [UrTy loc]
(Int -> ReadS (UrTy loc))
-> ReadS [UrTy loc]
-> ReadPrec (UrTy loc)
-> ReadPrec [UrTy loc]
-> Read (UrTy loc)
forall loc. Read loc => ReadPrec [UrTy loc]
forall loc. Read loc => ReadPrec (UrTy loc)
forall loc. Read loc => Int -> ReadS (UrTy loc)
forall loc. Read loc => ReadS [UrTy loc]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall loc. Read loc => Int -> ReadS (UrTy loc)
readsPrec :: Int -> ReadS (UrTy loc)
$creadList :: forall loc. Read loc => ReadS [UrTy loc]
readList :: ReadS [UrTy loc]
$creadPrec :: forall loc. Read loc => ReadPrec (UrTy loc)
readPrec :: ReadPrec (UrTy loc)
$creadListPrec :: forall loc. Read loc => ReadPrec [UrTy loc]
readListPrec :: ReadPrec [UrTy loc]
Read, Eq (UrTy loc)
Eq (UrTy loc)
-> (UrTy loc -> UrTy loc -> Ordering)
-> (UrTy loc -> UrTy loc -> IsBoxed)
-> (UrTy loc -> UrTy loc -> IsBoxed)
-> (UrTy loc -> UrTy loc -> IsBoxed)
-> (UrTy loc -> UrTy loc -> IsBoxed)
-> (UrTy loc -> UrTy loc -> UrTy loc)
-> (UrTy loc -> UrTy loc -> UrTy loc)
-> Ord (UrTy loc)
UrTy loc -> UrTy loc -> IsBoxed
UrTy loc -> UrTy loc -> Ordering
UrTy loc -> UrTy loc -> UrTy loc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {loc}. Ord loc => Eq (UrTy loc)
forall loc. Ord loc => UrTy loc -> UrTy loc -> IsBoxed
forall loc. Ord loc => UrTy loc -> UrTy loc -> Ordering
forall loc. Ord loc => UrTy loc -> UrTy loc -> UrTy loc
$ccompare :: forall loc. Ord loc => UrTy loc -> UrTy loc -> Ordering
compare :: UrTy loc -> UrTy loc -> Ordering
$c< :: forall loc. Ord loc => UrTy loc -> UrTy loc -> IsBoxed
< :: UrTy loc -> UrTy loc -> IsBoxed
$c<= :: forall loc. Ord loc => UrTy loc -> UrTy loc -> IsBoxed
<= :: UrTy loc -> UrTy loc -> IsBoxed
$c> :: forall loc. Ord loc => UrTy loc -> UrTy loc -> IsBoxed
> :: UrTy loc -> UrTy loc -> IsBoxed
$c>= :: forall loc. Ord loc => UrTy loc -> UrTy loc -> IsBoxed
>= :: UrTy loc -> UrTy loc -> IsBoxed
$cmax :: forall loc. Ord loc => UrTy loc -> UrTy loc -> UrTy loc
max :: UrTy loc -> UrTy loc -> UrTy loc
$cmin :: forall loc. Ord loc => UrTy loc -> UrTy loc -> UrTy loc
min :: UrTy loc -> UrTy loc -> UrTy loc
Ord, UrTy loc -> UrTy loc -> IsBoxed
(UrTy loc -> UrTy loc -> IsBoxed)
-> (UrTy loc -> UrTy loc -> IsBoxed) -> Eq (UrTy loc)
forall loc. Eq loc => UrTy loc -> UrTy loc -> IsBoxed
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: forall loc. Eq loc => UrTy loc -> UrTy loc -> IsBoxed
== :: UrTy loc -> UrTy loc -> IsBoxed
$c/= :: forall loc. Eq loc => UrTy loc -> UrTy loc -> IsBoxed
/= :: UrTy loc -> UrTy loc -> IsBoxed
Eq, (forall x. UrTy loc -> Rep (UrTy loc) x)
-> (forall x. Rep (UrTy loc) x -> UrTy loc) -> Generic (UrTy loc)
forall x. Rep (UrTy loc) x -> UrTy loc
forall x. UrTy loc -> Rep (UrTy loc) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc x. Rep (UrTy loc) x -> UrTy loc
forall loc x. UrTy loc -> Rep (UrTy loc) x
$cfrom :: forall loc x. UrTy loc -> Rep (UrTy loc) x
from :: forall x. UrTy loc -> Rep (UrTy loc) x
$cto :: forall loc x. Rep (UrTy loc) x -> UrTy loc
to :: forall x. Rep (UrTy loc) x -> UrTy loc
Generic, UrTy loc -> ()
(UrTy loc -> ()) -> NFData (UrTy loc)
forall loc. NFData loc => UrTy loc -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall loc. NFData loc => UrTy loc -> ()
rnf :: UrTy loc -> ()
NFData, (forall a b. (a -> b) -> UrTy a -> UrTy b)
-> (forall a b. a -> UrTy b -> UrTy a) -> Functor UrTy
forall a b. a -> UrTy b -> UrTy a
forall a b. (a -> b) -> UrTy a -> UrTy b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UrTy a -> UrTy b
fmap :: forall a b. (a -> b) -> UrTy a -> UrTy b
$c<$ :: forall a b. a -> UrTy b -> UrTy a
<$ :: forall a b. a -> UrTy b -> UrTy a
Functor, (forall m. Monoid m => UrTy m -> m)
-> (forall m a. Monoid m => (a -> m) -> UrTy a -> m)
-> (forall m a. Monoid m => (a -> m) -> UrTy a -> m)
-> (forall a b. (a -> b -> b) -> b -> UrTy a -> b)
-> (forall a b. (a -> b -> b) -> b -> UrTy a -> b)
-> (forall b a. (b -> a -> b) -> b -> UrTy a -> b)
-> (forall b a. (b -> a -> b) -> b -> UrTy a -> b)
-> (forall a. (a -> a -> a) -> UrTy a -> a)
-> (forall a. (a -> a -> a) -> UrTy a -> a)
-> (forall a. UrTy a -> [a])
-> (forall a. UrTy a -> IsBoxed)
-> (forall a. UrTy a -> Int)
-> (forall a. Eq a => a -> UrTy a -> IsBoxed)
-> (forall a. Ord a => UrTy a -> a)
-> (forall a. Ord a => UrTy a -> a)
-> (forall a. Num a => UrTy a -> a)
-> (forall a. Num a => UrTy a -> a)
-> Foldable UrTy
forall a. Eq a => a -> UrTy a -> IsBoxed
forall a. Num a => UrTy a -> a
forall a. Ord a => UrTy a -> a
forall m. Monoid m => UrTy m -> m
forall a. UrTy a -> IsBoxed
forall a. UrTy a -> Int
forall a. UrTy a -> [a]
forall a. (a -> a -> a) -> UrTy a -> a
forall m a. Monoid m => (a -> m) -> UrTy a -> m
forall b a. (b -> a -> b) -> b -> UrTy a -> b
forall a b. (a -> b -> b) -> b -> UrTy a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> IsBoxed)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> IsBoxed)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => UrTy m -> m
fold :: forall m. Monoid m => UrTy m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> UrTy a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> UrTy a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> UrTy a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> UrTy a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> UrTy a -> b
foldr :: forall a b. (a -> b -> b) -> b -> UrTy a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> UrTy a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> UrTy a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> UrTy a -> b
foldl :: forall b a. (b -> a -> b) -> b -> UrTy a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> UrTy a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> UrTy a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> UrTy a -> a
foldr1 :: forall a. (a -> a -> a) -> UrTy a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> UrTy a -> a
foldl1 :: forall a. (a -> a -> a) -> UrTy a -> a
$ctoList :: forall a. UrTy a -> [a]
toList :: forall a. UrTy a -> [a]
$cnull :: forall a. UrTy a -> IsBoxed
null :: forall a. UrTy a -> IsBoxed
$clength :: forall a. UrTy a -> Int
length :: forall a. UrTy a -> Int
$celem :: forall a. Eq a => a -> UrTy a -> IsBoxed
elem :: forall a. Eq a => a -> UrTy a -> IsBoxed
$cmaximum :: forall a. Ord a => UrTy a -> a
maximum :: forall a. Ord a => UrTy a -> a
$cminimum :: forall a. Ord a => UrTy a -> a
minimum :: forall a. Ord a => UrTy a -> a
$csum :: forall a. Num a => UrTy a -> a
sum :: forall a. Num a => UrTy a -> a
$cproduct :: forall a. Num a => UrTy a -> a
product :: forall a. Num a => UrTy a -> a
Foldable, Functor UrTy
Foldable UrTy
Functor UrTy
-> Foldable UrTy
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> UrTy a -> f (UrTy b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    UrTy (f a) -> f (UrTy a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> UrTy a -> m (UrTy b))
-> (forall (m :: * -> *) a. Monad m => UrTy (m a) -> m (UrTy a))
-> Traversable UrTy
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => UrTy (m a) -> m (UrTy a)
forall (f :: * -> *) a. Applicative f => UrTy (f a) -> f (UrTy a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UrTy a -> m (UrTy b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UrTy a -> f (UrTy b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UrTy a -> f (UrTy b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UrTy a -> f (UrTy b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => UrTy (f a) -> f (UrTy a)
sequenceA :: forall (f :: * -> *) a. Applicative f => UrTy (f a) -> f (UrTy a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UrTy a -> m (UrTy b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UrTy a -> m (UrTy b)
$csequence :: forall (m :: * -> *) a. Monad m => UrTy (m a) -> m (UrTy a)
sequence :: forall (m :: * -> *) a. Monad m => UrTy (m a) -> m (UrTy a)
Traversable, Int -> UrTy loc -> Doc
[UrTy loc] -> Doc
UrTy loc -> Doc
(Int -> UrTy loc -> Doc)
-> (UrTy loc -> Doc) -> ([UrTy loc] -> Doc) -> Out (UrTy loc)
forall loc. Out loc => Int -> UrTy loc -> Doc
forall loc. Out loc => [UrTy loc] -> Doc
forall loc. Out loc => UrTy loc -> Doc
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: forall loc. Out loc => Int -> UrTy loc -> Doc
docPrec :: Int -> UrTy loc -> Doc
$cdoc :: forall loc. Out loc => UrTy loc -> Doc
doc :: UrTy loc -> Doc
$cdocList :: forall loc. Out loc => [UrTy loc] -> Doc
docList :: [UrTy loc] -> Doc
Out)


--------------------------------------------------------------------------------
-- Generic Ops
--------------------------------------------------------------------------------

-- | Expression and program types which support a notion of free variables.
class FreeVars a where
    -- | Return a set of free TERM variables.  Does not return location variables.
    gFreeVars :: a -> S.Set Var


-- | A generic interface to expressions found in different phases of
-- the compiler.
class (Show e, Out e, FreeVars e) => Expression e where
  -- | The type representation used in this expression.
  type TyOf e
  -- | The location (variable) representation used in this expression.
  type LocOf e
  -- | Is an expression considered trivial (duplicatable by the compiler)?
  isTrivial :: e -> Bool


-- | IRs amenable to flattening
class Expression e => Flattenable e where
  -- | Process an expression into a fully-flattened expression which typically includes a
  -- larger number of temporary, local variable bindings.
  gFlattenExp :: DDefs (TyOf e) -> Env2 (TyOf e) -> e -> PassM e

  -- | A private method.  Gather the bindings from a subexpression,
  -- but do not "discharge" them by creating a let expression.  They
  -- are in order, so later may depend on earlier.
  gFlattenGatherBinds :: DDefs (TyOf e) -> Env2 (TyOf e) -> e -> PassM ([Binds e],e)

type Binds e = (Var,[LocOf e],TyOf e, e)


-- | IRs amenable to simplification/inlineTrivs. Note that there's a
-- separate 'SimplifiableExt' for simplifying extensions. 'Simplifiable' is
-- the only class which makes such a distinction -- b/c when it's simplifying
-- an extension point, the type of the environment would still be 'M.Map Var e',
-- where e is a top-level IR. Right now we don't have a class (and probably
-- don't want to have one as well) which ties an extension point with an IR.
-- Keeping these classes separate works out nicely.
class Expression e => Simplifiable e where
  gInlineTrivExp :: M.Map Var e -> e -> e

class Expression e => SimplifiableExt e ext where
  gInlineTrivExt :: M.Map Var e -> ext -> ext

type HasSimplifiable e l d = ( Show l, Out l, Show d, Out d
                             , Expression (e l d)
                             , SimplifiableExt (PreExp e l d) (e l d)
                             )

type HasSimplifiableExt e l d = ( Show l, Out l, Show d, Out d
                                , Simplifiable (PreExp e l d)
                                )


-- | This is NOT a replacement for any typechecker. This only recover type of
-- an expression given a type-environment. Without this, we cannot have truly
-- generic Flattenable, b/c we need to know the type of an expression before we
-- bind it with a LetE.
class Expression e => Typeable e where
  gRecoverType :: DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e

-- | Generic substitution over expressions.
class Expression e => Substitutable e where
  gSubst  :: Var -> e -> e -> e
  gSubstE :: e   -> e -> e -> e

class Expression e => SubstitutableExt e ext where
  gSubstExt  :: Var -> e -> ext -> ext
  gSubstEExt :: e   -> e -> ext -> ext

type HasSubstitutable e l d = ( Expression (e l d)
                              , SubstitutableExt (PreExp e l d) (e l d)
                              , Eq d, Show d, Out d, Eq l, Show l, Out l
                              , Eq (e l d) )

type HasSubstitutableExt e l d = ( Eq d, Show d, Out d, Eq l, Show l, Out l
                                 , Substitutable (PreExp e l d) )

-- | Alpha renaming, without worrying about name capture -- assuming that Freshen
-- has run before!
class Renamable e where
  gRename :: M.Map Var Var -> e -> e

type HasRenamable e l d = (Renamable l, Renamable d, Renamable (e l d))

-- A convenience wrapper over some of the constraints.
type HasOut ex = (Out ex, Out (TyOf ex), Out (ArrowTy (TyOf ex)))
type HasShow ex = (Show ex, Show (TyOf ex), Show (ArrowTy (TyOf ex)))
type HasEq ex = (Eq ex, Eq (TyOf ex), Eq (ArrowTy (TyOf ex)))
type HasGeneric ex = (Generic ex, Generic (TyOf ex), Generic (ArrowTy (TyOf ex)))
type HasNFData ex = (NFData ex, NFData (TyOf ex), NFData (ArrowTy (TyOf ex)))

--------------------------------------------------------------------------------
-- Things which can be interpreted to yield a final, printed value.
--------------------------------------------------------------------------------

type ValEnv e = M.Map Var (Value e)
type InterpLog = Builder

newtype InterpM s e a = InterpM { forall s e a. InterpM s e a -> WriterT InterpLog (StateT s IO) a
unInterpM ::  WriterT InterpLog (StateT s IO) a }
    deriving newtype ((forall a b. (a -> b) -> InterpM s e a -> InterpM s e b)
-> (forall a b. a -> InterpM s e b -> InterpM s e a)
-> Functor (InterpM s e)
forall a b. a -> InterpM s e b -> InterpM s e a
forall a b. (a -> b) -> InterpM s e a -> InterpM s e b
forall s e a b. a -> InterpM s e b -> InterpM s e a
forall s e a b. (a -> b) -> InterpM s e a -> InterpM s e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s e a b. (a -> b) -> InterpM s e a -> InterpM s e b
fmap :: forall a b. (a -> b) -> InterpM s e a -> InterpM s e b
$c<$ :: forall s e a b. a -> InterpM s e b -> InterpM s e a
<$ :: forall a b. a -> InterpM s e b -> InterpM s e a
Functor, Functor (InterpM s e)
Functor (InterpM s e)
-> (forall a. a -> InterpM s e a)
-> (forall a b.
    InterpM s e (a -> b) -> InterpM s e a -> InterpM s e b)
-> (forall a b c.
    (a -> b -> c) -> InterpM s e a -> InterpM s e b -> InterpM s e c)
-> (forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b)
-> (forall a b. InterpM s e a -> InterpM s e b -> InterpM s e a)
-> Applicative (InterpM s e)
forall a. a -> InterpM s e a
forall s e. Functor (InterpM s e)
forall a b. InterpM s e a -> InterpM s e b -> InterpM s e a
forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b
forall a b. InterpM s e (a -> b) -> InterpM s e a -> InterpM s e b
forall s e a. a -> InterpM s e a
forall a b c.
(a -> b -> c) -> InterpM s e a -> InterpM s e b -> InterpM s e c
forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e a
forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e b
forall s e a b.
InterpM s e (a -> b) -> InterpM s e a -> InterpM s e b
forall s e a b c.
(a -> b -> c) -> InterpM s e a -> InterpM s e b -> InterpM s e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall s e a. a -> InterpM s e a
pure :: forall a. a -> InterpM s e a
$c<*> :: forall s e a b.
InterpM s e (a -> b) -> InterpM s e a -> InterpM s e b
<*> :: forall a b. InterpM s e (a -> b) -> InterpM s e a -> InterpM s e b
$cliftA2 :: forall s e a b c.
(a -> b -> c) -> InterpM s e a -> InterpM s e b -> InterpM s e c
liftA2 :: forall a b c.
(a -> b -> c) -> InterpM s e a -> InterpM s e b -> InterpM s e c
$c*> :: forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e b
*> :: forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b
$c<* :: forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e a
<* :: forall a b. InterpM s e a -> InterpM s e b -> InterpM s e a
Applicative, Applicative (InterpM s e)
Applicative (InterpM s e)
-> (forall a b.
    InterpM s e a -> (a -> InterpM s e b) -> InterpM s e b)
-> (forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b)
-> (forall a. a -> InterpM s e a)
-> Monad (InterpM s e)
forall a. a -> InterpM s e a
forall s e. Applicative (InterpM s e)
forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b
forall a b. InterpM s e a -> (a -> InterpM s e b) -> InterpM s e b
forall s e a. a -> InterpM s e a
forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e b
forall s e a b.
InterpM s e a -> (a -> InterpM s e b) -> InterpM s e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall s e a b.
InterpM s e a -> (a -> InterpM s e b) -> InterpM s e b
>>= :: forall a b. InterpM s e a -> (a -> InterpM s e b) -> InterpM s e b
$c>> :: forall s e a b. InterpM s e a -> InterpM s e b -> InterpM s e b
>> :: forall a b. InterpM s e a -> InterpM s e b -> InterpM s e b
$creturn :: forall s e a. a -> InterpM s e a
return :: forall a. a -> InterpM s e a
Monad, MonadState s, Monad (InterpM s e)
Monad (InterpM s e)
-> (forall a. IO a -> InterpM s e a) -> MonadIO (InterpM s e)
forall a. IO a -> InterpM s e a
forall s e. Monad (InterpM s e)
forall s e a. IO a -> InterpM s e a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall s e a. IO a -> InterpM s e a
liftIO :: forall a. IO a -> InterpM s e a
MonadIO, MonadWriter InterpLog)

instance MonadFail (InterpM a b) where
    fail :: forall a. DataCon -> InterpM a b a
fail = DataCon -> InterpM a b a
forall a. HasCallStack => DataCon -> a
error

runInterpM :: InterpM s e a -> s -> IO (a, InterpLog, s)
runInterpM :: forall s e a. InterpM s e a -> s -> IO (a, InterpLog, s)
runInterpM InterpM s e a
m s
s = do
    ((a
v,InterpLog
logs), s
s1) <- StateT s IO (a, InterpLog) -> s -> IO ((a, InterpLog), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterT InterpLog (StateT s IO) a -> StateT s IO (a, InterpLog)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (InterpM s e a -> WriterT InterpLog (StateT s IO) a
forall s e a. InterpM s e a -> WriterT InterpLog (StateT s IO) a
unInterpM InterpM s e a
m)) s
s
    (a, InterpLog, s) -> IO (a, InterpLog, s)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, InterpLog
logs, s
s1)

-- | Pure Gibbon programs, at any stage of compilation, should always
-- be evaluatable to a unique value.  The only side effects are timing.
class Expression e => Interp s e where
  gInterpExp :: RunConfig -> ValEnv e -> DDefs (TyOf e) -> FunDefs e -> e -> InterpM s e (Value e)

class (Expression e, Expression ext) => InterpExt s e ext where
  gInterpExt :: RunConfig -> ValEnv e -> DDefs (TyOf e) -> FunDefs e -> ext -> InterpM s e (Value e)

class Interp s e => InterpProg s e where
  {-# MINIMAL gInterpProg #-}
  gInterpProg :: s -> RunConfig -> Prog e -> IO (s, Value e, B.ByteString)

  -- | Interpret while ignoring timing constructs, and dropping the
  -- corresponding output to stdout.
  gInterpNoLogs :: s -> RunConfig -> Prog e -> String
  gInterpNoLogs s
s RunConfig
rc Prog e
p = IO DataCon -> DataCon
forall a. IO a -> a
unsafePerformIO (IO DataCon -> DataCon) -> IO DataCon -> DataCon
forall a b. (a -> b) -> a -> b
$ Value e -> DataCon
forall a. Show a => a -> DataCon
show (Value e -> DataCon)
-> ((s, Value e, ByteString) -> Value e)
-> (s, Value e, ByteString)
-> DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s, Value e, ByteString) -> Value e
forall a b c. (a, b, c) -> b
snd3 ((s, Value e, ByteString) -> DataCon)
-> IO (s, Value e, ByteString) -> IO DataCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> RunConfig -> Prog e -> IO (s, Value e, ByteString)
forall s e.
InterpProg s e =>
s -> RunConfig -> Prog e -> IO (s, Value e, ByteString)
gInterpProg s
s RunConfig
rc Prog e
p

  -- | Interpret and produce a "log" of output lines, as well as a
  -- final, printed result.  The output lines include timing information.
  gInterpWithStdout :: s -> RunConfig -> Prog e -> IO (String,[String])
  gInterpWithStdout s
s RunConfig
rc Prog e
p = do
    (s
_s1,Value e
res,ByteString
logs) <- s -> RunConfig -> Prog e -> IO (s, Value e, ByteString)
forall s e.
InterpProg s e =>
s -> RunConfig -> Prog e -> IO (s, Value e, ByteString)
gInterpProg s
s RunConfig
rc Prog e
p
    (DataCon, [DataCon]) -> IO (DataCon, [DataCon])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value e -> DataCon
forall a. Show a => a -> DataCon
show Value e
res, DataCon -> [DataCon]
lines (ByteString -> DataCon
B.unpack ByteString
logs))


-- | It's a first order language with simple values.
data Value e = VInt Int
             | VChar Char
             | VFloat Double
             | VSym String
             | VBool Bool
             | VDict (M.Map (Value e) (Value e))
             | VProd [(Value e)]
             | VList [(Value e)]
             | VPacked DataCon [(Value e)]
             | VLoc { forall e. Value e -> Var
bufID :: Var, forall e. Value e -> Int
offset :: Int }
             | VCursor { bufID :: Var, offset :: Int }
             | VPtr { bufID :: Var, offset :: Int }
               -- ^ Cursor are a pointer into the Store plus an offset into the Buffer.
             | VLam [Var] e (ValEnv e)
             | VWrapId Int (Value e)
               -- ^ A wrapper for vectors that wraps the value with an "id".
               -- All Inplace* operations use this "id" to update the value
               -- in 'ValEnv'.
  deriving (ReadPrec [Value e]
ReadPrec (Value e)
Int -> ReadS (Value e)
ReadS [Value e]
(Int -> ReadS (Value e))
-> ReadS [Value e]
-> ReadPrec (Value e)
-> ReadPrec [Value e]
-> Read (Value e)
forall e. (Ord e, Read e) => ReadPrec [Value e]
forall e. (Ord e, Read e) => ReadPrec (Value e)
forall e. (Ord e, Read e) => Int -> ReadS (Value e)
forall e. (Ord e, Read e) => ReadS [Value e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. (Ord e, Read e) => Int -> ReadS (Value e)
readsPrec :: Int -> ReadS (Value e)
$creadList :: forall e. (Ord e, Read e) => ReadS [Value e]
readList :: ReadS [Value e]
$creadPrec :: forall e. (Ord e, Read e) => ReadPrec (Value e)
readPrec :: ReadPrec (Value e)
$creadListPrec :: forall e. (Ord e, Read e) => ReadPrec [Value e]
readListPrec :: ReadPrec [Value e]
Read,Value e -> Value e -> IsBoxed
(Value e -> Value e -> IsBoxed)
-> (Value e -> Value e -> IsBoxed) -> Eq (Value e)
forall e. Eq e => Value e -> Value e -> IsBoxed
forall a. (a -> a -> IsBoxed) -> (a -> a -> IsBoxed) -> Eq a
$c== :: forall e. Eq e => Value e -> Value e -> IsBoxed
== :: Value e -> Value e -> IsBoxed
$c/= :: forall e. Eq e => Value e -> Value e -> IsBoxed
/= :: Value e -> Value e -> IsBoxed
Eq,Eq (Value e)
Eq (Value e)
-> (Value e -> Value e -> Ordering)
-> (Value e -> Value e -> IsBoxed)
-> (Value e -> Value e -> IsBoxed)
-> (Value e -> Value e -> IsBoxed)
-> (Value e -> Value e -> IsBoxed)
-> (Value e -> Value e -> Value e)
-> (Value e -> Value e -> Value e)
-> Ord (Value e)
Value e -> Value e -> IsBoxed
Value e -> Value e -> Ordering
Value e -> Value e -> Value e
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> IsBoxed)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e}. Ord e => Eq (Value e)
forall e. Ord e => Value e -> Value e -> IsBoxed
forall e. Ord e => Value e -> Value e -> Ordering
forall e. Ord e => Value e -> Value e -> Value e
$ccompare :: forall e. Ord e => Value e -> Value e -> Ordering
compare :: Value e -> Value e -> Ordering
$c< :: forall e. Ord e => Value e -> Value e -> IsBoxed
< :: Value e -> Value e -> IsBoxed
$c<= :: forall e. Ord e => Value e -> Value e -> IsBoxed
<= :: Value e -> Value e -> IsBoxed
$c> :: forall e. Ord e => Value e -> Value e -> IsBoxed
> :: Value e -> Value e -> IsBoxed
$c>= :: forall e. Ord e => Value e -> Value e -> IsBoxed
>= :: Value e -> Value e -> IsBoxed
$cmax :: forall e. Ord e => Value e -> Value e -> Value e
max :: Value e -> Value e -> Value e
$cmin :: forall e. Ord e => Value e -> Value e -> Value e
min :: Value e -> Value e -> Value e
Ord,(forall x. Value e -> Rep (Value e) x)
-> (forall x. Rep (Value e) x -> Value e) -> Generic (Value e)
forall x. Rep (Value e) x -> Value e
forall x. Value e -> Rep (Value e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (Value e) x -> Value e
forall e x. Value e -> Rep (Value e) x
$cfrom :: forall e x. Value e -> Rep (Value e) x
from :: forall x. Value e -> Rep (Value e) x
$cto :: forall e x. Rep (Value e) x -> Value e
to :: forall x. Rep (Value e) x -> Value e
Generic)

instance Out e => Out (Value e)
instance NFData e => NFData (Value e)

instance Show e => Show (Value e) where
 show :: Value e -> DataCon
show Value e
v =
  case Value e
v of
   VInt Int
n   -> Int -> DataCon
forall a. Show a => a -> DataCon
show Int
n
   VChar Char
c  -> Char -> DataCon
forall a. Show a => a -> DataCon
show Char
c
   VFloat Double
n -> Double -> DataCon
forall a. Show a => a -> DataCon
show Double
n
   VSym DataCon
s   -> DataCon
"'" DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
s
   VBool IsBoxed
b  -> if IsBoxed
b then DataCon
truePrinted else DataCon
falsePrinted
-- TODO: eventually want Haskell style tuple-printing:
--    VProd ls -> "("++ concat(intersperse ", " (L.map show ls)) ++")"
-- For now match Gibbon's Racket backend
   VProd [] -> DataCon
""
   VProd [Value e]
ls -> DataCon
"'#("DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ [DataCon] -> DataCon
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat(DataCon -> [DataCon] -> [DataCon]
forall a. a -> [a] -> [a]
L.intersperse DataCon
" " ((Value e -> DataCon) -> [Value e] -> [DataCon]
forall a b. (a -> b) -> [a] -> [b]
L.map Value e -> DataCon
forall a. Show a => a -> DataCon
show [Value e]
ls)) DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
")"
   VList [Value e]
ls -> [Value e] -> DataCon
forall a. Show a => a -> DataCon
show [Value e]
ls
   VDict Map (Value e) (Value e)
m      -> [(Value e, Value e)] -> DataCon
forall a. Show a => a -> DataCon
show (Map (Value e) (Value e) -> [(Value e, Value e)]
forall k a. Map k a -> [(k, a)]
M.toList Map (Value e) (Value e)
m)
   -- For now, Racket style:
   VPacked DataCon
k [Value e]
ls -> DataCon
"(" DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
k DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ [DataCon] -> DataCon
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Value e -> DataCon) -> [Value e] -> [DataCon]
forall a b. (a -> b) -> [a] -> [b]
L.map ((DataCon
" "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Value e -> DataCon) -> Value e -> DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value e -> DataCon
forall a. Show a => a -> DataCon
show) [Value e]
ls) DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
")"
   VLoc Var
buf Int
off -> DataCon
"<location "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show Var
bufDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
", "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> DataCon
forall a. Show a => a -> DataCon
show Int
offDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
">"
   VCursor Var
idx Int
off -> DataCon
"<cursor "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show Var
idxDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
", "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> DataCon
forall a. Show a => a -> DataCon
show Int
offDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
">"
   VPtr Var
idx Int
off -> DataCon
"<ptr "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Var -> DataCon
forall a. Show a => a -> DataCon
show Var
idxDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
", "DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> DataCon
forall a. Show a => a -> DataCon
show Int
offDataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
">"
   VLam [Var]
args e
bod ValEnv e
env -> DataCon
"(Clos (lambda (" DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ [DataCon] -> DataCon
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Var -> DataCon) -> [Var] -> [DataCon]
forall a b. (a -> b) -> [a] -> [b]
map ((DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++DataCon
" ") ShowS -> (Var -> DataCon) -> Var -> DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> DataCon
forall a. Show a => a -> DataCon
show) [Var]
args) DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
") " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> DataCon
forall a. Show a => a -> DataCon
show e
bod DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
") #{" DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ ValEnv e -> DataCon
forall a. Show a => a -> DataCon
show ValEnv e
env DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
"})"
   VWrapId Int
vid Value e
val -> DataCon
"(id: " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> DataCon
forall a. Show a => a -> DataCon
show Int
vid DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
" " DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ Value e -> DataCon
forall a. Show a => a -> DataCon
show Value e
val DataCon -> ShowS
forall a. [a] -> [a] -> [a]
++ DataCon
")"

execAndPrint :: (InterpProg s ex) => s -> RunConfig -> Prog ex -> IO ()
execAndPrint :: forall s ex. InterpProg s ex => s -> RunConfig -> Prog ex -> IO ()
execAndPrint s
s RunConfig
rc Prog ex
prg = do
  (s
_s1,Value ex
val,ByteString
logs) <- s -> RunConfig -> Prog ex -> IO (s, Value ex, ByteString)
forall s e.
InterpProg s e =>
s -> RunConfig -> Prog e -> IO (s, Value e, ByteString)
gInterpProg s
s RunConfig
rc Prog ex
prg
  ByteString -> IO ()
B.putStr ByteString
logs
  case Value ex
val of
    -- Special case: don't print void return:
    VProd [] -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- FIXME: remove this.
    Value ex
_ -> Value ex -> IO ()
forall a. Show a => a -> IO ()
print Value ex
val

--------------------------------------------------------------------------------

makeBaseFunctor ''PreExp
makeBaseFunctor ''UrTy
makeBaseFunctor ''Prim