Mercurial > urweb

comparison src/monoize.sml @ 1272:56bd4a4f6e66

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some serious bug-fix work to get HTML example to compile; this includes fixing a bug with 'val' patterns in Unnest and the need for more local reduction in Especialize
author Adam Chlipala <adamc@hcoop.net>
date Thu, 03 Jun 2010 13:04:37 -0400
parents 459a334345ae
children 3d06e0f7a6f3
comparison
equal deleted inserted replaced
1271:503d4ec93494 1272:56bd4a4f6e66
2735 (L.ECApp ( 2735 (L.ECApp (
2736 (L.ECApp ( 2736 (L.ECApp (
2737 (L.ECApp ( 2737 (L.ECApp (
2738 (L.ECApp ( 2738 (L.ECApp (
2739 (L.EFfi ("Basis", "tag"), 2739 (L.EFfi ("Basis", "tag"),
2740 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 2740 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
2741 class), _), 2741 class), _),
2742 attrs), _), 2742 attrs), _),
2743 tag), _), 2743 tag), _),
2744 xml) => 2744 xml) =>
2745 let 2745 let
2766 val (tag, targs) = getTag tag 2766 val (tag, targs) = getTag tag
2767 2767
2768 val (attrs, fm) = monoExp (env, st, fm) attrs 2768 val (attrs, fm) = monoExp (env, st, fm) attrs
2769 val attrs = case #1 attrs of 2769 val attrs = case #1 attrs of
2770 L'.ERecord xes => xes 2770 L'.ERecord xes => xes
2771 | _ => raise Fail "Non-record attributes!" 2771 | _ => map (fn ((L.CName x, _), t) => (x, (L'.EField (attrs, x), loc), monoType env t)
2772 | (c, t) => (E.errorAt loc "Non-constant field name for HTML tag attribute";
2773 Print.eprefaces' [("Name", CorePrint.p_con env c)];
2774 ("", (L'.EField (attrs, ""), loc), monoType env t))) attrsGiven
2772 2775
2773 val attrs = 2776 val attrs =
2774 if List.exists (fn ("Link", _, _) => true 2777 if List.exists (fn ("Link", _, _) => true
2775 | _ => false) attrs then 2778 | _ => false) attrs then
2776 List.filter (fn ("Href", _, _) => false 2779 List.filter (fn ("Href", _, _) => false