defer actual parsing of command spans and thus allow new commands to be used in the same theory where defined;
authorwenzelm
Fri Mar 16 14:42:11 2012 +0100 (2012-03-16 ago)
changeset 46959cdc791910460
parent 46958 0ec8f04e753a
child 46960 f19e5837ad69
defer actual parsing of command spans and thus allow new commands to be used in the same theory where defined;
NEWS
src/Pure/Isar/toplevel.ML
src/Pure/Thy/thy_load.ML
     1.1 --- a/NEWS	Fri Mar 16 13:05:30 2012 +0100
     1.2 +++ b/NEWS	Fri Mar 16 14:42:11 2012 +0100
     1.3 @@ -41,6 +41,10 @@
     1.4  "syntax_ambiguity_warning" and "syntax_ambiguity_limit" in isar-ref
     1.5  manual.  Minor INCOMPATIBILITY.
     1.6  
     1.7 +* Forward declaration of outer syntax keywords within the theory
     1.8 +header -- minor INCOMPATIBILITY for user-defined commands.  Allow new
     1.9 +commands to be used in the same theory where defined.
    1.10 +
    1.11  
    1.12  *** Pure ***
    1.13  
    1.14 @@ -372,9 +376,6 @@
    1.15  
    1.16  *** ML ***
    1.17  
    1.18 -* Outer syntax keywords for user-defined Isar commands need to be
    1.19 -defined explicitly in the theory header.  Minor INCOMPATIBILITY.
    1.20 -
    1.21  * Antiquotation @{keyword "name"} produces a parser for outer syntax
    1.22  from a minor keyword introduced via theory header declaration.
    1.23  
     2.1 --- a/src/Pure/Isar/toplevel.ML	Fri Mar 16 13:05:30 2012 +0100
     2.2 +++ b/src/Pure/Isar/toplevel.ML	Fri Mar 16 14:42:11 2012 +0100
     2.3 @@ -90,8 +90,8 @@
     2.4    val add_hook: (transition -> state -> state -> unit) -> unit
     2.5    val transition: bool -> transition -> state -> (state * (exn * string) option) option
     2.6    val command: transition -> state -> state
     2.7 -  val excursion:
     2.8 -    (transition * transition list) list -> (transition * state) list future list * theory
     2.9 +  val proof_result: bool -> transition * transition list -> state ->
    2.10 +    (transition * state) list future * state
    2.11  end;
    2.12  
    2.13  structure Toplevel: TOPLEVEL =
    2.14 @@ -644,7 +644,7 @@
    2.15    in (st', st') end;
    2.16  
    2.17  
    2.18 -(* excursion of units, consisting of commands with proof *)
    2.19 +(* scheduled proof result *)
    2.20  
    2.21  structure States = Proof_Data
    2.22  (
    2.23 @@ -692,12 +692,4 @@
    2.24        in (result, st'') end
    2.25    end;
    2.26  
    2.27 -fun excursion input =
    2.28 -  let
    2.29 -    val end_pos = if null input then error "No input" else pos_of (fst (List.last input));
    2.30 -    val immediate = not (Goal.future_enabled ());
    2.31 -    val (results, end_state) = fold_map (proof_result immediate) input toplevel;
    2.32 -    val thy = end_theory end_pos end_state;
    2.33 -  in (results, thy) end;
    2.34 -
    2.35  end;
     3.1 --- a/src/Pure/Thy/thy_load.ML	Fri Mar 16 13:05:30 2012 +0100
     3.2 +++ b/src/Pure/Thy/thy_load.ML	Fri Mar 16 14:42:11 2012 +0100
     3.3 @@ -168,6 +168,26 @@
     3.4    |> fold (fn (path, true) => Context.theory_map (exec_ml path) o Theory.checkpoint | _ => I) uses
     3.5    |> Theory.checkpoint;
     3.6  
     3.7 +fun excursion init elements =
     3.8 +  let
     3.9 +    val immediate = not (Goal.future_enabled ());
    3.10 +
    3.11 +    fun proof_result (tr, trs) (st, _) =
    3.12 +      let
    3.13 +        val (result, st') = Toplevel.proof_result immediate (tr, trs) st;
    3.14 +        val pos' = Toplevel.pos_of (List.last (tr :: trs));
    3.15 +      in (result, (st', pos')) end;
    3.16 +
    3.17 +    fun element_result elem x =
    3.18 +      fold_map proof_result
    3.19 +        (Outer_Syntax.read_element (#2 (Outer_Syntax.get_syntax ())) init elem) x;
    3.20 +
    3.21 +    val (results, (end_state, end_pos)) =
    3.22 +      fold_map element_result elements (Toplevel.toplevel, Position.none);
    3.23 +
    3.24 +    val thy = Toplevel.end_theory end_pos end_state;
    3.25 +  in (flat results, thy) end;
    3.26 +
    3.27  fun load_thy update_time dir header pos text parents =
    3.28    let
    3.29      val time = ! Toplevel.timing;
    3.30 @@ -179,29 +199,30 @@
    3.31        begin_theory dir header parents
    3.32        |> Present.begin_theory update_time dir uses;
    3.33  
    3.34 -    val (lexs, outer_syntax) = Outer_Syntax.get_syntax ();
    3.35 +    val lexs = Keyword.get_lexicons ();
    3.36  
    3.37      val toks = Thy_Syntax.parse_tokens lexs pos text;
    3.38      val spans = Thy_Syntax.parse_spans toks;
    3.39 -    val elements =
    3.40 -      maps (Outer_Syntax.read_element outer_syntax init) (Thy_Syntax.parse_elements spans);
    3.41 +    val elements = Thy_Syntax.parse_elements spans;
    3.42  
    3.43      val _ = Present.theory_source name
    3.44        (fn () => HTML.html_mode (implode o map Thy_Syntax.present_span) spans);
    3.45  
    3.46      val _ = if time then writeln ("\n**** Starting theory " ^ quote name ^ " ****") else ();
    3.47 -    val (results, thy) = cond_timeit time "" (fn () => Toplevel.excursion elements);
    3.48 +    val (results, thy) = cond_timeit time "" (fn () => excursion init elements);
    3.49      val _ = if time then writeln ("**** Finished theory " ^ quote name ^ " ****\n") else ();
    3.50  
    3.51      val present =
    3.52        singleton (Future.cond_forks {name = "Outer_Syntax.present:" ^ name, group = NONE,
    3.53          deps = map Future.task_of results, pri = 0, interrupts = true})
    3.54        (fn () =>
    3.55 -        Thy_Output.present_thy (#1 lexs) Keyword.command_tags
    3.56 -          (Outer_Syntax.is_markup outer_syntax)
    3.57 -          (maps Future.join results) toks
    3.58 -        |> Buffer.content
    3.59 -        |> Present.theory_output name);
    3.60 +        let val ((minor, _), outer_syntax) = Outer_Syntax.get_syntax () in
    3.61 +          Thy_Output.present_thy minor Keyword.command_tags
    3.62 +            (Outer_Syntax.is_markup outer_syntax)
    3.63 +            (maps Future.join results) toks
    3.64 +          |> Buffer.content
    3.65 +          |> Present.theory_output name
    3.66 +        end);
    3.67  
    3.68    in (thy, present) end;
    3.69