clarified input source;
authorwenzelm
Tue, 24 Mar 2015 11:53:18 +0100
changeset 59795 d453c69596cc
parent 59792 f19f4afa49e2
child 59796 f05ef8c62e4f
clarified input source;
src/Pure/Isar/proof_context.ML
src/Pure/Isar/token.ML
src/Pure/PIDE/markup.ML
src/Pure/Syntax/syntax.ML
src/Pure/Syntax/syntax_phases.ML
src/Tools/Code/code_thingol.ML
src/Tools/induct_tacs.ML
--- a/src/Pure/Isar/proof_context.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Pure/Isar/proof_context.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -412,7 +412,7 @@
 
 fun read_class ctxt text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (c, reports) = check_class ctxt (Input.source_content source, Input.pos_of source);
     val _ = Position.reports reports;
   in c end;
@@ -480,7 +480,7 @@
 
 fun read_type_name ctxt flags text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (T, reports) =
       check_type_name ctxt flags (Input.source_content source, Input.pos_of source);
     val _ = Position.reports reports;
@@ -530,7 +530,7 @@
 
 fun read_const ctxt flags text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (t, reports) = check_const ctxt flags (Input.source_content source, [Input.pos_of source]);
     val _ = Position.reports reports;
   in t end;
@@ -945,7 +945,7 @@
 fun retrieve pick context (Facts.Fact s) =
       let
         val ctxt = Context.the_proof context;
-        val pos = Syntax.read_token_pos s;
+        val pos = Syntax.read_input_pos s;
         val prop =
           Syntax.read_prop (ctxt |> set_mode mode_default |> allow_dummies) s
           |> singleton (Variable.polymorphic ctxt);
--- a/src/Pure/Isar/token.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Pure/Isar/token.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -55,9 +55,9 @@
   val is_space: T -> bool
   val is_blank: T -> bool
   val is_newline: T -> bool
-  val inner_syntax_of: T -> string
+  val content_of: T -> string
   val source_position_of: T -> Input.source
-  val content_of: T -> string
+  val inner_syntax_of: T -> string
   val keyword_markup: bool * Markup.T -> string -> Markup.T
   val completion_report: T -> Position.report_text list
   val reports: Keyword.keywords -> T -> Position.report_text list
@@ -279,18 +279,14 @@
 
 (* token content *)
 
-fun inner_syntax_of (Token ((source, (pos, _)), (kind, x), _)) =
-  if YXML.detect x then x
-  else
-    let
-      val delimited = delimited_kind kind;
-      val tree = XML.Elem (Markup.token delimited (Position.properties_of pos), [XML.Text source]);
-    in YXML.string_of tree end;
+fun content_of (Token (_, (_, x), _)) = x;
 
 fun source_position_of (Token ((source, range), (kind, _), _)) =
   Input.source (delimited_kind kind) source range;
 
-fun content_of (Token (_, (_, x), _)) = x;
+fun inner_syntax_of tok =
+  let val x = content_of tok
+  in if YXML.detect x then x else Syntax.implode_input (source_position_of tok) end;
 
 
 (* markup reports *)
--- a/src/Pure/PIDE/markup.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Pure/PIDE/markup.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -114,13 +114,13 @@
   val document_antiquotation_optionN: string
   val paragraphN: string val paragraph: T
   val text_foldN: string val text_fold: T
+  val inputN: string val input: bool -> Properties.T -> T
   val commandN: string val command: T
   val stringN: string val string: T
   val alt_stringN: string val alt_string: T
   val verbatimN: string val verbatim: T
   val cartoucheN: string val cartouche: T
   val commentN: string val comment: T
-  val tokenN: string val token: bool -> Properties.T -> T
   val keyword1N: string val keyword1: T
   val keyword2N: string val keyword2: T
   val keyword3N: string val keyword3: T
@@ -456,6 +456,12 @@
 val (text_foldN, text_fold) = markup_elem "text_fold";
 
 
+(* formal input *)
+
+val inputN = "input";
+fun input delimited props = (inputN, (delimitedN, print_bool delimited) :: props);
+
+
 (* outer syntax *)
 
 val (commandN, command) = markup_elem "command";
@@ -471,9 +477,6 @@
 val (cartoucheN, cartouche) = markup_elem "cartouche";
 val (commentN, comment) = markup_elem "comment";
 
-val tokenN = "token";
-fun token delimited props = (tokenN, (delimitedN, print_bool delimited) :: props);
-
 
 (* timing *)
 
--- a/src/Pure/Syntax/syntax.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Pure/Syntax/syntax.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -14,9 +14,11 @@
   val ambiguity_warning: bool Config.T
   val ambiguity_limit_raw: Config.raw
   val ambiguity_limit: int Config.T
-  val read_token_pos: string -> Position.T
-  val read_token: string -> Input.source
-  val parse_token: Proof.context -> (XML.tree list -> 'a) ->
+  val encode_input: Input.source -> XML.tree
+  val implode_input: Input.source -> string
+  val read_input_pos: string -> Position.T
+  val read_input: string -> Input.source
+  val parse_input: Proof.context -> (XML.tree list -> 'a) ->
     (bool -> Markup.T) -> (Symbol_Pos.T list * Position.T -> 'a) -> string -> 'a
   val parse_sort: Proof.context -> string -> sort
   val parse_typ: Proof.context -> string -> typ
@@ -159,33 +161,42 @@
 val ambiguity_limit = Config.int ambiguity_limit_raw;
 
 
-(* outer syntax token -- with optional YXML content *)
+(* formal input *)
+
+fun encode_input source =
+  let
+    val delimited = Input.is_delimited source;
+    val pos = Input.pos_of source;
+    val text = Input.text_of source;
+  in XML.Elem (Markup.input delimited (Position.properties_of pos), [XML.Text text]) end;
+
+val implode_input = encode_input #> YXML.string_of;
 
 local
 
-fun token_range (XML.Elem ((name, props), _)) =
-      if name = Markup.tokenN
+fun input_range (XML.Elem ((name, props), _)) =
+      if name = Markup.inputN
       then (Markup.is_delimited props, Position.range_of_properties props)
       else (false, Position.no_range)
-  | token_range (XML.Text _) = (false, Position.no_range);
+  | input_range (XML.Text _) = (false, Position.no_range);
 
-fun token_source tree : Input.source =
+fun input_source tree =
   let
     val text = XML.content_of [tree];
-    val (delimited, range) = token_range tree;
+    val (delimited, range) = input_range tree;
   in Input.source delimited text range end;
 
 in
 
-fun read_token_pos str = #1 (#2 (token_range (YXML.parse str handle Fail msg => error msg)));
+fun read_input_pos str = #1 (#2 (input_range (YXML.parse str handle Fail msg => error msg)));
 
-fun read_token str = token_source (YXML.parse str handle Fail msg => error msg);
+fun read_input str = input_source (YXML.parse str handle Fail msg => error msg);
 
-fun parse_token ctxt decode markup parse str =
+fun parse_input ctxt decode markup parse str =
   let
     fun parse_tree tree =
       let
-        val source = token_source tree;
+        val source = input_source tree;
         val syms = Input.source_explode source;
         val pos = Input.pos_of source;
         val _ = Context_Position.report ctxt pos (markup (Input.is_delimited source));
@@ -193,7 +204,7 @@
   in
     (case YXML.parse_body str handle Fail msg => error msg of
       body as [tree as XML.Elem ((name, _), _)] =>
-        if name = Markup.tokenN then parse_tree tree else decode body
+        if name = Markup.inputN then parse_tree tree else decode body
     | [tree as XML.Text _] => parse_tree tree
     | body => decode body)
   end;
--- a/src/Pure/Syntax/syntax_phases.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -365,7 +365,7 @@
     Markup.markup_report (Context_Position.reported_text ctxt pos Markup.bad ""));
 
 fun parse_sort ctxt =
-  Syntax.parse_token ctxt Term_XML.Decode.sort Markup.language_sort
+  Syntax.parse_input ctxt Term_XML.Decode.sort Markup.language_sort
     (fn (syms, pos) =>
       parse_tree ctxt "sort" (syms, pos)
       |> uncurry (report_result ctxt pos)
@@ -374,7 +374,7 @@
       handle ERROR msg => parse_failed ctxt pos msg "sort");
 
 fun parse_typ ctxt =
-  Syntax.parse_token ctxt Term_XML.Decode.typ Markup.language_type
+  Syntax.parse_input ctxt Term_XML.Decode.typ Markup.language_type
     (fn (syms, pos) =>
       parse_tree ctxt "type" (syms, pos)
       |> uncurry (report_result ctxt pos)
@@ -389,7 +389,7 @@
       else (Markup.language_term, "term", Config.get ctxt Syntax.root, I);
     val decode = constrain o Term_XML.Decode.term;
   in
-    Syntax.parse_token ctxt decode markup
+    Syntax.parse_input ctxt decode markup
       (fn (syms, pos) =>
         let
           val (ambig_msgs, results) = parse_tree ctxt root (syms, pos) ||> map (decode_term ctxt);
@@ -463,7 +463,7 @@
           else decode_appl ps asts
       | decode ps (Ast.Appl asts) = decode_appl ps asts;
 
-    val source = Syntax.read_token str;
+    val source = Syntax.read_input str;
     val pos = Input.pos_of source;
     val syms = Input.source_explode source;
     val ast =
--- a/src/Tools/Code/code_thingol.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Tools/Code/code_thingol.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -895,7 +895,7 @@
       (fn thy'' => not (Sign.declared_const thy'' c)) (Theory.parents_of thy');
     fun consts_of_select thy' = filter (belongs_here thy') (consts_of thy');
     fun read_const_expr str =
-      (case Syntax.parse_token ctxt (K NONE) (K Markup.empty) (SOME o Symbol_Pos.implode o #1) str of
+      (case Syntax.parse_input ctxt (K NONE) (K Markup.empty) (SOME o Symbol_Pos.implode o #1) str of
         SOME "_" => ([], consts_of thy)
       | SOME s =>
           if String.isSuffix "._" s
@@ -910,7 +910,7 @@
   let
     val (consts, consts_permissive) = read_const_exprs_internal ctxt const_exprs;
     val consts' = implemented_deps
-      (consts_program_permissive ((Proof_Context.theory_of ctxt)) consts_permissive);
+      (consts_program_permissive (Proof_Context.theory_of ctxt) consts_permissive);
   in union (op =) consts' consts end;
 
 
--- a/src/Tools/induct_tacs.ML	Mon Mar 23 23:16:40 2015 +0100
+++ b/src/Tools/induct_tacs.ML	Tue Mar 24 11:53:18 2015 +0100
@@ -35,7 +35,7 @@
       | NONE =>
           (case Induct.find_casesT ctxt
               (#2 (check_type ctxt (Proof_Context.read_term_schematic ctxt s,
-                Syntax.read_token_pos s))) of
+                Syntax.read_input_pos s))) of
             rule :: _ => rule
           | [] => @{thm case_split}));
     val _ = Method.trace ctxt [rule];
@@ -72,7 +72,7 @@
     fun induct_var name =
       let
         val t = Syntax.read_term ctxt name;
-        val pos = Syntax.read_token_pos name;
+        val pos = Syntax.read_input_pos name;
         val (x, _) = Term.dest_Free t handle TERM _ =>
           error ("Induction argument not a variable: " ^
             quote (Syntax.string_of_term ctxt t) ^ Position.here pos);