incremental-computing (empty) → 0.0.0.0
raw patch · 9 files changed
+1581/−0 lines, 9 filesdep +Cabaldep +QuickCheckdep +basesetup-changed
Dependencies added: Cabal, QuickCheck, base, cabal-test-quickcheck, containers, dlist, fingertree, incremental-computing, order-maintenance, transformers
Files
- LICENSE +27/−0
- Setup.hs +4/−0
- incremental-computing.cabal +83/−0
- src/library/Data/Incremental.hs +348/−0
- src/library/Data/Incremental/Sequence.hs +622/−0
- src/library/Data/Incremental/Tuple.hs +92/−0
- src/library/Data/MultiChange.hs +122/−0
- src/test-suites/TestSuite.hs +210/−0
- src/test-suites/TestSuite/Sequence.hs +73/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright © 2014, 2015 Denis Firsov, © 2014, 2015 Wolfgang Jeltsch+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++ • Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++ • Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++ • Neither the name of the copyright holders nor the names of the+ contributors may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain
+ incremental-computing.cabal view
@@ -0,0 +1,83 @@+Name: incremental-computing+Version: 0.0.0.0+Cabal-Version: >= 1.16+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: © 2014, 2015 Denis Firsov; © 2014, 2015 Wolfgang Jeltsch+Author: Wolfgang Jeltsch+Maintainer: wolfgang@cs.ioc.ee+Stability: provisional+Homepage: http://darcs.wolfgang.jeltsch.info/haskell/incremental-computing+Package-URL: http://hackage.haskell.org/packages/archive/incremental-computing/0.0.0.0/incremental-computing-0.0.0.0.tar.gz+Synopsis: Incremental computing+Description: This package is about incremental computing.+Category: Data+Tested-With: GHC == 7.8.3++Source-Repository head++ Type: darcs+ Location: http://darcs.wolfgang.jeltsch.info/haskell/incremental-computing/main++Source-Repository this++ Type: darcs+ Location: http://darcs.wolfgang.jeltsch.info/haskell/incremental-computing/main+ Tag: incremental-computing-0.0.0.0++Library++ Build-Depends: base >= 3.0 && < 5,+ containers >= 0.1 && < 0.6,+ dlist >= 0.7 && < 0.8,+ fingertree >= 0.1 && < 0.2,+ order-maintenance >= 0.0 && < 0.1,+ transformers >= 0.3 && < 0.5++ Default-Language: Haskell2010++ Default-Extensions: FlexibleContexts+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ RankNTypes+ TypeFamilies+ TypeOperators++ if impl(ghc >= 7.8) {+ Default-Extensions: AutoDeriveTypeable+ }++ Exposed-Modules: Data.Incremental+ Data.Incremental.Sequence+ Data.Incremental.Tuple+ Data.MultiChange++ HS-Source-Dirs: src/library++Test-Suite sequence-tests++ Type: detailed-0.9++ Build-Depends: base >= 3.0 && < 5,+ Cabal >= 1.16 && < 2,+ cabal-test-quickcheck >= 0.1 && < 0.2,+ containers >= 0.1 && < 0.6,+ QuickCheck >= 2.6 && < 3,+ incremental-computing == 0.0.0.0++ Default-Language: Haskell2010++ Default-Extensions: FlexibleContexts+ GeneralizedNewtypeDeriving+ StandaloneDeriving+ TypeFamilies+ TypeOperators++ Other-Extensions: UndecidableInstances++ Test-Module: TestSuite.Sequence++ Other-Modules: TestSuite++ HS-Source-Dirs: src/test-suites
+ src/library/Data/Incremental.hs view
@@ -0,0 +1,348 @@+module Data.Incremental (++ -- * Changes++ Change (Value, ($$)),+ PrimitiveChange (Keep, ReplaceBy),++ -- * Transformations++ Trans,+ TransProc,++ -- ** Construction++ simpleTrans,+ stateTrans,+ stTrans,+ trans,++ -- ** Deconstruction++ runTrans,+ toFunction,+ toSTProc,++ -- ** Utilities++ const,+ fromFunction,+ sanitize,++ -- * Changeables++ Changeable (DefaultChange),+ type (->>)++) where++-- Prelude++import Prelude hiding (id, (.), const)+import qualified Prelude++-- Control++import Control.Category+import Control.Monad.ST.Lazy+import Control.Monad.ST.Lazy.Unsafe++-- Data++import Data.Monoid+import Data.Functor.Identity+import Data.STRef.Lazy++infixr 0 $$+infixr 0 ->>++{-NOTE:+ Our policy regarding class constraints with Change and Changeable is as+ follows:++ • Global values that are about changes directly and do not use ($$) (which+ are almost all of them) should not have Change constraints. Adding all+ these change constraints everywhere would give us nothing and only+ introduce clutter and possibly performance issues.++ • Global values that are about changeables (which first and foremost+ includes all that are about (->>)) should have Changeable constraints,+ because this ensures that standard changes are monoids and the value+ type of standard changes is the type that we started with.+-}++-- * Changes++class Change p where++ type Value p :: *++ -- NOTE: Operator $$ is at least not used in the base library.+ ($$) :: p -> Value p -> Value p++data PrimitiveChange a = Keep | ReplaceBy a deriving (Show, Read)++instance Functor PrimitiveChange where++ fmap _ Keep = Keep+ fmap fun (ReplaceBy val) = ReplaceBy (fun val)++instance Monoid (PrimitiveChange a) where++ mempty = Keep++ Keep `mappend` change = change+ ReplaceBy val `mappend` _ = ReplaceBy val++instance Change (PrimitiveChange a) where++ type Value (PrimitiveChange a) = a++ Keep $$ val = val+ ReplaceBy val $$ _ = val++-- * Transformations++newtype Trans p q = Trans ((Value p, [p]) -> (Value q, [q]))++instance Category Trans where++ id = Trans id++ Trans conv2 . Trans conv1 = Trans (conv2 . conv1)++type TransProc m p q = Value p -> m (Value q, p -> m q)++-- ** Construction++simpleTrans :: (Value p -> Value q) -> (p -> q) -> Trans p q+simpleTrans fun prop = trans (\ cont -> runIdentity (cont transProc)) where++ transProc val = return (fun val, return . prop)++stateTrans :: (Value p -> (Value q, s)) -> (p -> s -> (q, s)) -> Trans p q+stateTrans init prop = stTrans (\ val -> do+ let (val', initState) = init val+ stateRef <- newSTRef initState+ let stProp change = do+ oldState <- readSTRef stateRef+ let (change', newState) = prop change oldState+ writeSTRef stateRef newState+ return change'+ return (val', stProp))++stTrans :: (forall s . TransProc (ST s) p q) -> Trans p q+stTrans transProc = trans (\ cont -> runST (cont transProc))++{-NOTE:+ ST with OrderT layers around can be run as follows:++ transNested :: (forall o1 ... on s .+ TransProc (OrderT o1 (... (OrderT on (ST s)))) p q)+ -> Trans p q+ transNested transProc = trans (\ cont -> runST (+ evalOrderT (+ ... (+ evalOrderT (cont transProc)))))+-}++{-FIXME:+ We have to mention in the documentation that the monad is supposed to be+ lazy. If it is strict, the constructed transformation trans will (probably)+ have the following properties:++ • Reducing any expression runTrans trans valAndChanges to WHNF results in+ the initialization being run and the constructed propagator being run on+ all the changes.++ • The expression toSTProc trans is a processor that always yields ⊥ as the+ output value and constructs propagators that always yield ⊥ as the+ output change.+-}+trans :: (forall r . (forall m . Monad m => TransProc m p q -> m r) -> r)+ -> Trans p q+trans cpsProcAndRun = errorIfStrictMonad `seq` Trans conv where++ errorIfStrictMonad = cpsProcAndRun $+ Prelude.const (strictMonadError >> return ())++ strictMonadError = error "Data.Incremental: \+ \Transformation processor uses strict monad"++ conv valAndChanges = cpsProcAndRun $+ \ transProc -> monadicConv transProc valAndChanges++ monadicConv transProc ~(val, changes) = do+ ~(val', prop) <- transProc val+ changes' <- mapM prop changes+ return (val', changes')++-- ** Deconstruction++runTrans :: Trans p q -> (Value p, [p]) -> (Value q, [q])+runTrans (Trans conv) = conv++toFunction :: Trans p q -> (Value p -> Value q)+toFunction (Trans conv) val = fst (conv (val, undefined))++{-FIXME:+ We have to mention the following in the documentation:++ The function toSTProc . stTrans is not the identity. A computation in+ the original value of type forall s . TransProc (ST s) may yield an+ undefined state, but for computations in the constructed value,+ undefinedness can only occur in the values they output.++ On the other hand, stTrans . toSTProc is the identity. [At least, it+ should be.]+-}+{-FIXME:+ It is crucial that toSTProc cannot be called on functions of type++ (Value p, [p]) -> (Value q, [q]) ,++ but only on transformations, which correspond only to sensible, in+ particular causal, functions.++ Take, for example, the following function:++ \ ~(val, ~(change1 : ~(change2 : rest))) -> (val, change2 : change1 : rest)++ (Maybe, we do not even need to use lazy patterns.) If we would apply a+ function like toSTProc to it, and apply runTrans to the result, we would get+ a function that is not referentially transparent. Let this function be+ called f. Let us proceed as follows:++ let input = (False, [ReplaceBy False, ReplaceBy True])+ let output = f input+ let changes' = snd output+ let change1' = changes' !! 0+ let change2' = changes' !! 1++ If we now evaluate change1', we will hit ⊥, because the second input change+ has not been written into the channel. However, if we first evaluate+ change2' and then change1', then change1' will evaluate to ReplaceBy True.++ This particular problem should not occur with our toSTProc, which only works+ with transformations. If a user would reimplement toSTProc such that it+ works with arbitrary functions of the above-mentioned type, he would have to+ use unsafeInterleaveST directly, where there would be no guarantees anyhow.++ That said, we have to analyze very carefully whether our toSTProc is really+ completely safe. Only if it is, we should declare a module that contains it+ trustworthy (in the sense of Safe Haskell). We have to take into account+ that trans works with arbitrary runnable monad families and an instantiation+ of the Monad class could be bogus. The argument that running a+ transformation always yields causal functions relies on the assumption that+ the output of the first argument of (>>=) cannot depend on data that is only+ contained in the second argument of (>>=). Maybe, this assumption can be+ broken with a bogus Monad instance. But maybe, parametricity ensures that+ this assumption holds.+-}++toSTProc :: Trans p q -> TransProc (ST s) p q+toSTProc (Trans conv) val = do+ (chan, changes) <- newChannel+ let (val', changes') = conv (val, changes)+ remainderRef <- newSTRef changes'+ let prop change = do+ writeChannel chan change+ next : further <- readSTRef remainderRef+ writeSTRef remainderRef further+ return next+ return (val', prop)++-- ** Utilities++const :: Monoid q => Value q -> Trans p q+const val = simpleTrans (Prelude.const val) (Prelude.const mempty)++fromFunction :: (a -> b) -> Trans (PrimitiveChange a) (PrimitiveChange b)+fromFunction fun = simpleTrans fun (fmap fun)++sanitize :: Eq a => Trans (PrimitiveChange a) (PrimitiveChange a)+sanitize = stateTrans init prop where++ init val = (val, val)++ prop Keep state = (Keep, state)+ prop (ReplaceBy val) state = if val == state+ then (Keep, state)+ else (ReplaceBy val, val)++-- * Changeables++class (Monoid (DefaultChange a),+ Change (DefaultChange a),+ Value (DefaultChange a) ~ a) =>+ Changeable a where++ type DefaultChange a :: *+ type DefaultChange a = PrimitiveChange a++instance Changeable Bool++instance Changeable Int++{-FIXME:+ Add default instance declarations for all remaining Prelude types and+ replace them by something more decent if there is something more decent.+-}++type a ->> b = Trans (DefaultChange a) (DefaultChange b)++-- * Channels in the ST monad++data Cell s a = Cell a (CellRef s a)++type CellRef s a = STRef s (Cell s a)++type Channel s a = STRef s (CellRef s a)++newChannel :: ST s (Channel s a, [a])+newChannel = do+ cellRef <- newSTRef undefined+ chan <- newSTRef cellRef+ let getContents cellRef = unsafeInterleaveST $ do+ Cell val cellRef' <- readSTRef cellRef+ vals <- getContents cellRef'+ return (val : vals)+ -- FIXME: Is this use of unsafeInterleaveST safe?+ contents <- getContents cellRef+ return (chan, contents)++writeChannel :: Channel s a -> a -> ST s ()+writeChannel chan val = do+ cellRef <- readSTRef chan+ cellRef' <- newSTRef undefined+ writeSTRef cellRef (Cell val cellRef')+ writeSTRef chan cellRef'++{-FIXME:+ Is there already an implementation of ST channels?+-}++{-FIXME:+ Remove Control.Monad.ST.Lazy.Unsafe from the import list, if the channel+ code moves to its own module.+-}++{-FIXME:+ The following things are to be considered:++ • Does our framework correspond to update lenses? How is it related to+ update lenses? Look at the slides of Tarmo’s seminar talk from+ 11 September 2014.++ • Our work on order maintenance could be turned into a paper. Currently,+ one has to read more than one paper to understand the algorithm (Dietz+ and Sleator 1987; Willard 1986) and Dietz and Sleator (1987) do not+ explain deletion.++ • The incrementalized version of maps cannot allow conversion to sequences+ of key–value pairs, but only to sequences of values, because if the map+ was created from a sequence and was then converted to a sequence of+ key–value pairs, the choice of keys from equivalence classes of keys+ would depend on the history of changes to the original sequence, not+ just on the current value of the sequence.+-}
+ src/library/Data/Incremental/Sequence.hs view
@@ -0,0 +1,622 @@+module Data.Incremental.Sequence (++ -- * Type++ Seq,+ {-NOTE:+ By re-exporting Seq, we get the definition of DefaultChange for Seq into+ the documentation generated by Haddock.+ -}++ -- * Changes++ insert,+ delete,+ shift,+ changeAt,++ -- * Atomic changes++ AtomicChange (Insert, Delete, Shift, ChangeAt),+ normalizeAtomicChange,++ -- * Transformations++ singleton,+ fromPair,+ cat,+ null,+ length,+ map,+ map',+ concat,+ concatMap,+ gate,+ gate',+ filter,+ filter',+ reverse,+ sort,+ sortBy++) where++-- Prelude++import Prelude hiding (+ id,+ (.),+ null,+ length,+ map,+ concat,+ concatMap,+ filter,+ reverse,+ foldl)+import qualified Prelude++-- Control++import Control.Category+import Control.Monad.ST.Lazy+import Control.Monad.Trans.Class+import Control.Monad.Trans.Order++-- Data++import Data.Monoid+import Data.Foldable (foldl, asum, toList)+import Data.Traversable (traverse)+import Data.FingerTree (FingerTree, Measured (measure))+import qualified Data.FingerTree as FingerTree+import Data.Sequence (Seq, (><))+import qualified Data.Sequence as Seq+import Data.Set (Set)+import qualified Data.Set as Set+import Data.STRef.Lazy+import Data.MultiChange (MultiChange)+import qualified Data.MultiChange as MultiChange+import Data.Incremental+import qualified Data.Incremental.Tuple as Tuple++{-NOTE:+ Naming policy:++ • Data of argument transformations gets additional text, like “elem”.++ • Data related to input of a transformation gets an ordinary identifier,+ and the corresponding data related to output gets the same identifier+ with a prime.++ • Data that refers to the situation after applying a change gets an+ identifier that starts with “new”, and the corresponding data that+ refers to the situation before applying this change gets the+ corresponding identifier that starts with “old”.+-}++-- * Changes++instance Changeable a => Changeable (Seq a) where++ type DefaultChange (Seq a) = MultiChange (AtomicChange a)++insert :: Int -> Seq a -> DefaultChange (Seq a)+insert ix seq = MultiChange.singleton (Insert ix seq)++delete :: Int -> Int -> DefaultChange (Seq a)+delete ix len = MultiChange.singleton (Delete ix len)++shift :: Int -> Int -> Int -> DefaultChange (Seq a)+shift src len tgt = MultiChange.singleton (Shift src len tgt)++changeAt :: Int -> DefaultChange a -> DefaultChange (Seq a)+changeAt ix change = MultiChange.singleton (ChangeAt ix change)++-- * Atomic changes++data AtomicChange a = Insert !Int (Seq a)+ | Delete !Int !Int+ | Shift !Int !Int !Int+ | ChangeAt !Int (DefaultChange a)+{-FIXME:+ Are these strictness annotations sensible? Should the sequence be strict?+-}++{-NOTE:+ Change application for sequences is total. It uses forms of saturation to+ achieve this. All the transformations must work correctly also in the+ saturation cases. At the time of writing, they do.+-}+instance Changeable a => Change (AtomicChange a) where++ type Value (AtomicChange a) = Seq a++ Insert ix seq' $$ seq = applyInsert ix seq' seq++ Delete ix len $$ seq = applyDelete ix len seq++ Shift src len tgt $$ seq = applyShift src len tgt seq++ ChangeAt ix change $$ seq+ | indexInBounds (Seq.length seq) ix+ = front >< (change $$ elem) Seq.<| rear+ | otherwise+ = seq where++ (front, rest) = Seq.splitAt ix seq++ (elem Seq.:< rear) = Seq.viewl rest++applyInsert :: Int -> Seq a -> Seq a -> Seq a+applyInsert ix seq' seq = front >< seq' >< rear where++ (front, rear) = Seq.splitAt ix seq++applyDelete :: Int -> Int -> Seq a -> Seq a+applyDelete ix len seq = front >< rear where++ (front, rest) = Seq.splitAt ix seq++ (_, rear) = Seq.splitAt len rest++applyShift :: Int -> Int -> Int -> Seq a -> Seq a+applyShift src len tgt seq = applyInsert tgt mid (front >< rear) where++ (front, rest) = Seq.splitAt src seq++ (mid, rear) = Seq.splitAt len rest++normalizeAtomicChange :: Int -> AtomicChange a -> AtomicChange a+normalizeAtomicChange totalLen (Insert ix seq) = Insert ix' seq where++ ix' = normalizeIx totalLen ix++normalizeAtomicChange totalLen (Delete ix len) = Delete ix' len' where++ (ix', len') = normalizeIxAndLen totalLen ix len++normalizeAtomicChange totalLen (Shift src len tgt) = Shift src' len' tgt' where++ (src', len') = normalizeIxAndLen totalLen src len++ tgt' = normalizeIx (totalLen - len') tgt++normalizeAtomicChange totalLen (ChangeAt ix change) = ChangeAt ix' change where++ ix' | indexInBounds totalLen ix = ix+ | otherwise = totalLen++normalizeIx :: Int -> Int -> Int+normalizeIx totalLen ix = (ix `max` 0) `min` totalLen++normalizeIxAndLen :: Int -> Int -> Int -> (Int, Int)+normalizeIxAndLen totalLen ix len = (ix', len') where++ ix' = normalizeIx totalLen ix++ len' = (len `max` 0) `min` (totalLen - ix')++noChange :: Changeable a => AtomicChange a+noChange = ChangeAt (-1) mempty++changeLength :: AtomicChange a -> Int -> Int+changeLength (Insert _ seq) totalLength = totalLength + Seq.length seq+changeLength (Delete _ len) totalLength = totalLength - len+changeLength (Shift _ _ _) totalLength = totalLength+changeLength (ChangeAt _ _) totalLength = totalLength+-- NOTE: The given change must be normal.++indexInBounds :: Int -> Int -> Bool+indexInBounds len ix = ix >= 0 && ix < len++-- * Transformations++-- ** Singleton construction++singleton :: Changeable a => a ->> Seq a+singleton = simpleTrans Seq.singleton (changeAt 0)++-- ** Two-element sequence construction++fromPair :: Changeable a => (a, a) ->> Seq a+fromPair = MultiChange.map $ simpleTrans fun prop where++ fun ~(val1, val2) = Seq.fromList [val1, val2]++ prop (Tuple.First change) = ChangeAt 0 change+ prop (Tuple.Second change) = ChangeAt 1 change++-- ** Concatenation of two sequences++cat :: Changeable a => (Seq a, Seq a) ->> Seq a+cat = concat . fromPair++-- ** Length queries++null :: Changeable a => Seq a ->> Bool+null = fromFunction (== 0) . length++length :: Changeable a => Seq a ->> Int+length = MultiChange.composeMap $ stateTrans init prop where++ init seq = (len, len) where++ len = Seq.length seq++ prop change state = (ReplaceBy len', len') where++ normChange = normalizeAtomicChange state change++ len' = changeLength normChange state++-- ** Mapping++map :: (Changeable a, Changeable b) => (a ->> b) -> Seq a ->> Seq b+map trans = MultiChange.map $ stTrans (\ seq -> do+ let elemProc = toSTProc trans+ let seqInit seq = do+ procOutputs <- traverse elemProc seq+ return (fmap fst procOutputs, fmap snd procOutputs)+ (seq', elemProps) <- seqInit seq+ elemPropsRef <- newSTRef elemProps+ let prop (Insert ix seq) = do+ (seq', elemProps) <- seqInit seq+ modifySTRef elemPropsRef (applyInsert ix elemProps)+ return (Insert ix seq')+ prop (Delete ix len) = do+ modifySTRef elemPropsRef (applyDelete ix len)+ return (Delete ix len)+ prop (Shift src len tgt) = do+ modifySTRef elemPropsRef (applyShift src len tgt)+ return (Shift src len tgt)+ prop (ChangeAt ix change) = do+ elemProps <- readSTRef elemPropsRef+ if indexInBounds (Seq.length elemProps) ix+ then do+ let elemProp = Seq.index elemProps ix+ change' <- elemProp change+ return (ChangeAt ix change')+ else return noChange+ return (seq', prop))++map' :: (Changeable a, DefaultChange a ~ PrimitiveChange a,+ Changeable b, DefaultChange b ~ PrimitiveChange b) =>+ (a -> b) -> Seq a ->> Seq b+map' fun = MultiChange.map $ simpleTrans (fmap fun) prop where++ prop (Insert ix seq) = Insert ix (fmap fun seq)+ prop (Delete ix len) = Delete ix len+ prop (Shift src len tgt) = Shift src len tgt+ prop (ChangeAt ix change) = ChangeAt ix (fmap fun change)++-- ** Concatenation of multiple sequences++seqConcat :: Seq (Seq a) -> Seq a+seqConcat = asum++newtype ConcatStateElement = ConcatStateElement Int++data ConcatStateMeasure = ConcatStateMeasure {+ sourceLength :: Int,+ targetLength :: Int+ }++instance Monoid ConcatStateMeasure where++ mempty = ConcatStateMeasure 0 0++ mappend (ConcatStateMeasure srcLen1 tgtLen1)+ (ConcatStateMeasure srcLen2 tgtLen2) = measure' where++ measure' = ConcatStateMeasure (srcLen1 + srcLen2) (tgtLen1 + tgtLen2)++instance Measured ConcatStateMeasure ConcatStateElement where++ measure (ConcatStateElement elLen) = ConcatStateMeasure 1 elLen++type ConcatState = FingerTree ConcatStateMeasure ConcatStateElement++seqToConcatState :: Seq (Seq a) -> ConcatState+seqToConcatState = FingerTree.fromList .+ toList .+ fmap (ConcatStateElement . Seq.length)++concat :: Changeable a => Seq (Seq a) ->> Seq a+concat = MultiChange.bind $ stateTrans init prop where++ init seq = (seqConcat seq, seqToConcatState seq)++ prop (Insert ix seq) state = (change', state') where++ (ix', front, rear) = splitAndTranslate ix state++ change' = insert ix' (seqConcat seq)++ state' = front <> seqToConcatState seq <> rear++ prop (Delete ix len) state = (change', state') where++ (ix', front, rest) = splitAndTranslate ix state++ (len', _, rear) = splitAndTranslate len rest++ change' = delete ix' len'++ state' = front <> rear++ prop (Shift src len tgt) state = (change', state') where++ (src', front, rest) = splitAndTranslate src state++ (len', mid, rear) = splitAndTranslate len rest++ (tgt', front', rear') = splitAndTranslate tgt (front <> rear)++ change' = shift src' len' tgt'++ state' = front' <> mid <> rear'++ prop (ChangeAt ix change) state+ | indexInBounds len ix = (change', state')+ | otherwise = (mempty, state) where++ len = sourceLength (measure state)++ (ix', front, rest) = splitAndTranslate ix state++ (ConcatStateElement elemLen FingerTree.:< rear) = FingerTree.viewl rest++ (change', elemLen') = foldl next (mempty, elemLen) change where++ next (curChange, curElemLen) atomic = (curChange', curElemLen') where++ normAtomic = normalizeAtomicChange curElemLen atomic++ shiftedNormAtomic = case normAtomic of+ Insert elemIx seq+ -> Insert (ix' + elemIx) seq+ Delete elemIx curElemLen+ -> Delete (ix' + elemIx) curElemLen+ Shift elemSrc curElemLen elemTgt+ -> Shift (ix' + elemSrc) curElemLen (ix' + elemTgt)+ ChangeAt elemIx change+ -> if indexInBounds curElemLen elemIx+ then ChangeAt (ix' + elemIx) change+ else noChange++ curChange' = MultiChange.singleton shiftedNormAtomic `mappend`+ curChange++ curElemLen' = changeLength normAtomic curElemLen+ -- NOTE: Strictness is not perfect.+ -- FIXME: One line too wide.++ state' = front <> (ConcatStateElement elemLen' FingerTree.<| rear)+ {-NOTE:+ This is a bit fishy. Even if the inner change is illegal, we get a+ non-⊥ state. So the state is not always a property of the original+ value. If the original value is ⊥, the state might not be ⊥.+ However, this should not result in violation of the main property+ that changing and then transforming is the same as transforming and+ then changing with the propagated change. We would propagate to+ non-⊥ changes in the future, but applying these to ⊥ yields ⊥. The+ latter might not always be the case, but it is the case for+ sequences.+ -}++ splitAndTranslate :: Int -> ConcatState -> (Int, ConcatState, ConcatState)+ splitAndTranslate ix state = (ix', front, rear) where++ (front, rear) = FingerTree.split ((> ix) . sourceLength) state++ ix' = targetLength (measure front)++-- ** Monadic bind++concatMap :: (Changeable a, Changeable b) => (a ->> Seq b) -> Seq a ->> Seq b+concatMap trans = concat . map trans++-- ** Gates++gate :: Changeable a => (a ->> Bool) -> a ->> Seq a+gate prd = stTrans (\ val -> do+ valRef <- newSTRef val+ ~(accepted, prop) <- toSTProc prd val+ acceptedRef <- newSTRef accepted+ let prop' change = do+ oldVal <- readSTRef valRef+ let newVal = change $$ oldVal+ writeSTRef valRef newVal+ acceptedChange <- prop change+ oldAccepted <- readSTRef acceptedRef+ let newAccepted = acceptedChange $$ oldAccepted+ writeSTRef acceptedRef newAccepted+ return $ case (oldAccepted, newAccepted) of+ (False, False) -> mempty+ (False, True) -> insert 0 (Seq.singleton newVal)+ (True, False) -> delete 0 1+ (True, True) -> changeAt 0 change+ return (emptyOrSingleton accepted val, prop'))+{-FIXME:+ Consider factoring out at least the update of values and accepted flags.+-}+{-FIXME:+ Here we seem to use the apostrophe to distinguish between argument+ transformation and result transformation, which does not seem to be coherent+ with the rest of this module.+-}++gate' :: (Changeable a, DefaultChange a ~ PrimitiveChange a) =>+ (a -> Bool) -> a ->> Seq a+gate' prd = stateTrans init prop where++ init val = (emptyOrSingleton accepted val, accepted) where++ accepted = prd val++ prop Keep oldAccepted = (mempty, oldAccepted)+ prop (ReplaceBy val) oldAccepted = (change', newAccepted) where++ change' = case (oldAccepted, newAccepted) of+ (False, False) -> mempty+ (False, True) -> insert 0 (Seq.singleton val)+ (True, False) -> delete 0 1+ (True, True) -> changeAt 0 (ReplaceBy val)++ newAccepted = prd val++emptyOrSingleton :: Bool -> a -> Seq a+emptyOrSingleton accepted val | accepted = Seq.singleton val+ | otherwise = Seq.empty++-- ** Filtering++filter :: Changeable a => (a ->> Bool) -> Seq a ->> Seq a+filter = concatMap . gate++filter' :: (Changeable a, DefaultChange a ~ PrimitiveChange a) =>+ (a -> Bool) -> Seq a ->> Seq a+filter' = concatMap . gate'++-- FIXME: Maybe add partition and partition'.++-- ** Reversal++reverse :: Changeable a => Seq a ->> Seq a+reverse = MultiChange.map $ stateTrans init prop where++ init seq = (Seq.reverse seq, Seq.length seq)++ prop change state = propNorm (normalizeAtomicChange state change) state++ propNorm change state = (propCore change state, changeLength change state)++ propCore (Insert ix seq) state = change' where++ change' = Insert (state - ix) (Seq.reverse seq)++ propCore (Delete ix len) state = change' where++ change' = Delete (state - (ix + len)) len++ propCore (Shift src len tgt) state = change' where++ change' = Shift (state - (src + len)) len (state - len - tgt)++ propCore (ChangeAt ix elemChange) state = change' where++ change' = ChangeAt (state - ix - 1) elemChange++-- ** Sorting++sort :: (Ord a, Changeable a) => Seq a ->> Seq a+sort = MultiChange.bind $ orderSTTrans (\ seq -> do+ let seq' = Seq.sort seq+ initTaggedSeq <- traverse (\ elem -> fmap ((,) elem) newMaximum) seq+ let initTaggedSet = Set.fromList (toList initTaggedSeq)+ taggedSeqRef <- lift $ newSTRef initTaggedSeq+ taggedSetRef <- lift $ newSTRef initTaggedSet+ let performInsert ix elem = do+ taggedSeq <- lift $ readSTRef taggedSeqRef+ let (front, rest) = Seq.splitAt ix taggedSeq+ tag <- case Seq.viewl rest of+ Seq.EmptyL -> newMaximum+ (_, neighborTag) Seq.:< _ -> newBefore neighborTag+ lift $ writeSTRef taggedSeqRef (front >< (elem, tag) Seq.<| rest)+ oldTaggedSet <- lift $ readSTRef taggedSetRef+ let newTaggedSet = Set.insert (elem, tag) oldTaggedSet+ lift $ writeSTRef taggedSetRef newTaggedSet+ return (Set.findIndex (elem, tag) newTaggedSet)+ let performDelete ix = do+ taggedSeq <- lift $ readSTRef taggedSeqRef+ let (front, rest) = Seq.splitAt ix taggedSeq+ let (elem, tag) Seq.:< rear = Seq.viewl rest+ lift $ writeSTRef taggedSeqRef (front >< rear)+ taggedSet <- lift $ readSTRef taggedSetRef+ lift $ writeSTRef taggedSetRef+ (Set.delete (elem, tag) taggedSet)+ return (Set.findIndex (elem, tag) taggedSet)+ let elemInsert ix elem = do+ ix' <- performInsert ix elem+ return (Insert ix' (Seq.singleton elem))+ let elemDelete ix = do+ ix' <- performDelete ix+ return (Delete ix' 1)+ let elemShift src tgt = do+ taggedSeq <- lift $ readSTRef taggedSeqRef+ let elem = fst (Seq.index taggedSeq src)+ src' <- performDelete src+ tgt' <- performInsert tgt elem+ return (Shift src' 1 tgt')+ let propNorm (Insert ix seq) = do+ changes' <- traverse (elemInsert ix) (Prelude.reverse (toList seq))+ return (MultiChange.fromList changes')+ propNorm (Delete ix len) = do+ changes' <- traverse elemDelete (replicate len ix)+ return (MultiChange.fromList changes')+ propNorm (Shift src len tgt) = (case compare src tgt of+ LT -> genShifts (Prelude.reverse [0 .. len - 1])+ GT -> genShifts [0 .. len - 1]+ EQ -> return mempty) where++ genShifts offsets = do+ changes' <- traverse genShift offsets+ return (MultiChange.fromList changes')++ genShift offset = elemShift (src + offset) (tgt + offset)++ propNorm (ChangeAt ix change) = do+ taggedSeq <- lift $ readSTRef taggedSeqRef+ if indexInBounds (Seq.length taggedSeq) ix+ then do+ let (oldElem, _) = Seq.index taggedSeq ix+ let newElem = change $$ oldElem+ src' <- performDelete ix+ tgt' <- performInsert ix newElem+ return (shift src' 1 tgt' `mappend` changeAt src' change)+ else return mempty+ let prop change = do+ taggedSeq <- lift $ readSTRef taggedSeqRef+ propNorm (normalizeAtomicChange (Seq.length taggedSeq) change)+ return (seq', prop))++orderSTTrans :: (forall o s . TransProc (OrderT o (ST s)) p q) -> Trans p q+orderSTTrans transProc = trans (\ cont -> runST (evalOrderT (cont transProc)))++sortBy :: Changeable a => (a -> a -> Ordering) -> Seq a ->> Seq a+sortBy compare = map fromOrderValue . sort . map (toOrderValue compare)+{-FIXME:+ In the future, we maybe should have a sortBy that takes a compare+ transformation instead of a compare function.+-}++data OrderValue a = OrderValue (a -> a -> Ordering) a++instance Eq (OrderValue a) where++ orderVal1 == orderVal2 = compare orderVal1 orderVal2 == EQ++instance Ord (OrderValue a) where++ compare (OrderValue compare val1) (OrderValue _ val2) = compare val1 val2++newtype OrderChange p = OrderChange p deriving Monoid++instance Change p => Change (OrderChange p) where++ type Value (OrderChange p) = OrderValue (Value p)++ OrderChange change $$ OrderValue compare val = OrderValue compare $+ change $$ val++instance Changeable a => Changeable (OrderValue a) where++ type DefaultChange (OrderValue a) = OrderChange (DefaultChange a)++toOrderValue :: Changeable a => (a -> a -> Ordering) -> a ->> OrderValue a+toOrderValue compare = simpleTrans (OrderValue compare) OrderChange++fromOrderValue :: Changeable a => OrderValue a ->> a+fromOrderValue = simpleTrans (\ (OrderValue _ val) -> val)+ (\ (OrderChange change) -> change)
+ src/library/Data/Incremental/Tuple.hs view
@@ -0,0 +1,92 @@+module Data.Incremental.Tuple (++ {-NOTE:+ We would have liked to re-export (,), like we re-export Seq from+ Data.Incremental.Sequence. However, we could not find a way to+ re-export (,).+ -}++ -- * Changes++ first,+ second,++ -- * Atomic changes++ AtomicChange (First, Second),++ -- * Transformations++ (&&&),+ fst,+ snd,+ swap++) where++-- Prelude++import Prelude hiding (fst, snd)+import qualified Prelude++-- Data++import Data.Monoid (Monoid (mempty, mappend))+import qualified Data.Tuple as Tuple+import Data.MultiChange (MultiChange)+import qualified Data.MultiChange as MultiChange+import Data.Incremental++-- * Changes++instance (Changeable a, Changeable b) => Changeable (a, b) where++ type DefaultChange (a, b) = MultiChange (AtomicChange a b)++first :: DefaultChange a -> DefaultChange (a, b)+first = MultiChange.singleton . First++second :: DefaultChange b -> DefaultChange (a, b)+second = MultiChange.singleton . Second++-- * Atomic changes++data AtomicChange a b = First (DefaultChange a) | Second (DefaultChange b)++instance (Changeable a, Changeable b) => Change (AtomicChange a b) where++ type Value (AtomicChange a b) = (a, b)++ First change $$ (val1, val2) = (change $$ val1, val2)+ Second change $$ (val1, val2) = (val1, change $$ val2)++-- * Transformations++(&&&) :: (Changeable a, Changeable b, Changeable c) =>+ (a ->> b) -> (a ->> c) -> (a ->> (b, c))+trans1 &&& trans2 = stTrans (\ val -> do+ ~(val1, prop1) <- toSTProc trans1 val+ ~(val2, prop2) <- toSTProc trans2 val+ let prop change = do+ change1 <- prop1 change+ change2 <- prop2 change+ return (first change1 `mappend` second change2)+ return ((val1, val2), prop))++fst :: (Changeable a, Changeable b) => (a, b) ->> a+fst = MultiChange.composeMap $ simpleTrans Prelude.fst prop where++ prop (First change) = change+ prop (Second _) = mempty++snd :: (Changeable a, Changeable b) => (a, b) ->> b+snd = MultiChange.composeMap $ simpleTrans Prelude.snd prop where++ prop (First _) = mempty+ prop (Second change) = change++swap :: (Changeable a, Changeable b) => (a, b) ->> (b, a)+swap = MultiChange.map $ simpleTrans Tuple.swap prop where++ prop (First change) = Second change+ prop (Second change) = First change
+ src/library/Data/MultiChange.hs view
@@ -0,0 +1,122 @@+module Data.MultiChange (++ -- * Type++ MultiChange,++ -- * Construction++ singleton,+ fromList,++ -- * Monad structure++ map,+ return,+ join,+ bind,++ -- * Multi composition++ compose,+ composeMap++) where++-- Prelude++import Prelude hiding (id, (.), map, return)+import qualified Prelude+{-FIXME:+ After establishment of the Applicative–Monad proposal, we have to optionally+ hide join.+-}++-- Control++import Control.Category+import Control.Arrow (second)+import Control.Monad (liftM)++-- Data++import Data.Monoid+import Data.Foldable as Foldable+import qualified Data.List as List+import Data.DList (DList)+import qualified Data.DList as DList+import Data.Incremental++-- * Type++newtype MultiChange p = MultiChange (Dual (DList p)) deriving Monoid++instance Show p => Show (MultiChange p) where++ showsPrec prec xs = showParen (prec > 10) $+ showString "fromList " . shows (toList xs)+ -- NOTE: This is basically taken from Data.Sequence.++instance Read p => Read (MultiChange p) where++ readsPrec prec = readParen (prec > 10) $ \ str -> do+ ("fromList", rest) <- lex str+ (list, rest') <- reads rest+ Prelude.return (fromList list, rest')+ -- NOTE: This is basically taken from Data.Sequence.++instance Foldable MultiChange where++ foldMap fun (MultiChange (Dual dList)) = foldMap fun dList++ foldr next init (MultiChange (Dual dList)) = Foldable.foldr next init dList++instance Change p => Change (MultiChange p) where++ type Value (MultiChange p) = Value p++ change $$ val = List.foldl' (flip ($$)) val (toList change)++-- * Construction++singleton :: p -> MultiChange p+singleton = MultiChange . Dual . DList.singleton++{-NOTE:+ The lists are “in diagramatic order” (first atomic change at the beginning).+-}++fromList :: [p] -> MultiChange p+fromList = MultiChange . Dual . DList.fromList++-- * Monad structure++map :: Trans p q -> Trans (MultiChange p) (MultiChange q)+map trans = stTrans (\ val -> do+ ~(val', prop) <- toSTProc trans val+ let multiProp change = do+ atomics' <- mapM prop (toList change)+ Prelude.return (fromList atomics')+ Prelude.return (val', multiProp))++return :: Trans p (MultiChange p)+return = simpleTrans id singleton++join :: Trans (MultiChange (MultiChange p)) (MultiChange p)+join = compose++bind :: Trans p (MultiChange q) -> Trans (MultiChange p) (MultiChange q)+bind = composeMap++-- * Multi composition++compose :: Monoid p => Trans (MultiChange p) p+compose = simpleTrans id (mconcat . reverse . toList)+{-FIXME:+ Check whether the use of mconcat . reverse is questionable regarding space+ usage or strictness. If it is, consider using foldr (flip mappend) mempty+ instead.+-}++composeMap :: Monoid q => Trans p q -> Trans (MultiChange p) q+composeMap trans = compose . map trans
+ src/test-suites/TestSuite.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE UndecidableInstances #-}+module TestSuite (++ -- * Changes++ AtomicAChange (DoubleAndAdd),+ AtomicBChange (TripleAndAdd),++ -- * Test functions and transformations++ testTrans,+ testFun,+ testPrdTrans,+ testPrdFun,+ testCompare,++ -- * Test pattern++ transTest++) where++-- Prelude++import Prelude hiding (id, (.))++-- Control++import Control.Category+import Control.Applicative++-- Data++import Data.Foldable (toList)+import Data.MultiChange (MultiChange)+import qualified Data.MultiChange as MultiChange+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Incremental+import qualified Data.Incremental.Tuple as Tuple+import qualified Data.Incremental.Sequence as Seq++-- Test++import Test.QuickCheck+import Test.QuickCheck.Poly++-- Distribution++import Distribution.TestSuite+import Distribution.TestSuite.QuickCheck++-- * Test data generation++instance Arbitrary a => Arbitrary (Seq a) where++ arbitrary = fmap Seq.fromList arbitrary++ shrink seq = map Seq.fromList (shrink (toList seq))++-- * Changes++-- ** Common changes++instance Arbitrary a => Arbitrary (PrimitiveChange a) where++ arbitrary = frequency [(1, keepGen), (5, replaceGen)] where++ keepGen = return Keep++ replaceGen = fmap ReplaceBy arbitrary++ shrink Keep = []+ shrink (ReplaceBy val) = Keep : map ReplaceBy (shrink val)++instance Arbitrary p => Arbitrary (MultiChange p) where++ arbitrary = fmap MultiChange.fromList arbitrary++ shrink change = map MultiChange.fromList (shrink (toList change))++-- ** Pair changes++deriving instance (Show (DefaultChange a), Show (DefaultChange b)) =>+ Show (Tuple.AtomicChange a b)++instance (Arbitrary (DefaultChange a), Arbitrary (DefaultChange b)) =>+ Arbitrary (Tuple.AtomicChange a b) where++ arbitrary = oneof [firstGen, secondGen] where++ firstGen = fmap Tuple.First arbitrary++ secondGen = fmap Tuple.Second arbitrary++ shrink (Tuple.First change) = map Tuple.First (shrink change)+ shrink (Tuple.Second change) = map Tuple.Second (shrink change)++-- ** Sequence changes++deriving instance (Show a, Show (DefaultChange a)) => Show (Seq.AtomicChange a)++instance (Arbitrary a, Arbitrary (DefaultChange a)) =>+ Arbitrary (Seq.AtomicChange a) where++ arbitrary = oneof [insertGen, deleteGen, shiftGen, changeAtGen] where++ insertGen = liftA2 Seq.Insert arbitrary arbitrary++ deleteGen = liftA2 Seq.Delete arbitrary arbitrary++ shiftGen = liftA3 Seq.Shift arbitrary arbitrary arbitrary++ changeAtGen = liftA2 Seq.ChangeAt arbitrary arbitrary++ shrink (Seq.Insert ix seq)+ = [Seq.Insert ix' seq'+ | (ix', seq') <- shrink (ix, seq)]+ shrink (Seq.Delete ix len)+ = [Seq.Delete ix' len'+ | (ix', len') <- shrink (ix, len)]+ shrink (Seq.Shift src len tgt)+ = [Seq.Shift src' len' tgt'+ | (src', len', tgt') <- shrink (src, len, tgt)]+ shrink (Seq.ChangeAt ix change)+ = [Seq.ChangeAt ix' change'+ | (ix', change') <- shrink (ix, change)]++-- ** Element changes++newtype AtomicAChange = DoubleAndAdd Integer deriving (Show, Arbitrary)++instance Change AtomicAChange where++ type Value AtomicAChange = A++ DoubleAndAdd diff $$ A integer = A (2 * integer + diff)++instance Changeable A where++ type DefaultChange A = MultiChange AtomicAChange++deriving instance Ord A++newtype AtomicBChange = TripleAndAdd Integer deriving (Show, Arbitrary)++instance Change AtomicBChange where++ type Value AtomicBChange = B++ TripleAndAdd diff $$ B integer = B (3 * integer + diff)++instance Changeable B where++ type DefaultChange B = MultiChange AtomicBChange++instance Changeable C++-- * Test functions and transformations++testTrans :: A ->> B+testTrans = MultiChange.map $ stateTrans init prop where++ init (A integer) = (B integer, integer)++ prop (DoubleAndAdd diff) state = (change', state') where++ change' = TripleAndAdd (diff - state)++ state' = 2 * state + diff++testFun :: C -> C+testFun = id++testPrdTrans :: A ->> Bool+testPrdTrans = MultiChange.composeMap $ stateTrans init prop where++ init (A integer) = (testPrd integer, integer)++ prop (DoubleAndAdd diff) state = (change', state') where++ change' = ReplaceBy (testPrd state')++ state' = 2 * state + diff++testPrdFun :: C -> Bool+testPrdFun = testPrd . unC++testPrd :: Integer -> Bool+testPrd = (>= 0)++testCompare :: A -> A -> Ordering+testCompare (A integer1) (A integer2) = compare (integer1 `div` 3)+ (integer2 `div` 3)++-- * Test pattern++transTest :: (Show a, Arbitrary a, Changeable a,+ Show (DefaultChange a), Arbitrary (DefaultChange a),+ Eq b, Changeable b) =>+ String -> (a ->> b) -> (a -> b) -> Test+transTest name trans fun = testProperty name prop where++ prop valAndChanges = map fun (applyChanges valAndChanges) ==+ applyChanges valAndChanges' where++ valAndChanges' = runTrans trans valAndChanges++applyChanges :: Change p => (Value p, [p]) -> [Value p]+applyChanges (val, changes) = scanl (flip ($$)) val changes
+ src/test-suites/TestSuite/Sequence.hs view
@@ -0,0 +1,73 @@+module TestSuite.Sequence (++ tests++) where++-- Data++import Data.Foldable (asum)+import Data.Incremental+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import qualified Data.Incremental.Sequence as IncSeq++-- Test++import Test.QuickCheck+import Test.QuickCheck.Poly++-- Distribution++import Distribution.TestSuite++-- TestSuite+import TestSuite++-- * Tests++tests :: IO [Test]+tests = return [transTest "singleton" IncSeq.singleton+ (Seq.singleton :: A -> Seq A),+ transTest "fromPair" IncSeq.fromPair+ (seqFromPair :: (A, A) -> Seq A),+ transTest "cat" IncSeq.cat+ (seqCat :: (Seq A, Seq A) -> Seq A),+ transTest "null" IncSeq.null+ (Seq.null :: Seq A -> Bool),+ transTest "length" IncSeq.length+ (Seq.length :: Seq A -> Int),+ transTest "map" (IncSeq.map testTrans)+ (fmap (toFunction testTrans)),+ transTest "map'" (IncSeq.map' testFun)+ (fmap testFun),+ transTest "concat" IncSeq.concat+ (seqConcat :: Seq (Seq A) -> Seq A),+ transTest "gate" (IncSeq.gate testPrdTrans)+ (seqGate (toFunction testPrdTrans)),+ transTest "gate'" (IncSeq.gate' testPrdFun)+ (seqGate testPrdFun),+ transTest "filter" (IncSeq.filter testPrdTrans)+ (Seq.filter (toFunction testPrdTrans)),+ transTest "filter'" (IncSeq.filter' testPrdFun)+ (Seq.filter testPrdFun),+ transTest "reverse" IncSeq.reverse+ (Seq.reverse :: Seq A -> Seq A),+ transTest "sort" IncSeq.sort+ (Seq.sort :: Seq A -> Seq A),+ transTest "sortBy" (IncSeq.sortBy testCompare)+ (Seq.sortBy testCompare)]+-- FIXME: Explain why we have no test for concatMap.++seqFromPair :: (a, a) -> Seq a+seqFromPair (val1, val2) = Seq.fromList [val1, val2]++seqCat :: (Seq a, Seq a) -> Seq a+seqCat = uncurry (Seq.><)++seqConcat :: Seq (Seq a) -> Seq a+seqConcat = asum++seqGate :: (a -> Bool) -> a -> Seq a+seqGate prd val | prd val = Seq.singleton val+ | otherwise = Seq.empty