purescript 0.3.10 → 0.3.10.1

raw patch · 4 files changed

+17/−14 lines, 4 files

Files

• libraries/prelude/prelude.purs +2/−0
• purescript.cabal +1/−1
• src/Language/PureScript/CodeGen/Optimize.hs +7/−7
• src/Language/PureScript/Sugar/BindingGroups.hs +7/−6

@@ -987,6 +987,7 @@                              \  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 @@                             \  return function(val) {\                             \    return function() {\                             \      ref.value = val;\+                            \      return {};\                             \    };\                             \  };\                             \}" :: forall s r. IORef s -> s -> Eff (ref :: Ref | r) {}

@@ -1,5 +1,5 @@ name: purescript-version: 0.3.10+version: 0.3.10.1 cabal-version: >=1.8 build-type: Simple license: MIT

@@ -94,14 +94,13 @@   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 @@   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 @@   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")

@@ -36,7 +36,7 @@ -- 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 @@ -- | -- 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 @@   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]