@@ -256,7 +256,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
256 jss <- forM binders $ \(CaseAlternative bs result) -> do
256 jss <- forM binders $ \(CaseAlternative bs result) -> do
257 ret <- guardsToJs result
257 ret <- guardsToJs result
258 go valNames ret bs
258 go valNames ret bs
259− return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") [JSStringLiteral "Failed pattern match"]])))
259+ return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
262 go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
262 go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
@@ -266,6 +266,15 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
266 binderToJs v done'' b
266 binderToJs v done'' b
267 go _ _ _ = error "Invalid arguments to bindersToJs"
267 go _ _ _ = error "Invalid arguments to bindersToJs"
269+ failedPatternError :: [String] -> JS
270+ failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral "Failed pattern match: ") (JSArrayLiteral $ zipWith valueError names vals)]
272+ valueError :: String -> JS -> JS
273+ valueError _ l@(JSNumericLiteral _) = l
274+ valueError _ l@(JSStringLiteral _) = l
275+ valueError _ l@(JSBooleanLiteral _) = l
276+ valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
269 guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
278 guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
270 guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
279 guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
271 cond' <- valueToJs cond
280 cond' <- valueToJs cond