@@ -26,6 +26,7 @@ indent = concatMap f
28parens s = "(" ++ s ++ ")"
28parens s = "(" ++ s ++ ")"
29+quoted s = "'" ++ s ++ "'"
29braces s = "{" ++ s ++ "}"
30braces s = "{" ++ s ++ "}"
30jsList ss = "["++ intercalate "," ss ++"]"
31jsList ss = "["++ intercalate "," ss ++"]"
31jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
32jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
@@ -122,12 +123,13 @@ jsImport' (modul, Hiding vs) =
122stmtsToJS :: [Statement] -> String
123stmtsToJS :: [Statement] -> String
123stmtsToJS stmts = run (concat `liftM` mapM toJS (sortBy cmpStmt stmts))
124stmtsToJS stmts = run (concat `liftM` mapM toJS (sortBy cmpStmt stmts))
124 where cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)
125 where cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)
125− valueOf s = case s of Datatype _ _ _ -> 1
126+ valueOf s = case s of
126− ImportEvent _ _ _ _ -> 3
128+ ImportEvent _ _ _ _ -> 2
127− Definition (FnDef _ [] _) -> 3
129+ Definition (FnDef f [] _) ->
128− Definition (OpDef _ _ _ _) -> 3
130+ if derename f == "main" then 5 else 4
129− Definition _ -> 4
131+ Definition _ -> 3
130− ExportEvent _ _ _ -> 5
132+ ExportEvent _ _ _ -> 6
132class ToJS a where
134class ToJS a where
133 toJS :: a -> GuidCounter String
135 toJS :: a -> GuidCounter String
@@ -166,8 +168,8 @@ instance ToJS Expr where
166 IntNum n -> return $ show n
168 IntNum n -> return $ show n
167 FloatNum n -> return $ show n
169 FloatNum n -> return $ show n
168 Var x -> return $ x
170 Var x -> return $ x
169− Chr c -> return $ show c
171+ Chr c -> return $ quoted [c]
170− Str s -> return $ "Value.str" ++ parens (show s)
172+ Str s -> return $ "Value.str" ++ parens (quoted s)
171 Boolean b -> return $ if b then "true" else "false"
173 Boolean b -> return $ if b then "true" else "false"
172 Range lo hi -> jsRange `liftM` toJS lo `ap` toJS hi
174 Range lo hi -> jsRange `liftM` toJS lo `ap` toJS hi
173 Access e lbl -> (\s -> s ++ "." ++ lbl) `liftM` toJS e
175 Access e lbl -> (\s -> s ++ "." ++ lbl) `liftM` toJS e
@@ -175,13 +177,13 @@ instance ToJS Expr where
175 If eb et ef -> parens `liftM` (iff `liftM` toJS eb `ap` toJS et `ap` toJS ef)
177 If eb et ef -> parens `liftM` (iff `liftM` toJS eb `ap` toJS et `ap` toJS ef)
176 Guard ps -> guardToJS ps
178 Guard ps -> guardToJS ps
177 Lambda v e -> liftM (jsFunc v . ret) (toJS e)
179 Lambda v e -> liftM (jsFunc v . ret) (toJS e)
178− App (Var "toText") (Str s) -> return $ "toText" ++ parens (show s)
180+ App (Var "toText") (Str s) -> return $ "toText" ++ parens (quoted s)
179− App (Var "link") (Str s) -> return $ "link(" ++ show s ++ ")"
181+ App (Var "link") (Str s) -> return $ "link(" ++ quoted s ++ ")"
180− App (Var "plainText") (Str s) -> return $ "plainText(" ++ show s ++ ")"
182+ App (Var "plainText") (Str s) -> return $ "plainText(" ++ quoted s ++ ")"
181 App e1 e2 -> (++) `liftM` (toJS e1) `ap` (parens `liftM` toJS e2)
183 App e1 e2 -> (++) `liftM` (toJS e1) `ap` (parens `liftM` toJS e2)
182 Let defs e -> jsLet defs e
184 Let defs e -> jsLet defs e
183 Case e cases -> caseToJS e cases
185 Case e cases -> caseToJS e cases
184− Data name es -> (\ss -> jsList $ show name : ss) `liftM` mapM toJS es
186+ Data name es -> (\ss -> jsList $ quoted name : ss) `liftM` mapM toJS es
185 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"
187 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"
186 where md = formatMarkdown $ Pan.writeHtmlString Pan.defaultWriterOptions doc
188 where md = formatMarkdown $ Pan.writeHtmlString Pan.defaultWriterOptions doc
187 pad = "<div style=\"height:0;width:0;\"> </div>"
189 pad = "<div style=\"height:0;width:0;\"> </div>"
@@ -230,10 +232,10 @@ matchToJS (Seq ms) = concat `liftM` mapM matchToJS ms
230clauseToJS var (Clause name vars e) = do
232clauseToJS var (Clause name vars e) = do
231 let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]
233 let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]
232 s <- matchToJS $ matchSubst (zip vars vars') e
234 s <- matchToJS $ matchSubst (zip vars vars') e
233− return $ concat [ "\ncase ", show name, ":", s ]
235+ return $ concat [ "\ncase ", quoted name, ":", s ]
235jsNil = "[\"Nil\"]"
237jsNil = "[\"Nil\"]"
236−jsCons e1 e2 = jsList [ show "Cons", e1, e2 ]
238+jsCons e1 e2 = jsList [ quoted "Cons", e1, e2 ]
237jsRange e1 e2 = (++"()") . jsFunc "" $
239jsRange e1 e2 = (++"()") . jsFunc "" $
238 assign "lo" e1 ++ assign "hi" e2 ++ assign "lst" jsNil ++
240 assign "lo" e1 ++ assign "hi" e2 ++ assign "lst" jsNil ++
239 "if(lo<=hi){do{lst=" ++ (jsCons "hi" "lst") ++ "}while(hi-->lo)}" ++
241 "if(lo<=hi){do{lst=" ++ (jsCons "hi" "lst") ++ "}while(hi-->lo)}" ++