version 0.5.30.5.3

5 files changed, 16 insertions, 26 deletions

diff --git a/prelude/prelude.purs b/prelude/prelude.purs
index 0900929..2284412 100644
--- a/prelude/prelude.purs
+++ b/prelude/prelude.purs
@@ -604,6 +604,9 @@ module Data.Eq where
     (==) = liftRef refEq
     (/=) = liftRef refIneq
 
+  instance functorRef :: Functor Ref where
+    (<$>) f (Ref x) = Ref (f x)
+
 module Prelude.Unsafe where
 
   foreign import unsafeIndex
@@ -684,9 +687,11 @@ module Control.Monad.Eff where
 
   foreign import foreachE "function foreachE(as) {\
                           \  return function(f) {\
-                          \    for (var i = 0; i < as.length; i++) {\
-                          \      f(as[i])();\
-                          \    }\
+                          \    return function() {\
+                          \      for (var i = 0; i < as.length; i++) {\
+                          \        f(as[i])();\
+                          \      }\
+                          \    };\
                           \  };\
                           \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit
 
diff --git a/purescript.cabal b/purescript.cabal
index 743f0bf..9a31906 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
 name: purescript
-version: 0.5.2.6
+version: 0.5.3
 cabal-version: >=1.8
 build-type: Custom
 license: MIT
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 0c37a64..6184461 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -171,7 +171,7 @@ valueToJs opts m e (Let ds val) = do
   ret <- valueToJs opts m e val
   return $ JSApp (JSFunction Nothing [] (JSBlock (decls ++ [JSReturn ret]))) []
 valueToJs opts m e (Abs (Left arg) val) = do
-  ret <- valueToJs opts m (bindName m arg e) val
+  ret <- valueToJs opts m e val
   return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
 valueToJs opts m e (TypedValue _ (Abs (Left arg) val) ty) | optionsPerformRuntimeTypeChecks opts = do
   let arg' = identToJs arg
@@ -201,22 +201,6 @@ extendObj obj sts = do
     stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
     extend = map stToAssign sts
   return $ JSApp (JSFunction Nothing [] block) []
-  where
-
--- |
--- Temporarily extends the environment with a single local variable name
---
-bindName :: ModuleName -> Ident -> Environment -> Environment
-bindName m ident = bindNames m [ident]
-
--- |
--- Temporarily extends the environment to include local variable names introduced by lambda
--- abstractions or case statements
---
-bindNames :: ModuleName -> [Ident] -> Environment -> Environment
-bindNames m idents env = env { names = M.fromList [ ((m, ident), (noType, LocalVariable)) | ident <- idents ] `M.union` names env }
-  where
-  noType = error "Temporary lambda variable type was read"
 
 -- |
 -- Generate code in the simplified Javascript intermediate representation for runtime type checks.
@@ -274,7 +258,7 @@ bindersToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> E
 bindersToJs opts m e binders vals = do
   valNames <- replicateM (length vals) freshName
   jss <- forM binders $ \(CaseAlternative bs grd result) -> do
-    ret <- valueToJs opts m (bindNames m (concatMap binderNames bs) e) result
+    ret <- valueToJs opts m e result
     go valNames [JSReturn ret] bs grd
   return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
                  vals
diff --git a/src/Language/PureScript/Optimizer/TCO.hs b/src/Language/PureScript/Optimizer/TCO.hs
index ba5ed68..511b006 100644
--- a/src/Language/PureScript/Optimizer/TCO.hs
+++ b/src/Language/PureScript/Optimizer/TCO.hs
@@ -41,7 +41,7 @@ tco' = everywhereOnJS convert
     in case () of
       _ | isTailCall name body' ->
             let
-              allArgs = reverse $ concat argss
+              allArgs = concat $ reverse argss
             in
               JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
         | otherwise -> js
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 3e2470b..349f32e 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -137,8 +137,9 @@ typeClassDictionaryDeclaration name args implies members =
                                                         , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs
                                                         , let fieldName = mkSuperclassDictionaryName superclass index
                                                         ], REmpty))
-
-  in TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList ((C.__superclasses, superclassesType) : map (first identToProperty . memberToNameAndType) members, REmpty))
+      members' = map (first identToProperty . memberToNameAndType) members
+      mtys = if null implies then members' else (C.__superclasses, superclassesType) : members'
+  in TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (mtys, REmpty))
 
 typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration
 typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =
@@ -187,7 +188,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =
             , let fieldName = mkSuperclassDictionaryName superclass index
             ]
 
-      let memberNames' = (C.__superclasses, superclasses) : memberNames
+      let memberNames' = if null implies then memberNames else (C.__superclasses, superclasses) : memberNames
           dictTy = foldl TypeApp (TypeConstructor className) tys
           constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)
           dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'