{-# LANGUAGE OverloadedStrings #-}

module Jacinda.Backend.T ( LineCtx, run, eB ) where

import           A
import           A.I
import           C
import           Control.Exception                 (Exception, throw)
import           Control.Monad                     (zipWithM, (<=<))
import           Control.Monad.Trans.State.Strict  (State, evalState, runState, state)
import           Data.Bifunctor                    (first, second)
import qualified Data.ByteString                   as BS
import           Data.ByteString.Builder           (hPutBuilder)
import           Data.ByteString.Builder.RealFloat (doubleDec)
import           Data.Foldable                     (fold, traverse_)
import           Data.Function                     ((&))
import qualified Data.IntMap.Strict                as IM
import qualified Data.IntSet                       as IS
import           Data.List                         (foldl', scanl')
import qualified Data.Map                          as M
import           Data.Maybe                        (fromMaybe)
import qualified Data.Set                          as S
import qualified Data.Text                         as T
import qualified Data.Vector                       as V
import           Data.Vector.Ext                   (scanlM')
import           Data.Word                         (Word8)
import           Jacinda.Backend.Const
import           Jacinda.Backend.Printf
import           Jacinda.Regex
import           Nm
import           NumParse
import           Prettyprinter                     (hardline, pretty)
import           Prettyprinter.Render.Text         (putDoc)
import           Regex.Rure                        (RureMatch (RureMatch), RurePtr)
import           System.IO                         (hFlush, stdout)
import           Ty.Const
import           U

infixl 4 <$!>

data EvalErr = EmptyFold
             | IndexOutOfBounds Int
             | NoSuchField Int BS.ByteString
             | InternalCoercionError (E T) TB
             | ExpectedTup (E T) | ExpectedRec (E T)
             | InternalTmp Tmp
             | InternalNm (Nm T)
             | InternalArityOrEta Int (E T)
             | InternalUnexpectedStream (E T)
             deriving (Int -> EvalErr -> ShowS
[EvalErr] -> ShowS
EvalErr -> [Char]
(Int -> EvalErr -> ShowS)
-> (EvalErr -> [Char]) -> ([EvalErr] -> ShowS) -> Show EvalErr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalErr -> ShowS
showsPrec :: Int -> EvalErr -> ShowS
$cshow :: EvalErr -> [Char]
show :: EvalErr -> [Char]
$cshowList :: [EvalErr] -> ShowS
showList :: [EvalErr] -> ShowS
Show)

instance Exception EvalErr where

data StreamError = NakedField deriving (Int -> StreamError -> ShowS
[StreamError] -> ShowS
StreamError -> [Char]
(Int -> StreamError -> ShowS)
-> (StreamError -> [Char])
-> ([StreamError] -> ShowS)
-> Show StreamError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamError -> ShowS
showsPrec :: Int -> StreamError -> ShowS
$cshow :: StreamError -> [Char]
show :: StreamError -> [Char]
$cshowList :: [StreamError] -> ShowS
showList :: [StreamError] -> ShowS
Show)

instance Exception StreamError where

type Env = IM.IntMap (Maybe (E T)); type I=Int
data Σ = Σ !I !Env (IM.IntMap (S.Set BS.ByteString)) (IM.IntMap IS.IntSet) (IM.IntMap (S.Set Double)) IS.IntSet
type Tmp = Int
type Β = IM.IntMap (E T)

mE :: (Env -> Env) -> Σ -> Σ
mE :: (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
f (Σ Int
i IntMap (Maybe (E T))
e IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) = Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
f IntMap (Maybe (E T))
e) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
gE :: Σ -> IntMap (Maybe (E T))
gE (Σ Int
_ IntMap (Maybe (E T))
e IntMap (Set ByteString)
_ IntMap IntSet
_ IntMap (Set Double)
_ IntSet
_) = IntMap (Maybe (E T))
e

at :: V.Vector a -> Int -> a
Vector a
v at :: forall a. Vector a -> Int -> a
`at` Int
ix = case Vector a
v Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!? (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of {Just a
x -> a
x; Maybe a
Nothing -> EvalErr -> a
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> a) -> EvalErr -> a
forall a b. (a -> b) -> a -> b
$ Int -> EvalErr
IndexOutOfBounds Int
ix}

fieldOf :: V.Vector BS.ByteString -> BS.ByteString -> Int -> BS.ByteString
fieldOf :: Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
fs ByteString
b Int
n = case Vector ByteString
fs Vector ByteString -> Int -> Maybe ByteString
forall a. Vector a -> Int -> Maybe a
V.!? (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of {Just ByteString
x -> ByteString
x; Maybe ByteString
Nothing -> EvalErr -> ByteString
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> ByteString) -> EvalErr -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> EvalErr
NoSuchField Int
n ByteString
b}

parseAsEInt :: BS.ByteString -> E T
parseAsEInt :: ByteString -> E T
parseAsEInt = Integer -> E T
mkI(Integer -> E T) -> (ByteString -> Integer) -> ByteString -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Integer
readDigits

parseAsF :: BS.ByteString -> E T
parseAsF :: ByteString -> E T
parseAsF = Double -> E T
mkF(Double -> E T) -> (ByteString -> Double) -> ByteString -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> Double
readFloat

(!) :: Env -> Tmp -> Maybe (E T)
! :: IntMap (Maybe (E T)) -> Int -> Maybe (E T)
(!) IntMap (Maybe (E T))
m Int
r = Maybe (E T) -> Int -> IntMap (Maybe (E T)) -> Maybe (E T)
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (EvalErr -> Maybe (E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw(EvalErr -> Maybe (E T)) -> EvalErr -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$Int -> EvalErr
InternalTmp Int
r) Int
r IntMap (Maybe (E T))
m

foldSeq :: t a -> t a
foldSeq t a
x = (a -> () -> ()) -> () -> t a -> ()
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> () -> ()
forall a b. a -> b -> b
seq () t a
x () -> t a -> t a
forall a b. a -> b -> b
`seq` t a
x

type MM = State Int

nI :: MM Int
nI :: MM Int
nI = (Int -> (Int, Int)) -> MM Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\Int
i -> (Int
i, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

nN :: T -> MM (Nm T)
nN :: T -> MM (Nm T)
nN T
t = do {u <- MM Int
nI; pure (Nm "fold_hole" (U u) t)}

pSF :: Bool -> (Maybe Tmp, [Tmp]) -> [Env] -> IO ()
pSF :: Bool -> (Maybe Int, [Int]) -> [IntMap (Maybe (E T))] -> IO ()
pSF Bool
flush (Just Int
t, [Int]
tt) [IntMap (Maybe (E T))
e] = do
    (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((E T -> IO ()) -> Maybe (E T) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> E T -> IO ()
pS Bool
flush)(Maybe (E T) -> IO ()) -> (Int -> Maybe (E T)) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IntMap (Maybe (E T))
e IntMap (Maybe (E T)) -> Int -> Maybe (E T)
!)) [Int]
tt
    (E T -> IO ()) -> Maybe (E T) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> E T -> IO ()
pS Bool
flush) (IntMap (Maybe (E T))
eIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
t)
pSF Bool
flush c :: (Maybe Int, [Int])
c@(Maybe Int
_, [Int]
tt) (IntMap (Maybe (E T))
e:[IntMap (Maybe (E T))]
es) = do
    (Maybe (E T) -> IO ()) -> [Maybe (E T)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((E T -> IO ()) -> Maybe (E T) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> E T -> IO ()
pS Bool
flush)) [IntMap (Maybe (E T))
eIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
t|Int
t <- [Int]
tt]
    Bool -> (Maybe Int, [Int]) -> [IntMap (Maybe (E T))] -> IO ()
pSF Bool
flush (Maybe Int, [Int])
c [IntMap (Maybe (E T))]
es
pSF Bool
_ (Maybe Int, [Int])
_ [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

run :: Bool -> Int -> E T -> [LineCtx] -> IO ()
run :: Bool -> Int -> E T -> [LineCtx] -> IO ()
run Bool
_ Int
_ E T
e [LineCtx]
_ | ty :: T
ty@TyArr{} <- E T -> T
forall a. E a -> a
eLoc E T
e = [Char] -> IO ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
"Found function type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ T -> [Char]
forall a. Show a => a -> [Char]
show T
ty)
run Bool
flush Int
j E T
e [LineCtx]
ctxs | TyB TB
TyUnit <- E T -> T
forall a. E a -> a
eLoc E T
e =  (\(Maybe Int
s, [Int]
f, [IntMap (Maybe (E T))]
env) -> Bool -> (Maybe Int, [Int]) -> [IntMap (Maybe (E T))] -> IO ()
pSF Bool
flush (Maybe Int
s,[Int]
f) [IntMap (Maybe (E T))]
env) ((Maybe Int, [Int], [IntMap (Maybe (E T))]) -> IO ())
-> (Maybe Int, [Int], [IntMap (Maybe (E T))]) -> IO ()
forall a b. (a -> b) -> a -> b
$ (State Int (Maybe Int, [Int], [IntMap (Maybe (E T))])
 -> Int -> (Maybe Int, [Int], [IntMap (Maybe (E T))]))
-> Int
-> State Int (Maybe Int, [Int], [IntMap (Maybe (E T))])
-> (Maybe Int, [Int], [IntMap (Maybe (E T))])
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (Maybe Int, [Int], [IntMap (Maybe (E T))])
-> Int -> (Maybe Int, [Int], [IntMap (Maybe (E T))])
forall s a. State s a -> s -> a
evalState Int
j (State Int (Maybe Int, [Int], [IntMap (Maybe (E T))])
 -> (Maybe Int, [Int], [IntMap (Maybe (E T))]))
-> State Int (Maybe Int, [Int], [IntMap (Maybe (E T))])
-> (Maybe Int, [Int], [IntMap (Maybe (E T))])
forall a b. (a -> b) -> a -> b
$ do
    (res, tt, iEnv, μ) <- E T
-> MM (Maybe Int, [Int], IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
unit E T
e
    u <- nI
    let outs=LineCtx -> Σ -> Σ
μ(LineCtx -> Σ -> Σ) -> [LineCtx] -> [Σ -> Σ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[LineCtx]
ctxs; es'=(Σ -> (Σ -> Σ) -> Σ) -> Σ -> [Σ -> Σ] -> [Σ]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Σ -> (Σ -> Σ) -> Σ
forall a b. a -> (a -> b) -> b
(&) (Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u IntMap (Maybe (E T))
iEnv IntMap (Set ByteString)
forall a. IntMap a
IM.empty IntMap IntSet
forall a. IntMap a
IM.empty IntMap (Set Double)
forall a. IntMap a
IM.empty IntSet
IS.empty) [Σ -> Σ]
outs
    pure (res, tt, gE<$>es')
run Bool
flush Int
j E T
e [LineCtx]
ctxs | TyB TB
TyStream:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
e = (Maybe (E T) -> IO ()) -> [Maybe (E T)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((E T -> IO ()) -> Maybe (E T) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> E T -> IO ()
pS Bool
flush))([Maybe (E T)] -> IO ())
-> (State Int [Maybe (E T)] -> [Maybe (E T)])
-> State Int [Maybe (E T)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(State Int [Maybe (E T)] -> Int -> [Maybe (E T)])
-> Int -> State Int [Maybe (E T)] -> [Maybe (E T)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [Maybe (E T)] -> Int -> [Maybe (E T)]
forall s a. State s a -> s -> a
evalState Int
j (State Int [Maybe (E T)] -> IO ())
-> State Int [Maybe (E T)] -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    t <- MM Int
nI
    (iEnv, μ) <- ctx e t
    u <- nI
    let outs=LineCtx -> Σ -> Σ
μ(LineCtx -> Σ -> Σ) -> [LineCtx] -> [Σ -> Σ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[LineCtx]
ctxs; es={-# SCC "scanMain" #-} (Σ -> (Σ -> Σ) -> Σ) -> Σ -> [Σ -> Σ] -> [Σ]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Σ -> (Σ -> Σ) -> Σ
forall a b. a -> (a -> b) -> b
(&) (Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u IntMap (Maybe (E T))
iEnv IntMap (Set ByteString)
forall a. IntMap a
IM.empty IntMap IntSet
forall a. IntMap a
IM.empty IntMap (Set Double)
forall a. IntMap a
IM.empty IntSet
IS.empty) [Σ -> Σ]
outs
    pure ((! t).gE<$>es)
run Bool
_ Int
j E T
e [LineCtx]
ctxs = E T -> IO ()
pDocLn (E T -> IO ()) -> E T -> IO ()
forall a b. (a -> b) -> a -> b
$ (State Int (E T) -> Int -> E T) -> Int -> State Int (E T) -> E T
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (E T) -> Int -> E T
forall s a. State s a -> s -> a
evalState Int
j (State Int (E T) -> E T) -> State Int (E T) -> E T
forall a b. (a -> b) -> a -> b
$ do
    (iEnv, g, e0) <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e
    u <- nI
    let updates=LineCtx -> Σ -> Σ
g(LineCtx -> Σ -> Σ) -> [LineCtx] -> [Σ -> Σ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[LineCtx]
ctxs
        finEnv=(Σ -> (Σ -> Σ) -> Σ) -> Σ -> [Σ -> Σ] -> Σ
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Σ -> (Σ -> Σ) -> Σ
forall a b. a -> (a -> b) -> b
(&) (Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u IntMap (Maybe (E T))
iEnv IntMap (Set ByteString)
forall a. IntMap a
IM.empty IntMap IntSet
forall a. IntMap a
IM.empty IntMap (Set Double)
forall a. IntMap a
IM.empty IntSet
IS.empty) [Σ -> Σ]
updates
    e0@>(fromMaybe (throw EmptyFold)<$>gE finEnv)

unit :: E T -> MM (Maybe Tmp, [Tmp], Env, LineCtx -> Σ -> Σ)
unit :: E T
-> MM (Maybe Int, [Int], IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
unit (Anchor T
_ [E T]
es) = do
    tt <- (E T -> MM Int) -> [E T] -> StateT Int Identity [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\E T
_ -> MM Int
nI) [E T]
es
    (iEnvs, μs) <- unzip <$> zipWithM ctx es tt
    pure (Nothing, tt, fold iEnvs, ts μs)
unit (EApp T
_ (EApp T
_ (BB T
_ BBin
Report) E T
es) E T
e) = do
    r <- MM Int
nI
    t <- nI
    (iEnv, μ) <- ctx es t
    (rEnv, g) <- φ e r
    pure (Just r, [t], iEnv<>rEnv, μ@.g)
unit E T
e = [Char]
-> MM (Maybe Int, [Int], IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
"Internal error. '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ E T -> [Char]
forall a. Show a => a -> [Char]
show E T
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"' assigned unit type?")

pS :: Bool -> E T -> IO ()
pS Bool
p = if Bool
p then (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>IO ()
fflush)(IO () -> IO ()) -> (E T -> IO ()) -> E T -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> IO ()
pDocLn else E T -> IO ()
pDocLn where fflush :: IO ()
fflush = Handle -> IO ()
hFlush Handle
stdout

pDocLn :: E T -> IO ()
pDocLn :: E T -> IO ()
pDocLn (Lit T
_ (FLit Double
f)) = Handle -> Builder -> IO ()
hPutBuilder Handle
stdout (Double -> Builder
doubleDec Double
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n")
pDocLn E T
e                = Doc Any -> IO ()
forall ann. Doc ann -> IO ()
putDoc (E T -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. E T -> Doc ann
pretty E T
e Doc Any -> Doc Any -> Doc Any
forall a. Semigroup a => a -> a -> a
<> Doc Any
forall ann. Doc ann
hardline)

collect :: E T -> MM (Env, LineCtx -> Σ -> Σ, E T)
collect :: E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect e :: E T
e@(EApp T
ty (EApp T
_ (EApp T
_ (TB T
_ BTer
Fold) E T
_) E T
_) E T
_) = do
    v <- T -> MM (Nm T)
nN T
ty
    (iEnv, g) <- φ e (unU$unique v)
    pure (iEnv, g, F v)
collect e :: E T
e@(EApp T
ty (EApp T
_ (BB T
_ BBin
Fold1) E T
_) E T
_) = do
    v <- T -> MM (Nm T)
nN T
ty
    (iEnv, g) <- φ e (unU$unique v)
    pure (iEnv, g, F v)
collect (Tup T
ty [E T]
es) = do
    (seedEnvs, updates, es') <- [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
-> ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
 -> ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T]))
-> StateT
     Int Identity [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
-> StateT
     Int Identity ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> [E T]
-> StateT
     Int Identity [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect [E T]
es
    pure (fold seedEnvs, ts updates, Tup ty es')
collect (Rec T
ty [(Nm T, E T)]
rs) = do
    (seedEnvs, updates, es') <- [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
-> ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
 -> ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T]))
-> StateT
     Int Identity [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
-> StateT
     Int Identity ([IntMap (Maybe (E T))], [LineCtx -> Σ -> Σ], [E T])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> [E T]
-> StateT
     Int Identity [(IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect [E T]
es
    pure (fold seedEnvs, ts updates, Rec ty (zip ns es'))
  where
    ([Nm T]
ns,[E T]
es)=[(Nm T, E T)] -> ([Nm T], [E T])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Nm T, E T)]
rs
collect (EApp T
ty0 (EApp T
ty1 op :: E T
op@BB{} E T
e0) E T
e1) = do
    (env1, f1, e1') <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e1
    (env0, f0, e0') <- collect e0
    pure (env0<>env1, f1@.f0, EApp ty0 (EApp ty1 op e0') e1')
collect (EApp T
ty0 (EApp T
ty1 (EApp T
ty2 op :: E T
op@TB{} E T
e0) E T
e1) E T
e2) = do
    (env2, f2, e2') <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e2
    (env1, f1, e1') <- collect e1
    (env0, f0, e0') <- collect e0
    pure (env0<>env1<>env2, f2@.f1@.f0, EApp ty0 (EApp ty1 (EApp ty2 op e0') e1') e2')
collect (EApp T
ty f :: E T
f@UB{} E T
e) = do
    (env, fϵ, eϵ) <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e
    pure (env, fϵ, EApp ty f eϵ)
collect e :: E T
e@Lit{} = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap (Maybe (E T))
forall a. IntMap a
IM.empty, (Σ -> Σ) -> LineCtx -> Σ -> Σ
forall a b. a -> b -> a
const Σ -> Σ
forall a. a -> a
id, E T
e)
collect (Cond T
t E T
p E T
e0 E T
e1) = do
    (envp, pg, p') <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
p
    (env0, f0, e0') <- collect e0
    (env1, f1, e1') <- collect e1
    pure (envp<>env0<>env1, pg@.f0@.f1, Cond t p' e0' e1')
collect (Lam T
t Nm T
n E T
e) = do
    (env,f,e') <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e
    pure (env,f,Lam t n e')
collect (OptionVal T
t (Just E T
e)) = do
    (env, f, e') <- E T -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
collect E T
e
    pure (env, f, OptionVal t (Just e'))
collect (OptionVal T
t Maybe (E T)
Nothing) = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap (Maybe (E T))
forall a. Monoid a => a
mempty, (Σ -> Σ) -> LineCtx -> Σ -> Σ
forall a b. a -> b -> a
const Σ -> Σ
forall a. a -> a
id, T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
t Maybe (E T)
forall a. Maybe a
Nothing)
collect e :: E T
e@Column{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@IParseCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@FParseCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@ParseCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@AllColumn{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@ParseAllCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@IParseAllCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@FParseAllCol{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@Guarded{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect e :: E T
e@Implicit{} = EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T))
-> EvalErr -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a b. (a -> b) -> a -> b
$ E T -> EvalErr
InternalUnexpectedStream E T
e
collect Field{} = StreamError -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw StreamError
NakedField
collect LastField{} = StreamError -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw StreamError
NakedField
collect AllField{} = StreamError -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw StreamError
NakedField
collect FieldList{} = StreamError -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ, E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw StreamError
NakedField

t -> b -> c
f @. :: (t -> b -> c) -> (t -> a -> b) -> t -> a -> c
@. t -> a -> b
g = \t
l -> t -> b -> c
f t
l(b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t -> a -> b
g t
l

ts :: [LineCtx -> Σ -> Σ] -> LineCtx -> Σ -> Σ
ts :: [LineCtx -> Σ -> Σ] -> LineCtx -> Σ -> Σ
ts = ((LineCtx -> Σ -> Σ) -> (LineCtx -> Σ -> Σ) -> LineCtx -> Σ -> Σ)
-> (LineCtx -> Σ -> Σ) -> [LineCtx -> Σ -> Σ] -> LineCtx -> Σ -> Σ
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (LineCtx -> Σ -> Σ) -> (LineCtx -> Σ -> Σ) -> LineCtx -> Σ -> Σ
forall {t} {b} {c} {a}.
(t -> b -> c) -> (t -> a -> b) -> t -> a -> c
(@.) (\LineCtx
_ -> Σ -> Σ
forall a. a -> a
id)

φ :: E T -> Tmp -> MM (Env, LineCtx -> Σ -> Σ)
φ :: E T -> Int -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
φ (EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Fold) E T
op) E T
seed) E T
xs) Int
tgt = do
    t <- MM Int
nI
    seed' <- seed @> mempty
    let iEnv=Int -> Maybe (E T) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a
IM.singleton Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
seed')
    (env, f) <- ctx xs t
    let g=E T -> Int -> Int -> Σ -> Σ
wF E T
op Int
t Int
tgt
    pure (env<>iEnv, (g.).f)
φ (EApp T
_ (EApp T
_ (BB T
_ BBin
Fold1) E T
op) E T
xs) Int
tgt = do
    let iEnv :: IntMap (Maybe a)
iEnv=Int -> Maybe a -> IntMap (Maybe a)
forall a. Int -> a -> IntMap a
IM.singleton Int
tgt Maybe a
forall a. Maybe a
Nothing
    t <- MM Int
nI
    (env, f) <- ctx xs t
    let g=E T -> Int -> Int -> Σ -> Σ
wF E T
op Int
t Int
tgt
    pure (env<>iEnv, (g.).f)

{-# SCC κ #-}
κ :: E T -> LineCtx -> E T
κ :: E T -> LineCtx -> E T
κ AllField{} ~(ByteString
b, Vector ByteString
_, Integer
_)   = ByteString -> E T
mkStr ByteString
b
κ (Field T
_ Int
i) ~(ByteString
_, Vector ByteString
bs, Integer
_) = ByteString -> E T
mkStr (ByteString -> E T) -> ByteString -> E T
forall a b. (a -> b) -> a -> b
$ Vector ByteString
bs Vector ByteString -> Int -> ByteString
forall a. Vector a -> Int -> a
`at` Int
i
κ LastField{} ~(ByteString
_, Vector ByteString
bs, Integer
_) = ByteString -> E T
mkStr (ByteString -> E T) -> ByteString -> E T
forall a b. (a -> b) -> a -> b
$ Vector ByteString -> ByteString
forall a. Vector a -> a
V.last Vector ByteString
bs
κ FieldList{} ~(ByteString
_, Vector ByteString
bs, Integer
_) = Vector ByteString -> E T
vS Vector ByteString
bs
κ (EApp T
ty E T
e0 E T
e1) LineCtx
line    = T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a
EApp T
ty (E T
e0 E T -> LineCtx -> E T
`κ` LineCtx
line) (E T
e1 E T -> LineCtx -> E T
`κ` LineCtx
line)
κ (NB T
_ N
Ix) ~(ByteString
_, Vector ByteString
_, Integer
fp)   = Integer -> E T
mkI Integer
fp
κ (NB T
_ N
Nf) ~(ByteString
_, Vector ByteString
bs, Integer
_)   = Integer -> E T
mkI(Integer -> E T) -> Integer -> E T
forall a b. (a -> b) -> a -> b
$Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ByteString -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector ByteString
bs)
κ e :: E T
e@BB{} LineCtx
_                = E T
e
κ e :: E T
e@UB{} LineCtx
_                = E T
e
κ e :: E T
e@TB{} LineCtx
_                = E T
e
κ e :: E T
e@NB{} LineCtx
_                = E T
e
κ e :: E T
e@Lit{} LineCtx
_               = E T
e
κ e :: E T
e@RC{} LineCtx
_                = E T
e
κ e :: E T
e@Var{} LineCtx
_               = E T
e
κ e :: E T
e@F{} LineCtx
_                 = E T
e
κ (Lam T
t Nm T
n E T
e) LineCtx
line        = T -> Nm T -> E T -> E T
forall a. a -> Nm a -> E a -> E a
Lam T
t Nm T
n (E T -> LineCtx -> E T
κ E T
e LineCtx
line)
κ (Tup T
ty [E T]
es) LineCtx
line        = T -> [E T] -> E T
forall a. a -> [E a] -> E a
Tup T
ty ((E T -> LineCtx -> E T
`κ` LineCtx
line)(E T -> E T) -> [E T] -> [E T]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[E T]
es)
κ (Arr T
ty Vector (E T)
es) LineCtx
line        = T -> Vector (E T) -> E T
forall a. a -> Vector (E a) -> E a
Arr T
ty ((E T -> LineCtx -> E T
`κ` LineCtx
line)(E T -> E T) -> Vector (E T) -> Vector (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Vector (E T)
es)
κ (Rec T
ty [(Nm T, E T)]
es) LineCtx
line        = T -> [(Nm T, E T)] -> E T
forall a. a -> [(Nm a, E a)] -> E a
Rec T
ty ((E T -> E T) -> (Nm T, E T) -> (Nm T, E T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (E T -> LineCtx -> E T
`κ` LineCtx
line)((Nm T, E T) -> (Nm T, E T)) -> [(Nm T, E T)] -> [(Nm T, E T)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(Nm T, E T)]
es)
κ (OptionVal T
t Maybe (E T)
e) LineCtx
line    = T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
t ((E T -> LineCtx -> E T
`κ` LineCtx
line)(E T -> E T) -> Maybe (E T) -> Maybe (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$!>Maybe (E T)
e)
κ (Cond T
ty E T
p E T
e0 E T
e1) LineCtx
line  = T -> E T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a -> E a
Cond T
ty (E T
p E T -> LineCtx -> E T
`κ` LineCtx
line) (E T
e0 E T -> LineCtx -> E T
`κ` LineCtx
line) (E T
e1 E T -> LineCtx -> E T
`κ` LineCtx
line)
κ e :: E T
e@ParseCol{} LineCtx
_          = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@IParseCol{} LineCtx
_         = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@FParseCol{} LineCtx
_         = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@Column{} LineCtx
_            = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@AllColumn{} LineCtx
_         = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@Guarded{} LineCtx
_           = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@Implicit{} LineCtx
_          = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@IParseAllCol{} LineCtx
_      = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@FParseAllCol{} LineCtx
_      = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@Anchor{} LineCtx
_            = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ e :: E T
e@ParseAllCol{} LineCtx
_       = E T -> E T
forall {a} {a}. Show a => a -> a
badctx E T
e
κ Dfn{} LineCtx
_                 = E T
forall {a}. a
desugar
κ ResVar{} LineCtx
_              = E T
forall {a}. a
desugar
κ Paren{} LineCtx
_               = E T
forall {a}. a
desugar
κ RwB{} LineCtx
_                 = E T
forall {a}. a
desugar
κ RwT{} LineCtx
_                 = E T
forall {a}. a
desugar

ni :: Int -> IntMap (Maybe a)
ni Int
t=Int -> Maybe a -> IntMap (Maybe a)
forall a. Int -> a -> IntMap a
IM.singleton Int
t Maybe a
forall a. Maybe a
Nothing
na :: Int -> IntMap (Maybe a) -> IntMap (Maybe a)
na=(Maybe (Maybe a) -> Maybe (Maybe a))
-> Int -> IntMap (Maybe a) -> IntMap (Maybe a)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Maybe a) -> Maybe (Maybe a)
forall {a}. Maybe (Maybe a) -> Maybe (Maybe a)
go where go :: Maybe (Maybe a) -> Maybe (Maybe a)
go Maybe (Maybe a)
Nothing = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing; go x :: Maybe (Maybe a)
x@Just{} = Maybe (Maybe a)
x

ctx :: E T -> Tmp -> MM (Env, LineCtx -> Σ -> Σ)
ctx :: E T -> Int -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
ctx AllColumn{} Int
res                                      = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
_, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
mkStr ByteString
b))
ctx (ParseAllCol (T
_:$TyB TB
TyI)) Int
res                       = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
_, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsEInt ByteString
b))
ctx (ParseAllCol (T
_:$TyB TB
TyFloat)) Int
res                   = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
_, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsF ByteString
b))
ctx FParseAllCol{} Int
res                                   = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
_, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsF ByteString
b))
ctx IParseAllCol{} Int
res                                   = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
_, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsEInt ByteString
b))
ctx (Column T
_ Int
i) Int
res                                     = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
bs, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$ByteString -> E T
mkStr (Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
bs ByteString
b Int
i)))
ctx (FParseCol T
_ Int
i) Int
res                                  = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
bs, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsF (Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
bs ByteString
b Int
i)))
ctx (IParseCol T
_ Int
i) Int
res                                  = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
bs, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsEInt (Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
bs ByteString
b Int
i)))
ctx (ParseCol (T
_:$TyB TB
TyFloat) Int
i) Int
res                    = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
bs, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsF (Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
bs ByteString
b Int
i)))
ctx (ParseCol (T
_:$TyB TB
TyI) Int
i) Int
res                        = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
res, \ ~(ByteString
b, Vector ByteString
bs, Integer
_) -> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
mE((IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ)
-> (IntMap (Maybe (E T)) -> IntMap (Maybe (E T))) -> Σ -> Σ
forall a b. (a -> b) -> a -> b
$Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
res (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!ByteString -> E T
parseAsEInt (Vector ByteString -> ByteString -> Int -> ByteString
fieldOf Vector ByteString
bs ByteString
b Int
i)))
ctx (EApp T
_ (EApp T
_ (BB T
_ BBin
Map) E T
f) E T
xs) Int
o                  = do {t <- MM Int
nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->E T -> Int -> Int -> Σ -> Σ
wM E T
f Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (BB T
_ BBin
MapMaybe) E T
f) E T
xs) Int
o             = do {t <- MM Int
nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->E T -> Int -> Int -> Σ -> Σ
wMM E T
f Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (UB T
_ BUn
CatMaybes) E T
xs) Int
o                       = do {t <- MM Int
nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->Int -> Int -> Σ -> Σ
wCM Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (BB T
_ BBin
Filter) E T
p) E T
xs) Int
o               = do {t <- MM Int
nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->E T -> Int -> Int -> Σ -> Σ
wP E T
p Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (Guarded T
_ E T
p E T
e) Int
o                                    = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
o, (E T, E T) -> Int -> LineCtx -> Σ -> Σ
wG (E T
p, E T
e) Int
o)
ctx (Implicit T
_ E T
e) Int
o                                     = (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
-> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IntMap (Maybe (E T))
forall {a}. Int -> IntMap (Maybe a)
ni Int
o, E T -> Int -> LineCtx -> Σ -> Σ
wI E T
e Int
o)
ctx (EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Scan) E T
op) E T
seed) E T
xs) Int
o  = do {t <- MM Int
nI; (env, sb) <- ctx xs t; seed' <- seed@>mempty; pure (IM.insert o (Just$!seed') env, \LineCtx
l->E T -> Int -> Int -> Σ -> Σ
wF E T
op Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
ZipW) E T
op) E T
xs) E T
ys) Int
o    = do {t0 <- MM Int
nI; t1 <- nI; (env0, sb0) <- ctx xs t0; (env1, sb1) <- ctx ys t1; pure (na o (env0<>env1), \LineCtx
l->E T -> Int -> Int -> Int -> Σ -> Σ
wZ E T
op Int
t0 Int
t1 Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb0 LineCtx
l(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb1 LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (BB T
_ BBin
Prior) E T
op) E T
xs) Int
o               = do {t <- MM Int
nI; (env, sb) <- ctx xs t; pt <- nI; pure (na o (IM.insert pt Nothing env), \LineCtx
l -> E T -> Int -> Int -> Int -> Σ -> Σ
wΠ E T
op Int
pt Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp (T
_:$TyB TB
ty) (UB T
_ BUn
Dedup) E T
xs) Int
o                 = do {k <- MM Int
nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->TB -> Int -> Int -> Int -> Σ -> Σ
wD TB
ty Int
k Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (BB T
_ BBin
DedupOn) E T
f) E T
xs) Int
o              = do {k <- MM Int
nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \LineCtx
l->E T -> Int -> Int -> Int -> Σ -> Σ
wDOp E T
f Int
k Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx (EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Bookend) E T
e0) E T
e1) E T
xs) Int
o = do {k <- MM Int
nI; t <- nI; (env, sb) <- ctx xs t; r0 <- e0@>mempty; r1<- e1@>mempty; pure (na o env, \LineCtx
l->(E T, E T) -> Int -> Int -> Int -> Σ -> Σ
wB (E T
r0,E T
r1) Int
k Int
t Int
o(Σ -> Σ) -> (Σ -> Σ) -> Σ -> Σ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineCtx -> Σ -> Σ
sb LineCtx
l)}
ctx E T
e Int
_ | TyB TB
TyStream:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
e = [Char] -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
"?? uh-oh. " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ E T -> [Char]
forall a. Show a => a -> [Char]
show E T
e)
        | Bool
otherwise = [Char] -> MM (IntMap (Maybe (E T)), LineCtx -> Σ -> Σ)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Internal error. ctx expects a stream."

type LineCtx = (BS.ByteString, V.Vector BS.ByteString, Integer) -- line number

asS :: E T -> BS.ByteString
asS :: E T -> ByteString
asS (Lit T
_ (StrLit ByteString
s)) = ByteString
s; asS E T
e = EvalErr -> ByteString
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyStr)

asI :: E T -> Integer
asI :: E T -> Integer
asI (Lit T
_ (ILit Integer
i)) = Integer
i; asI E T
e = EvalErr -> Integer
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyI)

asF :: E T -> Double
asF :: E T -> Double
asF (Lit T
_ (FLit Double
x)) = Double
x; asF E T
e = EvalErr -> Double
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyFloat)

asR :: E T -> RurePtr
asR :: E T -> RurePtr
asR (RC RurePtr
r) = RurePtr
r; asR E T
e = EvalErr -> RurePtr
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyR)

asM :: E T -> Maybe (E T)
asM :: E T -> Maybe (E T)
asM (OptionVal T
_ Maybe (E T)
e) = Maybe (E T)
e; asM E T
e = EvalErr -> Maybe (E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyOption)

asB :: E T -> Bool
asB :: E T -> Bool
asB (Lit T
_ (BLit Bool
b)) = Bool
b; asB E T
e = EvalErr -> Bool
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyBool)

asV :: E T -> V.Vector (E T)
asV :: E T -> Vector (E T)
asV (Arr T
_ Vector (E T)
v) = Vector (E T)
v; asV E T
e = EvalErr -> Vector (E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> TB -> EvalErr
InternalCoercionError E T
e TB
TyVec)

asT :: E T -> [E T]
asT :: E T -> [E T]
asT (Tup T
_ [E T]
es) = [E T]
es; asT E T
e = EvalErr -> [E T]
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> EvalErr
ExpectedTup E T
e)

asRec :: E T -> M.Map T.Text (E T)
asRec :: E T -> Map Text (E T)
asRec (Rec T
_ [(Nm T, E T)]
rs) = [(Text, E T)] -> Map Text (E T)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Nm T -> Text) -> (Nm T, E T) -> (Text, E T)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Nm T -> Text
forall a. Nm a -> Text
name((Nm T, E T) -> (Text, E T)) -> [(Nm T, E T)] -> [(Text, E T)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(Nm T, E T)]
rs); asRec E T
e = EvalErr -> Map Text (E T)
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (E T -> EvalErr
ExpectedRec E T
e)

vS :: V.Vector BS.ByteString -> E T
vS :: Vector ByteString -> E T
vS = T -> Vector (E T) -> E T
forall a. a -> Vector (E a) -> E a
Arr (T -> T
tyV T
tyStr)(Vector (E T) -> E T)
-> (Vector ByteString -> Vector (E T)) -> Vector ByteString -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ByteString -> E T) -> Vector ByteString -> Vector (E T)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> E T
mkStr

the :: BS.ByteString -> Word8
the :: ByteString -> Word8
the ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
    Maybe (Word8, ByteString)
Nothing                -> [Char] -> Word8
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Empty splitc char!"
    Just (Word8
c,ByteString
b) | ByteString -> Bool
BS.null ByteString
b -> Word8
c
    Just (Word8, ByteString)
_                 -> [Char] -> Word8
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Splitc takes only one char!"

rureMatchTup :: RureMatch -> E T
rureMatchTup :: RureMatch -> E T
rureMatchTup (RureMatch CSize
s CSize
e) = T -> [E T] -> E T
forall a. a -> [E a] -> E a
Tup ([T] -> T
TyTup [T
tyI,T
tyI]) (Integer -> E T
mkI(Integer -> E T) -> (CSize -> Integer) -> CSize -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CSize -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CSize -> E T) -> [CSize] -> [E T]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[CSize
s,CSize
e])

asTup :: Maybe RureMatch -> E T
asTup :: Maybe RureMatch -> E T
asTup Maybe RureMatch
Nothing  = T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
forall a. (?callStack::CallStack) => a
undefined Maybe (E T)
forall a. Maybe a
Nothing
asTup (Just RureMatch
m) = T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
forall a. (?callStack::CallStack) => a
undefined (E T -> Maybe (E T)
forall a. a -> Maybe a
Just (RureMatch -> E T
rureMatchTup RureMatch
m))

{-# SCC (!>) #-}
(!>) :: Β -> Nm T -> E T
!> :: Β -> Nm T -> E T
(!>) Β
m Nm T
n = E T -> Int -> Β -> E T
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault (EvalErr -> E T
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw(EvalErr -> E T) -> EvalErr -> E T
forall a b. (a -> b) -> a -> b
$Nm T -> EvalErr
InternalNm Nm T
n) (U -> Int
unU(U -> Int) -> U -> Int
forall a b. (a -> b) -> a -> b
$Nm T -> U
forall a. Nm a -> U
unique Nm T
n) Β
m

a2e :: Β -> E T -> E T -> E T -> UM (E T)
a2e :: Β -> E T -> E T -> E T -> State Int (E T)
a2e Β
b E T
op E T
e0 E T
e1 = (E T -> Β -> State Int (E T)
@>Β
b) (E T -> State Int (E T)) -> State Int (E T) -> State Int (E T)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< E T -> E T -> E T -> State Int (E T)
a2 E T
op E T
e0 E T
e1

a1e :: Β -> E T -> E T -> UM (E T)
a1e :: Β -> E T -> E T -> State Int (E T)
a1e Β
b E T
f E T
x = (E T -> Β -> State Int (E T)
@>Β
b) (E T -> State Int (E T)) -> State Int (E T) -> State Int (E T)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< E T -> E T -> State Int (E T)
a1 E T
f E T
x

eB :: Int ->E T -> E T
eB :: Int -> E T -> E T
eB Int
j = (State Int (E T) -> Int -> E T) -> Int -> State Int (E T) -> E T
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (E T) -> Int -> E T
forall s a. State s a -> s -> a
evalState Int
j(State Int (E T) -> E T) -> (E T -> State Int (E T)) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((E T -> Β -> State Int (E T)
@>Β
forall a. Monoid a => a
mempty) (E T -> State Int (E T))
-> (E T -> State Int (E T)) -> E T -> State Int (E T)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< E T -> State Int (E T)
forall a. E a -> UM (E a)
lβ)

a1 :: E T -> E T -> UM (E T)
a1 :: E T -> E T -> State Int (E T)
a1 E T
f E T
x | TyArr T
_ T
cod <- E T -> T
forall a. E a -> a
eLoc E T
f = E T -> State Int (E T)
forall a. E a -> UM (E a)
lβ (T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a
EApp T
cod E T
f E T
x)

a2 :: E T -> E T -> E T -> UM (E T)
a2 :: E T -> E T -> E T -> State Int (E T)
a2 E T
op E T
x0 E T
x1 | TyArr T
_ t :: T
t@(TyArr T
_ T
t') <- E T -> T
forall a. E a -> a
eLoc E T
op = E T -> State Int (E T)
forall a. E a -> UM (E a)
lβ (T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a
EApp T
t' (T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a
EApp T
t E T
op E T
x0) E T
x1)

num :: Num a => BBin -> Maybe (a -> a -> a)
num :: forall a. Num a => BBin -> Maybe (a -> a -> a)
num BBin
Plus = (a -> a -> a) -> Maybe (a -> a -> a)
forall a. a -> Maybe a
Just a -> a -> a
forall a. Num a => a -> a -> a
(+); num BBin
Minus = (a -> a -> a) -> Maybe (a -> a -> a)
forall a. a -> Maybe a
Just (-); num BBin
Times = (a -> a -> a) -> Maybe (a -> a -> a)
forall a. a -> Maybe a
Just a -> a -> a
forall a. Num a => a -> a -> a
(*); num BBin
_ = Maybe (a -> a -> a)
forall a. Maybe a
Nothing

binRel :: Ord a => BBin -> Maybe (a -> a -> Bool)
binRel :: forall a. Ord a => BBin -> Maybe (a -> a -> Bool)
binRel BBin
Lt = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<); binRel BBin
Gt = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>); binRel BBin
Eq = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
binRel BBin
Neq = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=); binRel BBin
Geq = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=); binRel BBin
Leq = (a -> a -> Bool) -> Maybe (a -> a -> Bool)
forall a. a -> Maybe a
Just a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
binRel BBin
_   = Maybe (a -> a -> Bool)
forall a. Maybe a
Nothing

($@) :: E T -> Int -> (E T, Int)
E T
e $@ :: E T -> Int -> (E T, Int)
$@ Int
j = E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
forall a. Monoid a => a
mempty)

(@!) :: E T -> (Int, Β) -> (E T, Int)
@! :: E T -> (Int, Β) -> (E T, Int)
(@!) E T
e (Int
j,Β
ϵ) = State Int (E T) -> Int -> (E T, Int)
forall s a. State s a -> s -> (a, s)
runState (E T
eE T -> Β -> State Int (E T)
@>Β
ϵ) Int
j

{-# SCC (@>) #-}
(@>) :: E T -> Β -> UM (E T)
e :: E T
e@Lit{} @> :: E T -> Β -> State Int (E T)
@> Β
_     = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
e
e :: E T
e@RC{} @> Β
_      = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
e
(F Nm T
n) @> Β
b       = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E T -> State Int (E T)) -> E T -> State Int (E T)
forall a b. (a -> b) -> a -> b
$ Β
bΒ -> Nm T -> E T
!>Nm T
n
e :: E T
e@(Var T
_ Nm T
n) @> Β
b = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E T -> State Int (E T)) -> E T -> State Int (E T)
forall a b. (a -> b) -> a -> b
$ case Int -> Β -> Maybe (E T)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (U -> Int
unU(U -> Int) -> U -> Int
forall a b. (a -> b) -> a -> b
$Nm T -> U
forall a. Nm a -> U
unique Nm T
n) Β
b of {Just E T
y -> E T
y; Maybe (E T)
Nothing -> E T
e}
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyI) T
_) BBin
Max) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> Integer
asI(E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1' <- asI<$>(x1@>b)
    pure $ mkI (max x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyI) T
_) BBin
Min) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> Integer
asI (E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1' <- asI <$> (x1@>b)
    pure $ mkI (min x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyFloat) T
_) BBin
Max) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> Double
asF(E T -> Double) -> State Int (E T) -> StateT Int Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1' <- asF<$>(x1@>b)
    pure $ mkF (max x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyFloat) T
_) BBin
Min) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> Double
asF(E T -> Double) -> State Int (E T) -> StateT Int Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1' <- asF<$>(x1@>b)
    pure $ mkF (min x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyStr) T
_) BBin
Max) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> ByteString
asS(E T -> ByteString)
-> State Int (E T) -> StateT Int Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1' <- asS<$>(x1@>b)
    pure $ mkStr (max x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyStr) T
_) BBin
Min) E T
x0) E T
x1) @> Β
b = do
    x0' <- E T -> ByteString
asS(E T -> ByteString)
-> State Int (E T) -> StateT Int Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1'<-asS<$>(x1@>b)
    pure $ mkStr (min x0' x1')
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyI) T
_) BBin
op) E T
x0) E T
x1) @> Β
b | Just Integer -> Integer -> Integer
op' <- BBin -> Maybe (Integer -> Integer -> Integer)
forall a. Num a => BBin -> Maybe (a -> a -> a)
num BBin
op = do
    x0e <- E T -> Integer
asI(E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1e <- asI<$>(x1@>b)
    pure $ mkI (op' x0e x1e)
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyFloat) T
_) BBin
op) E T
x0) E T
x1) @> Β
b | Just Double -> Double -> Double
op' <- BBin -> Maybe (Double -> Double -> Double)
forall a. Num a => BBin -> Maybe (a -> a -> a)
num BBin
op = do
    x0e <- E T -> Double
asF(E T -> Double) -> State Int (E T) -> StateT Int Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1e <- asF<$>(x1@>b)
    pure $ mkF (op' x0e x1e)
(EApp T
_ (EApp T
_ (BB T
_ BBin
Div) E T
x0) E T
x1) @> Β
b = do
    x0e <- E T
x0E T -> Β -> State Int (E T)
@>Β
b; x1e <- x1@>b
    pure (mkF (asF x0e/asF x1e))
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyI) T
_) BBin
op) E T
x0) E T
x1) @> Β
b | Just Integer -> Integer -> Bool
rel <- BBin -> Maybe (Integer -> Integer -> Bool)
forall a. Ord a => BBin -> Maybe (a -> a -> Bool)
binRel BBin
op = do
    x0e<-E T -> Integer
asI(E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1e<-asI<$>(x1@>b)
    pure (mkB (rel x0e x1e))
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyFloat) T
_) BBin
op) E T
x0) E T
x1) @> Β
b | Just Double -> Double -> Bool
rel <- BBin -> Maybe (Double -> Double -> Bool)
forall a. Ord a => BBin -> Maybe (a -> a -> Bool)
binRel BBin
op = do
    x0e <- E T -> Double
asF(E T -> Double) -> State Int (E T) -> StateT Int Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1e <- asF<$>(x1@>b)
    pure (mkB (rel x0e x1e))
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyStr) T
_) BBin
op) E T
x0) E T
x1) @> Β
b | Just ByteString -> ByteString -> Bool
rel <- BBin -> Maybe (ByteString -> ByteString -> Bool)
forall a. Ord a => BBin -> Maybe (a -> a -> Bool)
binRel BBin
op = do
    x0e <- E T -> ByteString
asS(E T -> ByteString)
-> State Int (E T) -> StateT Int Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
x0E T -> Β -> State Int (E T)
@>Β
b); x1e <- asS<$>(x1@>b)
    pure (mkB (rel x0e x1e))
(EApp T
_ (EApp T
_ (BB (TyArr (TyB TB
TyStr) T
_) BBin
Plus) E T
x0) E T
x1) @> Β
b = do
    x0e <- E T
x0E T -> Β -> State Int (E T)
@>Β
b; x1e <- x1@>b
    pure (mkStr (asS x0e<>asS x1e))
(EApp T
_ (EApp T
_ (BB T
_ BBin
And) E T
x0) E T
x1) @> Β
b = do
    x0e <- E T
x0E T -> Β -> State Int (E T)
@>Β
b; x1e <- x1@>b
    pure (mkB (asB x0e&&asB x1e))
(EApp T
_ (EApp T
_ (BB T
_ BBin
Or) E T
x0) E T
x1) @> Β
b = do
    x0e <- E T
x0E T -> Β -> State Int (E T)
@>Β
b; x1e <- x1@>b
    pure (mkB (asB x0e||asB x1e))
(EApp T
_ (EApp T
_ (UB T
_ BUn
Const) E T
x) E T
_) @> Β
b = E T
xE T -> Β -> State Int (E T)
@>Β
b
(EApp T
_ (EApp T
_ (BB T
_ BBin
Match) E T
s) E T
r) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; r' <- r@>b
    pure (asTup (find' (asR r') (asS s')))
(EApp T
_ (EApp T
_ (BB T
_ BBin
Matches) E T
s) E T
r) @> Β
b = do
    se <- E T
sE T -> Β -> State Int (E T)
@>Β
b; re <- r@>b
    pure (mkB (isMatch' (asR re) (asS se)))
(EApp T
_ (EApp T
_ (BB T
_ BBin
NotMatches) E T
s) E T
r) @> Β
b = do
    se <- E T
sE T -> Β -> State Int (E T)
@>Β
b; re <- r@>b
    pure (mkB (not$isMatch' (asR re) (asS se)))
(EApp T
ty (EApp T
_ (BB T
_ BBin
MMatch) E T
s) E T
r) @> Β
b = do
    se <- E T
sE T -> Β -> State Int (E T)
@>Β
b; re <- r@>b
    pure (if isMatch' (asR re) (asS se) then OptionVal ty (Just$!se) else OptionVal ty Nothing)
(EApp T
ty (EApp T
_ (BB T
_ BBin
Take) E T
n) E T
x) @> Β
b = do
    n' <- E T -> Integer
asI(E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
nE T -> Β -> State Int (E T)
@>Β
b); x' <- asV<$>(x@>b)
    pure $ Arr ty (V.take (fromIntegral n') x')
(EApp T
ty (EApp T
_ (BB T
_ BBin
Drop) E T
n) E T
x) @> Β
b = do
    n' <- E T -> Integer
asI(E T -> Integer) -> State Int (E T) -> StateT Int Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
nE T -> Β -> State Int (E T)
@>Β
b); x' <- asV<$>(x@>b)
    pure $ Arr ty (V.drop (fromIntegral n') x')
(Tup T
ty [E T]
es) @> Β
b = T -> [E T] -> E T
forall a. a -> [E a] -> E a
Tup T
ty([E T] -> E T) -> ([E T] -> [E T]) -> [E T] -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[E T] -> [E T]
forall {t :: * -> *} {a}. Foldable t => t a -> t a
foldSeq ([E T] -> E T) -> StateT Int Identity [E T] -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T -> State Int (E T)) -> [E T] -> StateT Int Identity [E T]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (E T -> Β -> State Int (E T)
@>Β
b) [E T]
es
(Rec T
ty [(Nm T, E T)]
es) @> Β
b = T -> [(Nm T, E T)] -> E T
forall a. a -> [(Nm a, E a)] -> E a
Rec T
ty([(Nm T, E T)] -> E T)
-> ([(Nm T, E T)] -> [(Nm T, E T)]) -> [(Nm T, E T)] -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(Nm T, E T)] -> [(Nm T, E T)]
forall {t :: * -> *} {a}. Foldable t => t a -> t a
foldSeq ([(Nm T, E T)] -> E T)
-> StateT Int Identity [(Nm T, E T)] -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Nm T, E T) -> StateT Int Identity (Nm T, E T))
-> [(Nm T, E T)] -> StateT Int Identity [(Nm T, E T)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((E T -> State Int (E T))
-> (Nm T, E T) -> StateT Int Identity (Nm T, E T)
forall (m :: * -> *) b b' a.
Functor m =>
(b -> m b') -> (a, b) -> m (a, b')
secondM (E T -> Β -> State Int (E T)
@>Β
b)) [(Nm T, E T)]
es
(EApp T
_ (UB T
_ BUn
Head) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    pure $ V.head (asV x')
(EApp T
ty (UB T
_ BUn
Tail) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    pure $ Arr ty (V.tail (asV x'))
(EApp T
_ (UB T
_ BUn
Last) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    pure $ V.last (asV x')
(EApp T
ty (UB T
_ BUn
Init) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    pure $ Arr ty (V.init (asV x'))
(EApp T
_ (UB T
_ BUn
Tally) E T
e) @> Β
b = do
    e' <- E T
eE T -> Β -> State Int (E T)
@>Β
b
    pure $ let r=Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length(ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$E T -> ByteString
asS E T
e') in mkI r
(EApp T
_ (UB T
_ BUn
TallyList) E T
e) @> Β
b = do
    e' <- E T
eE T -> Β -> State Int (E T)
@>Β
b
    pure $ let r=Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (E T) -> Int
forall a. Vector a -> Int
V.length(Vector (E T) -> Int) -> Vector (E T) -> Int
forall a b. (a -> b) -> a -> b
$E T -> Vector (E T)
asV E T
e') in mkI r
(EApp T
_ (EApp T
_ (BB T
_ BBin
Sprintf) E T
fs) E T
s) @> Β
b = do
    fs' <- E T
fsE T -> Β -> State Int (E T)
@>Β
b; s' <- s@>b
    pure (mkStr (sprintf (asS fs') s'))
(Cond T
_ E T
p E T
e E T
e') @> Β
b = do {p' <- E T
pE T -> Β -> State Int (E T)
@>Β
b; if asB p' then e@>b else e'@>b}
(EApp T
ty (EApp T
_ (EApp T
_ (TB T
_ BTer
Captures) E T
s) E T
i) E T
r) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; i' <- i@>b; r' <- r@>b
    pure $ OptionVal ty (mkStr <$> findCapture (asR r') (asS s') (fromIntegral$asI i'))
(EApp T
ty (EApp T
_ (EApp T
_ (TB T
_ BTer
AllCaptures) E T
s) E T
i) E T
r) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; i' <- i@>b; r' <- r@>b
    pure $ Arr ty (V.fromList (mkStr <$> captures' (asR r') (asS s') (fromIntegral$asI i')))
(EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Ixes) E T
s) E T
i) E T
r) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; i' <- i@>b; r' <- r@>b
    pure (Arr (tyV (TyTup [tyI,tyI])) (V.fromList (rureMatchTup<$>capturesIx (asR r') (asS s') (fromIntegral (asI i')))))
(NB (TyB TB
TyStr) N
MZ) @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E T -> State Int (E T)) -> E T -> State Int (E T)
forall a b. (a -> b) -> a -> b
$ ByteString -> E T
mkStr ByteString
BS.empty
(NB ty :: T
ty@(TyB TB
TyVec:$T
_) N
MZ) @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E T -> State Int (E T)) -> E T -> State Int (E T)
forall a b. (a -> b) -> a -> b
$ T -> Vector (E T) -> E T
forall a. a -> Vector (E a) -> E a
Arr T
ty Vector (E T)
forall a. Vector a
V.empty
(EApp T
_ (UB T
_ BUn
Not) E T
e) @> Β
b = do {e' <- E T
eE T -> Β -> State Int (E T)
@> Β
b; pure$mkB (not (asB e'))}
(EApp T
_ (EApp T
_ (BB T
_ BBin
Split) E T
s) E T
r) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; r' <- r@>b
    pure $ vS (splitBy (asR r') (asS s'))
(EApp T
_ (EApp T
_ (BB T
_ BBin
Splitc) E T
s) E T
c) @> Β
b = do
    s' <- E T
sE T -> Β -> State Int (E T)
@>Β
b; c' <- c@>b
    pure $ vS (V.fromList (BS.split (the$asS c') (asS s')))
(EApp T
_ (UB T
_ BUn
FParse) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (parseAsF (asS x'))}
(EApp T
_ (UB T
_ BUn
IParse) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (parseAsEInt (asS x'))}
(EApp (TyB TB
TyI) (UB T
_ BUn
Parse) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (parseAsEInt (asS x'))}
(EApp (TyB TB
TyFloat) (UB T
_ BUn
Parse) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (parseAsF (asS x'))}
(EApp T
_ (UB T
_ (At Int
i)) E T
v) @> Β
b = do {v' <- E T
vE T -> Β -> State Int (E T)
@>Β
b; pure (asV v' `at` i)}
(EApp T
_ (UB T
_ (Select Int
i)) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (asT x' !! (i-1))}
(EApp T
_ (UB T
_ (SelR Nm ()
n)) E T
x) @> Β
b = do {x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; pure (asRec x' M.! name n)}
(EApp T
_ (UB T
_ BUn
Floor) E T
x) @> Β
b = Integer -> E T
mkI(Integer -> E T) -> (E T -> Integer) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor(Double -> Integer) -> (E T -> Double) -> E T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> Double
asF(E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
xE T -> Β -> State Int (E T)
@>Β
b)
(EApp T
_ (UB T
_ BUn
Ceiling) E T
x) @> Β
b = Integer -> E T
mkI(Integer -> E T) -> (E T -> Integer) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling(Double -> Integer) -> (E T -> Double) -> E T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> Double
asF(E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
xE T -> Β -> State Int (E T)
@>Β
b)
(EApp (TyB TB
TyI) (UB T
_ BUn
Negate) E T
i) @> Β
b = Integer -> E T
mkI(Integer -> E T) -> (E T -> Integer) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Integer -> Integer
forall a. Num a => a -> a
negate(Integer -> Integer) -> (E T -> Integer) -> E T -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> Integer
asI(E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
iE T -> Β -> State Int (E T)
@>Β
b)
(EApp (TyB TB
TyFloat) (UB T
_ BUn
Negate) E T
x) @> Β
b = Double -> E T
mkF(Double -> E T) -> (E T -> Double) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Double -> Double
forall a. Num a => a -> a
negate(Double -> Double) -> (E T -> Double) -> E T -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> Double
asF(E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
xE T -> Β -> State Int (E T)
@>Β
b)
(EApp T
ty (UB T
_ BUn
Some) E T
e) @> Β
b = T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
ty(Maybe (E T) -> E T) -> (E T -> Maybe (E T)) -> E T -> E T
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(E T
eE T -> Β -> State Int (E T)
@>Β
b)
(NB T
ty N
None) @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E T -> State Int (E T)) -> E T -> State Int (E T)
forall a b. (a -> b) -> a -> b
$ T -> Maybe (E T) -> E T
forall a. a -> Maybe (E a) -> E a
OptionVal T
ty Maybe (E T)
forall a. Maybe a
Nothing
(EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Substr) E T
s) E T
i0) E T
i1) @> Β
b = do
    i0' <- E T
i0E T -> Β -> State Int (E T)
@>Β
b; i1' <- i1@>b; s' <- s@>b
    pure $ mkStr (substr (asS s') (fromIntegral$asI i0') (fromIntegral$asI i1'))
(EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Sub1) E T
r) E T
s0) E T
s1) @> Β
b = do
    r' <- E T
rE T -> Β -> State Int (E T)
@>Β
b; s0' <- s0@>b; s1' <- s1@>b
    pure $ mkStr (sub1 (asR r') (asS s1') (asS s0'))
(EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Subs) E T
r) E T
s0) E T
s1) @> Β
b = do
    r' <- E T
rE T -> Β -> State Int (E T)
@>Β
b; s0' <- s0@>b; s1' <- s1@>b
    pure $ mkStr (subs (asR r') (asS s1') (asS s0'))
(EApp T
_ (EApp T
_ (EApp T
_ (TB T
_ BTer
Fold) E T
op) E T
seed) E T
xs) @> Β
b | TyB TB
TyVec:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
xs = do
    seed' <- E T
seedE T -> Β -> State Int (E T)
@>Β
b; xs' <- xs@>b
    V.foldM (a2e b op) seed' (asV xs')
(EApp T
_ (EApp T
_ (BB T
_ BBin
Rein) E T
s) E T
ss) @> Β
b | TyB TB
TyVec:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
ss = do
    s' <- (E T -> ByteString)
-> State Int (E T) -> StateT Int Identity ByteString
forall a b.
(a -> b) -> StateT Int Identity a -> StateT Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E T -> ByteString
asS (E T
sE T -> Β -> State Int (E T)
@>Β
b); ss' <- ss@>b
    pure $ mkStr (V.foldl' (\ByteString
x ByteString
y -> ByteString
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
y) mempty (asS<$>asV ss'))
(EApp yT :: T
yT@(TyB TB
TyVec:$T
_) (EApp T
_ (EApp T
_ (TB T
_ BTer
ScanList) E T
op) E T
seed) E T
xs) @> Β
b | TyB TB
TyVec:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
xs = do
    xs' <- E T
xsE T -> Β -> State Int (E T)
@>Β
b; seed' <- seed@>b
    Arr yT <$> scanlM' (a2e b op) seed' (asV xs')
(EApp T
_ (EApp T
_ (BB T
_ BBin
Fold1) E T
op) E T
xs) @> Β
b | TyB TB
TyVec:$T
_ <- E T -> T
forall a. E a -> a
eLoc E T
xs = do
    xs' <- E T
xsE T -> Β -> State Int (E T)
@>Β
b
    let xsV=E T -> Vector (E T)
asV E T
xs'
        (seed, xs'') = case V.uncons xsV of
            Just (E T, Vector (E T))
v  -> (E T, Vector (E T))
v
            Maybe (E T, Vector (E T))
Nothing -> EvalErr -> (E T, Vector (E T))
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw EvalErr
EmptyFold
    V.foldM (a2e b op) seed xs''
(EApp yT :: T
yT@(TyB TB
TyVec:$T
_) (EApp T
_ (BB T
_ BBin
Filter) E T
p) E T
xs) @> Β
b = do
    xs' <- E T
xsE T -> Β -> State Int (E T)
@>Β
b
    Arr yT <$> V.filterM (fmap asB.a1e b p) (asV xs')
(EApp yT :: T
yT@(TyB TB
TyVec:$T
_) (EApp T
_ (BB T
_ BBin
Map) E T
f) E T
xs) @> Β
b = do
    xs' <- E T
xsE T -> Β -> State Int (E T)
@>Β
b
    Arr yT <$> traverse (a1e b f) (asV xs')
(EApp yT :: T
yT@(TyB TB
TyOption:$T
_) (EApp T
_ (BB T
_ BBin
Map) E T
f) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    OptionVal yT <$> traverse (a1e b f) (asM x')
(EApp yT :: T
yT@(TyB TB
TyVec:$T
_) (EApp T
_ (BB T
_ BBin
MapMaybe) E T
g) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    Arr yT <$> V.mapMaybeM (fmap asM.a1e b g) (asV x')
(EApp yT :: T
yT@(TyB TB
TyVec:$T
_) (UB T
_ BUn
CatMaybes) E T
x) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b
    pure $ Arr yT (V.catMaybes (asM<$>asV x'))
(EApp T
t (EApp T
_ (EApp T
_ (TB T
_ BTer
Option) E T
x) E T
g) E T
y) @> Β
b = do
    x' <- E T
xE T -> Β -> State Int (E T)
@>Β
b; y' <- y@>b
    case asM y' of
        Maybe (E T)
Nothing -> E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
x'
        Just E T
yϵ -> (E T -> Β -> State Int (E T)
@>Β
b) (E T -> State Int (E T)) -> State Int (E T) -> State Int (E T)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< E T -> State Int (E T)
forall a. E a -> UM (E a)
lβ (T -> E T -> E T -> E T
forall a. a -> E a -> E a -> E a
EApp T
t E T
g E T
yϵ)
(Arr T
t Vector (E T)
es) @> Β
b = T -> Vector (E T) -> E T
forall a. a -> Vector (E a) -> E a
Arr T
t (Vector (E T) -> E T)
-> StateT Int Identity (Vector (E T)) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T -> State Int (E T))
-> Vector (E T) -> StateT Int Identity (Vector (E T))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse (E T -> Β -> State Int (E T)
@>Β
b) Vector (E T)
es
e :: E T
e@BB{} @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
e
e :: E T
e@TB{} @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
e
e :: E T
e@UB{} @> Β
_ = E T -> State Int (E T)
forall a. a -> StateT Int Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure E T
e
(Lam T
t Nm T
n E T
e) @> Β
b = T -> Nm T -> E T -> E T
forall a. a -> Nm a -> E a -> E a
Lam T
t Nm T
n (E T -> E T) -> State Int (E T) -> State Int (E T)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E T
eE T -> Β -> State Int (E T)
@>Β
b)
-- basically an option can evaluate to a function... so ((option ...) x)
-- needs to be reduced! but nothing will detect that...
-- (when can a builtin etc. return a FUNCTION? if...then...else could!)
--
-- Question: would (f x) ever need for x to be inspected in order for things
-- to proceed?? I think no...
--
-- thabove returns g'=(and another +) e=line (should be further reduced!)
-- but g'=(+) and e=... will trip up

me :: [(Nm T, E T)] -> Β
me :: [(Nm T, E T)] -> Β
me [(Nm T, E T)]
xs = [(Int, E T)] -> Β
forall a. [(Int, a)] -> IntMap a
IM.fromList [(U -> Int
unU(U -> Int) -> U -> Int
forall a b. (a -> b) -> a -> b
$Nm T -> U
forall a. Nm a -> U
unique Nm T
nm, E T
e) | (Nm T
nm, E T
e) <- [(Nm T, E T)]
xs]

ms :: Nm T -> E T -> Β
ms :: Nm T -> E T -> Β
ms (Nm Text
_ (U Int
i) T
_) = Int -> E T -> Β
forall a. Int -> a -> IntMap a
IM.singleton Int
i

wCM :: Tmp -> Tmp -> Σ -> Σ
wCM :: Int -> Int -> Σ -> Σ
wCM Int
src Int
tgt (Σ Int
u IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let xϵ :: Maybe (E T)
xϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u (case Maybe (E T)
xϵ of
        Just E T
y  -> case E T -> Maybe (E T)
asM E T
y of {Maybe (E T)
Nothing -> Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env; Just E T
yϵ -> Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
yϵ) IntMap (Maybe (E T))
env}
        Maybe (E T)
Nothing -> Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b

{-# SCC wMM #-}
wMM :: E T -> Tmp -> Tmp -> Σ -> Σ
wMM :: E T -> Int -> Int -> Σ -> Σ
wMM (Lam T
_ Nm T
n E T
e) Int
src Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let xϵ :: Maybe (E T)
xϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
xϵ of
        Just E T
x ->
            let be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
x; (E T
y,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (case E T -> Maybe (E T)
asM E T
y of
                Just E T
yϵ -> Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
yϵ) IntMap (Maybe (E T))
env
                Maybe (E T)
Nothing -> Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wMM E T
e Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw(EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$Int -> E T -> EvalErr
InternalArityOrEta Int
1 E T
e

wZ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ
wZ :: E T -> Int -> Int -> Int -> Σ -> Σ
wZ (Lam T
_ Nm T
n0 (Lam T
_ Nm T
n1 E T
e)) Int
src0 Int
src1 Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x0ϵ :: Maybe (E T)
x0ϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src0; x1ϵ :: Maybe (E T)
x1ϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src1
    in (case (Maybe (E T)
x0ϵ, Maybe (E T)
x1ϵ) of
        (Just E T
x, Just E T
y) ->
            let be :: Β
be=[(Nm T, E T)] -> Β
me [(Nm T
n0, E T
x), (Nm T
n1, E T
y)]; (E T
z,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
z) IntMap (Maybe (E T))
env)
        (Maybe (E T)
Nothing, Maybe (E T)
Nothing) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env)) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wZ E T
e Int
_ Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw(EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$Int -> E T -> EvalErr
InternalArityOrEta Int
2 E T
e

wM :: E T -> Tmp -> Tmp -> Σ -> Σ
wM :: E T -> Int -> Int -> Σ -> Σ
wM (Lam T
_ Nm T
n E T
e) Int
src Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let xϵ :: Maybe (E T)
xϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
xϵ of
        Just E T
x ->
            let be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
x; (E T
y,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wM E T
e Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw(EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$Int -> E T -> EvalErr
InternalArityOrEta Int
1 E T
e

wI :: E T -> Tmp -> LineCtx -> Σ -> Σ
wI :: E T -> Int -> LineCtx -> Σ -> Σ
wI E T
e Int
tgt LineCtx
line (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let e' :: E T
e'=E T
e E T -> LineCtx -> E T
`κ` LineCtx
line; (E T
e'',Int
k)=E T
e'E T -> Int -> (E T, Int)
$@Int
j in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e'') IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b

wG :: (E T, E T) -> Tmp -> LineCtx -> Σ -> Σ
wG :: (E T, E T) -> Int -> LineCtx -> Σ -> Σ
wG (E T
p, E T
e) Int
tgt LineCtx
line (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let p' :: E T
p'=E T
p E T -> LineCtx -> E T
`κ` LineCtx
line; (E T
p'',Int
k)=E T
p'E T -> Int -> (E T, Int)
$@Int
j
    in (if E T -> Bool
asB E T
p''
        then let e' :: E T
e'=E T
e E T -> LineCtx -> E T
`κ` LineCtx
line; (E T
e'',Int
u) =E T
e'E T -> Int -> (E T, Int)
$@Int
k in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e'') IntMap (Maybe (E T))
env)
        else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env)) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b

wDOp :: E T -> Int -> Tmp -> Tmp -> Σ -> Σ
wDOp :: E T -> Int -> Int -> Int -> Σ -> Σ
wDOp (Lam (TyArr T
_ (TyB TB
TyStr)) Nm T
n E T
e) Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
xϵ ->
            case Int -> IntMap (Set ByteString) -> Maybe (Set ByteString)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap (Set ByteString)
d of
                Maybe (Set ByteString)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) (Int
-> Set ByteString
-> IntMap (Set ByteString)
-> IntMap (Set ByteString)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (ByteString -> Set ByteString
forall a. a -> Set a
S.singleton ByteString
e') IntMap (Set ByteString)
d) IntMap IntSet
di IntMap (Set Double)
df IntSet
b
                Just Set ByteString
ss -> (if ByteString
e' ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set ByteString
ss then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) ((Maybe (Set ByteString) -> Maybe (Set ByteString))
-> Int -> IntMap (Set ByteString) -> IntMap (Set ByteString)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Set ByteString) -> Maybe (Set ByteString)
go Int
key IntMap (Set ByteString)
d)) IntMap IntSet
di IntMap (Set Double)
df IntSet
b
              where
                (E T
y,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
i,Β
be); be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
xϵ
                e' :: ByteString
e'=E T -> ByteString
asS E T
y

                go :: Maybe (Set ByteString) -> Maybe (Set ByteString)
go Maybe (Set ByteString)
Nothing  = Set ByteString -> Maybe (Set ByteString)
forall a. a -> Maybe a
Just(Set ByteString -> Maybe (Set ByteString))
-> Set ByteString -> Maybe (Set ByteString)
forall a b. (a -> b) -> a -> b
$!ByteString -> Set ByteString
forall a. a -> Set a
S.singleton ByteString
e'
                go (Just Set ByteString
s) = Set ByteString -> Maybe (Set ByteString)
forall a. a -> Maybe a
Just(Set ByteString -> Maybe (Set ByteString))
-> Set ByteString -> Maybe (Set ByteString)
forall a b. (a -> b) -> a -> b
$!ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => a -> Set a -> Set a
S.insert ByteString
e' Set ByteString
s
wDOp (Lam (TyArr T
_ (TyB TB
TyI)) Nm T
n E T
e) Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
xϵ ->
            case Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap IntSet
di of
                Maybe IntSet
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d (Int -> IntSet -> IntMap IntSet -> IntMap IntSet
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (Int -> IntSet
IS.singleton Int
e') IntMap IntSet
di) IntMap (Set Double)
df IntSet
b
                Just IntSet
ds -> (if Int
e' Int -> IntSet -> Bool
`IS.member` IntSet
ds then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d ((Maybe IntSet -> Maybe IntSet)
-> Int -> IntMap IntSet -> IntMap IntSet
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe IntSet -> Maybe IntSet
go Int
key IntMap IntSet
di)) IntMap (Set Double)
df IntSet
b

              where
                (E T
y,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
i,Β
be); be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
xϵ
                e' :: Int
e'=Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$E T -> Integer
asI E T
y

                go :: Maybe IntSet -> Maybe IntSet
go Maybe IntSet
Nothing  = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just(IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$!Int -> IntSet
IS.singleton Int
e'
                go (Just IntSet
s) = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just(IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$!Int -> IntSet -> IntSet
IS.insert Int
e' IntSet
s
wDOp (Lam (TyArr T
_ (TyB TB
TyFloat)) Nm T
n E T
e) Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
xϵ ->
            case Int -> IntMap (Set Double) -> Maybe (Set Double)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap (Set Double)
df of
                Maybe (Set Double)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di (Int -> Set Double -> IntMap (Set Double) -> IntMap (Set Double)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (Double -> Set Double
forall a. a -> Set a
S.singleton Double
e') IntMap (Set Double)
df) IntSet
b
                Just Set Double
ds -> if Double
e' Double -> Set Double -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Double
ds then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
y) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di ((Maybe (Set Double) -> Maybe (Set Double))
-> Int -> IntMap (Set Double) -> IntMap (Set Double)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Set Double) -> Maybe (Set Double)
go Int
key IntMap (Set Double)
df) IntSet
b
              where
                (E T
y,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
i,Β
be); be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
xϵ
                e' :: Double
e'=E T -> Double
asF E T
y

                go :: Maybe (Set Double) -> Maybe (Set Double)
go Maybe (Set Double)
Nothing  = Set Double -> Maybe (Set Double)
forall a. a -> Maybe a
Just(Set Double -> Maybe (Set Double))
-> Set Double -> Maybe (Set Double)
forall a b. (a -> b) -> a -> b
$!Double -> Set Double
forall a. a -> Set a
S.singleton Double
e'
                go (Just Set Double
s) = Set Double -> Maybe (Set Double)
forall a. a -> Maybe a
Just(Set Double -> Maybe (Set Double))
-> Set Double -> Maybe (Set Double)
forall a b. (a -> b) -> a -> b
$!Double -> Set Double -> Set Double
forall a. Ord a => a -> Set a -> Set a
S.insert Double
e' Set Double
s
wDOp E T
e Int
_ Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$ Int -> E T -> EvalErr
InternalArityOrEta Int
1 E T
e

wB :: (E T, E T) -> Int -> Tmp -> Tmp -> Σ -> Σ
wB :: (E T, E T) -> Int -> Int -> Int -> Σ -> Σ
wB (E T
e0, E T
e1) Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
xϵ -> let xS :: ByteString
xS=E T -> ByteString
asS E T
xϵ in if Int
key Int -> IntSet -> Bool
`IS.member` IntSet
b
            then if RurePtr -> ByteString -> Bool
isMatch' RurePtr
r1 ByteString
xS then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
xϵ) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df (Int -> IntSet -> IntSet
IS.delete Int
key IntSet
b) else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
xϵ) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
            else if RurePtr -> ByteString -> Bool
isMatch' RurePtr
r0 ByteString
xS then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
xϵ) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df (Int -> IntSet -> IntSet
IS.insert Int
key IntSet
b) else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
  where
    r0 :: RurePtr
r0=E T -> RurePtr
asR E T
e0; r1 :: RurePtr
r1=E T -> RurePtr
asR E T
e1

{-# SCC wD #-}
wD :: TB -> Int -> Tmp -> Tmp -> Σ -> Σ
wD :: TB -> Int -> Int -> Int -> Σ -> Σ
wD TB
TyStr Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
e ->
            case Int -> IntMap (Set ByteString) -> Maybe (Set ByteString)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap (Set ByteString)
d of
                Maybe (Set ByteString)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) (Int
-> Set ByteString
-> IntMap (Set ByteString)
-> IntMap (Set ByteString)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (ByteString -> Set ByteString
forall a. a -> Set a
S.singleton ByteString
e') IntMap (Set ByteString)
d) IntMap IntSet
di IntMap (Set Double)
df IntSet
b
                Just Set ByteString
ds -> (if ByteString
e' ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set ByteString
ds then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) ((Maybe (Set ByteString) -> Maybe (Set ByteString))
-> Int -> IntMap (Set ByteString) -> IntMap (Set ByteString)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Set ByteString) -> Maybe (Set ByteString)
go Int
key IntMap (Set ByteString)
d)) IntMap IntSet
di IntMap (Set Double)
df IntSet
b
              where
                go :: Maybe (Set ByteString) -> Maybe (Set ByteString)
go Maybe (Set ByteString)
Nothing  = Set ByteString -> Maybe (Set ByteString)
forall a. a -> Maybe a
Just(Set ByteString -> Maybe (Set ByteString))
-> Set ByteString -> Maybe (Set ByteString)
forall a b. (a -> b) -> a -> b
$!ByteString -> Set ByteString
forall a. a -> Set a
S.singleton ByteString
e'
                go (Just Set ByteString
s) = Set ByteString -> Maybe (Set ByteString)
forall a. a -> Maybe a
Just(Set ByteString -> Maybe (Set ByteString))
-> Set ByteString -> Maybe (Set ByteString)
forall a b. (a -> b) -> a -> b
$!ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => a -> Set a -> Set a
S.insert ByteString
e' Set ByteString
s

                e' :: ByteString
e'=E T -> ByteString
asS E T
e
wD TB
TyI Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
e ->
            case Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap IntSet
di of
                Maybe IntSet
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d (Int -> IntSet -> IntMap IntSet -> IntMap IntSet
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (Int -> IntSet
IS.singleton Int
e') IntMap IntSet
di) IntMap (Set Double)
df IntSet
b
                Just IntSet
ds -> (if Int
e' Int -> IntSet -> Bool
`IS.member` IntSet
ds then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d ((Maybe IntSet -> Maybe IntSet)
-> Int -> IntMap IntSet -> IntMap IntSet
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe IntSet -> Maybe IntSet
go Int
key IntMap IntSet
di)) IntMap (Set Double)
df IntSet
b
              where
                e' :: Int
e'=Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$E T -> Integer
asI E T
e

                go :: Maybe IntSet -> Maybe IntSet
go Maybe IntSet
Nothing  = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just(IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$!Int -> IntSet
IS.singleton Int
e'
                go (Just IntSet
s) = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just(IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$!Int -> IntSet -> IntSet
IS.insert Int
e' IntSet
s
wD TB
TyFloat Int
key Int
src Int
tgt (Σ Int
i IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let x :: Maybe (E T)
x=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
x of
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Just E T
e ->
            case Int -> IntMap (Set Double) -> Maybe (Set Double)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
key IntMap (Set Double)
df of
                Maybe (Set Double)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di (Int -> Set Double -> IntMap (Set Double) -> IntMap (Set Double)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
key (Double -> Set Double
forall a. a -> Set a
S.singleton Double
e') IntMap (Set Double)
df) IntSet
b
                Just Set Double
ds -> (if Double
e' Double -> Set Double -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Double
ds then Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df else Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
i (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
e) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di ((Maybe (Set Double) -> Maybe (Set Double))
-> Int -> IntMap (Set Double) -> IntMap (Set Double)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Set Double) -> Maybe (Set Double)
go Int
key IntMap (Set Double)
df)) IntSet
b
              where
                e' :: Double
e'=E T -> Double
asF E T
e

                go :: Maybe (Set Double) -> Maybe (Set Double)
go Maybe (Set Double)
Nothing  = Set Double -> Maybe (Set Double)
forall a. a -> Maybe a
Just(Set Double -> Maybe (Set Double))
-> Set Double -> Maybe (Set Double)
forall a b. (a -> b) -> a -> b
$!Double -> Set Double
forall a. a -> Set a
S.singleton Double
e'
                go (Just Set Double
s) = Set Double -> Maybe (Set Double)
forall a. a -> Maybe a
Just(Set Double -> Maybe (Set Double))
-> Set Double -> Maybe (Set Double)
forall a b. (a -> b) -> a -> b
$!Double -> Set Double -> Set Double
forall a. Ord a => a -> Set a -> Set a
S.insert Double
e' Set Double
s


wP :: E T -> Tmp -> Tmp -> Σ -> Σ
wP :: E T -> Int -> Int -> Σ -> Σ
wP (Lam T
_ Nm T
n E T
e) Int
src Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let xϵ :: Maybe (E T)
xϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in case Maybe (E T)
xϵ of
        Just E T
x ->
            let be :: Β
be=Nm T -> E T -> Β
ms Nm T
n E T
x; (E T
p,Int
k)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
k (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (if E T -> Bool
asB E T
p then E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
x else Maybe (E T)
forall a. Maybe a
Nothing) IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
        Maybe (E T)
Nothing -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wP E T
e Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$ Int -> E T -> EvalErr
InternalArityOrEta Int
1 E T
e

wΠ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ
wΠ :: E T -> Int -> Int -> Int -> Σ -> Σ
wΠ (Lam T
_ Nm T
nn (Lam T
_ Nm T
nprev E T
e)) Int
pt Int
src Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let prevϵ :: Maybe (E T)
prevϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
pt; xϵ :: Maybe (E T)
xϵ=IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in (case (Maybe (E T)
prevϵ, Maybe (E T)
xϵ) of
        (Just E T
prev, Just E T
x) ->
            let be :: Β
be=[(Nm T, E T)] -> Β
me [(Nm T
nprev, E T
prev), (Nm T
nn, E T
x)]
                (E T
res,Int
u)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j,Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
pt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
x) (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
res) IntMap (Maybe (E T))
env))
        (Maybe (E T)
Nothing, Maybe (E T)
Nothing) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env)
        (Maybe (E T)
Nothing, Just E T
x) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
pt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
x) (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env))
        (Just{}, Maybe (E T)
Nothing) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env)) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wΠ E T
e Int
_ Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$ Int -> E T -> EvalErr
InternalArityOrEta Int
2 E T
e

{-# SCC wF #-}
wF :: E T -> Tmp -> Tmp -> Σ -> Σ
wF :: E T -> Int -> Int -> Σ -> Σ
wF (Lam T
_ Nm T
nacc (Lam T
_ Nm T
nn E T
e)) Int
src Int
tgt (Σ Int
j IntMap (Maybe (E T))
env IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b) =
    let accϵ :: Maybe (E T)
accϵ = IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
tgt; xϵ :: Maybe (E T)
xϵ = IntMap (Maybe (E T))
envIntMap (Maybe (E T)) -> Int -> Maybe (E T)
!Int
src
    in (case (Maybe (E T)
accϵ, Maybe (E T)
xϵ) of
        (Just E T
acc, Just E T
x) ->
            let be :: Β
be=[(Nm T, E T)] -> Β
me [(Nm T
nacc, E T
acc), (Nm T
nn, E T
x)]
                (E T
res, Int
u)=E T
eE T -> (Int, Β) -> (E T, Int)
@!(Int
j, Β
be)
            in Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
u (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
res) IntMap (Maybe (E T))
env)
        (Just E T
acc, Maybe (E T)
Nothing) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
acc) IntMap (Maybe (E T))
env)
        (Maybe (E T)
Nothing, Maybe (E T)
Nothing) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt Maybe (E T)
forall a. Maybe a
Nothing IntMap (Maybe (E T))
env)
        (Maybe (E T)
Nothing, Just E T
x) -> Int
-> IntMap (Maybe (E T))
-> IntMap (Set ByteString)
-> IntMap IntSet
-> IntMap (Set Double)
-> IntSet
-> Σ
Σ Int
j (Int -> Maybe (E T) -> IntMap (Maybe (E T)) -> IntMap (Maybe (E T))
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
tgt (E T -> Maybe (E T)
forall a. a -> Maybe a
Just(E T -> Maybe (E T)) -> E T -> Maybe (E T)
forall a b. (a -> b) -> a -> b
$!E T
x) IntMap (Maybe (E T))
env)) IntMap (Set ByteString)
d IntMap IntSet
di IntMap (Set Double)
df IntSet
b
wF E T
e Int
_ Int
_ Σ
_ = EvalErr -> Σ
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (EvalErr -> Σ) -> EvalErr -> Σ
forall a b. (a -> b) -> a -> b
$ Int -> E T -> EvalErr
InternalArityOrEta Int
2 E T
e

badctx :: a -> a
badctx a
e = [Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
"Internal error: κ called on" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
e)
desugar :: a
desugar = [Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Internal error. Should have been desugared by now."

<$!> :: (a -> b) -> f a -> f b
(<$!>) a -> b
f f a
x = (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$!) f a
x