{-# 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 -> Count bps :: {-# UNPACK #-} !Word64 , Elem -> Count size :: {-# UNPACK #-} !Count } deriving (Elem -> Elem -> Bool 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 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. 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 -> Count size :: {-# UNPACK #-} !Count , Measure -> Int min :: {-# UNPACK #-} !Int , Measure -> Int excess :: {-# UNPACK #-} !Int } deriving (Measure -> Measure -> Bool 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 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 Ord, Int -> Measure -> ShowS [Measure] -> ShowS Measure -> String 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. 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 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 -> () forall a. (a -> ()) -> NFData a rnf :: ParensSeq -> () $crnf :: ParensSeq -> () NFData, 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 Count aSize Int aMin Int aExcess <> :: Measure -> Measure -> Measure <> Measure Count bSize Int bMin Int bExcess = Measure { $sel:size:Measure :: Count size = Count aSize forall a. Num a => a -> a -> a + Count bSize , $sel:min:Measure :: Int min = forall a. Ord a => a -> a -> a P.min Int aMin (Int bMin forall a. Num a => a -> a -> a + Int aExcess) , $sel:excess:Measure :: Int excess = Int aExcess forall a. Num a => a -> a -> a + Int bExcess } instance Monoid Measure where mempty :: Measure mempty = Count -> Int -> Int -> Measure Measure Count 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 Count w Count size) = Measure { Int min :: Int $sel:min:Measure :: Int min, Int excess :: Int $sel:excess:Measure :: Int excess, Count size :: Count $sel:size:Measure :: Count size } where MinExcess Int min Int excess = forall a. PartialMinExcess1 a => Int -> a -> MinExcess partialMinExcess1 (forall a b. (Integral a, Num b) => a -> b fromIntegral Count size) Count 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 forall a b. (a -> b) -> a -> b $ case forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt ft of Elem Count w Count nw :< ParensSeqFt rt -> if Count nw forall a. Ord a => a -> a -> Bool >= Count 0 Bool -> Bool -> Bool && Count nw forall a. Ord a => a -> a -> Bool < Count 64 then Count -> Count -> Elem Elem ((Count w forall a. Shift a => a -> Count -> a .<. Count 1) forall a. BitWise a => a -> a -> a .|. Count bw) (Count nw forall a. Num a => a -> a -> a + Count 1) forall v. Cons v => Elem v -> v -> v <| ParensSeqFt rt else Count -> Count -> Elem Elem Count bw Count 1 forall v. Cons v => Elem v -> v -> v <| ParensSeqFt ft ViewL (FingerTree Measure) Elem FT.EmptyL -> forall v a. Measured v a => a -> FingerTree v a FT.singleton (Count -> Count -> Elem Elem Count bw Count 1) where bw :: Count bw = if Elem ParensSeq b then Count 1 else Count 0 instance HW.Snoc ParensSeq where snoc :: ParensSeq -> Elem ParensSeq -> ParensSeq snoc (ParensSeq ParensSeqFt ft) Elem ParensSeq b = ParensSeqFt -> ParensSeq ParensSeq forall a b. (a -> b) -> a -> b $ case forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr ParensSeqFt ft of ParensSeqFt lt :> Elem Count w Count nw -> if Count nw forall a. Ord a => a -> a -> Bool >= Count 0 Bool -> Bool -> Bool && Count nw forall a. Ord a => a -> a -> Bool < Count 64 then Count -> Count -> Elem Elem (Count w forall a. BitWise a => a -> a -> a .|. (Count bw forall a. Shift a => a -> Count -> a .<. Count nw)) (Count nw forall a. Num a => a -> a -> a + Count 1) forall v. Cons v => Elem v -> v -> v <| ParensSeqFt lt else Count -> Count -> Elem Elem Count bw Count 1 forall v. Cons v => Elem v -> v -> v <| ParensSeqFt lt ViewR (FingerTree Measure) Elem FT.EmptyR -> forall v a. Measured v a => a -> FingerTree v a FT.singleton (Count -> Count -> Elem Elem Count bw Count 1) where bw :: Count bw = if Elem ParensSeq b then Count 1 else Count 0 instance Semigroup ParensSeq where ParensSeq ParensSeqFt tl <> :: ParensSeq -> ParensSeq -> ParensSeq <> ParensSeq ParensSeqFt tr = ParensSeqFt -> ParensSeq ParensSeq forall a b. (a -> b) -> a -> b $ case forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr ParensSeqFt tl of ParensSeqFt tll :> Elem Count wl Count nwl -> case forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt tr of Elem Count wr Count nwr :< ParensSeqFt trr -> let nw :: Count nw = Count nwl forall a. Num a => a -> a -> a + Count nwr in if Count nw forall a. Ord a => a -> a -> Bool <= Count 64 then (ParensSeqFt tll forall v. Snoc v => v -> Elem v -> v |> Count -> Count -> Elem Elem (Count wl forall a. BitWise a => a -> a -> a .|. (Count wr forall a. Shift a => a -> Count -> a .<. Count nwl)) Count nw) forall v. (Semigroup v, Container v) => v -> v -> v >< ParensSeqFt trr else ParensSeqFt tl 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 -> forall v a. Measured v a => FingerTree v a FT.empty (|>#) :: ParensSeqFt -> Elem -> ParensSeqFt |># :: ParensSeqFt -> Elem -> ParensSeqFt (|>#) ParensSeqFt ft e :: Elem e@(Elem Count _ Count wn) = if Count wn forall a. Ord a => a -> a -> Bool > Count 0 then ParensSeqFt ft forall v. Snoc v => v -> Elem v -> v |> Elem e else ParensSeqFt ft (#<|) :: Elem ->ParensSeqFt -> ParensSeqFt #<| :: Elem -> ParensSeqFt -> ParensSeqFt (#<|) e :: Elem e@(Elem Count _ Count wn) ParensSeqFt ft = if Count wn forall a. Ord a => a -> a -> Bool > Count 0 then Elem e 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 forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl ParensSeqFt rt of Elem Count w Count nw :< ParensSeqFt rrt -> let c :: Count c = Count -> Count -> Count -> Count go Count w Count nw Count nw in (ParensSeqFt lt ParensSeqFt -> Elem -> ParensSeqFt |># Count -> Count -> Elem Elem Count w Count c, Count -> Count -> Elem Elem (Count w forall a. Shift a => a -> Count -> a .>. Count c) (Count nw forall a. Num a => a -> a -> a - Count c) Elem -> ParensSeqFt -> ParensSeqFt #<| ParensSeqFt rrt) ViewL (FingerTree Measure) Elem FT.EmptyL -> (ParensSeqFt ft, forall v a. Measured v a => FingerTree v a FT.empty) where (ParensSeqFt lt, ParensSeqFt rt) = 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 = forall v a. Measured v a => a -> v FT.measure ParensSeqFt lt go :: Word64 -> Count -> Count -> Count go :: Count -> Count -> Count -> Count go Count w Count c Count nw = if Count c forall a. Ord a => a -> a -> Bool > Count 0 then if Measure -> Bool p (Measure ltm forall a. Semigroup a => a -> a -> a <> forall v a. Measured v a => a -> v FT.measure (Count -> Count -> Elem Elem (Count w forall a. Shift a => a -> Count -> a .<. (Count 64 forall a. Num a => a -> a -> a - Count c) forall a. Shift a => a -> Count -> a .>. (Count 64 forall a. Num a => a -> a -> a - Count c)) Count c)) then Count -> Count -> Count -> Count go Count w (Count c forall a. Num a => a -> a -> a - Count 1) Count nw else Count c else Count 0 atSizeBelowZero :: Count -> Measure -> Bool atSizeBelowZero :: Count -> Measure -> Bool atSizeBelowZero Count n (Measure { $sel:size:Measure :: Measure -> Count size = Count sz }) = Count n forall a. Ord a => a -> a -> Bool < Count sz atMinZero :: Measure -> Bool atMinZero :: Measure -> Bool atMinZero (Measure { $sel:min:Measure :: Measure -> Int min = Int m }) = Int m forall a. Ord a => a -> a -> Bool <= Int 0