0c188f6 · rowtype-yoga/purescript-native

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

on golang help sign in

Fix --magic-do

0c188f6Phil Freeman13 years ago

purescript.cabal+1−1

compare with golang

unifiedsplit

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

1name: purescript

2−version: 0.2.15.1

2+version: 0.2.15.2

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

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

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

23import Language.PureScript.Names

24import Language.PureScript.CodeGen.JS.AST

25import Language.PureScript.Options

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

27+import Language.PureScript.Sugar.TypeClasses

28+ (mkDictionaryValueName)

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

27optimize :: Options -> JS -> JS

31optimize :: Options -> JS -> JS

28optimize opts =

32optimize opts =

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

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

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

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

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

215 convert other = other

219 convert other = other

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

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

217 isBind _ = False

221 isBind _ = False

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

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

219 isReturn _ = False

223 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

220 undo :: JS -> JS

239 undo :: JS -> JS

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

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

222 undo other = other

241 undo other = other