git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #1825, generate fresh binder names unless all names in case are equal
75876fePhil Freeman
examples/failing/1825.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith UnknownValue
2+
3+module Main where
4+
5+data W = X | Y | Z
6+
7+bad X a = a
8+bad Y _ = a
9+bad Z a = a
src/Language/PureScript/Sugar/CaseDeclarations.hs+9−18
@@ -150,7 +150,7 @@ toTuple _ = internalError "Not a value declaration"
150makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration
150makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, MonadError MultipleErrors m) => Ident -> [([Binder], Either [(Guard, Expr)] Expr)] -> m Declaration
151makeCaseDeclaration ident alternatives = do
151makeCaseDeclaration ident alternatives = do
152 let namedArgs = map findName . fst <$> alternatives
152 let namedArgs = map findName . fst <$> alternatives
153− argNames = map join $ foldl1 resolveNames namedArgs
153+ argNames = foldl1 resolveNames namedArgs
154 args <- if allUnique (catMaybes argNames)
154 args <- if allUnique (catMaybes argNames)
155 then mapM argName argNames
155 then mapM argName argNames
156 else replicateM (length argNames) freshIdent'
156 else replicateM (length argNames) freshIdent'
@@ -160,14 +160,11 @@ makeCaseDeclaration ident alternatives = do
160 return $ ValueDeclaration ident Public [] (Right value)
160 return $ ValueDeclaration ident Public [] (Right value)
161 where
161 where
162 -- We will construct a table of potential names.
162 -- We will construct a table of potential names.
163− -- VarBinders will become Just (Just _) which is a potential name.
163+ -- VarBinders will become Just _ which is a potential name.
164− -- NullBinder will become Just Nothing, which indicates that we may
164+ -- Everything else becomes Nothing, which indicates that we
165 -- have to generate a name.
165 -- have to generate a name.
166− -- Everything else becomes Nothing, which indicates that we definitely
167− -- have to generate a name.
168− findName :: Binder -> Maybe (Maybe Ident)
166+ findName :: Binder -> Maybe Ident
169− findName NullBinder = Just Nothing
170− findName (VarBinder name) = Just (Just name)
167+ findName (VarBinder name) = Just name
171 findName (PositionedBinder _ _ binder) = findName binder
168 findName (PositionedBinder _ _ binder) = findName binder
172 findName _ = Nothing
169 findName _ = Nothing
173
170
@@ -182,19 +179,13 @@ makeCaseDeclaration ident alternatives = do
182
179
183 -- Combine two lists of potential names from two case alternatives
180 -- Combine two lists of potential names from two case alternatives
184 -- by zipping correspoding columns.
181 -- by zipping correspoding columns.
185− resolveNames :: [Maybe (Maybe Ident)] ->
182+ resolveNames :: [Maybe Ident] -> [Maybe Ident] -> [Maybe Ident]
186− [Maybe (Maybe Ident)] ->
187− [Maybe (Maybe Ident)]
188 resolveNames = zipWith resolveName
183 resolveNames = zipWith resolveName
189
184
190 -- Resolve a pair of names. VarBinder beats NullBinder, and everything
185 -- Resolve a pair of names. VarBinder beats NullBinder, and everything
191 -- else results in Nothing.
186 -- else results in Nothing.
192− resolveName :: Maybe (Maybe Ident) ->
187+ resolveName :: Maybe Ident -> Maybe Ident -> Maybe Ident
193− Maybe (Maybe Ident) ->
194− Maybe (Maybe Ident)
195− resolveName (Just (Just a)) (Just (Just b))
188+ resolveName (Just a) (Just b)
196− | a == b = Just (Just a)
189+ | a == b = Just a
197 | otherwise = Nothing
190 | otherwise = Nothing
198− resolveName (Just Nothing) a = a
199− resolveName a (Just Nothing) = a
200 resolveName _ _ = Nothing
191 resolveName _ _ = Nothing