summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 12:31:54 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 12:31:54 -0400
commit84168a777e28ab53917bc3ed448cc90e6b00a4ed (patch)
tree9df501486d7beb6949a4743263fc15e53cf1c8e4 /src
parent0f0d418e2290cdf5e6e392f65579756b37661be9 (diff)
Stop tracking CSS classes in XML types
Diffstat (limited to 'src')
-rw-r--r--src/cjr.sml2
-rw-r--r--src/cjr_print.sml18
-rw-r--r--src/core.sml2
-rw-r--r--src/core_env.sml4
-rw-r--r--src/core_print.sml18
-rw-r--r--src/core_util.sml11
-rw-r--r--src/corify.sml15
-rw-r--r--src/elab.sml2
-rw-r--r--src/elab_env.sml4
-rw-r--r--src/elab_print.sig1
-rw-r--r--src/elab_print.sml10
-rw-r--r--src/elab_util.sml13
-rw-r--r--src/elaborate.sml75
-rw-r--r--src/expl.sml2
-rw-r--r--src/expl_env.sml4
-rw-r--r--src/expl_print.sml10
-rw-r--r--src/explify.sml2
-rw-r--r--src/mono.sml2
-rw-r--r--src/mono_print.sml10
-rw-r--r--src/monoize.sml69
-rw-r--r--src/reduce.sml2
-rw-r--r--src/shake.sml4
-rw-r--r--src/source.sml2
-rw-r--r--src/source_print.sml10
-rw-r--r--src/urweb.grm31
25 files changed, 116 insertions, 207 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-14 23:42:48 +0000