Mercurial > urweb

comparison src/tag.sml @ 1628:3621f486ce72

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Don't crash on invalid URL head terms during Tag
author Adam Chlipala <adam@chlipala.net>
date Sat, 03 Dec 2011 17:25:51 -0500
parents 44a12a321150
children ca3b73a7b4d0
comparison
equal deleted inserted replaced
1627:5c1f10cdac63 1628:3621f486ce72
63 (n, es @ [e2]) 63 (n, es @ [e2])
64 end 64 end
65 | _ => (ErrorMsg.errorAt loc ("Invalid " ^ newAttr 65 | _ => (ErrorMsg.errorAt loc ("Invalid " ^ newAttr
66 ^ " expression"); 66 ^ " expression");
67 Print.epreface ("Expression", 67 Print.epreface ("Expression",
68 CorePrint.p_exp CoreEnv.empty eOrig); 68 CorePrint.p_exp env eOrig);
69 (0, [])) 69 (0, []))
70 70
71 val (f, args) = unravel e 71 val (f, args) = unravel e
72
73 val (cn, count, tags, newTags) =
74 case IM.find (tags, f) of
75 NONE =>
76 (count, count + 1, IM.insert (tags, f, count),
77 (ek, f, count) :: newTags)
78 | SOME cn => (cn, count, tags, newTags)
79
80 val (_, _, _, s) = E.lookupENamed env f
81
82 val byTag = case SM.find (byTag, s) of
83 NONE => SM.insert (byTag, s, (ek, f))
84 | SOME (ek', f') =>
85 (if f = f' then
86 ()
87 else
88 ErrorMsg.errorAt loc
89 ("Duplicate HTTP tag "
90 ^ s);
91 if ek = ek' then
92 ()
93 else
94 both (loc, s);
95 byTag)
96
97 val e = (EClosure (cn, args), loc)
98 in 72 in
99 (e, (count, tags, byTag, newTags)) 73 if f = 0 then
74 (e, (count, tags, byTag, newTags))
75 else
76 let
77 val (cn, count, tags, newTags) =
78 case IM.find (tags, f) of
79 NONE =>
80 (count, count + 1, IM.insert (tags, f, count),
81 (ek, f, count) :: newTags)
82 | SOME cn => (cn, count, tags, newTags)
83
84 val (_, _, _, s) = E.lookupENamed env f
85
86 val byTag = case SM.find (byTag, s) of
87 NONE => SM.insert (byTag, s, (ek, f))
88 | SOME (ek', f') =>
89 (if f = f' then
90 ()
91 else
92 ErrorMsg.errorAt loc
93 ("Duplicate HTTP tag "
94 ^ s);
95 if ek = ek' then
96 ()
97 else
98 both (loc, s);
99 byTag)
100
101 val e = (EClosure (cn, args), loc)
102 in
103 (e, (count, tags, byTag, newTags))
104 end
100 end 105 end
101 in 106 in
102 case e of 107 case e of
103 EApp ( 108 EApp (
104 (EApp ( 109 (EApp (