{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Haskell terms which are interesting
-- to pattern-match when optimizing.
module Symantic.Parser.Haskell.Term where

import Data.Bool (Bool(..))
import Data.Either (Either(..))
import Data.Eq (Eq)
import Data.Maybe (Maybe(..))
import Data.Functor.Identity (Identity(..))
import Prelude (undefined)
import Text.Show (Show(..))
import qualified Data.Eq as Eq
import qualified Data.Function as Fun
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

import qualified Symantic.Univariant.Trans as Sym

-- * Class 'Termable'
-- | Single-out some Haskell terms in order to 
class Termable repr where
  -- | Application, aka. unabstract.
  (.@) :: repr (a->b) -> repr a -> repr b
  -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style.
  lam :: (repr a -> repr b) -> repr (a->b)
  -- | Like 'lam' but whose argument is used only once,
  -- hence safe to beta-reduce (inline) without duplicating work.
  lam1 :: (repr a -> repr b) -> repr (a->b)

  -- Singled-out terms
  bool :: Bool -> repr Bool
  char :: (TH.Lift tok, Show tok) => tok -> repr tok
  cons :: repr (a -> [a] -> [a])
  nil :: repr [a]
  eq :: Eq a => repr (a -> a -> Bool)
  unit :: repr ()
  left :: repr (l -> Either l r)
  right :: repr (r -> Either l r)
  nothing :: repr (Maybe a)
  just :: repr (a -> Maybe a)
  const :: repr (a -> b -> a)
  flip :: repr ((a -> b -> c) -> b -> a -> c)
  id :: repr (a->a)
  (.) :: repr ((b->c) -> (a->b) -> a -> c)
  ($) :: repr ((a->b) -> a -> b)

  default (.@) ::
    Sym.Liftable2 repr => Termable (Sym.Output repr) =>
    repr (a->b) -> repr a -> repr b
  default lam ::
    Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) =>
    (repr a -> repr b) -> repr (a->b)
  default lam1 ::
    Sym.Liftable repr => Sym.Unliftable repr => Termable (Sym.Output repr) =>
    (repr a -> repr b) -> repr (a->b)
  default bool ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    Bool -> repr Bool
  default char ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    TH.Lift tok => Show tok =>
    tok -> repr tok
  default cons ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (a -> [a] -> [a])
  default nil ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr [a]
  default eq ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    Eq a => repr (a -> a -> Bool)
  default unit ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr ()
  default left ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (l -> Either l r)
  default right ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (r -> Either l r)
  default nothing ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (Maybe a)
  default just ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (a -> Maybe a)
  default const ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (a -> b -> a)
  default flip ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr ((a -> b -> c) -> b -> a -> c)
  default id ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr (a->a)
  default (.) ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr ((b->c) -> (a->b) -> a -> c)
  default ($) ::
    Sym.Liftable repr => Termable (Sym.Output repr) =>
    repr ((a->b) -> a -> b)

  (.@) = (Output repr (a -> b) -> Output repr a -> Output repr b)
-> repr (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b c.
Liftable2 repr =>
(Output repr a -> Output repr b -> Output repr c)
-> repr a -> repr b -> repr c
Sym.lift2 Output repr (a -> b) -> Output repr a -> Output repr b
forall (repr :: * -> *) a b.
Termable repr =>
repr (a -> b) -> repr a -> repr b
(.@)
  lam repr a -> repr b
f = Output repr (a -> b) -> repr (a -> b)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift ((Output repr a -> Output repr b) -> Output repr (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam (repr b -> Output repr b
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
Sym.trans (repr b -> Output repr b)
-> (Output repr a -> repr b) -> Output repr a -> Output repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. repr a -> repr b
f (repr a -> repr b)
-> (Output repr a -> repr a) -> Output repr a -> repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Output repr a -> repr a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
Sym.trans))
  lam1 repr a -> repr b
f = Output repr (a -> b) -> repr (a -> b)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift ((Output repr a -> Output repr b) -> Output repr (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam1 (repr b -> Output repr b
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
Sym.trans (repr b -> Output repr b)
-> (Output repr a -> repr b) -> Output repr a -> Output repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. repr a -> repr b
f (repr a -> repr b)
-> (Output repr a -> repr a) -> Output repr a -> repr b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Output repr a -> repr a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
Sym.trans))
  bool = Output repr Bool -> repr Bool
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift (Output repr Bool -> repr Bool)
-> (Bool -> Output repr Bool) -> Bool -> repr Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Bool -> Output repr Bool
forall (repr :: * -> *). Termable repr => Bool -> repr Bool
bool
  char = Output repr tok -> repr tok
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift (Output repr tok -> repr tok)
-> (tok -> Output repr tok) -> tok -> repr tok
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. tok -> Output repr tok
forall (repr :: * -> *) tok.
(Termable repr, Lift tok, Show tok) =>
tok -> repr tok
char
  cons = Output repr (a -> [a] -> [a]) -> repr (a -> [a] -> [a])
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (a -> [a] -> [a])
forall (repr :: * -> *) a. Termable repr => repr (a -> [a] -> [a])
cons
  nil = Output repr [a] -> repr [a]
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr [a]
forall (repr :: * -> *) a. Termable repr => repr [a]
nil
  eq = Output repr (a -> a -> Bool) -> repr (a -> a -> Bool)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (a -> a -> Bool)
forall (repr :: * -> *) a.
(Termable repr, Eq a) =>
repr (a -> a -> Bool)
eq
  unit = Output repr () -> repr ()
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr ()
forall (repr :: * -> *). Termable repr => repr ()
unit
  left = Output repr (l -> Either l r) -> repr (l -> Either l r)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (l -> Either l r)
forall (repr :: * -> *) l r.
Termable repr =>
repr (l -> Either l r)
left
  right = Output repr (r -> Either l r) -> repr (r -> Either l r)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (r -> Either l r)
forall (repr :: * -> *) r l.
Termable repr =>
repr (r -> Either l r)
right
  nothing = Output repr (Maybe a) -> repr (Maybe a)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (Maybe a)
nothing
  just = Output repr (a -> Maybe a) -> repr (a -> Maybe a)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (a -> Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (a -> Maybe a)
just
  const = Output repr (a -> b -> a) -> repr (a -> b -> a)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (a -> b -> a)
forall (repr :: * -> *) a b. Termable repr => repr (a -> b -> a)
const
  flip = Output repr ((a -> b -> c) -> b -> a -> c)
-> repr ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a b c.
Termable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip
  id = Output repr (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr (a -> a)
forall (repr :: * -> *) a. Termable repr => repr (a -> a)
id
  (.) = Output repr ((b -> c) -> (a -> b) -> a -> c)
-> repr ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) b c a.
Termable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.)
  ($) = Output repr ((a -> b) -> a -> b) -> repr ((a -> b) -> a -> b)
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
repr ((a -> b) -> a -> b)
($)
infixr 0 $
infixr 9 .
infixl 9 .@

-- * Type 'ValueCode'
data ValueCode a = ValueCode
  { forall a. ValueCode a -> a
value :: a
  , forall a. ValueCode a -> CodeQ a
code :: TH.CodeQ a
  }
instance Termable ValueCode where
  ValueCode (a -> b)
f .@ :: forall a b. ValueCode (a -> b) -> ValueCode a -> ValueCode b
.@ ValueCode a
x = ValueCode :: forall a. a -> CodeQ a -> ValueCode a
ValueCode
    { value :: b
value = Identity b -> b
forall a. Identity a -> a
runIdentity ((a -> b) -> Identity (a -> b)
forall a. a -> Identity a
Identity (ValueCode (a -> b) -> a -> b
forall a. ValueCode a -> a
value ValueCode (a -> b)
f) Identity (a -> b) -> Identity a -> Identity b
forall (repr :: * -> *) a b.
Termable repr =>
repr (a -> b) -> repr a -> repr b
.@ (a -> Identity a
forall a. a -> Identity a
Identity (ValueCode a -> a
forall a. ValueCode a -> a
value ValueCode a
x)))
    , code :: CodeQ b
code = ValueCode (a -> b) -> CodeQ (a -> b)
forall a. ValueCode a -> CodeQ a
code ValueCode (a -> b)
f CodeQ (a -> b) -> Code Q a -> CodeQ b
forall (repr :: * -> *) a b.
Termable repr =>
repr (a -> b) -> repr a -> repr b
.@ ValueCode a -> Code Q a
forall a. ValueCode a -> CodeQ a
code ValueCode a
x
    }
  lam :: forall a b. (ValueCode a -> ValueCode b) -> ValueCode (a -> b)
lam ValueCode a -> ValueCode b
f = ValueCode :: forall a. a -> CodeQ a -> ValueCode a
ValueCode
    { value :: a -> b
value = Identity (a -> b) -> a -> b
forall a. Identity a -> a
runIdentity ((Identity a -> Identity b) -> Identity (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (Identity a -> b) -> Identity a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. ValueCode b -> b
forall a. ValueCode a -> a
value (ValueCode b -> b)
-> (Identity a -> ValueCode b) -> Identity a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. ValueCode a -> ValueCode b
f (ValueCode a -> ValueCode b)
-> (Identity a -> ValueCode a) -> Identity a -> ValueCode b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. (a -> CodeQ a -> ValueCode a
forall a. a -> CodeQ a -> ValueCode a
`ValueCode` CodeQ a
forall a. HasCallStack => a
undefined) (a -> ValueCode a)
-> (Identity a -> a) -> Identity a -> ValueCode a
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Identity a -> a
forall a. Identity a -> a
runIdentity))
    , code :: CodeQ (a -> b)
code  = (CodeQ a -> Code Q b) -> CodeQ (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam (ValueCode b -> Code Q b
forall a. ValueCode a -> CodeQ a
code (ValueCode b -> Code Q b)
-> (CodeQ a -> ValueCode b) -> CodeQ a -> Code Q b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. ValueCode a -> ValueCode b
f (ValueCode a -> ValueCode b)
-> (CodeQ a -> ValueCode a) -> CodeQ a -> ValueCode b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. a -> CodeQ a -> ValueCode a
forall a. a -> CodeQ a -> ValueCode a
ValueCode a
forall a. HasCallStack => a
undefined)
    }
  lam1 :: forall a b. (ValueCode a -> ValueCode b) -> ValueCode (a -> b)
lam1     = (ValueCode a -> ValueCode b) -> ValueCode (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam
  bool :: Bool -> ValueCode Bool
bool Bool
b   = Bool -> CodeQ Bool -> ValueCode Bool
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Bool -> Identity Bool
forall (repr :: * -> *). Termable repr => Bool -> repr Bool
bool Bool
b)) (Bool -> CodeQ Bool
forall (repr :: * -> *). Termable repr => Bool -> repr Bool
bool Bool
b)
  char :: forall tok. (Lift tok, Show tok) => tok -> ValueCode tok
char tok
c   = tok -> CodeQ tok -> ValueCode tok
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity tok -> tok
forall a. Identity a -> a
runIdentity (tok -> Identity tok
forall (repr :: * -> *) tok.
(Termable repr, Lift tok, Show tok) =>
tok -> repr tok
char tok
c)) (tok -> CodeQ tok
forall (repr :: * -> *) tok.
(Termable repr, Lift tok, Show tok) =>
tok -> repr tok
char tok
c)
  cons :: forall a. ValueCode (a -> [a] -> [a])
cons     = (a -> [a] -> [a])
-> CodeQ (a -> [a] -> [a]) -> ValueCode (a -> [a] -> [a])
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (a -> [a] -> [a]) -> a -> [a] -> [a]
forall a. Identity a -> a
runIdentity Identity (a -> [a] -> [a])
forall (repr :: * -> *) a. Termable repr => repr (a -> [a] -> [a])
cons) CodeQ (a -> [a] -> [a])
forall (repr :: * -> *) a. Termable repr => repr (a -> [a] -> [a])
cons
  nil :: forall a. ValueCode [a]
nil      = [a] -> CodeQ [a] -> ValueCode [a]
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity [a] -> [a]
forall a. Identity a -> a
runIdentity Identity [a]
forall (repr :: * -> *) a. Termable repr => repr [a]
nil) CodeQ [a]
forall (repr :: * -> *) a. Termable repr => repr [a]
nil
  eq :: forall a. Eq a => ValueCode (a -> a -> Bool)
eq       = (a -> a -> Bool)
-> CodeQ (a -> a -> Bool) -> ValueCode (a -> a -> Bool)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (a -> a -> Bool) -> a -> a -> Bool
forall a. Identity a -> a
runIdentity Identity (a -> a -> Bool)
forall (repr :: * -> *) a.
(Termable repr, Eq a) =>
repr (a -> a -> Bool)
eq) CodeQ (a -> a -> Bool)
forall (repr :: * -> *) a.
(Termable repr, Eq a) =>
repr (a -> a -> Bool)
eq
  unit :: ValueCode ()
unit     = () -> CodeQ () -> ValueCode ()
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity () -> ()
forall a. Identity a -> a
runIdentity Identity ()
forall (repr :: * -> *). Termable repr => repr ()
unit) CodeQ ()
forall (repr :: * -> *). Termable repr => repr ()
unit
  left :: forall l r. ValueCode (l -> Either l r)
left     = (l -> Either l r)
-> CodeQ (l -> Either l r) -> ValueCode (l -> Either l r)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (l -> Either l r) -> l -> Either l r
forall a. Identity a -> a
runIdentity Identity (l -> Either l r)
forall (repr :: * -> *) l r.
Termable repr =>
repr (l -> Either l r)
left) CodeQ (l -> Either l r)
forall (repr :: * -> *) l r.
Termable repr =>
repr (l -> Either l r)
left
  right :: forall r l. ValueCode (r -> Either l r)
right    = (r -> Either l r)
-> CodeQ (r -> Either l r) -> ValueCode (r -> Either l r)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (r -> Either l r) -> r -> Either l r
forall a. Identity a -> a
runIdentity Identity (r -> Either l r)
forall (repr :: * -> *) r l.
Termable repr =>
repr (r -> Either l r)
right) CodeQ (r -> Either l r)
forall (repr :: * -> *) r l.
Termable repr =>
repr (r -> Either l r)
right
  nothing :: forall a. ValueCode (Maybe a)
nothing  = Maybe a -> CodeQ (Maybe a) -> ValueCode (Maybe a)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (Maybe a) -> Maybe a
forall a. Identity a -> a
runIdentity Identity (Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (Maybe a)
nothing) CodeQ (Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (Maybe a)
nothing
  just :: forall a. ValueCode (a -> Maybe a)
just     = (a -> Maybe a) -> CodeQ (a -> Maybe a) -> ValueCode (a -> Maybe a)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (a -> Maybe a) -> a -> Maybe a
forall a. Identity a -> a
runIdentity Identity (a -> Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (a -> Maybe a)
just) CodeQ (a -> Maybe a)
forall (repr :: * -> *) a. Termable repr => repr (a -> Maybe a)
just
  const :: forall a b. ValueCode (a -> b -> a)
const    = (a -> b -> a) -> CodeQ (a -> b -> a) -> ValueCode (a -> b -> a)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (a -> b -> a) -> a -> b -> a
forall a. Identity a -> a
runIdentity Identity (a -> b -> a)
forall (repr :: * -> *) a b. Termable repr => repr (a -> b -> a)
const) CodeQ (a -> b -> a)
forall (repr :: * -> *) a b. Termable repr => repr (a -> b -> a)
const
  flip :: forall a b c. ValueCode ((a -> b -> c) -> b -> a -> c)
flip     = ((a -> b -> c) -> b -> a -> c)
-> CodeQ ((a -> b -> c) -> b -> a -> c)
-> ValueCode ((a -> b -> c) -> b -> a -> c)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity ((a -> b -> c) -> b -> a -> c)
-> (a -> b -> c) -> b -> a -> c
forall a. Identity a -> a
runIdentity Identity ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a b c.
Termable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip) CodeQ ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a b c.
Termable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip
  id :: forall a. ValueCode (a -> a)
id       = (a -> a) -> CodeQ (a -> a) -> ValueCode (a -> a)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity (a -> a) -> a -> a
forall a. Identity a -> a
runIdentity Identity (a -> a)
forall (repr :: * -> *) a. Termable repr => repr (a -> a)
id) CodeQ (a -> a)
forall (repr :: * -> *) a. Termable repr => repr (a -> a)
id
  $ :: forall a b. ValueCode ((a -> b) -> a -> b)
($)      = ((a -> b) -> a -> b)
-> CodeQ ((a -> b) -> a -> b) -> ValueCode ((a -> b) -> a -> b)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity ((a -> b) -> a -> b) -> (a -> b) -> a -> b
forall a. Identity a -> a
runIdentity Identity ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
repr ((a -> b) -> a -> b)
($)) CodeQ ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
repr ((a -> b) -> a -> b)
($)
  . :: forall b c a. ValueCode ((b -> c) -> (a -> b) -> a -> c)
(.)      = ((b -> c) -> (a -> b) -> a -> c)
-> CodeQ ((b -> c) -> (a -> b) -> a -> c)
-> ValueCode ((b -> c) -> (a -> b) -> a -> c)
forall a. a -> CodeQ a -> ValueCode a
ValueCode (Identity ((b -> c) -> (a -> b) -> a -> c)
-> (b -> c) -> (a -> b) -> a -> c
forall a. Identity a -> a
runIdentity Identity ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) b c a.
Termable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.)) CodeQ ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) b c a.
Termable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.)
instance Termable Identity where
  Identity (a -> b)
f .@ :: forall a b. Identity (a -> b) -> Identity a -> Identity b
.@ Identity a
x   = b -> Identity b
forall a. a -> Identity a
Identity (Identity (a -> b) -> a -> b
forall a. Identity a -> a
runIdentity Identity (a -> b)
f (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
x))
  lam :: forall a b. (Identity a -> Identity b) -> Identity (a -> b)
lam Identity a -> Identity b
f    = (a -> b) -> Identity (a -> b)
forall a. a -> Identity a
Identity (Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> (a -> Identity b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. Identity a -> Identity b
f (Identity a -> Identity b) -> (a -> Identity a) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Fun.. a -> Identity a
forall a. a -> Identity a
Identity)
  lam1 :: forall a b. (Identity a -> Identity b) -> Identity (a -> b)
lam1     = (Identity a -> Identity b) -> Identity (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam
  bool :: Bool -> Identity Bool
bool     = Bool -> Identity Bool
forall a. a -> Identity a
Identity
  char :: forall tok. (Lift tok, Show tok) => tok -> Identity tok
char     = tok -> Identity tok
forall a. a -> Identity a
Identity
  cons :: forall a. Identity (a -> [a] -> [a])
cons     = (a -> [a] -> [a]) -> Identity (a -> [a] -> [a])
forall a. a -> Identity a
Identity (:)
  nil :: forall a. Identity [a]
nil      = [a] -> Identity [a]
forall a. a -> Identity a
Identity []
  eq :: forall a. Eq a => Identity (a -> a -> Bool)
eq       = (a -> a -> Bool) -> Identity (a -> a -> Bool)
forall a. a -> Identity a
Identity a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(Eq.==)
  unit :: Identity ()
unit     = () -> Identity ()
forall a. a -> Identity a
Identity ()
  left :: forall l r. Identity (l -> Either l r)
left     = (l -> Either l r) -> Identity (l -> Either l r)
forall a. a -> Identity a
Identity l -> Either l r
forall a b. a -> Either a b
Left
  right :: forall r l. Identity (r -> Either l r)
right    = (r -> Either l r) -> Identity (r -> Either l r)
forall a. a -> Identity a
Identity r -> Either l r
forall a b. b -> Either a b
Right
  nothing :: forall a. Identity (Maybe a)
nothing  = Maybe a -> Identity (Maybe a)
forall a. a -> Identity a
Identity Maybe a
forall a. Maybe a
Nothing
  just :: forall a. Identity (a -> Maybe a)
just     = (a -> Maybe a) -> Identity (a -> Maybe a)
forall a. a -> Identity a
Identity a -> Maybe a
forall a. a -> Maybe a
Just
  const :: forall a b. Identity (a -> b -> a)
const    = (a -> b -> a) -> Identity (a -> b -> a)
forall a. a -> Identity a
Identity a -> b -> a
forall a b. a -> b -> a
Fun.const
  flip :: forall a b c. Identity ((a -> b -> c) -> b -> a -> c)
flip     = ((a -> b -> c) -> b -> a -> c)
-> Identity ((a -> b -> c) -> b -> a -> c)
forall a. a -> Identity a
Identity (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
Fun.flip
  id :: forall a. Identity (a -> a)
id       = (a -> a) -> Identity (a -> a)
forall a. a -> Identity a
Identity a -> a
forall a. a -> a
Fun.id
  $ :: forall a b. Identity ((a -> b) -> a -> b)
($)      = ((a -> b) -> a -> b) -> Identity ((a -> b) -> a -> b)
forall a. a -> Identity a
Identity (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
(Fun.$)
  . :: forall b c a. Identity ((b -> c) -> (a -> b) -> a -> c)
(.)      = ((b -> c) -> (a -> b) -> a -> c)
-> Identity ((b -> c) -> (a -> b) -> a -> c)
forall a. a -> Identity a
Identity (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Fun..)
instance Termable TH.CodeQ where
  .@ :: forall a b. CodeQ (a -> b) -> CodeQ a -> CodeQ b
(.@) CodeQ (a -> b)
f CodeQ a
x = [|| $$f $$x ||]
  lam :: forall a b. (CodeQ a -> CodeQ b) -> CodeQ (a -> b)
lam CodeQ a -> CodeQ b
f    = [|| \x -> $$(f [||x||]) ||]
  lam1 :: forall a b. (CodeQ a -> CodeQ b) -> CodeQ (a -> b)
lam1     = (Code Q a -> Code Q b) -> Code Q (a -> b)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
lam
  bool :: Bool -> CodeQ Bool
bool Bool
b   = [|| b ||]
  char :: forall tok. (Lift tok, Show tok) => tok -> CodeQ tok
char tok
c   = [|| c ||]
  cons :: forall a. CodeQ (a -> [a] -> [a])
cons     = [|| (:) ||]
  nil :: forall a. CodeQ [a]
nil      = [|| [] ||]
  eq :: forall a. Eq a => CodeQ (a -> a -> Bool)
eq       = [|| (Eq.==) ||]
  unit :: CodeQ ()
unit     = [|| () ||]
  left :: forall l r. CodeQ (l -> Either l r)
left     = [|| Left ||]
  right :: forall r l. CodeQ (r -> Either l r)
right    = [|| Right ||]
  nothing :: forall a. CodeQ (Maybe a)
nothing  = [|| Nothing ||]
  just :: forall a. CodeQ (a -> Maybe a)
just     = [|| Just ||]
  const :: forall a b. CodeQ (a -> b -> a)
const    = [|| Fun.const ||]
  id :: forall a. CodeQ (a -> a)
id       = [|| \x -> x ||]
  flip :: forall a b c. CodeQ ((a -> b -> c) -> b -> a -> c)
flip     = [|| \f x y -> f y x ||]
  $ :: forall a b. CodeQ ((a -> b) -> a -> b)
($)      = [|| (Fun.$) ||]
  . :: forall b c a. CodeQ ((b -> c) -> (a -> b) -> a -> c)
(.)      = [|| (Fun..) ||]