[commit: packages/containers] master: Escape slashes in Haddock (1f10dce)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:48:48 UTC 2017


Repository : ssh://git@git.haskell.org/containers

On branch  : master
Link       : http://git.haskell.org/packages/containers.git/commitdiff/1f10dcec6116bc598840fb08947d3be36facace2

>---------------------------------------------------------------

commit 1f10dcec6116bc598840fb08947d3be36facace2
Author: David Feuer <David.Feuer at gmail.com>
Date:   Mon Feb 20 15:55:51 2017 -0500

    Escape slashes in Haddock
    
    Fixes #388


>---------------------------------------------------------------

1f10dcec6116bc598840fb08947d3be36facace2
 Data/Map/Internal.hs | 12 ++++++------
 Data/Set/Internal.hs |  6 +++---
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 861e8f1..d953722 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -1851,7 +1851,7 @@ difference t1 (Bin _ k _ l2 r2) = case split k t1 of
 {-# INLINABLE difference #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'.
+-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'.
 --
 -- @
 -- m `withoutKeys` s = 'filterWithKey' (\k _ -> k `'Set.notMember'` s) m
@@ -1931,7 +1931,7 @@ intersection t1@(Bin _ k x l1 r1) t2
 {-# INLINABLE intersection #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Restrict a 'Map' to only those keys
+-- | /O(m*log(n\/m + 1)), m <= n/. Restrict a 'Map' to only those keys
 -- found in a 'Set'.
 --
 -- @
@@ -2589,7 +2589,7 @@ mergeWithKey f g1 g2 = go
 {--------------------------------------------------------------------
   Submap
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/.
+-- | /O(m*log(n\/m + 1)), m <= n/.
 -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
 --
 isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
@@ -2598,7 +2598,7 @@ isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2
 {-# INLINABLE isSubmapOf #-}
 #endif
 
-{- | /O(m*log(n/m + 1)), m <= n/.
+{- | /O(m*log(n\/m + 1)), m <= n/.
  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
  all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
  applied to their respective values. For example, the following
@@ -2636,7 +2636,7 @@ submap' f (Bin _ kx x l r) t
 {-# INLINABLE submap' #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
+-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
 isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
 isProperSubmapOf m1 m2
@@ -2645,7 +2645,7 @@ isProperSubmapOf m1 m2
 {-# INLINABLE isProperSubmapOf #-}
 #endif
 
-{- | /O(m*log(n/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
+{- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
  The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
  @m1@ and @m2@ are not equal,
  all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
diff --git a/Data/Set/Internal.hs b/Data/Set/Internal.hs
index f1a68a0..c2407f1 100644
--- a/Data/Set/Internal.hs
+++ b/Data/Set/Internal.hs
@@ -669,7 +669,7 @@ unions = foldlStrict union empty
 {-# INLINABLE unions #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. The union of two sets, preferring the first set when
+-- | /O(m*log(n\/m + 1)), m <= n/. The union of two sets, preferring the first set when
 -- equal elements are encountered.
 union :: Ord a => Set a -> Set a -> Set a
 union t1 Tip  = t1
@@ -689,7 +689,7 @@ union t1@(Bin _ x l1 r1) t2 = case splitS x t2 of
 {--------------------------------------------------------------------
   Difference
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/. Difference of two sets.
+-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two sets.
 difference :: Ord a => Set a -> Set a -> Set a
 difference Tip _   = Tip
 difference t1 Tip  = t1
@@ -706,7 +706,7 @@ difference t1 (Bin _ x l2 r2) = case split x t1 of
 {--------------------------------------------------------------------
   Intersection
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/. The intersection of two sets.
+-- | /O(m*log(n\/m + 1)), m <= n/. The intersection of two sets.
 -- Elements of the result come from the first set, so for example
 --
 -- > import qualified Data.Set as S



More information about the ghc-commits mailing list