{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}

-- | A simple typechecker for the L3 language
-- It's very similar to the L1 typechecker
module Gibbon.L3.Typecheck
  ( tcProg, tcExp ) where


import Control.Monad
import Control.Monad.Except
import qualified Data.Map as M
import qualified Data.List as L
import Data.Maybe
import Prelude hiding (exp)

import Gibbon.Common
import Gibbon.L1.Typecheck hiding (tcProg, tcExp, ensureEqual, ensureEqualTy)
import Gibbon.L3.Syntax

-- | Typecheck a L1 expression
--
tcExp :: Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp :: Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env Exp3
exp =
  case Exp3
exp of
    Ext E3Ext () Ty3
ext ->
      case E3Ext () Ty3
ext of
        -- One cursor in, (int, cursor') out
        ReadScalar Scalar
s Var
v -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Scalar -> Ty3
forall a. Scalar -> UrTy a
scalarToTy Scalar
s, Ty3
forall loc. UrTy loc
CursorTy]

        -- Write int at cursor, and return a cursor
        WriteScalar Scalar
s Var
v Exp3
rhs -> do
          Ty3
vty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Ty3
vrhs <- Exp3 -> TcM Ty3 Exp3
go Exp3
rhs
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vrhs (Scalar -> Ty3
forall a. Scalar -> UrTy a
scalarToTy Scalar
s)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        -- One cursor in, (tag,cursor) out
        -- QUESTION: what should be the type of the tag ?  It's just an Int for now
        ReadTag Var
v -> do
          Ty3
vty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
forall loc. UrTy loc
IntTy, Ty3
forall loc. UrTy loc
CursorTy]

        -- Write Tag at Cursor, and return a cursor
        WriteTag [Char]
_dcon Var
v -> do
          Ty3
vty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        TagCursor Var
a Var
b -> do
          Ty3
aty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
a Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
aty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
bty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
b Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
bty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        ReadTaggedCursor Var
v -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
IntTy]

        WriteTaggedCursor Var
v Exp3
val -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
valty <- Exp3 -> TcM Ty3 Exp3
go Exp3
val
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
valty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        ReadCursor Var
v -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
CursorTy]

        WriteCursor Var
cur Exp3
val -> do
          Ty3
curty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
cur Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
curty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
valty <- Exp3 -> TcM Ty3 Exp3
go Exp3
val
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
valty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        ReadList Var
v Ty3
ty -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
ty, Ty3
forall loc. UrTy loc
CursorTy]

        WriteList Var
cur Exp3
val Ty3
el_ty -> do
          Ty3
curty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
cur Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
curty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
valty <- Exp3 -> TcM Ty3 Exp3
go Exp3
val
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
valty (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
el_ty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        ReadVector Var
v Ty3
ty -> do
          Ty3
vty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
ty, Ty3
forall loc. UrTy loc
CursorTy]

        WriteVector Var
cur Exp3
val Ty3
el_ty -> do
          Ty3
curty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
cur Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
curty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
valty <- Exp3 -> TcM Ty3 Exp3
go Exp3
val
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
valty (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
el_ty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        -- Add a constant offset to a cursor variable
        AddCursor Var
v Exp3
rhs -> do
          Ty3
vty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
vrhs <- Exp3 -> TcM Ty3 Exp3
go Exp3
rhs
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vrhs Ty3
forall loc. UrTy loc
IntTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        -- Subtract something from a cursor variable
        SubPtr Var
v Var
w -> do
          Ty3
vty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
vty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
wty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
w Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
wty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        -- Create a new buffer, and return a cursor
        NewBuffer{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
        NewParBuffer{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        -- Create a scoped buffer, and return a cursor
        ScopedBuffer{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
        ScopedParBuffer{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        EndOfBuffer{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        MMapFileSize{} -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        -- Takes in start and end cursors, and returns an Int
        SizeOfPacked Var
start Var
end -> do
          Ty3
sty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
start Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
sty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
ety  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
end Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
ety Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        -- Takes in a variable, and returns an Int
        SizeOfScalar Var
v -> do
          Ty3
sty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          if Ty3
sty Ty3 -> Ty3 -> Bool
forall a. Eq a => a -> a -> Bool
== Ty3
forall loc. UrTy loc
IntTy Bool -> Bool -> Bool
|| Ty3
sty Ty3 -> Ty3 -> Bool
forall a. Eq a => a -> a -> Bool
== Ty3
forall loc. UrTy loc
FloatTy
          then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy
          else TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Unknown scalar type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
sty) Exp3
exp

        -- The IntTy is just a placeholder. BoundsCheck is a side-effect
        BoundsCheck Int
_ Var
bound Var
cur -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
bound Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
cty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
cur Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
cty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        IndirectionBarrier [Char]
_tycon (Var
l1, Var
end_r1, Var
l2, Var
end_r2) -> do
          Ty3
l1_ty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
l1 Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
l1_ty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
end_r1_ty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
end_r1 Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
end_r1_ty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
l2_ty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
l2 Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
l2_ty Ty3
forall loc. UrTy loc
CursorTy
          Ty3
end_r2_ty  <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
end_r2 Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
end_r2_ty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        BumpArenaRefCount{} ->
          TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"BumpArenaRefCount not handled.") Exp3
exp

        RetE [Exp3]
ls -> do
          [Ty3]
tys <- (Exp3 -> TcM Ty3 Exp3)
-> [Exp3] -> ExceptT (TCError Exp3) Identity [Ty3]
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 Exp3 -> TcM Ty3 Exp3
go [Exp3]
ls
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3]
tys)

        E3Ext () Ty3
NullCursor -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        E3Ext () Ty3
GetCilkWorkerNum -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        LetAvail [Var]
_ Exp3
bod -> Exp3 -> TcM Ty3 Exp3
go Exp3
bod

        AllocateTagHere Var
v [Char]
_ -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        AllocateScalarsHere Var
v -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        StartTagAllocation Var
v -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        EndTagAllocation Var
v -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        EndScalarsAllocation Var
v -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        StartScalarsAllocation Var
v -> do
          Ty3
rty <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        SSPush SSModality
_ Var
v Var
w [Char]
_ -> do
          Ty3
rty1 <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty1 Ty3
forall loc. UrTy loc
CursorTy
          Ty3
rty2 <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
w Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty2 Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        SSPop SSModality
_ Var
v Var
w -> do
          Ty3
rty1 <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty1 Ty3
forall loc. UrTy loc
CursorTy
          Ty3
rty2 <- Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
w Exp3
exp
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
rty2 Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Assert Exp3
rhs -> do
          Ty3
ety <- Exp3 -> TcM Ty3 Exp3
go Exp3
rhs
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
rhs Ty3
ety Ty3
forall loc. UrTy loc
BoolTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

    -- All the other cases are exactly same as L1.Typecheck

    VarE Var
v    -> Env2 Ty3 -> Var -> Exp3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Env2 (UrTy l)
-> Var -> PreExp e () Ty3 -> TcM (UrTy l) (PreExp e () Ty3)
lookupVar Env2 Ty3
env Var
v Exp3
exp
    LitE Int
_    -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy
    CharE Char
_   -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CharTy
    FloatE{}  -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
FloatTy
    LitSymE Var
_ -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymTy

    AppE Var
v [()]
locs [Exp3]
ls -> do
      let funty :: ([Ty3], Ty3)
funty =
            case (Var -> Map Var ([Ty3], Ty3) -> Maybe ([Ty3], Ty3)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v (Env2 Ty3 -> TyEnv (ArrowTy Ty3)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 Ty3
env)) of
              Just ([Ty3], Ty3)
ty -> ([Ty3], Ty3)
ty
              Maybe ([Ty3], Ty3)
Nothing -> [Char] -> ([Ty3], Ty3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([Ty3], Ty3)) -> [Char] -> ([Ty3], Ty3)
forall a b. (a -> b) -> a -> b
$ [Char]
"Function not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" while checking " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                 Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
exp

          ([Ty3]
funInTys,Ty3
funRetTy) = (ArrowTy Ty3 -> [Ty3]
forall ty. FunctionTy ty => ArrowTy ty -> [ty]
inTys ([Ty3], Ty3)
ArrowTy Ty3
funty, ArrowTy Ty3 -> Ty3
forall ty. FunctionTy ty => ArrowTy ty -> ty
outTy ([Ty3], Ty3)
ArrowTy Ty3
funty)

      -- Check that the expression does not have any locations
      case [()]
locs of
        [] -> () -> ExceptT (TCError Exp3) Identity ()
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [()]
_  -> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Expected the locations to be empty in L1. Got"
                                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [()] -> [Char]
forall a. Out a => a -> [Char]
sdoc [()]
locs)
                           Exp3
exp

      -- Check arity
      if ([Exp3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp3]
ls) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ([Ty3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ty3]
funInTys)
      then TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Arity mismatch. Expected:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Ty3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ty3]
funInTys) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                   [Char]
" Got:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Exp3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp3]
ls)) Exp3
exp
      else () -> ExceptT (TCError Exp3) Identity ()
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      -- Check argument type
      [Ty3]
argTys <- (Exp3 -> TcM Ty3 Exp3)
-> [Exp3] -> ExceptT (TCError Exp3) Identity [Ty3]
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 Exp3 -> TcM Ty3 Exp3
go [Exp3]
ls

      let combAr :: (UrTy loc, UrTy loc) -> Map Var Var -> Map Var Var
combAr (SymDictTy (Just Var
v1) Ty3
_, SymDictTy (Just Var
v2) Ty3
_) Map Var Var
m = Var -> Var -> Map Var Var -> Map Var Var
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v2 Var
v1 Map Var Var
m
          combAr (UrTy loc, UrTy loc)
_ Map Var Var
m = Map Var Var
m
          arMap :: Map Var Var
arMap = ((Ty3, Ty3) -> Map Var Var -> Map Var Var)
-> Map Var Var -> [(Ty3, Ty3)] -> Map Var Var
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (Ty3, Ty3) -> Map Var Var -> Map Var Var
forall {loc} {loc}.
(UrTy loc, UrTy loc) -> Map Var Var -> Map Var Var
combAr Map Var Var
forall k a. Map k a
M.empty ([(Ty3, Ty3)] -> Map Var Var) -> [(Ty3, Ty3)] -> Map Var Var
forall a b. (a -> b) -> a -> b
$ [Ty3] -> [Ty3] -> [(Ty3, Ty3)]
forall a b.
(Show a, Show b, HasCallStack) =>
[a] -> [b] -> [(a, b)]
fragileZip [Ty3]
argTys [Ty3]
funInTys

          subDictTy :: Map Var Var -> Ty3 -> Ty3
subDictTy Map Var Var
m (SymDictTy (Just Var
w) Ty3
ty) =
              case Var -> Map Var Var -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
w Map Var Var
m of
                Just Var
w' -> Maybe Var -> Ty3 -> Ty3
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
w') Ty3
ty
                Maybe Var
Nothing -> [Char] -> Ty3
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ty3) -> [Char] -> Ty3
forall a b. (a -> b) -> a -> b
$ ([Char]
"Cannot match up arena for dictionary in function application: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
exp)
          subDictTy Map Var Var
_ Ty3
ty = Ty3
ty

          subFunInTys :: [Ty3]
subFunInTys = (Ty3 -> Ty3) -> [Ty3] -> [Ty3]
forall a b. (a -> b) -> [a] -> [b]
L.map (Map Var Var -> Ty3 -> Ty3
subDictTy Map Var Var
arMap) [Ty3]
funInTys
          subFunOutTy :: Ty3
subFunOutTy = Map Var Var -> Ty3 -> Ty3
subDictTy Map Var Var
arMap Ty3
funRetTy
      [Ty3]
_ <- ((Ty3, Ty3) -> TcM Ty3 Exp3)
-> [(Ty3, Ty3)] -> ExceptT (TCError Exp3) Identity [Ty3]
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 (\(Ty3
a,Ty3
b) -> Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
a Ty3
b) ([Ty3] -> [Ty3] -> [(Ty3, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty3]
subFunInTys [Ty3]
argTys)
      Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
subFunOutTy

    PrimAppE Prim Ty3
pr [Exp3]
es -> do
      -- Special case because we can't lookup the type of the function pointer
      let es' :: [Exp3]
es' = case Prim Ty3
pr of
                  VSortP{} -> [Exp3] -> [Exp3]
forall a. HasCallStack => [a] -> [a]
init [Exp3]
es
                  InplaceVSortP{} -> [Exp3] -> [Exp3]
forall a. HasCallStack => [a] -> [a]
init [Exp3]
es
                  Prim Ty3
_ -> [Exp3]
es
      [Ty3]
tys <- (Exp3 -> TcM Ty3 Exp3)
-> [Exp3] -> ExceptT (TCError Exp3) Identity [Ty3]
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 Exp3 -> TcM Ty3 Exp3
go [Exp3]
es'
      let len0 :: ExceptT (TCError Exp3) Identity ()
len0 = Exp3
-> Prim Ty3 -> Int -> [Exp3] -> ExceptT (TCError Exp3) Identity ()
forall op arg (e :: * -> * -> *).
(Out op, Out arg) =>
PreExp e () Ty3 -> op -> Int -> [arg] -> TcM () (PreExp e () Ty3)
checkLen Exp3
exp Prim Ty3
pr Int
0 [Exp3]
es
          len1 :: ExceptT (TCError Exp3) Identity ()
len1 = Exp3
-> Prim Ty3 -> Int -> [Exp3] -> ExceptT (TCError Exp3) Identity ()
forall op arg (e :: * -> * -> *).
(Out op, Out arg) =>
PreExp e () Ty3 -> op -> Int -> [arg] -> TcM () (PreExp e () Ty3)
checkLen Exp3
exp Prim Ty3
pr Int
1 [Exp3]
es
          len2 :: ExceptT (TCError Exp3) Identity ()
len2 = Exp3
-> Prim Ty3 -> Int -> [Exp3] -> ExceptT (TCError Exp3) Identity ()
forall op arg (e :: * -> * -> *).
(Out op, Out arg) =>
PreExp e () Ty3 -> op -> Int -> [arg] -> TcM () (PreExp e () Ty3)
checkLen Exp3
exp Prim Ty3
pr Int
2 [Exp3]
es
          len3 :: ExceptT (TCError Exp3) Identity ()
len3 = Exp3
-> Prim Ty3 -> Int -> [Exp3] -> ExceptT (TCError Exp3) Identity ()
forall op arg (e :: * -> * -> *).
(Out op, Out arg) =>
PreExp e () Ty3 -> op -> Int -> [arg] -> TcM () (PreExp e () Ty3)
checkLen Exp3
exp Prim Ty3
pr Int
3 [Exp3]
es
          len4 :: ExceptT (TCError Exp3) Identity ()
len4 = Exp3
-> Prim Ty3 -> Int -> [Exp3] -> ExceptT (TCError Exp3) Identity ()
forall op arg (e :: * -> * -> *).
(Out op, Out arg) =>
PreExp e () Ty3 -> op -> Int -> [arg] -> TcM () (PreExp e () Ty3)
checkLen Exp3
exp Prim Ty3
pr Int
4 [Exp3]
es

          mk_bools :: TcM Ty3 Exp3
mk_bools = do
            ExceptT (TCError Exp3) Identity ()
len0
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

          bool_ops :: TcM Ty3 Exp3
bool_ops = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
BoolTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
BoolTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

          int_ops :: TcM Ty3 Exp3
int_ops = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
IntTy

          float_ops :: TcM Ty3 Exp3
float_ops = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
FloatTy

          int_cmps :: TcM Ty3 Exp3
int_cmps = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

          float_cmps :: TcM Ty3 Exp3
float_cmps = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

          char_cmps :: TcM Ty3 Exp3
char_cmps = do
            ExceptT (TCError Exp3) Identity ()
len2
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
CharTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
            Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
CharTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
            Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

      case Prim Ty3
pr of
        Prim Ty3
MkTrue  -> TcM Ty3 Exp3
mk_bools
        Prim Ty3
MkFalse -> TcM Ty3 Exp3
mk_bools
        Prim Ty3
AddP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
SubP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
MulP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
DivP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
ModP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
ExpP    -> TcM Ty3 Exp3
int_ops
        Prim Ty3
FAddP   -> TcM Ty3 Exp3
float_ops
        Prim Ty3
FSubP   -> TcM Ty3 Exp3
float_ops
        Prim Ty3
FMulP   -> TcM Ty3 Exp3
float_ops
        Prim Ty3
FDivP   -> TcM Ty3 Exp3
float_ops
        Prim Ty3
FExpP   -> TcM Ty3 Exp3
float_ops
        Prim Ty3
EqIntP  -> TcM Ty3 Exp3
int_cmps
        Prim Ty3
LtP     -> TcM Ty3 Exp3
int_cmps
        Prim Ty3
GtP     -> TcM Ty3 Exp3
int_cmps
        Prim Ty3
LtEqP   -> TcM Ty3 Exp3
int_cmps
        Prim Ty3
GtEqP   -> TcM Ty3 Exp3
int_cmps
        Prim Ty3
EqFloatP -> TcM Ty3 Exp3
float_cmps
        Prim Ty3
EqCharP  -> TcM Ty3 Exp3
char_cmps
        Prim Ty3
FLtP     -> TcM Ty3 Exp3
float_cmps
        Prim Ty3
FGtP     -> TcM Ty3 Exp3
float_cmps
        Prim Ty3
FLtEqP   -> TcM Ty3 Exp3
float_cmps
        Prim Ty3
FGtEqP   -> TcM Ty3 Exp3
float_cmps
        Prim Ty3
OrP     -> TcM Ty3 Exp3
bool_ops
        Prim Ty3
AndP    -> TcM Ty3 Exp3
bool_ops

        Prim Ty3
Gensym -> ExceptT (TCError Exp3) Identity ()
len0 ExceptT (TCError Exp3) Identity ()
-> (() -> TcM Ty3 Exp3) -> TcM Ty3 Exp3
forall a b.
ExceptT (TCError Exp3) Identity a
-> (a -> ExceptT (TCError Exp3) Identity b)
-> ExceptT (TCError Exp3) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
_ -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
SymTy

        Prim Ty3
EqSymP -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
BoolTy

        EqBenchProgP [Char]
_ -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
BoolTy

        Prim Ty3
RandP -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy
        Prim Ty3
FRandP-> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
FloatTy
        Prim Ty3
FSqrtP -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
FloatTy

        Prim Ty3
FTanP -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
FloatTy

        Prim Ty3
FloatToIntP -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        Prim Ty3
IntToFloatP -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
FloatTy

        Prim Ty3
SizeParam -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        Prim Ty3
IsBig -> do
          ExceptT (TCError Exp3) Identity ()
len2
          let [Ty3
ity, Ty3
ety] = [Ty3]
tys
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
ity Ty3
forall loc. UrTy loc
IntTy
          Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
ety Ty3
forall loc. UrTy loc
CursorTy
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
BoolTy

        Prim Ty3
PrintInt -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Prim Ty3
PrintChar -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
CharTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Prim Ty3
PrintFloat -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
FloatTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Prim Ty3
PrintBool -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
BoolTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Prim Ty3
PrintSym -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        Prim Ty3
ReadInt -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        Prim Ty3
SymSetEmpty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymSetTy

        Prim Ty3
SymSetInsert -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymSetTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymSetTy

        Prim Ty3
SymSetContains -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymSetTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
BoolTy

        Prim Ty3
SymHashEmpty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymHashTy

        Prim Ty3
SymHashInsert -> do
          ExceptT (TCError Exp3) Identity ()
len3
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymHashTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymHashTy

        Prim Ty3
SymHashLookup -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymHashTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
SymTy

        Prim Ty3
SymHashContains -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
SymHashTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
BoolTy

        DictEmptyP Ty3
_ty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          let [Ty3
a] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
ArenaTy Ty3
a
          let (VarE Var
var) = [Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty3 -> Ty3
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
var) Ty3
forall loc. UrTy loc
CursorTy

        DictInsertP Ty3
_ty -> do
          ExceptT (TCError Exp3) Identity ()
len4
          let [Ty3
a,Ty3
_d,Ty3
k,Ty3
v] = [Ty3]
tys
          let (VarE Var
var) = [Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
ArenaTy Ty3
a
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
SymTy Ty3
k
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
CursorTy Ty3
v
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty3 -> Ty3
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
var) Ty3
forall loc. UrTy loc
CursorTy

        DictLookupP Ty3
_ty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          let [Ty3
_d,Ty3
k] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
SymTy Ty3
k
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy

        DictHasKeyP Ty3
_ty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          let [Ty3
_d,Ty3
k] = [Ty3]
tys
          -- _ <- ensureEqualTyNoLoc exp (SymDictTy ty) d
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
forall loc. UrTy loc
SymTy Ty3
k
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
BoolTy

        ErrorP [Char]
_str Ty3
ty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
ty

        ReadPackedFile Maybe [Char]
_fp [Char]
_tycon Maybe Var
_reg Ty3
ty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          if Bool
isPacked
          then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
          else Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
ty

        WritePackedFile [Char]
_ Ty3
ty
           | PackedTy{} <- Ty3
ty  -> do
             ExceptT (TCError Exp3) Identity ()
len1
             let [Ty3
packed_ty] = [Ty3]
tys
             Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
packed_ty Ty3
ty
             Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])
           | Bool
otherwise -> [Char] -> TcM Ty3 Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> TcM Ty3 Exp3) -> [Char] -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"writePackedFile expects a packed type. Given" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
ty

        ReadArrayFile Maybe ([Char], Int)
_ Ty3
ty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          if Ty3 -> Bool
forall a. UrTy a -> Bool
isValidListElemTy Ty3
ty
          then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
ty)
          else TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
"Not a valid list type" Exp3
exp

        Prim Ty3
RequestSizeOf -> [Char] -> TcM Ty3 Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"RequestSizeOf shouldn't occur in a L3 program."

        VAllocP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntTy Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)

        VFreeP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        VFree2P Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        VLengthP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ls] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
IntTy

        VNthP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ls, Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
IntTy Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
elty

        VSliceP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len3
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
from,Ty3
to,Ty3
ls] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntTy Ty3
from
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
IntTy Ty3
to
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)

        InplaceVUpdateP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len3
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ls,Ty3
i,Ty3
x] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
IntTy Ty3
i
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) Ty3
elty Ty3
x
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)

        VConcatP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ls] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)) Ty3
ls
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)

        -- Given that the first argument is a list of type (VectorTy t),
        -- ensure that the 2nd argument is function reference of type:
        -- ty -> ty -> IntTy
        VSortP Ty3
elty ->
          case ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) of
            VarE Var
f -> do
              ExceptT (TCError Exp3) Identity ()
len2
              let [Ty3
ls] = [Ty3]
tys
                  fn_ty :: ArrowTy Ty3
fn_ty@([Ty3]
in_tys, Ty3
ret_ty) = Var -> Env2 Ty3 -> ArrowTy Ty3
forall a. Out (ArrowTy a) => Var -> Env2 a -> ArrowTy a
lookupFEnv Var
f Env2 Ty3
env
                  err :: ([Ty3], Ty3) -> TcM Ty3 Exp3
err ([Ty3], Ty3)
x = TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"vsort: Expected a sort function of type (ty -> ty -> Bool). Got"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Ty3], Ty3) -> [Char]
forall a. Out a => a -> [Char]
sdoc ([Ty3], Ty3)
x) Exp3
exp
              Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls
              case [Ty3]
in_tys of
                [Ty3
a,Ty3
b] -> do
                   Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
a Ty3
elty
                   Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
b Ty3
elty
                   Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
ret_ty Ty3
forall loc. UrTy loc
IntTy
                   Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)
                [Ty3]
_ -> ([Ty3], Ty3) -> TcM Ty3 Exp3
err ([Ty3], Ty3)
ArrowTy Ty3
fn_ty
            Exp3
oth -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"vsort: function pointer has to be a variable reference. Got"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
oth) Exp3
exp

        InplaceVSortP Ty3
elty -> Exp3 -> TcM Ty3 Exp3
go (Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
VSortP Ty3
elty) [Exp3]
es)

        VMergeP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ls1,Ty3
ls2] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls1
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty) Ty3
ls2
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
VectorTy Ty3
elty)

        PDictInsertP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len3
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          let [Ty3
key, Ty3
val, Ty3
dict] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
key Ty3
kty
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
val Ty3
vty
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) Ty3
dict (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)

        PDictLookupP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          let [Ty3
key, Ty3
dict] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
key Ty3
kty
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
dict (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3
vty)

        PDictAllocP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)

        PDictHasKeyP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          let [Ty3
key, Ty3
dict] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
key Ty3
kty
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
dict (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3
forall loc. UrTy loc
BoolTy)

        PDictForkP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          let [Ty3
dict] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
dict (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty, Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty])

        PDictJoinP Ty3
kty Ty3
vty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
kty
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
vty
          let [Ty3
dict1, Ty3
dict2] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
dict1 (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
dict2 (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy Ty3
kty Ty3
vty)

        LLAllocP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)

        LLIsEmptyP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ll] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
ll (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3
forall loc. UrTy loc
BoolTy)

        LLConsP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
elt, Ty3
ll] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
elt Ty3
elty
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
ll (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)

        LLHeadP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ll] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
ll (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3
elty)

        LLTailP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
ll] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
ll (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)

        LLFreeP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty) Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        LLFree2P Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty) Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [])

        LLCopyP Ty3
elty -> do
          ExceptT (TCError Exp3) Identity ()
len1
          Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
elty
          let [Ty3
i] = [Ty3]
tys
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty) Ty3
i
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
ListTy Ty3
elty)

        Prim Ty3
GetNumProcessors -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
IntTy

        Prim Ty3
IntHashEmpty -> do
          ExceptT (TCError Exp3) Identity ()
len0
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntHashTy

        Prim Ty3
IntHashInsert -> do
          ExceptT (TCError Exp3) Identity ()
len3
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntHashTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) Ty3
forall loc. UrTy loc
IntTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
2)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntHashTy

        Prim Ty3
IntHashLookup -> do
          ExceptT (TCError Exp3) Identity ()
len2
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0) Ty3
forall loc. UrTy loc
IntHashTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy ([Exp3]
es [Exp3] -> Int -> Exp3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) Ty3
forall loc. UrTy loc
SymTy ([Ty3]
tys [Ty3] -> Int -> Ty3
forall a. HasCallStack => [a] -> Int -> a
!! Int
1)
          Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
IntTy

        Write3dPpmFile{} -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
"Write3dPpmFile not handled yet" Exp3
exp

        RequestEndOf{} -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
"RequestEndOf not handled yet" Exp3
exp


    LetE (Var
v,[],SymDictTy Maybe Var
_ Ty3
_pty, Exp3
rhs) Exp3
e -> do
      Ty3
tyRhs <- Exp3 -> TcM Ty3 Exp3
go Exp3
rhs
      case Ty3
tyRhs of
        SymDictTy Maybe Var
ar Ty3
_ ->
            do  Bool
-> ExceptT (TCError Exp3) Identity ()
-> ExceptT (TCError Exp3) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Var -> Bool
forall a. Maybe a -> Bool
isJust Maybe Var
ar) (ExceptT (TCError Exp3) Identity ()
 -> ExceptT (TCError Exp3) Identity ())
-> ExceptT (TCError Exp3) Identity ()
-> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
"Expected arena variable annotation" Exp3
rhs
                let env' :: Env2 Ty3
env' = Env2 Ty3 -> [(Var, Ty3)] -> Env2 Ty3
forall l. Env2 (UrTy l) -> [(Var, UrTy l)] -> Env2 (UrTy l)
extendEnv Env2 Ty3
env [(Var
v,Maybe Var -> Ty3 -> Ty3
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
ar Ty3
forall loc. UrTy loc
CursorTy)]
                Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env' Exp3
e
        Ty3
_ -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Expected expression to be SymDict type:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
rhs) Exp3
exp

    LetE (Var
v,[()]
locs,Ty3
ty,Exp3
rhs) Exp3
e -> do
      -- Check that the expression does not have any locations
      case [()]
locs of
        [] -> () -> ExceptT (TCError Exp3) Identity ()
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [()]
_  -> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Expected the locations to be empty in L1. Got"
                                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [()] -> [Char]
forall a. Out a => a -> [Char]
sdoc [()]
locs)
                           Exp3
exp
      -- Check RHS
      Ty3
tyRhs <- Exp3 -> TcM Ty3 Exp3
go Exp3
rhs
      Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
tyRhs Ty3
ty
      let env' :: Env2 Ty3
env' = Env2 Ty3 -> [(Var, Ty3)] -> Env2 Ty3
forall l. Env2 (UrTy l) -> [(Var, UrTy l)] -> Env2 (UrTy l)
extendEnv Env2 Ty3
env [(Var
v,Ty3
ty)]
      -- Check body
      Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env' Exp3
e

    IfE Exp3
tst Exp3
consq Exp3
alt -> do
      -- Check if the test is a boolean
      Ty3
tyTst <- Exp3 -> TcM Ty3 Exp3
go Exp3
tst
      Ty3
_ <- Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
tyTst Ty3
forall loc. UrTy loc
BoolTy

      -- Check if both branches match
      Ty3
tyConsq <- Exp3 -> TcM Ty3 Exp3
go Exp3
consq
      Ty3
tyAlt   <- Exp3 -> TcM Ty3 Exp3
go Exp3
alt

      -- _ <- ensureEqualTyModCursor exp tyConsq tyAlt
      -- if tyConsq == tyAlt
      -- then return tyConsq
      -- else throwError $ GenericTC ("If branches have mismatched types:"
      --                              ++ sdoc tyConsq ++ ", " ++ sdoc tyAlt) exp
      Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
tyConsq Ty3
tyAlt

    MkProdE [] -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy []

    MkProdE [Exp3]
es -> do
      [Ty3]
tys <- (Exp3 -> TcM Ty3 Exp3)
-> [Exp3] -> ExceptT (TCError Exp3) Identity [Ty3]
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 Exp3 -> TcM Ty3 Exp3
go [Exp3]
es
      Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3]
tys

    ProjE Int
i Exp3
e -> do
      Ty3
ty  <- Exp3 -> TcM Ty3 Exp3
go Exp3
e
      Ty3
tyi <- Exp3 -> Int -> Ty3 -> TcM Ty3 Exp3
forall l (e :: * -> * -> *).
Out l =>
PreExp e () Ty3 -> Int -> UrTy l -> TcM (UrTy l) (PreExp e () Ty3)
tcProj Exp3
exp Int
i Ty3
ty
      Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
tyi

    CaseE Exp3
e [([Char], [(Var, ())], Exp3)]
cs -> do
      Ty3
tye  <- Exp3 -> TcM Ty3 Exp3
go Exp3
e
      let tycons :: [[Char]]
tycons = (([Char], [(Var, ())], Exp3) -> [Char])
-> [([Char], [(Var, ())], Exp3)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
L.map (DDefs3 -> [Char] -> [Char]
forall a. Out a => DDefs a -> [Char] -> [Char]
getTyOfDataCon DDefs3
ddfs ([Char] -> [Char])
-> (([Char], [(Var, ())], Exp3) -> [Char])
-> ([Char], [(Var, ())], Exp3)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Char]
a,[(Var, ())]
_,Exp3
_) -> [Char]
a)) [([Char], [(Var, ())], Exp3)]
cs
      case [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
L.nub [[Char]]
tycons of
        [[Char]
_one] -> do
          Bool
-> ExceptT (TCError Exp3) Identity ()
-> ExceptT (TCError Exp3) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ty3
tye Ty3 -> Ty3 -> Bool
forall a. Eq a => a -> a -> Bool
/= Ty3
forall loc. UrTy loc
CursorTy Bool -> Bool -> Bool
&& Bool -> Bool
not (Ty3 -> Bool
forall a. UrTy a -> Bool
isPackedTy Ty3
tye)) (ExceptT (TCError Exp3) Identity ()
 -> ExceptT (TCError Exp3) Identity ())
-> ExceptT (TCError Exp3) Identity ()
-> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$
            TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Case scrutinee should be packed, or have a cursor type. Got"
                                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
tye) Exp3
e
          Bool
-> DDefs3
-> Env2 Ty3
-> [([Char], [(Var, ())], Exp3)]
-> TcM Ty3 Exp3
tcCases Bool
isPacked DDefs3
ddfs Env2 Ty3
env [([Char], [(Var, ())], Exp3)]
cs
        [[Char]]
oth   -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Case branches have mismatched types: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Out a => a -> [Char]
sdoc [[Char]]
oth
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" , in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
exp) Exp3
exp

    DataConE ()
loc [Char]
dc [Exp3]
es -> do
      [Ty3]
tys <- (Exp3 -> TcM Ty3 Exp3)
-> [Exp3] -> ExceptT (TCError Exp3) Identity [Ty3]
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 Exp3 -> TcM Ty3 Exp3
go [Exp3]
es
      let dcTy :: [Char]
dcTy = DDefs3 -> [Char] -> [Char]
forall a. Out a => DDefs a -> [Char] -> [Char]
getTyOfDataCon DDefs3
ddfs [Char]
dc
          args :: [Ty3]
args = DDefs3 -> [Char] -> [Ty3]
forall a. Out a => DDefs a -> [Char] -> [a]
lookupDataCon DDefs3
ddfs [Char]
dc
      if [Ty3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ty3]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Exp3] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp3]
es
      then TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Invalid argument length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Exp3] -> [Char]
forall a. Out a => a -> [Char]
sdoc [Exp3]
es) Exp3
exp
      else do
        -- Check if arguments match with expected datacon types
        [TcM Ty3 Exp3] -> ExceptT (TCError Exp3) Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
e Ty3
ty1 Ty3
ty2
                  | (Ty3
ty1,Ty3
ty2,Exp3
e) <- [Ty3] -> [Ty3] -> [Exp3] -> [(Ty3, Ty3, Exp3)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Ty3]
args [Ty3]
tys [Exp3]
es]
        Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> () -> Ty3
forall loc. [Char] -> loc -> UrTy loc
PackedTy [Char]
dcTy ()
loc

    TimeIt Exp3
e Ty3
_ty Bool
_b -> do
      -- Before flatten, _ty is always (PackedTy "DUMMY_TY" ())
      -- enforce ty == _ty in strict mode ?
      Ty3
ty <- Exp3 -> TcM Ty3 Exp3
go Exp3
e
      Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
ty

    SpawnE Var
fn [()]
locs [Exp3]
args -> Exp3 -> TcM Ty3 Exp3
go (Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [()]
locs [Exp3]
args)
    Exp3
SyncE -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty3
forall loc. UrTy loc
voidTy

    WithArenaE Var
v Exp3
e -> do
      let env' :: Env2 Ty3
env' = Var -> Ty3 -> Env2 Ty3 -> Env2 Ty3
forall a. Var -> a -> Env2 a -> Env2 a
extendVEnv Var
v Ty3
forall loc. UrTy loc
ArenaTy Env2 Ty3
env
      Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env' Exp3
e

    MapE{}  -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ Exp3 -> TCError Exp3
forall exp. exp -> TCError exp
UnsupportedExpTC Exp3
exp
    FoldE{} -> TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ Exp3 -> TCError Exp3
forall exp. exp -> TCError exp
UnsupportedExpTC Exp3
exp

    -- oth -> error $ "L1.tcExp : TODO " ++ sdoc oth

  where
    go :: Exp3 -> TcM Ty3 Exp3
go = Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env
    checkListElemTy :: Ty3 -> ExceptT (TCError Exp3) Identity ()
checkListElemTy Ty3
el_ty =
      if Ty3 -> Bool
forall a. UrTy a -> Bool
isValidListElemTy Ty3
el_ty
      then () -> ExceptT (TCError Exp3) Identity ()
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      else TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> ExceptT (TCError Exp3) Identity ())
-> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC ([Char]
"Gibbon-TODO: Lists of only scalars or flat products of scalars are allowed. Got" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
el_ty) Exp3
exp


-- | Typecheck a L1 program
--
tcProg :: Bool -> Prog3 -> PassM Prog3
tcProg :: Bool -> Prog3 -> PassM Prog3
tcProg Bool
isPacked prg :: Prog3
prg@Prog{DDefs (TyOf Exp3)
ddefs :: DDefs (TyOf Exp3)
ddefs :: forall ex. Prog ex -> DDefs (TyOf ex)
ddefs,FunDefs Exp3
fundefs :: FunDefs Exp3
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs,Maybe (Exp3, TyOf Exp3)
mainExp :: Maybe (Exp3, TyOf Exp3)
mainExp :: forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp} = do

  -- Handle functions
  (FunDef Exp3 -> PassM ()) -> [FunDef Exp3] -> PassM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FunDef Exp3 -> PassM ()
fd ([FunDef Exp3] -> PassM ()) -> [FunDef Exp3] -> PassM ()
forall a b. (a -> b) -> a -> b
$ FunDefs Exp3 -> [FunDef Exp3]
forall k a. Map k a -> [a]
M.elems FunDefs Exp3
fundefs

  -- Handle main expression
  -- We don't change the type of mainExp to have cursors. So if it's type was `Packed`,
  -- it's still Packed, while the expression actually has type CursorTy.
  -- They're essentially the same.
  case Maybe (Exp3, TyOf Exp3)
mainExp of
    Maybe (Exp3, TyOf Exp3)
Nothing -> () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Exp3
e,TyOf Exp3
ty)  ->
      let res :: Either (TCError Exp3) Ty3
res = TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3
forall e a. Except e a -> Either e a
runExcept (TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3)
-> TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3
forall a b. (a -> b) -> a -> b
$ Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs (TyOf Exp3)
DDefs3
ddefs Env2 (TyOf Exp3)
Env2 Ty3
env Exp3
e
      in case Either (TCError Exp3) Ty3
res of
        Left TCError Exp3
err -> [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ TCError Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc TCError Exp3
err
        Right Ty3
ty' -> if Ty3 -> Ty3 -> Bool
forall {loc}. Eq loc => UrTy loc -> UrTy loc -> Bool
tyEq TyOf Exp3
Ty3
ty Ty3
ty'
                     then () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     else [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc TyOf Exp3
Ty3
ty [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"and got type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
ty'

  -- Identity function for now.
  Prog3 -> PassM Prog3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Prog3
prg

  where
    env :: Env2 (TyOf Exp3)
env = Prog3 -> Env2 (TyOf Exp3)
forall a. Prog a -> Env2 (TyOf a)
progToEnv Prog3
prg
    tyEq :: UrTy loc -> UrTy loc -> Bool
tyEq UrTy loc
CursorTy PackedTy{} = Bool
True
    tyEq PackedTy{} UrTy loc
CursorTy = Bool
True
    tyEq UrTy loc
ty1 UrTy loc
ty2 =
      case UrTy loc
ty1 of
        PackedTy{}  -> UrTy loc
ty2 UrTy loc -> UrTy loc -> Bool
forall a. Eq a => a -> a -> Bool
== [UrTy loc] -> UrTy loc
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy loc
forall loc. UrTy loc
CursorTy,UrTy loc
forall loc. UrTy loc
CursorTy] Bool -> Bool -> Bool
|| UrTy loc
ty1 UrTy loc -> UrTy loc -> Bool
forall a. Eq a => a -> a -> Bool
== UrTy loc
ty2
        ProdTy [UrTy loc]
tys2 -> let ProdTy [UrTy loc]
tys1 = UrTy loc
ty1
                       in  ((UrTy loc, UrTy loc) -> Bool) -> [(UrTy loc, UrTy loc)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(UrTy loc
a,UrTy loc
b) -> UrTy loc -> UrTy loc -> Bool
tyEq UrTy loc
a UrTy loc
b) ([UrTy loc] -> [UrTy loc] -> [(UrTy loc, UrTy loc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UrTy loc]
tys1 [UrTy loc]
tys2)
        UrTy loc
_ -> UrTy loc
ty1 UrTy loc -> UrTy loc -> Bool
forall a. Eq a => a -> a -> Bool
== UrTy loc
ty2

    -- fd :: forall e l . FunDef Ty1 Exp -> PassM ()
    fd :: FunDef Exp3 -> PassM ()
fd FunDef{[Var]
funArgs :: [Var]
funArgs :: forall ex. FunDef ex -> [Var]
funArgs,ArrowTy (TyOf Exp3)
funTy :: ArrowTy (TyOf Exp3)
funTy :: forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy,Exp3
funBody :: Exp3
funBody :: forall ex. FunDef ex -> ex
funBody} = do
      let ([Ty3]
intys, Ty3
outty) = ArrowTy (TyOf Exp3)
funTy
          venv :: Map Var Ty3
venv = [(Var, Ty3)] -> Map Var Ty3
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Ty3] -> [(Var, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
funArgs [Ty3]
intys)
          env' :: Env2 Ty3
env' = Map Var Ty3 -> TyEnv (ArrowTy Ty3) -> Env2 Ty3
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 Map Var Ty3
venv (Env2 Ty3 -> TyEnv (ArrowTy Ty3)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 (TyOf Exp3)
Env2 Ty3
env)
          res :: Either (TCError Exp3) Ty3
res = TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3
forall e a. Except e a -> Either e a
runExcept (TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3)
-> TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3
forall a b. (a -> b) -> a -> b
$ Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs (TyOf Exp3)
DDefs3
ddefs Env2 Ty3
env' Exp3
funBody
      case Either (TCError Exp3) Ty3
res of
        Left TCError Exp3
err -> [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ TCError Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc TCError Exp3
err
        Right Ty3
ty -> if Ty3
ty Ty3 -> Ty3 -> Bool
`compareModCursor` Ty3
outty
                    then () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    else [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
outty)
                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and got type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
ty) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
funBody)

      () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


tcCases :: Bool -> DDefs3 -> Env2 Ty3 -> [(DataCon, [(Var, ())], Exp3)] -> TcM Ty3 (Exp3)
tcCases :: Bool
-> DDefs3
-> Env2 Ty3
-> [([Char], [(Var, ())], Exp3)]
-> TcM Ty3 Exp3
tcCases Bool
isPacked DDefs3
ddfs Env2 Ty3
env [([Char], [(Var, ())], Exp3)]
cs = do
  [Ty3]
tys <- [([Char], [(Var, ())], Exp3)]
-> (([Char], [(Var, ())], Exp3) -> TcM Ty3 Exp3)
-> ExceptT (TCError Exp3) Identity [Ty3]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Char], [(Var, ())], Exp3)]
cs ((([Char], [(Var, ())], Exp3) -> TcM Ty3 Exp3)
 -> ExceptT (TCError Exp3) Identity [Ty3])
-> (([Char], [(Var, ())], Exp3) -> TcM Ty3 Exp3)
-> ExceptT (TCError Exp3) Identity [Ty3]
forall a b. (a -> b) -> a -> b
$ \([Char]
c,[(Var, ())]
args',Exp3
rhs) -> do
           let args :: [Var]
args  = ((Var, ()) -> Var) -> [(Var, ())] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (Var, ()) -> Var
forall a b. (a, b) -> a
fst [(Var, ())]
args'
               targs :: [Ty3]
targs = (Ty3 -> Ty3) -> [Ty3] -> [Ty3]
forall a b. (a -> b) -> [a] -> [b]
map Ty3 -> Ty3
packedToCursor ([Ty3] -> [Ty3]) -> [Ty3] -> [Ty3]
forall a b. (a -> b) -> a -> b
$ DDefs3 -> [Char] -> [Ty3]
forall a. Out a => DDefs a -> [Char] -> [a]
lookupDataCon DDefs3
ddfs [Char]
c
               env' :: Env2 Ty3
env'  = Env2 Ty3 -> [(Var, Ty3)] -> Env2 Ty3
forall l. Env2 (UrTy l) -> [(Var, UrTy l)] -> Env2 (UrTy l)
extendEnv Env2 Ty3
env ([Var] -> [Ty3] -> [(Var, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args [Ty3]
targs)
           Bool -> DDefs3 -> Env2 Ty3 -> Exp3 -> TcM Ty3 Exp3
tcExp Bool
isPacked DDefs3
ddfs Env2 Ty3
env' Exp3
rhs
  (Ty3 -> (Exp3, Ty3) -> TcM Ty3 Exp3)
-> Ty3 -> [(Exp3, Ty3)] -> ExceptT (TCError Exp3) Identity ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (\Ty3
acc (Exp3
ex,Ty3
ty) -> Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
ex Ty3
ty Ty3
acc)
            -- if ty == acc
            -- then return acc
            -- else throwError $ GenericTC ("Case branches have mismatched types: "
            --                              ++ sdoc acc ++ ", " ++ sdoc ty) ex)
         ([Ty3] -> Ty3
forall a. HasCallStack => [a] -> a
head [Ty3]
tys) ((Ty3 -> ([Char], [(Var, ())], Exp3) -> (Exp3, Ty3))
-> [Ty3] -> [([Char], [(Var, ())], Exp3)] -> [(Exp3, Ty3)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ty3
ty ([Char]
_,[(Var, ())]
_,Exp3
ex) -> (Exp3
ex,Ty3
ty)) [Ty3]
tys [([Char], [(Var, ())], Exp3)]
cs)
  Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Ty3] -> Ty3
forall a. HasCallStack => [a] -> a
head [Ty3]
tys

-- | Ensure that two things are equal.
-- Includes an expression for error reporting.
ensureEqual :: Exp3 -> String -> Ty3 -> Ty3 -> TcM Ty3 (Exp3)
ensureEqual :: Exp3 -> [Char] -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqual Exp3
exp [Char]
str (SymDictTy Maybe Var
ar1 Ty3
_) (SymDictTy Maybe Var
ar2 Ty3
_) =
    if Maybe Var
ar1 Maybe Var -> Maybe Var -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Var
ar2
    then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> TcM Ty3 Exp3) -> Ty3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty3 -> Ty3
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
ar1 Ty3
forall loc. UrTy loc
CursorTy
    else TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
str Exp3
exp
ensureEqual Exp3
exp [Char]
str Ty3
a Ty3
b = if Ty3
a Ty3 -> Ty3 -> Bool
forall a. Eq a => a -> a -> Bool
== Ty3
b
                          then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
a
                          else TCError Exp3 -> TcM Ty3 Exp3
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError Exp3 -> TcM Ty3 Exp3) -> TCError Exp3 -> TcM Ty3 Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp3 -> TCError Exp3
forall exp. [Char] -> exp -> TCError exp
GenericTC [Char]
str Exp3
exp


-- | Ensure that two types are equal.
-- Includes an expression for error reporting.
ensureEqualTy :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 (Exp3)
ensureEqualTy :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
a Ty3
b = Exp3 -> [Char] -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqual Exp3
exp ([Char]
"Expected these types to be the same: "
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" <> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Ty3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Ty3
b)) Ty3
a Ty3
b

ensureEqualTyModCursor :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 (Exp3)
ensureEqualTyModCursor :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
_exp Ty3
CursorTy (PackedTy [Char]
_ ()
_) = Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
ensureEqualTyModCursor Exp3
_exp (PackedTy [Char]
_ ()
_) Ty3
CursorTy = Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
ensureEqualTyModCursor Exp3
_exp Ty3
IntTy Ty3
CursorTy = Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
ensureEqualTyModCursor Exp3
_exp Ty3
CursorTy Ty3
IntTy = Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
forall loc. UrTy loc
CursorTy
ensureEqualTyModCursor Exp3
exp (ProdTy [Ty3]
ls1) (ProdTy [Ty3]
ls2) =
  [TcM Ty3 Exp3] -> ExceptT (TCError Exp3) Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyModCursor Exp3
exp Ty3
ty1 Ty3
ty2 | (Ty3
ty1,Ty3
ty2) <- [Ty3] -> [Ty3] -> [(Ty3, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty3]
ls1 [Ty3]
ls2] ExceptT (TCError Exp3) Identity ()
-> (() -> TcM Ty3 Exp3) -> TcM Ty3 Exp3
forall a b.
ExceptT (TCError Exp3) Identity a
-> (a -> ExceptT (TCError Exp3) Identity b)
-> ExceptT (TCError Exp3) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \()
_ -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty3 -> Ty3
packedToCursor ([Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3]
ls1))
ensureEqualTyModCursor Exp3
exp Ty3
a Ty3
b = Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
a Ty3
b

packedToCursor :: Ty3 -> Ty3
packedToCursor :: Ty3 -> Ty3
packedToCursor (PackedTy [Char]
_ ()
_) = Ty3
forall loc. UrTy loc
CursorTy
packedToCursor (ProdTy [Ty3]
tys) = [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([Ty3] -> Ty3) -> [Ty3] -> Ty3
forall a b. (a -> b) -> a -> b
$ (Ty3 -> Ty3) -> [Ty3] -> [Ty3]
forall a b. (a -> b) -> [a] -> [b]
map Ty3 -> Ty3
packedToCursor [Ty3]
tys
packedToCursor Ty3
ty = Ty3
ty

compareModCursor :: Ty3 -> Ty3 -> Bool
compareModCursor :: Ty3 -> Ty3 -> Bool
compareModCursor Ty3
CursorTy (PackedTy [Char]
_ ()
_) = Bool
True
compareModCursor (PackedTy [Char]
_ ()
_) Ty3
CursorTy = Bool
True
compareModCursor Ty3
ty1 Ty3
ty2 = Ty3
ty1 Ty3 -> Ty3 -> Bool
forall a. Eq a => a -> a -> Bool
== Ty3
ty2

ensureEqualTyNoLoc :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 (Exp3)
ensureEqualTyNoLoc :: Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyNoLoc Exp3
exp Ty3
t1 Ty3
t2 =
  case (Ty3
t1,Ty3
t2) of
    (SymDictTy Maybe Var
_ Ty3
_ty1, SymDictTy Maybe Var
_ Ty3
_ty2) -> Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
t1
        -- do ty1' <- L2.dummyTyLocs ty1
        --    ty2' <- L2.dummyTyLocs ty2
        --    ensureEqualTyNoLoc exp ty1' ty2'
    (PackedTy [Char]
dc1 ()
_, PackedTy [Char]
dc2 ()
_) -> if [Char]
dc1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
dc2
                                        then Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
t1
                                        else Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
t1 Ty3
t2
    (ProdTy [Ty3]
tys1, ProdTy [Ty3]
tys2) -> do
        [TcM Ty3 Exp3]
checks <- [TcM Ty3 Exp3] -> ExceptT (TCError Exp3) Identity [TcM Ty3 Exp3]
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([TcM Ty3 Exp3] -> ExceptT (TCError Exp3) Identity [TcM Ty3 Exp3])
-> [TcM Ty3 Exp3] -> ExceptT (TCError Exp3) Identity [TcM Ty3 Exp3]
forall a b. (a -> b) -> a -> b
$ ((Ty3, Ty3) -> TcM Ty3 Exp3) -> [(Ty3, Ty3)] -> [TcM Ty3 Exp3]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Ty3
ty1,Ty3
ty2) -> Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTyNoLoc Exp3
exp Ty3
ty1 Ty3
ty2) ([Ty3] -> [Ty3] -> [(Ty3, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty3]
tys1 [Ty3]
tys2)
        [TcM Ty3 Exp3]
-> (TcM Ty3 Exp3 -> ExceptT (TCError Exp3) Identity ())
-> ExceptT (TCError Exp3) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TcM Ty3 Exp3]
checks ((TcM Ty3 Exp3 -> ExceptT (TCError Exp3) Identity ())
 -> ExceptT (TCError Exp3) Identity ())
-> (TcM Ty3 Exp3 -> ExceptT (TCError Exp3) Identity ())
-> ExceptT (TCError Exp3) Identity ()
forall a b. (a -> b) -> a -> b
$ \TcM Ty3 Exp3
c -> do
            let c' :: Either (TCError Exp3) Ty3
c' = TcM Ty3 Exp3 -> Either (TCError Exp3) Ty3
forall e a. Except e a -> Either e a
runExcept TcM Ty3 Exp3
c
            case Either (TCError Exp3) Ty3
c' of
              Left TCError Exp3
err -> TCError Exp3 -> ExceptT (TCError Exp3) Identity ()
forall a. TCError Exp3 -> ExceptT (TCError Exp3) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError TCError Exp3
err
              Right Ty3
_  -> () -> ExceptT (TCError Exp3) Identity ()
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Ty3 -> TcM Ty3 Exp3
forall a. a -> ExceptT (TCError Exp3) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty3
t1
    (Ty3, Ty3)
_ -> Exp3 -> Ty3 -> Ty3 -> TcM Ty3 Exp3
ensureEqualTy Exp3
exp Ty3
t1 Ty3
t2