d96d4a0 · rowtype-yoga/purescript-native

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

Prevent unused arguments from being renamed

commitd96d4a074f516030ef3dbc3612e3fa92cde02567 authorGary Burgess <gary.burgess@gmail.com> dateTue 5 Aug 2014, 21:26 (12 years ago) parent905041c

6 files changed+13−6

compare with golang

unifiedsplit

src/Language/PureScript/Constants.hs+3 src/Language/PureScript/Optimizer/Inliner.hs+2−2 src/Language/PureScript/Optimizer/MagicDo.hs+1−1 src/Language/PureScript/Renamer.hs+4 src/Language/PureScript/Sugar/DoNotation.hs+1−1 src/Language/PureScript/Sugar/TypeClasses.hs+2−2

src/Language/PureScript/Constants.hs+3

@@ -201,6 +201,9 @@ main = "main"

201201__superclass_ :: String

202202__superclass_ = "__superclass_"

203203

204+__unused :: String

205+__unused = "__unused"

206+

204207-- Modules

205208

206209prim :: String

src/Language/PureScript/Optimizer/Inliner.hs+2−2

@@ -49,8 +49,8 @@ etaConvert = everywhereOnJS convert

4949 not (any (`isRebound` block) (map JSVar idents)) &&

5050 not (any (`isRebound` block) args)

5151 = JSBlock (map (replaceIdents (zip idents args)) body)

52− convert (JSFunction Nothing ["_"] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))

53− = fn

52+ convert (JSFunction Nothing [arg] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))

53+ | arg == C.__unused = fn

5454 convert js = js

5555

5656unThunk :: JS -> JS

src/Language/PureScript/Optimizer/MagicDo.hs+1−1

@@ -60,7 +60,7 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert

6060 -- Desugar pure

6161 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val

6262 -- Desugar >>

63− convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock js)]) | isBind bind && isJSReturn (last js) =

63+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) && arg == C.__unused =

6464 let JSReturn ret = last js in

6565 JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )

6666 -- Desugar >>=

src/Language/PureScript/Renamer.hs+4

@@ -28,6 +28,8 @@ import Language.PureScript.Environment

2828import Language.PureScript.Names

2929import Language.PureScript.Traversals

3030

31+import qualified Language.PureScript.Constants as C

32+

3133-- |

3234-- The state object used in this module

3335--

@@ -69,6 +71,7 @@ newScope x = do

6971-- unique name is generated and stored.

7072--

7173updateScope :: Ident -> Rename Ident

74+updateScope i@(Ident name) | name == C.__unused = return i

7275updateScope name = do

7376 scope <- get

7477 let name' = case name `S.member` rsUsedNames scope of

@@ -87,6 +90,7 @@ updateScope name = do

8790-- Finds the new name to use for an ident.

8891--

8992lookupIdent :: Ident -> Rename Ident

93+lookupIdent i@(Ident name) | name == C.__unused = return i

9094lookupIdent name = do

9195 name' <- gets $ M.lookup name . rsBoundNames

9296 case name' of

src/Language/PureScript/Sugar/DoNotation.hs+1−1

@@ -57,7 +57,7 @@ desugarDo d =

5757 go [DoNotationValue val] = return val

5858 go (DoNotationValue val : rest) = do

5959 rest' <- go rest

60− return $ App (App bind val) (Abs (Left (Ident "_")) rest')

60+ return $ App (App bind val) (Abs (Left (Ident C.__unused)) rest')

6161 go [DoNotationBind _ _] = lift $ Left $ mkErrorStack "Bind statement cannot be the last statement in a do block" Nothing

6262 go (DoNotationBind NullBinder val : rest) = go (DoNotationValue val : rest)

6363 go (DoNotationBind (VarBinder ident) val : rest) = do

src/Language/PureScript/Sugar/TypeClasses.hs+2−2

@@ -239,7 +239,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

239239 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

240240 -- dependencies, we introduce an unnamed function parameter.

241241 let superclasses =

242− [ (fieldName, Abs (Left (Ident "_")) (SuperClassDictionary superclass tyArgs))

242+ [ (fieldName, Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs))

243243 | (index, (superclass, suTyArgs)) <- zip [0..] implies

244244 , let tyArgs = map (replaceAllTypeVars (zip args tys)) suTyArgs

245245 , let fieldName = mkSuperclassDictionaryName superclass index

@@ -249,7 +249,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

249249 dictTy = foldl TypeApp (TypeConstructor className) tys

250250 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

251251 dict = TypeClassDictionaryConstructorApp className memberNames'

252− dict' = if null deps then Abs (Left (Ident "_")) dict else dict

252+ dict' = if null deps then Abs (Left (Ident C.__unused)) dict else dict

253253 result = ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict' constrainedTy)

254254 return result

255255