on master help sign in
Begin using new data format for ADTs. Should be significantly faster while actually being nicer to read.
commit05c6e2da9801afd744b07190d068c9aa3b20dd55 authorevancz <info@elm-lang.org> dateWed 20 Feb 2013, 23:38 (14 years ago) parent54ffaab
1 file changed+16−13
elm/src/Gen/CompileToJS.hs+16−13
elm/src/Gen/CompileToJS.hs+16−13
@@ -26,7 +26,7 @@ indent = concatMap f
2626 f c = [c]
2727
2828parens s = "(" ++ s ++ ")"
29−braces s = "{" ++ s ++ "}"
29+brackets s = "{" ++ s ++ "}"
3030jsList ss = "["++ intercalate "," ss ++"]"
3131jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
3232assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"
@@ -81,7 +81,7 @@ jsModule (escapees, Module names exports imports stmts) =
8181 defs = concat [ assign "$op" "{}"
8282 , "\nfor(Elm['i'] in Elm){eval('var '+Elm['i']+'=Elm[Elm.i];');}" ]
8383
84−getExports names stmts = ret . braces $ intercalate ",\n" (op : map fnPair fns)
84+getExports names stmts = ret . brackets $ intercalate ",\n" (op : map fnPair fns)
8585 where exNames n = either derename id n `elem` names
8686 exports | null names = concatMap get stmts
8787 | otherwise = filter exNames (concatMap get stmts)
@@ -91,7 +91,7 @@ getExports names stmts = ret . braces $ intercalate ",\n" (op : map fnPair fns)
9191 opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"
9292 fnPair fn = let fn' = derename fn in fn' ++ ":" ++ fn
9393
94− op = ("$op : "++) . braces . intercalate ", " $ map opPair ops
94+ op = ("$op : "++) . brackets . intercalate ", " $ map opPair ops
9595
9696 get' (FnDef x _ _) = Left x
9797 get' (OpDef op _ _ _) = Right op
@@ -122,7 +122,7 @@ jsImport' (modul, Hiding vs) =
122122 concat [ assign "hiddenVars" . ("{"++) . (++"}") . intercalate "," $
123123 map (\v -> v ++ ":true") (map deprime vs)
124124 , "\nfor (Elm['i'] in " ++ modul ++ ") "
125− , braces . indent . concat $
125+ , brackets . indent . concat $
126126 [ "\nif (hiddenVars[Elm['i']]) continue;"
127127 , "\neval('var ' + Elm['i'] + ' = "
128128 , modul, "[Elm.i];');" ]
@@ -148,7 +148,7 @@ instance ToJS Def where
148148 toJS (FnDef x [] e) = assign x `liftM` toJS' e
149149 toJS (FnDef f (a:as) e) =
150150 do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e as)
151− return $ concat ["\nfunction ",f,parens a, braces . indent $ ret body]
151+ return $ concat ["\nfunction ",f,parens a, brackets . indent $ ret body]
152152 toJS (OpDef op a1 a2 e) =
153153 do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e [a1,a2])
154154 return $ concat [ "\n$op['", op, "'] = ", body, ";" ]
@@ -194,7 +194,7 @@ makeRecord kvs = record `liftM` collect kvs
194194 do v <- toJS' (foldr (\x e -> C t s $ Lambda x e) e as)
195195 return (k,[v])
196196 fields fs =
197− braces ("\n "++intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))
197+ brackets ("\n "++intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))
198198 hidden = fields . map (second jsList) .
199199 filter (not . null . snd) . Map.toList . Map.map tail
200200 record kvs = fields . (("_", hidden kvs) :) . Map.toList . Map.map head $ kvs
@@ -234,7 +234,10 @@ instance ToJS Expr where
234234
235235 App e1 e2 -> (++) `liftM` (toJS' e1) `ap` (parens `liftM` toJS' e2)
236236 Let defs e -> jsLet defs e
237− Data name es -> (\ss -> jsList $ quoted name : ss) `liftM` mapM toJS' es
237+ Data name es ->
238+ do fs <- mapM toJS' es
239+ let fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs
240+ return (brackets ("ctor:" ++ show name ++ concatMap (", "++) fields))
238241
239242 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"
240243 where pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
@@ -276,7 +279,7 @@ caseToJS span e ps = do
276279matchToJS span (Match name clauses def) = do
277280 cases <- concat `liftM` mapM (clauseToJS span name) clauses
278281 finally <- matchToJS span def
279− return $ concat [ "\nswitch(", name, "[0]){", indent cases, "\n}", finally ]
282+ return $ concat [ "\nswitch(", name, ".ctor){", indent cases, "\n}", finally ]
280283matchToJS span Fail = return ("\nthrow new Error(\"Non-exhaustive pattern match " ++
281284 "in case expression (" ++ show span ++ ")\");")
282285matchToJS span Break = return "break;"
@@ -284,7 +287,7 @@ matchToJS span (Other e) = ret `liftM` toJS' e
284287matchToJS span (Seq ms) = concat `liftM` mapM (matchToJS span) ms
285288
286289clauseToJS span var (Clause name vars e) = do
287− let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]
290+ let vars' = map (\n -> var ++ "._" ++ show n) [ 1 .. length vars ]
288291 s <- matchToJS span $ matchSubst (zip vars vars') e
289292 return $ concat [ "\ncase ", quoted name, ":", s ]
290293
@@ -307,12 +310,12 @@ binop (o:p) e1 e2
307310 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"
308311 "==" -> "eq(" ++ e1 ++ "," ++ e2 ++ ")"
309312 "/=" -> "not(eq(" ++ e1 ++ "," ++ e2 ++ "))"
310− "<" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ")[0] === 'LT')"
311− ">" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ")[0] === 'GT')"
313+ "<" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ").ctor === 'LT')"
314+ ">" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ").ctor === 'GT')"
312315 "<=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++
313− e2 ++ ")[0]; return ord==='LT' || ord==='EQ'; }()"
316+ e2 ++ ").ctor; return ord==='LT' || ord==='EQ'; }()"
314317 ">=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++
315− e2 ++ ")[0]; return ord==='GT' || ord==='EQ'; }()"
318+ e2 ++ ").ctor; return ord==='GT' || ord==='EQ'; }()"
316319 "<~" -> "lift" ++ parens e1 ++ parens e2
317320 "~" -> "lift2(function(f){return function(x){return f(x);};})" ++
318321 parens e1 ++ parens e2