diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-20 13:30:19 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-20 13:30:19 -0400 |
| commit | b1997d2e699e92e83f7130b7b4a4c5467dcdcd27 (patch) | |
| tree | ab280240433798e7e1b8063804424ea76e7eed57 /src/tag.sml | |
| parent | 26a8eaaa3429aea2e455d18ff9a0f6c661d90cef (diff) | |
Almost ready to have a form work
Diffstat (limited to 'src/tag.sml')
| -rw-r--r-- | src/tag.sml | 95 |
1 files changed, 51 insertions, 44 deletions
diff --git a/src/tag.sml b/src/tag.sml index 53966bf9..3bd9f3f1 100644 --- a/src/tag.sml +++ b/src/tag.sml @@ -65,50 +65,57 @@ fun exp env (e, s) = 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, [])) - - 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 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 "href", loc), e, t), - (count, tags, byTag, newTags)) - end - | _ => ((x, e, t), (count, tags, byTag, newTags))) + 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 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 ( |