summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/tag.sml61
-rw-r--r--tests/invurl.ur9
2 files changed, 42 insertions, 28 deletions
diff --git a/src/tag.sml b/src/tag.sml
index a313e0a6..dc648739 100644
--- a/src/tag.sml
+++ b/src/tag.sml
@@ -65,38 +65,43 @@ fun exp env (e, s) =
| _ => (ErrorMsg.errorAt loc ("Invalid " ^ newAttr
^ " expression");
Print.epreface ("Expression",
- CorePrint.p_exp CoreEnv.empty eOrig);
+ CorePrint.p_exp env eOrig);
(0, []))
val (f, args) = unravel e
-
- val (cn, count, tags, newTags) =
- case IM.find (tags, f) of
- NONE =>
- (count, count + 1, IM.insert (tags, f, count),
- (ek, f, count) :: newTags)
- | SOME cn => (cn, count, tags, newTags)
-
- val (_, _, _, s) = E.lookupENamed env f
-
- val byTag = case SM.find (byTag, s) of
- NONE => SM.insert (byTag, s, (ek, f))
- | SOME (ek', f') =>
- (if f = f' then
- ()
- else
- ErrorMsg.errorAt loc
- ("Duplicate HTTP tag "
- ^ s);
- if ek = ek' then
- ()
- else
- both (loc, s);
- byTag)
-
- val e = (EClosure (cn, args), loc)
in
- (e, (count, tags, byTag, newTags))
+ if f = 0 then
+ (e, (count, tags, byTag, newTags))
+ else
+ let
+ val (cn, count, tags, newTags) =
+ case IM.find (tags, f) of
+ NONE =>
+ (count, count + 1, IM.insert (tags, f, count),
+ (ek, f, count) :: newTags)
+ | SOME cn => (cn, count, tags, newTags)
+
+ val (_, _, _, s) = E.lookupENamed env f
+
+ val byTag = case SM.find (byTag, s) of
+ NONE => SM.insert (byTag, s, (ek, f))
+ | SOME (ek', f') =>
+ (if f = f' then
+ ()
+ else
+ ErrorMsg.errorAt loc
+ ("Duplicate HTTP tag "
+ ^ s);
+ if ek = ek' then
+ ()
+ else
+ both (loc, s);
+ byTag)
+
+ val e = (EClosure (cn, args), loc)
+ in
+ (e, (count, tags, byTag, newTags))
+ end
end
in
case e of
diff --git a/tests/invurl.ur b/tests/invurl.ur
new file mode 100644
index 00000000..aef1ced6
--- /dev/null
+++ b/tests/invurl.ur
@@ -0,0 +1,9 @@
+val r = { F = fn () => return <xml/> }
+
+fun main () : transaction page = return <xml><body>
+ <a link={r.F ()}>Go</a>
+</body></xml>
+
+fun main' (r' : {F : unit -> transaction page}) : transaction page = return <xml><body>
+ <a link={r'.F ()}>Go</a>
+</body></xml>