{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE StandaloneDeriving    #-}

-- | A higher-ordered surface language that supports Rank-1 parametric
-- polymorphism.
module Gibbon.L0.Syntax
  ( module Gibbon.L0.Syntax,
    module Gibbon.Language,
  )
where

import           Control.Monad.State ( MonadState )
import           Control.DeepSeq (NFData)
import qualified Data.List as L
import qualified Data.Loc as Loc
import           GHC.Generics
import           Text.PrettyPrint.GenericPretty
import           Text.PrettyPrint.HughesPJ as PP
import qualified Data.Set as S
import qualified Data.Map as M

import           Gibbon.Common as C
import           Gibbon.Language hiding (UrTy(..))

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

-- In L0, type information may be held in locations, as locations don't exist
type Exp0     = PreExp E0Ext Ty0 Ty0
type DDefs0   = DDefs Ty0
type DDef0    = DDef Ty0
type FunDef0  = FunDef Exp0
type FunDefs0 = FunDefs Exp0
type Prog0    = Prog Exp0

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

-- | The extension point for L0.
data E0Ext loc dec =
   LambdaE [(Var,dec)] -- Variable tagged with type
           (PreExp E0Ext loc dec)
   -- unused for much of L0, may be due to a bug
 | PolyAppE (PreExp E0Ext loc dec) -- Operator
            (PreExp E0Ext loc dec) -- Operand
 | FunRefE [loc] Var -- Reference to a function (toplevel or lambda),
                     -- along with its tyapps.
 | BenchE Var [loc] [(PreExp E0Ext loc dec)] Bool
 | ParE0 [(PreExp E0Ext loc dec)]
 | PrintPacked dec (PreExp E0Ext loc dec) -- ^ Print a packed value to standard out.
 | CopyPacked dec (PreExp E0Ext loc dec) -- ^ Copy a packed value.
 | TravPacked dec (PreExp E0Ext loc dec) -- ^ Traverse a packed value.
 | L Loc.Loc (PreExp E0Ext loc dec)
 | LinearExt (LinearExt loc dec)
 deriving (Int -> E0Ext loc dec -> ShowS
[E0Ext loc dec] -> ShowS
E0Ext loc dec -> String
(Int -> E0Ext loc dec -> ShowS)
-> (E0Ext loc dec -> String)
-> ([E0Ext loc dec] -> ShowS)
-> Show (E0Ext loc dec)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall loc dec.
(Show loc, Show dec) =>
Int -> E0Ext loc dec -> ShowS
forall loc dec. (Show loc, Show dec) => [E0Ext loc dec] -> ShowS
forall loc dec. (Show loc, Show dec) => E0Ext loc dec -> String
$cshowsPrec :: forall loc dec.
(Show loc, Show dec) =>
Int -> E0Ext loc dec -> ShowS
showsPrec :: Int -> E0Ext loc dec -> ShowS
$cshow :: forall loc dec. (Show loc, Show dec) => E0Ext loc dec -> String
show :: E0Ext loc dec -> String
$cshowList :: forall loc dec. (Show loc, Show dec) => [E0Ext loc dec] -> ShowS
showList :: [E0Ext loc dec] -> ShowS
Show, Eq (E0Ext loc dec)
Eq (E0Ext loc dec)
-> (E0Ext loc dec -> E0Ext loc dec -> Ordering)
-> (E0Ext loc dec -> E0Ext loc dec -> Bool)
-> (E0Ext loc dec -> E0Ext loc dec -> Bool)
-> (E0Ext loc dec -> E0Ext loc dec -> Bool)
-> (E0Ext loc dec -> E0Ext loc dec -> Bool)
-> (E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec)
-> (E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec)
-> Ord (E0Ext loc dec)
E0Ext loc dec -> E0Ext loc dec -> Bool
E0Ext loc dec -> E0Ext loc dec -> Ordering
E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {loc} {dec}. (Ord loc, Ord dec) => Eq (E0Ext loc dec)
forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Ordering
forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
$ccompare :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Ordering
compare :: E0Ext loc dec -> E0Ext loc dec -> Ordering
$c< :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
< :: E0Ext loc dec -> E0Ext loc dec -> Bool
$c<= :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
<= :: E0Ext loc dec -> E0Ext loc dec -> Bool
$c> :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
> :: E0Ext loc dec -> E0Ext loc dec -> Bool
$c>= :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
>= :: E0Ext loc dec -> E0Ext loc dec -> Bool
$cmax :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
max :: E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
$cmin :: forall loc dec.
(Ord loc, Ord dec) =>
E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
min :: E0Ext loc dec -> E0Ext loc dec -> E0Ext loc dec
Ord, E0Ext loc dec -> E0Ext loc dec -> Bool
(E0Ext loc dec -> E0Ext loc dec -> Bool)
-> (E0Ext loc dec -> E0Ext loc dec -> Bool) -> Eq (E0Ext loc dec)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall loc dec.
(Eq loc, Eq dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
$c== :: forall loc dec.
(Eq loc, Eq dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
== :: E0Ext loc dec -> E0Ext loc dec -> Bool
$c/= :: forall loc dec.
(Eq loc, Eq dec) =>
E0Ext loc dec -> E0Ext loc dec -> Bool
/= :: E0Ext loc dec -> E0Ext loc dec -> Bool
Eq, ReadPrec [E0Ext loc dec]
ReadPrec (E0Ext loc dec)
Int -> ReadS (E0Ext loc dec)
ReadS [E0Ext loc dec]
(Int -> ReadS (E0Ext loc dec))
-> ReadS [E0Ext loc dec]
-> ReadPrec (E0Ext loc dec)
-> ReadPrec [E0Ext loc dec]
-> Read (E0Ext loc dec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall loc dec. (Read loc, Read dec) => ReadPrec [E0Ext loc dec]
forall loc dec. (Read loc, Read dec) => ReadPrec (E0Ext loc dec)
forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (E0Ext loc dec)
forall loc dec. (Read loc, Read dec) => ReadS [E0Ext loc dec]
$creadsPrec :: forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (E0Ext loc dec)
readsPrec :: Int -> ReadS (E0Ext loc dec)
$creadList :: forall loc dec. (Read loc, Read dec) => ReadS [E0Ext loc dec]
readList :: ReadS [E0Ext loc dec]
$creadPrec :: forall loc dec. (Read loc, Read dec) => ReadPrec (E0Ext loc dec)
readPrec :: ReadPrec (E0Ext loc dec)
$creadListPrec :: forall loc dec. (Read loc, Read dec) => ReadPrec [E0Ext loc dec]
readListPrec :: ReadPrec [E0Ext loc dec]
Read, (forall x. E0Ext loc dec -> Rep (E0Ext loc dec) x)
-> (forall x. Rep (E0Ext loc dec) x -> E0Ext loc dec)
-> Generic (E0Ext loc dec)
forall x. Rep (E0Ext loc dec) x -> E0Ext loc dec
forall x. E0Ext loc dec -> Rep (E0Ext loc dec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc dec x. Rep (E0Ext loc dec) x -> E0Ext loc dec
forall loc dec x. E0Ext loc dec -> Rep (E0Ext loc dec) x
$cfrom :: forall loc dec x. E0Ext loc dec -> Rep (E0Ext loc dec) x
from :: forall x. E0Ext loc dec -> Rep (E0Ext loc dec) x
$cto :: forall loc dec x. Rep (E0Ext loc dec) x -> E0Ext loc dec
to :: forall x. Rep (E0Ext loc dec) x -> E0Ext loc dec
Generic, E0Ext loc dec -> ()
(E0Ext loc dec -> ()) -> NFData (E0Ext loc dec)
forall a. (a -> ()) -> NFData a
forall loc dec. (NFData dec, NFData loc) => E0Ext loc dec -> ()
$crnf :: forall loc dec. (NFData dec, NFData loc) => E0Ext loc dec -> ()
rnf :: E0Ext loc dec -> ()
NFData)

-- | Linear types primitives.
data LinearExt loc dec =
    -- (&) :: a %1 -> (a %1 -> b) %1 -> b
  ReverseAppE (PreExp E0Ext loc dec) (PreExp E0Ext loc dec)

-- lseq :: a %1-> b %1-> b
  | LseqE (PreExp E0Ext loc dec) (PreExp E0Ext loc dec)

-- unsafeAlias :: a %1-> (a,a)
  | AliasE (PreExp E0Ext loc dec)

-- unsafeToLinear :: (a %p-> b) %1-> (a %1-> b)
  | ToLinearE (PreExp E0Ext loc dec)
  deriving (Int -> LinearExt loc dec -> ShowS
[LinearExt loc dec] -> ShowS
LinearExt loc dec -> String
(Int -> LinearExt loc dec -> ShowS)
-> (LinearExt loc dec -> String)
-> ([LinearExt loc dec] -> ShowS)
-> Show (LinearExt loc dec)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall loc dec.
(Show loc, Show dec) =>
Int -> LinearExt loc dec -> ShowS
forall loc dec.
(Show loc, Show dec) =>
[LinearExt loc dec] -> ShowS
forall loc dec. (Show loc, Show dec) => LinearExt loc dec -> String
$cshowsPrec :: forall loc dec.
(Show loc, Show dec) =>
Int -> LinearExt loc dec -> ShowS
showsPrec :: Int -> LinearExt loc dec -> ShowS
$cshow :: forall loc dec. (Show loc, Show dec) => LinearExt loc dec -> String
show :: LinearExt loc dec -> String
$cshowList :: forall loc dec.
(Show loc, Show dec) =>
[LinearExt loc dec] -> ShowS
showList :: [LinearExt loc dec] -> ShowS
Show, Eq (LinearExt loc dec)
Eq (LinearExt loc dec)
-> (LinearExt loc dec -> LinearExt loc dec -> Ordering)
-> (LinearExt loc dec -> LinearExt loc dec -> Bool)
-> (LinearExt loc dec -> LinearExt loc dec -> Bool)
-> (LinearExt loc dec -> LinearExt loc dec -> Bool)
-> (LinearExt loc dec -> LinearExt loc dec -> Bool)
-> (LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec)
-> (LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec)
-> Ord (LinearExt loc dec)
LinearExt loc dec -> LinearExt loc dec -> Bool
LinearExt loc dec -> LinearExt loc dec -> Ordering
LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {loc} {dec}. (Ord loc, Ord dec) => Eq (LinearExt loc dec)
forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Ordering
forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
$ccompare :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Ordering
compare :: LinearExt loc dec -> LinearExt loc dec -> Ordering
$c< :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
< :: LinearExt loc dec -> LinearExt loc dec -> Bool
$c<= :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
<= :: LinearExt loc dec -> LinearExt loc dec -> Bool
$c> :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
> :: LinearExt loc dec -> LinearExt loc dec -> Bool
$c>= :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
>= :: LinearExt loc dec -> LinearExt loc dec -> Bool
$cmax :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
max :: LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
$cmin :: forall loc dec.
(Ord loc, Ord dec) =>
LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
min :: LinearExt loc dec -> LinearExt loc dec -> LinearExt loc dec
Ord, LinearExt loc dec -> LinearExt loc dec -> Bool
(LinearExt loc dec -> LinearExt loc dec -> Bool)
-> (LinearExt loc dec -> LinearExt loc dec -> Bool)
-> Eq (LinearExt loc dec)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall loc dec.
(Eq loc, Eq dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
$c== :: forall loc dec.
(Eq loc, Eq dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
== :: LinearExt loc dec -> LinearExt loc dec -> Bool
$c/= :: forall loc dec.
(Eq loc, Eq dec) =>
LinearExt loc dec -> LinearExt loc dec -> Bool
/= :: LinearExt loc dec -> LinearExt loc dec -> Bool
Eq, ReadPrec [LinearExt loc dec]
ReadPrec (LinearExt loc dec)
Int -> ReadS (LinearExt loc dec)
ReadS [LinearExt loc dec]
(Int -> ReadS (LinearExt loc dec))
-> ReadS [LinearExt loc dec]
-> ReadPrec (LinearExt loc dec)
-> ReadPrec [LinearExt loc dec]
-> Read (LinearExt loc dec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall loc dec.
(Read loc, Read dec) =>
ReadPrec [LinearExt loc dec]
forall loc dec.
(Read loc, Read dec) =>
ReadPrec (LinearExt loc dec)
forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (LinearExt loc dec)
forall loc dec. (Read loc, Read dec) => ReadS [LinearExt loc dec]
$creadsPrec :: forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (LinearExt loc dec)
readsPrec :: Int -> ReadS (LinearExt loc dec)
$creadList :: forall loc dec. (Read loc, Read dec) => ReadS [LinearExt loc dec]
readList :: ReadS [LinearExt loc dec]
$creadPrec :: forall loc dec.
(Read loc, Read dec) =>
ReadPrec (LinearExt loc dec)
readPrec :: ReadPrec (LinearExt loc dec)
$creadListPrec :: forall loc dec.
(Read loc, Read dec) =>
ReadPrec [LinearExt loc dec]
readListPrec :: ReadPrec [LinearExt loc dec]
Read, (forall x. LinearExt loc dec -> Rep (LinearExt loc dec) x)
-> (forall x. Rep (LinearExt loc dec) x -> LinearExt loc dec)
-> Generic (LinearExt loc dec)
forall x. Rep (LinearExt loc dec) x -> LinearExt loc dec
forall x. LinearExt loc dec -> Rep (LinearExt loc dec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc dec x. Rep (LinearExt loc dec) x -> LinearExt loc dec
forall loc dec x. LinearExt loc dec -> Rep (LinearExt loc dec) x
$cfrom :: forall loc dec x. LinearExt loc dec -> Rep (LinearExt loc dec) x
from :: forall x. LinearExt loc dec -> Rep (LinearExt loc dec) x
$cto :: forall loc dec x. Rep (LinearExt loc dec) x -> LinearExt loc dec
to :: forall x. Rep (LinearExt loc dec) x -> LinearExt loc dec
Generic, LinearExt loc dec -> ()
(LinearExt loc dec -> ()) -> NFData (LinearExt loc dec)
forall a. (a -> ()) -> NFData a
forall loc dec. (NFData loc, NFData dec) => LinearExt loc dec -> ()
$crnf :: forall loc dec. (NFData loc, NFData dec) => LinearExt loc dec -> ()
rnf :: LinearExt loc dec -> ()
NFData)

--------------------------------------------------------------------------------
-- Helper methods to integrate the Data.Loc with Gibbon

deriving instance Generic Loc.Loc
deriving instance Generic Loc.Pos
deriving instance NFData  Loc.Pos
deriving instance NFData  Loc.Loc

-- | Orphaned instance: read without source locations.
instance Read t => Read (Loc.L t) where
  readsPrec :: Int -> ReadS (L t)
readsPrec Int
n String
str = [ (Loc -> t -> L t
forall a. Loc -> a -> L a
Loc.L Loc
Loc.NoLoc t
a,String
s) | (t
a,String
s) <- Int -> ReadS t
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
str ]

instance Out Loc.Loc where
  docPrec :: Int -> Loc -> Doc
docPrec Int
_ Loc
loc = Loc -> Doc
forall a. Out a => a -> Doc
doc Loc
loc

  doc :: Loc -> Doc
doc Loc
loc =
    case Loc
loc of
      Loc.Loc Pos
start Pos
_end -> Pos -> Doc
forall a. Out a => a -> Doc
doc Pos
start
      Loc
Loc.NoLoc -> Doc
PP.empty

instance Out Loc.Pos where
  docPrec :: Int -> Pos -> Doc
docPrec Int
_ Pos
pos = Pos -> Doc
forall a. Out a => a -> Doc
doc Pos
pos
  doc :: Pos -> Doc
doc (Loc.Pos String
path Int
line Int
col Int
_) = [Doc] -> Doc
hcat [String -> Doc
forall a. Out a => a -> Doc
doc String
path, Doc
colon, Int -> Doc
forall a. Out a => a -> Doc
doc Int
line, Doc
colon, Int -> Doc
forall a. Out a => a -> Doc
doc Int
col]

--------------------------------------------------------------------------------
-- Instances for E0Ext

instance FreeVars (E0Ext l d) where
  gFreeVars :: E0Ext l d -> Set Var
gFreeVars E0Ext l d
e =
    case E0Ext l d
e of
      LambdaE [(Var, d)]
args PreExp E0Ext l d
bod -> (Var -> Set Var -> Set Var) -> Set Var -> [Var] -> Set Var
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.delete (PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
bod) (((Var, d) -> Var) -> [(Var, d)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, d) -> Var
forall a b. (a, b) -> a
fst [(Var, d)]
args)
      PolyAppE PreExp E0Ext l d
f PreExp E0Ext l d
d     -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
f Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
d
      FunRefE [l]
_ Var
f      -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
f
      BenchE Var
_ [l]
_ [PreExp E0Ext l d]
args Bool
_-> [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E0Ext l d -> Set Var) -> [PreExp E0Ext l d] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars [PreExp E0Ext l d]
args)
      ParE0 [PreExp E0Ext l d]
ls         -> [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E0Ext l d -> Set Var) -> [PreExp E0Ext l d] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars [PreExp E0Ext l d]
ls)
      PrintPacked d
_ PreExp E0Ext l d
e1 -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
e1
      CopyPacked d
_ PreExp E0Ext l d
e1  -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
e1
      TravPacked d
_ PreExp E0Ext l d
e1  -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
e1
      L Loc
_ PreExp E0Ext l d
e1           -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
e1
      LinearExt LinearExt l d
ext      -> LinearExt l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars LinearExt l d
ext

instance (Out l, Out d, Show l, Show d) => Expression (E0Ext l d) where
  type LocOf (E0Ext l d) = l
  type TyOf (E0Ext l d)  = d
  isTrivial :: E0Ext l d -> Bool
isTrivial E0Ext l d
_ = Bool
False

instance (Show l, Out l) => Flattenable (E0Ext l Ty0) where
    gFlattenGatherBinds :: DDefs (TyOf (E0Ext l Ty0))
-> Env2 (TyOf (E0Ext l Ty0))
-> E0Ext l Ty0
-> PassM ([Binds (E0Ext l Ty0)], E0Ext l Ty0)
gFlattenGatherBinds DDefs (TyOf (E0Ext l Ty0))
_ddfs Env2 (TyOf (E0Ext l Ty0))
_env E0Ext l Ty0
ex = ([(Var, [l], Ty0, E0Ext l Ty0)], E0Ext l Ty0)
-> PassM ([(Var, [l], Ty0, E0Ext l Ty0)], E0Ext l Ty0)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], E0Ext l Ty0
ex)
    gFlattenExp :: DDefs (TyOf (E0Ext l Ty0))
-> Env2 (TyOf (E0Ext l Ty0)) -> E0Ext l Ty0 -> PassM (E0Ext l Ty0)
gFlattenExp DDefs (TyOf (E0Ext l Ty0))
_ddfs Env2 (TyOf (E0Ext l Ty0))
_env E0Ext l Ty0
ex = E0Ext l Ty0 -> PassM (E0Ext l Ty0)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return E0Ext l Ty0
ex

instance HasSubstitutableExt E0Ext l d => SubstitutableExt (PreExp E0Ext l d) (E0Ext l d) where
  gSubstExt :: Var -> PreExp E0Ext l d -> E0Ext l d -> E0Ext l d
gSubstExt Var
old PreExp E0Ext l d
new E0Ext l d
ext =
    case E0Ext l d
ext of
      LambdaE [(Var, d)]
args PreExp E0Ext l d
bod -> [(Var, d)] -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE [(Var, d)]
args (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
bod)
      PolyAppE PreExp E0Ext l d
a PreExp E0Ext l d
b     -> PreExp E0Ext l d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
a) (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
b)
      FunRefE{}        -> E0Ext l d
ext
      BenchE Var
fn [l]
tyapps [PreExp E0Ext l d]
args Bool
b -> Var -> [l] -> [PreExp E0Ext l d] -> Bool -> E0Ext l d
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [l]
tyapps ((PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new) [PreExp E0Ext l d]
args) Bool
b
      ParE0 [PreExp E0Ext l d]
ls -> [PreExp E0Ext l d] -> E0Ext l d
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ([PreExp E0Ext l d] -> E0Ext l d)
-> [PreExp E0Ext l d] -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new) [PreExp E0Ext l d]
ls
      PrintPacked d
ty PreExp E0Ext l d
e1 -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked d
ty (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
e1)
      CopyPacked d
ty PreExp E0Ext l d
e1 -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked d
ty (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
e1)
      TravPacked d
ty PreExp E0Ext l d
e1 -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked d
ty (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
e1)
      L Loc
p PreExp E0Ext l d
e1   -> Loc -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
e1)
      LinearExt LinearExt l d
e -> LinearExt l d -> E0Ext l d
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Var -> PreExp E0Ext l d -> LinearExt l d -> LinearExt l d
forall e ext. SubstitutableExt e ext => Var -> e -> ext -> ext
gSubstExt Var
old PreExp E0Ext l d
new LinearExt l d
e)

  gSubstEExt :: PreExp E0Ext l d -> PreExp E0Ext l d -> E0Ext l d -> E0Ext l d
gSubstEExt PreExp E0Ext l d
old PreExp E0Ext l d
new E0Ext l d
ext =
    case E0Ext l d
ext of
      LambdaE [(Var, d)]
args PreExp E0Ext l d
bod -> [(Var, d)] -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE [(Var, d)]
args (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
bod)
      PolyAppE PreExp E0Ext l d
a PreExp E0Ext l d
b     -> PreExp E0Ext l d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
a) (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
b)
      FunRefE{}        -> E0Ext l d
ext
      BenchE Var
fn [l]
tyapps [PreExp E0Ext l d]
args Bool
b -> Var -> [l] -> [PreExp E0Ext l d] -> Bool -> E0Ext l d
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [l]
tyapps ((PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new) [PreExp E0Ext l d]
args) Bool
b
      ParE0 [PreExp E0Ext l d]
ls -> [PreExp E0Ext l d] -> E0Ext l d
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ([PreExp E0Ext l d] -> E0Ext l d)
-> [PreExp E0Ext l d] -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new) [PreExp E0Ext l d]
ls
      PrintPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked d
ty (PreExp E0Ext l d -> E0Ext l d) -> PreExp E0Ext l d -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
e)
      CopyPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked d
ty (PreExp E0Ext l d -> E0Ext l d) -> PreExp E0Ext l d -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
e)
      TravPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked d
ty (PreExp E0Ext l d -> E0Ext l d) -> PreExp E0Ext l d -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
e)
      L Loc
p PreExp E0Ext l d
e    -> Loc -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p (PreExp E0Ext l d -> E0Ext l d) -> PreExp E0Ext l d -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
e)
      LinearExt LinearExt l d
e -> LinearExt l d -> E0Ext l d
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (PreExp E0Ext l d
-> PreExp E0Ext l d -> LinearExt l d -> LinearExt l d
forall e ext. SubstitutableExt e ext => e -> e -> ext -> ext
gSubstEExt PreExp E0Ext l d
old PreExp E0Ext l d
new LinearExt l d
e)

instance HasRenamable E0Ext l d => Renamable (E0Ext l d) where
  gRename :: Map Var Var -> E0Ext l d -> E0Ext l d
gRename Map Var Var
env E0Ext l d
ext =
    case E0Ext l d
ext of
      LambdaE [(Var, d)]
args PreExp E0Ext l d
bod -> [(Var, d)] -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE (((Var, d) -> (Var, d)) -> [(Var, d)] -> [(Var, d)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
a,d
b) -> (Var -> Var
forall a. Renamable a => a -> a
go Var
a, d -> d
forall a. Renamable a => a -> a
go d
b)) [(Var, d)]
args) (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
bod)
      PolyAppE PreExp E0Ext l d
a PreExp E0Ext l d
b     -> PreExp E0Ext l d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
a) (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
b)
      FunRefE [l]
tyapps Var
a -> [l] -> Var -> E0Ext l d
forall loc dec. [loc] -> Var -> E0Ext loc dec
FunRefE ((l -> l) -> [l] -> [l]
forall a b. (a -> b) -> [a] -> [b]
map l -> l
forall a. Renamable a => a -> a
go [l]
tyapps) (Var -> Var
forall a. Renamable a => a -> a
go Var
a)
      BenchE Var
fn [l]
tyapps [PreExp E0Ext l d]
args Bool
b -> Var -> [l] -> [PreExp E0Ext l d] -> Bool -> E0Ext l d
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn ((l -> l) -> [l] -> [l]
forall a b. (a -> b) -> [a] -> [b]
map l -> l
forall a. Renamable a => a -> a
go [l]
tyapps) ((PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go [PreExp E0Ext l d]
args) Bool
b
      ParE0 [PreExp E0Ext l d]
ls -> [PreExp E0Ext l d] -> E0Ext l d
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ([PreExp E0Ext l d] -> E0Ext l d)
-> [PreExp E0Ext l d] -> E0Ext l d
forall a b. (a -> b) -> a -> b
$ (PreExp E0Ext l d -> PreExp E0Ext l d)
-> [PreExp E0Ext l d] -> [PreExp E0Ext l d]
forall a b. (a -> b) -> [a] -> [b]
map (Map Var Var -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env) [PreExp E0Ext l d]
ls
      PrintPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked d
ty (Map Var Var -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env PreExp E0Ext l d
e)
      CopyPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked d
ty (Map Var Var -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env PreExp E0Ext l d
e)
      TravPacked d
ty PreExp E0Ext l d
e -> d -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked d
ty (Map Var Var -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env PreExp E0Ext l d
e)
      L Loc
p PreExp E0Ext l d
e    -> Loc -> PreExp E0Ext l d -> E0Ext l d
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p (Map Var Var -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env PreExp E0Ext l d
e)
      LinearExt LinearExt l d
e -> LinearExt l d -> E0Ext l d
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Map Var Var -> LinearExt l d -> LinearExt l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env LinearExt l d
e)
    where
      go :: forall a. Renamable a => a -> a
      go :: forall a. Renamable a => a -> a
go = Map Var Var -> a -> a
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env

instance (Out l, Out d) => Out (E0Ext l d)
instance Out Ty0
instance Out TyScheme

--------------------------------------------------------------------------------
-- Instances for LinearExt

instance FreeVars (LinearExt l d) where
  gFreeVars :: LinearExt l d -> Set Var
gFreeVars LinearExt l d
e =
    case LinearExt l d
e of
      ReverseAppE PreExp E0Ext l d
fn PreExp E0Ext l d
arg -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
fn Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
arg)
      LseqE PreExp E0Ext l d
a PreExp E0Ext l d
b   -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
a Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
b
      AliasE PreExp E0Ext l d
a    -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
a
      ToLinearE PreExp E0Ext l d
a -> PreExp E0Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E0Ext l d
a

instance (Out l, Out d, Show l, Show d) => Expression (LinearExt l d) where
  type LocOf (LinearExt l d) = l
  type TyOf (LinearExt l d)  = d
  isTrivial :: LinearExt l d -> Bool
isTrivial LinearExt l d
_ = Bool
False

instance (Show l, Out l) => Flattenable (LinearExt l Ty0) where
    gFlattenGatherBinds :: DDefs (TyOf (LinearExt l Ty0))
-> Env2 (TyOf (LinearExt l Ty0))
-> LinearExt l Ty0
-> PassM ([Binds (LinearExt l Ty0)], LinearExt l Ty0)
gFlattenGatherBinds DDefs (TyOf (LinearExt l Ty0))
_ddfs Env2 (TyOf (LinearExt l Ty0))
_env LinearExt l Ty0
ex = ([(Var, [l], Ty0, LinearExt l Ty0)], LinearExt l Ty0)
-> PassM ([(Var, [l], Ty0, LinearExt l Ty0)], LinearExt l Ty0)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], LinearExt l Ty0
ex)
    gFlattenExp :: DDefs (TyOf (LinearExt l Ty0))
-> Env2 (TyOf (LinearExt l Ty0))
-> LinearExt l Ty0
-> PassM (LinearExt l Ty0)
gFlattenExp DDefs (TyOf (LinearExt l Ty0))
_ddfs Env2 (TyOf (LinearExt l Ty0))
_env LinearExt l Ty0
ex = LinearExt l Ty0 -> PassM (LinearExt l Ty0)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return LinearExt l Ty0
ex

instance HasSubstitutableExt E0Ext l d => SubstitutableExt (PreExp E0Ext l d) (LinearExt l d) where
  gSubstExt :: Var -> PreExp E0Ext l d -> LinearExt l d -> LinearExt l d
gSubstExt Var
old PreExp E0Ext l d
new LinearExt l d
ext =
    case LinearExt l d
ext of
      ReverseAppE PreExp E0Ext l d
fn PreExp E0Ext l d
arg -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
ReverseAppE (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
fn) (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
arg)
      LseqE PreExp E0Ext l d
a PreExp E0Ext l d
b   -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
LseqE (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
a) (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
b)
      AliasE PreExp E0Ext l d
a    -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
AliasE (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
a)
      ToLinearE PreExp E0Ext l d
a -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
ToLinearE (Var -> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E0Ext l d
new PreExp E0Ext l d
a)

  gSubstEExt :: PreExp E0Ext l d
-> PreExp E0Ext l d -> LinearExt l d -> LinearExt l d
gSubstEExt PreExp E0Ext l d
old PreExp E0Ext l d
new LinearExt l d
ext =
    case LinearExt l d
ext of
      ReverseAppE PreExp E0Ext l d
fn PreExp E0Ext l d
arg -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
ReverseAppE (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
fn) (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
arg)
      LseqE PreExp E0Ext l d
a PreExp E0Ext l d
b   -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
LseqE (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
a) (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
b)
      AliasE PreExp E0Ext l d
a    -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
AliasE (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
a)
      ToLinearE PreExp E0Ext l d
a -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
ToLinearE (PreExp E0Ext l d
-> PreExp E0Ext l d -> PreExp E0Ext l d -> PreExp E0Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E0Ext l d
old PreExp E0Ext l d
new PreExp E0Ext l d
a)

instance HasRenamable E0Ext l d => Renamable (LinearExt l d) where
  gRename :: Map Var Var -> LinearExt l d -> LinearExt l d
gRename Map Var Var
env LinearExt l d
ext =
    case LinearExt l d
ext of
      ReverseAppE PreExp E0Ext l d
fn PreExp E0Ext l d
arg -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
ReverseAppE (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
fn) (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
arg)
      LseqE PreExp E0Ext l d
a PreExp E0Ext l d
b   -> PreExp E0Ext l d -> PreExp E0Ext l d -> LinearExt l d
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
LseqE (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
a) (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
b)
      AliasE PreExp E0Ext l d
a    -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
AliasE (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
a)
      ToLinearE PreExp E0Ext l d
a -> PreExp E0Ext l d -> LinearExt l d
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
ToLinearE (PreExp E0Ext l d -> PreExp E0Ext l d
forall a. Renamable a => a -> a
go PreExp E0Ext l d
a)
    where
      go :: forall a. Renamable a => a -> a
      go :: forall a. Renamable a => a -> a
go = Map Var Var -> a -> a
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env

instance (Out l, Out d) => Out (LinearExt l d)

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

data MetaTv = Meta Int
  deriving (ReadPrec [MetaTv]
ReadPrec MetaTv
Int -> ReadS MetaTv
ReadS [MetaTv]
(Int -> ReadS MetaTv)
-> ReadS [MetaTv]
-> ReadPrec MetaTv
-> ReadPrec [MetaTv]
-> Read MetaTv
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MetaTv
readsPrec :: Int -> ReadS MetaTv
$creadList :: ReadS [MetaTv]
readList :: ReadS [MetaTv]
$creadPrec :: ReadPrec MetaTv
readPrec :: ReadPrec MetaTv
$creadListPrec :: ReadPrec [MetaTv]
readListPrec :: ReadPrec [MetaTv]
Read, Int -> MetaTv -> ShowS
[MetaTv] -> ShowS
MetaTv -> String
(Int -> MetaTv -> ShowS)
-> (MetaTv -> String) -> ([MetaTv] -> ShowS) -> Show MetaTv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetaTv -> ShowS
showsPrec :: Int -> MetaTv -> ShowS
$cshow :: MetaTv -> String
show :: MetaTv -> String
$cshowList :: [MetaTv] -> ShowS
showList :: [MetaTv] -> ShowS
Show, MetaTv -> MetaTv -> Bool
(MetaTv -> MetaTv -> Bool)
-> (MetaTv -> MetaTv -> Bool) -> Eq MetaTv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaTv -> MetaTv -> Bool
== :: MetaTv -> MetaTv -> Bool
$c/= :: MetaTv -> MetaTv -> Bool
/= :: MetaTv -> MetaTv -> Bool
Eq, Eq MetaTv
Eq MetaTv
-> (MetaTv -> MetaTv -> Ordering)
-> (MetaTv -> MetaTv -> Bool)
-> (MetaTv -> MetaTv -> Bool)
-> (MetaTv -> MetaTv -> Bool)
-> (MetaTv -> MetaTv -> Bool)
-> (MetaTv -> MetaTv -> MetaTv)
-> (MetaTv -> MetaTv -> MetaTv)
-> Ord MetaTv
MetaTv -> MetaTv -> Bool
MetaTv -> MetaTv -> Ordering
MetaTv -> MetaTv -> MetaTv
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MetaTv -> MetaTv -> Ordering
compare :: MetaTv -> MetaTv -> Ordering
$c< :: MetaTv -> MetaTv -> Bool
< :: MetaTv -> MetaTv -> Bool
$c<= :: MetaTv -> MetaTv -> Bool
<= :: MetaTv -> MetaTv -> Bool
$c> :: MetaTv -> MetaTv -> Bool
> :: MetaTv -> MetaTv -> Bool
$c>= :: MetaTv -> MetaTv -> Bool
>= :: MetaTv -> MetaTv -> Bool
$cmax :: MetaTv -> MetaTv -> MetaTv
max :: MetaTv -> MetaTv -> MetaTv
$cmin :: MetaTv -> MetaTv -> MetaTv
min :: MetaTv -> MetaTv -> MetaTv
Ord, (forall x. MetaTv -> Rep MetaTv x)
-> (forall x. Rep MetaTv x -> MetaTv) -> Generic MetaTv
forall x. Rep MetaTv x -> MetaTv
forall x. MetaTv -> Rep MetaTv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetaTv -> Rep MetaTv x
from :: forall x. MetaTv -> Rep MetaTv x
$cto :: forall x. Rep MetaTv x -> MetaTv
to :: forall x. Rep MetaTv x -> MetaTv
Generic, MetaTv -> ()
(MetaTv -> ()) -> NFData MetaTv
forall a. (a -> ()) -> NFData a
$crnf :: MetaTv -> ()
rnf :: MetaTv -> ()
NFData)

instance Out MetaTv where
  doc :: MetaTv -> Doc
doc (Meta Int
i) = String -> Doc
text String
"$" Doc -> Doc -> Doc
PP.<> Int -> Doc
forall a. Out a => a -> Doc
doc Int
i
  docPrec :: Int -> MetaTv -> Doc
docPrec Int
_ MetaTv
v = MetaTv -> Doc
forall a. Out a => a -> Doc
doc MetaTv
v

newMetaTv :: MonadState Int m => m MetaTv
newMetaTv :: forall (m :: * -> *). MonadState Int m => m MetaTv
newMetaTv = Int -> MetaTv
Meta (Int -> MetaTv) -> m Int -> m MetaTv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Int
forall (m :: * -> *). MonadState Int m => m Int
newUniq

newMetaTy :: MonadState Int m => m Ty0
newMetaTy :: forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy = MetaTv -> Ty0
MetaTv (MetaTv -> Ty0) -> m MetaTv -> m Ty0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MetaTv
forall (m :: * -> *). MonadState Int m => m MetaTv
newMetaTv

newTyVar :: MonadState Int m => m TyVar
newTyVar :: forall (m :: * -> *). MonadState Int m => m TyVar
newTyVar = Var -> TyVar
BoundTv (Var -> TyVar) -> m Var -> m TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Var
forall (m :: * -> *). MonadState Int m => m Var
genLetter

data Ty0
 = IntTy
 | CharTy
 | FloatTy
 | SymTy0
 | BoolTy
 | TyVar TyVar   -- Rigid/skolem type variables
 | MetaTv MetaTv -- Unification variables
 | ProdTy [Ty0]
 | SymDictTy (Maybe Var) Ty0
 | PDictTy Ty0 Ty0
 | SymSetTy
 | SymHashTy
 | IntHashTy
 | ArrowTy [Ty0] Ty0
 | PackedTy TyCon [Ty0] -- Type arguments to the type constructor
 | VectorTy Ty0
 | ListTy Ty0
 | ArenaTy
  deriving (Int -> Ty0 -> ShowS
[Ty0] -> ShowS
Ty0 -> String
(Int -> Ty0 -> ShowS)
-> (Ty0 -> String) -> ([Ty0] -> ShowS) -> Show Ty0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ty0 -> ShowS
showsPrec :: Int -> Ty0 -> ShowS
$cshow :: Ty0 -> String
show :: Ty0 -> String
$cshowList :: [Ty0] -> ShowS
showList :: [Ty0] -> ShowS
Show, ReadPrec [Ty0]
ReadPrec Ty0
Int -> ReadS Ty0
ReadS [Ty0]
(Int -> ReadS Ty0)
-> ReadS [Ty0] -> ReadPrec Ty0 -> ReadPrec [Ty0] -> Read Ty0
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Ty0
readsPrec :: Int -> ReadS Ty0
$creadList :: ReadS [Ty0]
readList :: ReadS [Ty0]
$creadPrec :: ReadPrec Ty0
readPrec :: ReadPrec Ty0
$creadListPrec :: ReadPrec [Ty0]
readListPrec :: ReadPrec [Ty0]
Read, Ty0 -> Ty0 -> Bool
(Ty0 -> Ty0 -> Bool) -> (Ty0 -> Ty0 -> Bool) -> Eq Ty0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ty0 -> Ty0 -> Bool
== :: Ty0 -> Ty0 -> Bool
$c/= :: Ty0 -> Ty0 -> Bool
/= :: Ty0 -> Ty0 -> Bool
Eq, Eq Ty0
Eq Ty0
-> (Ty0 -> Ty0 -> Ordering)
-> (Ty0 -> Ty0 -> Bool)
-> (Ty0 -> Ty0 -> Bool)
-> (Ty0 -> Ty0 -> Bool)
-> (Ty0 -> Ty0 -> Bool)
-> (Ty0 -> Ty0 -> Ty0)
-> (Ty0 -> Ty0 -> Ty0)
-> Ord Ty0
Ty0 -> Ty0 -> Bool
Ty0 -> Ty0 -> Ordering
Ty0 -> Ty0 -> Ty0
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ty0 -> Ty0 -> Ordering
compare :: Ty0 -> Ty0 -> Ordering
$c< :: Ty0 -> Ty0 -> Bool
< :: Ty0 -> Ty0 -> Bool
$c<= :: Ty0 -> Ty0 -> Bool
<= :: Ty0 -> Ty0 -> Bool
$c> :: Ty0 -> Ty0 -> Bool
> :: Ty0 -> Ty0 -> Bool
$c>= :: Ty0 -> Ty0 -> Bool
>= :: Ty0 -> Ty0 -> Bool
$cmax :: Ty0 -> Ty0 -> Ty0
max :: Ty0 -> Ty0 -> Ty0
$cmin :: Ty0 -> Ty0 -> Ty0
min :: Ty0 -> Ty0 -> Ty0
Ord, (forall x. Ty0 -> Rep Ty0 x)
-> (forall x. Rep Ty0 x -> Ty0) -> Generic Ty0
forall x. Rep Ty0 x -> Ty0
forall x. Ty0 -> Rep Ty0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ty0 -> Rep Ty0 x
from :: forall x. Ty0 -> Rep Ty0 x
$cto :: forall x. Rep Ty0 x -> Ty0
to :: forall x. Rep Ty0 x -> Ty0
Generic, Ty0 -> ()
(Ty0 -> ()) -> NFData Ty0
forall a. (a -> ()) -> NFData a
$crnf :: Ty0 -> ()
rnf :: Ty0 -> ()
NFData)

instance FunctionTy Ty0 where
  type ArrowTy Ty0 = TyScheme
  inTys :: ArrowTy Ty0 -> [Ty0]
inTys  = ArrowTy Ty0 -> [Ty0]
TyScheme -> [Ty0]
arrIns
  outTy :: ArrowTy Ty0 -> Ty0
outTy  = ArrowTy Ty0 -> Ty0
TyScheme -> Ty0
arrOut

instance Renamable TyVar where
  gRename :: Map Var Var -> TyVar -> TyVar
gRename Map Var Var
env TyVar
tv =
    case TyVar
tv of
      BoundTv Var
v  -> Var -> TyVar
BoundTv (Map Var Var -> Var -> Var
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env Var
v)
      SkolemTv{} -> TyVar
tv
      UserTv Var
v   -> Var -> TyVar
UserTv (Map Var Var -> Var -> Var
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env Var
v)

instance Renamable Ty0 where
  gRename :: Map Var Var -> Ty0 -> Ty0
gRename Map Var Var
env Ty0
ty =
    case Ty0
ty of
      Ty0
IntTy  -> Ty0
IntTy
      Ty0
CharTy -> Ty0
CharTy
      Ty0
FloatTy-> Ty0
FloatTy
      Ty0
SymTy0 -> Ty0
SymTy0
      Ty0
BoolTy -> Ty0
BoolTy
      TyVar TyVar
tv  -> TyVar -> Ty0
TyVar (TyVar -> TyVar
forall a. Renamable a => a -> a
go TyVar
tv)
      MetaTv{}  -> Ty0
ty
      ProdTy [Ty0]
ls -> [Ty0] -> Ty0
ProdTy ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
forall a. Renamable a => a -> a
go [Ty0]
ls)
      SymDictTy Maybe Var
a Ty0
t     -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
a (Ty0 -> Ty0
forall a. Renamable a => a -> a
go Ty0
t)
      PDictTy Ty0
k Ty0
v       -> Ty0 -> Ty0 -> Ty0
PDictTy (Ty0 -> Ty0
forall a. Renamable a => a -> a
go Ty0
k) (Ty0 -> Ty0
forall a. Renamable a => a -> a
go Ty0
v)
      ArrowTy [Ty0]
args Ty0
ret  -> [Ty0] -> Ty0 -> Ty0
ArrowTy ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
forall a. Renamable a => a -> a
go [Ty0]
args) Ty0
ret
      PackedTy String
tycon [Ty0]
ls -> String -> [Ty0] -> Ty0
PackedTy String
tycon ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
forall a. Renamable a => a -> a
go [Ty0]
ls)
      VectorTy Ty0
a        -> Ty0 -> Ty0
VectorTy (Ty0 -> Ty0
forall a. Renamable a => a -> a
go Ty0
a)
      ListTy Ty0
a          -> Ty0 -> Ty0
ListTy (Ty0 -> Ty0
forall a. Renamable a => a -> a
go Ty0
a)
      Ty0
ArenaTy           -> Ty0
ArenaTy
      Ty0
SymSetTy          -> Ty0
SymSetTy
      Ty0
SymHashTy         -> Ty0
SymHashTy
      Ty0
IntHashTy         -> Ty0
IntHashTy
    where
      go :: forall a. Renamable a => a -> a
      go :: forall a. Renamable a => a -> a
go = Map Var Var -> a -> a
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env

-- | Straightforward parametric polymorphism.
data TyScheme = ForAll [TyVar] Ty0
 deriving (Int -> TyScheme -> ShowS
[TyScheme] -> ShowS
TyScheme -> String
(Int -> TyScheme -> ShowS)
-> (TyScheme -> String) -> ([TyScheme] -> ShowS) -> Show TyScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TyScheme -> ShowS
showsPrec :: Int -> TyScheme -> ShowS
$cshow :: TyScheme -> String
show :: TyScheme -> String
$cshowList :: [TyScheme] -> ShowS
showList :: [TyScheme] -> ShowS
Show, ReadPrec [TyScheme]
ReadPrec TyScheme
Int -> ReadS TyScheme
ReadS [TyScheme]
(Int -> ReadS TyScheme)
-> ReadS [TyScheme]
-> ReadPrec TyScheme
-> ReadPrec [TyScheme]
-> Read TyScheme
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TyScheme
readsPrec :: Int -> ReadS TyScheme
$creadList :: ReadS [TyScheme]
readList :: ReadS [TyScheme]
$creadPrec :: ReadPrec TyScheme
readPrec :: ReadPrec TyScheme
$creadListPrec :: ReadPrec [TyScheme]
readListPrec :: ReadPrec [TyScheme]
Read, TyScheme -> TyScheme -> Bool
(TyScheme -> TyScheme -> Bool)
-> (TyScheme -> TyScheme -> Bool) -> Eq TyScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyScheme -> TyScheme -> Bool
== :: TyScheme -> TyScheme -> Bool
$c/= :: TyScheme -> TyScheme -> Bool
/= :: TyScheme -> TyScheme -> Bool
Eq, Eq TyScheme
Eq TyScheme
-> (TyScheme -> TyScheme -> Ordering)
-> (TyScheme -> TyScheme -> Bool)
-> (TyScheme -> TyScheme -> Bool)
-> (TyScheme -> TyScheme -> Bool)
-> (TyScheme -> TyScheme -> Bool)
-> (TyScheme -> TyScheme -> TyScheme)
-> (TyScheme -> TyScheme -> TyScheme)
-> Ord TyScheme
TyScheme -> TyScheme -> Bool
TyScheme -> TyScheme -> Ordering
TyScheme -> TyScheme -> TyScheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TyScheme -> TyScheme -> Ordering
compare :: TyScheme -> TyScheme -> Ordering
$c< :: TyScheme -> TyScheme -> Bool
< :: TyScheme -> TyScheme -> Bool
$c<= :: TyScheme -> TyScheme -> Bool
<= :: TyScheme -> TyScheme -> Bool
$c> :: TyScheme -> TyScheme -> Bool
> :: TyScheme -> TyScheme -> Bool
$c>= :: TyScheme -> TyScheme -> Bool
>= :: TyScheme -> TyScheme -> Bool
$cmax :: TyScheme -> TyScheme -> TyScheme
max :: TyScheme -> TyScheme -> TyScheme
$cmin :: TyScheme -> TyScheme -> TyScheme
min :: TyScheme -> TyScheme -> TyScheme
Ord, (forall x. TyScheme -> Rep TyScheme x)
-> (forall x. Rep TyScheme x -> TyScheme) -> Generic TyScheme
forall x. Rep TyScheme x -> TyScheme
forall x. TyScheme -> Rep TyScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TyScheme -> Rep TyScheme x
from :: forall x. TyScheme -> Rep TyScheme x
$cto :: forall x. Rep TyScheme x -> TyScheme
to :: forall x. Rep TyScheme x -> TyScheme
Generic, TyScheme -> ()
(TyScheme -> ()) -> NFData TyScheme
forall a. (a -> ()) -> NFData a
$crnf :: TyScheme -> ()
rnf :: TyScheme -> ()
NFData)

-- instance FreeVars TyScheme where
--   gFreeVars (ForAll tvs ty) = gFreeVars ty `S.difference` (S.fromList tvs)

arrIns :: TyScheme -> [Ty0]
arrIns :: TyScheme -> [Ty0]
arrIns (ForAll [TyVar]
_ (ArrowTy [Ty0]
i Ty0
_)) = [Ty0]
i
arrIns TyScheme
err = String -> [Ty0]
forall a. HasCallStack => String -> a
error (String -> [Ty0]) -> String -> [Ty0]
forall a b. (a -> b) -> a -> b
$ String
"arrIns: Not an arrow type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyScheme -> String
forall a. Show a => a -> String
show TyScheme
err

arrOut :: TyScheme -> Ty0
arrOut :: TyScheme -> Ty0
arrOut (ForAll [TyVar]
_ (ArrowTy [Ty0]
_ Ty0
o)) = Ty0
o
arrOut TyScheme
err = String -> Ty0
forall a. HasCallStack => String -> a
error (String -> Ty0) -> String -> Ty0
forall a b. (a -> b) -> a -> b
$ String
"arrOut: Not an arrow type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyScheme -> String
forall a. Show a => a -> String
show TyScheme
err

arrIns' :: Ty0 -> [Ty0]
arrIns' :: Ty0 -> [Ty0]
arrIns' (ArrowTy [Ty0]
i Ty0
_) = [Ty0]
i
arrIns' Ty0
err = String -> [Ty0]
forall a. HasCallStack => String -> a
error (String -> [Ty0]) -> String -> [Ty0]
forall a b. (a -> b) -> a -> b
$ String
"arrIns': Not an arrow type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ty0 -> String
forall a. Show a => a -> String
show Ty0
err

tyFromScheme :: TyScheme -> Ty0
tyFromScheme :: TyScheme -> Ty0
tyFromScheme (ForAll [TyVar]
_ Ty0
a) = Ty0
a

tyVarsFromScheme :: TyScheme -> [TyVar]
tyVarsFromScheme :: TyScheme -> [TyVar]
tyVarsFromScheme (ForAll [TyVar]
a Ty0
_) = [TyVar]
a

isFunTy :: Ty0 -> Bool
isFunTy :: Ty0 -> Bool
isFunTy ArrowTy{} = Bool
True
isFunTy Ty0
_ = Bool
False

isCallUnsaturated :: TyScheme -> [Exp0] -> Bool
isCallUnsaturated :: TyScheme -> [Exp0] -> Bool
isCallUnsaturated TyScheme
sigma [Exp0]
args = [Exp0] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp0]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Ty0] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TyScheme -> [Ty0]
arrIns TyScheme
sigma)

saturateCall :: MonadState Int m => TyScheme -> Exp0 -> m Exp0
saturateCall :: forall (m :: * -> *).
MonadState Int m =>
TyScheme -> Exp0 -> m Exp0
saturateCall TyScheme
sigma Exp0
ex =
  case Exp0
ex of
    AppE Var
f [] [Exp0]
args -> do
      -- # args needed to saturate this call-site.
      let args_wanted :: Int
args_wanted = [Ty0] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TyScheme -> [Ty0]
arrIns TyScheme
sigma) Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Exp0] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp0]
args
      [Var]
new_args <- (Int -> m Var) -> [Int] -> m [Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
_ -> Var -> m Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"sat_arg_") [Int
0..(Int
args_wantedInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
      [Ty0]
new_tys  <- (Var -> m Ty0) -> [Var] -> m [Ty0]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Var
_ -> m Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy) [Var]
new_args
      Exp0 -> m Exp0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> m Exp0) -> Exp0 -> m Exp0
forall a b. (a -> b) -> a -> b
$
        E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([(Var, Ty0)] -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE ([Var] -> [Ty0] -> [(Var, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
new_args [Ty0]
new_tys)
               (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] ([Exp0]
args [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ ((Var -> Exp0) -> [Var] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE [Var]
new_args))))

    AppE Var
_ [Ty0]
tyapps [Exp0]
_ ->
      String -> m Exp0
forall a. HasCallStack => String -> a
error (String -> m Exp0) -> String -> m Exp0
forall a b. (a -> b) -> a -> b
$ String
"saturateCall: Expected tyapps to be [], got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Ty0] -> String
forall a. Out a => a -> String
sdoc [Ty0]
tyapps
    Exp0
_ -> String -> m Exp0
forall a. HasCallStack => String -> a
error (String -> m Exp0) -> String -> m Exp0
forall a b. (a -> b) -> a -> b
$ String
"saturateCall: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Exp0 -> String
forall a. Out a => a -> String
sdoc Exp0
ex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a call-site."

-- | Get the free TyVars from types; no duplicates in result.
tyVarsInTy :: Ty0 -> [TyVar]
tyVarsInTy :: Ty0 -> [TyVar]
tyVarsInTy Ty0
ty = [Ty0] -> [TyVar]
tyVarsInTys [Ty0
ty]

-- | Like 'tyVarsInTy'.
tyVarsInTys :: [Ty0] -> [TyVar]
tyVarsInTys :: [Ty0] -> [TyVar]
tyVarsInTys [Ty0]
tys = (Ty0 -> [TyVar] -> [TyVar]) -> [TyVar] -> [Ty0] -> [TyVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go []) [] [Ty0]
tys
  where
    go :: [TyVar] -> Ty0 -> [TyVar] -> [TyVar]
    go :: [TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound Ty0
ty [TyVar]
acc =
      case Ty0
ty of
        Ty0
IntTy  -> [TyVar]
acc
        Ty0
CharTy -> [TyVar]
acc
        Ty0
FloatTy-> [TyVar]
acc
        Ty0
SymTy0 -> [TyVar]
acc
        Ty0
BoolTy -> [TyVar]
acc
        TyVar TyVar
tv -> if (TyVar
tv TyVar -> [TyVar] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TyVar]
bound) Bool -> Bool -> Bool
|| (TyVar
tv TyVar -> [TyVar] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TyVar]
acc)
                    then [TyVar]
acc
                    else TyVar
tv TyVar -> [TyVar] -> [TyVar]
forall a. a -> [a] -> [a]
: [TyVar]
acc
        MetaTv MetaTv
_ -> [TyVar]
acc
        ProdTy [Ty0]
tys1     -> (Ty0 -> [TyVar] -> [TyVar]) -> [TyVar] -> [Ty0] -> [TyVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound) [TyVar]
acc [Ty0]
tys1
        SymDictTy Maybe Var
_ Ty0
ty1   -> [TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound Ty0
ty1 [TyVar]
acc
        PDictTy Ty0
k Ty0
v -> (Ty0 -> [TyVar] -> [TyVar]) -> [TyVar] -> [Ty0] -> [TyVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound) [TyVar]
acc [Ty0
k,Ty0
v]
        ArrowTy [Ty0]
tys1 Ty0
b  -> (Ty0 -> [TyVar] -> [TyVar]) -> [TyVar] -> [Ty0] -> [TyVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound) ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound Ty0
b [TyVar]
acc) [Ty0]
tys1
        PackedTy String
_ [Ty0]
tys1 -> (Ty0 -> [TyVar] -> [TyVar]) -> [TyVar] -> [Ty0] -> [TyVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound) [TyVar]
acc [Ty0]
tys1
        VectorTy Ty0
ty1 -> [TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound Ty0
ty1 [TyVar]
acc
        ListTy Ty0
ty1 -> [TyVar] -> Ty0 -> [TyVar] -> [TyVar]
go [TyVar]
bound Ty0
ty1 [TyVar]
acc
        Ty0
ArenaTy -> [TyVar]
acc
        Ty0
SymSetTy -> [TyVar]
acc
        Ty0
SymHashTy -> [TyVar]
acc
        Ty0
IntHashTy -> [TyVar]
acc

-- | Get the MetaTvs from a type; no duplicates in result.
metaTvsInTy :: Ty0 -> [MetaTv]
metaTvsInTy :: Ty0 -> [MetaTv]
metaTvsInTy Ty0
ty = [Ty0] -> [MetaTv]
metaTvsInTys [Ty0
ty]

-- | Like 'metaTvsInTy'.
metaTvsInTys :: [Ty0] -> [MetaTv]
metaTvsInTys :: [Ty0] -> [MetaTv]
metaTvsInTys [Ty0]
tys = (Ty0 -> [MetaTv] -> [MetaTv]) -> [MetaTv] -> [Ty0] -> [MetaTv]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ty0 -> [MetaTv] -> [MetaTv]
go [] [Ty0]
tys
  where
    go :: Ty0 -> [MetaTv] -> [MetaTv]
    go :: Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
ty [MetaTv]
acc =
      case Ty0
ty of
        MetaTv MetaTv
tv -> if MetaTv
tv MetaTv -> [MetaTv] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MetaTv]
acc
                     then [MetaTv]
acc
                     else MetaTv
tv MetaTv -> [MetaTv] -> [MetaTv]
forall a. a -> [a] -> [a]
: [MetaTv]
acc
        Ty0
IntTy   -> [MetaTv]
acc
        Ty0
CharTy  -> [MetaTv]
acc
        Ty0
FloatTy -> [MetaTv]
acc
        Ty0
SymTy0  -> [MetaTv]
acc
        Ty0
BoolTy  -> [MetaTv]
acc
        TyVar{} -> [MetaTv]
acc
        ProdTy [Ty0]
tys1     -> (Ty0 -> [MetaTv] -> [MetaTv]) -> [MetaTv] -> [Ty0] -> [MetaTv]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ty0 -> [MetaTv] -> [MetaTv]
go [MetaTv]
acc [Ty0]
tys1
        SymDictTy Maybe Var
_ Ty0
ty1   -> Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
ty1 [MetaTv]
acc
        PDictTy Ty0
k Ty0
v -> Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
v (Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
k [MetaTv]
acc)
        ArrowTy [Ty0]
tys1 Ty0
b  -> Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
b ((Ty0 -> [MetaTv] -> [MetaTv]) -> [MetaTv] -> [Ty0] -> [MetaTv]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ty0 -> [MetaTv] -> [MetaTv]
go [MetaTv]
acc [Ty0]
tys1)
        PackedTy String
_ [Ty0]
tys1 -> (Ty0 -> [MetaTv] -> [MetaTv]) -> [MetaTv] -> [Ty0] -> [MetaTv]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ty0 -> [MetaTv] -> [MetaTv]
go [MetaTv]
acc [Ty0]
tys1
        VectorTy Ty0
ty1 -> Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
ty1 [MetaTv]
acc
        ListTy Ty0
ty1 -> Ty0 -> [MetaTv] -> [MetaTv]
go Ty0
ty1 [MetaTv]
acc
        Ty0
ArenaTy -> [MetaTv]
acc
        Ty0
SymSetTy -> [MetaTv]
acc
        Ty0
SymHashTy -> [MetaTv]
acc
        Ty0
IntHashTy -> [MetaTv]
acc

-- | Like 'tyVarsInTy'.
tyVarsInTyScheme :: TyScheme -> [TyVar]
tyVarsInTyScheme :: TyScheme -> [TyVar]
tyVarsInTyScheme (ForAll [TyVar]
tyvars Ty0
ty) = Ty0 -> [TyVar]
tyVarsInTy Ty0
ty [TyVar] -> [TyVar] -> [TyVar]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [TyVar]
tyvars

-- | Like 'metaTvsInTy'.
metaTvsInTyScheme :: TyScheme -> [MetaTv]
metaTvsInTyScheme :: TyScheme -> [MetaTv]
metaTvsInTyScheme (ForAll [TyVar]
_ Ty0
ty) = Ty0 -> [MetaTv]
metaTvsInTy Ty0
ty -- ForAll binds TyVars only

-- | Like 'metaTvsInTys'.
metaTvsInTySchemes :: [TyScheme] -> [MetaTv]
metaTvsInTySchemes :: [TyScheme] -> [MetaTv]
metaTvsInTySchemes [TyScheme]
tys = (TyScheme -> [MetaTv]) -> [TyScheme] -> [MetaTv]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyScheme -> [MetaTv]
metaTvsInTyScheme [TyScheme]
tys

arrowTysInTy :: Ty0 -> [Ty0]
arrowTysInTy :: Ty0 -> [Ty0]
arrowTysInTy = [Ty0] -> Ty0 -> [Ty0]
go []
  where
    go :: [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc Ty0
ty =
      case Ty0
ty of
        Ty0
IntTy    -> [Ty0]
acc
        Ty0
CharTy   -> [Ty0]
acc
        Ty0
FloatTy  -> [Ty0]
acc
        Ty0
SymTy0   -> [Ty0]
acc
        Ty0
BoolTy   -> [Ty0]
acc
        Ty0
ArenaTy  -> [Ty0]
acc
        TyVar{}  -> [Ty0]
acc
        MetaTv{} -> [Ty0]
acc
        ProdTy [Ty0]
tys -> ([Ty0] -> Ty0 -> [Ty0]) -> [Ty0] -> [Ty0] -> [Ty0]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc [Ty0]
tys
        SymDictTy Maybe Var
_ Ty0
a -> [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc Ty0
a
        PDictTy Ty0
k Ty0
v   -> [Ty0] -> Ty0 -> [Ty0]
go ([Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc Ty0
k) Ty0
v
        ArrowTy [Ty0]
tys Ty0
b -> [Ty0] -> Ty0 -> [Ty0]
go (([Ty0] -> Ty0 -> [Ty0]) -> [Ty0] -> [Ty0] -> [Ty0]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc [Ty0]
tys) Ty0
b [Ty0] -> [Ty0] -> [Ty0]
forall a. [a] -> [a] -> [a]
++ [Ty0
ty]
        PackedTy String
_ [Ty0]
vs -> ([Ty0] -> Ty0 -> [Ty0]) -> [Ty0] -> [Ty0] -> [Ty0]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc [Ty0]
vs
        VectorTy Ty0
a -> [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc Ty0
a
        ListTy Ty0
a  -> [Ty0] -> Ty0 -> [Ty0]
go [Ty0]
acc Ty0
a
        Ty0
SymSetTy  -> [Ty0]
acc
        Ty0
SymHashTy -> [Ty0]
acc
        Ty0
IntHashTy -> [Ty0]
acc

-- | Replace the specified quantified type variables by
-- given meta type variables.
substTyVar :: M.Map TyVar Ty0 -> Ty0 -> Ty0
substTyVar :: Map TyVar Ty0 -> Ty0 -> Ty0
substTyVar Map TyVar Ty0
mp Ty0
ty =
  case Ty0
ty of
    Ty0
IntTy    -> Ty0
ty
    Ty0
CharTy   -> Ty0
ty
    Ty0
FloatTy  -> Ty0
ty
    Ty0
SymTy0   -> Ty0
ty
    Ty0
BoolTy   -> Ty0
ty
    TyVar TyVar
v  -> Ty0 -> TyVar -> Map TyVar Ty0 -> Ty0
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Ty0
ty TyVar
v Map TyVar Ty0
mp
    MetaTv{} -> Ty0
ty
    ProdTy [Ty0]
tys  -> [Ty0] -> Ty0
ProdTy ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
go [Ty0]
tys)
    SymDictTy Maybe Var
v Ty0
t -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
v (Ty0 -> Ty0
go Ty0
t)
    PDictTy Ty0
k Ty0
v -> Ty0 -> Ty0 -> Ty0
PDictTy (Ty0 -> Ty0
go Ty0
k) (Ty0 -> Ty0
go Ty0
v)
    ArrowTy [Ty0]
tys Ty0
b  -> [Ty0] -> Ty0 -> Ty0
ArrowTy ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
go [Ty0]
tys) (Ty0 -> Ty0
go Ty0
b)
    PackedTy String
t [Ty0]
tys -> String -> [Ty0] -> Ty0
PackedTy String
t ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
go [Ty0]
tys)
    VectorTy Ty0
t -> Ty0 -> Ty0
VectorTy (Ty0 -> Ty0
go Ty0
t)
    ListTy Ty0
t -> Ty0 -> Ty0
ListTy (Ty0 -> Ty0
go Ty0
t)
    Ty0
ArenaTy -> Ty0
ty
    Ty0
SymSetTy -> Ty0
ty
    Ty0
SymHashTy -> Ty0
ty
    Ty0
IntHashTy -> Ty0
ty
  where
    go :: Ty0 -> Ty0
go = Map TyVar Ty0 -> Ty0 -> Ty0
substTyVar Map TyVar Ty0
mp

isScalarTy0 :: Ty0 -> Bool
isScalarTy0 :: Ty0 -> Bool
isScalarTy0 Ty0
IntTy  = Bool
True
isScalarTy0 Ty0
CharTy = Bool
True
isScalarTy0 Ty0
SymTy0 = Bool
True
isScalarTy0 Ty0
BoolTy = Bool
True
isScalarTy0 Ty0
FloatTy= Bool
True
isScalarTy0 Ty0
_      = Bool
False

voidTy0 :: Ty0
voidTy0 :: Ty0
voidTy0 = [Ty0] -> Ty0
ProdTy []

-- | Lists of scalars or flat products of scalars are allowed.
isValidListElemTy0 :: Ty0 -> Bool
isValidListElemTy0 :: Ty0 -> Bool
isValidListElemTy0 Ty0
ty
  | Ty0 -> Bool
isScalarTy0 Ty0
ty = Bool
True
  | Bool
otherwise = case Ty0
ty of
                  ProdTy [Ty0]
tys -> (Ty0 -> Bool) -> [Ty0] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Ty0 -> Bool
isScalarTy0 [Ty0]
tys
                  Ty0
_ -> Bool
False

-- Hack: in the specializer, we sometimes want to know the type of
-- an expression. However, we cannot derive Typeable for L0.
--
-- Typeable is based on 'UrTy' which is used by the L1, L2 and L3 IR's, but *not* L0.
-- L0 uses it's own type (Ty0) representation.
--
-- Can we merge 'Ty0' and 'UrTy' ? We could, but we would end up polluting 'UrTy'
-- with type variables and function types and such, which are unused after L0.
-- Or we can have a special function just for L0, which is what recoverType is.
-- ¯\_(ツ)_/¯
--
recoverType :: DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType :: DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
ex =
  case Exp0
ex of
    VarE Var
v       -> Ty0 -> Var -> TyEnv Ty0 -> Ty0
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (String -> Ty0
forall a. HasCallStack => String -> a
error (String -> Ty0) -> String -> Ty0
forall a b. (a -> b) -> a -> b
$ String
"recoverType: Unbound variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
v) Var
v (Env2 Ty0 -> TyEnv Ty0
forall a. Env2 a -> TyEnv a
vEnv Env2 Ty0
env2)
    LitE Int
_       -> Ty0
IntTy
    CharE Char
_      -> Ty0
CharTy
    FloatE{}     -> Ty0
FloatTy
    LitSymE Var
_    -> Ty0
IntTy
    AppE Var
v [Ty0]
tyapps [Exp0]
_ -> let (ForAll [TyVar]
tyvars (ArrowTy [Ty0]
_ Ty0
retty)) = Env2 Ty0 -> TyEnv (ArrowTy Ty0)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 Ty0
env2 Map Var TyScheme -> Var -> TyScheme
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v
                       in Map TyVar Ty0 -> Ty0 -> Ty0
substTyVar ([(TyVar, Ty0)] -> Map TyVar Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b.
(Show a, Show b, HasCallStack) =>
[a] -> [b] -> [(a, b)]
fragileZip [TyVar]
tyvars [Ty0]
tyapps)) Ty0
retty
    -- PrimAppE (DictInsertP ty) ((L _ (VarE v)):_) -> SymDictTy (Just v) ty
    -- PrimAppE (DictEmptyP  ty) ((L _ (VarE v)):_) -> SymDictTy (Just v) ty
    PrimAppE Prim Ty0
p [Exp0]
_ -> Prim Ty0 -> Ty0
primRetTy1 Prim Ty0
p
    LetE (Var
v,[Ty0]
_,Ty0
t,Exp0
_) Exp0
e -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs (Var -> Ty0 -> Env2 Ty0 -> Env2 Ty0
forall a. Var -> a -> Env2 a -> Env2 a
extendVEnv Var
v Ty0
t Env2 Ty0
env2) Exp0
e
    IfE Exp0
_ Exp0
e Exp0
_        -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e
    MkProdE [Exp0]
es       -> [Ty0] -> Ty0
ProdTy ([Ty0] -> Ty0) -> [Ty0] -> Ty0
forall a b. (a -> b) -> a -> b
$ (Exp0 -> Ty0) -> [Exp0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map (DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2) [Exp0]
es
    DataConE (ProdTy [Ty0]
locs) String
c [Exp0]
_ -> String -> [Ty0] -> Ty0
PackedTy (DDefs0 -> ShowS
forall a. Out a => DDefs a -> ShowS
getTyOfDataCon DDefs0
ddfs String
c) [Ty0]
locs
    DataConE Ty0
loc String
c [Exp0]
_ -> String -> [Ty0] -> Ty0
PackedTy (DDefs0 -> ShowS
forall a. Out a => DDefs a -> ShowS
getTyOfDataCon DDefs0
ddfs String
c) [Ty0
loc]
    TimeIt Exp0
e Ty0
_ Bool
_     -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e
    MapE (Var, Ty0, Exp0)
_ Exp0
e         -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e
    FoldE (Var, Ty0, Exp0)
_ (Var, Ty0, Exp0)
_ Exp0
e      -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e
    ProjE Int
i Exp0
e ->
      case DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e of
        (ProdTy [Ty0]
tys) -> [Ty0]
tys [Ty0] -> Int -> Ty0
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
        Ty0
oth -> String -> Ty0
forall a. HasCallStack => String -> a
error(String -> Ty0) -> String -> Ty0
forall a b. (a -> b) -> a -> b
$ String
"typeExp: Cannot project fields from this type: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Ty0 -> String
forall a. Show a => a -> String
show Ty0
oth
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\nExpression:\n  "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Exp0 -> String
forall a. Out a => a -> String
sdoc Exp0
ex
                      String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\nEnvironment:\n  "String -> ShowS
forall a. [a] -> [a] -> [a]
++TyEnv Ty0 -> String
forall a. Out a => a -> String
sdoc (Env2 Ty0 -> TyEnv Ty0
forall a. Env2 a -> TyEnv a
vEnv Env2 Ty0
env2)
    SpawnE Var
v [Ty0]
tyapps [Exp0]
_ -> let (ForAll [TyVar]
tyvars (ArrowTy [Ty0]
_ Ty0
retty)) = Env2 Ty0 -> TyEnv (ArrowTy Ty0)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 Ty0
env2 Map Var TyScheme -> Var -> TyScheme
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v
                         in Map TyVar Ty0 -> Ty0 -> Ty0
substTyVar ([(TyVar, Ty0)] -> Map TyVar Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b.
(Show a, Show b, HasCallStack) =>
[a] -> [b] -> [(a, b)]
fragileZip [TyVar]
tyvars [Ty0]
tyapps)) Ty0
retty
    Exp0
SyncE -> Ty0
voidTy0
    CaseE Exp0
_ [(String, [(Var, Ty0)], Exp0)]
mp ->
      let (String
c,[(Var, Ty0)]
args,Exp0
e) = [(String, [(Var, Ty0)], Exp0)] -> (String, [(Var, Ty0)], Exp0)
forall a. HasCallStack => [a] -> a
head [(String, [(Var, Ty0)], Exp0)]
mp
          args' :: [Var]
args' = ((Var, Ty0) -> Var) -> [(Var, Ty0)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, Ty0) -> Var
forall a b. (a, b) -> a
fst [(Var, Ty0)]
args
      in DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs (TyEnv Ty0 -> Env2 Ty0 -> Env2 Ty0
forall a. Map Var a -> Env2 a -> Env2 a
extendsVEnv ([(Var, Ty0)] -> TyEnv Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Ty0] -> [(Var, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args' (DDefs0 -> String -> [Ty0]
forall a. Out a => DDefs a -> String -> [a]
lookupDataCon DDefs0
ddfs String
c))) Env2 Ty0
env2) Exp0
e
    WithArenaE{} -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"recoverType: WithArenaE not handled."
    Ext E0Ext Ty0 Ty0
ext ->
      case E0Ext Ty0 Ty0
ext of
        LambdaE [(Var, Ty0)]
args Exp0
bod ->
          DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs (TyEnv Ty0 -> Env2 Ty0 -> Env2 Ty0
forall a. Map Var a -> Env2 a -> Env2 a
extendsVEnv ([(Var, Ty0)] -> TyEnv Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var, Ty0)]
args) Env2 Ty0
env2) Exp0
bod
        FunRefE [Ty0]
_ Var
f ->
          case (Var -> TyEnv Ty0 -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f (Env2 Ty0 -> TyEnv Ty0
forall a. Env2 a -> TyEnv a
vEnv Env2 Ty0
env2), Var -> Map Var TyScheme -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f (Env2 Ty0 -> TyEnv (ArrowTy Ty0)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 Ty0
env2)) of
            (Maybe Ty0
Nothing, Maybe TyScheme
Nothing) -> String -> Ty0
forall a. HasCallStack => String -> a
error (String -> Ty0) -> String -> Ty0
forall a b. (a -> b) -> a -> b
$ String
"recoverType: Unbound function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
f
            (Just Ty0
ty, Maybe TyScheme
_) -> Ty0
ty
            (Maybe Ty0
_, Just TyScheme
ty) -> TyScheme -> Ty0
tyFromScheme TyScheme
ty -- CSK: Not sure if this is what we want?
        PolyAppE{}  -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"recoverTypeep: TODO PolyAppE"
        BenchE Var
fn [Ty0]
_ [Exp0]
_ Bool
_ -> ArrowTy Ty0 -> Ty0
forall ty. FunctionTy ty => ArrowTy ty -> ty
outTy (ArrowTy Ty0 -> Ty0) -> ArrowTy Ty0 -> Ty0
forall a b. (a -> b) -> a -> b
$ Env2 Ty0 -> TyEnv (ArrowTy Ty0)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 Ty0
env2 Map Var TyScheme -> Var -> TyScheme
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
fn
        PrintPacked Ty0
_ Exp0
arg -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
arg
        CopyPacked Ty0
_ Exp0
arg -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
arg
        TravPacked Ty0
_ Exp0
_ -> Ty0
voidTy0
        ParE0 [Exp0]
ls -> [Ty0] -> Ty0
ProdTy ([Ty0] -> Ty0) -> [Ty0] -> Ty0
forall a b. (a -> b) -> a -> b
$ (Exp0 -> Ty0) -> [Exp0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map (DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2) [Exp0]
ls
        LinearExt LinearExt Ty0 Ty0
lin ->
          case LinearExt Ty0 Ty0
lin of
            ReverseAppE Exp0
fn Exp0
_args -> case DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
fn of
                                      ArrowTy [Ty0]
_ Ty0
ty -> Ty0
ty
                                      Ty0
oth -> String -> Ty0
forall a. HasCallStack => String -> a
error (String -> Ty0) -> String -> Ty0
forall a b. (a -> b) -> a -> b
$ String
"recoverType: ReverseAppE expected a function type, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ty0 -> String
forall a. Out a => a -> String
sdoc Ty0
oth
            LseqE Exp0
_ Exp0
b -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
b
            AliasE Exp0
a  -> let ty :: Ty0
ty = DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
a
                         in [Ty0] -> Ty0
ProdTy [Ty0
ty,Ty0
ty]
            ToLinearE Exp0
a -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
a

        L Loc
_ Exp0
e    -> DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
recoverType DDefs0
ddfs Env2 Ty0
env2 Exp0
e
  where
    -- Return type for a primitive operation.
    primRetTy1 :: Prim Ty0 -> Ty0
    primRetTy1 :: Prim Ty0 -> Ty0
primRetTy1 Prim Ty0
p =
      case Prim Ty0
p of
        Prim Ty0
AddP -> Ty0
IntTy
        Prim Ty0
SubP -> Ty0
IntTy
        Prim Ty0
MulP -> Ty0
IntTy
        Prim Ty0
DivP -> Ty0
IntTy
        Prim Ty0
ModP -> Ty0
IntTy
        Prim Ty0
ExpP -> Ty0
IntTy
        Prim Ty0
RandP-> Ty0
IntTy
        Prim Ty0
FAddP -> Ty0
FloatTy
        Prim Ty0
FSubP -> Ty0
FloatTy
        Prim Ty0
FMulP -> Ty0
FloatTy
        Prim Ty0
FDivP -> Ty0
FloatTy
        Prim Ty0
FExpP -> Ty0
FloatTy
        Prim Ty0
FSqrtP-> Ty0
FloatTy
        Prim Ty0
FRandP-> Ty0
FloatTy
        Prim Ty0
FTanP -> Ty0
FloatTy
        Prim Ty0
FloatToIntP -> Ty0
IntTy
        Prim Ty0
IntToFloatP -> Ty0
FloatTy
        Prim Ty0
EqSymP  -> Ty0
BoolTy
        EqBenchProgP String
_ -> Ty0
BoolTy
        Prim Ty0
EqIntP  -> Ty0
BoolTy
        Prim Ty0
EqFloatP-> Ty0
BoolTy
        Prim Ty0
EqCharP -> Ty0
BoolTy
        Prim Ty0
LtP  -> Ty0
BoolTy
        Prim Ty0
GtP  -> Ty0
BoolTy
        Prim Ty0
OrP  -> Ty0
BoolTy
        Prim Ty0
LtEqP-> Ty0
BoolTy
        Prim Ty0
GtEqP-> Ty0
BoolTy
        Prim Ty0
FLtP  -> Ty0
BoolTy
        Prim Ty0
FGtP  -> Ty0
BoolTy
        Prim Ty0
FLtEqP-> Ty0
BoolTy
        Prim Ty0
FGtEqP-> Ty0
BoolTy
        Prim Ty0
AndP -> Ty0
BoolTy
        Prim Ty0
MkTrue  -> Ty0
BoolTy
        Prim Ty0
MkFalse -> Ty0
BoolTy
        Prim Ty0
Gensym  -> Ty0
SymTy0
        Prim Ty0
SizeParam      -> Ty0
IntTy
        Prim Ty0
IsBig          -> Ty0
BoolTy
        DictHasKeyP Ty0
_  -> Ty0
BoolTy
        DictEmptyP Ty0
ty  -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
forall a. Maybe a
Nothing Ty0
ty
        DictInsertP Ty0
ty -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
forall a. Maybe a
Nothing Ty0
ty
        DictLookupP Ty0
ty -> Ty0
ty
        VAllocP Ty0
elty   -> Ty0 -> Ty0
VectorTy Ty0
elty
        VFreeP Ty0
_elty   -> [Ty0] -> Ty0
ProdTy []
        VFree2P Ty0
_elty  -> [Ty0] -> Ty0
ProdTy []
        VLengthP Ty0
_elty -> Ty0
IntTy
        VNthP Ty0
elty     -> Ty0
elty
        VSliceP Ty0
elty   -> Ty0 -> Ty0
VectorTy Ty0
elty
        InplaceVUpdateP Ty0
elty -> Ty0 -> Ty0
VectorTy Ty0
elty
        VConcatP Ty0
elty  -> Ty0 -> Ty0
VectorTy Ty0
elty
        VSortP Ty0
elty        -> Ty0 -> Ty0
VectorTy Ty0
elty
        InplaceVSortP Ty0
elty -> Ty0 -> Ty0
VectorTy Ty0
elty
        VMergeP Ty0
elty -> Ty0 -> Ty0
VectorTy Ty0
elty
        PDictInsertP Ty0
kty Ty0
vty -> Ty0 -> Ty0 -> Ty0
PDictTy Ty0
kty Ty0
vty
        PDictLookupP Ty0
_kty Ty0
vty -> Ty0
vty
        PDictAllocP Ty0
kty Ty0
vty -> Ty0 -> Ty0 -> Ty0
PDictTy Ty0
kty Ty0
vty
        PDictHasKeyP Ty0
_kty Ty0
_vty -> Ty0
BoolTy
        PDictForkP Ty0
kty Ty0
vty -> [Ty0] -> Ty0
ProdTy [Ty0 -> Ty0 -> Ty0
PDictTy Ty0
kty Ty0
vty, Ty0 -> Ty0 -> Ty0
PDictTy Ty0
kty Ty0
vty]
        PDictJoinP Ty0
kty Ty0
vty -> Ty0 -> Ty0 -> Ty0
PDictTy Ty0
kty Ty0
vty
        LLAllocP Ty0
elty -> Ty0 -> Ty0
ListTy Ty0
elty
        LLIsEmptyP Ty0
_elty -> Ty0
BoolTy
        LLConsP Ty0
elty  -> Ty0 -> Ty0
ListTy Ty0
elty
        LLHeadP Ty0
elty  -> Ty0
elty
        LLTailP Ty0
elty  -> Ty0 -> Ty0
ListTy Ty0
elty
        LLFreeP Ty0
_elty   -> [Ty0] -> Ty0
ProdTy []
        LLFree2P Ty0
_elty  -> [Ty0] -> Ty0
ProdTy []
        LLCopyP Ty0
elty -> Ty0 -> Ty0
ListTy Ty0
elty
        Prim Ty0
GetNumProcessors -> Ty0
IntTy
        (ErrorP String
_ Ty0
ty)  -> Ty0
ty
        ReadPackedFile Maybe String
_ String
_ Maybe Var
_ Ty0
ty -> Ty0
ty
        WritePackedFile{} -> [Ty0] -> Ty0
ProdTy []
        ReadArrayFile Maybe (String, Int)
_ Ty0
ty      -> Ty0
ty
        Prim Ty0
PrintInt     -> [Ty0] -> Ty0
ProdTy []
        Prim Ty0
PrintChar    -> [Ty0] -> Ty0
ProdTy []
        Prim Ty0
PrintFloat   -> [Ty0] -> Ty0
ProdTy []
        Prim Ty0
PrintBool    -> [Ty0] -> Ty0
ProdTy []
        Prim Ty0
PrintSym     -> [Ty0] -> Ty0
ProdTy []
        Prim Ty0
ReadInt      -> Ty0
IntTy
        Prim Ty0
RequestSizeOf-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: RequestSizeOf not handled yet"
        Prim Ty0
RequestEndOf -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: RequestEndOf not handled yet"
        Prim Ty0
SymSetEmpty  -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymSetEmpty not handled yet"
        Prim Ty0
SymSetContains-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymSetContains not handled yet"
        Prim Ty0
SymSetInsert -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymSetInsert not handled yet"
        Prim Ty0
SymHashEmpty -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymHashEmpty not handled yet"
        Prim Ty0
SymHashInsert-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymHashInsert not handled yet"
        Prim Ty0
SymHashLookup-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymHashLookup not handled yet"
        Prim Ty0
SymHashContains-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: SymHashLookup not handled yet"
        Prim Ty0
IntHashEmpty -> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: IntHashEmpty not handled yet"
        Prim Ty0
IntHashInsert-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: IntHashInsert not handled yet"
        Prim Ty0
IntHashLookup-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: IntHashLookup not handled yet"
        Write3dPpmFile{}-> String -> Ty0
forall a. HasCallStack => String -> a
error String
"primRetTy1: Write3dPpmFile not handled yet"


{-

-- | Variable definitions

-- ^ Monomorphic version
data VarDef a ex = VarDef { varName :: Var
                          , varTy   :: a
                          , varBody :: ex }
  deriving (Show, Eq, Ord, Generic, NFData)

type VarDefs a ex = M.Map Var (VarDef a ex)

type FunDefs0 = M.Map Var FunDef0

type FunDef0 = FunDef (L Exp0)

instance FunctionTy Ty0 where
  type ArrowTy Ty0 = (Ty0 , Ty0)
  inTy = fst
  outTy = snd

-- ^ Polymorphic version

data PVDef a ex = PVDef { vName :: Var
                        , vTy   :: Scheme a
                        , vBody :: ex }
  deriving (Show, Read, Eq, Ord, Generic, NFData)

type PVDefs a ex = M.Map Var (PVDef a ex)

-- | for now, using a specialized DDef for L0
-- this enables the DDefs to have type variables
type PDDefs a = M.Map Var (PDDef a)

data PDDef a = PDDef { dName :: Var
                     , dCons :: [(DataCon,[(IsBoxed,Scheme a)])] } -- ^ Polymorphic data constructors
  deriving (Read,Show,Eq,Ord, Generic)


-- | for now, using a specialized FunDef for L0
-- theoretically these should disappear after monomorphization
-- this enables the FunDefs to have type schemes
type PFDefs a ex = M.Map Var (PFDef a ex)

data PFDef a ex  = PFDef { fName :: Var
                         , fArg  :: Var
                         , fTy   :: Scheme a -- ^ the type will be a ForAll
                         , fBody :: ex }
  deriving (Read,Show,Eq,Ord, Functor, Generic)

-- ^ Polymorphic program
data PProg = PProg { pddefs    :: PDDefs Ty0
                   , pfundefs  :: PFDefs Ty0 (L Exp0)
                   , pvardefs  :: PVDefs Ty0 (L Exp0)
                   , pmainExp  :: Maybe (L Exp0)
                   }
  deriving (Show, Eq, Ord, Generic)

-- ^ Monomorphic program
data MProg = MProg { ddefs    :: DDefs Ty0
                   , fundefs  :: FunDefs0
                   , vardefs  :: VarDefs Ty0 (L Exp0)
                   , mainExp  :: Maybe (L Exp0)
                   }
  deriving (Show, Eq, Ord, Generic)

-- | some type defns to make things look cleaner
type Exp = (L Exp0)

-- | we now have curried functions and curried calls
-- curried functions are these variable defns
-- but curried calls vs function calls are PolyAppE vs AppE
type CurFun  = VarDef Ty0 Exp
type CCall = Exp

-- | Monomorphized functions
type L0Fun = FunDef0
type FCall = Exp

arrIn :: Ty0 -> Ty0
arrIn (ArrowTy i _) = i
arrIn err = error $ "arrIn: Not an arrow type: " ++ show err

arrOut :: Ty0 -> Ty0
arrOut (ArrowTy _ o) = o
arrOut err = error $ "arrOut: Not an arrow type: " ++ show err

typeFromScheme :: Scheme a -> a
typeFromScheme (ForAll _ a) = a

initFunEnv :: PFDefs Ty0 Exp -> FunEnv Ty0
initFunEnv fds = M.foldr (\fn acc -> let fnTy = typeFromScheme (fTy fn)
                                         fntyin  = arrIn fnTy
                                         fntyout = arrOut fnTy
                                     in M.insert (fName fn) (fntyin, fntyout) acc)
                 M.empty fds

initVarEnv :: PVDefs Ty0 Exp -> M.Map Var Ty0
initVarEnv vds = M.foldr (\v acc -> M.insert (vName v) (typeFromScheme (vTy v)) acc)
                 M.empty vds
-}