ref: f7105307b1c44efcfba29e4809abafa0e75336b0
parent: 35cc33cdee501af74eaf699d1f1a34c51f6b8ee1
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Jan 6 06:25:55 EST 2025
Better checking of dups
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -389,6 +389,15 @@
eSeq :: Exp -> Exp -> Exp
eSeq e1 e2 = App (App (Lit (LPrim "seq")) e1) e2
+-- XXX quadratic. but only used for short lists
+groupEq :: forall a . (a -> a -> Bool) -> [a] -> [[a]]
+groupEq eq axs =
+ case axs of
+ [] -> []
+ x:xs ->
+ case partition (eq x) xs of
+ (es, ns) -> (x:es) : groupEq eq ns
+
-- Desugar a pattern matrix.
-- The input is a (usually identifier) vector e1, ..., en
-- and patterns matrix p11, ..., p1n -> e1
@@ -529,21 +538,12 @@
ELit _ _ -> []
_ -> impossible
--- XXX quadratic
-groupEq :: forall a . (a -> a -> Bool) -> [a] -> [[a]]
-groupEq eq axs =
- case axs of
- [] -> []
- x:xs ->
- case partition (eq x) xs of
- (es, ns) -> (x:es) : groupEq eq ns
+getDups :: (Ord a) => [a] -> [[a]]
+getDups = filter ((> 1) . length) . groupSort
-getDups :: forall a . (a -> a -> Bool) -> [a] -> [[a]]
-getDups eq = filter ((> 1) . length) . groupEq eq
-
checkDup :: [LDef] -> [LDef]
checkDup ds =
- case getDups (==) (filter (/= dummyIdent) $ map fst ds) of
+ case getDups $ filter (/= dummyIdent) $ map fst ds of
[] -> ds
(i1:_i2:_) : _ ->
errorMessage (getSLoc i1) $ "duplicate definition " ++ showIdent i1
--- a/src/MicroHs/List.hs
+++ b/src/MicroHs/List.hs
@@ -60,6 +60,9 @@
| otherwise = anySameAdj xs
anySameAdj _ = False
+groupSort :: (Ord a) => [a] -> [[a]]
+groupSort = group . sortLE (<=)
+
deleteAllBy :: forall a . (a -> a -> Bool) -> a -> [a] -> [a]
deleteAllBy _ _ [] = []
deleteAllBy eq x (y:ys) = if eq x y then deleteAllBy eq x ys else y : deleteAllBy eq x ys