{-# LANGUAGE DerivingStrategies, GeneralisedNewtypeDeriving, UnboxedTuples #-}
{-|
Module      : Parsley.Internal.Backend.Machine.Types.Input.Offset
Description : Statically refined offsets.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the statically refined `Offset` type,
which can be used to reason about input in different parts of
a parser as it is evaluated.

@since 1.8.0.0
-}
module Parsley.Internal.Backend.Machine.Types.Input.Offset (
    Offset, mkOffset, offset, moveOne, moveN, same, updateDeepestKnown, unsafeDeepestKnown
  ) where

import Parsley.Internal.Backend.Machine.InputRep   (StaRep)
import Data.Maybe                                  (fromJust)

{-|
Augments a regular @'Code' ('Rep' o)@ with information about its origins and
how much input is known to have been consumed since it came into existence.
This can be used to statically evaluate handlers (see
`Parsley.Internal.Backend.Machine.Types.Statics.staHandlerEval`).

@since 1.5.0.0
-}
data Offset o = Offset {
    -- | The underlying code that represents the current offset into the input.
    forall o. Offset o -> StaRep o
offset :: !(StaRep o),
    forall o. Offset o -> Maybe (StaRep o)
deepestKnownChar :: !(Maybe (StaRep o)),
    -- | The unique identifier that determines where this offset originated from.
    forall o. Offset o -> Word
unique :: {-# UNPACK #-} !Word,
    -- | The amount of input that has been consumed on this offset since it was born.
    forall o. Offset o -> Amount
moved  :: {-# UNPACK #-} !Amount
  }

newtype Amount = Amount Word {- ^ The additive offset. -} deriving newtype (Amount -> Amount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Amount -> Amount -> Bool
$c/= :: Amount -> Amount -> Bool
== :: Amount -> Amount -> Bool
$c== :: Amount -> Amount -> Bool
Eq, Integer -> Amount
Amount -> Amount
Amount -> Amount -> Amount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Amount
$cfromInteger :: Integer -> Amount
signum :: Amount -> Amount
$csignum :: Amount -> Amount
abs :: Amount -> Amount
$cabs :: Amount -> Amount
negate :: Amount -> Amount
$cnegate :: Amount -> Amount
* :: Amount -> Amount -> Amount
$c* :: Amount -> Amount -> Amount
- :: Amount -> Amount -> Amount
$c- :: Amount -> Amount -> Amount
+ :: Amount -> Amount -> Amount
$c+ :: Amount -> Amount -> Amount
Num, Int -> Amount -> ShowS
[Amount] -> ShowS
Amount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Amount] -> ShowS
$cshowList :: [Amount] -> ShowS
show :: Amount -> String
$cshow :: Amount -> String
showsPrec :: Int -> Amount -> ShowS
$cshowsPrec :: Int -> Amount -> ShowS
Show)

{-|
Given two `Offset`s, this determines whether or not they represent the same
offset into the input stream at runtime. This comparison only makes sense when
both `Offset`s share the same origin, hence the @Maybe@.

@since 1.4.0.0
-}
same :: Offset o -> Offset o -> Maybe Bool
same :: forall o. Offset o -> Offset o -> Maybe Bool
same Offset o
o1 Offset o
o2
  | forall o. Offset o -> Word
unique Offset o
o1 forall a. Eq a => a -> a -> Bool
== forall o. Offset o -> Word
unique Offset o
o2 = forall a. a -> Maybe a
Just (forall o. Offset o -> Amount
moved Offset o
o1 forall a. Eq a => a -> a -> Bool
== forall o. Offset o -> Amount
moved Offset o
o2)
  | Bool
otherwise = forall a. Maybe a
Nothing

{-|
Updates an `Offset` with its new underlying representation of a real
runtime offset and records that another character has been consumed.

@since 1.4.0.0
-}
moveOne :: Offset o -> StaRep o -> Offset o
moveOne :: forall o. Offset o -> StaRep o -> Offset o
moveOne = forall o. Word -> Offset o -> StaRep o -> Offset o
moveN Word
1

{-|
Updates an `Offset` with its new underlying representation of a real
runtime offset and records that several more characters have been consumed.
Here, `Nothing` represents an unknown but non-zero amount of characters.

@since 1.5.0.0
-}
moveN :: Word -> Offset o -> StaRep o -> Offset o
moveN :: forall o. Word -> Offset o -> StaRep o -> Offset o
moveN Word
n Offset o
off StaRep o
o = Offset o
off { offset :: StaRep o
offset = StaRep o
o, moved :: Amount
moved = forall o. Offset o -> Amount
moved Offset o
off forall a. Num a => a -> a -> a
+ Word -> Amount
Amount Word
n }

{-|
Makes a fresh `Offset` that has not had any input consumed off of it
yet.

@since 1.4.0.0
-}
mkOffset :: StaRep o -> Word -> Offset o
mkOffset :: forall o. StaRep o -> Word -> Offset o
mkOffset StaRep o
offset Word
unique = forall o.
StaRep o -> Maybe (StaRep o) -> Word -> Amount -> Offset o
Offset StaRep o
offset forall a. Maybe a
Nothing Word
unique Amount
0

updateDeepestKnown :: StaRep o -> Offset o -> Offset o
updateDeepestKnown :: forall o. StaRep o -> Offset o -> Offset o
updateDeepestKnown StaRep o
known Offset o
offset = Offset o
offset { deepestKnownChar :: Maybe (StaRep o)
deepestKnownChar = forall a. a -> Maybe a
Just StaRep o
known }

unsafeDeepestKnown :: Offset o -> StaRep o
unsafeDeepestKnown :: forall o. Offset o -> StaRep o
unsafeDeepestKnown = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o. Offset o -> Maybe (StaRep o)
deepestKnownChar

{-
add :: Amount -> Amount -> Amount
add a1@(Amount n i) a2@(Amount m j)
  -- If the multiplicites don't match then this is _even_ more unknowable
  | n /= m, n /= 0, m /= 0 = Amount (n + m) 0
  -- This is a funny case, it shouldn't happen and it's not really clear what happens if it does
  | n /= 0, m /= 0         = error ("adding " ++ show a1 ++ " and " ++ show a2 ++ " makes no sense?")
  -- If one of the multiplicites is 0 then the offset can be added
  | otherwise              = Amount (max n m) (i + j)
-}

-- Instances
instance Show (Offset o) where
  show :: Offset o -> String
show Offset o
o = forall a. Show a => a -> String
show (forall o. Offset o -> Word
unique Offset o
o) forall a. [a] -> [a] -> [a]
++ String
"+" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall o. Offset o -> Amount
moved Offset o
o)

{-
instance Show Amount where
  show (Amount n m) = show n ++ "*n+" ++ show m
-}