Mercurial > urweb

comparison src/cjr_print.sml @ 1782:61c7eb1d3867

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Support fancy expressions in module-level 'val' declarations
author Adam Chlipala <adam@chlipala.net>
date Wed, 18 Jul 2012 17:29:13 -0400
parents 95dd9f427bb2
children 3d922a28370b
comparison
equal deleted inserted replaced
1781:25824a0e8bf1 1782:61c7eb1d3867
2318 string ");"], 2318 string ");"],
2319 newline, 2319 newline,
2320 string "}"] 2320 string "}"]
2321 end 2321 end
2322 2322
2323 val global_initializers : Print.PD.pp_desc list ref = ref []
2324
2323 fun p_decl env (dAll as (d, _) : decl) = 2325 fun p_decl env (dAll as (d, _) : decl) =
2324 case d of 2326 case d of
2325 DStruct (n, xts) => 2327 DStruct (n, xts) =>
2326 let 2328 let
2327 val env = E.declBinds env dAll 2329 val env = E.declBinds env dAll
2412 end 2414 end
2413 2415
2414 | DDatatypeForward _ => box [] 2416 | DDatatypeForward _ => box []
2415 2417
2416 | DVal (x, n, t, e) => 2418 | DVal (x, n, t, e) =>
2417 box [p_typ env t, 2419 (global_initializers := box [string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n),
2418 space, 2420 space,
2419 string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n), 2421 string "=",
2420 space, 2422 space,
2421 string "=", 2423 p_exp env e,
2422 space, 2424 string ";"] :: !global_initializers;
2423 p_exp env e, 2425 box [p_typ env t,
2424 string ";"] 2426 space,
2427 string ("__uwn_" ^ ident x ^ "_" ^ Int.toString n ^ ";")])
2425 | DFun vi => p_fun false env vi 2428 | DFun vi => p_fun false env vi
2426 | DFunRec vis => 2429 | DFunRec vis =>
2427 let 2430 let
2428 val env = E.declBinds env dAll 2431 val env = E.declBinds env dAll
2429 in 2432 in
2563 let 2566 let
2564 val () = (clearUrlHandlers (); 2567 val () = (clearUrlHandlers ();
2565 unurlifies := IS.empty; 2568 unurlifies := IS.empty;
2566 urlifies := IS.empty; 2569 urlifies := IS.empty;
2567 urlifiesL := IS.empty; 2570 urlifiesL := IS.empty;
2568 self := NONE) 2571 self := NONE;
2572 global_initializers := [])
2569 2573
2570 val (pds, env) = ListUtil.foldlMap (fn (d, env) => 2574 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
2571 let 2575 let
2572 val d' = p_decl env d 2576 val d' = p_decl env d
2573 val hs = latestUrlHandlers () 2577 val hs = latestUrlHandlers ()
3472 string "}"], 3476 string "}"],
3473 3477
3474 newline, 3478 newline,
3475 string "static void uw_initializer(uw_context ctx) {", 3479 string "static void uw_initializer(uw_context ctx) {",
3476 newline, 3480 newline,
3477 box [p_list_sep (box []) (fn (x1, x2, e) => box [string "({", 3481 box [string "uw_begin_initializing(ctx);",
3482 newline,
3483 p_list_sep newline (fn x => x) (rev (!global_initializers)),
3484 string "uw_end_initializing(ctx);",
3485 newline,
3486 p_list_sep (box []) (fn (x1, x2, e) => box [string "({",
3478 newline, 3487 newline,
3479 string "uw_unit __uwr_", 3488 string "uw_unit __uwr_",
3480 string x1, 3489 string x1,
3481 string "_0 = 0, __uwr_", 3490 string "_0 = 0, __uwr_",
3482 string x2, 3491 string x2,