@@ -26,6 +26,7 @@ indent = concatMap f
2626 f c = [c]
2727
2828parens s = "(" ++ s ++ ")"
29+quoted s = "'" ++ s ++ "'"
2930braces s = "{" ++ s ++ "}"
3031jsList ss = "["++ intercalate "," ss ++"]"
3132jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
@@ -122,12 +123,13 @@ jsImport' (modul, Hiding vs) =
122123stmtsToJS :: [Statement] -> String
123124stmtsToJS stmts = run (concat `liftM` mapM toJS (sortBy cmpStmt stmts))
124125 where cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)
125− valueOf s = case s of Datatype _ _ _ -> 1
126− ImportEvent _ _ _ _ -> 3
127− Definition (FnDef _ [] _) -> 3
128− Definition (OpDef _ _ _ _) -> 3
129− Definition _ -> 4
130− ExportEvent _ _ _ -> 5
126+ valueOf s = case s of
127+ Datatype _ _ _ -> 1
128+ ImportEvent _ _ _ _ -> 2
129+ Definition (FnDef f [] _) ->
130+ if derename f == "main" then 5 else 4
131+ Definition _ -> 3
132+ ExportEvent _ _ _ -> 6
131133
132134class ToJS a where
133135 toJS :: a -> GuidCounter String
@@ -166,8 +168,8 @@ instance ToJS Expr where
166168 IntNum n -> return $ show n
167169 FloatNum n -> return $ show n
168170 Var x -> return $ x
169− Chr c -> return $ show c
170− Str s -> return $ "Value.str" ++ parens (show s)
171+ Chr c -> return $ quoted [c]
172+ Str s -> return $ "Value.str" ++ parens (quoted s)
171173 Boolean b -> return $ if b then "true" else "false"
172174 Range lo hi -> jsRange `liftM` toJS lo `ap` toJS hi
173175 Access e lbl -> (\s -> s ++ "." ++ lbl) `liftM` toJS e
@@ -175,13 +177,13 @@ instance ToJS Expr where
175177 If eb et ef -> parens `liftM` (iff `liftM` toJS eb `ap` toJS et `ap` toJS ef)
176178 Guard ps -> guardToJS ps
177179 Lambda v e -> liftM (jsFunc v . ret) (toJS e)
178− App (Var "toText") (Str s) -> return $ "toText" ++ parens (show s)
179− App (Var "link") (Str s) -> return $ "link(" ++ show s ++ ")"
180− App (Var "plainText") (Str s) -> return $ "plainText(" ++ show s ++ ")"
180+ App (Var "toText") (Str s) -> return $ "toText" ++ parens (quoted s)
181+ App (Var "link") (Str s) -> return $ "link(" ++ quoted s ++ ")"
182+ App (Var "plainText") (Str s) -> return $ "plainText(" ++ quoted s ++ ")"
181183 App e1 e2 -> (++) `liftM` (toJS e1) `ap` (parens `liftM` toJS e2)
182184 Let defs e -> jsLet defs e
183185 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
185187 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"
186188 where md = formatMarkdown $ Pan.writeHtmlString Pan.defaultWriterOptions doc
187189 pad = "<div style=\"height:0;width:0;\"> </div>"
@@ -230,10 +232,10 @@ matchToJS (Seq ms) = concat `liftM` mapM matchToJS ms
230232clauseToJS var (Clause name vars e) = do
231233 let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]
232234 s <- matchToJS $ matchSubst (zip vars vars') e
233− return $ concat [ "\ncase ", show name, ":", s ]
235+ return $ concat [ "\ncase ", quoted name, ":", s ]
234236
235237jsNil = "[\"Nil\"]"
236−jsCons e1 e2 = jsList [ show "Cons", e1, e2 ]
238+jsCons e1 e2 = jsList [ quoted "Cons", e1, e2 ]
237239jsRange e1 e2 = (++"()") . jsFunc "" $
238240 assign "lo" e1 ++ assign "hi" e2 ++ assign "lst" jsNil ++
239241 "if(lo<=hi){do{lst=" ++ (jsCons "hi" "lst") ++ "}while(hi-->lo)}" ++