git.iko.soy/elk
on master help sign in
Better JS for function composition, runtime errors report which module they came from
0cd594cEvan Czaplicki
compiler/Generate/JavaScript.hs+46−28
compare with master
unifiedsplit
@@ -28,13 +28,14 @@ indent = concatMap f
28 where f '\n' = "\n "
28 where f '\n' = "\n "
29 f c = [c]
29 f c = [c]
30
30
31−internalImports =
31+internalImports name =
32 [ ("N" , "Elm.Native"),
32 [ ("N" , "Elm.Native"),
33 ("_N", "N.Utils(elm)"),
33 ("_N", "N.Utils(elm)"),
34 ("_L", "N.List(elm)"),
34 ("_L", "N.List(elm)"),
35 ("_E", "N.Error(elm)"),
35 ("_E", "N.Error(elm)"),
36 ("_J", "N.JavaScript(elm)"),
36 ("_J", "N.JavaScript(elm)"),
37− ("_str", "_J.toString")
37+ ("_str", "_J.toString"),
38+ ("$moduleName", quoted name)
38 ]
39 ]
39
40
40parens s = "(" ++ s ++ ")"
41parens s = "(" ++ s ++ ")"
@@ -78,7 +79,7 @@ jsModule modul =
78 ]
79 ]
79 setup names = concatMap (\n -> globalAssign n $ n ++ " || {}") .
80 setup names = concatMap (\n -> globalAssign n $ n ++ " || {}") .
80 map dotSep . drop 2 . List.inits $ init names
81 map dotSep . drop 2 . List.inits $ init names
81− usefulFuncs = commaSep (map (uncurry assign') internalImports)
82+ usefulFuncs = commaSep (map (uncurry assign') (internalImports modName)
82
83
83 jsExports = setup ("elm" : names modul) ++
84 jsExports = setup ("elm" : names modul) ++
84 ret (assign' ("elm." ++ modName) (brackets exs))
85 ret (assign' ("elm." ++ modName) (brackets exs))
@@ -194,7 +195,7 @@ instance ToJS (Expr t v) where
194 Modify e fs -> do fs' <- (mapM (\(x,v) -> (,) x `liftM` toJS' v) fs)
195 Modify e fs -> do fs' <- (mapM (\(x,v) -> (,) x `liftM` toJS' v) fs)
195 setField fs' `liftM` toJS' e
196 setField fs' `liftM` toJS' e
196 Record fs -> makeRecord fs
197 Record fs -> makeRecord fs
197− Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2
198+ Binop op e1 e2 -> binop op e1 e2
198
199
199 Lambda p e@(L s _) -> liftM (fastFunc . ret) (toJS' body)
200 Lambda p e@(L s _) -> liftM (fastFunc . ret) (toJS' body)
200 where
201 where
@@ -257,7 +258,7 @@ formatMarkdown = concatMap f
257multiIfToJS span ps =
258multiIfToJS span ps =
258 case last ps of
259 case last ps of
259 (L _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)
260 (L _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)
260− _ -> format ("_E.If" ++ parens (quoted (show span))) ps
261+ _ -> format ("_E.If" ++ parens ("$moduleName," ++ quoted (show span))) ps
261 where
262 where
262 format base ps =
263 format base ps =
263 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
264 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
@@ -289,7 +290,7 @@ matchToJS span match =
289 access = if any isLiteral clauses then "" else ".ctor"
290 access = if any isLiteral clauses then "" else ".ctor"
290 return $ concat [ "\nswitch (", name, access, ") {"
291 return $ concat [ "\nswitch (", name, access, ") {"
291 , indent cases, "\n}", finally ]
292 , indent cases, "\n}", finally ]
292− Fail -> return ("_E.Case" ++ parens (quoted (show span)))
293+ Fail -> return ("_E.Case" ++ parens ("$moduleName," ++ quoted (show span)))
293 Break -> return "break;"
294 Break -> return "break;"
294 Other e -> ret `liftM` toJS' e
295 Other e -> ret `liftM` toJS' e
295 Seq ms -> concat `liftM` mapM (matchToJS span) (dropEnd [] ms)
296 Seq ms -> concat `liftM` mapM (matchToJS span) (dropEnd [] ms)
@@ -318,33 +319,50 @@ jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)
318jsCompare e1 e2 op = parens ("_N.cmp(" ++ e1 ++ "," ++ e2 ++ ")" ++ op)
319jsCompare e1 e2 op = parens ("_N.cmp(" ++ e1 ++ "," ++ e2 ++ ")" ++ op)
319
320
320
321
321−binop op e1 e2 =
322+binop op e1 e2
323+ | op == "Basics.." =
324+ do ss <- mapM toJS' (e1 : collect [] e2)
325+ return . jsFunc "$" . ret $ apply "$" ss
326+ | op == "Basics.<|" =
327+ do arg <- toJS' e2
328+ funcs <- mapM toJS' (collect [] e1)
329+ return (apply arg funcs)
330+ | otherwise =
331+ binopNormal op `liftM` toJS' e1 `ap` toJS' e2
332+ where
333+ apply = foldr (\f arg-> f ++ parens arg)
334+
335+ collect es e =
336+ case e of
337+ L _ (Binop op e1 e2) | op == "Basics.." -> collect (es ++ [e1]) e2
338+ _ -> es ++ [e]
339+
340+binopNormal op s1 s2 =
322 case Map.lookup op opDict of
341 case Map.lookup op opDict of
323 Just e -> e
342 Just e -> e
324− Nothing -> "A2" ++ parens (commaSep [ prefix ++ func, e1, e2 ])
343+ Nothing -> "A2" ++ parens (commaSep [ prefix ++ func, s1, s2 ])
325− where
326− func | isOp op' = "_op['" ++ op' ++ "']"
327− | otherwise = op'
328− (prefix, op') = case List.elemIndices '.' op of
329− [] -> ("", op)
330− xs -> splitAt (last xs + 1) op
331 where
344 where
345+ func | isOp op' = "_op['" ++ op' ++ "']"
346+ | otherwise = op'
347+ (prefix, op') = case List.elemIndices '.' op of
348+ [] -> ("", op)
349+ xs -> splitAt (last xs + 1) op
350+
332 opDict = Map.fromList $ basics ++
351 opDict = Map.fromList $ basics ++
333− [ ("::", jsCons e1 e2)
352+ [ ("::", jsCons s1 s2)
334− , ("List.++", "_L.append" ++ parens (e1 ++ "," ++ e2)) ]
353+ , ("List.++", "_L.append" ++ parens (s1 ++ "," ++ s2)) ]
335
354
336− ops = pow : map (\op -> (op, parens (e1 ++ op ++ e2))) ["+","-","*","/","&&","||"]
355+ ops = pow : map (\op -> (op, parens (s1 ++ op ++ s2))) ["+","-","*","/","&&","||"]
337− where pow = ("^" , "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")")
356+ where pow = ("^" , "Math.pow(" ++ s1 ++ "," ++ s2 ++ ")")
338
357
339 basics = ops ++ map (\(op,e) -> ("Basics." ++ op, e))
358 basics = ops ++ map (\(op,e) -> ("Basics." ++ op, e))
340− (ops ++ [ ("<|", e1 ++ parens e2)
359+ (ops ++ [ ("<|", s1 ++ parens s2)
341− , ("|>", e2 ++ parens e1)
360+ , ("|>", s2 ++ parens s1)
342− , ("." , jsFunc "$" . ret $ e1 ++ parens (e2 ++ parens "$"))
343− , ("==", "_N.eq(" ++ e1 ++ "," ++ e2 ++ ")")
361+ , ("==", "_N.eq(" ++ s1 ++ "," ++ s2 ++ ")")
344− , ("/=", "!_N.eq(" ++ e1 ++ "," ++ e2 ++ ")")
362+ , ("/=", "!_N.eq(" ++ s1 ++ "," ++ s2 ++ ")")
345− , ("<" , jsCompare e1 e2 "<0")
363+ , ("<" , jsCompare s1 s2 "<0")
346− , (">" , jsCompare e1 e2 ">0")
364+ , (">" , jsCompare s1 s2 ">0")
347− , ("<=", jsCompare e1 e2 "<1")
365+ , ("<=", jsCompare s1 s2 "<1")
348− , (">=", jsCompare e1 e2 ">-1")
366+ , (">=", jsCompare s1 s2 ">-1")
349− , ("div", parens (e1 ++ "/" ++ e2 ++ "|0"))
367+ , ("div", parens (s1 ++ "/" ++ s2 ++ "|0"))
350 ])
368 ])
libraries/Native/Error.js+6−6
@@ -6,14 +6,14 @@ Elm.Native.Error = function(elm) {
6
6
7 var fromString = Elm.Native.JavaScript(elm).fromString;
7 var fromString = Elm.Native.JavaScript(elm).fromString;
8
8
9− function Case(span) {
9+ function Case(moduleName, span) {
10− var msg = 'Non-exhaustive pattern match in case expression'
10+ var msg = 'Non-exhaustive pattern match in case expression in module '
11− throw new Error(msg + " (" + span + ")")
11+ throw new Error(msg + moduleName + " (" + span + ")")
12 }
12 }
13
13
14− function If(span) {
14+ function If(moduleName, span) {
15− var msg = 'Non-exhaustive pattern match in multi-way-if expression'
15+ var msg = 'Non-exhaustive pattern match in multi-way-if expression in module '
16− throw new Error(msg + " (" + span + ")")
16+ throw new Error(msg + moduleName + " (" + span + ")")
17 }
17 }
18
18
19 function raise(str) { throw new Error(fromString(str)); }
19 function raise(str) { throw new Error(fromString(str)); }