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

module Unison.Runtime.ANF
  ( 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,
    pattern TBox,
    Mem (..),
    Lit (..),
    Cacheability (..),
    Direction (..),
    SuperNormal (..),
    arity,
    SuperGroup (..),
    arities,
    entryArity,
    POp (..),
    litRef,
    ANormalF (.., AApv, ACom, ACon, AKon, AReq, APrm, AFOp),
    ANormal,
    RTag,
    CTag,
    PackedTag (..),
    Tag (..),
    RecordRef (..),
    RecordSchema (..),
    FieldName,
    GroupRef (..),
    Code (..),
    ValList,
    Value (..),
    Cont (..),
    BLit (..),
    packTags,
    unpackTags,
    maskTags,
    ANFM,
    Branched (.., MatchDataCover),
    Func (..),
    SGEqv (..),
    equivocate,
    codeGroup,
    valueTermLinks,
    collectValueLinks,
    valueLinks,
    groupTermLinks,
    replaceConstructors,
    replaceFunctions,
    foldGroup,
    foldGroupLinks,
    groupRecordSchemas,
    overGroup,
    overGroupLinks,
    traverseGroup,
    traverseGroupLinks,
    normalLinks,
    prettyGroup,
    prettySuperNormal,
    prettyANF,

    -- * For the translation from terms (Unison.Runtime.ANF.Convert)
    ANFD,
    DNormal,
    Ctx,
    Cte,
    CTE (..),
    Directed,
    BranchAccum (..),
    SeqEnd (..),
    pattern Lit',
    pattern ST1,
    pattern TRec,
    pattern TRecSet,
    cteVars,
    directed,
  )
where

import Control.Monad.Reader (ReaderT (..))
import Control.Monad.State (State)
import Data.Bifoldable (Bifoldable (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Functor.Compose (Compose (..))
import Data.List hiding (and, or, unsnoc, unzip)
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Text qualified as Data.Text
import Data.Text qualified as Text
import Numeric.Natural (Natural)
import Unison.ABT qualified as ABT
import Unison.ABT.Normalized qualified as ABTN
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.Prelude
import Unison.Reference (Reference, toShortHash)
import Unison.ReferentPrime qualified as Rfn
import Unison.Runtime.ANF.POp (POp (..))
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.ShortHash qualified as SH
import Unison.Symbol (Symbol)
import Unison.Term hiding (Char, Float, List, Record, Ref, Text, arity, float, fresh, record, resolve)
import Unison.Type qualified as Ty
import Unison.Util.Bytes (Bytes)
import Unison.Util.EnumContainers as EC
import Unison.Util.Text qualified as Util.Text
import Unison.Var (Var)
import Unison.Var qualified as Var
import Prelude hiding (abs, and, or, seq, unzip)

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

-- | How a let's binder, a parameter or a match arm's field is held:
-- unboxed, boxed, or wide. A wide binder (Unison.Runtime.Wide) has
-- 'wideWidth' slots, its boxed value on top; only a let of one variable
-- has one, marked by Unison.Runtime.MCode.Wide in a batch's code after it
-- is loaded, so nothing stored has it (the serializers refuse it).
data Mem = UN | BX | WD 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 Reference 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 Reference v -> Set v
forall (f :: * -> * -> *) v. Term f v -> Set v
ABTN.freeVars ANormal Reference v
e
cteVars (LZ v
v Either Reference v
r [v]
as) = [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ((Reference -> [v] -> [v])
-> (v -> [v] -> [v]) -> Either Reference v -> [v] -> [v]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([v] -> [v]) -> Reference -> [v] -> [v]
forall a b. a -> b -> a
const [v] -> [v]
forall a. a -> a
id) (:) Either Reference 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
  | -- | Box a wide variable in place (Unison.Runtime.Wide): if its value
    -- slot holds an unboxed constructor, the heap object built from its
    -- slots replaces it, so from here on the variable is an ordinary
    -- value. Binds nothing, like a discard. Placed by
    -- Unison.Runtime.MCode.Wide before the first escape of the variable
    -- on each path; only in loaded code, never stored.
    ABox 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)
  bimap a -> b
f c -> d
_ (ABox a
v) = b -> ANormalF ref b d
forall ref v e. v -> ANormalF ref v e
ABox (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
  bifoldMap a -> m
f b -> m
_ (ABox a
v) = 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
f el -> er -> g es
_ (ABox vl
u) (ABox 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
ABox (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
_ 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
_ (FRec RecordSchema
rl) (FRec RecordSchema
rr)
  | RecordSchema
rl RecordSchema -> RecordSchema -> Bool
forall a. Eq a => a -> a -> Bool
== RecordSchema
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
$ RecordSchema -> Func ref vs
forall ref v. RecordSchema -> Func ref v
FRec RecordSchema
rl
alignFunc vl -> vr -> f vs
_ (FRecSet Text
fl) (FRecSet Text
fr)
  | Text
fl Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fr = 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
$ Text -> Func ref vs
forall ref v. Text -> Func ref v
FRecSet Text
fl
alignFunc vl -> vr -> f vs
_ (FWorker ref
rl Word64
il) (FWorker ref
rr Word64
ir)
  | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr, Word64
il Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
ir = 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 -> Word64 -> Func ref vs
forall ref v. ref -> Word64 -> Func ref v
FWorker ref
rl Word64
il
alignFunc vl -> vr -> f vs
_ Func ref vl
FYield Func ref vr
FYield = 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
$ Func ref vs
forall ref v. Func ref v
FYield
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 Word64 el
bl Maybe el
dl) (MatchIntegral EnumMap Word64 er
br Maybe er
dr)
  | EnumMap Word64 el -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 el
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 er -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 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 Word64 es -> Maybe es -> Branched ref es
forall ref e. EnumMap Word64 e -> Maybe e -> Branched ref e
MatchIntegral
          (EnumMap Word64 es -> Maybe es -> Branched ref es)
-> f (EnumMap Word64 es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap Word64 el -> EnumMap Word64 er -> f (EnumMap Word64 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 Word64 el
bl EnumMap Word64 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 (MatchBytes Map Bytes el
bl Maybe el
dl) (MatchBytes Map Bytes er
br Maybe er
dr)
  | Map Bytes el -> Set Bytes
forall k a. Map k a -> Set k
Map.keysSet Map Bytes el
bl Set Bytes -> Set Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Map Bytes er -> Set Bytes
forall k a. Map k a -> Set k
Map.keysSet Map Bytes 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 Bytes es -> Maybe es -> Branched ref es
forall ref e. Map Bytes e -> Maybe e -> Branched ref e
MatchBytes
          (Map Bytes es -> Maybe es -> Branched ref es)
-> f (Map Bytes es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f es -> f es) -> Map Bytes (f es) -> f (Map Bytes 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 Bytes a -> f (Map Bytes b)
traverse f es -> f es
forall a. a -> a
id ((el -> er -> f es)
-> Map Bytes el -> Map Bytes er -> Map Bytes (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 Bytes el
bl Map Bytes 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 (MatchRec RecordSchema
rsl el
bdl) (MatchRec RecordSchema
rsr er
bdr)
  | RecordSchema
rsl RecordSchema -> RecordSchema -> Bool
forall a. Eq a => a -> a -> Bool
== RecordSchema
rsr = 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
$ RecordSchema -> es -> Branched ref es
forall ref e. RecordSchema -> e -> Branched ref e
MatchRec RecordSchema
rsl (es -> Branched ref es) -> f es -> f (Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> el -> er -> f es
f el
bdl er
bdr
alignBranch el -> er -> f es
f (MatchSum EnumMap Word64 ([Mem], el)
bl) (MatchSum EnumMap Word64 ([Mem], er)
br)
  | EnumMap Word64 ([Mem], el) -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 ([Mem], el)
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 ([Mem], er) -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 ([Mem], er)
br,
    (Word64 -> Bool) -> [Word64] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Word64
w -> ([Mem], el) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap Word64 ([Mem], el)
bl EnumMap Word64 ([Mem], el) -> Word64 -> ([Mem], el)
forall k a. EnumKey k => EnumMap k a -> k -> a
! Word64
w) [Mem] -> [Mem] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Mem], er) -> [Mem]
forall a b. (a, b) -> a
fst (EnumMap Word64 ([Mem], er)
br EnumMap Word64 ([Mem], er) -> Word64 -> ([Mem], er)
forall k a. EnumKey k => EnumMap k a -> k -> a
! Word64
w)) (EnumMap Word64 ([Mem], el) -> [Word64]
forall k a. EnumKey k => EnumMap k a -> [k]
keys EnumMap Word64 ([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 Word64 ([Mem], es) -> Branched ref es
forall ref e. EnumMap Word64 ([Mem], e) -> Branched ref e
MatchSum (EnumMap Word64 ([Mem], es) -> Branched ref es)
-> f (EnumMap Word64 ([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 Word64 ([Mem], el)
-> EnumMap Word64 ([Mem], er)
-> f (EnumMap Word64 ([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 Word64 ([Mem], el)
bl EnumMap Word64 ([Mem], er)
br
alignBranch el -> er -> f es
f (MatchNumeric ref
rl EnumMap Word64 el
bl Maybe el
dl) (MatchNumeric ref
rr EnumMap Word64 er
br Maybe er
dr)
  | ref
rl ref -> ref -> Bool
forall a. Eq a => a -> a -> Bool
== ref
rr,
    EnumMap Word64 el -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 el
bl EnumSet Word64 -> EnumSet Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== EnumMap Word64 er -> EnumSet Word64
forall k a. EnumKey k => EnumMap k a -> EnumSet k
keysSet EnumMap Word64 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 Word64 es -> Maybe es -> Branched ref es
forall ref e. ref -> EnumMap Word64 e -> Maybe e -> Branched ref e
MatchNumeric ref
rl
          (EnumMap Word64 es -> Maybe es -> Branched ref es)
-> f (EnumMap Word64 es) -> f (Maybe es -> Branched ref es)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (el -> er -> f es)
-> EnumMap Word64 el -> EnumMap Word64 er -> f (EnumMap Word64 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 Word64 el
bl EnumMap Word64 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 Reference)
matchLit (Int' Int64
i) = Lit Reference -> Maybe (Lit Reference)
forall a. a -> Maybe a
Just (Lit Reference -> Maybe (Lit Reference))
-> Lit Reference -> Maybe (Lit Reference)
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit Reference
forall ref. Int64 -> Lit ref
I Int64
i
matchLit (Nat' Word64
n) = Lit Reference -> Maybe (Lit Reference)
forall a. a -> Maybe a
Just (Lit Reference -> Maybe (Lit Reference))
-> Lit Reference -> Maybe (Lit Reference)
forall a b. (a -> b) -> a -> b
$ Word64 -> Lit Reference
forall ref. Word64 -> Lit ref
N Word64
n
matchLit (Float' Double
f) = Lit Reference -> Maybe (Lit Reference)
forall a. a -> Maybe a
Just (Lit Reference -> Maybe (Lit Reference))
-> Lit Reference -> Maybe (Lit Reference)
forall a b. (a -> b) -> a -> b
$ Double -> Lit Reference
forall ref. Double -> Lit ref
F Double
f
matchLit (Text' Text
t) = Lit Reference -> Maybe (Lit Reference)
forall a. a -> Maybe a
Just (Lit Reference -> Maybe (Lit Reference))
-> Lit Reference -> Maybe (Lit Reference)
forall a b. (a -> b) -> a -> b
$ Text -> Lit Reference
forall ref. Text -> Lit ref
T (Text -> Text
Util.Text.fromText Text
t)
matchLit (Char' Char
c) = Lit Reference -> Maybe (Lit Reference)
forall a. a -> Maybe a
Just (Lit Reference -> Maybe (Lit Reference))
-> Lit Reference -> Maybe (Lit Reference)
forall a b. (a -> b) -> a -> b
$ Char -> Lit Reference
forall ref. Char -> Lit ref
C Char
c
matchLit Term (F v a a) v a
_ = Maybe (Lit Reference)
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 Reference -> 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 TRec ::
  (ABT.Var v) =>
  RecordSchema ->
  [v] ->
  ANormal ref v
pattern $mTRec :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (RecordSchema -> [v] -> r) -> ((# #) -> r) -> r
$bTRec :: forall v ref. Var v => RecordSchema -> [v] -> ANormal ref v
TRec rs args = TApp (FRec rs) args

pattern TRecSet ::
  (ABT.Var v) =>
  FieldName ->
  [v] ->
  ANormal ref v
pattern $mTRecSet :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (Text -> [v] -> r) -> ((# #) -> r) -> r
$bTRecSet :: forall v ref. Var v => Text -> [v] -> ANormal ref v
TRecSet field args = TApp (FRecSet field) 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)

pattern TBox :: (ABT.Var v) => v -> ANormal ref v
pattern $mTBox :: forall {r} {v} {ref}.
Var v =>
ANormal ref v -> (v -> r) -> ((# #) -> r) -> r
$bTBox :: forall v ref. Var v => v -> ANormal ref v
TBox v = ABTN.TTm (ABox v)

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

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

bind :: (Var v) => Cte v -> ANormal Reference v -> ANormal Reference v
bind :: forall v.
Var v =>
Cte v -> ANormal Reference v -> ANormal Reference v
bind (ST Direction Word16
d [v]
us [Mem]
ms ANormal Reference v
bu) = Direction Word16
-> [v]
-> [Mem]
-> ANormal Reference v
-> ANormal Reference v
-> ANormal Reference 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 Reference v
bu
bind (LZ v
u Either Reference v
f [v]
as) = v
-> Either Reference v
-> [v]
-> ANormal Reference v
-> ANormal Reference v
forall v ref.
Var v =>
v -> Either ref v -> [v] -> ANormal ref v -> ANormal ref v
TName v
u Either Reference v
f [v]
as

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

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

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

pattern TBinds ::
  (Var v) => [Cte v] -> ANormal Reference v -> ANormal Reference v
pattern $mTBinds :: forall {r} {v}.
Var v =>
ANormal Reference v
-> ([Cte v] -> ANormal Reference v -> r) -> ((# #) -> r) -> r
$bTBinds :: forall v.
Var v =>
[Cte v] -> ANormal Reference v -> ANormal Reference v
TBinds ctx bd <-
  (unbinds -> (ctx, bd))
  where
    TBinds [Cte v]
ctx ANormal Reference v
bd = (Cte v -> ANormal Reference v -> ANormal Reference v)
-> ANormal Reference v -> [Cte v] -> ANormal Reference 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 Reference v -> ANormal Reference v
forall v.
Var v =>
Cte v -> ANormal Reference v -> ANormal Reference v
bind ANormal Reference 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)
  | MatchBytes (Map.Map Bytes e) (Maybe e)
  | MatchRequest [(ref, (EnumMap CTag ([Mem], e)))] e
  | MatchEmpty
  | MatchData ref (EnumMap CTag ([Mem], e)) (Maybe e)
  | MatchRec RecordSchema 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 ref m. Monoid m => Branched ref m -> m
forall m a. Monoid m => (a -> m) -> Branched ref a -> 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))
  | AccumBytes
      (Maybe (ANormal Reference v))
      (Map.Map Bytes (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))
  | AccumRec RecordSchema (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 Reference
rl Maybe (ANormal Reference v)
dl EnumMap Word64 (ANormal Reference v)
cl <> AccumIntegral Reference
rr Maybe (ANormal Reference v)
dr EnumMap Word64 (ANormal Reference v)
cr
    | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
AccumIntegral Reference
rl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr) (EnumMap Word64 (ANormal Reference v) -> BranchAccum v)
-> EnumMap Word64 (ANormal Reference v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal Reference v)
cl EnumMap Word64 (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
forall a. Semigroup a => a -> a -> a
<> EnumMap Word64 (ANormal Reference v)
cr
  AccumText Maybe (ANormal Reference v)
dl Map Text (ANormal Reference v)
cl <> AccumText Maybe (ANormal Reference v)
dr Map Text (ANormal Reference v)
cr =
    Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
AccumText (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr) (Map Text (ANormal Reference v)
cl Map Text (ANormal Reference v)
-> Map Text (ANormal Reference v) -> Map Text (ANormal Reference v)
forall a. Semigroup a => a -> a -> a
<> Map Text (ANormal Reference v)
cr)
  AccumBytes Maybe (ANormal Reference v)
dl Map Bytes (ANormal Reference v)
cl <> AccumBytes Maybe (ANormal Reference v)
dr Map Bytes (ANormal Reference v)
cr =
    Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
AccumBytes (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr) (Map Bytes (ANormal Reference v)
cl Map Bytes (ANormal Reference v)
-> Map Bytes (ANormal Reference v)
-> Map Bytes (ANormal Reference v)
forall a. Semigroup a => a -> a -> a
<> Map Bytes (ANormal Reference v)
cr)
  AccumData Reference
rl Maybe (ANormal Reference v)
dl EnumMap CTag ([Mem], ANormal Reference v)
cl <> AccumData Reference
rr Maybe (ANormal Reference v)
dr EnumMap CTag ([Mem], ANormal Reference v)
cr
    | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr = Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
AccumData Reference
rl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr) (EnumMap CTag ([Mem], ANormal Reference v)
cl EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
forall a. Semigroup a => a -> a -> a
<> EnumMap CTag ([Mem], ANormal Reference v)
cr)
  AccumDefault ANormal Reference v
dl <> AccumIntegral Reference
r Maybe (ANormal Reference v)
_ EnumMap Word64 (ANormal Reference v)
cr =
    Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
AccumIntegral Reference
r (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl) EnumMap Word64 (ANormal Reference v)
cr
  AccumDefault ANormal Reference v
dl <> AccumText Maybe (ANormal Reference v)
_ Map Text (ANormal Reference v)
cr =
    Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
AccumText (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl) Map Text (ANormal Reference v)
cr
  AccumDefault ANormal Reference v
dl <> AccumBytes Maybe (ANormal Reference v)
_ Map Bytes (ANormal Reference v)
cr =
    Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
AccumBytes (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl) Map Bytes (ANormal Reference v)
cr
  AccumDefault ANormal Reference v
dl <> AccumData Reference
rr Maybe (ANormal Reference v)
_ EnumMap CTag ([Mem], ANormal Reference v)
cr =
    Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
AccumData Reference
rr (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl) EnumMap CTag ([Mem], ANormal Reference v)
cr
  AccumIntegral Reference
r Maybe (ANormal Reference v)
dl EnumMap Word64 (ANormal Reference v)
cl <> AccumDefault ANormal Reference v
dr =
    Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
-> BranchAccum v
AccumIntegral Reference
r (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr) EnumMap Word64 (ANormal Reference v)
cl
  AccumText Maybe (ANormal Reference v)
dl Map Text (ANormal Reference v)
cl <> AccumDefault ANormal Reference v
dr =
    Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Text (ANormal Reference v) -> BranchAccum v
AccumText (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr) Map Text (ANormal Reference v)
cl
  AccumBytes Maybe (ANormal Reference v)
dl Map Bytes (ANormal Reference v)
cl <> AccumDefault ANormal Reference v
dr =
    Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
forall v.
Maybe (ANormal Reference v)
-> Map Bytes (ANormal Reference v) -> BranchAccum v
AccumBytes (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr) Map Bytes (ANormal Reference v)
cl
  AccumData Reference
rl Maybe (ANormal Reference v)
dl EnumMap CTag ([Mem], ANormal Reference v)
cl <> AccumDefault ANormal Reference v
dr =
    Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
forall v.
Reference
-> Maybe (ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> BranchAccum v
AccumData Reference
rl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr) EnumMap CTag ([Mem], ANormal Reference v)
cl
  l :: BranchAccum v
l@(AccumPure ANormal Reference v
_) <> AccumPure ANormal Reference v
_ = BranchAccum v
l
  AccumPure ANormal Reference v
dl <> AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hr Maybe (ANormal Reference v)
_ = Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hr (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl)
  AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hl Maybe (ANormal Reference v)
dl <> AccumPure ANormal Reference v
dr =
    Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr)
  AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hl Maybe (ANormal Reference v)
dl <> AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hr Maybe (ANormal Reference v)
dr =
    Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
forall v.
Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Maybe (ANormal Reference v) -> BranchAccum v
AccumRequest Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hm (Maybe (ANormal Reference v) -> BranchAccum v)
-> Maybe (ANormal Reference v) -> BranchAccum v
forall a b. (a -> b) -> a -> b
$ Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr
    where
      hm :: Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hm = (EnumMap CTag ([Mem], ANormal Reference v)
 -> EnumMap CTag ([Mem], ANormal Reference v)
 -> EnumMap CTag ([Mem], ANormal Reference v))
-> Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
-> Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
forall a. Semigroup a => a -> a -> a
(<>) Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hl Map Reference (EnumMap CTag ([Mem], ANormal Reference v))
hr
  l :: BranchAccum v
l@(AccumSeqEmpty ANormal Reference v
_) <> AccumSeqEmpty ANormal Reference v
_ = BranchAccum v
l
  AccumSeqEmpty ANormal Reference v
eml <> AccumSeqView SeqEnd
er Maybe (ANormal Reference v)
_ ANormal Reference v
cnr =
    SeqEnd
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqView SeqEnd
er (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
eml) ANormal Reference v
cnr
  AccumSeqView SeqEnd
el Maybe (ANormal Reference v)
eml ANormal Reference v
cnl <> AccumSeqEmpty ANormal Reference v
emr =
    SeqEnd
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal Reference v)
eml Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
emr) ANormal Reference v
cnl
  AccumSeqView SeqEnd
el Maybe (ANormal Reference v)
eml ANormal Reference v
cnl <> AccumSeqView SeqEnd
er Maybe (ANormal Reference v)
emr ANormal Reference 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 Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqView SeqEnd
el (Maybe (ANormal Reference v)
eml Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
emr) ANormal Reference v
cnl
  AccumSeqView SeqEnd
_ Maybe (ANormal Reference v)
_ ANormal Reference v
_ <> AccumDefault ANormal Reference v
_ =
    [Word] -> String -> BranchAccum v
forall a. HasCallStack => [Word] -> String -> a
internalBug [] String
"seq views may not have defaults"
  AccumDefault ANormal Reference v
_ <> AccumSeqView SeqEnd
_ Maybe (ANormal Reference v)
_ ANormal Reference 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 Reference v)
dl ANormal Reference v
bl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal Reference v)
dr ANormal Reference 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 Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ANormal Reference v)
dr) ANormal Reference v
bl
  AccumDefault ANormal Reference v
dl <> AccumSeqSplit SeqEnd
er Int
nr Maybe (ANormal Reference v)
_ ANormal Reference v
br =
    SeqEnd
-> Int
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqSplit SeqEnd
er Int
nr (ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dl) ANormal Reference v
br
  AccumSeqSplit SeqEnd
el Int
nl Maybe (ANormal Reference v)
dl ANormal Reference v
bl <> AccumDefault ANormal Reference v
dr =
    SeqEnd
-> Int
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
forall v.
SeqEnd
-> Int
-> Maybe (ANormal Reference v)
-> ANormal Reference v
-> BranchAccum v
AccumSeqSplit SeqEnd
el Int
nl (Maybe (ANormal Reference v)
dl Maybe (ANormal Reference v)
-> Maybe (ANormal Reference v) -> Maybe (ANormal Reference v)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ANormal Reference v -> Maybe (ANormal Reference v)
forall a. a -> Maybe a
Just ANormal Reference v
dr) ANormal Reference 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

newtype RecordRef = RecordRef Word64
  deriving (Int -> RecordRef -> ShowS
[RecordRef] -> ShowS
RecordRef -> String
(Int -> RecordRef -> ShowS)
-> (RecordRef -> String)
-> ([RecordRef] -> ShowS)
-> Show RecordRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordRef -> ShowS
showsPrec :: Int -> RecordRef -> ShowS
$cshow :: RecordRef -> String
show :: RecordRef -> String
$cshowList :: [RecordRef] -> ShowS
showList :: [RecordRef] -> ShowS
Show, RecordRef -> RecordRef -> Bool
(RecordRef -> RecordRef -> Bool)
-> (RecordRef -> RecordRef -> Bool) -> Eq RecordRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordRef -> RecordRef -> Bool
== :: RecordRef -> RecordRef -> Bool
$c/= :: RecordRef -> RecordRef -> Bool
/= :: RecordRef -> RecordRef -> Bool
Eq, Eq RecordRef
Eq RecordRef =>
(RecordRef -> RecordRef -> Ordering)
-> (RecordRef -> RecordRef -> Bool)
-> (RecordRef -> RecordRef -> Bool)
-> (RecordRef -> RecordRef -> Bool)
-> (RecordRef -> RecordRef -> Bool)
-> (RecordRef -> RecordRef -> RecordRef)
-> (RecordRef -> RecordRef -> RecordRef)
-> Ord RecordRef
RecordRef -> RecordRef -> Bool
RecordRef -> RecordRef -> Ordering
RecordRef -> RecordRef -> RecordRef
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 :: RecordRef -> RecordRef -> Ordering
compare :: RecordRef -> RecordRef -> Ordering
$c< :: RecordRef -> RecordRef -> Bool
< :: RecordRef -> RecordRef -> Bool
$c<= :: RecordRef -> RecordRef -> Bool
<= :: RecordRef -> RecordRef -> Bool
$c> :: RecordRef -> RecordRef -> Bool
> :: RecordRef -> RecordRef -> Bool
$c>= :: RecordRef -> RecordRef -> Bool
>= :: RecordRef -> RecordRef -> Bool
$cmax :: RecordRef -> RecordRef -> RecordRef
max :: RecordRef -> RecordRef -> RecordRef
$cmin :: RecordRef -> RecordRef -> RecordRef
min :: RecordRef -> RecordRef -> RecordRef
Ord)

newtype RecordSchema = RecordSchema (Set FieldName)
  deriving (Int -> RecordSchema -> ShowS
[RecordSchema] -> ShowS
RecordSchema -> String
(Int -> RecordSchema -> ShowS)
-> (RecordSchema -> String)
-> ([RecordSchema] -> ShowS)
-> Show RecordSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordSchema -> ShowS
showsPrec :: Int -> RecordSchema -> ShowS
$cshow :: RecordSchema -> String
show :: RecordSchema -> String
$cshowList :: [RecordSchema] -> ShowS
showList :: [RecordSchema] -> ShowS
Show, RecordSchema -> RecordSchema -> Bool
(RecordSchema -> RecordSchema -> Bool)
-> (RecordSchema -> RecordSchema -> Bool) -> Eq RecordSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordSchema -> RecordSchema -> Bool
== :: RecordSchema -> RecordSchema -> Bool
$c/= :: RecordSchema -> RecordSchema -> Bool
/= :: RecordSchema -> RecordSchema -> Bool
Eq, Eq RecordSchema
Eq RecordSchema =>
(RecordSchema -> RecordSchema -> Ordering)
-> (RecordSchema -> RecordSchema -> Bool)
-> (RecordSchema -> RecordSchema -> Bool)
-> (RecordSchema -> RecordSchema -> Bool)
-> (RecordSchema -> RecordSchema -> Bool)
-> (RecordSchema -> RecordSchema -> RecordSchema)
-> (RecordSchema -> RecordSchema -> RecordSchema)
-> Ord RecordSchema
RecordSchema -> RecordSchema -> Bool
RecordSchema -> RecordSchema -> Ordering
RecordSchema -> RecordSchema -> RecordSchema
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 :: RecordSchema -> RecordSchema -> Ordering
compare :: RecordSchema -> RecordSchema -> Ordering
$c< :: RecordSchema -> RecordSchema -> Bool
< :: RecordSchema -> RecordSchema -> Bool
$c<= :: RecordSchema -> RecordSchema -> Bool
<= :: RecordSchema -> RecordSchema -> Bool
$c> :: RecordSchema -> RecordSchema -> Bool
> :: RecordSchema -> RecordSchema -> Bool
$c>= :: RecordSchema -> RecordSchema -> Bool
>= :: RecordSchema -> RecordSchema -> Bool
$cmax :: RecordSchema -> RecordSchema -> RecordSchema
max :: RecordSchema -> RecordSchema -> RecordSchema
$cmin :: RecordSchema -> RecordSchema -> RecordSchema
min :: RecordSchema -> RecordSchema -> RecordSchema
Ord)

type FieldName = Text

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)
  | -- record constructor
    FRec RecordSchema
  | -- record update: replace one field's value, keeping the record's shape
    FRecSet FieldName
  | -- a worker of a function's group (Unison.Runtime.MCode.Explode): the
    -- combinator at this index, called with exactly the arguments it
    -- takes. Only in a batch's code after it is loaded; never stored.
    FWorker !ref !Word64
  | -- a return of the arguments as that many values (the tails of a
    -- product-return worker, Unison.Runtime.MCode.Explode). Only in a
    -- batch's code after it is loaded; never stored.
    FYield
  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 ref m. Monoid m => Func ref m -> m
forall m a. Monoid m => (a -> m) -> Func ref a -> 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 -> Reference
litRef (I Int64
_) = Reference
Ty.intRef
litRef (N Word64
_) = Reference
Ty.natRef
litRef (F Double
_) = Reference
Ty.floatRef
litRef (T Text
_) = Reference
Ty.textRef
litRef (C Char
_) = Reference
Ty.charRef
litRef (LM Referent' ref
_) = Reference
Ty.termLinkRef
litRef (LY ref
_) = Reference
Ty.typeLinkRef

type ANormal ref = ABTN.Term (ANormalF ref)

type Cte v = CTE v (ANormal Reference v)

-- A block's bindings so far, in order. A Seq, because a left-nested
-- application appends the left operand's whole context at each level
-- (`anfArg`, `anfArgs`), which with a list copied it each time: quadratic
-- in the nesting, and the live heap of a wide expression's normalization
-- was almost all list cells.
type Ctx v = Directed () (Seq (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) -> Ctx v
directed :: forall (f :: * -> *) v. Foldable f => f (Cte v) -> Ctx 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, [Cte v] -> Seq (Cte v)
forall a. [a] -> Seq a
Seq.fromList (f (Cte v) -> [Cte v]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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

-- | The number of arguments the group's main entry accepts.
entryArity :: SuperGroup ref v -> Int
entryArity :: forall ref v. SuperGroup ref v -> Int
entryArity (Rec [(v, SuperNormal ref v)]
_ SuperNormal ref v
e) = SuperNormal ref v -> Int
forall ref v. SuperNormal ref v -> Int
arity SuperNormal ref v
e

-- 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 (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip [(v, SuperNormal ref v)]
bs0
    ([v]
vs1, [SuperNormal ref v]
ns1) = [(v, SuperNormal ref v)] -> ([v], [SuperNormal ref v])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f 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)
  | Record RecordSchema (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)]
  | -- arbitrary precision numbers
    BigInt Integer
  | BigNat Natural
  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)

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

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

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

collectValueLinks :: (Ord ref) => Value ref -> (Set ref, Set ref)
collectValueLinks :: forall ref. Ord ref => Value ref -> (Set ref, Set ref)
collectValueLinks = (Bool -> ref -> (Set ref, Set ref))
-> Value ref -> (Set ref, Set ref)
forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
valueLinks Bool -> ref -> (Set ref, Set ref)
forall {a}. Ord a => Bool -> a -> (Set a, Set a)
f
  where
    f :: Bool -> a -> (Set a, Set a)
f Bool
False a
r = (Set a
forall a. Monoid a => a
mempty, a -> Set a
forall a. a -> Set a
Set.singleton a
r)
    f Bool
True a
r = (a -> Set a
forall a. a -> Set a
Set.singleton a
r, Set a
forall a. Monoid a => a
mempty)

-- 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 = Value ref -> a
go
  where
    go :: Value ref -> a
go (Partial (GR ref
cr Word64
_) 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 Value ref -> a
go ValList ref
vs
    go (Data ref
dr Word64
_ 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 Value ref -> a
go ValList ref
vs
    go (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 Value ref -> a
go 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
    go (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
    go (Record RecordSchema
_rs ValList ref
vs) = (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 Value ref -> a
go ValList ref
vs
{-# INLINE valueLinks #-}

-- 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 Word64
t ValList r
vs ->
      s -> Word64 -> ValList s -> Value s
forall ref. ref -> Word64 -> ValList ref -> Value ref
Data (Bool -> r -> s
h Bool
True r
r) Word64
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)
    Record RecordSchema
rs ValList r
vs -> RecordSchema -> ValList s -> Value s
forall ref. RecordSchema -> ValList ref -> Value ref
Record RecordSchema
rs ((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)

  foldMapRefs :: forall a ref. Monoid a => (Bool -> ref -> a) -> Value ref -> a
foldMapRefs Bool -> r -> m
h = \case
    Partial (GR r
r Word64
_) 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 Word64
_ 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
    Record RecordSchema
_rs ValList r
vs -> (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

  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 Word64
t ValList r
vs ->
      (s -> Word64 -> ValList s -> Value s)
-> Word64 -> s -> ValList s -> Value s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> Word64 -> ValList s -> Value s
forall ref. ref -> Word64 -> ValList ref -> Value ref
Data Word64
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
    Record RecordSchema
rs ValList r
vs -> RecordSchema -> ValList s -> Value s
forall ref. RecordSchema -> ValList ref -> Value ref
Record RecordSchema
rs (ValList s -> Value s) -> f (ValList s) -> f (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

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 = Cont ref -> a
go
  where
    go :: Cont ref -> a
go (Push Word64
_ Word64
_ (GR ref
cr Word64
_) Cont ref
k) =
      Bool -> ref -> a
f Bool
False ref
cr a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Cont ref -> a
go Cont ref
k
    go (Mark Word64
_ [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
<> Cont ref -> a
go Cont ref
k
    go Cont ref
KE = a
forall a. Monoid a => a
mempty
{-# INLINE contLinks #-}

-- 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 Word64
asz [r]
rs [(r, Value r)]
env Cont r
k ->
      Word64 -> [s] -> [(s, Value s)] -> Cont s -> Cont s
forall ref.
Word64 -> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark
        Word64
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 Word64
fsz Word64
asz GroupRef r
gr Cont r
k ->
      Word64 -> Word64 -> GroupRef s -> Cont s -> Cont s
forall ref.
Word64 -> Word64 -> GroupRef ref -> Cont ref -> Cont ref
Push Word64
fsz Word64
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 Word64
_ Word64
_ (GR r
r Word64
_) 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 Word64
_ [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 Word64
asz [r]
rs [(r, Value r)]
env Cont r
k ->
      Word64 -> [s] -> [(s, Value s)] -> Cont s -> Cont s
forall ref.
Word64 -> [ref] -> [(ref, Value ref)] -> Cont ref -> Cont ref
Mark Word64
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 Word64
fsz Word64
asz GroupRef r
gr Cont r
k ->
      Word64 -> Word64 -> GroupRef s -> Cont s -> Cont s
forall ref.
Word64 -> Word64 -> GroupRef ref -> Cont ref -> Cont ref
Push Word64
fsz Word64
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 = BLit ref -> a
go
  where
    go :: BLit ref -> a
go (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
    go (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
    go (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
    go BLit ref
_ = a
forall a. Monoid a => a
mempty
{-# INLINE blitLinks #-}

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 Word64
n -> Word64 -> BLit s
forall ref. Word64 -> BLit ref
Pos Word64
n
    Neg Word64
n -> Word64 -> BLit s
forall ref. Word64 -> BLit ref
Neg Word64
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
    BigInt Integer
i -> Integer -> BLit s
forall ref. Integer -> BLit ref
BigInt Integer
i
    BigNat Natural
n -> Natural -> BLit s
forall ref. Natural -> BLit ref
BigNat Natural
n

  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 Word64
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
$ Word64 -> BLit s
forall ref. Word64 -> BLit ref
Pos Word64
n
    Neg Word64
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
$ Word64 -> BLit s
forall ref. Word64 -> BLit ref
Neg Word64
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
    BigInt Integer
i -> 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
$ Integer -> BLit s
forall ref. Integer -> BLit ref
BigInt Integer
i
    BigNat Natural
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
$ Natural -> BLit s
forall ref. Natural -> BLit ref
BigNat Natural
n

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 (ZonkAny 0) v) -> r
forall {k} a (b :: k). Const a b -> a
getConst (Const r (SuperGroup (ZonkAny 0) v) -> r)
-> (SuperGroup ref v -> Const r (SuperGroup (ZonkAny 0) v))
-> SuperGroup ref v
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ref -> Const r (ZonkAny 0))
-> SuperGroup ref v -> Const r (SuperGroup (ZonkAny 0) 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 (ZonkAny 0)
forall {k} a (b :: k). a -> Const a b
Const (r -> Const r (ZonkAny 0))
-> (ref -> r) -> ref -> Const r (ZonkAny 0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ref -> r
f Bool
b)

-- | Every record schema constructed or matched on anywhere in a group.
--
-- Record schemas are interned by the runtime like type and term references
-- are, so this is the analogue of 'foldGroupLinks' for them: it tells the code
-- cache which schemas a group needs before its code is emitted.
groupRecordSchemas :: SuperGroup ref v -> Set RecordSchema
groupRecordSchemas :: forall ref v. SuperGroup ref v -> Set RecordSchema
groupRecordSchemas (Rec [(v, SuperNormal ref v)]
bs SuperNormal ref v
e) =
  ((v, SuperNormal ref v) -> Set RecordSchema)
-> [(v, SuperNormal ref v)] -> Set RecordSchema
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SuperNormal ref v -> Set RecordSchema
forall ref v. SuperNormal ref v -> Set RecordSchema
normalRecordSchemas (SuperNormal ref v -> Set RecordSchema)
-> ((v, SuperNormal ref v) -> SuperNormal ref v)
-> (v, SuperNormal ref v)
-> Set RecordSchema
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 Set RecordSchema -> Set RecordSchema -> Set RecordSchema
forall a. Semigroup a => a -> a -> a
<> SuperNormal ref v -> Set RecordSchema
forall ref v. SuperNormal ref v -> Set RecordSchema
normalRecordSchemas SuperNormal ref v
e

normalRecordSchemas :: SuperNormal ref v -> Set RecordSchema
normalRecordSchemas :: forall ref v. SuperNormal ref v -> Set RecordSchema
normalRecordSchemas (Lambda [Mem]
_ ANormal ref v
e) = ANormal ref v -> Set RecordSchema
forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas ANormal ref v
e

anfRecordSchemas :: ANormal ref v -> Set RecordSchema
anfRecordSchemas :: forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas = \case
  ABTN.Term Set v
_ (ABTN.Abs v
_ ANormal ref v
e) -> ANormal ref v -> Set RecordSchema
forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas ANormal ref v
e
  ABTN.Term Set v
_ (ABTN.Tm ANormalF ref v (ANormal ref v)
e) -> case ANormalF ref v (ANormal ref v)
e of
    AApp (FRec RecordSchema
rs) [v]
_ -> RecordSchema -> Set RecordSchema
forall a. a -> Set a
Set.singleton RecordSchema
rs
    AMatch v
_ Branched ref (ANormal ref v)
bs -> Branched ref (ANormal ref v) -> Set RecordSchema
forall ref v. Branched ref (ANormal ref v) -> Set RecordSchema
branchRecordSchemas Branched ref (ANormal ref v)
bs
    -- Everything else just recurses; `ANormalF` is Foldable in its
    -- subexpressions, and no other constructor mentions a schema.
    ANormalF ref v (ANormal ref v)
_ -> (ANormal ref v -> Set RecordSchema)
-> ANormalF ref v (ANormal ref v) -> Set RecordSchema
forall m a. Monoid m => (a -> m) -> ANormalF ref v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ANormal ref v -> Set RecordSchema
forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas ANormalF ref v (ANormal ref v)
e

branchRecordSchemas :: Branched ref (ANormal ref v) -> Set RecordSchema
branchRecordSchemas :: forall ref v. Branched ref (ANormal ref v) -> Set RecordSchema
branchRecordSchemas = \case
  MatchRec RecordSchema
rs ANormal ref v
e -> RecordSchema -> Set RecordSchema -> Set RecordSchema
forall a. Ord a => a -> Set a -> Set a
Set.insert RecordSchema
rs (ANormal ref v -> Set RecordSchema
forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas ANormal ref v
e)
  Branched ref (ANormal ref v)
bs -> (ANormal ref v -> Set RecordSchema)
-> Branched ref (ANormal ref v) -> Set RecordSchema
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 ANormal ref v -> Set RecordSchema
forall ref v. ANormal ref v -> Set RecordSchema
anfRecordSchemas Branched ref (ANormal ref v)
bs

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
anfFLinks Bool -> ref0 -> f ref1
_ e0 -> f e1
_ (ABox 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
ABox 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 Word64
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 -> Word64 -> GConstructorReference ref1)
-> Word64 -> ref1 -> GConstructorReference ref1
forall a b c. (a -> b -> c) -> b -> a -> c
flip ref1 -> Word64 -> GConstructorReference ref1
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Word64
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 Word64
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
$ Word64 -> Lit ref1
forall ref. Word64 -> Lit ref
N Word64
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 (MatchBytes Map Bytes e0
m Maybe e0
e) =
  Map Bytes e1 -> Maybe e1 -> Branched ref1 e1
forall ref e. Map Bytes e -> Maybe e -> Branched ref e
MatchBytes (Map Bytes e1 -> Maybe e1 -> Branched ref1 e1)
-> f (Map Bytes e1) -> f (Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e0 -> f e1) -> Map Bytes e0 -> f (Map Bytes 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 Bytes a -> f (Map Bytes b)
traverse e0 -> f e1
g Map Bytes 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 Word64 e0
m Maybe e0
e) =
  EnumMap Word64 e1 -> Maybe e1 -> Branched ref1 e1
forall ref e. EnumMap Word64 e -> Maybe e -> Branched ref e
MatchIntegral (EnumMap Word64 e1 -> Maybe e1 -> Branched ref1 e1)
-> f (EnumMap Word64 e1) -> f (Maybe e1 -> Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e0 -> f e1) -> EnumMap Word64 e0 -> f (EnumMap Word64 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 Word64 a -> f (EnumMap Word64 b)
traverse e0 -> f e1
g EnumMap Word64 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 Word64 e0
m Maybe e0
e) =
  ref1 -> EnumMap Word64 e1 -> Maybe e1 -> Branched ref1 e1
forall ref e. ref -> EnumMap Word64 e -> Maybe e -> Branched ref e
MatchNumeric (ref1 -> EnumMap Word64 e1 -> Maybe e1 -> Branched ref1 e1)
-> f ref1 -> f (EnumMap Word64 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 Word64 e1 -> Maybe e1 -> Branched ref1 e1)
-> f (EnumMap Word64 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 Word64 e0 -> f (EnumMap Word64 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 Word64 a -> f (EnumMap Word64 b)
traverse e0 -> f e1
g EnumMap Word64 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 Word64 ([Mem], e0)
m) =
  EnumMap Word64 ([Mem], e1) -> Branched ref1 e1
forall ref e. EnumMap Word64 ([Mem], e) -> Branched ref e
MatchSum (EnumMap Word64 ([Mem], e1) -> Branched ref1 e1)
-> f (EnumMap Word64 ([Mem], e1)) -> f (Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([Mem], e0) -> f ([Mem], e1))
-> EnumMap Word64 ([Mem], e0) -> f (EnumMap Word64 ([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 Word64 a -> f (EnumMap Word64 b)
traverse ((([Mem], e0) -> f ([Mem], e1))
 -> EnumMap Word64 ([Mem], e0) -> f (EnumMap Word64 ([Mem], e1)))
-> ((e0 -> f e1) -> ([Mem], e0) -> f ([Mem], e1))
-> (e0 -> f e1)
-> EnumMap Word64 ([Mem], e0)
-> f (EnumMap Word64 ([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 Word64 ([Mem], e0)
m
branchLinks ref0 -> f ref1
_ e0 -> f e1
g (MatchRec RecordSchema
rs e0
e) =
  RecordSchema -> e1 -> Branched ref1 e1
forall ref e. RecordSchema -> e -> Branched ref e
MatchRec RecordSchema
rs (e1 -> Branched ref1 e1) -> f e1 -> f (Branched ref1 e1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e0 -> f e1
g e0
e
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
funcLinks Bool -> ref0 -> f ref1
_ (FRec RecordSchema
rr) = 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
$ RecordSchema -> Func ref1 v
forall ref v. RecordSchema -> Func ref v
FRec RecordSchema
rr
funcLinks Bool -> ref0 -> f ref1
_ (FRecSet Text
field) = 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
$ Text -> Func ref1 v
forall ref v. Text -> Func ref v
FRecSet Text
field
funcLinks Bool -> ref0 -> f ref1
f (FWorker ref0
r Word64
i) = (ref1 -> Word64 -> Func ref1 v) -> Word64 -> ref1 -> Func ref1 v
forall a b c. (a -> b -> c) -> b -> a -> c
flip ref1 -> Word64 -> Func ref1 v
forall ref v. ref -> Word64 -> Func ref v
FWorker Word64
i (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
_ Func ref0 v
FYield = Func ref1 v -> f (Func ref1 v)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Func ref1 v
forall ref v. Func ref v
FYield

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 Reference v -> ShowS
prettyGroup String
s (Rec [(v, SuperNormal Reference v)]
grp SuperNormal Reference 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 Reference v) -> ShowS -> ShowS)
-> ShowS -> [(v, SuperNormal Reference 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 Reference v) -> ShowS -> ShowS
forall {v} {v} {a}.
(Var v, Var v) =>
(v, SuperNormal Reference v) -> (a -> String) -> a -> String
f ShowS
forall a. a -> a
id [(v, SuperNormal Reference 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 Reference v -> ShowS
forall v. Var v => Int -> SuperNormal Reference v -> ShowS
prettySuperNormal Int
1 SuperNormal Reference v
ent
  where
    f :: (v, SuperNormal Reference v) -> (a -> String) -> a -> String
f (v
v, SuperNormal Reference 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 Reference v -> ShowS
forall v. Var v => Int -> SuperNormal Reference v -> ShowS
prettySuperNormal Int
2 SuperNormal Reference 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 Reference v -> ShowS
prettySuperNormal Int
ind (Lambda [Mem]
ccs (ABTN.TAbss [v]
vs Term (ANormalF Reference) 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 Reference) v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term (ANormalF Reference) 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 Reference v -> ShowS
prettyANF Bool
m Int
ind ANormal Reference v
tm =
  Bool -> Int -> ShowS
prettySpace (Bool -> ANormal Reference v -> Bool
forall v ref. Var v => Bool -> ANormal ref v -> Bool
reqSpace Bool
m ANormal Reference v
tm) Int
ind ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case ANormal Reference v
tm of
    TLets Direction Word16
_ [v]
vs [Mem]
_ ANormal Reference v
bn ANormal Reference 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 Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal Reference v
bn
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
True Int
ind ANormal Reference v
bo
    TName v
v Either Reference v
f [v]
vs ANormal Reference 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 Reference v -> ShowS
forall v. Var v => Either Reference v -> ShowS
prettyLZF Either Reference 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 Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
True Int
ind ANormal Reference v
bo
    TLit Lit Reference
l -> Lit Reference -> ShowS
forall a. Show a => a -> ShowS
shows Lit Reference
l
    TBLit Lit Reference
l -> Lit Reference -> ShowS
forall a. Show a => a -> ShowS
shows Lit Reference
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 Reference v
f [v]
vs -> Func Reference v -> ShowS
forall v. Var v => Func Reference v -> ShowS
prettyFunc Func Reference 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 Reference (ANormal Reference 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 Reference (ANormal Reference v) -> ShowS
forall v.
Var v =>
Int -> Branched Reference (ANormal Reference v) -> ShowS
prettyBranches (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Branched Reference (ANormal Reference v)
bs
    TShift Reference
r v
v ANormal Reference v
bo ->
      String -> ShowS
showString String
"shift["
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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 Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal Reference v
bo
    THnd [Reference]
rs v
nh Maybe v
ah ANormal Reference v
bo ->
      String -> ShowS
showString String
"handle"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> ShowS
prettyRefs [Reference]
rs
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int -> ANormal Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
False (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal Reference 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 Reference 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 Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal Reference 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
"]"
    TBox v
v ->
      String -> ShowS
showString String
"box[" 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 Reference 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 Reference v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ANormal Reference 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 Reference v -> ShowS
prettyLZF (Left Reference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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 :: [Reference] -> ShowS
prettyRefs [] = String -> ShowS
showString String
"{}"
prettyRefs (Reference
r : [Reference]
rs) =
  String -> ShowS
showString String
"{"
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
r
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> ShowS -> ShowS) -> ShowS -> [Reference] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Reference
t ShowS
r -> String -> ShowS
showString String
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r) ShowS
forall a. a -> a
id [Reference]
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 Reference 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 Reference
w) = String -> ShowS
showString String
"ENV(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
w ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc (FCon Reference
r CTag
t) =
  String -> ShowS
showString String
"CON("
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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 Reference
r CTag
t) =
  String -> ShowS
showString String
"REQ("
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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
" "
prettyFunc (FRec RecordSchema
r) =
  String -> ShowS
showString String
"REC(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordSchema -> ShowS
forall a. Show a => a -> ShowS
shows RecordSchema
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") "
prettyFunc (FRecSet Text
field) =
  String -> ShowS
showString String
"RECSET(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
forall a. Show a => a -> ShowS
shows Text
field ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
") "
prettyFunc (FWorker Reference
r Word64
i) =
  String -> ShowS
showString String
"WORKER(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows Word64
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
prettyFunc Func Reference v
FYield = String -> ShowS
showString String
"YIELD "

showsShort :: Reference -> ShowS
showsShort :: Reference -> ShowS
showsShort =
  String -> ShowS
showString (String -> ShowS) -> (Reference -> String) -> Reference -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Reference -> Text) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Text
SH.toText (ShortHash -> Text)
-> (Reference -> ShortHash) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortHash -> ShortHash
shortenTo Int
10 (ShortHash -> ShortHash)
-> (Reference -> ShortHash) -> Reference -> ShortHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShortHash
toShortHash

prettyBranches ::
  (Var v) => Int -> Branched Reference (ANormal Reference v) -> ShowS
prettyBranches :: forall v.
Var v =>
Int -> Branched Reference (ANormal Reference v) -> ShowS
prettyBranches Int
ind Branched Reference (ANormal Reference v)
bs = case Branched Reference (ANormal Reference v)
bs of
  Branched Reference (ANormal Reference v)
MatchEmpty -> String -> ShowS
showString String
"{}"
  MatchIntegral EnumMap Word64 (ANormal Reference v)
bs Maybe (ANormal Reference v)
df ->
    ShowS
-> (ANormal Reference v -> ShowS)
-> Maybe (ANormal Reference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal Reference v
e -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal Reference v
e ShowS
forall a. a -> a
id) Maybe (ANormal Reference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal Reference 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 ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
 -> (Word64, ANormal Reference v) -> ShowS -> ShowS)
-> (Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64 -> ShowS)
-> Word64
-> ANormal Reference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap Word64 (ANormal Reference v)
-> [(Word64, ANormal Reference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (ANormal Reference v)
bs)
  MatchText Map Text (ANormal Reference v)
bs Maybe (ANormal Reference v)
df ->
    ShowS
-> (ANormal Reference v -> ShowS)
-> Maybe (ANormal Reference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal Reference v
e -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal Reference v
e ShowS
forall a. a -> a
id) Maybe (ANormal Reference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(Text, ANormal Reference 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 Reference v -> ShowS -> ShowS)
-> (Text, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Text -> ANormal Reference v -> ShowS -> ShowS)
 -> (Text, ANormal Reference v) -> ShowS -> ShowS)
-> (Text -> ANormal Reference v -> ShowS -> ShowS)
-> (Text, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (Text -> ShowS) -> Text -> ANormal Reference 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 Reference v) -> [(Text, ANormal Reference v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text (ANormal Reference v)
bs)
  MatchBytes Map Bytes (ANormal Reference v)
bs Maybe (ANormal Reference v)
df ->
    ShowS
-> (ANormal Reference v -> ShowS)
-> Maybe (ANormal Reference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal Reference v
e -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal Reference v
e ShowS
forall a. a -> a
id) Maybe (ANormal Reference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bytes, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(Bytes, ANormal Reference 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 ((Bytes -> ANormal Reference v -> ShowS -> ShowS)
-> (Bytes, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Bytes -> ANormal Reference v -> ShowS -> ShowS)
 -> (Bytes, ANormal Reference v) -> ShowS -> ShowS)
-> (Bytes -> ANormal Reference v -> ShowS -> ShowS)
-> (Bytes, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (Bytes -> ShowS)
-> Bytes
-> ANormal Reference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (Map Bytes (ANormal Reference v) -> [(Bytes, ANormal Reference v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Bytes (ANormal Reference v)
bs)
  MatchData Reference
r EnumMap CTag ([Mem], ANormal Reference v)
bs Maybe (ANormal Reference v)
df ->
    ShowS
-> (ANormal Reference v -> ShowS)
-> Maybe (ANormal Reference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal Reference v
e -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal Reference v
e ShowS
forall a. a -> a
id) Maybe (ANormal Reference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CTag, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal Reference 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 Reference v -> ShowS -> ShowS)
-> (CTag, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((CTag -> ANormal Reference v -> ShowS -> ShowS)
 -> (CTag, ANormal Reference v) -> ShowS -> ShowS)
-> (CTag -> ANormal Reference v -> ShowS -> ShowS)
-> (CTag, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (CTag -> ShowS) -> CTag -> ANormal Reference v -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> CTag -> ShowS
forall {a}. Show a => Reference -> a -> ShowS
prettyTag Reference
r)
        ShowS
forall a. a -> a
id
        (EnumMap CTag (ANormal Reference v) -> [(CTag, ANormal Reference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal Reference v)
 -> [(CTag, ANormal Reference v)])
-> EnumMap CTag (ANormal Reference v)
-> [(CTag, ANormal Reference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal Reference v) -> ANormal Reference v
forall a b. (a, b) -> b
snd (([Mem], ANormal Reference v) -> ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal Reference v)
bs)
  MatchRec (RecordSchema Set Text
rs) ANormal Reference v
bd ->
    let fields :: String
fields =
          Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
rs
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
", "
            Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack
     in Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"REC{" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
fields ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}") ANormal Reference v
bd ShowS
forall a. a -> a
id
  MatchRequest [(Reference, EnumMap CTag ([Mem], ANormal Reference v))]
bs ANormal Reference v
df ->
    ((Reference, EnumMap CTag ([Mem], ANormal Reference v))
 -> ShowS -> ShowS)
-> ShowS
-> [(Reference, EnumMap CTag ([Mem], ANormal Reference 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
      ( \(Reference
r, EnumMap CTag ([Mem], ANormal Reference v)
m) ShowS
s ->
          ((CTag, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(CTag, ANormal Reference 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 Reference v
e) -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (Reference -> CTag -> ShowS
forall {a}. Show a => Reference -> a -> ShowS
prettyReq Reference
r CTag
c) ANormal Reference v
e)
            ShowS
s
            (EnumMap CTag (ANormal Reference v) -> [(CTag, ANormal Reference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap CTag (ANormal Reference v)
 -> [(CTag, ANormal Reference v)])
-> EnumMap CTag (ANormal Reference v)
-> [(CTag, ANormal Reference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal Reference v) -> ANormal Reference v
forall a b. (a, b) -> b
snd (([Mem], ANormal Reference v) -> ANormal Reference v)
-> EnumMap CTag ([Mem], ANormal Reference v)
-> EnumMap CTag (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap CTag ([Mem], ANormal Reference v)
m)
      )
      (Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"REQ(0,0)") ANormal Reference v
df ShowS
forall a. a -> a
id)
      [(Reference, EnumMap CTag ([Mem], ANormal Reference v))]
bs
  MatchSum EnumMap Word64 ([Mem], ANormal Reference v)
bs ->
    ((Word64, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal Reference 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
      ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
 -> (Word64, ANormal Reference v) -> ShowS -> ShowS)
-> (Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64 -> ShowS)
-> Word64
-> ANormal Reference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows)
      ShowS
forall a. a -> a
id
      (EnumMap Word64 (ANormal Reference v)
-> [(Word64, ANormal Reference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList (EnumMap Word64 (ANormal Reference v)
 -> [(Word64, ANormal Reference v)])
-> EnumMap Word64 (ANormal Reference v)
-> [(Word64, ANormal Reference v)]
forall a b. (a -> b) -> a -> b
$ ([Mem], ANormal Reference v) -> ANormal Reference v
forall a b. (a, b) -> b
snd (([Mem], ANormal Reference v) -> ANormal Reference v)
-> EnumMap Word64 ([Mem], ANormal Reference v)
-> EnumMap Word64 (ANormal Reference v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap Word64 ([Mem], ANormal Reference v)
bs)
  MatchNumeric Reference
_ EnumMap Word64 (ANormal Reference v)
bs Maybe (ANormal Reference v)
df ->
    ShowS
-> (ANormal Reference v -> ShowS)
-> Maybe (ANormal Reference v)
-> ShowS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
forall a. a -> a
id (\ANormal Reference v
e -> Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (String -> ShowS
showString String
"_") ANormal Reference v
e ShowS
forall a. a -> a
id) Maybe (ANormal Reference v)
df
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, ANormal Reference v) -> ShowS -> ShowS)
-> ShowS -> [(Word64, ANormal Reference 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 ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v) -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Word64 -> ANormal Reference v -> ShowS -> ShowS)
 -> (Word64, ANormal Reference v) -> ShowS -> ShowS)
-> (Word64 -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64, ANormal Reference v)
-> ShowS
-> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
forall v.
Var v =>
Int -> ShowS -> ANormal Reference v -> ShowS -> ShowS
prettyCase Int
ind (ShowS -> ANormal Reference v -> ShowS -> ShowS)
-> (Word64 -> ShowS)
-> Word64
-> ANormal Reference v
-> ShowS
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows) ShowS
forall a. a -> a
id (EnumMap Word64 (ANormal Reference v)
-> [(Word64, ANormal Reference v)]
forall k a. EnumKey k => EnumMap k a -> [(k, a)]
mapToList EnumMap Word64 (ANormal Reference v)
bs)
  where
    -- _ -> error "prettyBranches: todo"

    -- prettyReq :: Reference -> CTag -> ShowS
    prettyReq :: Reference -> a -> ShowS
prettyReq Reference
r a
c =
      String -> ShowS
showString String
"REQ("
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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 :: Reference -> a -> ShowS
prettyTag Reference
r a
c =
      String -> ShowS
showString String
"CON("
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShowS
showsShort Reference
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 Reference v -> ShowS -> ShowS
prettyCase Int
ind ShowS
sc (ABTN.TAbss [v]
vs Term (ANormalF Reference) 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 Reference) v -> ShowS
forall v. Var v => Bool -> Int -> ANormal Reference v -> ShowS
prettyANF Bool
True (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term (ANormalF Reference) v
e
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
r