{-# LANGUAGE CPP
           , ScopedTypeVariables
           , GADTs
           , DataKinds
           , KindSignatures
           , GeneralizedNewtypeDeriving
           , TypeOperators
           , FlexibleContexts
           , FlexibleInstances
           , OverloadedStrings
           , PatternGuards
           , Rank2Types
           #-}

{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
----------------------------------------------------------------
--                                                    2016.05.28
-- |
-- Module      :  Language.Hakaru.Syntax.TypeCheck
-- Copyright   :  Copyright (c) 2016 the Hakaru team
-- License     :  BSD3
-- Maintainer  :  wren@community.haskell.org
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Bidirectional type checking for our AST.
----------------------------------------------------------------
module Language.Hakaru.Syntax.TypeCheck
    (
    -- * The type checking monad
      TypeCheckError
    , TypeCheckMonad(), runTCM, unTCM
    , TypeCheckMode(..)
    -- * Type checking itself
    , inferable
    , mustCheck
    , TypedAST(..)
    , onTypedAST, onTypedASTM, elimTypedAST
    , inferType
    , checkType
    ) where

import           Prelude hiding (id, (.))
import           Control.Category
import           Data.Proxy            (KProxy(..))
import           Data.Text             (pack, Text())
import           Data.Either           (partitionEithers)
import qualified Data.IntMap           as IM
import qualified Data.Traversable      as T
import qualified Data.List.NonEmpty    as L
import qualified Data.Foldable         as F
import qualified Data.Sequence         as S
import qualified Data.Vector           as V
#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative   (Applicative(..), (<$>))
import           Data.Monoid           (Monoid(..))
#endif
import qualified Language.Hakaru.Parser.AST as U

import Data.Number.Nat                (fromNat)
import Language.Hakaru.Syntax.TypeCheck.TypeCheckMonad
import Language.Hakaru.Syntax.TypeCheck.Unification
import Language.Hakaru.Syntax.IClasses
import Language.Hakaru.Types.DataKind (Hakaru(..), HData', HBool)
import Language.Hakaru.Types.Sing
import Language.Hakaru.Types.Coercion
import Language.Hakaru.Types.HClasses
    ( HEq, hEq_Sing, HOrd, hOrd_Sing, HSemiring, hSemiring_Sing
    , hRing_Sing, sing_HRing, hFractional_Sing, sing_HFractional
    , sing_NonNegative, hDiscrete_Sing
    , HIntegrable(..)
    , HRadical(..), HContinuous(..))
import Language.Hakaru.Syntax.ABT
import Language.Hakaru.Syntax.Datum
import Language.Hakaru.Syntax.Reducer
import Language.Hakaru.Syntax.AST
import Language.Hakaru.Syntax.AST.Sing
    (sing_Literal, sing_MeasureOp)
import Language.Hakaru.Pretty.Concrete (prettyType, prettyTypeT)
import Language.Hakaru.Syntax.TypeOf (typeOf)
import Language.Hakaru.Syntax.Prelude (triv)

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

-- | Those terms from which we can synthesize a unique type. We are
-- also allowed to check them, via the change-of-direction rule.
inferable :: U.AST -> Bool
inferable :: AST -> Bool
inferable = Bool -> Bool
not (Bool -> Bool) -> (AST -> Bool) -> AST -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AST -> Bool
mustCheck


-- | Those terms whose types must be checked analytically. We cannot
-- synthesize (unambiguous) types for these terms.
--
-- N.B., this function assumes we're in 'StrictMode'. If we're
-- actually in 'LaxMode' then a handful of AST nodes behave
-- differently: in particular, 'U.NaryOp_', 'U.Superpose', and
-- 'U.Case_'. In strict mode those cases can just infer one of their
-- arguments and then check the rest against the inferred type.
-- (For case-expressions, we must also check the scrutinee since
-- it's type cannot be unambiguously inferred from the patterns.)
-- Whereas in lax mode we must infer all arguments and then take
-- the lub of their types in order to know which coercions to
-- introduce.
mustCheck :: U.AST -> Bool
mustCheck :: AST -> Bool
mustCheck AST
e = AST
-> (Variable 'U -> Bool)
-> (Term (MetaABT SourceSpan Term) 'U -> Bool)
-> Bool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn AST
e (Bool -> Variable 'U -> Bool
forall a b. a -> b -> a
const Bool
False) Term (MetaABT SourceSpan Term) 'U -> Bool
go
    where
    go :: U.MetaTerm -> Bool
    go :: Term (MetaABT SourceSpan Term) 'U -> Bool
go (U.Lam_ SSing
_  U_ABT '[ 'U] 'U
e2)     = U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e2

    -- In general, applications don't require checking; we infer
    -- the first applicand to get the type of the second and of the
    -- result, then we check the second and return the result type.
    -- Thus, applications will only yield \"must check\" errors if
    -- the function does; but that's the responsability of the
    -- function term, not of the application term it's embedded
    -- within.
    --
    -- However, do note that the above only applies to lambda-defined
    -- functions, not to all \"function-like\" things. In particular,
    -- data constructors require checking (see the note below).
    go (U.App_ AST
_  AST
_)      = Bool
False

    -- We follow Dunfield & Pientka and \Pi\Sigma in inferring or
    -- checking depending on what the body requires. This is as
    -- opposed to the TLDI'05 paper, which always infers @e2@ but
    -- will check or infer the @e1@ depending on whether it has a
    -- type annotation or not.
    go (U.Let_ AST
_ U_ABT '[ 'U] 'U
e2)      = U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e2

    go (U.Ann_ SSing
_ AST
_)       = Bool
False
    go (U.CoerceTo_ Some2 Coercion
_ AST
_)  = Bool
False
    go (U.UnsafeTo_ Some2 Coercion
_ AST
_)  = Bool
False

    -- In general (according to Dunfield & Pientka), we should be
    -- able to infer the result of a fully saturated primop by
    -- looking up its type and then checking all the arguments.
    go (U.PrimOp_  PrimOp
_ [AST]
_)   = Bool
False
    go (U.ArrayOp_ ArrayOp
_ [AST]
es)  = (AST -> Bool) -> [AST] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all AST -> Bool
mustCheck [AST]
es

    -- In strict mode: if we can infer any of the arguments, then
    -- we can check all the rest at the same type.
    --
    -- BUG: in lax mode we must be able to infer all of them;
    -- otherwise we may not be able to take the lub of the types
    go (U.NaryOp_   NaryOp
_ [AST]
es) = (AST -> Bool) -> [AST] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all AST -> Bool
mustCheck [AST]
es
    go (U.Superpose_ NonEmpty (AST, AST)
pes) = ((AST, AST) -> Bool) -> NonEmpty (AST, AST) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (AST -> Bool
mustCheck (AST -> Bool) -> ((AST, AST) -> AST) -> (AST, AST) -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AST, AST) -> AST
forall a b. (a, b) -> b
snd) NonEmpty (AST, AST)
pes

    -- Our numeric literals aren't polymorphic, so we can infer
    -- them just fine. Or rather, according to our AST they aren't;
    -- in truth, they are in the surface language. Which is part
    -- of the reason for needing 'LaxMode'
    --
    -- TODO: correctly capture our surface-language semantics by
    -- always treating literals as if we're in 'LaxMode'.
    go (U.Literal_ Some1 Literal
_) = Bool
False

    -- I return true because most folks (neelk, Pfenning, Dunfield
    -- & Pientka) say all data constructors mustCheck. The main
    -- issue here is dealing with (polymorphic) sum types and phantom
    -- types, since these mean the term doesn't contain enough
    -- information for all the type indices. Even for record types,
    -- there's the additional issue of the term (perhaps) not giving
    -- enough information about the nominal type even if it does
    -- give enough info for the structural type.
    --
    -- Still, given those limitations, we should be able to infer
    -- a subset of data constructors which happen to avoid the
    -- problem areas. In particular, given that our surface syntax
    -- doesn't use the sum-of-products representation, we should
    -- be able to rely on symbol resolution to avoid the nominal
    -- typing issue. Thus, for non-empty arrays and non-phantom
    -- record types, we should be able to infer the whole type
    -- provided we can infer the various subterms.
    go (U.Pair_ AST
e1 AST
e2)      = AST -> Bool
mustCheck  AST
e1 Bool -> Bool -> Bool
&& AST -> Bool
mustCheck AST
e2
    go (U.Array_ AST
_ U_ABT '[ 'U] 'U
e1)      = U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e1
    go (U.ArrayLiteral_ [AST]
es) = (AST -> Bool) -> [AST] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all AST -> Bool
mustCheck [AST]
es
    go (U.Datum_ Datum (MetaABT SourceSpan Term)
_)         = Bool
True

    -- TODO: everyone says this, but it seems to me that if we can
    -- infer any of the branches (and check the rest to agree) then
    -- we should be able to infer the whole thing... Or maybe the
    -- problem is that the change-of-direction rule might send us
    -- down the wrong path?
    go (U.Case_ AST
_ [Branch_ (MetaABT SourceSpan Term)]
_)     = Bool
True

    go (U.Dirac_  AST
e1)        = AST -> Bool
mustCheck  AST
e1
    go (U.MBind_  AST
_   U_ABT '[ 'U] 'U
e2)    = U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e2
    go (U.Plate_  AST
_   U_ABT '[ 'U] 'U
e2)    = U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e2
    go (U.Chain_  AST
_   AST
e2 U_ABT '[ 'U] 'U
e3) = AST -> Bool
mustCheck  AST
e2 Bool -> Bool -> Bool
&& U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e3
    go (U.MeasureOp_ SomeOp MeasureOp
_ [AST]
_)    = Bool
False
    go (U.Integrate_  AST
_ AST
_ U_ABT '[ 'U] 'U
_) = Bool
False
    go (U.Summate_    AST
_ AST
_ U_ABT '[ 'U] 'U
_) = Bool
False
    go (U.Product_    AST
_ AST
_ U_ABT '[ 'U] 'U
_) = Bool
False
    go (U.Bucket_     AST
_ AST
_ Reducer xs (MetaABT SourceSpan Term) 'U
_) = Bool
False
    go Term (MetaABT SourceSpan Term) 'U
U.Reject_             = Bool
True
    go (U.Transform_ Transform as x
tr SArgs (MetaABT SourceSpan Term) as
es ) =
      case (Transform as x
tr, SArgs (MetaABT SourceSpan Term) as
es) of
        (Transform as x
Expect   , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu, U_ABT varsu 'U)
_ U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
        (Transform as x
Observe  , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu, U_ABT varsu 'U)
_ U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
        (Transform as x
MCMC     , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1 Bool -> Bool -> Bool
&& AST -> Bool
mustCheck U_ABT varsu 'U
AST
e2
        (Disint TransformImpl
_ , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
        (Transform as x
Simplify , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
        (Transform as x
Summarize, (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
        (Transform as x
Reparam  , (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End)
          -> AST -> Bool
mustCheck U_ABT varsu 'U
AST
e1
    go U.InjTyped{}          = Bool
False

mustCheck'
    :: MetaABT U.SourceSpan U.Term '[ 'U.U ] 'U.U
    -> Bool
mustCheck' :: U_ABT '[ 'U] 'U -> Bool
mustCheck' U_ABT '[ 'U] 'U
e = U_ABT '[ 'U] 'U -> (Variable 'U -> AST -> Bool) -> Bool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e ((Variable 'U -> AST -> Bool) -> Bool)
-> (Variable 'U -> AST -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \Variable 'U
_ AST
e' -> AST -> Bool
mustCheck AST
e'

inferBinder
    :: (ABT Term abt)
    => Sing a
    -> MetaABT U.SourceSpan U.Term '[ 'U.U ] 'U.U
    -> (forall b. Sing b -> abt '[ a ] b -> TypeCheckMonad r)
    -> TypeCheckMonad r
inferBinder :: Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing a
typ U_ABT '[ 'U] 'U
e forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r
k =
    U_ABT '[ 'U] 'U
-> (Variable 'U -> AST -> TypeCheckMonad r) -> TypeCheckMonad r
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e ((Variable 'U -> AST -> TypeCheckMonad r) -> TypeCheckMonad r)
-> (Variable 'U -> AST -> TypeCheckMonad r) -> TypeCheckMonad r
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x AST
e1 -> do
    let x' :: Variable a
x' = Variable 'U
x {varType :: Sing a
varType = Sing a
typ}
    TypedAST Sing b
typ1 abt '[] b
e1' <- Variable a
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable a
x' (AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e1)
    Sing b -> abt '[a] b -> TypeCheckMonad r
forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r
k Sing b
typ1 (Variable a -> abt '[] b -> abt '[a] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable a
x' abt '[] b
e1')

inferBinders
    :: (ABT Term abt)
    => List1 Variable xs
    -> U.AST
    -> (forall a. Sing a -> abt xs a -> TypeCheckMonad r)
    -> TypeCheckMonad r
inferBinders :: List1 Variable xs
-> AST
-> (forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinders = \List1 Variable xs
xs AST
e forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r
k -> do
    TypedAST Sing b
typ abt '[] b
e' <- List1 Variable xs
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall (xs :: [Hakaru]) b.
List1 Variable xs -> TypeCheckMonad b -> TypeCheckMonad b
pushesCtx List1 Variable xs
xs (AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e)
    Sing b -> abt xs b -> TypeCheckMonad r
forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r
k Sing b
typ (List1 Variable xs -> abt '[] b -> abt xs b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (b :: k).
ABT syn abt =>
List1 Variable xs -> abt '[] b -> abt xs b
binds_ List1 Variable xs
xs abt '[] b
e')
    where
    -- TODO: make sure the 'TCM'\/'unTCM' stuff doesn't do stupid asymptotic things
    pushesCtx
        :: List1 Variable (xs :: [Hakaru])
        -> TypeCheckMonad b
        -> TypeCheckMonad b
    pushesCtx :: List1 Variable xs -> TypeCheckMonad b -> TypeCheckMonad b
pushesCtx List1 Variable xs
Nil1         TypeCheckMonad b
m = TypeCheckMonad b
m
    pushesCtx (Cons1 Variable x
x List1 Variable xs
xs) TypeCheckMonad b
m = List1 Variable xs -> TypeCheckMonad b -> TypeCheckMonad b
forall (xs :: [Hakaru]) b.
List1 Variable xs -> TypeCheckMonad b -> TypeCheckMonad b
pushesCtx List1 Variable xs
xs ((Ctx -> Input -> TypeCheckMode -> Either TypeCheckError b)
-> TypeCheckMonad b
forall a.
(Ctx -> Input -> TypeCheckMode -> Either TypeCheckError a)
-> TypeCheckMonad a
TCM (TypeCheckMonad b
-> Ctx -> Input -> TypeCheckMode -> Either TypeCheckError b
forall a.
TypeCheckMonad a
-> Ctx -> Input -> TypeCheckMode -> Either TypeCheckError a
unTCM TypeCheckMonad b
m (Ctx -> Input -> TypeCheckMode -> Either TypeCheckError b)
-> (Ctx -> Ctx)
-> Ctx
-> Input
-> TypeCheckMode
-> Either TypeCheckError b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Variable x -> Ctx -> Ctx
forall k (a :: k).
Variable a -> VarSet (KindOf a) -> VarSet (KindOf a)
insertVarSet Variable x
x))


checkBinder
    :: (ABT Term abt)
    => Sing a
    -> Sing b
    -> MetaABT U.SourceSpan U.Term '[ 'U.U ] 'U.U
    -> TypeCheckMonad (abt '[ a ] b)
checkBinder :: Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ Sing b
eTyp U_ABT '[ 'U] 'U
e =
    U_ABT '[ 'U] 'U
-> (Variable 'U -> AST -> TypeCheckMonad (abt '[a] b))
-> TypeCheckMonad (abt '[a] b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e ((Variable 'U -> AST -> TypeCheckMonad (abt '[a] b))
 -> TypeCheckMonad (abt '[a] b))
-> (Variable 'U -> AST -> TypeCheckMonad (abt '[a] b))
-> TypeCheckMonad (abt '[a] b)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x AST
e1 -> do
    let x' :: Variable a
x' = Variable 'U
x {varType :: Sing a
varType = Sing a
typ}
    Variable a
-> TypeCheckMonad (abt '[a] b) -> TypeCheckMonad (abt '[a] b)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable a
x' (Variable a -> abt '[] b -> abt '[a] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable a
x' (abt '[] b -> abt '[a] b)
-> TypeCheckMonad (abt '[] b) -> TypeCheckMonad (abt '[a] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType Sing b
eTyp AST
e1)


checkBinders
    :: (ABT Term abt)
    => List1 Variable xs
    -> Sing a
    -> U.AST
    -> TypeCheckMonad (abt xs a)
checkBinders :: List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable xs
xs Sing a
eTyp AST
e =
    case List1 Variable xs
xs of
    List1 Variable xs
Nil1        -> Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType Sing a
eTyp AST
e
    Cons1 Variable x
x List1 Variable xs
xs' -> Variable x
-> TypeCheckMonad (abt (x : xs) a)
-> TypeCheckMonad (abt (x : xs) a)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable x
x (Variable x -> abt xs a -> abt (x : xs) a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable x
x (abt xs a -> abt (x : xs) a)
-> TypeCheckMonad (abt xs a) -> TypeCheckMonad (abt (x : xs) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
ABT Term abt =>
List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable xs
xs' Sing a
eTyp AST
e)

----------------------------------------------------------------
-- | Given a typing environment and a term, synthesize the term's
-- type (and produce an elaborated term):
--
-- > Γ ⊢ e ⇒ e' ∈ τ
inferType
    :: forall abt
    .  (ABT Term abt)
    => U.AST
    -> TypeCheckMonad (TypedAST abt)
inferType :: AST -> TypeCheckMonad (TypedAST abt)
inferType = AST -> TypeCheckMonad (TypedAST abt)
inferType_
  where
  -- HACK: we need to give these local definitions to avoid
  -- \"ambiguity\" in the choice of ABT instance...
  checkType_ :: forall b. Sing b -> U.AST -> TypeCheckMonad (abt '[] b)
  checkType_ :: Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ = Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType

  inferOneCheckOthers_ ::
      [U.AST] -> TypeCheckMonad (TypedASTs abt)
  inferOneCheckOthers_ :: [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_ = [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
[AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers


  inferVariable
      :: Maybe U.SourceSpan
      -> Variable 'U.U
      -> TypeCheckMonad (TypedAST abt)
  inferVariable :: Maybe SourceSpan -> Variable 'U -> TypeCheckMonad (TypedAST abt)
inferVariable Maybe SourceSpan
sourceSpan (Variable TypeCheckError
hintID Nat
nameID Sing 'U
_) = do
      Ctx
ctx <- TypeCheckMonad Ctx
getCtx
      case Key
-> IntMap (SomeVariable 'KProxy) -> Maybe (SomeVariable 'KProxy)
forall a. Key -> IntMap a -> Maybe a
IM.lookup (Nat -> Key
fromNat Nat
nameID) (Ctx -> IntMap (SomeVariable 'KProxy)
forall k (kproxy :: KProxy k).
VarSet kproxy -> IntMap (SomeVariable kproxy)
unVarSet Ctx
ctx) of
        Just (SomeVariable Variable a
x') ->
            TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing a -> abt '[] a -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Variable a -> Sing a
forall k (a :: k). Variable a -> Sing a
varType Variable a
x') (Variable a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var Variable a
x')
        Maybe (SomeVariable 'KProxy)
Nothing -> TypeCheckError -> Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckError -> Maybe SourceSpan -> TypeCheckMonad r
ambiguousFreeVariable TypeCheckError
hintID Maybe SourceSpan
sourceSpan


  -- HACK: We need this monomorphic binding so that GHC doesn't get
  -- confused about which @(ABT AST abt)@ instance to use in recursive
  -- calls.
  inferType_ :: U.AST -> TypeCheckMonad (TypedAST abt)
  inferType_ :: AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e0 =
    let s :: Maybe SourceSpan
s = AST -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata AST
e0 in
    AST
-> (Variable 'U -> TypeCheckMonad (TypedAST abt))
-> (Term (MetaABT SourceSpan Term) 'U
    -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn AST
e0 (Maybe SourceSpan -> Variable 'U -> TypeCheckMonad (TypedAST abt)
inferVariable Maybe SourceSpan
s) (Maybe SourceSpan
-> Term (MetaABT SourceSpan Term) 'U
-> TypeCheckMonad (TypedAST abt)
go Maybe SourceSpan
s)
    where
    go :: Maybe U.SourceSpan -> U.MetaTerm -> TypeCheckMonad (TypedAST abt)
    go :: Maybe SourceSpan
-> Term (MetaABT SourceSpan Term) 'U
-> TypeCheckMonad (TypedAST abt)
go Maybe SourceSpan
sourceSpan Term (MetaABT SourceSpan Term) 'U
t =
      case Term (MetaABT SourceSpan Term) 'U
t of
       U.Lam_ (U.SSing Sing a
typ) U_ABT '[ 'U] 'U
e -> do
           Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru).
    Sing b -> abt '[a] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) r.
ABT Term abt =>
Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing a
typ U_ABT '[ 'U] 'U
e ((forall (b :: Hakaru).
  Sing b -> abt '[a] b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (b :: Hakaru).
    Sing b -> abt '[a] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing b
typ2 abt '[a] b
e2 ->
               TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] (a ':-> b) -> TypedAST abt)
-> abt '[] (a ':-> b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing (a ':-> b) -> abt '[] (a ':-> b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing a -> Sing b -> Sing (a ':-> b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typ Sing b
typ2) (abt '[] (a ':-> b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] (a ':-> b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt (a ':-> b) -> abt '[] (a ':-> b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[ '( '[a], b)] (a ':-> b)
forall (a :: Hakaru) (a :: Hakaru). SCon '[ '( '[a], a)] (a ':-> a)
Lam_ SCon '[ '( '[a], b)] (a ':-> b)
-> SArgs abt '[ '( '[a], b)] -> Term abt (a ':-> b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[a] b
e2 abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.App_ AST
e1 AST
e2 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           Unify2 (':->) (TypedAST abt) b
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun Sing b
typ1 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (b ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (b ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 Sing b
typ3 -> do
            abt '[] a
e2' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ2 AST
e2
            TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ3 (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC (a ':-> b), LC a] b
forall (a :: Hakaru) (b :: Hakaru). SCon '[LC (a ':-> b), LC a] b
App_ SCon '[LC (a ':-> b), LC a] b
-> SArgs abt '[LC (a ':-> b), LC a] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[LC a] -> SArgs abt '[ '( '[], b), LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
e2' abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

           -- case typ1 of
           --     SFun typ2 typ3 -> do
           --         e2' <- checkType_ typ2 e2
           --         return . TypedAST typ3 $ syn (App_ :$ e1' :* e2' :* End)
           --     _ -> typeMismatch sourceSpan (Left "function type") (Right typ1)
           -- The above is the standard rule that everyone uses.
           -- However, if the @e1@ is a lambda (rather than a primop
           -- or a variable), then it will require a type annotation.
           -- Couldn't we just as well add an additional rule that
           -- says to infer @e2@ and then infer @e1@ under the assumption
           -- that the variable has the same type as the argument? (or
           -- generalize that idea to keep track of a bunch of arguments
           -- being passed in; sort of like a dual to our typing
           -- environments?) Is this at all related to what Dunfield
           -- & Neelk are doing in their ICFP'13 paper with that
           -- \"=>=>\" judgment? (prolly not, but...)

       U.Let_ AST
e1 U_ABT '[ 'U] 'U
e2 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           Sing b
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) r.
ABT Term abt =>
Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing b
typ1 U_ABT '[ 'U] 'U
e2 ((forall (b :: Hakaru).
  Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing b
typ2 abt '[b] b
e2' ->
               TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ2 (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC b, '( '[b], b)] b
forall (a :: Hakaru) (b :: Hakaru). SCon '[LC a, '( '[a], b)] b
Let_ SCon '[LC b, '( '[b], b)] b
-> SArgs abt '[LC b, '( '[b], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] b
e2' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Ann_ (U.SSing Sing a
typ1) AST
e1 -> do
           -- N.B., this requires that @typ1@ is a 'Sing' not a 'Proxy',
           -- since we can't generate a 'Sing' from a 'Proxy'.
           Sing a -> abt '[] a -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing a
typ1 (abt '[] a -> TypedAST abt)
-> TypeCheckMonad (abt '[] a) -> TypeCheckMonad (TypedAST abt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ1 AST
e1

       U.PrimOp_  PrimOp
op [AST]
es -> PrimOp -> [AST] -> TypeCheckMonad (TypedAST abt)
inferPrimOp  PrimOp
op [AST]
es
       U.ArrayOp_ ArrayOp
op [AST]
es -> ArrayOp -> [AST] -> TypeCheckMonad (TypedAST abt)
inferArrayOp ArrayOp
op [AST]
es
       U.NaryOp_  NaryOp
op [AST]
es -> do
           TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
           TypedASTs Sing b
typ [abt '[] b]
es' <-
               case TypeCheckMode
mode of
               TypeCheckMode
StrictMode -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_ [AST]
es
               TypeCheckMode
LaxMode    -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan [AST]
es
               TypeCheckMode
UnsafeMode -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan [AST]
es
           NaryOp b
op' <- Sing b -> NaryOp -> TypeCheckMonad (NaryOp b)
forall (a :: Hakaru). Sing a -> NaryOp -> TypeCheckMonad (NaryOp a)
make_NaryOp Sing b
typ NaryOp
op
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (NaryOp b -> Seq (abt '[] b) -> Term abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp b
op' (Seq (abt '[] b) -> Term abt b) -> Seq (abt '[] b) -> Term abt b
forall a b. (a -> b) -> a -> b
$ [abt '[] b] -> Seq (abt '[] b)
forall a. [a] -> Seq a
S.fromList [abt '[] b]
es')

       U.Literal_ (Some1 Literal i
v) ->
           -- TODO: in truth, we can infer this to be any supertype
           -- (adjusting the concrete @v@ as necessary). That is, the
           -- surface language treats numeric literals as polymorphic,
           -- so we should capture that somehow--- even if we're not
           -- in 'LaxMode'. We'll prolly need to handle this
           -- subtype-polymorphism the same way as we do for for
           -- everything when in 'UnsafeMode'.
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] i -> TypedAST abt)
-> abt '[] i
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing i -> abt '[] i -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Literal i -> Sing i
forall (a :: Hakaru). Literal a -> Sing a
sing_Literal Literal i
v) (abt '[] i -> TypeCheckMonad (TypedAST abt))
-> abt '[] i -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt i -> abt '[] i
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Literal i -> Term abt i
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Literal a -> Term abt a
Literal_ Literal i
v)

       -- TODO: we can try to do 'U.Case_' by using branch-based
       -- variants of 'inferOneCheckOthers' and 'inferLubType' depending
       -- on the mode; provided we can in fact infer the type of the
       -- scrutinee. N.B., if we add this case, then we need to update
       -- 'mustCheck' to return the right thing.

       U.CoerceTo_ (Some2 Coercion i j
c) AST
e1 ->
           case Coercion i j -> Maybe (Sing i, Sing j)
forall (a :: Hakaru) (b :: Hakaru).
Coercion a b -> Maybe (Sing a, Sing b)
singCoerceDomCod Coercion i j
c of
           Maybe (Sing i, Sing j)
Nothing
               | AST -> Bool
inferable AST
e1 -> AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
               | Bool
otherwise    -> Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousNullCoercion Maybe SourceSpan
sourceSpan
           Just (Sing i
dom,Sing j
cod) -> do
               abt '[] i
e1' <- Sing i -> AST -> TypeCheckMonad (abt '[] i)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing i
dom AST
e1
               TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] j -> TypedAST abt)
-> abt '[] j
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing j -> abt '[] j -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing j
cod (abt '[] j -> TypeCheckMonad (TypedAST abt))
-> abt '[] j -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt j -> abt '[] j
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion i j -> SCon '[LC i] j
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC a] b
CoerceTo_ Coercion i j
c SCon '[LC i] j -> SArgs abt '[LC i] -> Term abt j
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] i
e1' abt '[] i -> SArgs abt '[] -> SArgs abt '[LC i]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.UnsafeTo_ (Some2 Coercion i j
c) AST
e1 ->
           case Coercion i j -> Maybe (Sing i, Sing j)
forall (a :: Hakaru) (b :: Hakaru).
Coercion a b -> Maybe (Sing a, Sing b)
singCoerceDomCod Coercion i j
c of
           Maybe (Sing i, Sing j)
Nothing
               | AST -> Bool
inferable AST
e1 -> AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
               | Bool
otherwise    -> Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousNullCoercion Maybe SourceSpan
sourceSpan
           Just (Sing i
dom,Sing j
cod) -> do
               abt '[] j
e1' <- Sing j -> AST -> TypeCheckMonad (abt '[] j)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing j
cod AST
e1
               TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] i -> TypedAST abt)
-> abt '[] i
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing i -> abt '[] i -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing i
dom (abt '[] i -> TypeCheckMonad (TypedAST abt))
-> abt '[] i -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt i -> abt '[] i
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion i j -> SCon '[LC j] i
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC b] a
UnsafeFrom_ Coercion i j
c SCon '[LC j] i -> SArgs abt '[LC j] -> Term abt i
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] j
e1' abt '[] j -> SArgs abt '[] -> SArgs abt '[LC j]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.MeasureOp_ (U.SomeOp MeasureOp typs a
op) [AST]
es -> do
           let (List1 Sing typs
typs, Sing a
typ1) = MeasureOp typs a -> (List1 Sing typs, Sing a)
forall (typs :: [Hakaru]) (a :: Hakaru).
MeasureOp typs a -> (List1 Sing typs, Sing a)
sing_MeasureOp MeasureOp typs a
op
           SArgs abt args
es' <- List1 Sing typs -> [AST] -> TypeCheckMonad (SArgs abt args)
forall (abt :: [Hakaru] -> Hakaru -> *) (typs :: [Hakaru])
       (args :: [([Hakaru], Hakaru)]).
(ABT Term abt, typs ~ UnLCs args, args ~ LCs typs) =>
List1 Sing typs -> [AST] -> TypeCheckMonad (SArgs abt args)
checkSArgs List1 Sing typs
typs [AST]
es
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure a) -> TypedAST abt)
-> abt '[] ('HMeasure a)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HMeasure a) -> abt '[] ('HMeasure a) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typ1) (abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (MeasureOp typs a -> SCon args ('HMeasure a)
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
MeasureOp typs a -> SCon args ('HMeasure a)
MeasureOp_ MeasureOp typs a
op SCon args ('HMeasure a) -> SArgs abt args -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt args
es')

       U.Pair_ AST
e1 AST
e2 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           TypedAST Sing b
typ2 abt '[] b
e2' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e2
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] (HPair b b) -> TypedAST abt)
-> abt '[] (HPair b b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing (HPair b b) -> abt '[] (HPair b b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing b -> Sing b -> Sing (HPair b b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair Sing b
typ1 Sing b
typ2) (abt '[] (HPair b b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] (HPair b b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                  Term abt (HPair b b) -> abt '[] (HPair b b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Datum (abt '[]) (HData' (('TyCon "Pair" ':@ b) ':@ b))
-> Term abt (HData' (('TyCon "Pair" ':@ b) ':@ b))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
Datum (abt '[]) (HData' t) -> Term abt (HData' t)
Datum_ (Datum (abt '[]) (HData' (('TyCon "Pair" ':@ b) ':@ b))
 -> Term abt (HData' (('TyCon "Pair" ':@ b) ':@ b)))
-> Datum (abt '[]) (HData' (('TyCon "Pair" ':@ b) ':@ b))
-> Term abt (HData' (('TyCon "Pair" ':@ b) ':@ b))
forall a b. (a -> b) -> a -> b
$ Sing b
-> Sing b -> abt '[] b -> abt '[] b -> Datum (abt '[]) (HPair b b)
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
Sing a -> Sing b -> ast a -> ast b -> Datum ast (HPair a b)
dPair_ Sing b
typ1 Sing b
typ2 abt '[] b
e1' abt '[] b
e2')

       U.Array_ AST
e1 U_ABT '[ 'U] 'U
e2 -> do
           abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
           Sing 'HNat
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru).
    Sing b -> abt '[ 'HNat] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) r.
ABT Term abt =>
Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing 'HNat
SNat U_ABT '[ 'U] 'U
e2 ((forall (b :: Hakaru).
  Sing b -> abt '[ 'HNat] b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (b :: Hakaru).
    Sing b -> abt '[ 'HNat] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing b
typ2 abt '[ 'HNat] b
e2' ->
               TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HArray b) -> TypedAST abt)
-> abt '[] ('HArray b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HArray b) -> abt '[] ('HArray b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing b -> Sing ('HArray b)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray Sing b
typ2) (abt '[] ('HArray b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HArray b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HArray b) -> abt '[] ('HArray b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] 'HNat -> abt '[ 'HNat] b -> Term abt ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
Array_ abt '[] 'HNat
e1' abt '[ 'HNat] b
e2')

       U.ArrayLiteral_ [AST]
es -> do
           TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
           TypedASTs Sing b
typ [abt '[] b]
es' <-
               case TypeCheckMode
mode of
                 TypeCheckMode
StrictMode -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_ [AST]
es
                 TypeCheckMode
LaxMode    -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan [AST]
es
                 TypeCheckMode
UnsafeMode -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan [AST]
es
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HArray b) -> TypedAST abt)
-> abt '[] ('HArray b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HArray b) -> abt '[] ('HArray b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing b -> Sing ('HArray b)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray Sing b
typ) (abt '[] ('HArray b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HArray b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HArray b) -> abt '[] ('HArray b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn ([abt '[] b] -> Term abt ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
[abt '[] a] -> Term abt ('HArray a)
ArrayLiteral_ [abt '[] b]
es')

       U.Case_ AST
e1 [Branch_ (MetaABT SourceSpan Term)]
branches -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
           case TypeCheckMode
mode of
               TypeCheckMode
StrictMode -> Sing b
-> abt '[] b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a
-> abt '[] a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferCaseStrict Sing b
typ1 abt '[] b
e1' [Branch_ (MetaABT SourceSpan Term)]
branches
               TypeCheckMode
LaxMode    -> Maybe SourceSpan
-> Sing b
-> abt '[] b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> Sing a
-> abt '[] a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferCaseLax Maybe SourceSpan
sourceSpan Sing b
typ1 abt '[] b
e1' [Branch_ (MetaABT SourceSpan Term)]
branches
               TypeCheckMode
UnsafeMode -> Maybe SourceSpan
-> Sing b
-> abt '[] b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> Sing a
-> abt '[] a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferCaseLax Maybe SourceSpan
sourceSpan Sing b
typ1 abt '[] b
e1' [Branch_ (MetaABT SourceSpan Term)]
branches

       U.Dirac_ AST
e1 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure b) -> TypedAST abt)
-> abt '[] ('HMeasure b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HMeasure b) -> abt '[] ('HMeasure b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing b -> Sing ('HMeasure b)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing b
typ1) (abt '[] ('HMeasure b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure b) -> abt '[] ('HMeasure b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC b] ('HMeasure b)
forall (a :: Hakaru). SCon '[LC a] ('HMeasure a)
Dirac SCon '[LC b] ('HMeasure b)
-> SArgs abt '[LC b] -> Term abt ('HMeasure b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.MBind_ AST
e1 U_ABT '[ 'U] 'U
e2 ->
           U_ABT '[ 'U] 'U
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e2 ((Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x AST
e2' -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 ->
            let x' :: Variable a
x' = Variable 'U -> Sing a -> Variable a
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing a
typ2 in
            Variable a
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable a
x' (TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ do
             TypedAST Sing b
typ3 abt '[] b
e3' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e2'
             Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ3 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
_ ->
              TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure a) -> TypedAST abt)
-> abt '[] ('HMeasure a)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ3 (abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
forall (a :: Hakaru) (a :: Hakaru).
SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
MBind SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HMeasure a)]
-> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[a], b)]
-> SArgs abt '[ '( '[], b), '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Variable a -> abt '[] b -> abt '[a] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable a
x' abt '[] b
e3' abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Plate_ AST
e1 U_ABT '[ 'U] 'U
e2 ->
           U_ABT '[ 'U] 'U
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e2 ((Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x AST
e2' -> do
           abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
           let x' :: Variable 'HNat
x' = Variable 'U -> Sing 'HNat -> Variable 'HNat
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing 'HNat
SNat
           Variable 'HNat
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable 'HNat
x' (TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ do
            TypedAST Sing b
typ2 abt '[] b
e3' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e2'
            Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ2 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ3 ->
             TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure ('HArray a)) -> TypedAST abt)
-> abt '[] ('HMeasure ('HArray a))
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HMeasure ('HArray a))
-> abt '[] ('HMeasure ('HArray a)) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing ('HArray a) -> Sing ('HMeasure ('HArray a))
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure (Sing ('HArray a) -> Sing ('HMeasure ('HArray a)))
-> (Sing a -> Sing ('HArray a))
-> Sing a
-> Sing ('HMeasure ('HArray a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing a -> Sing ('HArray a)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray (Sing a -> Sing ('HMeasure ('HArray a)))
-> Sing a -> Sing ('HMeasure ('HArray a))
forall a b. (a -> b) -> a -> b
$ Sing a
typ3) (abt '[] ('HMeasure ('HArray a)) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure ('HArray a)) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
              Term abt ('HMeasure ('HArray a)) -> abt '[] ('HMeasure ('HArray a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
forall (a :: Hakaru).
SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
Plate SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
-> Term abt ('HMeasure ('HArray a))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1' abt '[] 'HNat
-> SArgs abt '[ '( '[ 'HNat], b)]
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Variable 'HNat -> abt '[] b -> abt '[ 'HNat] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
x' abt '[] b
e3' abt '[ 'HNat] b -> SArgs abt '[] -> SArgs abt '[ '( '[ 'HNat], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Chain_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 ->
           U_ABT '[ 'U] 'U
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT '[ 'U] 'U
e3 ((Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (Variable 'U -> AST -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x AST
e3' -> do
           abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
           TypedAST Sing b
typ2 abt '[] b
e2' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e2
           let x' :: Variable b
x' = Variable 'U -> Sing b -> Variable b
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing b
typ2
           Variable b
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable b
x' (TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ do
               TypedAST Sing b
typ3 abt '[] b
e4' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e3'
               Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ3 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ4 ->
                Unify2 HPair (TypedAST abt) a
forall r (x :: Hakaru). Unify2 HPair r x
unifyPair Sing a
typ4 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (a ~ HPair a b) =>
  Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (a ~ HPair a b) =>
    Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
a Sing b
b ->
                Sing b
-> Sing b
-> Maybe SourceSpan
-> ()
-> ()
-> ((b ~ b) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing b
typ2 Sing b
b Maybe SourceSpan
sourceSpan () () (((b ~ b) => TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> ((b ~ b) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                 TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure (HPair ('HArray a) b)) -> TypedAST abt)
-> abt '[] ('HMeasure (HPair ('HArray a) b))
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HMeasure (HPair ('HArray a) b))
-> abt '[] ('HMeasure (HPair ('HArray a) b)) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing (HPair ('HArray a) b)
-> Sing ('HMeasure (HPair ('HArray a) b))
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure (Sing (HPair ('HArray a) b)
 -> Sing ('HMeasure (HPair ('HArray a) b)))
-> Sing (HPair ('HArray a) b)
-> Sing ('HMeasure (HPair ('HArray a) b))
forall a b. (a -> b) -> a -> b
$ Sing ('HArray a) -> Sing b -> Sing (HPair ('HArray a) b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair (Sing a -> Sing ('HArray a)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray Sing a
a) Sing b
typ2) (abt '[] ('HMeasure (HPair ('HArray a) b))
 -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                 Term abt ('HMeasure (HPair ('HArray a) b))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
  ('HMeasure (HPair ('HArray a) b))
forall (s :: Hakaru) (a :: Hakaru).
SCon
  '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
  ('HMeasure (HPair ('HArray a) s))
Chain SCon
  '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
  ('HMeasure (HPair ('HArray a) b))
-> SArgs abt '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
-> Term abt ('HMeasure (HPair ('HArray a) b))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1' abt '[] 'HNat
-> SArgs abt '[LC b, '( '[b], b)]
-> SArgs abt '[LC 'HNat, LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* Variable b -> abt '[] b -> abt '[b] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable b
x' abt '[] b
e4' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Integrate_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 -> do
           abt '[] 'HReal
e1' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e1
           abt '[] 'HReal
e2' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e2
           abt '[ 'HReal] 'HProb
e3' <- Sing 'HReal
-> Sing 'HProb
-> U_ABT '[ 'U] 'U
-> TypeCheckMonad (abt '[ 'HReal] 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing 'HReal
SReal Sing 'HProb
SProb U_ABT '[ 'U] 'U
e3
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                  Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)] 'HProb
Integrate SCon '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)] 'HProb
-> SArgs abt '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)]
-> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e1' abt '[] 'HReal
-> SArgs abt '[LC 'HReal, '( '[ 'HReal], 'HProb)]
-> SArgs abt '[LC 'HReal, LC 'HReal, '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HReal
e2' abt '[] 'HReal
-> SArgs abt '[ '( '[ 'HReal], 'HProb)]
-> SArgs abt '[LC 'HReal, '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[ 'HReal] 'HProb
e3' abt '[ 'HReal] 'HProb
-> SArgs abt '[] -> SArgs abt '[ '( '[ 'HReal], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Summate_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e1
           abt '[] b
e2' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ1 AST
e2
           case Sing b -> Maybe (HDiscrete b)
forall (a :: Hakaru). Sing a -> Maybe (HDiscrete a)
hDiscrete_Sing Sing b
typ1 of
             Maybe (HDiscrete b)
Nothing -> TypeCheckError -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Summate given bounds which are not discrete"
             Just HDiscrete b
h1 -> Sing b
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) r.
ABT Term abt =>
Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing b
typ1 U_ABT '[ 'U] 'U
e3 ((forall (b :: Hakaru).
  Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing b
typ2 abt '[b] b
ee' ->
               case Sing b -> Maybe (HSemiring b)
forall (a :: Hakaru). Sing a -> Maybe (HSemiring a)
hSemiring_Sing Sing b
typ2 of
                 Maybe (HSemiring b)
Nothing -> TypeCheckError -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Summate given summands which are not in a semiring"
                 Just HSemiring b
h2 ->
                     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ2 (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                            Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (HDiscrete b -> HSemiring b -> SCon '[LC b, LC b, '( '[b], b)] b
forall (a :: Hakaru) (b :: Hakaru).
HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
Summate HDiscrete b
h1 HSemiring b
h2 SCon '[LC b, LC b, '( '[b], b)] b
-> SArgs abt '[LC b, LC b, '( '[b], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[LC b, '( '[b], b)]
-> SArgs abt '[LC b, LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] b
ee' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Product_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 -> do
           TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e1
           abt '[] b
e2' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ1 AST
e2
           case Sing b -> Maybe (HDiscrete b)
forall (a :: Hakaru). Sing a -> Maybe (HDiscrete a)
hDiscrete_Sing Sing b
typ1 of
             Maybe (HDiscrete b)
Nothing -> TypeCheckError -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Product given bounds which are not discrete"
             Just HDiscrete b
h1 -> Sing b
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) r.
ABT Term abt =>
Sing a
-> U_ABT '[ 'U] 'U
-> (forall (b :: Hakaru). Sing b -> abt '[a] b -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinder Sing b
typ1 U_ABT '[ 'U] 'U
e3 ((forall (b :: Hakaru).
  Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (b :: Hakaru).
    Sing b -> abt '[b] b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing b
typ2 abt '[b] b
e3' ->
               case Sing b -> Maybe (HSemiring b)
forall (a :: Hakaru). Sing a -> Maybe (HSemiring a)
hSemiring_Sing Sing b
typ2 of
                 Maybe (HSemiring b)
Nothing -> TypeCheckError -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Product given factors which are not in a semiring"
                 Just HSemiring b
h2 ->
                     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ2 (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                            Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (HDiscrete b -> HSemiring b -> SCon '[LC b, LC b, '( '[b], b)] b
forall (a :: Hakaru) (b :: Hakaru).
HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
Product HDiscrete b
h1 HSemiring b
h2 SCon '[LC b, LC b, '( '[b], b)] b
-> SArgs abt '[LC b, LC b, '( '[b], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[LC b, '( '[b], b)]
-> SArgs abt '[LC b, LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] b
e3' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

       U.Bucket_ AST
e1 AST
e2 Reducer xs (MetaABT SourceSpan Term) 'U
r1 -> do
           abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
           abt '[] 'HNat
e2' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e2
           TypedReducer Sing b
typ1 List1 Variable '[]
Nil1 Reducer abt '[] b
r1' <- Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable '[] -> TypeCheckMonad (TypedReducer abt '[])
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
r1 List1 Variable '[]
forall k (a :: k -> *). List1 a '[]
Nil1
           TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ1 (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                  Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] 'HNat -> abt '[] 'HNat -> Reducer abt '[] b -> Term abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[] 'HNat -> Reducer abt '[] a -> Term abt a
Bucket abt '[] 'HNat
e1' abt '[] 'HNat
e2' Reducer abt '[] b
r1')

       U.Transform_ Transform as x
tr SArgs (MetaABT SourceSpan Term) as
es -> Maybe SourceSpan
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (TypedAST abt)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Maybe SourceSpan
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (TypedAST abt)
inferTransform Maybe SourceSpan
sourceSpan Transform as x
tr SArgs (MetaABT SourceSpan Term) as
es

       U.Superpose_ NonEmpty (AST, AST)
pes -> do
           -- TODO: clean up all this @map fst@, @map snd@, @zip@ stuff
           TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
           TypedASTs Sing b
typ [abt '[] b]
es' <-
               case TypeCheckMode
mode of
               TypeCheckMode
StrictMode -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_    (NonEmpty AST -> [AST]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty AST -> [AST]) -> NonEmpty AST -> [AST]
forall a b. (a -> b) -> a -> b
$ ((AST, AST) -> AST) -> NonEmpty (AST, AST) -> NonEmpty AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AST, AST) -> AST
forall a b. (a, b) -> b
snd NonEmpty (AST, AST)
pes)
               TypeCheckMode
LaxMode    -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan (NonEmpty AST -> [AST]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty AST -> [AST]) -> NonEmpty AST -> [AST]
forall a b. (a -> b) -> a -> b
$ ((AST, AST) -> AST) -> NonEmpty (AST, AST) -> NonEmpty AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AST, AST) -> AST
forall a b. (a, b) -> b
snd NonEmpty (AST, AST)
pes)
               TypeCheckMode
UnsafeMode -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
sourceSpan (NonEmpty AST -> [AST]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty AST -> [AST]) -> NonEmpty AST -> [AST]
forall a b. (a -> b) -> a -> b
$ ((AST, AST) -> AST) -> NonEmpty (AST, AST) -> NonEmpty AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AST, AST) -> AST
forall a b. (a, b) -> b
snd NonEmpty (AST, AST)
pes)
           Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
_ -> do
            NonEmpty (abt '[] 'HProb)
ps' <- (AST -> TypeCheckMonad (abt '[] 'HProb))
-> NonEmpty AST -> TypeCheckMonad (NonEmpty (abt '[] 'HProb))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType Sing 'HProb
SProb) (((AST, AST) -> AST) -> NonEmpty (AST, AST) -> NonEmpty AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AST, AST) -> AST
forall a b. (a, b) -> a
fst NonEmpty (AST, AST)
pes)
            TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ (Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
Superpose_ (NonEmpty (abt '[] 'HProb)
-> NonEmpty (abt '[] b) -> NonEmpty (abt '[] 'HProb, abt '[] b)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
L.zip NonEmpty (abt '[] 'HProb)
ps' ([abt '[] b] -> NonEmpty (abt '[] b)
forall a. [a] -> NonEmpty a
L.fromList [abt '[] b]
es'))))

       U.InjTyped forall (abt' :: [Hakaru] -> Hakaru -> *).
ABT Term abt' =>
abt' '[] x
t     -> let t' :: abt '[] x
t' = abt '[] x
forall (abt' :: [Hakaru] -> Hakaru -> *).
ABT Term abt' =>
abt' '[] x
t in TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing x -> abt '[] x -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (abt '[] x -> Sing x
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf abt '[] x
t') abt '[] x
t'

       Term (MetaABT SourceSpan Term) 'U
_   | AST -> Bool
mustCheck AST
e0 -> Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousMustCheck Maybe SourceSpan
sourceSpan
           | Bool
otherwise    -> [Char] -> TypeCheckMonad (TypedAST abt)
forall a. HasCallStack => [Char] -> a
error [Char]
"inferType: missing an inferable branch!"

  inferTransform
      :: Maybe U.SourceSpan
      -> Transform as x
      -> U.SArgs U.U_ABT as
      -> TypeCheckMonad (TypedAST abt)
  inferTransform :: Maybe SourceSpan
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (TypedAST abt)
inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
Expect
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (Cons2 ToUntyped x y
U.ToU List2 ToUntyped xs ys
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    let e1src :: Maybe SourceSpan
e1src = U_ABT varsu 'U -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata U_ABT varsu 'U
e1
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 Maybe SourceSpan
e1src ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
     abt '[a] 'HProb
e2' <- Sing a
-> Sing 'HProb
-> U_ABT '[ 'U] 'U
-> TypeCheckMonad (abt '[a] 'HProb)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ2 Sing 'HProb
SProb U_ABT varsu 'U
U_ABT '[ 'U] 'U
e2
     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn
       (Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
-> SCon '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
forall (a :: Hakaru).
Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
Expect SCon '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HProb)]
-> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[a], 'HProb)]
-> SArgs abt '[ '( '[], b), '( '[a], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[a] 'HProb
e2' abt '[a] 'HProb -> SArgs abt '[] -> SArgs abt '[ '( '[a], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

  inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
Observe
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    let e1src :: Maybe SourceSpan
e1src = U_ABT varsu 'U -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata U_ABT varsu 'U
e1
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 Maybe SourceSpan
e1src ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
     abt '[] a
e2' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ2 U_ABT varsu 'U
AST
e2
     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] ('HMeasure a) -> TypedAST abt)
-> abt '[] ('HMeasure a)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ1 (abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn
       (Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
-> SCon '[LC ('HMeasure a), LC a] ('HMeasure a)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
forall (a :: Hakaru).
Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
Observe SCon '[LC ('HMeasure a), LC a] ('HMeasure a)
-> SArgs abt '[LC ('HMeasure a), LC a] -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[LC a] -> SArgs abt '[ '( '[], b), LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
e2' abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

  inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
MCMC
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    let e1src :: Maybe SourceSpan
e1src = U_ABT varsu 'U -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata U_ABT varsu 'U
e1
        e2src :: Maybe SourceSpan
e2src = U_ABT varsu 'U -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata U_ABT varsu 'U
e2
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    TypedAST Sing b
typ2 abt '[] b
e2' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e2
    Unify2 (':->) (TypedAST abt) b
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun     Sing b
typ1  Maybe SourceSpan
e1src ((forall (a :: Hakaru) (b :: Hakaru).
  (b ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (b ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typa Sing b
typmb ->
     Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typmb Maybe SourceSpan
e1src ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typb ->
     Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ2  Maybe SourceSpan
e2src ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typc ->
     Sing a
-> Sing a
-> Maybe SourceSpan
-> Sing (a ':-> 'HMeasure a)
-> Sing b
-> ((a ~ a) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing a
typa Sing a
typb Maybe SourceSpan
e1src (Sing a -> Sing ('HMeasure a) -> Sing (a ':-> 'HMeasure a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typa (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typa)) Sing b
typ1 (((a ~ a) => TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> ((a ~ a) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
     Sing a
-> Sing a
-> Maybe SourceSpan
-> Sing b
-> Sing b
-> ((a ~ a) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing a
typb Sing a
typc Maybe SourceSpan
e2src Sing b
typmb Sing b
typ2 (((a ~ a) => TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> ((a ~ a) => TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing (a ':-> 'HMeasure a)
-> abt '[] (a ':-> 'HMeasure a) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing a -> Sing ('HMeasure a) -> Sing (a ':-> 'HMeasure a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typa (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typa))
            (abt '[] (a ':-> 'HMeasure a) -> TypedAST abt)
-> abt '[] (a ':-> 'HMeasure a) -> TypedAST abt
forall a b. (a -> b) -> a -> b
$ Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a))
-> Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall a b. (a -> b) -> a -> b
$ Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
-> SCon
     '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
forall (a :: Hakaru).
Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
MCMC SCon
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
-> SArgs abt '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)]
-> Term abt (a ':-> 'HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], b), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End

  inferTransform Maybe SourceSpan
sourceSpan
                 (Disint TransformImpl
k)
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    let e1src :: Maybe SourceSpan
e1src = U_ABT varsu 'U -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata U_ABT varsu 'U
e1
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    Unify1 'HMeasure (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 Maybe SourceSpan
e1src ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 ->
     Unify2 HPair (TypedAST abt) a
forall r (x :: Hakaru). Unify2 HPair r x
unifyPair Sing a
typ2 Maybe SourceSpan
e1src ((forall (a :: Hakaru) (b :: Hakaru).
  (a ~ HPair a b) =>
  Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (a ~ HPair a b) =>
    Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typa Sing b
typb ->
     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing (a ':-> 'HMeasure b)
-> abt '[] (a ':-> 'HMeasure b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (Sing a -> Sing ('HMeasure b) -> Sing (a ':-> 'HMeasure b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typa (Sing b -> Sing ('HMeasure b)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing b
typb)) (abt '[] (a ':-> 'HMeasure b) -> TypedAST abt)
-> abt '[] (a ':-> 'HMeasure b) -> TypedAST abt
forall a b. (a -> b) -> a -> b
$
     Term abt (a ':-> 'HMeasure b) -> abt '[] (a ':-> 'HMeasure b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt (a ':-> 'HMeasure b) -> abt '[] (a ':-> 'HMeasure b))
-> Term abt (a ':-> 'HMeasure b) -> abt '[] (a ':-> 'HMeasure b)
forall a b. (a -> b) -> a -> b
$ Transform '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
-> SCon '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ (TransformImpl
-> Transform '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
forall (a :: Hakaru) (b :: Hakaru).
TransformImpl
-> Transform '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
Disint TransformImpl
k) SCon '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
-> SArgs abt '[LC ('HMeasure (HPair a b))]
-> Term abt (a ':-> 'HMeasure b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End

  inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
Simplify
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ1 (abt '[] b -> TypedAST abt) -> abt '[] b -> TypedAST abt
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[LC b] b -> SCon '[LC b] b
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC b] b
forall (a :: Hakaru). Transform '[LC a] a
Simplify SCon '[LC b] b -> SArgs abt '[LC b] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

  inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
Reparam
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ1 (abt '[] b -> TypedAST abt) -> abt '[] b -> TypedAST abt
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[LC b] b -> SCon '[LC b] b
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC b] b
forall (a :: Hakaru). Transform '[LC a] a
Reparam SCon '[LC b] b -> SArgs abt '[LC b] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

  inferTransform Maybe SourceSpan
sourceSpan
                 Transform as x
Summarize
                 ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
    TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
    TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ1 (abt '[] b -> TypedAST abt) -> abt '[] b -> TypedAST abt
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[LC b] b -> SCon '[LC b] b
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC b] b
forall (a :: Hakaru). Transform '[LC a] a
Summarize SCon '[LC b] b -> SArgs abt '[LC b] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

  inferTransform Maybe SourceSpan
_ Transform as x
tr SArgs (MetaABT SourceSpan Term) as
_ = [Char] -> TypeCheckMonad (TypedAST abt)
forall a. HasCallStack => [Char] -> a
error ([Char] -> TypeCheckMonad (TypedAST abt))
-> [Char] -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ [Char]
"inferTransform{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Transform as x -> [Char]
forall a. Show a => a -> [Char]
show Transform as x
tr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: TODO"

  inferPrimOp
      :: U.PrimOp
      -> [U.AST]
      -> TypeCheckMonad (TypedAST abt)
  inferPrimOp :: PrimOp -> [AST] -> TypeCheckMonad (TypedAST abt)
inferPrimOp PrimOp
U.Not [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] HBool
e' <- Sing HBool -> AST -> TypeCheckMonad (abt '[] HBool)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing HBool
sBool AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] HBool -> TypedAST abt)
-> abt '[] HBool
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing HBool -> abt '[] HBool -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing HBool
sBool (abt '[] HBool -> TypeCheckMonad (TypedAST abt))
-> abt '[] HBool -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[HBool] HBool -> SCon '[ '( '[], HBool)] HBool
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[HBool] HBool
Not SCon '[ '( '[], HBool)] HBool
-> SArgs abt '[ '( '[], HBool)] -> Term abt HBool
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] HBool
e' abt '[] HBool -> SArgs abt '[] -> SArgs abt '[ '( '[], HBool)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Pi [AST]
es =
      case [AST]
es of
        [] -> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HProb -> SCon '[] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[] 'HProb
Pi SCon '[] 'HProb -> SArgs abt '[] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_  -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Cos [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HReal
e' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HReal -> TypedAST abt)
-> abt '[] 'HReal
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HReal -> abt '[] 'HReal -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HReal
SReal (abt '[] 'HReal -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HReal -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HReal -> abt '[] 'HReal
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HReal] 'HReal -> SCon '[LC 'HReal] 'HReal
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HReal] 'HReal
Cos SCon '[LC 'HReal] 'HReal
-> SArgs abt '[LC 'HReal] -> Term abt 'HReal
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.RealPow [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2] -> do abt '[] 'HProb
e1' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e1
                       abt '[] 'HReal
e2' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e2
                       TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                              Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HProb, 'HReal] 'HProb
-> SCon '[ '( '[], 'HProb), LC 'HReal] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HProb, 'HReal] 'HProb
RealPow SCon '[ '( '[], 'HProb), LC 'HReal] 'HProb
-> SArgs abt '[ '( '[], 'HProb), LC 'HReal] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HProb
e1' abt '[] 'HProb
-> SArgs abt '[LC 'HReal]
-> SArgs abt '[ '( '[], 'HProb), LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HReal
e2' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_        -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Choose [AST]
es =
      case [AST]
es of 
        [AST
e1, AST
e2] -> do abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
                       abt '[] 'HNat
e2' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e2
                       TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HNat -> TypedAST abt)
-> abt '[] 'HNat
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HNat -> abt '[] 'HNat -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HNat
SNat (abt '[] 'HNat -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HNat -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                              Term abt 'HNat -> abt '[] 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HNat, 'HNat] 'HNat -> SCon '[LC 'HNat, LC 'HNat] 'HNat
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HNat, 'HNat] 'HNat
Choose SCon '[LC 'HNat, LC 'HNat] 'HNat
-> SArgs abt '[LC 'HNat, LC 'HNat] -> Term abt 'HNat
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1' abt '[] 'HNat
-> SArgs abt '[LC 'HNat] -> SArgs abt '[LC 'HNat, LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HNat
e2' abt '[] 'HNat -> SArgs abt '[] -> SArgs abt '[LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_        -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Exp [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HReal
e' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HReal] 'HProb -> SCon '[LC 'HReal] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HReal] 'HProb
Exp SCon '[LC 'HReal] 'HProb
-> SArgs abt '[LC 'HReal] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Log [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HProb
e' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HReal -> TypedAST abt)
-> abt '[] 'HReal
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HReal -> abt '[] 'HReal -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HReal
SReal (abt '[] 'HReal -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HReal -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HReal -> abt '[] 'HReal
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HProb] 'HReal -> SCon '[ '( '[], 'HProb)] 'HReal
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HProb] 'HReal
Log SCon '[ '( '[], 'HProb)] 'HReal
-> SArgs abt '[ '( '[], 'HProb)] -> Term abt 'HReal
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HProb
e' abt '[] 'HProb -> SArgs abt '[] -> SArgs abt '[ '( '[], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Infinity [AST]
es =
      case [AST]
es of
        [] -> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                     Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HProb -> SCon '[] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HIntegrable 'HProb -> PrimOp '[] 'HProb
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HProb
HIntegrable_Prob) SCon '[] 'HProb -> SArgs abt '[] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_  -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.GammaFunc [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HReal
e' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HReal] 'HProb -> SCon '[LC 'HReal] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HReal] 'HProb
GammaFunc SCon '[LC 'HReal] 'HProb
-> SArgs abt '[LC 'HReal] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.BetaFunc [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2] -> do abt '[] 'HProb
e1' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e1
                       abt '[] 'HProb
e2' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e2
                       TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                              Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HProb, 'HProb] 'HProb
-> SCon '[ '( '[], 'HProb), '( '[], 'HProb)] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HProb, 'HProb] 'HProb
BetaFunc SCon '[ '( '[], 'HProb), '( '[], 'HProb)] 'HProb
-> SArgs abt '[ '( '[], 'HProb), '( '[], 'HProb)]
-> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HProb
e1' abt '[] 'HProb
-> SArgs abt '[ '( '[], 'HProb)]
-> SArgs abt '[ '( '[], 'HProb), '( '[], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HProb
e2' abt '[] 'HProb -> SArgs abt '[] -> SArgs abt '[ '( '[], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_        -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Equal [AST]
es =
      case [AST]
es of
        [AST
_, AST
_] -> do TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                     TypedASTs Sing b
typ [abt '[] b
e1', abt '[] b
e2'] <-
                         case TypeCheckMode
mode of
                           TypeCheckMode
StrictMode -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_ [AST]
es
                           TypeCheckMode
_          -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
forall a. Maybe a
Nothing [AST]
es
                     PrimOp '[b, b] HBool
primop <- HEq b -> PrimOp '[b, b] HBool
forall (a :: Hakaru). HEq a -> PrimOp '[a, a] HBool
Equal (HEq b -> PrimOp '[b, b] HBool)
-> TypeCheckMonad (HEq b) -> TypeCheckMonad (PrimOp '[b, b] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing b -> TypeCheckMonad (HEq b)
forall (a :: Hakaru). Sing a -> TypeCheckMonad (HEq a)
getHEq Sing b
typ
                     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] HBool -> TypedAST abt)
-> abt '[] HBool
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing HBool -> abt '[] HBool -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing HBool
sBool (abt '[] HBool -> TypeCheckMonad (TypedAST abt))
-> abt '[] HBool -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                            Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b, b] HBool -> SCon '[ '( '[], b), '( '[], b)] HBool
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b, b] HBool
primop SCon '[ '( '[], b), '( '[], b)] HBool
-> SArgs abt '[ '( '[], b), '( '[], b)] -> Term abt HBool
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], b), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_      -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Less [AST]
es =
      case [AST]
es of
        [AST
_, AST
_] -> do TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                     TypedASTs Sing b
typ [abt '[] b
e1', abt '[] b
e2'] <-
                         case TypeCheckMode
mode of
                           TypeCheckMode
StrictMode -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers_ [AST]
es
                           TypeCheckMode
_          -> Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
forall a. Maybe a
Nothing [AST]
es
                     PrimOp '[b, b] HBool
primop <- HOrd b -> PrimOp '[b, b] HBool
forall (a :: Hakaru). HOrd a -> PrimOp '[a, a] HBool
Less (HOrd b -> PrimOp '[b, b] HBool)
-> TypeCheckMonad (HOrd b) -> TypeCheckMonad (PrimOp '[b, b] HBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing b -> TypeCheckMonad (HOrd b)
forall (a :: Hakaru). Sing a -> TypeCheckMonad (HOrd a)
getHOrd Sing b
typ
                     TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] HBool -> TypedAST abt)
-> abt '[] HBool
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing HBool -> abt '[] HBool -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing HBool
sBool (abt '[] HBool -> TypeCheckMonad (TypedAST abt))
-> abt '[] HBool -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                            Term abt HBool -> abt '[] HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b, b] HBool -> SCon '[ '( '[], b), '( '[], b)] HBool
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b, b] HBool
primop SCon '[ '( '[], b), '( '[], b)] HBool
-> SArgs abt '[ '( '[], b), '( '[], b)] -> Term abt HBool
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[], b)] -> SArgs abt '[ '( '[], b), '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_      -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.NatPow [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2] -> do TypedAST Sing b
typ abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
                       abt '[] 'HNat
e2' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e2
                       PrimOp '[b, 'HNat] b
primop <- HSemiring b -> PrimOp '[b, 'HNat] b
forall (a :: Hakaru). HSemiring a -> PrimOp '[a, 'HNat] a
NatPow (HSemiring b -> PrimOp '[b, 'HNat] b)
-> TypeCheckMonad (HSemiring b)
-> TypeCheckMonad (PrimOp '[b, 'HNat] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing b -> TypeCheckMonad (HSemiring b)
forall (a :: Hakaru). Sing a -> TypeCheckMonad (HSemiring a)
getHSemiring Sing b
typ
                       TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                              Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b, 'HNat] b -> SCon '[ '( '[], b), LC 'HNat] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b, 'HNat] b
primop SCon '[ '( '[], b), LC 'HNat] b
-> SArgs abt '[ '( '[], b), LC 'HNat] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[LC 'HNat] -> SArgs abt '[ '( '[], b), LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HNat
e2' abt '[] 'HNat -> SArgs abt '[] -> SArgs abt '[LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_        -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Negate [AST]
es =
      case [AST]
es of
        [AST
e] -> do TypedAST Sing b
typ abt '[] b
e' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e
                  TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                  SomeRing HRing b
ring Coercion b b
c <- Sing b -> TypeCheckMode -> TypeCheckMonad (SomeRing b)
forall (a :: Hakaru).
Sing a -> TypeCheckMode -> TypeCheckMonad (SomeRing a)
getHRing Sing b
typ TypeCheckMode
mode
                  PrimOp '[b] b
primop <- HRing b -> PrimOp '[b] b
forall (a :: Hakaru). HRing a -> PrimOp '[a] a
Negate (HRing b -> PrimOp '[b] b)
-> TypeCheckMonad (HRing b) -> TypeCheckMonad (PrimOp '[b] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HRing b -> TypeCheckMonad (HRing b)
forall (m :: * -> *) a. Monad m => a -> m a
return HRing b
ring
                  let e'' :: abt '[] b
e'' = case Coercion b b
c of
                              Coercion b b
CNil -> abt '[] b
abt '[] b
e'
                              Coercion b b
c'   -> LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt b -> LC_ abt b) -> LC_ abt b -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b b -> LC_ abt b -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b b
c' (LC_ abt b -> abt '[] b) -> LC_ abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] b
e'
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (HRing b -> Sing b
forall (a :: Hakaru). HRing a -> Sing a
sing_HRing HRing b
ring) (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b] b -> SCon '[ '( '[], b)] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b] b
primop SCon '[ '( '[], b)] b -> SArgs abt '[ '( '[], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e'' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Abs [AST]
es =
      case [AST]
es of
        [AST
e] -> do TypedAST Sing b
typ abt '[] b
e' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e
                  TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                  SomeRing HRing b
ring Coercion b b
c <- Sing b -> TypeCheckMode -> TypeCheckMonad (SomeRing b)
forall (a :: Hakaru).
Sing a -> TypeCheckMode -> TypeCheckMonad (SomeRing a)
getHRing Sing b
typ TypeCheckMode
mode
                  PrimOp '[b] (NonNegative b)
primop <- HRing b -> PrimOp '[b] (NonNegative b)
forall (a :: Hakaru). HRing a -> PrimOp '[a] (NonNegative a)
Abs (HRing b -> PrimOp '[b] (NonNegative b))
-> TypeCheckMonad (HRing b)
-> TypeCheckMonad (PrimOp '[b] (NonNegative b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HRing b -> TypeCheckMonad (HRing b)
forall (m :: * -> *) a. Monad m => a -> m a
return HRing b
ring
                  let e'' :: abt '[] b
e'' = case Coercion b b
c of
                              Coercion b b
CNil -> abt '[] b
abt '[] b
e'
                              Coercion b b
c'   -> LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt b -> LC_ abt b) -> LC_ abt b -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b b -> LC_ abt b -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b b
c' (LC_ abt b -> abt '[] b) -> LC_ abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] b
e'
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] (NonNegative b) -> TypedAST abt)
-> abt '[] (NonNegative b)
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing (NonNegative b) -> abt '[] (NonNegative b) -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (HRing b -> Sing (NonNegative b)
forall (a :: Hakaru). HRing a -> Sing (NonNegative a)
sing_NonNegative HRing b
ring) (abt '[] (NonNegative b) -> TypeCheckMonad (TypedAST abt))
-> abt '[] (NonNegative b) -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt (NonNegative b) -> abt '[] (NonNegative b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b] (NonNegative b) -> SCon '[ '( '[], b)] (NonNegative b)
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b] (NonNegative b)
primop SCon '[ '( '[], b)] (NonNegative b)
-> SArgs abt '[ '( '[], b)] -> Term abt (NonNegative b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e'' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Signum [AST]
es =
      case [AST]
es of
        [AST
e] -> do TypedAST Sing b
typ abt '[] b
e' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e
                  TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                  SomeRing HRing b
ring Coercion b b
c <- Sing b -> TypeCheckMode -> TypeCheckMonad (SomeRing b)
forall (a :: Hakaru).
Sing a -> TypeCheckMode -> TypeCheckMonad (SomeRing a)
getHRing Sing b
typ TypeCheckMode
mode
                  PrimOp '[b] b
primop <- HRing b -> PrimOp '[b] b
forall (a :: Hakaru). HRing a -> PrimOp '[a] a
Signum (HRing b -> PrimOp '[b] b)
-> TypeCheckMonad (HRing b) -> TypeCheckMonad (PrimOp '[b] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HRing b -> TypeCheckMonad (HRing b)
forall (m :: * -> *) a. Monad m => a -> m a
return HRing b
ring
                  let e'' :: abt '[] b
e'' = case Coercion b b
c of
                              Coercion b b
CNil -> abt '[] b
abt '[] b
e'
                              Coercion b b
c'   -> LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt b -> LC_ abt b) -> LC_ abt b -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b b -> LC_ abt b -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b b
c' (LC_ abt b -> abt '[] b) -> LC_ abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] b
e'
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (HRing b -> Sing b
forall (a :: Hakaru). HRing a -> Sing a
sing_HRing HRing b
ring) (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b] b -> SCon '[ '( '[], b)] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b] b
primop SCon '[ '( '[], b)] b -> SArgs abt '[ '( '[], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e'' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Recip [AST]
es =
      case [AST]
es of
        [AST
e] -> do TypedAST Sing b
typ abt '[] b
e' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e
                  TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                  SomeFractional HFractional b
frac Coercion b b
c <- Sing b -> TypeCheckMode -> TypeCheckMonad (SomeFractional b)
forall (a :: Hakaru).
Sing a -> TypeCheckMode -> TypeCheckMonad (SomeFractional a)
getHFractional Sing b
typ TypeCheckMode
mode
                  PrimOp '[b] b
primop <- HFractional b -> PrimOp '[b] b
forall (a :: Hakaru). HFractional a -> PrimOp '[a] a
Recip (HFractional b -> PrimOp '[b] b)
-> TypeCheckMonad (HFractional b) -> TypeCheckMonad (PrimOp '[b] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HFractional b -> TypeCheckMonad (HFractional b)
forall (m :: * -> *) a. Monad m => a -> m a
return HFractional b
frac
                  let e'' :: abt '[] b
e'' = case Coercion b b
c of
                              Coercion b b
CNil -> abt '[] b
abt '[] b
e'
                              Coercion b b
c'   -> LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt b -> LC_ abt b) -> LC_ abt b -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b b -> LC_ abt b -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b b
c' (LC_ abt b -> abt '[] b) -> LC_ abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] b
e'
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] b -> TypedAST abt)
-> abt '[] b
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST (HFractional b -> Sing b
forall (a :: Hakaru). HFractional a -> Sing a
sing_HFractional HFractional b
frac) (abt '[] b -> TypeCheckMonad (TypedAST abt))
-> abt '[] b -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[b] b -> SCon '[ '( '[], b)] b
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[b] b
primop SCon '[ '( '[], b)] b -> SArgs abt '[ '( '[], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e'' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  -- BUG: Only defined for HRadical_Prob
  inferPrimOp PrimOp
U.NatRoot [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2] -> do abt '[] 'HProb
e1' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e1
                       abt '[] 'HNat
e2' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat  AST
e2
                       TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HProb -> TypedAST abt)
-> abt '[] 'HProb
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HProb -> abt '[] 'HProb -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HProb
SProb (abt '[] 'HProb -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HProb -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                              Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HProb, 'HNat] 'HProb
-> SCon '[ '( '[], 'HProb), LC 'HNat] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HRadical 'HProb -> PrimOp '[ 'HProb, 'HNat] 'HProb
forall (a :: Hakaru). HRadical a -> PrimOp '[a, 'HNat] a
NatRoot HRadical 'HProb
HRadical_Prob)
                                   SCon '[ '( '[], 'HProb), LC 'HNat] 'HProb
-> SArgs abt '[ '( '[], 'HProb), LC 'HNat] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HProb
e1' abt '[] 'HProb
-> SArgs abt '[LC 'HNat] -> SArgs abt '[ '( '[], 'HProb), LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HNat
e2' abt '[] 'HNat -> SArgs abt '[] -> SArgs abt '[LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  -- BUG: Only defined for HContinuous_Real
  inferPrimOp PrimOp
U.Erf [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HReal
e' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HReal -> TypedAST abt)
-> abt '[] 'HReal
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HReal -> abt '[] 'HReal -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HReal
SReal (abt '[] 'HReal -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HReal -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt 'HReal -> abt '[] 'HReal
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HReal] 'HReal -> SCon '[LC 'HReal] 'HReal
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HContinuous 'HReal -> PrimOp '[ 'HReal] 'HReal
forall (a :: Hakaru). HContinuous a -> PrimOp '[a] a
Erf HContinuous 'HReal
HContinuous_Real)
                              SCon '[LC 'HReal] 'HReal
-> SArgs abt '[LC 'HReal] -> Term abt 'HReal
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
x [AST]
es
      | Just PrimOp '[ 'HReal] 'HReal
y <- PrimOp
-> [(PrimOp, PrimOp '[ 'HReal] 'HReal)]
-> Maybe (PrimOp '[ 'HReal] 'HReal)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PrimOp
x
                 [(PrimOp
U.Sin  , PrimOp '[ 'HReal] 'HReal
Sin  ),
                  (PrimOp
U.Cos  , PrimOp '[ 'HReal] 'HReal
Cos  ),
                  (PrimOp
U.Tan  , PrimOp '[ 'HReal] 'HReal
Tan  ),
                  (PrimOp
U.Asin , PrimOp '[ 'HReal] 'HReal
Asin ),
                  (PrimOp
U.Acos , PrimOp '[ 'HReal] 'HReal
Acos ),
                  (PrimOp
U.Atan , PrimOp '[ 'HReal] 'HReal
Atan ),
                  (PrimOp
U.Sinh , PrimOp '[ 'HReal] 'HReal
Sinh ),
                  (PrimOp
U.Cosh , PrimOp '[ 'HReal] 'HReal
Cosh ),
                  (PrimOp
U.Tanh , PrimOp '[ 'HReal] 'HReal
Tanh ),
                  (PrimOp
U.Asinh, PrimOp '[ 'HReal] 'HReal
Asinh),
                  (PrimOp
U.Acosh, PrimOp '[ 'HReal] 'HReal
Acosh),
                  (PrimOp
U.Atanh, PrimOp '[ 'HReal] 'HReal
Atanh)] =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HReal
e' <- Sing 'HReal -> AST -> TypeCheckMonad (abt '[] 'HReal)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HReal
SReal AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HReal -> TypedAST abt)
-> abt '[] 'HReal
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HReal -> abt '[] 'HReal -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HReal
SReal (abt '[] 'HReal -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HReal -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                         Term abt 'HReal -> abt '[] 'HReal
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HReal] 'HReal -> SCon '[LC 'HReal] 'HReal
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HReal] 'HReal
y SCon '[LC 'HReal] 'HReal
-> SArgs abt '[LC 'HReal] -> Term abt 'HReal
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HReal
e' abt '[] 'HReal -> SArgs abt '[] -> SArgs abt '[LC 'HReal]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
U.Floor [AST]
es =
      case [AST]
es of
        [AST
e] -> do abt '[] 'HProb
e' <- Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
e
                  TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HNat -> TypedAST abt)
-> abt '[] 'HNat
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HNat -> abt '[] 'HNat -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HNat
SNat (abt '[] 'HNat -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HNat -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ Term abt 'HNat -> abt '[] 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[ 'HProb] 'HNat -> SCon '[ '( '[], 'HProb)] 'HNat
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ PrimOp '[ 'HProb] 'HNat
Floor SCon '[ '( '[], 'HProb)] 'HNat
-> SArgs abt '[ '( '[], 'HProb)] -> Term abt 'HNat
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HProb
e' abt '[] 'HProb -> SArgs abt '[] -> SArgs abt '[ '( '[], 'HProb)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferPrimOp PrimOp
x [AST]
_ = [Char] -> TypeCheckMonad (TypedAST abt)
forall a. HasCallStack => [Char] -> a
error ([Char]
"TODO: inferPrimOp: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PrimOp -> [Char]
forall a. Show a => a -> [Char]
show PrimOp
x)


  inferArrayOp :: U.ArrayOp
               -> [U.AST]
               -> TypeCheckMonad (TypedAST abt)
  inferArrayOp :: ArrayOp -> [AST] -> TypeCheckMonad (TypedAST abt)
inferArrayOp ArrayOp
U.Index_ [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2] -> do TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
                       Unify1 'HArray (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing b
typ1 Maybe SourceSpan
forall a. Maybe a
Nothing ((forall (a :: Hakaru).
  (b ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
                        abt '[] 'HNat
e2' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e2
                        TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] a -> TypedAST abt)
-> abt '[] a
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing a -> abt '[] a -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing a
typ2 (abt '[] a -> TypeCheckMonad (TypedAST abt))
-> abt '[] a -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                               Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[ 'HArray a, 'HNat] a -> SCon '[ '( '[], b), LC 'HNat] a
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ (Sing a -> ArrayOp '[ 'HArray a, 'HNat] a
forall (a :: Hakaru). Sing a -> ArrayOp '[ 'HArray a, 'HNat] a
Index Sing a
typ2) SCon '[ '( '[], b), LC 'HNat] a
-> SArgs abt '[ '( '[], b), LC 'HNat] -> Term abt a
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[LC 'HNat] -> SArgs abt '[ '( '[], b), LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] 'HNat
e2' abt '[] 'HNat -> SArgs abt '[] -> SArgs abt '[LC 'HNat]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_        -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferArrayOp ArrayOp
U.Size [AST]
es =
      case [AST]
es of
        [AST
e] -> do TypedAST Sing b
typ abt '[] b
e' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e
                  Unify1 'HArray (TypedAST abt) b
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing b
typ Maybe SourceSpan
forall a. Maybe a
Nothing ((forall (a :: Hakaru).
  (b ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    (b ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 ->
                   TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] 'HNat -> TypedAST abt)
-> abt '[] 'HNat
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing 'HNat -> abt '[] 'HNat -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing 'HNat
SNat (abt '[] 'HNat -> TypeCheckMonad (TypedAST abt))
-> abt '[] 'HNat -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                          Term abt 'HNat -> abt '[] 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[ 'HArray a] 'HNat -> SCon '[ '( '[], b)] 'HNat
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ (Sing a -> ArrayOp '[ 'HArray a] 'HNat
forall (a :: Hakaru). Sing a -> ArrayOp '[ 'HArray a] 'HNat
Size Sing a
typ1) SCon '[ '( '[], b)] 'HNat
-> SArgs abt '[ '( '[], b)] -> Term abt 'HNat
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e' abt '[] b -> SArgs abt '[] -> SArgs abt '[ '( '[], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_   -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferArrayOp ArrayOp
U.Reduce [AST]
es =
      case [AST]
es of
        [AST
e1, AST
e2, AST
e3] -> do
           TypedAST Sing b
typ abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
           Unify2 (':->) (TypedAST abt) b
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun Sing b
typ Maybe SourceSpan
forall a. Maybe a
Nothing ((forall (a :: Hakaru) (b :: Hakaru).
  (b ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (b ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 Sing b
typ2 -> do
            TypeEq b (a ':-> a)
Refl <- Sing b -> Sing (a ':-> a) -> TypeCheckMonad (TypeEq b (a ':-> a))
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> TypeCheckMonad (TypeEq a b)
jmEq1_ Sing b
typ2 (Sing a -> Sing a -> Sing (a ':-> a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typ1 Sing a
typ1)
            abt '[] a
e2' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ1 AST
e2
            abt '[] ('HArray a)
e3' <- Sing ('HArray a) -> AST -> TypeCheckMonad (abt '[] ('HArray a))
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ (Sing a -> Sing ('HArray a)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray Sing a
typ1) AST
e3
            TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> (abt '[] a -> TypedAST abt)
-> abt '[] a
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing a -> abt '[] a -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing a
typ1 (abt '[] a -> TypeCheckMonad (TypedAST abt))
-> abt '[] a -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$
                   Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
-> SCon '[ '( '[], b), '( '[], a), '( '[], 'HArray a)] a
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
ArrayOp typs a -> SCon args a
ArrayOp_ (Sing a -> ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
forall (a :: Hakaru).
Sing a -> ArrayOp '[ a ':-> (a ':-> a), a, 'HArray a] a
Reduce Sing a
typ1)
                        SCon '[ '( '[], b), '( '[], a), '( '[], 'HArray a)] a
-> SArgs abt '[ '( '[], b), '( '[], a), '( '[], 'HArray a)]
-> Term abt a
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[], a), '( '[], 'HArray a)]
-> SArgs abt '[ '( '[], b), '( '[], a), '( '[], 'HArray a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
e2' abt '[] a
-> SArgs abt '[ '( '[], 'HArray a)]
-> SArgs abt '[ '( '[], a), '( '[], 'HArray a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] ('HArray a)
e3' abt '[] ('HArray a)
-> SArgs abt '[] -> SArgs abt '[ '( '[], 'HArray a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
        [AST]
_            -> TypeCheckMonad (TypedAST abt)
forall r. TypeCheckMonad r
argumentNumberError

  inferReducer :: U.Reducer xs U.U_ABT 'U.U
               -> List1 Variable xs1
               -> TypeCheckMonad (TypedReducer abt xs1)

  inferReducer :: Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer (U.R_Fanout_ Reducer xs (MetaABT SourceSpan Term) 'U
r1 Reducer xs (MetaABT SourceSpan Term) 'U
r2) List1 Variable xs1
xs = do
      TypedReducer Sing b
t1 List1 Variable xs1
_ Reducer abt xs1 b
r1' <- Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
r1 List1 Variable xs1
xs
      TypedReducer Sing b
t2 List1 Variable xs1
_ Reducer abt xs1 b
r2' <- Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
r2 List1 Variable xs1
xs
      TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing (HPair b b)
-> List1 Variable xs1
-> Reducer abt xs1 (HPair b b)
-> TypedReducer abt xs1
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (b :: Hakaru).
Sing b
-> List1 Variable xs -> Reducer abt xs b -> TypedReducer abt xs
TypedReducer (Sing b -> Sing b -> Sing (HPair b b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair Sing b
t1 Sing b
t2) List1 Variable xs1
xs (Reducer abt xs1 b
-> Reducer abt xs1 b -> Reducer abt xs1 (HPair b b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru) (b :: Hakaru).
Reducer abt xs a -> Reducer abt xs b -> Reducer abt xs (HPair a b)
Red_Fanout Reducer abt xs1 b
r1' Reducer abt xs1 b
r2'))

  inferReducer (U.R_Index_ Variable 'U
x U_ABT xs 'U
n U_ABT ('U : xs) 'U
ix Reducer ('U : xs) (MetaABT SourceSpan Term) 'U
r1) List1 Variable xs1
xs = do
      let (List1 Variable xs
_, AST
n') = U_ABT xs 'U -> (List1 Variable xs, AST)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> (List1 Variable xs, abt '[] a)
caseBinds U_ABT xs 'U
n
      let b :: Variable 'HNat
b = Variable 'U -> Sing 'HNat -> Variable 'HNat
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing 'HNat
SNat
      TypedReducer Sing b
t1 List1 Variable ('HNat : xs1)
_ Reducer abt ('HNat : xs1) b
r1' <- Reducer ('U : xs) (MetaABT SourceSpan Term) 'U
-> List1 Variable ('HNat : xs1)
-> TypeCheckMonad (TypedReducer abt ('HNat : xs1))
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer ('U : xs) (MetaABT SourceSpan Term) 'U
r1 (Variable 'HNat
-> List1 Variable xs1 -> List1 Variable ('HNat : xs1)
forall a (a :: a -> *) (x :: a) (xs :: [a]).
a x -> List1 a xs -> List1 a (x : xs)
Cons1 Variable 'HNat
b List1 Variable xs1
xs)
      abt xs1 'HNat
n'' <- List1 Variable xs1
-> Sing 'HNat -> AST -> TypeCheckMonad (abt xs1 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
ABT Term abt =>
List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable xs1
xs Sing 'HNat
SNat AST
n'
      U_ABT ('U : xs) 'U
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT ('U : xs) 'U
ix ((Variable 'U
  -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
 -> TypeCheckMonad (TypedReducer abt xs1))
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
i U_ABT xs 'U
ix1 ->
          let i' :: Variable 'HNat
i' = Variable 'U -> Sing 'HNat -> Variable 'HNat
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
i Sing 'HNat
SNat
              (List1 Variable xs
_, AST
ix2) = U_ABT xs 'U -> (List1 Variable xs, AST)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> (List1 Variable xs, abt '[] a)
caseBinds U_ABT xs 'U
ix1 in do
          abt xs1 'HNat
ix3 <- Variable 'HNat
-> TypeCheckMonad (abt xs1 'HNat) -> TypeCheckMonad (abt xs1 'HNat)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable 'HNat
i' (List1 Variable xs1
-> Sing 'HNat -> AST -> TypeCheckMonad (abt xs1 'HNat)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
ABT Term abt =>
List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable xs1
xs Sing 'HNat
SNat AST
ix2)
          TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1))
-> (Reducer abt xs1 ('HArray b) -> TypedReducer abt xs1)
-> Reducer abt xs1 ('HArray b)
-> TypeCheckMonad (TypedReducer abt xs1)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing ('HArray b)
-> List1 Variable xs1
-> Reducer abt xs1 ('HArray b)
-> TypedReducer abt xs1
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (b :: Hakaru).
Sing b
-> List1 Variable xs -> Reducer abt xs b -> TypedReducer abt xs
TypedReducer (Sing b -> Sing ('HArray b)
forall (a :: Hakaru). Sing a -> Sing ('HArray a)
SArray Sing b
t1) List1 Variable xs1
xs (Reducer abt xs1 ('HArray b)
 -> TypeCheckMonad (TypedReducer abt xs1))
-> Reducer abt xs1 ('HArray b)
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$
                 abt xs1 'HNat
-> abt ('HNat : xs1) 'HNat
-> Reducer abt ('HNat : xs1) b
-> Reducer abt xs1 ('HArray b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
abt xs 'HNat
-> abt ('HNat : xs) 'HNat
-> Reducer abt ('HNat : xs) a
-> Reducer abt xs ('HArray a)
Red_Index abt xs1 'HNat
n'' (Variable 'HNat -> abt xs1 'HNat -> abt ('HNat : xs1) 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
i' abt xs1 'HNat
ix3) Reducer abt ('HNat : xs1) b
r1'

  inferReducer (U.R_Split_ U_ABT ('U : xs) 'U
b Reducer xs (MetaABT SourceSpan Term) 'U
r1 Reducer xs (MetaABT SourceSpan Term) 'U
r2) List1 Variable xs1
xs = do
      TypedReducer Sing b
t1 List1 Variable xs1
_ Reducer abt xs1 b
r1' <- Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
r1 List1 Variable xs1
xs
      TypedReducer Sing b
t2 List1 Variable xs1
_ Reducer abt xs1 b
r2' <- Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (xs :: [Untyped]) (xs1 :: [Hakaru]).
Reducer xs (MetaABT SourceSpan Term) 'U
-> List1 Variable xs1 -> TypeCheckMonad (TypedReducer abt xs1)
inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
r2 List1 Variable xs1
xs
      U_ABT ('U : xs) 'U
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT ('U : xs) 'U
b ((Variable 'U
  -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
 -> TypeCheckMonad (TypedReducer abt xs1))
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x U_ABT xs 'U
b1 ->
       let (List1 Variable xs
_, AST
b2) = U_ABT xs 'U -> (List1 Variable xs, AST)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> (List1 Variable xs, abt '[] a)
caseBinds U_ABT xs 'U
b1
           x' :: Variable 'HNat
x'  = Variable 'U -> Sing 'HNat -> Variable 'HNat
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing 'HNat
SNat in do
           abt xs1 HBool
b3 <- Variable 'HNat
-> TypeCheckMonad (abt xs1 HBool) -> TypeCheckMonad (abt xs1 HBool)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable 'HNat
x' (List1 Variable xs1
-> Sing HBool -> AST -> TypeCheckMonad (abt xs1 HBool)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
ABT Term abt =>
List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable xs1
xs Sing HBool
sBool AST
b2)
           TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1))
-> (Reducer abt xs1 (HPair b b) -> TypedReducer abt xs1)
-> Reducer abt xs1 (HPair b b)
-> TypeCheckMonad (TypedReducer abt xs1)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing (HPair b b)
-> List1 Variable xs1
-> Reducer abt xs1 (HPair b b)
-> TypedReducer abt xs1
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (b :: Hakaru).
Sing b
-> List1 Variable xs -> Reducer abt xs b -> TypedReducer abt xs
TypedReducer (Sing b -> Sing b -> Sing (HPair b b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair Sing b
t1 Sing b
t2) List1 Variable xs1
xs (Reducer abt xs1 (HPair b b)
 -> TypeCheckMonad (TypedReducer abt xs1))
-> Reducer abt xs1 (HPair b b)
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$
                  (abt ('HNat : xs1) HBool
-> Reducer abt xs1 b
-> Reducer abt xs1 b
-> Reducer abt xs1 (HPair b b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru) (b :: Hakaru).
abt ('HNat : xs) HBool
-> Reducer abt xs a
-> Reducer abt xs b
-> Reducer abt xs (HPair a b)
Red_Split (Variable 'HNat -> abt xs1 HBool -> abt ('HNat : xs1) HBool
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
x' abt xs1 HBool
b3) Reducer abt xs1 b
r1' Reducer abt xs1 b
r2')

  inferReducer Reducer xs (MetaABT SourceSpan Term) 'U
U.R_Nop_ List1 Variable xs1
xs = TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing HUnit
-> List1 Variable xs1
-> Reducer abt xs1 HUnit
-> TypedReducer abt xs1
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (b :: Hakaru).
Sing b
-> List1 Variable xs -> Reducer abt xs b -> TypedReducer abt xs
TypedReducer Sing HUnit
sUnit List1 Variable xs1
xs Reducer abt xs1 HUnit
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]).
Reducer abt xs HUnit
Red_Nop)

  inferReducer (U.R_Add_ U_ABT ('U : xs) 'U
e) List1 Variable xs1
xs =
      U_ABT ('U : xs) 'U
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (x :: k) (xs :: [k]) (a :: k) r.
ABT syn abt =>
abt (x : xs) a -> (Variable x -> abt xs a -> r) -> r
caseBind U_ABT ('U : xs) 'U
e ((Variable 'U
  -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
 -> TypeCheckMonad (TypedReducer abt xs1))
-> (Variable 'U
    -> U_ABT xs 'U -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$ \Variable 'U
x U_ABT xs 'U
e1 ->
      let (List1 Variable xs
_, AST
e2) = U_ABT xs 'U -> (List1 Variable xs, AST)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (xs :: [k]) (a :: k).
ABT syn abt =>
abt xs a -> (List1 Variable xs, abt '[] a)
caseBinds U_ABT xs 'U
e1
          x' :: Variable 'HNat
x'  = Variable 'U -> Sing 'HNat -> Variable 'HNat
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar Variable 'U
x Sing 'HNat
SNat in
          Variable 'HNat
-> TypeCheckMonad (TypedReducer abt xs1)
-> TypeCheckMonad (TypedReducer abt xs1)
forall (a :: Hakaru) b.
Variable a -> TypeCheckMonad b -> TypeCheckMonad b
pushCtx Variable 'HNat
x' (TypeCheckMonad (TypedReducer abt xs1)
 -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$
            List1 Variable xs1
-> AST
-> (forall (a :: Hakaru).
    Sing a -> abt xs1 a -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]) r.
ABT Term abt =>
List1 Variable xs
-> AST
-> (forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinders List1 Variable xs1
xs AST
e2 ((forall (a :: Hakaru).
  Sing a -> abt xs1 a -> TypeCheckMonad (TypedReducer abt xs1))
 -> TypeCheckMonad (TypedReducer abt xs1))
-> (forall (a :: Hakaru).
    Sing a -> abt xs1 a -> TypeCheckMonad (TypedReducer abt xs1))
-> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ abt xs1 a
e3 -> do
              HSemiring a
h <- Sing a -> TypeCheckMonad (HSemiring a)
forall (a :: Hakaru). Sing a -> TypeCheckMonad (HSemiring a)
getHSemiring Sing a
typ
              TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1))
-> TypedReducer abt xs1 -> TypeCheckMonad (TypedReducer abt xs1)
forall a b. (a -> b) -> a -> b
$ Sing a
-> List1 Variable xs1 -> Reducer abt xs1 a -> TypedReducer abt xs1
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (b :: Hakaru).
Sing b
-> List1 Variable xs -> Reducer abt xs b -> TypedReducer abt xs
TypedReducer Sing a
typ List1 Variable xs1
xs (HSemiring a -> abt ('HNat : xs1) a -> Reducer abt xs1 a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *)
       (xs :: [Hakaru]).
HSemiring a -> abt ('HNat : xs) a -> Reducer abt xs a
Red_Add HSemiring a
h (Variable 'HNat -> abt xs1 a -> abt ('HNat : xs1) a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'HNat
x' abt xs1 a
e3))

-- TODO: can we make this lazier in the second component of 'TypedASTs'
-- so that we can perform case analysis on the type component before
-- actually evaluating 'checkOthers'? Problem is, even though we
-- have the type to return we don't know whether the whole thing
-- will succeed or not until after calling 'checkOthers'... We could
-- handle this by changing the return type to @TypeCheckMonad (exists
-- b. (Sing b, TypeCheckMonad [abt '[] b]))@ thereby making the
-- staging explicit.
--
-- | Given a list of terms which must all have the same type, try
-- inferring each term in order until one of them succeeds and then
-- check all the others against that type. This is appropriate for
-- 'StrictMode' where we won't need to insert coercions; for
-- 'LaxMode', see 'inferLubType' instead.
inferOneCheckOthers
    :: forall abt
    .  (ABT Term abt)
    => [U.AST]
    -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers :: [AST] -> TypeCheckMonad (TypedASTs abt)
inferOneCheckOthers = [AST] -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOne []
    where
    inferOne :: [U.AST] -> [U.AST] -> TypeCheckMonad (TypedASTs abt)
    inferOne :: [AST] -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOne [AST]
ls []
        | [AST] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AST]
ls   = Maybe SourceSpan -> TypeCheckMonad (TypedASTs abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousEmptyNary Maybe SourceSpan
forall a. Maybe a
Nothing
        | Bool
otherwise = Maybe SourceSpan -> TypeCheckMonad (TypedASTs abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousMustCheckNary Maybe SourceSpan
forall a. Maybe a
Nothing
    inferOne [AST]
ls (AST
e:[AST]
rs) = do
        Maybe (TypedAST abt)
m <- TypeCheckMonad (TypedAST abt)
-> TypeCheckMonad (Maybe (TypedAST abt))
forall a. TypeCheckMonad a -> TypeCheckMonad (Maybe a)
try (TypeCheckMonad (TypedAST abt)
 -> TypeCheckMonad (Maybe (TypedAST abt)))
-> TypeCheckMonad (TypedAST abt)
-> TypeCheckMonad (Maybe (TypedAST abt))
forall a b. (a -> b) -> a -> b
$ AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e
        case Maybe (TypedAST abt)
m of
            Maybe (TypedAST abt)
Nothing                -> [AST] -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferOne (AST
eAST -> [AST] -> [AST]
forall a. a -> [a] -> [a]
:[AST]
ls) [AST]
rs
            Just (TypedAST Sing b
typ abt '[] b
e') -> do
                [abt '[] b]
ls' <- Sing b -> [AST] -> TypeCheckMonad [abt '[] b]
forall (a :: Hakaru). Sing a -> [AST] -> TypeCheckMonad [abt '[] a]
checkOthers Sing b
typ [AST]
ls
                [abt '[] b]
rs' <- Sing b -> [AST] -> TypeCheckMonad [abt '[] b]
forall (a :: Hakaru). Sing a -> [AST] -> TypeCheckMonad [abt '[] a]
checkOthers Sing b
typ [AST]
rs
                TypedASTs abt -> TypeCheckMonad (TypedASTs abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing b -> [abt '[] b] -> TypedASTs abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> [abt '[] b] -> TypedASTs abt
TypedASTs Sing b
typ ([abt '[] b] -> [abt '[] b]
forall a. [a] -> [a]
reverse [abt '[] b]
ls' [abt '[] b] -> [abt '[] b] -> [abt '[] b]
forall a. [a] -> [a] -> [a]
++ abt '[] b
e' abt '[] b -> [abt '[] b] -> [abt '[] b]
forall a. a -> [a] -> [a]
: [abt '[] b]
rs'))

    checkOthers
        :: forall a. Sing a -> [U.AST] -> TypeCheckMonad [abt '[] a]
    checkOthers :: Sing a -> [AST] -> TypeCheckMonad [abt '[] a]
checkOthers Sing a
typ = (AST -> TypeCheckMonad (abt '[] a))
-> [AST] -> TypeCheckMonad [abt '[] a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType Sing a
typ)

-- | Given a list of terms which must all have the same type, infer
-- all the terms in order and coerce them to the lub of all their
-- types. This is appropriate for 'LaxMode' where we need to insert
-- coercions; for 'StrictMode', see 'inferOneCheckOthers' instead.
inferLubType
    :: forall abt
    .  (ABT Term abt)
    => Maybe U.SourceSpan
    -> [U.AST]
    -> TypeCheckMonad (TypedASTs abt)
inferLubType :: Maybe SourceSpan -> [AST] -> TypeCheckMonad (TypedASTs abt)
inferLubType Maybe SourceSpan
s = [AST] -> TypeCheckMonad (TypedASTs abt)
start
    where
    start :: [U.AST] -> TypeCheckMonad (TypedASTs abt)
    start :: [AST] -> TypeCheckMonad (TypedASTs abt)
start []     = Maybe SourceSpan -> TypeCheckMonad (TypedASTs abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousEmptyNary Maybe SourceSpan
forall a. Maybe a
Nothing
    start (AST
u:[AST]
us) = do
        TypedAST  Sing b
typ1 abt '[] b
e1 <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
u
        TypedASTs Sing b
typ2 [abt '[] b]
es <- (TypedASTs abt -> AST -> TypeCheckMonad (TypedASTs abt))
-> TypedASTs abt -> [AST] -> TypeCheckMonad (TypedASTs abt)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM TypedASTs abt -> AST -> TypeCheckMonad (TypedASTs abt)
step (Sing b -> [abt '[] b] -> TypedASTs abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> [abt '[] b] -> TypedASTs abt
TypedASTs Sing b
typ1 [abt '[] b
e1]) [AST]
us
        TypedASTs abt -> TypeCheckMonad (TypedASTs abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing b -> [abt '[] b] -> TypedASTs abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> [abt '[] b] -> TypedASTs abt
TypedASTs Sing b
typ2 ([abt '[] b] -> [abt '[] b]
forall a. [a] -> [a]
reverse [abt '[] b]
es))

    -- TODO: inline 'F.foldlM' and then inline this, to unpack the first argument.
    step :: TypedASTs abt -> U.AST -> TypeCheckMonad (TypedASTs abt)
    step :: TypedASTs abt -> AST -> TypeCheckMonad (TypedASTs abt)
step (TypedASTs Sing b
typ1 [abt '[] b]
es) AST
u = do
        TypedAST Sing b
typ2 abt '[] b
e2 <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
u
        case Sing b -> Sing b -> Maybe (Lub b b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Maybe (Lub a b)
findLub Sing b
typ1 Sing b
typ2 of
            Maybe (Lub b b)
Nothing              -> Sing b
-> Sing b -> Maybe SourceSpan -> TypeCheckMonad (TypedASTs abt)
forall (a :: Hakaru) (b :: Hakaru) r.
Sing a -> Sing b -> Maybe SourceSpan -> TypeCheckMonad r
missingLub Sing b
typ1 Sing b
typ2 Maybe SourceSpan
s
            Just (Lub Sing c
typ Coercion b c
c1 Coercion b c
c2) ->
                let es' :: [abt '[] c]
es' = (abt '[] b -> abt '[] c) -> [abt '[] b] -> [abt '[] c]
forall a b. (a -> b) -> [a] -> [b]
map (LC_ abt c -> abt '[] c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt c -> abt '[] c)
-> (abt '[] b -> LC_ abt c) -> abt '[] b -> abt '[] c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b c -> LC_ abt b -> LC_ abt c
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b c
c1 (LC_ abt b -> LC_ abt c)
-> (abt '[] b -> LC_ abt b) -> abt '[] b -> LC_ abt c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_) [abt '[] b]
es
                    e2' :: abt '[] c
e2' = LC_ abt c -> abt '[] c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt c -> abt '[] c)
-> (LC_ abt b -> LC_ abt c) -> LC_ abt b -> abt '[] c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b c -> LC_ abt b -> LC_ abt c
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b c
c2 (LC_ abt b -> abt '[] c) -> LC_ abt b -> abt '[] c
forall a b. (a -> b) -> a -> b
$ abt '[] b -> LC_ abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] b
e2
                in TypedASTs abt -> TypeCheckMonad (TypedASTs abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing c -> [abt '[] c] -> TypedASTs abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> [abt '[] b] -> TypedASTs abt
TypedASTs Sing c
typ (abt '[] c
e2' abt '[] c -> [abt '[] c] -> [abt '[] c]
forall a. a -> [a] -> [a]
: [abt '[] c]
es'))


inferCaseStrict
    :: forall abt a
    .  (ABT Term abt)
    => Sing a
    -> abt '[] a
    -> [U.Branch]
    -> TypeCheckMonad (TypedAST abt)
inferCaseStrict :: Sing a
-> abt '[] a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferCaseStrict Sing a
typA abt '[] a
e1 = [Branch_ (MetaABT SourceSpan Term)]
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferOne []
    where
    inferOne :: [U.Branch] -> [U.Branch] -> TypeCheckMonad (TypedAST abt)
    inferOne :: [Branch_ (MetaABT SourceSpan Term)]
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferOne [Branch_ (MetaABT SourceSpan Term)]
ls []
        | [Branch_ (MetaABT SourceSpan Term)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Branch_ (MetaABT SourceSpan Term)]
ls   = Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousEmptyNary Maybe SourceSpan
forall a. Maybe a
Nothing
        | Bool
otherwise = Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousMustCheckNary Maybe SourceSpan
forall a. Maybe a
Nothing
    inferOne [Branch_ (MetaABT SourceSpan Term)]
ls (b :: Branch_ (MetaABT SourceSpan Term)
b@(U.Branch_ Pattern
pat AST
e):[Branch_ (MetaABT SourceSpan Term)]
rs) = do
        SP Pattern vars a
pat' List1 Variable vars
vars <- Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing a
typA Pattern
pat
        Maybe (TypedAST abt)
m <- TypeCheckMonad (TypedAST abt)
-> TypeCheckMonad (Maybe (TypedAST abt))
forall a. TypeCheckMonad a -> TypeCheckMonad (Maybe a)
try (TypeCheckMonad (TypedAST abt)
 -> TypeCheckMonad (Maybe (TypedAST abt)))
-> TypeCheckMonad (TypedAST abt)
-> TypeCheckMonad (Maybe (TypedAST abt))
forall a b. (a -> b) -> a -> b
$ List1 Variable vars
-> AST
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]) r.
ABT Term abt =>
List1 Variable xs
-> AST
-> (forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinders List1 Variable vars
vars AST
e ((forall (a :: Hakaru).
  Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ abt vars a
e' -> do
                    [Branch a abt a]
ls' <- Sing a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt a]
forall (b :: Hakaru).
Sing b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt b]
checkOthers Sing a
typ [Branch_ (MetaABT SourceSpan Term)]
ls
                    [Branch a abt a]
rs' <- Sing a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt a]
forall (b :: Hakaru).
Sing b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt b]
checkOthers Sing a
typ [Branch_ (MetaABT SourceSpan Term)]
rs
                    TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Sing a -> abt '[] a -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing a
typ (abt '[] a -> TypedAST abt) -> abt '[] a -> TypedAST abt
forall a b. (a -> b) -> a -> b
$ Term abt a -> abt '[] a
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] a -> [Branch a abt a] -> Term abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
abt '[] a -> [Branch a abt b] -> Term abt b
Case_ abt '[] a
e1 ([Branch a abt a] -> [Branch a abt a]
forall a. [a] -> [a]
reverse [Branch a abt a]
ls' [Branch a abt a] -> [Branch a abt a] -> [Branch a abt a]
forall a. [a] -> [a] -> [a]
++ (Pattern vars a -> abt vars a -> Branch a abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern vars a
pat' abt vars a
e') Branch a abt a -> [Branch a abt a] -> [Branch a abt a]
forall a. a -> [a] -> [a]
: [Branch a abt a]
rs')))
        case Maybe (TypedAST abt)
m of
            Maybe (TypedAST abt)
Nothing -> [Branch_ (MetaABT SourceSpan Term)]
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferOne (Branch_ (MetaABT SourceSpan Term)
bBranch_ (MetaABT SourceSpan Term)
-> [Branch_ (MetaABT SourceSpan Term)]
-> [Branch_ (MetaABT SourceSpan Term)]
forall a. a -> [a] -> [a]
:[Branch_ (MetaABT SourceSpan Term)]
ls) [Branch_ (MetaABT SourceSpan Term)]
rs
            Just TypedAST abt
m' -> TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return TypedAST abt
m'

    checkOthers
        :: forall b. Sing b -> [U.Branch] -> TypeCheckMonad [Branch a abt b]
    checkOthers :: Sing b
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt b]
checkOthers Sing b
typ = (Branch_ (MetaABT SourceSpan Term)
 -> TypeCheckMonad (Branch a abt b))
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad [Branch a abt b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (Sing a
-> Sing b
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (Branch a abt b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a
-> Sing b
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (Branch a abt b)
checkBranch Sing a
typA Sing b
typ)

inferCaseLax
    :: forall abt a
    .  (ABT Term abt)
    => Maybe U.SourceSpan
    -> Sing a
    -> abt '[] a
    -> [U.Branch]
    -> TypeCheckMonad (TypedAST abt)
inferCaseLax :: Maybe SourceSpan
-> Sing a
-> abt '[] a
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
inferCaseLax Maybe SourceSpan
s Sing a
typA abt '[] a
e1 = [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
start
    where
    start :: [U.Branch] -> TypeCheckMonad (TypedAST abt)
    start :: [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (TypedAST abt)
start []     = Maybe SourceSpan -> TypeCheckMonad (TypedAST abt)
forall r. Maybe SourceSpan -> TypeCheckMonad r
ambiguousEmptyNary Maybe SourceSpan
forall a. Maybe a
Nothing
    start ((U.Branch_ Pattern
pat AST
e):[Branch_ (MetaABT SourceSpan Term)]
us) = do
        SP Pattern vars a
pat' List1 Variable vars
vars <- Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing a
typA Pattern
pat
        List1 Variable vars
-> AST
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]) r.
ABT Term abt =>
List1 Variable xs
-> AST
-> (forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinders List1 Variable vars
vars AST
e ((forall (a :: Hakaru).
  Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
 -> TypeCheckMonad (TypedAST abt))
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (TypedAST abt))
-> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 abt vars a
e' -> do
            SomeBranch Sing b
typ2 [Branch a abt b]
bs <- (SomeBranch a abt
 -> Branch_ (MetaABT SourceSpan Term)
 -> TypeCheckMonad (SomeBranch a abt))
-> SomeBranch a abt
-> [Branch_ (MetaABT SourceSpan Term)]
-> TypeCheckMonad (SomeBranch a abt)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM SomeBranch a abt
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (SomeBranch a abt)
step (Sing a -> [Branch a abt a] -> SomeBranch a abt
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *)
       (b :: Hakaru).
Sing b -> [Branch a abt b] -> SomeBranch a abt
SomeBranch Sing a
typ1 [Pattern vars a -> abt vars a -> Branch a abt a
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern vars a
pat' abt vars a
e']) [Branch_ (MetaABT SourceSpan Term)]
us
            TypedAST abt -> TypeCheckMonad (TypedAST abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypedAST abt -> TypeCheckMonad (TypedAST abt))
-> ([Branch a abt b] -> TypedAST abt)
-> [Branch a abt b]
-> TypeCheckMonad (TypedAST abt)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Sing b -> abt '[] b -> TypedAST abt
forall (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru).
Sing b -> abt '[] b -> TypedAST abt
TypedAST Sing b
typ2 (abt '[] b -> TypedAST abt)
-> ([Branch a abt b] -> abt '[] b)
-> [Branch a abt b]
-> TypedAST abt
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt b -> abt '[] b)
-> ([Branch a abt b] -> Term abt b)
-> [Branch a abt b]
-> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. abt '[] a -> [Branch a abt b] -> Term abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
abt '[] a -> [Branch a abt b] -> Term abt b
Case_ abt '[] a
e1 ([Branch a abt b] -> TypeCheckMonad (TypedAST abt))
-> [Branch a abt b] -> TypeCheckMonad (TypedAST abt)
forall a b. (a -> b) -> a -> b
$ [Branch a abt b] -> [Branch a abt b]
forall a. [a] -> [a]
reverse [Branch a abt b]
bs

    -- TODO: inline 'F.foldlM' and then inline this, to unpack the first argument.
    step :: SomeBranch a abt
        -> U.Branch
        -> TypeCheckMonad (SomeBranch a abt)
    step :: SomeBranch a abt
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (SomeBranch a abt)
step (SomeBranch Sing b
typB [Branch a abt b]
bs) (U.Branch_ Pattern
pat AST
e) = do
        SP Pattern vars a
pat' List1 Variable vars
vars <- Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing a
typA Pattern
pat
        List1 Variable vars
-> AST
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (SomeBranch a abt))
-> TypeCheckMonad (SomeBranch a abt)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru]) r.
ABT Term abt =>
List1 Variable xs
-> AST
-> (forall (a :: Hakaru). Sing a -> abt xs a -> TypeCheckMonad r)
-> TypeCheckMonad r
inferBinders List1 Variable vars
vars AST
e ((forall (a :: Hakaru).
  Sing a -> abt vars a -> TypeCheckMonad (SomeBranch a abt))
 -> TypeCheckMonad (SomeBranch a abt))
-> (forall (a :: Hakaru).
    Sing a -> abt vars a -> TypeCheckMonad (SomeBranch a abt))
-> TypeCheckMonad (SomeBranch a abt)
forall a b. (a -> b) -> a -> b
$ \Sing a
typE abt vars a
e' ->
            case Sing b -> Sing a -> Maybe (Lub b a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Maybe (Lub a b)
findLub Sing b
typB Sing a
typE of
            Maybe (Lub b a)
Nothing                     -> Sing b
-> Sing a -> Maybe SourceSpan -> TypeCheckMonad (SomeBranch a abt)
forall (a :: Hakaru) (b :: Hakaru) r.
Sing a -> Sing b -> Maybe SourceSpan -> TypeCheckMonad r
missingLub Sing b
typB Sing a
typE Maybe SourceSpan
s
            Just (Lub Sing c
typLub Coercion b c
coeB Coercion a c
coeE) ->
                SomeBranch a abt -> TypeCheckMonad (SomeBranch a abt)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBranch a abt -> TypeCheckMonad (SomeBranch a abt))
-> SomeBranch a abt -> TypeCheckMonad (SomeBranch a abt)
forall a b. (a -> b) -> a -> b
$ Sing c -> [Branch a abt c] -> SomeBranch a abt
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *)
       (b :: Hakaru).
Sing b -> [Branch a abt b] -> SomeBranch a abt
SomeBranch Sing c
typLub
                    ( Pattern vars a -> abt vars c -> Branch a abt c
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern vars a
pat' (Coercion a c -> abt vars a -> abt vars c
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru) (b :: Hakaru)
       (xs :: [Hakaru]).
ABT Term abt =>
Coercion a b -> abt xs a -> abt xs b
coerceTo_nonLC Coercion a c
coeE abt vars a
e')
                    Branch a abt c -> [Branch a abt c] -> [Branch a abt c]
forall a. a -> [a] -> [a]
: (Branch a abt b -> Branch a abt c)
-> [Branch a abt b] -> [Branch a abt c]
forall a b. (a -> b) -> [a] -> [b]
map (Coercion b c -> Branch a abt b -> Branch a abt c
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion b c
coeB) [Branch a abt b]
bs
                    )

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

-- HACK: we must add the constraints that 'LCs' and 'UnLCs' are inverses.
-- TODO: how can we do that in general rather than needing to repeat
-- it here and in the various constructors of 'SCon'?
checkSArgs
    :: (ABT Term abt, typs ~ UnLCs args, args ~ LCs typs)
    => List1 Sing typs
    -> [U.AST]
    -> TypeCheckMonad (SArgs abt args)
checkSArgs :: List1 Sing typs -> [AST] -> TypeCheckMonad (SArgs abt args)
checkSArgs List1 Sing typs
Nil1             []     = SArgs abt '[] -> TypeCheckMonad (SArgs abt '[])
forall (m :: * -> *) a. Monad m => a -> m a
return SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End
checkSArgs (Cons1 Sing x
typ List1 Sing xs
typs) (AST
e:[AST]
es) =
    abt '[] x -> SArgs abt (LCs xs) -> SArgs abt ('( '[], x) : LCs xs)
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
(:*) (abt '[] x
 -> SArgs abt (LCs xs) -> SArgs abt ('( '[], x) : LCs xs))
-> TypeCheckMonad (abt '[] x)
-> TypeCheckMonad
     (SArgs abt (LCs xs) -> SArgs abt ('( '[], x) : LCs xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing x -> AST -> TypeCheckMonad (abt '[] x)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType Sing x
typ AST
e TypeCheckMonad
  (SArgs abt (LCs xs) -> SArgs abt ('( '[], x) : LCs xs))
-> TypeCheckMonad (SArgs abt (LCs xs))
-> TypeCheckMonad (SArgs abt ('( '[], x) : LCs xs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> List1 Sing xs -> [AST] -> TypeCheckMonad (SArgs abt (LCs xs))
forall (abt :: [Hakaru] -> Hakaru -> *) (typs :: [Hakaru])
       (args :: [([Hakaru], Hakaru)]).
(ABT Term abt, typs ~ UnLCs args, args ~ LCs typs) =>
List1 Sing typs -> [AST] -> TypeCheckMonad (SArgs abt args)
checkSArgs List1 Sing xs
typs [AST]
es
checkSArgs List1 Sing typs
_ [AST]
_ =
    [Char] -> TypeCheckMonad (SArgs abt args)
forall a. HasCallStack => [Char] -> a
error [Char]
"checkSArgs: the number of types and terms doesn't match up"


-- | Given a typing environment, a type, and a term, verify that
-- the term satisfies the type (and produce an elaborated term):
--
-- > Γ ⊢ τ ∋ e ⇒ e'
checkType
    :: forall abt a
    .  (ABT Term abt)
    => Sing a
    -> U.AST
    -> TypeCheckMonad (abt '[] a)
checkType :: Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType = Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_
    where
    -- HACK: to convince GHC to stop being stupid about resolving
    -- the \"choice\" of @abt'@. I'm not sure why we don't need to
    -- use this same hack when 'inferType' calls 'checkType', but whatevs.
    inferType_ :: U.AST -> TypeCheckMonad (TypedAST abt)
    inferType_ :: AST -> TypeCheckMonad (TypedAST abt)
inferType_ = AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType

    checkVariable
        :: forall b
        .  Sing b
        -> Maybe U.SourceSpan
        -> Variable 'U.U
        -> TypeCheckMonad (abt '[] b)
    checkVariable :: Sing b
-> Maybe SourceSpan -> Variable 'U -> TypeCheckMonad (abt '[] b)
checkVariable Sing b
typ0 Maybe SourceSpan
sourceSpan Variable 'U
x = do
      TypedAST Sing b
typ' abt '[] b
e0' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ (Variable 'U -> AST
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var Variable 'U
x)
      TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
      case TypeCheckMode
mode of
        TypeCheckMode
StrictMode ->
            case Sing b -> Sing b -> Maybe (TypeEq b b)
forall k (a :: k -> *) (i :: k) (j :: k).
JmEq1 a =>
a i -> a j -> Maybe (TypeEq i j)
jmEq1 Sing b
typ0 Sing b
typ' of
              Just TypeEq b b
Refl -> abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return abt '[] b
e0'
              Maybe (TypeEq b b)
Nothing   -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
sourceSpan (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ0) (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ')
        TypeCheckMode
LaxMode    -> Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce       Maybe SourceSpan
sourceSpan abt '[] b
e0' Sing b
typ' Sing b
typ0
        TypeCheckMode
UnsafeMode -> Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce Maybe SourceSpan
sourceSpan abt '[] b
e0' Sing b
typ' Sing b
typ0


    checkType_
        :: forall b. Sing b -> U.AST -> TypeCheckMonad (abt '[] b)
    checkType_ :: Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ0 AST
e0 =
      let s :: Maybe SourceSpan
s = AST -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata AST
e0 in
      AST
-> (Variable 'U -> TypeCheckMonad (abt '[] b))
-> (Term (MetaABT SourceSpan Term) 'U
    -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) r.
ABT syn abt =>
abt '[] a -> (Variable a -> r) -> (syn abt a -> r) -> r
caseVarSyn AST
e0 (Sing b
-> Maybe SourceSpan -> Variable 'U -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru).
Sing b
-> Maybe SourceSpan -> Variable 'U -> TypeCheckMonad (abt '[] b)
checkVariable Sing b
typ0 Maybe SourceSpan
s) (Maybe SourceSpan
-> Term (MetaABT SourceSpan Term) 'U -> TypeCheckMonad (abt '[] b)
go Maybe SourceSpan
s)
      where
      go :: Maybe SourceSpan
-> Term (MetaABT SourceSpan Term) 'U -> TypeCheckMonad (abt '[] b)
go Maybe SourceSpan
sourceSpan Term (MetaABT SourceSpan Term) 'U
t =
        case Term (MetaABT SourceSpan Term) 'U
t of
        -- Change of direction rule suggests this doesn't need to be here
        -- We keep it here in case, we later use a U.Lam which doesn't
        -- carry the type of its variable 
        U.Lam_ (U.SSing Sing a
typ) U_ABT '[ 'U] 'U
e1 ->
          Unify2 (':->) (abt '[] b) b
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (b ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (b ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 Sing b
typ2 ->
          Sing a
-> Sing a
-> Maybe SourceSpan
-> ()
-> ()
-> ((a ~ a) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing a
typ1 Sing a
typ Maybe SourceSpan
sourceSpan () () (((a ~ a) => TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> ((a ~ a) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$
            do abt '[a] b
e1' <- Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ1 Sing b
typ2 U_ABT '[ 'U] 'U
e1
               abt '[] (a ':-> b) -> TypeCheckMonad (abt '[] (a ':-> b))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] (a ':-> b) -> TypeCheckMonad (abt '[] (a ':-> b)))
-> abt '[] (a ':-> b) -> TypeCheckMonad (abt '[] (a ':-> b))
forall a b. (a -> b) -> a -> b
$ Term abt (a ':-> b) -> abt '[] (a ':-> b)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[ '( '[a], b)] (a ':-> b)
forall (a :: Hakaru) (a :: Hakaru). SCon '[ '( '[a], a)] (a ':-> a)
Lam_ SCon '[ '( '[a], b)] (a ':-> b)
-> SArgs abt '[ '( '[a], b)] -> Term abt (a ':-> b)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[a] b
e1' abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.Let_ AST
e1 U_ABT '[ 'U] 'U
e2 -> do
            TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
            abt '[b] b
e2' <- Sing b -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[b] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing b
typ1 Sing b
typ0 U_ABT '[ 'U] 'U
e2
            abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC b, '( '[b], b)] b
forall (a :: Hakaru) (b :: Hakaru). SCon '[LC a, '( '[a], b)] b
Let_ SCon '[LC b, '( '[b], b)] b
-> SArgs abt '[LC b, '( '[b], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] b
e2' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.CoerceTo_ (Some2 Coercion i j
c) AST
e1 ->
            case Coercion i j -> Maybe (Sing i, Sing j)
forall (a :: Hakaru) (b :: Hakaru).
Coercion a b -> Maybe (Sing a, Sing b)
singCoerceDomCod Coercion i j
c of
            Maybe (Sing i, Sing j)
Nothing -> do
                abt '[] b
e1' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ0 AST
e1
                abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion b b -> SCon '[LC b] b
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC a] b
CoerceTo_ Coercion b b
forall (a :: Hakaru). Coercion a a
CNil SCon '[LC b] b -> SArgs abt '[LC b] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$  abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
            Just (Sing i
dom, Sing j
cod) ->
                Sing b
-> Sing j
-> Maybe SourceSpan
-> ()
-> ()
-> ((b ~ j) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing b
typ0 Sing j
cod Maybe SourceSpan
sourceSpan () () (((b ~ j) => TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> ((b ~ j) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ do
                 abt '[] i
e1' <- Sing i -> AST -> TypeCheckMonad (abt '[] i)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing i
dom AST
e1
                 abt '[] j -> TypeCheckMonad (abt '[] j)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] j -> TypeCheckMonad (abt '[] j))
-> abt '[] j -> TypeCheckMonad (abt '[] j)
forall a b. (a -> b) -> a -> b
$ Term abt j -> abt '[] j
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion i j -> SCon '[LC i] j
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC a] b
CoerceTo_ Coercion i j
c SCon '[LC i] j -> SArgs abt '[LC i] -> Term abt j
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] i
e1' abt '[] i -> SArgs abt '[] -> SArgs abt '[LC i]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.UnsafeTo_ (Some2 Coercion i j
c) AST
e1 ->
            case Coercion i j -> Maybe (Sing i, Sing j)
forall (a :: Hakaru) (b :: Hakaru).
Coercion a b -> Maybe (Sing a, Sing b)
singCoerceDomCod Coercion i j
c of
            Maybe (Sing i, Sing j)
Nothing -> do
                abt '[] b
e1' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ0 AST
e1
                abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion b b -> SCon '[LC b] b
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC b] a
UnsafeFrom_ Coercion b b
forall (a :: Hakaru). Coercion a a
CNil SCon '[LC b] b -> SArgs abt '[LC b] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$  abt '[] b
e1' abt '[] b -> SArgs abt '[] -> SArgs abt '[LC b]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
            Just (Sing i
dom, Sing j
cod) ->
                Sing b
-> Sing i
-> Maybe SourceSpan
-> ()
-> ()
-> ((b ~ i) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing b
typ0 Sing i
dom Maybe SourceSpan
sourceSpan () () (((b ~ i) => TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> ((b ~ i) => TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ do
                 abt '[] j
e1' <- Sing j -> AST -> TypeCheckMonad (abt '[] j)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing j
cod AST
e1
                 abt '[] i -> TypeCheckMonad (abt '[] i)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] i -> TypeCheckMonad (abt '[] i))
-> abt '[] i -> TypeCheckMonad (abt '[] i)
forall a b. (a -> b) -> a -> b
$ Term abt i -> abt '[] i
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Coercion i j -> SCon '[LC j] i
forall (a :: Hakaru) (b :: Hakaru). Coercion a b -> SCon '[LC b] a
UnsafeFrom_ Coercion i j
c SCon '[LC j] i -> SArgs abt '[LC j] -> Term abt i
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] j
e1' abt '[] j -> SArgs abt '[] -> SArgs abt '[LC j]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        -- TODO: Find better place to put this logic
        U.PrimOp_ PrimOp
U.Infinity [] -> do
            case Sing b
typ0 of
              Sing b
SNat  -> abt '[] 'HNat -> TypeCheckMonad (abt '[] 'HNat)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] 'HNat -> TypeCheckMonad (abt '[] 'HNat))
-> abt '[] 'HNat -> TypeCheckMonad (abt '[] 'HNat)
forall a b. (a -> b) -> a -> b
$
                         Term abt 'HNat -> abt '[] 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HNat -> SCon '[] 'HNat
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HIntegrable 'HNat -> PrimOp '[] 'HNat
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HNat
HIntegrable_Nat) SCon '[] 'HNat -> SArgs abt '[] -> Term abt 'HNat
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
              Sing b
SInt  -> Maybe SourceSpan
-> abt '[] 'HNat
-> Sing 'HNat
-> Sing 'HInt
-> TypeCheckMonad (abt '[] 'HInt)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce Maybe SourceSpan
sourceSpan (Term abt 'HNat -> abt '[] 'HNat
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HNat -> SCon '[] 'HNat
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HIntegrable 'HNat -> PrimOp '[] 'HNat
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HNat
HIntegrable_Nat) SCon '[] 'HNat -> SArgs abt '[] -> Term abt 'HNat
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End))
                         Sing 'HNat
SNat
                         Sing 'HInt
SInt
              Sing b
SProb -> abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb))
-> abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb)
forall a b. (a -> b) -> a -> b
$
                         Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HProb -> SCon '[] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HIntegrable 'HProb -> PrimOp '[] 'HProb
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HProb
HIntegrable_Prob) SCon '[] 'HProb -> SArgs abt '[] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
              Sing b
SReal -> Maybe SourceSpan
-> abt '[] 'HProb
-> Sing 'HProb
-> Sing 'HReal
-> TypeCheckMonad (abt '[] 'HReal)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce Maybe SourceSpan
sourceSpan (Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (PrimOp '[] 'HProb -> SCon '[] 'HProb
forall (typs :: [Hakaru]) (args :: [([Hakaru], Hakaru)])
       (a :: Hakaru).
(typs ~ UnLCs args, args ~ LCs typs) =>
PrimOp typs a -> SCon args a
PrimOp_ (HIntegrable 'HProb -> PrimOp '[] 'HProb
forall (a :: Hakaru). HIntegrable a -> PrimOp '[] a
Infinity HIntegrable 'HProb
HIntegrable_Prob) SCon '[] 'HProb -> SArgs abt '[] -> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End))
                         Sing 'HProb
SProb
                         Sing 'HReal
SReal
              Sing b
_     -> TypeCheckError -> TypeCheckMonad (abt '[] b)
forall r. TypeCheckError -> TypeCheckMonad r
failwith (TypeCheckError -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad TypeCheckError -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                        TypeCheckError
-> Maybe SourceSpan
-> TypeCheckError
-> TypeCheckMonad TypeCheckError
makeErrMsg
                         TypeCheckError
"Type Mismatch:"
                         Maybe SourceSpan
sourceSpan
                         TypeCheckError
"infinity can only be checked against nat or prob"

        U.Product_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 ->
           case Sing b -> Maybe (HSemiring b)
forall (a :: Hakaru). Sing a -> Maybe (HSemiring a)
hSemiring_Sing Sing b
typ0 of
             Maybe (HSemiring b)
Nothing -> TypeCheckError -> TypeCheckMonad (abt '[] b)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Product given factors which are not in a semiring"
             Just HSemiring b
h2 -> do
               TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e1
               abt '[] b
e2' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ1 AST
e2
               case Sing b -> Maybe (HDiscrete b)
forall (a :: Hakaru). Sing a -> Maybe (HDiscrete a)
hDiscrete_Sing Sing b
typ1 of
                 Maybe (HDiscrete b)
Nothing -> TypeCheckError -> TypeCheckMonad (abt '[] b)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"Product given bounds which are not discrete"
                 Just HDiscrete b
h1 -> do
                     abt '[b] b
e3' <- Sing b -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[b] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing b
typ1 Sing b
typ0 U_ABT '[ 'U] 'U
e3
                     abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (HDiscrete b -> HSemiring b -> SCon '[LC b, LC b, '( '[b], b)] b
forall (a :: Hakaru) (b :: Hakaru).
HDiscrete a -> HSemiring b -> SCon '[LC a, LC a, '( '[a], b)] b
Product HDiscrete b
h1 HSemiring b
h2 SCon '[LC b, LC b, '( '[b], b)] b
-> SArgs abt '[LC b, LC b, '( '[b], b)] -> Term abt b
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[LC b, '( '[b], b)]
-> SArgs abt '[LC b, LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b
-> SArgs abt '[ '( '[b], b)] -> SArgs abt '[LC b, '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] b
e3' abt '[b] b -> SArgs abt '[] -> SArgs abt '[ '( '[b], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.NaryOp_ NaryOp
op [AST]
es -> do
            TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
            case TypeCheckMode
mode of
              TypeCheckMode
StrictMode -> Sing b -> TypeCheckMonad (abt '[] b)
forall (c :: Hakaru). Sing c -> TypeCheckMonad (abt '[] c)
safeNaryOp Sing b
typ0
              TypeCheckMode
LaxMode    -> Sing b -> TypeCheckMonad (abt '[] b)
forall (c :: Hakaru). Sing c -> TypeCheckMonad (abt '[] c)
safeNaryOp Sing b
typ0
              TypeCheckMode
UnsafeMode -> case NaryOp
op of
               NaryOp
U.Prod -> do
                NaryOp b
op' <- Sing b -> NaryOp -> TypeCheckMonad (NaryOp b)
forall (a :: Hakaru). Sing a -> NaryOp -> TypeCheckMonad (NaryOp a)
make_NaryOp Sing b
typ0 NaryOp
op
                ([AST]
bads, [abt '[] b]
goods) <-
                  ([Either AST (abt '[] b)] -> ([AST], [abt '[] b]))
-> TypeCheckMonad [Either AST (abt '[] b)]
-> TypeCheckMonad ([AST], [abt '[] b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either AST (abt '[] b)] -> ([AST], [abt '[] b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (TypeCheckMonad [Either AST (abt '[] b)]
 -> TypeCheckMonad ([AST], [abt '[] b]))
-> ((AST -> TypeCheckMonad (Either AST (abt '[] b)))
    -> TypeCheckMonad [Either AST (abt '[] b)])
-> (AST -> TypeCheckMonad (Either AST (abt '[] b)))
-> TypeCheckMonad ([AST], [abt '[] b])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [AST]
-> (AST -> TypeCheckMonad (Either AST (abt '[] b)))
-> TypeCheckMonad [Either AST (abt '[] b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM [AST]
es ((AST -> TypeCheckMonad (Either AST (abt '[] b)))
 -> TypeCheckMonad ([AST], [abt '[] b]))
-> (AST -> TypeCheckMonad (Either AST (abt '[] b)))
-> TypeCheckMonad ([AST], [abt '[] b])
forall a b. (a -> b) -> a -> b
$ \AST
e -> do
                    Maybe (abt '[] b)
r <- TypeCheckMode
-> TypeCheckMonad (abt '[] b) -> TypeCheckMonad (Maybe (abt '[] b))
forall a.
TypeCheckMode -> TypeCheckMonad a -> TypeCheckMonad (Maybe a)
tryWith TypeCheckMode
LaxMode (Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ0 AST
e)
                    case Maybe (abt '[] b)
r of
                      Just abt '[] b
er -> Either AST (abt '[] b) -> TypeCheckMonad (Either AST (abt '[] b))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> Either AST (abt '[] b)
forall a b. b -> Either a b
Right abt '[] b
er)
                      Maybe (abt '[] b)
Nothing -> do
                        Maybe (abt '[] b)
r <- TypeCheckMonad (abt '[] b) -> TypeCheckMonad (Maybe (abt '[] b))
forall a. TypeCheckMonad a -> TypeCheckMonad (Maybe a)
try (do TypedAST Sing b
t abt '[] b
p <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType AST
e
                                     Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce Maybe SourceSpan
sourceSpan abt '[] b
p Sing b
t Sing b
typ0)
                        case Maybe (abt '[] b)
r of
                          Just abt '[] b
er -> Either AST (abt '[] b) -> TypeCheckMonad (Either AST (abt '[] b))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> Either AST (abt '[] b)
forall a b. b -> Either a b
Right abt '[] b
er)
                          Maybe (abt '[] b)
Nothing -> Either AST (abt '[] b) -> TypeCheckMonad (Either AST (abt '[] b))
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Either AST (abt '[] b)
forall a b. a -> Either a b
Left AST
e)
                if [AST] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AST]
bads
                then abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (NaryOp b -> Seq (abt '[] b) -> Term abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp b
op' ([abt '[] b] -> Seq (abt '[] b)
forall a. [a] -> Seq a
S.fromList [abt '[] b]
goods))
                else do TypedAST Sing b
typ abt '[] b
bad <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType (case [AST]
bads of
                          [AST
b] -> AST
b
                          [AST]
_   -> Term (MetaABT SourceSpan Term) 'U -> AST
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term (MetaABT SourceSpan Term) 'U -> AST)
-> Term (MetaABT SourceSpan Term) 'U -> AST
forall a b. (a -> b) -> a -> b
$ NaryOp -> [AST] -> Term (MetaABT SourceSpan Term) 'U
forall (abt :: [Untyped] -> Untyped -> *).
NaryOp -> [abt '[] 'U] -> Term abt 'U
U.NaryOp_ NaryOp
op [AST]
bads)
                        abt '[] b
bad <- Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce Maybe SourceSpan
sourceSpan abt '[] b
bad Sing b
typ Sing b
typ0
                        abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (case abt '[] b
badabt '[] b -> [abt '[] b] -> [abt '[] b]
forall a. a -> [a] -> [a]
:[abt '[] b]
goods of
                          [abt '[] b
e] -> abt '[] b
e
                          [abt '[] b]
es' -> Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt b -> abt '[] b) -> Term abt b -> abt '[] b
forall a b. (a -> b) -> a -> b
$ NaryOp b -> Seq (abt '[] b) -> Term abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp b
op' ([abt '[] b] -> Seq (abt '[] b)
forall a. [a] -> Seq a
S.fromList [abt '[] b]
es'))
               NaryOp
_ -> do
                Maybe (abt '[] b)
es' <- TypeCheckMode
-> TypeCheckMonad (abt '[] b) -> TypeCheckMonad (Maybe (abt '[] b))
forall a.
TypeCheckMode -> TypeCheckMonad a -> TypeCheckMonad (Maybe a)
tryWith TypeCheckMode
LaxMode (Sing b -> TypeCheckMonad (abt '[] b)
forall (c :: Hakaru). Sing c -> TypeCheckMonad (abt '[] c)
safeNaryOp Sing b
typ0)
                case Maybe (abt '[] b)
es' of
                  Just abt '[] b
es'' -> abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return abt '[] b
es''
                  Maybe (abt '[] b)
Nothing   -> do
                    TypedAST Sing b
typ abt '[] b
e0' <- AST -> TypeCheckMonad (TypedAST abt)
forall (abt :: [Hakaru] -> Hakaru -> *).
ABT Term abt =>
AST -> TypeCheckMonad (TypedAST abt)
inferType (Term (MetaABT SourceSpan Term) 'U -> AST
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term (MetaABT SourceSpan Term) 'U -> AST)
-> Term (MetaABT SourceSpan Term) 'U -> AST
forall a b. (a -> b) -> a -> b
$ NaryOp -> [AST] -> Term (MetaABT SourceSpan Term) 'U
forall (abt :: [Untyped] -> Untyped -> *).
NaryOp -> [abt '[] 'U] -> Term abt 'U
U.NaryOp_ NaryOp
op [AST]
es)
                    Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce Maybe SourceSpan
sourceSpan abt '[] b
e0' Sing b
typ Sing b
typ0
            where
            safeNaryOp :: forall c. Sing c -> TypeCheckMonad (abt '[] c)
            safeNaryOp :: Sing c -> TypeCheckMonad (abt '[] c)
safeNaryOp Sing c
typ = do
                NaryOp c
op'  <- Sing c -> NaryOp -> TypeCheckMonad (NaryOp c)
forall (a :: Hakaru). Sing a -> NaryOp -> TypeCheckMonad (NaryOp a)
make_NaryOp Sing c
typ NaryOp
op
                [abt '[] c]
es'  <- [AST]
-> (AST -> TypeCheckMonad (abt '[] c))
-> TypeCheckMonad [abt '[] c]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM [AST]
es ((AST -> TypeCheckMonad (abt '[] c)) -> TypeCheckMonad [abt '[] c])
-> (AST -> TypeCheckMonad (abt '[] c))
-> TypeCheckMonad [abt '[] c]
forall a b. (a -> b) -> a -> b
$ Sing c -> AST -> TypeCheckMonad (abt '[] c)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing c
typ
                abt '[] c -> TypeCheckMonad (abt '[] c)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] c -> TypeCheckMonad (abt '[] c))
-> abt '[] c -> TypeCheckMonad (abt '[] c)
forall a b. (a -> b) -> a -> b
$ Term abt c -> abt '[] c
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (NaryOp c -> Seq (abt '[] c) -> Term abt c
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
NaryOp a -> Seq (abt '[] a) -> Term abt a
NaryOp_ NaryOp c
op' ([abt '[] c] -> Seq (abt '[] c)
forall a. [a] -> Seq a
S.fromList [abt '[] c]
es'))

        U.Pair_ AST
e1 AST
e2 ->
          Unify2 HPair (abt '[] b) b
forall r (x :: Hakaru). Unify2 HPair r x
unifyPair Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (b ~ HPair a b) =>
  Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (b ~ HPair a b) =>
    Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
a Sing b
b -> do
           abt '[] a
e1' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
a AST
e1
           abt '[] b
e2' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
b AST
e2
           abt '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
-> TypeCheckMonad
     (abt '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]]))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
 -> TypeCheckMonad
      (abt
         '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])))
-> abt
     '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
-> TypeCheckMonad
     (abt '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]]))
forall a b. (a -> b) -> a -> b
$ Term abt ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
-> abt
     '[] ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Datum (abt '[]) (HData' (('TyCon "Pair" ':@ a) ':@ b))
-> Term abt (HData' (('TyCon "Pair" ':@ a) ':@ b))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
Datum (abt '[]) (HData' t) -> Term abt (HData' t)
Datum_ (Datum (abt '[]) (HData' (('TyCon "Pair" ':@ a) ':@ b))
 -> Term abt (HData' (('TyCon "Pair" ':@ a) ':@ b)))
-> Datum (abt '[]) (HData' (('TyCon "Pair" ':@ a) ':@ b))
-> Term abt (HData' (('TyCon "Pair" ':@ a) ':@ b))
forall a b. (a -> b) -> a -> b
$ Sing a
-> Sing b
-> abt '[] a
-> abt '[] b
-> Datum
     (abt '[]) ('HData (('TyCon "Pair" ':@ a) ':@ b) '[ '[ 'K a, 'K b]])
forall (a :: Hakaru) (b :: Hakaru) (ast :: Hakaru -> *).
Sing a -> Sing b -> ast a -> ast b -> Datum ast (HPair a b)
dPair_ Sing a
a Sing b
b abt '[] a
e1' abt '[] b
e2')

        U.Array_ AST
e1 U_ABT '[ 'U] 'U
e2 ->
            Unify1 'HArray (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 -> do
             abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_  Sing 'HNat
SNat AST
e1
             abt '[ 'HNat] a
e2' <- Sing 'HNat
-> Sing a -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[ 'HNat] a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing 'HNat
SNat Sing a
typ1 U_ABT '[ 'U] 'U
e2
             abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a)))
-> abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] 'HNat -> abt '[ 'HNat] a -> Term abt ('HArray a)
Array_ abt '[] 'HNat
e1' abt '[ 'HNat] a
e2')

        U.ArrayLiteral_ [AST]
es ->
            Unify1 'HArray (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 ->
            if [AST] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AST]
es then abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a)))
-> abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Sing ('HArray a) -> Term abt ('HArray a)
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Sing ('HArray a) -> Term abt ('HArray a)
Empty_ Sing b
Sing ('HArray a)
typ0) else do
               [abt '[] a]
es' <- [AST]
-> (AST -> TypeCheckMonad (abt '[] a))
-> TypeCheckMonad [abt '[] a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM [AST]
es ((AST -> TypeCheckMonad (abt '[] a)) -> TypeCheckMonad [abt '[] a])
-> (AST -> TypeCheckMonad (abt '[] a))
-> TypeCheckMonad [abt '[] a]
forall a b. (a -> b) -> a -> b
$ Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ1
               abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a)))
-> abt '[] ('HArray a) -> TypeCheckMonad (abt '[] ('HArray a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HArray a) -> abt '[] ('HArray a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn ([abt '[] a] -> Term abt ('HArray a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
[abt '[] a] -> Term abt ('HArray a)
ArrayLiteral_ [abt '[] a]
es')

        U.Datum_ (U.Datum TypeCheckError
hint DCode (MetaABT SourceSpan Term)
d) ->
            case Sing b
typ0 of
            SData _ typ2 ->
                (Term abt ('HData t (Code t)) -> abt '[] ('HData t (Code t))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HData t (Code t)) -> abt '[] ('HData t (Code t)))
-> (DatumCode (Code t) (abt '[]) ('HData t (Code t))
    -> Term abt ('HData t (Code t)))
-> DatumCode (Code t) (abt '[]) ('HData t (Code t))
-> abt '[] ('HData t (Code t))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Datum (abt '[]) ('HData t (Code t)) -> Term abt ('HData t (Code t))
forall (abt :: [Hakaru] -> Hakaru -> *) (t :: HakaruCon).
Datum (abt '[]) (HData' t) -> Term abt (HData' t)
Datum_ (Datum (abt '[]) ('HData t (Code t))
 -> Term abt ('HData t (Code t)))
-> (DatumCode (Code t) (abt '[]) ('HData t (Code t))
    -> Datum (abt '[]) ('HData t (Code t)))
-> DatumCode (Code t) (abt '[]) ('HData t (Code t))
-> Term abt ('HData t (Code t))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TypeCheckError
-> Sing ('HData t (Code t))
-> DatumCode (Code t) (abt '[]) ('HData t (Code t))
-> Datum (abt '[]) ('HData t (Code t))
forall (xss :: HakaruCon) (ast :: Hakaru -> *).
TypeCheckError
-> Sing (HData' xss)
-> DatumCode (Code xss) ast (HData' xss)
-> Datum ast (HData' xss)
Datum TypeCheckError
hint Sing b
Sing ('HData t (Code t))
typ0)
                    (DatumCode (Code t) (abt '[]) ('HData t (Code t))
 -> abt '[] ('HData t (Code t)))
-> TypeCheckMonad
     (DatumCode (Code t) (abt '[]) ('HData t (Code t)))
-> TypeCheckMonad (abt '[] ('HData t (Code t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing ('HData t (Code t))
-> Sing (Code t)
-> DCode (MetaABT SourceSpan Term)
-> TypeCheckMonad
     (DatumCode (Code t) (abt '[]) ('HData t (Code t)))
forall (xss :: [[HakaruFun]]) (t :: HakaruCon).
Sing (HData' t)
-> Sing xss
-> DCode (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
checkDatumCode Sing b
Sing ('HData t (Code t))
typ0 Sing (Code t)
typ2 DCode (MetaABT SourceSpan Term)
d
            Sing b
_ -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing Any)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
sourceSpan (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ0) (TypeCheckError -> Either TypeCheckError (Sing Any)
forall a b. a -> Either a b
Left TypeCheckError
"HData")

        U.Case_ AST
e1 [Branch_ (MetaABT SourceSpan Term)]
branches -> do
            TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
            [Branch b abt b]
branches' <- [Branch_ (MetaABT SourceSpan Term)]
-> (Branch_ (MetaABT SourceSpan Term)
    -> TypeCheckMonad (Branch b abt b))
-> TypeCheckMonad [Branch b abt b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM [Branch_ (MetaABT SourceSpan Term)]
branches ((Branch_ (MetaABT SourceSpan Term)
  -> TypeCheckMonad (Branch b abt b))
 -> TypeCheckMonad [Branch b abt b])
-> (Branch_ (MetaABT SourceSpan Term)
    -> TypeCheckMonad (Branch b abt b))
-> TypeCheckMonad [Branch b abt b]
forall a b. (a -> b) -> a -> b
$ Sing b
-> Sing b
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (Branch b abt b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a
-> Sing b
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (Branch a abt b)
checkBranch Sing b
typ1 Sing b
typ0
            abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> abt '[] b -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ Term abt b -> abt '[] b
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (abt '[] b -> [Branch b abt b] -> Term abt b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
abt '[] a -> [Branch a abt b] -> Term abt b
Case_ abt '[] b
e1' [Branch b abt b]
branches')

        U.Dirac_ AST
e1 ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 -> do
             abt '[] a
e1' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ1 AST
e1
             abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC a] ('HMeasure a)
forall (a :: Hakaru). SCon '[LC a] ('HMeasure a)
Dirac SCon '[LC a] ('HMeasure a)
-> SArgs abt '[LC a] -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e1' abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.MBind_ AST
e1 U_ABT '[ 'U] 'U
e2 ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
_ -> do
             TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e1
             Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 (AST -> Maybe SourceSpan
forall meta k (syn :: ([k] -> k -> *) -> k -> *) (xs :: [k])
       (a :: k).
MetaABT meta syn xs a -> Maybe meta
getMetadata AST
e1) ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
              abt '[a] b
e2' <- Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ2 Sing b
typ0 U_ABT '[ 'U] 'U
e2
              abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
forall (a :: Hakaru) (a :: Hakaru).
SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
MBind SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HMeasure a)]
-> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[a], b)]
-> SArgs abt '[ '( '[], b), '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[a] b
e2' abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.Plate_ AST
e1 U_ABT '[ 'U] 'U
e2 ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 -> do
             abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HNat
SNat AST
e1
             Unify1 'HArray (abt '[] b) a
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing a
typ1 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (a ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (a ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
              abt '[ 'HNat] ('HMeasure a)
e2' <- Sing 'HNat
-> Sing ('HMeasure a)
-> U_ABT '[ 'U] 'U
-> TypeCheckMonad (abt '[ 'HNat] ('HMeasure a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing 'HNat
SNat (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typ2) U_ABT '[ 'U] 'U
e2
              abt '[] ('HMeasure ('HArray a))
-> TypeCheckMonad (abt '[] ('HMeasure ('HArray a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure ('HArray a))
 -> TypeCheckMonad (abt '[] ('HMeasure ('HArray a))))
-> abt '[] ('HMeasure ('HArray a))
-> TypeCheckMonad (abt '[] ('HMeasure ('HArray a)))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure ('HArray a)) -> abt '[] ('HMeasure ('HArray a))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
forall (a :: Hakaru).
SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
Plate SCon
  '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)] ('HMeasure ('HArray a))
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
-> Term abt ('HMeasure ('HArray a))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1' abt '[] 'HNat
-> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
-> SArgs abt '[LC 'HNat, '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[ 'HNat] ('HMeasure a)
e2' abt '[ 'HNat] ('HMeasure a)
-> SArgs abt '[] -> SArgs abt '[ '( '[ 'HNat], 'HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.Chain_ AST
e1 AST
e2 U_ABT '[ 'U] 'U
e3 ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
typ1 ->
            Unify2 HPair (abt '[] b) a
forall r (x :: Hakaru). Unify2 HPair r x
unifyPair Sing a
typ1 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (a ~ HPair a b) =>
  Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (a ~ HPair a b) =>
    Sing a -> Sing b -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
aa Sing b
s ->
            Unify1 'HArray (abt '[] b) a
forall r (x :: Hakaru). Unify1 'HArray r x
unifyArray Sing a
aa Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (a ~ 'HArray a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (a ~ 'HArray a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
a -> do
              abt '[] 'HNat
e1' <- Sing 'HNat -> AST -> TypeCheckMonad (abt '[] 'HNat)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_  Sing 'HNat
SNat AST
e1
              abt '[] b
e2' <- Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_  Sing b
s    AST
e2
              abt '[b] ('HMeasure (HPair a b))
e3' <- Sing b
-> Sing ('HMeasure (HPair a b))
-> U_ABT '[ 'U] 'U
-> TypeCheckMonad (abt '[b] ('HMeasure (HPair a b)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing b
s    (Sing (HPair a b) -> Sing ('HMeasure (HPair a b))
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure (Sing (HPair a b) -> Sing ('HMeasure (HPair a b)))
-> Sing (HPair a b) -> Sing ('HMeasure (HPair a b))
forall a b. (a -> b) -> a -> b
$ Sing a -> Sing b -> Sing (HPair a b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair Sing a
a Sing b
s) U_ABT '[ 'U] 'U
e3
              abt '[] ('HMeasure (HPair ('HArray a) b))
-> TypeCheckMonad (abt '[] ('HMeasure (HPair ('HArray a) b)))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure (HPair ('HArray a) b))
 -> TypeCheckMonad (abt '[] ('HMeasure (HPair ('HArray a) b))))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
-> TypeCheckMonad (abt '[] ('HMeasure (HPair ('HArray a) b)))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure (HPair ('HArray a) b))
-> abt '[] ('HMeasure (HPair ('HArray a) b))
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon
  '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
  ('HMeasure (HPair ('HArray a) b))
forall (s :: Hakaru) (a :: Hakaru).
SCon
  '[LC 'HNat, LC s, '( '[s], 'HMeasure (HPair a s))]
  ('HMeasure (HPair ('HArray a) s))
Chain SCon
  '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
  ('HMeasure (HPair ('HArray a) b))
-> SArgs abt '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
-> Term abt ('HMeasure (HPair ('HArray a) b))
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] 'HNat
e1' abt '[] 'HNat
-> SArgs abt '[LC b, '( '[b], 'HMeasure (HPair a b))]
-> SArgs abt '[LC 'HNat, LC b, '( '[b], 'HMeasure (HPair a b))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] b
e2' abt '[] b
-> SArgs abt '[ '( '[b], 'HMeasure (HPair a b))]
-> SArgs abt '[LC b, '( '[b], 'HMeasure (HPair a b))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[b] ('HMeasure (HPair a b))
e3' abt '[b] ('HMeasure (HPair a b))
-> SArgs abt '[] -> SArgs abt '[ '( '[b], 'HMeasure (HPair a b))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

        U.Transform_ Transform as x
tr SArgs (MetaABT SourceSpan Term) as
es -> Maybe SourceSpan
-> Sing b
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (abt '[] b)
forall (x' :: Hakaru) (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Maybe SourceSpan
-> Sing x'
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (abt '[] x')
checkTransform Maybe SourceSpan
sourceSpan Sing b
typ0 Transform as x
tr SArgs (MetaABT SourceSpan Term) as
es

        U.Superpose_ NonEmpty (AST, AST)
pes ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
_ ->
                (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
 -> abt '[] ('HMeasure a))
-> TypeCheckMonad
     (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
-> TypeCheckMonad (abt '[] ('HMeasure a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt ('HMeasure a) -> abt '[] ('HMeasure a))
-> (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
    -> Term abt ('HMeasure a))
-> NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> abt '[] ('HMeasure a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))
-> Term abt ('HMeasure a)
Superpose_) (TypeCheckMonad (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
 -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> (((AST, AST)
     -> TypeCheckMonad (abt '[] 'HProb, abt '[] ('HMeasure a)))
    -> TypeCheckMonad
         (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a))))
-> ((AST, AST)
    -> TypeCheckMonad (abt '[] 'HProb, abt '[] ('HMeasure a)))
-> TypeCheckMonad (abt '[] ('HMeasure a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
                    NonEmpty (AST, AST)
-> ((AST, AST)
    -> TypeCheckMonad (abt '[] 'HProb, abt '[] ('HMeasure a)))
-> TypeCheckMonad
     (NonEmpty (abt '[] 'HProb, abt '[] ('HMeasure a)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
T.forM NonEmpty (AST, AST)
pes (((AST, AST) -> TypeCheckMonad (abt '[] 'HProb, abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> ((AST, AST) -> TypeCheckMonad (abt '[] 'HProb, abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \(AST
p,AST
e) ->
                        (,) (abt '[] 'HProb -> abt '[] b -> (abt '[] 'HProb, abt '[] b))
-> TypeCheckMonad (abt '[] 'HProb)
-> TypeCheckMonad (abt '[] b -> (abt '[] 'HProb, abt '[] b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing 'HProb -> AST -> TypeCheckMonad (abt '[] 'HProb)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing 'HProb
SProb AST
p TypeCheckMonad (abt '[] b -> (abt '[] 'HProb, abt '[] b))
-> TypeCheckMonad (abt '[] b)
-> TypeCheckMonad (abt '[] 'HProb, abt '[] b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sing b -> AST -> TypeCheckMonad (abt '[] b)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing b
typ0 AST
e

        Term (MetaABT SourceSpan Term) 'U
U.Reject_ ->
            Unify1 'HMeasure (abt '[] b) b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] b))
 -> TypeCheckMonad (abt '[] b))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] b))
-> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ \Sing a
_ ->
            abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Sing ('HMeasure a) -> Term abt ('HMeasure a)
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *).
Sing ('HMeasure a) -> Term abt ('HMeasure a)
Reject_ Sing b
Sing ('HMeasure a)
typ0)

        U.InjTyped forall (abt' :: [Hakaru] -> Hakaru -> *).
ABT Term abt' =>
abt' '[] x
t ->
            let typ1 :: Sing x
typ1 = TrivialABT Term '[] x -> Sing x
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
abt '[] a -> Sing a
typeOf (TrivialABT Term '[] x -> Sing x)
-> TrivialABT Term '[] x -> Sing x
forall a b. (a -> b) -> a -> b
$ TrivialABT Term '[] x -> TrivialABT Term '[] x
forall (a :: Hakaru).
TrivialABT Term '[] a -> TrivialABT Term '[] a
triv TrivialABT Term '[] x
forall (abt' :: [Hakaru] -> Hakaru -> *).
ABT Term abt' =>
abt' '[] x
t
            in case Sing b -> Sing x -> Maybe (TypeEq b x)
forall k (a :: k -> *) (i :: k) (j :: k).
JmEq1 a =>
a i -> a j -> Maybe (TypeEq i j)
jmEq1 Sing b
typ0 Sing x
typ1 of
                 Just TypeEq b x
Refl -> abt '[] x -> TypeCheckMonad (abt '[] x)
forall (m :: * -> *) a. Monad m => a -> m a
return abt '[] x
forall (abt' :: [Hakaru] -> Hakaru -> *).
ABT Term abt' =>
abt' '[] x
t
                 Maybe (TypeEq b x)
Nothing   -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing x)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
sourceSpan (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ0) (Sing x -> Either TypeCheckError (Sing x)
forall a b. b -> Either a b
Right Sing x
typ1)

        Term (MetaABT SourceSpan Term) 'U
_   | AST -> Bool
inferable AST
e0 -> do
                TypedAST Sing b
typ' abt '[] b
e0' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ AST
e0
                TypeCheckMode
mode <- TypeCheckMonad TypeCheckMode
getMode
                case TypeCheckMode
mode of
                  TypeCheckMode
StrictMode ->
                    case Sing b -> Sing b -> Maybe (TypeEq b b)
forall k (a :: k -> *) (i :: k) (j :: k).
JmEq1 a =>
a i -> a j -> Maybe (TypeEq i j)
jmEq1 Sing b
typ0 Sing b
typ' of
                    Just TypeEq b b
Refl -> abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return abt '[] b
e0'
                    Maybe (TypeEq b b)
Nothing   -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
sourceSpan (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ0) (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typ')
                  TypeCheckMode
LaxMode    -> Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce       Maybe SourceSpan
sourceSpan abt '[] b
e0' Sing b
typ' Sing b
typ0
                  TypeCheckMode
UnsafeMode -> Maybe SourceSpan
-> abt '[] b -> Sing b -> Sing b -> TypeCheckMonad (abt '[] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce Maybe SourceSpan
sourceSpan abt '[] b
e0' Sing b
typ' Sing b
typ0
            | Bool
otherwise -> [Char] -> TypeCheckMonad (abt '[] b)
forall a. HasCallStack => [Char] -> a
error [Char]
"checkType: missing an mustCheck branch!"

    checkTransform
        :: Maybe U.SourceSpan
        -> Sing x'
        -> Transform as x
        -> U.SArgs U.U_ABT as
        -> TypeCheckMonad (abt '[] x')
    checkTransform :: Maybe SourceSpan
-> Sing x'
-> Transform as x
-> SArgs (MetaABT SourceSpan Term) as
-> TypeCheckMonad (abt '[] x')
checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
Expect
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (Cons2 ToUntyped x y
U.ToU List2 ToUntyped xs ys
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) =
      case Sing x'
typ0 of
      Sing x'
SProb -> do
          TypedAST Sing b
typ1 abt '[] b
e1' <- AST -> TypeCheckMonad (TypedAST abt)
inferType_ U_ABT varsu 'U
AST
e1
          Unify1 'HMeasure (abt '[] x') b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typ1 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
           abt '[a] x'
e2' <- Sing a
-> Sing x' -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] x')
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ2 Sing x'
typ0 U_ABT varsu 'U
U_ABT '[ 'U] 'U
e2
           abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb))
-> abt '[] 'HProb -> TypeCheckMonad (abt '[] 'HProb)
forall a b. (a -> b) -> a -> b
$ Term abt 'HProb -> abt '[] 'HProb
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
-> SCon '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
forall (a :: Hakaru).
Transform '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
Expect SCon '[LC ('HMeasure a), '( '[a], 'HProb)] 'HProb
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HProb)]
-> Term abt 'HProb
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] b
e1' abt '[] b
-> SArgs abt '[ '( '[a], x')]
-> SArgs abt '[ '( '[], b), '( '[a], x')]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[a] x'
e2' abt '[a] x' -> SArgs abt '[] -> SArgs abt '[ '( '[a], x')]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
      Sing x'
_ -> Maybe SourceSpan
-> Either TypeCheckError (Sing x')
-> Either TypeCheckError (Sing Any)
-> TypeCheckMonad (abt '[] x')
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
sourceSpan (Sing x' -> Either TypeCheckError (Sing x')
forall a b. b -> Either a b
Right Sing x'
typ0) (TypeCheckError -> Either TypeCheckError (Sing Any)
forall a b. a -> Either a b
Left TypeCheckError
"HProb")

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
Observe
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) =
      Unify1 'HMeasure (abt '[] x') x'
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing x'
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (x' ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru).
    (x' ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typ2 -> do
          abt '[] x'
e1' <- Sing x' -> AST -> TypeCheckMonad (abt '[] x')
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing x'
typ0 U_ABT varsu 'U
AST
e1
          abt '[] a
e2' <- Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ2 U_ABT varsu 'U
AST
e2
          abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
-> SCon '[LC ('HMeasure a), LC a] ('HMeasure a)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
forall (a :: Hakaru).
Transform '[LC ('HMeasure a), LC a] ('HMeasure a)
Observe SCon '[LC ('HMeasure a), LC a] ('HMeasure a)
-> SArgs abt '[LC ('HMeasure a), LC a] -> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] x'
e1' abt '[] x' -> SArgs abt '[LC a] -> SArgs abt '[ '( '[], x'), LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] a
e2' abt '[] a -> SArgs abt '[] -> SArgs abt '[LC a]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
MCMC
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* (List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e2) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) =
      Unify2 (':->) (abt '[] x') x'
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun Sing x'
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (x' ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (x' ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typa Sing b
typmb ->
      Unify1 'HMeasure (abt '[] x') b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typmb Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typb ->
      Sing a
-> Sing a
-> Maybe SourceSpan
-> Sing (a ':-> 'HMeasure a)
-> Sing x'
-> ((a ~ a) => TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall t0 t1 (x :: Hakaru) (y :: Hakaru) r.
(TCMTypeRepr t0, TCMTypeRepr t1) =>
Sing x
-> Sing y
-> Maybe SourceSpan
-> t0
-> t1
-> ((x ~ y) => TypeCheckMonad r)
-> TypeCheckMonad r
matchTypes Sing a
typa Sing a
typb Maybe SourceSpan
sourceSpan (Sing a -> Sing ('HMeasure a) -> Sing (a ':-> 'HMeasure a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typa (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typa)) Sing x'
typ0 (((a ~ a) => TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> ((a ~ a) => TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ do
       abt '[] (a ':-> 'HMeasure a)
e1' <- Sing (a ':-> 'HMeasure a)
-> AST -> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType (Sing a -> Sing ('HMeasure a) -> Sing (a ':-> 'HMeasure a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (a ':-> b)
SFun Sing a
typa (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typa)) U_ABT varsu 'U
AST
e1
       abt '[] ('HMeasure a)
e2' <- Sing ('HMeasure a) -> AST -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType            (Sing a -> Sing ('HMeasure a)
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure Sing a
typa)  U_ABT varsu 'U
AST
e2
       abt '[] (a ':-> 'HMeasure a)
-> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] (a ':-> 'HMeasure a)
 -> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a)))
-> abt '[] (a ':-> 'HMeasure a)
-> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a))
-> Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall a b. (a -> b) -> a -> b
$ Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
-> SCon
     '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
forall (a :: Hakaru).
Transform
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
MCMC SCon
  '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)] (a ':-> 'HMeasure a)
-> SArgs abt '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)]
-> Term abt (a ':-> 'HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] (a ':-> 'HMeasure a)
e1' abt '[] (a ':-> 'HMeasure a)
-> SArgs abt '[LC ('HMeasure a)]
-> SArgs abt '[LC (a ':-> 'HMeasure a), LC ('HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[] ('HMeasure a)
e2' abt '[] ('HMeasure a)
-> SArgs abt '[] -> SArgs abt '[LC ('HMeasure a)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   (Disint TransformImpl
k)
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) =
      Unify2 (':->) (abt '[] x') x'
forall r (x :: Hakaru). Unify2 (':->) r x
unifyFun Sing x'
typ0 Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru) (b :: Hakaru).
  (x' ~ (a ':-> b)) =>
  Sing a -> Sing b -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru) (b :: Hakaru).
    (x' ~ (a ':-> b)) =>
    Sing a -> Sing b -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typa Sing b
typmb ->
      Unify1 'HMeasure (abt '[] x') b
forall r (x :: Hakaru). Unify1 'HMeasure r x
unifyMeasure Sing b
typmb Maybe SourceSpan
sourceSpan ((forall (a :: Hakaru).
  (b ~ 'HMeasure a) =>
  Sing a -> TypeCheckMonad (abt '[] x'))
 -> TypeCheckMonad (abt '[] x'))
-> (forall (a :: Hakaru).
    (b ~ 'HMeasure a) =>
    Sing a -> TypeCheckMonad (abt '[] x'))
-> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ \Sing a
typb -> do
       abt '[] ('HMeasure (HPair a a))
e1' <- Sing ('HMeasure (HPair a a))
-> AST -> TypeCheckMonad (abt '[] ('HMeasure (HPair a a)))
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
ABT Term abt =>
Sing a -> AST -> TypeCheckMonad (abt '[] a)
checkType (Sing (HPair a a) -> Sing ('HMeasure (HPair a a))
forall (a :: Hakaru). Sing a -> Sing ('HMeasure a)
SMeasure (Sing a -> Sing a -> Sing (HPair a a)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Sing (HPair a b)
sPair Sing a
typa Sing a
typb)) U_ABT varsu 'U
AST
e1
       abt '[] (a ':-> 'HMeasure a)
-> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] (a ':-> 'HMeasure a)
 -> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a)))
-> abt '[] (a ':-> 'HMeasure a)
-> TypeCheckMonad (abt '[] (a ':-> 'HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a))
-> Term abt (a ':-> 'HMeasure a) -> abt '[] (a ':-> 'HMeasure a)
forall a b. (a -> b) -> a -> b
$ Transform '[LC ('HMeasure (HPair a a))] (a ':-> 'HMeasure a)
-> SCon '[LC ('HMeasure (HPair a a))] (a ':-> 'HMeasure a)
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ (TransformImpl
-> Transform '[LC ('HMeasure (HPair a a))] (a ':-> 'HMeasure a)
forall (a :: Hakaru) (b :: Hakaru).
TransformImpl
-> Transform '[LC ('HMeasure (HPair a b))] (a ':-> 'HMeasure b)
Disint TransformImpl
k) SCon '[LC ('HMeasure (HPair a a))] (a ':-> 'HMeasure a)
-> SArgs abt '[LC ('HMeasure (HPair a a))]
-> Term abt (a ':-> 'HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] ('HMeasure (HPair a a))
e1' abt '[] ('HMeasure (HPair a a))
-> SArgs abt '[] -> SArgs abt '[LC ('HMeasure (HPair a a))]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
Simplify
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
      abt '[] x'
e1' <- Sing x' -> AST -> TypeCheckMonad (abt '[] x')
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing x'
typ0 U_ABT varsu 'U
AST
e1
      abt '[] x' -> TypeCheckMonad (abt '[] x')
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] x' -> TypeCheckMonad (abt '[] x'))
-> abt '[] x' -> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ Term abt x' -> abt '[] x'
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[ '( '[], x')] x' -> SCon '[ '( '[], x')] x'
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[ '( '[], x')] x'
forall (a :: Hakaru). Transform '[LC a] a
Simplify SCon '[ '( '[], x')] x' -> SArgs abt '[ '( '[], x')] -> Term abt x'
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] x'
e1' abt '[] x' -> SArgs abt '[] -> SArgs abt '[ '( '[], x')]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
Reparam
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
      abt '[] x'
e1' <- Sing x' -> AST -> TypeCheckMonad (abt '[] x')
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing x'
typ0 U_ABT varsu 'U
AST
e1
      abt '[] x' -> TypeCheckMonad (abt '[] x')
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] x' -> TypeCheckMonad (abt '[] x'))
-> abt '[] x' -> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ Term abt x' -> abt '[] x'
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[ '( '[], x')] x' -> SCon '[ '( '[], x')] x'
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[ '( '[], x')] x'
forall (a :: Hakaru). Transform '[LC a] a
Reparam SCon '[ '( '[], x')] x' -> SArgs abt '[ '( '[], x')] -> Term abt x'
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] x'
e1' abt '[] x' -> SArgs abt '[] -> SArgs abt '[ '( '[], x')]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

    checkTransform Maybe SourceSpan
sourceSpan Sing x'
typ0
                   Transform as x
Summarize
                   ((List2 ToUntyped vars varsu
Nil2, U_ABT varsu 'U
e1) U.:* SArgs (MetaABT SourceSpan Term) args
U.End) = do
      abt '[] x'
e1' <- Sing x' -> AST -> TypeCheckMonad (abt '[] x')
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing x'
typ0 U_ABT varsu 'U
AST
e1
      abt '[] x' -> TypeCheckMonad (abt '[] x')
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] x' -> TypeCheckMonad (abt '[] x'))
-> abt '[] x' -> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ Term abt x' -> abt '[] x'
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Transform '[ '( '[], x')] x' -> SCon '[ '( '[], x')] x'
forall (as :: [([Hakaru], Hakaru)]) (x :: Hakaru).
Transform as x -> SCon as x
Transform_ Transform '[ '( '[], x')] x'
forall (a :: Hakaru). Transform '[LC a] a
Summarize SCon '[ '( '[], x')] x' -> SArgs abt '[ '( '[], x')] -> Term abt x'
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] x'
e1' abt '[] x' -> SArgs abt '[] -> SArgs abt '[ '( '[], x')]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)

    checkTransform Maybe SourceSpan
_ Sing x'
_ Transform as x
tr SArgs (MetaABT SourceSpan Term) as
_ = [Char] -> TypeCheckMonad (abt '[] x')
forall a. HasCallStack => [Char] -> a
error ([Char] -> TypeCheckMonad (abt '[] x'))
-> [Char] -> TypeCheckMonad (abt '[] x')
forall a b. (a -> b) -> a -> b
$ [Char]
"checkTransform{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Transform as x -> [Char]
forall a. Show a => a -> [Char]
show Transform as x
tr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: TODO"

    --------------------------------------------------------
    -- We make these local to 'checkType' for the same reason we have 'checkType_'
    -- TODO: can we combine these in with the 'checkBranch' functions somehow?
    checkDatumCode
        :: forall xss t
        .  Sing (HData' t)
        -> Sing xss
        -> U.DCode_
        -> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
    checkDatumCode :: Sing (HData' t)
-> Sing xss
-> DCode (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
checkDatumCode Sing (HData' t)
typA Sing xss
typ DCode (MetaABT SourceSpan Term)
d =
        case DCode (MetaABT SourceSpan Term)
d of
        U.Inr DCode (MetaABT SourceSpan Term)
d2 ->
            case Sing xss
typ of
            SPlus _ typ2 -> DatumCode xss (abt '[]) (HData' t)
-> DatumCode (xs : xss) (abt '[]) (HData' t)
forall (xss :: [[HakaruFun]]) (abt :: Hakaru -> *) (a :: Hakaru)
       (xs :: [HakaruFun]).
DatumCode xss abt a -> DatumCode (xs : xss) abt a
Inr (DatumCode xss (abt '[]) (HData' t)
 -> DatumCode (xs : xss) (abt '[]) (HData' t))
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
-> TypeCheckMonad (DatumCode (xs : xss) (abt '[]) (HData' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing (HData' t)
-> Sing xss
-> DCode (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
forall (xss :: [[HakaruFun]]) (t :: HakaruCon).
Sing (HData' t)
-> Sing xss
-> DCode (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
checkDatumCode Sing (HData' t)
typA Sing xss
typ2 DCode (MetaABT SourceSpan Term)
d2
            Sing xss
_            -> TypeCheckError
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `inr' type"
        U.Inl DStruct (MetaABT SourceSpan Term)
d1 ->
            case Sing xss
typ of
            SPlus typ1 _ -> DatumStruct xs (abt '[]) (HData' t)
-> DatumCode (xs : xss) (abt '[]) (HData' t)
forall (xs :: [HakaruFun]) (abt :: Hakaru -> *) (a :: Hakaru)
       (xss :: [[HakaruFun]]).
DatumStruct xs abt a -> DatumCode (xs : xss) abt a
Inl (DatumStruct xs (abt '[]) (HData' t)
 -> DatumCode (xs : xss) (abt '[]) (HData' t))
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
-> TypeCheckMonad (DatumCode (xs : xss) (abt '[]) (HData' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing (HData' t)
-> Sing xs
-> DStruct (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
forall (xs :: [HakaruFun]) (t :: HakaruCon).
Sing (HData' t)
-> Sing xs
-> DStruct (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
checkDatumStruct Sing (HData' t)
typA Sing xs
typ1 DStruct (MetaABT SourceSpan Term)
d1
            Sing xss
_            -> TypeCheckError
-> TypeCheckMonad (DatumCode xss (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `inl' type"

    checkDatumStruct
        :: forall xs t
        .  Sing (HData' t)
        -> Sing xs
        -> U.DStruct_
        -> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
    checkDatumStruct :: Sing (HData' t)
-> Sing xs
-> DStruct (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
checkDatumStruct Sing (HData' t)
typA Sing xs
typ DStruct (MetaABT SourceSpan Term)
d =
        case DStruct (MetaABT SourceSpan Term)
d of
        U.Et DFun (MetaABT SourceSpan Term)
d1 DStruct (MetaABT SourceSpan Term)
d2 ->
            case Sing xs
typ of
            SEt typ1 typ2 -> DatumFun x (abt '[]) (HData' t)
-> DatumStruct xs (abt '[]) (HData' t)
-> DatumStruct (x : xs) (abt '[]) (HData' t)
forall (x :: HakaruFun) (abt :: Hakaru -> *) (a :: Hakaru)
       (xs :: [HakaruFun]).
DatumFun x abt a
-> DatumStruct xs abt a -> DatumStruct (x : xs) abt a
Et
                (DatumFun x (abt '[]) (HData' t)
 -> DatumStruct xs (abt '[]) (HData' t)
 -> DatumStruct (x : xs) (abt '[]) (HData' t))
-> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
-> TypeCheckMonad
     (DatumStruct xs (abt '[]) (HData' t)
      -> DatumStruct (x : xs) (abt '[]) (HData' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing (HData' t)
-> Sing x
-> DFun (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
forall (x :: HakaruFun) (t :: HakaruCon).
Sing (HData' t)
-> Sing x
-> DFun (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
checkDatumFun    Sing (HData' t)
typA Sing x
typ1 DFun (MetaABT SourceSpan Term)
d1
                TypeCheckMonad
  (DatumStruct xs (abt '[]) (HData' t)
   -> DatumStruct (x : xs) (abt '[]) (HData' t))
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
-> TypeCheckMonad (DatumStruct (x : xs) (abt '[]) (HData' t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sing (HData' t)
-> Sing xs
-> DStruct (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
forall (xs :: [HakaruFun]) (t :: HakaruCon).
Sing (HData' t)
-> Sing xs
-> DStruct (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
checkDatumStruct Sing (HData' t)
typA Sing xs
typ2 DStruct (MetaABT SourceSpan Term)
d2
            Sing xs
_     -> TypeCheckError
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `et' type"
        DStruct (MetaABT SourceSpan Term)
U.Done ->
            case Sing xs
typ of
            Sing xs
SDone -> DatumStruct '[] (abt '[]) (HData' t)
-> TypeCheckMonad (DatumStruct '[] (abt '[]) (HData' t))
forall (m :: * -> *) a. Monad m => a -> m a
return DatumStruct '[] (abt '[]) (HData' t)
forall (abt :: Hakaru -> *) (a :: Hakaru). DatumStruct '[] abt a
Done
            Sing xs
_     -> TypeCheckError
-> TypeCheckMonad (DatumStruct xs (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `done' type"

    checkDatumFun
        :: forall x t
        .  Sing (HData' t)
        -> Sing x
        -> U.DFun_
        -> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
    checkDatumFun :: Sing (HData' t)
-> Sing x
-> DFun (MetaABT SourceSpan Term)
-> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
checkDatumFun Sing (HData' t)
typA Sing x
typ DFun (MetaABT SourceSpan Term)
d =
        case DFun (MetaABT SourceSpan Term)
d of
        U.Ident AST
e1 ->
            case Sing x
typ of
            Sing x
SIdent      -> abt '[] (HData' t) -> DatumFun 'I (abt '[]) (HData' t)
forall (ast :: Hakaru -> *) (a :: Hakaru).
ast a -> DatumFun 'I ast a
Ident (abt '[] (HData' t) -> DatumFun 'I (abt '[]) (HData' t))
-> TypeCheckMonad (abt '[] (HData' t))
-> TypeCheckMonad (DatumFun 'I (abt '[]) (HData' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing (HData' t) -> AST -> TypeCheckMonad (abt '[] (HData' t))
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing (HData' t)
typA AST
e1
            Sing x
_           -> TypeCheckError -> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `I' type"
        U.Konst AST
e1 ->
            case Sing x
typ of
            SKonst typ1 -> abt '[] a -> DatumFun ('K a) (abt '[]) (HData' t)
forall (ast :: Hakaru -> *) (b :: Hakaru) (a :: Hakaru).
ast b -> DatumFun ('K b) ast a
Konst (abt '[] a -> DatumFun ('K a) (abt '[]) (HData' t))
-> TypeCheckMonad (abt '[] a)
-> TypeCheckMonad (DatumFun ('K a) (abt '[]) (HData' t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing a -> AST -> TypeCheckMonad (abt '[] a)
forall (b :: Hakaru). Sing b -> AST -> TypeCheckMonad (abt '[] b)
checkType_ Sing a
typ1 AST
e1
            Sing x
_           -> TypeCheckError -> TypeCheckMonad (DatumFun x (abt '[]) (HData' t))
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected datum of `K' type"

checkBranch
    :: (ABT Term abt)
    => Sing a
    -> Sing b
    -> U.Branch
    -> TypeCheckMonad (Branch a abt b)
checkBranch :: Sing a
-> Sing b
-> Branch_ (MetaABT SourceSpan Term)
-> TypeCheckMonad (Branch a abt b)
checkBranch Sing a
patTyp Sing b
bodyTyp (U.Branch_ Pattern
pat AST
body) = do
    SP Pattern vars a
pat' List1 Variable vars
vars <- Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing a
patTyp Pattern
pat
    Pattern vars a -> abt vars b -> Branch a abt b
forall (a :: Hakaru) (abt :: [Hakaru] -> Hakaru -> *) (b :: Hakaru)
       (xs :: [Hakaru]).
Pattern xs a -> abt xs b -> Branch a abt b
Branch Pattern vars a
pat' (abt vars b -> Branch a abt b)
-> TypeCheckMonad (abt vars b) -> TypeCheckMonad (Branch a abt b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 Variable vars -> Sing b -> AST -> TypeCheckMonad (abt vars b)
forall (abt :: [Hakaru] -> Hakaru -> *) (xs :: [Hakaru])
       (a :: Hakaru).
ABT Term abt =>
List1 Variable xs -> Sing a -> AST -> TypeCheckMonad (abt xs a)
checkBinders List1 Variable vars
vars Sing b
bodyTyp AST
body

checkPattern
    :: Sing a
    -> U.Pattern
    -> TypeCheckMonad (SomePattern a)
checkPattern :: Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern = \Sing a
typA Pattern
pat ->
    case Pattern
pat of
    U.PVar Name
x -> SomePattern a -> TypeCheckMonad (SomePattern a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePattern a -> TypeCheckMonad (SomePattern a))
-> SomePattern a -> TypeCheckMonad (SomePattern a)
forall a b. (a -> b) -> a -> b
$ Pattern '[a] a -> List1 Variable '[a] -> SomePattern a
forall (a :: Hakaru) (vars :: [Hakaru]).
Pattern vars a -> List1 Variable vars -> SomePattern a
SP Pattern '[a] a
forall (a :: Hakaru). Pattern '[a] a
PVar (Variable a -> List1 Variable '[] -> List1 Variable '[a]
forall a (a :: a -> *) (x :: a) (xs :: [a]).
a x -> List1 a xs -> List1 a (x : xs)
Cons1 (Variable 'U -> Sing a -> Variable a
forall (a :: Hakaru). Variable 'U -> Sing a -> Variable a
makeVar (Name -> Variable 'U
U.nameToVar Name
x) Sing a
typA) List1 Variable '[]
forall k (a :: k -> *). List1 a '[]
Nil1)
    Pattern
U.PWild  -> SomePattern a -> TypeCheckMonad (SomePattern a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePattern a -> TypeCheckMonad (SomePattern a))
-> SomePattern a -> TypeCheckMonad (SomePattern a)
forall a b. (a -> b) -> a -> b
$ Pattern '[] a -> List1 Variable '[] -> SomePattern a
forall (a :: Hakaru) (vars :: [Hakaru]).
Pattern vars a -> List1 Variable vars -> SomePattern a
SP Pattern '[] a
forall (a :: Hakaru). Pattern '[] a
PWild List1 Variable '[]
forall k (a :: k -> *). List1 a '[]
Nil1
    U.PDatum TypeCheckError
hint PCode
pat1 ->
        case Sing a
typA of
        SData _ typ1 -> do
            SPC PDatumCode (Code t) vars (HData' t)
pat1' List1 Variable vars
xs <- Sing (HData' t)
-> Sing (Code t)
-> PCode
-> TypeCheckMonad (SomePatternCode (Code t) t)
forall (t :: HakaruCon) (xss :: [[HakaruFun]]).
Sing (HData' t)
-> Sing xss -> PCode -> TypeCheckMonad (SomePatternCode xss t)
checkPatternCode Sing a
Sing (HData' t)
typA Sing (Code t)
typ1 PCode
pat1
            SomePattern a -> TypeCheckMonad (SomePattern a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePattern a -> TypeCheckMonad (SomePattern a))
-> SomePattern a -> TypeCheckMonad (SomePattern a)
forall a b. (a -> b) -> a -> b
$ Pattern vars a -> List1 Variable vars -> SomePattern a
forall (a :: Hakaru) (vars :: [Hakaru]).
Pattern vars a -> List1 Variable vars -> SomePattern a
SP (TypeCheckError
-> PDatumCode (Code t) vars (HData' t) -> Pattern vars (HData' t)
forall (t :: HakaruCon) (vars :: [Hakaru]).
TypeCheckError
-> PDatumCode (Code t) vars (HData' t) -> Pattern vars (HData' t)
PDatum TypeCheckError
hint PDatumCode (Code t) vars (HData' t)
pat1') List1 Variable vars
xs
        Sing a
_ -> Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing Any)
-> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
forall a. Maybe a
Nothing (Sing a -> Either TypeCheckError (Sing a)
forall a b. b -> Either a b
Right Sing a
typA) (TypeCheckError -> Either TypeCheckError (Sing Any)
forall a b. a -> Either a b
Left TypeCheckError
"HData")
    where
    checkPatternCode
        :: Sing (HData' t)
        -> Sing xss
        -> U.PCode
        -> TypeCheckMonad (SomePatternCode xss t)
    checkPatternCode :: Sing (HData' t)
-> Sing xss -> PCode -> TypeCheckMonad (SomePatternCode xss t)
checkPatternCode Sing (HData' t)
typA Sing xss
typ PCode
pat =
        case PCode
pat of
        U.PInr PCode
pat2 ->
            case Sing xss
typ of
            SPlus _ typ2 -> do
                SPC PDatumCode xss vars (HData' t)
pat2' List1 Variable vars
xs <- Sing (HData' t)
-> Sing xss -> PCode -> TypeCheckMonad (SomePatternCode xss t)
forall (t :: HakaruCon) (xss :: [[HakaruFun]]).
Sing (HData' t)
-> Sing xss -> PCode -> TypeCheckMonad (SomePatternCode xss t)
checkPatternCode Sing (HData' t)
typA Sing xss
typ2 PCode
pat2
                SomePatternCode (xs : xss) t
-> TypeCheckMonad (SomePatternCode (xs : xss) t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternCode (xs : xss) t
 -> TypeCheckMonad (SomePatternCode (xs : xss) t))
-> SomePatternCode (xs : xss) t
-> TypeCheckMonad (SomePatternCode (xs : xss) t)
forall a b. (a -> b) -> a -> b
$ PDatumCode (xs : xss) vars (HData' t)
-> List1 Variable vars -> SomePatternCode (xs : xss) t
forall (xss :: [[HakaruFun]]) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumCode xss vars (HData' t)
-> List1 Variable vars -> SomePatternCode xss t
SPC (PDatumCode xss vars (HData' t)
-> PDatumCode (xs : xss) vars (HData' t)
forall (xss :: [[HakaruFun]]) (vars :: [Hakaru]) (a :: Hakaru)
       (xs :: [HakaruFun]).
PDatumCode xss vars a -> PDatumCode (xs : xss) vars a
PInr PDatumCode xss vars (HData' t)
pat2') List1 Variable vars
xs
            Sing xss
_            -> TypeCheckError -> TypeCheckMonad (SomePatternCode xss t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `sum' type"
        U.PInl PStruct
pat1 ->
            case Sing xss
typ of
            SPlus typ1 _ -> do
                SPS PDatumStruct xs vars (HData' t)
pat1' List1 Variable vars
xs <- Sing (HData' t)
-> Sing xs -> PStruct -> TypeCheckMonad (SomePatternStruct xs t)
forall (t :: HakaruCon) (xs :: [HakaruFun]).
Sing (HData' t)
-> Sing xs -> PStruct -> TypeCheckMonad (SomePatternStruct xs t)
checkPatternStruct Sing (HData' t)
typA Sing xs
typ1 PStruct
pat1
                SomePatternCode (xs : xss) t
-> TypeCheckMonad (SomePatternCode (xs : xss) t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternCode (xs : xss) t
 -> TypeCheckMonad (SomePatternCode (xs : xss) t))
-> SomePatternCode (xs : xss) t
-> TypeCheckMonad (SomePatternCode (xs : xss) t)
forall a b. (a -> b) -> a -> b
$ PDatumCode (xs : xss) vars (HData' t)
-> List1 Variable vars -> SomePatternCode (xs : xss) t
forall (xss :: [[HakaruFun]]) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumCode xss vars (HData' t)
-> List1 Variable vars -> SomePatternCode xss t
SPC (PDatumStruct xs vars (HData' t)
-> PDatumCode (xs : xss) vars (HData' t)
forall (xs :: [HakaruFun]) (vars :: [Hakaru]) (a :: Hakaru)
       (xss :: [[HakaruFun]]).
PDatumStruct xs vars a -> PDatumCode (xs : xss) vars a
PInl PDatumStruct xs vars (HData' t)
pat1') List1 Variable vars
xs
            Sing xss
_ -> TypeCheckError -> TypeCheckMonad (SomePatternCode xss t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `zero' type"

    checkPatternStruct
        :: Sing (HData' t)
        -> Sing xs
        -> U.PStruct
        -> TypeCheckMonad (SomePatternStruct xs t)
    checkPatternStruct :: Sing (HData' t)
-> Sing xs -> PStruct -> TypeCheckMonad (SomePatternStruct xs t)
checkPatternStruct  Sing (HData' t)
typA Sing xs
typ PStruct
pat =
        case PStruct
pat of
        U.PEt PFun
pat1 PStruct
pat2 ->
            case Sing xs
typ of
            SEt typ1 typ2 -> do
                SPF PDatumFun x vars (HData' t)
pat1' List1 Variable vars
xs <- Sing (HData' t)
-> Sing x -> PFun -> TypeCheckMonad (SomePatternFun x t)
forall (t :: HakaruCon) (x :: HakaruFun).
Sing (HData' t)
-> Sing x -> PFun -> TypeCheckMonad (SomePatternFun x t)
checkPatternFun    Sing (HData' t)
typA Sing x
typ1 PFun
pat1
                SPS PDatumStruct xs vars (HData' t)
pat2' List1 Variable vars
ys <- Sing (HData' t)
-> Sing xs -> PStruct -> TypeCheckMonad (SomePatternStruct xs t)
forall (t :: HakaruCon) (xs :: [HakaruFun]).
Sing (HData' t)
-> Sing xs -> PStruct -> TypeCheckMonad (SomePatternStruct xs t)
checkPatternStruct Sing (HData' t)
typA Sing xs
typ2 PStruct
pat2
                SomePatternStruct (x : xs) t
-> TypeCheckMonad (SomePatternStruct (x : xs) t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternStruct (x : xs) t
 -> TypeCheckMonad (SomePatternStruct (x : xs) t))
-> SomePatternStruct (x : xs) t
-> TypeCheckMonad (SomePatternStruct (x : xs) t)
forall a b. (a -> b) -> a -> b
$ PDatumStruct (x : xs) (vars ++ vars) (HData' t)
-> List1 Variable (vars ++ vars) -> SomePatternStruct (x : xs) t
forall (xs :: [HakaruFun]) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumStruct xs vars (HData' t)
-> List1 Variable vars -> SomePatternStruct xs t
SPS (PDatumFun x vars (HData' t)
-> PDatumStruct xs vars (HData' t)
-> PDatumStruct (x : xs) (vars ++ vars) (HData' t)
forall (x :: HakaruFun) (vars1 :: [Hakaru]) (a :: Hakaru)
       (xs :: [HakaruFun]) (vars2 :: [Hakaru]).
PDatumFun x vars1 a
-> PDatumStruct xs vars2 a
-> PDatumStruct (x : xs) (vars1 ++ vars2) a
PEt PDatumFun x vars (HData' t)
pat1' PDatumStruct xs vars (HData' t)
pat2') (List1 Variable vars
-> List1 Variable vars -> List1 Variable (vars ++ vars)
forall k (a :: k -> *) (xs :: [k]) (ys :: [k]).
List1 a xs -> List1 a ys -> List1 a (xs ++ ys)
append1 List1 Variable vars
xs List1 Variable vars
ys)
            Sing xs
_ -> TypeCheckError -> TypeCheckMonad (SomePatternStruct xs t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `et' type"
        PStruct
U.PDone ->
            case Sing xs
typ of
            Sing xs
SDone -> SomePatternStruct '[] t -> TypeCheckMonad (SomePatternStruct '[] t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternStruct '[] t
 -> TypeCheckMonad (SomePatternStruct '[] t))
-> SomePatternStruct '[] t
-> TypeCheckMonad (SomePatternStruct '[] t)
forall a b. (a -> b) -> a -> b
$ PDatumStruct '[] '[] (HData' t)
-> List1 Variable '[] -> SomePatternStruct '[] t
forall (xs :: [HakaruFun]) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumStruct xs vars (HData' t)
-> List1 Variable vars -> SomePatternStruct xs t
SPS PDatumStruct '[] '[] (HData' t)
forall (a :: Hakaru). PDatumStruct '[] '[] a
PDone List1 Variable '[]
forall k (a :: k -> *). List1 a '[]
Nil1
            Sing xs
_     -> TypeCheckError -> TypeCheckMonad (SomePatternStruct xs t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `done' type"

    checkPatternFun
        :: Sing (HData' t)
        -> Sing x
        -> U.PFun
        -> TypeCheckMonad (SomePatternFun x t)
    checkPatternFun :: Sing (HData' t)
-> Sing x -> PFun -> TypeCheckMonad (SomePatternFun x t)
checkPatternFun Sing (HData' t)
typA Sing x
typ PFun
pat =
        case PFun
pat of
        U.PIdent Pattern
pat1 ->
            case Sing x
typ of
            Sing x
SIdent -> do
                SP Pattern vars (HData' t)
pat1' List1 Variable vars
xs <- Sing (HData' t)
-> Pattern -> TypeCheckMonad (SomePattern (HData' t))
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing (HData' t)
typA Pattern
pat1
                SomePatternFun 'I t -> TypeCheckMonad (SomePatternFun 'I t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternFun 'I t -> TypeCheckMonad (SomePatternFun 'I t))
-> SomePatternFun 'I t -> TypeCheckMonad (SomePatternFun 'I t)
forall a b. (a -> b) -> a -> b
$ PDatumFun 'I vars (HData' t)
-> List1 Variable vars -> SomePatternFun 'I t
forall (x :: HakaruFun) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumFun x vars (HData' t)
-> List1 Variable vars -> SomePatternFun x t
SPF (Pattern vars (HData' t) -> PDatumFun 'I vars (HData' t)
forall (vars :: [Hakaru]) (a :: Hakaru).
Pattern vars a -> PDatumFun 'I vars a
PIdent Pattern vars (HData' t)
pat1') List1 Variable vars
xs
            Sing x
_ -> TypeCheckError -> TypeCheckMonad (SomePatternFun x t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `I' type"
        U.PKonst Pattern
pat1 ->
            case Sing x
typ of
            SKonst typ1 -> do
                SP Pattern vars a
pat1' List1 Variable vars
xs <- Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
forall (a :: Hakaru).
Sing a -> Pattern -> TypeCheckMonad (SomePattern a)
checkPattern Sing a
typ1 Pattern
pat1
                SomePatternFun ('K a) t -> TypeCheckMonad (SomePatternFun ('K a) t)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomePatternFun ('K a) t
 -> TypeCheckMonad (SomePatternFun ('K a) t))
-> SomePatternFun ('K a) t
-> TypeCheckMonad (SomePatternFun ('K a) t)
forall a b. (a -> b) -> a -> b
$ PDatumFun ('K a) vars (HData' t)
-> List1 Variable vars -> SomePatternFun ('K a) t
forall (x :: HakaruFun) (t :: HakaruCon) (vars :: [Hakaru]).
PDatumFun x vars (HData' t)
-> List1 Variable vars -> SomePatternFun x t
SPF (Pattern vars a -> PDatumFun ('K a) vars (HData' t)
forall (vars :: [Hakaru]) (b :: Hakaru) (a :: Hakaru).
Pattern vars b -> PDatumFun ('K b) vars a
PKonst Pattern vars a
pat1') List1 Variable vars
xs
            Sing x
_ -> TypeCheckError -> TypeCheckMonad (SomePatternFun x t)
forall r. TypeCheckError -> TypeCheckMonad r
failwith_ TypeCheckError
"expected pattern of `K' type"

checkOrCoerce
    :: (ABT Term abt)
    => Maybe (U.SourceSpan)
    -> abt '[] a
    -> Sing a
    -> Sing b
    -> TypeCheckMonad (abt '[] b)
checkOrCoerce :: Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrCoerce Maybe SourceSpan
s abt '[] a
e Sing a
typA Sing b
typB =
    case Sing a -> Sing b -> Maybe (Coercion a b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Maybe (Coercion a b)
findCoercion Sing a
typA Sing b
typB of
    Just Coercion a b
c  -> abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> (LC_ abt a -> abt '[] b)
-> LC_ abt a
-> TypeCheckMonad (abt '[] b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt a -> LC_ abt b) -> LC_ abt a -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion a b -> LC_ abt a -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion a b
c (LC_ abt a -> TypeCheckMonad (abt '[] b))
-> LC_ abt a -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ abt '[] a -> LC_ abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] a
e
    Maybe (Coercion a b)
Nothing -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing a)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
s (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typB) (Sing a -> Either TypeCheckError (Sing a)
forall a b. b -> Either a b
Right Sing a
typA)

checkOrUnsafeCoerce
    :: (ABT Term abt)
    => Maybe (U.SourceSpan)
    -> abt '[] a
    -> Sing a
    -> Sing b
    -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce :: Maybe SourceSpan
-> abt '[] a -> Sing a -> Sing b -> TypeCheckMonad (abt '[] b)
checkOrUnsafeCoerce Maybe SourceSpan
s abt '[] a
e Sing a
typA Sing b
typB =
    case Sing a -> Sing b -> Maybe (CoercionMode a b)
forall (a :: Hakaru) (b :: Hakaru).
Sing a -> Sing b -> Maybe (CoercionMode a b)
findEitherCoercion Sing a
typA Sing b
typB of
    Just (Unsafe  Coercion b a
c) ->
        abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> (LC_ abt a -> abt '[] b)
-> LC_ abt a
-> TypeCheckMonad (abt '[] b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt a -> LC_ abt b) -> LC_ abt a -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion b a -> LC_ abt a -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f b -> f a
coerceFrom Coercion b a
c (LC_ abt a -> TypeCheckMonad (abt '[] b))
-> LC_ abt a -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ abt '[] a -> LC_ abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] a
e
    Just (Safe    Coercion a b
c) ->
        abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> (LC_ abt a -> abt '[] b)
-> LC_ abt a
-> TypeCheckMonad (abt '[] b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt a -> LC_ abt b) -> LC_ abt a -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion a b -> LC_ abt a -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion a b
c (LC_ abt a -> TypeCheckMonad (abt '[] b))
-> LC_ abt a -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ abt '[] a -> LC_ abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] a
e
    Just (Mixed   (Sing c
_, Coercion c a
c1, Coercion c b
c2)) ->
        abt '[] b -> TypeCheckMonad (abt '[] b)
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] b -> TypeCheckMonad (abt '[] b))
-> (LC_ abt a -> abt '[] b)
-> LC_ abt a
-> TypeCheckMonad (abt '[] b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LC_ abt b -> abt '[] b
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
LC_ abt a -> abt '[] a
unLC_ (LC_ abt b -> abt '[] b)
-> (LC_ abt a -> LC_ abt b) -> LC_ abt a -> abt '[] b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion c b -> LC_ abt c -> LC_ abt b
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f a -> f b
coerceTo Coercion c b
c2 (LC_ abt c -> LC_ abt b)
-> (LC_ abt a -> LC_ abt c) -> LC_ abt a -> LC_ abt b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Coercion c a -> LC_ abt a -> LC_ abt c
forall (f :: Hakaru -> *) (a :: Hakaru) (b :: Hakaru).
Coerce f =>
Coercion a b -> f b -> f a
coerceFrom Coercion c a
c1 (LC_ abt a -> TypeCheckMonad (abt '[] b))
-> LC_ abt a -> TypeCheckMonad (abt '[] b)
forall a b. (a -> b) -> a -> b
$ abt '[] a -> LC_ abt a
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru).
abt '[] a -> LC_ abt a
LC_ abt '[] a
e
    Maybe (CoercionMode a b)
Nothing ->
        case (Sing a
typA, Sing b
typB) of
          -- mighty, mighty hack!
          (SMeasure typ1, SMeasure _) -> do
            let x :: Variable 'U
x = TypeCheckError -> Nat -> Sing 'U -> Variable 'U
forall k (a :: k). TypeCheckError -> Nat -> Sing a -> Variable a
Variable ([Char] -> TypeCheckError
pack [Char]
"") Nat
0 Sing 'U
U.SU
            abt '[a] b
e2' <- Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
forall (abt :: [Hakaru] -> Hakaru -> *) (a :: Hakaru)
       (b :: Hakaru).
ABT Term abt =>
Sing a -> Sing b -> U_ABT '[ 'U] 'U -> TypeCheckMonad (abt '[a] b)
checkBinder Sing a
typ1 Sing b
typB (Variable 'U -> AST -> U_ABT '[ 'U] 'U
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k) (xs :: [k]) (b :: k).
ABT syn abt =>
Variable a -> abt xs b -> abt (a : xs) b
bind Variable 'U
x (AST -> U_ABT '[ 'U] 'U) -> AST -> U_ABT '[ 'U] 'U
forall a b. (a -> b) -> a -> b
$ Term (MetaABT SourceSpan Term) 'U -> AST
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (Term (MetaABT SourceSpan Term) 'U -> AST)
-> Term (MetaABT SourceSpan Term) 'U -> AST
forall a b. (a -> b) -> a -> b
$ AST -> Term (MetaABT SourceSpan Term) 'U
forall (abt :: [Untyped] -> Untyped -> *).
abt '[] 'U -> Term abt 'U
U.Dirac_ (Variable 'U -> AST
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
Variable a -> abt '[] a
var Variable 'U
x))
            abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall (m :: * -> *) a. Monad m => a -> m a
return (abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a)))
-> abt '[] ('HMeasure a) -> TypeCheckMonad (abt '[] ('HMeasure a))
forall a b. (a -> b) -> a -> b
$ Term abt ('HMeasure a) -> abt '[] ('HMeasure a)
forall k (syn :: ([k] -> k -> *) -> k -> *) (abt :: [k] -> k -> *)
       (a :: k).
ABT syn abt =>
syn abt a -> abt '[] a
syn (SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
forall (a :: Hakaru) (a :: Hakaru).
SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
MBind SCon '[LC ('HMeasure a), '( '[a], 'HMeasure a)] ('HMeasure a)
-> SArgs abt '[LC ('HMeasure a), '( '[a], 'HMeasure a)]
-> Term abt ('HMeasure a)
forall (args :: [([Hakaru], Hakaru)]) (a :: Hakaru)
       (abt :: [Hakaru] -> Hakaru -> *).
SCon args a -> SArgs abt args -> Term abt a
:$ abt '[] a
e abt '[] a
-> SArgs abt '[ '( '[a], b)]
-> SArgs abt '[ '( '[], a), '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* abt '[a] b
e2' abt '[a] b -> SArgs abt '[] -> SArgs abt '[ '( '[a], b)]
forall (abt :: [Hakaru] -> Hakaru -> *) (vars :: [Hakaru])
       (a :: Hakaru) (args :: [([Hakaru], Hakaru)]).
abt vars a -> SArgs abt args -> SArgs abt ('(vars, a) : args)
:* SArgs abt '[]
forall (abt :: [Hakaru] -> Hakaru -> *). SArgs abt '[]
End)
          (Sing a
_ ,  Sing b
_) -> Maybe SourceSpan
-> Either TypeCheckError (Sing b)
-> Either TypeCheckError (Sing a)
-> TypeCheckMonad (abt '[] b)
forall (a :: Hakaru) (b :: Hakaru) r.
Maybe SourceSpan
-> Either TypeCheckError (Sing a)
-> Either TypeCheckError (Sing b)
-> TypeCheckMonad r
typeMismatch Maybe SourceSpan
s (Sing b -> Either TypeCheckError (Sing b)
forall a b. b -> Either a b
Right Sing b
typB) (Sing a -> Either TypeCheckError (Sing a)
forall a b. b -> Either a b
Right Sing a
typA)



----------------------------------------------------------------
----------------------------------------------------------- fin.