[darcs-users] [patch273] Haddock merge2FL and fastRemoveFL in Pat... (and 4 more)
Eric Kow
kowey at darcs.net
Tue Jun 8 10:10:35 UTC 2010
Hey,
It's 11:10 here and I should probably be starting on that Day Job.
I'm going to apply the most obvious bits of this bundle. Florent,
would you mind having a look at this one, please?
On Mon, Jun 07, 2010 at 20:06:18 +0000, Petr Ročkai wrote:
> This is a work-in-progress bundle, sort of. I guess it could be merged, modulo
> the "get.sh" extension that currently fails and needs fixing, or renaming to
> failing-. Presumably, most of this *should* go into our first 2.5 alpha.
OK
> However, the code should be ready to handle issue1014 and friends, all that
> needs to be done is relaxing the error conditions. This may involve passing the
> "middle" bit of the findCommonAndUncommon result down the chain, probably as
> far as tentativelyMergePatches, which can then decide if the nonemptiness of
> the "middle" section is legit (duplicate patches) or is a bug (patchinfo
> collision or maybe patch corruption).
I think we need to introduce some extra-evil issue1014 friends.
Can QuickCheck help?
> Mon Jun 7 20:48:49 CEST 2010 Petr Rockai <me at mornfall.net>
> * Haddock merge2FL and fastRemoveFL in Patch.Depends.
>
> Mon Jun 7 20:50:41 CEST 2010 Petr Rockai <me at mornfall.net>
> * Extend the issue1014 test to check that named patches are not duplicated.
Applied these two!
> Mon Jun 7 20:49:34 CEST 2010 Petr Rockai <me at mornfall.net>
> * Use merge2FL instead of plain merge in tentativelMergePatches.
>
> Mon Jun 7 20:50:10 CEST 2010 Petr Rockai <me at mornfall.net>
> * Extend the get test to cover --context interaction with tags.
>
> Mon Jun 7 21:59:12 CEST 2010 Petr Rockai <me at mornfall.net>
> * Make partitionFL do a 3-way split, and detect commutation bugs in Depends.
Eek, grown-up needed!
Haddock merge2FL and fastRemoveFL in Patch.Depends.
---------------------------------------------------
> +-- | Merge two FLs (say L and R), starting in a common context. The result is a
> +-- FL starting in the original end context of L, going to a new context that is
> +-- the result of applying all patches from R on top of patches from L. This
> +-- version also correctly handles duplicate patches.
What would not correctly handling duplicate patches consist of?
> merge2FL :: RepoPatch p => FL (PatchInfoAnd p) C(x y)
> -> FL (PatchInfoAnd p) C(x z)
> -> Sealed (FL (PatchInfoAnd p) C(y))
Reviewing Haddock patches is interesting because you read the Haddock
and you read the code and you try to think about whether the two fit
together (but if you're like me, your reading of the code is most
definitely influenced by the haddock). Thanks for documenting these.
It does indeed seem to provide the kind of context you can't just get by
looking at the code.
> +-- whenever the patch has been found and removed. If the patch is not present
> +-- in the sequence at all or any commutation fails, we get Nothing. First two
> +-- cases are optimisations for the common cases where the head of the list is
> +-- the patch to remove, or the patch is not there at all.
Use merge2FL instead of plain merge in tentativelMergePatches.
--------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20100607184934
> Ignore-this: 9fde612f399cab5553e9cf57e0764685
> ] hunk ./src/Darcs/Patch/Depends.hs 33
> getPatchesBeyondTag, getPatchesInTag,
> splitOnTag,
> newsetUnion, newsetIntersection,
> - commuteToEnd, findCommonAndUncommon
> + commuteToEnd, findCommonAndUncommon, merge2FL
> ) where
> import Data.List ( delete, intersect, (\\) )
>
> hunk ./src/Darcs/Repository/Merge.hs 37
> import Darcs.Patch
> ( RepoPatch, Prim, merge, joinPatches, listTouchedFiles
> , patchcontents, anonymous, fromPrims, effect )
> +import Darcs.Patch.Depends( merge2FL )
> import Progress( debugMessage )
> import Darcs.ProgressPatches( progressFL )
> import Darcs.Witnesses.Sealed( Sealed(Sealed), seal )
> hunk ./src/Darcs/Repository/Merge.hs 58
> tentativelyMergePatches_ mc r cmd opts usi themi =
> do let us = mapFL_FL hopefully usi
> them = mapFL_FL hopefully themi
> - _ :/\: pc <- return $ merge (progressFL "Merging them" them :\/: progressFL "Merging us" us)
> + Sealed pc <- return $ merge2FL (progressFL "Merging them" usi) (progressFL "Merging us" themi)
> pend <- unrecordedChanges opts r []
> hunk ./src/Darcs/Repository/Merge.hs 60
> - anonpend <- anonymous (fromPrims pend)
> + anonpend <- n2pia `fmap` anonymous (fromPrims pend)
> pend' :/\: pw <- return $ merge (pc :\/: anonpend :>: NilFL)
> hunk ./src/Darcs/Repository/Merge.hs 62
> - let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $ mapFL_FL patchcontents pw
> + let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $
> + mapFL_FL (patchcontents . hopefully) pw
> Sealed standard_resolved_pw <- return $ standardResolution pwprim
> debugMessage "Checking for conflicts..."
> unless (AllowConflicts `elem` opts || NoAllowConflicts `elem` opts) $
> hunk ./src/Darcs/Repository/Merge.hs 71
> debugMessage "Announcing conflicts..."
> have_conflicts <- announceMergeConflicts cmd opts standard_resolved_pw
> debugMessage "Checking for unrecorded conflicts..."
> - have_unrecorded_conflicts <- checkUnrecordedConflicts opts pc
> + have_unrecorded_conflicts <- checkUnrecordedConflicts opts $ mapFL_FL hopefully pc
> debugMessage "Reading working directory..."
> working <- readUnrecorded r
> debugMessage "Working out conflicts in actual working directory..."
> hunk ./src/Darcs/Repository/Merge.hs 88
> when (mc == MakeChanges) $
> do let doChanges :: FL (PatchInfoAnd p) C(x t) -> IO ()
> doChanges NilFL = applyps r themi
> - doChanges _ = applyps r (mapFL_FL n2pia pc)
> + doChanges _ = applyps r pc
> doChanges usi
> setTentativePending r (effect pend' +>+ pw_resolution)
> return $ seal (effect pwprim +>+ pw_resolution)
Extend the get test to cover --context interaction with tags.
-------------------------------------------------------------
> -rm -rf temp1 temp2
> +
> +cd temp1
> +darcs tag -m tt
> +echo x > x
> +darcs rec -lam "x" x
> +darcs changes --context > my_context
> +cd ..
> +
> +rm -rf temp2
> +darcs get temp1 --context="${abs_to_context}" temp2
> +darcs changes --context --repo temp2 > repo2_context
> +diff -u ${abs_to_context} repo2_context
Looks good, not applied as requested.
Extend the issue1014 test to check that named patches are not duplicated.
-------------------------------------------------------------------------
> +darcs changes
>
> hunk ./tests/failing-issue1014_identical_patches.sh 62
> +test `darcs changes | fgrep -c '* C'` -eq 1
OK, that is indeed our issue1868 test sorted
Make partitionFL do a 3-way split, and detect commutation bugs in Depends.
--------------------------------------------------------------------------
> Petr Rockai <me at mornfall.net>**20100607195912
> Ignore-this: b692fb774356bab221442b938d8b4347
> ] hunk ./src/Darcs/Patch/Depends.hs 49
> import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL, Origin )
> import Darcs.ProgressPatches ( progressRL )
> import Darcs.Witnesses.Sealed (Sealed(..), FlippedSeal(..), flipSeal, seal )
> -import Printer ( renderString )
> +import Printer ( renderString, vcat )
> #include "impossible.h"
>
> {-|
> hunk ./src/Darcs/Patch/Depends.hs 208
> with_partial_intersection us them $
> \common us' them' ->
> case partitionFL ((`elem` mapRL info them') . info) $ reverseRL us' of
> - common2 :> only_ours -> PatchSet (reverseFL common2) common :>> only_ours
> + _ :> bad@(_:>:_) :> _ -> bug $ "Failed to commute common patches:\n" ++
> + (renderString $ vcat $ mapRL (humanFriendly . info) $ reverseFL bad)
> + common2 :> _ :> only_ours -> PatchSet (reverseFL common2) common :>> unsafeCoerceP only_ours
>
> findCommonAndUncommon :: RepoPatch p => PatchSet p C(start x) -> PatchSet p C(start y)
> -> (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(x y)
> hunk ./src/Darcs/Patch/Permutations.hs 47
> partitionFL :: Commute p
> => (FORALL(u v) p C(u v) -> Bool) -- ^predicate; if true we would like the patch in the "left" list
> -> FL p C(x y) -- ^input 'FL'
> - -> (FL p :> FL p) C(x y) -- ^"left" and "right" results
> + -> ((FL p :> FL p :> FL p) C(x y)) -- ^"left", "middle" and "right"
>
> -- optimise by using an accumulating parameter to track all the "right" patches that we've found so far
> partitionFL' :: Commute p
> hunk ./src/Darcs/Patch/Permutations.hs 52
> => (FORALL(u v) p C(u v) -> Bool)
> - -> RL p C(x z) -- the "right" patches found so far
> - -> FL p C(z y)
> - -> (FL p :> FL p) C(x y)
> + -> RL p C(a b) -- the "middle" patches found so far
> + -> RL p C(b c) -- the "right" patches found so far
> + -> FL p C(c d)
> + -> ((FL p :> FL p :> FL p) C(a d))
>
> hunk ./src/Darcs/Patch/Permutations.hs 57
> -partitionFL keepleft ps = partitionFL' keepleft NilRL ps
> +partitionFL keepleft ps = partitionFL' keepleft NilRL NilRL ps
> +
> +partitionFL' _ middle right NilFL = (NilFL :> reverseRL middle :> reverseRL right)
> +partitionFL' keepleft middle right (p :>: ps)
> + | keepleft p = case commuteRL (right :> p) of
> + Just (p' :> right') -> case commuteRL (middle :> p') of
> + Just (p'' :> middle') -> case partitionFL' keepleft middle' right' ps of
> + (a :> b :> c) -> (p'' :>: a :> b :> c)
> + Nothing -> partitionFL' keepleft (p' :<: middle) right' ps
> + Nothing -> case commuteWhatWeCanRL (right :> p) of
> + (tomiddle :> p' :> right') -> partitionFL' keepleft (p' :<: tomiddle +<+ middle) right' ps
> + | otherwise = partitionFL' keepleft middle (p :<: right) ps
>
> hunk ./src/Darcs/Patch/Permutations.hs 70
> -partitionFL' _ qs NilFL = NilFL :> reverseRL qs
> -partitionFL' keepleft qs (p :>: ps)
> - | keepleft p,
> - Just (p' :> qs') <- commuteRL (qs :> p)
> - = case partitionFL' keepleft qs' ps of
> - a :> b -> p' :>: a :> b
> - | otherwise = partitionFL' keepleft (p :<: qs) ps
>
> -- |split an 'RL' into "left" and "right" lists according to a predicate, using commutation as necessary.
> -- If a patch does satisfy the predicate but cannot be commuted past one that does not satisfy
>
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 198 bytes
Desc: Digital signature
URL: <http://lists.osuosl.org/pipermail/darcs-users/attachments/20100608/322e09be/attachment-0001.pgp>
More information about the darcs-users
mailing list