62c2164 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Fix an issue with type decls in instances

commit62c2164e9f55e985a9756fe4c21467742943ad7d authorPhil Freeman <paf31@cantab.net> dateFri 28 Mar 2014, 19:32 (13 years ago) parent621ea30

2 files changed+18−5

compare with golang

unifiedsplit

examples/passing/LetInInstance.purs+12 src/Language/PureScript/Sugar/Names.hs+6−5

examples/passing/LetInInstance.pursnew file+12

@@ -0,0 +1,12 @@

1+module Main where

3+class Foo a where

4+ foo :: a -> String

6+instance fooString :: Foo String where

7+ foo = go

8+ where

9+ go :: String -> String

10+ go s = s

11+

12+main = Debug.Trace.trace "Done"

src/Language/PureScript/Sugar/Names.hs+6−5

@@ -17,7 +17,7 @@ module Language.PureScript.Sugar.Names (

1717) where

1818

1919import Data.Data

20−import Data.Maybe (fromMaybe, isJust)

20+import Data.Maybe (fromMaybe, isJust, mapMaybe)

2121import Data.Generics (extM, mkM, everywhereM)

2222import Data.Generics.Extras (mkS, extS, everywhereWithContextM')

2323

@@ -200,7 +200,7 @@ renameInModule imports exports (Module mn decls exps) =

200200 rethrowFor "declaration" name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'

201201 where

202202 bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')

203− bindFunctionArgs bound (Let ds val') = let args = map letBoundVariable ds in

203+ bindFunctionArgs bound (Let ds val') = let args = mapMaybe letBoundVariable ds in

204204 return (args ++ bound, Let ds val')

205205 bindFunctionArgs bound (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =

206206 (,) bound <$> (Var <$> updateValueName name')

@@ -214,10 +214,10 @@ renameInModule imports exports (Module mn decls exps) =

214214 bindBinders :: [Ident] -> CaseAlternative -> Either String ([Ident], CaseAlternative)

215215 bindBinders bound c@(CaseAlternative bs _ _) = return (binderNames bs ++ bound, c)

216216

217− letBoundVariable :: Declaration -> Ident

218− letBoundVariable (ValueDeclaration ident _ _ _ _) = ident

217+ letBoundVariable :: Declaration -> Maybe Ident

218+ letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident

219219 letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

220− letBoundVariable _ = error "Invalid argument to letBoundVariable"

220+ letBoundVariable _ = Nothing

221221 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name

222222 go (ExternDeclaration fit name js ty) =

223223 rethrowFor "declaration" name $ ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty

@@ -449,3 +449,4 @@ resolveImport currentModule importModule exps imps impQual = maybe importAll (fo

449449 then return item

450450 else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just importModule) item) ++ "'"

451451

452+