Mercurial > urweb
diff src/tag.sml @ 143:4b9c2bd6157c
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 |
line wrap: on
line diff
--- a/src/tag.sml Sun Jul 20 12:21:30 2008 -0400 +++ b/src/tag.sml Sun Jul 20 13:30:19 2008 -0400 @@ -65,50 +65,57 @@ let val (xets, s) = ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) => - case x of - (CName "Link", _) => - let - fun unravel (e, _) = - case e of - ENamed n => (n, []) - | EApp (e1, e2) => - let - val (n, es) = unravel e1 - in - (n, es @ [e2]) - end - | _ => (ErrorMsg.errorAt loc "Invalid link expression"; - (0, [])) + let + fun tagIt newAttr = + let + fun unravel (e, _) = + case e of + ENamed n => (n, []) + | EApp (e1, e2) => + let + val (n, es) = unravel e1 + in + (n, es @ [e2]) + end + | _ => (ErrorMsg.errorAt loc "Invalid link expression"; + (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), - (f, count) :: newTags) - | SOME cn => (cn, count, tags, newTags) - val (_, _, _, s) = E.lookupENamed env f + val (f, args) = unravel e - val byTag = case SM.find (byTag, s) of - NONE => SM.insert (byTag, s, f) - | SOME f' => - (if f = f' then - () - else - ErrorMsg.errorAt loc - ("Duplicate HTTP tag " - ^ s); - byTag) + val (cn, count, tags, newTags) = + case IM.find (tags, f) of + NONE => + (count, count + 1, IM.insert (tags, f, count), + (f, count) :: newTags) + | SOME cn => (cn, count, tags, newTags) + + val (_, _, _, s) = E.lookupENamed env f - val e = (EClosure (cn, args), loc) - val t = (CFfi ("Basis", "string"), loc) - in - (((CName "href", loc), e, t), - (count, tags, byTag, newTags)) - end - | _ => ((x, e, t), (count, tags, byTag, newTags))) + val byTag = case SM.find (byTag, s) of + NONE => SM.insert (byTag, s, f) + | SOME f' => + (if f = f' then + () + else + ErrorMsg.errorAt loc + ("Duplicate HTTP tag " + ^ s); + byTag) + + val e = (EClosure (cn, args), loc) + val t = (CFfi ("Basis", "string"), loc) + in + (((CName newAttr, loc), e, t), + (count, tags, byTag, newTags)) + end + in + case x of + (CName "Link", _) => tagIt "Href" + | (CName "Action", _) => tagIt "Action" + | _ => ((x, e, t), (count, tags, byTag, newTags)) + end) s xets in (EApp (