{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.Runtime.ANF
  ( minimizeCyclesOrCrash,
    pattern TVar,
    pattern TLit,
    pattern TBLit,
    pattern TApp,
    pattern TApv,
    pattern TCom,
    pattern TCon,
    pattern UFalse,
    pattern UTrue,
    pattern TKon,
    pattern TReq,
    pattern TPrm,
    pattern TFOp,
    pattern THnd,
    pattern TLet,
    pattern TLetD,
    pattern TFrc,
    pattern TLets,
    pattern TName,
    pattern TBind,
    pattern TBinds,
    pattern TShift,
    pattern TMatch,
    pattern TDiscard,
    pattern TLocal,
    pattern TUpdate,
    FloatName (..),
    prettyFloatName,
    Mem (..),
    Lit (..),
    Cacheability (..),
    Direction (..),
    SuperNormal (..),
    arity,
    SuperGroup (..),
    arities,
    POp (..),
    close,
    saturate,
    float,
    floatGroup,
    lamLift,
    lamLiftGroup,
    litRef,
    inlineAlias,
    addDefaultCases,
    ANormalF (.., AApv, ACom, ACon, AKon, AReq, APrm, AFOp),
    ANormal,
    RTag,
    CTag,
    PackedTag (..),
    Tag (..),
    GroupRef (..),
    Code (..),
    ValList,
    Value (..),
    Cont (..),
    BLit (..),
    packTags,
    unpackTags,
    maskTags,
    ANFM,
    Branched (.., MatchDataCover),
    Func (..),
    SGEqv (..),
    equivocate,
    superNormalize,
    anfTerm,
    codeGroup,
    valueTermLinks,
    valueLinks,
    groupTermLinks,
    replaceConstructors,
    replaceFunctions,
    foldGroup,
    foldGroupLinks,
    overGroup,
    overGroupLinks,
    traverseGroup,
    traverseGroupLinks,
    normalLinks,
    prettyGroup,
    prettySuperNormal,
    prettyANF,
  )
where

import Control.Lens (snoc, unsnoc)
import Control.Monad.Reader (ReaderT (..), ask, local)
import Control.Monad.State (MonadState (..), State, gets, modify, runState)
import Data.Bifoldable (Bifoldable (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Functor.Compose (Compose (..))
import Data.List hiding (and, or)
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Set qualified as Set
import Data.Text qualified as Data.Text
import Unison.ABT qualified as ABT
import Unison.ABT.Normalized qualified as ABTN
import Unison.Blank (nameb)
import Unison.Builtin.Decls qualified as Ty
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes)
import Unison.Pattern (SeqOp (..))
import Unison.Pattern qualified as P
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv, termName)
import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId), toShortHash)
import Unison.ReferentPrime qualified as Rfn
import Unison.Runtime.Array qualified as PA
import Unison.Runtime.Foreign.Function.Type (ForeignFunc (..))
import Unison.Runtime.InternalError (internalBug)
import Unison.Runtime.Referenced (Referential (..))
import Unison.Runtime.TypeTags (CTag (..), PackedTag (..), RTag (..), Tag (..), maskTags, packTags, unpackTags)
import Unison.ShortHash (shortenTo)
import Unison.Symbol (Symbol)
import Unison.Syntax.NamePrinter (prettyHashQualified, prettyShortHash)
import Unison.Term hiding (Char, Float, List, Ref, Text, arity, float, fresh, resolve)
import Unison.Type qualified as Ty
import Unison.Typechecker.Components (minimize')
import Unison.Util.Bytes (Bytes)
import Unison.Util.EnumContainers as EC
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Var, typed)
import Unison.Var qualified as Var
import Prelude hiding (abs, and, or, seq)

closure :: (Var v) => Map v (Set v, Set v) -> Map v (Set v)
closure :: forall v. Var v => Map v (Set v, Set v) -> Map v (Set v)
closure Map v (Set v, Set v)
m0 = Map v (Set v) -> Map v (Set v)
trace ((Set v, Set v) -> Set v
forall a b. (a, b) -> b
snd ((Set v, Set v) -> Set v) -> Map v (Set v, Set v) -> Map v (Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Set v, Set v)
m0)
  where
    refs :: Map v (Set v)
refs = (Set v, Set v) -> Set v
forall a b. (a, b) -> a
fst ((Set v, Set v) -> Set v) -> Map v (Set v, Set v) -> Map v (Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Set v, Set v)
m0

    expand :: Map k a -> a -> t k -> a
expand Map k a
acc a
fvs t k
rvs =
      a
fvs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (k -> a) -> t k -> a
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\k
r -> a -> k -> Map k a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
forall a. Monoid a => a
mempty k
r Map k a
acc) t k
rvs

    trace :: Map v (Set v) -> Map v (Set v)
trace Map v (Set v)
acc
      | Map v (Set v)
acc Map v (Set v) -> Map v (Set v) -> Bool
forall a. Eq a => a -> a -> Bool
== Map v (Set v)
acc' = Map v (Set v)
acc
      | Bool
otherwise = Map v (Set v) -> Map v (Set v)
trace Map v (Set v)
acc'
      where
        acc' :: Map v (Set v)
acc' = (Set v -> Set v -> Set v)
-> Map v (Set v) -> Map v (Set v) -> Map v (Set v)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (Map v (Set v) -> Set v -> Set v -> Set v
forall {a} {t :: * -> *} {k}.
(Foldable t, Monoid a, Ord k) =>
Map k a -> a -> t k -> a
expand Map v (Set v)
acc) Map v (Set v)
acc Map v (Set v)
refs

expandRec ::
  (Var v, Monoid a) =>
  Set v ->
  [(v, Term v a)] ->
  [(v, Term v a)]
expandRec :: forall v a.
(Var v, Monoid a) =>
Set v -> [(v, Term v a)] -> [(v, Term v a)]
expandRec Set v
keep [(v, Term v a)]
vbs = (v, [v]) -> (v, Term v a)
forall {v} {a} {vt} {at} {ap}.
(Ord v, Monoid a) =>
(v, [v]) -> (v, Term2 vt at ap v a)
mkSub ((v, [v]) -> (v, Term v a)) -> [(v, [v])] -> [(v, Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, [v])]
fvl
  where
    mkSub :: (v, [v]) -> (v, Term2 vt at ap v a)
mkSub (v
v, [v]
fvs) = (v
v, Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty v
v) (a -> v -> Term2 vt at ap v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty (v -> Term2 vt at ap v a) -> [v] -> [Term2 vt at ap v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
fvs))

    fvl :: [(v, [v])]
fvl =
      Map v [v] -> [(v, [v])]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map v [v] -> [(v, [v])])
-> (Map v (Set v, Set v) -> Map v [v])
-> Map v (Set v, Set v)
-> [(v, [v])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set v -> [v]) -> Map v (Set v) -> Map v [v]
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set v -> [v]
forall a. Set a -> [a]
Set.toList)
        (Map v (Set v) -> Map v [v])
-> (Map v (Set v, Set v) -> Map v (Set v))
-> Map v (Set v, Set v)
-> Map v [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v (Set v, Set v) -> Map v (Set v)
forall v. Var v => Map v (Set v, Set v) -> Map v (Set v)
closure
        (Map v (Set v, Set v) -> [(v, [v])])
-> Map v (Set v, Set v) -> [(v, [v])]
forall a b. (a -> b) -> a -> b
$ (v -> Bool) -> Set v -> (Set v, Set v)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set v
keep)
          (Set v -> (Set v, Set v))
-> (Term v a -> Set v) -> Term v a -> (Set v, Set v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars
          (Term v a -> (Set v, Set v))
-> Map v (Term v a) -> Map v (Set v, Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Term v a)] -> Map v (Term v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Term v a)]
vbs

expandSimple ::
  (Var v, Monoid a) =>
  Set v ->
  (v, Term v a) ->
  (v, Term v a)
expandSimple :: forall v a.
(Var v, Monoid a) =>
Set v -> (v, Term v a) -> (v, Term v a)
expandSimple Set v
keep (v
v, Term v a
bnd) = (v
v, Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v) [Term v a]
evs)
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
bnd
    fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
bnd
    evs :: [Term v a]
evs = (v -> Term v a) -> [v] -> [Term v a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a) ([v] -> [Term v a]) -> (Set v -> [v]) -> Set v -> [Term v a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [Term v a]) -> Set v -> [Term v a]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep

abstract :: (Var v) => Set v -> Term v a -> Term v a
abstract :: forall v a. Var v => Set v -> Term v a -> Term v a
abstract Set v
keep Term v a
bnd = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs Term v a
bnd
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
bnd
    fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
bnd
    evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep

enclose ::
  (Var v, Monoid a) =>
  Set v ->
  (Set v -> Term v a -> Term v a) ->
  Term v a ->
  Maybe (Term v a)
enclose :: forall v a.
(Var v, Monoid a) =>
Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
enclose Set v
keep Set v -> Term v a -> Term v a
rec (LetRecNamedTop' Bool
top [(v, Term v a)]
vbs Term v a
bd) =
  Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
top [(v, a, Term v a)]
lvbs Term v a
lbd
  where
    xpnd :: [(v, Term v a)]
xpnd = Set v -> [(v, Term v a)] -> [(v, Term v a)]
forall v a.
(Var v, Monoid a) =>
Set v -> [(v, Term v a)] -> [(v, Term v a)]
expandRec Set v
keep' [(v, Term v a)]
vbs
    keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set v
keep (Set v -> Set v)
-> ([(v, Term v a)] -> Set v) -> [(v, Term v a)] -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v)
-> ([(v, Term v a)] -> [v]) -> [(v, Term v a)] -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> v
forall a b. (a, b) -> a
fst ([(v, Term v a)] -> Set v) -> [(v, Term v a)] -> Set v
forall a b. (a -> b) -> a -> b
$ [(v, Term v a)]
vbs
    lvbs :: [(v, a, Term v a)]
lvbs =
      [(v, Term v a)]
vbs
        [(v, Term v a)]
-> ((v, Term v a) -> (v, a, Term v a)) -> [(v, a, Term v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, Term v a
trm) ->
          (v
v, Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
trm, (Set v -> Term v a -> Term v a
rec Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
forall v a. Var v => Set v -> Term v a -> Term v a
abstract Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
xpnd) Term v a
trm)
    lbd :: Term v a
lbd = Set v -> Term v a -> Term v a
rec Set v
keep' (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
xpnd (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
bd
-- will be lifted, so keep this variable
enclose Set v
keep Set v -> Term v a -> Term v a
rec (Let1NamedTop' Bool
top v
v b :: Term v a
b@(Term v a -> Term v a
forall v a. Term v a -> Term v a
unAnn -> LamsNamed' [v]
vs Term v a
bd) Term v a
e) =
  Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a))
-> (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [(v, Term v a)] -> Term v a -> Term v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
top [(v
v, Term v a
lamb)] (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
rec (v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v Set v
keep) (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$
    v -> Term v a -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
v -> Term f v a -> Term f v a -> Term f v a
ABT.subst v
v Term v a
av Term v a
e
  where
    (v
_, Term v a
av) = Set v -> (v, Term v a) -> (v, Term v a)
forall v a.
(Var v, Monoid a) =>
Set v -> (v, Term v a) -> (v, Term v a)
expandSimple Set v
keep (v
v, Term v a
b)
    keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
keep (Set v -> Set v) -> Set v -> Set v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs
    fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
b
    evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
    lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep' Term v a
bd
    annotate :: Term v a -> Term v a
annotate Term v a
tm
      | Ann' Term v a
_ Type v a
ty <- Term v a
b = a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a Term v a
tm Type v a
ty
      | Bool
otherwise = Term v a
tm
    lamb :: Term v a
lamb = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs (Term v a -> Term v a
annotate (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term v a
lbody)
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(LamsAnnot [v]
vs0 Maybe (Type v a)
mty [v]
vs1 Term v a
body) =
  Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ if [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs then Term v a
lamb else Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term v a
lamb ([Term v a] -> Term v a) -> [Term v a] -> Term v a
forall a b. (a -> b) -> a -> b
$ (v -> Term v a) -> [v] -> [Term v a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a) [v]
evs
  where
    -- remove shadowed variables
    keep' :: Set v
keep' = Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
keep (Set v -> Set v) -> Set v -> Set v
forall a b. (a -> b) -> a -> b
$ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v]
vs0 [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs1)
    fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
t
    evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t
    lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep' Term v a
body
    lamb :: Term v a
lamb = a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
forall v a.
Var v =>
a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
lamsAnnot a
a ([v]
evs [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs0) Maybe (Type v a)
mty [v]
vs1 Term v a
lbody
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(Handle' Term v a
h Term v a
body)
  | Term v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term v a
body =
      Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a))
-> (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Term v a -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
handle (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t) (Set v -> Term v a -> Term v a
rec Set v
keep Term v a
h) (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term v a
lamb [Term v a]
args
  where
    fvs :: Set v
fvs = Term v a -> Set v
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Term v a
body
    evs :: [v]
evs = Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set v
fvs Set v
keep
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
body
    lbody :: Term v a
lbody = Set v -> Term v a -> Term v a
rec Set v
keep Term v a
body
    fv :: v
fv = Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
fvs (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Eta
    args :: [Term v a]
args
      | [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs = [a -> ConstructorReference -> Term v a
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor a
a (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
Ty.unitRef ConstructorId
0)]
      | Bool
otherwise = a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a (v -> Term v a) -> [v] -> [Term v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
evs
    lamb :: Term v a
lamb
      | [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
evs = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v
fv] Term v a
lbody
      | Bool
otherwise = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
evs Term v a
lbody
enclose Set v
keep Set v -> Term v a -> Term v a
rec t :: Term v a
t@(Match' Term v a
s0 [MatchCase a (Term v a)]
cs0) = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> [MatchCase a (Term v a)] -> Term v a
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
match a
a Term v a
s [MatchCase a (Term v a)]
cs
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
t
    s :: Term v a
s = Set v -> Term v a -> Term v a
rec Set v
keep Term v a
s0
    cs :: [MatchCase a (Term v a)]
cs = a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
forall v a.
(Var v, Monoid a) =>
a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
encloseCase a
a Set v
keep Set v -> Term v a -> Term v a
rec (MatchCase a (Term v a) -> MatchCase a (Term v a))
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a (Term v a)]
cs0
enclose Set v
_ Set v -> Term v a -> Term v a
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing

encloseCase ::
  (Var v, Monoid a) =>
  a ->
  Set v ->
  (Set v -> Term v a -> Term v a) ->
  MatchCase a (Term v a) ->
  MatchCase a (Term v a)
encloseCase :: forall v a.
(Var v, Monoid a) =>
a
-> Set v
-> (Set v -> Term v a -> Term v a)
-> MatchCase a (Term v a)
-> MatchCase a (Term v a)
encloseCase a
a Set v
keep Set v -> Term v a -> Term v a
rec0 (MatchCase Pattern a
pats Maybe (Term v a)
guard Term v a
body) =
  Pattern a -> Maybe (Term v a) -> Term v a -> MatchCase a (Term v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase Pattern a
pats (Term v a -> Term v a
rec (Term v a -> Term v a) -> Maybe (Term v a) -> Maybe (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term v a)
guard) (Term v a -> Term v a
rec Term v a
body)
  where
    rec :: Term v a -> Term v a
rec (ABT.AbsN' [v]
vs Term v a
bd) =
      [(a, v)] -> Term v a -> Term v a
forall v a (f :: * -> *).
Ord v =>
[(a, v)] -> Term f v a -> Term f v a
ABT.absChain' ((,) a
a (v -> (a, v)) -> [v] -> [(a, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs) (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$
        Set v -> Term v a -> Term v a
rec0 (Set v
keep Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs) Term v a
bd

newtype Prefix v x = Pfx (Map v [v]) deriving (Int -> Prefix v x -> ShowS
[Prefix v x] -> ShowS
Prefix v x -> String
(Int -> Prefix v x -> ShowS)
-> (Prefix v x -> String)
-> ([Prefix v x] -> ShowS)
-> Show (Prefix v x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v x. Show v => Int -> Prefix v x -> ShowS
forall v x. Show v => [Prefix v x] -> ShowS
forall v x. Show v => Prefix v x -> String
$cshowsPrec :: forall v x. Show v => Int -> Prefix v x -> ShowS
showsPrec :: Int -> Prefix v x -> ShowS
$cshow :: forall v x. Show v => Prefix v x -> String
show :: Prefix v x -> String
$cshowList :: forall v x. Show v => [Prefix v x] -> ShowS
showList :: [Prefix v x] -> ShowS
Show)

instance Functor (Prefix v) where
  fmap :: forall a b. (a -> b) -> Prefix v a -> Prefix v b
fmap a -> b
_ (Pfx Map v [v]
m) = Map v [v] -> Prefix v b
forall v x. Map v [v] -> Prefix v x
Pfx Map v [v]
m

instance (Ord v) => Applicative (Prefix v) where
  pure :: forall a. a -> Prefix v a
pure a
_ = Map v [v] -> Prefix v a
forall v x. Map v [v] -> Prefix v x
Pfx Map v [v]
forall k a. Map k a
Map.empty
  Pfx Map v [v]
ml <*> :: forall a b. Prefix v (a -> b) -> Prefix v a -> Prefix v b
<*> Pfx Map v [v]
mr = Map v [v] -> Prefix v b
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Prefix v b) -> Map v [v] -> Prefix v b
forall a b. (a -> b) -> a -> b
$ ([v] -> [v] -> [v]) -> Map v [v] -> Map v [v] -> Map v [v]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common Map v [v]
ml Map v [v]
mr

common :: (Eq v) => [v] -> [v] -> [v]
common :: forall v. Eq v => [v] -> [v] -> [v]
common (v
u : [v]
us) (v
v : [v]
vs)
  | v
u v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = v
u v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common [v]
us [v]
vs
common [v]
_ [v]
_ = []

splitPfx :: v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx :: forall v a x. v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx v
v = ([v] -> Prefix v x)
-> ([v], [Term v a]) -> (Prefix v x, [Term v a])
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 (Map v [v] -> Prefix v x
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Prefix v x)
-> ([v] -> Map v [v]) -> [v] -> Prefix v x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> [v] -> Map v [v]
forall k a. k -> a -> Map k a
Map.singleton v
v) (([v], [Term v a]) -> (Prefix v x, [Term v a]))
-> ([Term v a] -> ([v], [Term v a]))
-> [Term v a]
-> (Prefix v x, [Term v a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term v a] -> ([v], [Term v a])
forall {f :: * -> *} {a} {a}. [Term f a a] -> ([a], [Term f a a])
split
  where
    split :: [Term f a a] -> ([a], [Term f a a])
split (Var' a
u : [Term f a a]
as) = ([a] -> [a]) -> ([a], [Term f a a]) -> ([a], [Term f a a])
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 (a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [Term f a a]) -> ([a], [Term f a a]))
-> ([a], [Term f a a]) -> ([a], [Term f a a])
forall a b. (a -> b) -> a -> b
$ [Term f a a] -> ([a], [Term f a a])
split [Term f a a]
as
    split [Term f a a]
rest = ([], [Term f a a]
rest)

-- Finds the common variable prefixes that function variables are
-- applied to, so that they can be reduced.
prefix :: (Ord v) => Term v a -> Prefix v (Term v a)
prefix :: forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix = (Term (F v a a) v a -> Maybe (Prefix v (Term (F v a a) v a)))
-> Term (F v a a) v a -> Prefix v (Term (F v a a) v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit \case
  Apps' (Var' v
u) [Term (F v a a) v a]
as -> case v
-> [Term (F v a a) v a]
-> (Prefix v (Term (F v a a) v a), [Term (F v a a) v a])
forall v a x. v -> [Term v a] -> (Prefix v x, [Term v a])
splitPfx v
u [Term (F v a a) v a]
as of
    (Prefix v (Term (F v a a) v a)
pf, [Term (F v a a) v a]
rest) -> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a. a -> Maybe a
Just (Prefix v (Term (F v a a) v a)
 -> Maybe (Prefix v (Term (F v a a) v a)))
-> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a b. (a -> b) -> a -> b
$ (Term (F v a a) v a -> Prefix v (Term (F v a a) v a))
-> [Term (F v a a) v a] -> Prefix v [Term (F v a a) v a]
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 Term (F v a a) v a -> Prefix v (Term (F v a a) v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix [Term (F v a a) v a]
rest Prefix v [Term (F v a a) v a]
-> Prefix v (Term (F v a a) v a) -> Prefix v (Term (F v a a) v a)
forall a b. Prefix v a -> Prefix v b -> Prefix v b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Prefix v (Term (F v a a) v a)
pf
  Var' v
u -> Prefix v (Term (F v a a) v a)
-> Maybe (Prefix v (Term (F v a a) v a))
forall a. a -> Maybe a
Just (Prefix v (Term (F v a a) v a)
 -> Maybe (Prefix v (Term (F v a a) v a)))
-> (Map v [v] -> Prefix v (Term (F v a a) v a))
-> Map v [v]
-> Maybe (Prefix v (Term (F v a a) v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v [v] -> Prefix v (Term (F v a a) v a)
forall v x. Map v [v] -> Prefix v x
Pfx (Map v [v] -> Maybe (Prefix v (Term (F v a a) v a)))
-> Map v [v] -> Maybe (Prefix v (Term (F v a a) v a))
forall a b. (a -> b) -> a -> b
$ v -> [v] -> Map v [v]
forall k a. k -> a -> Map k a
Map.singleton v
u []
  Term (F v a a) v a
_ -> Maybe (Prefix v (Term (F v a a) v a))
forall a. Maybe a
Nothing

appPfx :: (Ord v) => Prefix v a -> v -> [v] -> [v]
appPfx :: forall v a. Ord v => Prefix v a -> v -> [v] -> [v]
appPfx (Pfx Map v [v]
m) v
v = ([v] -> [v]) -> ([v] -> [v] -> [v]) -> Maybe [v] -> [v] -> [v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([v] -> [v] -> [v]
forall a b. a -> b -> a
const []) [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common (Maybe [v] -> [v] -> [v]) -> Maybe [v] -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ v -> Map v [v] -> Maybe [v]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v [v]
m

-- Rewrites a term by dropping the first n arguments to every
-- application of `v`. This just assumes such a thing makes sense, as
-- in `beta`, where we've calculated how many arguments to drop by
-- looking at every occurrence of `v`.
dropPrefix :: (Ord v) => (Semigroup a) => v -> Int -> Term v a -> Term v a
dropPrefix :: forall v a.
(Ord v, Semigroup a) =>
v -> Int -> Term v a -> Term v a
dropPrefix v
_ Int
0 = Term v a -> Term v a
forall a. a -> a
id
dropPrefix v
v Int
n = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure Term v a -> Maybe (Term v a)
rw
  where
    rw :: Term v a -> Maybe (Term v a)
rw (Apps' f :: Term v a
f@(Var' v
u) [Term v a]
as)
      | v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
u = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
f) v
u) (Int -> [Term v a] -> [Term v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term v a]
as))
    rw Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing

dropPrefixes ::
  (Ord v) => (Semigroup a) => Map v Int -> Term v a -> Term v a
dropPrefixes :: forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure Term (F v a a) v a -> Maybe (Term (F v a a) v a)
rw
  where
    rw :: Term (F v a a) v a -> Maybe (Term (F v a a) v a)
rw (Apps' f :: Term (F v a a) v a
f@(Var' v
u) [Term (F v a a) v a]
as)
      | Just Int
n <- v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
u Map v Int
m =
          Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var (Term (F v a a) v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term (F v a a) v a
f) v
u) (Int -> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term (F v a a) v a]
as))
    rw Term (F v a a) v a
_ = Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing

-- Performs opposite transformations to those in enclose. Named after
-- the lambda case, which is beta reduction.
beta :: (Var v) => (Monoid a) => (Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta :: forall v a.
(Var v, Monoid a) =>
(Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta Term v a -> Term v a
rec (LetRecNamedTop' Bool
top (((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term v a -> Term v a
rec) -> [(v, Term v a)]
vbs) (Term v a -> Term v a
rec -> Term v a
bd)) =
  Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
top [(v, a, Term v a)]
lvbs Term v a
lbd
  where
    -- Avoid completely reducing a lambda expression, because recursive
    -- lets must be guarded.
    args :: (a, Term2 vt at ap v a) -> (a, [v])
args (a
v, LamsNamed' [v]
vs Ann' {}) = (a
v, [v]
vs)
    args (a
v, LamsNamed' [v]
vs Term2 vt at ap v a
_) = (a
v, [v] -> [v]
forall a. HasCallStack => [a] -> [a]
init [v]
vs)
    args (a
v, Term2 vt at ap v a
_) = (a
v, [])

    Pfx Map v [v]
m0 = ((v, Term v a) -> Prefix v (Term v a))
-> [(v, Term v a)] -> Prefix v ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix (Term v a -> Prefix v (Term v a))
-> ((v, Term v a) -> Term v a)
-> (v, Term v a)
-> Prefix v (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Term v a) -> Term v a
forall a b. (a, b) -> b
snd) [(v, Term v a)]
vbs Prefix v () -> Prefix v (Term v a) -> Prefix v (Term v a)
forall a b. Prefix v a -> Prefix v b -> Prefix v b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix Term v a
bd

    f :: [v] -> [v] -> Maybe [v]
f [v]
ls [v]
rs = case [v] -> [v] -> [v]
forall v. Eq v => [v] -> [v] -> [v]
common [v]
ls [v]
rs of
      [] -> Maybe [v]
forall a. Maybe a
Nothing
      [v]
vs -> [v] -> Maybe [v]
forall a. a -> Maybe a
Just [v]
vs

    m :: Map v Int
m = ([v] -> Int) -> Map v [v] -> Map v Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map v [v] -> Map v Int) -> Map v [v] -> Map v Int
forall a b. (a -> b) -> a -> b
$ ([v] -> [v] -> Maybe [v]) -> Map v [v] -> Map v [v] -> Map v [v]
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith [v] -> [v] -> Maybe [v]
forall {v}. Eq v => [v] -> [v] -> Maybe [v]
f ([(v, [v])] -> Map v [v]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(v, [v])] -> Map v [v]) -> [(v, [v])] -> Map v [v]
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> (v, [v])) -> [(v, Term v a)] -> [(v, [v])]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> (v, [v])
forall {a} {vt} {at} {ap} {v} {a}.
(a, Term2 vt at ap v a) -> (a, [v])
args [(v, Term v a)]
vbs) Map v [v]
m0
    lvbs :: [(v, a, Term v a)]
lvbs =
      [(v, Term v a)]
vbs [(v, Term v a)]
-> ((v, Term v a) -> (v, a, Term v a)) -> [(v, a, Term v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, Term v a
b0) -> (v
v,Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b0,) (Term v a -> (v, a, Term v a)) -> Term v a -> (v, a, Term v a)
forall a b. (a -> b) -> a -> b
$ case Term v a
b0 of
        LamsNamed' [v]
vs Term v a
b
          | Just Int
n <- v -> Map v Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v Int
m ->
              a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns (Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b0) (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
b)
        -- shouldn't happen
        Term v a
b -> Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
b

    lbd :: Term v a
lbd = Map v Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
Map v Int -> Term v a -> Term v a
dropPrefixes Map v Int
m Term v a
bd
beta Term v a -> Term v a
rec (Let1NamedTop' Bool
top v
v l :: Term v a
l@(LamsNamed' [v]
vs Term v a
bd) (Term v a -> Term v a
rec -> Term v a
e))
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool -> [(v, Term v a)] -> Term v a -> Term v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
top [(v
v, Term v a
lamb)] (v -> Int -> Term v a -> Term v a
forall v a.
(Ord v, Semigroup a) =>
v -> Int -> Term v a -> Term v a
dropPrefix v
v Int
n Term v a
e)
  | Bool
otherwise = Maybe (Term v a)
forall a. Maybe a
Nothing
  where
    lamb :: Term v a
lamb = a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
al (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Term v a
bd)
    al :: a
al = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
l
    -- Calculate a maximum number of arguments to drop.
    -- Enclosing doesn't create let-bound lambdas, so we
    -- should never reduce a lambda to a non-lambda, as that
    -- could affect evaluation order.
    m :: Int
m
      | Ann' Term v a
_ Type v a
_ <- Term v a
bd = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs
      | Bool
otherwise = [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m (Int -> Int) -> ([v] -> Int) -> [v] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([v] -> Int) -> [v] -> Int
forall a b. (a -> b) -> a -> b
$ Prefix v (Term v a) -> v -> [v] -> [v]
forall v a. Ord v => Prefix v a -> v -> [v] -> [v]
appPfx (Term v a -> Prefix v (Term v a)
forall v a. Ord v => Term v a -> Prefix v (Term v a)
prefix Term v a
e) v
v [v]
vs
beta Term v a -> Term v a
rec (Apps' l :: Term v a
l@(LamsNamed' [v]
vs Term v a
body) [Term v a]
as)
  | Int
n <- Int -> [v] -> [Term v a] -> Int
forall {a} {t} {f :: * -> *} {a}.
(Eq a, Num t) =>
t -> [a] -> [Term f a a] -> t
matchVars Int
0 [v]
vs [Term v a]
as,
    Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
      Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [Term v a] -> Term v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
al (Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
n [v]
vs) (Term v a -> Term v a
rec Term v a
body)) (Int -> [Term v a] -> [Term v a]
forall a. Int -> [a] -> [a]
drop Int
n [Term v a]
as)
  | Bool
otherwise = Maybe (Term v a)
forall a. Maybe a
Nothing
  where
    al :: a
al = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
l
    matchVars :: t -> [a] -> [Term f a a] -> t
matchVars !t
n (a
u : [a]
us) (Var' a
v : [Term f a a]
as) | a
u a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v = t -> [a] -> [Term f a a] -> t
matchVars (t
1 t -> t -> t
forall a. Num a => a -> a -> a
+ t
n) [a]
us [Term f a a]
as
    matchVars t
n [a]
_ [Term f a a]
_ = t
n
beta Term v a -> Term v a
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing

isStructured :: (Var v) => Term v a -> Bool
isStructured :: forall v a. Var v => Term v a -> Bool
isStructured (Var' {}) = Bool
False
isStructured (Lam' {}) = Bool
False
isStructured (Nat' {}) = Bool
False
isStructured (Int' {}) = Bool
False
isStructured (Float' {}) = Bool
False
isStructured (Text' {}) = Bool
False
isStructured (Char' {}) = Bool
False
isStructured (Constructor' {}) = Bool
False
isStructured (Apps' Constructor' {} [Term (F v a a) v a]
args) = (Term (F v a a) v a -> Bool) -> [Term (F v a a) v a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured [Term (F v a a) v a]
args
isStructured (If' Term (F v a a) v a
b Term (F v a a) v a
t Term (F v a a) v a
f) =
  Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
b Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
t Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
f
isStructured (And' Term (F v a a) v a
l Term (F v a a) v a
r) = Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
l Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
r
isStructured (Or' Term (F v a a) v a
l Term (F v a a) v a
r) = Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
l Bool -> Bool -> Bool
|| Term (F v a a) v a -> Bool
forall v a. Var v => Term v a -> Bool
isStructured Term (F v a a) v a
r
isStructured Term (F v a a) v a
_ = Bool
True

close :: (Var v, Monoid a) => Set v -> Term v a -> Term v a
close :: forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
keep Term v a
tm = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure (Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall v a.
(Var v, Monoid a) =>
Set v
-> (Set v -> Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
enclose Set v
keep Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close) Term v a
tm

-- Attempts to undo what was done in `close`. Useful for decompiling.
open :: (Var v, Monoid a) => Term v a -> Term v a
open :: forall v a. (Var v, Monoid a) => Term v a -> Term v a
open Term v a
x = (Term v a -> Maybe (Term v a)) -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
forall v a.
(Var v, Monoid a) =>
(Term v a -> Term v a) -> Term v a -> Maybe (Term v a)
beta Term v a -> Term v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
open) Term v a
x

data FloatSeg v = FSRef Reference | FSText Text | FSVar v

data FloatName v = FloatName [FloatSeg v]

extendName :: FloatSeg v -> FloatName v -> FloatName v
extendName :: forall v. FloatSeg v -> FloatName v -> FloatName v
extendName FloatSeg v
s (FloatName [FloatSeg v]
ss) = [FloatSeg v] -> FloatName v
forall v. [FloatSeg v] -> FloatName v
FloatName ([FloatSeg v] -> FloatName v) -> [FloatSeg v] -> FloatName v
forall a b. (a -> b) -> a -> b
$ FloatSeg v
s FloatSeg v -> [FloatSeg v] -> [FloatSeg v]
forall a. a -> [a] -> [a]
: [FloatSeg v]
ss

prettyFloatName ::
  (Var v) => PrettyPrintEnv -> FloatName v -> Pretty.Pretty Pretty.ColorText
prettyFloatName :: forall v.
Var v =>
PrettyPrintEnv -> FloatName v -> Pretty ColorText
prettyFloatName PrettyPrintEnv
ppe (FloatName [FloatSeg v]
ts) =
  Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pretty.sep Pretty ColorText
"$" ([Pretty ColorText] -> Pretty ColorText)
-> ([FloatSeg v] -> [Pretty ColorText])
-> [FloatSeg v]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FloatSeg v -> Pretty ColorText)
-> [FloatSeg v] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FloatSeg v -> Pretty ColorText
prettySeg ([FloatSeg v] -> Pretty ColorText)
-> [FloatSeg v] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [FloatSeg v] -> [FloatSeg v]
forall a. [a] -> [a]
reverse [FloatSeg v]
ts
  where
    prettySeg :: FloatSeg v -> Pretty ColorText
prettySeg (FSText Text
tx) = Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text Text
tx
    prettySeg (FSVar v
v) = Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v
    prettySeg (FSRef TypeReference
r) =
      Pretty (SyntaxText' TypeReference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor
        (Pretty (SyntaxText' TypeReference) -> Pretty ColorText)
-> (Referent -> Pretty (SyntaxText' TypeReference))
-> Referent
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Pretty (SyntaxText' TypeReference)
prettyHashQualified
        (HashQualified Name -> Pretty (SyntaxText' TypeReference))
-> (Referent -> HashQualified Name)
-> Referent
-> Pretty (SyntaxText' TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Referent -> HashQualified Name
termName PrettyPrintEnv
ppe
        (Referent -> Pretty ColorText) -> Referent -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ TypeReference -> Referent
forall r. r -> Referent' r
Rfn.Ref' TypeReference
r

data FloatState v a = FS
  { forall v a. FloatState v a -> Int
lambdas :: Int,
    forall v a. FloatState v a -> FloatName v
path :: FloatName v,
    forall v a. FloatState v a -> Set v
ctxVars :: Set v,
    forall v a. FloatState v a -> [(v, Term v a)]
floated :: [(v, Term v a)],
    forall v a. FloatState v a -> [(v, FloatName v)]
floatNames :: [(v, FloatName v)],
    forall v a. FloatState v a -> [(v, Term v a)]
decomp :: [(v, Term v a)]
  }

emptyState :: FloatState v a
emptyState :: forall v a. FloatState v a
emptyState = Int
-> FloatName v
-> Set v
-> [(v, Term v a)]
-> [(v, FloatName v)]
-> [(v, Term v a)]
-> FloatState v a
forall v a.
Int
-> FloatName v
-> Set v
-> [(v, Term v a)]
-> [(v, FloatName v)]
-> [(v, Term v a)]
-> FloatState v a
FS Int
0 ([FloatSeg v] -> FloatName v
forall v. [FloatSeg v] -> FloatName v
FloatName []) Set v
forall a. Set a
Set.empty [] [] []

type FloatM v a r = State (FloatState v a) r

addVars :: (Ord v) => Set v -> FloatM v a ()
addVars :: forall v a. Ord v => Set v -> FloatM v a ()
addVars Set v
new = (FloatState v a -> FloatState v a)
-> StateT (FloatState v a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \FloatState v a
st -> FloatState v a
st {ctxVars = new <> ctxVars st}

inLocal :: FloatSeg v -> FloatM v a r -> FloatM v a r
inLocal :: forall v a r. FloatSeg v -> FloatM v a r -> FloatM v a r
inLocal FloatSeg v
nm FloatM v a r
act = do
  FloatState v a
st <- StateT (FloatState v a) Identity (FloatState v a)
forall s (m :: * -> *). MonadState s m => m s
get
  FloatState v a -> StateT (FloatState v a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FloatState v a -> StateT (FloatState v a) Identity ())
-> FloatState v a -> StateT (FloatState v a) Identity ()
forall a b. (a -> b) -> a -> b
$
    FloatState v a
st
      { path = extendName nm $ path st,
        lambdas = 0
      }
  r
r <- FloatM v a r
act
  (FloatState v a -> FloatState v a)
-> StateT (FloatState v a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \FloatState v a
st' -> FloatState v a
st' {path = path st, lambdas = lambdas st}
  pure r
r

inLocalLam :: FloatM v a r -> FloatM v a r
inLocalLam :: forall v a r. FloatM v a r -> FloatM v a r
inLocalLam FloatM v a r
act = do
  Int
n <- (FloatState v a -> Int) -> StateT (FloatState v a) Identity Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FloatState v a -> Int
forall v a. FloatState v a -> Int
lambdas
  FloatSeg v -> FloatM v a r -> FloatM v a r
forall v a r. FloatSeg v -> FloatM v a r -> FloatM v a r
inLocal (Text -> FloatSeg v
forall v. Text -> FloatSeg v
FSText (Text -> FloatSeg v) -> Text -> FloatSeg v
forall a b. (a -> b) -> a -> b
$ Text
"Lambda" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n)) FloatM v a r
act

addFloated ::
  [(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
addFloated :: forall v a.
[(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
addFloated [(v, FloatSeg v, Term v a)]
fln [(v, Term v a)]
dc = (FloatState v a -> FloatState v a)
-> StateT (FloatState v a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify \FloatState v a
st ->
  let fl :: [(v, Term v a)]
fl = [(v, FloatSeg v, Term v a)]
fln [(v, FloatSeg v, Term v a)]
-> ((v, FloatSeg v, Term v a) -> (v, Term v a)) -> [(v, Term v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, FloatSeg v
_, Term v a
tm) -> (v
v, Term v a
tm)
      fn :: [(v, FloatName v)]
fn = [(v, FloatSeg v, Term v a)]
fln [(v, FloatSeg v, Term v a)]
-> ((v, FloatSeg v, Term v a) -> (v, FloatName v))
-> [(v, FloatName v)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, FloatSeg v
n, Term v a
_) -> (v
v, FloatSeg v -> FloatName v -> FloatName v
forall v. FloatSeg v -> FloatName v -> FloatName v
extendName FloatSeg v
n (FloatName v -> FloatName v) -> FloatName v -> FloatName v
forall a b. (a -> b) -> a -> b
$ FloatState v a -> FloatName v
forall v a. FloatState v a -> FloatName v
path FloatState v a
st)
   in FloatState v a
st
        { floated = fl <> floated st,
          floatNames = fn <> floatNames st,
          decomp = dc <> decomp st
        }

nameLambda :: (Var v) => Maybe v -> FloatM v a Text
nameLambda :: forall v a. Var v => Maybe v -> FloatM v a Text
nameLambda (Just v
v) = Text -> StateT (FloatState v a) Identity Text
forall a. a -> StateT (FloatState v a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> StateT (FloatState v a) Identity Text)
-> Text -> StateT (FloatState v a) Identity Text
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v
nameLambda Maybe v
Nothing = (FloatState v a -> (Text, FloatState v a))
-> StateT (FloatState v a) Identity Text
forall a.
(FloatState v a -> (a, FloatState v a))
-> StateT (FloatState v a) Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state \FloatState v a
st ->
  let n :: Int
n = FloatState v a -> Int
forall v a. FloatState v a -> Int
lambdas FloatState v a
st
   in (Text
"Lambda" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n), FloatState v a
st {lambdas = n + 1})

freshFloat :: (Var v) => Set v -> v -> v
freshFloat :: forall v. Var v => Set v -> v -> v
freshFloat Set v
avoid (Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
avoid -> v
v0) =
  case v -> Type
forall v. Var v => v -> Type
Var.typeOf v
v0 of
    Var.User Text
nm
      | v
v <- Type -> v
forall v. Var v => Type -> v
typed (Text -> Type
Var.User (Text -> Type) -> Text -> Type
forall a b. (a -> b) -> a -> b
$ Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w),
        v
v v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set v
avoid ->
          v
v
      | Bool
otherwise ->
          Set v -> v -> v
forall v. Var v => Set v -> v -> v
freshFloat (v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
v0 Set v
avoid) v
v0
    Type
_ -> v
v0
  where
    w :: Text
w = String -> Text
Data.Text.pack (String -> Text)
-> (ConstructorId -> String) -> ConstructorId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> String
forall a. Show a => a -> String
show (ConstructorId -> Text) -> ConstructorId -> Text
forall a b. (a -> b) -> a -> b
$ v -> ConstructorId
forall v. Var v => v -> ConstructorId
Var.freshId v
v0

groupFloater ::
  (Var v, Monoid a) =>
  (Term v a -> FloatM v a (Term v a)) ->
  [(v, Term v a)] ->
  FloatM v a (Map v v)
groupFloater :: forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs = do
  Set v
cvs <- (FloatState v a -> Set v)
-> StateT (FloatState v a) Identity (Set v)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FloatState v a -> Set v
forall v a. FloatState v a -> Set v
ctxVars
  let shadows :: [(v, v)]
shadows =
        [ (v
v, Set v -> v -> v
forall v. Var v => Set v -> v -> v
freshFloat Set v
cvs v
v)
          | (v
v, Term v a
_) <- [(v, Term v a)]
vbs,
            v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member v
v Set v
cvs
        ]
      shadowMap :: Map v v
shadowMap = [(v, v)] -> Map v v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, v)]
shadows
      rn :: v -> v
rn v
v = v -> v -> Map v v -> v
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault v
v v
v Map v v
shadowMap
      shvs :: Set v
shvs = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v -> v
rn (v -> v) -> ((v, Term v a) -> v) -> (v, Term v a) -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Term v a) -> v
forall a b. (a, b) -> a
fst) [(v, Term v a)]
vbs
      h :: (v, Term v a)
-> StateT (FloatState v a) Identity (v, FloatSeg v, Term v a)
h (v
v, Term v a
b) =
        (v -> v
rn v
v,FloatSeg v
nm,) (Term v a -> (v, FloatSeg v, Term v a))
-> FloatM v a (Term v a)
-> StateT (FloatState v a) Identity (v, FloatSeg v, Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FloatSeg v -> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall v a r. FloatSeg v -> FloatM v a r -> FloatM v a r
inLocal FloatSeg v
nm (Term v a -> FloatM v a (Term v a)
rec' (Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames Map v v
shadowMap Term v a
b))
        where
          nm :: FloatSeg v
nm = v -> FloatSeg v
forall v. v -> FloatSeg v
FSVar v
v
  Set v -> FloatM v a ()
forall v a. Ord v => Set v -> FloatM v a ()
addVars Set v
shvs
  [(v, FloatSeg v, Term v a)]
fvnbs <- ((v, Term v a)
 -> StateT (FloatState v a) Identity (v, FloatSeg v, Term v a))
-> [(v, Term v a)]
-> StateT (FloatState v a) Identity [(v, FloatSeg v, Term v a)]
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 (v, Term v a)
-> StateT (FloatState v a) Identity (v, FloatSeg v, Term v a)
h [(v, Term v a)]
vbs
  let dvbs :: [(v, Term v a)]
dvbs = ((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(v
v, Term v a
b) -> (v -> v
rn v
v, Term v a -> Term v a
forall v a. Var v => Term v a -> Term v a
deannotate Term v a
b)) [(v, Term v a)]
vbs
  [(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
forall v a.
[(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
addFloated [(v, FloatSeg v, Term v a)]
fvnbs [(v, Term v a)]
dvbs
  pure Map v v
shadowMap
  where
    rec' :: Term v a -> FloatM v a (Term v a)
rec' Term v a
b
      | LamsAnnot [v]
vs0 Maybe (Type v a)
mty [v]
vs1 Term v a
bd <- Term v a
b =
          a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
forall v a.
Var v =>
a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
lamsAnnot a
a [v]
vs0 Maybe (Type v a)
mty [v]
vs1 (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec Term v a
bd
      where
        a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
    rec' Term v a
b = Term v a -> FloatM v a (Term v a)
rec Term v a
b

letFloater ::
  (Var v, Monoid a) =>
  (Term v a -> FloatM v a (Term v a)) ->
  [(v, Term v a)] ->
  Term v a ->
  FloatM v a (Term v a)
letFloater :: forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
letFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs Term v a
e = do
  Map v v
shadowMap <- (Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs
  pure $ Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames Map v v
shadowMap Term v a
e

lamFloater ::
  (Var v, Monoid a) =>
  Bool ->
  Term v a ->
  Maybe v ->
  a ->
  [v] ->
  Term v a ->
  FloatM v a v
lamFloater :: forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
closed Term v a
tm Maybe v
mv a
a [v]
vs Term v a
bd =
  StateT (FloatState v a) Identity (FloatState v a)
forall s (m :: * -> *). MonadState s m => m s
get StateT (FloatState v a) Identity (FloatState v a)
-> (FloatState v a -> StateT (FloatState v a) Identity v)
-> StateT (FloatState v a) Identity v
forall a b.
StateT (FloatState v a) Identity a
-> (a -> StateT (FloatState v a) Identity b)
-> StateT (FloatState v a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FS {Set v
$sel:ctxVars:FS :: forall v a. FloatState v a -> Set v
ctxVars :: Set v
ctxVars, [(v, Term v a)]
$sel:floated:FS :: forall v a. FloatState v a -> [(v, Term v a)]
floated :: [(v, Term v a)]
floated} ->
    case ((v, Term v a) -> Bool) -> [(v, Term v a)] -> Maybe (v, Term v a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (v, Term v a) -> Bool
p [(v, Term v a)]
floated of
      Just (v
v, Term v a
_) -> v -> StateT (FloatState v a) Identity v
forall a. a -> StateT (FloatState v a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v
      Maybe (v, Term v a)
Nothing -> do
        let v :: v
v = Set v -> v -> v
forall v. Var v => Set v -> v -> v
ABT.freshIn Set v
ctxVars (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe (Type -> v
forall v. Var v => Type -> v
typed Type
Var.Float) Maybe v
mv
        Text
nm <- Maybe v -> FloatM v a Text
forall v a. Var v => Maybe v -> FloatM v a Text
nameLambda Maybe v
mv
        Set v -> FloatM v a ()
forall v a. Ord v => Set v -> FloatM v a ()
addVars (Set v -> FloatM v a ()) -> Set v -> FloatM v a ()
forall a b. (a -> b) -> a -> b
$ v -> Set v
forall a. a -> Set a
Set.singleton v
v
        [(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
forall v a.
[(v, FloatSeg v, Term v a)] -> [(v, Term v a)] -> FloatM v a ()
addFloated
          [(v
v, Text -> FloatSeg v
forall v. Text -> FloatSeg v
FSText Text
nm, a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term v a
bd)]
          (Bool -> v -> Term v a -> [(v, Term v a)]
forall v a. Bool -> v -> Term v a -> [(v, Term v a)]
floatDecomp Bool
closed v
v Term v a
tm)
        pure v
v
  where
    tgt :: Term0' v v
tgt = Term v a -> Term0' v v
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
unannotate (a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs Term v a
bd)
    p :: (v, Term v a) -> Bool
p (v
_, Term v a
flam) = Term v a -> Term0' v v
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
unannotate Term v a
flam Term0' v v -> Term0' v v -> Bool
forall a. Eq a => a -> a -> Bool
== Term0' v v
tgt

floatDecomp ::
  Bool -> v -> Term v a -> [(v, Term v a)]
floatDecomp :: forall v a. Bool -> v -> Term v a -> [(v, Term v a)]
floatDecomp Bool
True v
v Term v a
b = [(v
v, Term v a
b)]
floatDecomp Bool
False v
_ Term v a
_ = []

floater ::
  (Var v, Monoid a) =>
  Bool ->
  (Term v a -> FloatM v a (Term v a)) ->
  Term v a ->
  Maybe (FloatM v a (Term v a))
floater :: forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
top Term v a -> FloatM v a (Term v a)
rec tm0 :: Term v a
tm0@(Ann' Term v a
tm Type v a
ty) =
  ((FloatM v a (Term v a) -> FloatM v a (Term v a))
-> Maybe (FloatM v a (Term v a)) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FloatM v a (Term v a) -> FloatM v a (Term v a))
 -> Maybe (FloatM v a (Term v a)) -> Maybe (FloatM v a (Term v a)))
-> ((Term v a -> Term v a)
    -> FloatM v a (Term v a) -> FloatM v a (Term v a))
-> (Term v a -> Term v a)
-> Maybe (FloatM v a (Term v a))
-> Maybe (FloatM v a (Term v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall a b.
(a -> b)
-> StateT (FloatState v a) Identity a
-> StateT (FloatState v a) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\Term v a
tm -> a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a Term v a
tm Type v a
ty) (Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
top Term v a -> FloatM v a (Term v a)
rec Term v a
tm)
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
tm0
floater Bool
top Term v a -> FloatM v a (Term v a)
rec (LetRecNamed' [(v, Term v a)]
vbs Term v a
e) =
  FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$
    (Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> Term v a -> FloatM v a (Term v a)
letFloater Term v a -> FloatM v a (Term v a)
rec [(v, Term v a)]
vbs Term v a
e FloatM v a (Term v a)
-> (Term v a -> FloatM v a (Term v a)) -> FloatM v a (Term v a)
forall a b.
StateT (FloatState v a) Identity a
-> (a -> StateT (FloatState v a) Identity b)
-> StateT (FloatState v a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      lm :: Term v a
lm@(LamsNamed' [v]
vs Term v a
bd) | Bool
top -> a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a -> FloatM v a (Term v a)
rec Term v a
bd
        where
          a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
lm
      Term v a
tm -> Term v a -> FloatM v a (Term v a)
rec Term v a
tm
floater Bool
_ Term v a -> FloatM v a (Term v a)
rec (Let1Named' v
v Term v a
b Term v a
e)
  | LamsAnnot [v]
vs0 Maybe (Type v a)
_ [v]
vs1 Term v a
bd <- Term v a
b =
      FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$
        Term v a -> FloatM v a (Term v a)
rec Term v a
bd
          FloatM v a (Term v a)
-> (Term v a -> StateT (FloatState v a) Identity v)
-> StateT (FloatState v a) Identity v
forall a b.
StateT (FloatState v a) Identity a
-> (a -> StateT (FloatState v a) Identity b)
-> StateT (FloatState v a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool
-> Term v a
-> Maybe v
-> a
-> [v]
-> Term v a
-> StateT (FloatState v a) Identity v
forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
True Term v a
b (v -> Maybe v
forall a. a -> Maybe a
Just v
v) a
a ([v]
vs0 [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs1)
          StateT (FloatState v a) Identity v
-> (v -> FloatM v a (Term v a)) -> FloatM v a (Term v a)
forall a b.
StateT (FloatState v a) Identity a
-> (a -> StateT (FloatState v a) Identity b)
-> StateT (FloatState v a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v
lv -> Term v a -> FloatM v a (Term v a)
rec (Term v a -> FloatM v a (Term v a))
-> Term v a -> FloatM v a (Term v a)
forall a b. (a -> b) -> a -> b
$ Map v v -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
Map v v -> Term f v a -> Term f v a
ABT.renames (v -> v -> Map v v
forall k a. k -> a -> Map k a
Map.singleton v
v v
lv) Term v a
e
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
b
floater Bool
top Term v a -> FloatM v a (Term v a)
rec tm :: Term v a
tm@(LamsAnnot [v]
vs0 Maybe (Type v a)
mty [v]
vs1 Term v a
bd)
  | Bool
top = FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$ a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
forall v a.
Var v =>
a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
lamsAnnot a
a [v]
vs0 Maybe (Type v a)
mty [v]
vs1 (Term v a -> Term v a)
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall v a r. FloatM v a r -> FloatM v a r
inLocalLam (Term v a -> FloatM v a (Term v a)
rec Term v a
bd)
  | Bool
otherwise = FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a. a -> Maybe a
Just (FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a)))
-> FloatM v a (Term v a) -> Maybe (FloatM v a (Term v a))
forall a b. (a -> b) -> a -> b
$ do
      Term v a
bd <- FloatM v a (Term v a) -> FloatM v a (Term v a)
forall v a r. FloatM v a r -> FloatM v a r
inLocalLam (FloatM v a (Term v a) -> FloatM v a (Term v a))
-> FloatM v a (Term v a) -> FloatM v a (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> FloatM v a (Term v a)
rec Term v a
bd
      v
lv <- Bool
-> Term v a
-> Maybe v
-> a
-> [v]
-> Term v a
-> StateT (FloatState v a) Identity v
forall v a.
(Var v, Monoid a) =>
Bool -> Term v a -> Maybe v -> a -> [v] -> Term v a -> FloatM v a v
lamFloater Bool
True Term v a
tm Maybe v
forall a. Maybe a
Nothing a
a ([v]
vs0 [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
vs1) Term v a
bd
      pure $ a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
lv
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
tm
floater Bool
_ Term v a -> FloatM v a (Term v a)
_ Term v a
_ = Maybe (FloatM v a (Term v a))
forall a. Maybe a
Nothing

postFloat ::
  (Var v) =>
  (Monoid a) =>
  Map v Reference ->
  FloatState v a ->
  ( [(v, Term v a)],
    [(v, Id)],
    [(Reference, FloatName v)],
    [(Reference, Term v a)],
    [(Reference, Term v a)]
  )
postFloat :: forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> FloatState v a
-> ([(v, Term v a)], [(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
postFloat Map v TypeReference
orig (FS {[(v, FloatName v)]
$sel:floatNames:FS :: forall v a. FloatState v a -> [(v, FloatName v)]
floatNames :: [(v, FloatName v)]
floatNames, [(v, Term2 v a a v a)]
$sel:floated:FS :: forall v a. FloatState v a -> [(v, Term v a)]
floated :: [(v, Term2 v a a v a)]
floated, [(v, Term2 v a a v a)]
$sel:decomp:FS :: forall v a. FloatState v a -> [(v, Term v a)]
decomp :: [(v, Term2 v a a v a)]
decomp}) =
  ( [(v, Term2 v a a v a)]
subs,
    [(v, Id)]
subvs,
    (Maybe (TypeReference, FloatName v)
 -> Maybe (TypeReference, FloatName v))
-> [Maybe (TypeReference, FloatName v)]
-> [(TypeReference, FloatName v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (((TypeReference, FloatName v) -> (TypeReference, FloatName v))
-> Maybe (TypeReference, FloatName v)
-> Maybe (TypeReference, FloatName v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TypeReference, FloatName v) -> (TypeReference, FloatName v))
 -> Maybe (TypeReference, FloatName v)
 -> Maybe (TypeReference, FloatName v))
-> ((TypeReference, FloatName v) -> (TypeReference, FloatName v))
-> Maybe (TypeReference, FloatName v)
-> Maybe (TypeReference, FloatName v)
forall a b. (a -> b) -> a -> b
$ (FloatName v -> FloatName v)
-> (TypeReference, FloatName v) -> (TypeReference, FloatName v)
forall a b. (a -> b) -> (TypeReference, a) -> (TypeReference, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FloatName v -> FloatName v
originals) [Maybe (TypeReference, FloatName v)]
nms,
    [(TypeReference, Term2 v a a v a)]
tops,
    [(v, Term2 v a a v a)]
decomp [(v, Term2 v a a v a)]
-> ((v, Term2 v a a v a) -> [(TypeReference, Term2 v a a v a)])
-> [(TypeReference, Term2 v a a v a)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(v
v, Term2 v a a v a
tm) ->
      let stm :: Term2 v a a v a
stm = Term2 v a a v a -> Term2 v a a v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
open (Term2 v a a v a -> Term2 v a a v a)
-> Term2 v a a v a -> Term2 v a a v a
forall a b. (a -> b) -> a -> b
$ [(v, Term2 v a a v a)] -> Term2 v a a v a -> Term2 v a a v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term2 v a a v a)]
dsubs Term2 v a a v a
tm
       in (Map v TypeReference
subm Map v TypeReference -> v -> TypeReference
forall k a. Ord k => Map k a -> k -> a
Map.! v
v, Term2 v a a v a
stm) (TypeReference, Term2 v a a v a)
-> [(TypeReference, Term2 v a a v a)]
-> [(TypeReference, Term2 v a a v a)]
forall a. a -> [a] -> [a]
: [(TypeReference
r, Term2 v a a v a
stm) | Just TypeReference
r <- [v -> Map v TypeReference -> Maybe TypeReference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v TypeReference
orig]]
  )
  where
    m :: Map v (Id, Term2 v a a v a)
m =
      ((Id, Term2 v a a v a) -> (Id, Term2 v a a v a))
-> Map v (Id, Term2 v a a v a) -> Map v (Id, Term2 v a a v a)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term2 v a a v a -> Term2 v a a v a)
-> (Id, Term2 v a a v a) -> (Id, Term2 v a a v a)
forall a b. (a -> b) -> (Id, a) -> (Id, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term2 v a a v a -> Term2 v a a v a
forall v a. Var v => Term v a -> Term v a
deannotate)
        (Map v (Id, Term2 v a a v a) -> Map v (Id, Term2 v a a v a))
-> ([(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a))
-> [(v, Term2 v a a v a)]
-> Map v (Id, Term2 v a a v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map v (Term2 v a a v a) -> Map v (Id, Term2 v a a v a)
forall v a. Var v => Map v (Term v a) -> Map v (Id, Term v a)
hashTermComponentsWithoutTypes
        (Map v (Term2 v a a v a) -> Map v (Id, Term2 v a a v a))
-> ([(v, Term2 v a a v a)] -> Map v (Term2 v a a v a))
-> [(v, Term2 v a a v a)]
-> Map v (Id, Term2 v a a v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term2 v a a v a)] -> Map v (Term2 v a a v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a))
-> [(v, Term2 v a a v a)] -> Map v (Id, Term2 v a a v a)
forall a b. (a -> b) -> a -> b
$ [(v, Term2 v a a v a)]
floated
    vname :: Map v (FloatName v)
vname = [(v, FloatName v)] -> Map v (FloatName v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, FloatName v)]
floatNames
    trips :: [(v, (Id, Term2 v a a v a))]
trips = Map v (Id, Term2 v a a v a) -> [(v, (Id, Term2 v a a v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Id, Term2 v a a v a)
m
    f :: (v, (Id, Term2 v a a v a))
-> ((v, Id), Maybe (TypeReference, FloatName v),
    (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))
f (v
v, (Id
id, Term2 v a a v a
tm)) =
      ((v
v, Id
id), (TypeReference
rf,) (FloatName v -> (TypeReference, FloatName v))
-> Maybe (FloatName v) -> Maybe (TypeReference, FloatName v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> Map v (FloatName v) -> Maybe (FloatName v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v (FloatName v)
vname, (v
v, Term2 v a a v a
idtm), (TypeReference
rf, Term2 v a a v a
tm))
      where
        rf :: TypeReference
rf = Id -> TypeReference
forall h t. Id' h -> Reference' t h
DerivedId Id
id
        idtm :: Term2 v a a v a
idtm = a -> TypeReference -> Term2 v a a v a
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
ref (Term2 v a a v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term2 v a a v a
tm) TypeReference
rf
    unzip4 :: [(a, a, a, a)] -> ([a], [a], [a], [a])
unzip4 [] = ([], [], [], [])
    unzip4 ((a
a, a
b, a
c, a
d) : ([(a, a, a, a)] -> ([a], [a], [a], [a])
unzip4 -> ~([a]
as, [a]
bs, [a]
cs, [a]
ds))) =
      (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
bs, a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cs, a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ds)
    ([(v, Id)]
subvs, [Maybe (TypeReference, FloatName v)]
nms, [(v, Term2 v a a v a)]
subs, [(TypeReference, Term2 v a a v a)]
tops) = [((v, Id), Maybe (TypeReference, FloatName v),
  (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))]
-> ([(v, Id)], [Maybe (TypeReference, FloatName v)],
    [(v, Term2 v a a v a)], [(TypeReference, Term2 v a a v a)])
forall {a} {a} {a} {a}. [(a, a, a, a)] -> ([a], [a], [a], [a])
unzip4 ([((v, Id), Maybe (TypeReference, FloatName v),
   (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))]
 -> ([(v, Id)], [Maybe (TypeReference, FloatName v)],
     [(v, Term2 v a a v a)], [(TypeReference, Term2 v a a v a)]))
-> [((v, Id), Maybe (TypeReference, FloatName v),
     (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))]
-> ([(v, Id)], [Maybe (TypeReference, FloatName v)],
    [(v, Term2 v a a v a)], [(TypeReference, Term2 v a a v a)])
forall a b. (a -> b) -> a -> b
$ ((v, (Id, Term2 v a a v a))
 -> ((v, Id), Maybe (TypeReference, FloatName v),
     (v, Term2 v a a v a), (TypeReference, Term2 v a a v a)))
-> [(v, (Id, Term2 v a a v a))]
-> [((v, Id), Maybe (TypeReference, FloatName v),
     (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))]
forall a b. (a -> b) -> [a] -> [b]
map (v, (Id, Term2 v a a v a))
-> ((v, Id), Maybe (TypeReference, FloatName v),
    (v, Term2 v a a v a), (TypeReference, Term2 v a a v a))
f [(v, (Id, Term2 v a a v a))]
trips
    subm :: Map v TypeReference
subm = (Id -> TypeReference) -> Map v Id -> Map v TypeReference
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> TypeReference
forall h t. Id' h -> Reference' t h
DerivedId ([(v, Id)] -> Map v Id
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Id)]
subvs)
    dsubs :: [(v, Term2 v a a v a)]
dsubs = Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)])
-> Map v (Term2 v a a v a) -> [(v, Term2 v a a v a)]
forall a b. (a -> b) -> a -> b
$ (TypeReference -> Term2 v a a v a)
-> Map v TypeReference -> Map v (Term2 v a a v a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (a -> TypeReference -> Term2 v a a v a
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
ref a
forall a. Monoid a => a
mempty) Map v TypeReference
orig Map v (Term2 v a a v a)
-> Map v (Term2 v a a v a) -> Map v (Term2 v a a v a)
forall a. Semigroup a => a -> a -> a
<> [(v, Term2 v a a v a)] -> Map v (Term2 v a a v a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(v, Term2 v a a v a)]
subs

    originals :: FloatName v -> FloatName v
originals (FloatName [FloatSeg v]
ss) =
      [FloatSeg v] -> FloatName v
forall v. [FloatSeg v] -> FloatName v
FloatName ([FloatSeg v] -> FloatName v) -> [FloatSeg v] -> FloatName v
forall a b. (a -> b) -> a -> b
$
        [FloatSeg v]
ss [FloatSeg v] -> (FloatSeg v -> FloatSeg v) -> [FloatSeg v]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          FSVar v
v
            | Just TypeReference
r <- v -> Map v TypeReference -> Maybe TypeReference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v TypeReference
orig -> TypeReference -> FloatSeg v
forall v. TypeReference -> FloatSeg v
FSRef TypeReference
r
          FloatSeg v
seg -> FloatSeg v
seg

float ::
  (Var v) =>
  (Monoid a) =>
  Map v Reference ->
  Term v a ->
  ( Term v a,
    Map Reference Reference,
    Map Reference (FloatName v),
    [(Reference, Term v a)],
    [(Reference, Term v a)]
  )
float :: forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> Term v a
-> (Term v a, Map TypeReference TypeReference,
    Map TypeReference (FloatName v), [(TypeReference, Term v a)],
    [(TypeReference, Term v a)])
float Map v TypeReference
orig Term v a
tm = case State (FloatState v a) (Term v a)
-> FloatState v a -> (Term v a, FloatState v a)
forall s a. State s a -> s -> (a, s)
runState State (FloatState v a) (Term v a)
go0 FloatState v a
forall v a. FloatState v a
emptyState of
  (Term v a
bd, FloatState v a
st) -> case Map v TypeReference
-> FloatState v a
-> ([(v, Term v a)], [(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> FloatState v a
-> ([(v, Term v a)], [(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
postFloat Map v TypeReference
orig FloatState v a
st of
    ([(v, Term v a)]
subs, [(v, Id)]
subvs, [(TypeReference, FloatName v)]
fnames, [(TypeReference, Term v a)]
tops, [(TypeReference, Term v a)]
dcmp) ->
      ( Bool -> [(v, a, Term v a)] -> Term v a -> Term v a
forall v a vt.
(Ord v, Monoid a) =>
Bool -> [(v, a, Term' vt v a)] -> Term' vt v a -> Term' vt v a
letRec' Bool
True [] (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Term v a)] -> Term v a -> Term v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
ABT.substs [(v, Term v a)]
subs (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Term v a
forall v a. Var v => Term v a -> Term v a
deannotate (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
bd,
        [(TypeReference, TypeReference)] -> Map TypeReference TypeReference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TypeReference, TypeReference)]
 -> Map TypeReference TypeReference)
-> ([(v, Id)] -> [(TypeReference, TypeReference)])
-> [(v, Id)]
-> Map TypeReference TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Id) -> Maybe (TypeReference, TypeReference))
-> [(v, Id)] -> [(TypeReference, TypeReference)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (v, Id) -> Maybe (TypeReference, TypeReference)
f ([(v, Id)] -> Map TypeReference TypeReference)
-> [(v, Id)] -> Map TypeReference TypeReference
forall a b. (a -> b) -> a -> b
$ [(v, Id)]
subvs,
        [(TypeReference, FloatName v)] -> Map TypeReference (FloatName v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TypeReference, FloatName v)]
fnames,
        [(TypeReference, Term v a)]
tops,
        [(TypeReference, Term v a)]
dcmp
      )
  where
    f :: (v, Id) -> Maybe (TypeReference, TypeReference)
f (v
v, Id
i) = (,Id -> TypeReference
forall h t. Id' h -> Reference' t h
DerivedId Id
i) (TypeReference -> (TypeReference, TypeReference))
-> Maybe TypeReference -> Maybe (TypeReference, TypeReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> Map v TypeReference -> Maybe TypeReference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v TypeReference
orig
    go0 :: State (FloatState v a) (Term v a)
go0 = State (FloatState v a) (Term v a)
-> Maybe (State (FloatState v a) (Term v a))
-> State (FloatState v a) (Term v a)
forall a. a -> Maybe a -> a
fromMaybe (Term v a -> State (FloatState v a) (Term v a)
go Term v a
tm) (Bool
-> (Term v a -> State (FloatState v a) (Term v a))
-> Term v a
-> Maybe (State (FloatState v a) (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
True Term v a -> State (FloatState v a) (Term v a)
go Term v a
tm)
    go :: Term v a -> State (FloatState v a) (Term v a)
go = (Term v a -> Maybe (State (FloatState v a) (Term v a)))
-> Term v a -> State (FloatState v a) (Term v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit ((Term v a -> Maybe (State (FloatState v a) (Term v a)))
 -> Term v a -> State (FloatState v a) (Term v a))
-> (Term v a -> Maybe (State (FloatState v a) (Term v a)))
-> Term v a
-> State (FloatState v a) (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term v a -> State (FloatState v a) (Term v a))
-> Term v a
-> Maybe (State (FloatState v a) (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
False Term v a -> State (FloatState v a) (Term v a)
go

floatGroup ::
  (Var v) =>
  (Monoid a) =>
  Map v Reference ->
  [(v, Term v a)] ->
  ( [(v, Id)],
    [(Reference, FloatName v)],
    [(Reference, Term v a)],
    [(Reference, Term v a)]
  )
floatGroup :: forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
floatGroup Map v TypeReference
orig [(v, Term v a)]
grp = case State (FloatState v a) (Map v v)
-> FloatState v a -> (Map v v, FloatState v a)
forall s a. State s a -> s -> (a, s)
runState State (FloatState v a) (Map v v)
go0 FloatState v a
forall v a. FloatState v a
emptyState of
  (Map v v
_, FloatState v a
st) -> case Map v TypeReference
-> FloatState v a
-> ([(v, Term v a)], [(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> FloatState v a
-> ([(v, Term v a)], [(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
postFloat Map v TypeReference
orig FloatState v a
st of
    ([(v, Term v a)]
_, [(v, Id)]
subvs, [(TypeReference, FloatName v)]
fnames, [(TypeReference, Term v a)]
tops, [(TypeReference, Term v a)]
dcmp) -> ([(v, Id)]
subvs, [(TypeReference, FloatName v)]
fnames, [(TypeReference, Term v a)]
tops, [(TypeReference, Term v a)]
dcmp)
  where
    go :: Term v a -> StateT (FloatState v a) Identity (Term v a)
go = (Term v a -> Maybe (StateT (FloatState v a) Identity (Term v a)))
-> Term v a -> StateT (FloatState v a) Identity (Term v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(Term f v a -> Maybe (g (Term f v a)))
-> Term f v a -> g (Term f v a)
ABT.visit ((Term v a -> Maybe (StateT (FloatState v a) Identity (Term v a)))
 -> Term v a -> StateT (FloatState v a) Identity (Term v a))
-> (Term v a
    -> Maybe (StateT (FloatState v a) Identity (Term v a)))
-> Term v a
-> StateT (FloatState v a) Identity (Term v a)
forall a b. (a -> b) -> a -> b
$ Bool
-> (Term v a -> StateT (FloatState v a) Identity (Term v a))
-> Term v a
-> Maybe (StateT (FloatState v a) Identity (Term v a))
forall v a.
(Var v, Monoid a) =>
Bool
-> (Term v a -> FloatM v a (Term v a))
-> Term v a
-> Maybe (FloatM v a (Term v a))
floater Bool
False Term v a -> StateT (FloatState v a) Identity (Term v a)
go
    go0 :: State (FloatState v a) (Map v v)
go0 = (Term v a -> StateT (FloatState v a) Identity (Term v a))
-> [(v, Term v a)] -> State (FloatState v a) (Map v v)
forall v a.
(Var v, Monoid a) =>
(Term v a -> FloatM v a (Term v a))
-> [(v, Term v a)] -> FloatM v a (Map v v)
groupFloater Term v a -> StateT (FloatState v a) Identity (Term v a)
go [(v, Term v a)]
grp

unAnn :: Term v a -> Term v a
unAnn :: forall v a. Term v a -> Term v a
unAnn (Ann' Term (F v a a) v a
tm Type v a
_) = Term (F v a a) v a
tm
unAnn Term (F v a a) v a
tm = Term (F v a a) v a
tm

unLamsAnnot :: Term v a -> Maybe ([v], Maybe (Ty.Type v a), [v], Term v a)
unLamsAnnot :: forall v a.
Term v a -> Maybe ([v], Maybe (Type v a), [v], Term v a)
unLamsAnnot Term v a
tm0
  | [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
vs0, [v] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
vs1 = Maybe ([v], Maybe (Type v a), [v], Term v a)
forall a. Maybe a
Nothing
  | Bool
otherwise = ([v], Maybe (Type v a), [v], Term v a)
-> Maybe ([v], Maybe (Type v a), [v], Term v a)
forall a. a -> Maybe a
Just ([v]
vs0, Maybe (Type v a)
mty, [v]
vs1, Term v a
bd)
  where
    ([v]
vs0, Term v a
bd0)
      | LamsNamed' [v]
vs Term v a
bd <- Term v a
tm0 = ([v]
vs, Term v a
bd)
      | Bool
otherwise = ([], Term v a
tm0)
    (Maybe (Type v a)
mty, Term v a
bd1)
      | Ann' Term v a
bd Type v a
ty <- Term v a
bd0 = (Type v a -> Maybe (Type v a)
forall a. a -> Maybe a
Just Type v a
ty, Term v a
bd)
      | Bool
otherwise = (Maybe (Type v a)
forall a. Maybe a
Nothing, Term v a
bd0)
    ([v]
vs1, Term v a
bd)
      | LamsNamed' [v]
vs Term v a
bd <- Term v a
bd1 = ([v]
vs, Term v a
bd)
      | Bool
otherwise = ([], Term v a
bd1)

-- Matches a lambda term with an annotation in the middle, like:
--
--   w x -> (y z -> ...) : ...
--
-- This can occur due to enclosing an annotated lambda term with free
-- variables.
pattern LamsAnnot ::
  [v] -> Maybe (Ty.Type v a) -> [v] -> Term v a -> Term v a
pattern $mLamsAnnot :: forall {r} {v} {a}.
Term v a
-> ([v] -> Maybe (Type v a) -> [v] -> Term v a -> r)
-> ((# #) -> r)
-> r
LamsAnnot us mty vs bd <-
  (unLamsAnnot -> Just (us, mty, vs, bd))

-- Builds a lambda term with arguments separated by an annotation, as
-- above. Just a convenience function that reverses the above pattern.
lamsAnnot ::
  (Var v) => a -> [v] -> Maybe (Ty.Type v a) -> [v] -> Term v a -> Term v a
lamsAnnot :: forall v a.
Var v =>
a -> [v] -> Maybe (Type v a) -> [v] -> Term v a -> Term v a
lamsAnnot a
a [v]
us Maybe (Type v a)
mty [v]
vs Term v a
bd =
  a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
us
    (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a)
-> (Type v a -> Term v a -> Term v a)
-> Maybe (Type v a)
-> Term v a
-> Term v a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Term v a -> Term v a
forall a. a -> a
id ((Term v a -> Type v a -> Term v a)
-> Type v a -> Term v a -> Term v a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Term v a -> Type v a -> Term v a)
 -> Type v a -> Term v a -> Term v a)
-> (Term v a -> Type v a -> Term v a)
-> Type v a
-> Term v a
-> Term v a
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> Type v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
ann a
a) Maybe (Type v a)
mty
    (Term v a -> Term v a)
-> (Term v a -> Term v a) -> Term v a -> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [v] -> Term v a -> Term v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
a [v]
vs
    (Term v a -> Term v a) -> Term v a -> Term v a
forall a b. (a -> b) -> a -> b
$ Term v a
bd

deannotate :: (Var v) => Term v a -> Term v a
deannotate :: forall v a. Var v => Term v a -> Term v a
deannotate = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
 -> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
  Ann' Term (F v a a) v a
c Type v a
_ -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ Term (F v a a) v a -> Term (F v a a) v a
forall v a. Var v => Term v a -> Term v a
deannotate Term (F v a a) v a
c
  Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing

lamLift ::
  (Var v) =>
  (Monoid a) =>
  Map v Reference ->
  Term v a ->
  ( Term v a,
    Map Reference Reference,
    Map Reference (FloatName v),
    [(Reference, Term v a)],
    [(Reference, Term v a)]
  )
lamLift :: forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> Term v a
-> (Term v a, Map TypeReference TypeReference,
    Map TypeReference (FloatName v), [(TypeReference, Term v a)],
    [(TypeReference, Term v a)])
lamLift Map v TypeReference
orig = Map v TypeReference
-> Term v a
-> (Term v a, Map TypeReference TypeReference,
    Map TypeReference (FloatName v), [(TypeReference, Term v a)],
    [(TypeReference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> Term v a
-> (Term v a, Map TypeReference TypeReference,
    Map TypeReference (FloatName v), [(TypeReference, Term v a)],
    [(TypeReference, Term v a)])
float Map v TypeReference
orig (Term v a
 -> (Term v a, Map TypeReference TypeReference,
     Map TypeReference (FloatName v), [(TypeReference, Term v a)],
     [(TypeReference, Term v a)]))
-> (Term v a -> Term v a)
-> Term v a
-> (Term v a, Map TypeReference TypeReference,
    Map TypeReference (FloatName v), [(TypeReference, Term v a)],
    [(TypeReference, Term v a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
forall a. Set a
Set.empty

lamLiftGroup ::
  (Var v) =>
  (Monoid a) =>
  Map v Reference ->
  [(v, Term v a)] ->
  ( [(v, Id)],
    [(Reference, FloatName v)],
    [(Reference, Term v a)],
    [(Reference, Term v a)]
  )
lamLiftGroup :: forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
lamLiftGroup Map v TypeReference
orig [(v, Term v a)]
gr = Map v TypeReference
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
forall v a.
(Var v, Monoid a) =>
Map v TypeReference
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
floatGroup Map v TypeReference
orig ([(v, Term v a)]
 -> ([(v, Id)], [(TypeReference, FloatName v)],
     [(TypeReference, Term v a)], [(TypeReference, Term v a)]))
-> ([(v, Term v a)] -> [(v, Term v a)])
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((v, Term v a) -> (v, Term v a))
-> [(v, Term v a)] -> [(v, Term v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((v, Term v a) -> (v, Term v a))
 -> [(v, Term v a)] -> [(v, Term v a)])
-> ((Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a))
-> (Term v a -> Term v a)
-> [(v, Term v a)]
-> [(v, Term v a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a -> Term v a) -> (v, Term v a) -> (v, Term v a)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Set v -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Set v -> Term v a -> Term v a
close Set v
keep) ([(v, Term v a)]
 -> ([(v, Id)], [(TypeReference, FloatName v)],
     [(TypeReference, Term v a)], [(TypeReference, Term v a)]))
-> [(v, Term v a)]
-> ([(v, Id)], [(TypeReference, FloatName v)],
    [(TypeReference, Term v a)], [(TypeReference, Term v a)])
forall a b. (a -> b) -> a -> b
$ [(v, Term v a)]
gr
  where
    keep :: Set v
keep = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Term v a) -> v
forall a b. (a, b) -> a
fst [(v, Term v a)]
gr

saturate ::
  (Var v, Monoid a) =>
  Map ConstructorReference Int ->
  Term v a ->
  Term v a
saturate :: forall v a.
(Var v, Monoid a) =>
Map ConstructorReference Int -> Term v a -> Term v a
saturate Map ConstructorReference Int
dat = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
 -> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
  Apps' f :: Term (F v a a) v a
f@(Constructor' ConstructorReference
r) [Term (F v a a) v a]
args -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args
  Apps' f :: Term (F v a a) v a
f@(Request' ConstructorReference
r) [Term (F v a a) v a]
args -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args
  f :: Term (F v a a) v a
f@(Constructor' ConstructorReference
r) -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f []
  f :: Term (F v a a) v a
f@(Request' ConstructorReference
r) -> ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f []
  Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing
  where
    frsh :: Set b -> p -> (Set b, b)
frsh Set b
avoid p
_ =
      let v :: b
v = Set b -> b -> b
forall v. Var v => Set v -> v -> v
Var.freshIn Set b
avoid (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Type -> b
forall v. Var v => Type -> v
typed Type
Var.Eta
       in (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
v Set b
avoid, b
v)
    sat :: ConstructorReference
-> Term (F v a a) v a
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
sat ConstructorReference
r Term (F v a a) v a
f [Term (F v a a) v a]
args = case ConstructorReference -> Map ConstructorReference Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConstructorReference
r Map ConstructorReference Int
dat of
      Just Int
n
        | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n,
          [v]
vs <- (Set v, [v]) -> [v]
forall a b. (a, b) -> b
snd ((Set v, [v]) -> [v]) -> (Set v, [v]) -> [v]
forall a b. (a -> b) -> a -> b
$ (Set v -> Int -> (Set v, v)) -> Set v -> [Int] -> (Set v, [v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Set v -> Int -> (Set v, v)
forall {b} {p}. Var b => Set b -> p -> (Set b, b)
frsh Set v
fvs [Int
1 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m],
          [Term (F v a a) v a]
nargs <- a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty (v -> Term (F v a a) v a) -> [v] -> [Term (F v a a) v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vs ->
            Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> ([Term (F v a a) v a] -> Term (F v a a) v a)
-> [Term (F v a a) v a]
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [v] -> Term (F v a a) v a -> Term (F v a a) v a
forall v a vt at ap.
Ord v =>
a -> [v] -> Term2 vt at ap v a -> Term2 vt at ap v a
lamWithoutBindingAnns a
forall a. Monoid a => a
mempty [v]
vs (Term (F v a a) v a -> Term (F v a a) v a)
-> ([Term (F v a a) v a] -> Term (F v a a) v a)
-> [Term (F v a a) v a]
-> Term (F v a a) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f ([Term (F v a a) v a] -> Maybe (Term (F v a a) v a))
-> [Term (F v a a) v a] -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ [Term (F v a a) v a]
args' [Term (F v a a) v a]
-> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall a. [a] -> [a] -> [a]
++ [Term (F v a a) v a]
nargs
        | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n,
          ([Term (F v a a) v a]
sargs, [Term (F v a a) v a]
eargs) <- Int
-> [Term (F v a a) v a]
-> ([Term (F v a a) v a], [Term (F v a a) v a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Term (F v a a) v a]
args',
          v
sv <- Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
fvs (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Eta ->
            Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just
              (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> (Term (F v a a) v a -> Term (F v a a) v a)
-> Term (F v a a) v a
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> [(v, Term (F v a a) v a)]
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a v vt at ap.
(Semigroup a, Ord v) =>
Bool
-> [(v, Term2 vt at ap v a)]
-> Term2 vt at ap v a
-> Term2 vt at ap v a
let1' Bool
False [(v
sv, Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f [Term (F v a a) v a]
sargs)]
              (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (a -> v -> Term (F v a a) v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
forall a. Monoid a => a
mempty v
sv) [Term (F v a a) v a]
eargs
      Maybe Int
_ -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> [Term (F v a a) v a] -> Term (F v a a) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' Term (F v a a) v a
f [Term (F v a a) v a]
args')
      where
        m :: Int
m = [Term (F v a a) v a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Term (F v a a) v a]
args
        fvs :: Set v
fvs = (Term (F v a a) v a -> Set v) -> [Term (F v a a) v a] -> Set v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term (F v a a) v a -> Set v
forall vt v a. Term' vt v a -> Set v
freeVars [Term (F v a a) v a]
args
        args' :: [Term (F v a a) v a]
args' = Map ConstructorReference Int
-> Term (F v a a) v a -> Term (F v a a) v a
forall v a.
(Var v, Monoid a) =>
Map ConstructorReference Int -> Term v a -> Term v a
saturate Map ConstructorReference Int
dat (Term (F v a a) v a -> Term (F v a a) v a)
-> [Term (F v a a) v a] -> [Term (F v a a) v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term (F v a a) v a]
args

replaceConstructors ::
  (Ord ref, Var v) =>
  Map ref (Map CTag ForeignFunc) ->
  SuperGroup ref v ->
  SuperGroup ref v
replaceConstructors :: forall ref v.
(Ord ref, Var v) =>
Map ref (Map CTag ForeignFunc)
-> SuperGroup ref v -> SuperGroup ref v
replaceConstructors Map ref (Map CTag ForeignFunc)
reps (Rec [(v, SuperNormal ref v)]
bs SuperNormal ref v
entry) =
  [(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
forall ref v.
[(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
Rec ((SuperNormal ref v -> SuperNormal ref v)
-> (v, SuperNormal ref v) -> (v, SuperNormal ref v)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperNormal ref v -> SuperNormal ref v
go0 ((v, SuperNormal ref v) -> (v, SuperNormal ref v))
-> [(v, SuperNormal ref v)] -> [(v, SuperNormal ref v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, SuperNormal ref v)]
bs) (SuperNormal ref v -> SuperNormal ref v
go0 SuperNormal ref v
entry)
  where
    go0 :: SuperNormal ref v -> SuperNormal ref v
go0 (Lambda [Mem]
ccs ANormal ref v
body) = [Mem] -> ANormal ref v -> SuperNormal ref v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda [Mem]
ccs (ANormal ref v -> SuperNormal ref v)
-> ANormal ref v -> SuperNormal ref v
forall a b. (a -> b) -> a -> b
$ (ANormal ref v -> Maybe (ANormal ref v))
-> ANormal ref v -> ANormal ref v
forall (f :: * -> * -> *) v.
(Bifoldable f, Traversable (f v), Var v) =>
(Term f v -> Maybe (Term f v)) -> Term f v -> Term f v
ABTN.visitPure ANormal ref v -> Maybe (ANormal ref v)
f ANormal ref v
body

    f :: ANormal ref v -> Maybe (ANormal ref v)
f (TApp (FCon ref
r CTag
c) [v]
as) = do
      Map CTag ForeignFunc
cs <- ref
-> Map ref (Map CTag ForeignFunc) -> Maybe (Map CTag ForeignFunc)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ref
r Map ref (Map CTag ForeignFunc)
reps
      ForeignFunc
ff <- CTag -> Map CTag ForeignFunc -> Maybe ForeignFunc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CTag
c Map CTag ForeignFunc
cs
      pure $ Func ref v -> [v] -> ANormal ref v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (Either POp ForeignFunc -> Func ref v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim (ForeignFunc -> Either POp ForeignFunc
forall a b. b -> Either a b
Right ForeignFunc
ff)) [v]
as
    f ANormal ref v
_ = Maybe (ANormal ref v)
forall a. Maybe a
Nothing

replaceFunctions ::
  (Ord ref, Var v) =>
  Map ref ref ->
  SuperGroup ref v ->
  SuperGroup ref v
replaceFunctions :: forall ref v.
(Ord ref, Var v) =>
Map ref ref -> SuperGroup ref v -> SuperGroup ref v
replaceFunctions Map ref ref
reps (Rec [(v, SuperNormal ref v)]
bs SuperNormal ref v
entry) =
  [(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
forall ref v.
[(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
Rec ((SuperNormal ref v -> SuperNormal ref v)
-> (v, SuperNormal ref v) -> (v, SuperNormal ref v)
forall a b. (a -> b) -> (v, a) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperNormal ref v -> SuperNormal ref v
go0 ((v, SuperNormal ref v) -> (v, SuperNormal ref v))
-> [(v, SuperNormal ref v)] -> [(v, SuperNormal ref v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, SuperNormal ref v)]
bs) (SuperNormal ref v -> SuperNormal ref v
go0 SuperNormal ref v
entry)
  where
    go0 :: SuperNormal ref v -> SuperNormal ref v
go0 (Lambda [Mem]
ccs ANormal ref v
body) = [Mem] -> ANormal ref v -> SuperNormal ref v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda [Mem]
ccs (ANormal ref v -> SuperNormal ref v)
-> ANormal ref v -> SuperNormal ref v
forall a b. (a -> b) -> a -> b
$ (ANormal ref v -> Maybe (ANormal ref v))
-> ANormal ref v -> ANormal ref v
forall (f :: * -> * -> *) v.
(Bifoldable f, Traversable (f v), Var v) =>
(Term f v -> Maybe (Term f v)) -> Term f v -> Term f v
ABTN.visitPure ANormal ref v -> Maybe (ANormal ref v)
f ANormal ref v
body

    f :: ANormal ref v -> Maybe (ANormal ref v)
f (TApp (FComb ref
r) [v]
as) =
      ref -> Map ref ref -> Maybe ref
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ref
r Map ref ref
reps Maybe ref -> (ref -> ANormal ref v) -> Maybe (ANormal ref v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ref
r -> Func ref v -> [v] -> ANormal ref v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (ref -> Func ref v
forall ref v. ref -> Func ref v
FComb ref
r) [v]
as
    f ANormal ref v
_ = Maybe (ANormal ref v)
forall a. Maybe a
Nothing

addDefaultCases :: (Var v) => (Monoid a) => Text -> Term v a -> Term v a
addDefaultCases :: forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
 -> Term (F v a a) v a -> Term (F v a a) v a)
-> (Text -> Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Text
-> Term (F v a a) v a
-> Term (F v a a) v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall v a.
(Var v, Monoid a) =>
Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor

defaultCaseVisitor ::
  (Var v) => (Monoid a) => Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor :: forall v a.
(Var v, Monoid a) =>
Text -> Term v a -> Maybe (Term v a)
defaultCaseVisitor Text
func m :: Term v a
m@(Match' Term v a
scrut [MatchCase a (Term v a)]
cases)
  | Term v a
scrut <- Text -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases Text
func Term v a
scrut,
    [MatchCase a (Term v a)]
cases <- (Term v a -> Term v a)
-> MatchCase a (Term v a) -> MatchCase a (Term v a)
forall a b. (a -> b) -> MatchCase a a -> MatchCase a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Term v a -> Term v a
forall v a. (Var v, Monoid a) => Text -> Term v a -> Term v a
addDefaultCases Text
func) (MatchCase a (Term v a) -> MatchCase a (Term v a))
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a (Term v a)]
cases =
      Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just (Term v a -> Maybe (Term v a)) -> Term v a -> Maybe (Term v a)
forall a b. (a -> b) -> a -> b
$ a -> Term v a -> [MatchCase a (Term v a)] -> Term v a
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
match a
a Term v a
scrut ([MatchCase a (Term v a)]
cases [MatchCase a (Term v a)]
-> [MatchCase a (Term v a)] -> [MatchCase a (Term v a)]
forall a. [a] -> [a] -> [a]
++ [MatchCase a (Term v a)
dflt])
  where
    a :: a
a = Term v a -> a
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v a
m
    v :: v
v = Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
forall a. Monoid a => a
mempty (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.Blank
    txt :: Text
txt = Text
"pattern match failure in function `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
func Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
    msg :: Term v a
msg = a -> Text -> Term v a
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text a
a Text
txt
    bu :: Term v a
bu = a -> TypeReference -> Term v a
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
ref a
a (Text -> TypeReference
forall t h. t -> Reference' t h
Builtin Text
"bug")
    dflt :: MatchCase a (Term v a)
dflt =
      Pattern a -> Maybe (Term v a) -> Term v a -> MatchCase a (Term v a)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
MatchCase (a -> Pattern a
forall loc. loc -> Pattern loc
P.Var a
a) Maybe (Term v a)
forall a. Maybe a
Nothing
        (Term v a -> MatchCase a (Term v a))
-> (Term v a -> Term v a) -> Term v a -> MatchCase a (Term v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v -> Term v a -> Term v a
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' a
a v
v
        (Term v a -> MatchCase a (Term v a))
-> Term v a -> MatchCase a (Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> [(a, Term v a)] -> Term v a
forall v vt at ap a.
Ord v =>
Term2 vt at ap v a
-> [(a, Term2 vt at ap v a)] -> Term2 vt at ap v a
apps Term v a
bu [(a
a, [Term v a] -> Term v a
forall v a vt at ap.
(Var v, Monoid a) =>
[Term2 vt at ap v a] -> Term2 vt at ap v a
Ty.tupleTerm [Term v a
msg, a -> v -> Term v a
forall a v vt at ap. a -> v -> Term2 vt at ap v a
var a
a v
v])]
defaultCaseVisitor Text
_ Term v a
_ = Maybe (Term v a)
forall a. Maybe a
Nothing

inlineAlias :: (Var v) => (Monoid a) => Term v a -> Term v a
inlineAlias :: forall v a. (Var v, Monoid a) => Term v a -> Term v a
inlineAlias = (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
(Term f v a -> Maybe (Term f v a)) -> Term f v a -> Term f v a
ABT.visitPure ((Term (F v a a) v a -> Maybe (Term (F v a a) v a))
 -> Term (F v a a) v a -> Term (F v a a) v a)
-> (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a
-> Term (F v a a) v a
forall a b. (a -> b) -> a -> b
$ \case
  Let1Named' v
v b :: Term (F v a a) v a
b@(Var' v
_) Term (F v a a) v a
e -> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a. a -> Maybe a
Just (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> (Term (F v a a) v a -> Term (F v a a) v a)
-> Term (F v a a) v a
-> Maybe (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term (F v a a) v a -> Term (F v a a) v a
forall v a. (Var v, Monoid a) => Term v a -> Term v a
inlineAlias (Term (F v a a) v a -> Maybe (Term (F v a a) v a))
-> Term (F v a a) v a -> Maybe (Term (F v a a) v a)
forall a b. (a -> b) -> a -> b
$ v -> Term (F v a a) v a -> Term (F v a a) v a -> Term (F v a a) v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
v -> Term f v a -> Term f v a -> Term f v a
ABT.subst v
v Term (F v a a) v a
b Term (F v a a) v a
e
  Term (F v a a) v a
_ -> Maybe (Term (F v a a) v a)
forall a. Maybe a
Nothing

minimizeCyclesOrCrash :: (Var v, Ord a) => Term v a -> Term v a
minimizeCyclesOrCrash :: forall v a. (Var v, Ord a) => Term v a -> Term v a
minimizeCyclesOrCrash Term v a
t = case Term v a -> Either (NonEmpty (v, NESet a)) (Term v a)
forall v a vt.
(Var v, Ord a) =>
Term' vt v a -> Either (NonEmpty (v, NESet a)) (Term' vt v a)
minimize' Term v a
t of
  Right Term v a
t -> Term v a
t
  Left NonEmpty (v, NESet a)
e ->
    [Word] -> String -> Term v a
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String -> Term v a) -> String -> Term v a
forall a b. (a -> b) -> a -> b
$
      String
"tried to minimize let rec with duplicate definitions: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [v] -> String
forall a. Show a => a -> String
show ((v, NESet a) -> v
forall a b. (a, b) -> a
fst ((v, NESet a) -> v) -> [(v, NESet a)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (v, NESet a) -> [(v, NESet a)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (v, NESet a)
e)

data Mem = UN | BX deriving (Mem -> Mem -> Bool
(Mem -> Mem -> Bool) -> (Mem -> Mem -> Bool) -> Eq Mem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mem -> Mem -> Bool
== :: Mem -> Mem -> Bool
$c/= :: Mem -> Mem -> Bool
/= :: Mem -> Mem -> Bool
Eq, Eq Mem
Eq Mem =>
(Mem -> Mem -> Ordering)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Bool)
-> (Mem -> Mem -> Mem)
-> (Mem -> Mem -> Mem)
-> Ord Mem
Mem -> Mem -> Bool
Mem -> Mem -> Ordering
Mem -> Mem -> Mem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Mem -> Mem -> Ordering
compare :: Mem -> Mem -> Ordering
$c< :: Mem -> Mem -> Bool
< :: Mem -> Mem -> Bool
$c<= :: Mem -> Mem -> Bool
<= :: Mem -> Mem -> Bool
$c> :: Mem -> Mem -> Bool
> :: Mem -> Mem -> Bool
$c>= :: Mem -> Mem -> Bool
>= :: Mem -> Mem -> Bool
$cmax :: Mem -> Mem -> Mem
max :: Mem -> Mem -> Mem
$cmin :: Mem -> Mem -> Mem
min :: Mem -> Mem -> Mem
Ord, Int -> Mem -> ShowS
[Mem] -> ShowS
Mem -> String
(Int -> Mem -> ShowS)
-> (Mem -> String) -> ([Mem] -> ShowS) -> Show Mem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mem -> ShowS
showsPrec :: Int -> Mem -> ShowS
$cshow :: Mem -> String
show :: Mem -> String
$cshowList :: [Mem] -> ShowS
showList :: [Mem] -> ShowS
Show, Int -> Mem
Mem -> Int
Mem -> [Mem]
Mem -> Mem
Mem -> Mem -> [Mem]
Mem -> Mem -> Mem -> [Mem]
(Mem -> Mem)
-> (Mem -> Mem)
-> (Int -> Mem)
-> (Mem -> Int)
-> (Mem -> [Mem])
-> (Mem -> Mem -> [Mem])
-> (Mem -> Mem -> [Mem])
-> (Mem -> Mem -> Mem -> [Mem])
-> Enum Mem
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Mem -> Mem
succ :: Mem -> Mem
$cpred :: Mem -> Mem
pred :: Mem -> Mem
$ctoEnum :: Int -> Mem
toEnum :: Int -> Mem
$cfromEnum :: Mem -> Int
fromEnum :: Mem -> Int
$cenumFrom :: Mem -> [Mem]
enumFrom :: Mem -> [Mem]
$cenumFromThen :: Mem -> Mem -> [Mem]
enumFromThen :: Mem -> Mem -> [Mem]
$cenumFromTo :: Mem -> Mem -> [Mem]
enumFromTo :: Mem -> Mem -> [Mem]
$cenumFromThenTo :: Mem -> Mem -> Mem -> [Mem]
enumFromThenTo :: Mem -> Mem -> Mem -> [Mem]
Enum)

-- Context entries with evaluation strategy
data CTE v s
  = ST (Direction Word16) [v] [Mem] s
  | LZ v (Either Reference v) [v]
  deriving (Int -> CTE v s -> ShowS
[CTE v s] -> ShowS
CTE v s -> String
(Int -> CTE v s -> ShowS)
-> (CTE v s -> String) -> ([CTE v s] -> ShowS) -> Show (CTE v s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v s. (Show s, Show v) => Int -> CTE v s -> ShowS
forall v s. (Show s, Show v) => [CTE v s] -> ShowS
forall v s. (Show s, Show v) => CTE v s -> String
$cshowsPrec :: forall v s. (Show s, Show v) => Int -> CTE v s -> ShowS
showsPrec :: Int -> CTE v s -> ShowS
$cshow :: forall v s. (Show s, Show v) => CTE v s -> String
show :: CTE v s -> String
$cshowList :: forall v s. (Show s, Show v) => [CTE v s] -> ShowS
showList :: [CTE v s] -> ShowS
Show)

pattern ST1 :: Direction Word16 -> v -> Mem -> s -> CTE v s
pattern $mST1 :: forall {r} {v} {s}.
CTE v s
-> (Direction Word16 -> v -> Mem -> s -> r) -> ((# #) -> r) -> r
$bST1 :: forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 d v m s = ST d [v] [m] s

-- All variables, both bound and free occurring in a CTE. This is
-- useful for avoiding both free and bound variables when
-- freshening.
cteVars :: (Ord v) => Cte v -> Set v
cteVars :: forall v. Ord v => Cte v -> Set v
cteVars (ST Direction Word16
_ [v]
vs [Mem]
_ ANormal TypeReference v
e) = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` ANormal TypeReference v -> Set v
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars ANormal TypeReference v
e
cteVars (LZ v
v Either TypeReference v
r [v]
as) = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ((TypeReference -> [v] -> [v])
-> (v -> [v] -> [v]) -> Either TypeReference v -> [v] -> [v]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([v] -> [v]) -> TypeReference -> [v] -> [v]
forall a b. a -> b -> a
const [v] -> [v]
forall a. a -> a
id) (:) Either TypeReference v
r ([v] -> [v]) -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
as)

data ANormalF ref v e
  = ALet (Direction Word16) [Mem] e e
  | AName (Either ref v) [v] e
  | ALit (Lit ref)
  | ABLit (Lit ref) -- direct boxed literal
  | AMatch v (Branched ref e)
  | AShift ref e
  | AHnd [ref] v (Maybe v) e
  | AApp (Func ref v) [v]
  | AFrc v
  | AVar v
  | -- Affine handler support
    ADiscard v
  | ALocal v e
  | -- Boolean indicates whether there are indirect calls afterward
    AUpdate Bool v v
  deriving (Int -> ANormalF ref v e -> ShowS
[ANormalF ref v e] -> ShowS
ANormalF ref v e -> String
(Int -> ANormalF ref v e -> ShowS)
-> (ANormalF ref v e -> String)
-> ([ANormalF ref v e] -> ShowS)
-> Show (ANormalF ref v e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ref v e.
(Show ref, Show e, Show v) =>
Int -> ANormalF ref v e -> ShowS
forall ref v e.
(Show ref, Show e, Show v) =>
[ANormalF ref v e] -> ShowS
forall ref v e.
(Show ref, Show e, Show v) =>
ANormalF ref v e -> String
$cshowsPrec :: forall ref v e.
(Show ref, Show e, Show v) =>
Int -> ANormalF ref v e -> ShowS
showsPrec :: Int -> ANormalF ref v e -> ShowS
$cshow :: forall ref v e.
(Show ref, Show e, Show v) =>
ANormalF ref v e -> String
show :: ANormalF ref v e -> String
$cshowList :: forall ref v e.
(Show ref, Show e, Show v) =>
[ANormalF ref v e] -> ShowS
showList :: [ANormalF ref v e] -> ShowS
Show, ANormalF ref v e -> ANormalF ref v e -> Bool
(ANormalF ref v e -> ANormalF ref v e -> Bool)
-> (ANormalF ref v e -> ANormalF ref v e -> Bool)
-> Eq (ANormalF ref v e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ref v e.
(Eq ref, Eq e, Eq v) =>
ANormalF ref v e -> ANormalF ref v e -> Bool
$c== :: forall ref v e.
(Eq ref, Eq e, Eq v) =>
ANormalF ref v e -> ANormalF ref v e -> Bool
== :: ANormalF ref v e -> ANormalF ref v e -> Bool
$c/= :: forall ref v e.
(Eq ref, Eq e, Eq v) =>
ANormalF ref v e -> ANormalF ref v e -> Bool
/= :: ANormalF ref v e -> ANormalF ref v e -> Bool
Eq, (forall a b. (a -> b) -> ANormalF ref v a -> ANormalF ref v b)
-> (forall a b. a -> ANormalF ref v b -> ANormalF ref v a)
-> Functor (ANormalF ref v)
forall a b. a -> ANormalF ref v b -> ANormalF ref v a
forall a b. (a -> b) -> ANormalF ref v a -> ANormalF ref v b
forall ref v a b. a -> ANormalF ref v b -> ANormalF ref v a
forall ref v a b. (a -> b) -> ANormalF ref v a -> ANormalF ref v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ref v a b. (a -> b) -> ANormalF ref v a -> ANormalF ref v b
fmap :: forall a b. (a -> b) -> ANormalF ref v a -> ANormalF ref v b
$c<$ :: forall ref v a b. a -> ANormalF ref v b -> ANormalF ref v a
<$ :: forall a b. a -> ANormalF ref v b -> ANormalF ref v a
Functor, (forall m. Monoid m => ANormalF ref v m -> m)
-> (forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m)
-> (forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m)
-> (forall a b. (a -> b -> b) -> b -> ANormalF ref v a -> b)
-> (forall a b. (a -> b -> b) -> b -> ANormalF ref v a -> b)
-> (forall b a. (b -> a -> b) -> b -> ANormalF ref v a -> b)
-> (forall b a. (b -> a -> b) -> b -> ANormalF ref v a -> b)
-> (forall a. (a -> a -> a) -> ANormalF ref v a -> a)
-> (forall a. (a -> a -> a) -> ANormalF ref v a -> a)
-> (forall a. ANormalF ref v a -> [a])
-> (forall a. ANormalF ref v a -> Bool)
-> (forall a. ANormalF ref v a -> Int)
-> (forall a. Eq a => a -> ANormalF ref v a -> Bool)
-> (forall a. Ord a => ANormalF ref v a -> a)
-> (forall a. Ord a => ANormalF ref v a -> a)
-> (forall a. Num a => ANormalF ref v a -> a)
-> (forall a. Num a => ANormalF ref v a -> a)
-> Foldable (ANormalF ref v)
forall a. Eq a => a -> ANormalF ref v a -> Bool
forall a. Num a => ANormalF ref v a -> a
forall a. Ord a => ANormalF ref v a -> a
forall m. Monoid m => ANormalF ref v m -> m
forall a. ANormalF ref v a -> Bool
forall a. ANormalF ref v a -> Int
forall a. ANormalF ref v a -> [a]
forall a. (a -> a -> a) -> ANormalF ref v a -> a
forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
forall b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
forall a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
forall ref v a. Eq a => a -> ANormalF ref v a -> Bool
forall ref v a. Num a => ANormalF ref v a -> a
forall ref v a. Ord a => ANormalF ref v a -> a
forall ref v m. Monoid m => ANormalF ref v m -> m
forall ref v a. ANormalF ref v a -> Bool
forall ref v a. ANormalF ref v a -> Int
forall ref v a. ANormalF ref v a -> [a]
forall ref v a. (a -> a -> a) -> ANormalF ref v a -> a
forall ref v m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
forall ref v b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
forall ref v a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall ref v m. Monoid m => ANormalF ref v m -> m
fold :: forall m. Monoid m => ANormalF ref v m -> m
$cfoldMap :: forall ref v m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
$cfoldMap' :: forall ref v m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
$cfoldr :: forall ref v a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
$cfoldr' :: forall ref v a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ANormalF ref v a -> b
$cfoldl :: forall ref v b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
$cfoldl' :: forall ref v b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ANormalF ref v a -> b
$cfoldr1 :: forall ref v a. (a -> a -> a) -> ANormalF ref v a -> a
foldr1 :: forall a. (a -> a -> a) -> ANormalF ref v a -> a
$cfoldl1 :: forall ref v a. (a -> a -> a) -> ANormalF ref v a -> a
foldl1 :: forall a. (a -> a -> a) -> ANormalF ref v a -> a
$ctoList :: forall ref v a. ANormalF ref v a -> [a]
toList :: forall a. ANormalF ref v a -> [a]
$cnull :: forall ref v a. ANormalF ref v a -> Bool
null :: forall a. ANormalF ref v a -> Bool
$clength :: forall ref v a. ANormalF ref v a -> Int
length :: forall a. ANormalF ref v a -> Int
$celem :: forall ref v a. Eq a => a -> ANormalF ref v a -> Bool
elem :: forall a. Eq a => a -> ANormalF ref v a -> Bool
$cmaximum :: forall ref v a. Ord a => ANormalF ref v a -> a
maximum :: forall a. Ord a => ANormalF ref v a -> a
$cminimum :: forall ref v a. Ord a => ANormalF ref v a -> a
minimum :: forall a. Ord a => ANormalF ref v a -> a
$csum :: forall ref v a. Num a => ANormalF ref v a -> a
sum :: forall a. Num a => ANormalF ref v a -> a
$cproduct :: forall ref v a. Num a => ANormalF ref v a -> a
product :: forall a. Num a => ANormalF ref v a -> a
Foldable, Functor (ANormalF ref v)
Foldable (ANormalF ref v)
(Functor (ANormalF ref v), Foldable (ANormalF ref v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ANormalF ref v a -> f (ANormalF ref v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ANormalF ref v (f a) -> f (ANormalF ref v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ANormalF ref v a -> m (ANormalF ref v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ANormalF ref v (m a) -> m (ANormalF ref v a))
-> Traversable (ANormalF ref v)
forall ref v. Functor (ANormalF ref v)
forall ref v. Foldable (ANormalF ref v)
forall ref v (m :: * -> *) a.
Monad m =>
ANormalF ref v (m a) -> m (ANormalF ref v a)
forall ref v (f :: * -> *) a.
Applicative f =>
ANormalF ref v (f a) -> f (ANormalF ref v a)
forall ref v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ANormalF ref v a -> m (ANormalF ref v b)
forall ref v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ANormalF ref v a -> f (ANormalF ref v b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ANormalF ref v (m a) -> m (ANormalF ref v a)
forall (f :: * -> *) a.
Applicative f =>
ANormalF ref v (f a) -> f (ANormalF ref v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ANormalF ref v a -> m (ANormalF ref v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ANormalF ref v a -> f (ANormalF ref v b)
$ctraverse :: forall ref v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ANormalF ref v a -> f (ANormalF ref v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ANormalF ref v a -> f (ANormalF ref v b)
$csequenceA :: forall ref v (f :: * -> *) a.
Applicative f =>
ANormalF ref v (f a) -> f (ANormalF ref v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ANormalF ref v (f a) -> f (ANormalF ref v a)
$cmapM :: forall ref v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ANormalF ref v a -> m (ANormalF ref v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ANormalF ref v a -> m (ANormalF ref v b)
$csequence :: forall ref v (m :: * -> *) a.
Monad m =>
ANormalF ref v (m a) -> m (ANormalF ref v a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ANormalF ref v (m a) -> m (ANormalF ref v a)
Traversable)

instance Bifunctor (ANormalF ref) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> ANormalF ref a c -> ANormalF ref b d
bimap a -> b
f c -> d
_ (AVar a
v) = b -> ANormalF ref b d
forall ref v e. v -> ANormalF ref v e
AVar (a -> b
f a
v)
  bimap a -> b
_ c -> d
_ (ALit Lit ref
l) = Lit ref -> ANormalF ref b d
forall ref v e. Lit ref -> ANormalF ref v e
ALit Lit ref
l
  bimap a -> b
_ c -> d
_ (ABLit Lit ref
l) = Lit ref -> ANormalF ref b d
forall ref v e. Lit ref -> ANormalF ref v e
ABLit Lit ref
l
  bimap a -> b
_ c -> d
g (ALet Direction Word16
d [Mem]
m c
bn c
bo) = Direction Word16 -> [Mem] -> d -> d -> ANormalF ref b d
forall ref v e.
Direction Word16 -> [Mem] -> e -> e -> ANormalF ref v e
ALet Direction Word16
d [Mem]
m (c -> d
g c
bn) (c -> d
g c
bo)
  bimap a -> b
f c -> d
g (AName Either ref a
n [a]
as c
bo) = Either ref b -> [b] -> d -> ANormalF ref b d
forall ref v e. Either ref v -> [v] -> e -> ANormalF ref v e
AName (a -> b
f (a -> b) -> Either ref a -> Either ref b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ref a
n) (a -> b
f (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as) (d -> ANormalF ref b d) -> d -> ANormalF ref b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
bo
  bimap a -> b
f c -> d
g (AMatch a
v Branched ref c
br) = b -> Branched ref d -> ANormalF ref b d
forall ref v e. v -> Branched ref e -> ANormalF ref v e
AMatch (a -> b
f a
v) (Branched ref d -> ANormalF ref b d)
-> Branched ref d -> ANormalF ref b d
forall a b. (a -> b) -> a -> b
$ (c -> d) -> Branched ref c -> Branched ref d
forall a b. (a -> b) -> Branched ref a -> Branched ref b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g Branched ref c
br
  bimap a -> b
f c -> d
g (AHnd [ref]
rs a
nh Maybe a
ah c
e) = [ref] -> b -> Maybe b -> d -> ANormalF ref b d
forall ref v e. [ref] -> v -> Maybe v -> e -> ANormalF ref v e
AHnd [ref]
rs (a -> b
f a
nh) ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
ah) (d -> ANormalF ref b d) -> d -> ANormalF ref b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
e
  bimap a -> b
_ c -> d
g (AShift ref
i c
e) = ref -> d -> ANormalF ref b d
forall ref v e. ref -> e -> ANormalF ref v e
AShift ref
i (d -> ANormalF ref b d) -> d -> ANormalF ref b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
e
  bimap a -> b
f c -> d
_ (AFrc a
v) = b -> ANormalF ref b d
forall ref v e. v -> ANormalF ref v e
AFrc (a -> b
f a
v)
  bimap a -> b
f c -> d
_ (AApp Func ref a
fu [a]
args) = Func ref b -> [b] -> ANormalF ref b d
forall ref v e. Func ref v -> [v] -> ANormalF ref v e
AApp ((a -> b) -> Func ref a -> Func ref b
forall a b. (a -> b) -> Func ref a -> Func ref b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Func ref a
fu) ([b] -> ANormalF ref b d) -> [b] -> ANormalF ref b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
args
  bimap a -> b
f c -> d
_ (ADiscard a
v) = b -> ANormalF ref b d
forall ref v e. v -> ANormalF ref v e
ADiscard (a -> b
f a
v)
  bimap a -> b
f c -> d
g (ALocal a
v c
bo) = b -> d -> ANormalF ref b d
forall ref v e. v -> e -> ANormalF ref v e
ALocal (a -> b
f a
v) (c -> d
g c
bo)
  bimap a -> b
f c -> d
_ (AUpdate Bool
b a
r a
v) = Bool -> b -> b -> ANormalF ref b d
forall ref v e. Bool -> v -> v -> ANormalF ref v e
AUpdate Bool
b (a -> b
f a
r) (a -> b
f a
v)

instance Bifoldable (ANormalF ref) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> ANormalF ref a b -> m
bifoldMap a -> m
f b -> m
_ (AVar a
v) = a -> m
f a
v
  bifoldMap a -> m
_ b -> m
_ (ALit Lit ref
_) = m
forall a. Monoid a => a
mempty
  bifoldMap a -> m
_ b -> m
_ (ABLit Lit ref
_) = m
forall a. Monoid a => a
mempty
  bifoldMap a -> m
_ b -> m
g (ALet Direction Word16
_ [Mem]
_ b
b b
e) = b -> m
g b
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
  bifoldMap a -> m
f b -> m
g (AName Either ref a
n [a]
as b
e) = (a -> m) -> Either ref a -> m
forall m a. Monoid m => (a -> m) -> Either ref a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Either ref a
n m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
as m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
  bifoldMap a -> m
f b -> m
g (AMatch a
v Branched ref b
br) = a -> m
f a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (b -> m) -> Branched ref b -> m
forall m a. Monoid m => (a -> m) -> Branched ref a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g Branched ref b
br
  bifoldMap a -> m
f b -> m
g (AHnd [ref]
_ a
nh Maybe a
ah b
e) = a -> m
f a
nh m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Maybe a -> m
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Maybe a
ah m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
e
  bifoldMap a -> m
_ b -> m
g (AShift ref
_ b
e) = b -> m
g b
e
  bifoldMap a -> m
f b -> m
_ (AFrc a
v) = a -> m
f a
v
  bifoldMap a -> m
f b -> m
_ (AApp Func ref a
func [a]
args) = (a -> m) -> Func ref a -> m
forall m a. Monoid m => (a -> m) -> Func ref a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Func ref a
func m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
args
  bifoldMap a -> m
f b -> m
_ (ADiscard a
v) = a -> m
f a
v
  bifoldMap a -> m
f b -> m
g (ALocal a
v b
bo) = a -> m
f a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
bo
  bifoldMap a -> m
f b -> m
_ (AUpdate Bool
_ a
r a
v) = a -> m
f a
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
v

instance (Ord ref) => ABTN.Align (ANormalF ref) where
  align :: forall (g :: * -> *) vl vr vs el er es.
Applicative g =>
(vl -> vr -> g vs)
-> (el -> er -> g es)
-> ANormalF ref vl el
-> ANormalF ref vr er
-> Maybe (g (ANormalF ref vs es))
align vl -> vr -> g vs
f el -> er -> g es
_ (AVar vl
u) (AVar vr
v) = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ vs -> ANormalF ref vs es
forall ref v e. v -> ANormalF ref v e
AVar (vs -> ANormalF ref vs es) -> g vs -> g (ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v
  align vl -> vr -> g vs
_ el -> er -> g es
_ (ALit Lit ref
l) (ALit Lit ref
r)
    | Lit ref
l Lit ref -> Lit ref -> Bool
forall a. Eq a => a -> a -> Bool
== Lit ref
r = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ ANormalF ref vs es -> g (ANormalF ref vs es)
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref -> ANormalF ref vs es
forall ref v e. Lit ref -> ANormalF ref v e
ALit Lit ref
l)
  align vl -> vr -> g vs
_ el -> er -> g es
_ (ABLit Lit ref
l) (ABLit Lit ref
r)
    | Lit ref
l Lit ref -> Lit ref -> Bool
forall a. Eq a => a -> a -> Bool
== Lit ref
r = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ ANormalF ref vs es -> g (ANormalF ref vs es)
forall a. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref -> ANormalF ref vs es
forall ref v e. Lit ref -> ANormalF ref v e
ABLit Lit ref
l)
  align vl -> vr -> g vs
_ el -> er -> g es
g (ALet Direction Word16
dl [Mem]
ccl el
bl el
el) (ALet Direction Word16
dr [Mem]
ccr er
br er
er)
    | Direction Word16
dl Direction Word16 -> Direction Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Direction Word16
dr,
      [Mem]
ccl [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== [Mem]
ccr =
        g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ Direction Word16 -> [Mem] -> es -> es -> ANormalF ref vs es
forall ref v e.
Direction Word16 -> [Mem] -> e -> e -> ANormalF ref v e
ALet Direction Word16
dl [Mem]
ccl (es -> es -> ANormalF ref vs es)
-> g es -> g (es -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> el -> er -> g es
g el
bl er
br g (es -> ANormalF ref vs es) -> g es -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
el er
er
  align vl -> vr -> g vs
f el -> er -> g es
g (AName Either ref vl
hl [vl]
asl el
el) (AName Either ref vr
hr [vr]
asr er
er)
    | [vl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vl]
asl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [vr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vr]
asr,
      Just g (Either ref vs)
hs <- (vl -> vr -> g vs)
-> Either ref vl -> Either ref vr -> Maybe (g (Either ref vs))
forall ref (f :: * -> *) l r s.
(Eq ref, Applicative f) =>
(l -> r -> f s)
-> Either ref l -> Either ref r -> Maybe (f (Either ref s))
alignEither vl -> vr -> g vs
f Either ref vl
hl Either ref vr
hr =
        g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$
          Either ref vs -> [vs] -> es -> ANormalF ref vs es
forall ref v e. Either ref v -> [v] -> e -> ANormalF ref v e
AName
            (Either ref vs -> [vs] -> es -> ANormalF ref vs es)
-> g (Either ref vs) -> g ([vs] -> es -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Either ref vs)
hs
            g ([vs] -> es -> ANormalF ref vs es)
-> g [vs] -> g (es -> ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((vl, vr) -> g vs) -> [(vl, vr)] -> g [vs]
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 ((vl -> vr -> g vs) -> (vl, vr) -> g vs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry vl -> vr -> g vs
f) ([vl] -> [vr] -> [(vl, vr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [vl]
asl [vr]
asr)
            g (es -> ANormalF ref vs es) -> g es -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
el er
er
  align vl -> vr -> g vs
f el -> er -> g es
g (AMatch vl
vl Branched ref el
bsl) (AMatch vr
vr Branched ref er
bsr)
    | Just g (Branched ref es)
bss <- (el -> er -> g es)
-> Branched ref el
-> Branched ref er
-> Maybe (g (Branched ref es))
forall ref (f :: * -> *) el er es.
(Ord ref, Applicative f) =>
(el -> er -> f es)
-> Branched ref el
-> Branched ref er
-> Maybe (f (Branched ref es))
alignBranch el -> er -> g es
g Branched ref el
bsl Branched ref er
bsr =
        g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ vs -> Branched ref es -> ANormalF ref vs es
forall ref v e. v -> Branched ref e -> ANormalF ref v e
AMatch (vs -> Branched ref es -> ANormalF ref vs es)
-> g vs -> g (Branched ref es -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
vl vr
vr g (Branched ref es -> ANormalF ref vs es)
-> g (Branched ref es) -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g (Branched ref es)
bss
  align vl -> vr -> g vs
f el -> er -> g es
g (AHnd [ref]
rl vl
nhl Maybe vl
ahl el
bl) (AHnd [ref]
rr vr
nhr Maybe vr
ahr er
br)
    | [ref]
rl [ref] -> [ref] -> Bool
forall a. Eq a => a -> a -> Bool
== [ref]
rr,
      Just g (Maybe vs)
ah <- (vl -> vr -> g vs) -> Maybe vl -> Maybe vr -> Maybe (g (Maybe vs))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe vl -> vr -> g vs
f Maybe vl
ahl Maybe vr
ahr =
        g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ [ref] -> vs -> Maybe vs -> es -> ANormalF ref vs es
forall ref v e. [ref] -> v -> Maybe v -> e -> ANormalF ref v e
AHnd [ref]
rl (vs -> Maybe vs -> es -> ANormalF ref vs es)
-> g vs -> g (Maybe vs -> es -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
nhl vr
nhr g (Maybe vs -> es -> ANormalF ref vs es)
-> g (Maybe vs) -> g (es -> ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g (Maybe vs)
ah g (es -> ANormalF ref vs es) -> g es -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
bl er
br
  align vl -> vr -> g vs
_ el -> er -> g es
g (AShift ref
rl el
bl) (AShift ref
rr er
br)
    | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ ref -> es -> ANormalF ref vs es
forall ref v e. ref -> e -> ANormalF ref v e
AShift ref
rl (es -> ANormalF ref vs es) -> g es -> g (ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> el -> er -> g es
g el
bl er
br
  align vl -> vr -> g vs
f el -> er -> g es
_ (AFrc vl
u) (AFrc vr
v) = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ vs -> ANormalF ref vs es
forall ref v e. v -> ANormalF ref v e
AFrc (vs -> ANormalF ref vs es) -> g vs -> g (ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v
  align vl -> vr -> g vs
f el -> er -> g es
_ (AApp Func ref vl
hl [vl]
asl) (AApp Func ref vr
hr [vr]
asr)
    | Just g (Func ref vs)
hs <- (vl -> vr -> g vs)
-> Func ref vl -> Func ref vr -> Maybe (g (Func ref vs))
forall ref (f :: * -> *) vl vr vs.
(Eq ref, Applicative f) =>
(vl -> vr -> f vs)
-> Func ref vl -> Func ref vr -> Maybe (f (Func ref vs))
alignFunc vl -> vr -> g vs
f Func ref vl
hl Func ref vr
hr,
      [vl] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vl]
asl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [vr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [vr]
asr =
        g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ Func ref vs -> [vs] -> ANormalF ref vs es
forall ref v e. Func ref v -> [v] -> ANormalF ref v e
AApp (Func ref vs -> [vs] -> ANormalF ref vs es)
-> g (Func ref vs) -> g ([vs] -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (Func ref vs)
hs g ([vs] -> ANormalF ref vs es) -> g [vs] -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((vl, vr) -> g vs) -> [(vl, vr)] -> g [vs]
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 ((vl -> vr -> g vs) -> (vl, vr) -> g vs
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry vl -> vr -> g vs
f) ([vl] -> [vr] -> [(vl, vr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [vl]
asl [vr]
asr)
  align vl -> vr -> g vs
f el -> er -> g es
_ (ADiscard vl
u) (ADiscard vr
v) = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ vs -> ANormalF ref vs es
forall ref v e. v -> ANormalF ref v e
ADiscard (vs -> ANormalF ref vs es) -> g vs -> g (ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v
  align vl -> vr -> g vs
f el -> er -> g es
g (ALocal vl
u el
bl) (ALocal vr
v er
br) =
    g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ vs -> es -> ANormalF ref vs es
forall ref v e. v -> e -> ANormalF ref v e
ALocal (vs -> es -> ANormalF ref vs es)
-> g vs -> g (es -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
u vr
v g (es -> ANormalF ref vs es) -> g es -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> g es
g el
bl er
br
  align vl -> vr -> g vs
f el -> er -> g es
_ (AUpdate Bool
b vl
r vl
u) (AUpdate Bool
c vr
s vr
v)
    | Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
c = g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a. a -> Maybe a
Just (g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es)))
-> g (ANormalF ref vs es) -> Maybe (g (ANormalF ref vs es))
forall a b. (a -> b) -> a -> b
$ Bool -> vs -> vs -> ANormalF ref vs es
forall ref v e. Bool -> v -> v -> ANormalF ref v e
AUpdate Bool
b (vs -> vs -> ANormalF ref vs es)
-> g vs -> g (vs -> ANormalF ref vs es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> g vs
f vl
r vr
s g (vs -> ANormalF ref vs es) -> g vs -> g (ANormalF ref vs es)
forall a b. g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> vl -> vr -> g vs
f vl
u vr
v
  align vl -> vr -> g vs
_ el -> er -> g es
_ ANormalF ref vl el
_ ANormalF ref vr er
_ = Maybe (g (ANormalF ref vs es))
forall a. Maybe a
Nothing

alignEither ::
  (Eq ref, Applicative f) =>
  (l -> r -> f s) ->
  Either ref l ->
  Either ref r ->
  Maybe (f (Either ref s))
alignEither :: forall ref (f :: * -> *) l r s.
(Eq ref, Applicative f) =>
(l -> r -> f s)
-> Either ref l -> Either ref r -> Maybe (f (Either ref s))
alignEither l -> r -> f s
_ (Left ref
rl) (Left ref
rr) | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr = f (Either ref s) -> Maybe (f (Either ref s))
forall a. a -> Maybe a
Just (f (Either ref s) -> Maybe (f (Either ref s)))
-> (Either ref s -> f (Either ref s))
-> Either ref s
-> Maybe (f (Either ref s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ref s -> f (Either ref s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ref s -> Maybe (f (Either ref s)))
-> Either ref s -> Maybe (f (Either ref s))
forall a b. (a -> b) -> a -> b
$ ref -> Either ref s
forall a b. a -> Either a b
Left ref
rl
alignEither l -> r -> f s
f (Right l
u) (Right r
v) = f (Either ref s) -> Maybe (f (Either ref s))
forall a. a -> Maybe a
Just (f (Either ref s) -> Maybe (f (Either ref s)))
-> f (Either ref s) -> Maybe (f (Either ref s))
forall a b. (a -> b) -> a -> b
$ s -> Either ref s
forall a b. b -> Either a b
Right (s -> Either ref s) -> f s -> f (Either ref s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
u r
v
alignEither l -> r -> f s
_ Either ref l
_ Either ref r
_ = Maybe (f (Either ref s))
forall a. Maybe a
Nothing

alignMaybe ::
  (Applicative f) =>
  (l -> r -> f s) ->
  Maybe l ->
  Maybe r ->
  Maybe (f (Maybe s))
alignMaybe :: forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe l -> r -> f s
f (Just l
l) (Just r
r) = f (Maybe s) -> Maybe (f (Maybe s))
forall a. a -> Maybe a
Just (f (Maybe s) -> Maybe (f (Maybe s)))
-> f (Maybe s) -> Maybe (f (Maybe s))
forall a b. (a -> b) -> a -> b
$ s -> Maybe s
forall a. a -> Maybe a
Just (s -> Maybe s) -> f s -> f (Maybe s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
l r
r
alignMaybe l -> r -> f s
_ Maybe l
Nothing Maybe r
Nothing = f (Maybe s) -> Maybe (f (Maybe s))
forall a. a -> Maybe a
Just (Maybe s -> f (Maybe s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe s
forall a. Maybe a
Nothing)
alignMaybe l -> r -> f s
_ Maybe l
_ Maybe r
_ = Maybe (f (Maybe s))
forall a. Maybe a
Nothing

alignFunc ::
  (Eq ref, Applicative f) =>
  (vl -> vr -> f vs) ->
  Func ref vl ->
  Func ref vr ->
  Maybe (f (Func ref vs))
alignFunc :: forall ref (f :: * -> *) vl vr vs.
(Eq ref, Applicative f) =>
(vl -> vr -> f vs)
-> Func ref vl -> Func ref vr -> Maybe (f (Func ref vs))
alignFunc vl -> vr -> f vs
f (FVar vl
u) (FVar vr
v) = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> f (Func ref vs) -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ vs -> Func ref vs
forall ref v. v -> Func ref v
FVar (vs -> Func ref vs) -> f vs -> f (Func ref vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> f vs
f vl
u vr
v
alignFunc vl -> vr -> f vs
_ (FComb ref
rl) (FComb ref
rr) | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> (Func ref vs -> f (Func ref vs))
-> Func ref vs
-> Maybe (f (Func ref vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func ref vs -> f (Func ref vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref vs -> Maybe (f (Func ref vs)))
-> Func ref vs -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ ref -> Func ref vs
forall ref v. ref -> Func ref v
FComb ref
rl
alignFunc vl -> vr -> f vs
f (FCont vl
u) (FCont vr
v) = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> f (Func ref vs) -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ vs -> Func ref vs
forall ref v. v -> Func ref v
FCont (vs -> Func ref vs) -> f vs -> f (Func ref vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> vl -> vr -> f vs
f vl
u vr
v
alignFunc vl -> vr -> f vs
_ (FCon ref
rl CTag
tl) (FCon ref
rr CTag
tr)
  | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr, CTag
tl CTag -> CTag -> Bool
forall a. Eq a => a -> a -> Bool
== CTag
tr = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> (Func ref vs -> f (Func ref vs))
-> Func ref vs
-> Maybe (f (Func ref vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func ref vs -> f (Func ref vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref vs -> Maybe (f (Func ref vs)))
-> Func ref vs -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ ref -> CTag -> Func ref vs
forall ref v. ref -> CTag -> Func ref v
FCon ref
rl CTag
tl
alignFunc vl -> vr -> f vs
_ (FReq ref
rl CTag
tl) (FReq ref
rr CTag
tr)
  | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr, CTag
tl CTag -> CTag -> Bool
forall a. Eq a => a -> a -> Bool
== CTag
tr = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> (Func ref vs -> f (Func ref vs))
-> Func ref vs
-> Maybe (f (Func ref vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func ref vs -> f (Func ref vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref vs -> Maybe (f (Func ref vs)))
-> Func ref vs -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ ref -> CTag -> Func ref vs
forall ref v. ref -> CTag -> Func ref v
FReq ref
rl CTag
tl
alignFunc vl -> vr -> f vs
_ (FPrim Either POp ForeignFunc
ol) (FPrim Either POp ForeignFunc
or)
  | Either POp ForeignFunc
ol Either POp ForeignFunc -> Either POp ForeignFunc -> Bool
forall a. Eq a => a -> a -> Bool
== Either POp ForeignFunc
or = f (Func ref vs) -> Maybe (f (Func ref vs))
forall a. a -> Maybe a
Just (f (Func ref vs) -> Maybe (f (Func ref vs)))
-> (Func ref vs -> f (Func ref vs))
-> Func ref vs
-> Maybe (f (Func ref vs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Func ref vs -> f (Func ref vs)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref vs -> Maybe (f (Func ref vs)))
-> Func ref vs -> Maybe (f (Func ref vs))
forall a b. (a -> b) -> a -> b
$ Either POp ForeignFunc -> Func ref vs
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim Either POp ForeignFunc
ol
alignFunc vl -> vr -> f vs
_ Func ref vl
_ Func ref vr
_ = Maybe (f (Func ref vs))
forall a. Maybe a
Nothing

alignBranch ::
  (Ord ref, Applicative f) =>
  (el -> er -> f es) ->
  Branched ref el ->
  Branched ref er ->
  Maybe (f (Branched ref es))
alignBranch :: forall ref (f :: * -> *) el er es.
(Ord ref, Applicative f) =>
(el -> er -> f es)
-> Branched ref el
-> Branched ref er
-> Maybe (f (Branched ref es))
alignBranch el -> er -> f es
_ Branched ref el
MatchEmpty Branched ref er
MatchEmpty = f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$ Branched ref es -> f (Branched ref es)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched ref es
forall ref e. Branched ref e
MatchEmpty
alignBranch el -> er -> f es
f (MatchIntegral EnumMap ConstructorId el
bl Maybe el
dl) (MatchIntegral EnumMap ConstructorId er
br Maybe er
dr)
  | EnumMap ConstructorId el -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId el
bl EnumSet ConstructorId -> EnumSet ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap ConstructorId er -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId er
br,
    Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$
        EnumMap ConstructorId es -> Maybe es -> Branched ref es
forall ref e. EnumMap ConstructorId e -> Maybe e -> Branched ref e
MatchIntegral
          (EnumMap ConstructorId es -> Maybe es -> Branched ref es)
-> f (EnumMap ConstructorId es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap ConstructorId el
-> EnumMap ConstructorId er
-> f (EnumMap ConstructorId es)
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse el -> er -> f es
f EnumMap ConstructorId el
bl EnumMap ConstructorId er
br
          f (Maybe es -> Branched ref es)
-> f (Maybe es) -> f (Branched ref es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchText Map Text el
bl Maybe el
dl) (MatchText Map Text er
br Maybe er
dr)
  | Map Text el -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text el
bl Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text er -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text er
br,
    Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$
        Map Text es -> Maybe es -> Branched ref es
forall ref e. Map Text e -> Maybe e -> Branched ref e
MatchText
          (Map Text es -> Maybe es -> Branched ref es)
-> f (Map Text es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f es -> f es) -> Map Text (f es) -> f (Map Text es)
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) -> Map Text a -> f (Map Text b)
traverse f es -> f es
forall a. a -> a
id ((el -> er -> f es) -> Map Text el -> Map Text er -> Map Text (f es)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith el -> er -> f es
f Map Text el
bl Map Text er
br)
          f (Maybe es -> Branched ref es)
-> f (Maybe es) -> f (Branched ref es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchRequest [(ref, EnumMap CTag ([Mem], el))]
bl el
pl) (MatchRequest [(ref, EnumMap CTag ([Mem], er))]
br er
pr)
  | Just f [(ref, EnumMap CTag ([Mem], es))]
bs <- (EnumMap CTag ([Mem], el)
 -> EnumMap CTag ([Mem], er)
 -> Maybe (f (EnumMap CTag ([Mem], es))))
-> [(ref, EnumMap CTag ([Mem], el))]
-> [(ref, EnumMap CTag ([Mem], er))]
-> Maybe (f [(ref, EnumMap CTag ([Mem], es))])
forall (f :: * -> *) k a b c.
(Applicative f, Ord k) =>
(a -> b -> Maybe (f c))
-> [(k, a)] -> [(k, b)] -> Maybe (f [(k, c)])
alignAscList EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er) -> Maybe (f (EnumMap CTag ([Mem], es)))
h [(ref, EnumMap CTag ([Mem], el))]
bl [(ref, EnumMap CTag ([Mem], er))]
br =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$ [(ref, EnumMap CTag ([Mem], es))] -> es -> Branched ref es
forall ref e.
[(ref, EnumMap CTag ([Mem], e))] -> e -> Branched ref e
MatchRequest ([(ref, EnumMap CTag ([Mem], es))] -> es -> Branched ref es)
-> f [(ref, EnumMap CTag ([Mem], es))] -> f (es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ref, EnumMap CTag ([Mem], es))]
bs f (es -> Branched ref es) -> f es -> f (Branched ref es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> el -> er -> f es
f el
pl er
pr
  where
    h :: EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er) -> Maybe (f (EnumMap CTag ([Mem], es)))
h EnumMap CTag ([Mem], el)
csl EnumMap CTag ([Mem], er)
csr
      | EnumMap CTag ([Mem], el) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], el)
csl EnumSet CTag -> EnumSet CTag -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap CTag ([Mem], er) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], er)
csr,
        (CTag -> Bool) -> [CTag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CTag -> Bool
q (EnumMap CTag ([Mem], el) -> [CTag]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap CTag ([Mem], el)
csl) =
          f (EnumMap CTag ([Mem], es))
-> Maybe (f (EnumMap CTag ([Mem], es)))
forall a. a -> Maybe a
Just (f (EnumMap CTag ([Mem], es))
 -> Maybe (f (EnumMap CTag ([Mem], es))))
-> f (EnumMap CTag ([Mem], es))
-> Maybe (f (EnumMap CTag ([Mem], es)))
forall a b. (a -> b) -> a -> b
$ (([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er)
-> f (EnumMap CTag ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f) EnumMap CTag ([Mem], el)
csl EnumMap CTag ([Mem], er)
csr
      | Bool
otherwise = Maybe (f (EnumMap CTag ([Mem], es)))
forall a. Maybe a
Nothing
      where
        q :: CTag -> Bool
q CTag
t = ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], el)
csl EnumMap CTag ([Mem], el) -> CTag -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], er)
csr EnumMap CTag ([Mem], er) -> CTag -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t)
alignBranch el -> er -> f es
f (MatchData ref
rfl EnumMap CTag ([Mem], el)
bl Maybe el
dl) (MatchData ref
rfr EnumMap CTag ([Mem], er)
br Maybe er
dr)
  | ref
rfl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rfr,
    EnumMap CTag ([Mem], el) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], el)
bl EnumSet CTag -> EnumSet CTag -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap CTag ([Mem], er) -> EnumSet CTag
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap CTag ([Mem], er)
br,
    (CTag -> Bool) -> [CTag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\CTag
t -> ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], el)
bl EnumMap CTag ([Mem], el) -> CTag -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap CTag ([Mem], er)
br EnumMap CTag ([Mem], er) -> CTag -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! CTag
t)) (EnumMap CTag ([Mem], el) -> [CTag]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap CTag ([Mem], el)
bl),
    Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$ ref -> EnumMap CTag ([Mem], es) -> Maybe es -> Branched ref es
forall ref e.
ref -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched ref e
MatchData ref
rfl (EnumMap CTag ([Mem], es) -> Maybe es -> Branched ref es)
-> f (EnumMap CTag ([Mem], es)) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap CTag ([Mem], el)
-> EnumMap CTag ([Mem], er)
-> f (EnumMap CTag ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f) EnumMap CTag ([Mem], el)
bl EnumMap CTag ([Mem], er)
br f (Maybe es -> Branched ref es)
-> f (Maybe es) -> f (Branched ref es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
f (MatchSum EnumMap ConstructorId ([Mem], el)
bl) (MatchSum EnumMap ConstructorId ([Mem], er)
br)
  | EnumMap ConstructorId ([Mem], el) -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId ([Mem], el)
bl EnumSet ConstructorId -> EnumSet ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap ConstructorId ([Mem], er) -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId ([Mem], er)
br,
    (ConstructorId -> Bool) -> [ConstructorId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ConstructorId
w -> ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap ConstructorId ([Mem], el)
bl EnumMap ConstructorId ([Mem], el) -> ConstructorId -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! ConstructorId
w) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap ConstructorId ([Mem], er)
br EnumMap ConstructorId ([Mem], er) -> ConstructorId -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! ConstructorId
w)) (EnumMap ConstructorId ([Mem], el) -> [ConstructorId]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap ConstructorId ([Mem], el)
bl) =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$ EnumMap ConstructorId ([Mem], es) -> Branched ref es
forall ref e. EnumMap ConstructorId ([Mem], e) -> Branched ref e
MatchSum (EnumMap ConstructorId ([Mem], es) -> Branched ref es)
-> f (EnumMap ConstructorId ([Mem], es)) -> f (Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Mem], el) -> ([Mem], er) -> f ([Mem], es))
-> EnumMap ConstructorId ([Mem], el)
-> EnumMap ConstructorId ([Mem], er)
-> f (EnumMap ConstructorId ([Mem], es))
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse ((el -> er -> f es) -> ([Mem], el) -> ([Mem], er) -> f ([Mem], es)
forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs el -> er -> f es
f) EnumMap ConstructorId ([Mem], el)
bl EnumMap ConstructorId ([Mem], er)
br
alignBranch el -> er -> f es
f (MatchNumeric ref
rl EnumMap ConstructorId el
bl Maybe el
dl) (MatchNumeric ref
rr EnumMap ConstructorId er
br Maybe er
dr)
  | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr,
    EnumMap ConstructorId el -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId el
bl EnumSet ConstructorId -> EnumSet ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap ConstructorId er -> EnumSet ConstructorId
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap ConstructorId er
br,
    Just f (Maybe es)
ds <- (el -> er -> f es) -> Maybe el -> Maybe er -> Maybe (f (Maybe es))
forall (f :: * -> *) l r s.
Applicative f =>
(l -> r -> f s) -> Maybe l -> Maybe r -> Maybe (f (Maybe s))
alignMaybe el -> er -> f es
f Maybe el
dl Maybe er
dr =
      f (Branched ref es) -> Maybe (f (Branched ref es))
forall a. a -> Maybe a
Just (f (Branched ref es) -> Maybe (f (Branched ref es)))
-> f (Branched ref es) -> Maybe (f (Branched ref es))
forall a b. (a -> b) -> a -> b
$
        ref -> EnumMap ConstructorId es -> Maybe es -> Branched ref es
forall ref e.
ref -> EnumMap ConstructorId e -> Maybe e -> Branched ref e
MatchNumeric ref
rl
          (EnumMap ConstructorId es -> Maybe es -> Branched ref es)
-> f (EnumMap ConstructorId es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap ConstructorId el
-> EnumMap ConstructorId er
-> f (EnumMap ConstructorId es)
forall (f :: * -> *) a b c k.
Applicative f =>
(a -> b -> f c) -> EnumMap k a -> EnumMap k b -> f (EnumMap k c)
interverse el -> er -> f es
f EnumMap ConstructorId el
bl EnumMap ConstructorId er
br
          f (Maybe es -> Branched ref es)
-> f (Maybe es) -> f (Branched ref es)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Maybe es)
ds
alignBranch el -> er -> f es
_ Branched ref el
_ Branched ref er
_ = Maybe (f (Branched ref es))
forall a. Maybe a
Nothing

alignAscList ::
  (Applicative f, Ord k) =>
  (a -> b -> Maybe (f c)) ->
  [(k, a)] ->
  [(k, b)] ->
  Maybe (f [(k, c)])
alignAscList :: forall (f :: * -> *) k a b c.
(Applicative f, Ord k) =>
(a -> b -> Maybe (f c))
-> [(k, a)] -> [(k, b)] -> Maybe (f [(k, c)])
alignAscList a -> b -> Maybe (f c)
f [(k, a)]
ls0 [(k, b)]
rs0
  | Int
ll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lr = Maybe (f [(k, c)])
forall a. Maybe a
Nothing
  | Bool
otherwise = Compose Maybe f [(k, c)] -> Maybe (f [(k, c)])
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose Maybe f [(k, c)] -> Maybe (f [(k, c)]))
-> Compose Maybe f [(k, c)] -> Maybe (f [(k, c)])
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> [(k, b)] -> Compose Maybe f [(k, c)]
zipped [(k, a)]
ls [(k, b)]
rs
  where
    (Int
ll, [(k, a)]
ls) = case Int -> [(k, a)] -> Either Int Int
forall {a} {b}. Ord a => Int -> [(a, b)] -> Either Int Int
prep Int
0 [(k, a)]
ls0 of
      Left Int
n -> (Int
n, ((k, a) -> (k, a) -> Ordering) -> [(k, a)] -> [(k, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((k, a) -> k) -> (k, a) -> (k, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (k, a) -> k
forall a b. (a, b) -> a
fst) [(k, a)]
ls0)
      Right Int
n -> (Int
n, [(k, a)]
ls0)

    (Int
lr, [(k, b)]
rs) = case Int -> [(k, b)] -> Either Int Int
forall {a} {b}. Ord a => Int -> [(a, b)] -> Either Int Int
prep Int
0 [(k, b)]
rs0 of
      Left Int
n -> (Int
n, ((k, b) -> (k, b) -> Ordering) -> [(k, b)] -> [(k, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((k, b) -> k) -> (k, b) -> (k, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (k, b) -> k
forall a b. (a, b) -> a
fst) [(k, b)]
rs0)
      Right Int
n -> (Int
n, [(k, b)]
rs0)

    prep :: Int -> [(a, b)] -> Either Int Int
prep !Int
n ((a
k0, b
_) : xs :: [(a, b)]
xs@((a
k1, b
_) : [(a, b)]
_))
      | a
k0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k1 = Int -> [(a, b)] -> Either Int Int
prep (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(a, b)]
xs
    prep Int
n [(a, b)
_] = Int -> Either Int Int
forall a b. b -> Either a b
Right (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    prep Int
n [] = Int -> Either Int Int
forall a b. b -> Either a b
Right Int
n
    prep Int
n [(a, b)]
xs = Int -> Either Int Int
forall a b. a -> Either a b
Left (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(a, b)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
xs)

    zipped :: [(k, a)] -> [(k, b)] -> Compose Maybe f [(k, c)]
zipped [] [] = Maybe (f [(k, c)]) -> Compose Maybe f [(k, c)]
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Maybe (f [(k, c)]) -> Compose Maybe f [(k, c)])
-> (f [(k, c)] -> Maybe (f [(k, c)]))
-> f [(k, c)]
-> Compose Maybe f [(k, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f [(k, c)] -> Maybe (f [(k, c)])
forall a. a -> Maybe a
Just (f [(k, c)] -> Compose Maybe f [(k, c)])
-> f [(k, c)] -> Compose Maybe f [(k, c)]
forall a b. (a -> b) -> a -> b
$ [(k, c)] -> f [(k, c)]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    zipped ((k
lk, a
lv) : [(k, a)]
lkvs) ((k
rk, b
rv) : [(k, b)]
rkvs)
      | k
lk k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
rk = (:) ((k, c) -> [(k, c)] -> [(k, c)])
-> (c -> (k, c)) -> c -> [(k, c)] -> [(k, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k
lk,) (c -> [(k, c)] -> [(k, c)])
-> Compose Maybe f c -> Compose Maybe f ([(k, c)] -> [(k, c)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f c) -> Compose Maybe f c
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (a -> b -> Maybe (f c)
f a
lv b
rv) Compose Maybe f ([(k, c)] -> [(k, c)])
-> Compose Maybe f [(k, c)] -> Compose Maybe f [(k, c)]
forall a b.
Compose Maybe f (a -> b) -> Compose Maybe f a -> Compose Maybe f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(k, a)] -> [(k, b)] -> Compose Maybe f [(k, c)]
zipped [(k, a)]
lkvs [(k, b)]
rkvs
    zipped [(k, a)]
_ [(k, b)]
_ = Maybe (f [(k, c)]) -> Compose Maybe f [(k, c)]
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (f [(k, c)])
forall a. Maybe a
Nothing

alignCCs :: (Functor f) => (l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs :: forall (f :: * -> *) l r s a.
Functor f =>
(l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
alignCCs l -> r -> f s
f (a
ccs, l
l) (a
_, r
r) = (,) a
ccs (s -> (a, s)) -> f s -> f (a, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l -> r -> f s
f l
l r
r

matchLit :: Term v a -> Maybe (Lit Reference)
matchLit :: forall v a. Term v a -> Maybe (Lit TypeReference)
matchLit (Int' Int64
i) = Lit TypeReference -> Maybe (Lit TypeReference)
forall a. a -> Maybe a
Just (Lit TypeReference -> Maybe (Lit TypeReference))
-> Lit TypeReference -> Maybe (Lit TypeReference)
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit TypeReference
forall ref. Int64 -> Lit ref
I Int64
i
matchLit (Nat' ConstructorId
n) = Lit TypeReference -> Maybe (Lit TypeReference)
forall a. a -> Maybe a
Just (Lit TypeReference -> Maybe (Lit TypeReference))
-> Lit TypeReference -> Maybe (Lit TypeReference)
forall a b. (a -> b) -> a -> b
$ ConstructorId -> Lit TypeReference
forall ref. ConstructorId -> Lit ref
N ConstructorId
n
matchLit (Float' Double
f) = Lit TypeReference -> Maybe (Lit TypeReference)
forall a. a -> Maybe a
Just (Lit TypeReference -> Maybe (Lit TypeReference))
-> Lit TypeReference -> Maybe (Lit TypeReference)
forall a b. (a -> b) -> a -> b
$ Double -> Lit TypeReference
forall ref. Double -> Lit ref
F Double
f
matchLit (Text' Text
t) = Lit TypeReference -> Maybe (Lit TypeReference)
forall a. a -> Maybe a
Just (Lit TypeReference -> Maybe (Lit TypeReference))
-> Lit TypeReference -> Maybe (Lit TypeReference)
forall a b. (a -> b) -> a -> b
$ Text -> Lit TypeReference
forall ref. Text -> Lit ref
T (Text -> Text
Util.Text.fromText Text
t)
matchLit (Char' Char
c) = Lit TypeReference -> Maybe (Lit TypeReference)
forall a. a -> Maybe a
Just (Lit TypeReference -> Maybe (Lit TypeReference))
-> Lit TypeReference -> Maybe (Lit TypeReference)
forall a b. (a -> b) -> a -> b
$ Char -> Lit TypeReference
forall ref. Char -> Lit ref
C Char
c
matchLit Term (F v a a) v a
_ = Maybe (Lit TypeReference)
forall a. Maybe a
Nothing

pattern TLet ::
  (ABT.Var v) =>
  Direction Word16 ->
  v ->
  Mem ->
  ANormal ref v ->
  ANormal ref v ->
  ANormal ref v
pattern $mTLet :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (Direction Word16
    -> v -> Mem -> ANormal ref v -> ANormal ref v -> r)
-> ((# #) -> r)
-> r
$bTLet :: forall v ref.
Var v =>
Direction Word16
-> v -> Mem -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLet d v m bn bo = ABTN.TTm (ALet d [m] bn (ABTN.TAbs v bo))

pattern TLetD ::
  (ABT.Var v) =>
  v ->
  Mem ->
  ANormal ref v ->
  ANormal ref v ->
  ANormal ref v
pattern $mTLetD :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (v -> Mem -> ANormal ref v -> ANormal ref v -> r)
-> ((# #) -> r)
-> r
$bTLetD :: forall v ref.
Var v =>
v -> Mem -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLetD v m bn bo = ABTN.TTm (ALet Direct [m] bn (ABTN.TAbs v bo))

pattern TLets ::
  (ABT.Var v) =>
  Direction Word16 ->
  [v] ->
  [Mem] ->
  ANormal ref v ->
  ANormal ref v ->
  ANormal ref v
pattern $mTLets :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (Direction Word16
    -> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> r)
-> ((# #) -> r)
-> r
$bTLets :: forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets d vs ms bn bo = ABTN.TTm (ALet d ms bn (ABTN.TAbss vs bo))

pattern TName ::
  (ABT.Var v) =>
  v ->
  Either ref v ->
  [v] ->
  ANormal ref v ->
  ANormal ref v
pattern $mTName :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (v -> Either ref v -> [v] -> ANormal ref v -> r)
-> ((# #) -> r)
-> r
$bTName :: forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v f as bo = ABTN.TTm (AName f as (ABTN.TAbs v bo))

pattern Lit' :: Lit Reference -> Term v a
pattern $mLit' :: forall {r} {v} {a}.
Term v a -> (Lit TypeReference -> r) -> ((# #) -> r) -> r
Lit' l <- (matchLit -> Just l)

pattern TLit ::
  (ABT.Var v) =>
  Lit ref ->
  ANormal ref v
pattern $mTLit :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (Lit ref -> r) -> ((# #) -> r) -> r
$bTLit :: forall v ref. Var v => Lit ref -> ANormal ref v
TLit l = ABTN.TTm (ALit l)

pattern TBLit ::
  (ABT.Var v) =>
  Lit ref ->
  ANormal ref v
pattern $mTBLit :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (Lit ref -> r) -> ((# #) -> r) -> r
$bTBLit :: forall v ref. Var v => Lit ref -> ANormal ref v
TBLit l = ABTN.TTm (ABLit l)

pattern TApp ::
  (ABT.Var v) =>
  Func ref v ->
  [v] ->
  ANormal ref v
pattern $mTApp :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (Func ref v -> [v] -> r) -> ((# #) -> r) -> r
$bTApp :: forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp f args = ABTN.TTm (AApp f args)

pattern AApv :: v -> [v] -> ANormalF ref v e
pattern $mAApv :: forall {r} {v} {ref} {e}.
ANormalF ref v e -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bAApv :: forall v ref e. v -> [v] -> ANormalF ref v e
AApv v args = AApp (FVar v) args

pattern TApv ::
  (ABT.Var v) =>
  v ->
  [v] ->
  ANormal ref v
pattern $mTApv :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bTApv :: forall v ref. Var v => v -> [v] -> ANormal ref v
TApv v args = TApp (FVar v) args

pattern ACom :: ref -> [v] -> ANormalF ref v e
pattern $mACom :: forall {r} {ref} {v} {e}.
ANormalF ref v e -> (ref -> [v] -> r) -> ((# #) -> r) -> r
$bACom :: forall ref v e. ref -> [v] -> ANormalF ref v e
ACom r args = AApp (FComb r) args

pattern TCom ::
  (ABT.Var v) =>
  ref ->
  [v] ->
  ANormal ref v
pattern $mTCom :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (ref -> [v] -> r) -> ((# #) -> r) -> r
$bTCom :: forall v ref. Var v => ref -> [v] -> ANormal ref v
TCom r args = TApp (FComb r) args

pattern ACon :: ref -> CTag -> [v] -> ANormalF ref v e
pattern $mACon :: forall {r} {ref} {v} {e}.
ANormalF ref v e -> (ref -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bACon :: forall ref v e. ref -> CTag -> [v] -> ANormalF ref v e
ACon r t args = AApp (FCon r t) args

pattern TCon ::
  (ABT.Var v) =>
  ref ->
  CTag ->
  [v] ->
  ANormal ref v
pattern $mTCon :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (ref -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bTCon :: forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TCon r t args = TApp (FCon r t) args

pattern AKon :: v -> [v] -> ANormalF ref v e
pattern $mAKon :: forall {r} {v} {ref} {e}.
ANormalF ref v e -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bAKon :: forall v ref e. v -> [v] -> ANormalF ref v e
AKon v args = AApp (FCont v) args

pattern TKon ::
  (ABT.Var v) =>
  v ->
  [v] ->
  ANormal ref v
pattern $mTKon :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> [v] -> r) -> ((# #) -> r) -> r
$bTKon :: forall v ref. Var v => v -> [v] -> ANormal ref v
TKon v args = TApp (FCont v) args

pattern AReq :: ref -> CTag -> [v] -> ANormalF ref v e
pattern $mAReq :: forall {r} {ref} {v} {e}.
ANormalF ref v e -> (ref -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bAReq :: forall ref v e. ref -> CTag -> [v] -> ANormalF ref v e
AReq r t args = AApp (FReq r t) args

pattern TReq ::
  (ABT.Var v) =>
  ref ->
  CTag ->
  [v] ->
  ANormal ref v
pattern $mTReq :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (ref -> CTag -> [v] -> r) -> ((# #) -> r) -> r
$bTReq :: forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TReq r t args = TApp (FReq r t) args

pattern APrm :: POp -> [v] -> ANormalF ref v e
pattern $mAPrm :: forall {r} {v} {ref} {e}.
ANormalF ref v e -> (POp -> [v] -> r) -> ((# #) -> r) -> r
$bAPrm :: forall v ref e. POp -> [v] -> ANormalF ref v e
APrm p args = AApp (FPrim (Left p)) args

pattern TPrm ::
  (ABT.Var v) =>
  POp ->
  [v] ->
  ANormal ref v
pattern $mTPrm :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (POp -> [v] -> r) -> ((# #) -> r) -> r
$bTPrm :: forall v ref. Var v => POp -> [v] -> ANormal ref v
TPrm p args = TApp (FPrim (Left p)) args

pattern AFOp :: ForeignFunc -> [v] -> ANormalF ref v e
pattern $mAFOp :: forall {r} {v} {ref} {e}.
ANormalF ref v e -> (ForeignFunc -> [v] -> r) -> ((# #) -> r) -> r
$bAFOp :: forall v ref e. ForeignFunc -> [v] -> ANormalF ref v e
AFOp p args = AApp (FPrim (Right p)) args

pattern TFOp ::
  (ABT.Var v) =>
  ForeignFunc ->
  [v] ->
  ANormal ref v
pattern $mTFOp :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (ForeignFunc -> [v] -> r) -> ((# #) -> r) -> r
$bTFOp :: forall v ref. Var v => ForeignFunc -> [v] -> ANormal ref v
TFOp p args = TApp (FPrim (Right p)) args

pattern THnd ::
  (ABT.Var v) =>
  [ref] ->
  v ->
  Maybe v ->
  ANormal ref v ->
  ANormal ref v
pattern $mTHnd :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> ([ref] -> v -> Maybe v -> ANormal ref v -> r)
-> ((# #) -> r)
-> r
$bTHnd :: forall v ref.
Var v =>
[ref] -> v -> Maybe v -> ANormal ref v -> ANormal ref v
THnd rs nh ah b = ABTN.TTm (AHnd rs nh ah b)

pattern TShift ::
  (ABT.Var v) =>
  ref ->
  v ->
  ANormal ref v ->
  ANormal ref v
pattern $mTShift :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (ref -> v -> ANormal ref v -> r) -> ((# #) -> r) -> r
$bTShift :: forall v ref. Var v => ref -> v -> ANormal ref v -> ANormal ref v
TShift i v e = ABTN.TTm (AShift i (ABTN.TAbs v e))

pattern TMatch ::
  (ABT.Var v) =>
  v ->
  Branched ref (ANormal ref v) ->
  ANormal ref v
pattern $mTMatch :: forall {r} {v} {ref}.
Var v =>
ANormal ref v
-> (v -> Branched ref (ANormal ref v) -> r) -> ((# #) -> r) -> r
$bTMatch :: forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v cs = ABTN.TTm (AMatch v cs)

pattern TFrc :: (ABT.Var v) => v -> ANormal ref v
pattern $mTFrc :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> r) -> ((# #) -> r) -> r
$bTFrc :: forall v ref. Var v => v -> ANormal ref v
TFrc v = ABTN.TTm (AFrc v)

pattern TVar :: (ABT.Var v) => v -> ANormal ref v
pattern $mTVar :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> r) -> ((# #) -> r) -> r
$bTVar :: forall v ref. Var v => v -> ANormal ref v
TVar v = ABTN.TTm (AVar v)

pattern TDiscard :: (ABT.Var v) => v -> ANormal ref v
pattern $mTDiscard :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> r) -> ((# #) -> r) -> r
$bTDiscard :: forall v ref. Var v => v -> ANormal ref v
TDiscard v = ABTN.TTm (ADiscard v)

pattern TLocal ::
  (ABT.Var v) => v -> ANormal ref v -> ANormal ref v
pattern $mTLocal :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> ANormal ref v -> r) -> ((# #) -> r) -> r
$bTLocal :: forall v ref. Var v => v -> ANormal ref v -> ANormal ref v
TLocal v e = ABTN.TTm (ALocal v e)

pattern TUpdate ::
  (ABT.Var v) => Bool -> v -> v -> ABTN.Term (ANormalF ref) v
pattern $mTUpdate :: forall {r} {v} {ref}.
Var v =>
Term (ANormalF ref) v -> (Bool -> v -> v -> r) -> ((# #) -> r) -> r
$bTUpdate :: forall v ref. Var v => Bool -> v -> v -> Term (ANormalF ref) v
TUpdate ind u v = ABTN.TTm (AUpdate ind u v)

{-# COMPLETE
  TLets,
  TName,
  TVar,
  TApp,
  TFrc,
  TLit,
  TBLit,
  THnd,
  TShift,
  TMatch,
  TDiscard,
  TLocal,
  TUpdate,
  ABTN.TAbs
  #-}

{-# COMPLETE
  TLets,
  TName,
  TVar,
  TFrc,
  TApv,
  TCom,
  TCon,
  TKon,
  TReq,
  TPrm,
  TFOp,
  TLit,
  TBLit,
  THnd,
  TShift,
  TMatch,
  TDiscard,
  TLocal,
  TUpdate,
  ABTN.TAbs
  #-}

bind :: (Var v) => Cte v -> ANormal Reference v -> ANormal Reference v
bind :: forall v.
Var v =>
Cte v -> ANormal TypeReference v -> ANormal TypeReference v
bind (ST Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu) = Direction Word16
-> [v]
-> [Mem]
-> ANormal TypeReference v
-> ANormal TypeReference v
-> ANormal TypeReference v
forall v ref.
Var v =>
Direction Word16
-> [v] -> [Mem] -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLets Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu
bind (LZ v
u Either TypeReference v
f [v]
as) = v
-> Either TypeReference v
-> [v]
-> ANormal TypeReference v
-> ANormal TypeReference v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
u Either TypeReference v
f [v]
as

unbind ::
  (Var v) => ANormal Reference v -> Maybe (Cte v, ANormal Reference v)
unbind :: forall v.
Var v =>
ANormal TypeReference v -> Maybe (Cte v, ANormal TypeReference v)
unbind (TLets Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu ANormal TypeReference v
bd) = (Cte v, ANormal TypeReference v)
-> Maybe (Cte v, ANormal TypeReference v)
forall a. a -> Maybe a
Just (Direction Word16
-> [v] -> [Mem] -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu, ANormal TypeReference v
bd)
unbind (TName v
u Either TypeReference v
f [v]
as ANormal TypeReference v
bd) = (Cte v, ANormal TypeReference v)
-> Maybe (Cte v, ANormal TypeReference v)
forall a. a -> Maybe a
Just (v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
u Either TypeReference v
f [v]
as, ANormal TypeReference v
bd)
unbind ANormal TypeReference v
_ = Maybe (Cte v, ANormal TypeReference v)
forall a. Maybe a
Nothing

unbinds ::
  (Var v) => ANormal Reference v -> ([Cte v], ANormal Reference v)
unbinds :: forall v.
Var v =>
ANormal TypeReference v -> ([Cte v], ANormal TypeReference v)
unbinds (TLets Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu (ANormal TypeReference v -> ([Cte v], ANormal TypeReference v)
forall v.
Var v =>
ANormal TypeReference v -> ([Cte v], ANormal TypeReference v)
unbinds -> ([Cte v]
ctx, ANormal TypeReference v
bd))) =
  (Direction Word16
-> [v] -> [Mem] -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
us [Mem]
ms ANormal TypeReference v
bu Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
ctx, ANormal TypeReference v
bd)
unbinds (TName v
u Either TypeReference v
f [v]
as (ANormal TypeReference v -> ([Cte v], ANormal TypeReference v)
forall v.
Var v =>
ANormal TypeReference v -> ([Cte v], ANormal TypeReference v)
unbinds -> ([Cte v]
ctx, ANormal TypeReference v
bd))) = (v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
u Either TypeReference v
f [v]
as Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
ctx, ANormal TypeReference v
bd)
unbinds ANormal TypeReference v
tm = ([], ANormal TypeReference v
tm)

pattern TBind ::
  (Var v) =>
  Cte v ->
  ANormal Reference v ->
  ANormal Reference v
pattern $mTBind :: forall {r} {v}.
Var v =>
ANormal TypeReference v
-> (Cte v -> ANormal TypeReference v -> r) -> ((# #) -> r) -> r
$bTBind :: forall v.
Var v =>
Cte v -> ANormal TypeReference v -> ANormal TypeReference v
TBind bn bd <-
  (unbind -> Just (bn, bd))
  where
    TBind Cte v
bn ANormal TypeReference v
bd = Cte v -> ANormal TypeReference v -> ANormal TypeReference v
forall v.
Var v =>
Cte v -> ANormal TypeReference v -> ANormal TypeReference v
bind Cte v
bn ANormal TypeReference v
bd

pattern TBinds ::
  (Var v) => [Cte v] -> ANormal Reference v -> ANormal Reference v
pattern $mTBinds :: forall {r} {v}.
Var v =>
ANormal TypeReference v
-> ([Cte v] -> ANormal TypeReference v -> r) -> ((# #) -> r) -> r
$bTBinds :: forall v.
Var v =>
[Cte v] -> ANormal TypeReference v -> ANormal TypeReference v
TBinds ctx bd <-
  (unbinds -> (ctx, bd))
  where
    TBinds [Cte v]
ctx ANormal TypeReference v
bd = (Cte v -> ANormal TypeReference v -> ANormal TypeReference v)
-> ANormal TypeReference v -> [Cte v] -> ANormal TypeReference v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cte v -> ANormal TypeReference v -> ANormal TypeReference v
forall v.
Var v =>
Cte v -> ANormal TypeReference v -> ANormal TypeReference v
bind ANormal TypeReference v
bd [Cte v]
ctx

{-# COMPLETE TBinds #-}

data SeqEnd = SLeft | SRight
  deriving (SeqEnd -> SeqEnd -> Bool
(SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool) -> Eq SeqEnd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeqEnd -> SeqEnd -> Bool
== :: SeqEnd -> SeqEnd -> Bool
$c/= :: SeqEnd -> SeqEnd -> Bool
/= :: SeqEnd -> SeqEnd -> Bool
Eq, Eq SeqEnd
Eq SeqEnd =>
(SeqEnd -> SeqEnd -> Ordering)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> Bool)
-> (SeqEnd -> SeqEnd -> SeqEnd)
-> (SeqEnd -> SeqEnd -> SeqEnd)
-> Ord SeqEnd
SeqEnd -> SeqEnd -> Bool
SeqEnd -> SeqEnd -> Ordering
SeqEnd -> SeqEnd -> SeqEnd
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SeqEnd -> SeqEnd -> Ordering
compare :: SeqEnd -> SeqEnd -> Ordering
$c< :: SeqEnd -> SeqEnd -> Bool
< :: SeqEnd -> SeqEnd -> Bool
$c<= :: SeqEnd -> SeqEnd -> Bool
<= :: SeqEnd -> SeqEnd -> Bool
$c> :: SeqEnd -> SeqEnd -> Bool
> :: SeqEnd -> SeqEnd -> Bool
$c>= :: SeqEnd -> SeqEnd -> Bool
>= :: SeqEnd -> SeqEnd -> Bool
$cmax :: SeqEnd -> SeqEnd -> SeqEnd
max :: SeqEnd -> SeqEnd -> SeqEnd
$cmin :: SeqEnd -> SeqEnd -> SeqEnd
min :: SeqEnd -> SeqEnd -> SeqEnd
Ord, Int -> SeqEnd
SeqEnd -> Int
SeqEnd -> [SeqEnd]
SeqEnd -> SeqEnd
SeqEnd -> SeqEnd -> [SeqEnd]
SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
(SeqEnd -> SeqEnd)
-> (SeqEnd -> SeqEnd)
-> (Int -> SeqEnd)
-> (SeqEnd -> Int)
-> (SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> [SeqEnd])
-> (SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd])
-> Enum SeqEnd
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SeqEnd -> SeqEnd
succ :: SeqEnd -> SeqEnd
$cpred :: SeqEnd -> SeqEnd
pred :: SeqEnd -> SeqEnd
$ctoEnum :: Int -> SeqEnd
toEnum :: Int -> SeqEnd
$cfromEnum :: SeqEnd -> Int
fromEnum :: SeqEnd -> Int
$cenumFrom :: SeqEnd -> [SeqEnd]
enumFrom :: SeqEnd -> [SeqEnd]
$cenumFromThen :: SeqEnd -> SeqEnd -> [SeqEnd]
enumFromThen :: SeqEnd -> SeqEnd -> [SeqEnd]
$cenumFromTo :: SeqEnd -> SeqEnd -> [SeqEnd]
enumFromTo :: SeqEnd -> SeqEnd -> [SeqEnd]
$cenumFromThenTo :: SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
enumFromThenTo :: SeqEnd -> SeqEnd -> SeqEnd -> [SeqEnd]
Enum, Int -> SeqEnd -> ShowS
[SeqEnd] -> ShowS
SeqEnd -> String
(Int -> SeqEnd -> ShowS)
-> (SeqEnd -> String) -> ([SeqEnd] -> ShowS) -> Show SeqEnd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeqEnd -> ShowS
showsPrec :: Int -> SeqEnd -> ShowS
$cshow :: SeqEnd -> String
show :: SeqEnd -> String
$cshowList :: [SeqEnd] -> ShowS
showList :: [SeqEnd] -> ShowS
Show)

-- Note: MatchNumeric is a new form for matching directly on boxed
-- numeric data. This leaves MatchIntegral around so that builtins can
-- continue to use it. But interchanged code can be free of unboxed
-- details.
data Branched ref e
  = MatchIntegral (EnumMap Word64 e) (Maybe e)
  | MatchText (Map.Map Util.Text.Text e) (Maybe e)
  | MatchRequest [(ref, (EnumMap CTag ([Mem], e)))] e
  | MatchEmpty
  | MatchData ref (EnumMap CTag ([Mem], e)) (Maybe e)
  | MatchSum (EnumMap Word64 ([Mem], e))
  | MatchNumeric ref (EnumMap Word64 e) (Maybe e)
  deriving (Int -> Branched ref e -> ShowS
[Branched ref e] -> ShowS
Branched ref e -> String
(Int -> Branched ref e -> ShowS)
-> (Branched ref e -> String)
-> ([Branched ref e] -> ShowS)
-> Show (Branched ref e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ref e. (Show e, Show ref) => Int -> Branched ref e -> ShowS
forall ref e. (Show e, Show ref) => [Branched ref e] -> ShowS
forall ref e. (Show e, Show ref) => Branched ref e -> String
$cshowsPrec :: forall ref e. (Show e, Show ref) => Int -> Branched ref e -> ShowS
showsPrec :: Int -> Branched ref e -> ShowS
$cshow :: forall ref e. (Show e, Show ref) => Branched ref e -> String
show :: Branched ref e -> String
$cshowList :: forall ref e. (Show e, Show ref) => [Branched ref e] -> ShowS
showList :: [Branched ref e] -> ShowS
Show, Branched ref e -> Branched ref e -> Bool
(Branched ref e -> Branched ref e -> Bool)
-> (Branched ref e -> Branched ref e -> Bool)
-> Eq (Branched ref e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ref e.
(Eq e, Eq ref) =>
Branched ref e -> Branched ref e -> Bool
$c== :: forall ref e.
(Eq e, Eq ref) =>
Branched ref e -> Branched ref e -> Bool
== :: Branched ref e -> Branched ref e -> Bool
$c/= :: forall ref e.
(Eq e, Eq ref) =>
Branched ref e -> Branched ref e -> Bool
/= :: Branched ref e -> Branched ref e -> Bool
Eq, (forall a b. (a -> b) -> Branched ref a -> Branched ref b)
-> (forall a b. a -> Branched ref b -> Branched ref a)
-> Functor (Branched ref)
forall a b. a -> Branched ref b -> Branched ref a
forall a b. (a -> b) -> Branched ref a -> Branched ref b
forall ref a b. a -> Branched ref b -> Branched ref a
forall ref a b. (a -> b) -> Branched ref a -> Branched ref b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ref a b. (a -> b) -> Branched ref a -> Branched ref b
fmap :: forall a b. (a -> b) -> Branched ref a -> Branched ref b
$c<$ :: forall ref a b. a -> Branched ref b -> Branched ref a
<$ :: forall a b. a -> Branched ref b -> Branched ref a
Functor, (forall m. Monoid m => Branched ref m -> m)
-> (forall m a. Monoid m => (a -> m) -> Branched ref a -> m)
-> (forall m a. Monoid m => (a -> m) -> Branched ref a -> m)
-> (forall a b. (a -> b -> b) -> b -> Branched ref a -> b)
-> (forall a b. (a -> b -> b) -> b -> Branched ref a -> b)
-> (forall b a. (b -> a -> b) -> b -> Branched ref a -> b)
-> (forall b a. (b -> a -> b) -> b -> Branched ref a -> b)
-> (forall a. (a -> a -> a) -> Branched ref a -> a)
-> (forall a. (a -> a -> a) -> Branched ref a -> a)
-> (forall a. Branched ref a -> [a])
-> (forall a. Branched ref a -> Bool)
-> (forall a. Branched ref a -> Int)
-> (forall a. Eq a => a -> Branched ref a -> Bool)
-> (forall a. Ord a => Branched ref a -> a)
-> (forall a. Ord a => Branched ref a -> a)
-> (forall a. Num a => Branched ref a -> a)
-> (forall a. Num a => Branched ref a -> a)
-> Foldable (Branched ref)
forall a. Eq a => a -> Branched ref a -> Bool
forall a. Num a => Branched ref a -> a
forall a. Ord a => Branched ref a -> a
forall m. Monoid m => Branched ref m -> m
forall a. Branched ref a -> Bool
forall a. Branched ref a -> Int
forall a. Branched ref a -> [a]
forall a. (a -> a -> a) -> Branched ref a -> a
forall ref a. Eq a => a -> Branched ref a -> Bool
forall ref a. Num a => Branched ref a -> a
forall ref a. Ord a => Branched ref a -> a
forall m a. Monoid m => (a -> m) -> Branched ref a -> m
forall ref m. Monoid m => Branched ref m -> m
forall ref a. Branched ref a -> Bool
forall ref a. Branched ref a -> Int
forall ref a. Branched ref a -> [a]
forall b a. (b -> a -> b) -> b -> Branched ref a -> b
forall a b. (a -> b -> b) -> b -> Branched ref a -> b
forall ref a. (a -> a -> a) -> Branched ref a -> a
forall ref m a. Monoid m => (a -> m) -> Branched ref a -> m
forall ref b a. (b -> a -> b) -> b -> Branched ref a -> b
forall ref a b. (a -> b -> b) -> b -> Branched ref a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall ref m. Monoid m => Branched ref m -> m
fold :: forall m. Monoid m => Branched ref m -> m
$cfoldMap :: forall ref m a. Monoid m => (a -> m) -> Branched ref a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Branched ref a -> m
$cfoldMap' :: forall ref m a. Monoid m => (a -> m) -> Branched ref a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Branched ref a -> m
$cfoldr :: forall ref a b. (a -> b -> b) -> b -> Branched ref a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Branched ref a -> b
$cfoldr' :: forall ref a b. (a -> b -> b) -> b -> Branched ref a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Branched ref a -> b
$cfoldl :: forall ref b a. (b -> a -> b) -> b -> Branched ref a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Branched ref a -> b
$cfoldl' :: forall ref b a. (b -> a -> b) -> b -> Branched ref a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Branched ref a -> b
$cfoldr1 :: forall ref a. (a -> a -> a) -> Branched ref a -> a
foldr1 :: forall a. (a -> a -> a) -> Branched ref a -> a
$cfoldl1 :: forall ref a. (a -> a -> a) -> Branched ref a -> a
foldl1 :: forall a. (a -> a -> a) -> Branched ref a -> a
$ctoList :: forall ref a. Branched ref a -> [a]
toList :: forall a. Branched ref a -> [a]
$cnull :: forall ref a. Branched ref a -> Bool
null :: forall a. Branched ref a -> Bool
$clength :: forall ref a. Branched ref a -> Int
length :: forall a. Branched ref a -> Int
$celem :: forall ref a. Eq a => a -> Branched ref a -> Bool
elem :: forall a. Eq a => a -> Branched ref a -> Bool
$cmaximum :: forall ref a. Ord a => Branched ref a -> a
maximum :: forall a. Ord a => Branched ref a -> a
$cminimum :: forall ref a. Ord a => Branched ref a -> a
minimum :: forall a. Ord a => Branched ref a -> a
$csum :: forall ref a. Num a => Branched ref a -> a
sum :: forall a. Num a => Branched ref a -> a
$cproduct :: forall ref a. Num a => Branched ref a -> a
product :: forall a. Num a => Branched ref a -> a
Foldable, Functor (Branched ref)
Foldable (Branched ref)
(Functor (Branched ref), Foldable (Branched ref)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Branched ref a -> f (Branched ref b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Branched ref (f a) -> f (Branched ref a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Branched ref a -> m (Branched ref b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Branched ref (m a) -> m (Branched ref a))
-> Traversable (Branched ref)
forall ref. Functor (Branched ref)
forall ref. Foldable (Branched ref)
forall ref (m :: * -> *) a.
Monad m =>
Branched ref (m a) -> m (Branched ref a)
forall ref (f :: * -> *) a.
Applicative f =>
Branched ref (f a) -> f (Branched ref a)
forall ref (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched ref a -> m (Branched ref b)
forall ref (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched ref a -> f (Branched ref b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Branched ref (m a) -> m (Branched ref a)
forall (f :: * -> *) a.
Applicative f =>
Branched ref (f a) -> f (Branched ref a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched ref a -> m (Branched ref b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched ref a -> f (Branched ref b)
$ctraverse :: forall ref (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched ref a -> f (Branched ref b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Branched ref a -> f (Branched ref b)
$csequenceA :: forall ref (f :: * -> *) a.
Applicative f =>
Branched ref (f a) -> f (Branched ref a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Branched ref (f a) -> f (Branched ref a)
$cmapM :: forall ref (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched ref a -> m (Branched ref b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Branched ref a -> m (Branched ref b)
$csequence :: forall ref (m :: * -> *) a.
Monad m =>
Branched ref (m a) -> m (Branched ref a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Branched ref (m a) -> m (Branched ref a)
Traversable)

-- Data cases expected to cover all constructors
pattern MatchDataCover ::
  ref -> EnumMap CTag ([Mem], e) -> Branched ref e
pattern $mMatchDataCover :: forall {r} {ref} {e}.
Branched ref e
-> (ref -> EnumMap CTag ([Mem], e) -> r) -> ((# #) -> r) -> r
$bMatchDataCover :: forall ref e. ref -> EnumMap CTag ([Mem], e) -> Branched ref e
MatchDataCover r m = MatchData r m Nothing

data BranchAccum v
  = AccumEmpty
  | AccumIntegral
      Reference
      (Maybe (ANormal Reference v))
      (EnumMap Word64 (ANormal Reference v))
  | AccumText
      (Maybe (ANormal Reference v))
      (Map.Map Util.Text.Text (ANormal Reference v))
  | AccumDefault (ANormal Reference v)
  | AccumPure (ANormal Reference v)
  | AccumRequest
      (Map Reference (EnumMap CTag ([Mem], ANormal Reference v)))
      (Maybe (ANormal Reference v))
  | AccumData
      Reference
      (Maybe (ANormal Reference v))
      (EnumMap CTag ([Mem], ANormal Reference v))
  | AccumSeqEmpty (ANormal Reference v)
  | AccumSeqView
      SeqEnd
      (Maybe (ANormal Reference v)) -- empty
      (ANormal Reference v) -- cons/snoc
  | AccumSeqSplit
      SeqEnd
      Int -- split at
      (Maybe (ANormal Reference v)) -- default
      (ANormal Reference v) -- split

instance Semigroup (BranchAccum v) where
  BranchAccum v
AccumEmpty <> :: BranchAccum v -> BranchAccum v -> BranchAccum v
<> BranchAccum v
r = BranchAccum v
r
  BranchAccum v
l <> BranchAccum v
AccumEmpty = BranchAccum v
l
  AccumIntegral TypeReference
rl Maybe (ANormal TypeReference v)
dl EnumMap ConstructorId (ANormal TypeReference v)
cl <> AccumIntegral TypeReference
rr Maybe (ANormal TypeReference v)
dr EnumMap ConstructorId (ANormal TypeReference v)
cr
    | TypeReference
rl TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
rr = TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
rl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
dr) (EnumMap ConstructorId (ANormal TypeReference v) -> BranchAccum v)
-> EnumMap ConstructorId (ANormal TypeReference v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ EnumMap ConstructorId (ANormal TypeReference v)
cl EnumMap ConstructorId (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
forall a. Semigroup a => a -> a -> a
<> EnumMap ConstructorId (ANormal TypeReference v)
cr
  AccumText Maybe (ANormal TypeReference v)
dl Map Text (ANormal TypeReference v)
cl <> AccumText Maybe (ANormal TypeReference v)
dr Map Text (ANormal TypeReference v)
cr =
    Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
forall v.
Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
AccumText (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
dr) (Map Text (ANormal TypeReference v)
cl Map Text (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v)
forall a. Semigroup a => a -> a -> a
<> Map Text (ANormal TypeReference v)
cr)
  AccumData TypeReference
rl Maybe (ANormal TypeReference v)
dl EnumMap CTag ([Mem], ANormal TypeReference v)
cl <> AccumData TypeReference
rr Maybe (ANormal TypeReference v)
dr EnumMap CTag ([Mem], ANormal TypeReference v)
cr
    | TypeReference
rl TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
rr = TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
AccumData TypeReference
rl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
dr) (EnumMap CTag ([Mem], ANormal TypeReference v)
cl EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall a. Semigroup a => a -> a -> a
<> EnumMap CTag ([Mem], ANormal TypeReference v)
cr)
  AccumDefault ANormal TypeReference v
dl <> AccumIntegral TypeReference
r Maybe (ANormal TypeReference v)
_ EnumMap ConstructorId (ANormal TypeReference v)
cr =
    TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
r (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dl) EnumMap ConstructorId (ANormal TypeReference v)
cr
  AccumDefault ANormal TypeReference v
dl <> AccumText Maybe (ANormal TypeReference v)
_ Map Text (ANormal TypeReference v)
cr =
    Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
forall v.
Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
AccumText (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dl) Map Text (ANormal TypeReference v)
cr
  AccumDefault ANormal TypeReference v
dl <> AccumData TypeReference
rr Maybe (ANormal TypeReference v)
_ EnumMap CTag ([Mem], ANormal TypeReference v)
cr =
    TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
AccumData TypeReference
rr (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dl) EnumMap CTag ([Mem], ANormal TypeReference v)
cr
  AccumIntegral TypeReference
r Maybe (ANormal TypeReference v)
dl EnumMap ConstructorId (ANormal TypeReference v)
cl <> AccumDefault ANormal TypeReference v
dr =
    TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
r (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dr) EnumMap ConstructorId (ANormal TypeReference v)
cl
  AccumText Maybe (ANormal TypeReference v)
dl Map Text (ANormal TypeReference v)
cl <> AccumDefault ANormal TypeReference v
dr =
    Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
forall v.
Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
AccumText (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dr) Map Text (ANormal TypeReference v)
cl
  AccumData TypeReference
rl Maybe (ANormal TypeReference v)
dl EnumMap CTag ([Mem], ANormal TypeReference v)
cl <> AccumDefault ANormal TypeReference v
dr =
    TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
AccumData TypeReference
rl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dr) EnumMap CTag ([Mem], ANormal TypeReference v)
cl
  l :: BranchAccum v
l@(AccumPure ANormal TypeReference v
_) <> AccumPure ANormal TypeReference v
_ = BranchAccum v
l
  AccumPure ANormal TypeReference v
dl <> AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hr Maybe (ANormal TypeReference v)
_ = Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
forall v.
Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hr (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dl)
  AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hl Maybe (ANormal TypeReference v)
dl <> AccumPure ANormal TypeReference v
dr =
    Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
forall v.
Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dr)
  AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hl Maybe (ANormal TypeReference v)
dl <> AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hr Maybe (ANormal TypeReference v)
dr =
    Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
forall v.
Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
AccumRequest Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hm (Maybe (ANormal TypeReference v) -> BranchAccum v)
-> Maybe (ANormal TypeReference v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
dr
    where
      hm :: Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hm = (EnumMap CTag ([Mem], ANormal TypeReference v)
 -> EnumMap CTag ([Mem], ANormal TypeReference v)
 -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall a. Semigroup a => a -> a -> a
(<>) Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hl Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
hr
  l :: BranchAccum v
l@(AccumSeqEmpty ANormal TypeReference v
_) <> AccumSeqEmpty ANormal TypeReference v
_ = BranchAccum v
l
  AccumSeqEmpty ANormal TypeReference v
eml <> AccumSeqView SeqEnd
er Maybe (ANormal TypeReference v)
_ ANormal TypeReference v
cnr =
    SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqView SeqEnd
er (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
eml) ANormal TypeReference v
cnr
  AccumSeqView SeqEnd
el Maybe (ANormal TypeReference v)
eml ANormal TypeReference v
cnl <> AccumSeqEmpty ANormal TypeReference v
emr =
    SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal TypeReference v)
eml Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
emr) ANormal TypeReference v
cnl
  AccumSeqView SeqEnd
el Maybe (ANormal TypeReference v)
eml ANormal TypeReference v
cnl <> AccumSeqView SeqEnd
er Maybe (ANormal TypeReference v)
emr ANormal TypeReference v
_
    | SeqEnd
el SeqEnd -> SeqEnd -> Bool
forall a. Eq a => a -> a -> Bool
/= SeqEnd
er =
        [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"AccumSeqView: trying to merge views of opposite ends"
    | Bool
otherwise = SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal TypeReference v)
eml Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
emr) ANormal TypeReference v
cnl
  AccumSeqView SeqEnd
_ Maybe (ANormal TypeReference v)
_ ANormal TypeReference v
_ <> AccumDefault ANormal TypeReference v
_ =
    [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"seq views may not have defaults"
  AccumDefault ANormal TypeReference v
_ <> AccumSeqView SeqEnd
_ Maybe (ANormal TypeReference v)
_ ANormal TypeReference v
_ =
    [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"seq views may not have defaults"
  AccumSeqSplit SeqEnd
el Int
nl Maybe (ANormal TypeReference v)
dl ANormal TypeReference v
bl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal TypeReference v)
dr ANormal TypeReference v
_
    | SeqEnd
el SeqEnd -> SeqEnd -> Bool
forall a. Eq a => a -> a -> Bool
/= SeqEnd
er =
        [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"AccumSeqSplit: trying to merge splits at opposite ends"
    | Int
nl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nr =
        [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"AccumSeqSplit: trying to merge splits at different positions"
    | Bool
otherwise =
        SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal TypeReference v)
dr) ANormal TypeReference v
bl
  AccumDefault ANormal TypeReference v
dl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal TypeReference v)
_ ANormal TypeReference v
br =
    SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqSplit SeqEnd
er Int
nr (ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dl) ANormal TypeReference v
br
  AccumSeqSplit SeqEnd
el Int
nl Maybe (ANormal TypeReference v)
dl ANormal TypeReference v
bl <> AccumDefault ANormal TypeReference v
dr =
    SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal TypeReference v)
dl Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
-> Maybe (ANormal TypeReference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal TypeReference v -> Maybe (ANormal TypeReference v)
forall a. a -> Maybe a
Just ANormal TypeReference v
dr) ANormal TypeReference v
bl
  BranchAccum v
_ <> BranchAccum v
_ = [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"cannot merge data cases for different types"

instance Monoid (BranchAccum e) where
  mempty :: BranchAccum e
mempty = BranchAccum e
forall e. BranchAccum e
AccumEmpty

data Func ref v
  = -- variable
    FVar v
  | -- top-level combinator
    FComb !ref
  | -- continuation jump
    FCont v
  | -- data constructor
    FCon !ref !CTag
  | -- ability request
    FReq !ref !CTag
  | -- prim op
    FPrim (Either POp ForeignFunc)
  deriving (Int -> Func ref v -> ShowS
[Func ref v] -> ShowS
Func ref v -> String
(Int -> Func ref v -> ShowS)
-> (Func ref v -> String)
-> ([Func ref v] -> ShowS)
-> Show (Func ref v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ref v. (Show v, Show ref) => Int -> Func ref v -> ShowS
forall ref v. (Show v, Show ref) => [Func ref v] -> ShowS
forall ref v. (Show v, Show ref) => Func ref v -> String
$cshowsPrec :: forall ref v. (Show v, Show ref) => Int -> Func ref v -> ShowS
showsPrec :: Int -> Func ref v -> ShowS
$cshow :: forall ref v. (Show v, Show ref) => Func ref v -> String
show :: Func ref v -> String
$cshowList :: forall ref v. (Show v, Show ref) => [Func ref v] -> ShowS
showList :: [Func ref v] -> ShowS
Show, Func ref v -> Func ref v -> Bool
(Func ref v -> Func ref v -> Bool)
-> (Func ref v -> Func ref v -> Bool) -> Eq (Func ref v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ref v. (Eq v, Eq ref) => Func ref v -> Func ref v -> Bool
$c== :: forall ref v. (Eq v, Eq ref) => Func ref v -> Func ref v -> Bool
== :: Func ref v -> Func ref v -> Bool
$c/= :: forall ref v. (Eq v, Eq ref) => Func ref v -> Func ref v -> Bool
/= :: Func ref v -> Func ref v -> Bool
Eq, (forall a b. (a -> b) -> Func ref a -> Func ref b)
-> (forall a b. a -> Func ref b -> Func ref a)
-> Functor (Func ref)
forall a b. a -> Func ref b -> Func ref a
forall a b. (a -> b) -> Func ref a -> Func ref b
forall ref a b. a -> Func ref b -> Func ref a
forall ref a b. (a -> b) -> Func ref a -> Func ref b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ref a b. (a -> b) -> Func ref a -> Func ref b
fmap :: forall a b. (a -> b) -> Func ref a -> Func ref b
$c<$ :: forall ref a b. a -> Func ref b -> Func ref a
<$ :: forall a b. a -> Func ref b -> Func ref a
Functor, (forall m. Monoid m => Func ref m -> m)
-> (forall m a. Monoid m => (a -> m) -> Func ref a -> m)
-> (forall m a. Monoid m => (a -> m) -> Func ref a -> m)
-> (forall a b. (a -> b -> b) -> b -> Func ref a -> b)
-> (forall a b. (a -> b -> b) -> b -> Func ref a -> b)
-> (forall b a. (b -> a -> b) -> b -> Func ref a -> b)
-> (forall b a. (b -> a -> b) -> b -> Func ref a -> b)
-> (forall a. (a -> a -> a) -> Func ref a -> a)
-> (forall a. (a -> a -> a) -> Func ref a -> a)
-> (forall a. Func ref a -> [a])
-> (forall a. Func ref a -> Bool)
-> (forall a. Func ref a -> Int)
-> (forall a. Eq a => a -> Func ref a -> Bool)
-> (forall a. Ord a => Func ref a -> a)
-> (forall a. Ord a => Func ref a -> a)
-> (forall a. Num a => Func ref a -> a)
-> (forall a. Num a => Func ref a -> a)
-> Foldable (Func ref)
forall a. Eq a => a -> Func ref a -> Bool
forall a. Num a => Func ref a -> a
forall a. Ord a => Func ref a -> a
forall m. Monoid m => Func ref m -> m
forall a. Func ref a -> Bool
forall a. Func ref a -> Int
forall a. Func ref a -> [a]
forall a. (a -> a -> a) -> Func ref a -> a
forall ref a. Eq a => a -> Func ref a -> Bool
forall ref a. Num a => Func ref a -> a
forall ref a. Ord a => Func ref a -> a
forall m a. Monoid m => (a -> m) -> Func ref a -> m
forall ref m. Monoid m => Func ref m -> m
forall ref a. Func ref a -> Bool
forall ref a. Func ref a -> Int
forall ref a. Func ref a -> [a]
forall b a. (b -> a -> b) -> b -> Func ref a -> b
forall a b. (a -> b -> b) -> b -> Func ref a -> b
forall ref a. (a -> a -> a) -> Func ref a -> a
forall ref m a. Monoid m => (a -> m) -> Func ref a -> m
forall ref b a. (b -> a -> b) -> b -> Func ref a -> b
forall ref a b. (a -> b -> b) -> b -> Func ref a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall ref m. Monoid m => Func ref m -> m
fold :: forall m. Monoid m => Func ref m -> m
$cfoldMap :: forall ref m a. Monoid m => (a -> m) -> Func ref a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Func ref a -> m
$cfoldMap' :: forall ref m a. Monoid m => (a -> m) -> Func ref a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Func ref a -> m
$cfoldr :: forall ref a b. (a -> b -> b) -> b -> Func ref a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Func ref a -> b
$cfoldr' :: forall ref a b. (a -> b -> b) -> b -> Func ref a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Func ref a -> b
$cfoldl :: forall ref b a. (b -> a -> b) -> b -> Func ref a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Func ref a -> b
$cfoldl' :: forall ref b a. (b -> a -> b) -> b -> Func ref a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Func ref a -> b
$cfoldr1 :: forall ref a. (a -> a -> a) -> Func ref a -> a
foldr1 :: forall a. (a -> a -> a) -> Func ref a -> a
$cfoldl1 :: forall ref a. (a -> a -> a) -> Func ref a -> a
foldl1 :: forall a. (a -> a -> a) -> Func ref a -> a
$ctoList :: forall ref a. Func ref a -> [a]
toList :: forall a. Func ref a -> [a]
$cnull :: forall ref a. Func ref a -> Bool
null :: forall a. Func ref a -> Bool
$clength :: forall ref a. Func ref a -> Int
length :: forall a. Func ref a -> Int
$celem :: forall ref a. Eq a => a -> Func ref a -> Bool
elem :: forall a. Eq a => a -> Func ref a -> Bool
$cmaximum :: forall ref a. Ord a => Func ref a -> a
maximum :: forall a. Ord a => Func ref a -> a
$cminimum :: forall ref a. Ord a => Func ref a -> a
minimum :: forall a. Ord a => Func ref a -> a
$csum :: forall ref a. Num a => Func ref a -> a
sum :: forall a. Num a => Func ref a -> a
$cproduct :: forall ref a. Num a => Func ref a -> a
product :: forall a. Num a => Func ref a -> a
Foldable, Functor (Func ref)
Foldable (Func ref)
(Functor (Func ref), Foldable (Func ref)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Func ref a -> f (Func ref b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Func ref (f a) -> f (Func ref a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Func ref a -> m (Func ref b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Func ref (m a) -> m (Func ref a))
-> Traversable (Func ref)
forall ref. Functor (Func ref)
forall ref. Foldable (Func ref)
forall ref (m :: * -> *) a.
Monad m =>
Func ref (m a) -> m (Func ref a)
forall ref (f :: * -> *) a.
Applicative f =>
Func ref (f a) -> f (Func ref a)
forall ref (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func ref a -> m (Func ref b)
forall ref (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func ref a -> f (Func ref b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Func ref (m a) -> m (Func ref a)
forall (f :: * -> *) a.
Applicative f =>
Func ref (f a) -> f (Func ref a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func ref a -> m (Func ref b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func ref a -> f (Func ref b)
$ctraverse :: forall ref (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func ref a -> f (Func ref b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Func ref a -> f (Func ref b)
$csequenceA :: forall ref (f :: * -> *) a.
Applicative f =>
Func ref (f a) -> f (Func ref a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Func ref (f a) -> f (Func ref a)
$cmapM :: forall ref (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func ref a -> m (Func ref b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Func ref a -> m (Func ref b)
$csequence :: forall ref (m :: * -> *) a.
Monad m =>
Func ref (m a) -> m (Func ref a)
sequence :: forall (m :: * -> *) a. Monad m => Func ref (m a) -> m (Func ref a)
Traversable)

data Lit ref
  = I Int64
  | N Word64
  | F Double
  | T Util.Text.Text
  | C Char
  | LM (Rfn.Referent' ref) -- Term Link
  | LY ref -- Type Link
  deriving (Int -> Lit ref -> ShowS
[Lit ref] -> ShowS
Lit ref -> String
(Int -> Lit ref -> ShowS)
-> (Lit ref -> String) -> ([Lit ref] -> ShowS) -> Show (Lit ref)
forall ref. Show ref => Int -> Lit ref -> ShowS
forall ref. Show ref => [Lit ref] -> ShowS
forall ref. Show ref => Lit ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> Lit ref -> ShowS
showsPrec :: Int -> Lit ref -> ShowS
$cshow :: forall ref. Show ref => Lit ref -> String
show :: Lit ref -> String
$cshowList :: forall ref. Show ref => [Lit ref] -> ShowS
showList :: [Lit ref] -> ShowS
Show, Lit ref -> Lit ref -> Bool
(Lit ref -> Lit ref -> Bool)
-> (Lit ref -> Lit ref -> Bool) -> Eq (Lit ref)
forall ref. Eq ref => Lit ref -> Lit ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref. Eq ref => Lit ref -> Lit ref -> Bool
== :: Lit ref -> Lit ref -> Bool
$c/= :: forall ref. Eq ref => Lit ref -> Lit ref -> Bool
/= :: Lit ref -> Lit ref -> Bool
Eq)

litRef :: Lit ref -> Reference
litRef :: forall ref. Lit ref -> TypeReference
litRef (I Int64
_) = TypeReference
Ty.intRef
litRef (N ConstructorId
_) = TypeReference
Ty.natRef
litRef (F Double
_) = TypeReference
Ty.floatRef
litRef (T Text
_) = TypeReference
Ty.textRef
litRef (C Char
_) = TypeReference
Ty.charRef
litRef (LM Referent' ref
_) = TypeReference
Ty.termLinkRef
litRef (LY ref
_) = TypeReference
Ty.typeLinkRef

-- Note: Enum/Bounded instances should only be used for things like
-- getting a list of all ops. Using auto-generated numberings for
-- serialization, for instance, could cause observable changes to
-- formats that we want to control and version.
data POp
  = -- Int
    ADDI -- +
  | SUBI -- -
  | MULI
  | DIVI -- /
  | SGNI -- sgn
  | NEGI -- neg
  | MODI -- mod
  | POWI -- pow
  | SHLI -- shiftl
  | SHRI -- shiftr
  | ANDI -- and
  | IORI -- or
  | XORI -- xor
  | COMI -- complement
  | INCI -- inc
  | DECI -- dec
  | LEQI -- <=
  | LESI -- <
  | EQLI -- ==
  | NEQI -- !=
  | TRNC -- truncate0
  -- Nat
  | ADDN -- +
  | SUBN -- -
  | DRPN -- drop
  | MULN
  | DIVN -- /
  | MODN -- mod
  | TZRO -- trailingZeros
  | LZRO -- leadingZeros
  | POPC -- popCount
  | POWN -- pow
  | SHLN -- shiftl
  | SHRN -- shiftr
  | ANDN -- and
  | IORN -- or
  | XORN -- xor
  | COMN -- complement
  | INCN -- inc
  | DECN -- dec
  | LEQN -- <=
  | LESN -- <
  | EQLN -- ==
  | NEQN -- !=
  -- Float
  | ADDF -- +
  | SUBF -- -
  | MULF
  | DIVF -- /
  | MINF -- min
  | MAXF -- max
  | LEQF -- <=
  | LESF -- <
  | EQLF -- ==
  | NEQF -- !=
  | POWF -- pow
  | EXPF -- exp
  | SQRT -- sqrt
  | LOGF -- log
  | LOGB -- logBase
  | ABSF -- abs
  | CEIL -- ceil
  | FLOR -- floor
  | TRNF -- truncate
  | RNDF -- round
  -- Trig
  | COSF -- cos
  | ACOS -- acos
  | COSH -- cosh
  | ACSH -- acosh
  | SINF -- sin
  | ASIN -- asin
  | SINH -- sinh
  | ASNH -- asinh
  | TANF -- tan
  | ATAN -- atan
  | TANH -- tanh
  | ATNH -- atanh
  | ATN2 -- atan2
  -- Text
  | CATT -- ++
  | TAKT -- take
  | DRPT -- drop
  | SIZT -- size
  | IXOT -- indexOf
  | UCNS -- uncons
  | USNC -- unsnoc
  | EQLT -- ==
  | LEQT -- <=
  | PAKT -- pack
  | UPKT -- unpack
  -- Sequence
  | CATS -- ++
  | TAKS -- take
  | DRPS -- drop
  | SIZS -- size
  | CONS -- cons
  | SNOC -- snoc
  | IDXS -- at
  | BLDS -- build
  | VWLS -- viewl
  | VWRS -- viewr
  | SPLL -- splitl
  | SPLR -- splitr
  -- Bytes
  | PAKB -- pack
  | UPKB -- unpack
  | TAKB -- take
  | DRPB -- drop
  | IXOB -- indexOf
  | IDXB -- index
  | SIZB -- size
  | FLTB -- flatten
  | CATB -- append
  -- Conversion
  | ITOF -- intToFloat
  | NTOF -- natToFloat
  | ITOT -- intToText
  | NTOT -- natToText
  | TTOI -- textToInt
  | TTON -- textToNat
  | TTOF -- textToFloat
  | FTOT -- floatToText
  | CAST -- runtime type cast for unboxed values.
  | -- Concurrency
    FORK -- fork
  | -- Universal operations
    EQLU -- ==
  | CMPU -- compare
  | LEQU -- <=
  | LESU -- <
  | EROR -- error
  | -- Code
    MISS -- isMissing
  | CACH -- cache_
  | LKUP -- lookup
  | LOAD -- load
  | CVLD -- validate
  | SDBX -- sandbox
  | VALU -- value
  | TLTT -- Term.Link.toText
  -- Debug
  | PRNT -- print
  | INFO -- info
  | TRCE -- trace
  | DBTX -- debugText
  | -- STM
    ATOM -- atomically
  | TFRC -- try force
  | SDBL -- sandbox link list
  | SDBV -- sandbox check for Values
  -- Refs
  | REFN -- Ref.new
  | REFR -- Ref.read
  | REFW -- Ref.write
  | RCAS -- Ref.cas
  | RRFC -- Ref.readForCas
  | TIKR -- Ref.Ticket.read
  -- Bools
  | NOTB -- not
  | ANDB -- and
  | IORB -- or
  deriving (Int -> POp -> ShowS
[POp] -> ShowS
POp -> String
(Int -> POp -> ShowS)
-> (POp -> String) -> ([POp] -> ShowS) -> Show POp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> POp -> ShowS
showsPrec :: Int -> POp -> ShowS
$cshow :: POp -> String
show :: POp -> String
$cshowList :: [POp] -> ShowS
showList :: [POp] -> ShowS
Show, POp -> POp -> Bool
(POp -> POp -> Bool) -> (POp -> POp -> Bool) -> Eq POp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: POp -> POp -> Bool
== :: POp -> POp -> Bool
$c/= :: POp -> POp -> Bool
/= :: POp -> POp -> Bool
Eq, Eq POp
Eq POp =>
(POp -> POp -> Ordering)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> Bool)
-> (POp -> POp -> POp)
-> (POp -> POp -> POp)
-> Ord POp
POp -> POp -> Bool
POp -> POp -> Ordering
POp -> POp -> POp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: POp -> POp -> Ordering
compare :: POp -> POp -> Ordering
$c< :: POp -> POp -> Bool
< :: POp -> POp -> Bool
$c<= :: POp -> POp -> Bool
<= :: POp -> POp -> Bool
$c> :: POp -> POp -> Bool
> :: POp -> POp -> Bool
$c>= :: POp -> POp -> Bool
>= :: POp -> POp -> Bool
$cmax :: POp -> POp -> POp
max :: POp -> POp -> POp
$cmin :: POp -> POp -> POp
min :: POp -> POp -> POp
Ord, Int -> POp
POp -> Int
POp -> [POp]
POp -> POp
POp -> POp -> [POp]
POp -> POp -> POp -> [POp]
(POp -> POp)
-> (POp -> POp)
-> (Int -> POp)
-> (POp -> Int)
-> (POp -> [POp])
-> (POp -> POp -> [POp])
-> (POp -> POp -> [POp])
-> (POp -> POp -> POp -> [POp])
-> Enum POp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: POp -> POp
succ :: POp -> POp
$cpred :: POp -> POp
pred :: POp -> POp
$ctoEnum :: Int -> POp
toEnum :: Int -> POp
$cfromEnum :: POp -> Int
fromEnum :: POp -> Int
$cenumFrom :: POp -> [POp]
enumFrom :: POp -> [POp]
$cenumFromThen :: POp -> POp -> [POp]
enumFromThen :: POp -> POp -> [POp]
$cenumFromTo :: POp -> POp -> [POp]
enumFromTo :: POp -> POp -> [POp]
$cenumFromThenTo :: POp -> POp -> POp -> [POp]
enumFromThenTo :: POp -> POp -> POp -> [POp]
Enum, POp
POp -> POp -> Bounded POp
forall a. a -> a -> Bounded a
$cminBound :: POp
minBound :: POp
$cmaxBound :: POp
maxBound :: POp
Bounded)

type ANormal ref = ABTN.Term (ANormalF ref)

type Cte v = CTE v (ANormal Reference v)

type Ctx v = Directed () [Cte v]

data Direction a = Indirect a | Direct
  deriving (Direction a -> Direction a -> Bool
(Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool) -> Eq (Direction a)
forall a. Eq a => Direction a -> Direction a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Direction a -> Direction a -> Bool
== :: Direction a -> Direction a -> Bool
$c/= :: forall a. Eq a => Direction a -> Direction a -> Bool
/= :: Direction a -> Direction a -> Bool
Eq, Eq (Direction a)
Eq (Direction a) =>
(Direction a -> Direction a -> Ordering)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Bool)
-> (Direction a -> Direction a -> Direction a)
-> (Direction a -> Direction a -> Direction a)
-> Ord (Direction a)
Direction a -> Direction a -> Bool
Direction a -> Direction a -> Ordering
Direction a -> Direction a -> Direction a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Direction a)
forall a. Ord a => Direction a -> Direction a -> Bool
forall a. Ord a => Direction a -> Direction a -> Ordering
forall a. Ord a => Direction a -> Direction a -> Direction a
$ccompare :: forall a. Ord a => Direction a -> Direction a -> Ordering
compare :: Direction a -> Direction a -> Ordering
$c< :: forall a. Ord a => Direction a -> Direction a -> Bool
< :: Direction a -> Direction a -> Bool
$c<= :: forall a. Ord a => Direction a -> Direction a -> Bool
<= :: Direction a -> Direction a -> Bool
$c> :: forall a. Ord a => Direction a -> Direction a -> Bool
> :: Direction a -> Direction a -> Bool
$c>= :: forall a. Ord a => Direction a -> Direction a -> Bool
>= :: Direction a -> Direction a -> Bool
$cmax :: forall a. Ord a => Direction a -> Direction a -> Direction a
max :: Direction a -> Direction a -> Direction a
$cmin :: forall a. Ord a => Direction a -> Direction a -> Direction a
min :: Direction a -> Direction a -> Direction a
Ord, Int -> Direction a -> ShowS
[Direction a] -> ShowS
Direction a -> String
(Int -> Direction a -> ShowS)
-> (Direction a -> String)
-> ([Direction a] -> ShowS)
-> Show (Direction a)
forall a. Show a => Int -> Direction a -> ShowS
forall a. Show a => [Direction a] -> ShowS
forall a. Show a => Direction a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Direction a -> ShowS
showsPrec :: Int -> Direction a -> ShowS
$cshow :: forall a. Show a => Direction a -> String
show :: Direction a -> String
$cshowList :: forall a. Show a => [Direction a] -> ShowS
showList :: [Direction a] -> ShowS
Show, (forall a b. (a -> b) -> Direction a -> Direction b)
-> (forall a b. a -> Direction b -> Direction a)
-> Functor Direction
forall a b. a -> Direction b -> Direction a
forall a b. (a -> b) -> Direction a -> Direction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Direction a -> Direction b
fmap :: forall a b. (a -> b) -> Direction a -> Direction b
$c<$ :: forall a b. a -> Direction b -> Direction a
<$ :: forall a b. a -> Direction b -> Direction a
Functor, (forall m. Monoid m => Direction m -> m)
-> (forall m a. Monoid m => (a -> m) -> Direction a -> m)
-> (forall m a. Monoid m => (a -> m) -> Direction a -> m)
-> (forall a b. (a -> b -> b) -> b -> Direction a -> b)
-> (forall a b. (a -> b -> b) -> b -> Direction a -> b)
-> (forall b a. (b -> a -> b) -> b -> Direction a -> b)
-> (forall b a. (b -> a -> b) -> b -> Direction a -> b)
-> (forall a. (a -> a -> a) -> Direction a -> a)
-> (forall a. (a -> a -> a) -> Direction a -> a)
-> (forall a. Direction a -> [a])
-> (forall a. Direction a -> Bool)
-> (forall a. Direction a -> Int)
-> (forall a. Eq a => a -> Direction a -> Bool)
-> (forall a. Ord a => Direction a -> a)
-> (forall a. Ord a => Direction a -> a)
-> (forall a. Num a => Direction a -> a)
-> (forall a. Num a => Direction a -> a)
-> Foldable Direction
forall a. Eq a => a -> Direction a -> Bool
forall a. Num a => Direction a -> a
forall a. Ord a => Direction a -> a
forall m. Monoid m => Direction m -> m
forall a. Direction a -> Bool
forall a. Direction a -> Int
forall a. Direction a -> [a]
forall a. (a -> a -> a) -> Direction a -> a
forall m a. Monoid m => (a -> m) -> Direction a -> m
forall b a. (b -> a -> b) -> b -> Direction a -> b
forall a b. (a -> b -> b) -> b -> Direction a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Direction m -> m
fold :: forall m. Monoid m => Direction m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Direction a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Direction a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Direction a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Direction a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Direction a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Direction a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Direction a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Direction a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Direction a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Direction a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Direction a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Direction a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Direction a -> a
foldr1 :: forall a. (a -> a -> a) -> Direction a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Direction a -> a
foldl1 :: forall a. (a -> a -> a) -> Direction a -> a
$ctoList :: forall a. Direction a -> [a]
toList :: forall a. Direction a -> [a]
$cnull :: forall a. Direction a -> Bool
null :: forall a. Direction a -> Bool
$clength :: forall a. Direction a -> Int
length :: forall a. Direction a -> Int
$celem :: forall a. Eq a => a -> Direction a -> Bool
elem :: forall a. Eq a => a -> Direction a -> Bool
$cmaximum :: forall a. Ord a => Direction a -> a
maximum :: forall a. Ord a => Direction a -> a
$cminimum :: forall a. Ord a => Direction a -> a
minimum :: forall a. Ord a => Direction a -> a
$csum :: forall a. Num a => Direction a -> a
sum :: forall a. Num a => Direction a -> a
$cproduct :: forall a. Num a => Direction a -> a
product :: forall a. Num a => Direction a -> a
Foldable, Functor Direction
Foldable Direction
(Functor Direction, Foldable Direction) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Direction a -> f (Direction b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Direction (f a) -> f (Direction a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Direction a -> m (Direction b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Direction (m a) -> m (Direction a))
-> Traversable Direction
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a)
forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Direction a -> f (Direction b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Direction (f a) -> f (Direction a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Direction a -> m (Direction b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Direction (m a) -> m (Direction a)
Traversable)

directed :: (Foldable f) => f (Cte v) -> Directed () (f (Cte v))
directed :: forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed f (Cte v)
x = ((Cte v -> Direction ()) -> f (Cte v) -> Direction ()
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Cte v -> Direction ()
forall {v} {s}. CTE v s -> Direction ()
f f (Cte v)
x, f (Cte v)
x)
  where
    f :: CTE v s -> Direction ()
f (ST Direction Word16
d [v]
_ [Mem]
_ s
_) = () () -> Direction Word16 -> Direction ()
forall a b. a -> Direction b -> Direction a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Direction Word16
d
    f CTE v s
_ = Direction ()
forall a. Direction a
Direct

instance (Semigroup a) => Semigroup (Direction a) where
  Indirect a
l <> :: Direction a -> Direction a -> Direction a
<> Indirect a
r = a -> Direction a
forall a. a -> Direction a
Indirect (a -> Direction a) -> a -> Direction a
forall a b. (a -> b) -> a -> b
$ a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r
  Direction a
Direct <> Direction a
r = Direction a
r
  Direction a
l <> Direction a
Direct = Direction a
l

instance (Semigroup a) => Monoid (Direction a) where
  mempty :: Direction a
mempty = Direction a
forall a. Direction a
Direct

type Directed a = (,) (Direction a)

type DNormal v = Directed () (ANormal Reference v)

-- Should be a completely closed term
data SuperNormal ref v = Lambda {forall ref v. SuperNormal ref v -> [Mem]
conventions :: [Mem], forall ref v. SuperNormal ref v -> ANormal ref v
bound :: ANormal ref v}
  deriving (Int -> SuperNormal ref v -> ShowS
[SuperNormal ref v] -> ShowS
SuperNormal ref v -> String
(Int -> SuperNormal ref v -> ShowS)
-> (SuperNormal ref v -> String)
-> ([SuperNormal ref v] -> ShowS)
-> Show (SuperNormal ref v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ref v.
(Show v, Show ref) =>
Int -> SuperNormal ref v -> ShowS
forall ref v. (Show v, Show ref) => [SuperNormal ref v] -> ShowS
forall ref v. (Show v, Show ref) => SuperNormal ref v -> String
$cshowsPrec :: forall ref v.
(Show v, Show ref) =>
Int -> SuperNormal ref v -> ShowS
showsPrec :: Int -> SuperNormal ref v -> ShowS
$cshow :: forall ref v. (Show v, Show ref) => SuperNormal ref v -> String
show :: SuperNormal ref v -> String
$cshowList :: forall ref v. (Show v, Show ref) => [SuperNormal ref v] -> ShowS
showList :: [SuperNormal ref v] -> ShowS
Show, SuperNormal ref v -> SuperNormal ref v -> Bool
(SuperNormal ref v -> SuperNormal ref v -> Bool)
-> (SuperNormal ref v -> SuperNormal ref v -> Bool)
-> Eq (SuperNormal ref v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ref v.
(Var v, Eq ref) =>
SuperNormal ref v -> SuperNormal ref v -> Bool
$c== :: forall ref v.
(Var v, Eq ref) =>
SuperNormal ref v -> SuperNormal ref v -> Bool
== :: SuperNormal ref v -> SuperNormal ref v -> Bool
$c/= :: forall ref v.
(Var v, Eq ref) =>
SuperNormal ref v -> SuperNormal ref v -> Bool
/= :: SuperNormal ref v -> SuperNormal ref v -> Bool
Eq)

data SuperGroup ref v = Rec
  { forall ref v. SuperGroup ref v -> [(v, SuperNormal ref v)]
group :: [(v, SuperNormal ref v)],
    forall ref v. SuperGroup ref v -> SuperNormal ref v
entry :: SuperNormal ref v
  }
  deriving (Int -> SuperGroup ref v -> ShowS
[SuperGroup ref v] -> ShowS
SuperGroup ref v -> String
(Int -> SuperGroup ref v -> ShowS)
-> (SuperGroup ref v -> String)
-> ([SuperGroup ref v] -> ShowS)
-> Show (SuperGroup ref v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ref v.
(Show v, Show ref) =>
Int -> SuperGroup ref v -> ShowS
forall ref v. (Show v, Show ref) => [SuperGroup ref v] -> ShowS
forall ref v. (Show v, Show ref) => SuperGroup ref v -> String
$cshowsPrec :: forall ref v.
(Show v, Show ref) =>
Int -> SuperGroup ref v -> ShowS
showsPrec :: Int -> SuperGroup ref v -> ShowS
$cshow :: forall ref v. (Show v, Show ref) => SuperGroup ref v -> String
show :: SuperGroup ref v -> String
$cshowList :: forall ref v. (Show v, Show ref) => [SuperGroup ref v] -> ShowS
showList :: [SuperGroup ref v] -> ShowS
Show)

-- | Whether the evaluation of a given definition is cacheable or not.
-- i.e. it's a top-level pure value.
data Cacheability = Cacheable | Uncacheable
  deriving stock (Cacheability -> Cacheability -> Bool
(Cacheability -> Cacheability -> Bool)
-> (Cacheability -> Cacheability -> Bool) -> Eq Cacheability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cacheability -> Cacheability -> Bool
== :: Cacheability -> Cacheability -> Bool
$c/= :: Cacheability -> Cacheability -> Bool
/= :: Cacheability -> Cacheability -> Bool
Eq, Int -> Cacheability -> ShowS
[Cacheability] -> ShowS
Cacheability -> String
(Int -> Cacheability -> ShowS)
-> (Cacheability -> String)
-> ([Cacheability] -> ShowS)
-> Show Cacheability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cacheability -> ShowS
showsPrec :: Int -> Cacheability -> ShowS
$cshow :: Cacheability -> String
show :: Cacheability -> String
$cshowList :: [Cacheability] -> ShowS
showList :: [Cacheability] -> ShowS
Show)

instance (Ord ref, Var v) => Eq (SuperGroup ref v) where
  SuperGroup ref v
g0 == :: SuperGroup ref v -> SuperGroup ref v -> Bool
== SuperGroup ref v
g1 | Left SGEqv ref v
_ <- SuperGroup ref v -> SuperGroup ref v -> Either (SGEqv ref v) ()
forall ref v.
(Ord ref, Var v) =>
SuperGroup ref v -> SuperGroup ref v -> Either (SGEqv ref v) ()
equivocate SuperGroup ref v
g0 SuperGroup ref v
g1 = Bool
False | Bool
otherwise = Bool
True

-- Failure modes for SuperGroup alpha equivalence test
data SGEqv ref v
  = -- mismatch number of definitions in group
    NumDefns (SuperGroup ref v) (SuperGroup ref v)
  | -- mismatched SuperNormal calling conventions
    DefnConventions (SuperNormal ref v) (SuperNormal ref v)
  | -- mismatched subterms in corresponding definition
    Subterms (ANormal ref v) (ANormal ref v)

-- Yields the number of arguments directly accepted by a combinator.
arity :: SuperNormal ref v -> Int
arity :: forall ref v. SuperNormal ref v -> Int
arity (Lambda [Mem]
ccs ANormal ref v
_) = [Mem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Mem]
ccs

-- Yields the numbers of arguments directly accepted by the
-- combinators in a group. The main entry is the first element, and
-- local bindings follow in their original order.
arities :: SuperGroup ref v -> [Int]
arities :: forall ref v. SuperGroup ref v -> [Int]
arities (Rec [(v, SuperNormal ref v)]
bs SuperNormal ref v
e) = SuperNormal ref v -> Int
forall ref v. SuperNormal ref v -> Int
arity SuperNormal ref v
e Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((v, SuperNormal ref v) -> Int)
-> [(v, SuperNormal ref v)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SuperNormal ref v -> Int
forall ref v. SuperNormal ref v -> Int
arity (SuperNormal ref v -> Int)
-> ((v, SuperNormal ref v) -> SuperNormal ref v)
-> (v, SuperNormal ref v)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, SuperNormal ref v) -> SuperNormal ref v
forall a b. (a, b) -> b
snd) [(v, SuperNormal ref v)]
bs

-- Checks if two SuperGroups are equivalent up to renaming. The rest
-- of the structure must match on the nose. If the two groups are not
-- equivalent, an example of conflicting structure is returned.
equivocate ::
  (Ord ref, Var v) =>
  SuperGroup ref v ->
  SuperGroup ref v ->
  Either (SGEqv ref v) ()
equivocate :: forall ref v.
(Ord ref, Var v) =>
SuperGroup ref v -> SuperGroup ref v -> Either (SGEqv ref v) ()
equivocate g0 :: SuperGroup ref v
g0@(Rec [(v, SuperNormal ref v)]
bs0 SuperNormal ref v
e0) g1 :: SuperGroup ref v
g1@(Rec [(v, SuperNormal ref v)]
bs1 SuperNormal ref v
e1)
  | [(v, SuperNormal ref v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(v, SuperNormal ref v)]
bs0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(v, SuperNormal ref v)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(v, SuperNormal ref v)]
bs1 =
      ((SuperNormal ref v, SuperNormal ref v) -> Either (SGEqv ref v) ())
-> [(SuperNormal ref v, SuperNormal ref v)]
-> Either (SGEqv ref v) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SuperNormal ref v, SuperNormal ref v) -> Either (SGEqv ref v) ()
eqvSN ([SuperNormal ref v]
-> [SuperNormal ref v] -> [(SuperNormal ref v, SuperNormal ref v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SuperNormal ref v]
ns0 [SuperNormal ref v]
ns1) Either (SGEqv ref v) ()
-> Either (SGEqv ref v) () -> Either (SGEqv ref v) ()
forall a b.
Either (SGEqv ref v) a
-> Either (SGEqv ref v) b -> Either (SGEqv ref v) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SuperNormal ref v, SuperNormal ref v) -> Either (SGEqv ref v) ()
eqvSN (SuperNormal ref v
e0, SuperNormal ref v
e1)
  | Bool
otherwise = SGEqv ref v -> Either (SGEqv ref v) ()
forall a b. a -> Either a b
Left (SGEqv ref v -> Either (SGEqv ref v) ())
-> SGEqv ref v -> Either (SGEqv ref v) ()
forall a b. (a -> b) -> a -> b
$ SuperGroup ref v -> SuperGroup ref v -> SGEqv ref v
forall ref v. SuperGroup ref v -> SuperGroup ref v -> SGEqv ref v
NumDefns SuperGroup ref v
g0 SuperGroup ref v
g1
  where
    ([v]
vs0, [SuperNormal ref v]
ns0) = [(v, SuperNormal ref v)] -> ([v], [SuperNormal ref v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal ref v)]
bs0
    ([v]
vs1, [SuperNormal ref v]
ns1) = [(v, SuperNormal ref v)] -> ([v], [SuperNormal ref v])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, SuperNormal ref v)]
bs1
    vm :: Map v v
vm = [(v, v)] -> Map v v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([v] -> [v] -> [(v, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs1 [v]
vs0)

    promote :: Either (ANormal ref v, ANormal ref v) b -> Either (SGEqv ref v) b
promote (Left (ANormal ref v
l, ANormal ref v
r)) = SGEqv ref v -> Either (SGEqv ref v) b
forall a b. a -> Either a b
Left (SGEqv ref v -> Either (SGEqv ref v) b)
-> SGEqv ref v -> Either (SGEqv ref v) b
forall a b. (a -> b) -> a -> b
$ ANormal ref v -> ANormal ref v -> SGEqv ref v
forall ref v. ANormal ref v -> ANormal ref v -> SGEqv ref v
Subterms ANormal ref v
l ANormal ref v
r
    promote (Right b
v) = b -> Either (SGEqv ref v) b
forall a b. b -> Either a b
Right b
v

    eqvSN :: (SuperNormal ref v, SuperNormal ref v) -> Either (SGEqv ref v) ()
eqvSN (Lambda [Mem]
ccs0 ANormal ref v
e0, Lambda [Mem]
ccs1 ANormal ref v
e1)
      | [Mem]
ccs0 [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== [Mem]
ccs1 = Either (ANormal ref v, ANormal ref v) () -> Either (SGEqv ref v) ()
forall {ref} {v} {b}.
Either (ANormal ref v, ANormal ref v) b -> Either (SGEqv ref v) b
promote (Either (ANormal ref v, ANormal ref v) ()
 -> Either (SGEqv ref v) ())
-> Either (ANormal ref v, ANormal ref v) ()
-> Either (SGEqv ref v) ()
forall a b. (a -> b) -> a -> b
$ Map v v
-> ANormal ref v
-> ANormal ref v
-> Either (ANormal ref v, ANormal ref v) ()
forall (f :: * -> * -> *) v.
(Align f, Var v) =>
Map v v -> Term f v -> Term f v -> Either (Term f v, Term f v) ()
ABTN.alpha Map v v
vm ANormal ref v
e0 ANormal ref v
e1
    eqvSN (SuperNormal ref v
n0, SuperNormal ref v
n1) = SGEqv ref v -> Either (SGEqv ref v) ()
forall a b. a -> Either a b
Left (SGEqv ref v -> Either (SGEqv ref v) ())
-> SGEqv ref v -> Either (SGEqv ref v) ()
forall a b. (a -> b) -> a -> b
$ SuperNormal ref v -> SuperNormal ref v -> SGEqv ref v
forall ref v. SuperNormal ref v -> SuperNormal ref v -> SGEqv ref v
DefnConventions SuperNormal ref v
n0 SuperNormal ref v
n1

type ANFM v =
  ReaderT
    (Set v)
    (State (Word64, Word16, [(v, SuperNormal Reference v)]))

type ANFD v = Compose (ANFM v) (Directed ())

data GroupRef ref = GR ref Word64
  deriving ((forall a b. (a -> b) -> GroupRef a -> GroupRef b)
-> (forall a b. a -> GroupRef b -> GroupRef a) -> Functor GroupRef
forall a b. a -> GroupRef b -> GroupRef a
forall a b. (a -> b) -> GroupRef a -> GroupRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GroupRef a -> GroupRef b
fmap :: forall a b. (a -> b) -> GroupRef a -> GroupRef b
$c<$ :: forall a b. a -> GroupRef b -> GroupRef a
<$ :: forall a b. a -> GroupRef b -> GroupRef a
Functor, (forall m. Monoid m => GroupRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> GroupRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> GroupRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> GroupRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> GroupRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GroupRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> GroupRef a -> b)
-> (forall a. (a -> a -> a) -> GroupRef a -> a)
-> (forall a. (a -> a -> a) -> GroupRef a -> a)
-> (forall a. GroupRef a -> [a])
-> (forall a. GroupRef a -> Bool)
-> (forall a. GroupRef a -> Int)
-> (forall a. Eq a => a -> GroupRef a -> Bool)
-> (forall a. Ord a => GroupRef a -> a)
-> (forall a. Ord a => GroupRef a -> a)
-> (forall a. Num a => GroupRef a -> a)
-> (forall a. Num a => GroupRef a -> a)
-> Foldable GroupRef
forall a. Eq a => a -> GroupRef a -> Bool
forall a. Num a => GroupRef a -> a
forall a. Ord a => GroupRef a -> a
forall m. Monoid m => GroupRef m -> m
forall a. GroupRef a -> Bool
forall a. GroupRef a -> Int
forall a. GroupRef a -> [a]
forall a. (a -> a -> a) -> GroupRef a -> a
forall m a. Monoid m => (a -> m) -> GroupRef a -> m
forall b a. (b -> a -> b) -> b -> GroupRef a -> b
forall a b. (a -> b -> b) -> b -> GroupRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GroupRef m -> m
fold :: forall m. Monoid m => GroupRef m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GroupRef a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GroupRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GroupRef a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GroupRef a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GroupRef a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GroupRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GroupRef a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GroupRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GroupRef a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GroupRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GroupRef a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GroupRef a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GroupRef a -> a
foldr1 :: forall a. (a -> a -> a) -> GroupRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GroupRef a -> a
foldl1 :: forall a. (a -> a -> a) -> GroupRef a -> a
$ctoList :: forall a. GroupRef a -> [a]
toList :: forall a. GroupRef a -> [a]
$cnull :: forall a. GroupRef a -> Bool
null :: forall a. GroupRef a -> Bool
$clength :: forall a. GroupRef a -> Int
length :: forall a. GroupRef a -> Int
$celem :: forall a. Eq a => a -> GroupRef a -> Bool
elem :: forall a. Eq a => a -> GroupRef a -> Bool
$cmaximum :: forall a. Ord a => GroupRef a -> a
maximum :: forall a. Ord a => GroupRef a -> a
$cminimum :: forall a. Ord a => GroupRef a -> a
minimum :: forall a. Ord a => GroupRef a -> a
$csum :: forall a. Num a => GroupRef a -> a
sum :: forall a. Num a => GroupRef a -> a
$cproduct :: forall a. Num a => GroupRef a -> a
product :: forall a. Num a => GroupRef a -> a
Foldable, Functor GroupRef
Foldable GroupRef
(Functor GroupRef, Foldable GroupRef) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GroupRef a -> f (GroupRef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GroupRef (f a) -> f (GroupRef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GroupRef a -> m (GroupRef b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GroupRef (m a) -> m (GroupRef a))
-> Traversable GroupRef
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => GroupRef (m a) -> m (GroupRef a)
forall (f :: * -> *) a.
Applicative f =>
GroupRef (f a) -> f (GroupRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GroupRef a -> m (GroupRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GroupRef a -> f (GroupRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GroupRef a -> f (GroupRef b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GroupRef a -> f (GroupRef b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GroupRef (f a) -> f (GroupRef a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GroupRef (f a) -> f (GroupRef a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GroupRef a -> m (GroupRef b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GroupRef a -> m (GroupRef b)
$csequence :: forall (m :: * -> *) a. Monad m => GroupRef (m a) -> m (GroupRef a)
sequence :: forall (m :: * -> *) a. Monad m => GroupRef (m a) -> m (GroupRef a)
Traversable, Int -> GroupRef ref -> ShowS
[GroupRef ref] -> ShowS
GroupRef ref -> String
(Int -> GroupRef ref -> ShowS)
-> (GroupRef ref -> String)
-> ([GroupRef ref] -> ShowS)
-> Show (GroupRef ref)
forall ref. Show ref => Int -> GroupRef ref -> ShowS
forall ref. Show ref => [GroupRef ref] -> ShowS
forall ref. Show ref => GroupRef ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> GroupRef ref -> ShowS
showsPrec :: Int -> GroupRef ref -> ShowS
$cshow :: forall ref. Show ref => GroupRef ref -> String
show :: GroupRef ref -> String
$cshowList :: forall ref. Show ref => [GroupRef ref] -> ShowS
showList :: [GroupRef ref] -> ShowS
Show, GroupRef ref -> GroupRef ref -> Bool
(GroupRef ref -> GroupRef ref -> Bool)
-> (GroupRef ref -> GroupRef ref -> Bool) -> Eq (GroupRef ref)
forall ref. Eq ref => GroupRef ref -> GroupRef ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref. Eq ref => GroupRef ref -> GroupRef ref -> Bool
== :: GroupRef ref -> GroupRef ref -> Bool
$c/= :: forall ref. Eq ref => GroupRef ref -> GroupRef ref -> Bool
/= :: GroupRef ref -> GroupRef ref -> Bool
Eq)

-- | A list of either unboxed or boxed values.
-- Each slot is one of unboxed or boxed but not both.
type ValList ref = [Value ref]

data Value ref
  = Partial (GroupRef ref) (ValList ref)
  | Data ref Word64 (ValList ref)
  | Cont (ValList ref) (Cont ref)
  | BLit (BLit ref)
  deriving (Int -> Value ref -> ShowS
[Value ref] -> ShowS
Value ref -> String
(Int -> Value ref -> ShowS)
-> (Value ref -> String)
-> ([Value ref] -> ShowS)
-> Show (Value ref)
forall ref. Show ref => Int -> Value ref -> ShowS
forall ref. Show ref => [Value ref] -> ShowS
forall ref. Show ref => Value ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> Value ref -> ShowS
showsPrec :: Int -> Value ref -> ShowS
$cshow :: forall ref. Show ref => Value ref -> String
show :: Value ref -> String
$cshowList :: forall ref. Show ref => [Value ref] -> ShowS
showList :: [Value ref] -> ShowS
Show, Value ref -> Value ref -> Bool
(Value ref -> Value ref -> Bool)
-> (Value ref -> Value ref -> Bool) -> Eq (Value ref)
forall ref. Ord ref => Value ref -> Value ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref. Ord ref => Value ref -> Value ref -> Bool
== :: Value ref -> Value ref -> Bool
$c/= :: forall ref. Ord ref => Value ref -> Value ref -> Bool
/= :: Value ref -> Value ref -> Bool
Eq)

-- Since we can now track cacheability of supergroups, this type
-- pairs the two together. This is the type that should be used
-- as the representation of unison Code values rather than the
-- previous `SuperGroup Symbol`.
data Code ref = CodeRep (SuperGroup ref Symbol) Cacheability
  deriving (Int -> Code ref -> ShowS
[Code ref] -> ShowS
Code ref -> String
(Int -> Code ref -> ShowS)
-> (Code ref -> String) -> ([Code ref] -> ShowS) -> Show (Code ref)
forall ref. Show ref => Int -> Code ref -> ShowS
forall ref. Show ref => [Code ref] -> ShowS
forall ref. Show ref => Code ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> Code ref -> ShowS
showsPrec :: Int -> Code ref -> ShowS
$cshow :: forall ref. Show ref => Code ref -> String
show :: Code ref -> String
$cshowList :: forall ref. Show ref => [Code ref] -> ShowS
showList :: [Code ref] -> ShowS
Show)

codeGroup :: Code ref -> SuperGroup ref Symbol
codeGroup :: forall ref. Code ref -> SuperGroup ref Symbol
codeGroup (CodeRep SuperGroup ref Symbol
sg Cacheability
_) = SuperGroup ref Symbol
sg

instance (Ord ref) => Eq (Code ref) where
  CodeRep SuperGroup ref Symbol
sg1 Cacheability
_ == :: Code ref -> Code ref -> Bool
== CodeRep SuperGroup ref Symbol
sg2 Cacheability
_ = SuperGroup ref Symbol
sg1 SuperGroup ref Symbol -> SuperGroup ref Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== SuperGroup ref Symbol
sg2

overGroup ::
  (SuperGroup ref0 Symbol -> SuperGroup ref1 Symbol) ->
  Code ref0 ->
  Code ref1
overGroup :: forall ref0 ref1.
(SuperGroup ref0 Symbol -> SuperGroup ref1 Symbol)
-> Code ref0 -> Code ref1
overGroup SuperGroup ref0 Symbol -> SuperGroup ref1 Symbol
f (CodeRep SuperGroup ref0 Symbol
sg Cacheability
ch) = SuperGroup ref1 Symbol -> Cacheability -> Code ref1
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep (SuperGroup ref0 Symbol -> SuperGroup ref1 Symbol
f SuperGroup ref0 Symbol
sg) Cacheability
ch

foldGroup ::
  (Monoid m) => (SuperGroup ref Symbol -> m) -> Code ref -> m
foldGroup :: forall m ref.
Monoid m =>
(SuperGroup ref Symbol -> m) -> Code ref -> m
foldGroup SuperGroup ref Symbol -> m
f (CodeRep SuperGroup ref Symbol
sg Cacheability
_) = SuperGroup ref Symbol -> m
f SuperGroup ref Symbol
sg

traverseGroup ::
  (Applicative f) =>
  (SuperGroup ref0 Symbol -> f (SuperGroup ref1 Symbol)) ->
  Code ref0 ->
  f (Code ref1)
traverseGroup :: forall (f :: * -> *) ref0 ref1.
Applicative f =>
(SuperGroup ref0 Symbol -> f (SuperGroup ref1 Symbol))
-> Code ref0 -> f (Code ref1)
traverseGroup SuperGroup ref0 Symbol -> f (SuperGroup ref1 Symbol)
f (CodeRep SuperGroup ref0 Symbol
sg Cacheability
ch) = (SuperGroup ref1 Symbol -> Cacheability -> Code ref1)
-> Cacheability -> SuperGroup ref1 Symbol -> Code ref1
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup ref1 Symbol -> Cacheability -> Code ref1
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep Cacheability
ch (SuperGroup ref1 Symbol -> Code ref1)
-> f (SuperGroup ref1 Symbol) -> f (Code ref1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuperGroup ref0 Symbol -> f (SuperGroup ref1 Symbol)
f SuperGroup ref0 Symbol
sg

instance Referential Code where
  overRefs :: forall r s. (Bool -> r -> s) -> Code r -> Code s
overRefs Bool -> r -> s
f (CodeRep SuperGroup r Symbol
sg Cacheability
ch) = SuperGroup s Symbol -> Cacheability -> Code s
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep ((Bool -> r -> s) -> SuperGroup r Symbol -> SuperGroup s Symbol
forall v ref0 ref1.
Var v =>
(Bool -> ref0 -> ref1) -> SuperGroup ref0 v -> SuperGroup ref1 v
overGroupLinks Bool -> r -> s
f SuperGroup r Symbol
sg) Cacheability
ch
  foldMapRefs :: forall m r. Monoid m => (Bool -> r -> m) -> Code r -> m
foldMapRefs Bool -> r -> m
f (CodeRep SuperGroup r Symbol
sg Cacheability
_) = (Bool -> r -> m) -> SuperGroup r Symbol -> m
forall r v ref.
(Monoid r, Var v) =>
(Bool -> ref -> r) -> SuperGroup ref v -> r
foldGroupLinks Bool -> r -> m
f SuperGroup r Symbol
sg
  traverseRefs :: forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Code r -> f (Code s)
traverseRefs Bool -> r -> f s
f (CodeRep SuperGroup r Symbol
sg Cacheability
ch) =
    (SuperGroup s Symbol -> Cacheability -> Code s)
-> Cacheability -> SuperGroup s Symbol -> Code s
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperGroup s Symbol -> Cacheability -> Code s
forall ref. SuperGroup ref Symbol -> Cacheability -> Code ref
CodeRep Cacheability
ch (SuperGroup s Symbol -> Code s)
-> f (SuperGroup s Symbol) -> f (Code s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> r -> f s)
-> SuperGroup r Symbol -> f (SuperGroup s Symbol)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperGroup ref0 v -> f (SuperGroup ref1 v)
traverseGroupLinks Bool -> r -> f s
f SuperGroup r Symbol
sg

data Cont ref
  = KE
  | Mark
      Word64 -- pending args
      [ref]
      [(ref, Value ref)]
      (Cont ref)
  | Push
      Word64 -- Frame size
      Word64 -- Pending args
      (GroupRef ref)
      (Cont ref)
  deriving (Int -> Cont ref -> ShowS
[Cont ref] -> ShowS
Cont ref -> String
(Int -> Cont ref -> ShowS)
-> (Cont ref -> String) -> ([Cont ref] -> ShowS) -> Show (Cont ref)
forall ref. Show ref => Int -> Cont ref -> ShowS
forall ref. Show ref => [Cont ref] -> ShowS
forall ref. Show ref => Cont ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> Cont ref -> ShowS
showsPrec :: Int -> Cont ref -> ShowS
$cshow :: forall ref. Show ref => Cont ref -> String
show :: Cont ref -> String
$cshowList :: forall ref. Show ref => [Cont ref] -> ShowS
showList :: [Cont ref] -> ShowS
Show, Cont ref -> Cont ref -> Bool
(Cont ref -> Cont ref -> Bool)
-> (Cont ref -> Cont ref -> Bool) -> Eq (Cont ref)
forall ref. Ord ref => Cont ref -> Cont ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref. Ord ref => Cont ref -> Cont ref -> Bool
== :: Cont ref -> Cont ref -> Bool
$c/= :: forall ref. Ord ref => Cont ref -> Cont ref -> Bool
/= :: Cont ref -> Cont ref -> Bool
Eq)

data BLit ref
  = Text Util.Text.Text
  | List (Seq (Value ref))
  | TmLink (Rfn.Referent' ref)
  | TyLink ref
  | Bytes Bytes
  | Quote (Value ref)
  | Code (Code ref)
  | BArr PA.ByteArray
  | Arr (PA.Array (Value ref))
  | -- Despite the following being in the Boxed Literal type, they all represent unboxed values
    Pos Word64
  | Neg Word64
  | Char Char
  | Float Double
  | -- special cases for newer formats
    Map [(Value ref, Value ref)]
  deriving (Int -> BLit ref -> ShowS
[BLit ref] -> ShowS
BLit ref -> String
(Int -> BLit ref -> ShowS)
-> (BLit ref -> String) -> ([BLit ref] -> ShowS) -> Show (BLit ref)
forall ref. Show ref => Int -> BLit ref -> ShowS
forall ref. Show ref => [BLit ref] -> ShowS
forall ref. Show ref => BLit ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> BLit ref -> ShowS
showsPrec :: Int -> BLit ref -> ShowS
$cshow :: forall ref. Show ref => BLit ref -> String
show :: BLit ref -> String
$cshowList :: forall ref. Show ref => [BLit ref] -> ShowS
showList :: [BLit ref] -> ShowS
Show, BLit ref -> BLit ref -> Bool
(BLit ref -> BLit ref -> Bool)
-> (BLit ref -> BLit ref -> Bool) -> Eq (BLit ref)
forall ref. Ord ref => BLit ref -> BLit ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref. Ord ref => BLit ref -> BLit ref -> Bool
== :: BLit ref -> BLit ref -> Bool
$c/= :: forall ref. Ord ref => BLit ref -> BLit ref -> Bool
/= :: BLit ref -> BLit ref -> Bool
Eq)

groupVars :: ANFM v (Set v)
groupVars :: forall v. ANFM v (Set v)
groupVars = ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (Set v)
forall r (m :: * -> *). MonadReader r m => m r
ask

bindLocal :: (Ord v) => [v] -> ANFM v r -> ANFM v r
bindLocal :: forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs = (Set v -> Set v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     r
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     r
forall a.
(Set v -> Set v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs)

freshANF :: (Var v) => Word64 -> v
freshANF :: forall v. Var v => ConstructorId -> v
freshANF ConstructorId
fr = ConstructorId -> v -> v
forall v. Var v => ConstructorId -> v -> v
Var.freshenId ConstructorId
fr (v -> v) -> v -> v
forall a b. (a -> b) -> a -> b
$ Type -> v
forall v. Var v => Type -> v
typed Type
Var.ANFBlank

fresh :: (Var v) => ANFM v v
fresh :: forall v. Var v => ANFM v v
fresh = ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (v,
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     v
forall a.
((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (a,
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  -> (v,
      (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      v)
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (v,
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     v
forall a b. (a -> b) -> a -> b
$ \(ConstructorId
fr, Word16
bnd, [(v, SuperNormal TypeReference v)]
cs) -> (ConstructorId -> v
forall v. Var v => ConstructorId -> v
freshANF ConstructorId
fr, (ConstructorId
fr ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
1, Word16
bnd, [(v, SuperNormal TypeReference v)]
cs))

contextualize :: (Var v) => DNormal v -> ANFM v (Ctx v, v)
contextualize :: forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize (Direction ()
_, TVar v
cv) = do
  Set v
gvs <- ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars
  if v
cv v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set v
gvs
    then (Ctx v, v) -> ANFM v (Ctx v, v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], v
cv)
    else do
      v
bv <- ANFM v v
forall v. Var v => ANFM v v
fresh
      Direction Word16
d <- Word16 -> Direction Word16
forall a. a -> Direction a
Indirect (Word16 -> Direction Word16)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     Word16
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
forall v. ANFM v Word16
binder
      pure ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [Direction Word16 -> v -> Mem -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
bv Mem
BX (ANormal TypeReference v -> Cte v)
-> ANormal TypeReference v -> Cte v
forall a b. (a -> b) -> a -> b
$ v -> [v] -> ANormal TypeReference v
forall v ref. Var v => v -> [v] -> ANormal ref v
TApv v
cv []], v
bv)
contextualize (Direction ()
d0, ANormal TypeReference v
tm) = do
  v
fv <- ANFM v v
forall v. Var v => ANFM v v
fresh
  Direction Word16
d <- Direction ()
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction Word16)
forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection Direction ()
d0
  pure ((Direction ()
d0, [Direction Word16 -> v -> Mem -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
fv Mem
BX ANormal TypeReference v
tm]), v
fv)

binder :: ANFM v Word16
binder :: forall v. ANFM v Word16
binder = ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (Word16,
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     Word16
forall a.
((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (a,
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  -> (Word16,
      (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      Word16)
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (Word16,
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     Word16
forall a b. (a -> b) -> a -> b
$ \(ConstructorId
fr, Word16
bnd, [(v, SuperNormal TypeReference v)]
cs) -> (Word16
bnd, (ConstructorId
fr, Word16
bnd Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1, [(v, SuperNormal TypeReference v)]
cs))

bindDirection :: Direction a -> ANFM v (Direction Word16)
bindDirection :: forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection = (a
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      Word16)
-> Direction a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction Word16)
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) -> Direction a -> f (Direction b)
traverse (ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
-> a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     Word16
forall a b. a -> b -> a
const ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
forall v. ANFM v Word16
binder)

record :: (Var v) => (v, SuperNormal Reference v) -> ANFM v ()
record :: forall v. Var v => (v, SuperNormal TypeReference v) -> ANFM v ()
record (v, SuperNormal TypeReference v)
p = ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      ())
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ()
forall a b. (a -> b) -> a -> b
$ \(ConstructorId
fr, Word16
bnd, [(v, SuperNormal TypeReference v)]
to) -> (ConstructorId
fr, Word16
bnd, (v, SuperNormal TypeReference v)
p (v, SuperNormal TypeReference v)
-> [(v, SuperNormal TypeReference v)]
-> [(v, SuperNormal TypeReference v)]
forall a. a -> [a] -> [a]
: [(v, SuperNormal TypeReference v)]
to)

superNormalize :: (Var v) => Term v a -> SuperGroup Reference v
superNormalize :: forall v a. Var v => Term v a -> SuperGroup TypeReference v
superNormalize Term v a
tm = [(v, SuperNormal TypeReference v)]
-> SuperNormal TypeReference v -> SuperGroup TypeReference v
forall ref v.
[(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
Rec [(v, SuperNormal TypeReference v)]
l SuperNormal TypeReference v
c
  where
    ([(v, Term v a)]
bs, Term v a
e)
      | LetRecNamed' [(v, Term v a)]
bs Term v a
e <- Term v a
tm = ([(v, Term v a)]
bs, Term v a
e)
      | Bool
otherwise = ([], Term v a
tm)
    grp :: Set v
grp = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ (v, Term v a) -> v
forall a b. (a, b) -> a
fst ((v, Term v a) -> v) -> [(v, Term v a)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Term v a)]
bs
    comp :: ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (SuperNormal TypeReference v)
comp = ((v, Term v a)
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      ())
-> [(v, Term v a)]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (v, Term v a)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ()
forall v a. Var v => (v, Term v a) -> ANFM v ()
superBinding [(v, Term v a)]
bs ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  ()
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (SuperNormal TypeReference v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (SuperNormal TypeReference v)
forall a b.
ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (SuperNormal TypeReference v)
forall v a.
Var v =>
Term v a -> ANFM v (SuperNormal TypeReference v)
toSuperNormal Term v a
e
    subc :: State
  (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  (SuperNormal TypeReference v)
subc = ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (SuperNormal TypeReference v)
-> Set v
-> State
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
     (SuperNormal TypeReference v)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (SuperNormal TypeReference v)
comp Set v
grp
    (SuperNormal TypeReference v
c, (ConstructorId
_, Word16
_, [(v, SuperNormal TypeReference v)]
l)) = State
  (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  (SuperNormal TypeReference v)
-> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
-> (SuperNormal TypeReference v,
    (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
forall s a. State s a -> s -> (a, s)
runState State
  (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  (SuperNormal TypeReference v)
subc (ConstructorId
0, Word16
1, [])

superBinding :: (Var v) => (v, Term v a) -> ANFM v ()
superBinding :: forall v a. Var v => (v, Term v a) -> ANFM v ()
superBinding (v
v, Term v a
tm) = do
  SuperNormal TypeReference v
nf <- Term v a -> ANFM v (SuperNormal TypeReference v)
forall v a.
Var v =>
Term v a -> ANFM v (SuperNormal TypeReference v)
toSuperNormal Term v a
tm
  ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
-> ANFM v ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
 -> ANFM v ())
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
-> ANFM v ()
forall a b. (a -> b) -> a -> b
$ \(ConstructorId
cvs, Word16
bnd, [(v, SuperNormal TypeReference v)]
ctx) -> (ConstructorId
cvs, Word16
bnd, (v
v, SuperNormal TypeReference v
nf) (v, SuperNormal TypeReference v)
-> [(v, SuperNormal TypeReference v)]
-> [(v, SuperNormal TypeReference v)]
forall a. a -> [a] -> [a]
: [(v, SuperNormal TypeReference v)]
ctx)

toSuperNormal :: (Var v) => Term v a -> ANFM v (SuperNormal Reference v)
toSuperNormal :: forall v a.
Var v =>
Term v a -> ANFM v (SuperNormal TypeReference v)
toSuperNormal Term v a
tm = do
  Set v
grp <- ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars
  if Bool -> Bool
not (Bool -> Bool) -> (Set v -> Bool) -> Set v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> Bool
forall a. Set a -> Bool
Set.null (Set v -> Bool) -> (Set v -> Set v) -> Set v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set v
grp) (Set v -> Bool) -> Set v -> Bool
forall a b. (a -> b) -> a -> b
$ Term v a -> Set v
forall vt v a. Term' vt v a -> Set v
freeVars Term v a
tm
    then [Word] -> String -> ANFM v (SuperNormal TypeReference v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String -> ANFM v (SuperNormal TypeReference v))
-> String -> ANFM v (SuperNormal TypeReference v)
forall a b. (a -> b) -> a -> b
$ String
"free variables in supercombinator: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term v a -> String
forall a. Show a => a -> String
show Term v a
tm
    else
      [Mem] -> ANormal TypeReference v -> SuperNormal TypeReference v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
vs) (ANormal TypeReference v -> SuperNormal TypeReference v)
-> ((Direction (), ANormal TypeReference v)
    -> ANormal TypeReference v)
-> (Direction (), ANormal TypeReference v)
-> SuperNormal TypeReference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
vs (ANormal TypeReference v -> ANormal TypeReference v)
-> ((Direction (), ANormal TypeReference v)
    -> ANormal TypeReference v)
-> (Direction (), ANormal TypeReference v)
-> ANormal TypeReference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction (), ANormal TypeReference v) -> ANormal TypeReference v
forall a b. (a, b) -> b
snd
        ((Direction (), ANormal TypeReference v)
 -> SuperNormal TypeReference v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), ANormal TypeReference v)
-> ANFM v (SuperNormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), ANormal TypeReference v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), ANormal TypeReference v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs (Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), ANormal TypeReference v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
body)
  where
    ([v]
vs, Term v a
body) = ([v], Term v a) -> Maybe ([v], Term v a) -> ([v], Term v a)
forall a. a -> Maybe a -> a
fromMaybe ([], Term v a
tm) (Maybe ([v], Term v a) -> ([v], Term v a))
-> Maybe ([v], Term v a) -> ([v], Term v a)
forall a b. (a -> b) -> a -> b
$ Term v a -> Maybe ([v], Term v a)
forall vt at ap v a.
Term2 vt at ap v a -> Maybe ([v], Term2 vt at ap v a)
unLams' Term v a
tm

anfTerm :: (Var v) => Term v a -> ANFM v (DNormal v)
anfTerm :: forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
tm = ((Direction (), [Cte v]), (Direction (), ANormal TypeReference v))
-> (Direction (), ANormal TypeReference v)
forall {v} {a}.
Var v =>
((a, [Cte v]), (Direction (), ANormal TypeReference v))
-> (Direction (), ANormal TypeReference v)
f (((Direction (), [Cte v]), (Direction (), ANormal TypeReference v))
 -> (Direction (), ANormal TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ((Direction (), [Cte v]), (Direction (), ANormal TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     ((Direction (), [Cte v]), (Direction (), ANormal TypeReference v))
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
tm
  where
    -- f = uncurry (liftA2 TBinds)
    f :: ((a, [Cte v]), (Direction (), ANormal TypeReference v))
-> (Direction (), ANormal TypeReference v)
f ((a
_, []), (Direction (), ANormal TypeReference v)
dtm) = (Direction (), ANormal TypeReference v)
dtm
    f ((a
_, [Cte v]
cx), (Direction ()
_, ANormal TypeReference v
tm)) = (() -> Direction ()
forall a. a -> Direction a
Indirect (), [Cte v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v.
Var v =>
[Cte v] -> ANormal TypeReference v -> ANormal TypeReference v
TBinds [Cte v]
cx ANormal TypeReference v
tm)

floatableCtx :: (Var v) => Ctx v -> Bool
floatableCtx :: forall v. Var v => Ctx v -> Bool
floatableCtx = (CTE v (ANormal TypeReference v) -> Bool)
-> [CTE v (ANormal TypeReference v)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CTE v (ANormal TypeReference v) -> Bool
forall {v} {v} {ref}. Var v => CTE v (ANormal ref v) -> Bool
p ([CTE v (ANormal TypeReference v)] -> Bool)
-> (Ctx v -> [CTE v (ANormal TypeReference v)]) -> Ctx v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> [CTE v (ANormal TypeReference v)]
forall a b. (a, b) -> b
snd
  where
    p :: CTE v (ANormal ref v) -> Bool
p (LZ v
_ Either TypeReference v
_ [v]
_) = Bool
True
    p (ST Direction Word16
_ [v]
_ [Mem]
_ ANormal ref v
tm) = ANormal ref v -> Bool
forall {v} {ref}. Var v => ANormal ref v -> Bool
q ANormal ref v
tm
    q :: ANormal ref v -> Bool
q (TLit Lit ref
_) = Bool
True
    q (TVar v
_) = Bool
True
    q (TCon ref
_ CTag
_ [v]
_) = Bool
True
    q ANormal ref v
_ = Bool
False

anfHandled :: (Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled :: forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled Term v a
body =
  Term v a -> ANFM v (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
body ANFM v (Ctx v, DNormal v)
-> ((Ctx v, DNormal v) -> ANFM v (Ctx v, DNormal v))
-> ANFM v (Ctx v, DNormal v)
forall a b.
ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  a
-> (a
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         b)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Ctx v
ctx, (Direction ()
_, t :: ANormal TypeReference v
t@TCon {})) ->
      ANFM v v
forall v. Var v => ANFM v v
fresh ANFM v v -> (v -> (Ctx v, DNormal v)) -> ANFM v (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v ->
        (Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
v Mem
BX ANormal TypeReference v
t], ANormal TypeReference v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormal TypeReference v -> DNormal v)
-> ANormal TypeReference v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal TypeReference v
forall v ref. Var v => v -> ANormal ref v
TVar v
v)
    (Ctx v
ctx, (Direction ()
_, t :: ANormal TypeReference v
t@(TLit Lit TypeReference
l))) ->
      ANFM v v
forall v. Var v => ANFM v v
fresh ANFM v v -> (v -> (Ctx v, DNormal v)) -> ANFM v (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v
v ->
        (Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16 -> v -> Mem -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
v Mem
cc ANormal TypeReference v
t], ANormal TypeReference v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormal TypeReference v -> DNormal v)
-> ANormal TypeReference v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal TypeReference v
forall v ref. Var v => v -> ANormal ref v
TVar v
v)
      where
        cc :: Mem
cc = case Lit TypeReference
l of T {} -> Mem
BX; LM {} -> Mem
BX; LY {} -> Mem
BX; Lit TypeReference
_ -> Mem
UN
    (Ctx v, DNormal v)
p -> (Ctx v, DNormal v) -> ANFM v (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v, DNormal v)
p

pattern $mUFalse :: forall {r} {v}.
Var v =>
ANormal TypeReference v -> ((# #) -> r) -> ((# #) -> r) -> r
$bUFalse :: forall {v}. Var v => ANormal TypeReference v
UFalse <- TCon ((== Ty.booleanRef) -> True) 0 []
  where
    UFalse = TypeReference -> CTag -> [v] -> ANormal TypeReference v
forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TCon TypeReference
Ty.booleanRef CTag
0 []

pattern $mUTrue :: forall {r} {v}.
Var v =>
ANormal TypeReference v -> ((# #) -> r) -> ((# #) -> r) -> r
$bUTrue :: forall {v}. Var v => ANormal TypeReference v
UTrue <- TCon ((== Ty.booleanRef) -> True) 1 []
  where
    UTrue = TypeReference -> CTag -> [v] -> ANormal TypeReference v
forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TCon TypeReference
Ty.booleanRef CTag
1 []

-- Helper function for renaming a variable arising from a
--   let v = u
-- binding during ANF translation. Renames a variable in a
-- context, and returns an indication of whether the varible
-- was shadowed by one of the context bindings.
--
-- Note: this assumes that `u` is not bound by any of the context
-- entries, as no effort is made to rename them to avoid capturing
-- `u`.
renameCtx :: (Var v) => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx :: forall v. Var v => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx v
v v
u (Direction ()
d, [Cte v]
ctx) | ([Cte v]
ctx, Bool
b) <- v -> v -> [Cte v] -> ([Cte v], Bool)
forall v. Var v => v -> v -> [Cte v] -> ([Cte v], Bool)
renameCtes v
v v
u [Cte v]
ctx = ((Direction ()
d, [Cte v]
ctx), Bool
b)

-- As above, but without the Direction.
renameCtes :: (Var v) => v -> v -> [Cte v] -> ([Cte v], Bool)
renameCtes :: forall v. Var v => v -> v -> [Cte v] -> ([Cte v], Bool)
renameCtes v
v v
u = [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> ([CTE v (Term (ANormalF TypeReference) v)], Bool)
rn []
  where
    swap :: v -> v
swap v
w
      | v
w v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = v
u
      | Bool
otherwise = v
w

    rn :: [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> ([CTE v (Term (ANormalF TypeReference) v)], Bool)
rn [CTE v (Term (ANormalF TypeReference) v)]
acc [] = ([CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. [a] -> [a]
reverse [CTE v (Term (ANormalF TypeReference) v)]
acc, Bool
False)
    rn [CTE v (Term (ANormalF TypeReference) v)]
acc (ST Direction Word16
d [v]
vs [Mem]
ccs Term (ANormalF TypeReference) v
b : [CTE v (Term (ANormalF TypeReference) v)]
es)
      | (v -> Bool) -> [v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v) [v]
vs = ([CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. [a] -> [a]
reverse [CTE v (Term (ANormalF TypeReference) v)]
acc [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. [a] -> [a] -> [a]
++ CTE v (Term (ANormalF TypeReference) v)
e CTE v (Term (ANormalF TypeReference) v)
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. a -> [a] -> [a]
: [CTE v (Term (ANormalF TypeReference) v)]
es, Bool
True)
      | Bool
otherwise = [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> ([CTE v (Term (ANormalF TypeReference) v)], Bool)
rn (CTE v (Term (ANormalF TypeReference) v)
e CTE v (Term (ANormalF TypeReference) v)
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. a -> [a] -> [a]
: [CTE v (Term (ANormalF TypeReference) v)]
acc) [CTE v (Term (ANormalF TypeReference) v)]
es
      where
        e :: CTE v (Term (ANormalF TypeReference) v)
e = Direction Word16
-> [v]
-> [Mem]
-> Term (ANormalF TypeReference) v
-> CTE v (Term (ANormalF TypeReference) v)
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
vs [Mem]
ccs (Term (ANormalF TypeReference) v
 -> CTE v (Term (ANormalF TypeReference) v))
-> Term (ANormalF TypeReference) v
-> CTE v (Term (ANormalF TypeReference) v)
forall a b. (a -> b) -> a -> b
$ v
-> v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u Term (ANormalF TypeReference) v
b
    rn [CTE v (Term (ANormalF TypeReference) v)]
acc (LZ v
w Either TypeReference v
f [v]
as : [CTE v (Term (ANormalF TypeReference) v)]
es)
      | v
w v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = ([CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. [a] -> [a]
reverse [CTE v (Term (ANormalF TypeReference) v)]
acc [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. [a] -> [a] -> [a]
++ CTE v (Term (ANormalF TypeReference) v)
e CTE v (Term (ANormalF TypeReference) v)
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. a -> [a] -> [a]
: [CTE v (Term (ANormalF TypeReference) v)]
es, Bool
True)
      | Bool
otherwise = [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
-> ([CTE v (Term (ANormalF TypeReference) v)], Bool)
rn (CTE v (Term (ANormalF TypeReference) v)
e CTE v (Term (ANormalF TypeReference) v)
-> [CTE v (Term (ANormalF TypeReference) v)]
-> [CTE v (Term (ANormalF TypeReference) v)]
forall a. a -> [a] -> [a]
: [CTE v (Term (ANormalF TypeReference) v)]
acc) [CTE v (Term (ANormalF TypeReference) v)]
es
      where
        e :: CTE v (Term (ANormalF TypeReference) v)
e = v
-> Either TypeReference v
-> [v]
-> CTE v (Term (ANormalF TypeReference) v)
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
w (v -> v
swap (v -> v) -> Either TypeReference v -> Either TypeReference v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either TypeReference v
f) (v -> v
swap (v -> v) -> [v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
as)

-- Simultaneously renames variables in a list of context entries.
--
-- Assumes that the variables being renamed to are not bound by the
-- context entries, so that it is unnecessary to rename them.
renamesCtes :: (Var v) => Map v v -> [Cte v] -> [Cte v]
renamesCtes :: forall v. Var v => Map v v -> [Cte v] -> [Cte v]
renamesCtes Map v v
rn = (Cte v -> Cte v) -> [Cte v] -> [Cte v]
forall a b. (a -> b) -> [a] -> [b]
map Cte v -> Cte v
f
  where
    swap :: v -> v
swap v
w
      | Just v
u <- v -> Map v v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
w Map v v
rn = v
u
      | Bool
otherwise = v
w

    f :: Cte v -> Cte v
f (ST Direction Word16
d [v]
vs [Mem]
ccs Term (ANormalF TypeReference) v
b) = Direction Word16
-> [v] -> [Mem] -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
vs [Mem]
ccs (Map v v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v (f :: * -> * -> *).
(Var v, Bifunctor f, Bifoldable f) =>
Map v v -> Term f v -> Term f v
ABTN.renames Map v v
rn Term (ANormalF TypeReference) v
b)
    f (LZ v
v Either TypeReference v
r [v]
as) = v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
v ((v -> v) -> Either TypeReference v -> Either TypeReference v
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second v -> v
swap Either TypeReference v
r) ((v -> v) -> [v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map v -> v
swap [v]
as)

-- Calculates the free variables occurring in a context. This
-- consists of the free variables in the expressions being bound,
-- but with previously bound variables subtracted.
freeVarsCtx :: (Ord v) => Ctx v -> Set v
freeVarsCtx :: forall v. Ord v => Ctx v -> Set v
freeVarsCtx = [Cte v] -> Set v
forall v. Ord v => [Cte v] -> Set v
freeVarsCte ([Cte v] -> Set v) -> (Ctx v -> [Cte v]) -> Ctx v -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx v -> [Cte v]
forall a b. (a, b) -> b
snd

freeVarsCte :: (Ord v) => [Cte v] -> Set v
freeVarsCte :: forall v. Ord v => [Cte v] -> Set v
freeVarsCte = (Cte v -> Set v -> Set v) -> Set v -> [Cte v] -> Set v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cte v -> Set v -> Set v
forall {a} {f :: * -> * -> *}.
Ord a =>
CTE a (Term f a) -> Set a -> Set a
m Set v
forall a. Set a
Set.empty
  where
    m :: CTE a (Term f a) -> Set a -> Set a
m (ST Direction Word16
_ [a]
vs [Mem]
_ Term f a
bn) Set a
rest =
      Term f a -> Set a
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars Term f a
bn Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Set a
rest Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
vs)
    m (LZ a
v Either TypeReference a
r [a]
as) Set a
rest =
      [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ((TypeReference -> [a] -> [a])
-> (a -> [a] -> [a]) -> Either TypeReference a -> [a] -> [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([a] -> [a]) -> TypeReference -> [a] -> [a]
forall a b. a -> b -> a
const [a] -> [a]
forall a. a -> a
id) (:) Either TypeReference a
r [a]
as)
        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
v Set a
rest

-- Conditionally freshens a list of variables. The predicate
-- argument selects which variables to freshen, and the set is a set
-- of variables to avoid for freshness. The process ensures that the
-- result is mutually fresh, and returns a new set of variables to
-- avoid, which includes the freshened variables.
--
-- Presumably any variables selected by the predicate should be
-- included in the set, but the set may contain additional variables
-- to avoid, when freshening.
freshens :: (Var v) => (v -> Bool) -> Set v -> [v] -> (Set v, [v])
freshens :: forall v. Var v => (v -> Bool) -> Set v -> [v] -> (Set v, [v])
freshens v -> Bool
p Set v
avoid0 [v]
vs =
  (Set v -> v -> (Set v, v)) -> Set v -> [v] -> (Set v, [v])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Set v -> v -> (Set v, v)
f (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set v
avoid0 ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
vs)) [v]
vs
  where
    f :: Set v -> v -> (Set v, v)
f Set v
avoid v
v
      | v -> Bool
p v
v, v
u <- Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
avoid v
v = (v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
u Set v
avoid, v
u)
      | Bool
otherwise = (Set v
avoid, v
v)

-- Freshens the variable bindings in a context to avoid a set of
-- variables. Returns the renaming necessary for anything that was
-- bound in the freshened context.
--
-- Note: this only freshens if it's necessary to avoid variables in
-- the _original_ set. We need to keep track of other variables to
-- avoid when making up new names for those, but it it isn't
-- necessary to freshen variables to remove shadowing _within_ the
-- context, since it is presumably already correctly formed.
freshenCtx :: (Var v) => Set v -> Ctx v -> (Map v v, Ctx v)
freshenCtx :: forall v. Var v => Set v -> Ctx v -> (Map v v, Ctx v)
freshenCtx Set v
avoid0 (Direction ()
d, [Cte v]
ctx) =
  case Set v -> Map v v -> [Cte v] -> [Cte v] -> (Map v v, [Cte v])
go Set v
lavoid Map v v
forall k a. Map k a
Map.empty [] ([Cte v] -> (Map v v, [Cte v])) -> [Cte v] -> (Map v v, [Cte v])
forall a b. (a -> b) -> a -> b
$ [Cte v] -> [Cte v]
forall a. [a] -> [a]
reverse [Cte v]
ctx of
    (Map v v
rn, [Cte v]
ctx) -> (Map v v
rn, (Direction ()
d, [Cte v]
ctx))
  where
    -- precalculate all variable occurrences in the context to just
    -- completely avoid those as well.
    lavoid :: Set v
lavoid =
      (Set v -> Cte v -> Set v) -> Set v -> [Cte v] -> Set v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Cte v -> Set v -> Set v) -> Set v -> Cte v -> Set v
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Cte v -> Set v -> Set v) -> Set v -> Cte v -> Set v)
-> (Cte v -> Set v -> Set v) -> Set v -> Cte v -> Set v
forall a b. (a -> b) -> a -> b
$ Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set v -> Set v -> Set v)
-> (Cte v -> Set v) -> Cte v -> Set v -> Set v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cte v -> Set v
forall v. Ord v => Cte v -> Set v
cteVars) Set v
avoid0 [Cte v]
ctx

    go :: Set v -> Map v v -> [Cte v] -> [Cte v] -> (Map v v, [Cte v])
go Set v
_ Map v v
rns [Cte v]
fresh [] = (Map v v
rns, [Cte v]
fresh)
    go Set v
avoid Map v v
rns [Cte v]
fresh (Cte v
bn : [Cte v]
bns) = case Cte v
bn of
      LZ v
v Either TypeReference v
r [v]
as
        | v
v v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set v
avoid0,
          v
u <- Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn Set v
avoid v
v,
          ([Cte v]
fresh, Bool
_) <- v -> v -> [Cte v] -> ([Cte v], Bool)
forall v. Var v => v -> v -> [Cte v] -> ([Cte v], Bool)
renameCtes v
v v
u [Cte v]
fresh,
          Set v
avoid <- v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
Set.insert v
u Set v
avoid,
          Map v v
rns <- (Maybe v -> Maybe v) -> v -> Map v v -> Map v v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> (Maybe v -> v) -> Maybe v -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
u) v
v Map v v
rns ->
            Set v -> Map v v -> [Cte v] -> [Cte v] -> (Map v v, [Cte v])
go Set v
avoid Map v v
rns (v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
u Either TypeReference v
r [v]
as Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
fresh) [Cte v]
bns
      ST Direction Word16
d [v]
vs [Mem]
ccs ANormal TypeReference v
expr
        | (Set v
avoid, [v]
us) <- (v -> Bool) -> Set v -> [v] -> (Set v, [v])
forall v. Var v => (v -> Bool) -> Set v -> [v] -> (Set v, [v])
freshens (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set v
avoid0) Set v
avoid [v]
vs,
          Map v v
rn <- [(v, v)] -> Map v v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((v, v) -> Bool) -> [(v, v)] -> [(v, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((v -> v -> Bool) -> (v, v) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([(v, v)] -> [(v, v)]) -> [(v, v)] -> [(v, v)]
forall a b. (a -> b) -> a -> b
$ [v] -> [v] -> [(v, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip [v]
vs [v]
us),
          Bool -> Bool
not (Map v v -> Bool
forall k a. Map k a -> Bool
Map.null Map v v
rn),
          [Cte v]
fresh <- Map v v -> [Cte v] -> [Cte v]
forall v. Var v => Map v v -> [Cte v] -> [Cte v]
renamesCtes Map v v
rn [Cte v]
fresh,
          -- Note: rns union left-biased, so inner contexts take
          -- priority.
          Map v v
rns <- Map v v -> Map v v -> Map v v
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map v v
rns Map v v
rn ->
            Set v -> Map v v -> [Cte v] -> [Cte v] -> (Map v v, [Cte v])
go Set v
avoid Map v v
rns (Direction Word16
-> [v] -> [Mem] -> ANormal TypeReference v -> Cte v
forall v s. Direction Word16 -> [v] -> [Mem] -> s -> CTE v s
ST Direction Word16
d [v]
us [Mem]
ccs ANormal TypeReference v
expr Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
fresh) [Cte v]
bns
      Cte v
_ -> Set v -> Map v v -> [Cte v] -> [Cte v] -> (Map v v, [Cte v])
go Set v
avoid Map v v
rns (Cte v
bn Cte v -> [Cte v] -> [Cte v]
forall a. a -> [a] -> [a]
: [Cte v]
fresh) [Cte v]
bns

anfBlock :: (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock :: forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock (Var' v
v) = (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v -> Term (ANormalF TypeReference) v
forall v ref. Var v => v -> ANormal ref v
TVar v
v)
anfBlock (If' Term v a
c Term v a
t Term v a
f) = do
  (Ctx v
cctx, DNormal v
cc) <- Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
c
  (Direction ()
df, Term (ANormalF TypeReference) v
cf) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
f
  (Direction ()
dt, Term (ANormalF TypeReference) v
ct) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
t
  (Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
cc
  let cases :: Branched TypeReference (Term (ANormalF TypeReference) v)
cases =
        TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Maybe (Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e.
ref -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched ref e
MatchData
          (Text -> TypeReference
forall t h. t -> Reference' t h
Builtin (Text -> TypeReference) -> Text -> TypeReference
forall a b. (a -> b) -> a -> b
$ String -> Text
Data.Text.pack String
"Boolean")
          (CTag
-> ([Mem], Term (ANormalF TypeReference) v)
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton CTag
0 ([], Term (ANormalF TypeReference) v
cf))
          (Term (ANormalF TypeReference) v
-> Maybe (Term (ANormalF TypeReference) v)
forall a. a -> Maybe a
Just Term (ANormalF TypeReference) v
ct)
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
cctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
df Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
dt, v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v Branched TypeReference (Term (ANormalF TypeReference) v)
cases))
anfBlock (And' Term v a
l Term v a
r) = do
  (Ctx v
lctx, v
vl) <- Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
l
  (Direction ()
d, Term (ANormalF TypeReference) v
tmr) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
r
  let tree :: Term (ANormalF TypeReference) v
tree =
        v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
vl (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
    -> Branched TypeReference (Term (ANormalF TypeReference) v))
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. ref -> EnumMap CTag ([Mem], e) -> Branched ref e
MatchDataCover TypeReference
Ty.booleanRef (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall a b. (a -> b) -> a -> b
$
          [(CTag, ([Mem], Term (ANormalF TypeReference) v))]
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
            [ (CTag
0, ([], Term (ANormalF TypeReference) v
forall {v}. Var v => ANormal TypeReference v
UFalse)),
              (CTag
1, ([], Term (ANormalF TypeReference) v
tmr))
            ]
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
lctx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d, Term (ANormalF TypeReference) v
tree))
anfBlock (Or' Term v a
l Term v a
r) = do
  (Ctx v
lctx, v
vl) <- Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
l
  (Direction ()
d, Term (ANormalF TypeReference) v
tmr) <- Term v a -> ANFM v (DNormal v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
r
  let tree :: Term (ANormalF TypeReference) v
tree =
        v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
vl (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
    -> Branched TypeReference (Term (ANormalF TypeReference) v))
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. ref -> EnumMap CTag ([Mem], e) -> Branched ref e
MatchDataCover TypeReference
Ty.booleanRef (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall a b. (a -> b) -> a -> b
$
          [(CTag, ([Mem], Term (ANormalF TypeReference) v))]
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
            [ (CTag
1, ([], Term (ANormalF TypeReference) v
forall {v}. Var v => ANormal TypeReference v
UTrue)),
              (CTag
0, ([], Term (ANormalF TypeReference) v
tmr))
            ]
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
lctx, (() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d, Term (ANormalF TypeReference) v
tree))
anfBlock (Handle' Term v a
h Term v a
body) =
  Term v a -> ANFM v (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
h ANFM v (Ctx v, v)
-> ((Ctx v, v)
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         (Ctx v, DNormal v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b.
ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  a
-> (a
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         b)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Ctx v
hctx, v
vh) ->
    Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, DNormal v)
anfHandled Term v a
body ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (Ctx v, DNormal v)
-> ((Ctx v, DNormal v)
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         (Ctx v, DNormal v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b.
ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  a
-> (a
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         b)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Ctx v
ctx, (Direction ()
_, TCom TypeReference
f [v]
as)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
        v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
        pure
          ( Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
v (TypeReference -> Either TypeReference v
forall a b. a -> Either a b
Left TypeReference
f) [v]
as],
            (() -> Direction ()
forall a. a -> Direction a
Indirect (), Func TypeReference v -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (v -> Func TypeReference v
forall ref v. v -> Func ref v
FVar v
vh) [v
v])
          )
      (Ctx v
ctx, (Direction ()
_, TApv v
f [v]
as)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
        v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
        pure
          ( Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
v (v -> Either TypeReference v
forall a b. b -> Either a b
Right v
f) [v]
as],
            (() -> Direction ()
forall a. a -> Direction a
Indirect (), Func TypeReference v -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (v -> Func TypeReference v
forall ref v. v -> Func ref v
FVar v
vh) [v
v])
          )
      (Ctx v
ctx, (Direction ()
_, TVar v
v)) | Ctx v -> Bool
forall v. Var v => Ctx v -> Bool
floatableCtx Ctx v
ctx -> do
        (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
hctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ctx, (() -> Direction ()
forall a. a -> Direction a
Indirect (), Func TypeReference v -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp (v -> Func TypeReference v
forall ref v. v -> Func ref v
FVar v
vh) [v
v]))
      p :: (Ctx v, DNormal v)
p@(Ctx v
_, DNormal v
_) ->
        [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Ctx v, DNormal v))
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ String
"handle body should be a simple call: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Ctx v, DNormal v) -> String
forall a. Show a => a -> String
show (Ctx v, DNormal v)
p
anfBlock (Match' Term v a
scrut [MatchCase a (Term v a)]
cas) = do
  (Ctx v
sctx, DNormal v
sc) <- Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
scrut
  (Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
sc
  (Direction ()
d, BranchAccum v
brn) <- v
-> [MatchCase a (Term v a)] -> ANFM v (Direction (), BranchAccum v)
forall v p a.
Var v =>
v
-> [MatchCase p (Term v a)] -> ANFM v (Directed () (BranchAccum v))
anfCases v
v [MatchCase a (Term v a)]
cas
  (DNormal v -> DNormal v)
-> (Ctx v, DNormal v) -> (Ctx v, DNormal v)
forall a b. (a -> b) -> (Ctx v, a) -> (Ctx v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Direction () -> Direction ()) -> DNormal v -> DNormal v
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 ((() -> Direction ()
forall a. a -> Direction a
Indirect () Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<> Direction ()
d) Direction () -> Direction () -> Direction ()
forall a. Semigroup a => a -> a -> a
<>)) ((Ctx v, DNormal v) -> (Ctx v, DNormal v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BranchAccum v
brn of
    AccumDefault (TBinds ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed -> Ctx v
dctx) Term (ANormalF TypeReference) v
df) -> do
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
dctx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term (ANormalF TypeReference) v
df)
    AccumRequest Map
  TypeReference
  (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
_ Maybe (Term (ANormalF TypeReference) v)
Nothing ->
      [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfBlock: AccumRequest without default"
    AccumPure (ABTN.TAbss [v]
us Term (ANormalF TypeReference) v
bd)
      | [v
u] <- [v]
us,
        TBinds ([Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed -> Ctx v
bx) Term (ANormalF TypeReference) v
bd <- Term (ANormalF TypeReference) v
bd ->
          case Ctx v
cx of
            (Direction ()
_, []) -> do
              Direction Word16
d0 <- Word16 -> Direction Word16
forall a. a -> Direction a
Indirect (Word16 -> Direction Word16)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     Word16
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
forall v. ANFM v Word16
binder
              pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d0 v
u Mem
BX (v -> Term (ANormalF TypeReference) v
forall v ref. Var v => v -> ANormal ref v
TFrc v
v)] Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
bx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term (ANormalF TypeReference) v
bd)
            (Direction ()
d0, [ST1 Direction Word16
d1 v
_ Mem
BX Term (ANormalF TypeReference) v
tm]) ->
              (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> (Direction ()
d0, [Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d1 v
u Mem
BX Term (ANormalF TypeReference) v
tm]) Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
bx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term (ANormalF TypeReference) v
bd)
            Ctx v
_ -> [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfBlock|AccumPure: impossible"
      | Bool
otherwise -> [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"pure handler with too many variables"
    AccumRequest Map
  TypeReference
  (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
abr (Just Term (ANormalF TypeReference) v
df) -> do
      (v
r, [v]
vs) <- do
        v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
        v
v <- ANFM v v
forall v. Var v => ANFM v v
fresh
        ([v]
hfvs, SuperNormal TypeReference v
hcomb) <- v
-> Map
     TypeReference
     (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
-> Term (ANormalF TypeReference) v
-> ANFM v ([v], SuperNormal TypeReference v)
forall v.
Var v =>
v
-> ReqBranches TypeReference v
-> ANormal TypeReference v
-> ANFM v ([v], SuperNormal TypeReference v)
makeHandler v
v Map
  TypeReference
  (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
abr Term (ANormalF TypeReference) v
df
        (v, SuperNormal TypeReference v) -> ANFM v ()
forall v. Var v => (v, SuperNormal TypeReference v) -> ANFM v ()
record (v
r, SuperNormal TypeReference v
hcomb)
        pure (v
r, [v]
hfvs)
      v
hv <- ANFM v v
forall v. Var v => ANFM v v
fresh
      let (Direction ()
d, Term (ANormalF TypeReference) v
msc)
            | (Direction ()
d, [ST1 Direction Word16
_ v
_ Mem
BX Term (ANormalF TypeReference) v
tm]) <- Ctx v
cx = (Direction ()
d, Term (ANormalF TypeReference) v
tm)
            | (Direction ()
_, [ST Direction Word16
_ [v]
_ [Mem]
_ Term (ANormalF TypeReference) v
_]) <- Ctx v
cx =
                [Word] -> String -> DNormal v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfBlock: impossible"
            | Bool
otherwise = (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Term (ANormalF TypeReference) v
forall v ref. Var v => v -> ANormal ref v
TFrc v
v)
      pure
        ( Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v -> Either TypeReference v -> [v] -> Cte v
forall v s. v -> Either TypeReference v -> [v] -> CTE v s
LZ v
hv (v -> Either TypeReference v
forall a b. b -> Either a b
Right v
r) [v]
vs],
          (Direction ()
d, [TypeReference]
-> v
-> Maybe v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
[ref] -> v -> Maybe v -> ANormal ref v -> ANormal ref v
THnd (Map
  TypeReference
  (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
-> [TypeReference]
forall k a. Map k a -> [k]
Map.keys Map
  TypeReference
  (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v))
abr) v
hv Maybe v
forall a. Maybe a
Nothing Term (ANormalF TypeReference) v
msc)
        )
    AccumText Maybe (Term (ANormalF TypeReference) v)
df Map Text (Term (ANormalF TypeReference) v)
cs ->
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (Branched TypeReference (Term (ANormalF TypeReference) v)
    -> Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> DNormal v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall a b. (a -> b) -> a -> b
$ Map Text (Term (ANormalF TypeReference) v)
-> Maybe (Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. Map Text e -> Maybe e -> Branched ref e
MatchText Map Text (Term (ANormalF TypeReference) v)
cs Maybe (Term (ANormalF TypeReference) v)
df)
    AccumIntegral TypeReference
r Maybe (Term (ANormalF TypeReference) v)
df EnumMap ConstructorId (Term (ANormalF TypeReference) v)
cs ->
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall a b. (a -> b) -> a -> b
$ TypeReference
-> EnumMap ConstructorId (Term (ANormalF TypeReference) v)
-> Maybe (Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e.
ref -> EnumMap ConstructorId e -> Maybe e -> Branched ref e
MatchNumeric TypeReference
r EnumMap ConstructorId (Term (ANormalF TypeReference) v)
cs Maybe (Term (ANormalF TypeReference) v)
df)
    AccumData TypeReference
r Maybe (Term (ANormalF TypeReference) v)
df EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
cs ->
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (Branched TypeReference (Term (ANormalF TypeReference) v)
    -> Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> DNormal v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall a b. (a -> b) -> a -> b
$ TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Maybe (Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e.
ref -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched ref e
MatchData TypeReference
r EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
cs Maybe (Term (ANormalF TypeReference) v)
df)
    AccumSeqEmpty Term (ANormalF TypeReference) v
_ ->
      [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfBlock: non-exhaustive AccumSeqEmpty"
    AccumSeqView SeqEnd
en (Just Term (ANormalF TypeReference) v
em) Term (ANormalF TypeReference) v
bd -> do
      v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
      let op :: TypeReference
op
            | SeqEnd
SLeft <- SeqEnd
en = Text -> TypeReference
forall t h. t -> Reference' t h
Builtin Text
"List.viewl"
            | Bool
otherwise = Text -> TypeReference
forall t h. t -> Reference' t h
Builtin Text
"List.viewr"
      Word16
b <- ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
forall v. ANFM v Word16
binder
      pure
        ( Ctx v
sctx
            Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx
            Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> (() -> Direction ()
forall a. a -> Direction a
Indirect (), [Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
b) v
r Mem
BX (TypeReference -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> [v] -> ANormal ref v
TCom TypeReference
op [v
v])]),
          Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (Branched TypeReference (Term (ANormalF TypeReference) v)
    -> Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
r (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> DNormal v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> DNormal v
forall a b. (a -> b) -> a -> b
$
            TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. ref -> EnumMap CTag ([Mem], e) -> Branched ref e
MatchDataCover
              TypeReference
Ty.seqViewRef
              ( [(CTag, ([Mem], Term (ANormalF TypeReference) v))]
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
EC.mapFromList
                  [ (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.seqViewEmpty, ([], Term (ANormalF TypeReference) v
em)),
                    (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.seqViewElem, ([Mem
BX, Mem
BX], Term (ANormalF TypeReference) v
bd))
                  ]
              )
        )
    AccumSeqView {} ->
      [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfBlock: non-exhaustive AccumSeqView"
    AccumSeqSplit SeqEnd
en Int
n Maybe (Term (ANormalF TypeReference) v)
mdf Term (ANormalF TypeReference) v
bd -> do
      v
i <- ANFM v v
forall v. Var v => ANFM v v
fresh
      v
r <- ANFM v v
forall v. Var v => ANFM v v
fresh
      v
s <- ANFM v v
forall v. Var v => ANFM v v
fresh
      Word16
b <- ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  Word16
forall v. ANFM v Word16
binder
      let split :: Cte v
split = Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
b) v
r Mem
BX (TypeReference -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> [v] -> ANormal ref v
TCom TypeReference
op [v
i, v
v])
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [v -> Cte v
lit v
i, Cte v
split],
          Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
    -> Term (ANormalF TypeReference) v)
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
r (Branched TypeReference (Term (ANormalF TypeReference) v)
 -> Term (ANormalF TypeReference) v)
-> (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
    -> Branched TypeReference (Term (ANormalF TypeReference) v))
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. ref -> EnumMap CTag ([Mem], e) -> Branched ref e
MatchDataCover TypeReference
Ty.seqViewRef (EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
 -> DNormal v)
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
-> DNormal v
forall a b. (a -> b) -> a -> b
$
            [(CTag, ([Mem], Term (ANormalF TypeReference) v))]
-> EnumMap CTag ([Mem], Term (ANormalF TypeReference) v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
              [ (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.seqViewEmpty, ([], v -> Term (ANormalF TypeReference) v
df v
s)),
                (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.seqViewElem, ([Mem
BX, Mem
BX], Term (ANormalF TypeReference) v
bd))
              ]
        )
      where
        op :: TypeReference
op
          | SeqEnd
SLeft <- SeqEnd
en = Text -> TypeReference
forall t h. t -> Reference' t h
Builtin Text
"List.splitLeft"
          | Bool
otherwise = Text -> TypeReference
forall t h. t -> Reference' t h
Builtin Text
"List.splitRight"
        lit :: v -> Cte v
lit v
i = Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
i Mem
BX (Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TBLit (Lit TypeReference -> Term (ANormalF TypeReference) v)
-> (ConstructorId -> Lit TypeReference)
-> ConstructorId
-> Term (ANormalF TypeReference) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Lit TypeReference
forall ref. ConstructorId -> Lit ref
N (ConstructorId -> Term (ANormalF TypeReference) v)
-> ConstructorId -> Term (ANormalF TypeReference) v
forall a b. (a -> b) -> a -> b
$ Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
        df :: v -> Term (ANormalF TypeReference) v
df v
n =
          Term (ANormalF TypeReference) v
-> Maybe (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall a. a -> Maybe a -> a
fromMaybe
            ( Direction Word16
-> v
-> Mem
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
Direction Word16
-> v -> Mem -> ANormal ref v -> ANormal ref v -> ANormal ref v
TLet Direction Word16
forall a. Direction a
Direct v
n Mem
BX (Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Text -> Lit TypeReference
forall ref. Text -> Lit ref
T Text
"pattern match failure")) (Term (ANormalF TypeReference) v
 -> Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall a b. (a -> b) -> a -> b
$
                POp -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => POp -> [v] -> ANormal ref v
TPrm POp
EROR [v
n, v
v]
            )
            Maybe (Term (ANormalF TypeReference) v)
mdf
    BranchAccum v
AccumEmpty -> (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
sctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ v
-> Branched TypeReference (Term (ANormalF TypeReference) v)
-> Term (ANormalF TypeReference) v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v Branched TypeReference (Term (ANormalF TypeReference) v)
forall ref e. Branched ref e
MatchEmpty)
anfBlock (Let1Named' v
v Term v a
b Term v a
e) =
  Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
b ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  (Ctx v, DNormal v)
-> ((Ctx v, DNormal v)
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         (Ctx v, DNormal v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b.
ReaderT
  (Set v)
  (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
  a
-> (a
    -> ReaderT
         (Set v)
         (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
         b)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Ctx v
bctx, (Direction ()
Direct, TVar v
u)) -> do
      (Ctx v
ectx, DNormal v
ce) <- Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
e
      (Map v v
brn, Ctx v
bctx) <- Ctx v
-> Ctx v
-> DNormal v
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Map v v, Ctx v)
forall {f :: * -> *} {v} {a} {f :: * -> * -> *}.
(Applicative f, Var v) =>
Ctx v -> Ctx v -> (a, Term f v) -> f (Map v v, Ctx v)
fixupBctx Ctx v
bctx Ctx v
ectx DNormal v
ce
      v
u <- v -> ANFM v v
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> ANFM v v) -> v -> ANFM v v
forall a b. (a -> b) -> a -> b
$ v -> v -> Map v v -> v
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault v
u v
u Map v v
brn
      (Ctx v
ectx, Bool
shaded) <- (Ctx v, Bool)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Bool)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Ctx v, Bool)
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Ctx v, Bool))
-> (Ctx v, Bool)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Bool)
forall a b. (a -> b) -> a -> b
$ v -> v -> Ctx v -> (Ctx v, Bool)
forall v. Var v => v -> v -> Ctx v -> (Ctx v, Bool)
renameCtx v
v v
u Ctx v
ectx
      DNormal v
ce <- DNormal v -> ANFM v (DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DNormal v -> ANFM v (DNormal v))
-> DNormal v -> ANFM v (DNormal v)
forall a b. (a -> b) -> a -> b
$ if Bool
shaded then DNormal v
ce else v
-> v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u (Term (ANormalF TypeReference) v
 -> Term (ANormalF TypeReference) v)
-> DNormal v -> DNormal v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DNormal v
ce
      pure (Ctx v
bctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ectx, DNormal v
ce)
    (Ctx v
bctx, (Direction ()
d0, Term (ANormalF TypeReference) v
cb)) -> [v]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v
v] (ReaderT
   (Set v)
   (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
   (Ctx v, DNormal v)
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Ctx v, DNormal v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ do
      (Ctx v
ectx, DNormal v
ce) <- Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
e
      Direction Word16
d <- Direction ()
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction Word16)
forall a v. Direction a -> ANFM v (Direction Word16)
bindDirection Direction ()
d0
      (Map v v
brn, Ctx v
bctx) <- Ctx v
-> Ctx v
-> DNormal v
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Map v v, Ctx v)
forall {f :: * -> *} {v} {a} {f :: * -> * -> *}.
(Applicative f, Var v) =>
Ctx v -> Ctx v -> (a, Term f v) -> f (Map v v, Ctx v)
fixupBctx Ctx v
bctx Ctx v
ectx DNormal v
ce
      Term (ANormalF TypeReference) v
cb <- Term (ANormalF TypeReference) v
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Term (ANormalF TypeReference) v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Term (ANormalF TypeReference) v))
-> Term (ANormalF TypeReference) v
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Term (ANormalF TypeReference) v)
forall a b. (a -> b) -> a -> b
$ Map v v
-> Term (ANormalF TypeReference) v
-> Term (ANormalF TypeReference) v
forall v (f :: * -> * -> *).
(Var v, Bifunctor f, Bifoldable f) =>
Map v v -> Term f v -> Term f v
ABTN.renames Map v v
brn Term (ANormalF TypeReference) v
cb
      let octx :: Ctx v
octx = Ctx v
bctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall (f :: * -> *) v.
Foldable f =>
f (Cte v) -> Directed () (f (Cte v))
directed [Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
d v
v Mem
BX Term (ANormalF TypeReference) v
cb] Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
ectx
      (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
octx, DNormal v
ce)
  where
    fixupBctx :: Ctx v -> Ctx v -> (a, Term f v) -> f (Map v v, Ctx v)
fixupBctx Ctx v
bctx Ctx v
ectx (a
_, Term f v
ce) =
      (Map v v, Ctx v) -> f (Map v v, Ctx v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map v v, Ctx v) -> f (Map v v, Ctx v))
-> (Map v v, Ctx v) -> f (Map v v, Ctx v)
forall a b. (a -> b) -> a -> b
$ Set v -> Ctx v -> (Map v v, Ctx v)
forall v. Var v => Set v -> Ctx v -> (Map v v, Ctx v)
freshenCtx (Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set v
ecfvs Set v
efvs) Ctx v
bctx
      where
        ecfvs :: Set v
ecfvs = Ctx v -> Set v
forall v. Ord v => Ctx v -> Set v
freeVarsCtx Ctx v
ectx
        efvs :: Set v
efvs = Term f v -> Set v
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars Term f v
ce
anfBlock (Apps' (Blank' Blank a
b) [Term v a]
args) = do
  v
nm <- ANFM v v
forall v. Var v => ANFM v v
fresh
  (Ctx v
actx, [v]
cas) <- [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
args
  pure
    ( Ctx v
actx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
nm Mem
BX (Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Text -> Lit TypeReference
forall ref. Text -> Lit ref
T Text
msg))],
      Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => POp -> [v] -> ANormal ref v
TPrm POp
EROR (v
nm v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
cas)
    )
  where
    msg :: Text
msg = String -> Text
Util.Text.pack (String -> Text)
-> (Maybe String -> String) -> Maybe String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"blank expression" (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ Blank a -> Maybe String
forall loc. Blank loc -> Maybe String
nameb Blank a
b
anfBlock (Apps' Term v a
f [Term v a]
args) = do
  (Ctx v
fctx, (Direction ()
d, Func TypeReference v
cf)) <- Term v a -> ANFM v (Ctx v, Directed () (Func TypeReference v))
forall v a.
Var v =>
Term v a -> ANFM v (Ctx v, Directed () (Func TypeReference v))
anfFunc Term v a
f
  (Ctx v
actx, [v]
cas) <- [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
args
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
fctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
actx, (Direction ()
d, Func TypeReference v -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => Func ref v -> [v] -> ANormal ref v
TApp Func TypeReference v
cf [v]
cas))
anfBlock (Constructor' (ConstructorReference TypeReference
r ConstructorId
t)) =
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ TypeReference -> CTag -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TCon TypeReference
r (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t) [])
anfBlock (Request' (ConstructorReference TypeReference
r ConstructorId
t)) =
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), TypeReference -> CTag -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TReq TypeReference
r (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t) []))
anfBlock (Boolean' Bool
b) =
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ TypeReference -> CTag -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> CTag -> [v] -> ANormal ref v
TCon TypeReference
Ty.booleanRef (if Bool
b then CTag
1 else CTag
0) [])
anfBlock (Lit' l :: Lit TypeReference
l@(T Text
_)) =
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit Lit TypeReference
l)
anfBlock (Lit' Lit TypeReference
l) =
  (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TBLit Lit TypeReference
l)
anfBlock (Ref' TypeReference
r) = (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), TypeReference -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => ref -> [v] -> ANormal ref v
TCom TypeReference
r []))
anfBlock (Blank' Blank a
b) = do
  v
nm <- ANFM v v
forall v. Var v => ANFM v v
fresh
  v
ev <- ANFM v v
forall v. Var v => ANFM v v
fresh
  pure
    ( [Cte v] -> Ctx v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        [ Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
nm Mem
BX (Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Text -> Lit TypeReference
forall ref. Text -> Lit ref
T Text
name)),
          Direction Word16
-> v -> Mem -> Term (ANormalF TypeReference) v -> Cte v
forall v s. Direction Word16 -> v -> Mem -> s -> CTE v s
ST1 Direction Word16
forall a. Direction a
Direct v
ev Mem
BX (Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Text -> Lit TypeReference
forall ref. Text -> Lit ref
T (Text -> Lit TypeReference) -> Text -> Lit TypeReference
forall a b. (a -> b) -> a -> b
$ String -> Text
Util.Text.pack String
msg))
        ],
      Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> Term (ANormalF TypeReference) v -> DNormal v
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => POp -> [v] -> ANormal ref v
TPrm POp
EROR [v
nm, v
ev]
    )
  where
    name :: Text
name = Text
"blank expression"
    msg :: String
msg = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"blank expression" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Blank a -> Maybe String
forall loc. Blank loc -> Maybe String
nameb Blank a
b
anfBlock (TermLink' Referent
r) = (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (Lit TypeReference -> Term (ANormalF TypeReference) v)
-> Lit TypeReference
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Lit TypeReference -> DNormal v) -> Lit TypeReference -> DNormal v
forall a b. (a -> b) -> a -> b
$ Referent -> Lit TypeReference
forall ref. Referent' ref -> Lit ref
LM Referent
r)
anfBlock (TypeLink' TypeReference
r) = (Ctx v, DNormal v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> (Lit TypeReference -> Term (ANormalF TypeReference) v)
-> Lit TypeReference
-> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit TypeReference -> Term (ANormalF TypeReference) v
forall v ref. Var v => Lit ref -> ANormal ref v
TLit (Lit TypeReference -> DNormal v) -> Lit TypeReference -> DNormal v
forall a b. (a -> b) -> a -> b
$ TypeReference -> Lit TypeReference
forall ref. ref -> Lit ref
LY TypeReference
r)
anfBlock (List' Seq (Term v a)
as) = ([v] -> DNormal v) -> (Ctx v, [v]) -> (Ctx v, DNormal v)
forall a b. (a -> b) -> (Ctx v, a) -> (Ctx v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Term (ANormalF TypeReference) v -> DNormal v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term (ANormalF TypeReference) v -> DNormal v)
-> ([v] -> Term (ANormalF TypeReference) v) -> [v] -> DNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POp -> [v] -> Term (ANormalF TypeReference) v
forall v ref. Var v => POp -> [v] -> ANormal ref v
TPrm POp
BLDS) ((Ctx v, [v]) -> (Ctx v, DNormal v))
-> ANFM v (Ctx v, [v])
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term v a] -> ANFM v (Ctx v, [v])
forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
tms
  where
    tms :: [Term v a]
tms = Seq (Term v a) -> [Term v a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Term v a)
as
anfBlock Term v a
t = [Word]
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Ctx v, DNormal v))
-> String
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, DNormal v)
forall a b. (a -> b) -> a -> b
$ String
"anf: unhandled term: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Term v a -> String
forall a. Show a => a -> String
show Term v a
t

type ReqBranches ref v =
  Map Reference (EnumMap CTag ([Mem], ANormal ref v))

makeHandler ::
  (Var v) => v -> ReqBranches Reference v -> ANormal Reference v -> ANFM v ([v], SuperNormal Reference v)
makeHandler :: forall v.
Var v =>
v
-> ReqBranches TypeReference v
-> ANormal TypeReference v
-> ANFM v ([v], SuperNormal TypeReference v)
makeHandler v
v ReqBranches TypeReference v
abr ANormal TypeReference v
df = do
  [v]
hfvs <-
    ANFM v (Set v)
forall v. ANFM v (Set v)
groupVars ANFM v (Set v)
-> (Set v -> [v])
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     [v]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Set v
gvs ->
      Set v -> [v]
forall a. Set a -> [a]
Set.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ ANormal TypeReference v -> Set v
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars ANormal TypeReference v
hfb Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set v
gvs
  pure ([v]
hfvs, [Mem] -> ANormal TypeReference v -> SuperNormal TypeReference v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
hfvs [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v
v]) (ANormal TypeReference v -> SuperNormal TypeReference v)
-> ANormal TypeReference v -> SuperNormal TypeReference v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
hfvs ANormal TypeReference v
hfb)
  where
    hfb :: ANormal TypeReference v
hfb = v -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
ABTN.TAbs v
v (ANormal TypeReference v -> ANormal TypeReference v)
-> (Branched TypeReference (ANormal TypeReference v)
    -> ANormal TypeReference v)
-> Branched TypeReference (ANormal TypeReference v)
-> ANormal TypeReference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v
-> Branched TypeReference (ANormal TypeReference v)
-> ANormal TypeReference v
forall v ref.
Var v =>
v -> Branched ref (ANormal ref v) -> ANormal ref v
TMatch v
v (Branched TypeReference (ANormal TypeReference v)
 -> ANormal TypeReference v)
-> Branched TypeReference (ANormal TypeReference v)
-> ANormal TypeReference v
forall a b. (a -> b) -> a -> b
$ [(TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))]
-> ANormal TypeReference v
-> Branched TypeReference (ANormal TypeReference v)
forall ref e.
[(ref, EnumMap CTag ([Mem], e))] -> e -> Branched ref e
MatchRequest (ReqBranches TypeReference v
-> [(TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))]
forall k a. Map k a -> [(k, a)]
Map.toList ReqBranches TypeReference v
abr) ANormal TypeReference v
df

-- Note: this assumes that patterns have already been translated
-- to a state in which every case matches a single layer of data,
-- with no guards, and no variables ignored. This is not checked
-- completely.
anfInitCase ::
  (Var v) =>
  v ->
  MatchCase p (Term v a) ->
  ANFD v (BranchAccum v)
anfInitCase :: forall v p a.
Var v =>
v -> MatchCase p (Term v a) -> ANFD v (BranchAccum v)
anfInitCase v
u (MatchCase Pattern p
p Maybe (Term v a)
guard (ABT.AbsN' [v]
vs Term v a
bd))
  | Just Term v a
_ <- Maybe (Term v a)
guard = [Word] -> String -> ANFD v (BranchAccum v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfInitCase: unexpected guard"
  | P.Unbound p
_ <- Pattern p
p,
    [] <- [v]
vs =
      ANormal TypeReference v -> BranchAccum v
forall v. ANormal TypeReference v -> BranchAccum v
AccumDefault (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Var p
_ <- Pattern p
p,
    [v
v] <- [v]
vs =
      ANormal TypeReference v -> BranchAccum v
forall v. ANormal TypeReference v -> BranchAccum v
AccumDefault (ANormal TypeReference v -> BranchAccum v)
-> (ANormal TypeReference v -> ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> v -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *).
(Var v, Ord v, Bifunctor f, Bifoldable f) =>
v -> v -> Term f v -> Term f v
ABTN.rename v
v v
u (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Var p
_ <- Pattern p
p =
      [Word] -> String -> ANFD v (BranchAccum v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String -> ANFD v (BranchAccum v))
-> String -> ANFD v (BranchAccum v)
forall a b. (a -> b) -> a -> b
$ String
"vars: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
vs)
  | P.Int p
_ (Int64 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> ConstructorId
i) <- Pattern p
p =
      TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
Ty.intRef Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing (EnumMap ConstructorId (ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v
    -> EnumMap ConstructorId (ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId
-> ANormal TypeReference v
-> EnumMap ConstructorId (ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton ConstructorId
i (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Nat p
_ ConstructorId
i <- Pattern p
p =
      TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
Ty.natRef Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing (EnumMap ConstructorId (ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v
    -> EnumMap ConstructorId (ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId
-> ANormal TypeReference v
-> EnumMap ConstructorId (ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton ConstructorId
i (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Char p
_ Char
c <- Pattern p
p,
    ConstructorId
w <- Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ConstructorId) -> Int -> ConstructorId
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c =
      TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
-> BranchAccum v
AccumIntegral TypeReference
Ty.charRef Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing (EnumMap ConstructorId (ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v
    -> EnumMap ConstructorId (ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId
-> ANormal TypeReference v
-> EnumMap ConstructorId (ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton ConstructorId
w (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Boolean p
_ Bool
b <- Pattern p
p,
    CTag
t <- if Bool
b then CTag
1 else CTag
0 =
      TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
AccumData TypeReference
Ty.booleanRef Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing
        (EnumMap CTag ([Mem], ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v
    -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag
-> ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton CTag
t
        (([Mem], ANormal TypeReference v)
 -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> (ANormal TypeReference v -> ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)
        (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Text p
_ Text
t <- Pattern p
p,
    [] <- [v]
vs =
      Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
forall v.
Maybe (ANormal TypeReference v)
-> Map Text (ANormal TypeReference v) -> BranchAccum v
AccumText Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing (Map Text (ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v -> Map Text (ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ANormal TypeReference v -> Map Text (ANormal TypeReference v)
forall k a. k -> a -> Map k a
Map.singleton (Text -> Text
Util.Text.fromText Text
t) (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.Constructor p
_ (ConstructorReference TypeReference
r ConstructorId
t) [Pattern p]
ps <- Pattern p
p = do
      (,)
        ([v] -> ANormal TypeReference v -> ([v], ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ([v], ANormal TypeReference v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p]
ps [v]
vs
        Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ([v], ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose
     (ANFM v) ((,) (Direction ())) ([v], ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
        Compose
  (ANFM v) ((,) (Direction ())) ([v], ANormal TypeReference v)
-> (([v], ANormal TypeReference v) -> BranchAccum v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
us, ANormal TypeReference v
bd) ->
          TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
forall v.
TypeReference
-> Maybe (ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> BranchAccum v
AccumData TypeReference
r Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing (EnumMap CTag ([Mem], ANormal TypeReference v) -> BranchAccum v)
-> (ANormal TypeReference v
    -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag
-> ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t) (([Mem], ANormal TypeReference v)
 -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> (ANormal TypeReference v -> ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
us,) (ANormal TypeReference v -> BranchAccum v)
-> ANormal TypeReference v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us ANormal TypeReference v
bd
  | P.EffectPure p
_ Pattern p
q <- Pattern p
p =
      (,)
        ([v] -> ANormal TypeReference v -> ([v], ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ([v], ANormal TypeReference v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
q] [v]
vs
        Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ([v], ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose
     (ANFM v) ((,) (Direction ())) ([v], ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
        Compose
  (ANFM v) ((,) (Direction ())) ([v], ANormal TypeReference v)
-> (([v], ANormal TypeReference v) -> BranchAccum v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
us, ANormal TypeReference v
bd) -> ANormal TypeReference v -> BranchAccum v
forall v. ANormal TypeReference v -> BranchAccum v
AccumPure (ANormal TypeReference v -> BranchAccum v)
-> ANormal TypeReference v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us ANormal TypeReference v
bd
  | P.EffectBind p
_ (ConstructorReference TypeReference
r ConstructorId
t) [Pattern p]
ps Pattern p
pk <- Pattern p
p = do
      (,,)
        ([v]
 -> v
 -> ANormal TypeReference v
 -> ([v], v, ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (v -> ANormal TypeReference v -> ([v], v, ANormal TypeReference v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings ([Pattern p] -> Pattern p -> [Pattern p]
forall s a. Snoc s s a a => s -> a -> s
snoc [Pattern p]
ps Pattern p
pk) [v]
vs
        Compose
  (ANFM v)
  ((,) (Direction ()))
  (v -> ANormal TypeReference v -> ([v], v, ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) v
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ([v], v, ANormal TypeReference v))
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ANFM v (Directed () v) -> Compose (ANFM v) ((,) (Direction ())) v
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (v -> Directed () v
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> Directed () v) -> ANFM v v -> ANFM v (Directed () v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ANFM v v
forall v. Var v => ANFM v v
fresh)
        Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ([v], v, ANormal TypeReference v))
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose
     (ANFM v) ((,) (Direction ())) ([v], v, ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
        Compose
  (ANFM v) ((,) (Direction ())) ([v], v, ANormal TypeReference v)
-> (([v], v, ANormal TypeReference v) -> BranchAccum v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([v]
exp, v
kf, ANormal TypeReference v
bd) ->
          let ([v]
us, v
uk) =
                ([v], v) -> (([v], v) -> ([v], v)) -> Maybe ([v], v) -> ([v], v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Word] -> String -> ([v], v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"anfInitCase: unsnoc impossible") ([v], v) -> ([v], v)
forall a. a -> a
id (Maybe ([v], v) -> ([v], v)) -> Maybe ([v], v) -> ([v], v)
forall a b. (a -> b) -> a -> b
$
                  [v] -> Maybe ([v], v)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc [v]
exp
              jn :: Reference' Text h
jn = Text -> Reference' Text h
forall t h. t -> Reference' t h
Builtin Text
"jumpCont"
           in (Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
 -> Maybe (ANormal TypeReference v) -> BranchAccum v)
-> Maybe (ANormal TypeReference v)
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> BranchAccum v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
forall v.
Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
-> Maybe (ANormal TypeReference v) -> BranchAccum v
AccumRequest Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing
                (Map TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
 -> BranchAccum v)
-> (ANormal TypeReference v
    -> Map
         TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v)))
-> ANormal TypeReference v
-> BranchAccum v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
forall k a. k -> a -> Map k a
Map.singleton TypeReference
r
                (EnumMap CTag ([Mem], ANormal TypeReference v)
 -> Map
      TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v)))
-> (ANormal TypeReference v
    -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> Map
     TypeReference (EnumMap CTag ([Mem], ANormal TypeReference v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag
-> ([Mem], ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall k a. EnumKey k => k -> a -> EnumMap k a
EC.mapSingleton (ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t)
                (([Mem], ANormal TypeReference v)
 -> EnumMap CTag ([Mem], ANormal TypeReference v))
-> (ANormal TypeReference v -> ([Mem], ANormal TypeReference v))
-> ANormal TypeReference v
-> EnumMap CTag ([Mem], ANormal TypeReference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mem
BX Mem -> [v] -> [Mem]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [v]
us,)
                (ANormal TypeReference v -> ([Mem], ANormal TypeReference v))
-> (ANormal TypeReference v -> ANormal TypeReference v)
-> ANormal TypeReference v
-> ([Mem], ANormal TypeReference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss [v]
us
                (ANormal TypeReference v -> ANormal TypeReference v)
-> (ANormal TypeReference v -> ANormal TypeReference v)
-> ANormal TypeReference v
-> ANormal TypeReference v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference
-> v -> ANormal TypeReference v -> ANormal TypeReference v
forall v ref. Var v => ref -> v -> ANormal ref v -> ANormal ref v
TShift TypeReference
r v
kf
                (ANormal TypeReference v -> BranchAccum v)
-> ANormal TypeReference v -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ v
-> Either TypeReference v
-> [v]
-> ANormal TypeReference v
-> ANormal TypeReference v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
uk (TypeReference -> Either TypeReference v
forall a b. a -> Either a b
Left TypeReference
forall {h}. Reference' Text h
jn) [v
kf] ANormal TypeReference v
bd
  | P.SequenceLiteral p
_ [] <- Pattern p
p =
      ANormal TypeReference v -> BranchAccum v
forall v. ANormal TypeReference v -> BranchAccum v
AccumSeqEmpty (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd
  | P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
    SeqOp
Concat <- SeqOp
op,
    P.SequenceLiteral p
p [Pattern p]
ll <- Pattern p
l = do
      SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqSplit SeqEnd
SLeft ([Pattern p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern p]
ll) Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing
        (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [p -> Pattern p
forall loc. loc -> Pattern loc
P.Var p
p, Pattern p
r] [v]
vs Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd)
  | P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
    SeqOp
Concat <- SeqOp
op,
    P.SequenceLiteral p
p [Pattern p]
rl <- Pattern p
r =
      SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqSplit SeqEnd
SLeft ([Pattern p] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern p]
rl) Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing
        (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
l, p -> Pattern p
forall loc. loc -> Pattern loc
P.Var p
p] [v]
vs Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd)
  | P.SequenceOp p
_ Pattern p
l SeqOp
op Pattern p
r <- Pattern p
p,
    SeqEnd
dir <- case SeqOp
op of SeqOp
Cons -> SeqEnd
SLeft; SeqOp
_ -> SeqEnd
SRight =
      SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal TypeReference v)
-> ANormal TypeReference v
-> BranchAccum v
AccumSeqView SeqEnd
dir Maybe (ANormal TypeReference v)
forall a. Maybe a
Nothing
        (ANormal TypeReference v -> BranchAccum v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> ANFD v (BranchAccum v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([v] -> ANormal TypeReference v -> ANormal TypeReference v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
ABTN.TAbss ([v] -> ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) [v]
-> Compose
     (ANFM v)
     ((,) (Direction ()))
     (ANormal TypeReference v -> ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern p] -> [v] -> Compose (ANFM v) ((,) (Direction ())) [v]
forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p
l, Pattern p
r] [v]
vs Compose
  (ANFM v)
  ((,) (Direction ()))
  (ANormal TypeReference v -> ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall a b.
Compose (ANFM v) ((,) (Direction ())) (a -> b)
-> Compose (ANFM v) ((,) (Direction ())) a
-> Compose (ANFM v) ((,) (Direction ())) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
bd)
  where
    anfBody :: Term v a
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
anfBody Term v a
tm = ReaderT
  (Set v)
  (StateT
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
     Identity)
  (Direction (), ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ReaderT
   (Set v)
   (StateT
      (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
      Identity)
   (Direction (), ANormal TypeReference v)
 -> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v))
-> (ReaderT
      (Set v)
      (StateT
         (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
         Identity)
      (Direction (), ANormal TypeReference v)
    -> ReaderT
         (Set v)
         (StateT
            (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
            Identity)
         (Direction (), ANormal TypeReference v))
-> ReaderT
     (Set v)
     (StateT
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
        Identity)
     (Direction (), ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v]
-> ReaderT
     (Set v)
     (StateT
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
        Identity)
     (Direction (), ANormal TypeReference v)
-> ReaderT
     (Set v)
     (StateT
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
        Identity)
     (Direction (), ANormal TypeReference v)
forall v r. Ord v => [v] -> ANFM v r -> ANFM v r
bindLocal [v]
vs (ReaderT
   (Set v)
   (StateT
      (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
      Identity)
   (Direction (), ANormal TypeReference v)
 -> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v))
-> ReaderT
     (Set v)
     (StateT
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
        Identity)
     (Direction (), ANormal TypeReference v)
-> Compose (ANFM v) ((,) (Direction ())) (ANormal TypeReference v)
forall a b. (a -> b) -> a -> b
$ Term v a
-> ReaderT
     (Set v)
     (StateT
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
        Identity)
     (Direction (), ANormal TypeReference v)
forall v a. Var v => Term v a -> ANFM v (DNormal v)
anfTerm Term v a
tm
anfInitCase v
_ (MatchCase Pattern p
p Maybe (Term v a)
_ Term v a
_) =
  [Word] -> String -> ANFD v (BranchAccum v)
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String -> ANFD v (BranchAccum v))
-> String -> ANFD v (BranchAccum v)
forall a b. (a -> b) -> a -> b
$ String
"anfInitCase: unexpected pattern: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pattern p -> String
forall a. Show a => a -> String
show Pattern p
p

valueTermLinks :: (Ord ref) => Value ref -> [ref]
valueTermLinks :: forall ref. Ord ref => Value ref -> [ref]
valueTermLinks = Set ref -> [ref]
forall a. Set a -> [a]
Set.toList (Set ref -> [ref]) -> (Value ref -> Set ref) -> Value ref -> [ref]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ref -> Set ref) -> Value ref -> Set ref
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> Set ref
forall {a}. Bool -> a -> Set a
f
  where
    f :: Bool -> a -> Set a
f Bool
False a
r = a -> Set a
forall a. a -> Set a
Set.singleton a
r
    f Bool
_ a
_ = Set a
forall a. Set a
Set.empty

-- Folds over the references necessary to _load_ a `Value`. This does
-- not include references in quoted code or values, or literal
-- term/type links.
valueLinks :: (Monoid a) => (Bool -> ref -> a) -> Value ref -> a
valueLinks :: forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f (Partial (GR ref
cr ConstructorId
_) ValList ref
vs) =
  Bool -> ref -> a
f Bool
False ref
cr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Value ref -> a) -> ValList ref -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f) ValList ref
vs
valueLinks Bool -> ref -> a
f (Data ref
dr ConstructorId
_ ValList ref
vs) =
  Bool -> ref -> a
f Bool
True ref
dr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Value ref -> a) -> ValList ref -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f) ValList ref
vs
valueLinks Bool -> ref -> a
f (Cont ValList ref
vs Cont ref
k) =
  (Value ref -> a) -> ValList ref -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f) ValList ref
vs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> ref -> a) -> Cont ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
contLinks Bool -> ref -> a
f Cont ref
k
valueLinks Bool -> ref -> a
f (BLit BLit ref
l) = (Bool -> ref -> a) -> BLit ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> BLit ref -> a
blitLinks Bool -> ref -> a
f BLit ref
l

-- Traversals of _all_ references in a `Value`, for e.g.
-- canonicalization.
instance Referential Value where
  overRefs :: forall r s. (Bool -> r -> s) -> Value r -> Value s
overRefs Bool -> r -> s
h = \case
    Partial GroupRef r
gr ValList r
vs ->
      GroupRef s -> ValList s -> Value s
forall ref. GroupRef ref -> ValList ref -> Value ref
Partial (Bool -> r -> s
h Bool
False (r -> s) -> GroupRef r -> GroupRef s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupRef r
gr) ((Value r -> Value s) -> ValList r -> ValList s
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) ValList r
vs)
    Data r
r ConstructorId
t ValList r
vs ->
      s -> ConstructorId -> ValList s -> Value s
forall ref. ref -> ConstructorId -> ValList ref -> Value ref
Data (Bool -> r -> s
h Bool
True r
r) ConstructorId
t ((Value r -> Value s) -> ValList r -> ValList s
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) ValList r
vs)
    Cont ValList r
vs Cont r
k ->
      ValList s -> Cont s -> Value s
forall ref. ValList ref -> Cont ref -> Value ref
Cont ((Value r -> Value s) -> ValList r -> ValList s
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) ValList r
vs) ((Bool -> r -> s) -> Cont r -> Cont s
forall r s. (Bool -> r -> s) -> Cont r -> Cont s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Cont r
k)
    BLit BLit r
l -> BLit s -> Value s
forall ref. BLit ref -> Value ref
BLit ((Bool -> r -> s) -> BLit r -> BLit s
forall r s. (Bool -> r -> s) -> BLit r -> BLit s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h BLit r
l)

  foldMapRefs :: forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
foldMapRefs Bool -> r -> m
h = \case
    Partial (GR r
r ConstructorId
_) ValList r
vs -> Bool -> r -> m
h Bool
False r
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Value r -> m) -> ValList r -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) ValList r
vs
    Data r
r ConstructorId
_ ValList r
vs -> Bool -> r -> m
h Bool
True r
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Value r -> m) -> ValList r -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) ValList r
vs
    Cont ValList r
vs Cont r
k -> (Value r -> m) -> ValList r -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) ValList r
vs m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Bool -> r -> m) -> Cont r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Cont r
k
    BLit BLit r
l -> (Bool -> r -> m) -> BLit r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> BLit ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h BLit r
l

  traverseRefs :: forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h = \case
    Partial GroupRef r
gr ValList r
vs ->
      GroupRef s -> ValList s -> Value s
forall ref. GroupRef ref -> ValList ref -> Value ref
Partial
        (GroupRef s -> ValList s -> Value s)
-> f (GroupRef s) -> f (ValList s -> Value s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> f s) -> GroupRef r -> f (GroupRef s)
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) -> GroupRef a -> f (GroupRef b)
traverse (Bool -> r -> f s
h Bool
False) GroupRef r
gr
        f (ValList s -> Value s) -> f (ValList s) -> f (Value s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value r -> f (Value s)) -> ValList r -> f (ValList s)
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 ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) ValList r
vs
    Data r
r ConstructorId
t ValList r
vs ->
      (s -> ConstructorId -> ValList s -> Value s)
-> ConstructorId -> s -> ValList s -> Value s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> ConstructorId -> ValList s -> Value s
forall ref. ref -> ConstructorId -> ValList ref -> Value ref
Data ConstructorId
t
        (s -> ValList s -> Value s) -> f s -> f (ValList s -> Value s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> r -> f s
h Bool
True r
r
        f (ValList s -> Value s) -> f (ValList s) -> f (Value s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value r -> f (Value s)) -> ValList r -> f (ValList s)
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 ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) ValList r
vs
    Cont ValList r
vs Cont r
k ->
      ValList s -> Cont s -> Value s
forall ref. ValList ref -> Cont ref -> Value ref
Cont
        (ValList s -> Cont s -> Value s)
-> f (ValList s) -> f (Cont s -> Value s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value r -> f (Value s)) -> ValList r -> f (ValList s)
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 ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) ValList r
vs
        f (Cont s -> Value s) -> f (Cont s) -> f (Value s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> r -> f s) -> Cont r -> f (Cont s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Cont r -> f (Cont s)
traverseRefs Bool -> r -> f s
h Cont r
k
    BLit BLit r
l -> BLit s -> Value s
forall ref. BLit ref -> Value ref
BLit (BLit s -> Value s) -> f (BLit s) -> f (Value s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> r -> f s) -> BLit r -> f (BLit s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> BLit r -> f (BLit s)
traverseRefs Bool -> r -> f s
h BLit r
l

contLinks :: (Monoid a) => (Bool -> ref -> a) -> Cont ref -> a
contLinks :: forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
contLinks Bool -> ref -> a
f (Push ConstructorId
_ ConstructorId
_ (GR ref
cr ConstructorId
_) Cont ref
k) =
  Bool -> ref -> a
f Bool
False ref
cr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> ref -> a) -> Cont ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
contLinks Bool -> ref -> a
f Cont ref
k
contLinks Bool -> ref -> a
f (Mark ConstructorId
_ [ref]
ps [(ref, Value ref)]
de Cont ref
k) =
  (ref -> a) -> [ref] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> ref -> a
f Bool
True) [ref]
ps
    a -> a -> a
forall a. Semigroup a => a -> a -> a
<> ((ref, Value ref) -> a) -> [(ref, Value ref)] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ref
k, Value ref
c) -> Bool -> ref -> a
f Bool
True ref
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f Value ref
c) [(ref, Value ref)]
de
    a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> ref -> a) -> Cont ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
contLinks Bool -> ref -> a
f Cont ref
k
contLinks Bool -> ref -> a
_ Cont ref
KE = a
forall a. Monoid a => a
mempty

-- Traversals over references in a cont.
--
-- This traverses _all_ references in the continuation, not just the
-- ones necessary to load it.
instance Referential Cont where
  overRefs :: forall r s. (Bool -> r -> s) -> Cont r -> Cont s
overRefs Bool -> r -> s
h = \case
    Cont r
KE -> Cont s
forall ref. Cont ref
KE
    Mark ConstructorId
asz [r]
rs [(r, Value r)]
env Cont r
k ->
      ConstructorId -> [s] -> [(s, Value s)] -> Cont s -> Cont s
forall ref.
ConstructorId
-> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark
        ConstructorId
asz
        ((r -> s) -> [r] -> [s]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> r -> s
h Bool
True) [r]
rs)
        (((r, Value r) -> (s, Value s)) -> [(r, Value r)] -> [(s, Value s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((r -> s) -> (Value r -> Value s) -> (r, Value r) -> (s, Value s)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Bool -> r -> s
h Bool
True) ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h)) [(r, Value r)]
env)
        ((Bool -> r -> s) -> Cont r -> Cont s
forall r s. (Bool -> r -> s) -> Cont r -> Cont s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Cont r
k)
    Push ConstructorId
fsz ConstructorId
asz GroupRef r
gr Cont r
k ->
      ConstructorId -> ConstructorId -> GroupRef s -> Cont s -> Cont s
forall ref.
ConstructorId
-> ConstructorId -> GroupRef ref -> Cont ref -> Cont ref
Push ConstructorId
fsz ConstructorId
asz (Bool -> r -> s
h Bool
False (r -> s) -> GroupRef r -> GroupRef s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupRef r
gr) ((Bool -> r -> s) -> Cont r -> Cont s
forall r s. (Bool -> r -> s) -> Cont r -> Cont s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Cont r
k)

  foldMapRefs :: forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
foldMapRefs Bool -> r -> m
h = \case
    Cont r
KE -> m
forall a. Monoid a => a
mempty
    Push ConstructorId
_ ConstructorId
_ (GR r
r ConstructorId
_) Cont r
k -> Bool -> r -> m
h Bool
False r
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Bool -> r -> m) -> Cont r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Cont r
k
    Mark ConstructorId
_ [r]
rs [(r, Value r)]
env Cont r
k ->
      (r -> m) -> [r] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> r -> m
h Bool
True) [r]
rs
        m -> m -> m
forall a. Semigroup a => a -> a -> a
<> ((r, Value r) -> m) -> [(r, Value r)] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((r -> m) -> (Value r -> m) -> (r, Value r) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> (a, b) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (Bool -> r -> m
h Bool
True) ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h)) [(r, Value r)]
env
        m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Bool -> r -> m) -> Cont r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Cont ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Cont r
k

  traverseRefs :: forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Cont r -> f (Cont s)
traverseRefs Bool -> r -> f s
h = \case
    Cont r
KE -> Cont s -> f (Cont s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cont s
forall ref. Cont ref
KE
    Mark ConstructorId
asz [r]
rs [(r, Value r)]
env Cont r
k ->
      ConstructorId -> [s] -> [(s, Value s)] -> Cont s -> Cont s
forall ref.
ConstructorId
-> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark ConstructorId
asz
        ([s] -> [(s, Value s)] -> Cont s -> Cont s)
-> f [s] -> f ([(s, Value s)] -> Cont s -> Cont s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> f s) -> [r] -> f [s]
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 (Bool -> r -> f s
h Bool
True) [r]
rs
        f ([(s, Value s)] -> Cont s -> Cont s)
-> f [(s, Value s)] -> f (Cont s -> Cont s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((r, Value r) -> f (s, Value s))
-> [(r, Value r)] -> f [(s, Value s)]
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 ((r -> f s)
-> (Value r -> f (Value s)) -> (r, Value r) -> f (s, Value s)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Bool -> r -> f s
h Bool
True) ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h)) [(r, Value r)]
env
        f (Cont s -> Cont s) -> f (Cont s) -> f (Cont s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> r -> f s) -> Cont r -> f (Cont s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Cont r -> f (Cont s)
traverseRefs Bool -> r -> f s
h Cont r
k
    Push ConstructorId
fsz ConstructorId
asz GroupRef r
gr Cont r
k ->
      ConstructorId -> ConstructorId -> GroupRef s -> Cont s -> Cont s
forall ref.
ConstructorId
-> ConstructorId -> GroupRef ref -> Cont ref -> Cont ref
Push ConstructorId
fsz ConstructorId
asz
        (GroupRef s -> Cont s -> Cont s)
-> f (GroupRef s) -> f (Cont s -> Cont s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (r -> f s) -> GroupRef r -> f (GroupRef s)
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) -> GroupRef a -> f (GroupRef b)
traverse (Bool -> r -> f s
h Bool
False) GroupRef r
gr
        f (Cont s -> Cont s) -> f (Cont s) -> f (Cont s)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> r -> f s) -> Cont r -> f (Cont s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Cont r -> f (Cont s)
traverseRefs Bool -> r -> f s
h Cont r
k

blitLinks :: (Monoid a) => (Bool -> ref -> a) -> BLit ref -> a
blitLinks :: forall a ref. Monoid a => (Bool -> ref -> a) -> BLit ref -> a
blitLinks Bool -> ref -> a
f (List Seq (Value ref)
s) = (Value ref -> a) -> Seq (Value ref) -> a
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f) Seq (Value ref)
s
blitLinks Bool -> ref -> a
f (Arr Array (Value ref)
a) = (Value ref -> a) -> Array (Value ref) -> a
forall m a. Monoid m => (a -> m) -> Array a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f) Array (Value ref)
a
blitLinks Bool -> ref -> a
f (Map [(Value ref, Value ref)]
m) =
  ((Value ref, Value ref) -> a) -> [(Value ref, Value ref)] -> a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Value ref
k, Value ref
v) -> (Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f Value ref
k a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (Bool -> ref -> a) -> Value ref -> a
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> a
f Value ref
v) [(Value ref, Value ref)]
m
blitLinks Bool -> ref -> a
_ BLit ref
_ = a
forall a. Monoid a => a
mempty

instance Referential BLit where
  overRefs :: forall r s. (Bool -> r -> s) -> BLit r -> BLit s
overRefs Bool -> r -> s
h = \case
    List Seq (Value r)
vs -> Seq (Value s) -> BLit s
forall ref. Seq (Value ref) -> BLit ref
List ((Value r -> Value s) -> Seq (Value r) -> Seq (Value s)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) Seq (Value r)
vs)
    TmLink Referent' r
rn -> Referent' s -> BLit s
forall ref. Referent' ref -> BLit ref
TmLink ((Bool -> r -> s) -> Referent' r -> Referent' s
forall r s. (Bool -> r -> s) -> Referent' r -> Referent' s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Referent' r
rn)
    TyLink r
r -> s -> BLit s
forall ref. ref -> BLit ref
TyLink (s -> BLit s) -> s -> BLit s
forall a b. (a -> b) -> a -> b
$ Bool -> r -> s
h Bool
True r
r
    Quote Value r
v -> Value s -> BLit s
forall ref. Value ref -> BLit ref
Quote (Value s -> BLit s) -> Value s -> BLit s
forall a b. (a -> b) -> a -> b
$ (Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Value r
v
    Code Code r
co -> Code s -> BLit s
forall ref. Code ref -> BLit ref
Code (Code s -> BLit s) -> Code s -> BLit s
forall a b. (a -> b) -> a -> b
$ (Bool -> r -> s) -> Code r -> Code s
forall r s. (Bool -> r -> s) -> Code r -> Code s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h Code r
co
    Arr Array (Value r)
a -> Array (Value s) -> BLit s
forall ref. Array (Value ref) -> BLit ref
Arr (Array (Value s) -> BLit s) -> Array (Value s) -> BLit s
forall a b. (a -> b) -> a -> b
$ (Value r -> Value s) -> Array (Value r) -> Array (Value s)
forall a b. (a -> b) -> Array a -> Array b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) Array (Value r)
a
    Map [(Value r, Value r)]
kvs -> [(Value s, Value s)] -> BLit s
forall ref. [(Value ref, Value ref)] -> BLit ref
Map ([(Value s, Value s)] -> BLit s) -> [(Value s, Value s)] -> BLit s
forall a b. (a -> b) -> a -> b
$ ((Value r, Value r) -> (Value s, Value s))
-> [(Value r, Value r)] -> [(Value s, Value s)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value r -> Value s)
-> (Value r -> Value s) -> (Value r, Value r) -> (Value s, Value s)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h) ((Bool -> r -> s) -> Value r -> Value s
forall r s. (Bool -> r -> s) -> Value r -> Value s
forall (t :: * -> *) r s.
Referential t =>
(Bool -> r -> s) -> t r -> t s
overRefs Bool -> r -> s
h)) [(Value r, Value r)]
kvs
    Text Text
t -> Text -> BLit s
forall ref. Text -> BLit ref
Text Text
t
    Bytes Bytes
b -> Bytes -> BLit s
forall ref. Bytes -> BLit ref
Bytes Bytes
b
    BArr ByteArray
ba -> ByteArray -> BLit s
forall ref. ByteArray -> BLit ref
BArr ByteArray
ba
    Pos ConstructorId
n -> ConstructorId -> BLit s
forall ref. ConstructorId -> BLit ref
Pos ConstructorId
n
    Neg ConstructorId
n -> ConstructorId -> BLit s
forall ref. ConstructorId -> BLit ref
Neg ConstructorId
n
    Char Char
c -> Char -> BLit s
forall ref. Char -> BLit ref
Char Char
c
    Float Double
f -> Double -> BLit s
forall ref. Double -> BLit ref
Float Double
f

  foldMapRefs :: forall a ref. Monoid a => (Bool -> ref -> a) -> BLit ref -> a
foldMapRefs Bool -> r -> m
h = \case
    List Seq (Value r)
vs -> (Value r -> m) -> Seq (Value r) -> m
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) Seq (Value r)
vs
    TmLink Referent' r
rn -> (Bool -> r -> m) -> Referent' r -> m
forall m r. Monoid m => (Bool -> r -> m) -> Referent' r -> m
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Referent' r
rn
    TyLink r
r -> Bool -> r -> m
h Bool
True r
r
    Quote Value r
v -> (Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Value r
v
    Code Code r
co -> (Bool -> r -> m) -> Code r -> m
forall m r. Monoid m => (Bool -> r -> m) -> Code r -> m
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h Code r
co
    Arr Array (Value r)
a -> (Value r -> m) -> Array (Value r) -> m
forall m a. Monoid m => (a -> m) -> Array a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) Array (Value r)
a
    Map [(Value r, Value r)]
kvs -> ((Value r, Value r) -> m) -> [(Value r, Value r)] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Value r -> m) -> (Value r -> m) -> (Value r, Value r) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> (a, b) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h) ((Bool -> r -> m) -> Value r -> m
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
forall (t :: * -> *) m r.
(Referential t, Monoid m) =>
(Bool -> r -> m) -> t r -> m
foldMapRefs Bool -> r -> m
h)) [(Value r, Value r)]
kvs
    BLit r
_ -> m
forall a. Monoid a => a
mempty

  traverseRefs :: forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> BLit r -> f (BLit s)
traverseRefs Bool -> r -> f s
h = \case
    List Seq (Value r)
vs -> Seq (Value s) -> BLit s
forall ref. Seq (Value ref) -> BLit ref
List (Seq (Value s) -> BLit s) -> f (Seq (Value s)) -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value r -> f (Value s)) -> Seq (Value r) -> f (Seq (Value s))
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) -> Seq a -> f (Seq b)
traverse ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) Seq (Value r)
vs
    TmLink Referent' r
rn -> Referent' s -> BLit s
forall ref. Referent' ref -> BLit ref
TmLink (Referent' s -> BLit s) -> f (Referent' s) -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> r -> f s) -> Referent' r -> f (Referent' s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Referent' r -> f (Referent' s)
traverseRefs Bool -> r -> f s
h Referent' r
rn
    TyLink r
r -> s -> BLit s
forall ref. ref -> BLit ref
TyLink (s -> BLit s) -> f s -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> r -> f s
h Bool
True r
r
    Quote Value r
v -> Value s -> BLit s
forall ref. Value ref -> BLit ref
Quote (Value s -> BLit s) -> f (Value s) -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h Value r
v
    Code Code r
co -> Code s -> BLit s
forall ref. Code ref -> BLit ref
Code (Code s -> BLit s) -> f (Code s) -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> r -> f s) -> Code r -> f (Code s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Code r -> f (Code s)
traverseRefs Bool -> r -> f s
h Code r
co
    Arr Array (Value r)
a -> Array (Value s) -> BLit s
forall ref. Array (Value ref) -> BLit ref
Arr (Array (Value s) -> BLit s) -> f (Array (Value s)) -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value r -> f (Value s)) -> Array (Value r) -> f (Array (Value s))
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) -> Array a -> f (Array b)
traverse ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) Array (Value r)
a
    Map [(Value r, Value r)]
kvs ->
      [(Value s, Value s)] -> BLit s
forall ref. [(Value ref, Value ref)] -> BLit ref
Map
        ([(Value s, Value s)] -> BLit s)
-> f [(Value s, Value s)] -> f (BLit s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value r, Value r) -> f (Value s, Value s))
-> [(Value r, Value r)] -> f [(Value s, Value s)]
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 ((Value r -> f (Value s))
-> (Value r -> f (Value s))
-> (Value r, Value r)
-> f (Value s, Value s)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h) ((Bool -> r -> f s) -> Value r -> f (Value s)
forall (t :: * -> *) (f :: * -> *) r s.
(Referential t, Applicative f) =>
(Bool -> r -> f s) -> t r -> f (t s)
forall (f :: * -> *) r s.
Applicative f =>
(Bool -> r -> f s) -> Value r -> f (Value s)
traverseRefs Bool -> r -> f s
h)) [(Value r, Value r)]
kvs
    Text Text
t -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ Text -> BLit s
forall ref. Text -> BLit ref
Text Text
t
    Bytes Bytes
b -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ Bytes -> BLit s
forall ref. Bytes -> BLit ref
Bytes Bytes
b
    BArr ByteArray
ba -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ ByteArray -> BLit s
forall ref. ByteArray -> BLit ref
BArr ByteArray
ba
    Pos ConstructorId
n -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ ConstructorId -> BLit s
forall ref. ConstructorId -> BLit ref
Pos ConstructorId
n
    Neg ConstructorId
n -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ ConstructorId -> BLit s
forall ref. ConstructorId -> BLit ref
Neg ConstructorId
n
    Char Char
c -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ Char -> BLit s
forall ref. Char -> BLit ref
Char Char
c
    Float Double
f -> BLit s -> f (BLit s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BLit s -> f (BLit s)) -> BLit s -> f (BLit s)
forall a b. (a -> b) -> a -> b
$ Double -> BLit s
forall ref. Double -> BLit ref
Float Double
f

groupTermLinks :: (Ord ref, Var v) => SuperGroup ref v -> [ref]
groupTermLinks :: forall ref v. (Ord ref, Var v) => SuperGroup ref v -> [ref]
groupTermLinks = Set ref -> [ref]
forall a. Set a -> [a]
Set.toList (Set ref -> [ref])
-> (SuperGroup ref v -> Set ref) -> SuperGroup ref v -> [ref]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ref -> Set ref) -> SuperGroup ref v -> Set ref
forall r v ref.
(Monoid r, Var v) =>
(Bool -> ref -> r) -> SuperGroup ref v -> r
foldGroupLinks Bool -> ref -> Set ref
forall {a}. Bool -> a -> Set a
f
  where
    f :: Bool -> a -> Set a
f Bool
False a
r = a -> Set a
forall a. a -> Set a
Set.singleton a
r
    f Bool
_ a
_ = Set a
forall a. Set a
Set.empty

overGroupLinks ::
  (Var v) =>
  (Bool -> ref0 -> ref1) ->
  SuperGroup ref0 v ->
  SuperGroup ref1 v
overGroupLinks :: forall v ref0 ref1.
Var v =>
(Bool -> ref0 -> ref1) -> SuperGroup ref0 v -> SuperGroup ref1 v
overGroupLinks Bool -> ref0 -> ref1
f =
  Identity (SuperGroup ref1 v) -> SuperGroup ref1 v
forall a. Identity a -> a
runIdentity (Identity (SuperGroup ref1 v) -> SuperGroup ref1 v)
-> (SuperGroup ref0 v -> Identity (SuperGroup ref1 v))
-> SuperGroup ref0 v
-> SuperGroup ref1 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ref0 -> Identity ref1)
-> SuperGroup ref0 v -> Identity (SuperGroup ref1 v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperGroup ref0 v -> f (SuperGroup ref1 v)
traverseGroupLinks (\Bool
b -> ref1 -> Identity ref1
forall a. a -> Identity a
Identity (ref1 -> Identity ref1) -> (ref0 -> ref1) -> ref0 -> Identity ref1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ref0 -> ref1
f Bool
b)

traverseGroupLinks ::
  (Applicative f, Var v) =>
  (Bool -> ref0 -> f ref1) ->
  SuperGroup ref0 v ->
  f (SuperGroup ref1 v)
traverseGroupLinks :: forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperGroup ref0 v -> f (SuperGroup ref1 v)
traverseGroupLinks Bool -> ref0 -> f ref1
f (Rec [(v, SuperNormal ref0 v)]
bs SuperNormal ref0 v
e) =
  [(v, SuperNormal ref1 v)]
-> SuperNormal ref1 v -> SuperGroup ref1 v
forall ref v.
[(v, SuperNormal ref v)] -> SuperNormal ref v -> SuperGroup ref v
Rec ([(v, SuperNormal ref1 v)]
 -> SuperNormal ref1 v -> SuperGroup ref1 v)
-> f [(v, SuperNormal ref1 v)]
-> f (SuperNormal ref1 v -> SuperGroup ref1 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((v, SuperNormal ref0 v) -> f (v, SuperNormal ref1 v))
-> [(v, SuperNormal ref0 v)] -> f [(v, SuperNormal ref1 v)]
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 (((v, SuperNormal ref0 v) -> f (v, SuperNormal ref1 v))
 -> [(v, SuperNormal ref0 v)] -> f [(v, SuperNormal ref1 v)])
-> ((SuperNormal ref0 v -> f (SuperNormal ref1 v))
    -> (v, SuperNormal ref0 v) -> f (v, SuperNormal ref1 v))
-> (SuperNormal ref0 v -> f (SuperNormal ref1 v))
-> [(v, SuperNormal ref0 v)]
-> f [(v, SuperNormal ref1 v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperNormal ref0 v -> f (SuperNormal ref1 v))
-> (v, SuperNormal ref0 v) -> f (v, SuperNormal ref1 v)
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) -> (v, a) -> f (v, b)
traverse) ((Bool -> ref0 -> f ref1)
-> SuperNormal ref0 v -> f (SuperNormal ref1 v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperNormal ref0 v -> f (SuperNormal ref1 v)
normalLinks Bool -> ref0 -> f ref1
f) [(v, SuperNormal ref0 v)]
bs f (SuperNormal ref1 v -> SuperGroup ref1 v)
-> f (SuperNormal ref1 v) -> f (SuperGroup ref1 v)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> ref0 -> f ref1)
-> SuperNormal ref0 v -> f (SuperNormal ref1 v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperNormal ref0 v -> f (SuperNormal ref1 v)
normalLinks Bool -> ref0 -> f ref1
f SuperNormal ref0 v
e

foldGroupLinks ::
  (Monoid r, Var v) =>
  (Bool -> ref -> r) ->
  SuperGroup ref v ->
  r
foldGroupLinks :: forall r v ref.
(Monoid r, Var v) =>
(Bool -> ref -> r) -> SuperGroup ref v -> r
foldGroupLinks Bool -> ref -> r
f = Const r (SuperGroup Any v) -> r
forall {k} a (b :: k). Const a b -> a
getConst (Const r (SuperGroup Any v) -> r)
-> (SuperGroup ref v -> Const r (SuperGroup Any v))
-> SuperGroup ref v
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ref -> Const r Any)
-> SuperGroup ref v -> Const r (SuperGroup Any v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperGroup ref0 v -> f (SuperGroup ref1 v)
traverseGroupLinks (\Bool
b -> r -> Const r Any
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r Any) -> (ref -> r) -> ref -> Const r Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ref -> r
f Bool
b)

normalLinks ::
  (Applicative f, Var v) =>
  (Bool -> ref0 -> f ref1) ->
  SuperNormal ref0 v ->
  f (SuperNormal ref1 v)
normalLinks :: forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1)
-> SuperNormal ref0 v -> f (SuperNormal ref1 v)
normalLinks Bool -> ref0 -> f ref1
f (Lambda [Mem]
ccs ANormal ref0 v
e) = [Mem] -> ANormal ref1 v -> SuperNormal ref1 v
forall ref v. [Mem] -> ANormal ref v -> SuperNormal ref v
Lambda [Mem]
ccs (ANormal ref1 v -> SuperNormal ref1 v)
-> f (ANormal ref1 v) -> f (SuperNormal ref1 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1) -> ANormal ref0 v -> f (ANormal ref1 v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1) -> ANormal ref0 v -> f (ANormal ref1 v)
anfLinks Bool -> ref0 -> f ref1
f ANormal ref0 v
e

anfLinks ::
  (Applicative f, Var v) =>
  (Bool -> ref0 -> f ref1) ->
  ANormal ref0 v ->
  f (ANormal ref1 v)
anfLinks :: forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1) -> ANormal ref0 v -> f (ANormal ref1 v)
anfLinks Bool -> ref0 -> f ref1
f (ABTN.Term Set v
_ (ABTN.Abs v
v Term (ANormalF ref0) v
e)) =
  v -> Term (ANormalF ref1) v -> Term (ANormalF ref1) v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
ABTN.TAbs v
v (Term (ANormalF ref1) v -> Term (ANormalF ref1) v)
-> f (Term (ANormalF ref1) v) -> f (Term (ANormalF ref1) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1)
-> Term (ANormalF ref0) v -> f (Term (ANormalF ref1) v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1) -> ANormal ref0 v -> f (ANormal ref1 v)
anfLinks Bool -> ref0 -> f ref1
f Term (ANormalF ref0) v
e
anfLinks Bool -> ref0 -> f ref1
f (ABTN.Term Set v
_ (ABTN.Tm ANormalF ref0 v (Term (ANormalF ref0) v)
e)) =
  ANormalF ref1 v (Term (ANormalF ref1) v) -> Term (ANormalF ref1) v
forall v (f :: * -> * -> *).
(Var v, Bifoldable f) =>
f v (Term f v) -> Term f v
ABTN.TTm (ANormalF ref1 v (Term (ANormalF ref1) v)
 -> Term (ANormalF ref1) v)
-> f (ANormalF ref1 v (Term (ANormalF ref1) v))
-> f (Term (ANormalF ref1) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1)
-> (Term (ANormalF ref0) v -> f (Term (ANormalF ref1) v))
-> ANormalF ref0 v (Term (ANormalF ref0) v)
-> f (ANormalF ref1 v (Term (ANormalF ref1) v))
forall (f :: * -> *) ref0 ref1 e0 e1 v.
Applicative f =>
(Bool -> ref0 -> f ref1)
-> (e0 -> f e1) -> ANormalF ref0 v e0 -> f (ANormalF ref1 v e1)
anfFLinks Bool -> ref0 -> f ref1
f ((Bool -> ref0 -> f ref1)
-> Term (ANormalF ref0) v -> f (Term (ANormalF ref1) v)
forall (f :: * -> *) v ref0 ref1.
(Applicative f, Var v) =>
(Bool -> ref0 -> f ref1) -> ANormal ref0 v -> f (ANormal ref1 v)
anfLinks Bool -> ref0 -> f ref1
f) ANormalF ref0 v (Term (ANormalF ref0) v)
e

anfFLinks ::
  (Applicative f) =>
  (Bool -> ref0 -> f ref1) ->
  (e0 -> f e1) ->
  ANormalF ref0 v e0 ->
  f (ANormalF ref1 v e1)
anfFLinks :: forall (f :: * -> *) ref0 ref1 e0 e1 v.
Applicative f =>
(Bool -> ref0 -> f ref1)
-> (e0 -> f e1) -> ANormalF ref0 v e0 -> f (ANormalF ref1 v e1)
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
g (ALet Direction Word16
d [Mem]
ccs e0
b e0
e) = Direction Word16 -> [Mem] -> e1 -> e1 -> ANormalF ref1 v e1
forall ref v e.
Direction Word16 -> [Mem] -> e -> e -> ANormalF ref v e
ALet Direction Word16
d [Mem]
ccs (e1 -> e1 -> ANormalF ref1 v e1)
-> f e1 -> f (e1 -> ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e0 -> f e1
g e0
b f (e1 -> ANormalF ref1 v e1) -> f e1 -> f (ANormalF ref1 v e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e0 -> f e1
g e0
e
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
g (AName Either ref0 v
er [v]
vs e0
e) =
  (Either ref1 v -> [v] -> e1 -> ANormalF ref1 v e1)
-> [v] -> Either ref1 v -> e1 -> ANormalF ref1 v e1
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either ref1 v -> [v] -> e1 -> ANormalF ref1 v e1
forall ref v e. Either ref v -> [v] -> e -> ANormalF ref v e
AName [v]
vs (Either ref1 v -> e1 -> ANormalF ref1 v e1)
-> f (Either ref1 v) -> f (e1 -> ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ref0 -> f ref1)
-> (v -> f v) -> Either ref0 v -> f (Either ref1 v)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Bool -> ref0 -> f ref1
f Bool
False) v -> f v
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ref0 v
er f (e1 -> ANormalF ref1 v e1) -> f e1 -> f (ANormalF ref1 v e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e0 -> f e1
g e0
e
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
g (AMatch v
v Branched ref0 e0
bs) =
  v -> Branched ref1 e1 -> ANormalF ref1 v e1
forall ref v e. v -> Branched ref e -> ANormalF ref v e
AMatch v
v (Branched ref1 e1 -> ANormalF ref1 v e1)
-> f (Branched ref1 e1) -> f (ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ref0 -> f ref1)
-> (e0 -> f e1) -> Branched ref0 e0 -> f (Branched ref1 e1)
forall (f :: * -> *) ref0 ref1 e0 e1.
Applicative f =>
(ref0 -> f ref1)
-> (e0 -> f e1) -> Branched ref0 e0 -> f (Branched ref1 e1)
branchLinks (Bool -> ref0 -> f ref1
f Bool
True) e0 -> f e1
g Branched ref0 e0
bs
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
g (AShift ref0
r e0
e) =
  ref1 -> e1 -> ANormalF ref1 v e1
forall ref v e. ref -> e -> ANormalF ref v e
AShift (ref1 -> e1 -> ANormalF ref1 v e1)
-> f ref1 -> f (e1 -> ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
True ref0
r f (e1 -> ANormalF ref1 v e1) -> f e1 -> f (ANormalF ref1 v e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e0 -> f e1
g e0
e
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
g (AHnd [ref0]
rs v
nh Maybe v
ah e0
e) =
  (\[ref1]
rs -> [ref1] -> v -> Maybe v -> e1 -> ANormalF ref1 v e1
forall ref v e. [ref] -> v -> Maybe v -> e -> ANormalF ref v e
AHnd [ref1]
rs v
nh Maybe v
ah) ([ref1] -> e1 -> ANormalF ref1 v e1)
-> f [ref1] -> f (e1 -> ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ref0 -> f ref1) -> [ref0] -> f [ref1]
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 (Bool -> ref0 -> f ref1
f Bool
True) [ref0]
rs f (e1 -> ANormalF ref1 v e1) -> f e1 -> f (ANormalF ref1 v e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e0 -> f e1
g e0
e
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
_ (AApp Func ref0 v
fu [v]
vs) = (Func ref1 v -> [v] -> ANormalF ref1 v e1)
-> [v] -> Func ref1 v -> ANormalF ref1 v e1
forall a b c. (a -> b -> c) -> b -> a -> c
flip Func ref1 v -> [v] -> ANormalF ref1 v e1
forall ref v e. Func ref v -> [v] -> ANormalF ref v e
AApp [v]
vs (Func ref1 v -> ANormalF ref1 v e1)
-> f (Func ref1 v) -> f (ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1) -> Func ref0 v -> f (Func ref1 v)
forall (f :: * -> *) ref0 ref1 v.
Applicative f =>
(Bool -> ref0 -> f ref1) -> Func ref0 v -> f (Func ref1 v)
funcLinks Bool -> ref0 -> f ref1
f Func ref0 v
fu
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
_ (ALit Lit ref0
l) = Lit ref1 -> ANormalF ref1 v e1
forall ref v e. Lit ref -> ANormalF ref v e
ALit (Lit ref1 -> ANormalF ref1 v e1)
-> f (Lit ref1) -> f (ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1) -> Lit ref0 -> f (Lit ref1)
forall (f :: * -> *) ref0 ref1.
Applicative f =>
(Bool -> ref0 -> f ref1) -> Lit ref0 -> f (Lit ref1)
litLinks Bool -> ref0 -> f ref1
f Lit ref0
l
anfFLinks Bool -> ref0 -> f ref1
f e0 -> f e1
_ (ABLit Lit ref0
l) = Lit ref1 -> ANormalF ref1 v e1
forall ref v e. Lit ref -> ANormalF ref v e
ABLit (Lit ref1 -> ANormalF ref1 v e1)
-> f (Lit ref1) -> f (ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ref0 -> f ref1) -> Lit ref0 -> f (Lit ref1)
forall (f :: * -> *) ref0 ref1.
Applicative f =>
(Bool -> ref0 -> f ref1) -> Lit ref0 -> f (Lit ref1)
litLinks Bool -> ref0 -> f ref1
f Lit ref0
l
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
_ (AFrc v
v) = ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormalF ref1 v e1 -> f (ANormalF ref1 v e1))
-> ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a b. (a -> b) -> a -> b
$ v -> ANormalF ref1 v e1
forall ref v e. v -> ANormalF ref v e
AFrc v
v
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
_ (AVar v
v) = ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormalF ref1 v e1 -> f (ANormalF ref1 v e1))
-> ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a b. (a -> b) -> a -> b
$ v -> ANormalF ref1 v e1
forall ref v e. v -> ANormalF ref v e
AVar v
v
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
_ (ADiscard v
v) = ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormalF ref1 v e1 -> f (ANormalF ref1 v e1))
-> ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a b. (a -> b) -> a -> b
$ v -> ANormalF ref1 v e1
forall ref v e. v -> ANormalF ref v e
ADiscard v
v
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
g (ALocal v
v e0
e) = v -> e1 -> ANormalF ref1 v e1
forall ref v e. v -> e -> ANormalF ref v e
ALocal v
v (e1 -> ANormalF ref1 v e1) -> f e1 -> f (ANormalF ref1 v e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e0 -> f e1
g e0
e
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
_ (AUpdate Bool
b v
u v
v) = ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ANormalF ref1 v e1 -> f (ANormalF ref1 v e1))
-> ANormalF ref1 v e1 -> f (ANormalF ref1 v e1)
forall a b. (a -> b) -> a -> b
$ Bool -> v -> v -> ANormalF ref1 v e1
forall ref v e. Bool -> v -> v -> ANormalF ref v e
AUpdate Bool
b v
u v
v

litLinks ::
  (Applicative f) =>
  (Bool -> ref0 -> f ref1) ->
  Lit ref0 ->
  f (Lit ref1)
litLinks :: forall (f :: * -> *) ref0 ref1.
Applicative f =>
(Bool -> ref0 -> f ref1) -> Lit ref0 -> f (Lit ref1)
litLinks Bool -> ref0 -> f ref1
f (LY ref0
r) = ref1 -> Lit ref1
forall ref. ref -> Lit ref
LY (ref1 -> Lit ref1) -> f ref1 -> f (Lit ref1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
True ref0
r
litLinks Bool -> ref0 -> f ref1
f (LM (Rfn.Con' (ConstructorReference ref0
r ConstructorId
i) ConstructorType
t)) =
  Referent' ref1 -> Lit ref1
forall ref. Referent' ref -> Lit ref
LM (Referent' ref1 -> Lit ref1)
-> (ref1 -> Referent' ref1) -> ref1 -> Lit ref1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GConstructorReference ref1 -> ConstructorType -> Referent' ref1)
-> ConstructorType -> GConstructorReference ref1 -> Referent' ref1
forall a b c. (a -> b -> c) -> b -> a -> c
flip GConstructorReference ref1 -> ConstructorType -> Referent' ref1
forall r. GConstructorReference r -> ConstructorType -> Referent' r
Rfn.Con' ConstructorType
t (GConstructorReference ref1 -> Referent' ref1)
-> (ref1 -> GConstructorReference ref1) -> ref1 -> Referent' ref1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ref1 -> ConstructorId -> GConstructorReference ref1)
-> ConstructorId -> ref1 -> GConstructorReference ref1
forall a b c. (a -> b -> c) -> b -> a -> c
flip ref1 -> ConstructorId -> GConstructorReference ref1
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference ConstructorId
i (ref1 -> Lit ref1) -> f ref1 -> f (Lit ref1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
True ref0
r
litLinks Bool -> ref0 -> f ref1
f (LM (Rfn.Ref' ref0
r)) = Referent' ref1 -> Lit ref1
forall ref. Referent' ref -> Lit ref
LM (Referent' ref1 -> Lit ref1)
-> (ref1 -> Referent' ref1) -> ref1 -> Lit ref1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref1 -> Referent' ref1
forall r. r -> Referent' r
Rfn.Ref' (ref1 -> Lit ref1) -> f ref1 -> f (Lit ref1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
False ref0
r
litLinks Bool -> ref0 -> f ref1
_ (I Int64
i) = Lit ref1 -> f (Lit ref1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref1 -> f (Lit ref1)) -> Lit ref1 -> f (Lit ref1)
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit ref1
forall ref. Int64 -> Lit ref
I Int64
i
litLinks Bool -> ref0 -> f ref1
_ (N ConstructorId
n) = Lit ref1 -> f (Lit ref1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref1 -> f (Lit ref1)) -> Lit ref1 -> f (Lit ref1)
forall a b. (a -> b) -> a -> b
$ ConstructorId -> Lit ref1
forall ref. ConstructorId -> Lit ref
N ConstructorId
n
litLinks Bool -> ref0 -> f ref1
_ (F Double
d) = Lit ref1 -> f (Lit ref1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref1 -> f (Lit ref1)) -> Lit ref1 -> f (Lit ref1)
forall a b. (a -> b) -> a -> b
$ Double -> Lit ref1
forall ref. Double -> Lit ref
F Double
d
litLinks Bool -> ref0 -> f ref1
_ (T Text
t) = Lit ref1 -> f (Lit ref1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref1 -> f (Lit ref1)) -> Lit ref1 -> f (Lit ref1)
forall a b. (a -> b) -> a -> b
$ Text -> Lit ref1
forall ref. Text -> Lit ref
T Text
t
litLinks Bool -> ref0 -> f ref1
_ (C Char
c) = Lit ref1 -> f (Lit ref1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lit ref1 -> f (Lit ref1)) -> Lit ref1 -> f (Lit ref1)
forall a b. (a -> b) -> a -> b
$ Char -> Lit ref1
forall ref. Char -> Lit ref
C Char
c

branchLinks ::
  (Applicative f) =>
  (ref0 -> f ref1) ->
  (e0 -> f e1) ->
  Branched ref0 e0 ->
  f (Branched ref1 e1)
branchLinks :: forall (f :: * -> *) ref0 ref1 e0 e1.
Applicative f =>
(ref0 -> f ref1)
-> (e0 -> f e1) -> Branched ref0 e0 -> f (Branched ref1 e1)
branchLinks ref0 -> f ref1
f e0 -> f e1
g (MatchRequest [(ref0, EnumMap CTag ([Mem], e0))]
m e0
e) =
  [(ref1, EnumMap CTag ([Mem], e1))] -> e1 -> Branched ref1 e1
forall ref e.
[(ref, EnumMap CTag ([Mem], e))] -> e -> Branched ref e
MatchRequest ([(ref1, EnumMap CTag ([Mem], e1))] -> e1 -> Branched ref1 e1)
-> f [(ref1, EnumMap CTag ([Mem], e1))]
-> f (e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ref0, EnumMap CTag ([Mem], e0))
 -> f (ref1, EnumMap CTag ([Mem], e1)))
-> [(ref0, EnumMap CTag ([Mem], e0))]
-> f [(ref1, EnumMap CTag ([Mem], e1))]
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 (ref0, EnumMap CTag ([Mem], e0))
-> f (ref1, EnumMap CTag ([Mem], e1))
h [(ref0, EnumMap CTag ([Mem], e0))]
m f (e1 -> Branched ref1 e1) -> f e1 -> f (Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e0 -> f e1
g e0
e
  where
    h :: (ref0, EnumMap CTag ([Mem], e0))
-> f (ref1, EnumMap CTag ([Mem], e1))
h (ref0
r, EnumMap CTag ([Mem], e0)
cs) = (,) (ref1
 -> EnumMap CTag ([Mem], e1) -> (ref1, EnumMap CTag ([Mem], e1)))
-> f ref1
-> f (EnumMap CTag ([Mem], e1) -> (ref1, EnumMap CTag ([Mem], e1)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ref0 -> f ref1
f ref0
r f (EnumMap CTag ([Mem], e1) -> (ref1, EnumMap CTag ([Mem], e1)))
-> f (EnumMap CTag ([Mem], e1))
-> f (ref1, EnumMap CTag ([Mem], e1))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((([Mem], e0) -> f ([Mem], e1))
-> EnumMap CTag ([Mem], e0) -> f (EnumMap CTag ([Mem], e1))
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) -> EnumMap CTag a -> f (EnumMap CTag b)
traverse ((([Mem], e0) -> f ([Mem], e1))
 -> EnumMap CTag ([Mem], e0) -> f (EnumMap CTag ([Mem], e1)))
-> ((e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1))
-> (e0 -> f e1)
-> EnumMap CTag ([Mem], e0)
-> f (EnumMap CTag ([Mem], e1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1)
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) -> ([Mem], a) -> f ([Mem], b)
traverse) e0 -> f e1
g EnumMap CTag ([Mem], e0)
cs
branchLinks ref0 -> f ref1
f e0 -> f e1
g (MatchData ref0
r EnumMap CTag ([Mem], e0)
m Maybe e0
e) =
  ref1 -> EnumMap CTag ([Mem], e1) -> Maybe e1 -> Branched ref1 e1
forall ref e.
ref -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched ref e
MatchData (ref1 -> EnumMap CTag ([Mem], e1) -> Maybe e1 -> Branched ref1 e1)
-> f ref1
-> f (EnumMap CTag ([Mem], e1) -> Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ref0 -> f ref1
f ref0
r f (EnumMap CTag ([Mem], e1) -> Maybe e1 -> Branched ref1 e1)
-> f (EnumMap CTag ([Mem], e1)) -> f (Maybe e1 -> Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((([Mem], e0) -> f ([Mem], e1))
-> EnumMap CTag ([Mem], e0) -> f (EnumMap CTag ([Mem], e1))
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) -> EnumMap CTag a -> f (EnumMap CTag b)
traverse ((([Mem], e0) -> f ([Mem], e1))
 -> EnumMap CTag ([Mem], e0) -> f (EnumMap CTag ([Mem], e1)))
-> ((e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1))
-> (e0 -> f e1)
-> EnumMap CTag ([Mem], e0)
-> f (EnumMap CTag ([Mem], e1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1)
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) -> ([Mem], a) -> f ([Mem], b)
traverse) e0 -> f e1
g EnumMap CTag ([Mem], e0)
m f (Maybe e1 -> Branched ref1 e1)
-> f (Maybe e1) -> f (Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e0 -> f e1) -> Maybe e0 -> f (Maybe e1)
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) -> Maybe a -> f (Maybe b)
traverse e0 -> f e1
g Maybe e0
e
branchLinks ref0 -> f ref1
_ e0 -> f e1
g (MatchText Map Text e0
m Maybe e0
e) =
  Map Text e1 -> Maybe e1 -> Branched ref1 e1
forall ref e. Map Text e -> Maybe e -> Branched ref e
MatchText (Map Text e1 -> Maybe e1 -> Branched ref1 e1)
-> f (Map Text e1) -> f (Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e0 -> f e1) -> Map Text e0 -> f (Map Text e1)
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) -> Map Text a -> f (Map Text b)
traverse e0 -> f e1
g Map Text e0
m f (Maybe e1 -> Branched ref1 e1)
-> f (Maybe e1) -> f (Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e0 -> f e1) -> Maybe e0 -> f (Maybe e1)
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) -> Maybe a -> f (Maybe b)
traverse e0 -> f e1
g Maybe e0
e
branchLinks ref0 -> f ref1
_ e0 -> f e1
g (MatchIntegral EnumMap ConstructorId e0
m Maybe e0
e) =
  EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1
forall ref e. EnumMap ConstructorId e -> Maybe e -> Branched ref e
MatchIntegral (EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1)
-> f (EnumMap ConstructorId e1) -> f (Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e0 -> f e1)
-> EnumMap ConstructorId e0 -> f (EnumMap ConstructorId e1)
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)
-> EnumMap ConstructorId a -> f (EnumMap ConstructorId b)
traverse e0 -> f e1
g EnumMap ConstructorId e0
m f (Maybe e1 -> Branched ref1 e1)
-> f (Maybe e1) -> f (Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e0 -> f e1) -> Maybe e0 -> f (Maybe e1)
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) -> Maybe a -> f (Maybe b)
traverse e0 -> f e1
g Maybe e0
e
branchLinks ref0 -> f ref1
f e0 -> f e1
g (MatchNumeric ref0
r EnumMap ConstructorId e0
m Maybe e0
e) =
  ref1 -> EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1
forall ref e.
ref -> EnumMap ConstructorId e -> Maybe e -> Branched ref e
MatchNumeric (ref1 -> EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1)
-> f ref1
-> f (EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ref0 -> f ref1
f ref0
r f (EnumMap ConstructorId e1 -> Maybe e1 -> Branched ref1 e1)
-> f (EnumMap ConstructorId e1) -> f (Maybe e1 -> Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e0 -> f e1)
-> EnumMap ConstructorId e0 -> f (EnumMap ConstructorId e1)
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)
-> EnumMap ConstructorId a -> f (EnumMap ConstructorId b)
traverse e0 -> f e1
g EnumMap ConstructorId e0
m f (Maybe e1 -> Branched ref1 e1)
-> f (Maybe e1) -> f (Branched ref1 e1)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (e0 -> f e1) -> Maybe e0 -> f (Maybe e1)
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) -> Maybe a -> f (Maybe b)
traverse e0 -> f e1
g Maybe e0
e
branchLinks ref0 -> f ref1
_ e0 -> f e1
g (MatchSum EnumMap ConstructorId ([Mem], e0)
m) =
  EnumMap ConstructorId ([Mem], e1) -> Branched ref1 e1
forall ref e. EnumMap ConstructorId ([Mem], e) -> Branched ref e
MatchSum (EnumMap ConstructorId ([Mem], e1) -> Branched ref1 e1)
-> f (EnumMap ConstructorId ([Mem], e1)) -> f (Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([Mem], e0) -> f ([Mem], e1))
-> EnumMap ConstructorId ([Mem], e0)
-> f (EnumMap ConstructorId ([Mem], e1))
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)
-> EnumMap ConstructorId a -> f (EnumMap ConstructorId b)
traverse ((([Mem], e0) -> f ([Mem], e1))
 -> EnumMap ConstructorId ([Mem], e0)
 -> f (EnumMap ConstructorId ([Mem], e1)))
-> ((e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1))
-> (e0 -> f e1)
-> EnumMap ConstructorId ([Mem], e0)
-> f (EnumMap ConstructorId ([Mem], e1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1)
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) -> ([Mem], a) -> f ([Mem], b)
traverse) e0 -> f e1
g EnumMap ConstructorId ([Mem], e0)
m
branchLinks ref0 -> f ref1
_ e0 -> f e1
_ Branched ref0 e0
MatchEmpty = Branched ref1 e1 -> f (Branched ref1 e1)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branched ref1 e1
forall ref e. Branched ref e
MatchEmpty

funcLinks ::
  (Applicative f) =>
  (Bool -> ref0 -> f ref1) ->
  Func ref0 v ->
  f (Func ref1 v)
funcLinks :: forall (f :: * -> *) ref0 ref1 v.
Applicative f =>
(Bool -> ref0 -> f ref1) -> Func ref0 v -> f (Func ref1 v)
funcLinks Bool -> ref0 -> f ref1
f (FComb ref0
r) = ref1 -> Func ref1 v
forall ref v. ref -> Func ref v
FComb (ref1 -> Func ref1 v) -> f ref1 -> f (Func ref1 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
False ref0
r
funcLinks Bool -> ref0 -> f ref1
f (FCon ref0
r CTag
t) = (ref1 -> CTag -> Func ref1 v) -> CTag -> ref1 -> Func ref1 v
forall a b c. (a -> b -> c) -> b -> a -> c
flip ref1 -> CTag -> Func ref1 v
forall ref v. ref -> CTag -> Func ref v
FCon CTag
t (ref1 -> Func ref1 v) -> f ref1 -> f (Func ref1 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
True ref0
r
funcLinks Bool -> ref0 -> f ref1
f (FReq ref0
r CTag
t) = (ref1 -> CTag -> Func ref1 v) -> CTag -> ref1 -> Func ref1 v
forall a b c. (a -> b -> c) -> b -> a -> c
flip ref1 -> CTag -> Func ref1 v
forall ref v. ref -> CTag -> Func ref v
FReq CTag
t (ref1 -> Func ref1 v) -> f ref1 -> f (Func ref1 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ref0 -> f ref1
f Bool
True ref0
r
funcLinks Bool -> ref0 -> f ref1
_ (FVar v
v) = Func ref1 v -> f (Func ref1 v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref1 v -> f (Func ref1 v)) -> Func ref1 v -> f (Func ref1 v)
forall a b. (a -> b) -> a -> b
$ v -> Func ref1 v
forall ref v. v -> Func ref v
FVar v
v
funcLinks Bool -> ref0 -> f ref1
_ (FCont v
v) = Func ref1 v -> f (Func ref1 v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref1 v -> f (Func ref1 v)) -> Func ref1 v -> f (Func ref1 v)
forall a b. (a -> b) -> a -> b
$ v -> Func ref1 v
forall ref v. v -> Func ref v
FCont v
v
funcLinks Bool -> ref0 -> f ref1
_ (FPrim Either POp ForeignFunc
e) = Func ref1 v -> f (Func ref1 v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Func ref1 v -> f (Func ref1 v)) -> Func ref1 v -> f (Func ref1 v)
forall a b. (a -> b) -> a -> b
$ Either POp ForeignFunc -> Func ref1 v
forall ref v. Either POp ForeignFunc -> Func ref v
FPrim Either POp ForeignFunc
e

expandBindings' ::
  (Var v) =>
  Word64 ->
  [P.Pattern p] ->
  [v] ->
  Either String (Word64, [v])
expandBindings' :: forall v p.
Var v =>
ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
expandBindings' ConstructorId
fr [] [] = (ConstructorId, [v]) -> Either String (ConstructorId, [v])
forall a b. b -> Either a b
Right (ConstructorId
fr, [])
expandBindings' ConstructorId
fr (P.Unbound p
_ : [Pattern p]
ps) [v]
vs =
  ([v] -> [v]) -> (ConstructorId, [v]) -> (ConstructorId, [v])
forall a b. (a -> b) -> (ConstructorId, a) -> (ConstructorId, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
u v -> [v] -> [v]
forall a. a -> [a] -> [a]
:) ((ConstructorId, [v]) -> (ConstructorId, [v]))
-> Either String (ConstructorId, [v])
-> Either String (ConstructorId, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
forall v p.
Var v =>
ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
expandBindings' (ConstructorId
fr ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
1) [Pattern p]
ps [v]
vs
  where
    u :: v
u = ConstructorId -> v
forall v. Var v => ConstructorId -> v
freshANF ConstructorId
fr
expandBindings' ConstructorId
fr (P.Var p
_ : [Pattern p]
ps) (v
v : [v]
vs) =
  ([v] -> [v]) -> (ConstructorId, [v]) -> (ConstructorId, [v])
forall a b. (a -> b) -> (ConstructorId, a) -> (ConstructorId, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
:) ((ConstructorId, [v]) -> (ConstructorId, [v]))
-> Either String (ConstructorId, [v])
-> Either String (ConstructorId, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
forall v p.
Var v =>
ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
expandBindings' ConstructorId
fr [Pattern p]
ps [v]
vs
expandBindings' ConstructorId
_ [] (v
_ : [v]
_) =
  String -> Either String (ConstructorId, [v])
forall a b. a -> Either a b
Left String
"expandBindings': more bindings than expected"
expandBindings' ConstructorId
_ (Pattern p
_ : [Pattern p]
_) [] =
  String -> Either String (ConstructorId, [v])
forall a b. a -> Either a b
Left String
"expandBindings': more patterns than expected"
expandBindings' ConstructorId
_ [Pattern p]
_ [v]
_ =
  String -> Either String (ConstructorId, [v])
forall a b. a -> Either a b
Left (String -> Either String (ConstructorId, [v]))
-> String -> Either String (ConstructorId, [v])
forall a b. (a -> b) -> a -> b
$ String
"expandBindings': unexpected pattern"

expandBindings :: (Var v) => [P.Pattern p] -> [v] -> ANFD v [v]
expandBindings :: forall v p. Var v => [Pattern p] -> [v] -> ANFD v [v]
expandBindings [Pattern p]
ps [v]
vs =
  ANFM v (Directed () [v])
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     [v]
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ANFM v (Directed () [v])
 -> Compose
      (ReaderT
         (Set v)
         (State
            (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
      ((,) (Direction ()))
      [v])
-> (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
     -> (Directed () [v],
         (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
    -> ANFM v (Directed () [v]))
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (Directed () [v],
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (Directed () [v],
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ANFM v (Directed () [v])
forall a.
((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
 -> (a,
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
  -> (Directed () [v],
      (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
 -> Compose
      (ReaderT
         (Set v)
         (State
            (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
      ((,) (Direction ()))
      [v])
-> ((ConstructorId, Word16, [(v, SuperNormal TypeReference v)])
    -> (Directed () [v],
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     [v]
forall a b. (a -> b) -> a -> b
$ \(ConstructorId
fr, Word16
bnd, [(v, SuperNormal TypeReference v)]
co) -> case ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
forall v p.
Var v =>
ConstructorId
-> [Pattern p] -> [v] -> Either String (ConstructorId, [v])
expandBindings' ConstructorId
fr [Pattern p]
ps [v]
vs of
    Left String
err -> [Word]
-> String
-> (Directed () [v],
    (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
forall a. HasCallStack => [Word] -> String -> a
internalBug [] (String
 -> (Directed () [v],
     (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
-> String
-> (Directed () [v],
    (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Pattern p], [v]) -> String
forall a. Show a => a -> String
show ([Pattern p]
ps, [v]
vs)
    Right (ConstructorId
fr, [v]
l) -> ([v] -> Directed () [v]
forall a. a -> (Direction (), a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [v]
l, (ConstructorId
fr, Word16
bnd, [(v, SuperNormal TypeReference v)]
co))

anfCases ::
  (Var v) =>
  v ->
  [MatchCase p (Term v a)] ->
  ANFM v (Directed () (BranchAccum v))
anfCases :: forall v p a.
Var v =>
v
-> [MatchCase p (Term v a)] -> ANFM v (Directed () (BranchAccum v))
anfCases v
u = Compose
  (ReaderT
     (Set v)
     (State
        (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
  ((,) (Direction ()))
  (BranchAccum v)
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), BranchAccum v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose
   (ReaderT
      (Set v)
      (State
         (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
   ((,) (Direction ()))
   (BranchAccum v)
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Direction (), BranchAccum v))
-> ([MatchCase p (Term v a)]
    -> Compose
         (ReaderT
            (Set v)
            (State
               (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
         ((,) (Direction ()))
         (BranchAccum v))
-> [MatchCase p (Term v a)]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Direction (), BranchAccum v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BranchAccum v] -> BranchAccum v)
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     [BranchAccum v]
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     (BranchAccum v)
forall a b.
(a -> b)
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     a
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BranchAccum v] -> BranchAccum v
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Compose
   (ReaderT
      (Set v)
      (State
         (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
   ((,) (Direction ()))
   [BranchAccum v]
 -> Compose
      (ReaderT
         (Set v)
         (State
            (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
      ((,) (Direction ()))
      (BranchAccum v))
-> ([MatchCase p (Term v a)]
    -> Compose
         (ReaderT
            (Set v)
            (State
               (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
         ((,) (Direction ()))
         [BranchAccum v])
-> [MatchCase p (Term v a)]
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     (BranchAccum v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchCase p (Term v a)
 -> Compose
      (ReaderT
         (Set v)
         (State
            (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
      ((,) (Direction ()))
      (BranchAccum v))
-> [MatchCase p (Term v a)]
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     [BranchAccum v]
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 (v
-> MatchCase p (Term v a)
-> Compose
     (ReaderT
        (Set v)
        (State
           (ConstructorId, Word16, [(v, SuperNormal TypeReference v)])))
     ((,) (Direction ()))
     (BranchAccum v)
forall v p a.
Var v =>
v -> MatchCase p (Term v a) -> ANFD v (BranchAccum v)
anfInitCase v
u)

anfFunc ::
  (Var v) => Term v a -> ANFM v (Ctx v, Directed () (Func Reference v))
anfFunc :: forall v a.
Var v =>
Term v a -> ANFM v (Ctx v, Directed () (Func TypeReference v))
anfFunc (Var' v
v) = (Ctx v, Directed () (Func TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Directed () (Func TypeReference v))
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Func TypeReference v
forall ref v. v -> Func ref v
FVar v
v))
anfFunc (Ref' TypeReference
r) = (Ctx v, Directed () (Func TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Directed () (Func TypeReference v))
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), TypeReference -> Func TypeReference v
forall ref v. ref -> Func ref v
FComb TypeReference
r))
anfFunc (Constructor' (ConstructorReference TypeReference
r ConstructorId
t)) = (Ctx v, Directed () (Func TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Directed () (Func TypeReference v))
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (Direction ()
forall a. Direction a
Direct, TypeReference -> CTag -> Func TypeReference v
forall ref v. ref -> CTag -> Func ref v
FCon TypeReference
r (CTag -> Func TypeReference v) -> CTag -> Func TypeReference v
forall a b. (a -> b) -> a -> b
$ ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t))
anfFunc (Request' (ConstructorReference TypeReference
r ConstructorId
t)) = (Ctx v, Directed () (Func TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Directed () (Func TypeReference v))
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
forall a. Monoid a => a
mempty, (() -> Direction ()
forall a. a -> Direction a
Indirect (), TypeReference -> CTag -> Func TypeReference v
forall ref v. ref -> CTag -> Func ref v
FReq TypeReference
r (CTag -> Func TypeReference v) -> CTag -> Func TypeReference v
forall a b. (a -> b) -> a -> b
$ ConstructorId -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
t))
anfFunc Term (F v a a) v a
tm = do
  (Ctx v
fctx, DNormal v
ctm) <- Term (F v a a) v a -> ANFM v (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term (F v a a) v a
tm
  (Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
ctm
  (Ctx v, Directed () (Func TypeReference v))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, Directed () (Func TypeReference v))
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
fctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, (() -> Direction ()
forall a. a -> Direction a
Indirect (), v -> Func TypeReference v
forall ref v. v -> Func ref v
FVar v
v))

anfArg :: (Var v) => Term v a -> ANFM v (Ctx v, v)
anfArg :: forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg Term v a
tm = do
  (Ctx v
ctx, DNormal v
ctm) <- Term v a -> ANFM v (Ctx v, DNormal v)
forall v a. (Ord v, Var v) => Term v a -> ANFM v (Ctx v, DNormal v)
anfBlock Term v a
tm
  (Ctx v
cx, v
v) <- DNormal v -> ANFM v (Ctx v, v)
forall v. Var v => DNormal v -> ANFM v (Ctx v, v)
contextualize DNormal v
ctm
  (Ctx v, v) -> ANFM v (Ctx v, v)
forall a.
a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx v
ctx Ctx v -> Ctx v -> Ctx v
forall a. Semigroup a => a -> a -> a
<> Ctx v
cx, v
v)

anfArgs :: (Var v) => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs :: forall v a. Var v => [Term v a] -> ANFM v (Ctx v, [v])
anfArgs [Term v a]
tms = ([Ctx v] -> Ctx v) -> ([Ctx v], [v]) -> (Ctx v, [v])
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 [Ctx v] -> Ctx v
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (([Ctx v], [v]) -> (Ctx v, [v]))
-> ([(Ctx v, v)] -> ([Ctx v], [v])) -> [(Ctx v, v)] -> (Ctx v, [v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ctx v, v)] -> ([Ctx v], [v])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Ctx v, v)] -> (Ctx v, [v]))
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     [(Ctx v, v)]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term v a
 -> ReaderT
      (Set v)
      (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
      (Ctx v, v))
-> [Term v a]
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     [(Ctx v, v)]
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 Term v a
-> ReaderT
     (Set v)
     (State (ConstructorId, Word16, [(v, SuperNormal TypeReference v)]))
     (Ctx v, v)
forall v a. Var v => Term v a -> ANFM v (Ctx v, v)
anfArg [Term v a]
tms

indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
ind = String -> ShowS
showString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' ')

prettyGroup :: (Var v) => String -> SuperGroup Reference v -> ShowS
prettyGroup :: forall v. Var v => String -> SuperGroup TypeReference v -> ShowS
prettyGroup String
s (Rec [(v, SuperNormal TypeReference v)]
grp SuperNormal TypeReference v
ent) =
  String -> ShowS
showString (String
"let rec[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]\n")
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, SuperNormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(v, SuperNormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (v, SuperNormal TypeReference v) -> ShowS -> ShowS
forall {v} {v} {a}.
(Var v, Var v) =>
(v, SuperNormal TypeReference v) -> (a -> String) -> a -> String
f ShowS
forall a. a -> a
id [(v, SuperNormal TypeReference v)]
grp
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"entry"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SuperNormal TypeReference v -> ShowS
forall v. Var v => Int -> SuperNormal TypeReference v -> ShowS
prettySuperNormal Int
1 SuperNormal TypeReference v
ent
  where
    f :: (v, SuperNormal TypeReference v) -> (a -> String) -> a -> String
f (v
v, SuperNormal TypeReference v
sn) a -> String
r =
      Int -> ShowS
indent Int
1
        ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
        ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SuperNormal TypeReference v -> ShowS
forall v. Var v => Int -> SuperNormal TypeReference v -> ShowS
prettySuperNormal Int
2 SuperNormal TypeReference v
sn
        ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\n"
        ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
r

pvar :: (Var v) => v -> ShowS
pvar :: forall v. Var v => v -> ShowS
pvar v
v = String -> ShowS
showString (String -> ShowS) -> (Text -> String) -> Text -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack (Text -> ShowS) -> Text -> ShowS
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v

prettyVars :: (Var v) => [v] -> ShowS
prettyVars :: forall v. Var v => [v] -> ShowS
prettyVars =
  (v -> ShowS -> ShowS) -> ShowS -> [v] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v ShowS
r -> String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id

prettyLVars :: (Var v) => [Mem] -> [v] -> ShowS
prettyLVars :: forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [] [] = String -> ShowS
showString String
" "
prettyLVars (Mem
c : [Mem]
cs) (v
v : [v]
vs) =
  String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True (v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mem -> ShowS
forall a. Show a => a -> ShowS
shows Mem
c)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mem] -> [v] -> ShowS
forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [Mem]
cs [v]
vs
prettyLVars [] (v
_ : [v]
_) = [Word] -> String -> ShowS
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"more variables than conventions"
prettyLVars (Mem
_ : [Mem]
_) [] = [Word] -> String -> ShowS
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"more conventions than variables"

prettyRBind :: (Var v) => [v] -> ShowS
prettyRBind :: forall v. Var v => [v] -> ShowS
prettyRBind [] = String -> ShowS
showString String
"()"
prettyRBind [v
v] = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
prettyRBind (v
v : [v]
vs) =
  Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> ShowS -> ShowS) -> ShowS -> [v] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v ShowS
r -> v -> ShowS
forall a. Show a => a -> ShowS
shows v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id [v]
vs

prettySuperNormal ::
  (Var v) => Int -> SuperNormal Reference v -> ShowS
prettySuperNormal :: forall v. Var v => Int -> SuperNormal TypeReference v -> ShowS
prettySuperNormal Int
ind (Lambda [Mem]
ccs (ABTN.TAbss [v]
vs Term (ANormalF TypeReference) v
tm)) =
  [Mem] -> [v] -> ShowS
forall v. Var v => [Mem] -> [v] -> ShowS
prettyLVars [Mem]
ccs [v]
vs
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"="
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Term (ANormalF TypeReference) v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term (ANormalF TypeReference) v
tm

reqSpace :: (Var v) => Bool -> ANormal ref v -> Bool
reqSpace :: forall v ref. Var v => Bool -> ANormal ref v -> Bool
reqSpace Bool
_ TLets {} = Bool
True
reqSpace Bool
_ TName {} = Bool
True
reqSpace Bool
_ TLocal {} = Bool
True
reqSpace Bool
b ANormal ref v
_ = Bool
b

prettyANF :: (Var v) => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF :: forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
m Int
ind ANormal TypeReference v
tm =
  Bool -> Int -> ShowS
prettySpace (Bool -> ANormal TypeReference v -> Bool
forall v ref. Var v => Bool -> ANormal ref v -> Bool
reqSpace Bool
m ANormal TypeReference v
tm) Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case ANormal TypeReference v
tm of
    TLets Direction Word16
_ [v]
vs [Mem]
_ ANormal TypeReference v
bn ANormal TypeReference v
bo ->
      [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyRBind [v]
vs
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ="
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal TypeReference v
bn
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
True Int
ind ANormal TypeReference v
bo
    TName v
v Either TypeReference v
f [v]
vs ANormal TypeReference v
bo ->
      [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyRBind [v
v]
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" := "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TypeReference v -> ShowS
forall v. Var v => Either TypeReference v -> ShowS
prettyLZF Either TypeReference v
f
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
True Int
ind ANormal TypeReference v
bo
    TLit Lit TypeReference
l -> Lit TypeReference -> ShowS
forall a. Show a => a -> ShowS
shows Lit TypeReference
l
    TBLit Lit TypeReference
l -> Lit TypeReference -> ShowS
forall a. Show a => a -> ShowS
shows Lit TypeReference
l
    TFrc v
v -> String -> ShowS
showString String
"!" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
    TVar v
v -> v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
    TApp Func TypeReference v
f [v]
vs -> Func TypeReference v -> ShowS
forall v. Var v => Func TypeReference v -> ShowS
prettyFunc Func TypeReference v
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
    TMatch v
v Branched TypeReference (ANormal TypeReference v)
bs ->
      String -> ShowS
showString String
"match "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" with"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Branched TypeReference (ANormal TypeReference v) -> ShowS
forall v.
Var v =>
Int -> Branched TypeReference (ANormal TypeReference v) -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Branched TypeReference (ANormal TypeReference v)
bs
    TShift TypeReference
r v
v ANormal TypeReference v
bo ->
      String -> ShowS
showString String
"shift["
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v
v]
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"."
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal TypeReference v
bo
    THnd [TypeReference]
rs v
nh Maybe v
ah ANormal TypeReference v
bo ->
      String -> ShowS
showString String
"handle"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeReference] -> ShowS
prettyRefs [TypeReference]
rs
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal TypeReference v
bo
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ShowS
prettySpace Bool
True Int
ind
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"with "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
nh
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (v -> ShowS) -> Maybe v -> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\v
v -> String -> ShowS
showString String
" with affine " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v) Maybe v
ah
    TLocal v
hr ANormal TypeReference v
bo ->
      String -> ShowS
showString String
"in-local "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
hr
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal TypeReference v
bo
    TDiscard v
hr ->
      String -> ShowS
showString String
"discard[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
hr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
    TUpdate Bool
_ v
hr v
v ->
      String -> ShowS
showString String
"update["
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
hr
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
    ABTN.TAbs v
v (ABTN.TAbss [v]
vs ANormal TypeReference v
bo) ->
      [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
vs)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ->"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal TypeReference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal TypeReference v
bo

prettySpace :: Bool -> Int -> ShowS
prettySpace :: Bool -> Int -> ShowS
prettySpace Bool
False Int
_ = String -> ShowS
showString String
" "
prettySpace Bool
True Int
ind = String -> ShowS
showString String
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind

prettyLZF :: (Var v) => Either Reference v -> ShowS
prettyLZF :: forall v. Var v => Either TypeReference v -> ShowS
prettyLZF (Left TypeReference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
w ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") "
prettyLZF (Right v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "

prettyRefs :: [Reference] -> ShowS
prettyRefs :: [TypeReference] -> ShowS
prettyRefs [] = String -> ShowS
showString String
"{}"
prettyRefs (TypeReference
r : [TypeReference]
rs) =
  String -> ShowS
showString String
"{"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> ShowS -> ShowS)
-> ShowS -> [TypeReference] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TypeReference
t ShowS
r -> String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id [TypeReference]
rs
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"

prettyFunc :: (Var v) => Func Reference v -> ShowS
prettyFunc :: forall v. Var v => Func TypeReference v -> ShowS
prettyFunc (FVar v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyFunc (FCont v
v) = v -> ShowS
forall v. Var v => v -> ShowS
pvar v
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
prettyFunc (FComb TypeReference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
w ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FCon TypeReference
r CTag
t) =
  String -> ShowS
showString String
"CON("
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ShowS
forall a. Show a => a -> ShowS
shows CTag
t
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FReq TypeReference
r CTag
t) =
  String -> ShowS
showString String
"REQ("
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTag -> ShowS
forall a. Show a => a -> ShowS
shows CTag
t
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FPrim Either POp ForeignFunc
op) = (POp -> ShowS)
-> (ForeignFunc -> ShowS) -> Either POp ForeignFunc -> ShowS
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either POp -> ShowS
forall a. Show a => a -> ShowS
shows ForeignFunc -> ShowS
forall a. Show a => a -> ShowS
shows Either POp ForeignFunc
op ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "

showsShort :: Reference -> ShowS
showsShort :: TypeReference -> ShowS
showsShort =
  String -> ShowS
showString (String -> ShowS)
-> (TypeReference -> String) -> TypeReference -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> String
Pretty.toPlain Width
0 (Pretty ColorText -> String)
-> (TypeReference -> Pretty ColorText) -> TypeReference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Pretty ColorText
forall s. IsString s => ShortHash -> Pretty s
prettyShortHash (ShortHash -> Pretty ColorText)
-> (TypeReference -> ShortHash)
-> TypeReference
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortHash -> ShortHash
shortenTo Int
10 (ShortHash -> ShortHash)
-> (TypeReference -> ShortHash) -> TypeReference -> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShortHash
toShortHash

prettyBranches ::
  (Var v) => Int -> Branched Reference (ANormal Reference v) -> ShowS
prettyBranches :: forall v.
Var v =>
Int -> Branched TypeReference (ANormal TypeReference v) -> ShowS
prettyBranches Int
ind Branched TypeReference (ANormal TypeReference v)
bs = case Branched TypeReference (ANormal TypeReference v)
bs of
  Branched TypeReference (ANormal TypeReference v)
MatchEmpty -> String -> ShowS
showString String
"{}"
  MatchIntegral EnumMap ConstructorId (ANormal TypeReference v)
bs Maybe (ANormal TypeReference v)
df ->
    ShowS
-> (ANormal TypeReference v -> ShowS)
-> Maybe (ANormal TypeReference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal TypeReference v
e -> Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal TypeReference v
e ShowS
forall a. a -> a
id) Maybe (ANormal TypeReference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(ConstructorId, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
 -> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> (ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId -> ShowS)
-> ConstructorId
-> ANormal TypeReference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap ConstructorId (ANormal TypeReference v)
-> [(ConstructorId, ANormal TypeReference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap ConstructorId (ANormal TypeReference v)
bs)
  MatchText Map Text (ANormal TypeReference v)
bs Maybe (ANormal TypeReference v)
df ->
    ShowS
-> (ANormal TypeReference v -> ShowS)
-> Maybe (ANormal TypeReference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal TypeReference v
e -> Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal TypeReference v
e ShowS
forall a. a -> a
id) Maybe (ANormal TypeReference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(Text, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> ANormal TypeReference v -> ShowS -> ShowS)
-> (Text, ANormal TypeReference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Text -> ANormal TypeReference v -> ShowS -> ShowS)
 -> (Text, ANormal TypeReference v) -> ShowS -> ShowS)
-> (Text -> ANormal TypeReference v -> ShowS -> ShowS)
-> (Text, ANormal TypeReference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal TypeReference v -> ShowS -> ShowS)
-> (Text -> ShowS)
-> Text
-> ANormal TypeReference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (Map Text (ANormal TypeReference v)
-> [(Text, ANormal TypeReference v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text (ANormal TypeReference v)
bs)
  MatchData TypeReference
r EnumMap CTag ([Mem], ANormal TypeReference v)
bs Maybe (ANormal TypeReference v)
df ->
    ShowS
-> (ANormal TypeReference v -> ShowS)
-> Maybe (ANormal TypeReference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal TypeReference v
e -> Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal TypeReference v
e ShowS
forall a. a -> a
id) Maybe (ANormal TypeReference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CTag, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ((CTag -> ANormal TypeReference v -> ShowS -> ShowS)
-> (CTag, ANormal TypeReference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((CTag -> ANormal TypeReference v -> ShowS -> ShowS)
 -> (CTag, ANormal TypeReference v) -> ShowS -> ShowS)
-> (CTag -> ANormal TypeReference v -> ShowS -> ShowS)
-> (CTag, ANormal TypeReference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal TypeReference v -> ShowS -> ShowS)
-> (CTag -> ShowS)
-> CTag
-> ANormal TypeReference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> CTag -> ShowS
forall {a}. Show a => TypeReference -> a -> ShowS
prettyTag TypeReference
r)
        ShowS
forall a. a -> a
id
        (EnumMap CTag (ANormal TypeReference v)
-> [(CTag, ANormal TypeReference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal TypeReference v)
 -> [(CTag, ANormal TypeReference v)])
-> EnumMap CTag (ANormal TypeReference v)
-> [(CTag, ANormal TypeReference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal TypeReference v) -> ANormal TypeReference v
forall a b. (a, b) -> b
snd (([Mem], ANormal TypeReference v) -> ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag (ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal TypeReference v)
bs)
  MatchRequest [(TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))]
bs ANormal TypeReference v
df ->
    ((TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))
 -> ShowS -> ShowS)
-> ShowS
-> [(TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))]
-> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      ( \(TypeReference
r, EnumMap CTag ([Mem], ANormal TypeReference v)
m) ShowS
s ->
          ((CTag, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (\(CTag
c, ANormal TypeReference v
e) -> Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (TypeReference -> CTag -> ShowS
forall {a}. Show a => TypeReference -> a -> ShowS
prettyReq TypeReference
r CTag
c) ANormal TypeReference v
e)
            ShowS
s
            (EnumMap CTag (ANormal TypeReference v)
-> [(CTag, ANormal TypeReference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal TypeReference v)
 -> [(CTag, ANormal TypeReference v)])
-> EnumMap CTag (ANormal TypeReference v)
-> [(CTag, ANormal TypeReference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal TypeReference v) -> ANormal TypeReference v
forall a b. (a, b) -> b
snd (([Mem], ANormal TypeReference v) -> ANormal TypeReference v)
-> EnumMap CTag ([Mem], ANormal TypeReference v)
-> EnumMap CTag (ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal TypeReference v)
m)
      )
      (Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"REQ(0,0)") ANormal TypeReference v
df ShowS
forall a. a -> a
id)
      [(TypeReference, EnumMap CTag ([Mem], ANormal TypeReference v))]
bs
  MatchSum EnumMap ConstructorId ([Mem], ANormal TypeReference v)
bs ->
    ((ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(ConstructorId, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
 -> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> (ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId -> ShowS)
-> ConstructorId
-> ANormal TypeReference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> ShowS
forall a. Show a => a -> ShowS
shows)
      ShowS
forall a. a -> a
id
      (EnumMap ConstructorId (ANormal TypeReference v)
-> [(ConstructorId, ANormal TypeReference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap ConstructorId (ANormal TypeReference v)
 -> [(ConstructorId, ANormal TypeReference v)])
-> EnumMap ConstructorId (ANormal TypeReference v)
-> [(ConstructorId, ANormal TypeReference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal TypeReference v) -> ANormal TypeReference v
forall a b. (a, b) -> b
snd (([Mem], ANormal TypeReference v) -> ANormal TypeReference v)
-> EnumMap ConstructorId ([Mem], ANormal TypeReference v)
-> EnumMap ConstructorId (ANormal TypeReference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap ConstructorId ([Mem], ANormal TypeReference v)
bs)
  MatchNumeric TypeReference
_ EnumMap ConstructorId (ANormal TypeReference v)
bs Maybe (ANormal TypeReference v)
df ->
    ShowS
-> (ANormal TypeReference v -> ShowS)
-> Maybe (ANormal TypeReference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal TypeReference v
e -> Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal TypeReference v
e ShowS
forall a. a -> a
id) Maybe (ANormal TypeReference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> ShowS -> [(ConstructorId, ANormal TypeReference v)] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
 -> (ConstructorId, ANormal TypeReference v) -> ShowS -> ShowS)
-> (ConstructorId -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId, ANormal TypeReference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal TypeReference v -> ShowS -> ShowS)
-> (ConstructorId -> ShowS)
-> ConstructorId
-> ANormal TypeReference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap ConstructorId (ANormal TypeReference v)
-> [(ConstructorId, ANormal TypeReference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap ConstructorId (ANormal TypeReference v)
bs)
      -- _ -> error "prettyBranches: todo"
  where
    -- prettyReq :: Reference -> CTag -> ShowS
    prettyReq :: TypeReference -> a -> ShowS
prettyReq TypeReference
r a
c =
      String -> ShowS
showString String
"REQ("
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
c
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

    prettyTag :: TypeReference -> a -> ShowS
prettyTag TypeReference
r a
c =
      String -> ShowS
showString String
"CON("
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShowS
showsShort TypeReference
r
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
","
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
c
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

prettyCase ::
  (Var v) => Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase :: forall v.
Var v =>
Int -> ShowS -> ANormal TypeReference v -> ShowS -> ShowS
prettyCase Int
ind ShowS
sc (ABTN.TAbss [v]
vs Term (ANormalF TypeReference) v
e) ShowS
r =
  String -> ShowS
showString String
"\n"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
ind
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sc
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ShowS
forall v. Var v => [v] -> ShowS
prettyVars [v]
vs
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ->"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> Term (ANormalF TypeReference) v -> ShowS
forall v. Var v => Bool -> Int -> ANormal TypeReference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term (ANormalF TypeReference) v
e
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r