{-# LANGUAGE LambdaCase,
             PatternSynonyms,
             ViewPatterns #-}
module Parsley.Internal.Frontend.Optimiser (optimise) where

import Prelude hiding                      ((<$>))
import Parsley.Internal.Common             (Fix(In), Quapplicative(..))
import Parsley.Internal.Core.CombinatorAST (Combinator(..))
import Parsley.Internal.Core.Defunc        (Defunc(..), pattern FLIP_H, pattern COMPOSE_H, pattern FLIP_CONST, pattern UNIT)

pattern (:<$>:) :: Defunc (a -> b) -> Fix Combinator a -> Combinator (Fix Combinator) b
pattern f $b:<$>: :: Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
$m:<$>: :: forall r b.
Combinator (Fix Combinator) b
-> (forall a. Defunc (a -> b) -> Fix Combinator a -> r)
-> (Void# -> r)
-> r
:<$>: p = In (Pure f) :<*>: p
pattern (:$>:) :: Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
pattern p $b:$>: :: Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
$m:$>: :: forall r b.
Combinator (Fix Combinator) b
-> (forall a. Fix Combinator a -> Defunc b -> r)
-> (Void# -> r)
-> r
:$>: x = p :*>: In (Pure x)
pattern (:<$:) :: Defunc a -> Fix Combinator b -> Combinator (Fix Combinator) a
pattern x $b:<$: :: Defunc a -> Fix Combinator b -> Combinator (Fix Combinator) a
$m:<$: :: forall r a.
Combinator (Fix Combinator) a
-> (forall b. Defunc a -> Fix Combinator b -> r)
-> (Void# -> r)
-> r
:<$: p = In (Pure x) :<*: p

optimise :: Combinator (Fix Combinator) a -> Fix Combinator a
-- DESTRUCTIVE OPTIMISATION
-- Right Absorption Law: empty <*> u                    = empty
optimise :: Combinator (Fix Combinator) a -> Fix Combinator a
optimise (In Combinator (Fix Combinator) (a -> a)
Empty :<*>: Fix Combinator a
_)                             = 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
-- Failure Weakening Law: u <*> empty                   = u *> empty
optimise (Fix Combinator (a -> a)
u :<*>: In Combinator (Fix Combinator) a
Empty)                             = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
u Fix Combinator (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: 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)
-- Right Absorption Law: empty *> u                     = empty
optimise (In Combinator (Fix Combinator) a
Empty :*>: Fix Combinator a
_)                              = 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
-- Right Absorption Law: empty <* u                     = empty
optimise (In Combinator (Fix Combinator) a
Empty :<*: Fix Combinator b
_)                              = 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
-- Failure Weakening Law: u <* empty                    = u *> empty
optimise (Fix Combinator a
u :<*: In Combinator (Fix Combinator) b
Empty)                              = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: 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)
-- Branch Absorption Law: branch empty p q              = empty
optimise (Branch (In Combinator (Fix Combinator) (Either a b)
Empty) Fix Combinator (a -> a)
_ Fix Combinator (b -> a)
_)                        = 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
-- Branch Weakening Law: branch b empty empty           = b *> empty
optimise (Branch Fix Combinator (Either a b)
b (In Combinator (Fix Combinator) (a -> a)
Empty) (In Combinator (Fix Combinator) (b -> a)
Empty))               = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (Either a b)
b Fix Combinator (Either a b)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: 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)
-- Match Absorption Law: match _ empty _ def            = def
optimise (Match (In Combinator (Fix Combinator) a
Empty) [Defunc (a -> Bool)]
_ [Fix Combinator a]
_ Fix Combinator a
def)                     = Fix Combinator a
def
-- Match Weakening Law: match _ p (const empty) empty   = p *> empty
optimise (Match Fix Combinator a
p [Defunc (a -> Bool)]
_ [Fix Combinator a]
qs (In Combinator (Fix Combinator) a
Empty))
  | (Fix Combinator a -> Bool) -> [Fix Combinator a] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (\case {In Combinator (Fix Combinator) a
Empty -> Bool
True; Fix Combinator a
_ -> Bool
False}) [Fix Combinator a]
qs = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
p Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: 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)
-- APPLICATIVE OPTIMISATION
-- Identity Law: id <$> u                               = u
optimise (Defunc (a -> a)
ID :<$>: Fix Combinator a
u)                                   = Fix Combinator a
Fix Combinator a
u
-- Flip const optimisation: flip const <$> u            = u *> pure id
optimise (Defunc (a -> a)
FLIP_CONST :<$>: Fix Combinator a
u)                           = Combinator (Fix Combinator) (b -> b) -> Fix Combinator (b -> b)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator (b -> b) -> Combinator (Fix Combinator) (b -> b)
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Combinator (Fix Combinator) (b -> b) -> Fix Combinator (b -> b)
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc (b -> b) -> Combinator (Fix Combinator) (b -> b)
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc (b -> b)
forall a. Defunc (a -> a)
ID))
-- Homomorphism Law: pure f <*> pure x                  = pure (f x)
optimise (Defunc (a -> a)
f :<$>: In (Pure Defunc a
x))                          = 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 -> a) -> Defunc a -> Defunc a
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H Defunc (a -> a)
f Defunc a
x))
-- NOTE: This is basically a shortcut, it can be caught by the Composition Law and Homomorphism law
-- Functor Composition Law: f <$> (g <$> p)             = (f . g) <$> p
optimise (Defunc (a -> a)
f :<$>: In (Defunc (a -> a)
g :<$>: Fix Combinator a
p))                       = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc (a -> a) -> Defunc (a -> a) -> Defunc (a -> a)
forall z x y b c a.
((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) =>
Defunc x -> Defunc y -> Defunc z
COMPOSE_H Defunc (a -> a)
f Defunc (a -> a)
g Defunc (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator a
p)
-- Composition Law: u <*> (v <*> w)                     = (.) <$> u <*> v <*> w
optimise (Fix Combinator (a -> a)
u :<*>: In (Fix Combinator (a -> a)
v :<*>: Fix Combinator a
w))                       = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) (a -> a) -> Fix Combinator (a -> a)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) ((a -> a) -> a -> a)
-> Fix Combinator ((a -> a) -> a -> a)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc ((a -> a) -> (a -> a) -> a -> a)
forall b c a. Defunc ((b -> c) -> (a -> b) -> a -> c)
COMPOSE Defunc ((a -> a) -> (a -> a) -> a -> a)
-> Fix Combinator (a -> a)
-> Combinator (Fix Combinator) ((a -> a) -> a -> a)
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator (a -> a)
u) Fix Combinator ((a -> a) -> a -> a)
-> Fix Combinator (a -> a) -> Combinator (Fix Combinator) (a -> a)
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: Fix Combinator (a -> a)
v) 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
:<*>: Fix Combinator a
w)
-- Definition of *>
optimise (In (Defunc (a -> a -> a)
FLIP_CONST :<$>: Fix Combinator a
p) :<*>: Fix Combinator a
q)              = 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 b. k a -> k b -> Combinator k b
:*>: Fix Combinator a
q)
-- Definition of <*
optimise (In (Defunc (a -> a -> a)
CONST :<$>: Fix Combinator a
p) :<*>: Fix Combinator a
q)                   = 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 b. k a -> k b -> Combinator k a
:<*: Fix Combinator a
q)
-- Reassociation Law 1: (u *> v) <*> w                  = u *> (v <*> w)
optimise (In (Fix Combinator a
u :*>: Fix Combinator (a -> a)
v) :<*>: Fix Combinator a
w)                        = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
v 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
:<*>: Fix Combinator a
w)))
-- Interchange Law: u <*> pure x                        = pure ($ x) <*> u
optimise (Fix Combinator (a -> a)
u :<*>: In (Pure Defunc a
x))                          = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc (a -> (a -> a) -> a) -> Defunc a -> Defunc ((a -> a) -> a)
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H (Defunc ((a -> a) -> a -> a) -> Defunc (a -> (a -> a) -> a)
forall y x a b c.
((x -> y) ~ ((a -> b -> c) -> b -> a -> c)) =>
Defunc x -> Defunc y
FLIP_H Defunc ((a -> a) -> a -> a)
forall a. Defunc (a -> a)
ID) Defunc a
x Defunc ((a -> a) -> a)
-> Fix Combinator (a -> a) -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator (a -> a)
u)
-- Right Absorption Law: (f <$> p) *> q                 = p *> q
optimise (In (Defunc (a -> a)
_ :<$>: Fix Combinator a
p) :*>: Fix Combinator a
q)                        = 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 b. k a -> k b -> Combinator k b
:*>: Fix Combinator a
q)
-- Left Absorption Law: p <* (f <$> q)                  = p <* q
optimise (Fix Combinator a
p :<*: (In (Defunc (a -> b)
_ :<$>: Fix Combinator a
q)))                      = 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 b. k a -> k b -> Combinator k a
:<*: Fix Combinator a
q)
-- Reassociation Law 2: u <*> (v <* w)                  = (u <*> v) <* w
optimise (Fix Combinator (a -> a)
u :<*>: In (Fix Combinator a
v :<*: Fix Combinator b
w))                        = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
u 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
:<*>: Fix Combinator a
v) Fix Combinator a
-> Fix Combinator b -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Fix Combinator b
w)
-- Reassociation Law 3: u <*> (v $> x)                  = (u <*> pure x) <* v
optimise (Fix Combinator (a -> a)
u :<*>: In (Fix Combinator a
v :$>: Defunc a
x))                        = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
u 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
:<*>: 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)) Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Fix Combinator a
v)
-- ALTERNATIVE OPTIMISATION
-- Left Catch Law: pure x <|> u                         = pure x
optimise (p :: Fix Combinator a
p@(In (Pure Defunc a
_)) :<|>: Fix Combinator a
_)                      = Fix Combinator a
p
-- Left Neutral Law: empty <|> u                        = u
optimise (In Combinator (Fix Combinator) a
Empty :<|>: Fix Combinator a
u)                             = Fix Combinator a
u
-- Right Neutral Law: u <|> empty                       = u
optimise (Fix Combinator a
u :<|>: In Combinator (Fix Combinator) a
Empty)                             = Fix Combinator a
u
-- Associativity Law: (u <|> v) <|> w                   = u <|> (v <|> w)
optimise (In (Fix Combinator a
u :<|>: Fix Combinator a
v) :<|>: Fix Combinator a
w)                       = 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
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
v 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
w))
-- SEQUENCING OPTIMISATION
-- Identity law: pure x *> u                            = u
optimise (In (Pure Defunc a
_) :*>: Fix Combinator a
u)                           = Fix Combinator a
u
-- Identity law: (u $> x) *> v                          = u *> v
optimise (In (Fix Combinator a
u :$>: Defunc a
_) :*>: Fix Combinator a
v)                         = 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
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Fix Combinator a
v)
-- Associativity Law: u *> (v *> w)                     = (u *> v) *> w
optimise (Fix Combinator a
u :*>: In (Fix Combinator a
v :*>: Fix Combinator a
w))                         = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Fix Combinator a
v) Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Fix Combinator a
w)
-- Identity law: u <* pure x                            = u
optimise (Fix Combinator a
u :<*: In (Pure Defunc b
_))                           = Fix Combinator a
u
-- Identity law: u <* (v $> x)                          = u <* v
optimise (Fix Combinator a
u :<*: In (Fix Combinator a
v :$>: Defunc b
_))                         = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Fix Combinator a
v)
-- Commutativity Law: x <$ u                            = u $> x
optimise (Defunc a
x :<$: Fix Combinator b
u)                                     = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator b
u Fix Combinator b -> Defunc a -> Combinator (Fix Combinator) a
forall b a.
Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
:$>: Defunc a
x)
-- Associativity Law (u <* v) <* w                      = u <* (v <* w)
optimise (In (Fix Combinator a
u :<*: Fix Combinator b
v) :<*: Fix Combinator b
w)                         = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
u Fix Combinator a
-> Fix Combinator b -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Combinator (Fix Combinator) b -> Fix Combinator b
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator b
v Fix Combinator b
-> Fix Combinator b -> Combinator (Fix Combinator) b
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Fix Combinator b
w))
-- Pure lookahead: lookAhead (pure x)                   = pure x
optimise (LookAhead p :: Fix Combinator a
p@(In (Pure Defunc a
_)))                    = Fix Combinator a
p
-- Dead lookahead: lookAhead empty                      = empty
optimise (LookAhead p :: Fix Combinator a
p@(In Combinator (Fix Combinator) a
Empty))                       = Fix Combinator a
p
-- Pure negative-lookahead: notFollowedBy (pure x)      = empty
optimise (NotFollowedBy (In (Pure Defunc a
_)))                  = 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
-- Dead negative-lookahead: notFollowedBy empty         = unit
optimise (NotFollowedBy (In Combinator (Fix Combinator) a
Empty))                     = Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc () -> Combinator (Fix Combinator) ()
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc ()
UNIT)
-- Double Negation Law: notFollowedBy . notFollowedBy   = lookAhead . try . void
optimise (NotFollowedBy (In (NotFollowedBy Fix Combinator a
p)))         = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator () -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
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 -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try Fix Combinator a
p) Fix Combinator a
-> Fix Combinator () -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc () -> Combinator (Fix Combinator) ()
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc ()
UNIT))))
-- Zero Consumption Law: notFollowedBy (try p)          = notFollowedBy p
optimise (NotFollowedBy (In (Try Fix Combinator a
p)))                   = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p)
-- Idempotence Law: lookAhead . lookAhead               = lookAhead
optimise (LookAhead (In (LookAhead Fix Combinator a
p)))                 = 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
LookAhead Fix Combinator a
p)
-- Right Identity Law: notFollowedBy . lookAhead        = notFollowedBy
optimise (NotFollowedBy (In (LookAhead Fix Combinator a
p)))             = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p)
-- Left Identity Law: lookAhead . notFollowedBy         = notFollowedBy
optimise (LookAhead (In (NotFollowedBy Fix Combinator a
p)))             = Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p)
-- Transparency Law: notFollowedBy (try p <|> q)        = notFollowedBy p *> notFollowedBy q
optimise (NotFollowedBy (In (In (Try Fix Combinator a
p) :<|>: Fix Combinator a
q)))      = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p) Fix Combinator ()
-> Fix Combinator () -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
q))
-- Distributivity Law: lookAhead p <|> lookAhead q      = lookAhead (try p <|> q)
optimise (In (LookAhead Fix Combinator a
p) :<|>: In (LookAhead Fix Combinator a
q))      = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (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 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)))
-- Interchange Law: lookAhead (p $> x)                  = lookAhead p $> x
optimise (LookAhead (In (Fix Combinator a
p :$>: Defunc a
x)))                    = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead Fix Combinator a
p) Fix Combinator a -> Defunc a -> Combinator (Fix Combinator) a
forall b a.
Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
:$>: Defunc a
x)
-- Interchange law: lookAhead (f <$> p)                 = f <$> lookAhead p
optimise (LookAhead (In (Defunc (a -> a)
f :<$>: Fix Combinator a
p)))                   = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc (a -> a)
f Defunc (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead Fix Combinator a
p))
-- Absorption Law: p <*> notFollowedBy q                = (p <*> unit) <* notFollowedBy q
optimise (Fix Combinator (a -> a)
p :<*>: In (NotFollowedBy Fix Combinator a
q))                 = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
p 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
:<*>: Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc () -> Combinator (Fix Combinator) ()
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc ()
UNIT)) Fix Combinator a
-> Fix Combinator () -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: Combinator (Fix Combinator) () -> Fix Combinator ()
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
q))
-- Idempotence Law: notFollowedBy (p $> x)              = notFollowedBy p
optimise (NotFollowedBy (In (Fix Combinator a
p :$>: Defunc a
_)))                = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p)
-- Idempotence Law: notFollowedBy (f <$> p)             = notFollowedBy p
optimise (NotFollowedBy (In (Defunc (a -> a)
_ :<$>: Fix Combinator a
p)))               = Combinator (Fix Combinator) () -> Fix Combinator ()
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy Fix Combinator a
p)
-- Interchange Law: try (p $> x)                        = try p $> x
optimise (Try (In (Fix Combinator a
p :$>: Defunc a
x)))                          = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try Fix Combinator a
p) Fix Combinator a -> Defunc a -> Combinator (Fix Combinator) a
forall b a.
Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
:$>: Defunc a
x)
-- Interchange law: try (f <$> p)                       = f <$> try p
optimise (Try (In (Defunc (a -> a)
f :<$>: Fix Combinator a
p)))                         = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc (a -> a)
f Defunc (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try Fix Combinator a
p))
-- pure Left law: branch (pure (Left x)) p q            = p <*> pure x
optimise (Branch (In (Pure (l :: Defunc (Either a b)
l@(Defunc (Either a b) -> Either a b
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val -> Left a
x)))) Fix Combinator (a -> a)
p Fix Combinator (b -> a)
_)  = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (a -> a)
p 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
:<*>: 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 (a -> Code a -> Defunc a
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ a
x Code a
qx))) where qx :: Code a
qx = [||case $$(_code l) of Left x -> x||]
-- pure Right law: branch (pure (Right x)) p q          = q <*> pure x
optimise (Branch (In (Pure (r :: Defunc (Either a b)
r@(Defunc (Either a b) -> Either a b
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val -> Right b
x)))) Fix Combinator (a -> a)
_ Fix Combinator (b -> a)
q) = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (b -> a)
q Fix Combinator (b -> a)
-> Fix Combinator b -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: Combinator (Fix Combinator) b -> Fix Combinator b
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc b -> Combinator (Fix Combinator) b
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure (b -> Code b -> Defunc b
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ b
x Code b
qx))) where qx :: Code b
qx = [||case $$(_code r) of Right x -> x||]
-- Generalised Identity law: branch b (pure f) (pure g) = either f g <$> b
optimise (Branch Fix Combinator (Either a b)
b (In (Pure Defunc (a -> a)
f)) (In (Pure Defunc (b -> a)
g)))         = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise ((Either a b -> a)
-> Code (Either a b -> a) -> Defunc (Either a b -> a)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ ((a -> a) -> (b -> a) -> Either a b -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Defunc (a -> a) -> a -> a
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc (a -> a)
f) (Defunc (b -> a) -> b -> a
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc (b -> a)
g)) [||either $$(_code f) $$(_code g)||] Defunc (Either a b -> a)
-> Fix Combinator (Either a b) -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator (Either a b)
b)
-- Interchange law: branch (x *> y) p q                 = x *> branch y p q
optimise (Branch (In (Fix Combinator a
x :*>: Fix Combinator (Either a b)
y)) Fix Combinator (a -> a)
p Fix Combinator (b -> a)
q)                   = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator a
x Fix Combinator a
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (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)
y Fix Combinator (a -> a)
p Fix Combinator (b -> a)
q))
-- Negated Branch law: branch b p empty                 = branch (swapEither <$> b) empty p
optimise (Branch Fix Combinator (Either a b)
b Fix Combinator (a -> a)
p (In Combinator (Fix Combinator) (b -> a)
Empty))                        = 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 b a)
-> Fix Combinator (b -> a)
-> Fix Combinator (a -> 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 (Combinator (Fix Combinator) (Either b a)
-> Fix Combinator (Either b a)
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Combinator (Fix Combinator) (Either a b -> Either b a)
-> Fix Combinator (Either a b -> Either b a)
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc (Either a b -> Either b a)
-> Combinator (Fix Combinator) (Either a b -> Either b a)
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure ((Either a b -> Either b a)
-> Code (Either a b -> Either b a)
-> Defunc (Either a b -> Either b a)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ ((a -> Either b a) -> (b -> Either b a) -> Either a b -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either b a
forall a b. b -> Either a b
Right b -> Either b a
forall a b. a -> Either a b
Left) [||either Right Left||])) Fix Combinator (Either a b -> Either b a)
-> Fix Combinator (Either a b)
-> Combinator (Fix Combinator) (Either b a)
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: Fix Combinator (Either a b)
b)) (Combinator (Fix Combinator) (b -> a) -> Fix Combinator (b -> a)
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In Combinator (Fix Combinator) (b -> a)
forall (k :: Type -> Type) a. Combinator k a
Empty) Fix Combinator (a -> a)
p)
-- Branch Fusion law: branch (branch b empty (pure f)) empty k                  = branch (g <$> b) empty k where g is a monad transforming (>>= f)
optimise (Branch (In (Branch Fix Combinator (Either a b)
b (In Combinator (Fix Combinator) (a -> Either a b)
Empty) (In (Pure Defunc (b -> Either a b)
f)))) (In Combinator (Fix Combinator) (a -> a)
Empty) Fix Combinator (b -> a)
k) = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Fix Combinator (Either () b)
-> Fix Combinator (() -> 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 (Combinator (Fix Combinator) (Either () b)
-> Fix Combinator (Either () b)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Combinator (Fix Combinator) (Either a b -> Either () b)
-> Fix Combinator (Either a b -> Either () b)
forall k (f :: (k -> Type) -> k -> Type) (a :: k).
f (Fix f) a -> Fix f a
In (Defunc (Either a b -> Either () b)
-> Combinator (Fix Combinator) (Either a b -> Either () b)
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure ((Either a b -> Either () b)
-> Code (Either a b -> Either () b)
-> Defunc (Either a b -> Either () b)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ Either a b -> Either () b
g Code (Either a b -> Either () b)
qg)) Fix Combinator (Either a b -> Either () b)
-> Fix Combinator (Either a b)
-> Combinator (Fix Combinator) (Either () b)
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: Fix Combinator (Either a b)
b)) (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) Fix Combinator (b -> a)
k)
  where
    g :: Either a b -> Either () b
g (Left a
_) = () -> Either () b
forall a b. a -> Either a b
Left ()
    g (Right b
x) = case Defunc (b -> Either a b) -> b -> Either a b
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc (b -> Either a b)
f b
x of
      Left a
_ -> () -> Either () b
forall a b. a -> Either a b
Left ()
      Right b
x -> b -> Either () b
forall a b. b -> Either a b
Right b
x
    qg :: Code (Either a b -> Either () b)
qg = [||\case Left _ -> Left ()
                  Right x -> case $$(_code f) x of
                               Left _ -> Left ()
                               Right y -> Right y||]
-- Distributivity Law: f <$> branch b p q                = branch b ((f .) <$> p) ((f .) <$> q)
optimise (Defunc (a -> a)
f :<$>: In (Branch Fix Combinator (Either a b)
b Fix Combinator (a -> a)
p Fix Combinator (b -> a)
q))                     = Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (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 (Combinator (Fix Combinator) (a -> a) -> Fix Combinator (a -> a)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc ((a -> a) -> (a -> a) -> a -> a)
-> Defunc (a -> a) -> Defunc ((a -> a) -> a -> a)
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H Defunc ((a -> a) -> (a -> a) -> a -> a)
forall b c a. Defunc ((b -> c) -> (a -> b) -> a -> c)
COMPOSE Defunc (a -> a)
f Defunc ((a -> a) -> a -> a)
-> Fix Combinator (a -> a) -> Combinator (Fix Combinator) (a -> a)
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator (a -> a)
p)) (Combinator (Fix Combinator) (b -> a) -> Fix Combinator (b -> a)
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc ((a -> a) -> (b -> a) -> b -> a)
-> Defunc (a -> a) -> Defunc ((b -> a) -> b -> a)
forall a b. Defunc (a -> b) -> Defunc a -> Defunc b
APP_H Defunc ((a -> a) -> (b -> a) -> b -> a)
forall b c a. Defunc ((b -> c) -> (a -> b) -> a -> c)
COMPOSE Defunc (a -> a)
f Defunc ((b -> a) -> b -> a)
-> Fix Combinator (b -> a) -> Combinator (Fix Combinator) (b -> a)
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator (b -> a)
q)))
-- pure Match law: match vs (pure x) f def               = if elem x vs then f x else def
optimise (Match (In (Pure Defunc a
x)) [Defunc (a -> Bool)]
fs [Fix Combinator a]
qs Fix Combinator a
def)                 = ((Defunc (a -> Bool), Fix Combinator a)
 -> Fix Combinator a -> Fix Combinator a)
-> Fix Combinator a
-> [(Defunc (a -> Bool), Fix Combinator a)]
-> Fix Combinator a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Defunc (a -> Bool)
f, Fix Combinator a
q) Fix Combinator a
k -> if Defunc (a -> Bool) -> a -> Bool
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc (a -> Bool)
f (Defunc a -> a
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc a
x) then Fix Combinator a
q else Fix Combinator a
k) Fix Combinator a
def ([Defunc (a -> Bool)]
-> [Fix Combinator a] -> [(Defunc (a -> Bool), Fix Combinator a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Defunc (a -> Bool)]
fs [Fix Combinator a]
qs)
-- TODO I'm not actually sure this one is a good optimisation? might have some size constraint on it
-- Generalised Identity Match law: match vs p (pure . f) def = f <$> (p >?> flip elem vs) <|> def
{-optimise (Match p fs qs def)
  | all (\case {In (Pure _) -> True; _ -> False}) qs     = optimise (optimise (makeQ apply qapply :<$>: (p >?> (makeQ validate qvalidate))) :<|>: def)
    where apply x    = foldr (\(f, In (Pure y)) k -> if _val f x then _val y else k) (error "whoopsie") (zip fs qs)
          qapply     = [||\x -> $$(foldr (\(f, In (Pure y)) k -> [||if $$(_code f) x then $$(_code y) else $$k||]) ([||error "whoopsie"||]) (zip fs qs))||]
          validate x = foldr (\f b -> _val f x || b) False fs
          qvalidate  = [||\x -> $$(foldr (\f k -> [||$$(_code f) x || $$k||]) [||False||] fs)||]-}
-- Distributivity Law: f <$> match vs p g def            = match vs p ((f <$>) . g) (f <$> def)
optimise (Defunc (a -> a)
f :<$>: (In (Match Fix Combinator a
p [Defunc (a -> Bool)]
fs [Fix Combinator a]
qs Fix Combinator a
def)))              = 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)]
fs ((Fix Combinator a -> Fix Combinator a)
-> [Fix Combinator a] -> [Fix Combinator a]
forall a b. (a -> b) -> [a] -> [b]
map (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (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
. (Defunc (a -> a)
f Defunc (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>:)) [Fix Combinator a]
qs) (Combinator (Fix Combinator) a -> Fix Combinator a
forall a. Combinator (Fix Combinator) a -> Fix Combinator a
optimise (Defunc (a -> a)
f Defunc (a -> a)
-> Fix Combinator a -> Combinator (Fix Combinator) a
forall b a.
Defunc (a -> b)
-> Fix Combinator a -> Combinator (Fix Combinator) b
:<$>: Fix Combinator a
def)))
-- Trivial let-bindings - NOTE: These will get moved when Let nodes no longer have the "source" in them
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In (Pure Defunc a
_)))                               = Fix Combinator a
p
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In Combinator (Fix Combinator) a
Empty))                                  = Fix Combinator a
p
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In (Satisfy Defunc (Char -> Bool)
_)))                            = Fix Combinator a
p
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In (In (Satisfy Defunc (Char -> Bool)
_) :$>: Defunc a
_)))                = Fix Combinator a
p
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In (GetRegister ΣVar a
_)))                        = Fix Combinator a
p
optimise (Let Bool
False MVar a
_ p :: Fix Combinator a
p@(In (In (Pure Defunc (a -> a)
_) :<*>: In (GetRegister ΣVar a
_)))) = Fix Combinator a
p
optimise Combinator (Fix Combinator) a
p                                                           = 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
p

-- try (lookAhead p *> p *> lookAhead q) = lookAhead (p *> q) <* try p

{-(>?>) :: Fix Combinator a -> Defunc (a -> Bool) -> Fix Combinator a
p >?> f = In (Branch (In (makeQ g qg :<$>: p)) (In Empty) (In (Pure ID)))
  where
    g x = if _val f x then Right x else Left ()
    qg = [||\x -> if $$(_code f) x then Right x else Left ()||]-}