X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/4542571e02a2517e6ca9c342d433343293b06be8..ef18a74197873c2b319c57ff5dacb2a09e234d76:/src/autodoc.sml

diff --git a/src/autodoc.sml b/src/autodoc.sml
index 86c8651..640012c 100644
--- 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
@@ -187,4 +187,72 @@ 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)
+    end
+
 end