Hi David, Jason and all, On Fri, Jun 15, 2007 at 15:30:52 -0700, David Roundy wrote: > This is a rather massive set of patches, which brings you up > to our current state of gadt-integration.
I have had a look and while I don't understand everything, I'm pushing it all in. General comments and questions ------------------------------ 1) This does not compile with GHC 6.4.1, even without type witnesses. It complains about the constructors :/\: (and friends). Unless we can issue a fix rather quickly, we will have to require GHC 6.6 for the next release. Is that ok with you? 2) The new code will not parse/understand/ commute mergers. Is this correct? If so, I'm guessing you are planning some sort of repository conversion tool (à darcs optimize or upgrade). How do you reckon that would work? That is, what do mergers translate to? 3) I was wondering if there really exists such a thing as an empty composite or split patch (NilFL). Since we now have control over our own list type, would it be worthwhile to have lists that are guaranteed to have at least one element in them? You seem to be using ComP NilFL to double as an 'identity patch' (is that used just for internal purposes?). If this is the sole use of empty patch lists, maybe have a constructor just for that? Pattern guards -------------- > + p | IsEq <- nullP p -> id > + | otherwise -> (flatten p ++) More a comment for others. At first I didn't understand this code. Then I found out about the pattern guard extension: http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html Basically, code like myFn | IsEq <- nullP p = foo | otherwise = bar is a handier way to express something like myFn = case nullP p of IsEq -> foo _ -> bar This lightens up the code in some places. > +#endif > +apply opts (ComP ps) = applyFL opts ps > +apply opts (Split ps) = applyFL opts ps > > apply _ (FP f RmFile) = mRemoveFile f > apply _ (FP f AddFile) = mCreateFile f > hunk ./src/Darcs/Patch/Apply.lhs 129 > -apply opts p@(FP _ (Hunk _ _ _)) = apply_list opts [p] > +apply opts p@(FP _ (Hunk _ _ _)) = applyFL opts (p :>: NilFL) > apply _ (FP f (TokReplace t o n)) = mModifyFilePSs f doreplace > where doreplace ls = > case mapM (try_tok_internal t > hunk ./src/Darcs/Patch/Apply.lhs 150 > do b <- mDoesDirectoryExist (fp2fn "_darcs/prefs") > when b $ change_prefval p f t > > -apply_list :: WriteableDirectory m => [DarcsFlag] -> [Patch] -> m () > -apply_list _ [] = return () > -apply_list opts ((FP f h@(Hunk _ _ _)):the_ps) > - = case span f_hunk the_ps of > - (xs, ps') -> > - do let foo = h:map (\(FP _ h') -> h') xs > +applyFL :: WriteableDirectory m => [DarcsFlag] -> FL Patch C(x,y) -> m () > +applyFL _ NilFL = return () > +applyFL opts ((FP f h@(Hunk _ _ _)):>:the_ps) > + = case spanFL f_hunk the_ps of > + (xs :> ps') -> > + do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs > mModifyFilePS f $ hunkmod foo > case h of > (Hunk 1 _ (n:_)) | takePS 2 n == packString "#!" && > hunk ./src/Darcs/Patch/Apply.lhs 162 > SetScriptsExecutable `elem` opts > -> mSetFileExecutable f True > _ -> return () > - apply_list opts ps' > + applyFL opts ps' > where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True > f_hunk _ = False > hunk ./src/Darcs/Patch/Apply.lhs 165 > - hunkmod [] ps = return ps > - hunkmod (Hunk line old new:hs) ps > + hunkmod :: WriteableDirectory m => FL FilePatchType C(x,y) > + -> PackedString -> m PackedString > + hunkmod NilFL ps = return ps > + hunkmod (Hunk line old new:>:hs) ps > = case applyHunkLines [(line,old,new)] (impossible, Just ps) of > Just (_, Just ps') -> hunkmod hs ps' > Just (_, Nothing) -> impossible > hunk ./src/Darcs/Patch/Apply.lhs 174 > Nothing -> fail $ "Error applying hunk to file " ++ fn2fp f > hunkmod _ _ = impossible > -apply_list opts (p:ps) = do apply opts p > - apply_list opts ps > +applyFL opts (p:>:ps) = do apply opts p > + applyFL opts ps > \end{code} > > \subsection{Hunk patches} > hunk ./src/Darcs/Patch/Apply.lhs 310 > empty_markedup_file :: MarkedUpFile > empty_markedup_file = [(nilPS, None)] > > -markup_file :: PatchInfo -> Patch > +markup_file :: PatchInfo -> Patch C(x,y) > -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile) > markup_file n (NamedP _ _ p') (f, mk) = markup_file n p' (f, mk) > hunk ./src/Darcs/Patch/Apply.lhs 313 > +#ifndef GADT_WITNESSES > markup_file n p (f, mk) | is_merger p = > markup_file n (merger_equivalent p) (f, mk) > markup_file _ (Merger _ _ _ _ _ _) _ = impossible > hunk ./src/Darcs/Patch/Apply.lhs 317 > +#endif > markup_file _ (ComP NilFL) (f, mk) = (f, mk) > markup_file n (ComP (p:>:ps)) (f, mk) = markup_file n (ComP ps) $ > markup_file n p (f, mk) > hunk ./src/Darcs/Patch/Apply.lhs 394 > %(especially useful for larger repos) > > \begin{code} > -patchChanges :: Patch -> [(String,DirMark)] > +patchChanges :: Patch C(x,y) -> [(String,DirMark)] > patchChanges (NamedP _ _ p) = patchChanges p > patchChanges (Move f1 f2) = [(fn2fp f1,MovedFile $ fn2fp f2), > (fn2fp f2,MovedFile $ fn2fp f1)] > hunk ./src/Darcs/Patch/Apply.lhs 403 > patchChanges (FP f AddFile) = [(fn2fp f,AddedFile)] > patchChanges (FP f RmFile) = [(fn2fp f,RemovedFile)] > patchChanges (FP f _) = [(fn2fp f,ModifiedFile)] > -patchChanges (Split ps) = concatMap patchChanges $ unsafeUnFL ps > -patchChanges (ComP ps) = concatMap patchChanges $ unsafeUnFL ps > +patchChanges (Split ps) = concat $ mapFL patchChanges ps > +patchChanges (ComP ps) = concat $ mapFL patchChanges ps > +#ifndef GADT_WITNESSES > patchChanges p | is_merger p = patchChanges $ merger_equivalent p > patchChanges (Merger _ _ _ _ _ _) = impossible > hunk ./src/Darcs/Patch/Apply.lhs 408 > +#endif > patchChanges (ChangePref _ _ _) = [] > \end{code} > > hunk ./src/Darcs/Patch/Apply.lhs 415 > %apply a patch to a population at a given time > > \begin{code} > -applyToPop :: PatchInfo -> Patch -> Population -> Population > +applyToPop :: PatchInfo -> Patch C(x,y) -> Population -> Population > applyToPop pi patch (Pop _ tree) > = Pop pi (applyToPopTree patch tree) > -- ``pi'' is global below! > hunk ./src/Darcs/Patch/Apply.lhs 419 > - where applyToPopTree :: Patch -> PopTree -> PopTree > + where applyToPopTree :: Patch C(x,y) -> PopTree -> PopTree > applyToPopTree (NamedP _ _ p) tr = applyToPopTree p tr > hunk ./src/Darcs/Patch/Apply.lhs 421 > +#ifndef GADT_WITNESSES > applyToPopTree p tr | is_merger p > = applyToPopTree (merger_equivalent p) tr > applyToPopTree (Merger _ _ _ _ _ _) _ = impossible > hunk ./src/Darcs/Patch/Apply.lhs 425 > +#endif > applyToPopTree (ComP ps) tr = > hunk ./src/Darcs/Patch/Apply.lhs 427 > - foldl (\t p -> applyToPopTree p t) tr $ unsafeUnFL ps > + foldlFL (\t p -> applyToPopTree p t) tr ps > applyToPopTree (Split ps) tr = > hunk ./src/Darcs/Patch/Apply.lhs 429 > - foldl (\t p -> applyToPopTree p t) tr $ unsafeUnFL ps > + foldlFL (\t p -> applyToPopTree p t) tr ps > applyToPopTree p@(FP f AddFile) tr = > let xxx = splitPS '/' (fn2ps f) in > popChange xxx p $ fst $ breakP xxx tr > hunk ./src/Darcs/Patch/Apply.lhs 468 > insertP _ org _ = org > > -- change a population according to a patch > - popChange :: [PackedString] -> Patch -> PopTree -> PopTree > + popChange :: [PackedString] -> Patch C(x,y) -> PopTree -> PopTree > popChange [parent,path] (DP d AddDir) tr@(PopDir f trs) > | parent == (nameI f) = PopDir f (new:trs) > | otherwise = tr > hunk ./src/Darcs/Patch/Commute.lhs 21 > > \begin{code} > {-# OPTIONS -fglasgow-exts #-} > -module Darcs.Patch.Commute ( merge, elegant_merge, > - really_eq_patches, eq_patches, eq_list, > - compare_patches, compare_list, > - merger, merger_equivalent, glump, unravel, > - modernize_patch, > - resolve_conflicts, reorder_and_coalesce, canonize, > - commute, list_touched_files, list_conflicted_files, > - try_to_shrink, subcommutes, > - CommuteFunction, Perhaps(..), > - -- for PatchApply > - applyBinary, try_tok_internal, movedirfilename ) > +#include "gadts.h" > +module Darcs.Patch.Commute ( really_eq_patches, eq_patches, eq_list, > + compare_patches, compare_list, > + merger_equivalent, modernize_patch, > +#ifndef GADT_WITNESSES > + merge, elegant_merge, > + merger, glump, unravel, > + resolve_conflicts, > +#endif > + new_merge, > + reorder_and_coalesce, canonize, > + commute, list_touched_files, > list_conflicted_files, > + try_to_shrink, subcommutes, > + CommuteFunction, Perhaps(..), > + -- for PatchApply > + applyBinary, try_tok_internal, movedirfilename ) > where > > import Prelude hiding ( pi ) > hunk ./src/Darcs/Patch/Commute.lhs 40 > -import Control.Monad ( liftM, liftM2, > - MonadPlus, mplus, msum, mzero ) > +import Control.Monad ( liftM, MonadPlus, mplus, msum, mzero ) > import Data.Maybe ( isNothing ) > > hunk ./src/Darcs/Patch/Commute.lhs 43 > -import FastPackedString ( PackedString, packString, lastPS, nullPS, > - substrPS, > +import FastPackedString ( PackedString, packString, substrPS, > +#ifndef GADT_WITNESSES > + lastPS, nullPS, > +#endif > breakPS, concatPS, unlinesPS, linesPS, ) > import FileName ( FileName, fn2fp, fp2fn ) > hunk ./src/Darcs/Patch/Commute.lhs 49 > -import Printer ( vcat, text, ($$) ) > import Darcs.Patch.Core ( Patch(..), DirPatchType(..), FilePatchType(..), > hunk ./src/Darcs/Patch/Commute.lhs 50 > - (:<)(..), (:\/:)(..),FL(..),RL(..), > - lengthFL, unsafeUnFL, > - (+>+), reverseFL, join_patchesFL, flattenFL, > - unsafeFL, reverseRL, > - nubAdjBy, > - is_merger, invert, join_patches, null_patch, > is_null_patch, > - flatten, flatten_to_primitives, merger_undo ) > + (:<)(..), (:\/:)(..), (:/\:)(..),FL(..),RL(..), > + lengthFL, > + (+>+), reverseFL, > + reverseRL, > +#ifndef GADT_WITNESSES > + unsafeFL, unsafeUnFL, > + is_merger, merger_undo, > + flattenFL, join_patchesFL, > + join_patches, flatten, flatten_to_primitives, > + nubAdjBy, > +#endif > + invert, null_patch, nullP ) > +#ifndef GADT_WITNESSES > +import Printer ( vcat, text, ($$) ) > +import Darcs.Bug ( bugDoc ) > import Darcs.Patch.Show ( showPatch ) > import Data.List ( intersperse, sort, sortBy, nubBy ) > import Data.Maybe ( isJust, catMaybes ) > hunk ./src/Darcs/Patch/Commute.lhs 68 > +#endif > import Darcs.SlurpDirectory ( FileContents ) > import Lcs ( getChanges ) > import RegChars ( regChars ) > hunk ./src/Darcs/Patch/Commute.lhs 72 > -import Darcs.Bug ( bugDoc ) > import Darcs.Utils ( nubsort ) > hunk ./src/Darcs/Patch/Commute.lhs 73 > -#include "gadts.h" > #include "impossible.h" > hunk ./src/Darcs/Patch/Commute.lhs 74 > -import Darcs.Patch.Ordered ( mapFL_FL ) > +import Darcs.Patch.Ordered ( unsafeMap_l2f, mapFL, mapFL_FL > + , MyEq, EqCheck(IsEq), unsafeCompare, (=\/=) ) > +import GHC.Base (unsafeCoerce#) > \end{code} > > \section{Commuting patches} > hunk ./src/Darcs/Patch/Commute.lhs 93 > case sort_coalesce_composite ps of > p :>: NilFL -> return (p1 :< p) > ps' -> return (p1 :< Split ps') > - where cs (NilFL :< p1) = return (p1 :< NilFL) > + where cs :: ((FL Patch) :< Patch) C(x,y) -> Maybe ((Patch :< (FL Patch)) > C(x,y)) > + cs (NilFL :< p1) = return (p1 :< NilFL) > cs (p:>:ps :< p1) = do p1' :< p' <- commute (p :< p1) > p1'' :< ps' <- cs (ps :< p1') > return (p1'' :< p':>:ps') > hunk ./src/Darcs/Patch/Commute.lhs 128 > Nothing -> Nothing > Just (p' :< p1') -> try_one (p1':<:sofar) p' ps > > -reorder_and_coalesce :: Patch -> Patch > +reorder_and_coalesce :: Patch C(x,y) -> Patch C(x,y) > reorder_and_coalesce (NamedP n d p) = NamedP n d $ reorder_and_coalesce p > reorder_and_coalesce (ComP patches) = ComP $ sort_coalesce_composite patches > reorder_and_coalesce p =p > hunk ./src/Darcs/Patch/Commute.lhs 133 > > -sort_coalesce_composite :: FL Patch -> FL Patch > +sort_coalesce_composite :: FL Patch C(x,y) -> FL Patch C(x,y) > sort_coalesce_composite NilFL = NilFL > hunk ./src/Darcs/Patch/Commute.lhs 135 > -sort_coalesce_composite (x:>:xs) | is_null_patch x = sort_coalesce_composite > xs > +sort_coalesce_composite (x:>:xs) | IsEq <- nullP x = sort_coalesce_composite > xs > sort_coalesce_composite (x:>:xs) = > push_coalesce_patch x $ sort_coalesce_composite xs > > hunk ./src/Darcs/Patch/Commute.lhs 139 > -push_coalesce_patch :: Patch -> FL Patch -> FL Patch > +push_coalesce_patch :: Patch C(x,y) -> FL Patch C(y,z) -> FL Patch C(x,z) > push_coalesce_patch new NilFL = new :>: NilFL > push_coalesce_patch new ps@(p:>:ps') > = case coalesce (p :< new) of > hunk ./src/Darcs/Patch/Commute.lhs 143 > - Just new' | is_null_patch new' -> ps' > + Just new' | IsEq <- nullP new' -> ps' > | otherwise -> push_coalesce_patch new' ps' > Nothing -> if compare_patches new p == LT then new:>:ps > else case commute (p :< new) of > hunk ./src/Darcs/Patch/Commute.lhs 154 > r -> p' :>: r > Nothing -> new:>:ps > > -canonizeComposite :: FL Patch C(x,y) -> Maybe (Patch C(x,y)) > +canonizeComposite :: FL Patch C(x,y) -> Patch C(x,y) > canonizeComposite patches = > hunk ./src/Darcs/Patch/Commute.lhs 156 > - simplify_composite $ sort_coalesce_composite $ unsafeFL $ catMaybes $ > - map canonize $ unsafeUnFL patches > - where simplify_composite :: FL Patch C(x,y) -> Maybe (Patch C(x,y)) > - simplify_composite NilFL = Nothing > - simplify_composite (p:>:NilFL) = canonize p > - simplify_composite ps = Just $ ComP ps > + simplify_composite $ sort_coalesce_composite $ mapFL_FL canonize patches > + where simplify_composite :: FL Patch C(x,y) -> Patch C(x,y) > + simplify_composite NilFL = ComP NilFL > + simplify_composite (p:>:NilFL) = canonize p > + simplify_composite ps = ComP ps > \end{code} > > \newcommand{\commute}{\longleftrightarrow} > hunk ./src/Darcs/Patch/Commute.lhs 260 > -- Failed -> Failed > -- Unknown -> Unknown) > > -speedy_commute :: (Patch :< Patch) -> Perhaps (Patch :< Patch) > +speedy_commute :: CommuteFunction > speedy_commute (p1 :< p2) -- Deal with common case quickly! > | p1_modifies /= Nothing && p2_modifies /= Nothing && > hunk ./src/Darcs/Patch/Commute.lhs 263 unsafeCoerce# ------------- > - p1_modifies /= p2_modifies = Succeeded (p2 :< p1) > + p1_modifies /= p2_modifies = Succeeded (unsafeCoerce# p2 :< > unsafeCoerce# p1) As I understand it, the unsafeCoerce#s are used for forcing the type witnesses. I wonder then if we could have a somewhat safer wrapper like unsafeCoercePatch :: Patch C(x,y) -> Patch C(a,b) Just to avoid, for example, unintentionally coercing something completely unrelated because of a bracketing typo. MergeFunction ------------- > +new_merge :: (Patch :\/: Patch) C(x,y) -> Maybe ((Patch :/\: Patch) C(x,y)) > +new_merge (p1:\/:p2) = do ip1' :< p2' <- commute (p2 :< invert p1) > + return (p2' :/\: invert ip1') Would a MergeFunction type be useful? type MergeFunction = (Patch :\/: Patch) C(x,y) -> Maybe ((Patch :/\: Patch) C(x,y)) Canonize -------- > - liftM2 (merger g) (canonize p1) (canonize p2) > + (merger g) (canonize p1) (canonize p2) I am somewhat concerned about this. As I understand it, we replace the Nothings with an identity patch (ComP NilFL). Fine. But in places like this, does this mean we lose this idea of failures propagating in the Maybe monad? For example, does the example above really behave the same way (or does it really not matter?). I confess that I wasn't able to figure what returning Nothing means. Does it mean that canonization "fails" in some way? > -canonize p@(FP _ (Binary old new)) = if old /= new then Just p > - else Just null_patch Another thing is that now Just null_patch and Nothing are collapsed into a single type of result, the identity patch. Is that ok? Conflicted ---------- (with David's modifications) A Conflicted patch is (as I understand Jason's mail) a storage mechanism on top of which the cancellation patches will be implemented. A conflicted patch consists of a patch and a sequence of patches (a patch context). I'm guessing that we call it this because it is something we generate when there is a conflict. Jason, can you explain to me what the relationship is between the two? For example, why don't we just have a list of patches? Conflicted patches always commute, although how they commute depends on what they commute with. There are three cases that are looked at in order 1. we are commuting with another Conflicted patch trivial: just do it 2. we try commuting with something that does not conflict with us (Conflicted p1 cs) :> p2 ok... p1 p2' cs' p2'' p1' cs' and we return p2'' :> (Conflicted p1' cs') Yeah, this is redundant, but it sometimes helps me to just work through things 3. we try commuting with something that _does_ conflict with us swallow it (black magic) > -- If the confilcted patch or the context does not commute with the typo :-) > -- other patch then we need to add the other patch to the context of > -- the conflicted patch. > -- The hard case here, is doing the inverse commute. To work correctly > -- we must make sure that the context has the correct patch at the end. > -- Otherwise we cannot find it to remove it from the context. > conflicted_commute_depends :: CommuteFunction > conflicted_commute_depends (Conflicted p1 csp2 :< p2) | > ((lastc:<:initcs):_) <- filter (\(lastc:<:_) -> isEq (p2 =/\= lastc)) $ > last_permutations csp2 > = case p2 =/\= lastc of > IsEq -> Succeeded (p2 :< Conflicted p1 (reverseRL initcs)) > _ -> impossible > conflicted_commute_depends (Conflicted p1 cs :< ip2) = > Succeeded (ip2 :< Conflicted p1 (cs+>+invert ip2:>:NilFL)) > conflicted_commute_depends _ = Unknown I haven't really tried to understand this code. Sorry. By the way, could you explain what the Proof stuff is for? Just for grabbing patches which don't modify context, for example, Conflicted patches? I'm guessing filterE would still have a use even though it is no longer in this code? Sealed ------ > +data Sealed a where > + Sealed :: !(a C(x,)) -> Sealed a Thanks to Ian and Ganesh's gracious help, I was able to make more sense of this code. My stumbling block was forgetting that you could curry type parameters, so I was mentally substituting Sealed :: Patch x -> Sealed Patch which confused me. Maybe a little notational tweak might help lead readers a bit, something like Sealed :: !(px C(,y)) -> Sealed p > +unseal :: Sealed a -> (FORALL(x) a C(x,) -> b) -> b > +unseal (Sealed a) f = f a Similarly, unseal :: Sealed px -> (FORALL(y) px C(,y) -> b) -> b -- Eric Kow http://www.loria.fr/~kow PGP Key ID: 08AC04F9 Merci de corriger mon français.
pgp8ipBUkjw7u.pgp
Description: PGP signature
_______________________________________________ darcs-devel mailing list darcs-devel@darcs.net http://lists.osuosl.org/mailman/listinfo/darcs-devel