@@ -119,11 +119,32 @@ toTuple _ = error "Not a value declaration"
119119
120120makeCaseDeclaration :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration
121121makeCaseDeclaration ident alternatives = do
122− let argPattern = length . fst . head $ alternatives
123− args <- map Ident <$> replicateM argPattern freshName
122+ let namedArgs = map findName . fst <$> alternatives
123+ args <- mapM argName $ foldl1 resolveNames namedArgs
124124 let
125125 vars = map (Var . Qualified Nothing) args
126126 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]
127127 value = foldr (Abs . Left) (Case vars binders) args
128128 return $ ValueDeclaration ident Value [] (Right value)
129−
129+ where
130+ findName :: Binder -> Maybe Ident
131+ findName (VarBinder name) = Just name
132+ findName (PositionedBinder _ _ binder) = findName binder
133+ findName _ = Nothing
134+
135+ argName :: (MonadSupply m) => Maybe Ident -> m Ident
136+ argName (Just name) = return name
137+ argName Nothing = do
138+ name <- freshName
139+ return (Ident name)
140+
141+ resolveNames :: [Maybe Ident] -> [Maybe Ident] -> [Maybe Ident]
142+ resolveNames = zipWith resolveName
143+
144+ resolveName :: Maybe Ident -> Maybe Ident -> Maybe Ident
145+ resolveName (Just a) (Just b)
146+ | a == b = Just a
147+ | otherwise = Nothing
148+ resolveName Nothing Nothing = Nothing
149+ resolveName (Just a) Nothing = Just a
150+ resolveName Nothing (Just b) = Just b