0c188f6 · rowtype-yoga/purescript-native

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

Fix --magic-do

commit0c188f66aefaec8f4b81ab1b4e5486a0bd6ae04b authorPhil Freeman <paf31@cantab.net> dateFri 17 Jan 2014, 09:52 (13 years ago) parent5b2d549

2 files changed+22−3

compare with golang

unifiedsplit

purescript.cabal+1−1 src/Language/PureScript/CodeGen/Optimize.hs+21−2

purescript.cabal+1−1

@@ -1,5 +1,5 @@

11name: purescript

2−version: 0.2.15.1

2+version: 0.2.15.2

33cabal-version: >=1.8

44build-type: Simple

55license: MIT

src/Language/PureScript/CodeGen/Optimize.hs+21−2

@@ -23,6 +23,10 @@ import Data.Generics

2323import Language.PureScript.Names

2424import Language.PureScript.CodeGen.JS.AST

2525import Language.PureScript.Options

26+import Language.PureScript.Pretty.Common (identToJs)

27+import Language.PureScript.Sugar.TypeClasses

28+ (mkDictionaryValueName)

29+import Language.PureScript.Types (Type(..))

2630

2731optimize :: Options -> JS -> JS

2832optimize opts =

@@ -213,10 +217,25 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

213217 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

214218 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

215219 convert other = other

216− isBind (JSAccessor "bind" (JSAccessor "eff" (JSVar (Ident "Eff")))) = True

220+ isBind (JSApp bindPoly [JSApp effDict []]) | isBindPoly bindPoly && isEffDict effDict = True

217221 isBind _ = False

218− isReturn (JSAccessor "ret" (JSAccessor "eff" (JSVar (Ident "Eff")))) = True

222+ isReturn (JSApp retPoly [JSApp effDict []]) | isRetPoly retPoly && isEffDict effDict = True

219223 isReturn _ = False

224+ isBindPoly (JSVar (Op ">>=")) = True

225+ isBindPoly (JSAccessor prop (JSVar (Ident "Prelude"))) | prop == identToJs (Op ">>=") = True

226+ isBindPoly _ = False

227+ isRetPoly (JSVar (Ident "ret")) = True

228+ isRetPoly (JSAccessor "ret" (JSVar (Ident "Prelude"))) = True

229+ isRetPoly _ = False

230+ prelude = ModuleName (ProperName "Prelude")

231+ effModule = ModuleName (ProperName "Eff")

232+ Right (Ident effDictName) = mkDictionaryValueName

233+ effModule

234+ (Qualified (Just prelude) (ProperName "Monad"))

235+ (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

236+ isEffDict (JSVar (Ident ident)) | ident == effDictName = True

237+ isEffDict (JSAccessor prop (JSVar (Ident "Eff"))) | prop == effDictName = True

238+ isEffDict _ = False

220239 undo :: JS -> JS

221240 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body

222241 undo other = other