{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.BalancedParens.Internal.ParensSeq ( Elem(..) , Measure(..) , ParensSeq(..) , ParensSeqFt , (|>#) , (#<|) , ftSplit , atSizeBelowZero , atMinZero ) where import Control.DeepSeq import Data.Int import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Excess.MinExcess import HaskellWorks.Data.Excess.PartialMinExcess1 import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>)) import HaskellWorks.Data.Positioning import Prelude hiding (max, min) import qualified HaskellWorks.Data.Cons as HW import qualified HaskellWorks.Data.Container as HW import qualified HaskellWorks.Data.FingerTree as FT import qualified HaskellWorks.Data.Snoc as HW import qualified Prelude as P data Elem = Elem { Elem -> Word64 bps :: {-# UNPACK #-} !Word64 , Elem -> Word64 size :: {-# UNPACK #-} !Count } deriving (Elem -> Elem -> Bool (Elem -> Elem -> Bool) -> (Elem -> Elem -> Bool) -> Eq Elem forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Elem -> Elem -> Bool $c/= :: Elem -> Elem -> Bool == :: Elem -> Elem -> Bool $c== :: Elem -> Elem -> Bool Eq, Int -> Elem -> ShowS [Elem] -> ShowS Elem -> String (Int -> Elem -> ShowS) -> (Elem -> String) -> ([Elem] -> ShowS) -> Show Elem forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Elem] -> ShowS $cshowList :: [Elem] -> ShowS show :: Elem -> String $cshow :: Elem -> String showsPrec :: Int -> Elem -> ShowS $cshowsPrec :: Int -> Elem -> ShowS Show, (forall x. Elem -> Rep Elem x) -> (forall x. Rep Elem x -> Elem) -> Generic Elem forall x. Rep Elem x -> Elem forall x. Elem -> Rep Elem x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Elem x -> Elem $cfrom :: forall x. Elem -> Rep Elem x Generic) instance NFData Elem data Measure = Measure { Measure -> Word64 size :: {-# UNPACK #-} !Count , Measure -> Int min :: {-# UNPACK #-} !Int , Measure -> Int excess :: {-# UNPACK #-} !Int } deriving (Measure -> Measure -> Bool (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> Eq Measure forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Measure -> Measure -> Bool $c/= :: Measure -> Measure -> Bool == :: Measure -> Measure -> Bool $c== :: Measure -> Measure -> Bool Eq, Eq Measure Eq Measure -> (Measure -> Measure -> Ordering) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Measure) -> (Measure -> Measure -> Measure) -> Ord Measure Measure -> Measure -> Bool Measure -> Measure -> Ordering Measure -> Measure -> Measure forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Measure -> Measure -> Measure $cmin :: Measure -> Measure -> Measure max :: Measure -> Measure -> Measure $cmax :: Measure -> Measure -> Measure >= :: Measure -> Measure -> Bool $c>= :: Measure -> Measure -> Bool > :: Measure -> Measure -> Bool $c> :: Measure -> Measure -> Bool <= :: Measure -> Measure -> Bool $c<= :: Measure -> Measure -> Bool < :: Measure -> Measure -> Bool $c< :: Measure -> Measure -> Bool compare :: Measure -> Measure -> Ordering $ccompare :: Measure -> Measure -> Ordering $cp1Ord :: Eq Measure Ord, Int -> Measure -> ShowS [Measure] -> ShowS Measure -> String (Int -> Measure -> ShowS) -> (Measure -> String) -> ([Measure] -> ShowS) -> Show Measure forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Measure] -> ShowS $cshowList :: [Measure] -> ShowS show :: Measure -> String $cshow :: Measure -> String showsPrec :: Int -> Measure -> ShowS $cshowsPrec :: Int -> Measure -> ShowS Show, (forall x. Measure -> Rep Measure x) -> (forall x. Rep Measure x -> Measure) -> Generic Measure forall x. Rep Measure x -> Measure forall x. Measure -> Rep Measure x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Measure x -> Measure $cfrom :: forall x. Measure -> Rep Measure x Generic) instance NFData Measure type ParensSeqFt = FT.FingerTree Measure Elem newtype ParensSeq = ParensSeq { ParensSeq -> ParensSeqFt parens :: ParensSeqFt } deriving (Int -> ParensSeq -> ShowS [ParensSeq] -> ShowS ParensSeq -> String (Int -> ParensSeq -> ShowS) -> (ParensSeq -> String) -> ([ParensSeq] -> ShowS) -> Show ParensSeq forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ParensSeq] -> ShowS $cshowList :: [ParensSeq] -> ShowS show :: ParensSeq -> String $cshow :: ParensSeq -> String showsPrec :: Int -> ParensSeq -> ShowS $cshowsPrec :: Int -> ParensSeq -> ShowS Show, ParensSeq -> () (ParensSeq -> ()) -> NFData ParensSeq forall a. (a -> ()) -> NFData a rnf :: ParensSeq -> () $crnf :: ParensSeq -> () NFData, (forall x. ParensSeq -> Rep ParensSeq x) -> (forall x. Rep ParensSeq x -> ParensSeq) -> Generic ParensSeq forall x. Rep ParensSeq x -> ParensSeq forall x. ParensSeq -> Rep ParensSeq x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ParensSeq x -> ParensSeq $cfrom :: forall x. ParensSeq -> Rep ParensSeq x Generic) instance Semigroup Measure where Measure Word64 aSize Int aMin Int aExcess <> :: Measure -> Measure -> Measure <> Measure Word64 bSize Int bMin Int bExcess = Measure :: Word64 -> Int -> Int -> Measure Measure { $sel:size:Measure :: Word64 size = Word64 aSize Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 bSize , $sel:min:Measure :: Int min = Int -> Int -> Int forall a. Ord a => a -> a -> a P.min Int aMin (Int bMin Int -> Int -> Int forall a. Num a => a -> a -> a + Int aExcess) , $sel:excess:Measure :: Int excess = Int aExcess Int -> Int -> Int forall a. Num a => a -> a -> a + Int bExcess } instance Monoid Measure where mempty :: Measure mempty = Word64 -> Int -> Int -> Measure Measure Word64 0 Int 0 Int 0 #if MIN_VERSION_GLASGOW_HASKELL(8, 4, 4, 0) #else mappend = (<>) #endif instance FT.Measured Measure Elem where measure :: Elem -> Measure measure (Elem Word64 w Word64 size) = Measure :: Word64 -> Int -> Int -> Measure Measure { Int min :: Int $sel:min:Measure :: Int min, Int excess :: Int $sel:excess:Measure :: Int excess, Word64 size :: Word64 $sel:size:Measure :: Word64 size } where MinExcess Int min Int excess = Int -> Word64 -> MinExcess forall a. PartialMinExcess1 a => Int -> a -> MinExcess partialMinExcess1 (Word64 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 size) Word64 w instance HW.Container ParensSeq where type Elem ParensSeq = Bool instance HW.Cons ParensSeq where cons :: Elem ParensSeq -> ParensSeq -> ParensSeq cons Elem ParensSeq b (ParensSeq ParensSeqFt ft) = ParensSeqFt -> ParensSeq ParensSeq (ParensSeqFt -> ParensSeq) -> ParensSeqFt -> ParensSeq forall a b. (a -> b) -> a -> b $ case ParensSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt ft of Elem Word64 w Word64 nw :< ParensSeqFt rt -> if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool >= Word64 0 Bool -> Bool -> Bool && Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Word64 64 then Word64 -> Word64 -> Elem Elem ((Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 1) Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. Word64 bw) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 1) Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. Cons v => Elem v -> v -> v <| ParensSeqFt rt else Word64 -> Word64 -> Elem Elem Word64 bw Word64 1 Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. Cons v => Elem v -> v -> v <| ParensSeqFt ft ViewL (FingerTree Measure) Elem FT.EmptyL -> Elem -> ParensSeqFt forall v a. Measured v a => a -> FingerTree v a FT.singleton (Word64 -> Word64 -> Elem Elem Word64 bw Word64 1) where bw :: Word64 bw = if Bool Elem ParensSeq b then Word64 1 else Word64 0 instance HW.Snoc ParensSeq where snoc :: ParensSeq -> Elem ParensSeq -> ParensSeq snoc (ParensSeq ParensSeqFt ft) Elem ParensSeq b = ParensSeqFt -> ParensSeq ParensSeq (ParensSeqFt -> ParensSeq) -> ParensSeqFt -> ParensSeq forall a b. (a -> b) -> a -> b $ case ParensSeqFt -> ViewR (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr ParensSeqFt ft of ParensSeqFt lt :> Elem Word64 w Word64 nw -> if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool >= Word64 0 Bool -> Bool -> Bool && Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Word64 64 then Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. (Word64 bw Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 nw)) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 1) Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. Cons v => Elem v -> v -> v <| ParensSeqFt lt else Word64 -> Word64 -> Elem Elem Word64 bw Word64 1 Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. Cons v => Elem v -> v -> v <| ParensSeqFt lt ViewR (FingerTree Measure) Elem FT.EmptyR -> Elem -> ParensSeqFt forall v a. Measured v a => a -> FingerTree v a FT.singleton (Word64 -> Word64 -> Elem Elem Word64 bw Word64 1) where bw :: Word64 bw = if Bool Elem ParensSeq b then Word64 1 else Word64 0 instance Semigroup ParensSeq where ParensSeq ParensSeqFt tl <> :: ParensSeq -> ParensSeq -> ParensSeq <> ParensSeq ParensSeqFt tr = ParensSeqFt -> ParensSeq ParensSeq (ParensSeqFt -> ParensSeq) -> ParensSeqFt -> ParensSeq forall a b. (a -> b) -> a -> b $ case ParensSeqFt -> ViewR (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr ParensSeqFt tl of ParensSeqFt tll :> Elem Word64 wl Word64 nwl -> case ParensSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt tr of Elem Word64 wr Word64 nwr :< ParensSeqFt trr -> let nw :: Word64 nw = Word64 nwl Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 nwr in if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool <= Word64 64 then (ParensSeqFt tll ParensSeqFt -> Elem ParensSeqFt -> ParensSeqFt forall v. Snoc v => v -> Elem v -> v |> Word64 -> Word64 -> Elem Elem (Word64 wl Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. (Word64 wr Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 nwl)) Word64 nw) ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. (Semigroup v, Container v) => v -> v -> v >< ParensSeqFt trr else ParensSeqFt tl ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. (Semigroup v, Container v) => v -> v -> v >< ParensSeqFt tr ViewL (FingerTree Measure) Elem FT.EmptyL -> ParensSeqFt tr ViewR (FingerTree Measure) Elem FT.EmptyR -> ParensSeqFt forall v a. Measured v a => FingerTree v a FT.empty (|>#) :: ParensSeqFt -> Elem -> ParensSeqFt |># :: ParensSeqFt -> Elem -> ParensSeqFt (|>#) ParensSeqFt ft e :: Elem e@(Elem Word64 _ Word64 wn) = if Word64 wn Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then ParensSeqFt ft ParensSeqFt -> Elem ParensSeqFt -> ParensSeqFt forall v. Snoc v => v -> Elem v -> v |> Elem ParensSeqFt Elem e else ParensSeqFt ft (#<|) :: Elem ->ParensSeqFt -> ParensSeqFt #<| :: Elem -> ParensSeqFt -> ParensSeqFt (#<|) e :: Elem e@(Elem Word64 _ Word64 wn) ParensSeqFt ft = if Word64 wn Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then Elem ParensSeqFt Elem e Elem ParensSeqFt -> ParensSeqFt -> ParensSeqFt forall v. Cons v => Elem v -> v -> v <| ParensSeqFt ft else ParensSeqFt ft ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt) ftSplit :: (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt) ftSplit Measure -> Bool p ParensSeqFt ft = case ParensSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt rt of Elem Word64 w Word64 nw :< ParensSeqFt rrt -> let c :: Word64 c = Word64 -> Word64 -> Word64 -> Word64 go Word64 w Word64 nw Word64 nw in (ParensSeqFt lt ParensSeqFt -> Elem -> ParensSeqFt |># Word64 -> Word64 -> Elem Elem Word64 w Word64 c, Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. Word64 c) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c) Elem -> ParensSeqFt -> ParensSeqFt #<| ParensSeqFt rrt) ViewL (FingerTree Measure) Elem FT.EmptyL -> (ParensSeqFt ft, ParensSeqFt forall v a. Measured v a => FingerTree v a FT.empty) where (ParensSeqFt lt, ParensSeqFt rt) = (Measure -> Bool) -> ParensSeqFt -> (ParensSeqFt, ParensSeqFt) forall v a. Measured v a => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a) FT.split Measure -> Bool p ParensSeqFt ft ltm :: Measure ltm = ParensSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure ParensSeqFt lt go :: Word64 -> Count -> Count -> Count go :: Word64 -> Word64 -> Word64 -> Word64 go Word64 w Word64 c Word64 nw = if Word64 c Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then if Measure -> Bool p (Measure ltm Measure -> Measure -> Measure forall a. Semigroup a => a -> a -> a <> Elem -> Measure forall v a. Measured v a => a -> v FT.measure (Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. (Word64 64 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c) Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. (Word64 64 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c)) Word64 c)) then Word64 -> Word64 -> Word64 -> Word64 go Word64 w (Word64 c Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 1) Word64 nw else Word64 c else Word64 0 atSizeBelowZero :: Count -> Measure -> Bool atSizeBelowZero :: Word64 -> Measure -> Bool atSizeBelowZero Word64 n Measure m = Word64 n Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Measure -> Word64 size (Measure m :: Measure) atMinZero :: Measure -> Bool atMinZero :: Measure -> Bool atMinZero Measure m = Measure -> Int min (Measure m :: Measure) Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 0