@@ -13,7 +13,6 @@ import Context
13import Rename (derename)
13import Rename (derename)
14import Cases
14import Cases
15import Guid
15import Guid
17import Rename (deprime)
16import Rename (deprime)
18import Types.Types ( Type(RecordT) )
17import Types.Types ( Type(RecordT) )
@@ -24,7 +23,7 @@ showErr err = globalAssign "Elm.Main" (jsFunc "elm" body)
24 \return { main : T.text(T.monospace(" ++ msg ++ ")) };"
23 \return { main : T.text(T.monospace(" ++ msg ++ ")) };"
26indent = concatMap f
25indent = concatMap f
27− where f '\n' = "\n "
26+ where f '\n' = "\n "
30internalImports =
29internalImports =
@@ -122,9 +121,8 @@ jsImport (modul, how) =
123stmtsToJS :: [Statement] -> String
122stmtsToJS :: [Statement] -> String
124stmtsToJS stmts = run $ do program <- mapM toJS (sortBy cmpStmt stmts)
123stmtsToJS stmts = run $ do program <- mapM toJS (sortBy cmpStmt stmts)
125− return (vars ++ concat program)
124+ return (concat program)
127− vars = "\nvar " ++ intercalate ", " ("e":"case0":letBoundVars stmts) ++ ";"
128 cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)
126 cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)
129 valueOf s = case s of
127 valueOf s = case s of
130 Datatype _ _ _ -> 1
128 Datatype _ _ _ -> 1
@@ -142,9 +140,10 @@ class ToJS a where
142instance ToJS Def where
140instance ToJS Def where
143 toJS (FnDef x [] e) = assign' x `liftM` toJS' e
141 toJS (FnDef x [] e) = assign' x `liftM` toJS' e
144 toJS (FnDef f as e) = (assign' f . wrapper . func) `liftM` toJS' e
142 toJS (FnDef f as e) = (assign' f . wrapper . func) `liftM` toJS' e
145− where func body = jsFunc (intercalate ", " as) (ret body)
144+ func body = jsFunc (intercalate ", " as) (ret body)
146− wrapper e | length as == 1 = e
145+ wrapper e | length as == 1 = e
147− | otherwise = 'F' : show (length as) ++ parens e
146+ | otherwise = 'F' : show (length as) ++ parens e
148 toJS (OpDef op a1 a2 e) =
147 toJS (OpDef op a1 a2 e) =
149 do body <- toJS' e
148 do body <- toJS' e
150 let func = "F2" ++ parens (jsFunc (a1 ++ ", " ++ a2) (ret body))
149 let func = "F2" ++ parens (jsFunc (a1 ++ ", " ++ a2) (ret body))
@@ -161,7 +160,7 @@ instance ToJS Statement where
161 Data (derename name) (map (noContext . Var) vars)
160 Data (derename name) (map (noContext . Var) vars)
162 ImportEvent js base elm _ ->
161 ImportEvent js base elm _ ->
163 do v <- toJS' base
162 do v <- toJS' base
164− return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal.constant(" ++ v ++ ");"
163+ return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal(elm).constant(" ++ v ++ ");"
165 , "\ndocument.addEventListener('", js
164 , "\ndocument.addEventListener('", js
166 , "_' + elm.id, function(e) { elm.notify(", elm
165 , "_' + elm.id, function(e) { elm.notify(", elm
167 , ".id, e.value); });" ]
166 , ".id, e.value); });" ]
@@ -268,9 +267,10 @@ multiIfToJS span ps =
268 return (b' ++ " ? " ++ e')
267 return (b' ++ " ? " ++ e')
270jsLet defs e' = do ds <- jsDefs defs
269jsLet defs e' = do ds <- jsDefs defs
271− e <- toJS' e'
270+ e <- toJS' e'
272− return $ parens (intercalate ", " ds ++ ", " ++ e)
271+ return $ jsFunc "" (combineDefs ds ++ ret e) ++ "()"
273+ combineDefs = concatMap (\def -> "\nvar " ++ def ++ ";")
274 jsDefs defs = mapM toJS (sortBy f defs)
274 jsDefs defs = mapM toJS (sortBy f defs)
275 f a b = compare (valueOf a) (valueOf b)
275 f a b = compare (valueOf a) (valueOf b)
276 valueOf (FnDef _ args _) = min 1 (length args)
276 valueOf (FnDef _ args _) = min 1 (length args)
@@ -279,39 +279,37 @@ jsLet defs e' = do ds <- jsDefs defs
279caseToJS span e ps = do
279caseToJS span e ps = do
280 match <- caseToMatch ps
280 match <- caseToMatch ps
281 e' <- toJS' e
281 e' <- toJS' e
282− (match',stmt) <- case (match,e) of
282+ let (match',stmt) = case (match,e) of
283− (Match name _ _, C _ _ (Var x)) ->
284− return (matchSubst [(name,x)] match, Nothing)
283+ (Match name _ _, C _ _ (Var x)) -> (matchSubst [(name,x)] match, Nothing)
285− (Match name _ _, _) ->
284+ (Match name _ _, _) -> (match, Just (name ++ " = " ++ e'))
286− return (match, Just (name ++ " = " ++ e'))
287− _ -> return (match, Nothing)
285+ _ -> (match, Nothing)
288 matches <- matchToJS span match'
286 matches <- matchToJS span match'
287+ let enclose body = "function(){ " ++ body ++ " }()"
289− return $ case stmt of
288+ return . enclose $ case stmt of
290− Nothing -> matches
289+ Nothing -> matches
291− Just exp -> parens (exp ++ ", " ++ matches)
290+ Just exp -> "\nvar " ++ exp ++ ";" ++ matches
293matchToJS span match =
292matchToJS span match =
294− let sqnc e1 e2 = parens ("e=" ++ e1 ++ ":null,e!==null?e:" ++ e2)
295− in case match of
293+ case match of
296 Match name clauses def ->
294 Match name clauses def ->
297− do cases <- intercalate ":" `liftM` mapM (clauseToJS span name) clauses
295+ do cases <- concat `liftM` mapM (clauseToJS span name) clauses
298 finally <- matchToJS span def
296 finally <- matchToJS span def
299− return (sqnc cases finally)
297+ return $ concat [ "\nswitch(", name, ".ctor){", indent cases, "\n}", finally ]
300 Fail -> return ("_E.Case" ++ parens (quoted (show span)))
298 Fail -> return ("_E.Case" ++ parens (quoted (show span)))
301− Break -> return "null"
299+ Break -> return "break;"
302− Other e -> toJS' e
300+ Other e -> ret `liftM` toJS' e
303− Seq ms -> foldr1 sqnc `liftM` mapM (matchToJS span) (dropEnd [] ms)
301+ Seq ms -> concat `liftM` mapM (matchToJS span) (dropEnd [] ms)
304− where dropEnd acc [] = acc
303+ dropEnd acc [] = acc
305− dropEnd acc (m:ms) =
304+ dropEnd acc (m:ms) =
306− case m of
305+ case m of
307− Other _ -> acc ++ [m]
306+ Other _ -> acc ++ [m]
308− _ -> dropEnd (acc ++ [m]) ms
307+ _ -> dropEnd (acc ++ [m]) ms
311clauseToJS span var (Clause name vars e) = do
309clauseToJS span var (Clause name vars e) = do
312 let vars' = map (\n -> var ++ "._" ++ show n) [0..]
310 let vars' = map (\n -> var ++ "._" ++ show n) [0..]
313 s <- matchToJS span $ matchSubst (zip vars vars') e
311 s <- matchToJS span $ matchSubst (zip vars vars') e
314− return $ concat [ var, ".ctor===", quoted name, "?", s ]
312+ return $ concat [ "\ncase ", quoted name, ":", indent s ]
316jsNil = "_L.Nil"
314jsNil = "_L.Nil"
317jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"
315jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"