moved global keywords from OuterSyntax to OuterKeyword, tuned interfaces;
lexicons: allow overlapping keywords/commands -- warning instead of error;
--- a/src/Pure/Isar/outer_keyword.ML Wed Jun 25 17:38:36 2008 +0200
+++ b/src/Pure/Isar/outer_keyword.ML Wed Jun 25 17:38:37 2008 +0200
@@ -2,7 +2,7 @@
ID: $Id$
Author: Makarius
-Isar command keyword classification.
+Isar command keyword classification and global keyword tables.
*)
signature OUTER_KEYWORD =
@@ -38,12 +38,21 @@
val tag_theory: T -> T
val tag_proof: T -> T
val tag_ml: T -> T
+ val get_lexicons: unit -> Scan.lexicon * Scan.lexicon
+ val is_keyword: string -> bool
+ val dest_keywords: unit -> string list
+ val dest_commands: unit -> string list
+ val command_keyword: string -> T option
+ val command_tags: string -> string list
+ val report: unit -> unit
+ val keyword: string -> unit
+ val command: string -> T -> unit
end;
structure OuterKeyword: OUTER_KEYWORD =
struct
-(* keyword classification *)
+(** keyword classification **)
datatype T = Keyword of string * string list;
@@ -92,4 +101,67 @@
val tag_proof = tag "proof";
val tag_ml = tag "ML";
+
+
+(** global keyword tables **)
+
+local
+
+val global_commands = ref (Symtab.empty: T Symtab.table);
+val global_lexicons = ref (Scan.empty_lexicon, Scan.empty_lexicon);
+
+in
+
+fun get_commands () = CRITICAL (fn () => ! global_commands);
+fun get_lexicons () = CRITICAL (fn () => ! global_lexicons);
+
+fun change_commands f = CRITICAL (fn () => change global_commands f);
+
+fun change_lexicons f = CRITICAL (fn () =>
+ (change global_lexicons f;
+ (case (op inter_string) (pairself Scan.dest_lexicon (get_lexicons ())) of
+ [] => ()
+ | clash => warning ("Overlapping outer syntax commands and keywords: " ^ commas_quote clash))));
+
end;
+
+
+(* lookup *)
+
+fun is_keyword s = Scan.is_literal (#1 (get_lexicons ())) (Symbol.explode s);
+fun dest_keywords () = Scan.dest_lexicon (#1 (get_lexicons ()));
+
+fun dest_commands () = Symtab.keys (get_commands ());
+fun command_keyword name = Symtab.lookup (get_commands ()) name;
+fun command_tags name = these (Option.map tags_of (command_keyword name));
+
+
+(* report *)
+
+fun report_keyword name =
+ Pretty.mark (Markup.keyword_decl name)
+ (Pretty.str ("Outer syntax keyword: " ^ quote name));
+
+fun report_command (name, kind) =
+ Pretty.mark (Markup.command_decl name (kind_of kind))
+ (Pretty.str ("Outer syntax command: " ^ quote name ^ " (" ^ kind_of kind ^ ")"));
+
+fun report () =
+ let val (keywords, commands) = CRITICAL (fn () =>
+ (dest_keywords (), Symtab.dest (get_commands ())))
+ in map report_keyword keywords @ map report_command commands end
+ |> Pretty.chunks |> Pretty.writeln;
+
+
+(* augment tables *)
+
+fun keyword name =
+ (change_lexicons (apfst (Scan.extend_lexicon [Symbol.explode name]));
+ Pretty.writeln (report_keyword name));
+
+fun command name kind =
+ (change_lexicons (apsnd (Scan.extend_lexicon [Symbol.explode name]));
+ change_commands (Symtab.update (name, kind));
+ Pretty.writeln (report_command (name, kind)));
+
+end;