{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}

module Gibbon.HaskellFrontend
  ( parseFile, primMap, multiArgsToOne, desugarLinearExts ) where

import           Control.Monad
import           Data.Foldable ( foldrM, foldl' )
import           Data.Maybe (catMaybes, isJust)
import qualified Data.Map as M
import qualified Data.Set as S
import           Data.IORef
import           Language.Haskell.Exts.Extension
import           Language.Haskell.Exts.Parser
import           Language.Haskell.Exts.Syntax as H
import           Language.Haskell.Exts.Pretty
import           Language.Haskell.Exts.SrcLoc
import           Language.Haskell.Exts.CPP
import           System.Environment ( getEnvironment )
import           System.Directory
import           System.FilePath
import           System.Process
import           System.Exit
import           System.IO

import           Gibbon.L0.Syntax as L0
import           Gibbon.Common
import           Gibbon.DynFlags

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

{-

Importing modules:
~~~~~~~~~~~~~~~~~~

We use the same notion of search paths as GHC[1], except that GHC also has a
set of "known" packages (base, containers, etc.) where it looks for modules.
Gibbon doesn't have those, and the rootset for our search is a singleton {"."}.
Consider this directory structure:
    .
    |── A
    |   └── B
    |       |── C.hs
    |       |── D.hs
    |       |── Foo.hs
    |── Bar.hs

If Bar.hs has a `import A.B.C`, we look for a file `./A/B/C.hs`. However, note
that this design is much more primitive than what Cabal/Stack allow. Can A.B.C
import A.B.D? It depends on where we invoke GHC from. If we do it from ".", then
yes, because A.B.D exists at A/B/D.hs. But if we run "ghc C.hs", it will fail since
it expects A.B.D to be at A/B/A/B/D.hs.

[1] https://downloads.haskell.org/ghc/8.6.4/docs/html/users_guide/separate_compilation.html?#the-search-path

-}


parseFile :: Config -> FilePath -> IO (PassM Prog0)
parseFile :: Config -> FilePath -> IO (PassM Prog0)
parseFile Config
cfg FilePath
path = do
    IORef ParseState
pstate0_ref <- ParseState -> IO (IORef ParseState)
forall a. a -> IO (IORef a)
newIORef ParseState
emptyParseState
    Config
-> IORef ParseState -> [FilePath] -> FilePath -> IO (PassM Prog0)
parseFile' Config
cfg IORef ParseState
pstate0_ref [] FilePath
path


data ParseState = ParseState
    { ParseState -> Map (FilePath, FilePath) Prog0
imported :: M.Map (String, FilePath) Prog0 }

emptyParseState :: ParseState
emptyParseState :: ParseState
emptyParseState = Map (FilePath, FilePath) Prog0 -> ParseState
ParseState Map (FilePath, FilePath) Prog0
forall k a. Map k a
M.empty

parseMode :: ParseMode
parseMode :: ParseMode
parseMode = ParseMode
defaultParseMode { extensions :: [Extension]
extensions = [ KnownExtension -> Extension
EnableExtension KnownExtension
ScopedTypeVariables
                                            , KnownExtension -> Extension
EnableExtension KnownExtension
CPP
                                            , KnownExtension -> Extension
EnableExtension KnownExtension
TypeApplications
                                            ]
                                            [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ (ParseMode -> [Extension]
extensions ParseMode
defaultParseMode)
                             }

parseFile' :: Config -> IORef ParseState -> [String] -> FilePath -> IO (PassM Prog0)
parseFile' :: Config
-> IORef ParseState -> [FilePath] -> FilePath -> IO (PassM Prog0)
parseFile' Config
cfg IORef ParseState
pstate_ref [FilePath]
import_route FilePath
path = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GhcTc (Config -> DynFlags
dynflags Config
cfg)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Config -> FilePath -> IO ()
typecheckWithGhc Config
cfg FilePath
path
  FilePath
str <- FilePath -> IO FilePath
readFile FilePath
path
  let cleaned :: FilePath
cleaned = FilePath -> FilePath
removeLinearArrows FilePath
str
  -- let parsed = parseModuleWithMode parseMode cleaned
  ParseResult (Module SrcSpanInfo, [Comment])
parsed <- CpphsOptions
-> ParseMode
-> FilePath
-> IO (ParseResult (Module SrcSpanInfo, [Comment]))
parseFileContentsWithCommentsAndCPP CpphsOptions
defaultCpphsOptions ParseMode
parseMode FilePath
cleaned
  case ParseResult (Module SrcSpanInfo, [Comment])
parsed of
    ParseOk (Module SrcSpanInfo
hs,[Comment]
_comments) -> Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> Module SrcSpanInfo
-> IO (PassM Prog0)
forall a.
(Show a, Pretty a) =>
Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> Module a
-> IO (PassM Prog0)
desugarModule Config
cfg IORef ParseState
pstate_ref [FilePath]
import_route (FilePath -> FilePath
takeDirectory FilePath
path) Module SrcSpanInfo
hs
    ParseFailed SrcLoc
loc FilePath
er -> do
      FilePath -> IO (PassM Prog0)
forall a. HasCallStack => FilePath -> a
error (FilePath
"haskell-src-exts failed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
er FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SrcLoc -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint SrcLoc
loc)

-- | ASSUMPTION: gibbon-stdlib is available to Cabal.
--
-- Currently 'run_all_tests.sh' installs it with 'cabal v1-install . -w ghc-9.0.1'.
typecheckWithGhc :: Config -> FilePath -> IO ()
typecheckWithGhc :: Config -> FilePath -> IO ()
typecheckWithGhc Config
cfg FilePath
path = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Int
verbosity Config
cfg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> IO ()
putStr FilePath
" [compiler] Running pass, GHC typechecker\n   => "
  let cmd :: FilePath
cmd = FilePath
"ghc-9.0.1 -package gibbon-stdlib-0.1 -XNoImplicitPrelude -fno-code " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
  (Maybe Handle
_, Just Handle
hout, Just Handle
herr, ProcessHandle
phandle) <-
        CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (FilePath -> CreateProcess
shell FilePath
cmd)
            { std_out :: StdStream
std_out = StdStream
CreatePipe
            , std_err :: StdStream
std_err = StdStream
CreatePipe
            , cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> FilePath
takeDirectory FilePath
path)
            }
  ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
phandle
  case ExitCode
exitCode of
    ExitCode
ExitSuccess -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Int
verbosity Config
cfg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath
out <- Handle -> IO FilePath
hGetContents Handle
hout
        FilePath
err <- Handle -> IO FilePath
hGetContents Handle
herr
        FilePath -> IO ()
putStrLn FilePath
out
        FilePath -> IO ()
putStrLn FilePath
err
      () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ExitFailure Int
_ -> do
      FilePath
err <- Handle -> IO FilePath
hGetContents Handle
herr
      FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
err

-- | Really basic, and won't catch every occurence of a linear arrow.
--
-- But its only a stop-gap until we move to ghc-lib-parser, which can parse
-- linear types and other things not supported by haskell-src-exts (e.g. CPP).
removeLinearArrows :: String -> String
removeLinearArrows :: FilePath -> FilePath
removeLinearArrows FilePath
str =
    (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Bool) -> FilePath) -> (FilePath, Bool) -> FilePath
forall a b. (a -> b) -> a -> b
$
    (Char -> (FilePath, Bool) -> (FilePath, Bool))
-> (FilePath, Bool) -> FilePath -> (FilePath, Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c (FilePath
acc,Bool
saw_one) ->
                if Bool
saw_one Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'
                then (FilePath
acc, Bool
False)
                else if Bool
saw_one Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%'
                then (Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'1'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
acc, Bool
False)
                else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1'
                then (FilePath
acc, Bool
True)
                else (Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
acc, Bool
False))
           ([],Bool
False)
           FilePath
str
    {-
     - messup up indendataion and causes compilation errors.
     -
     - unlines .
     - map (unwords .
     -      map (\w -> if w == "%1->" || w == "%1 ->"
     -                 then "->"
     -                 else w) .
     -      words) .
     - lines
     -}

data TopLevel
  = HDDef (DDef Ty0)
  | HFunDef (FunDef Exp0)
  | HMain (Maybe (Exp0, Ty0))
  | HInline Var
  deriving (Int -> TopLevel -> FilePath -> FilePath
[TopLevel] -> FilePath -> FilePath
TopLevel -> FilePath
(Int -> TopLevel -> FilePath -> FilePath)
-> (TopLevel -> FilePath)
-> ([TopLevel] -> FilePath -> FilePath)
-> Show TopLevel
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> TopLevel -> FilePath -> FilePath
showsPrec :: Int -> TopLevel -> FilePath -> FilePath
$cshow :: TopLevel -> FilePath
show :: TopLevel -> FilePath
$cshowList :: [TopLevel] -> FilePath -> FilePath
showList :: [TopLevel] -> FilePath -> FilePath
Show, TopLevel -> TopLevel -> Bool
(TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool) -> Eq TopLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopLevel -> TopLevel -> Bool
== :: TopLevel -> TopLevel -> Bool
$c/= :: TopLevel -> TopLevel -> Bool
/= :: TopLevel -> TopLevel -> Bool
Eq)

type TopTyEnv = TyEnv TyScheme
type TypeSynEnv = M.Map TyCon Ty0

desugarModule :: (Show a,  Pretty a)
              => Config -> IORef ParseState -> [String] -> FilePath -> Module a -> IO (PassM Prog0)
desugarModule :: forall a.
(Show a, Pretty a) =>
Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> Module a
-> IO (PassM Prog0)
desugarModule Config
cfg IORef ParseState
pstate_ref [FilePath]
import_route FilePath
dir (Module a
_ Maybe (ModuleHead a)
head_mb [ModulePragma a]
_pragmas [ImportDecl a]
imports [Decl a]
decls) = do
  let type_syns :: TypeSynEnv
type_syns = (TypeSynEnv -> Decl a -> TypeSynEnv)
-> TypeSynEnv -> [Decl a] -> TypeSynEnv
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TypeSynEnv -> Decl a -> TypeSynEnv
forall a. (Show a, Pretty a) => TypeSynEnv -> Decl a -> TypeSynEnv
collectTypeSynonyms TypeSynEnv
forall k a. Map k a
M.empty [Decl a]
decls
      -- Since top-level functions and their types can't be declared in
      -- single top-level declaration we first collect types and then collect
      -- definitions.
      funtys :: TopTyEnv
funtys = (Decl a -> TopTyEnv -> TopTyEnv)
-> TopTyEnv -> [Decl a] -> TopTyEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
collectTopTy TypeSynEnv
type_syns) TopTyEnv
forall k a. Map k a
M.empty [Decl a]
decls
  [PassM Prog0]
imported_progs :: [PassM Prog0] <- (ImportDecl a -> IO (PassM Prog0))
-> [ImportDecl a] -> IO [PassM Prog0]
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 (Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> ImportDecl a
-> IO (PassM Prog0)
forall a.
Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> ImportDecl a
-> IO (PassM Prog0)
processImport Config
cfg IORef ParseState
pstate_ref (FilePath
mod_name FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
import_route) FilePath
dir) [ImportDecl a]
imports
  let prog :: PassM Prog0
prog = do
        [TopLevel]
toplevels <- [Maybe TopLevel] -> [TopLevel]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TopLevel] -> [TopLevel])
-> PassM [Maybe TopLevel] -> PassM [TopLevel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl a -> PassM (Maybe TopLevel))
-> [Decl a] -> PassM [Maybe TopLevel]
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 (TypeSynEnv -> TopTyEnv -> Decl a -> PassM (Maybe TopLevel)
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Decl a -> PassM (Maybe TopLevel)
collectTopLevel TypeSynEnv
type_syns TopTyEnv
funtys) [Decl a]
decls
        let (Map Var (DDef Ty0)
defs,Map Any Any
_vars,Map Var (FunDef Exp0)
funs,Set Var
inlines,Maybe (Exp0, Ty0)
main) = (TopLevel
 -> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
     Set Var, Maybe (Exp0, Ty0))
 -> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
     Set Var, Maybe (Exp0, Ty0)))
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
-> [TopLevel]
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TopLevel
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
classify (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0), Set Var,
 Maybe (Exp0, Ty0))
forall {k} {a} {k} {a} {k} {a} {a} {a}.
(Map k a, Map k a, Map k a, Set a, Maybe a)
init_acc [TopLevel]
toplevels
            funs' :: Map Var (FunDef Exp0)
funs' = (Var -> Map Var (FunDef Exp0) -> Map Var (FunDef Exp0))
-> Map Var (FunDef Exp0) -> Set Var -> Map Var (FunDef Exp0)
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Var
v Map Var (FunDef Exp0)
acc -> (FunDef Exp0 -> Maybe (FunDef Exp0))
-> Var -> Map Var (FunDef Exp0) -> Map Var (FunDef Exp0)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (\fn :: FunDef Exp0
fn@(FunDef{FunMeta
funMeta :: FunMeta
funMeta :: forall ex. FunDef ex -> FunMeta
funMeta}) -> FunDef Exp0 -> Maybe (FunDef Exp0)
forall a. a -> Maybe a
Just (FunDef Exp0
fn { funMeta :: FunMeta
funMeta = FunMeta
funMeta { funInline :: FunInline
funInline = FunInline
Inline }})) Var
v Map Var (FunDef Exp0)
acc) Map Var (FunDef Exp0)
funs Set Var
inlines
        [Prog0]
imported_progs' <- (PassM Prog0 -> PassM Prog0) -> [PassM Prog0] -> PassM [Prog0]
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 PassM Prog0 -> PassM Prog0
forall a. a -> a
id [PassM Prog0]
imported_progs
        let (Map Var (DDef Ty0)
defs0,Map Var (FunDef Exp0)
funs0) =
              (Prog0
 -> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
 -> (Map Var (DDef Ty0), Map Var (FunDef Exp0)))
-> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
-> [Prog0]
-> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\Prog{DDefs (TyOf Exp0)
ddefs :: DDefs (TyOf Exp0)
ddefs :: forall ex. Prog ex -> DDefs (TyOf ex)
ddefs,Map Var (FunDef Exp0)
fundefs :: Map Var (FunDef Exp0)
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs} (Map Var (DDef Ty0)
defs1,Map Var (FunDef Exp0)
funs1) ->
                     let ddef_names1 :: Set Var
ddef_names1 = Map Var (DDef Ty0) -> Set Var
forall k a. Map k a -> Set k
M.keysSet Map Var (DDef Ty0)
defs1
                         ddef_names2 :: Set Var
ddef_names2 = Map Var (DDef Ty0) -> Set Var
forall k a. Map k a -> Set k
M.keysSet DDefs (TyOf Exp0)
Map Var (DDef Ty0)
ddefs
                         fn_names1 :: Set Var
fn_names1 = Map Var (FunDef Exp0) -> Set Var
forall k a. Map k a -> Set k
M.keysSet Map Var (FunDef Exp0)
funs1
                         fn_names2 :: Set Var
fn_names2 = Map Var (FunDef Exp0) -> Set Var
forall k a. Map k a -> Set k
M.keysSet Map Var (FunDef Exp0)
fundefs
                         em1 :: Set Var
em1 = Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Var
ddef_names1 Set Var
ddef_names2
                         em2 :: Set Var
em2 = Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Var
fn_names1 Set Var
fn_names2
                         conflicts1 :: [Var]
conflicts1 = (Var -> [Var] -> [Var]) -> [Var] -> Set Var -> [Var]
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                        (\Var
d [Var]
acc ->
                                             if (DDefs (TyOf Exp0)
Map Var (DDef Ty0)
ddefs Map Var (DDef Ty0) -> Var -> DDef Ty0
forall k a. Ord k => Map k a -> k -> a
M.! Var
d) DDef Ty0 -> DDef Ty0 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Map Var (DDef Ty0)
defs1 Map Var (DDef Ty0) -> Var -> DDef Ty0
forall k a. Ord k => Map k a -> k -> a
M.! Var
d)
                                             then Var
d Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: [Var]
acc
                                             else [Var]
acc)
                                        []
                                        Set Var
em1
                         conflicts2 :: [Var]
conflicts2 = (Var -> [Var] -> [Var]) -> [Var] -> Set Var -> [Var]
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                        (\Var
f [Var]
acc ->
                                             if (Map Var (FunDef Exp0)
fundefs Map Var (FunDef Exp0) -> Var -> FunDef Exp0
forall k a. Ord k => Map k a -> k -> a
M.! Var
f) FunDef Exp0 -> FunDef Exp0 -> Bool
forall a. Eq a => a -> a -> Bool
/= (Map Var (FunDef Exp0)
funs1 Map Var (FunDef Exp0) -> Var -> FunDef Exp0
forall k a. Ord k => Map k a -> k -> a
M.! Var
f)
                                             then FilePath -> [Var] -> [Var]
forall a. FilePath -> a -> a
dbgTraceIt ((FunDef Exp0, FunDef Exp0) -> FilePath
forall a. Out a => a -> FilePath
sdoc ((Map Var (FunDef Exp0)
fundefs Map Var (FunDef Exp0) -> Var -> FunDef Exp0
forall k a. Ord k => Map k a -> k -> a
M.! Var
f), (Map Var (FunDef Exp0)
funs1 Map Var (FunDef Exp0) -> Var -> FunDef Exp0
forall k a. Ord k => Map k a -> k -> a
M.! Var
f))) (Var
f Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: [Var]
acc)
                                             else [Var]
acc)
                                        []
                                        Set Var
em2
                     in case ([Var]
conflicts1, [Var]
conflicts2) of
                            ([], []) -> (Map Var (DDef Ty0) -> Map Var (DDef Ty0) -> Map Var (DDef Ty0)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union DDefs (TyOf Exp0)
Map Var (DDef Ty0)
ddefs Map Var (DDef Ty0)
defs1,  Map Var (FunDef Exp0)
-> Map Var (FunDef Exp0) -> Map Var (FunDef Exp0)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Var (FunDef Exp0)
fundefs Map Var (FunDef Exp0)
funs1)
                            (Var
_x:[Var]
_xs,[Var]
_) -> FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0)))
-> FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
forall a b. (a -> b) -> a -> b
$ FilePath
"Conflicting definitions of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Var] -> FilePath
forall a. Show a => a -> FilePath
show [Var]
conflicts1 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_name
                            ([Var]
_,Var
_x:[Var]
_xs) -> FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0)))
-> FilePath -> (Map Var (DDef Ty0), Map Var (FunDef Exp0))
forall a b. (a -> b) -> a -> b
$ FilePath
"Conflicting definitions of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Var] -> FilePath
forall a. Show a => a -> FilePath
show (Set Var -> [Var]
forall a. Set a -> [a]
S.toList Set Var
em2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_name)
                (Map Var (DDef Ty0)
defs, Map Var (FunDef Exp0)
funs')
                [Prog0]
imported_progs'
        Prog0 -> PassM Prog0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DDefs (TyOf Exp0)
-> Map Var (FunDef Exp0) -> Maybe (Exp0, TyOf Exp0) -> Prog0
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp0)
Map Var (DDef Ty0)
defs0 Map Var (FunDef Exp0)
funs0 Maybe (Exp0, TyOf Exp0)
Maybe (Exp0, Ty0)
main)
  PassM Prog0 -> IO (PassM Prog0)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PassM Prog0
prog
  where
    init_acc :: (Map k a, Map k a, Map k a, Set a, Maybe a)
init_acc = (Map k a
forall k a. Map k a
M.empty, Map k a
forall k a. Map k a
M.empty, Map k a
forall k a. Map k a
M.empty, Set a
forall a. Set a
S.empty, Maybe a
forall a. Maybe a
Nothing)
    mod_name :: FilePath
mod_name = Maybe (ModuleHead a) -> FilePath
forall a. Maybe (ModuleHead a) -> FilePath
moduleName Maybe (ModuleHead a)
head_mb

    moduleName :: Maybe (ModuleHead a) -> String
    moduleName :: forall a. Maybe (ModuleHead a) -> FilePath
moduleName Maybe (ModuleHead a)
Nothing = FilePath
"Main"
    moduleName (Just (ModuleHead a
_ ModuleName a
mod_name1 Maybe (WarningText a)
_warnings Maybe (ExportSpecList a)
_exports)) =
      ModuleName a -> FilePath
forall a. ModuleName a -> FilePath
mnameToStr ModuleName a
mod_name1

    classify :: TopLevel
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
classify TopLevel
thing (Map Var (DDef Ty0)
defs,Map Any Any
vars,Map Var (FunDef Exp0)
funs,Set Var
inlines,Maybe (Exp0, Ty0)
main) =
      case TopLevel
thing of
        HDDef DDef Ty0
d   -> (Var -> DDef Ty0 -> Map Var (DDef Ty0) -> Map Var (DDef Ty0)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (DDef Ty0 -> Var
forall a. DDef a -> Var
tyName DDef Ty0
d) DDef Ty0
d Map Var (DDef Ty0)
defs, Map Any Any
vars, Map Var (FunDef Exp0)
funs, Set Var
inlines, Maybe (Exp0, Ty0)
main)
        HFunDef FunDef Exp0
f -> (Map Var (DDef Ty0)
defs, Map Any Any
vars, Var
-> FunDef Exp0 -> Map Var (FunDef Exp0) -> Map Var (FunDef Exp0)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FunDef Exp0 -> Var
forall ex. FunDef ex -> Var
funName FunDef Exp0
f) FunDef Exp0
f Map Var (FunDef Exp0)
funs, Set Var
inlines, Maybe (Exp0, Ty0)
main)
        HMain Maybe (Exp0, Ty0)
m ->
          case Maybe (Exp0, Ty0)
main of
            Maybe (Exp0, Ty0)
Nothing -> (Map Var (DDef Ty0)
defs, Map Any Any
vars, Map Var (FunDef Exp0)
funs, Set Var
inlines, Maybe (Exp0, Ty0)
m)
            Just (Exp0, Ty0)
_  -> FilePath
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
forall a. HasCallStack => FilePath -> a
error (FilePath
 -> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
     Set Var, Maybe (Exp0, Ty0)))
-> FilePath
-> (Map Var (DDef Ty0), Map Any Any, Map Var (FunDef Exp0),
    Set Var, Maybe (Exp0, Ty0))
forall a b. (a -> b) -> a -> b
$ FilePath
"A module cannot have two main expressions."
                               FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
mod_name
        HInline Var
v   -> (Map Var (DDef Ty0)
defs,Map Any Any
vars,Map Var (FunDef Exp0)
funs,Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v Set Var
inlines,Maybe (Exp0, Ty0)
main)
desugarModule Config
_ IORef ParseState
_ [FilePath]
_ FilePath
_ Module a
m = FilePath -> IO (PassM Prog0)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (PassM Prog0)) -> FilePath -> IO (PassM Prog0)
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarModule: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Module a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Module a
m

stdlibModules :: [String]
stdlibModules :: [FilePath]
stdlibModules =
  [ FilePath
"Gibbon.Prim"
  , FilePath
"Gibbon.Prelude"
  , FilePath
"Gibbon.Vector"
  , FilePath
"Gibbon.Vector.Parallel"
  , FilePath
"Gibbon.List"
  , FilePath
"Gibbon.PList"
  , FilePath
"Gibbon.ByteString"
  ]

processImport :: Config -> IORef ParseState -> [String] -> FilePath -> ImportDecl a -> IO (PassM Prog0)
processImport :: forall a.
Config
-> IORef ParseState
-> [FilePath]
-> FilePath
-> ImportDecl a
-> IO (PassM Prog0)
processImport Config
cfg IORef ParseState
pstate_ref [FilePath]
import_route FilePath
dir decl :: ImportDecl a
decl@ImportDecl{a
Bool
Maybe FilePath
Maybe (ImportSpecList a)
Maybe (ModuleName a)
ModuleName a
importAnn :: a
importModule :: ModuleName a
importQualified :: Bool
importSrc :: Bool
importSafe :: Bool
importPkg :: Maybe FilePath
importAs :: Maybe (ModuleName a)
importSpecs :: Maybe (ImportSpecList a)
importAnn :: forall l. ImportDecl l -> l
importModule :: forall l. ImportDecl l -> ModuleName l
importQualified :: forall l. ImportDecl l -> Bool
importSrc :: forall l. ImportDecl l -> Bool
importSafe :: forall l. ImportDecl l -> Bool
importPkg :: forall l. ImportDecl l -> Maybe FilePath
importAs :: forall l. ImportDecl l -> Maybe (ModuleName l)
importSpecs :: forall l. ImportDecl l -> Maybe (ImportSpecList l)
..}
    -- When compiling with Gibbon, we should *NOT* inline things defined in Gibbon.Prim.
    | FilePath
mod_name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Gibbon.Prim" = PassM Prog0 -> IO (PassM Prog0)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog0 -> PassM Prog0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DDefs (TyOf Exp0)
-> Map Var (FunDef Exp0) -> Maybe (Exp0, TyOf Exp0) -> Prog0
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp0)
Map Var (DDef Ty0)
forall k a. Map k a
M.empty Map Var (FunDef Exp0)
forall k a. Map k a
M.empty Maybe (Exp0, TyOf Exp0)
Maybe (Exp0, Ty0)
forall a. Maybe a
Nothing))
    | Bool
otherwise = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
mod_name FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
import_route) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Circular dependency detected. Import path: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show (FilePath
mod_name FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
import_route)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
importQualified) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Qualified imports not supported yet. Offending import: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++  ImportDecl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ImportDecl a
decl
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (ModuleName a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ModuleName a)
importAs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Module aliases not supported yet. Offending import: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++  ImportDecl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ImportDecl a
decl
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (ImportSpecList a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ImportSpecList a)
importSpecs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Selective imports not supported yet. Offending import: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++  ImportDecl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint ImportDecl a
decl
    (ParseState Map (FilePath, FilePath) Prog0
imported) <- IORef ParseState -> IO ParseState
forall a. IORef a -> IO a
readIORef IORef ParseState
pstate_ref
    FilePath
mod_fp <- if FilePath
mod_name FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
stdlibModules
                then FilePath -> IO FilePath
stdlibImportPath FilePath
mod_name
                else ModuleName a -> FilePath -> IO FilePath
forall a. ModuleName a -> FilePath -> IO FilePath
modImportPath ModuleName a
importModule FilePath
dir
    Int -> FilePath -> IO () -> IO ()
forall a. Int -> FilePath -> a -> a
dbgTrace Int
5 (FilePath
"Looking at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_name) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    Int -> FilePath -> IO () -> IO ()
forall a. Int -> FilePath -> a -> a
dbgTrace Int
5 (FilePath
"Previously imported: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Set (FilePath, FilePath) -> FilePath
forall a. Show a => a -> FilePath
show (Map (FilePath, FilePath) Prog0 -> Set (FilePath, FilePath)
forall k a. Map k a -> Set k
M.keysSet Map (FilePath, FilePath) Prog0
imported)) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    Prog0
prog <- case (FilePath, FilePath)
-> Map (FilePath, FilePath) Prog0 -> Maybe Prog0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath
mod_name, FilePath
mod_fp) Map (FilePath, FilePath) Prog0
imported of
                Just Prog0
prog -> do
                    Int -> FilePath -> IO () -> IO ()
forall a. Int -> FilePath -> a -> a
dbgTrace Int
5 (FilePath
"Already imported " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_name) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                    Prog0 -> IO Prog0
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog0
prog
                Maybe Prog0
Nothing -> do
                    Int -> FilePath -> IO () -> IO ()
forall a. Int -> FilePath -> a -> a
dbgTrace Int
5 (FilePath
"Importing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" from " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mod_fp) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                    PassM Prog0
prog0 <- Config
-> IORef ParseState -> [FilePath] -> FilePath -> IO (PassM Prog0)
parseFile' Config
cfg IORef ParseState
pstate_ref [FilePath]
import_route FilePath
mod_fp
                    (ParseState Map (FilePath, FilePath) Prog0
imported') <- IORef ParseState -> IO ParseState
forall a. IORef a -> IO a
readIORef IORef ParseState
pstate_ref
                    let (Prog0
prog0',Int
_) = PassM Prog0 -> (Prog0, Int)
forall a. PassM a -> (a, Int)
defaultRunPassM PassM Prog0
prog0
                    let imported'' :: Map (FilePath, FilePath) Prog0
imported'' = (FilePath, FilePath)
-> Prog0
-> Map (FilePath, FilePath) Prog0
-> Map (FilePath, FilePath) Prog0
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FilePath
mod_name, FilePath
mod_fp) Prog0
prog0' Map (FilePath, FilePath) Prog0
imported'
                    let pstate' :: ParseState
pstate' = ParseState { imported :: Map (FilePath, FilePath) Prog0
imported = Map (FilePath, FilePath) Prog0
imported'' }
                    IORef ParseState -> ParseState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ParseState
pstate_ref ParseState
pstate'
                    Prog0 -> IO Prog0
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog0
prog0'

    PassM Prog0 -> IO (PassM Prog0)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog0 -> PassM Prog0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog0
prog)
  where
    mod_name :: FilePath
mod_name = ModuleName a -> FilePath
forall a. ModuleName a -> FilePath
mnameToStr ModuleName a
importModule

stdlibImportPath :: String -> IO FilePath
stdlibImportPath :: FilePath -> IO FilePath
stdlibImportPath FilePath
mod_name = do
    [(FilePath, FilePath)]
env <- IO [(FilePath, FilePath)]
getEnvironment
    let stdlibPath :: FilePath
stdlibPath = case FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"GIBBONDIR" [(FilePath, FilePath)]
env of
                    Just FilePath
p -> FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
"gibbon-stdlib" FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
modNameToFilename FilePath
mod_name
                    -- Assume we're running from the compiler dir!
                    Maybe FilePath
Nothing -> FilePath -> FilePath
modNameToFilename FilePath
mod_name
    Bool
e <- FilePath -> IO Bool
doesFileExist FilePath
stdlibPath
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
e (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error(FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"stdlib.hs file not found at path: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
stdlibPath
                     FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\n Consider setting GIBBONDIR to repo root.\n"
    FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
stdlibPath
  where
    modNameToFilename :: String -> String
    modNameToFilename :: FilePath -> FilePath
modNameToFilename FilePath
"Gibbon.Prelude" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"Prelude.hs"
    modNameToFilename FilePath
"Gibbon.Vector" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"Vector.hs"
    modNameToFilename FilePath
"Gibbon.Vector.Parallel" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"Vector" FilePath -> FilePath -> FilePath
</> FilePath
"Parallel.hs"
    modNameToFilename FilePath
"Gibbon.List" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"List.hs"
    modNameToFilename FilePath
"Gibbon.PList" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"PList.hs"
    modNameToFilename FilePath
"Gibbon.ByteString" = FilePath
"Gibbon" FilePath -> FilePath -> FilePath
</> FilePath
"ByteString.hs"
    modNameToFilename FilePath
oth = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
oth

modImportPath :: ModuleName a -> String -> IO FilePath
modImportPath :: forall a. ModuleName a -> FilePath -> IO FilePath
modImportPath ModuleName a
importModule FilePath
dir = do
    let mod_name :: FilePath
mod_name = ModuleName a -> FilePath
forall a. ModuleName a -> FilePath
mnameToStr ModuleName a
importModule
    Maybe FilePath
mb_fp <- FilePath -> ModuleName a -> IO (Maybe FilePath)
forall a. FilePath -> ModuleName a -> IO (Maybe FilePath)
findModule FilePath
dir ModuleName a
importModule
    case Maybe FilePath
mb_fp of
        Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot find module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                   FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
mod_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
        Just FilePath
mod_fp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
mod_fp

-- | Look for a module on the filesystem.
findModule :: FilePath -> ModuleName a -> IO (Maybe FilePath)
findModule :: forall a. FilePath -> ModuleName a -> IO (Maybe FilePath)
findModule FilePath
dir ModuleName a
m = do
  let mod_fp :: FilePath
mod_fp  = FilePath
dir FilePath -> FilePath -> FilePath
</> ModuleName a -> FilePath
forall a. ModuleName a -> FilePath
moduleNameToSlashes ModuleName a
m FilePath -> FilePath -> FilePath
<.> FilePath
"hs"
  FilePath -> IO Bool
doesFileExist FilePath
mod_fp IO Bool -> (Bool -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
    if Bool
b
    then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
mod_fp
    else Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing

-- | Returns the string version of the module name, with dots replaced by slashes.
--
moduleNameToSlashes :: ModuleName a -> String
moduleNameToSlashes :: forall a. ModuleName a -> FilePath
moduleNameToSlashes (ModuleName a
_ FilePath
s) = FilePath -> FilePath
dots_to_slashes FilePath
s
  where dots_to_slashes :: FilePath -> FilePath
dots_to_slashes = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
pathSeparator else Char
c)


builtinTys :: S.Set Var
builtinTys :: Set Var
builtinTys = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$
    [ Var
"Int", Var
"Float", Var
"Bool", Var
"Sym", Var
"SymHash", Var
"IntHash", Var
"SymSet", Var
"SymDict", Var
"Arena", Var
"Vector" ]

keywords :: S.Set Var
keywords :: Set Var
keywords = [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ (FilePath -> Var) -> [FilePath] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Var
toVar ([FilePath] -> [Var]) -> [FilePath] -> [Var]
forall a b. (a -> b) -> a -> b
$
    -- These cannot be added to primMap because they all require special handling while parsing.
    --
    [ FilePath
"quote", FilePath
"bench", FilePath
"error", FilePath
"par", FilePath
"spawn", FilePath
"is_big"
    -- operations on vectors
    , FilePath
"valloc", FilePath
"vnth", FilePath
"vlength", FilePath
"vslice", FilePath
"inplacevupdate",
      FilePath
"vsort", FilePath
"inplacevsort", FilePath
"vfree", FilePath
"vfree2"
    -- parallel dictionaries
    , FilePath
"alloc_pdict", FilePath
"insert_pdict", FilePath
"lookup_pdict", FilePath
"member_pdict", FilePath
"fork_pdict", FilePath
"join_pdict"
    -- linked lists
    , FilePath
"alloc_ll", FilePath
"is_empty_ll", FilePath
"cons_ll", FilePath
"head_ll", FilePath
"tail_ll", FilePath
"free_ll", FilePath
"free2_ll", FilePath
"copy_ll"
    ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Map FilePath (Prim Any) -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath (Prim Any)
forall a. Map FilePath (Prim a)
primMap

desugarTopType :: (Show a,  Pretty a) => TypeSynEnv -> Type a -> TyScheme
desugarTopType :: forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> TyScheme
desugarTopType TypeSynEnv
type_syns Type a
ty =
  case Type a
ty of
    -- forall tvs ty.
    TyForall a
_ Maybe [TyVarBind a]
mb_tvbind Maybe (Context a)
_ Type a
ty1 ->
      let tyvars :: [TyVar]
tyvars = case Maybe [TyVarBind a]
mb_tvbind of
                     Just [TyVarBind a]
bnds -> (TyVarBind a -> TyVar) -> [TyVarBind a] -> [TyVar]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind a -> TyVar
forall a. TyVarBind a -> TyVar
desugarTyVarBind [TyVarBind a]
bnds
                     Maybe [TyVarBind a]
Nothing   -> []
      in [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars (TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty1)
    -- quantify over all tyvars.
    Type a
_ -> let ty' :: Ty0
ty' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty
             tyvars :: [TyVar]
tyvars = Ty0 -> [TyVar]
tyVarsInTy Ty0
ty'
        in [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars Ty0
ty'

desugarType :: (Show a,  Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType :: forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty =
  case Type a
ty of
    H.TyVar a
_ (Ident a
_ FilePath
t) -> TyVar -> Ty0
L0.TyVar (TyVar -> Ty0) -> TyVar -> Ty0
forall a b. (a -> b) -> a -> b
$ Var -> TyVar
UserTv (FilePath -> Var
toVar FilePath
t)
    TyTuple a
_ Boxed
Boxed [Type a]
tys   -> [Ty0] -> Ty0
ProdTy ((Type a -> Ty0) -> [Type a] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map (TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns) [Type a]
tys)
    TyCon a
_ (Special a
_ (UnitCon a
_))     -> [Ty0] -> Ty0
ProdTy []
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"Int"))  -> Ty0
IntTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"Char")) -> Ty0
CharTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"Float"))-> Ty0
FloatTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"Bool")) -> Ty0
BoolTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"Sym"))  -> Ty0
SymTy0
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"SymSet"))  -> Ty0
SymSetTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"SymHash"))  -> Ty0
SymHashTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
"IntHash"))  -> Ty0
IntHashTy
    TyCon a
_ (UnQual a
_ (Ident a
_ FilePath
con)) ->
      case FilePath -> TypeSynEnv -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
con TypeSynEnv
type_syns of
        Maybe Ty0
Nothing -> FilePath -> [Ty0] -> Ty0
PackedTy FilePath
con []
        Just Ty0
ty' -> Ty0
ty'
    TyFun a
_ Type a
t1 Type a
t2 -> let t1' :: Ty0
t1' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
t1
                         t2' :: Ty0
t2' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
t2
                     in [Ty0] -> Ty0 -> Ty0
ArrowTy [Ty0
t1'] Ty0
t2'
    TyParen a
_ Type a
ty1 -> TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty1
    TyApp a
_ Type a
tycon Type a
arg ->
      let ty' :: Ty0
ty' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
tycon in
      case Ty0
ty' of
        PackedTy FilePath
con [Ty0]
tyargs ->
            case (FilePath
con,[Ty0]
tyargs) of
                (FilePath
"Vector",[]) -> Ty0 -> Ty0
VectorTy (TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
arg)
                (FilePath
"List",[]) -> Ty0 -> Ty0
ListTy (TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
arg)
                (FilePath
"PDict",[]) ->
                  let arg' :: Ty0
arg' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
arg in
                  case Ty0
arg' of
                    ProdTy [Ty0
k, Ty0
v] -> Ty0 -> Ty0 -> Ty0
PDictTy Ty0
k Ty0
v
                    Ty0
_ -> FilePath -> Ty0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Ty0) -> FilePath -> Ty0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarType: Unexpected PDictTy argument: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Ty0 -> FilePath
forall a. Show a => a -> FilePath
show Ty0
arg'
                (FilePath, [Ty0])
_ ->
                  case FilePath -> TypeSynEnv -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
con TypeSynEnv
type_syns of
                    Maybe Ty0
Nothing -> FilePath -> [Ty0] -> Ty0
PackedTy FilePath
con ([Ty0]
tyargs [Ty0] -> [Ty0] -> [Ty0]
forall a. [a] -> [a] -> [a]
++ [TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
arg])
                    Just Ty0
ty'' -> Ty0
ty''
        Ty0
_ -> FilePath -> Ty0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Ty0) -> FilePath -> Ty0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarType: Unexpected type arguments: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Ty0 -> FilePath
forall a. Show a => a -> FilePath
show Ty0
ty'
    Type a
_ -> FilePath -> Ty0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Ty0) -> FilePath -> Ty0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarType: Unsupported type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Type a -> FilePath
forall a. Show a => a -> FilePath
show Type a
ty


-- Like 'desugarTopType' but understands boxity.
desugarTopType' :: (Show a,  Pretty a) => TypeSynEnv -> Type a -> (IsBoxed, TyScheme)
desugarTopType' :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Type a -> (Bool, TyScheme)
desugarTopType' TypeSynEnv
type_syns Type a
ty =
  case Type a
ty of
    -- forall tvs ty.
    TyForall a
_ Maybe [TyVarBind a]
mb_tvbind Maybe (Context a)
_ Type a
ty1 ->
      let tyvars :: [TyVar]
tyvars = case Maybe [TyVarBind a]
mb_tvbind of
                     Just [TyVarBind a]
bnds -> (TyVarBind a -> TyVar) -> [TyVarBind a] -> [TyVar]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBind a -> TyVar
forall a. TyVarBind a -> TyVar
desugarTyVarBind [TyVarBind a]
bnds
                     Maybe [TyVarBind a]
Nothing   -> []
          (Bool
boxity, Ty0
ty') = TypeSynEnv -> Type a -> (Bool, Ty0)
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> (Bool, Ty0)
desugarType' TypeSynEnv
type_syns Type a
ty1
      in (Bool
boxity, [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars Ty0
ty')
    -- quantify over all tyvars.
    Type a
_ -> let (Bool
boxity, Ty0
ty') = TypeSynEnv -> Type a -> (Bool, Ty0)
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> (Bool, Ty0)
desugarType' TypeSynEnv
type_syns Type a
ty
             tyvars :: [TyVar]
tyvars = Ty0 -> [TyVar]
tyVarsInTy Ty0
ty'
        in (Bool
boxity, [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars Ty0
ty')

-- Like 'desugarType' but understands boxity.
desugarType' :: (Show a,  Pretty a) => TypeSynEnv -> Type a -> (IsBoxed, Ty0)
desugarType' :: forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> (Bool, Ty0)
desugarType' TypeSynEnv
type_syns Type a
ty =
  case Type a
ty of
    TyBang a
_ BangType a
_ (NoUnpack a
_) Type a
ty1 -> (Bool
True, TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty1)
    Type a
_ -> (Bool
False, TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty)

-- | Transform a multi-argument function type to one where all inputs are a
-- single tuple argument. E.g. (a -> b -> c -> d) => ((a,b,c) -> d).
unCurryTopTy :: TyScheme -> TyScheme
unCurryTopTy :: TyScheme -> TyScheme
unCurryTopTy (ForAll [TyVar]
tyvars Ty0
ty) = [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars (Ty0 -> Ty0
unCurryTy Ty0
ty)

unCurryTy :: Ty0 -> Ty0
unCurryTy :: Ty0 -> Ty0
unCurryTy Ty0
ty1 =
  case Ty0
ty1 of
    ArrowTy [Ty0]
_ ArrowTy{} ->
      let ([Ty0]
a,Ty0
b) = [Ty0] -> Ty0 -> ([Ty0], Ty0)
go [] Ty0
ty1
          a' :: [Ty0]
a' = (Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
unCurryTy [Ty0]
a
      in [Ty0] -> Ty0 -> Ty0
ArrowTy [Ty0]
a' Ty0
b
    Ty0
_ -> Ty0
ty1
  where
    go :: [Ty0] -> Ty0 -> ([Ty0], Ty0)
    go :: [Ty0] -> Ty0 -> ([Ty0], Ty0)
go [Ty0]
acc Ty0
ty =
      case Ty0
ty of
        ArrowTy [Ty0]
as Ty0
b -> ([Ty0] -> Ty0 -> ([Ty0], Ty0)
go ([Ty0]
acc[Ty0] -> [Ty0] -> [Ty0]
forall a. [a] -> [a] -> [a]
++[Ty0]
as) Ty0
b)
        Ty0
_ -> ([Ty0]
acc,Ty0
ty)

-- ^ A map between SExp-frontend prefix function names, and Gibbon
-- abstract Primops.
primMap :: M.Map String (Prim a)
primMap :: forall a. Map FilePath (Prim a)
primMap = [(FilePath, Prim a)] -> Map FilePath (Prim a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (FilePath
"+", Prim a
forall ty. Prim ty
AddP)
  , (FilePath
"-", Prim a
forall ty. Prim ty
SubP)
  , (FilePath
"*", Prim a
forall ty. Prim ty
MulP)
  , (FilePath
"/", Prim a
forall ty. Prim ty
DivP)
  , (FilePath
"div", Prim a
forall ty. Prim ty
DivP)
  , (FilePath
"^", Prim a
forall ty. Prim ty
ExpP)
  , (FilePath
".+.", Prim a
forall ty. Prim ty
FAddP)
  , (FilePath
".-.", Prim a
forall ty. Prim ty
FSubP)
  , (FilePath
".*.", Prim a
forall ty. Prim ty
FMulP)
  , (FilePath
"./.", Prim a
forall ty. Prim ty
FDivP)
  , (FilePath
"sqrt", Prim a
forall ty. Prim ty
FSqrtP)
  , (FilePath
"==", Prim a
forall ty. Prim ty
EqIntP)
  , (FilePath
".==.", Prim a
forall ty. Prim ty
EqFloatP)
  , (FilePath
"*==*", Prim a
forall ty. Prim ty
EqCharP)
  , (FilePath
"<", Prim a
forall ty. Prim ty
LtP)
  , (FilePath
">", Prim a
forall ty. Prim ty
GtP)
  , (FilePath
"<=", Prim a
forall ty. Prim ty
LtEqP)
  , (FilePath
">=", Prim a
forall ty. Prim ty
GtEqP)
  , (FilePath
".<.", Prim a
forall ty. Prim ty
FLtP)
  , (FilePath
".>.", Prim a
forall ty. Prim ty
FGtP)
  , (FilePath
".<=.", Prim a
forall ty. Prim ty
FLtEqP)
  , (FilePath
".>=.", Prim a
forall ty. Prim ty
FGtEqP)
  , (FilePath
"tan", Prim a
forall ty. Prim ty
FTanP)
  , (FilePath
"mod", Prim a
forall ty. Prim ty
ModP)
  , (FilePath
"||" , Prim a
forall ty. Prim ty
OrP)
  , (FilePath
"&&", Prim a
forall ty. Prim ty
AndP)
  , (FilePath
"eqsym", Prim a
forall ty. Prim ty
EqSymP)
  , (FilePath
"rand", Prim a
forall ty. Prim ty
RandP)
  , (FilePath
"frand", Prim a
forall ty. Prim ty
FRandP)
  , (FilePath
"intToFloat", Prim a
forall ty. Prim ty
IntToFloatP)
  , (FilePath
"floatToInt", Prim a
forall ty. Prim ty
FloatToIntP)
  , (FilePath
"sizeParam", Prim a
forall ty. Prim ty
SizeParam)
  , (FilePath
"getNumProcessors", Prim a
forall ty. Prim ty
GetNumProcessors)
  , (FilePath
"True", Prim a
forall ty. Prim ty
MkTrue)
  , (FilePath
"False", Prim a
forall ty. Prim ty
MkFalse)
  , (FilePath
"gensym", Prim a
forall ty. Prim ty
Gensym)
  , (FilePath
"printint", Prim a
forall ty. Prim ty
PrintInt)
  , (FilePath
"printchar", Prim a
forall ty. Prim ty
PrintChar)
  , (FilePath
"printfloat", Prim a
forall ty. Prim ty
PrintFloat)
  , (FilePath
"printbool", Prim a
forall ty. Prim ty
PrintBool)
  , (FilePath
"printsym", Prim a
forall ty. Prim ty
PrintSym)
  , (FilePath
"readint", Prim a
forall ty. Prim ty
ReadInt)
  , (FilePath
"is_big", Prim a
forall ty. Prim ty
IsBig)
  , (FilePath
"empty_set", Prim a
forall ty. Prim ty
SymSetEmpty)
  , (FilePath
"insert_set", Prim a
forall ty. Prim ty
SymSetInsert)
  , (FilePath
"contains_set", Prim a
forall ty. Prim ty
SymSetContains)
  , (FilePath
"empty_hash", Prim a
forall ty. Prim ty
SymHashEmpty)
  , (FilePath
"insert_hash", Prim a
forall ty. Prim ty
SymHashInsert)
  , (FilePath
"lookup_hash", Prim a
forall ty. Prim ty
SymHashLookup)
  , (FilePath
"contains_hash", Prim a
forall ty. Prim ty
SymHashContains)
  , (FilePath
"empty_int_hash", Prim a
forall ty. Prim ty
IntHashEmpty)
  , (FilePath
"insert_int_hash", Prim a
forall ty. Prim ty
IntHashInsert)
  , (FilePath
"lookup_int_hash", Prim a
forall ty. Prim ty
IntHashLookup)
  ]

desugarExp :: (Show a, Pretty a) => TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e =
  case Exp a
e of
    Paren a
_ (ExpTypeSig a
_ (App a
_ (H.Var a
_ QName a
f) (Lit a
_ Literal a
lit)) Type a
tyc)
        | (QName a -> FilePath
forall a. QName a -> FilePath
qnameToStr QName a
f) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"error" -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (FilePath -> Ty0 -> Prim Ty0
forall ty. FilePath -> ty -> Prim ty
ErrorP (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
lit) (TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
tyc)) []
    -- Paren _ (App _ (H.Var _ f) (Lit _ lit))
    --     | (qnameToStr f) == "error" -> pure $ PrimAppE (ErrorP (litToString lit
    Paren a
_ Exp a
e2 -> TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
    H.Var a
_ QName a
qv -> do
      let str :: FilePath
str = QName a -> FilePath
forall a. QName a -> FilePath
qnameToStr QName a
qv
          v :: Var
v = (FilePath -> Var
toVar FilePath
str)
      if FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"alloc_pdict"
      then do
        Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
        Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
        Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictAllocP Ty0
kty Ty0
vty) []
      else if FilePath
str FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"alloc_ll"
      then do
        Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
        Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLAllocP Ty0
ty) []
      else if Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"sync"
      then Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
      else if Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"lsync"
      then Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
      else if FilePath -> Map FilePath (Prim Any) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FilePath
str Map FilePath (Prim Any)
forall a. Map FilePath (Prim a)
primMap
      then Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Map FilePath (Prim Ty0)
forall a. Map FilePath (Prim a)
primMap Map FilePath (Prim Ty0) -> FilePath -> Prim Ty0
forall k a. Ord k => Map k a -> k -> a
M.! FilePath
str) []
      else case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TopTyEnv
toplevel of
             Just TyScheme
sigma ->
               case TyScheme -> Ty0
tyFromScheme TyScheme
sigma of
                 ArrowTy{} ->
                   -- Functions with >0 args must be VarE's here -- the 'App _ e1 e2'
                   -- case below depends on it.
                   Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
                 -- Otherwise, 'v' is a top-level value binding, which we
                 -- encode as a function which takes no arguments.
                 Ty0
_ -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
v [] []
             Maybe TyScheme
Nothing -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
    Lit a
_ Literal a
lit  -> Literal a -> PassM Exp0
forall a. Literal a -> PassM Exp0
desugarLiteral Literal a
lit

    Lambda a
_ [Pat a]
pats Exp a
bod -> do
      Exp0
bod' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
bod
      ([Var]
vars,[Ty0]
tys,[[(Var, [Ty0], Ty0, Exp0)]]
bindss) <- [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
 -> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]]))
-> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> PassM ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pat a -> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)]))
-> [Pat a] -> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
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 (TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns) [Pat a]
pats
      let binds :: [(Var, [Ty0], Ty0, Exp0)]
binds = [[(Var, [Ty0], Ty0, Exp0)]] -> [(Var, [Ty0], Ty0, Exp0)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Var, [Ty0], Ty0, Exp0)]]
bindss
          args :: [(Var, Ty0)]
args = [Var] -> [Ty0] -> [(Var, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars [Ty0]
tys
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [(Var, Ty0)] -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE [(Var, Ty0)]
args ([(Var, [Ty0], Ty0, Exp0)] -> Exp0 -> Exp0
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [Ty0], Ty0, Exp0)]
binds Exp0
bod')

    App a
_ Exp a
e1 Exp a
e2 -> do
        TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e1 PassM Exp0 -> (Exp0 -> PassM Exp0) -> PassM Exp0
forall a b. PassM a -> (a -> PassM b) -> PassM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          (VarE Var
f) ->
            case FilePath -> Map FilePath (Prim Ty0) -> Maybe (Prim Ty0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Var -> FilePath
fromVar Var
f) Map FilePath (Prim Ty0)
forall a. Map FilePath (Prim a)
primMap of
              Just Prim Ty0
p  -> (\Exp0
e2' -> Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
p [Exp0
e2']) (Exp0 -> Exp0) -> PassM Exp0 -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
              Maybe (Prim Ty0)
Nothing ->
                  if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"quote"
                  then case Exp a
e2 of
                         Lit a
_ Literal a
lit -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
LitSymE (FilePath -> Var
toVar (FilePath -> Var) -> FilePath -> Var
forall a b. (a -> b) -> a -> b
$ Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
lit)
                         Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: quote only accepts string literals. E.g quote \"hello\""
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"eqBenchProg"
                  then case Exp a
e2 of
                         Lit a
_ Literal a
lit -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (FilePath -> Prim Ty0
forall ty. FilePath -> Prim ty
EqBenchProgP (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
lit)) [])
                         Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: eqBenchProg only accepts string literals."
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"readArrayFile"
                  then let go :: Exp a -> m (PreExp ext loc Ty0)
go Exp a
e0 = case Exp a
e0 of
                                    Con a
_ (UnQual a
_ (Ident a
_ FilePath
"Nothing")) -> do
                                      Ty0
t <- m Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                                      PreExp ext loc Ty0 -> m (PreExp ext loc Ty0)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreExp ext loc Ty0 -> m (PreExp ext loc Ty0))
-> PreExp ext loc Ty0 -> m (PreExp ext loc Ty0)
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [PreExp ext loc Ty0] -> PreExp ext loc Ty0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Maybe (FilePath, Int) -> Ty0 -> Prim Ty0
forall ty. Maybe (FilePath, Int) -> ty -> Prim ty
ReadArrayFile Maybe (FilePath, Int)
forall a. Maybe a
Nothing Ty0
t) []
                                    App a
_ (Con a
_ (UnQual a
_ (Ident a
_ FilePath
"Just"))) (Tuple a
_ Boxed
Boxed [Lit a
_ Literal a
name, Lit a
_ Literal a
len]) -> do
                                      Ty0
t <- m Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                                      PreExp ext loc Ty0 -> m (PreExp ext loc Ty0)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreExp ext loc Ty0 -> m (PreExp ext loc Ty0))
-> PreExp ext loc Ty0 -> m (PreExp ext loc Ty0)
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [PreExp ext loc Ty0] -> PreExp ext loc Ty0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Maybe (FilePath, Int) -> Ty0 -> Prim Ty0
forall ty. Maybe (FilePath, Int) -> ty -> Prim ty
ReadArrayFile ((FilePath, Int) -> Maybe (FilePath, Int)
forall a. a -> Maybe a
Just (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
name, Literal a -> Int
forall a. Literal a -> Int
litToInt Literal a
len)) Ty0
t) []
                                    Paren a
_ Exp a
e3 -> Exp a -> m (PreExp ext loc Ty0)
go Exp a
e3
                                    Exp a
_ -> FilePath -> m (PreExp ext loc Ty0)
forall a. HasCallStack => FilePath -> a
error (FilePath -> m (PreExp ext loc Ty0))
-> FilePath -> m (PreExp ext loc Ty0)
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: couldn't parse readArrayFile; " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Show a => a -> FilePath
show Exp a
e0
                       in Exp a -> PassM Exp0
forall {m :: * -> *} {a} {ext :: * -> * -> *} {loc}.
(MonadState Int m, Show a) =>
Exp a -> m (PreExp ext loc Ty0)
go Exp a
e2
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"readPackedFile"
                  then let go :: Exp l -> f (PreExp ext loc Ty0)
go Exp l
e0 = case Exp l
e0 of
                                     TypeApp l
_ (TyCon l
_ (UnQual l
_ (Ident l
_ FilePath
con))) -> do
                                       let ty :: Ty0
ty = FilePath -> [Ty0] -> Ty0
PackedTy FilePath
con []
                                       PreExp ext loc Ty0 -> f (PreExp ext loc Ty0)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreExp ext loc Ty0 -> f (PreExp ext loc Ty0))
-> PreExp ext loc Ty0 -> f (PreExp ext loc Ty0)
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [PreExp ext loc Ty0] -> PreExp ext loc Ty0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Maybe FilePath -> FilePath -> Maybe Var -> Ty0 -> Prim Ty0
forall ty. Maybe FilePath -> FilePath -> Maybe Var -> ty -> Prim ty
ReadPackedFile Maybe FilePath
forall a. Maybe a
Nothing FilePath
con Maybe Var
forall a. Maybe a
Nothing Ty0
ty) []
                                     Exp l
_ -> FilePath -> f (PreExp ext loc Ty0)
forall a. HasCallStack => FilePath -> a
error (FilePath -> f (PreExp ext loc Ty0))
-> FilePath -> f (PreExp ext loc Ty0)
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: couldn't parse readPackedFile; " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp l -> FilePath
forall a. Show a => a -> FilePath
show Exp l
e0
                       in Exp a -> PassM Exp0
forall {f :: * -> *} {l} {ext :: * -> * -> *} {loc}.
(Applicative f, Show l) =>
Exp l -> f (PreExp ext loc Ty0)
go Exp a
e2
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"writePackedFile"
                  then
                    case Exp a
e2 of
                      Lit a
_ Literal a
fp -> do
                        Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                        Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (FilePath -> Ty0 -> Prim Ty0
forall ty. FilePath -> ty -> Prim ty
WritePackedFile (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
fp) Ty0
ty) []
                      Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: couldn't parse writePackedFile; " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Show a => a -> FilePath
show Exp a
e2
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"bench"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
"HOLE" [] [Exp0
e2'] Bool
False
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"timeit"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt Exp0
e2' Ty0
ty Bool
False
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"iterate"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt Exp0
e2' Ty0
ty Bool
True
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"error"
                  then case Exp a
e2 of
                         Lit a
_ Literal a
lit -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (FilePath -> Ty0 -> Prim Ty0
forall ty. FilePath -> ty -> Prim ty
ErrorP (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
lit) Ty0
IntTy) [] -- assume int (!)
                         Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: error expects String literal."
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"par"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"spawn"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
"HOLE" [] [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"valloc"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VAllocP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vfree"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VFreeP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vfree2"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VFree2P Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vnth"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VNthP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vlength"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VLengthP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"inplacevupdate"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
InplaceVUpdateP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vconcat"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VConcatP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vsort"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VSortP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"inplacevsort"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
InplaceVSortP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vslice"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VSliceP Ty0
ty) [Exp0
e2']

                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"vmerge"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VMergeP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"insert_pdict"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictInsertP Ty0
kty Ty0
vty) [Exp0
e2']

                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"lookup_pdict"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictLookupP Ty0
kty Ty0
vty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"member_pdict"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictHasKeyP Ty0
kty Ty0
vty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"fork_pdict"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictForkP Ty0
kty Ty0
vty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"join_pdict"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
kty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Ty0
vty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Ty0 -> Prim Ty0
forall ty. ty -> ty -> Prim ty
PDictJoinP Ty0
kty Ty0
vty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"is_empty_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLIsEmptyP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"cons_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLConsP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"head_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLHeadP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"tail_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLTailP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"free_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLFreeP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"free2_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLFree2P Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"copy_ll"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
LLCopyP Ty0
ty) [Exp0
e2']
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"fst"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
0 Exp0
e2'
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"snd"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
1 Exp0
e2'
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"printPacked"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked Ty0
ty Exp0
e2')
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"copyPacked"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked Ty0
ty Exp0
e2')
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"travPacked"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked Ty0
ty Exp0
e2')
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"unsafeAlias"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
e2'))
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"unsafeToLinear"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
e2'))
                  else if Var
f Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
"lseq"
                  then do
                    Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
e2' Exp0
forall a. HasCallStack => a
undefined))
                  else if Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Var
f Set Var
keywords
                  then FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: Keyword not handled: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Var -> FilePath
forall a. Out a => a -> FilePath
sdoc Var
f
                  else Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] ([Exp0] -> Exp0) -> (Exp0 -> [Exp0]) -> Exp0 -> Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp0 -> [Exp0] -> [Exp0]
forall a. a -> [a] -> [a]
: []) (Exp0 -> Exp0) -> PassM Exp0 -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
          (DataConE Ty0
tyapp FilePath
c [Exp0]
as) -> (\Exp0
e2' -> Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
tyapp FilePath
c ([Exp0]
as [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])) (Exp0 -> Exp0) -> PassM Exp0 -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
          (Ext (ParE0 [Exp0]
ls)) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])
          (AppE Var
f [] [Exp0]
ls) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])

          (Ext (BenchE Var
fn [] [Exp0]
ls Bool
b)) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [] ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2']) Bool
b

          (SpawnE Var
fn [] [Exp0]
ls) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn [] ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])

          (PrimAppE (WritePackedFile FilePath
fp Ty0
ty) [Exp0]
ls) -> do
             Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
             Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (FilePath -> Ty0 -> Prim Ty0
forall ty. FilePath -> ty -> Prim ty
WritePackedFile FilePath
fp Ty0
ty) ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])

          (PrimAppE (ReadPackedFile Maybe FilePath
_mb_fp FilePath
tycon Maybe Var
mb_var Ty0
ty) []) ->
             let go :: Exp a -> PassM Exp0
go Exp a
e0 = case Exp a
e0 of
                           Con a
_ (UnQual a
_ (Ident a
_ FilePath
"Nothing")) -> do
                             Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Maybe FilePath -> FilePath -> Maybe Var -> Ty0 -> Prim Ty0
forall ty. Maybe FilePath -> FilePath -> Maybe Var -> ty -> Prim ty
ReadPackedFile Maybe FilePath
forall a. Maybe a
Nothing FilePath
tycon Maybe Var
mb_var Ty0
ty) [])
                           App a
_ (Con a
_ (UnQual a
_ (Ident a
_ FilePath
"Just"))) (Lit a
_ Literal a
name) -> do
                             Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Maybe FilePath -> FilePath -> Maybe Var -> Ty0 -> Prim Ty0
forall ty. Maybe FilePath -> FilePath -> Maybe Var -> ty -> Prim ty
ReadPackedFile (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Literal a -> FilePath
forall a. Literal a -> FilePath
litToString Literal a
name)) FilePath
tycon Maybe Var
mb_var Ty0
ty) [])
                           Paren a
_ Exp a
e3 -> Exp a -> PassM Exp0
go Exp a
e3
                           Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: couldn't parse readPackedFile; " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Show a => a -> FilePath
show Exp a
e0
             in Exp a -> PassM Exp0
go Exp a
e2

          (PrimAppE (VMergeP Ty0
elty) [Exp0]
ls) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VMergeP Ty0
elty) ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])
          (PrimAppE Prim Ty0
p [Exp0]
ls) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
p ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])

          TimeIt{} ->
            FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: TimeIt can only accept 1 expression."

          (Ext (LinearExt (LseqE Exp0
a Exp0
_))) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
a Exp0
e2')))

          (Ext (LinearExt (ToLinearE (AppE Var
f [] [Exp0]
ls)))) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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 (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])))))

          (Ext (LinearExt (ToLinearE (DataConE Ty0
tyapp FilePath
dcon [Exp0]
ls)))) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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 (Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
tyapp FilePath
dcon ([Exp0]
ls [Exp0] -> [Exp0] -> [Exp0]
forall a. [a] -> [a] -> [a]
++ [Exp0
e2'])))))

          (Ext (LinearExt (ToLinearE (Ext (LambdaE [(Var
v,Ty0
ty)] Exp0
bod))))) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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 ((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
v,[],Ty0
ty,Exp0
e2') Exp0
bod))))

          (Ext (LinearExt (ToLinearE (VarE Var
fn)))) -> do
            Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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 (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [] [Exp0
e2']))))

          Exp0
f -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath
"desugarExp: Couldn't parse function application: (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp0 -> FilePath
forall a. Show a => a -> FilePath
show Exp0
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")")

    Let a
_ (BDecls a
_ [Decl a]
decls) Exp a
rhs -> do
      Exp0
rhs' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
      let funtys :: TopTyEnv
funtys = (Decl a -> TopTyEnv -> TopTyEnv)
-> TopTyEnv -> [Decl a] -> TopTyEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
collectTopTy TypeSynEnv
type_syns) TopTyEnv
forall k a. Map k a
M.empty [Decl a]
decls
      (Decl a -> Exp0 -> PassM Exp0) -> Exp0 -> [Decl a] -> PassM Exp0
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (TypeSynEnv -> TopTyEnv -> TopTyEnv -> Decl a -> Exp0 -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> TopTyEnv -> Decl a -> Exp0 -> PassM Exp0
generateBind TypeSynEnv
type_syns TopTyEnv
toplevel TopTyEnv
funtys) Exp0
rhs' [Decl a]
decls

    If a
_ Exp a
a Exp a
b Exp a
c -> do
      Exp0
a' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
a
      Exp0
b' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
b
      Exp0
c' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
c
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ 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
a' Exp0
b' Exp0
c'

    Tuple a
_ Boxed
Unboxed [Exp a]
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: Only boxed tuples are allowed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp a
e
    Tuple a
_ Boxed
Boxed [Exp a]
es  -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp0] -> Exp0) -> PassM [Exp0] -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp a -> PassM Exp0) -> [Exp a] -> PassM [Exp0]
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 (TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel) [Exp a]
es

    Case a
_ Exp a
scrt [Alt a]
alts -> do
      Exp0
scrt' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
scrt
      Exp0 -> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(FilePath, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp0
scrt' ([(FilePath, [(Var, Ty0)], Exp0)] -> Exp0)
-> PassM [(FilePath, [(Var, Ty0)], Exp0)] -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Alt a -> PassM (FilePath, [(Var, Ty0)], Exp0))
-> [Alt a] -> PassM [(FilePath, [(Var, Ty0)], Exp0)]
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 (TypeSynEnv
-> TopTyEnv -> Alt a -> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a.
(Show a, Pretty a) =>
TypeSynEnv
-> TopTyEnv -> Alt a -> PassM (FilePath, [(Var, Ty0)], Exp0)
desugarAlt TypeSynEnv
type_syns TopTyEnv
toplevel) [Alt a]
alts

    Con a
_ (Special a
_ (UnitCon a
_)) -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE []

    Con a
_ QName a
qname -> do
      let dcon :: FilePath
dcon = QName a -> FilePath
forall a. QName a -> FilePath
qnameToStr QName a
qname
      case FilePath -> Map FilePath (Prim Ty0) -> Maybe (Prim Ty0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
dcon Map FilePath (Prim Ty0)
forall a. Map FilePath (Prim a)
primMap of
        Just Prim Ty0
p  -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
p []
        Maybe (Prim Ty0)
Nothing -> do
          -- Just a placeholder for now, the typechecker will fill this hole.
          Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
ty FilePath
dcon []

    -- TODO: timeit: parsing it's type isn't straightforward.

    InfixApp a
_ Exp a
e1 (QVarOp a
_ (UnQual a
_ (Symbol a
_ FilePath
"!!!"))) Exp a
e2 -> do
      Exp0
e1' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e1
      case Exp a
e2 of
        Lit a
_ Literal a
lit -> do
          let i :: Int
i = Literal a -> Int
forall a. Literal a -> Int
litToInt Literal a
lit
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i Exp0
e1'
        Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: !!! expects a integer. Got: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp a
e2

    InfixApp a
_ Exp a
e1 QOp a
op Exp a
e2 -> do
      Exp0
e1' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e1
      Exp0
e2' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e2
      case QOp a
op of
        QVarOp a
_ (UnQual a
_ (Symbol a
_ FilePath
"&")) -> do
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
e2' Exp0
e1'))
        QOp a
_ -> do
          let op' :: Prim Ty0
op' = QOp a -> Prim Ty0
forall a. QOp a -> Prim Ty0
desugarOp QOp a
op
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
op' [Exp0
e1', Exp0
e2']

    NegApp a
_ Exp a
e1 -> do
      Exp0
e1' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
e1
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
forall ty. Prim ty
SubP [Int -> Exp0
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
0, Exp0
e1']

    Exp a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath
"desugarExp: Unsupported expression: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp a
e)

desugarFun :: (Show a,  Pretty a) => TypeSynEnv -> TopTyEnv -> TopTyEnv -> Decl a -> PassM (Var, [Var], TyScheme, Exp0)
desugarFun :: forall a.
(Show a, Pretty a) =>
TypeSynEnv
-> TopTyEnv
-> TopTyEnv
-> Decl a
-> PassM (Var, [Var], TyScheme, Exp0)
desugarFun TypeSynEnv
type_syns TopTyEnv
toplevel TopTyEnv
env Decl a
decl =
  case Decl a
decl of
    FunBind a
_ [Match a
_ Name a
fname [Pat a]
pats (UnGuardedRhs a
_ Exp a
bod) Maybe (Binds a)
_where] -> do
      let fname_str :: FilePath
fname_str = Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
fname
          fname_var :: Var
fname_var = FilePath -> Var
toVar (FilePath
fname_str)
      ([Var]
vars, [Ty0]
arg_tys,[[(Var, [Ty0], Ty0, Exp0)]]
bindss) <- [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
 -> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]]))
-> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> PassM ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pat a -> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)]))
-> [Pat a] -> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
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 (TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns) [Pat a]
pats
      let binds :: [(Var, [Ty0], Ty0, Exp0)]
binds = [[(Var, [Ty0], Ty0, Exp0)]] -> [(Var, [Ty0], Ty0, Exp0)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Var, [Ty0], Ty0, Exp0)]]
bindss
          args :: [Var]
args = [Var]
vars
      TyScheme
fun_ty <- case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
fname_var TopTyEnv
env of
                  Maybe TyScheme
Nothing -> do
                     Ty0
ret_ty  <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                     let funty :: Ty0
funty = [Ty0] -> Ty0 -> Ty0
ArrowTy [Ty0]
arg_tys Ty0
ret_ty
                     TyScheme -> PassM TyScheme
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyScheme -> PassM TyScheme) -> TyScheme -> PassM TyScheme
forall a b. (a -> b) -> a -> b
$ ([TyVar] -> Ty0 -> TyScheme
ForAll [] Ty0
funty)
                  Just TyScheme
ty -> TyScheme -> PassM TyScheme
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TyScheme
ty
      Exp0
bod' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
bod
      (Var, [Var], TyScheme, Exp0) -> PassM (Var, [Var], TyScheme, Exp0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Var, [Var], TyScheme, Exp0)
 -> PassM (Var, [Var], TyScheme, Exp0))
-> (Var, [Var], TyScheme, Exp0)
-> PassM (Var, [Var], TyScheme, Exp0)
forall a b. (a -> b) -> a -> b
$ (Var
fname_var, [Var]
args, TyScheme -> TyScheme
unCurryTopTy TyScheme
fun_ty, ([(Var, [Ty0], Ty0, Exp0)] -> Exp0 -> Exp0
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [Ty0], Ty0, Exp0)]
binds Exp0
bod'))
    Decl a
_ -> FilePath -> PassM (Var, [Var], TyScheme, Exp0)
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM (Var, [Var], TyScheme, Exp0))
-> FilePath -> PassM (Var, [Var], TyScheme, Exp0)
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarFun: Found a function with multiple RHS, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Decl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Decl a
decl

multiArgsToOne :: [Var] -> [Ty0] -> Exp0 -> (Var, Exp0)
multiArgsToOne :: [Var] -> [Ty0] -> Exp0 -> (Var, Exp0)
multiArgsToOne [Var]
args [Ty0]
tys Exp0
ex =
  let new_arg :: Var
new_arg = FilePath -> Var
toVar FilePath
"multi_arg"
  in (Var
new_arg, Var -> [Var] -> [Ty0] -> Exp0 -> Exp0
forall d (e :: * -> * -> *) l.
Var -> [Var] -> [d] -> PreExp e l d -> PreExp e l d
tuplizeRefs Var
new_arg [Var]
args [Ty0]
tys Exp0
ex)

collectTopTy :: (Show a,  Pretty a) => TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
collectTopTy :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Decl a -> TopTyEnv -> TopTyEnv
collectTopTy TypeSynEnv
type_syns Decl a
d TopTyEnv
env =
  case Decl a
d of
    TypeSig a
_ [Name a]
names Type a
ty ->
      let ty' :: TyScheme
ty' = TypeSynEnv -> Type a -> TyScheme
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> TyScheme
desugarTopType TypeSynEnv
type_syns Type a
ty
      in (Name a -> TopTyEnv -> TopTyEnv)
-> TopTyEnv -> [Name a] -> TopTyEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name a
name TopTyEnv
acc ->
                  let tycon_var :: Var
tycon_var = FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
name) in
                  case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
tycon_var TopTyEnv
acc of
                    Maybe TyScheme
Nothing ->  Var -> TyScheme -> TopTyEnv -> TopTyEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
tycon_var TyScheme
ty' TopTyEnv
acc
                    Just{} -> FilePath -> TopTyEnv
forall a. HasCallStack => FilePath -> a
error (FilePath -> TopTyEnv) -> FilePath -> TopTyEnv
forall a b. (a -> b) -> a -> b
$ FilePath
"collectTopTy: Multiple type signatures for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Var -> FilePath
forall a. Show a => a -> FilePath
show Var
tycon_var)
         TopTyEnv
env [Name a]
names
    Decl a
_ -> TopTyEnv
env

collectTypeSynonyms :: (Show a,  Pretty a) => TypeSynEnv -> Decl a -> TypeSynEnv
collectTypeSynonyms :: forall a. (Show a, Pretty a) => TypeSynEnv -> Decl a -> TypeSynEnv
collectTypeSynonyms TypeSynEnv
env Decl a
d =
  case Decl a
d of
    TypeDecl a
_ (DHead a
_ Name a
name) Type a
ty ->
      let ty' :: Ty0
ty' = TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
env Type a
ty
          tycon :: FilePath
tycon = Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
name
      in case FilePath -> TypeSynEnv -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
tycon TypeSynEnv
env of
           Maybe Ty0
Nothing -> FilePath -> Ty0 -> TypeSynEnv -> TypeSynEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
tycon Ty0
ty' TypeSynEnv
env
           Just{} -> FilePath -> TypeSynEnv
forall a. HasCallStack => FilePath -> a
error (FilePath -> TypeSynEnv) -> FilePath -> TypeSynEnv
forall a b. (a -> b) -> a -> b
$ FilePath
"collectTypeSynonyms: Multiple type synonym declarations: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
tycon
    Decl a
_ -> TypeSynEnv
env

collectTopLevel :: (Show a,  Pretty a) => TypeSynEnv -> TopTyEnv -> Decl a -> PassM (Maybe TopLevel)
collectTopLevel :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Decl a -> PassM (Maybe TopLevel)
collectTopLevel TypeSynEnv
type_syns TopTyEnv
env Decl a
decl =
  let toplevel :: TopTyEnv
toplevel = TopTyEnv
env in
  case Decl a
decl of
    -- 'collectTopTy' takes care of this.
    TypeSig{} -> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TopLevel
forall a. Maybe a
Nothing

    -- 'collectTypeSynonyms'.
    TypeDecl{} -> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TopLevel
forall a. Maybe a
Nothing

    DataDecl a
_ (DataType a
_) Maybe (Context a)
_ctx DeclHead a
decl_head [QualConDecl a]
cons [Deriving a]
_deriving_binds -> do
      let (Var
ty_name,  [TyVar]
ty_args) = DeclHead a -> (Var, [TyVar])
forall a. DeclHead a -> (Var, [TyVar])
desugarDeclHead DeclHead a
decl_head
          cons' :: [(FilePath, [(Bool, Ty0)])]
cons' = (QualConDecl a -> (FilePath, [(Bool, Ty0)]))
-> [QualConDecl a] -> [(FilePath, [(Bool, Ty0)])]
forall a b. (a -> b) -> [a] -> [b]
map (TypeSynEnv -> QualConDecl a -> (FilePath, [(Bool, Ty0)])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> QualConDecl a -> (FilePath, [(Bool, Ty0)])
desugarConstr TypeSynEnv
type_syns) [QualConDecl a]
cons
      if Var
ty_name Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
builtinTys
      then FilePath -> PassM (Maybe TopLevel)
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM (Maybe TopLevel))
-> FilePath -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ Var -> FilePath
forall a. Out a => a -> FilePath
sdoc Var
ty_name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is a built-in type."
      else Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ DDef Ty0 -> TopLevel
HDDef (Var -> [TyVar] -> [(FilePath, [(Bool, Ty0)])] -> DDef Ty0
forall a. Var -> [TyVar] -> [(FilePath, [(Bool, a)])] -> DDef a
DDef Var
ty_name [TyVar]
ty_args [(FilePath, [(Bool, Ty0)])]
cons')

    -- Reserved for HS.
    PatBind a
_ (PVar a
_ (Ident a
_ FilePath
"main")) (UnGuardedRhs a
_ Exp a
_) Maybe (Binds a)
_binds ->
      Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TopLevel
forall a. Maybe a
Nothing

    PatBind a
_ (PVar a
_ (Ident a
_ FilePath
"gibbon_main")) (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
_binds -> do
      Exp0
rhs' <- Exp0 -> Exp0
fixupSpawn (Exp0 -> Exp0) -> (Exp0 -> Exp0) -> Exp0 -> Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Exp0 -> Exp0
verifyBenchEAssumptions Bool
True (Exp0 -> Exp0) -> PassM Exp0 -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
      Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
      Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ Maybe (Exp0, Ty0) -> TopLevel
HMain (Maybe (Exp0, Ty0) -> TopLevel) -> Maybe (Exp0, Ty0) -> TopLevel
forall a b. (a -> b) -> a -> b
$ (Exp0, Ty0) -> Maybe (Exp0, Ty0)
forall a. a -> Maybe a
Just (Exp0
rhs', Ty0
ty)

    PatBind a
_ (PVar a
_ (Ident a
_ FilePath
fn)) (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
_binds ->
       case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath -> Var
toVar FilePath
fn) TopTyEnv
env of
         Maybe TyScheme
Nothing -> FilePath -> PassM (Maybe TopLevel)
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM (Maybe TopLevel))
-> FilePath -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ FilePath
"collectTopLevel: Top-level binding with no type signature: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn
         Just TyScheme
fun_ty ->
             -- This is a top-level function binding of the form:
             --     f = \x -> ...
             case Exp a
rhs of
               Lambda a
_ [Pat a]
pats Exp a
bod -> do
                 Exp0
bod' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
bod
                 case [Pat a]
pats of
                   [] -> FilePath -> PassM (Maybe TopLevel)
forall a. HasCallStack => FilePath -> a
error FilePath
"Impossible"
                   [Pat a]
_  -> do
                     ([Var]
vars,[Ty0]
_tys,[[(Var, [Ty0], Ty0, Exp0)]]
bindss) <- [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
 -> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]]))
-> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> PassM ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pat a -> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)]))
-> [Pat a] -> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
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 (TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns) [Pat a]
pats
                     let binds :: [(Var, [Ty0], Ty0, Exp0)]
binds = [[(Var, [Ty0], Ty0, Exp0)]] -> [(Var, [Ty0], Ty0, Exp0)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Var, [Ty0], Ty0, Exp0)]]
bindss
                         args :: [Var]
args = [Var]
vars
                     Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ FunDef Exp0 -> TopLevel
HFunDef (FunDef { funName :: Var
funName = FilePath -> Var
toVar FilePath
fn
                                                   , funArgs :: [Var]
funArgs = [Var]
args
                                                   , funTy :: ArrowTy (TyOf Exp0)
funTy   = ArrowTy (TyOf Exp0)
TyScheme
fun_ty
                                                   , funBody :: Exp0
funBody = Exp0 -> Exp0
fixupSpawn ([(Var, [Ty0], Ty0, Exp0)] -> Exp0 -> Exp0
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [Ty0], Ty0, Exp0)]
binds Exp0
bod')
                                                   , funMeta :: FunMeta
funMeta = FunMeta { funRec :: FunRec
funRec = FunRec
NotRec
                                                                       , funInline :: FunInline
funInline = FunInline
NoInline
                                                                       , funCanTriggerGC :: Bool
funCanTriggerGC = Bool
False
                                                                       }
                                                   })

               -- This is a top-level function that doesn't take any arguments.
               Exp a
_ -> do
                 Exp0
rhs' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
                 let fun_ty' :: Ty0
fun_ty'  = [Ty0] -> Ty0 -> Ty0
ArrowTy [] (TyScheme -> Ty0
tyFromScheme TyScheme
fun_ty)
                     fun_ty'' :: TyScheme
fun_ty'' = [TyVar] -> Ty0 -> TyScheme
ForAll (Ty0 -> [TyVar]
tyVarsInTy Ty0
fun_ty') Ty0
fun_ty'
                 Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ FunDef Exp0 -> TopLevel
HFunDef (FunDef { funName :: Var
funName = FilePath -> Var
toVar FilePath
fn
                                               , funArgs :: [Var]
funArgs = []
                                               , funTy :: ArrowTy (TyOf Exp0)
funTy   = ArrowTy (TyOf Exp0)
TyScheme
fun_ty''
                                               , funBody :: Exp0
funBody = Exp0 -> Exp0
fixupSpawn Exp0
rhs'
                                               , funMeta :: FunMeta
funMeta = FunMeta { funRec :: FunRec
funRec = FunRec
NotRec
                                                                   , funInline :: FunInline
funInline = FunInline
NoInline
                                                                   , funCanTriggerGC :: Bool
funCanTriggerGC = Bool
False
                                                                   }
                                               })


    FunBind{} -> do (Var
name,[Var]
args,TyScheme
ty,Exp0
bod) <- TypeSynEnv
-> TopTyEnv
-> TopTyEnv
-> Decl a
-> PassM (Var, [Var], TyScheme, Exp0)
forall a.
(Show a, Pretty a) =>
TypeSynEnv
-> TopTyEnv
-> TopTyEnv
-> Decl a
-> PassM (Var, [Var], TyScheme, Exp0)
desugarFun TypeSynEnv
type_syns TopTyEnv
toplevel TopTyEnv
env Decl a
decl
                    Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ FunDef Exp0 -> TopLevel
HFunDef (FunDef { funName :: Var
funName = Var
name
                                                  , funArgs :: [Var]
funArgs = [Var]
args
                                                  , funTy :: ArrowTy (TyOf Exp0)
funTy   = ArrowTy (TyOf Exp0)
TyScheme
ty
                                                  , funBody :: Exp0
funBody = Exp0 -> Exp0
fixupSpawn Exp0
bod
                                                  , funMeta :: FunMeta
funMeta = FunMeta { funRec :: FunRec
funRec = FunRec
NotRec
                                                                      , funInline :: FunInline
funInline = FunInline
NoInline
                                                                      , funCanTriggerGC :: Bool
funCanTriggerGC = Bool
False
                                                                      }
                                                  })

    InlineSig a
_ Bool
_ Maybe (Activation a)
_ QName a
qname -> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TopLevel -> PassM (Maybe TopLevel))
-> Maybe TopLevel -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ TopLevel -> Maybe TopLevel
forall a. a -> Maybe a
Just (TopLevel -> Maybe TopLevel) -> TopLevel -> Maybe TopLevel
forall a b. (a -> b) -> a -> b
$ Var -> TopLevel
HInline (FilePath -> Var
toVar (FilePath -> Var) -> FilePath -> Var
forall a b. (a -> b) -> a -> b
$ QName a -> FilePath
forall a. QName a -> FilePath
qnameToStr QName a
qname)

    Decl a
_ -> FilePath -> PassM (Maybe TopLevel)
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM (Maybe TopLevel))
-> FilePath -> PassM (Maybe TopLevel)
forall a b. (a -> b) -> a -> b
$ FilePath
"collectTopLevel: Unsupported top-level expression: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Decl a -> FilePath
forall a. Show a => a -> FilePath
show Decl a
decl


-- pure $ LitE (litToInt lit)
desugarLiteral :: Literal a -> PassM Exp0
desugarLiteral :: forall a. Literal a -> PassM Exp0
desugarLiteral Literal a
lit =
  case Literal a
lit of
    (Int a
_ Integer
i FilePath
_)  -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
    (Char a
_ Char
chr FilePath
_) -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Char -> Exp0
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
chr
    (Frac a
_ Rational
i FilePath
_) -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Double -> Exp0
forall (ext :: * -> * -> *) loc dec. Double -> PreExp ext loc dec
FloatE (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i)
    (String a
_ FilePath
str FilePath
_) -> do
      Var
vec <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym (FilePath -> Var
toVar FilePath
"vec")
      let n :: Int
n = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
str
          init_vec :: Exp0 -> Exp0
init_vec = (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
vec,[],Ty0 -> Ty0
VectorTy Ty0
CharTy, Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
VAllocP Ty0
CharTy) [Int -> Exp0
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
n])
          fn :: Int -> Char -> Exp0 -> Exp0
fn Int
i Char
c Exp0
b = (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
"_",[],Ty0 -> Ty0
VectorTy Ty0
CharTy,
                           Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty0 -> Prim Ty0
forall ty. ty -> Prim ty
InplaceVUpdateP Ty0
CharTy) [Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
vec, Int -> Exp0
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
i, Char -> Exp0
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
c])
                     Exp0
b
          add_chars :: Exp0
add_chars = ((Int, Char) -> Exp0 -> Exp0) -> Exp0 -> [(Int, Char)] -> Exp0
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i,Char
chr) Exp0
acc -> Int -> Char -> Exp0 -> Exp0
fn Int
i Char
chr Exp0
acc) (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
vec)
                        ([(Int, Char)] -> [(Int, Char)]
forall a. [a] -> [a]
reverse ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ [Int] -> FilePath -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] FilePath
str)
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Exp0
init_vec Exp0
add_chars

    Literal a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath
"desugarLiteral: Only integer litrals are allowed: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Literal a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Literal a
lit)


litToInt :: Literal a -> Int
litToInt :: forall a. Literal a -> Int
litToInt (Int a
_ Integer
i FilePath
_) = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
litToInt Literal a
lit         = FilePath -> Int
forall a. HasCallStack => FilePath -> a
error (FilePath
"litToInt: Not an integer: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Literal a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Literal a
lit)

litToString :: Literal a -> String
litToString :: forall a. Literal a -> FilePath
litToString (String a
_ FilePath
a FilePath
_) = FilePath
a
litToString Literal a
lit            = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath
"litToString: Expected a String, got: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Literal a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Literal a
lit)

qnameToStr :: H.QName a -> String
qnameToStr :: forall a. QName a -> FilePath
qnameToStr QName a
qname =
  case QName a
qname of
    Qual a
_ ModuleName a
mname Name a
n -> (ModuleName a -> FilePath
forall a. ModuleName a -> FilePath
mnameToStr ModuleName a
mname FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
n)
    UnQual a
_ Name a
n     -> (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
n)
    Special{}      -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"qnameToStr: Special identifiers not supported: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ QName a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint QName a
qname

mnameToStr :: ModuleName a -> String
mnameToStr :: forall a. ModuleName a -> FilePath
mnameToStr (ModuleName a
_ FilePath
s) = FilePath
s

desugarOp :: QOp a -> (Prim Ty0)
desugarOp :: forall a. QOp a -> Prim Ty0
desugarOp QOp a
qop =
  case QOp a
qop of
    QVarOp a
_ (UnQual a
_ (Symbol a
_ FilePath
op)) ->
      case FilePath -> Map FilePath (Prim Ty0) -> Maybe (Prim Ty0)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
op Map FilePath (Prim Ty0)
forall a. Map FilePath (Prim a)
primMap of
        Just Prim Ty0
pr -> Prim Ty0
pr
        Maybe (Prim Ty0)
Nothing -> FilePath -> Prim Ty0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Prim Ty0) -> FilePath -> Prim Ty0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarOp: Unsupported binary op: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
op
    QOp a
op -> FilePath -> Prim Ty0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Prim Ty0) -> FilePath -> Prim Ty0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarOp: Unsupported op: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ QOp a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint QOp a
op

desugarAlt :: (Show a,  Pretty a) => TypeSynEnv -> TopTyEnv -> Alt a -> PassM (DataCon, [(Var,Ty0)], Exp0)
desugarAlt :: forall a.
(Show a, Pretty a) =>
TypeSynEnv
-> TopTyEnv -> Alt a -> PassM (FilePath, [(Var, Ty0)], Exp0)
desugarAlt TypeSynEnv
type_syns TopTyEnv
toplevel Alt a
alt =
  case Alt a
alt of
    Alt a
_ (PApp a
_ QName a
qname [Pat a]
ps) (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
Nothing -> do
      let conName :: FilePath
conName = QName a -> FilePath
forall a. QName a -> FilePath
qnameToStr QName a
qname
      [Pat a]
-> FilePath -> Exp a -> PassM (FilePath, [(Var, Ty0)], Exp0)
desugarCase [Pat a]
ps FilePath
conName Exp a
rhs
    Alt a
_ (PWildCard a
_) (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
_b ->
      [Pat a]
-> FilePath -> Exp a -> PassM (FilePath, [(Var, Ty0)], Exp0)
desugarCase [] FilePath
"_default" Exp a
rhs
    Alt a
_ Pat a
_ GuardedRhss{} Maybe (Binds a)
_ -> FilePath -> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: Guarded RHS not supported in case."
    Alt a
_ Pat a
_ Rhs a
_ Just{}        -> FilePath -> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarExp: Where clauses not allowed in case."
    Alt a
_ Pat a
pat Rhs a
_ Maybe (Binds a)
_           -> FilePath -> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM (FilePath, [(Var, Ty0)], Exp0))
-> FilePath -> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: Unsupported pattern in case: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Pat a
pat
  where
    desugarCase :: [Pat a]
-> FilePath -> Exp a -> PassM (FilePath, [(Var, Ty0)], Exp0)
desugarCase [Pat a]
ps FilePath
conName Exp a
rhs = do
      [Var]
ps' <- (Pat a -> PassM Var) -> [Pat a] -> PassM [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 (\Pat a
x -> case Pat a
x of
                            PVar a
_ Name a
v -> (Var -> PassM Var
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> PassM Var) -> (Name a -> Var) -> Name a -> PassM Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Var
toVar (FilePath -> Var) -> (Name a -> FilePath) -> Name a -> Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> FilePath
forall a. Name a -> FilePath
nameToStr) Name a
v
                            PWildCard a
_ -> Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"wildcard_"
                            Pat a
_        -> FilePath -> PassM Var
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Var) -> FilePath -> PassM Var
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarExp: Non-variable pattern in case." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat a -> FilePath
forall a. Show a => a -> FilePath
show Pat a
x)
                  [Pat a]
ps
      Exp0
rhs' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
      [(Var, Ty0)]
ps'' <- (Var -> PassM (Var, Ty0)) -> [Var] -> PassM [(Var, 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
v -> (Var
v,) (Ty0 -> (Var, Ty0)) -> PassM Ty0 -> PassM (Var, Ty0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy) [Var]
ps'
      (FilePath, [(Var, Ty0)], Exp0)
-> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
conName, [(Var, Ty0)]
ps'', Exp0
rhs')

generateBind :: (Show a,  Pretty a) => TypeSynEnv -> TopTyEnv -> TopTyEnv -> Decl a -> Exp0 -> PassM (Exp0)
generateBind :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> TopTyEnv -> Decl a -> Exp0 -> PassM Exp0
generateBind TypeSynEnv
type_syns TopTyEnv
toplevel TopTyEnv
env Decl a
decl Exp0
exp2 =
  case Decl a
decl of
    -- 'collectTopTy' takes care of this.
    TypeSig{} -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
exp2
    -- 'collectTypeSynonyms' takes care of this.
    TypeDecl{} -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
exp2
    PatBind a
_ Pat a
_ Rhs a
_ Just{}        -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"generateBind: where clauses not allowed"
    PatBind a
_ Pat a
_ GuardedRhss{} Maybe (Binds a)
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"generateBind: Guarded right hand side not supported."
    PatBind a
_ (PTuple a
_ Boxed
Boxed [Pat a]
pats) (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
Nothing -> do
      Exp0
rhs' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
      Var
w <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup"
      Ty0
ty' <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
      let tupexp :: Exp0 -> Exp0
tupexp Exp0
e = (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
w,[],Ty0
ty',Exp0
rhs') Exp0
e
          binds :: [(Pat a, Int)]
binds = [(Pat a, Int)] -> [(Pat a, Int)]
forall a. [a] -> [a]
reverse ([(Pat a, Int)] -> [(Pat a, Int)])
-> [(Pat a, Int)] -> [(Pat a, Int)]
forall a b. (a -> b) -> a -> b
$ [Pat a] -> [Int] -> [(Pat a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pat a]
pats [Int
0..]
      Exp0
prjexp <- TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
generateTupleProjs TopTyEnv
toplevel TopTyEnv
env [(Pat a, Int)]
binds (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
w) Exp0
exp2
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Exp0
tupexp Exp0
prjexp
    PatBind a
_ Pat a
pat (UnGuardedRhs a
_ Exp a
rhs) Maybe (Binds a)
Nothing -> do
      Exp0
rhs' <- TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> TopTyEnv -> Exp a -> PassM Exp0
desugarExp TypeSynEnv
type_syns TopTyEnv
toplevel Exp a
rhs
      Var
w <- case Pat a
pat of
             PVar a
_ Name a
v    -> Var -> PassM Var
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> PassM Var) -> Var -> PassM Var
forall a b. (a -> b) -> a -> b
$ FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
v)
             PWildCard a
_ -> Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"wildcard_"
             Pat a
_           -> FilePath -> PassM Var
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Var) -> FilePath -> PassM Var
forall a b. (a -> b) -> a -> b
$ FilePath
"generateBind: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat a -> FilePath
forall a. Show a => a -> FilePath
show Pat a
pat
      Ty0
ty' <- case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
w TopTyEnv
env of
               Maybe TyScheme
Nothing -> PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
               Just (ForAll [TyVar]
_ Ty0
ty) -> Ty0 -> PassM Ty0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (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
w, [], Ty0
ty', Exp0
rhs') Exp0
exp2
    FunBind{} -> do (Var
name,[Var]
args,TyScheme
ty,Exp0
bod) <- TypeSynEnv
-> TopTyEnv
-> TopTyEnv
-> Decl a
-> PassM (Var, [Var], TyScheme, Exp0)
forall a.
(Show a, Pretty a) =>
TypeSynEnv
-> TopTyEnv
-> TopTyEnv
-> Decl a
-> PassM (Var, [Var], TyScheme, Exp0)
desugarFun TypeSynEnv
type_syns TopTyEnv
toplevel TopTyEnv
env Decl a
decl
                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (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
name,[], TyScheme -> Ty0
tyFromScheme TyScheme
ty, E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [(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]
args (ArrowTy Ty0 -> [Ty0]
forall ty. FunctionTy ty => ArrowTy ty -> [ty]
inTys ArrowTy Ty0
TyScheme
ty)) Exp0
bod) Exp0
exp2
    Decl a
oth -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath
"generateBind: Unsupported pattern: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Decl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Decl a
oth)

generateTupleProjs :: (Show a, Pretty a) => TopTyEnv -> TopTyEnv -> [(Pat a,Int)] -> Exp0 -> Exp0 -> PassM (Exp0)
generateTupleProjs :: forall a.
(Show a, Pretty a) =>
TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
generateTupleProjs TopTyEnv
_toplevel TopTyEnv
_env [] Exp0
_tup Exp0
exp2 = Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
exp2
generateTupleProjs TopTyEnv
toplevel TopTyEnv
env ((Pat a
p,Int
n):[(Pat a, Int)]
pats) Exp0
tup Exp0
exp2 =
    case Pat a
p of
        (PVar a
_ Name a
v) -> do
            let w :: Var
w = FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
v)
            Var -> PassM Exp0
go Var
w
        -- Don't bind wildcards from patterns.
        (PWildCard a
_) -> do
          TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
generateTupleProjs TopTyEnv
toplevel TopTyEnv
env [(Pat a, Int)]
pats Exp0
tup Exp0
exp2

        Pat a
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"generateTupleProjs: Pattern not handled: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Pat a
p

  where
    go :: Var -> PassM Exp0
go Var
w = do
        Ty0
ty' <- case Var -> TopTyEnv -> Maybe TyScheme
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
w TopTyEnv
env of
                   Maybe TyScheme
Nothing -> PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                   Just (ForAll [TyVar]
_ Ty0
ty) -> Ty0 -> PassM Ty0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
        let prjexp :: Exp0
prjexp = (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
w,[],Ty0
ty',Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
n Exp0
tup) Exp0
exp2
        TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
forall a.
(Show a, Pretty a) =>
TopTyEnv
-> TopTyEnv -> [(Pat a, Int)] -> Exp0 -> Exp0 -> PassM Exp0
generateTupleProjs TopTyEnv
toplevel TopTyEnv
env [(Pat a, Int)]
pats Exp0
tup Exp0
prjexp

desugarConstr :: (Show a,  Pretty a) => TypeSynEnv -> QualConDecl a -> (DataCon,[(IsBoxed, Ty0)])
desugarConstr :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> QualConDecl a -> (FilePath, [(Bool, Ty0)])
desugarConstr TypeSynEnv
type_syns QualConDecl a
qdecl =
  case QualConDecl a
qdecl of
    QualConDecl a
_ Maybe [TyVarBind a]
_tyvars Maybe (Context a)
_ctx (ConDecl a
_ Name a
name [Type a]
arg_tys) ->
      -- N.B. This is a type scheme only to make the types work everywhere else
      -- in code. However, we shouldn't actually quantify over any additional
      -- type variables here. We only support Rank-1 types.
      ( Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
name , (Type a -> (Bool, Ty0)) -> [Type a] -> [(Bool, Ty0)]
forall a b. (a -> b) -> [a] -> [b]
map (TypeSynEnv -> Type a -> (Bool, Ty0)
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> (Bool, Ty0)
desugarType' TypeSynEnv
type_syns) [Type a]
arg_tys )
    QualConDecl a
_ -> FilePath -> (FilePath, [(Bool, Ty0)])
forall a. HasCallStack => FilePath -> a
error (FilePath
"desugarConstr: Unsupported data constructor: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ QualConDecl a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint QualConDecl a
qdecl)

desugarDeclHead :: DeclHead a -> (Var, [TyVar])
desugarDeclHead :: forall a. DeclHead a -> (Var, [TyVar])
desugarDeclHead = [TyVar] -> DeclHead a -> (Var, [TyVar])
forall {a}. [TyVar] -> DeclHead a -> (Var, [TyVar])
go []
  where
    go :: [TyVar] -> DeclHead a -> (Var, [TyVar])
go [TyVar]
acc DeclHead a
decl_head =
      case DeclHead a
decl_head of
        DHead a
_ Name a
name -> (FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
name), [TyVar]
acc)
        DHParen a
_ DeclHead a
dh -> [TyVar] -> DeclHead a -> (Var, [TyVar])
go [TyVar]
acc DeclHead a
dh
        DHApp a
_ DeclHead a
dh TyVarBind a
tyvar ->
            let (Var
v,[TyVar]
acc') = [TyVar] -> DeclHead a -> (Var, [TyVar])
go [TyVar]
acc DeclHead a
dh
            in (Var
v, [TyVar]
acc' [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ [TyVarBind a -> TyVar
forall a. TyVarBind a -> TyVar
desugarTyVarBind TyVarBind a
tyvar])
        DeclHead a
_ -> FilePath -> (Var, [TyVar])
forall a. HasCallStack => FilePath -> a
error (FilePath
"collectTopLevel: Unsupported data declaration: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ DeclHead a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint DeclHead a
decl_head)

desugarTyVarBind :: TyVarBind a -> TyVar
desugarTyVarBind :: forall a. TyVarBind a -> TyVar
desugarTyVarBind (UnkindedVar a
_ Name a
name) = Var -> TyVar
UserTv (FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
name))
desugarTyVarBind v :: TyVarBind a
v@KindedVar{} = FilePath -> TyVar
forall a. HasCallStack => FilePath -> a
error (FilePath -> TyVar) -> FilePath -> TyVar
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarTyVarBind: Vars with kinds not supported yet." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TyVarBind a -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint TyVarBind a
v

desugarPatWithTy :: (Show a, Pretty a) => TypeSynEnv -> Pat a -> PassM (Var, Ty0, [L0.Binds Exp0])
desugarPatWithTy :: forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns Pat a
pat =
  case Pat a
pat of
    (PParen a
_ Pat a
p)        -> TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns Pat a
p
    (PatTypeSig a
_ Pat a
p Type a
ty) -> do (Var
v,Ty0
_ty,[(Var, [Ty0], Ty0, Exp0)]
binds) <- TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns Pat a
p
                              (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
-> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var
v, TypeSynEnv -> Type a -> Ty0
forall a. (Show a, Pretty a) => TypeSynEnv -> Type a -> Ty0
desugarType TypeSynEnv
type_syns Type a
ty, [(Var, [Ty0], Ty0, Exp0)]
binds)
    (PVar a
_ Name a
n)          -> do Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                              (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
-> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Var
toVar (Name a -> FilePath
forall a. Name a -> FilePath
nameToStr Name a
n), Ty0
ty, [])
    (PWildCard a
_)       -> do Var
v <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"wildcard_"
                              Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                              (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
-> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var
v,Ty0
ty,[])
    (PTuple a
_ Boxed
Boxed [Pat a]
pats) -> do ([Var]
vars,[Ty0]
tys,[[(Var, [Ty0], Ty0, Exp0)]]
bindss) <- [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
 -> ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]]))
-> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
-> PassM ([Var], [Ty0], [[(Var, [Ty0], Ty0, Exp0)]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pat a -> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)]))
-> [Pat a] -> PassM [(Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])]
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 (TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns) [Pat a]
pats
                                Var
tup <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup"
                                let binds0 :: [(Var, [Ty0], Ty0, Exp0)]
binds0 = [[(Var, [Ty0], Ty0, Exp0)]] -> [(Var, [Ty0], Ty0, Exp0)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Var, [Ty0], Ty0, Exp0)]]
bindss
                                    binds1 :: [(Var, [Ty0], Ty0, Exp0)]
binds1 = ((Var, Ty0, Int) -> (Var, [Ty0], Ty0, Exp0))
-> [(Var, Ty0, Int)] -> [(Var, [Ty0], Ty0, Exp0)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
v,Ty0
ty,Int
i) -> (Var
v,[],Ty0
ty,Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tup))) ([Var] -> [Ty0] -> [Int] -> [(Var, Ty0, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Var]
vars [Ty0]
tys [Int
0..])
                                    tupty :: Ty0
tupty = [Ty0] -> Ty0
ProdTy [Ty0]
tys
                                    -- current bindings: binds1, recursive bindings: binds0
                                (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
-> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var
tup,Ty0
tupty,[(Var, [Ty0], Ty0, Exp0)]
binds1 [(Var, [Ty0], Ty0, Exp0)]
-> [(Var, [Ty0], Ty0, Exp0)] -> [(Var, [Ty0], Ty0, Exp0)]
forall a. [a] -> [a] -> [a]
++ [(Var, [Ty0], Ty0, Exp0)]
binds0)

    (PApp a
_ (UnQual a
_ (Ident a
_ FilePath
"Ur")) [Pat a
one]) -> TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
forall a.
(Show a, Pretty a) =>
TypeSynEnv -> Pat a -> PassM (Var, Ty0, [Binds Exp0])
desugarPatWithTy TypeSynEnv
type_syns Pat a
one

    Pat a
_ -> FilePath -> PassM (Var, Ty0, [(Var, [Ty0], Ty0, Exp0)])
forall a. HasCallStack => FilePath -> a
error (FilePath
"desugarPatWithTy: Unsupported pattern: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Pat a -> FilePath
forall a. Show a => a -> FilePath
show Pat a
pat)

nameToStr :: Name a -> String
nameToStr :: forall a. Name a -> FilePath
nameToStr (Ident a
_ FilePath
s)  = FilePath
s
nameToStr (Symbol a
_ FilePath
s) = FilePath
s

instance Pretty SrcSpanInfo where

-- | SpawnE's are parsed in a strange way. If we see a 'spawn (f x1 x2)',
-- we parse it as 'SpawnE HOLE [] [(f x1 x2)]'. This function patches it
-- to 'SpawnE f [] [x1 x2]'.
fixupSpawn :: Exp0 -> Exp0
fixupSpawn :: Exp0 -> Exp0
fixupSpawn Exp0
ex =
  case Exp0
ex of
    Ext (LambdaE [(Var, Ty0)]
vars Exp0
bod) -> 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)]
vars (Exp0 -> Exp0
go Exp0
bod))
    Ext (PolyAppE Exp0
a Exp0
b)     -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Exp0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (Exp0 -> Exp0
go Exp0
a) (Exp0 -> Exp0
go Exp0
b))
    Ext (FunRefE{})        -> Exp0
ex
    Ext (BenchE Var
fn [Ty0]
tyapps [Exp0]
args Bool
b) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [Ty0]
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
args) Bool
b)
    Ext (ParE0 [Exp0]
ls) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
ls))
    Ext (PrintPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked Ty0
ty (Exp0 -> Exp0
go Exp0
arg))
    Ext (CopyPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked Ty0
ty (Exp0 -> Exp0
go Exp0
arg))
    Ext (TravPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked Ty0
ty (Exp0 -> Exp0
go Exp0
arg))
    Ext (L Loc
p Exp0
e)    -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Loc -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p (Exp0 -> Exp0
go Exp0
e))
    Ext (LinearExt LinearExt Ty0 Ty0
ext) ->
      case LinearExt Ty0 Ty0
ext of
        ReverseAppE Exp0
fn Exp0
arg -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
go Exp0
fn) (Exp0 -> Exp0
go Exp0
arg)))
        LseqE Exp0
a Exp0
b   -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
go Exp0
a) (Exp0 -> Exp0
go Exp0
b)))
        AliasE Exp0
a    -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
go Exp0
a)))
        ToLinearE Exp0
a -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (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
go Exp0
a)))
    -- Straightforward recursion ...
    VarE{}     -> Exp0
ex
    LitE{}     -> Exp0
ex
    CharE{}    -> Exp0
ex
    FloatE{}   -> Exp0
ex
    LitSymE{}  -> Exp0
ex
    AppE Var
fn [Ty0]
tyapps [Exp0]
args -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [Ty0]
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
args)
    PrimAppE Prim Ty0
pr [Exp0]
args -> Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
pr ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
args)
    DataConE Ty0
dcon FilePath
tyapps [Exp0]
args -> Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
dcon FilePath
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
args)
    ProjE Int
i Exp0
e  -> Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (Exp0 -> Exp0) -> Exp0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Exp0
go Exp0
e
    IfE Exp0
a Exp0
b Exp0
c  -> 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
go Exp0
a) (Exp0 -> Exp0
go Exp0
b) (Exp0 -> Exp0
go Exp0
c)
    MkProdE [Exp0]
ls -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp0] -> Exp0) -> [Exp0] -> Exp0
forall a b. (a -> b) -> a -> b
$ (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
go [Exp0]
ls
    -- Only allow BenchE in tail position
    LetE (Var
v,[Ty0]
locs,Ty0
ty,Exp0
rhs) Exp0
bod -> (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
v,[Ty0]
locs,Ty0
ty, Exp0 -> Exp0
go Exp0
rhs) (Exp0 -> Exp0
go Exp0
bod)
    CaseE Exp0
scrt [(FilePath, [(Var, Ty0)], Exp0)]
mp -> Exp0 -> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(FilePath, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Exp0 -> Exp0
go Exp0
scrt) ([(FilePath, [(Var, Ty0)], Exp0)] -> Exp0)
-> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall a b. (a -> b) -> a -> b
$ ((FilePath, [(Var, Ty0)], Exp0) -> (FilePath, [(Var, Ty0)], Exp0))
-> [(FilePath, [(Var, Ty0)], Exp0)]
-> [(FilePath, [(Var, Ty0)], Exp0)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
a,[(Var, Ty0)]
b,Exp0
c) -> (FilePath
a,[(Var, Ty0)]
b, Exp0 -> Exp0
go Exp0
c)) [(FilePath, [(Var, Ty0)], Exp0)]
mp
    TimeIt Exp0
e Ty0
ty Bool
b -> Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp0 -> Exp0
go Exp0
e) Ty0
ty Bool
b
    WithArenaE Var
v Exp0
e -> Var -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v (Exp0 -> Exp0
go Exp0
e)
    SpawnE Var
_ [Ty0]
_ [Exp0]
args ->
      case [Exp0]
args of
          [(AppE Var
fn [Ty0]
tyapps [Exp0]
ls)] -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn [Ty0]
tyapps [Exp0]
ls
          [Exp0]
_ -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"fixupSpawn: incorrect use of spawn: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp0 -> FilePath
forall a. Out a => a -> FilePath
sdoc Exp0
ex
    Exp0
SyncE   -> Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
    MapE{}  -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"fixupSpawn: TODO MapE"
    FoldE{} -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"fixupSpawn: TODO FoldE"
  where go :: Exp0 -> Exp0
go = Exp0 -> Exp0
fixupSpawn

-- | Verify some assumptions about BenchE.
verifyBenchEAssumptions :: Bool -> Exp0 -> Exp0
verifyBenchEAssumptions :: Bool -> Exp0 -> Exp0
verifyBenchEAssumptions Bool
bench_allowed Exp0
ex =
  case Exp0
ex of
    Ext (LambdaE [(Var, Ty0)]
vars Exp0
bod) -> 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)]
vars (Exp0 -> Exp0
not_allowed Exp0
bod))
    Ext (PolyAppE Exp0
a Exp0
b)     -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Exp0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE (Exp0 -> Exp0
not_allowed Exp0
a) (Exp0 -> Exp0
not_allowed Exp0
b))
    Ext (FunRefE{})        -> Exp0
ex
    Ext (BenchE Var
_ [Ty0]
tyapps [Exp0]
args Bool
b) ->
      if Bool
bench_allowed then
        case [Exp0]
args of
          ((VarE Var
fn) : [Exp0]
oth) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [Ty0]
tyapps [Exp0]
oth Bool
b)
          [Exp0]
_ -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarModule: bench is a reserved keyword. Usage: bench fn_name args. Got: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Exp0] -> FilePath
forall a. Out a => a -> FilePath
sdoc [Exp0]
args
      else FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"verifyBenchEAssumptions: 'bench' can only be used as a tail of the main expression, but it was used in a function. In: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp0 -> FilePath
forall a. Out a => a -> FilePath
sdoc Exp0
ex
    Ext (ParE0 [Exp0]
ls) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
ls))
    Ext (PrintPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked Ty0
ty (Exp0 -> Exp0
not_allowed Exp0
arg))
    Ext (CopyPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked Ty0
ty (Exp0 -> Exp0
not_allowed Exp0
arg))
    Ext (TravPacked Ty0
ty Exp0
arg) -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked Ty0
ty (Exp0 -> Exp0
not_allowed Exp0
arg))
    Ext (L Loc
p Exp0
e)    -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Loc -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p (Exp0 -> Exp0
go Exp0
e))
    Ext (LinearExt{}) -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"verifyBenchEAssumptions: LinearExt not handled."
    -- Straightforward recursion ...
    VarE{}     -> Exp0
ex
    LitE{}     -> Exp0
ex
    CharE{}    -> Exp0
ex
    FloatE{}   -> Exp0
ex
    LitSymE{}  -> Exp0
ex
    AppE Var
fn [Ty0]
tyapps [Exp0]
args -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [Ty0]
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
args)
    PrimAppE Prim Ty0
pr [Exp0]
args -> Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
pr ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
args)
    DataConE Ty0
dcon FilePath
tyapps [Exp0]
args -> Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
dcon FilePath
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
args)
    ProjE Int
i Exp0
e  -> Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (Exp0 -> Exp0) -> Exp0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Exp0
not_allowed Exp0
e
    IfE Exp0
a Exp0
b Exp0
c  -> 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
not_allowed Exp0
a) (Exp0 -> Exp0
go Exp0
b) (Exp0 -> Exp0
go Exp0
c)
    MkProdE [Exp0]
ls -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp0] -> Exp0) -> [Exp0] -> Exp0
forall a b. (a -> b) -> a -> b
$ (Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
ls
    LetE (Var
v,[Ty0]
locs,Ty0
ty,Exp0
rhs) Exp0
bod -> (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
v,[Ty0]
locs,Ty0
ty, Exp0 -> Exp0
not_allowed Exp0
rhs) (Exp0 -> Exp0
go Exp0
bod)
    CaseE Exp0
scrt [(FilePath, [(Var, Ty0)], Exp0)]
mp -> Exp0 -> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(FilePath, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Exp0 -> Exp0
go Exp0
scrt) ([(FilePath, [(Var, Ty0)], Exp0)] -> Exp0)
-> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall a b. (a -> b) -> a -> b
$ ((FilePath, [(Var, Ty0)], Exp0) -> (FilePath, [(Var, Ty0)], Exp0))
-> [(FilePath, [(Var, Ty0)], Exp0)]
-> [(FilePath, [(Var, Ty0)], Exp0)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
a,[(Var, Ty0)]
b,Exp0
c) -> (FilePath
a,[(Var, Ty0)]
b, Exp0 -> Exp0
go Exp0
c)) [(FilePath, [(Var, Ty0)], Exp0)]
mp
    TimeIt Exp0
e Ty0
ty Bool
b -> Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp0 -> Exp0
not_allowed Exp0
e) Ty0
ty Bool
b
    WithArenaE Var
v Exp0
e -> Var -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v (Exp0 -> Exp0
go Exp0
e)
    SpawnE Var
fn [Ty0]
tyapps [Exp0]
args -> Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn [Ty0]
tyapps ((Exp0 -> Exp0) -> [Exp0] -> [Exp0]
forall a b. (a -> b) -> [a] -> [b]
map Exp0 -> Exp0
not_allowed [Exp0]
args)
    Exp0
SyncE    -> Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
    MapE{}  -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"verifyBenchEAssumptions: TODO MapE"
    FoldE{} -> FilePath -> Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> Exp0) -> FilePath -> Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"verifyBenchEAssumptions: TODO FoldE"
  where go :: Exp0 -> Exp0
go = Bool -> Exp0 -> Exp0
verifyBenchEAssumptions Bool
bench_allowed
        not_allowed :: Exp0 -> Exp0
not_allowed = Bool -> Exp0 -> Exp0
verifyBenchEAssumptions Bool
False

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

desugarLinearExts :: Prog0 -> PassM Prog0
desugarLinearExts :: Prog0 -> PassM Prog0
desugarLinearExts (Prog DDefs (TyOf Exp0)
ddefs Map Var (FunDef Exp0)
fundefs Maybe (Exp0, TyOf Exp0)
main) = do
    Maybe (Exp0, Ty0)
main' <- case Maybe (Exp0, TyOf Exp0)
main of
               Maybe (Exp0, TyOf Exp0)
Nothing -> Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Exp0, Ty0)
forall a. Maybe a
Nothing
               Just (Exp0
e,TyOf Exp0
ty) -> do
                 let ty' :: Ty0
ty' = Ty0 -> Ty0
goty TyOf Exp0
Ty0
ty
                 Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
                 Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0)))
-> Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a b. (a -> b) -> a -> b
$ (Exp0, Ty0) -> Maybe (Exp0, Ty0)
forall a. a -> Maybe a
Just (Exp0
e', Ty0
ty')
    Map Var (FunDef Exp0)
fundefs' <- (FunDef Exp0 -> PassM (FunDef Exp0))
-> Map Var (FunDef Exp0) -> PassM (Map Var (FunDef Exp0))
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) -> Map Var a -> m (Map Var b)
mapM (\FunDef Exp0
fn -> do
                           Exp0
bod <- Exp0 -> PassM Exp0
go (FunDef Exp0 -> Exp0
forall ex. FunDef ex -> ex
funBody FunDef Exp0
fn)
                           let (ForAll [TyVar]
tyvars Ty0
ty) = (FunDef Exp0 -> ArrowTy (TyOf Exp0)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDef Exp0
fn)
                               ty' :: Ty0
ty' = Ty0 -> Ty0
goty Ty0
ty
                           FunDef Exp0 -> PassM (FunDef Exp0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunDef Exp0 -> PassM (FunDef Exp0))
-> FunDef Exp0 -> PassM (FunDef Exp0)
forall a b. (a -> b) -> a -> b
$ FunDef Exp0
fn { funBody :: Exp0
funBody = Exp0
bod
                                     , funTy :: ArrowTy (TyOf Exp0)
funTy = ([TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tyvars Ty0
ty')
                                     })
                     Map Var (FunDef Exp0)
fundefs
    Prog0 -> PassM Prog0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DDefs (TyOf Exp0)
-> Map Var (FunDef Exp0) -> Maybe (Exp0, TyOf Exp0) -> Prog0
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp0)
ddefs Map Var (FunDef Exp0)
fundefs' Maybe (Exp0, TyOf Exp0)
Maybe (Exp0, Ty0)
main')
  where
    goty :: Ty0 -> Ty0
    goty :: Ty0 -> Ty0
goty Ty0
ty =
      case Ty0
ty of
        ProdTy [Ty0]
tys -> [Ty0] -> Ty0
ProdTy ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
goty [Ty0]
tys)
        SymDictTy Maybe Var
v Ty0
t -> Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
v (Ty0 -> Ty0
goty Ty0
t)
        PDictTy Ty0
k Ty0
v -> Ty0 -> Ty0 -> Ty0
PDictTy (Ty0 -> Ty0
goty Ty0
k) (Ty0 -> Ty0
goty 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
goty [Ty0]
tys) (Ty0 -> Ty0
goty Ty0
b)
        PackedTy FilePath
"Ur" [Ty0
one] -> Ty0
one
        PackedTy FilePath
t [Ty0]
tys -> FilePath -> [Ty0] -> Ty0
PackedTy FilePath
t ((Ty0 -> Ty0) -> [Ty0] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map Ty0 -> Ty0
goty [Ty0]
tys)
        VectorTy Ty0
t -> Ty0 -> Ty0
VectorTy (Ty0 -> Ty0
goty Ty0
t)
        ListTy Ty0
t -> Ty0 -> Ty0
ListTy (Ty0 -> Ty0
goty Ty0
t)
        Ty0
_ -> Ty0
ty

    go :: PreExp E0Ext Ty0 Ty0 -> PassM Exp0
    go :: Exp0 -> PassM Exp0
go Exp0
ex =
      case Exp0
ex of
        VarE{}    -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
        LitE{}    -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
        CharE{}   -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
        FloatE{}  -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
        LitSymE{} -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
        AppE Var
f [Ty0]
tyapps [Exp0]
args -> do [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
                                 Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [Ty0]
tyapps [Exp0]
args')
        PrimAppE Prim Ty0
pr [Exp0]
args   -> do [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
                                 Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
pr [Exp0]
args')
        LetE (Var
v,[Ty0]
locs,Ty0
ty,Exp0
rhs) Exp0
bod -> do
          let ty' :: Ty0
ty' = Ty0 -> Ty0
goty Ty0
ty
          Exp0
rhs' <- Exp0 -> PassM Exp0
go Exp0
rhs
          Exp0
bod' <- Exp0 -> PassM Exp0
go Exp0
bod
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (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
v,[Ty0]
locs,Ty0
ty',Exp0
rhs') Exp0
bod'
        IfE Exp0
a Exp0
b Exp0
c -> do Exp0
a' <- Exp0 -> PassM Exp0
go Exp0
a
                        Exp0
b' <- Exp0 -> PassM Exp0
go Exp0
b
                        Exp0
c' <- Exp0 -> PassM Exp0
go Exp0
c
                        Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
a' Exp0
b' Exp0
c')
        MkProdE [Exp0]
ls -> do [Exp0]
ls' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
ls
                         Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp0]
ls')
        ProjE Int
i Exp0
e  -> do Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
                         Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i Exp0
e')
        CaseE Exp0
scrt [(FilePath, [(Var, Ty0)], Exp0)]
alts -> do Exp0
scrt' <- Exp0 -> PassM Exp0
go Exp0
scrt
                              [(FilePath, [(Var, Ty0)], Exp0)]
alts' <- ((FilePath, [(Var, Ty0)], Exp0)
 -> PassM (FilePath, [(Var, Ty0)], Exp0))
-> [(FilePath, [(Var, Ty0)], Exp0)]
-> PassM [(FilePath, [(Var, Ty0)], Exp0)]
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 (\(FilePath
a,[(Var, Ty0)]
b,Exp0
c) -> do Exp0
c' <- Exp0 -> PassM Exp0
go Exp0
c
                                                            (FilePath, [(Var, Ty0)], Exp0)
-> PassM (FilePath, [(Var, Ty0)], Exp0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
a,[(Var, Ty0)]
b,Exp0
c'))
                                            [(FilePath, [(Var, Ty0)], Exp0)]
alts
                              Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> [(FilePath, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(FilePath, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp0
scrt' [(FilePath, [(Var, Ty0)], Exp0)]
alts')
        DataConE Ty0
_ FilePath
"Ur" [Exp0
arg]   -> do Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                                      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
arg'
        DataConE Ty0
locs FilePath
dcon [Exp0]
args -> do [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
                                      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> FilePath -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> FilePath -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
locs FilePath
dcon [Exp0]
args')
        TimeIt Exp0
e Ty0
ty Bool
b -> do Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
                            let ty' :: Ty0
ty' = Ty0 -> Ty0
goty Ty0
ty
                            Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> Ty0 -> Bool -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt Exp0
e' Ty0
ty' Bool
b)
        WithArenaE Var
v Exp0
e -> do Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
                             Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v Exp0
e')
        SpawnE Var
f [Ty0]
tyapps [Exp0]
args -> do [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
                                   Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
f [Ty0]
tyapps [Exp0]
args')
        Exp0
SyncE -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
        MapE{}  -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarLinearExts: MapE"
        FoldE{} -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error FilePath
"desugarLinearExts: FoldE"
        Ext E0Ext Ty0 Ty0
ext ->
          case E0Ext Ty0 Ty0
ext of
            LambdaE [(Var, Ty0)]
args Exp0
bod -> do Exp0
bod' <- Exp0 -> PassM Exp0
go Exp0
bod
                                   let args' :: [(Var, Ty0)]
args' = ((Var, Ty0) -> (Var, Ty0)) -> [(Var, Ty0)] -> [(Var, Ty0)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
v,Ty0
ty) -> (Var
v,Ty0 -> Ty0
goty Ty0
ty)) [(Var, Ty0)]
args
                                   Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)]
args' Exp0
bod'))
            PolyAppE Exp0
fn Exp0
arg  -> do Exp0
fn' <- Exp0 -> PassM Exp0
go Exp0
fn
                                   Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                                   Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Exp0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
PreExp E0Ext loc dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PolyAppE Exp0
fn' Exp0
arg'))
            FunRefE{} -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
ex
            BenchE Var
fn [Ty0]
tyapps [Exp0]
args Bool
b -> do [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
                                          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> [Ty0] -> [Exp0] -> Bool -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> Bool -> E0Ext loc dec
BenchE Var
fn [Ty0]
tyapps [Exp0]
args' Bool
b))
            ParE0 [Exp0]
ls -> do [Exp0]
ls' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
ls
                           Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 [Exp0]
ls'))
            PrintPacked Ty0
ty Exp0
arg -> do Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                                     Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked Ty0
ty Exp0
arg'))
            CopyPacked Ty0
ty Exp0
arg -> do Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked Ty0
ty Exp0
arg'))
            TravPacked Ty0
ty Exp0
arg -> do Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                                    Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked Ty0
ty Exp0
arg'))
            L Loc
p Exp0
e -> do Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
                        Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Loc -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p Exp0
e'))
            LinearExt LinearExt Ty0 Ty0
lin ->
              case LinearExt Ty0 Ty0
lin of
                ReverseAppE Exp0
fn (Ext (LinearExt (AliasE Exp0
e))) -> do
                  Exp0
fn' <- Exp0 -> PassM Exp0
go Exp0
fn
                  case Exp0
fn' of
                    Ext (LambdaE [(Var
v,ProdTy [Ty0]
tys)] Exp0
bod) -> do
                      let ty :: Ty0
ty = [Ty0] -> Ty0
forall a. HasCallStack => [a] -> a
head [Ty0]
tys
                          bod'' :: Exp0
bod'' = (Exp0 -> Int -> Exp0) -> Exp0 -> [Int] -> Exp0
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Exp0
acc Int
i -> Exp0 -> Exp0 -> Exp0 -> Exp0
forall e. Substitutable e => e -> e -> e -> e
gSubstE (Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v)) (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v) Exp0
acc) Exp0
bod [Int
0..([Ty0] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ty0]
tys)]
                      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((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
v,[],Ty0
ty,Exp0
e) Exp0
bod'')
                    Exp0
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarLinearExts: couldn't desugar " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp0 -> FilePath
forall a. Out a => a -> FilePath
sdoc Exp0
ex
                ReverseAppE Exp0
fn Exp0
arg -> do
                  Exp0
fn'  <- Exp0 -> PassM Exp0
go Exp0
fn
                  Exp0
arg' <- Exp0 -> PassM Exp0
go Exp0
arg
                  case Exp0
fn' of
                    Ext (LambdaE [(Var
v,Ty0
ty)] Exp0
bod) -> do
                      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((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
v,[],Ty0
ty,Exp0
arg') Exp0
bod)
                    Exp0
_ -> FilePath -> PassM Exp0
forall a. HasCallStack => FilePath -> a
error (FilePath -> PassM Exp0) -> FilePath -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ FilePath
"desugarLinearExts: couldn't desugar " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Exp0 -> FilePath
forall a. Out a => a -> FilePath
sdoc Exp0
ex
                LseqE Exp0
_ Exp0
b   -> do Exp0
b' <- Exp0 -> PassM Exp0
go Exp0
b
                                  Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
b'
                AliasE Exp0
a    -> do Var
v <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"aliased"
                                  Ty0
ty <- PassM Ty0
forall (m :: * -> *). MonadState Int m => m Ty0
newMetaTy
                                  Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((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
v,[],Ty0
ty,[Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp0
a,Exp0
a]) (Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v))
                ToLinearE Exp0
a -> do Exp0
a' <- Exp0 -> PassM Exp0
go Exp0
a
                                  Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
a'