{-# LANGUAGE MagicHash,
             TypeFamilies,
             UnboxedTuples,
             StandaloneKindSignatures #-}
module Parsley.Internal.Backend.Machine.InputRep (
    Rep, RepKind,
    intSame, intLess, min#, max#,
    OffWith, offWith, offWithSame, offWithShiftRight,
    --OffWithStreamAnd(..),
    UnpackedLazyByteString, emptyUnpackedLazyByteString,
    Stream, dropStream,
    offsetText,
    representationTypes,
    -- These must be exposed
    textShiftRight, textShiftLeft,
    byteStringShiftRight, byteStringShiftLeft
  ) 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#)
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(..))
import qualified Language.Haskell.TH           as TH   (Q, Type)

{- Representation Types -}
type OffWith ts = (# Int#, ts #)
--data OffWithStreamAnd ts = OffWithStreamAnd {-# UNPACK #-} !Int !Stream ts
type UnpackedLazyByteString = (#
    Int#,
    Addr#,
    ForeignPtrContents,
    Int#,
    Int#,
    Lazy.ByteString
  #)

representationTypes :: [TH.Q TH.Type]
representationTypes :: [Q Type]
representationTypes = [[t|[Char]|], [t|UArray Int Char|], [t|Text16|], [t|ByteString|], [t|CharList|], [t|Stream|], [t|Lazy.ByteString|], [t|Text|]]

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

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

{- Representation Mappings -}
-- When a new input type is added here, it needs an Input instance in Parsley.Backend.Machine
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

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 -}
intSame :: Code Int# -> Code Int# -> Code Bool
intSame :: Code Int# -> Code Int# -> Code Bool
intSame Code Int#
qi# Code Int#
qj# = [||isTrue# ($$(qi#) ==# $$(qj#))||]

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

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

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

offWithShiftRight :: Code (Int -> ts -> ts) -> Code (# Int#, ts #) -> Code Int# -> Code (# Int#, ts #)
offWithShiftRight :: Code (Int -> ts -> ts)
-> Code (# Int#, ts #) -> Code Int# -> Code (# Int#, ts #)
offWithShiftRight Code (Int -> ts -> ts)
drop Code (# Int#, 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-}

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

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
nInt -> 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'

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
nInt -> 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 #)

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#)

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 #)

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#

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#