Mercurial > urweb
diff src/cjr_print.sml @ 101:717b6f8d8505
First executable generated
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 10 Jul 2008 11:13:49 -0400 |
parents | 4f641f8fddaa |
children | 5f04adf47f48 |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu Jul 10 10:11:35 2008 -0400 +++ b/src/cjr_print.sml Thu Jul 10 11:13:49 2008 -0400 @@ -43,9 +43,7 @@ fun p_typ' par env (t, loc) = case t of - TTop => - (EM.errorAt loc "Undetermined type"; - string "?") + TTop => string "void*" | TFun => (EM.errorAt loc "Undetermined function type"; string "?->") @@ -188,19 +186,73 @@ newline, box[string "return(", p_exp env' e, - string ")"], + string ");"], newline, string "}"] end -fun p_file env file = +fun p_page env (xts, (e, loc)) = + case e of + ERecord (_, xes) => + let + fun read x = ListUtil.search (fn (x', e) => if x' = x then SOME e else NONE) xes + in + case (read "code", read "env") of + (SOME code, SOME envx) => + (case #1 code of + ECode i => + let + val (_, (dom, _), _) = E.lookupF env i + in + case dom of + TRecord ri => + let + val axts = E.lookupStruct env ri + fun read x = ListUtil.search (fn (x', t) => if x' = x then SOME t else NONE) axts + in + case read "arg" of + NONE => string "Page handler is too complicated! [5]" + | SOME (at, _) => + case at of + TRecord ari => + let + val r = (ERecord (ri, [("env", envx), + ("arg", (ERecord (ari, []), loc))]), loc) + in + box [string "return", + space, + p_exp env (EApp (code, r), loc), + string ";"] + end + | _ => string "Page handler is too complicated! [6]" + end + | _ => string "Page handler is too complicated! [4]" + end + | _ => string "Page handler is too complicated! [3]") + + | _ => string "Page handler is too complicated! [1]" + end + | _ => string "Page handler is too complicated! [2]" + +fun p_file env (ds, ps) = let - val (pds, _) = ListUtil.foldlMap (fn (d, env) => + val (pds, env) = ListUtil.foldlMap (fn (d, env) => (p_decl env d, E.declBinds env d)) - env file + env ds + val pds' = map (p_page env) ps in - p_list_sep newline (fn x => x) pds + box [string "#include \"lacweb.h\"", + newline, + newline, + p_list_sep newline (fn x => x) pds, + newline, + string "char *lw_handle(void) {", + newline, + p_list_sep newline (fn x => x) pds', + newline, + string "}", + newline] end end