module Gibbon.L0.ElimNewtype where

import Gibbon.L0.Syntax
import Gibbon.Common

import Control.Arrow
import qualified Data.Map as M
import qualified Data.Set as S

elimNewtypes :: Monad m => Prog0 -> m Prog0
elimNewtypes :: forall (m :: * -> *). Monad m => Prog0 -> m Prog0
elimNewtypes = Prog0 -> m Prog0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog0 -> m Prog0) -> (Prog0 -> Prog0) -> Prog0 -> m Prog0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog0 -> Prog0
elimProgram

packedOccurs :: Var -> Ty0 -> Bool
packedOccurs :: Var -> Ty0 -> Bool
packedOccurs v :: Var
v@(Var Symbol
s) Ty0
t = case Ty0
t of
  PackedTy String
u [Ty0]
ts
    | Symbol -> String
unintern Symbol
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
u -> Bool
True
    | Bool
otherwise -> (Ty0 -> Bool) -> [Ty0] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Ty0 -> Bool
go [Ty0]
ts
  ProdTy [Ty0]
ts -> (Ty0 -> Bool) -> [Ty0] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Ty0 -> Bool
go [Ty0]
ts
  SymDictTy Maybe Var
_ Ty0
x -> Ty0 -> Bool
go Ty0
x
  ArrowTy [Ty0]
ts Ty0
x -> (Ty0 -> Bool) -> [Ty0] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Ty0 -> Bool
go [Ty0]
ts Bool -> Bool -> Bool
|| Ty0 -> Bool
go Ty0
x
  VectorTy Ty0
x -> Ty0 -> Bool
go Ty0
x
  ListTy Ty0
x -> Ty0 -> Bool
go Ty0
x
  Ty0
_ -> Bool
False
  where
    go :: Ty0 -> Bool
go = Var -> Ty0 -> Bool
packedOccurs Var
v

type TyMap = M.Map String ([Ty0] -> Ty0)
-- type params -> type in terms of params -> args -> substituted type
mkPolyNames :: [TyVar] -> Ty0 -> [Ty0] -> Ty0
mkPolyNames :: [TyVar] -> Ty0 -> [Ty0] -> Ty0
mkPolyNames [TyVar]
params Ty0
paramty [Ty0]
args =
  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)] -> Map TyVar Ty0)
-> [(TyVar, Ty0)] -> Map TyVar Ty0
forall a b. (a -> b) -> a -> b
$ [TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TyVar]
params [Ty0]
args) Ty0
paramty

elimProgram :: Prog0 -> Prog0
elimProgram :: Prog0 -> Prog0
elimProgram Prog0
prog =
  Prog
    { mainExp :: Maybe (Exp0, TyOf Exp0)
mainExp = (Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE Set String
connames TyMap
tynames (Prog0 -> DDefs (TyOf Exp0)
forall ex. Prog ex -> DDefs (TyOf ex)
ddefs Prog0
prog) (Exp0 -> Exp0) -> (Ty0 -> Ty0) -> (Exp0, Ty0) -> (Exp0, Ty0)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** TyMap -> Ty0 -> Ty0
elimTy TyMap
tynames) ((Exp0, Ty0) -> (Exp0, Ty0))
-> Maybe (Exp0, Ty0) -> Maybe (Exp0, Ty0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Prog0 -> Maybe (Exp0, TyOf Exp0)
forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp Prog0
prog
    , fundefs :: FunDefs Exp0
fundefs = FunDefs Exp0
fdefs
    , ddefs :: DDefs (TyOf Exp0)
ddefs = DDefs (TyOf Exp0)
DDefs Ty0
tys
    }
  where
    (DDefs Ty0
newtys, DDefs Ty0
tys) = (DDef Ty0 -> Bool) -> DDefs Ty0 -> (DDefs Ty0, DDefs Ty0)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition (\DDef Ty0
x -> case DDef Ty0 -> [(String, [(Bool, Ty0)])]
forall a. DDef a -> [(String, [(Bool, a)])]
dataCons DDef Ty0
x of
        [(String
_, [(Bool
_, Ty0
t)])] -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Var -> Ty0 -> Bool
packedOccurs (DDef Ty0 -> Var
forall a. DDef a -> Var
tyName DDef Ty0
x) Ty0
t
        [(String, [(Bool, Ty0)])]
_ -> Bool
False
      ) (Prog0 -> DDefs (TyOf Exp0)
forall ex. Prog ex -> DDefs (TyOf ex)
ddefs Prog0
prog)
    tynames :: TyMap
tynames =
      (Var -> String) -> Map Var ([Ty0] -> Ty0) -> TyMap
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\(Var Symbol
x) -> Symbol -> String
unintern Symbol
x)
      (Map Var ([Ty0] -> Ty0) -> TyMap)
-> Map Var ([Ty0] -> Ty0) -> TyMap
forall a b. (a -> b) -> a -> b
$ (DDef Ty0 -> [Ty0] -> Ty0) -> DDefs Ty0 -> Map Var ([Ty0] -> Ty0)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ([TyVar] -> Ty0 -> [Ty0] -> Ty0
mkPolyNames ([TyVar] -> Ty0 -> [Ty0] -> Ty0)
-> (DDef Ty0 -> [TyVar]) -> DDef Ty0 -> Ty0 -> [Ty0] -> Ty0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DDef Ty0 -> [TyVar]
forall a. DDef a -> [TyVar]
tyArgs (DDef Ty0 -> Ty0 -> [Ty0] -> Ty0)
-> (DDef Ty0 -> Ty0) -> DDef Ty0 -> [Ty0] -> Ty0
forall a b.
(DDef Ty0 -> a -> b) -> (DDef Ty0 -> a) -> DDef Ty0 -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool, Ty0) -> Ty0
forall a b. (a, b) -> b
snd ((Bool, Ty0) -> Ty0)
-> (DDef Ty0 -> (Bool, Ty0)) -> DDef Ty0 -> Ty0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bool, Ty0)] -> (Bool, Ty0)
forall a. HasCallStack => [a] -> a
head ([(Bool, Ty0)] -> (Bool, Ty0))
-> (DDef Ty0 -> [(Bool, Ty0)]) -> DDef Ty0 -> (Bool, Ty0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [(Bool, Ty0)]) -> [(Bool, Ty0)]
forall a b. (a, b) -> b
snd ((String, [(Bool, Ty0)]) -> [(Bool, Ty0)])
-> (DDef Ty0 -> (String, [(Bool, Ty0)]))
-> DDef Ty0
-> [(Bool, Ty0)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [(Bool, Ty0)])] -> (String, [(Bool, Ty0)])
forall a. HasCallStack => [a] -> a
head ([(String, [(Bool, Ty0)])] -> (String, [(Bool, Ty0)]))
-> (DDef Ty0 -> [(String, [(Bool, Ty0)])])
-> DDef Ty0
-> (String, [(Bool, Ty0)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DDef Ty0 -> [(String, [(Bool, Ty0)])]
forall a. DDef a -> [(String, [(Bool, a)])]
dataCons) DDefs Ty0
newtys
    connames :: Set String
connames = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (String, [(Bool, Ty0)]) -> String
forall a b. (a, b) -> a
fst ((String, [(Bool, Ty0)]) -> String)
-> (DDef Ty0 -> (String, [(Bool, Ty0)])) -> DDef Ty0 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, [(Bool, Ty0)])] -> (String, [(Bool, Ty0)])
forall a. HasCallStack => [a] -> a
head ([(String, [(Bool, Ty0)])] -> (String, [(Bool, Ty0)]))
-> (DDef Ty0 -> [(String, [(Bool, Ty0)])])
-> DDef Ty0
-> (String, [(Bool, Ty0)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DDef Ty0 -> [(String, [(Bool, Ty0)])]
forall a. DDef a -> [(String, [(Bool, a)])]
dataCons (DDef Ty0 -> String) -> [DDef Ty0] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty0 -> [DDef Ty0]
forall k a. Map k a -> [a]
M.elems DDefs Ty0
newtys
    fdefs :: FunDefs Exp0
fdefs = (FunDef Exp0 -> FunDef Exp0) -> FunDefs Exp0 -> FunDefs Exp0
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\FunDef Exp0
d -> FunDef Exp0
d { funTy :: ArrowTy (TyOf Exp0)
funTy=TyMap -> TyScheme -> TyScheme
elimTyScheme TyMap
tynames (FunDef Exp0 -> ArrowTy (TyOf Exp0)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDef Exp0
d)
                           , funBody :: Exp0
funBody=Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE Set String
connames TyMap
tynames (Prog0 -> DDefs (TyOf Exp0)
forall ex. Prog ex -> DDefs (TyOf ex)
ddefs Prog0
prog) (FunDef Exp0 -> Exp0
forall ex. FunDef ex -> ex
funBody FunDef Exp0
d)
                           }) (Prog0 -> FunDefs Exp0
forall ex. Prog ex -> FunDefs ex
fundefs Prog0
prog)

elimE :: S.Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE :: Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE Set String
cns TyMap
tns DDefs Ty0
dds Exp0
e0 = case Exp0
e0 of
  DataConE Ty0
_ty0 String
s [Exp0
e]
    | String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
s Set String
cns -> Exp0 -> Exp0
f Exp0
e
  DataConE Ty0
_ty0 String
s [Exp0]
es -> Ty0 -> String -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> String -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
_ty0 String
s (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
es)
  VarE Var
_ -> Exp0
e0
  LitE Int
_ -> Exp0
e0
  CharE Char
_ -> Exp0
e0
  FloatE Double
_ -> Exp0
e0
  LitSymE Var
_ -> Exp0
e0
  AppE Var
var [Ty0]
ty [Exp0]
es -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
var [Ty0]
ty (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
es)
  PrimAppE Prim Ty0
p [Exp0]
es -> Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (TyMap -> Prim Ty0 -> Prim Ty0
elimPrim TyMap
tns Prim Ty0
p) (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
es)
  LetE (Var
var, [Ty0]
u, Ty0
t, Exp0
e1) Exp0
e2 -> (Var, [Ty0], Ty0, Exp0) -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
var, Ty0 -> Ty0
g (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
u, Ty0 -> Ty0
g Ty0
t, Exp0 -> Exp0
f Exp0
e1) (Exp0 -> Exp0
f Exp0
e2)
  IfE Exp0
e1 Exp0
e2 Exp0
e3 -> Exp0 -> Exp0 -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (Exp0 -> Exp0
f Exp0
e1) (Exp0 -> Exp0
f Exp0
e2) (Exp0 -> Exp0
f Exp0
e3)
  MkProdE [Exp0]
es -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
es)
  ProjE Int
n Exp0
e -> Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
n (Exp0 -> Exp0
f Exp0
e)
  CaseE Exp0
e1 [(String
s, [(Var
var, Ty0
t)], Exp0
e2)]
    | String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member String
s Set String
cns -> (Var, [Ty0], Ty0, Exp0) -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
var, [], Ty0 -> Ty0
g Ty0
t, Exp0 -> Exp0
f Exp0
e1) (Exp0 -> Exp0
f Exp0
e2)
  CaseE Exp0
e [(String, [(Var, Ty0)], Exp0)]
x -> Exp0 -> [(String, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(String, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Exp0 -> Exp0
f Exp0
e) ((\(String
c, [(Var, Ty0)]
v, Exp0
e1) -> (String
c, [(Var, Ty0)]
v, Exp0 -> Exp0
f Exp0
e1)) ((String, [(Var, Ty0)], Exp0) -> (String, [(Var, Ty0)], Exp0))
-> [(String, [(Var, Ty0)], Exp0)] -> [(String, [(Var, Ty0)], Exp0)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, [(Var, Ty0)], Exp0)]
x)
  TimeIt Exp0
e Ty0
t Bool
b -> Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp0 -> Exp0
f Exp0
e) (Ty0 -> Ty0
g Ty0
t) Bool
b
  WithArenaE Var
var Exp0
e -> Var -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
var (Exp0 -> Exp0
f Exp0
e)
  SpawnE Var
var [Ty0]
ts [Exp0]
es -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
var [Ty0]
ts (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
es)

  Ext E0Ext Ty0 Ty0
ext -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Set String -> TyMap -> DDefs Ty0 -> E0Ext Ty0 Ty0 -> E0Ext Ty0 Ty0
elimExt Set String
cns TyMap
tns DDefs Ty0
dds E0Ext Ty0 Ty0
ext)
  Exp0
_ -> Exp0
e0
  where
    f :: Exp0 -> Exp0
f = Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE Set String
cns TyMap
tns DDefs Ty0
dds
    g :: Ty0 -> Ty0
g = TyMap -> Ty0 -> Ty0
elimTy TyMap
tns

elimExt :: S.Set String -> TyMap -> DDefs Ty0 -> E0Ext Ty0 Ty0 -> E0Ext Ty0 Ty0
elimExt :: Set String -> TyMap -> DDefs Ty0 -> E0Ext Ty0 Ty0 -> E0Ext Ty0 Ty0
elimExt Set String
cns TyMap
tns DDefs Ty0
dds E0Ext Ty0 Ty0
ext0 = case E0Ext Ty0 Ty0
ext0 of
  LambdaE [(Var, Ty0)]
args Exp0
applicand -> [(Var, Ty0)] -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE ((Ty0 -> Ty0) -> (Var, Ty0) -> (Var, Ty0)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Ty0 -> Ty0
g ((Var, Ty0) -> (Var, Ty0)) -> [(Var, Ty0)] -> [(Var, Ty0)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Ty0)]
args) (Exp0 -> Exp0
f Exp0
applicand)
  FunRefE [Ty0]
locs Var
var -> [Ty0] -> Var -> E0Ext Ty0 Ty0
forall loc dec. [loc] -> Var -> E0Ext loc dec
FunRefE (Ty0 -> Ty0
g (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
locs) Var
var
  PolyAppE Exp0
pe1 Exp0
pe2 -> Exp0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (Exp0 -> Exp0
f Exp0
pe1) (Exp0 -> Exp0
f Exp0
pe2)
  BenchE Var
var [Ty0]
locs [Exp0]
preexps Bool
bool -> Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
var (Ty0 -> Ty0
g (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
locs) (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
preexps) Bool
bool
  ParE0 [Exp0]
preexps -> [Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 (Exp0 -> Exp0
f (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0]
preexps)
  PrintPacked Ty0
dec Exp0
preexp -> Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked (Ty0 -> Ty0
g Ty0
dec) (Exp0 -> Exp0
f Exp0
preexp)
  CopyPacked Ty0
dec Exp0
preexp -> Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked (Ty0 -> Ty0
g Ty0
dec) (Exp0 -> Exp0
f Exp0
preexp)
  TravPacked Ty0
dec Exp0
preexp -> Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked (Ty0 -> Ty0
g Ty0
dec) (Exp0 -> Exp0
f Exp0
preexp)
  L Loc
loc Exp0
preexp -> Loc -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
loc (Exp0 -> Exp0
f Exp0
preexp)
  LinearExt (ReverseAppE Exp0
pe1 Exp0
pe2) -> LinearExt Ty0 Ty0 -> E0Ext Ty0 Ty0
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Exp0 -> Exp0 -> LinearExt Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
ReverseAppE (Exp0 -> Exp0
f Exp0
pe1) (Exp0 -> Exp0
f Exp0
pe2))
  LinearExt (LseqE Exp0
pe1 Exp0
pe2) -> LinearExt Ty0 Ty0 -> E0Ext Ty0 Ty0
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Exp0 -> Exp0 -> LinearExt Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> LinearExt loc dec
LseqE (Exp0 -> Exp0
f Exp0
pe1) (Exp0 -> Exp0
f Exp0
pe2))
  LinearExt (AliasE Exp0
pe) -> LinearExt Ty0 Ty0 -> E0Ext Ty0 Ty0
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Exp0 -> LinearExt Ty0 Ty0
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
AliasE (Exp0 -> Exp0
f Exp0
pe))
  LinearExt (ToLinearE Exp0
pe) -> LinearExt Ty0 Ty0 -> E0Ext Ty0 Ty0
forall loc dec. LinearExt loc dec -> E0Ext loc dec
LinearExt (Exp0 -> LinearExt Ty0 Ty0
forall loc dec. PreExp E0Ext loc dec -> LinearExt loc dec
ToLinearE (Exp0 -> Exp0
f Exp0
pe))
  where
    f :: Exp0 -> Exp0
f = Set String -> TyMap -> DDefs Ty0 -> Exp0 -> Exp0
elimE Set String
cns TyMap
tns DDefs Ty0
dds
    g :: Ty0 -> Ty0
g = TyMap -> Ty0 -> Ty0
elimTy TyMap
tns

elimPrim :: TyMap -> Prim Ty0 -> Prim Ty0
elimPrim :: TyMap -> Prim Ty0 -> Prim Ty0
elimPrim TyMap
tns Prim Ty0
p0 = case Prim Ty0
p0 of
  ErrorP String
s Ty0
t -> String -> Ty0 -> Prim Ty0
forall ty. String -> ty -> Prim ty
ErrorP String
s (Ty0 -> Ty0
f Ty0
t)
  DictInsertP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
DictInsertP (Ty0 -> Ty0
f Ty0
t)
  DictLookupP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
DictLookupP (Ty0 -> Ty0
f Ty0
t)
  DictEmptyP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
DictEmptyP (Ty0 -> Ty0
f Ty0
t)
  DictHasKeyP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
DictHasKeyP (Ty0 -> Ty0
f Ty0
t)
  PDictAllocP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictAllocP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  PDictInsertP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictInsertP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  PDictLookupP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictLookupP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  PDictHasKeyP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictHasKeyP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  PDictForkP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictForkP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  PDictJoinP Ty0
t1 Ty0
t2 -> Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictJoinP (Ty0 -> Ty0
f Ty0
t1) (Ty0 -> Ty0
f Ty0
t2)
  LLAllocP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLAllocP (Ty0 -> Ty0
f Ty0
t)
  LLIsEmptyP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLIsEmptyP (Ty0 -> Ty0
f Ty0
t)
  LLConsP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLConsP (Ty0 -> Ty0
f Ty0
t)
  LLHeadP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLHeadP (Ty0 -> Ty0
f Ty0
t)
  LLTailP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLTailP (Ty0 -> Ty0
f Ty0
t)
  LLFreeP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLFreeP (Ty0 -> Ty0
f Ty0
t)
  LLCopyP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLCopyP (Ty0 -> Ty0
f Ty0
t)
  VAllocP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VAllocP (Ty0 -> Ty0
f Ty0
t)
  VFreeP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VFreeP (Ty0 -> Ty0
f Ty0
t)
  VFree2P Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VFree2P (Ty0 -> Ty0
f Ty0
t)
  VLengthP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VLengthP (Ty0 -> Ty0
f Ty0
t)
  VNthP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VNthP (Ty0 -> Ty0
f Ty0
t)
  VSliceP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VSliceP (Ty0 -> Ty0
f Ty0
t)
  InplaceVUpdateP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
InplaceVUpdateP (Ty0 -> Ty0
f Ty0
t)
  VConcatP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VConcatP (Ty0 -> Ty0
f Ty0
t)
  VSortP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VSortP (Ty0 -> Ty0
f Ty0
t)
  InplaceVSortP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
InplaceVSortP (Ty0 -> Ty0
f Ty0
t)
  VMergeP Ty0
t -> Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VMergeP (Ty0 -> Ty0
f Ty0
t)
  ReadPackedFile Maybe String
ms String
s Maybe Var
mVar Ty0
t -> Maybe String -> String -> Maybe Var -> Ty0 -> Prim Ty0
forall ty. Maybe String -> String -> Maybe Var -> ty -> Prim ty
ReadPackedFile Maybe String
ms String
s Maybe Var
mVar (Ty0 -> Ty0
f Ty0
t)
  WritePackedFile String
s Ty0
t -> String -> Ty0 -> Prim Ty0
forall ty. String -> ty -> Prim ty
WritePackedFile String
s (Ty0 -> Ty0
f Ty0
t)
  ReadArrayFile Maybe (String, Int)
m Ty0
t -> Maybe (String, Int) -> Ty0 -> Prim Ty0
forall ty. Maybe (String, Int) -> ty -> Prim ty
ReadArrayFile Maybe (String, Int)
m (Ty0 -> Ty0
f Ty0
t)
  Prim Ty0
_ -> Prim Ty0
p0
  where
    f :: Ty0 -> Ty0
f = TyMap -> Ty0 -> Ty0
elimTy TyMap
tns

elimTyScheme :: TyMap -> TyScheme -> TyScheme
elimTyScheme :: TyMap -> TyScheme -> TyScheme
elimTyScheme TyMap
tns (ForAll [TyVar]
tvs Ty0
t) = [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tvs (TyMap -> Ty0 -> Ty0
elimTy TyMap
tns Ty0
t)

elimTy :: TyMap -> Ty0 -> Ty0
elimTy :: TyMap -> Ty0 -> Ty0
elimTy TyMap
tns Ty0
t0 = case Ty0
t0 of
  PackedTy String
s [Ty0]
args -> 
    Ty0 -> (([Ty0] -> Ty0) -> Ty0) -> Maybe ([Ty0] -> Ty0) -> Ty0
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [Ty0] -> Ty0
PackedTy String
s (Ty0 -> Ty0
f (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
args)) (Ty0 -> Ty0
f (Ty0 -> Ty0) -> (([Ty0] -> Ty0) -> Ty0) -> ([Ty0] -> Ty0) -> Ty0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Ty0] -> Ty0) -> [Ty0] -> Ty0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Ty0
f (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
args)) (String -> TyMap -> Maybe ([Ty0] -> Ty0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s TyMap
tns)
  ProdTy [Ty0]
ts -> [Ty0] -> Ty0
ProdTy (Ty0 -> Ty0
f (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
ts)
  SymDictTy Maybe Var
varMaybe Ty0
t -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
varMaybe (Ty0 -> Ty0
f Ty0
t)
  ArrowTy [Ty0]
ts Ty0
t -> [Ty0] -> Ty0 -> Ty0
ArrowTy (Ty0 -> Ty0
f (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ty0]
ts) (Ty0 -> Ty0
f Ty0
t)
  VectorTy Ty0
t -> Ty0 -> Ty0
VectorTy (Ty0 -> Ty0
f Ty0
t)
  PDictTy Ty0
tK Ty0
tV -> Ty0 -> Ty0 -> Ty0
PDictTy (Ty0 -> Ty0
f Ty0
tK) (Ty0 -> Ty0
f Ty0
tV)
  ListTy Ty0
t -> Ty0 -> Ty0
ListTy (Ty0 -> Ty0
f Ty0
t)
  Ty0
_ -> Ty0
t0
  where
    f :: Ty0 -> Ty0
f = TyMap -> Ty0 -> Ty0
elimTy TyMap
tns