wenzelm@5829: (* Title: Pure/Isar/outer_syntax.ML wenzelm@5829: ID: $Id$ wenzelm@5829: Author: Markus Wenzel, TU Muenchen wenzelm@5829: wenzelm@5829: The global Isabelle/Isar outer syntax. wenzelm@5829: *) wenzelm@5829: wenzelm@5829: signature BASIC_OUTER_SYNTAX = wenzelm@5829: sig wenzelm@5829: val main: unit -> unit wenzelm@5883: val loop: unit -> unit wenzelm@6860: val sync_main: unit -> unit wenzelm@6860: val sync_loop: unit -> unit wenzelm@5829: val help: unit -> unit wenzelm@5829: end; wenzelm@5829: wenzelm@5829: signature OUTER_SYNTAX = wenzelm@5829: sig wenzelm@5829: include BASIC_OUTER_SYNTAX wenzelm@6722: structure Keyword: wenzelm@6722: sig wenzelm@6722: val control: string wenzelm@6722: val diag: string wenzelm@6722: val thy_begin: string wenzelm@7104: val thy_switch: string wenzelm@6722: val thy_end: string wenzelm@6722: val thy_heading: string wenzelm@6722: val thy_decl: string wenzelm@6722: val thy_goal: string wenzelm@6722: val qed: string wenzelm@6733: val qed_block: string wenzelm@6722: val prf_goal: string wenzelm@6722: val prf_block: string wenzelm@6722: val prf_chain: string wenzelm@6722: val prf_decl: string wenzelm@6868: val prf_asm: string wenzelm@7676: val prf_asm_goal: string wenzelm@6722: val prf_script: string wenzelm@6722: val kinds: string list wenzelm@6722: end wenzelm@5829: type token wenzelm@5829: type parser wenzelm@6722: val command: string -> string -> string -> wenzelm@6373: (token list -> (Toplevel.transition -> Toplevel.transition) * token list) -> parser wenzelm@7750: val markup_command: string -> string -> string -> wenzelm@7750: (token list -> (Toplevel.transition -> Toplevel.transition) * token list) -> parser wenzelm@7789: val verbatim_command: string -> string -> string -> wenzelm@7789: (token list -> (Toplevel.transition -> Toplevel.transition) * token list) -> parser wenzelm@6722: val improper_command: string -> string -> string -> wenzelm@6373: (token list -> (Toplevel.transition -> Toplevel.transition) * token list) -> parser wenzelm@7026: val dest_keywords: unit -> string list wenzelm@7026: val dest_parsers: unit -> (string * string * string * bool) list wenzelm@5883: val print_outer_syntax: unit -> unit wenzelm@7367: val print_help: Toplevel.transition -> Toplevel.transition wenzelm@5829: val add_keywords: string list -> unit wenzelm@5829: val add_parsers: parser list -> unit wenzelm@6247: val theory_header: token list -> (string * string list * (string * bool) list) * token list wenzelm@7940: val deps_thy: string -> bool -> Path.T -> string list * Path.T list wenzelm@6199: val load_thy: string -> bool -> bool -> Path.T -> unit wenzelm@7333: val isar: bool -> bool -> Toplevel.isar wenzelm@5829: end; wenzelm@5829: wenzelm@5829: structure OuterSyntax: OUTER_SYNTAX = wenzelm@5829: struct wenzelm@5829: wenzelm@7750: structure T = OuterLex; wenzelm@6860: structure P = OuterParse; wenzelm@6860: wenzelm@5829: wenzelm@5829: (** outer syntax **) wenzelm@5829: wenzelm@6722: (* command keyword classification *) wenzelm@6722: wenzelm@6722: structure Keyword = wenzelm@6722: struct wenzelm@6722: val control = "control"; wenzelm@6722: val diag = "diag"; wenzelm@6722: val thy_begin = "theory-begin"; wenzelm@7104: val thy_switch = "theory-switch"; wenzelm@6722: val thy_end = "theory-end"; wenzelm@6722: val thy_heading = "theory-heading"; wenzelm@6722: val thy_decl = "theory-decl"; wenzelm@6722: val thy_goal = "theory-goal"; wenzelm@6722: val qed = "qed"; wenzelm@6733: val qed_block = "qed-block"; wenzelm@6722: val prf_goal = "proof-goal"; wenzelm@6722: val prf_block = "proof-block"; wenzelm@6722: val prf_chain = "proof-chain"; wenzelm@6722: val prf_decl = "proof-decl"; wenzelm@6868: val prf_asm = "proof-asm"; wenzelm@7676: val prf_asm_goal = "proof-asm-goal"; wenzelm@6722: val prf_script = "proof-script"; wenzelm@6722: wenzelm@7104: val kinds = [control, diag, thy_begin, thy_switch, thy_end, thy_heading, thy_decl, thy_goal, wenzelm@7676: qed, qed_block, prf_goal, prf_block, prf_chain, prf_decl, prf_asm, prf_asm_goal, prf_script]; wenzelm@6722: end; wenzelm@6722: wenzelm@6722: wenzelm@5829: (* parsers *) wenzelm@5829: wenzelm@7750: type token = T.token; wenzelm@5829: type parser_fn = token list -> (Toplevel.transition -> Toplevel.transition) * token list; wenzelm@5829: wenzelm@5829: datatype parser = wenzelm@7789: Parser of string * (string * string * bool option) * bool * parser_fn; wenzelm@5829: wenzelm@7750: fun parser int_only markup name comment kind parse = wenzelm@7750: Parser (name, (comment, kind, markup), int_only, parse); wenzelm@5829: wenzelm@5829: wenzelm@5829: (* parse command *) wenzelm@5829: wenzelm@6860: local wenzelm@6199: wenzelm@5829: fun command_body cmd (name, _) = wenzelm@7026: (case cmd name of wenzelm@7026: Some (int_only, parse) => P.!!! (Scan.prompt (name ^ "# ") (parse >> pair int_only)) wenzelm@7026: | None => sys_error ("no parser for outer syntax command " ^ quote name)); wenzelm@6860: wenzelm@6860: fun terminator false = Scan.succeed () wenzelm@6860: | terminator true = P.group "terminator" (Scan.option P.sync -- P.$$$ ";" >> K ()); wenzelm@6860: wenzelm@6860: in wenzelm@5829: wenzelm@6860: fun command term cmd = wenzelm@6860: P.$$$ ";" >> K None || wenzelm@6860: P.sync >> K None || wenzelm@7026: (P.position P.command :-- command_body cmd) --| terminator term wenzelm@6860: >> (fn ((name, pos), (int_only, f)) => wenzelm@6860: Some (Toplevel.empty |> Toplevel.name name |> Toplevel.position pos |> wenzelm@6860: Toplevel.interactive int_only |> f)); wenzelm@5829: wenzelm@6199: end; wenzelm@6199: wenzelm@5829: wenzelm@5829: wenzelm@5829: (** global syntax state **) wenzelm@5829: wenzelm@7026: local wenzelm@7026: wenzelm@7026: val global_lexicons = ref (Scan.empty_lexicon, Scan.empty_lexicon); wenzelm@7750: val global_parsers = wenzelm@7789: ref (Symtab.empty: (((string * string) * (bool * parser_fn)) * bool option) Symtab.table); wenzelm@7789: val global_markups = ref ([]: (string * bool) list); wenzelm@5952: wenzelm@7026: fun change_lexicons f = wenzelm@7026: let val lexs = f (! global_lexicons) in wenzelm@7026: (case (op inter_string) (pairself Scan.dest_lexicon lexs) of wenzelm@7026: [] => global_lexicons := lexs wenzelm@7026: | bads => error ("Clash of outer syntax commands and keywords: " ^ commas_quote bads)) wenzelm@7026: end; wenzelm@5829: wenzelm@7789: fun get_markup (ms, (name, (_, Some m))) = (name, m) :: ms wenzelm@7789: | get_markup (ms, _) = ms; wenzelm@7750: wenzelm@7750: fun make_markups () = global_markups := Symtab.foldl get_markup ([], ! global_parsers); wenzelm@7750: fun change_parsers f = (global_parsers := f (! global_parsers); make_markups ()); wenzelm@6722: wenzelm@7026: in wenzelm@7026: wenzelm@7750: wenzelm@7750: (* get current syntax *) wenzelm@7026: wenzelm@7026: (*Note: the syntax for files is statically determined at the very wenzelm@7026: beginning; for interactive processing it may change dynamically.*) wenzelm@7026: wenzelm@7026: fun get_lexicons () = ! global_lexicons; wenzelm@7026: fun get_parsers () = ! global_parsers; wenzelm@7750: fun get_parser () = apsome (#2 o #1) o curry Symtab.lookup (! global_parsers); wenzelm@7789: wenzelm@7789: fun lookup_markup name = assoc (! global_markups, name); wenzelm@7789: fun is_markup name = if_none (lookup_markup name) false; wenzelm@7789: fun is_verbatim name = if_none (apsome not (lookup_markup name)) false; wenzelm@5829: wenzelm@5829: wenzelm@5829: (* augment syntax *) wenzelm@5829: wenzelm@7026: fun add_keywords keywords = change_lexicons (apfst (fn lex => wenzelm@7026: (Scan.extend_lexicon lex (map Symbol.explode keywords)))); wenzelm@5829: wenzelm@7750: fun add_parser (tab, Parser (name, (comment, kind, markup), int_only, parse)) = wenzelm@5829: (if is_none (Symtab.lookup (tab, name)) then () wenzelm@5829: else warning ("Redefined outer syntax command " ^ quote name); wenzelm@7750: Symtab.update ((name, (((comment, kind), (int_only, parse)), markup)), tab)); wenzelm@5829: wenzelm@5829: fun add_parsers parsers = wenzelm@7026: (change_parsers (fn tab => foldl add_parser (tab, parsers)); wenzelm@7026: change_lexicons (apsnd (fn lex => Scan.extend_lexicon lex wenzelm@7026: (map (fn Parser (name, _, _, _) => Symbol.explode name) parsers)))); wenzelm@7026: wenzelm@7026: end; wenzelm@5829: wenzelm@5829: wenzelm@7026: (* print syntax *) wenzelm@7026: wenzelm@7026: fun dest_keywords () = Scan.dest_lexicon (#1 (get_lexicons ())); wenzelm@7026: wenzelm@7026: fun dest_parsers () = wenzelm@7750: map (fn (name, (((cmt, kind), (int_only, _)), _)) => (name, cmt, kind, int_only)) wenzelm@7026: (Symtab.dest (get_parsers ())); wenzelm@5829: wenzelm@7026: fun print_outer_syntax () = wenzelm@7026: let wenzelm@7026: fun pretty_cmd (name, comment, _, _) = wenzelm@7026: Pretty.block [Pretty.str (name ^ ":"), Pretty.brk 2, Pretty.str comment]; wenzelm@7026: val (int_cmds, cmds) = partition #4 (dest_parsers ()); wenzelm@7026: in wenzelm@7026: Pretty.writeln (Pretty.strs ("syntax keywords:" :: map quote (dest_keywords ()))); wenzelm@7026: Pretty.writeln (Pretty.big_list "proper commands:" (map pretty_cmd cmds)); wenzelm@7026: Pretty.writeln (Pretty.big_list "improper commands (interactive-only):" wenzelm@7026: (map pretty_cmd int_cmds)) wenzelm@7026: end; wenzelm@5829: wenzelm@7367: val print_help = wenzelm@7367: Toplevel.keep (fn state => wenzelm@7613: let val opt_thy = try Toplevel.theory_of state in wenzelm@7613: print_outer_syntax (); wenzelm@7613: Method.help_methods opt_thy; wenzelm@7613: Attrib.help_attributes opt_thy wenzelm@7613: end); wenzelm@7367: wenzelm@5829: wenzelm@5829: wenzelm@5829: (** read theory **) wenzelm@5829: wenzelm@7746: (* special keywords *) wenzelm@6247: wenzelm@7746: val headerN = "header"; wenzelm@6247: val theoryN = "theory"; wenzelm@7746: wenzelm@7750: val theory_keyword = P.$$$ theoryN; wenzelm@7750: val header_keyword = P.$$$ headerN; wenzelm@7746: val semicolon = P.$$$ ";"; wenzelm@6247: wenzelm@6247: wenzelm@7683: (* sources *) wenzelm@5829: wenzelm@6860: local wenzelm@5829: wenzelm@6860: val no_terminator = wenzelm@7750: Scan.unless semicolon (Scan.one (T.not_sync andf T.not_eof)); wenzelm@6860: wenzelm@6860: val recover = Scan.prompt "recover# " (Scan.repeat no_terminator); wenzelm@6860: wenzelm@6860: in wenzelm@5829: wenzelm@6860: fun source term do_recover cmd src = wenzelm@5829: src wenzelm@7750: |> Source.source T.stopper wenzelm@7750: (Scan.bulk (fn xs => P.!!! (command term (cmd ())) xs)) wenzelm@6860: (if do_recover then Some recover else None) wenzelm@5829: |> Source.mapfilter I; wenzelm@5829: wenzelm@6860: end; wenzelm@6860: wenzelm@7683: fun token_source (src, pos) = wenzelm@7683: src wenzelm@7683: |> Symbol.source false wenzelm@7750: |> T.source false (K (get_lexicons ())) pos; wenzelm@7683: wenzelm@7683: fun filter_proper src = wenzelm@7683: src wenzelm@7750: |> Source.filter T.is_proper; wenzelm@7683: wenzelm@5829: wenzelm@7746: (* scan header *) wenzelm@5829: wenzelm@7026: fun scan_header get_lex scan (src, pos) = wenzelm@5829: src wenzelm@5829: |> Symbol.source false wenzelm@7750: |> T.source false (fn () => (get_lex (), Scan.empty_lexicon)) pos wenzelm@7683: |> filter_proper wenzelm@7750: |> Source.source T.stopper (Scan.single scan) None wenzelm@5829: |> (fst o the o Source.get_single); wenzelm@5829: wenzelm@7746: wenzelm@7746: (* detect new/old header *) wenzelm@7746: wenzelm@7746: local wenzelm@5829: wenzelm@7746: val check_header_lexicon = Scan.make_lexicon [Symbol.explode headerN, Symbol.explode theoryN]; wenzelm@7746: val check_header = Scan.option (header_keyword || theory_keyword); wenzelm@7746: wenzelm@7746: in wenzelm@7746: wenzelm@7746: fun is_old_theory src = is_none (scan_header (K check_header_lexicon) check_header src); wenzelm@7746: wenzelm@7746: end; wenzelm@6199: wenzelm@6199: wenzelm@6199: (* deps_thy --- inspect theory header *) wenzelm@6199: wenzelm@7746: local wenzelm@7746: wenzelm@6247: val header_lexicon = wenzelm@7746: Scan.make_lexicon (map Symbol.explode ["(", ")", "+", ":", ";", "=", "files", headerN, theoryN]); wenzelm@6199: wenzelm@7026: val file_name = wenzelm@7026: (P.$$$ "(" |-- P.!!! (P.name --| P.$$$ ")")) >> rpair false || P.name >> rpair true; wenzelm@6247: wenzelm@7746: in wenzelm@7746: wenzelm@7746: val theory_header = wenzelm@6860: (P.name -- (P.$$$ "=" |-- P.enum1 "+" P.name) -- wenzelm@7746: Scan.optional (P.$$$ "files" |-- P.!!! (Scan.repeat1 file_name)) [] --| P.$$$ ":") wenzelm@6247: >> (fn ((A, Bs), files) => (A, Bs, files)); wenzelm@6247: wenzelm@7746: val new_header = wenzelm@7746: header_keyword |-- (P.!!! (P.text -- Scan.option semicolon -- theory_keyword |-- theory_header)) wenzelm@7746: || theory_keyword |-- P.!!! theory_header; wenzelm@6199: wenzelm@6199: val old_header = wenzelm@7810: P.!!! (P.group "theory header" wenzelm@7810: (P.name -- (P.$$$ "=" |-- P.name -- Scan.repeat (P.$$$ "+" |-- P.name)))) wenzelm@6247: >> (fn (A, (B, Bs)) => (A, B :: Bs, []: (string * bool) list)); wenzelm@6199: wenzelm@7940: fun deps_thy name ml path = wenzelm@6199: let wenzelm@7735: val src = Source.of_string (File.read path); wenzelm@7735: val pos = Path.position path; wenzelm@6247: val (name', parents, files) = wenzelm@7940: (*unfortunately, old-style headers dynamically depend on the current lexicon*) wenzelm@7746: if is_old_theory (src, pos) then wenzelm@7746: scan_header ThySyn.get_lexicon (Scan.error old_header) (src, pos) wenzelm@7735: else scan_header (K header_lexicon) (Scan.error new_header) (src, pos); wenzelm@6199: wenzelm@6199: val ml_path = ThyLoad.ml_path name; wenzelm@7940: val ml_file = if ml andalso is_some (ThyLoad.check_file ml_path) then [ml_path] else []; wenzelm@6199: in wenzelm@6199: if name <> name' then wenzelm@7940: error ("Filename " ^ quote (Path.pack path) ^ wenzelm@7940: " does not agree with theory name " ^ quote name) wenzelm@6247: else (parents, map (Path.unpack o #1) files @ ml_file) wenzelm@6199: end; wenzelm@6199: wenzelm@7746: end; wenzelm@7746: wenzelm@6199: wenzelm@7750: (* present theory source *) wenzelm@7750: wenzelm@7750: local wenzelm@7750: wenzelm@7903: val indent_prop = Scan.one T.is_indent -- Scan.one T.is_proper; wenzelm@7903: val improp = Scan.unless indent_prop (Scan.one (not o T.is_proper)); wenzelm@7903: val improper_keep_indent = Scan.repeat improp; wenzelm@7903: wenzelm@7755: val improper = Scan.any (not o T.is_proper); wenzelm@7903: wenzelm@7903: val improper_end = wenzelm@7903: (improper -- semicolon) |-- improper_keep_indent || wenzelm@7903: improper_keep_indent; wenzelm@7903: wenzelm@7755: val markup = Scan.one (T.is_kind T.Command andf is_markup o T.val_of) >> T.val_of; wenzelm@7789: val verbatim = Scan.one (T.is_kind T.Command andf is_verbatim o T.val_of); wenzelm@7750: wenzelm@7755: val present_token = wenzelm@7903: improper |-- markup -- (improper |-- P.text --| improper_end) >> Present.markup_token || wenzelm@7755: (P.$$$ "--" >> K "cmt") -- (improper |-- P.text) >> Present.markup_token || wenzelm@7903: (improper -- verbatim -- improper) |-- P.text --| improper_end >> Present.verbatim_token || wenzelm@7755: Scan.one T.not_eof >> Present.basic_token; wenzelm@7750: wenzelm@7750: in wenzelm@7750: wenzelm@7750: (*note: lazy evaluation ahead*) wenzelm@7750: wenzelm@7750: fun present_toks text pos () = wenzelm@7750: token_source (Source.of_list (Library.untabify text), pos) wenzelm@7755: |> Source.source T.stopper (Scan.bulk present_token) None wenzelm@7755: |> Source.exhaust; wenzelm@7750: wenzelm@7750: fun present_text text () = wenzelm@7750: Source.exhaust (Symbol.source false (Source.of_list (Library.untabify text))); wenzelm@7750: wenzelm@7750: end; wenzelm@7750: wenzelm@7750: wenzelm@6199: (* load_thy --- read text (including header) *) wenzelm@6199: wenzelm@7746: local wenzelm@7746: wenzelm@7940: fun try_ml_file name time = wenzelm@6199: let wenzelm@6199: val path = ThyLoad.ml_path name; wenzelm@7940: val tr = Toplevel.imperative (fn () => ThyInfo.load_file time path); wenzelm@6247: val tr_name = if time then "time_use" else "use"; wenzelm@6199: in wenzelm@7243: if is_none (ThyLoad.check_file path) then () wenzelm@7062: else Toplevel.excursion_error [Toplevel.empty |> Toplevel.name tr_name |> tr] wenzelm@6199: end; wenzelm@6199: wenzelm@7683: fun parse_thy src_pos = wenzelm@7746: src_pos wenzelm@7746: |> token_source wenzelm@7746: |> filter_proper wenzelm@7746: |> source false false (K (get_parser ())) wenzelm@7746: |> Source.exhaust; wenzelm@5829: wenzelm@6247: fun run_thy name path = wenzelm@7683: let wenzelm@7735: val text = explode (File.read path); wenzelm@7735: val src = Source.of_list text; wenzelm@7735: val pos = Path.position path; wenzelm@7683: in wenzelm@7735: Present.init_theory name; wenzelm@7768: Present.verbatim_source name (present_text text); wenzelm@7735: if is_old_theory (src, pos) then ThySyn.load_thy name text wenzelm@7774: else (Toplevel.excursion_error (parse_thy (src, pos)); wenzelm@7774: Present.token_source name (present_toks text pos)) wenzelm@6247: end; wenzelm@6199: wenzelm@7746: in wenzelm@7746: wenzelm@6199: fun load_thy name ml time path = wenzelm@6247: (if time then wenzelm@6247: timeit (fn () => wenzelm@6247: (writeln ("\n**** Starting theory " ^ quote name ^ " ****"); wenzelm@6247: setmp Goals.proof_timing true (run_thy name) path; wenzelm@6247: writeln ("**** Finished theory " ^ quote name ^ " ****\n"))) wenzelm@6247: else run_thy name path; wenzelm@6247: Context.context (ThyInfo.get_theory name); wenzelm@7940: if ml then try_ml_file name time else ()); wenzelm@5829: wenzelm@7746: end; wenzelm@7746: wenzelm@5829: wenzelm@5829: (* interactive source of state transformers *) wenzelm@5829: wenzelm@7333: fun isar term no_pos = wenzelm@5829: Source.tty wenzelm@5829: |> Symbol.source true wenzelm@7750: |> T.source true get_lexicons wenzelm@7604: (if no_pos then Position.none else Position.line_name 1 "stdin") wenzelm@7683: |> filter_proper wenzelm@6860: |> source term true get_parser; wenzelm@5829: wenzelm@5829: wenzelm@5829: wenzelm@5829: (** the read-eval-print loop **) wenzelm@5829: wenzelm@5923: (* main loop *) wenzelm@5923: wenzelm@7333: fun gen_loop term no_pos = wenzelm@7333: (Context.reset_context (); wenzelm@7333: Toplevel.loop (isar term no_pos)); wenzelm@5829: wenzelm@7333: fun gen_main term no_pos = wenzelm@5829: (Toplevel.set_state Toplevel.toplevel; wenzelm@6199: writeln (Session.welcome ()); wenzelm@7333: gen_loop term no_pos); wenzelm@6860: wenzelm@7333: fun main () = gen_main false false; wenzelm@7333: fun loop () = gen_loop false false; wenzelm@7333: fun sync_main () = gen_main true true; wenzelm@7333: fun sync_loop () = gen_loop true true; wenzelm@5829: wenzelm@5829: wenzelm@5829: (* help *) wenzelm@5829: wenzelm@5829: fun help () = wenzelm@5829: writeln ("This is Isabelle's underlying ML system (" ^ ml_system ^ ");\n\ wenzelm@5883: \invoke 'loop();' to enter the Isar loop."); wenzelm@5829: wenzelm@5829: wenzelm@6373: (*final declarations of this structure!*) wenzelm@7789: val command = parser false None; wenzelm@7789: val markup_command = parser false (Some true); wenzelm@7789: val verbatim_command = parser false (Some false); wenzelm@7789: val improper_command = parser true None; wenzelm@6685: wenzelm@6373: wenzelm@5829: end; wenzelm@5829: wenzelm@6199: (*setup theory syntax dependent operations*) wenzelm@6199: ThyLoad.deps_thy_fn := OuterSyntax.deps_thy; wenzelm@6199: ThyLoad.load_thy_fn := OuterSyntax.load_thy; wenzelm@6199: structure ThyLoad: THY_LOAD = ThyLoad; wenzelm@6199: wenzelm@5829: structure BasicOuterSyntax: BASIC_OUTER_SYNTAX = OuterSyntax; wenzelm@5829: open BasicOuterSyntax;