{-# LANGUAGE ImplicitParams, PatternSynonyms, StandaloneKindSignatures, TypeApplications, ViewPatterns #-}
{-|
Module      : Parsley.Internal.Backend.Machine.Defunc
Description : Machine-level defunctionalisation
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the infrastructure and definitions of defunctionalised
terms used solely within the machine.

@since 1.0.0.0
-}
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

{-|
Machine level defunctionalisation, for terms that can only be introduced by
the code generator, and that do not require value level representations.

@since 1.4.0.0
-}
data Defunc a where
  {-|
  Wraps `Lam` terms so that they can be used within the machine.

  @since 1.1.0.0
  -}
  LAM     :: Lam a -> Defunc a
  {-|
  Represents Haskell's @undefined@, which may be used by high-level
  optimisers to replace redundant values whilst preserving the types.

  @since 1.0.0.0
  -}
  BOTTOM  :: Defunc a
  {-|
  Allows the static `Input`s to be pushed onto the operand stack, which
  is the easiest way to get them to persist as arguments to handlers, and
  interact with `Parsley.Internal.Backend.Machine.Instructions.Seek` and
  `Parsley.Internal.Backend.Machine.Instructions.Tell`.

  @since 1.8.0.0
  -}
  INPUT  :: Input o -> Defunc o

{-|
Promotes a @Defunc@ value from the Frontend API into a Backend one.

@since 1.1.0.0
-}
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

{-|
Applies a function to a value when both are `Defunc`.

@since 1.3.0.0
-}
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))

{-|
Applies a function to two values when all are `Defunc`.

@since 1.3.0.0
-}
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)

{-|
Acts as an @if@-expression lifted to the `Defunc` level.

@since 1.3.0.0
-}
_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)

{-|
Generate the Haskell code that represents this defunctionalised value.

@since 1.0.0.0
-}
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 that normalises a `Lam` before returning it.

@since 1.1.0.0
-}
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 that represents simple `Lam` variables,
post-normalisation.

@since 1.1.0.0
-}
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)