@@ -27,24 +27,18 @@ indent = concatMap f
2727 f c = [c]
2828
2929internalImports =
30− [ ("_Utils", "Elm.Native.Utils(elm)"),
31− ("_insert", "_Utils.insert"),
32− ("_remove", "_Utils.remove"),
33− ("_replace", "_Utils.replace"),
34− ("_eq", "_Utils.eq"),
35− ("_compare", "_Utils.compare"),
36− ("_range", "Elm.Native.List(elm).range"),
37− ("_append", "Elm.Native.List(elm).append"),
38− ("_caseError", "Elm.Native.Error(elm).Case"),
39− ("_ifError", "Elm.Native.Error(elm).If"),
40− ("_str", "Elm.Native.JavaScript(elm).toString")
30+ [ ("N" , "Elm.Native"),
31+ ("_" , "N.Utils(elm)"),
32+ ("_L", "N.List(elm)"),
33+ ("_E", "N.Error(elm)"),
34+ ("_str", "N.JavaScript(elm).toString")
4135 ]
4236
4337parens s = "(" ++ s ++ ")"
4438brackets s = "{" ++ s ++ "}"
4539jsList ss = "["++ intercalate "," ss ++"]"
4640jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
47−assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"
41+assign x e = "\nvar " ++ x ++ " = " ++ e ++ ";"
4842ret e = "\nreturn "++ e ++";"
4943iff a b c = a ++ "?" ++ b ++ ":" ++ c
5044quoted s = "'" ++ concatMap f s ++ "'"
@@ -65,19 +59,17 @@ jsModule (Module names exports imports stmts) =
6559 modName = intercalate "." modNames
6660 includes = concatMap jsImport imports
6761 body = stmtsToJS stmts
68− export = getExports exports stmts
69− exps = if null exports then ["main"] else exports
7062 defs = assign "$op" "{}"
71− program = usefulFuncs ++ defs ++ includes ++ body ++
72− ret ("elm." ++ modName ++ " = " ++ export)
63+ program = "\nvar " ++ usefulFuncs ++ ";" ++ defs ++ includes ++ body ++
64+ "\n_ = " ++ "elm.Native." ++ modName ++ " || {};" ++
65+ getExports exports stmts ++
66+ ret (assign' ("elm." ++ modName) "_") ++ "\n"
7367 setup = concatMap (\n -> globalAssign n $ n ++ " || {}") .
7468 map (intercalate ".") . tail . inits $
7569 take (length modNames - 1) modNames
76− usefulFuncs =
77− "var " ++ intercalate ", " (map (uncurry assign) internalImports) ++ ";"
70+ usefulFuncs = intercalate ", " (map (uncurry assign') internalImports)
7871
79−getExports names stmts = brackets . ("\n "++) $
80− intercalate ",\n " (op : map fnPair fns)
72+getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)
8173 where exNames n = either derename id n `elem` names
8274 exports | null names = concatMap get stmts
8375 | otherwise = filter exNames (concatMap get stmts)
@@ -85,9 +77,9 @@ getExports names stmts = brackets . ("\n "++) $
8577 (fns,ops) = partitionEithers exports
8678
8779 opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"
88− fnPair fn = let fn' = derename fn in fn' ++ ":" ++ fn
80+ fnPair fn = let fn' = derename fn in "_." ++ fn' ++ " = " ++ fn
8981
90− op = ("$op : "++) . brackets . intercalate ", " $ map opPair ops
82+ op = ("_.$op = "++) . brackets . intercalate ", " $ map opPair ops
9183
9284 get' (FnDef x _ _) = Left x
9385 get' (OpDef op _ _ _) = Right op
@@ -103,12 +95,14 @@ jsImport (modul, how) =
10395 case how of
10496 As name -> assign name ("Elm." ++ modul ++ parens "elm")
10597 Importing vs ->
106− "\nElm." ++ modul ++ parens "elm" ++ ";" ++ concatMap def vs
107− where
108− imprt asgn v = asgn v ("elm." ++ modul ++ "." ++ v)
109− def (o:p) =
110− if isOp o then imprt globalAssign ("$op['" ++ o:p ++ "']")
111− else imprt assign (deprime (o:p))
98+ "\nvar _$ = Elm." ++ modul ++ parens "elm" ++ ";" ++
99+ if null vs then "\nfor (var k in _$) {eval('var '+k+'=_$[\"'+k+'\"]')}"
100+ else concatMap def vs
101+ where
102+ imprt asgn v = asgn v ("elm." ++ modul ++ "." ++ v)
103+ def (o:p) =
104+ if isOp o then imprt globalAssign ("$op['" ++ o:p ++ "']")
105+ else imprt assign (deprime (o:p))
112106
113107
114108stmtsToJS :: [Statement] -> String
@@ -179,9 +173,9 @@ toJS' (C txt span expr) =
179173 Case e cases -> caseToJS span e cases
180174 _ -> toJS expr
181175
182−remove x e = "_remove('" ++ x ++ "', " ++ e ++ ")"
183−addField x v e = "_insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
184−setField fs e = "_replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
176+remove x e = "_.remove('" ++ x ++ "', " ++ e ++ ")"
177+addField x v e = "_.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
178+setField fs e = "_.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
185179 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"
186180access x e = parens e ++ "." ++ x
187181makeRecord kvs = record `liftM` collect kvs
@@ -254,7 +248,7 @@ formatMarkdown = concatMap f
254248multiIfToJS span ps =
255249 case last ps of
256250 (C _ _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)
257− _ -> format ("_ifError" ++ parens (quoted (show span))) ps
251+ _ -> format ("_E.If" ++ parens (quoted (show span))) ps
258252 where
259253 format base ps =
260254 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
@@ -286,13 +280,13 @@ caseToJS span e ps = do
286280 Just exp -> parens (exp ++ ", " ++ matches)
287281
288282matchToJS span match =
289− let sqnc e1 e2 = parens ("e = " ++ e1 ++ " : null, " ++ "e !== null ? e : " ++ e2)
283+ let sqnc e1 e2 = parens ("e=" ++ e1 ++ ":null,e!==null?e:" ++ e2)
290284 in case match of
291285 Match name clauses def ->
292− do cases <- intercalate " : " `liftM` mapM (clauseToJS span name) clauses
286+ do cases <- intercalate ":" `liftM` mapM (clauseToJS span name) clauses
293287 finally <- matchToJS span def
294288 return (sqnc cases finally)
295− Fail -> return ("_caseError" ++ parens (quoted (show span)))
289+ Fail -> return ("_E.Case" ++ parens (quoted (show span)))
296290 Break -> return "null"
297291 Other e -> toJS' e
298292 Seq ms -> foldr1 sqnc `liftM` mapM (matchToJS span) (dropEnd [] ms)
@@ -306,12 +300,12 @@ matchToJS span match =
306300clauseToJS span var (Clause name vars e) = do
307301 let vars' = map (\n -> var ++ "._" ++ show n) [0..]
308302 s <- matchToJS span $ matchSubst (zip vars vars') e
309− return $ concat [ var, ".ctor === ", quoted name, " ? ", s ]
303+ return $ concat [ var, ".ctor===", quoted name, "?", s ]
310304
311−jsNil = "{ctor:'Nil'}"
312−jsCons e1 e2 = "{ctor:'Cons',_0:" ++ e1 ++ ",_1:" ++ e2 ++ "}"
313−jsRange e1 e2 = "_range" ++ parens (e1 ++ "," ++ e2)
314−jsCompare e1 e2 op = parens ("_compare(" ++ e1 ++ "," ++ e2 ++ ").ctor " ++ op)
305+jsNil = "_L.Nil"
306+jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"
307+jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)
308+jsCompare e1 e2 op = parens ("_.compare(" ++ e1 ++ "," ++ e2 ++ ").ctor" ++ op)
315309
316310binop (o:p) e1 e2
317311 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2
@@ -319,19 +313,18 @@ binop (o:p) e1 e2
319313 let ops = ["+","-","*","/","&&","||"] in
320314 case o:p of
321315 "::" -> jsCons e1 e2
322− "++" -> "_append" ++ parens (e1 ++ "," ++ e2)
316+ "++" -> "_L.append" ++ parens (e1 ++ "," ++ e2)
323317 "$" -> e1 ++ parens e2
324318 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")
325319 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"
326− "==" -> "_eq(" ++ e1 ++ "," ++ e2 ++ ")"
327− "/=" -> "!_eq(" ++ e1 ++ "," ++ e2 ++ ")"
328− "<" -> jsCompare e1 e2 "=== 'LT'"
329− ">" -> jsCompare e1 e2 "=== 'GT'"
330− "<=" -> jsCompare e1 e2 "!== 'GT'"
331− ">=" -> jsCompare e1 e2 "!== 'LT'"
332− "<~" -> "lift" ++ parens e1 ++ parens e2
333− "~" -> "lift2(function(f){return function(x){return f(x);};})" ++
334− parens e1 ++ parens e2
320+ "==" -> "_.eq(" ++ e1 ++ "," ++ e2 ++ ")"
321+ "/=" -> "!_.eq(" ++ e1 ++ "," ++ e2 ++ ")"
322+ "<" -> jsCompare e1 e2 "==='LT'"
323+ ">" -> jsCompare e1 e2 "==='GT'"
324+ "<=" -> jsCompare e1 e2 "!=='GT'"
325+ ">=" -> jsCompare e1 e2 "!=='LT'"
326+ "<~" -> "A2(lift," ++ e1 ++ "," ++ e2 ++ ")"
327+ "~" -> "A3(lift2,F2(function(f,x){return f(x)}),"++e1++","++e2++")"
335328 _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)
336329 | otherwise -> concat [ "$op['", o:p, "']"
337330 , parens e1, parens e2 ]