{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -Wno-deprecations #-} --FIXME: remove when Text16 is removed
{-# LANGUAGE AllowAmbiguousTypes,
             CPP,
             ConstraintKinds,
             FunctionalDependencies,
             ImplicitParams,
             MagicHash,
             RecordWildCards,
             TypeApplications,
             UnboxedTuples #-}
{-# LANGUAGE InstanceSigs #-}
{-|
Module      : Parsley.Internal.Backend.Machine.InputOps
Description : Primitive operations for working with input.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the primitive operations required by the
parsing machinery to work with input.

@since 1.0.0.0
-}
module Parsley.Internal.Backend.Machine.InputOps (
    InputPrep, PositionOps(..), LogOps(..), DynOps, asDyn, asSta,
    InputOps, next, check, uncons,
#if __GLASGOW_HASKELL__ <= 900
    word8ToWord#,
#endif
    prepare
  ) where

import Data.Array.Base                             (UArray(..){-, listArray-})
import Data.ByteString.Internal                    (ByteString(..))
import Data.Text.Internal                          (Text(..))
import Data.Text.Unsafe                            (iter, Iter(..))
import GHC.Exts                                    (Int(..), Char(..), TYPE, Int#)
import GHC.ForeignPtr                              (ForeignPtr(..))
import GHC.Prim                                    (indexWideCharArray#, readWord8OffAddr#, word2Int#, chr#, touch#, realWorld#, plusAddr#, (-#))
#if __GLASGOW_HASKELL__ > 900
import GHC.Prim                                    (word8ToWord#)
#else
import GHC.Prim                                    (Word#)
#endif
import Parsley.Internal.Backend.Machine.InputRep   (Stream(..), CharList(..), Text16(..), DynRep, StaRep, UnpackedLazyByteString,
                                                    StaText(..), PartialStaText(..), staText, PartialStaOffWith(..), staOffWith,
                                                    PartialStaOffset(..), dynOffset,
                                                    emptyUnpackedLazyByteString, intSame, intLess, intAdd, intSubNonNeg,
                                                    offWithShiftRight, dropStream,
                                                    textShiftRight, textShiftLeft, byteStringShiftRight, offsetText,
                                                    byteStringShiftLeft, byteStringNext)
import Parsley.Internal.Common.Utils               (Code)

import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))

#if __GLASGOW_HASKELL__ <= 900
{-# INLINE word8ToWord# #-}
word8ToWord# :: Word# -> Word#
word8ToWord# x = x
#endif

prepare :: InputPrep input => Code input -> ((?ops :: InputOps (StaRep input)) => StaRep input -> Code r) -> Code r
prepare :: forall input r.
InputPrep input =>
Code input
-> ((?ops::InputOps (StaRep input)) => StaRep input -> Code r)
-> Code r
prepare Code input
qinput (?ops::InputOps (StaRep input)) => StaRep input -> Code r
k = forall input starep r.
(InputPrep input, starep ~ StaRep input) =>
Code input -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code input
qinput (\InputOps (StaRep input)
_ops -> let ?ops = InputOps (StaRep input)
_ops in (?ops::InputOps (StaRep input)) => StaRep input -> Code r
k)

{- Typeclasses -}
{-|
This class is responsible for converting the user's input into a form that
parsley can work with efficiently.

@since 1.0.0.0
-}
class InputPrep input where
  {-|
  Given the user's input to the parser, in its original form, this function
  distils it first into @`Rep` input@, which is parsley's internal representation,
  and then produces an `InputDependant` containing the core operations.

  @since 1.0.0.0
  -}
  _prepare :: starep ~ StaRep input => Code input -> (InputOps starep -> starep -> Code r) -> Code r

{-|
Defines operations for manipulating offsets for regular use. These are not
tied to the original captured input but instead to the representation of its
offset.

@since 1.0.0.0
-}
class PositionOps rep where
  {-|
  Compares two "input"s for equality. In reality this usually means an offset
  present in the @rep@.

  @since 1.0.0.0
  -}
  same :: rep -> rep -> Code Bool

type DynOps o = DynOps_ (DynRep o) (StaRep o)

asDyn :: forall input. DynOps input => StaRep input -> Code (DynRep input)
asDyn :: forall input. DynOps input => StaRep input -> Code (DynRep input)
asDyn = forall dynrep starep.
DynOps_ dynrep starep =>
starep -> Code dynrep
_asDyn

asSta :: forall input. DynOps input => Code (DynRep input) -> StaRep input
asSta :: forall input. DynOps input => Code (DynRep input) -> StaRep input
asSta = forall dynrep starep.
DynOps_ dynrep starep =>
Code dynrep -> starep
_asSta

class DynOps_ (dynrep :: TYPE r) starep | dynrep -> starep, starep -> dynrep where
  _asDyn :: starep -> Code dynrep
  _asSta :: Code dynrep -> starep

{-|
Defines operation used for debugging operations.

@since 1.0.0.0
-}
class LogOps rep where
  {-|
  If possible, shifts the input back several characters.
  This is used to provide the previous input characters for the debugging combinator.

  @since 1.0.0.0
  -}
  shiftLeft :: rep -> Int -> (rep -> Code a) -> Code a

  {-|
  Advances the input by several characters at a time (existence not included).
  This can be used to check if characters exist at a future point in the input
  in conjunction with `more`.

  @since 2.3.0.0
  -}
  shiftRight :: rep -> Int -> (rep -> Code a) -> Code a

  {-|
  Converts the represention of the input into an @Int@.

  @since 1.0.0.0
  -}
  offToInt  :: rep -> Code Int

{-|
This is a psuedo-typeclass, which depends directly on the values obtained from
`prepare`. Because this instance may depend on local information, it is
synthesised and passed around using @ImplicitParams@.

@since 1.0.0.0
-}
data InputOps rep = InputOps { forall rep.
InputOps rep
-> forall a. rep -> (Code Char -> rep -> Code a) -> Code a
_next :: !(forall a. rep -> (Code Char -> rep -> Code a) -> Code a)              -- ^ Read the next character (without checking existence)
                             , forall rep.
InputOps rep
-> forall a.
   rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
_uncons :: !(forall a. rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)  -- ^ Read the next character, may check existence
                             , forall rep.
InputOps rep
-> forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a
_ensureN :: !(forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a)      -- ^ Ensure that n characters exist
                             , forall rep. InputOps rep -> Bool
_ensureNIsFast :: !Bool                                                                    -- ^ _ensureN is O(1) and not O(n)
                             }

checkImpl :: forall rep a. Bool                                        -- ^ is the ensureN argument O(1)?
          -> (Int -> rep -> (rep -> Code a) -> Code a -> Code a)       -- ^ ensures there are n characters available
          -> (rep -> (Code Char -> rep -> Code a) -> Code a -> Code a) -- ^ reads the next character if available
          -> (Int -> Int -> rep -> Maybe (Code Char -> Code a -> Code a) -> (rep -> [(Code Char, rep)] -> Code a) -> Code a -> Code a)
checkImpl :: forall rep a.
Bool
-> (Int -> rep -> (rep -> Code a) -> Code a -> Code a)
-> (rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)
-> Int
-> Int
-> rep
-> Maybe (Code Char -> Code a -> Code a)
-> (rep -> [(Code Char, rep)] -> Code a)
-> Code a
-> Code a
checkImpl Bool
fastEnsureN Int -> rep -> (rep -> Code a) -> Code a -> Code a
ensureN rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
uncons Int
n Int
m rep
qi Maybe (Code Char -> Code a -> Code a)
headCheck rep -> [(Code Char, rep)] -> Code a
good Code a
bad
  | Bool
fastEnsureN, Int
n forall a. Eq a => a -> a -> Bool
/= Int
0 = Int -> rep -> (rep -> Code a) -> Code a -> Code a
ensureN Int
n rep
qi (Int
-> Int
-> rep
-> ([(Code Char, rep)] -> [(Code Char, rep)])
-> Maybe (Code Char -> Code a -> Code a)
-> Maybe rep
-> Code a
go Int
n Int
m rep
qi forall a. a -> a
id Maybe (Code Char -> Code a -> Code a)
headCheck forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) Code a
bad
  | Bool
otherwise           = Int
-> Int
-> rep
-> ([(Code Char, rep)] -> [(Code Char, rep)])
-> Maybe (Code Char -> Code a -> Code a)
-> Maybe rep
-> Code a
go Int
n Int
m rep
qi forall a. a -> a
id Maybe (Code Char -> Code a -> Code a)
headCheck forall a. Maybe a
Nothing
  where
    go :: Int -> Int -> rep -> ([(Code Char, rep)] -> [(Code Char, rep)]) -> Maybe (Code Char -> Code a -> Code a) -> Maybe rep -> Code a
    go :: Int
-> Int
-> rep
-> ([(Code Char, rep)] -> [(Code Char, rep)])
-> Maybe (Code Char -> Code a -> Code a)
-> Maybe rep
-> Code a
go Int
0 Int
_ rep
qi [(Code Char, rep)] -> [(Code Char, rep)]
dcs Maybe (Code Char -> Code a -> Code a)
_ Maybe rep
_ = rep -> [(Code Char, rep)] -> Code a
good rep
qi ([(Code Char, rep)] -> [(Code Char, rep)]
dcs [])
    -- Here, we want no more cached characters, so just verify the remaining with shiftRight
    go Int
n Int
0 rep
qi [(Code Char, rep)] -> [(Code Char, rep)]
dcs Maybe (Code Char -> Code a -> Code a)
_ Maybe rep
Nothing = Int -> rep -> (rep -> Code a) -> Code a -> Code a
ensureN Int
n rep
qi (\rep
qi' -> rep -> [(Code Char, rep)] -> Code a
good rep
qi' ([(Code Char, rep)] -> [(Code Char, rep)]
dcs [])) Code a
bad
    -- We've already fastEnsured all the characters, so just feed forward the furthest to fill non-cached
    go Int
_ Int
0 rep
_ [(Code Char, rep)] -> [(Code Char, rep)]
dcs Maybe (Code Char -> Code a -> Code a)
_ (Just rep
furthest) = rep -> [(Code Char, rep)] -> Code a
good rep
furthest ([(Code Char, rep)] -> [(Code Char, rep)]
dcs [])
    -- Cached character wanted, so read it
    go Int
n Int
m rep
qi [(Code Char, rep)] -> [(Code Char, rep)]
dcs Maybe (Code Char -> Code a -> Code a)
headCheck Maybe rep
furthest = forall a b c. (a -> b -> c) -> b -> a -> c
flip (rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
uncons rep
qi) Code a
bad forall a b. (a -> b) -> a -> b
$ \Code Char
c rep
qi' ->
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. (a -> b) -> a -> b
$ Code Char
c) Maybe (Code Char -> Code a -> Code a)
headCheck forall a b. (a -> b) -> a -> b
$ -- if there is a headCheck available, perform it here DON'T pass it on
      Int
-> Int
-> rep
-> ([(Code Char, rep)] -> [(Code Char, rep)])
-> Maybe (Code Char -> Code a -> Code a)
-> Maybe rep
-> Code a
go (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int
m forall a. Num a => a -> a -> a
- Int
1) rep
qi' ([(Code Char, rep)] -> [(Code Char, rep)]
dcs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Code Char
c, rep
qi') forall a. a -> [a] -> [a]
:)) forall a. Maybe a
Nothing Maybe rep
furthest

{-|
Wraps around `InputOps` and `_next`.

Given some input and a continuation that accepts new input and a character, it will read
a character off (without checking that it exists!) and feeds it and the remaining input
to the continuation.

@since 1.0.0.0
-}
next :: forall rep a. (?ops :: InputOps rep) => rep -> (Code Char -> rep -> Code a) -> Code a
next :: forall rep a.
(?ops::InputOps rep) =>
rep -> (Code Char -> rep -> Code a) -> Code a
next = forall rep.
InputOps rep
-> forall a. rep -> (Code Char -> rep -> Code a) -> Code a
_next ?ops::InputOps rep
?ops

uncons :: forall rep a. (?ops :: InputOps rep) => rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
uncons :: forall rep a.
(?ops::InputOps rep) =>
rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
uncons = forall rep.
InputOps rep
-> forall a.
   rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
_uncons ?ops::InputOps rep
?ops

check :: forall rep a. (?ops :: InputOps rep) => Int -> Int -> rep -> Maybe (Code Char -> Code a -> Code a) -> (rep -> [(Code Char, rep)] -> Code a) -> Code a -> Code a
check :: forall rep a.
(?ops::InputOps rep) =>
Int
-> Int
-> rep
-> Maybe (Code Char -> Code a -> Code a)
-> (rep -> [(Code Char, rep)] -> Code a)
-> Code a
-> Code a
check = forall rep a.
Bool
-> (Int -> rep -> (rep -> Code a) -> Code a -> Code a)
-> (rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)
-> Int
-> Int
-> rep
-> Maybe (Code Char -> Code a -> Code a)
-> (rep -> [(Code Char, rep)] -> Code a)
-> Code a
-> Code a
checkImpl (forall rep. InputOps rep -> Bool
_ensureNIsFast ?ops::InputOps rep
?ops)
                  (forall rep.
InputOps rep
-> forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a
_ensureN ?ops::InputOps rep
?ops)
                  forall rep a.
(?ops::InputOps rep) =>
rep -> (Code Char -> rep -> Code a) -> Code a -> Code a
uncons

{- INSTANCES -}
-- InputPrep Instances
instance InputPrep String where
  _prepare :: forall starep r.
(starep ~ StaRep String) =>
Code String -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code String
qinput InputOps starep -> starep -> Code r
k =
    InputOps starep -> starep -> Code r
k (forall rep.
(forall a. rep -> (Code Char -> rep -> Code a) -> Code a)
-> (forall a.
    rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)
-> (forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a)
-> Bool
-> InputOps rep
InputOps (\starep
pocs Code Char -> starep -> Code a
k -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po Code String
qcs -> [|| let c:cs' = $$qcs in $$(k [||c||] (StaOW (intAdd po 1) [||cs'||])) ||])
                (\starep
pocs Code Char -> starep -> Code a
good Code a
bad -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po Code String
qcs -> [||
                      case $$qcs of
                        c : cs' -> $$(good [||c||] (StaOW (intAdd po 1) [||cs'||]))
                        []     -> $$bad
                    ||])
                (\Int
n starep
pocs starep -> Code a
good Code a
bad -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code String
qcs -> let (PartialStaOffset
qo', Code String
qcs') = forall ts.
Code (Int -> ts -> ts)
-> PartialStaOffset
-> Code ts
-> Int
-> (PartialStaOffset, Code ts)
offWithShiftRight [||drop||] PartialStaOffset
qo Code String
qcs (Int
n forall a. Num a => a -> a -> a
- Int
1) in [||
                      case $$qcs' of
                        [] -> $$bad
                        cs -> $$(good (StaOW qo' [||cs||]))
                    ||])
                Bool
False)
      (forall ts. PartialStaOffset -> Code ts -> PartialStaOffWith ts
StaOW (forall dynrep starep.
DynOps_ dynrep starep =>
Code dynrep -> starep
_asSta [||0#||]) Code String
qinput)

instance InputPrep ByteString where
  _prepare :: forall starep r.
(starep ~ StaRep ByteString) =>
Code ByteString -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code ByteString
qinput InputOps starep -> starep -> Code r
k = [||
      let PS (ForeignPtr addr# final) (I# off#) (I# size#) = $$qinput
          next i# =
            case readWord8OffAddr# (addr# `plusAddr#` i#) 0# realWorld# of
              (# s', x #) -> case touch# final s' of
                !_ -> chr# (word2Int# (word8ToWord# x))
      in $$(k (InputOps (\qi k -> [|| let !c# = next $$(dynOffset qi) in $$(k [||C# c#||] (intAdd qi 1)) ||])
                        (\qi k _ -> [|| let !c# = next $$(dynOffset qi) in $$(k [||C# c#||] (intAdd qi 1)) ||]) -- always guarded by fastEnsureN
                        (\n qi k -> intLess (dynOffset (intAdd qi (n - 1))) [||size#||] (k qi))
                        True)
              (_asSta [||off#||]))
    ||]

instance InputPrep Text where
  _prepare :: forall starep r.
(starep ~ StaRep Text) =>
Code Text -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code Text
qinput InputOps starep -> starep -> Code r
k =
    InputOps starep -> starep -> Code r
k (forall rep.
(forall a. rep -> (Code Char -> rep -> Code a) -> Code a)
-> (forall a.
    rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)
-> (forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a)
-> Bool
-> InputOps rep
InputOps (\starep
pt Code Char -> starep -> Code a
k -> forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText starep
pt forall a b. (a -> b) -> a -> b
$ \t :: StaText
t@StaText{Code Int
Code Text
Code Array
unconsumedText :: StaText -> Code Int
offText :: StaText -> Code Int
arrText :: StaText -> Code Array
origText :: StaText -> Code Text
unconsumedText :: Code Int
offText :: Code Int
arrText :: Code Array
origText :: Code Text
..} -> [||
                    let !(Iter c d) = iter $$origText 0
                        !unconsumed' = $$unconsumedText - d
                        !off'        = $$offText + d
                    in $$(k [||c||] (StaT $ t {origText = [||Text $$arrText off' unconsumed'||],
                                               offText = [||off'||],
                                               unconsumedText = [||unconsumed'||]})) ||])
                (\starep
pt Code Char -> starep -> Code a
good Code a
bad -> forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText starep
pt forall a b. (a -> b) -> a -> b
$ \t :: StaText
t@StaText{Code Int
Code Text
Code Array
unconsumedText :: Code Int
offText :: Code Int
arrText :: Code Array
origText :: Code Text
unconsumedText :: StaText -> Code Int
offText :: StaText -> Code Int
arrText :: StaText -> Code Array
origText :: StaText -> Code Text
..} -> [||
                    if $$unconsumedText > 0 then
                      let !(Iter c d) = iter $$origText 0
                          !unconsumed' = $$unconsumedText - d
                          !off'        = $$offText + d
                      in $$(good [||c||] (StaT $ t {origText = [||Text $$arrText off' unconsumed'||],
                                                    offText = [||off'||],
                                                    unconsumedText = [||unconsumed'||]}))
                    else $$bad
                  ||])
                (\(I# Int#
n) starep
pt starep -> Code a
good Code a
bad -> forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText starep
pt forall a b. (a -> b) -> a -> b
$ \StaText{Code Int
Code Text
Code Array
unconsumedText :: Code Int
offText :: Code Int
arrText :: Code Array
origText :: Code Text
unconsumedText :: StaText -> Code Int
offText :: StaText -> Code Int
arrText :: StaText -> Code Array
origText :: StaText -> Code Text
..} -> [|| -- could be improved, I guess?
                    case $$(textShiftRight origText (n -# 1#)) of
                      Text _ _ 0                -> $$bad
                      t@(Text _ off unconsumed) -> $$(good (StaT $ StaText [||t||] arrText [||off||] [||unconsumed||]))
                  ||])
                Bool
False)
      (Code Text -> PartialStaText
DynT Code Text
qinput)

--instance InputPrep String where _prepare input = _prepare @(UArray Int Char) [||listArray (0, length $$input-1) $$input||]
instance InputPrep (UArray Int Char) where
  _prepare :: forall starep r.
(starep ~ StaRep (UArray Int Char)) =>
Code (UArray Int Char)
-> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code (UArray Int Char)
qinput InputOps starep -> starep -> Code r
k = [||
      let !(UArray _ _ (I# size#) input#) = $$qinput
      in $$(k (InputOps (\qi k -> k [||C# (indexWideCharArray# input# $$(dynOffset qi))||] (intAdd qi 1))
                        (\qi k _ -> k [||C# (indexWideCharArray# input# $$(dynOffset qi))||] (intAdd qi 1)) -- always guarded by fastEnsureN
                        (\n qi k -> intLess (dynOffset (intAdd qi (n - 1))) [||size#||] (k qi))
                        True)
              (_asSta [||0#||]))
    ||]

instance InputPrep Lazy.ByteString where
  _prepare :: forall starep r.
(starep ~ StaRep ByteString) =>
Code ByteString -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code ByteString
qinput InputOps starep -> starep -> Code r
k = [||
      let initial :: UnpackedLazyByteString
          initial = case $$qinput of
            Lazy.Chunk (PS (ForeignPtr addr# final) (I# off#) (I# size#)) cs -> (# 0#, addr#, final, off#, size#, cs #)
            Lazy.Empty -> $$(emptyUnpackedLazyByteString [||0#||])
      in $$(k (InputOps (\qi k -> [|| let !(# c, qi' #) = byteStringNext $$qi in $$(k [||c||] [||qi'||]) ||])
                        (\qi good bad -> [||
                            case $$qi of
                              (# _, _, _, _, 0#, _ #) -> $$bad
                              bs                      ->
                                let !(# c, qi' #) = byteStringNext bs in $$(good [||c||] [||qi'||])
                          ||])
                        (\(I# n) qi good bad -> [||
                            case $$(byteStringShiftRight qi (n -# 1#)) of
                              (# _, _, _, _, 0#, _ #) -> $$bad
                              bs                      -> $$(good [||bs||])
                          ||])
                        False)
              [||initial||])
    ||]

instance InputPrep Stream where
  _prepare :: forall starep r.
(starep ~ StaRep Stream) =>
Code Stream -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code Stream
qinput InputOps starep -> starep -> Code r
k =
    InputOps starep -> starep -> Code r
k (forall rep.
(forall a. rep -> (Code Char -> rep -> Code a) -> Code a)
-> (forall a.
    rep -> (Code Char -> rep -> Code a) -> Code a -> Code a)
-> (forall a. Int -> rep -> (rep -> Code a) -> Code a -> Code a)
-> Bool
-> InputOps rep
InputOps (\starep
pocs Code Char -> starep -> Code a
k -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po Code Stream
qcs -> [|| let c :> cs' = $$qcs in $$(k [||c||] (StaOW (intAdd po 1) [||cs'||])) ||])
                (\starep
pocs Code Char -> starep -> Code a
k Code a
_ -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po Code Stream
qcs -> [|| let c :> cs' = $$qcs in $$(k [||c||] (StaOW (intAdd po 1) [||cs'||])) ||])
                (\Int
n starep
pocs starep -> Code a
good Code a
_ -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith starep
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code Stream
qcs -> starep -> Code a
good (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall ts. PartialStaOffset -> Code ts -> PartialStaOffWith ts
StaOW forall a b. (a -> b) -> a -> b
$ forall ts.
Code (Int -> ts -> ts)
-> PartialStaOffset
-> Code ts
-> Int
-> (PartialStaOffset, Code ts)
offWithShiftRight [||dropStream||] PartialStaOffset
qo Code Stream
qcs (Int
n forall a. Num a => a -> a -> a
- Int
1)))
                Bool
True)
      (forall ts. PartialStaOffset -> Code ts -> PartialStaOffWith ts
StaOW (forall dynrep starep.
DynOps_ dynrep starep =>
Code dynrep -> starep
_asSta [||0#||]) Code Stream
qinput)


instance InputPrep Text16 where _prepare :: forall starep r.
(starep ~ StaRep Text16) =>
Code Text16 -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code Text16
qinput = forall input starep r.
(InputPrep input, starep ~ StaRep input) =>
Code input -> (InputOps starep -> starep -> Code r) -> Code r
_prepare @Text [|| let Text16 t = $$qinput in t ||]
instance InputPrep CharList where _prepare :: forall starep r.
(starep ~ StaRep CharList) =>
Code CharList -> (InputOps starep -> starep -> Code r) -> Code r
_prepare Code CharList
qinput = forall input starep r.
(InputPrep input, starep ~ StaRep input) =>
Code input -> (InputOps starep -> starep -> Code r) -> Code r
_prepare @String [|| let CharList cs = $$qinput in cs ||]

-- PositionOps Instances
instance PositionOps PartialStaOffset where same :: PartialStaOffset -> PartialStaOffset -> Code Bool
same PartialStaOffset
po (StaO Code Int#
qo' Int
n) = Code Int# -> Code Int# -> Code Bool
intSame (PartialStaOffset -> Code Int#
dynOffset (PartialStaOffset -> Int -> PartialStaOffset
intAdd PartialStaOffset
po (forall a. Num a => a -> a
negate Int
n))) Code Int#
qo'
instance PositionOps (PartialStaOffWith ts) where
  same :: PartialStaOffWith ts -> PartialStaOffWith ts -> Code Bool
same PartialStaOffWith ts
pocs1 PartialStaOffWith ts
pocs2 = forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith ts
pocs1 forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po Code ts
_ -> forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith ts
pocs2 forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
po' Code ts
_ -> forall rep. PositionOps rep => rep -> rep -> Code Bool
same PartialStaOffset
po PartialStaOffset
po'
--instance PositionOps (Code Int#, Code Stream) where same = offWithSame
instance PositionOps PartialStaText where
  same :: PartialStaText -> PartialStaText -> Code Bool
same PartialStaText
pt1 PartialStaText
pt2 = forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText PartialStaText
pt1 forall a b. (a -> b) -> a -> b
$ \StaText
qt1 -> forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText PartialStaText
pt2 forall a b. (a -> b) -> a -> b
$ \StaText
qt2 -> [||$$(offText qt1) == $$(offText qt2)||]
instance PositionOps (Code UnpackedLazyByteString) where
  same :: Code UnpackedLazyByteString
-> Code UnpackedLazyByteString -> Code Bool
same Code UnpackedLazyByteString
qx# Code UnpackedLazyByteString
qy# = [||
      case $$(qx#) of
        (# i#, _, _, _, _, _ #) -> case $$(qy#) of
          (# j#, _, _, _, _, _ #) -> $$(intSame [||i#||] [||j#||])
    ||]

-- DynOps Instances
instance DynOps_ Int# PartialStaOffset where
  _asDyn :: PartialStaOffset -> Code Int#
_asDyn = PartialStaOffset -> Code Int#
dynOffset
  _asSta :: Code Int# -> PartialStaOffset
_asSta = forall a b c. (a -> b -> c) -> b -> a -> c
flip Code Int# -> Int -> PartialStaOffset
StaO Int
0

instance DynOps_ (# Int#, ts #) (PartialStaOffWith ts) where
  _asDyn :: PartialStaOffWith ts -> Code (# Int#, ts #)
_asDyn (StaOW PartialStaOffset
qo Code ts
qcs) = [||(# $$(dynOffset qo), $$qcs #)||]
  _asDyn (DynOW Code (# Int#, ts #)
qocs) = Code (# Int#, ts #)
qocs
  _asSta :: Code (# Int#, ts #) -> PartialStaOffWith ts
_asSta = forall ts. Code (# Int#, ts #) -> PartialStaOffWith ts
DynOW

instance DynOps_ Text PartialStaText where
  _asDyn :: PartialStaText -> Code Text
_asDyn (StaT StaText
t) = StaText -> Code Text
origText StaText
t
  _asDyn (DynT Code Text
t) = Code Text
t
  _asSta :: Code Text -> PartialStaText
_asSta = Code Text -> PartialStaText
DynT

instance DynOps_ UnpackedLazyByteString (Code UnpackedLazyByteString) where
  _asDyn :: Code UnpackedLazyByteString -> Code UnpackedLazyByteString
_asDyn = forall a. a -> a
id
  _asSta :: Code UnpackedLazyByteString -> Code UnpackedLazyByteString
_asSta = forall a. a -> a
id

-- LogOps Instances
instance LogOps PartialStaOffset where
  shiftLeft :: forall a.
PartialStaOffset -> Int -> (PartialStaOffset -> Code a) -> Code a
shiftLeft PartialStaOffset
po Int
n PartialStaOffset -> Code a
k = PartialStaOffset -> Code a
k (PartialStaOffset -> Int -> PartialStaOffset
intSubNonNeg PartialStaOffset
po Int
n)
  shiftRight :: forall a.
PartialStaOffset -> Int -> (PartialStaOffset -> Code a) -> Code a
shiftRight PartialStaOffset
po Int
n PartialStaOffset -> Code a
k = PartialStaOffset -> Code a
k (PartialStaOffset -> Int -> PartialStaOffset
intAdd PartialStaOffset
po Int
n)
  offToInt :: PartialStaOffset -> Code Int
offToInt PartialStaOffset
pi = [||I# $$(dynOffset pi)||]

instance LogOps (PartialStaOffWith String) where
  shiftLeft :: forall a.
PartialStaOffWith String
-> Int -> (PartialStaOffWith String -> Code a) -> Code a
shiftLeft PartialStaOffWith String
pocs Int
_ PartialStaOffWith String -> Code a
k = PartialStaOffWith String -> Code a
k PartialStaOffWith String
pocs
  shiftRight :: forall a.
PartialStaOffWith String
-> Int -> (PartialStaOffWith String -> Code a) -> Code a
shiftRight PartialStaOffWith String
pocs Int
n PartialStaOffWith String -> Code a
k = forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith String
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code String
qcs -> PartialStaOffWith String -> Code a
k (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall ts. PartialStaOffset -> Code ts -> PartialStaOffWith ts
StaOW forall a b. (a -> b) -> a -> b
$ forall ts.
Code (Int -> ts -> ts)
-> PartialStaOffset
-> Code ts
-> Int
-> (PartialStaOffset, Code ts)
offWithShiftRight [||drop||] PartialStaOffset
qo Code String
qcs Int
n)
  offToInt :: PartialStaOffWith String -> Code Int
offToInt PartialStaOffWith String
pocs = forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith String
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code String
_ -> [||I# $$(dynOffset qo)||]

instance LogOps (PartialStaOffWith Stream) where
  shiftLeft :: forall a.
PartialStaOffWith Stream
-> Int -> (PartialStaOffWith Stream -> Code a) -> Code a
shiftLeft PartialStaOffWith Stream
pocs Int
_ PartialStaOffWith Stream -> Code a
k = PartialStaOffWith Stream -> Code a
k PartialStaOffWith Stream
pocs
  shiftRight :: forall a.
PartialStaOffWith Stream
-> Int -> (PartialStaOffWith Stream -> Code a) -> Code a
shiftRight PartialStaOffWith Stream
pocs Int
n PartialStaOffWith Stream -> Code a
k = forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith Stream
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code Stream
qcs -> PartialStaOffWith Stream -> Code a
k (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall ts. PartialStaOffset -> Code ts -> PartialStaOffWith ts
StaOW forall a b. (a -> b) -> a -> b
$ forall ts.
Code (Int -> ts -> ts)
-> PartialStaOffset
-> Code ts
-> Int
-> (PartialStaOffset, Code ts)
offWithShiftRight [||dropStream||] PartialStaOffset
qo Code Stream
qcs Int
n)
  offToInt :: PartialStaOffWith Stream -> Code Int
offToInt PartialStaOffWith Stream
pocs = forall ts a.
PartialStaOffWith ts
-> (PartialStaOffset -> Code ts -> Code a) -> Code a
staOffWith PartialStaOffWith Stream
pocs forall a b. (a -> b) -> a -> b
$ \PartialStaOffset
qo Code Stream
_ -> [||I# $$(dynOffset qo)||]

instance LogOps PartialStaText where
  shiftLeft :: forall a.
PartialStaText -> Int -> (PartialStaText -> Code a) -> Code a
shiftLeft PartialStaText
pt (I# Int#
qi#) PartialStaText -> Code a
k = forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText PartialStaText
pt forall a b. (a -> b) -> a -> b
$ \StaText{Code Int
Code Text
Code Array
unconsumedText :: Code Int
offText :: Code Int
arrText :: Code Array
origText :: Code Text
unconsumedText :: StaText -> Code Int
offText :: StaText -> Code Int
arrText :: StaText -> Code Array
origText :: StaText -> Code Text
..} -> PartialStaText -> Code a
k (Code Text -> PartialStaText
DynT (Code Text -> Int# -> Code Text
textShiftLeft Code Text
origText Int#
qi#))
  shiftRight :: forall a.
PartialStaText -> Int -> (PartialStaText -> Code a) -> Code a
shiftRight PartialStaText
pt (I# Int#
n#) PartialStaText -> Code a
k = forall a. PartialStaText -> (StaText -> Code a) -> Code a
staText PartialStaText
pt forall a b. (a -> b) -> a -> b
$ \StaText{Code Int
Code Text
Code Array
unconsumedText :: Code Int
offText :: Code Int
arrText :: Code Array
origText :: Code Text
unconsumedText :: StaText -> Code Int
offText :: StaText -> Code Int
arrText :: StaText -> Code Array
origText :: StaText -> Code Text
..} -> PartialStaText -> Code a
k (Code Text -> PartialStaText
DynT (Code Text -> Int# -> Code Text
textShiftRight Code Text
origText Int#
n#))
  offToInt :: PartialStaText -> Code Int
offToInt = PartialStaText -> Code Int
offsetText

instance LogOps (Code UnpackedLazyByteString) where
  shiftLeft :: forall a.
Code UnpackedLazyByteString
-> Int -> (Code UnpackedLazyByteString -> Code a) -> Code a
shiftLeft Code UnpackedLazyByteString
qo# (I# Int#
qi#) Code UnpackedLazyByteString -> Code a
k = Code UnpackedLazyByteString -> Code a
k (Code UnpackedLazyByteString -> Int# -> Code UnpackedLazyByteString
byteStringShiftLeft Code UnpackedLazyByteString
qo# Int#
qi#)
  shiftRight :: forall a.
Code UnpackedLazyByteString
-> Int -> (Code UnpackedLazyByteString -> Code a) -> Code a
shiftRight Code UnpackedLazyByteString
qo# (I# Int#
qi#) Code UnpackedLazyByteString -> Code a
k = Code UnpackedLazyByteString -> Code a
k (Code UnpackedLazyByteString -> Int# -> Code UnpackedLazyByteString
byteStringShiftRight Code UnpackedLazyByteString
qo# Int#
qi#)
  offToInt :: Code UnpackedLazyByteString -> Code Int
offToInt Code UnpackedLazyByteString
qo# = [||case $$(qo#) of (# i#, _, _, _, _, _ #) -> I# i# ||]