{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP,
             MagicHash,
             TypeFamilies,
             UnboxedTuples,
             StandaloneKindSignatures #-}
{-|
Module      : Parsley.Internal.Backend.Machine.InputRep
Description : Internal representations of input and miscellaneous operations.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the translation from user input type to the
underlying parsley representation of it, as well as some miscellaneous
functions for working with specific types of input (these do not appear
in the rest of the machinery, but in "Parsley.Internal.Backend.Machine.InputOps"
and potentially the generated code).

@since 1.0.0.0
-}
module Parsley.Internal.Backend.Machine.InputRep (
    -- * Representation Type-Families
    Rep, RepKind,
    -- * @Int#@ Operations
    intSame, intLess, min#, max#,
    -- * @Offwith@ Operations
    OffWith, offWith, offWithSame, offWithShiftRight,
    --OffWithStreamAnd(..),
    -- * @LazyByteString@ Operations
    UnpackedLazyByteString, emptyUnpackedLazyByteString,
    -- * @Stream@ Operations
    dropStream,
    -- * @Text@ Operations
    offsetText,
    -- * Crucial Exposed Functions
    {- |
    These functions must be exposed, since they can appear
    in the generated code.
    -}
    textShiftRight, textShiftLeft,
    byteStringShiftRight, byteStringShiftLeft,
    -- * Re-exports
    module Parsley.Internal.Core.InputTypes
  ) where

import Data.Array.Unboxed                (UArray)
import Data.ByteString.Internal          (ByteString(..))
import Data.Kind                         (Type)
import Data.Text.Internal                (Text(..))
import Data.Text.Unsafe                  (iter_, reverseIter_)
import GHC.Exts                          (Int(..), TYPE, RuntimeRep(..), (==#), (<#), (+#), (-#), isTrue#)
#if __GLASGOW_HASKELL__ > 900
import GHC.Exts                          (LiftedRep)
#endif
import GHC.ForeignPtr                    (ForeignPtr(..), ForeignPtrContents)
import GHC.Prim                          (Int#, Addr#, nullAddr#)
import Parsley.Internal.Common.Utils     (Code)
import Parsley.Internal.Core.InputTypes  (Text16(..), CharList(..), Stream(..))

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

{- Representation Types -}
{-|
This allows types like @String@ and @Stream@ to be manipulated
more efficiently by packaging them along with an offset which can
be used for quicker comparisons.

@since 1.0.0.0
-}
type OffWith ts = (# Int#, ts #)

--data OffWithStreamAnd ts = OffWithStreamAnd {-# UNPACK #-} !Int !Stream ts

{-|
This type unpacks /lazy/ `Lazy.ByteString`s for efficiency.

@since 1.0.0.0
-}
type UnpackedLazyByteString = (#
    Int#,
    Addr#,
    ForeignPtrContents,
    Int#,
    Int#,
    Lazy.ByteString
  #)

{-|
Initialises an `OffWith` type, with a starting offset of @0@.

@since 1.0.0.0
-}
offWith :: Code ts -> Code (OffWith ts)
offWith :: Code ts -> Code (OffWith ts)
offWith Code ts
qts = [||(# 0#, $$qts #)||]

{-|
Initialises an `UnpackedLazyByteString` with a specified offset.
This offset varies as each lazy chunk is consumed.

@since 1.0.0.0
-}
emptyUnpackedLazyByteString :: Code Int# -> Code UnpackedLazyByteString
emptyUnpackedLazyByteString :: Code Int# -> Code UnpackedLazyByteString
emptyUnpackedLazyByteString Code Int#
qi# = [|| (# $$(qi#), nullAddr#, error "nullForeignPtr", 0#, 0#, Lazy.Empty #) ||]

{- Representation Mappings -}
-- NOTE: When a new input type is added here, it needs an Input instance in Parsley.Backend.Machine
{-|
The representation type of an input `Rep`, does not have to be a lifted type. To match a
representation of an input with the correct kind, this type family must be used.

@since 1.0.0.0
-}
type RepKind :: Type -> RuntimeRep
type family RepKind input where
  RepKind [Char] = IntRep
  RepKind (UArray Int Char) = IntRep
  RepKind Text16 = IntRep
  RepKind ByteString = IntRep
  RepKind Text = LiftedRep
  RepKind Lazy.ByteString = 'TupleRep '[IntRep, AddrRep, LiftedRep, IntRep, IntRep, LiftedRep]
  RepKind CharList = 'TupleRep '[IntRep, LiftedRep]
  RepKind Stream = 'TupleRep '[IntRep, LiftedRep]
  --RepKind (OffWithStreamAnd _) = 'TupleRep '[IntRep, LiftedRep, LiftedRep] --REMOVE
  --RepKind (Text, Stream) = 'TupleRep '[LiftedRep, LiftedRep] --REMOVE

{-|
This type family relates a user input type with the underlying parsley
representation, which is significantly more efficient to work with.
Most parts of the machine work with `Rep`.

@since 1.0.0.0
-}
type Rep :: forall (rep :: Type) -> TYPE (RepKind rep)
type family Rep input where
  Rep [Char] = Int#
  Rep (UArray Int Char) = Int#
  Rep Text16 = Int#
  Rep ByteString = Int#
  Rep Text = Text
  Rep Lazy.ByteString = UnpackedLazyByteString
  Rep CharList = (# Int#, String #)
  Rep Stream = (# Int#, Stream #)
  --Rep (OffWithStreamAnd ts) = (# Int#, Stream, ts #)
  --Rep (Text, Stream) = (# Text, Stream #)

{- Generic Representation Operations -}
{-|
Verifies that two `Int#`s are equal.

@since 1.0.0.0
-}
intSame :: Code Int# -> Code Int# -> Code Bool
intSame :: Code Int# -> Code Int# -> Code Bool
intSame Code Int#
qi# Code Int#
qj# = [||isTrue# ($$(qi#) ==# $$(qj#))||]

{-|
Is the first argument is less than the second?

@since 1.0.0.0
-}
intLess :: Code Int# -> Code Int# -> Code Bool
intLess :: Code Int# -> Code Int# -> Code Bool
intLess Code Int#
qi# Code Int#
qj# = [||isTrue# ($$(qi#) <# $$(qj#))||]

{-|
Extracts the offset from `Text`.

@since 1.0.0.0
-}
offsetText :: Code Text -> Code Int
offsetText :: Code Text -> Code Int
offsetText Code Text
qt = [||case $$qt of Text _ off _ -> off||]

{-|
Compares the bundled offsets of two `OffWith`s are equal: does not
need to inspect the corresponding input.

@since 1.0.0.0
-}
offWithSame :: Code (OffWith ts) -> Code (OffWith ts) -> Code Bool
offWithSame :: Code (OffWith ts) -> Code (OffWith ts) -> Code Bool
offWithSame Code (OffWith ts)
qi# Code (OffWith ts)
qj# = [||
    case $$(qi#) of
      (# i#, _ #) -> case $$(qj#) of
        (# j#, _ #) -> $$(intSame [||i#||] [||j#||])
  ||]

{-|
Shifts an `OffWith` to the right, taking care to also drop tokens from the
companion input.

@since 1.0.0.0
-}
offWithShiftRight :: Code (Int -> ts -> ts) -- ^ A @drop@ function for underlying input.
                  -> Code (OffWith ts)      -- ^ The `OffWith` to shift.
                  -> Code Int#              -- ^ How much to shift by.
                  -> Code (OffWith ts)
offWithShiftRight :: Code (Int -> ts -> ts)
-> Code (OffWith ts) -> Code Int# -> Code (OffWith ts)
offWithShiftRight Code (Int -> ts -> ts)
drop Code (OffWith ts)
qo# Code Int#
qi# = [||
    case $$(qo#) of (# o#, ts #) -> (# o# +# $$(qi#), $$drop (I# $$(qi#)) ts #)
  ||]

{-offWithStreamAnd :: ts -> OffWithStreamAnd ts
offWithStreamAnd ts = OffWithStreamAnd 0 nomore ts

offWithStreamAndToInt :: OffWithStreamAnd ts -> Int
offWithStreamAndToInt (OffWithStreamAnd i _ _) = i-}

{-|
Drops tokens off of a `Stream`.

@since 1.0.0.0
-}
dropStream :: Int -> Stream -> Stream
dropStream :: Int -> Stream -> Stream
dropStream Int
0 Stream
cs = Stream
cs
dropStream Int
n (Char
_ :> Stream
cs) = Int -> Stream -> Stream
dropStream (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Stream
cs

{-|
Drops tokens off of `Text`.

@since 1.0.0.0
-}
textShiftRight :: Text -> Int -> Text
textShiftRight :: Text -> Int -> Text
textShiftRight (Text Array
arr Int
off Int
unconsumed) Int
i = Int -> Int -> Int -> Text
go Int
i Int
off Int
unconsumed
  where
    go :: Int -> Int -> Int -> Text
go Int
0 Int
off' Int
unconsumed' = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
    go Int
n Int
off' Int
unconsumed'
      | Int
unconsumed' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let !d :: Int
d = Text -> Int -> Int
iter_ (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed') Int
0
                          in Int -> Int -> Int -> Text
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Int
unconsumed' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
      | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'

{-|
Rewinds input consumption on `Text` where the input is still available (i.e. in the same chunk).

@since 1.0.0.0
-}
textShiftLeft :: Text -> Int -> Text
textShiftLeft :: Text -> Int -> Text
textShiftLeft (Text Array
arr Int
off Int
unconsumed) Int
i = Int -> Int -> Int -> Text
go Int
i Int
off Int
unconsumed
  where
    go :: Int -> Int -> Int -> Text
go Int
0 Int
off' Int
unconsumed' = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'
    go Int
n Int
off' Int
unconsumed'
      | Int
off' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = let !d :: Int
d = Text -> Int -> Int
reverseIter_ (Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed') Int
0 in Int -> Int -> Int -> Text
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
off' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) (Int
unconsumed' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
      | Bool
otherwise = Array -> Int -> Int -> Text
Text Array
arr Int
off' Int
unconsumed'

{-# INLINE emptyUnpackedLazyByteString' #-}
emptyUnpackedLazyByteString' :: Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' :: Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' Int#
i# = (# Int#
i#, Addr#
nullAddr#, [Char] -> ForeignPtrContents
forall a. HasCallStack => [Char] -> a
error [Char]
"nullForeignPtr", Int#
0#, Int#
0#, ByteString
Lazy.Empty #)

{-|
Drops tokens off of a lazy `Lazy.ByteString`.

@since 1.0.0.0
-}
byteStringShiftRight :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight (# Int#
i#, Addr#
addr#, ForeignPtrContents
final, Int#
off#, Int#
size#, ByteString
cs #) Int#
j#
  | Int# -> Bool
isTrue# (Int#
j# Int# -> Int# -> Int#
<# Int#
size#)  = (# Int#
i# Int# -> Int# -> Int#
+# Int#
j#, Addr#
addr#, ForeignPtrContents
final, Int#
off# Int# -> Int# -> Int#
+# Int#
j#, Int#
size# Int# -> Int# -> Int#
-# Int#
j#, ByteString
cs #)
  | Bool
otherwise = case ByteString
cs of
    Lazy.Chunk (PS (ForeignPtr Addr#
addr'# ForeignPtrContents
final') (I# Int#
off'#) (I# Int#
size'#)) ByteString
cs' -> UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftRight (# Int#
i# Int# -> Int# -> Int#
+# Int#
size#, Addr#
addr'#, ForeignPtrContents
final', Int#
off'#, Int#
size'#, ByteString
cs' #) (Int#
j# Int# -> Int# -> Int#
-# Int#
size#)
    ByteString
Lazy.Empty -> Int# -> UnpackedLazyByteString
emptyUnpackedLazyByteString' (Int#
i# Int# -> Int# -> Int#
+# Int#
size#)

{-|
Rewinds input consumption on a lazy `Lazy.ByteString` if input is still available (within the same chunk).

@since 1.0.0.0
-}
byteStringShiftLeft :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftLeft :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
byteStringShiftLeft (# Int#
i#, Addr#
addr#, ForeignPtrContents
final, Int#
off#, Int#
size#, ByteString
cs #) Int#
j# =
  let d# :: Int#
d# = Int# -> Int# -> Int#
min# Int#
off# Int#
j#
  in (# Int#
i# Int# -> Int# -> Int#
-# Int#
d#, Addr#
addr#, ForeignPtrContents
final, Int#
off# Int# -> Int# -> Int#
-# Int#
d#, Int#
size# Int# -> Int# -> Int#
+# Int#
d#, ByteString
cs #)

{-|
Finds the minimum of two `Int#` values.

@since 1.0.0.0
-}
min# :: Int# -> Int# -> Int#
min# :: Int# -> Int# -> Int#
min# Int#
i# Int#
j# = case Int#
i# Int# -> Int# -> Int#
<# Int#
j# of
  Int#
0# -> Int#
j#
  Int#
_  -> Int#
i#

{-|
Finds the maximum of two `Int#` values.

@since 1.0.0.0
-}
max# :: Int# -> Int# -> Int#
max# :: Int# -> Int# -> Int#
max# Int#
i# Int#
j# = case Int#
i# Int# -> Int# -> Int#
<# Int#
j# of
  Int#
0# -> Int#
i#
  Int#
_  -> Int#
j#