git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Changes to binding name preservation improvements based on pull req feedback
5837be7Andy Arvanitis
src/Language/PureScript/Sugar/CaseDeclarations.hs+13−8
@@ -119,27 +119,32 @@ toTuple _ = error "Not a value declaration"
119
119
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 namedArgs = map findName . fst <$> alternatives
123− args <- mapM argName (foldl1 (zipWith resolveIdents) namedArgs)
123+ args <- mapM argName $ foldl1 resolveNames 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 where
129 where
130− namedArgs = findNames . fst <$> alternatives
130+ findName :: Binder -> Maybe Ident
131− findNames names = findName <$> names
132 findName (VarBinder name) = Just name
131 findName (VarBinder name) = Just name
132+ findName (PositionedBinder _ _ binder) = findName binder
133 findName _ = Nothing
133 findName _ = Nothing
134
134
135+ argName :: (MonadSupply m) => Maybe Ident -> m Ident
135 argName (Just name) = return name
136 argName (Just name) = return name
136 argName Nothing = do
137 argName Nothing = do
137 name <- freshName
138 name <- freshName
138 return (Ident name)
139 return (Ident name)
139
140
141+ resolveNames :: [Maybe Ident] -> [Maybe Ident] -> [Maybe Ident]
142+ resolveNames = zipWith resolveName
143+
144+ resolveName :: Maybe Ident -> Maybe Ident -> Maybe Ident
140− resolveIdents (Just a) (Just b)
145+ resolveName (Just a) (Just b)
141 | a == b = Just a
146 | a == b = Just a
142 | otherwise = Nothing
147 | otherwise = Nothing
143− resolveIdents Nothing Nothing = Nothing
148+ resolveName Nothing Nothing = Nothing
144− resolveIdents (Just a) Nothing = Just a
149+ resolveName (Just a) Nothing = Just a
145− resolveIdents Nothing (Just b) = Just b
150+ resolveName Nothing (Just b) = Just b