[darcs-devel] darcs patch: start gadt stuff (and 29 more)
Eric Y. Kow
eric.kow at gmail.com
Sun Jun 17 03:48:01 PDT 2007
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.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 186 bytes
Desc: not available
Url : http://lists.osuosl.org/pipermail/darcs-devel/attachments/20070617/2ac05e4f/attachment-0001.pgp
More information about the darcs-devel
mailing list