Fix regeneration of multi-file dependencies

[hcoop/domtool2.git] / src / autodoc.sml

diff --git a/src/autodoc.sml b/src/autodoc.sml
index 87134e4..bdf2527 100644 (file)
--- a/src/autodoc.sml
+++ b/src/autodoc.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2007, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -36,13 +36,13 @@ fun check' G fname =
        if !ErrorMsg.anyErrors then
            G
        else
-           Tycheck.checkFile G (Defaults.tInit ()) prog
+           Tycheck.checkFile G (Defaults.tInit prog) prog
     end
 
 fun autodoc {outdir, infiles} =
     let
-       val (prov, infiles) = Order.order infiles
-       val _ = HtmlPrint.setProviders prov
+       val (prov, infiles) = Order.order NONE infiles
+       val _ = HtmlPrintArg.setProviders prov
 
        val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
 
@@ -144,15 +144,18 @@ fun autodoc {outdir, infiles} =
        val items = map (fn file =>
                            let
                                val file' = modify file
+                               val (desc, _, _) = Parse.parse file
                            in
                                LI {ty = NONE,
                                    value = NONE,
-                                   content = TextBlock (A {name = NONE,
-                                                           href = SOME (file' ^ ".html"),
-                                                           rel = NONE,
-                                                           rev = NONE,
-                                                           title = NONE,
-                                                           content = PCDATA (uppercase file')})}
+                                   content = BlockList
+                                                 [TextBlock (A {name = NONE,
+                                                                href = SOME (file' ^ ".html"),
+                                                                rel = NONE,
+                                                                rev = NONE,
+                                                                title = NONE,
+                                                                content = PCDATA (uppercase file')}),
+                                                  TextBlock (PCDATA (Option.getOpt (desc, "")))]}
                            end) infiles
 
        val index = HTML {version = NONE,
@@ -184,4 +187,73 @@ fun autodoc {outdir, infiles} =
        app doFile infiles
     end
 
+fun makeEmacsKeywords infiles =
+    let
+       val (_, infiles) = Order.order NONE infiles
+       val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles       
+
+       fun annotate_decl d =
+           case d of
+               DVal (name, NONE, e) =>
+               (case Env.lookupVal G name of
+                    NONE => d
+                  | SOME t => DVal (name, SOME t, e))
+             | _ => d
+
+       fun doFile (file, acc) =
+           let
+               val (_, decls, _) = Parse.parse file
+
+               fun isAction evs (t, _) =
+                   case t of
+                       TAction (_, r1, r2) =>
+                       let
+                           fun enrich (r, evs) =
+                               StringMap.foldli (fn (ev, _, evs) =>
+                                                    StringSet.add (evs, ev))
+                                     evs r
+                       in
+                           SOME (enrich (r2, enrich (r1, evs)))
+                       end
+                     | TArrow (_, t) => isAction evs t
+                     | TNested (_, t) => isAction evs t
+                     | TUnif (_, ref (SOME t)) => isAction evs t
+                     | _ => NONE
+           in
+               foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) =>
+                         case annotate_decl d of
+                             DExternType s => (s :: types, contexts, actions, vals, evs)
+                           | DExternVal (s, t) =>
+                             (case isAction evs t of
+                                  SOME evs => (types, contexts, s :: actions, vals, evs)
+                                | NONE => (types, contexts, actions, s :: vals, evs))
+                           | DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs)
+                           | DVal (s, SOME t, _) =>
+                             (case isAction evs t of
+                                  SOME evs => (types, contexts, s :: actions, vals, evs)
+                                | NONE => (types, contexts, actions, s :: vals, evs))
+                           | DContext s => (types, s :: contexts, actions, vals, evs))
+                     acc decls
+           end
+
+       val (types, contexts, actions, vals, evs) =
+           foldl doFile ([], [], [], [], StringSet.empty) infiles
+
+       fun printKind (ident, syms) =
+           (print "(defconst domtool-";
+            print ident;
+            print "-regexp\n  (domtool-syms-re";
+            app (fn s => (print " \""; print s; print "\"")) syms;
+            print ")\n  \"A regexp that matches Domtool ";
+            print ident;
+            print " from the standard library.\")\n\n")
+    in
+       printKind ("types", types);
+       printKind ("contexts", contexts);
+       printKind ("actions", actions);
+       printKind ("vals", vals);
+       printKind ("env-vars", StringSet.listItems evs);
+       print "(provide 'domtool-tables)\n"
+    end
+
 end