comparison src/monoize.sml @ 1750:277480862cef

'style' attributes
author Adam Chlipala <adam@chlipala.net>
date Sun, 06 May 2012 14:01:29 -0400
parents f9e5a8e09cdf
children acadf9d1214a
comparison
equal deleted inserted replaced
1749:f9e5a8e09cdf 1750:277480862cef
219 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => 219 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
220 (L'.TFfi ("Basis", "string"), loc) 220 (L'.TFfi ("Basis", "string"), loc)
221 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => 221 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
222 (L'.TFfi ("Basis", "string"), loc) 222 (L'.TFfi ("Basis", "string"), loc)
223 | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc) 223 | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc)
224 | L.CFfi ("Basis", "css_value") => (L'.TFfi ("Basis", "string"), loc)
225 | L.CFfi ("Basis", "css_property") => (L'.TFfi ("Basis", "string"), loc)
226 | L.CFfi ("Basis", "css_style") => (L'.TFfi ("Basis", "string"), loc)
224 | L.CFfi ("Basis", "id") => (L'.TFfi ("Basis", "string"), loc) 227 | L.CFfi ("Basis", "id") => (L'.TFfi ("Basis", "string"), loc)
225 228
226 | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) => 229 | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) =>
227 (L'.TFfi ("Basis", "string"), loc) 230 (L'.TFfi ("Basis", "string"), loc)
228 231
2949 in 2952 in
2950 ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), 2953 ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc),
2951 fm) 2954 fm)
2952 end 2955 end
2953 2956
2957 | L.EFfiApp ("Basis", "css_url", [(s, _)]) =>
2958 let
2959 val (s, fm) = monoExp (env, st, fm) s
2960 in
2961 ((L'.EStrcat ((L'.EPrim (Prim.String "url("), loc),
2962 (L'.EStrcat ((L'.EFfiApp ("Basis", "css_url", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
2963 (L'.EPrim (Prim.String ")"), loc)), loc)), loc),
2964 fm)
2965 end
2966
2967 | L.EFfiApp ("Basis", "property", [(s, _)]) =>
2968 let
2969 val (s, fm) = monoExp (env, st, fm) s
2970 in
2971 ((L'.EStrcat ((L'.EFfiApp ("Basis", "property", [(s, (L'.TFfi ("Basis", "string"), loc))]), loc),
2972 (L'.EPrim (Prim.String ":"), loc)), loc),
2973 fm)
2974 end
2975 | L.EFfiApp ("Basis", "value", [(s1, _), (s2, _)]) =>
2976 let
2977 val (s1, fm) = monoExp (env, st, fm) s1
2978 val (s2, fm) = monoExp (env, st, fm) s2
2979 in
2980 ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc),
2981 fm)
2982 end
2983
2984 | L.EFfi ("Basis", "noStyle") => ((L'.EPrim (Prim.String ""), loc), fm)
2985 | L.EFfiApp ("Basis", "oneProperty", [(s1, _), (s2, _)]) =>
2986 let
2987 val (s1, fm) = monoExp (env, st, fm) s1
2988 val (s2, fm) = monoExp (env, st, fm) s2
2989 in
2990 ((L'.EStrcat (s1, (L'.EStrcat (s2, (L'.EPrim (Prim.String ";"), loc)), loc)), loc),
2991 fm)
2992 end
2993
2954 | L.EApp ( 2994 | L.EApp (
2955 (L.ECApp ( 2995 (L.ECApp (
2956 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), 2996 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
2957 _), _), 2997 _), _),
2958 se) => 2998 se) =>
2990 | L.EApp ( 3030 | L.EApp (
2991 (L.EApp ( 3031 (L.EApp (
2992 (L.EApp ( 3032 (L.EApp (
2993 (L.EApp ( 3033 (L.EApp (
2994 (L.EApp ( 3034 (L.EApp (
2995 (L.ECApp ( 3035 (L.EApp (
2996 (L.ECApp ( 3036 (L.ECApp (
2997 (L.ECApp ( 3037 (L.ECApp (
2998 (L.ECApp ( 3038 (L.ECApp (
2999 (L.ECApp ( 3039 (L.ECApp (
3000 (L.ECApp ( 3040 (L.ECApp (
3001 (L.ECApp ( 3041 (L.ECApp (
3002 (L.ECApp ( 3042 (L.ECApp (
3003 (L.EFfi ("Basis", "tag"), 3043 (L.ECApp (
3004 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 3044 (L.EFfi ("Basis", "tag"),
3005 class), _), 3045 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
3006 dynClass), _), 3046 class), _),
3047 dynClass), _),
3048 style), _),
3007 attrs), _), 3049 attrs), _),
3008 tag), _), 3050 tag), _),
3009 xml) => 3051 xml) =>
3010 let 3052 let
3011 fun getTag' (e, _) = 3053 fun getTag' (e, _) =
3059 else 3101 else
3060 (NONE, NONE, attrs) 3102 (NONE, NONE, attrs)
3061 3103
3062 val (class, fm) = monoExp (env, st, fm) class 3104 val (class, fm) = monoExp (env, st, fm) class
3063 val (dynClass, fm) = monoExp (env, st, fm) dynClass 3105 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3106 val (style, fm) = monoExp (env, st, fm) style
3064 3107
3065 val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"] 3108 val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"]
3066 3109
3067 val () = case #1 dynClass of 3110 val () = case #1 dynClass of
3068 L'.ENone _ => () 3111 L'.ENone _ => ()
3080 [((L'.PPrim (Prim.String ""), loc), 3123 [((L'.PPrim (Prim.String ""), loc),
3081 s), 3124 s),
3082 ((L'.PVar ("x", t), loc), 3125 ((L'.PVar ("x", t), loc),
3083 (L'.EStrcat (s, 3126 (L'.EStrcat (s,
3084 (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), 3127 (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
3128 (L'.EStrcat ((L'.ERel 0, loc),
3129 (L'.EPrim (Prim.String "\""), loc)),
3130 loc)), loc)), loc))],
3131 {disc = t,
3132 result = t}), loc)
3133
3134 val s = (L'.ECase (style,
3135 [((L'.PPrim (Prim.String ""), loc),
3136 s),
3137 ((L'.PVar ("x", t), loc),
3138 (L'.EStrcat (s,
3139 (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc),
3085 (L'.EStrcat ((L'.ERel 0, loc), 3140 (L'.EStrcat ((L'.ERel 0, loc),
3086 (L'.EPrim (Prim.String "\""), loc)), 3141 (L'.EPrim (Prim.String "\""), loc)),
3087 loc)), loc)), loc))], 3142 loc)), loc)), loc))],
3088 {disc = t, 3143 {disc = t,
3089 result = t}), loc) 3144 result = t}), loc)