{-# LANGUAGE ImplicitParams, PatternSynonyms, StandaloneKindSignatures, TypeApplications, ViewPatterns #-}
module Parsley.Internal.Backend.Machine.Defunc (
Defunc(..),
user,
ap, ap2,
_if,
genDefunc,
pattern NormLam, pattern FREEVAR
) where
import Parsley.Internal.Backend.Machine.Types.Input (Input(off))
import Parsley.Internal.Common.Utils (Code)
import Parsley.Internal.Core.Lam (Lam, normaliseGen, normalise)
import qualified Parsley.Internal.Core.Defunc as Core (Defunc, lamTerm)
import qualified Parsley.Internal.Core.Lam as Lam (Lam(..))
import qualified Parsley.Internal.Opt as Opt
data Defunc a where
LAM :: Lam a -> Defunc a
BOTTOM :: Defunc a
INPUT :: Input o -> Defunc o
user :: Core.Defunc a -> Defunc a
user :: forall a. Defunc a -> Defunc a
user = forall a. Lam a -> Defunc a
LAM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Defunc a -> Lam a
Core.lamTerm
ap :: (?flags :: Opt.Flags) => Defunc (a -> b) -> Defunc a -> Defunc b
ap :: forall a b.
(?flags::Flags) =>
Defunc (a -> b) -> Defunc a -> Defunc b
ap Defunc (a -> b)
f Defunc a
x = forall a. Lam a -> Defunc a
LAM (forall a1 a. Lam (a1 -> a) -> Lam a1 -> Lam a
Lam.App (forall a. (?flags::Flags) => Defunc a -> Lam a
unliftDefunc Defunc (a -> b)
f) (forall a. (?flags::Flags) => Defunc a -> Lam a
unliftDefunc Defunc a
x))
ap2 :: (?flags :: Opt.Flags) => Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c
ap2 :: forall a b c.
(?flags::Flags) =>
Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c
ap2 Defunc (a -> b -> c)
f Defunc a
x = forall a b.
(?flags::Flags) =>
Defunc (a -> b) -> Defunc a -> Defunc b
ap (forall a b.
(?flags::Flags) =>
Defunc (a -> b) -> Defunc a -> Defunc b
ap Defunc (a -> b -> c)
f Defunc a
x)
_if :: (?flags :: Opt.Flags) => Defunc Bool -> Code a -> Code a -> Code a
_if :: forall a.
(?flags::Flags) =>
Defunc Bool -> Code a -> Code a -> Code a
_if Defunc Bool
c Code a
t Code a
e = forall a. (?flags::Flags) => Lam a -> Code a
normaliseGen (forall a. Lam Bool -> Lam a -> Lam a -> Lam a
Lam.If (forall a. (?flags::Flags) => Defunc a -> Lam a
unliftDefunc Defunc Bool
c) (forall a. Bool -> Code a -> Lam a
Lam.Var Bool
False Code a
t) (forall a. Bool -> Code a -> Lam a
Lam.Var Bool
False Code a
e))
unliftDefunc :: (?flags :: Opt.Flags) => Defunc a -> Lam a
unliftDefunc :: forall a. (?flags::Flags) => Defunc a -> Lam a
unliftDefunc (LAM Lam a
x) = Lam a
x
unliftDefunc Defunc a
x = forall a. Bool -> Code a -> Lam a
Lam.Var Bool
False (forall a. (?flags::Flags) => Defunc a -> Code a
genDefunc Defunc a
x)
genDefunc :: (?flags :: Opt.Flags) => Defunc a -> Code a
genDefunc :: forall a. (?flags::Flags) => Defunc a -> Code a
genDefunc (LAM Lam a
x) = forall a. (?flags::Flags) => Lam a -> Code a
normaliseGen Lam a
x
genDefunc Defunc a
BOTTOM = [||undefined||]
genDefunc INPUT{} = forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot materialise an input in the regular way"
pattern NormLam :: (?flags :: Opt.Flags) => Lam a -> Defunc a
pattern $mNormLam :: forall {r} {a}.
(?flags::Flags) =>
Defunc a -> (Lam a -> r) -> ((# #) -> r) -> r
NormLam t <- LAM (normalise -> t)
pattern FREEVAR :: (?flags :: Opt.Flags) => Code a -> Defunc a
pattern $bFREEVAR :: forall a. (?flags::Flags) => Code a -> Defunc a
$mFREEVAR :: forall {r} {a}.
(?flags::Flags) =>
Defunc a -> (Code a -> r) -> ((# #) -> r) -> r
FREEVAR v <- NormLam (Lam.Var True v)
where
FREEVAR Code a
v = forall a. Lam a -> Defunc a
LAM (forall a. Bool -> Code a -> Lam a
Lam.Var Bool
True Code a
v)
instance Show (Defunc a) where
show :: Defunc a -> [Char]
show (LAM Lam a
x) = forall a. Show a => a -> [Char]
show Lam a
x
show Defunc a
BOTTOM = [Char]
"[[irrelevant]]"
show (INPUT Input a
inp) = [Char]
"input " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall o. Input o -> Offset o
off Input a
inp)