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 (