{-# LANGUAGE UnboxedTuples, MagicHash, RecordWildCards, TypeApplications #-}
{-|
Module      : Parsley.Internal.Backend.Machine.Types.Input
Description : Packaging of offsets and positions.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

Exposes abstractions for working with combined offset and position information. `Input` is used
for static augmented information, and `Input#` is a raw combination of the two components.

@since 1.8.0.0
-}
module Parsley.Internal.Backend.Machine.Types.Input (
    Input(off), Input#(..),
    mkInput, fromInput, toInput,
    forcePos, updatePos, updateOffset,
    chooseInput
  ) where

import Parsley.Internal.Backend.Machine.InputRep                  (StaRep, DynRep)
import Parsley.Internal.Backend.Machine.InputOps                  (DynOps, asSta, asDyn)
import Parsley.Internal.Backend.Machine.Types.Input.Offset        (Offset(offset), mkOffset, moveN)
import Parsley.Internal.Backend.Machine.Types.Input.Pos           (StaPos, DynPos, toDynPos, fromDynPos, fromStaPos, force, update)
import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
import Parsley.Internal.Common.Utils                              (Code)
import Parsley.Internal.Core.CharPred                             (CharPred)
import Parsley.Internal.Core.CombinatorAST                        (PosSelector)

{-|
Packages known static information about offsets (via `Offset`) with static information about positions
(currently unavailable).

@since 2.1.0.0
-}
data Input o = Input {
    -- | The offset contained within the input
    forall o. Input o -> Offset o
off :: {-# UNPACK #-} !(Offset o),
    -- | The position contained within the input
    forall o. Input o -> StaPos
pos :: {-# UNPACK #-} !StaPos
  }

{-|
Packages a dynamic offset with a dynamic position.

@since 1.8.0.0
-}
data Input# o = Input# {
    forall o. Input# o -> Code (DynRep o)
off#  :: !(Code (DynRep o)),
    forall o. Input# o -> DynPos
pos#  :: !DynPos
  }

{-|
Constructs an `Input` given a dynamic offset and a static position.

@since 2.1.0.0
-}
mkInput :: StaRep o -> (Word, Word) -> Input o
mkInput :: forall o. StaRep o -> (Word, Word) -> Input o
mkInput StaRep o
off = forall o. Offset o -> StaPos -> Input o
Input (forall o. StaRep o -> Word -> Offset o
mkOffset StaRep o
off Word
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word, Word) -> StaPos
fromStaPos

{-|
Strips away static information, returning the raw dynamic components.

@since 1.8.0.0
-}
fromInput :: forall o. DynOps o => Input o -> Input# o
fromInput :: forall o. DynOps o => Input o -> Input# o
fromInput Input{Offset o
StaPos
pos :: StaPos
off :: Offset o
pos :: forall o. Input o -> StaPos
off :: forall o. Input o -> Offset o
..} = forall o. Code (DynRep o) -> DynPos -> Input# o
Input# (forall input. DynOps input => StaRep input -> Code (DynRep input)
asDyn @o (forall o. Offset o -> StaRep o
offset Offset o
off)) (StaPos -> DynPos
toDynPos StaPos
pos)

{-|
Given a unique identifier, forms a plainly annotated static combination of position and offset.

@since 1.8.0.0
-}
toInput :: forall o. DynOps o => Word -> Input# o -> Input o
toInput :: forall o. DynOps o => Word -> Input# o -> Input o
toInput Word
u Input#{DynPos
Code (DynRep o)
pos# :: DynPos
off# :: Code (DynRep o)
pos# :: forall o. Input# o -> DynPos
off# :: forall o. Input# o -> Code (DynRep o)
..} = forall o. Offset o -> StaPos -> Input o
Input (forall o. StaRep o -> Word -> Offset o
mkOffset (forall input. DynOps input => Code (DynRep input) -> StaRep input
asSta @o Code (DynRep o)
off#) Word
u) (DynPos -> StaPos
fromDynPos DynPos
pos#)

updateOffset :: Offset o -> Input o -> Input o
updateOffset :: forall o. Offset o -> Input o -> Input o
updateOffset Offset o
off Input o
inp = Input o
inp { off :: Offset o
off = Offset o
off }

{-|
Collapse the position stored inside the input applying all updates to it. Once this has been completed,
the given `PosSelector` will be used to extract one of the line or column and return it to the given
continuation, along with the updated input post-collapse.

@since 2.1.0.0
-}
forcePos :: Input o -> PosSelector -> (Code Int -> Input o -> Code r) -> Code r
forcePos :: forall o r.
Input o -> PosSelector -> (Code Int -> Input o -> Code r) -> Code r
forcePos Input o
input PosSelector
sel Code Int -> Input o -> Code r
k = forall r.
StaPos -> PosSelector -> (Code Int -> StaPos -> Code r) -> Code r
force (forall o. Input o -> StaPos
pos Input o
input) PosSelector
sel (\Code Int
dp StaPos
sp -> Code Int -> Input o -> Code r
k Code Int
dp (Input o
input { pos :: StaPos
pos = StaPos
sp }))

{-|
Updates the position within the `Input` when a character has been consumed, providing it the
dynamic character that was produced as well as the static character-predicate that guarded it.

@since 2.1.0.0
-}
updatePos :: Input o -> Code Char -> CharPred -> Input o
updatePos :: forall o. Input o -> Code Char -> CharPred -> Input o
updatePos Input o
input Code Char
c CharPred
p = Input o
input { pos :: StaPos
pos = StaPos -> Code Char -> CharPred -> StaPos
update (forall o. Input o -> StaPos
pos Input o
input) Code Char
c CharPred
p }

{-|
Given knowledge about how input has been consumed through a call boundary, this function can update
the input using statically acquired knowledge.

@since 2.1.0.0
-}
-- TODO: In future, we could adjust InputCharacteristic to provide information about the static behaviours of the positions too...
chooseInput :: forall o. DynOps o => InputCharacteristic -> Word -> Input o -> Input# o -> Input o
chooseInput :: forall o.
DynOps o =>
InputCharacteristic -> Word -> Input o -> Input# o -> Input o
chooseInput (AlwaysConsumes (Just Word
n)) Word
_ Input o
inp  Input# o
inp#  = Input o
inp { off :: Offset o
off = forall o. Word -> Offset o -> StaRep o -> Offset o
moveN Word
n (forall o. Input o -> Offset o
off Input o
inp) (forall input. DynOps input => Code (DynRep input) -> StaRep input
asSta @o (forall o. Input# o -> Code (DynRep o)
off# Input# o
inp#)), pos :: StaPos
pos = DynPos -> StaPos
fromDynPos (forall o. Input# o -> DynPos
pos# Input# o
inp#) }
-- Technically, in this case, we know the whole input is unchanged. This essentially ignores the continuation arguments
-- hopefully GHC could optimise this better?
chooseInput InputCharacteristic
NeverConsumes      Word
_ Input o
inp  Input# o
_inp# = Input o
inp -- { off = (off inp) {offset = off# inp# }, pos = pos# inp# }
-- This is safer right now, since we never need information about input greater than another
chooseInput (AlwaysConsumes Maybe Word
Nothing) Word
u Input o
_inp Input# o
inp#  = forall o. DynOps o => Word -> Input# o -> Input o
toInput Word
u Input# o
inp#
chooseInput InputCharacteristic
MayConsume               Word
u Input o
_inp Input# o
inp#  = forall o. DynOps o => Word -> Input# o -> Input o
toInput Word
u Input# o
inp#