logict-sequence 0.2 → 0.2.0.1

raw patch · 5 files changed

+24/−53 lines, 5 files

Files

CHANGELOG.md +5/−0
logict-sequence.cabal +1/−2
src/Control/Monad/Logic/Sequence/Internal/Any.hs +0/−28
src/Control/Monad/Logic/Sequence/Internal/Queue.hs +7/−11
src/Control/Monad/Logic/Sequence/Internal/ScheduledQueue.hs +11/−12

CHANGELOG.md view

@@ -1,4 +1,9 @@ # Revision history for logict-sequence+## 0.2.0.1 -- 2022-11-23++* Fix a serious laziness bug in `<|>` and `>>=`. These were stricter than they+  should be in some cases.+ ## 0.2     -- 2022-11-22  * Rename things having to do with views, to enforce a consistent

logict-sequence.cabal view

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               logict-sequence-version:            0.2+version:            0.2.0.1  -- A short (one-line) description of the package. synopsis:           A backtracking logic-programming monad with asymptotic improvements to msplit@@ -43,7 +43,6 @@                     , Control.Monad.Logic.Sequence.Internal                     , Control.Monad.Logic.Sequence.Internal.Queue                     , Control.Monad.Logic.Sequence.Internal.ScheduledQueue-                    , Control.Monad.Logic.Sequence.Internal.Any      -- Modules included in this library but not exported.     -- other-modules:

− src/Control/Monad/Logic/Sequence/Internal/Any.hs

@@ -1,28 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Trustworthy #-}--- We suppress this warning because otherwise GHC complains--- about the newtype constructor not being used.-#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wno-unused-top-binds #-}-#endif---- | It's safe to coerce /to/ 'Any' as long as you don't--- coerce back. We define our own 'Any' instead of using--- the one in "GHC.Exts" directly to ensure that this--- module doesn't clash with one making the opposite--- assumption. We use a newtype rather than a closed type--- family with no instances because the latter weren't supported--- until 8.0.-module Control.Monad.Logic.Sequence.Internal.Any-  ( Any-  , toAnyList-  ) where--import Unsafe.Coerce-import qualified GHC.Exts as E--newtype Any = Any E.Any---- | Convert a list of anything to a list of 'Any'.-toAnyList :: [a] -> [Any]-toAnyList = unsafeCoerce

src/Control/Monad/Logic/Sequence/Internal/Queue.hs view

@@ -41,7 +41,7 @@  data Queue a   = Empty-  | a :< {-# UNPACK #-} !(SQ.Queue (Queue a))+  | a :< SQ.Queue (Queue a)   deriving (Functor, F.Foldable, T.Traversable)  instance Sequence Queue where@@ -51,7 +51,6 @@   singleton a = a :< S.empty   {-# INLINE (><) #-}   Empty >< r = r-  q >< Empty = q   (a :< q) >< r = a :< (q |> r)   {-# INLINE (|>) #-}   l |> x = l >< singleton x@@ -59,16 +58,13 @@   x <| r = singleton x >< r   {-# INLINE viewl #-}   viewl Empty     = EmptyL-  viewl (x :< q0)  = x S.:< case viewl q0 of-    EmptyL -> Empty-    t S.:< q'  -> linkAll t q'+  viewl (t :< q0) = t S.:< linkAll q0     where-    linkAll :: Queue a -> SQ.Queue (Queue a) -> Queue a-    linkAll t@(y :< q) q' = case viewl q' of-      EmptyL -> t-      h S.:< t' -> y :< (q |> linkAll h t')-    linkAll Empty _ = error "Invariant failure"-+    linkAll :: SQ.Queue (Queue a) -> Queue a+    linkAll v = case viewl v of+      EmptyL -> Empty+      Empty S.:< t' -> linkAll t'+      (x :< q) S.:< t' -> x :< (q |> linkAll t')  #if MIN_VERSION_base(4,9,0) instance Semigroup (Queue a) where

src/Control/Monad/Logic/Sequence/Internal/ScheduledQueue.hs view

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-}-+{-# LANGUAGE ExistentialQuantification #-}  ----------------------------------------------------------------------------- -- |@@ -26,7 +26,6 @@ import qualified Data.SequenceClass as S import Data.Foldable import qualified Data.Traversable as T-import Control.Monad.Logic.Sequence.Internal.Any import qualified Control.Applicative as A  #if !MIN_VERSION_base(4,8,0)@@ -50,26 +49,26 @@ -- Precondition: -- |f| = |r| - 1 rotate :: [a] -> SL a -> [a] -> [a]-rotate [] (~SNil :> y) a = y : a+rotate [] (_SNil :> y) a = y : a rotate (x : f) (r :> y) a = x : rotate f r (y : a) rotate _f _a _r  = error "Invariant |f| = |r| + |a| - 1 broken"  -- | A scheduled Banker's Queue, as described by Okasaki.-data Queue a = RQ ![a] !(SL a) ![Any]+data Queue a = forall x. RQ ![a] !(SL a) ![x] -- Invariant: |f| = |r| + |a|-  deriving Functor-  -- We use 'Any' rather than an existential to allow GHC to unpack-  -- queues. In particular, we want to unpack into the catenable queue-  -- constructor. -queue :: [a] -> SL a -> [Any] -> Queue a+instance Functor Queue where+  fmap f (RQ x y s) = RQ (fmap f x) (fmap f y) s+  a <$ RQ x y s = RQ (a <$ x) (a <$ y) s++queue :: [a] -> SL a -> [x] -> Queue a -- precondition : |f| = |r| + |a| - 1 -- postcondition: |f| = |r| + |a| queue f r [] =   let     f' = appendSL f r     {-# NOINLINE f' #-}-  in RQ f' SNil (toAnyList f')+  in RQ f' SNil f' queue f r (_h : t) = RQ f r t  instance Sequence Queue where@@ -78,10 +77,10 @@     let       c = [x]       {-# NOINLINE c #-}-    in RQ c SNil (toAnyList c)+    in RQ c SNil c   RQ f r a |> x = queue f (r :> x) a -  viewl (RQ [] ~SNil ~[]) = EmptyL+  viewl (RQ [] _SNil _nil) = EmptyL   viewl (RQ (h : t) f a) = h :< queue t f a  instance Foldable Queue where