From 84168a777e28ab53917bc3ed448cc90e6b00a4ed Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 12 Apr 2009 12:31:54 -0400 Subject: Stop tracking CSS classes in XML types --- src/cjr.sml | 2 +- src/cjr_print.sml | 18 +++++-------- src/core.sml | 2 +- src/core_env.sml | 4 +-- src/core_print.sml | 18 +++++-------- src/core_util.sml | 11 +++----- src/corify.sml | 15 +++++------ src/elab.sml | 2 +- src/elab_env.sml | 4 +-- src/elab_print.sig | 1 - src/elab_print.sml | 10 +++---- src/elab_util.sml | 13 +++------ src/elaborate.sml | 75 +++++++++++++++++++--------------------------------- src/expl.sml | 2 +- src/expl_env.sml | 4 +-- src/expl_print.sml | 10 +++---- src/explify.sml | 2 +- src/mono.sml | 2 +- src/mono_print.sml | 10 +++---- src/monoize.sml | 69 +++++++++++++---------------------------------- src/reduce.sml | 2 +- src/shake.sml | 4 +-- src/source.sml | 2 +- src/source_print.sml | 10 +++---- src/urweb.grm | 31 ++++++++++------------ 25 files changed, 116 insertions(+), 207 deletions(-) (limited to 'src') diff --git a/src/cjr.sml b/src/cjr.sml index 031a14f8..23dfb900 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -110,7 +110,7 @@ datatype decl' = | DPreparedStatements of (string * int) list | DJavaScript of string - | DStyle of string * string list + | DStyle of string withtype decl = decl' located diff --git a/src/cjr_print.sml b/src/cjr_print.sml index cabfc77f..46282410 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2146,17 +2146,13 @@ fun p_decl env (dAll as (d, _) : decl) = | DJavaScript s => box [string "static char jslib[] = \"", string (String.toString s), string "\";"] - | DStyle (s, xs) => box [string "/*", - space, - string "style", - space, - string s, - space, - string ":", - space, - p_list string xs, - space, - string "*/"] + | DStyle s => box [string "/*", + space, + string "style", + space, + string s, + space, + string "*/"] datatype 'a search = Found of 'a diff --git a/src/core.sml b/src/core.sml index bbd1a9b6..d9d7f51d 100644 --- a/src/core.sml +++ b/src/core.sml @@ -134,7 +134,7 @@ datatype decl' = | DSequence of string * int * string | DDatabase of string | DCookie of string * int * con * string - | DStyle of string * int * con * string + | DStyle of string * int * string withtype decl = decl' located diff --git a/src/core_env.sml b/src/core_env.sml index 01a791a0..caf30349 100644 --- a/src/core_env.sml +++ b/src/core_env.sml @@ -334,9 +334,9 @@ fun declBinds env (d, loc) = in pushENamed env x n t NONE s end - | DStyle (x, n, c, s) => + | DStyle (x, n, s) => let - val t = (CApp ((CFfi ("Basis", "css_class"), loc), c), loc) + val t = (CFfi ("Basis", "css_class"), loc) in pushENamed env x n t NONE s end diff --git a/src/core_print.sml b/src/core_print.sml index caf55adb..8d8f275c 100644 --- a/src/core_print.sml +++ b/src/core_print.sml @@ -586,17 +586,13 @@ fun p_decl env (dAll as (d, _) : decl) = string ":", space, p_con env c] - | DStyle (x, n, c, s) => box [string "style", - space, - p_named x n, - space, - string "as", - space, - string s, - space, - string ":", - space, - p_con env c] + | DStyle (x, n, s) => box [string "style", + space, + p_named x n, + space, + string "as", + space, + string s] fun p_file env file = let diff --git a/src/core_util.sml b/src/core_util.sml index 8ccd520a..d05aaa72 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -951,10 +951,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = S.map2 (mfc ctx c, fn c' => (DCookie (x, n, c', s), loc)) - | DStyle (x, n, c, s) => - S.map2 (mfc ctx c, - fn c' => - (DStyle (x, n, c', s), loc)) + | DStyle _ => S.return2 dAll and mfvi ctx (x, n, t, e, s) = S.bind2 (mfc ctx t, @@ -1092,9 +1089,9 @@ fun mapfoldB (all as {bind, ...}) = in bind (ctx, NamedE (x, n, t, NONE, s)) end - | DStyle (x, n, c, s) => + | DStyle (x, n, s) => let - val t = (CApp ((CFfi ("Basis", "css_class"), #2 d'), c), #2 d') + val t = (CFfi ("Basis", "css_class"), #2 d') in bind (ctx, NamedE (x, n, t, NONE, s)) end @@ -1159,7 +1156,7 @@ val maxName = foldl (fn ((d, _) : decl, count) => | DSequence (_, n, _) => Int.max (n, count) | DDatabase _ => count | DCookie (_, n, _, _) => Int.max (n, count) - | DStyle (_, n, _, _) => Int.max (n, count)) 0 + | DStyle (_, n, _) => Int.max (n, count)) 0 end diff --git a/src/corify.sml b/src/corify.sml index d0fc6200..c8da9df5 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -923,11 +923,10 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = ran' as (L.CApp ((L.CApp - ((L.CApp - ((L.CApp ((L.CModProj (basis', [], "xml"), _), - (L.CRecord (_, [((L.CName "Html", _), - _)]), _)), _), _), - _), _), _), _), _))) => + ((L.CApp ((L.CModProj (basis', [], "xml"), _), + (L.CRecord (_, [((L.CName "Html", _), + _)]), _)), _), _), + _), _), _))) => let val ran = (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc) val ranT = (L.CApp ((L.CModProj (basis, [], "transaction"), loc), @@ -1003,12 +1002,12 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = in ([(L'.DCookie (x, n, corifyCon st c, s), loc)], st) end - | L.DStyle (_, x, n, c) => + | L.DStyle (_, x, n) => let val (st, n) = St.bindVal st x n val s = doRestify (mods, x) in - ([(L'.DStyle (x, n, corifyCon st c, s), loc)], st) + ([(L'.DStyle (x, n, s), loc)], st) end and corifyStr mods ((str, _), st) = @@ -1066,7 +1065,7 @@ fun maxName ds = foldl (fn ((d, _), n) => | L.DSequence (_, _, n') => Int.max (n, n') | L.DDatabase _ => n | L.DCookie (_, _, n', _) => Int.max (n, n') - | L.DStyle (_, _, n', _) => Int.max (n, n')) + | L.DStyle (_, _, n') => Int.max (n, n')) 0 ds and maxNameStr (str, _) = diff --git a/src/elab.sml b/src/elab.sml index cabe0a94..41bc85dd 100644 --- a/src/elab.sml +++ b/src/elab.sml @@ -171,7 +171,7 @@ datatype decl' = | DClass of string * int * kind * con | DDatabase of string | DCookie of int * string * int * con - | DStyle of int * string * int * con + | DStyle of int * string * int and str' = StrConst of decl list diff --git a/src/elab_env.sml b/src/elab_env.sml index 828dface..6dae1d4b 100644 --- a/src/elab_env.sml +++ b/src/elab_env.sml @@ -1434,9 +1434,9 @@ fun declBinds env (d, loc) = in pushENamedAs env x n t end - | DStyle (tn, x, n, c) => + | DStyle (tn, x, n) => let - val t = (CApp ((CModProj (tn, [], "css_class"), loc), c), loc) + val t = (CModProj (tn, [], "css_class"), loc) in pushENamedAs env x n t end diff --git a/src/elab_print.sig b/src/elab_print.sig index 1eb832b3..41d72ca7 100644 --- a/src/elab_print.sig +++ b/src/elab_print.sig @@ -36,7 +36,6 @@ signature ELAB_PRINT = sig val p_decl : ElabEnv.env -> Elab.decl Print.printer val p_sgn_item : ElabEnv.env -> Elab.sgn_item Print.printer val p_sgn : ElabEnv.env -> Elab.sgn Print.printer - val p_str : ElabEnv.env -> Elab.str Print.printer val p_file : ElabEnv.env -> Elab.file Print.printer val debug : bool ref diff --git a/src/elab_print.sml b/src/elab_print.sml index 5028ff44..e6a2cccb 100644 --- a/src/elab_print.sml +++ b/src/elab_print.sml @@ -779,13 +779,9 @@ fun p_decl env (dAll as (d, _) : decl) = string ":", space, p_con env c] - | DStyle (_, x, n, c) => box [string "style", - space, - p_named x n, - space, - string ":", - space, - p_con env c] + | DStyle (_, x, n) => box [string "style", + space, + p_named x n] and p_str env (str, _) = case str of diff --git a/src/elab_util.sml b/src/elab_util.sml index 24a92e3f..0d78951b 100644 --- a/src/elab_util.sml +++ b/src/elab_util.sml @@ -797,9 +797,8 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f | DCookie (tn, x, n, c) => bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "cookie"), loc), c), loc))) - | DStyle (tn, x, n, c) => - bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "css_class"), loc), - c), loc))), + | DStyle (tn, x, n) => + bind (ctx, NamedE (x, (CModProj (n, [], "css_class"), loc))), mfd ctx d)) ctx ds, fn ds' => (StrConst ds', loc)) | StrVar _ => S.return2 strAll @@ -914,10 +913,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = f S.map2 (mfc ctx c, fn c' => (DCookie (tn, x, n, c'), loc)) - | DStyle (tn, x, n, c) => - S.map2 (mfc ctx c, - fn c' => - (DStyle (tn, x, n, c'), loc)) + | DStyle _ => S.return2 dAll and mfvi ctx (x, n, c, e) = S.bind2 (mfc ctx c, @@ -1057,8 +1053,7 @@ and maxNameDecl (d, _) = | DSequence (n1, _, n2) => Int.max (n1, n2) | DDatabase _ => 0 | DCookie (n1, _, n2, _) => Int.max (n1, n2) - | DStyle (n1, _, n2, _) => Int.max (n1, n2) - + | DStyle (n1, _, n2) => Int.max (n1, n2) and maxNameStr (str, _) = case str of StrConst ds => maxName ds diff --git a/src/elaborate.sml b/src/elaborate.sml index 792ab315..72b7b8fc 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -2402,7 +2402,7 @@ and sgiOfDecl (d, loc) = | L'.DClass (x, n, k, c) => [(L'.SgiClass (x, n, k, c), loc)] | L'.DDatabase _ => [] | L'.DCookie (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (cookieOf (), c), loc)), loc)] - | L'.DStyle (tn, x, n, c) => [(L'.SgiVal (x, n, (L'.CApp (styleOf (), c), loc)), loc)] + | L'.DStyle (tn, x, n) => [(L'.SgiVal (x, n, styleOf ()), loc)] and subSgn env sgn1 (sgn2 as (_, loc2)) = ((*prefaces "subSgn" [("sgn1", p_sgn env sgn1), @@ -3284,40 +3284,30 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) = (L'.CApp (tf, arg), _) => (case (hnormCon env tf, hnormCon env arg) of ((L'.CModProj (basis, [], "transaction"), _), - (L'.CApp (tf, arg4), _)) => + (L'.CApp (tf, arg3), _)) => (case (basis = !basis_r, - hnormCon env tf, hnormCon env arg4) of + hnormCon env tf, hnormCon env arg3) of (true, - (L'.CApp (tf, arg3), _), + (L'.CApp (tf, arg2), _), ((L'.CRecord (_, []), _))) => - (case hnormCon env tf of - (L'.CApp (tf, arg2), _) => - (case hnormCon env tf of - (L'.CApp (tf, arg1), _) => - (case (hnormCon env tf, - hnormCon env arg1, - hnormCon env arg2, - hnormCon env arg3, - hnormCon env arg4) of - (tf, - arg1, - (L'.CRecord (_, []), _), - arg2, - arg4) => - let - val t = (L'.CApp (tf, arg1), loc) - val t = (L'.CApp (t, arg2), loc) - val t = (L'.CApp (t, arg3), loc) - val t = (L'.CApp (t, arg4), loc) - - val t = (L'.CApp ( - (L'.CModProj - (basis, [], "transaction"), loc), + (case (hnormCon env tf) of + (L'.CApp (tf, arg1), _) => + (case (hnormCon env tf, + hnormCon env arg1, + hnormCon env arg2) of + (tf, arg1, + (L'.CRecord (_, []), _)) => + let + val t = (L'.CApp (tf, arg1), loc) + val t = (L'.CApp (t, arg2), loc) + val t = (L'.CApp (t, arg3), loc) + val t = (L'.CApp ( + (L'.CModProj + (basis, [], "transaction"), loc), t), loc) - in - (L'.SgiVal (x, n, makeRes t), loc) - end - | _ => all) + in + (L'.SgiVal (x, n, makeRes t), loc) + end | _ => all) | _ => all) | _ => all) @@ -3402,13 +3392,11 @@ and elabDecl (dAll as (d, loc), (env, denv, gs)) = checkKind env c' k (L'.KType, loc); ([(L'.DCookie (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs)) end - | L.DStyle (x, c) => + | L.DStyle x => let - val (c', k, gs') = elabCon (env, denv) c - val (env, n) = E.pushENamed env x (L'.CApp (styleOf (), c'), loc) + val (env, n) = E.pushENamed env x (styleOf ()) in - checkKind env c' k (L'.KRecord (L'.KUnit, loc), loc); - ([(L'.DStyle (!basis_r, x, n, c'), loc)], (env, denv, enD gs' @ gs)) + ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs)) end (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) @@ -3632,16 +3620,6 @@ fun elabFile basis topStr topSgn env file = [] => () | _ => raise Fail "Unresolved disjointness constraints in top.urs" val (topStr, topSgn', gs) = elabStr (env', D.empty) (L.StrConst topStr, ErrorMsg.dummySpan) - - val () = subSgn env' topSgn' topSgn - - val () = app (fn (env, k, s1, s2) => - unifySummaries env (k, normalizeRecordSummary env s1, normalizeRecordSummary env s2) - handle CUnify' err => (ErrorMsg.errorAt (#2 k) "Error in Top final record unification"; - cunifyError env err)) - (!delayedUnifs) - val () = delayedUnifs := [] - val () = case gs of [] => () | _ => app (fn Disjoint (loc, env, denv, c1, c2) => @@ -3651,8 +3629,7 @@ fun elabFile basis topStr topSgn env file = (prefaces "Unresolved constraint in top.ur" [("loc", PD.string (ErrorMsg.spanToString loc)), ("c1", p_con env c1), - ("c2", p_con env c2), - ("topStr", p_str env topStr)]; + ("c2", p_con env c2)]; raise Fail "Unresolved constraint in top.ur")) | TypeClass (env, c, r, loc) => let @@ -3663,6 +3640,8 @@ fun elabFile basis topStr topSgn env file = | NONE => expError env (Unresolvable (loc, c)) end) gs + val () = subSgn env' topSgn' topSgn + val (env', top_n) = E.pushStrNamed env' "Top" topSgn val () = top_r := top_n diff --git a/src/expl.sml b/src/expl.sml index ed4de953..859e21ff 100644 --- a/src/expl.sml +++ b/src/expl.sml @@ -145,7 +145,7 @@ datatype decl' = | DSequence of int * string * int | DDatabase of string | DCookie of int * string * int * con - | DStyle of int * string * int * con + | DStyle of int * string * int and str' = StrConst of decl list diff --git a/src/expl_env.sml b/src/expl_env.sml index 790c3aa8..1e99b36b 100644 --- a/src/expl_env.sml +++ b/src/expl_env.sml @@ -319,9 +319,9 @@ fun declBinds env (d, loc) = in pushENamed env x n t end - | DStyle (tn, x, n, c) => + | DStyle (tn, x, n) => let - val t = (CApp ((CModProj (tn, [], "css_class"), loc), c), loc) + val t = (CModProj (tn, [], "css_class"), loc) in pushENamed env x n t end diff --git a/src/expl_print.sml b/src/expl_print.sml index c912bd66..167c6850 100644 --- a/src/expl_print.sml +++ b/src/expl_print.sml @@ -691,13 +691,9 @@ fun p_decl env (dAll as (d, _) : decl) = string ":", space, p_con env c] - | DStyle (_, x, n, c) => box [string "style", - space, - p_named x n, - space, - string ":", - space, - p_con env c] + | DStyle (_, x, n) => box [string "style", + space, + p_named x n] and p_str env (str, _) = case str of diff --git a/src/explify.sml b/src/explify.sml index 32983619..6a33eabc 100644 --- a/src/explify.sml +++ b/src/explify.sml @@ -187,7 +187,7 @@ fun explifyDecl (d, loc : EM.span) = (L'.KArrow (explifyKind k, (L'.KType, loc)), loc), explifyCon c), loc) | L.DDatabase s => SOME (L'.DDatabase s, loc) | L.DCookie (nt, x, n, c) => SOME (L'.DCookie (nt, x, n, explifyCon c), loc) - | L.DStyle (nt, x, n, c) => SOME (L'.DStyle (nt, x, n, explifyCon c), loc) + | L.DStyle (nt, x, n) => SOME (L'.DStyle (nt, x, n), loc) and explifyStr (str, loc) = case str of diff --git a/src/mono.sml b/src/mono.sml index 4723e30a..4a4cb5da 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -127,7 +127,7 @@ datatype decl' = | DJavaScript of string - | DStyle of string * string list + | DStyle of string withtype decl = decl' located diff --git a/src/mono_print.sml b/src/mono_print.sml index 3870ce41..a9e68005 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -440,13 +440,9 @@ fun p_decl env (dAll as (d, _) : decl) = string s, string ")"] - | DStyle (s, xs) => box [string "style", - space, - string s, - space, - string ":", - space, - p_list string xs] + | DStyle s => box [string "style", + space, + string s] fun p_file env file = diff --git a/src/monoize.sml b/src/monoize.sml index e8244c9e..f14b6021 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -127,14 +127,10 @@ fun monoType env = readType (mt env dtmap t, loc) | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _), _), _) => + | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CFfi ("Basis", "css_class"), _), _) => - (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CFfi ("Basis", "css_subset"), _), _), _), _) => - (L'.TRecord [], loc) | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) @@ -2007,9 +2003,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.EApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), - _), _), + (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), _), _), se) => let @@ -2018,32 +2012,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm) end - | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "css_subset"), _), _), _), _) => - ((L'.ERecord [], loc), fm) - | L.EApp ( (L.EApp ( - (L.EApp ( - (L.EApp ( + (L.ECApp ( + (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "join"), - _), _), _), - _), _), - _), _), - _), _), - _), _), - _), _), + (L.EFfi ("Basis", "join"), + _), _), _), _), _), - xml1), _), - xml2), _), - _), _), - _) => + _), _), + _), _), + xml1), _), + xml2) => let val (xml1, fm) = monoExp (env, st, fm) xml1 val (xml2, fm) = monoExp (env, st, fm) xml2 @@ -2054,26 +2035,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.EApp ( (L.EApp ( (L.EApp ( - (L.EApp ( - (L.EApp ( + (L.ECApp ( + (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "tag"), - _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), - _), _), _), _), _), _), - attrs), _), - tag), _), - _), _), - _), _), + (L.EFfi ("Basis", "tag"), + _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), + attrs), _), + tag), _), xml) => let fun getTag' (e, _) = @@ -2732,23 +2705,17 @@ fun monoDecl (env, fm) (all as (d, loc)) = fm, [(L'.DVal (x, n, t', e, s), loc)]) end - | L.DStyle (x, n, (L.CRecord (_, xcs), _), s) => + | L.DStyle (x, n, s) => let - val xs = map (fn ((L.CName x, _), _) => x - | (x, _) => (E.errorAt (#2 x) "Undetermined style component"; - Print.eprefaces' [("Name", CorePrint.p_con env x)]; - "")) xcs - val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val e = (L'.EPrim (Prim.String s), loc) in SOME (Env.pushENamed env x n t NONE s, fm, - [(L'.DStyle (s, xs), loc), + [(L'.DStyle s, loc), (L'.DVal (x, n, t', e, s), loc)]) end - | L.DStyle _ => poly () end datatype expungable = Client | Channel diff --git a/src/reduce.sml b/src/reduce.sml index 714b55d7..914f26c0 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -469,7 +469,7 @@ fun reduce file = | DSequence _ => (d, st) | DDatabase _ => (d, st) | DCookie (s, n, c, s') => ((DCookie (s, n, con namedC [] c, s'), loc), st) - | DStyle (s, n, c, s') => ((DStyle (s, n, con namedC [] c, s'), loc), st) + | DStyle (s, n, s') => ((DStyle (s, n, s'), loc), st) val (file, _) = ListUtil.foldlMap doDecl (IM.empty, IM.empty) file in diff --git a/src/shake.sml b/src/shake.sml index 9c95d6a3..787bfd2f 100644 --- a/src/shake.sml +++ b/src/shake.sml @@ -87,8 +87,8 @@ fun shake file = | ((DDatabase _, _), acc) => acc | ((DCookie (_, n, c, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], c, dummye))) - | ((DStyle (_, n, c, _), _), (cdef, edef)) => - (cdef, IM.insert (edef, n, ([], c, dummye)))) + | ((DStyle (_, n, _), _), (cdef, edef)) => + (cdef, IM.insert (edef, n, ([], dummyt, dummye)))) (IM.empty, IM.empty) file fun kind (_, s) = s diff --git a/src/source.sml b/src/source.sml index a35c61be..6645ae75 100644 --- a/src/source.sml +++ b/src/source.sml @@ -164,7 +164,7 @@ datatype decl' = | DClass of string * kind * con | DDatabase of string | DCookie of string * con - | DStyle of string * con + | DStyle of string and str' = StrConst of decl list diff --git a/src/source_print.sml b/src/source_print.sml index bc933d57..58867f64 100644 --- a/src/source_print.sml +++ b/src/source_print.sml @@ -640,13 +640,9 @@ fun p_decl ((d, _) : decl) = string ":", space, p_con c] - | DStyle (x, c) => box [string "style", - space, - string x, - space, - string ":", - space, - p_con c] + | DStyle x => box [string "style", + space, + string x] and p_str (str, _) = case str of diff --git a/src/urweb.grm b/src/urweb.grm index 675bcc72..0251d3f4 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -451,7 +451,7 @@ decl : CON SYMBOL cargl2 kopt EQ cexp (let [(DClass (SYMBOL1, kind, c), s (CLASSleft, cexpright))] end) | COOKIE SYMBOL COLON cexp ([(DCookie (SYMBOL, cexp), s (COOKIEleft, cexpright))]) - | STYLE SYMBOL COLON cexp ([(DStyle (SYMBOL, cexp), s (STYLEleft, cexpright))]) + | STYLE SYMBOL ([(DStyle SYMBOL, s (STYLEleft, SYMBOLright))]) kopt : (NONE) | DCOLON kind (SOME kind) @@ -708,10 +708,9 @@ sgi : CON SYMBOL DCOLON kind ((SgiConAbs (SYMBOL, kind), s (CONleft, in (SgiVal (SYMBOL, t), loc) end) - | STYLE SYMBOL COLON cexp (let - val loc = s (STYLEleft, cexpright) - val t = (CApp ((CVar (["Basis"], "css_class"), loc), - cexp), loc) + | STYLE SYMBOL (let + val loc = s (STYLEleft, SYMBOLright) + val t = (CVar (["Basis"], "css_class"), loc) in (SgiVal (SYMBOL, t), loc) end) @@ -1208,12 +1207,11 @@ rexp : ([]) xml : xmlOne xml (let val pos = s (xmlOneleft, xmlright) - val e = (EVar (["Basis"], "join", Infer), pos) - val e = (EApp (e, xmlOne), pos) - val e = (EApp (e, xml), pos) - val e = (EApp (e, (EVar (["Basis"], "css_subset", Infer), pos)), pos) in - (EApp (e, (EVar (["Basis"], "css_subset", Infer), pos)), pos) + (EApp ((EApp ( + (EVar (["Basis"], "join", Infer), pos), + xmlOne), pos), + xml), pos) end) | xmlOne (xmlOne) @@ -1228,7 +1226,6 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) let val e = (EVar (["Basis"], "cdata", DontInfer), pos) val e = (ECApp (e, (CWild (KWild, pos), pos)), pos) - val e = (ECApp (e, (CRecord [], pos)), pos) in (ECApp (e, (CRecord [], pos)), pos) end @@ -1269,13 +1266,13 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) tag : tagHead attrs (let val pos = s (tagHeadleft, attrsright) - val e = (EVar (["Basis"], "tag", Infer), pos) - val e = (EApp (e, (ERecord attrs, pos)), pos) - val e = (EApp (e, (EApp (#2 tagHead, (ERecord [], pos)), pos)), pos) - val e = (EApp (e, (EVar (["Basis"], "css_subset", Infer), pos)), pos) - val e = (EApp (e, (EVar (["Basis"], "css_subset", Infer), pos)), pos) in - (#1 tagHead, e) + (#1 tagHead, + (EApp ((EApp ((EVar (["Basis"], "tag", Infer), pos), + (ERecord attrs, pos)), pos), + (EApp (#2 tagHead, + (ERecord [], pos)), pos)), + pos)) end) tagHead: BEGIN_TAG (let -- cgit v1.2.3