{-# LANGUAGE DerivingStrategies #-}
{-|
Module      : Parsley.Internal.Frontend.Analysis.Cut
Description : Marks cut points in the parser.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

Exposes a transformation that annotates the parts of the grammar where cuts occur: these are places
where backtracking is not allowed to occur. This information is used to help with correct allocation
of coins used for "Parsley.Internal.Backend.Analysis.Coins": the combinator tree has access to scoping
information lost in the machine.

@since 1.5.0.0
-}
module Parsley.Internal.Frontend.Analysis.Cut (cutAnalysis) where

import Data.Coerce                         (coerce)
import Data.Kind                           (Type)
import Parsley.Internal.Common.Indexed     (Fix(..), zygo, (:*:)(..), ifst)
import Parsley.Internal.Core.CombinatorAST (Combinator(..), MetaCombinator(..))

{-|
Annotate a tree with its cut-points. We assume a cut for let-bound parsers.

@since 1.5.0.0
-}
cutAnalysis :: Fix Combinator a -> Fix Combinator a
cutAnalysis :: Fix Combinator a -> Fix Combinator a
cutAnalysis = (Fix Combinator a, Bool) -> Fix Combinator a
forall a b. (a, b) -> a
fst ((Fix Combinator a, Bool) -> Fix Combinator a)
-> (Fix Combinator a -> (Fix Combinator a, Bool))
-> Fix Combinator a
-> Fix Combinator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> (Fix Combinator a, Bool))
-> Bool -> (Fix Combinator a, Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True) ((Bool -> (Fix Combinator a, Bool)) -> (Fix Combinator a, Bool))
-> (Fix Combinator a -> Bool -> (Fix Combinator a, Bool))
-> Fix Combinator a
-> (Fix Combinator a, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut (CutAnalysis a -> Bool -> (Fix Combinator a, Bool))
-> (Fix Combinator a -> CutAnalysis a)
-> Fix Combinator a
-> Bool
-> (Fix Combinator a, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall j.
 Combinator (CutAnalysis :*: Compliance) j -> CutAnalysis j)
-> (forall j. Combinator Compliance j -> Compliance j)
-> Fix Combinator a
-> CutAnalysis a
forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type)
       (b :: Type -> Type) i.
IFunctor f =>
(forall j. f (a :*: b) j -> a j)
-> (forall j. f b j -> b j) -> Fix f i -> a i
zygo ((Bool -> (Fix Combinator j, Bool)) -> CutAnalysis j
forall a. (Bool -> (Fix Combinator a, Bool)) -> CutAnalysis a
CutAnalysis ((Bool -> (Fix Combinator j, Bool)) -> CutAnalysis j)
-> (Combinator (CutAnalysis :*: Compliance) j
    -> Bool -> (Fix Combinator j, Bool))
-> Combinator (CutAnalysis :*: Compliance) j
-> CutAnalysis j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Combinator (CutAnalysis :*: Compliance) j
-> Bool -> (Fix Combinator j, Bool)
forall a.
Combinator (CutAnalysis :*: Compliance) a
-> Bool -> (Fix Combinator a, Bool)
cutAlg) forall j. Combinator Compliance j -> Compliance j
compliance

data Compliance (k :: Type) = DomComp | NonComp | Comp | FullPure deriving stock (Int -> Compliance k -> ShowS
[Compliance k] -> ShowS
Compliance k -> String
(Int -> Compliance k -> ShowS)
-> (Compliance k -> String)
-> ([Compliance k] -> ShowS)
-> Show (Compliance k)
forall k. Int -> Compliance k -> ShowS
forall k. [Compliance k] -> ShowS
forall k. Compliance k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compliance k] -> ShowS
$cshowList :: forall k. [Compliance k] -> ShowS
show :: Compliance k -> String
$cshow :: forall k. Compliance k -> String
showsPrec :: Int -> Compliance k -> ShowS
$cshowsPrec :: forall k. Int -> Compliance k -> ShowS
Show, Compliance k -> Compliance k -> Bool
(Compliance k -> Compliance k -> Bool)
-> (Compliance k -> Compliance k -> Bool) -> Eq (Compliance k)
forall k. Compliance k -> Compliance k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compliance k -> Compliance k -> Bool
$c/= :: forall k. Compliance k -> Compliance k -> Bool
== :: Compliance k -> Compliance k -> Bool
$c== :: forall k. Compliance k -> Compliance k -> Bool
Eq)
newtype CutAnalysis a = CutAnalysis { CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut :: Bool -> (Fix Combinator a, Bool) }

seqCompliance :: Compliance a -> Compliance b -> Compliance c
seqCompliance :: Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
c Compliance b
FullPure = Compliance a -> Compliance c
coerce Compliance a
c
seqCompliance Compliance a
FullPure Compliance b
c = Compliance b -> Compliance c
coerce Compliance b
c
seqCompliance Compliance a
Comp Compliance b
_     = Compliance c
forall k. Compliance k
Comp
seqCompliance Compliance a
_ Compliance b
_        = Compliance c
forall k. Compliance k
NonComp

caseCompliance :: Compliance a -> Compliance b -> Compliance c
caseCompliance :: Compliance a -> Compliance b -> Compliance c
caseCompliance Compliance a
c Compliance b
FullPure              = Compliance a -> Compliance c
coerce Compliance a
c
caseCompliance Compliance a
FullPure Compliance b
c              = Compliance b -> Compliance c
coerce Compliance b
c
caseCompliance Compliance a
c1 Compliance b
c2 | Compliance a
c1 Compliance a -> Compliance a -> Bool
forall a. Eq a => a -> a -> Bool
== Compliance b -> Compliance a
coerce Compliance b
c2 = Compliance a -> Compliance c
coerce Compliance a
c1
caseCompliance Compliance a
_ Compliance b
_                     = Compliance c
forall k. Compliance k
NonComp

{-# INLINE compliance #-}
compliance :: Combinator Compliance a -> Compliance a
compliance :: Combinator Compliance a -> Compliance a
compliance (Pure Defunc a
_)                 = Compliance a
forall k. Compliance k
FullPure
compliance (Satisfy Defunc (Char -> Bool)
_)              = Compliance a
forall k. Compliance k
NonComp
compliance Combinator Compliance a
Empty                    = Compliance a
forall k. Compliance k
FullPure
compliance Let{}                    = Compliance a
forall k. Compliance k
DomComp
compliance (Try Compliance a
_)                  = Compliance a
forall k. Compliance k
DomComp
compliance (Compliance a
NonComp :<|>: Compliance a
FullPure) = Compliance a
forall k. Compliance k
Comp
compliance (Compliance a
_ :<|>: Compliance a
_)              = Compliance a
forall k. Compliance k
NonComp
compliance (Compliance (a -> a)
l :<*>: Compliance a
r)              = Compliance (a -> a) -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance (a -> a)
l Compliance a
r
compliance (Compliance a
l :<*: Compliance b
r)               = Compliance a -> Compliance b -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
l Compliance b
r
compliance (Compliance a
l :*>: Compliance a
r)               = Compliance a -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
l Compliance a
r
compliance (LookAhead Compliance a
c)            = Compliance a
c -- Lookahead will consume input on failure, so its compliance matches that which is beneath it
compliance (NotFollowedBy Compliance a
_)        = Compliance a
forall k. Compliance k
FullPure
compliance (Debug String
_ Compliance a
c)              = Compliance a
c
compliance (ChainPre Compliance (a -> a)
NonComp Compliance a
p)     = Compliance Any -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance Any
forall k. Compliance k
Comp Compliance a
p
compliance (ChainPre Compliance (a -> a)
_ Compliance a
p)           = Compliance Any -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance Any
forall k. Compliance k
NonComp Compliance a
p
compliance (ChainPost Compliance a
p Compliance (a -> a)
NonComp)    = Compliance a -> Compliance Any -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
p Compliance Any
forall k. Compliance k
Comp
compliance (ChainPost Compliance a
p Compliance (a -> a)
_)          = Compliance a -> Compliance Any -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
p Compliance Any
forall k. Compliance k
NonComp
compliance (Branch Compliance (Either a b)
b Compliance (a -> a)
p Compliance (b -> a)
q)           = Compliance (Either a b) -> Compliance Any -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance (Either a b)
b (Compliance (a -> a) -> Compliance (b -> a) -> Compliance Any
forall a b c. Compliance a -> Compliance b -> Compliance c
caseCompliance Compliance (a -> a)
p Compliance (b -> a)
q)
compliance (Match Compliance a
p [Defunc (a -> Bool)]
_ [Compliance a]
qs Compliance a
def)       = Compliance a -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
p ((Compliance a -> Compliance a -> Compliance a)
-> [Compliance a] -> Compliance a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 Compliance a -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
caseCompliance (Compliance a
defCompliance a -> [Compliance a] -> [Compliance a]
forall a. a -> [a] -> [a]
:[Compliance a]
qs))
compliance (MakeRegister ΣVar a
_ Compliance a
l Compliance a
r)     = Compliance a -> Compliance a -> Compliance a
forall a b c. Compliance a -> Compliance b -> Compliance c
seqCompliance Compliance a
l Compliance a
r
compliance (GetRegister ΣVar a
_)          = Compliance a
forall k. Compliance k
FullPure
compliance (PutRegister ΣVar a
_ Compliance a
c)        = Compliance a -> Compliance a
coerce Compliance a
c
compliance (MetaCombinator MetaCombinator
_ Compliance a
c)     = Compliance a
c

cutAlg :: Combinator (CutAnalysis :*: Compliance) a -> Bool -> (Fix Combinator a, Bool)
cutAlg :: Combinator (CutAnalysis :*: Compliance) a
-> Bool -> (Fix Combinator a, Bool)
cutAlg (Pure Defunc a
x) Bool
_ = (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc a -> Combinator (Fix Combinator) a
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc a
x), Bool
False)
cutAlg (Satisfy Defunc (Char -> Bool)
f) Bool
cut = (Bool -> Fix Combinator Char -> Fix Combinator Char
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkCut Bool
cut (Combinator (Fix Combinator) Char -> Fix Combinator Char
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc (Char -> Bool) -> Combinator (Fix Combinator) Char
forall (k :: Type -> Type).
Defunc (Char -> Bool) -> Combinator k Char
Satisfy Defunc (Char -> Bool)
f)), Bool
True)
cutAlg Combinator (CutAnalysis :*: Compliance) a
Empty Bool
_ = (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. Combinator k a
Empty, Bool
False)
cutAlg (Let Bool
r MVar a
μ (:*:) CutAnalysis Compliance a
p) Bool
cut = (Bool -> Fix Combinator a -> Fix Combinator a
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkCut (Bool -> Bool
not Bool
cut) (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Bool -> MVar a -> Fix Combinator a -> Combinator (Fix Combinator) a
forall a (k :: Type -> Type).
Bool -> MVar a -> k a -> Combinator k a
Let Bool
r MVar a
μ ((Fix Combinator a, Bool) -> Fix Combinator a
forall a b. (a, b) -> a
fst (CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
True)))), Bool
False) -- If there is no cut, we generate a piggy for the continuation
cutAlg (Try (:*:) CutAnalysis Compliance a
p) Bool
cut = (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try (Bool -> Fix Combinator a -> Fix Combinator a
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkImmune Bool
cut ((Fix Combinator a, Bool) -> Fix Combinator a
forall a b. (a, b) -> a
fst (CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
False)))), Bool
False)
-- Special case of below, but we know immunity is useless within `q`
cutAlg ((CutAnalysis a
p :*: Compliance a
NonComp) :<|>: (CutAnalysis a
q :*: Compliance a
FullPure)) Bool
_ = (Fix Combinator a -> Fix Combinator a
forall a. Fix Combinator a -> Fix Combinator a
requiresCut (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In ((Fix Combinator a, Bool) -> Fix Combinator a
forall a b. (a, b) -> a
fst (CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis a
p Bool
True) Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: (Fix Combinator a, Bool) -> Fix Combinator a
forall a b. (a, b) -> a
fst (CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis a
q Bool
False))), Bool
False)
-- both branches have to handle a cut, if `p` fails having consumed input that satisfies a cut
-- but if it doesn't, then `q` will need to handle the cut instead. When `q` has no cut to handle,
-- then that means it is immune to cuts, which is handy!
cutAlg ((CutAnalysis a
p :*: Compliance a
NonComp) :<|>: (:*:) CutAnalysis Compliance a
q) Bool
cut =
  let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis a
p Bool
True
      (Fix Combinator a
q', Bool
handled') = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
q) Bool
cut
  in (Fix Combinator a -> Fix Combinator a
forall a. Fix Combinator a -> Fix Combinator a
requiresCut (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
p' Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: Bool -> Fix Combinator a -> Fix Combinator a
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkImmune (Bool -> Bool
not Bool
cut) Fix Combinator a
q')), Bool
handled Bool -> Bool -> Bool
&& Bool
handled')
-- Why cut in both branches? Good question
-- The point here is that, even though `p` doesn't require a cut, this will enable an immunity
-- allowing for internal factoring  of input. However, if we are not under a cut requirement, we'd
-- like this input to be factored out further.
cutAlg ((:*:) CutAnalysis Compliance a
p :<|>: (:*:) CutAnalysis Compliance a
q) Bool
cut =
  let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
cut
      (Fix Combinator a
q', Bool
handled') = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
q) Bool
cut
  in (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
p' Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: Fix Combinator a
q'), Bool
handled Bool -> Bool -> Bool
&& Bool
handled')
cutAlg ((:*:) CutAnalysis Compliance (a -> a)
l :<*>: (:*:) CutAnalysis Compliance a
r) Bool
cut = (Fix Combinator (a -> a)
 -> Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool
-> CutAnalysis (a -> a)
-> CutAnalysis a
-> (Fix Combinator a, Bool)
forall a b c.
(Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) c)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator c, Bool)
seqCutAlg Fix Combinator (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
(:<*>:) Bool
cut ((:*:) CutAnalysis Compliance (a -> a) -> CutAnalysis (a -> a)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (a -> a)
l) ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
r)
cutAlg ((:*:) CutAnalysis Compliance a
l :<*: (:*:) CutAnalysis Compliance b
r) Bool
cut = (Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) a)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator a, Bool)
forall a b c.
(Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) c)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator c, Bool)
seqCutAlg Fix Combinator a
-> Fix Combinator b -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
(:<*:) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
l) ((:*:) CutAnalysis Compliance b -> CutAnalysis b
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance b
r)
cutAlg ((:*:) CutAnalysis Compliance a
l :*>: (:*:) CutAnalysis Compliance a
r) Bool
cut = (Fix Combinator a
 -> Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool
-> CutAnalysis a
-> CutAnalysis a
-> (Fix Combinator a, Bool)
forall a b c.
(Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) c)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator c, Bool)
seqCutAlg Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
(:*>:) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
l) ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
r)
cutAlg (LookAhead (:*:) CutAnalysis Compliance a
p) Bool
cut = (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool -> CutAnalysis a -> (Fix Combinator a, Bool)
forall a b.
(Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p)
cutAlg (NotFollowedBy (:*:) CutAnalysis Compliance a
p) Bool
_ = Bool
False Bool -> (Fix Combinator (), Bool) -> (Fix Combinator (), Bool)
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ (Fix Combinator a -> Combinator (Fix Combinator) ())
-> Bool -> CutAnalysis a -> (Fix Combinator (), Bool)
forall a b.
(Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Bool
False ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p)
cutAlg (Debug String
msg (:*:) CutAnalysis Compliance a
p) Bool
cut = (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool -> CutAnalysis a -> (Fix Combinator a, Bool)
forall a b.
(Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap (String -> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
msg) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p)
cutAlg (ChainPre (CutAnalysis (a -> a)
op :*: Compliance (a -> a)
NonComp) (:*:) CutAnalysis Compliance a
p) Bool
_ =
  let (Fix Combinator (a -> a)
op', Bool
_) = CutAnalysis (a -> a) -> Bool -> (Fix Combinator (a -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis (a -> a)
op Bool
True
      (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
False
  -- the loop could terminate having read no `op`s, so only `p` can decide if its handled.
  in (Fix Combinator a -> Fix Combinator a
forall a. Fix Combinator a -> Fix Combinator a
requiresCut (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k (a -> a) -> k a -> Combinator k a
ChainPre Fix Combinator (a -> a)
op' Fix Combinator a
p')), Bool
handled)
cutAlg (ChainPre (:*:) CutAnalysis Compliance (a -> a)
op (:*:) CutAnalysis Compliance a
p) Bool
cut =
  let (Fix Combinator (a -> a)
op', Bool
_) = CutAnalysis (a -> a) -> Bool -> (Fix Combinator (a -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance (a -> a) -> CutAnalysis (a -> a)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (a -> a)
op) Bool
False
      (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
cut
  in (Bool -> Fix Combinator a -> Fix Combinator a
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkCut (Bool -> Bool
not Bool
cut) (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k (a -> a) -> k a -> Combinator k a
ChainPre Fix Combinator (a -> a)
op' Fix Combinator a
p')), Bool
handled)
cutAlg (ChainPost (:*:) CutAnalysis Compliance a
p (CutAnalysis (a -> a)
op :*: Compliance (a -> a)
NonComp)) Bool
cut =
  let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
cut
      (Fix Combinator (a -> a)
op', Bool
_) = CutAnalysis (a -> a) -> Bool -> (Fix Combinator (a -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis (a -> a)
op Bool
True
  -- the loop could terminate having read no `op`s, so only `p` can decide if its handled.
  in (Fix Combinator a -> Fix Combinator a
forall a. Fix Combinator a -> Fix Combinator a
requiresCut (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
-> Fix Combinator (a -> a) -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k (a -> a) -> Combinator k a
ChainPost Fix Combinator a
p' Fix Combinator (a -> a)
op')), Bool
handled)
cutAlg (ChainPost (:*:) CutAnalysis Compliance a
p (:*:) CutAnalysis Compliance (a -> a)
op) Bool
cut =
  let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
cut
      (Fix Combinator (a -> a)
op', Bool
_) = CutAnalysis (a -> a) -> Bool -> (Fix Combinator (a -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance (a -> a) -> CutAnalysis (a -> a)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (a -> a)
op) Bool
False
  in (Bool -> Fix Combinator a -> Fix Combinator a
forall a. Bool -> Fix Combinator a -> Fix Combinator a
mkCut (Bool
cut Bool -> Bool -> Bool
&& Bool
handled) (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
-> Fix Combinator (a -> a) -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k (a -> a) -> Combinator k a
ChainPost Fix Combinator a
p' Fix Combinator (a -> a)
op')), Bool
handled)
cutAlg (Branch (:*:) CutAnalysis Compliance (Either a b)
b (:*:) CutAnalysis Compliance (a -> a)
p (:*:) CutAnalysis Compliance (b -> a)
q) Bool
cut =
  let (Fix Combinator (Either a b)
b', Bool
handled) = CutAnalysis (Either a b)
-> Bool -> (Fix Combinator (Either a b), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance (Either a b)
-> CutAnalysis (Either a b)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (Either a b)
b) Bool
cut
      (Fix Combinator (a -> a)
p', Bool
handled') = CutAnalysis (a -> a) -> Bool -> (Fix Combinator (a -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance (a -> a) -> CutAnalysis (a -> a)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (a -> a)
p) (Bool
cut Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
handled)
      (Fix Combinator (b -> a)
q', Bool
handled'') = CutAnalysis (b -> a) -> Bool -> (Fix Combinator (b -> a), Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance (b -> a) -> CutAnalysis (b -> a)
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance (b -> a)
q) (Bool
cut Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
handled)
  in (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator (Either a b)
-> Fix Combinator (a -> a)
-> Fix Combinator (b -> a)
-> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b c.
k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Branch Fix Combinator (Either a b)
b' Fix Combinator (a -> a)
p' Fix Combinator (b -> a)
q'), Bool
handled Bool -> Bool -> Bool
|| (Bool
handled' Bool -> Bool -> Bool
&& Bool
handled''))
cutAlg (Match (:*:) CutAnalysis Compliance a
p [Defunc (a -> Bool)]
f [(:*:) CutAnalysis Compliance a]
qs (:*:) CutAnalysis Compliance a
def) Bool
cut =
  let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p) Bool
cut
      (Fix Combinator a
def', Bool
handled') = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
def) (Bool
cut Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
handled)
      ([Fix Combinator a]
qs', Bool
handled'') = ((:*:) CutAnalysis Compliance a
 -> ([Fix Combinator a], Bool) -> ([Fix Combinator a], Bool))
-> ([Fix Combinator a], Bool)
-> [(:*:) CutAnalysis Compliance a]
-> ([Fix Combinator a], Bool)
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(:*:) CutAnalysis Compliance a
q -> (Fix Combinator a -> [Fix Combinator a] -> [Fix Combinator a])
-> (Bool -> Bool -> Bool)
-> (Fix Combinator a, Bool)
-> ([Fix Combinator a], Bool)
-> ([Fix Combinator a], Bool)
forall a b c x y z.
(a -> b -> c) -> (x -> y -> z) -> (a, x) -> (b, y) -> (c, z)
biliftA2 (:) Bool -> Bool -> Bool
(&&) (CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
q) (Bool
cut Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
handled))) ([], Bool
handled') [(:*:) CutAnalysis Compliance a]
qs
  in (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
-> [Defunc (a -> Bool)]
-> [Fix Combinator a]
-> Fix Combinator a
-> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b.
k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Match Fix Combinator a
p' [Defunc (a -> Bool)]
f [Fix Combinator a]
qs' Fix Combinator a
def'), Bool
handled Bool -> Bool -> Bool
|| Bool
handled'')
cutAlg (MakeRegister ΣVar a
σ (:*:) CutAnalysis Compliance a
l (:*:) CutAnalysis Compliance a
r) Bool
cut = (Fix Combinator a
 -> Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool
-> CutAnalysis a
-> CutAnalysis a
-> (Fix Combinator a, Bool)
forall a b c.
(Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) c)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator c, Bool)
seqCutAlg (ΣVar a
-> Fix Combinator a
-> Fix Combinator a
-> Combinator (Fix Combinator) a
forall a (k :: Type -> Type) b.
ΣVar a -> k a -> k b -> Combinator k b
MakeRegister ΣVar a
σ) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
l) ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
r)
cutAlg (GetRegister ΣVar a
σ) Bool
_ = (Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (ΣVar a -> Combinator (Fix Combinator) a
forall a (k :: Type -> Type). ΣVar a -> Combinator k a
GetRegister ΣVar a
σ), Bool
False)
cutAlg (PutRegister ΣVar a
σ (:*:) CutAnalysis Compliance a
p) Bool
cut = (Fix Combinator a -> Combinator (Fix Combinator) ())
-> Bool -> CutAnalysis a -> (Fix Combinator (), Bool)
forall a b.
(Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap (ΣVar a -> Fix Combinator a -> Combinator (Fix Combinator) ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p)
cutAlg (MetaCombinator MetaCombinator
m (:*:) CutAnalysis Compliance a
p) Bool
cut = (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Bool -> CutAnalysis a -> (Fix Combinator a, Bool)
forall a b.
(Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap (MetaCombinator -> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m) Bool
cut ((:*:) CutAnalysis Compliance a -> CutAnalysis a
forall k (f :: k -> Type) (g :: k -> Type) (i :: k).
(:*:) f g i -> f i
ifst (:*:) CutAnalysis Compliance a
p)

mkCut :: Bool -> Fix Combinator a -> Fix Combinator a
mkCut :: Bool -> Fix Combinator a -> Fix Combinator a
mkCut Bool
True = Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Combinator (Fix Combinator) a -> Fix Combinator a)
-> (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Fix Combinator a
-> Fix Combinator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
Cut
mkCut Bool
False = Fix Combinator a -> Fix Combinator a
forall a. a -> a
id

mkImmune :: Bool -> Fix Combinator a -> Fix Combinator a
mkImmune :: Bool -> Fix Combinator a -> Fix Combinator a
mkImmune Bool
True = Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Combinator (Fix Combinator) a -> Fix Combinator a)
-> (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Fix Combinator a
-> Fix Combinator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
CutImmune
mkImmune Bool
False = Fix Combinator a -> Fix Combinator a
forall a. a -> a
id

requiresCut :: Fix Combinator a -> Fix Combinator a
requiresCut :: Fix Combinator a -> Fix Combinator a
requiresCut = Combinator (Fix Combinator) a -> Fix Combinator a
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Combinator (Fix Combinator) a -> Fix Combinator a)
-> (Fix Combinator a -> Combinator (Fix Combinator) a)
-> Fix Combinator a
-> Fix Combinator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
RequiresCut

seqCutAlg :: (Fix Combinator a -> Fix Combinator b -> Combinator (Fix Combinator) c) -> Bool -> CutAnalysis a -> CutAnalysis b -> (Fix Combinator c, Bool)
seqCutAlg :: (Fix Combinator a
 -> Fix Combinator b -> Combinator (Fix Combinator) c)
-> Bool
-> CutAnalysis a
-> CutAnalysis b
-> (Fix Combinator c, Bool)
seqCutAlg Fix Combinator a
-> Fix Combinator b -> Combinator (Fix Combinator) c
con Bool
cut CutAnalysis a
l CutAnalysis b
r =
  let (Fix Combinator a
l', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis a
l Bool
cut
      (Fix Combinator b
r', Bool
handled') = CutAnalysis b -> Bool -> (Fix Combinator b, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis b
r (Bool
cut Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
handled)
  in (Combinator (Fix Combinator) c -> Fix Combinator c
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a
-> Fix Combinator b -> Combinator (Fix Combinator) c
con Fix Combinator a
l' Fix Combinator b
r'), Bool
handled Bool -> Bool -> Bool
|| Bool
handled')

rewrap :: (Fix Combinator a -> Combinator (Fix Combinator) b) -> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap :: (Fix Combinator a -> Combinator (Fix Combinator) b)
-> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
rewrap Fix Combinator a -> Combinator (Fix Combinator) b
con Bool
cut CutAnalysis a
p = let (Fix Combinator a
p', Bool
handled) = CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
forall a. CutAnalysis a -> Bool -> (Fix Combinator a, Bool)
doCut CutAnalysis a
p Bool
cut in (Combinator (Fix Combinator) b -> Fix Combinator b
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a -> Combinator (Fix Combinator) b
con Fix Combinator a
p'), Bool
handled)

biliftA2 :: (a -> b -> c) -> (x -> y -> z) -> (a, x) -> (b, y) -> (c, z)
biliftA2 :: (a -> b -> c) -> (x -> y -> z) -> (a, x) -> (b, y) -> (c, z)
biliftA2 a -> b -> c
f x -> y -> z
g (a
x1, x
y1) (b
x2, y
y2) = (a -> b -> c
f a
x1 b
x2, x -> y -> z
g x
y1 y
y2)