version 0.3.10.10.3.10.1

4 files changed, 17 insertions, 14 deletions

diff --git a/libraries/prelude/prelude.purs b/libraries/prelude/prelude.purs
index fec2078..7959f73 100644
--- a/libraries/prelude/prelude.purs
+++ b/libraries/prelude/prelude.purs
@@ -987,6 +987,7 @@ module IORef where
                              \  return function(f) {\
                              \    return function() {\
                              \      ref.value = f(ref.value);\
+                             \      return {};\
                              \    };\
                              \  };\
                              \}" :: forall s r. IORef s -> (s -> s) -> Eff (ref :: Ref | r) {}
@@ -995,6 +996,7 @@ module IORef where
                             \  return function(val) {\
                             \    return function() {\
                             \      ref.value = val;\
+                            \      return {};\
                             \    };\
                             \  };\
                             \}" :: forall s r. IORef s -> s -> Eff (ref :: Ref | r) {}
diff --git a/purescript.cabal b/purescript.cabal
index a3c3065..7043137 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.3.10
+version: 0.3.10.1
 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 4427a4f..368d0c9 100644
--- a/src/Language/PureScript/CodeGen/Optimize.hs
+++ b/src/Language/PureScript/CodeGen/Optimize.hs
@@ -94,14 +94,13 @@ isReassigned var1 = everything (||) (mkQ False check)
   where
   check :: JS -> Bool
   check (JSFunction _ args _) | var1 `elem` args = True
+  check (JSVariableIntroduction arg _) | var1 == arg = True
   check _ = False
 
 isRebound :: (Data d) => JS -> d -> Bool
-isRebound js d = any (\var -> isReassigned var d) (variablesOf js)
+isRebound js d = any (\var -> isReassigned var d) (everything (++) (mkQ [] variablesOf) js)
   where
   variablesOf (JSVar var) = [var]
-  variablesOf (JSAccessor _ val) = variablesOf val
-  variablesOf (JSIndexer index val) = variablesOf index ++ variablesOf val
   variablesOf _ = []
 
 isUsed :: (Data d) => String -> d -> Bool
@@ -163,7 +162,10 @@ etaConvert = everywhere (mkT convert)
   where
   convert :: JS -> JS
   convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
-    | all shouldInline args && not (or (map (flip isRebound block) args)) = JSBlock (replaceIdents (zip idents args) body)
+    | all shouldInline args &&
+      not (any (flip isRebound block) (map JSVar idents)) &&
+      not (or (map (flip isRebound block) args))
+      = JSBlock (replaceIdents (zip idents args) body)
   convert js = js
 
 unThunk :: JS -> JS
@@ -270,12 +272,10 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
   isBind _ = False
   isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict effDict = True
   isReturn _ = False
-  isBindPoly (JSVar op) | op == identToJs (Op ">>=") = True
   isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True
   isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSVar "Prelude")) = True
   isBindPoly _ = False
-  isRetPoly (JSVar "ret") = True
-  isRetPoly (JSAccessor "ret" (JSVar "Prelude")) = True
+  isRetPoly (JSAccessor "$return" (JSVar "Prelude")) = True
   isRetPoly _ = False
   prelude = ModuleName (ProperName "Prelude")
   effModule = ModuleName (ProperName "Eff")
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
index de04561..ff92518 100644
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -36,7 +36,7 @@ import Language.PureScript.Types
 -- Replace all sets of mutually-recursive declarations in a module with binding groups
 --
 createBindingGroupsModule :: [Module] -> Either String [Module]
-createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups ds
+createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups (ModuleName name) ds
 
 -- |
 -- Collapse all binding groups in a module to individual declarations
@@ -47,15 +47,15 @@ collapseBindingGroupsModule = map $ \(Module name ds) -> Module name (collapseBi
 -- |
 -- Replace all sets of mutually-recursive declarations with binding groups
 --
-createBindingGroups :: [Declaration] -> Either String [Declaration]
-createBindingGroups ds = do
+createBindingGroups :: ModuleName -> [Declaration] -> Either String [Declaration]
+createBindingGroups moduleName ds = do
   let values = filter isValueDecl ds
       dataDecls = filter isDataDecl ds
       allProperNames = map getProperName dataDecls
       dataVerts = map (\d -> (d, getProperName d, usedProperNames d `intersect` allProperNames)) dataDecls
   dataBindingGroupDecls <- mapM toDataBindingGroup $ stronglyConnComp dataVerts
   let allIdents = map getIdent values
-      valueVerts = map (\d -> (d, getIdent d, usedIdents d `intersect` allIdents)) values
+      valueVerts = map (\d -> (d, getIdent d, usedIdents moduleName d `intersect` allIdents)) values
       bindingGroupDecls = map toBindingGroup $ stronglyConnComp valueVerts
   return $ filter isImportDecl ds ++
            filter isExternDataDecl ds ++
@@ -75,11 +75,12 @@ collapseBindingGroups ds = concatMap go ds
   go (BindingGroupDeclaration ds) = map (\(ident, val) -> ValueDeclaration ident [] Nothing val) ds
   go other = [other]
 
-usedIdents :: (Data d) => d -> [Ident]
-usedIdents = nub . everything (++) (mkQ [] names)
+usedIdents :: (Data d) => ModuleName -> d -> [Ident]
+usedIdents moduleName = nub . everything (++) (mkQ [] names)
   where
   names :: Value -> [Ident]
   names (Var (Qualified Nothing name)) = [name]
+  names (Var (Qualified (Just moduleName') name)) | moduleName == moduleName' = [name]
   names _ = []
 
 usedProperNames :: (Data d) => d -> [ProperName]