Mercurial > urweb
comparison src/monoize.sml @ 1272:56bd4a4f6e66
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 |