comparison src/monoize.sml @ 802:ef6de4075dc1

Fix a Core_untangle bug that missed closure variable references; XHTMLize
author Adam Chlipala <adamc@hcoop.net>
date Sat, 16 May 2009 12:41:33 -0400
parents e92cfac1608f
children 152b61b2901a
comparison
equal deleted inserted replaced
801:5f49a6b759cb 802:ef6de4075dc1
2448 [_, (L.CName name, _)] => 2448 [_, (L.CName name, _)] =>
2449 let 2449 let
2450 val (ts, fm) = tagStart "input" 2450 val (ts, fm) = tagStart "input"
2451 in 2451 in
2452 ((L'.EStrcat (ts, 2452 ((L'.EStrcat (ts,
2453 (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\"/>")), 2453 (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")),
2454 loc)), loc), fm) 2454 loc)), loc), fm)
2455 end 2455 end
2456 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 2456 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
2457 raise Fail "No name passed to input tag") 2457 raise Fail "No name passed to input tag")
2458 2458
2484 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), 2484 (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
2485 _), _), 2485 _), _),
2486 _), _), 2486 _), _),
2487 (L.EPrim (Prim.String s), _)), _) => 2487 (L.EPrim (Prim.String s), _)), _) =>
2488 if CharVector.all Char.isSpace s then 2488 if CharVector.all Char.isSpace s then
2489 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc), fm) 2489 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm)
2490 else 2490 else
2491 normal () 2491 normal ()
2492 | _ => normal () 2492 | _ => normal ()
2493 end 2493 end
2494 2494
2559 NONE => 2559 NONE =>
2560 let 2560 let
2561 val (ts, fm) = tagStart "input" 2561 val (ts, fm) = tagStart "input"
2562 in 2562 in
2563 ((L'.EStrcat (ts, 2563 ((L'.EStrcat (ts,
2564 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")), 2564 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")),
2565 loc)), loc), fm) 2565 loc)), loc), fm)
2566 end 2566 end
2567 | SOME (_, src, _) => 2567 | SOME (_, src, _) =>
2568 (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",", 2568 (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",",
2569 (L'.EJavaScript (L'.Script, src, NONE), loc), 2569 (L'.EJavaScript (L'.Script, src, NONE), loc),
2630 NONE => 2630 NONE =>
2631 let 2631 let
2632 val (ts, fm) = tagStart "input" 2632 val (ts, fm) = tagStart "input"
2633 in 2633 in
2634 ((L'.EStrcat (ts, 2634 ((L'.EStrcat (ts,
2635 (L'.EPrim (Prim.String "/>"), loc)), 2635 (L'.EPrim (Prim.String " />"), loc)),
2636 loc), fm) 2636 loc), fm)
2637 end 2637 end
2638 | SOME (_, src, _) => 2638 | SOME (_, src, _) =>
2639 let 2639 let
2640 val sc = strcat [str "inp(\"input\",", 2640 val sc = strcat [str "inp(\"input\",",
2653 NONE => 2653 NONE =>
2654 let 2654 let
2655 val (ts, fm) = tagStart "select" 2655 val (ts, fm) = tagStart "select"
2656 in 2656 in
2657 ((L'.EStrcat (ts, 2657 ((L'.EStrcat (ts,
2658 (L'.EPrim (Prim.String "/>"), loc)), 2658 (L'.EPrim (Prim.String " />"), loc)),
2659 loc), fm) 2659 loc), fm)
2660 end 2660 end
2661 | SOME (_, src, _) => 2661 | SOME (_, src, _) =>
2662 let 2662 let
2663 val (xml, fm) = monoExp (env, st, fm) xml 2663 val (xml, fm) = monoExp (env, st, fm) xml