@@ -34,6 +34,7 @@ import Control.Monad (foldM, replicateM, forM)
34import Control.Monad.Reader (MonadReader, asks)
34import Control.Monad.Reader (MonadReader, asks)
35import Control.Monad.Supply.Class
35import Control.Monad.Supply.Class
37+import Language.PureScript.AST.SourcePos
37import Language.PureScript.CodeGen.JS.AST as AST
38import Language.PureScript.CodeGen.JS.AST as AST
38import Language.PureScript.CodeGen.JS.Common as Common
39import Language.PureScript.CodeGen.JS.Common as Common
39import Language.PureScript.CoreFn
40import Language.PureScript.CoreFn
@@ -172,9 +173,9 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
172 unApp other args = (other, args)
173 unApp other args = (other, args)
173 valueToJs (Var _ ident) =
174 valueToJs (Var _ ident) =
174 return $ varToJs ident
175 return $ varToJs ident
175− valueToJs (Case _ values binders) = do
176+ valueToJs (Case (maybeSpan, _, _, _) values binders) = do
176 vals <- mapM valueToJs values
177 vals <- mapM valueToJs values
177− bindersToJs binders vals
178+ bindersToJs maybeSpan binders vals
178 valueToJs (Let _ ds val) = do
179 valueToJs (Let _ ds val) = do
179 ds' <- concat <$> mapM bindToJs ds
180 ds' <- concat <$> mapM bindToJs ds
180 ret <- valueToJs val
181 ret <- valueToJs val
@@ -249,8 +250,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
249 -- Generate code in the simplified Javascript intermediate representation for pattern match binders
250 -- Generate code in the simplified Javascript intermediate representation for pattern match binders
250 -- and guards.
251 -- and guards.
252− bindersToJs :: [CaseAlternative Ann] -> [JS] -> m JS
253+ bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
253− bindersToJs binders vals = do
254+ bindersToJs maybeSpan binders vals = do
254 valNames <- replicateM (length vals) freshName
255 valNames <- replicateM (length vals) freshName
255 let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
256 let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
256 jss <- forM binders $ \(CaseAlternative bs result) -> do
257 jss <- forM binders $ \(CaseAlternative bs result) -> do
@@ -267,7 +268,10 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
267 go _ _ _ = error "Invalid arguments to bindersToJs"
268 go _ _ _ = error "Invalid arguments to bindersToJs"
269 failedPatternError :: [String] -> JS
270 failedPatternError :: [String] -> JS
270− failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral "Failed pattern match: ") (JSArrayLiteral $ zipWith valueError names vals)]
271+ failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
273+ errorMessage :: String
274+ errorMessage = "Failed pattern match" ++ maybe "" ((" at " ++) . displaySourceSpan) maybeSpan ++ ": "
272 valueError :: String -> JS -> JS
276 valueError :: String -> JS -> JS
273 valueError _ l@(JSNumericLiteral _) = l
277 valueError _ l@(JSNumericLiteral _) = l