@@ -290,34 +290,42 @@ deriveOrd mn ds tyConNm = do
290290 mkCompareFunction (DataDeclaration _ _ _ args) = do
291291 x <- freshIdent "x"
292292 y <- freshIdent "y"
293− lamCase2 x y <$> (concat <$> mapM mkCtorClauses args)
293+ lamCase2 x y <$> (concat <$> mapM mkCtorClauses (splitLast args))
294294 mkCompareFunction (PositionedDeclaration _ _ d) = mkCompareFunction d
295295 mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"
296296
297+ splitLast :: [a] -> [(a, Bool)]
298+ splitLast [] = []
299+ splitLast [x] = [(x, True)]
300+ splitLast (x : xs) = (x, False) : splitLast xs
301+
297302 preludeCtor :: String -> Expr
298303 preludeCtor = Constructor . Qualified (Just (ModuleName [ProperName C.prelude])) . ProperName
299304
300305 preludeCompare :: Expr -> Expr -> Expr
301306 preludeCompare = App . App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.compare)))
302307
303− mkCtorClauses :: (ProperName 'ConstructorName, [Type]) -> m [CaseAlternative]
304− mkCtorClauses (ctorName, tys) = do
308+ mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]
309+ mkCtorClauses ((ctorName, tys), isLast) = do
305310 identsL <- replicateM (length tys) (freshIdent "l")
306311 identsR <- replicateM (length tys) (freshIdent "r")
307312 let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
308− return [ CaseAlternative [ caseBinder identsL
313+ extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
314+ , NullBinder
315+ ]
316+ (Right (preludeCtor "LT"))
317+ , CaseAlternative [ NullBinder
318+ , ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
319+ ]
320+ (Right (preludeCtor "GT"))
321+ ]
322+ | otherwise = []
323+ return $ CaseAlternative [ caseBinder identsL
309324 , caseBinder identsR
310325 ]
311326 (Right (appendAll tests))
312− , CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
313− , NullBinder
314− ]
315− (Right (preludeCtor "LT"))
316− , CaseAlternative [ NullBinder
317− , ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
318− ]
319− (Right (preludeCtor "GT"))
320− ]
327+ : extras
328+
321329 where
322330 caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
323331