git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Preserve binding names a bit better in functions
703dd66Andy Arvanitis
src/Language/PureScript/Sugar/CaseDeclarations.hs+18−2
compare with golang
unifiedsplit
@@ -120,10 +120,26 @@ toTuple _ = error "Not a value declaration"
120makeCaseDeclaration :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration
120makeCaseDeclaration :: (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration
121makeCaseDeclaration ident alternatives = do
121makeCaseDeclaration ident alternatives = do
122 let argPattern = length . fst . head $ alternatives
122 let argPattern = length . fst . head $ alternatives
123− args <- map Ident <$> replicateM argPattern freshName
123+ args <- mapM argName (foldl1 (zipWith resolveIdents) namedArgs)
124 let
124 let
125 vars = map (Var . Qualified Nothing) args
125 vars = map (Var . Qualified Nothing) args
126 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]
126 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]
127 value = foldr (Abs . Left) (Case vars binders) args
127 value = foldr (Abs . Left) (Case vars binders) args
128 return $ ValueDeclaration ident Value [] (Right value)
128 return $ ValueDeclaration ident Value [] (Right value)
129−
129+ where
130+ namedArgs = findNames . fst <$> alternatives
131+ findNames names = findName <$> names
132+ findName (VarBinder name) = Just name
133+ findName _ = Nothing
134+
135+ argName (Just name) = return name
136+ argName Nothing = do
137+ name <- freshName
138+ return (Ident name)
139+
140+ resolveIdents (Just a) (Just b)
141+ | a == b = Just a
142+ | otherwise = Nothing
143+ resolveIdents Nothing Nothing = Nothing
144+ resolveIdents (Just a) Nothing = Just a
145+ resolveIdents Nothing (Just b) = Just b