summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-01-17 17:53:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-01-17 17:53:00 (GMT)
commit55f9857d0a04f52fb4ba67b329e98495d9f38118 (patch)
treebe932d1e53a2f7838155e60b2db46ec4d318b937
parent72d725d035c4a6900866c66ee9ed0b798f8d977e (diff)
version 0.2.15.20.2.15.2
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/CodeGen/Optimize.hs23
2 files changed, 22 insertions, 3 deletions
diff --git a/purescript.cabal b/purescript.cabal
index 3ca0bb0..72db876 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.2.15.1
+version: 0.2.15.2
cabal-version: >=1.8
build-type: Simple
license: MIT
diff --git a/src/Language/PureScript/CodeGen/Optimize.hs b/src/Language/PureScript/CodeGen/Optimize.hs
index 0b336bb..509a776 100644
--- a/src/Language/PureScript/CodeGen/Optimize.hs
+++ b/src/Language/PureScript/CodeGen/Optimize.hs
@@ -23,6 +23,10 @@ import Data.Generics
import Language.PureScript.Names
import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Options
+import Language.PureScript.Pretty.Common (identToJs)
+import Language.PureScript.Sugar.TypeClasses
+ (mkDictionaryValueName)
+import Language.PureScript.Types (Type(..))
optimize :: Options -> JS -> JS
optimize opts =
@@ -213,10 +217,25 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =
JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]
convert other = other
- isBind (JSAccessor "bind" (JSAccessor "eff" (JSVar (Ident "Eff")))) = True
+ isBind (JSApp bindPoly [JSApp effDict []]) | isBindPoly bindPoly && isEffDict effDict = True
isBind _ = False
- isReturn (JSAccessor "ret" (JSAccessor "eff" (JSVar (Ident "Eff")))) = True
+ isReturn (JSApp retPoly [JSApp effDict []]) | isRetPoly retPoly && isEffDict effDict = True
isReturn _ = False
+ isBindPoly (JSVar (Op ">>=")) = True
+ isBindPoly (JSAccessor prop (JSVar (Ident "Prelude"))) | prop == identToJs (Op ">>=") = True
+ isBindPoly _ = False
+ isRetPoly (JSVar (Ident "ret")) = True
+ isRetPoly (JSAccessor "ret" (JSVar (Ident "Prelude"))) = True
+ isRetPoly _ = False
+ prelude = ModuleName (ProperName "Prelude")
+ effModule = ModuleName (ProperName "Eff")
+ Right (Ident effDictName) = mkDictionaryValueName
+ effModule
+ (Qualified (Just prelude) (ProperName "Monad"))
+ (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))
+ isEffDict (JSVar (Ident ident)) | ident == effDictName = True
+ isEffDict (JSAccessor prop (JSVar (Ident "Eff"))) | prop == effDictName = True
+ isEffDict _ = False
undo :: JS -> JS
undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
undo other = other