[darcs-users] darcs patch: change the type of gcau to reflect its b... (and 10 more)

Petr Rockai me at mornfall.net
Thu Sep 17 16:53:55 UTC 2009


Ganesh Sittampalam <ganesh at earth.li> writes:

>
> New patches:
>

change the type of gcau to reflect its behaviour
------------------------------------------------
>  Previously it returned RL (RL ...) but the outer RL was always singleton.
>  Changing this to RL ... simplifies a lot of client code that was just assuming
>  this behaviour by doing things like taking the head.
[snip lots of client code simplification that looks correct]

>  get_common_and_uncommon :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) ->
> -                           ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> +                           ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
>  get_common_and_uncommon_or_missing :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) ->
> hunk ./src/Darcs/Patch/Depends.hs 60
> -                                      Either PatchInfo ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> +                                      Either PatchInfo ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
>  
>  get_common_and_uncommon = 
>      either missingPatchError id . get_common_and_uncommon_err
> hunk ./src/Darcs/Patch/Depends.hs 69
>      either (\(MissingPatch x _) -> Left x) Right . get_common_and_uncommon_err
>  
>  get_common_and_uncommon_err :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) ->
> -                               Either MissingPatch ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> +                               Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
>  get_common_and_uncommon_err (ps1,ps2) = gcau (optimize_patchset ps1) ps2
>  
>  {-|
> hunk ./src/Darcs/Patch/Depends.hs 187
>  -}
>  
>  gcau :: forall p C(x y). RepoPatch p => PatchSet p C(x) -> PatchSet p C(y)
> -     -> Either MissingPatch ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> -gcau NilRL ps2 = return ([], NilRL:<:NilRL :\/: concatRL ps2 :<: NilRL)
> -gcau ps1 NilRL = return ([], concatRL ps1 :<: NilRL :\/: NilRL:<:NilRL)
> +     -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
> +gcau NilRL ps2 = return ([], NilRL :\/: concatRL ps2)
> +gcau ps1 NilRL = return ([], concatRL ps1 :\/: NilRL)
Ok, just drops extra (:<: NilRL).

>  gcau (NilRL:<:ps1) ps2 = gcau ps1 ps2
>  gcau ps1 (NilRL:<:ps2) = gcau ps1 ps2
>  gcau ((pi1:<:NilRL):<:_) ((pi2:<:NilRL):<:_)
> hunk ./src/Darcs/Patch/Depends.hs 195
>   | info pi1 == info pi2
>   , IsEq <- sloppyIdentity pi1
> - , IsEq <- sloppyIdentity pi2 = return ([info pi1], NilRL:<:NilRL :\/: unsafeCoerceP (NilRL:<:NilRL))
> + , IsEq <- sloppyIdentity pi2 = return ([info pi1], NilRL :\/: unsafeCoerceP NilRL)
Same.

>  gcau (orig_ps1:<:orig_ps1s) (orig_ps2:<:orig_ps2s)
>   = f (lengthRL orig_ps1) (unseal info $ lastRL orig_ps1) (orig_ps1:>:NilFL) orig_ps1s
>       (lengthRL orig_ps2) (unseal info $ lastRL orig_ps2) (orig_ps2:>:NilFL) orig_ps2s
> hunk ./src/Darcs/Patch/Depends.hs 203
>                           lx = last $ concatReverseFL psx   -}
>            f :: Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(r x) -> PatchSet p C(r)
>              -> Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(u y) -> PatchSet p C(u)
> -            -> Either MissingPatch ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> +            -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
>            f _n1 l1 ps1 _ps1s _n2 l2 ps2 _ps2s
>             | l1 == l2 = gcau_simple (unsafeCoerceP (concatReverseFL ps1)) (unsafeCoerceP (concatReverseFL ps2))
>            f n1 l1 ps1 ps1s n2 l2 ps2 ps2s
> hunk ./src/Darcs/Patch/Depends.hs 245
>  -- | Filters the common elements from @ps1@ and @ps2@ and returns the simplified sequences.
>  gcau_simple :: RepoPatch p => RL (PatchInfoAnd p) C(x y) -- ^ @ps1@
>              -> RL (PatchInfoAnd p) C(u v) -- ^ @ps2@
> -            -> Either MissingPatch ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(y v))
> +            -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(y v))
>  gcau_simple ps1 ps2 = do
>   FlippedSeal ex1 <- get_extra common ps1
>   FlippedSeal ex2 <- get_extra common ps2
> hunk ./src/Darcs/Patch/Depends.hs 250
>   let ps1' = filter (`elem` common) $ ps1_info
> - return (ps1', (unsafeCoerceP ex1 :<: NilRL) :\/: ex2 :<: NilRL)
> + return (ps1', (unsafeCoerceP ex1 :\/: ex2))
Same.

>    where common   = ps1_info `intersect` mapRL info ps2
>          ps1_info = mapRL info ps1
>  
> hunk ./src/Darcs/Patch/Depends.hs 510
>    f common a b = g_s $ gcau_simple a b
>      where
>        g_s :: Either MissingPatch
> -                    ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
> +                    ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y))
>            -> SealedPatchSet p
>        g_s (Left e) = missingPatchError e
> hunk ./src/Darcs/Patch/Depends.hs 513
> -      g_s (Right (_, (a' :<: NilRL) :\/: (b' :<: NilRL))) =
> +      g_s (Right (_, a' :\/: b')) =
>            case (merge_sets (a' :\/: b')) of
>            Sealed a'b' -> seal $ (a'b' +<+ b) :<: common
> hunk ./src/Darcs/Patch/Depends.hs 516
> -      g_s _ = impossible
>  
>  merge_sets :: RepoPatch p => (RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y) -> Sealed (RL (PatchInfoAnd p) C(y))
>  merge_sets (l :\/: r) =
> hunk ./src/Darcs/Repository/Internal.hs 920
>              debugMessage "Adjusting the context of the unrevert changes..."
>              ref <- readTentativeRepo repository
>              case get_common_and_uncommon (bundle, ref) of
> -                 (common,(h_us:<:NilRL):<:NilRL :\/: NilRL:<:NilRL) ->
> +                 (common,(h_us:<:NilRL) :\/: NilRL) ->
>                      case commuteRL (reverseFL ps :> hopefully h_us) of
>                      Nothing -> unrevert_impossible unrevert_loc
>                      Just (us' :> _) -> do
> hunk ./src/Darcs/Repository/Internal.hs 928
>                          writeDocBinFile unrevert_loc $
>                               make_bundle [] s
>                               (common \\ pis) (us':>:NilFL)
> -                 (common,(x:<:NilRL):<:NilRL:\/:_)
> +                 (common,(x:<:NilRL):\/:_)
>                          | isr && any (`elem` common) pis -> unrevert_impossible unrevert_loc
>                          | isr -> return ()
>                          where isr = isJust $ hopefullyM x
A bunch of pattern fixes.

Looks OK to me, I'll test-compile and run the tests and if all works out, I'll
push this today.

> [make type of checkUnrelatedRepos more general
(already applied)

I'm running out of time, I'll look at the rest later (hopefully tomorrow, or
over the weekend).
> [add witnesses to Darcs.Commands.Diff
> [add witnesses to Darcs.Commands.Remove
> [add witnesses to Darcs.Commands.TrackDown
> [add witnesses to Darcs.Commands.Pull
> [add witnesses to Darcs.Commands.Apply
> [add witnesses to Darcs.Commands.Push
> [need RankNTypes for some of the newly witnessed modules
> [add newly-witnessed modules to witnesses.hs

Yours,
   Petr.


More information about the darcs-users mailing list