@@ -27,24 +27,18 @@ indent = concatMap f
29internalImports =
29internalImports =
30− [ ("_Utils", "Elm.Native.Utils(elm)"),
30+ [ ("N" , "Elm.Native"),
31− ("_insert", "_Utils.insert"),
31+ ("_" , "N.Utils(elm)"),
32− ("_remove", "_Utils.remove"),
32+ ("_L", "N.List(elm)"),
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"),
33+ ("_E", "N.Error(elm)"),
40− ("_str", "Elm.Native.JavaScript(elm).toString")
34+ ("_str", "N.JavaScript(elm).toString")
43parens s = "(" ++ s ++ ")"
37parens s = "(" ++ s ++ ")"
44brackets s = "{" ++ s ++ "}"
38brackets s = "{" ++ s ++ "}"
45jsList ss = "["++ intercalate "," ss ++"]"
39jsList ss = "["++ intercalate "," ss ++"]"
46jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
40jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
47−assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"
41+assign x e = "\nvar " ++ x ++ " = " ++ e ++ ";"
48ret e = "\nreturn "++ e ++";"
42ret e = "\nreturn "++ e ++";"
49iff a b c = a ++ "?" ++ b ++ ":" ++ c
43iff a b c = a ++ "?" ++ b ++ ":" ++ c
50quoted s = "'" ++ concatMap f s ++ "'"
44quoted s = "'" ++ concatMap f s ++ "'"
@@ -65,19 +59,17 @@ jsModule (Module names exports imports stmts) =
65 modName = intercalate "." modNames
59 modName = intercalate "." modNames
66 includes = concatMap jsImport imports
60 includes = concatMap jsImport imports
67 body = stmtsToJS stmts
61 body = stmtsToJS stmts
68− export = getExports exports stmts
69− exps = if null exports then ["main"] else exports
70 defs = assign "$op" "{}"
62 defs = assign "$op" "{}"
71− program = usefulFuncs ++ defs ++ includes ++ body ++
63+ program = "\nvar " ++ usefulFuncs ++ ";" ++ defs ++ includes ++ body ++
64+ "\n_ = " ++ "elm.Native." ++ modName ++ " || {};" ++
65+ getExports exports stmts ++
72− ret ("elm." ++ modName ++ " = " ++ export)
66+ ret (assign' ("elm." ++ modName) "_") ++ "\n"
73 setup = concatMap (\n -> globalAssign n $ n ++ " || {}") .
67 setup = concatMap (\n -> globalAssign n $ n ++ " || {}") .
74 map (intercalate ".") . tail . inits $
68 map (intercalate ".") . tail . inits $
75 take (length modNames - 1) modNames
69 take (length modNames - 1) modNames
77− "var " ++ intercalate ", " (map (uncurry assign) internalImports) ++ ";"
70+ usefulFuncs = intercalate ", " (map (uncurry assign') internalImports)
79−getExports names stmts = brackets . ("\n "++) $
80− intercalate ",\n " (op : map fnPair fns)
72+getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)
81 where exNames n = either derename id n `elem` names
73 where exNames n = either derename id n `elem` names
82 exports | null names = concatMap get stmts
74 exports | null names = concatMap get stmts
83 | otherwise = filter exNames (concatMap get stmts)
75 | otherwise = filter exNames (concatMap get stmts)
@@ -85,9 +77,9 @@ getExports names stmts = brackets . ("\n "++) $
85 (fns,ops) = partitionEithers exports
77 (fns,ops) = partitionEithers exports
87 opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"
79 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
90− op = ("$op : "++) . brackets . intercalate ", " $ map opPair ops
82+ op = ("_.$op = "++) . brackets . intercalate ", " $ map opPair ops
92 get' (FnDef x _ _) = Left x
84 get' (FnDef x _ _) = Left x
93 get' (OpDef op _ _ _) = Right op
85 get' (OpDef op _ _ _) = Right op
@@ -103,12 +95,14 @@ jsImport (modul, how) =
103 case how of
95 case how of
104 As name -> assign name ("Elm." ++ modul ++ parens "elm")
96 As name -> assign name ("Elm." ++ modul ++ parens "elm")
105 Importing vs ->
97 Importing vs ->
98+ "\nvar _$ = Elm." ++ modul ++ parens "elm" ++ ";" ++
99+ if null vs then "\nfor (var k in _$) {eval('var '+k+'=_$[\"'+k+'\"]')}"
106− "\nElm." ++ modul ++ parens "elm" ++ ";" ++ concatMap def vs
100+ else concatMap def vs
108− imprt asgn v = asgn v ("elm." ++ modul ++ "." ++ v)
102+ imprt asgn v = asgn v ("elm." ++ modul ++ "." ++ v)
109− def (o:p) =
103+ def (o:p) =
110− if isOp o then imprt globalAssign ("$op['" ++ o:p ++ "']")
104+ if isOp o then imprt globalAssign ("$op['" ++ o:p ++ "']")
111− else imprt assign (deprime (o:p))
105+ else imprt assign (deprime (o:p))
114stmtsToJS :: [Statement] -> String
108stmtsToJS :: [Statement] -> String
@@ -179,9 +173,9 @@ toJS' (C txt span expr) =
179 Case e cases -> caseToJS span e cases
173 Case e cases -> caseToJS span e cases
180 _ -> toJS expr
174 _ -> toJS expr
182−remove x e = "_remove('" ++ x ++ "', " ++ e ++ ")"
176+remove x e = "_.remove('" ++ x ++ "', " ++ e ++ ")"
183−addField x v e = "_insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
177+addField x v e = "_.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
184−setField fs e = "_replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
178+setField fs e = "_.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
185 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"
179 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"
186access x e = parens e ++ "." ++ x
180access x e = parens e ++ "." ++ x
187makeRecord kvs = record `liftM` collect kvs
181makeRecord kvs = record `liftM` collect kvs
@@ -254,7 +248,7 @@ formatMarkdown = concatMap f
254multiIfToJS span ps =
248multiIfToJS span ps =
255 case last ps of
249 case last ps of
256 (C _ _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)
250 (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
259 format base ps =
253 format base ps =
260 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
254 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
@@ -286,13 +280,13 @@ caseToJS span e ps = do
286 Just exp -> parens (exp ++ ", " ++ matches)
280 Just exp -> parens (exp ++ ", " ++ matches)
288matchToJS span match =
282matchToJS 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)
290 in case match of
284 in case match of
291 Match name clauses def ->
285 Match name clauses def ->
292− do cases <- intercalate " : " `liftM` mapM (clauseToJS span name) clauses
286+ do cases <- intercalate ":" `liftM` mapM (clauseToJS span name) clauses
293 finally <- matchToJS span def
287 finally <- matchToJS span def
294 return (sqnc cases finally)
288 return (sqnc cases finally)
295− Fail -> return ("_caseError" ++ parens (quoted (show span)))
289+ Fail -> return ("_E.Case" ++ parens (quoted (show span)))
296 Break -> return "null"
290 Break -> return "null"
297 Other e -> toJS' e
291 Other e -> toJS' e
298 Seq ms -> foldr1 sqnc `liftM` mapM (matchToJS span) (dropEnd [] ms)
292 Seq ms -> foldr1 sqnc `liftM` mapM (matchToJS span) (dropEnd [] ms)
@@ -306,12 +300,12 @@ matchToJS span match =
306clauseToJS span var (Clause name vars e) = do
300clauseToJS span var (Clause name vars e) = do
307 let vars' = map (\n -> var ++ "._" ++ show n) [0..]
301 let vars' = map (\n -> var ++ "._" ++ show n) [0..]
308 s <- matchToJS span $ matchSubst (zip vars vars') e
302 s <- matchToJS span $ matchSubst (zip vars vars') e
309− return $ concat [ var, ".ctor === ", quoted name, " ? ", s ]
303+ return $ concat [ var, ".ctor===", quoted name, "?", s ]
311−jsNil = "{ctor:'Nil'}"
305+jsNil = "_L.Nil"
312−jsCons e1 e2 = "{ctor:'Cons',_0:" ++ e1 ++ ",_1:" ++ e2 ++ "}"
306+jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"
313−jsRange e1 e2 = "_range" ++ parens (e1 ++ "," ++ e2)
307+jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)
314−jsCompare e1 e2 op = parens ("_compare(" ++ e1 ++ "," ++ e2 ++ ").ctor " ++ op)
308+jsCompare e1 e2 op = parens ("_.compare(" ++ e1 ++ "," ++ e2 ++ ").ctor" ++ op)
316binop (o:p) e1 e2
310binop (o:p) e1 e2
317 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2
311 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2
@@ -319,19 +313,18 @@ binop (o:p) e1 e2
319 let ops = ["+","-","*","/","&&","||"] in
313 let ops = ["+","-","*","/","&&","||"] in
320 case o:p of
314 case o:p of
321 "::" -> jsCons e1 e2
315 "::" -> jsCons e1 e2
322− "++" -> "_append" ++ parens (e1 ++ "," ++ e2)
316+ "++" -> "_L.append" ++ parens (e1 ++ "," ++ e2)
323 "$" -> e1 ++ parens e2
317 "$" -> e1 ++ parens e2
324 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")
318 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")
325 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"
319 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"
326− "==" -> "_eq(" ++ e1 ++ "," ++ e2 ++ ")"
320+ "==" -> "_.eq(" ++ e1 ++ "," ++ e2 ++ ")"
327− "/=" -> "!_eq(" ++ e1 ++ "," ++ e2 ++ ")"
321+ "/=" -> "!_.eq(" ++ e1 ++ "," ++ e2 ++ ")"
328− "<" -> jsCompare e1 e2 "=== 'LT'"
322+ "<" -> jsCompare e1 e2 "==='LT'"
329− ">" -> jsCompare e1 e2 "=== 'GT'"
323+ ">" -> jsCompare e1 e2 "==='GT'"
330− "<=" -> jsCompare e1 e2 "!== 'GT'"
324+ "<=" -> jsCompare e1 e2 "!=='GT'"
331− ">=" -> jsCompare e1 e2 "!== 'LT'"
325+ ">=" -> jsCompare e1 e2 "!=='LT'"
332− "<~" -> "lift" ++ parens e1 ++ parens e2
326+ "<~" -> "A2(lift," ++ e1 ++ "," ++ e2 ++ ")"
333− "~" -> "lift2(function(f){return function(x){return f(x);};})" ++
327+ "~" -> "A3(lift2,F2(function(f,x){return f(x)}),"++e1++","++e2++")"
334− parens e1 ++ parens e2
335 _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)
328 _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)
336 | otherwise -> concat [ "$op['", o:p, "']"
329 | otherwise -> concat [ "$op['", o:p, "']"
337 , parens e1, parens e2 ]
330 , parens e1, parens e2 ]