@@ -25,6 +25,8 @@ module Language.PureScript.CodeGen.JS (
2525import Data.Maybe (fromMaybe, mapMaybe)
2626import Data.List (sortBy)
2727import Data.Function (on)
28+import Data.Data (Data)
29+import Data.Generics (mkQ, everything)
2830
2931import Control.Arrow (second)
3032import Control.Monad (replicateM, forM)
@@ -143,11 +145,20 @@ valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not
143145valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
144146
145147-- |
146−-- Temporarily extends the environment to include a local variable name introduced by a lambda
147−-- abstraction.
148+-- Temporarily extends the environment with a single local variable name
148149--
149150bindName :: ModuleName -> Ident -> Environment -> Environment
150−bindName m ident env = env { names = M.insert (m, ident) (error "Temporary lambda variable type was read", LocalVariable) $ names env }
151+bindName m ident = bindNames m [ident]
152+
153+-- |
154+-- Temporarily extends the environment to include local variable names introduced by lambda
155+-- abstractions or case statements
156+--
157+bindNames :: ModuleName -> [Ident] -> Environment -> Environment
158+bindNames m idents env = env { names = M.fromList [ ((m, ident), (noType, LocalVariable)) | ident <- idents ] `M.union` names env }
159+ where
160+ noType = error "Temporary lambda variable type was read"
161+
151162
152163-- |
153164-- Generate code in the simplified Javascript intermediate representation for runtime type checks.
@@ -215,7 +226,7 @@ qualifiedToJS f (Qualified Nothing a) = JSVar $ identToJs (f a)
215226bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS
216227bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do
217228 valNames <- replicateM (length vals) fresh
218− jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd
229+ jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m (bindNames m (binderNames bs) e) result)] bs grd
219230 return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
220231 vals
221232 where
@@ -227,6 +238,15 @@ bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders,
227238 binderToJs m e v done'' b
228239 go _ _ _ _ = error "Invalid arguments to bindersToJs"
229240
241+-- |
242+-- Collect all names introduced in binders in an expression
243+--
244+binderNames :: (Data d) => d -> [Ident]
245+binderNames = everything (++) (mkQ [] go)
246+ where
247+ go (VarBinder ident) = [ident]
248+ go _ = []
249+
230250-- |
231251-- Generate code in the simplified Javascript intermediate representation for a pattern match
232252-- binder.
@@ -241,7 +261,7 @@ binderToJs _ _ varName done (BooleanBinder True) =
241261 return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
242262binderToJs _ _ varName done (BooleanBinder False) =
243263 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
244−binderToJs _ _ varName done (VarBinder ident) =
264+binderToJs m e varName done (VarBinder ident) =
245265 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
246266binderToJs m e varName done (NullaryBinder ctor) =
247267 if isOnlyConstructor m e ctor
@@ -296,7 +316,7 @@ binderToJs m e varName done (NamedBinder ident binder) = do
296316
297317-- |
298318-- Checks whether a data constructor is the only constructor for that type, used to simplify the
299−-- check when generating code for binders.
319+-- check when generating code for binders.
300320--
301321isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool
302322isOnlyConstructor m e ctor =