Mercurial > urweb

comparison src/tag.sml @ 143:4b9c2bd6157c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Almost ready to have a form work
author Adam Chlipala <adamc@hcoop.net>
date Sun, 20 Jul 2008 13:30:19 -0400
parents f214c535d253
children f0d3402184d1
comparison
equal deleted inserted replaced
142:6f9e224692ec 143:4b9c2bd6157c
63 (case attrs of 63 (case attrs of
64 (ERecord xets, _) => 64 (ERecord xets, _) =>
65 let 65 let
66 val (xets, s) = 66 val (xets, s) =
67 ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) => 67 ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) =>
68 case x of 68 let
69 (CName "Link", _) => 69 fun tagIt newAttr =
70 let 70 let
71 fun unravel (e, _) = 71 fun unravel (e, _) =
72 case e of 72 case e of
73 ENamed n => (n, []) 73 ENamed n => (n, [])
74 | EApp (e1, e2) => 74 | EApp (e1, e2) =>
75 let 75 let
76 val (n, es) = unravel e1 76 val (n, es) = unravel e1
77 in 77 in
78 (n, es @ [e2]) 78 (n, es @ [e2])
79 end 79 end
80 | _ => (ErrorMsg.errorAt loc "Invalid link expression"; 80 | _ => (ErrorMsg.errorAt loc "Invalid link expression";
81 (0, [])) 81 (0, []))
82 82
83 val (f, args) = unravel e 83
84 84
85 val (cn, count, tags, newTags) = 85 val (f, args) = unravel e
86 case IM.find (tags, f) of 86
87 NONE => 87 val (cn, count, tags, newTags) =
88 (count, count + 1, IM.insert (tags, f, count), 88 case IM.find (tags, f) of
89 (f, count) :: newTags) 89 NONE =>
90 | SOME cn => (cn, count, tags, newTags) 90 (count, count + 1, IM.insert (tags, f, count),
91 91 (f, count) :: newTags)
92 val (_, _, _, s) = E.lookupENamed env f 92 | SOME cn => (cn, count, tags, newTags)
93 93
94 val byTag = case SM.find (byTag, s) of 94 val (_, _, _, s) = E.lookupENamed env f
95 NONE => SM.insert (byTag, s, f) 95
96 | SOME f' => 96 val byTag = case SM.find (byTag, s) of
97 (if f = f' then 97 NONE => SM.insert (byTag, s, f)
98 () 98 | SOME f' =>
99 else 99 (if f = f' then
100 ErrorMsg.errorAt loc 100 ()
101 ("Duplicate HTTP tag " 101 else
102 ^ s); 102 ErrorMsg.errorAt loc
103 byTag) 103 ("Duplicate HTTP tag "
104 104 ^ s);
105 val e = (EClosure (cn, args), loc) 105 byTag)
106 val t = (CFfi ("Basis", "string"), loc) 106
107 in 107 val e = (EClosure (cn, args), loc)
108 (((CName "href", loc), e, t), 108 val t = (CFfi ("Basis", "string"), loc)
109 (count, tags, byTag, newTags)) 109 in
110 end 110 (((CName newAttr, loc), e, t),
111 | _ => ((x, e, t), (count, tags, byTag, newTags))) 111 (count, tags, byTag, newTags))
112 end
113 in
114 case x of
115 (CName "Link", _) => tagIt "Href"
116 | (CName "Action", _) => tagIt "Action"
117 | _ => ((x, e, t), (count, tags, byTag, newTags))
118 end)
112 s xets 119 s xets
113 in 120 in
114 (EApp ( 121 (EApp (
115 (EApp ( 122 (EApp (
116 (EApp ( 123 (EApp (