step 4.4: call hierarchy up from Syntax.check_terms, partially
authorWalther Neuper <walther.neuper@jku.at>
Thu, 17 Dec 2020 18:00:27 +0100
changeset 60138209f8c177b5b
parent 60137 12f0c14fc333
child 60139 c3cb65678c47
step 4.4: call hierarchy up from Syntax.check_terms, partially
src/HOL/SPARK/Examples/Gcd/Greatest_Common_Divisor.thy
src/Pure/General/output.ML
src/Pure/Isar/expression.ML
src/Pure/Isar/obtain.ML
src/Pure/Isar/proof.ML
src/Pure/Isar/proof_context.ML
src/Pure/ROOT.ML
src/Pure/Syntax/syntax_phases.ML
src/Pure/Tools/rule_insts.ML
src/Pure/simplifier.ML
     1.1 --- a/src/HOL/SPARK/Examples/Gcd/Greatest_Common_Divisor.thy	Thu Dec 17 11:45:12 2020 +0100
     1.2 +++ b/src/HOL/SPARK/Examples/Gcd/Greatest_Common_Divisor.thy	Thu Dec 17 18:00:27 2020 +0100
     1.3 @@ -27,8 +27,10 @@
     1.4    from \<open>0 \<le> c\<close> \<open>0 < d\<close> \<open>gcd c d = gcd m n\<close> show ?C2
     1.5      by (simp add: sdiv_pos_pos minus_div_mult_eq_mod [symmetric] gcd_non_0_int)
     1.6  qed
     1.7 +
     1.8 +subsection \<open>observing interaction on the proof\<close>
     1.9  text \<open>
    1.10 -  general notes:
    1.11 +  :
    1.12  # Clicks on different positions give different traces.
    1.13  # There are blocks with equal traces (separated by \n or |)
    1.14      proof
    1.15 @@ -44,7 +46,7 @@
    1.16    but both NOT by ...                                      by (rule pos_mod_sign)
    1.17  # Private_Output.report seems to have "" as argument frequently
    1.18  # Output.report provided semantic annotations in Naproche;
    1.19 -  thus ALL calls of Output.report (in src/pure) are traced:
    1.20 +  thus ALL calls of Output.report (in src/Pure) are traced an show up at these elements:
    1.21      proof                                        x  x  .  .  .  
    1.22      from \<open>0 < d\<close>                                 x  .  x  x  x  
    1.23      have "0 \<le> c mod d"                           x  .  x  x  .  
    1.24 @@ -63,7 +65,7 @@
    1.25                                                   Private_Output.report
    1.26  \<close>
    1.27  
    1.28 -subsection \<open>tracing calls of \<close>
    1.29 +subsection \<open>tracing calls of Output.report\<close>
    1.30  text \<open>
    1.31  (*--------- click on "proof -" --------
    1.32  ### Private_Output.report keyword1
    1.33 @@ -74,8 +76,132 @@
    1.34  ### Private_Output.report 
    1.35  ### Token.syntax_generic, Scan.error
    1.36  \<close>
    1.37 +text \<open>
    1.38 +(*--------- click on "from \<open>0 < d\<close>" --------
    1.39 +### Private_Output.report keyword1
    1.40 +### Private_Output.report cartouch
    1.41 +### Private_Output.report delimite
    1.42 +### Private_Output.report entityo
    1.43 +### Syntax_Phases.check_typs
    1.44 +### Private_Output.report 
    1.45 +### Syntax_Phases.check_typs
    1.46 +### Private_Output.report 
    1.47 +### Syntax_Phases.check_terms
    1.48 +### Private_Output.report typingo          =====
    1.49 +### Context_Position.report_generic           //--- different to subsequent part below
    1.50 +### Private_Output.report entityo
    1.51 +\<close>
    1.52 +text \<open>
    1.53 +(*--------- click on "have "0 \<le> c mod d"" --------
    1.54 +### Private_Output.report keyword1
    1.55 +### Private_Output.report 
    1.56 +### Private_Output.report cartouch
    1.57 +### Private_Output.report delimite
    1.58 +### Private_Output.report entityo
    1.59 +### Syntax_Phases.check_typs
    1.60 +### Private_Output.report 
    1.61 +### Syntax_Phases.check_typs
    1.62 +### Private_Output.report 
    1.63 +### Syntax_Phases.check_terms
    1.64 +### Private_Output.report typingo          =====
    1.65 +### Syntax_Phases.check_typs                  //--- different to previous part above
    1.66 +### Private_Output.report 
    1.67 +### Syntax_Phases.check_terms
    1.68 +### Private_Output.report 
    1.69 +\<close>
    1.70 +
    1.71 +subsection \<open>signatures of the traced callers of Private_Output.report\<close>
    1.72 +ML \<open>
    1.73 +\<close> ML \<open>
    1.74 +Private_Output.report          : string(*= markup*) list                   -> unit; 
    1.75 +Context_Position.report_generic: Context.generic -> Position.T -> Markup.T -> unit;
    1.76 +Token.syntax_generic           : 'a Token.context_parser -> Token.src -> Context.generic ->
    1.77 +                                   'a * Context.generic;
    1.78 +(*Syntax_Phases.check_typs     : Proof.context -> typ list -> typ list;    ..local*)
    1.79 +(*Syntax_Phases.check_terms    : Proof.context -> term list -> term list;  ..local*)
    1.80 +\<close> ML \<open>
    1.81 +\<close>
    1.82 +
    1.83 +subsection \<open>lookup calls of Syntax_Phases.check_terms\<close>
    1.84 +text \<open>
    1.85 +  focus are    "from \<open>0 < d\<close>"   and   have "0 \<le> c mod d".
    1.86 +
    1.87 +  encapsulation?:
    1.88 +    Syntax_Phases.check_terms NOwhere in src/Pure,
    1.89 +    check_terms occurs in Theory.setup (Syntax.install_operations {..check_terms = check_terms..}
    1.90 +    and nowhere else (except fun check_props)
    1.91 +  so the calls are Syntax.check_terms ? -- NO: calls.1..4 --vv pop up in NONE of the 3 traces above.
    1.92 +                                           ^^^^^^^^^^^^^^^     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1.93 +  but they seem to be identical:
    1.94 +    Syntax_Phases.check_terms: Proof.context -> term list -> term list;
    1.95 +           Syntax.check_terms: Proof.context -> term list -> term list;
    1.96 +    ?! there are 3-times structure Syntax:
    1.97 +      Pure/Syntax/lexicon.ML                      /NO check_terms/
    1.98 +        signature LEXICON = sig structure Syntax: sig val const: string -> term ..
    1.99 +      Pure/Syntax/syntax.ML 
   1.100 +        type operations = {..., ..., check_terms: Proof.context -> term list -> term list, ..
   1.101 +        val check_terms = operation #check_terms;
   1.102 +      Pure/Syntax/syntax_trans.ML                 /NO check_terms/
   1.103 +        
   1.104 +  the ASSUMED callers of Syntax.check_terms:
   1.105 +//  Pure/Isar/expression.ML
   1.106 +//    1,val inst_morphism: (string * typ) list -> (string * bool) * term list -> Proof.context ->
   1.107 +//        morphism * Proof.context
   1.108 +//    2.val check_autofix:
   1.109 +//        ('a * ('b * term list)) list ->
   1.110 +//          ('c * term) list list ->
   1.111 +//            (typ, term, 'd) ctxt list ->
   1.112 +//              ('e * (term * term list) list) list -> Proof.context ->
   1.113 +//        (('a * ('b * term list)) list * ('c * term) list list * (typ, term, 'd) ctxt list *
   1.114 +//          ('e * (term * term list) list) list) * Proof.context
   1.115 +//        val check: (term * term list) list -> Proof.context ->
   1.116 +//          (term * term list) list * Proof.context
   1.117 +//  Pure/Isar/obtain.ML
   1.118 +//    3.val Obtain.read_obtains: Proof.context -> term -> Element.obtains -> (binding * term) list 
   1.119 +//  Pure/Isar/proof.ML
   1.120 +//    4.val let_bind: (term list * term) list -> state -> state
   1.121 +//    5.val let_bind_cmd: (string list * string) list -> state -> state
   1.122 +//        val read_terms: context -> typ -> string list -> term list
   1.123 +//  Pure/Isar/proof_context.ML
   1.124 +//    6.val infer_type: Proof.context -> string * typ -> typ
   1.125 +//  Pure/simplifier.ML
   1.126 +//    7.val Simplifier.define_simproc: binding -> term Simplifier.simproc_spec ->
   1.127 +//        local_theory -> local_theory
   1.128 +//  Pure/Tools/rule_insts.ML
   1.129 +//    8.val Rule_Insts.read_term: string -> Proof.context -> term * Proof.context
   1.130 +//    :
   1.131 +//    1.. looked up in the sequel
   1.132 +\<close>
   1.133 +subsection \<open>lookup Syntax.check_terms -> *1..4\<close>
   1.134 +text \<open>\<close>
   1.135 +
   1.136 +subsubsection \<open>lookup 1* -> Expression.inst_morphism\<close>
   1.137 +text \<open>\<close>
   1.138 +
   1.139 +subsubsection \<open>lookup 2* -> Expression.check_autofix\<close>
   1.140 +text \<open>
   1.141 +\<close> 
   1.142 +subsubsection \<open>lookup 3* -> Obtain.read_obtains\<close>
   1.143 +text \<open>\<close>
   1.144 +
   1.145 +subsubsection \<open>lookup 4* -> Proof.let_bind\<close>
   1.146 +text \<open>\<close>
   1.147 +
   1.148 +subsubsection \<open>lookup 5* -> Proof.let_bind_cmd\<close>
   1.149 +text \<open>\<close>
   1.150 +
   1.151 +subsubsection \<open>lookup 6* -> Proof_Context.infer_type\<close>
   1.152 +text \<open>\<close>
   1.153 +
   1.154 +subsubsection \<open>lookup 7* -> Simplifier.define_simproc\<close>
   1.155 +text \<open>\<close>
   1.156 +
   1.157 +subsubsection \<open>lookup 8* -> Rule_Insts.read_term\<close>
   1.158 +text \<open>\<close>
   1.159 +
   1.160  
   1.161  section \<open>example 2\<close>
   1.162 +
   1.163  spark_vc procedure_g_c_d_11 (*..select 2nd VC for proof: *)
   1.164  proof -
   1.165    from \<open>0 \<le> c\<close> \<open>0 < d\<close> \<open>c - c sdiv d * d = 0\<close>
     2.1 --- a/src/Pure/General/output.ML	Thu Dec 17 11:45:12 2020 +0100
     2.2 +++ b/src/Pure/General/output.ML	Thu Dec 17 18:00:27 2020 +0100
     2.3 @@ -159,7 +159,7 @@
     2.4  fun report ss = ! report_fn (map output ss);
     2.5  fun report ss =
     2.6  ((** )@{print} {a = "### Private_Output.report"};( *..not yet available*)
     2.7 - (**)writeln ("### Private_Output.report " (**)^ (ss |> cat_lines |> cut_string 10)(**));
     2.8 + (** )writeln ("### Private_Output.report " (**)^ (ss |> cat_lines |> cut_string 10));( **)
     2.9   (* HOL build fails with greater length ----------------------------------------^^ *)
    2.10    ! report_fn (map output ss)
    2.11  );
     3.1 --- a/src/Pure/Isar/expression.ML	Thu Dec 17 11:45:12 2020 +0100
     3.2 +++ b/src/Pure/Isar/expression.ML	Thu Dec 17 18:00:27 2020 +0100
     3.3 @@ -44,7 +44,7 @@
     3.4      (term list list * term list list * (string * morphism) list * (Attrib.binding * term) list list * morphism) * Proof.context
     3.5  end;
     3.6  
     3.7 -structure Expression : EXPRESSION =
     3.8 +structure Expression (**): EXPRESSION(**) =
     3.9  struct
    3.10  
    3.11  datatype ctxt = datatype Element.ctxt;
    3.12 @@ -166,10 +166,13 @@
    3.13  
    3.14  (* Instantiation morphism *)
    3.15  
    3.16 +(*val inst_morphism: (string * typ) list -> (string * bool) * term list -> Proof.context ->
    3.17 +        morphism * Proof.context*)
    3.18  fun inst_morphism params ((prfx, mandatory), insts') ctxt =
    3.19    let
    3.20 +    val _ = writeln "#### Expression.inst_morphism";
    3.21      (* parameters *)
    3.22 -    val parm_types = map #2 params;
    3.23 +    val parm_types = map #2 (params: (string * typ) list);
    3.24      val type_parms = fold Term.add_tfreesT parm_types [];
    3.25  
    3.26      (* type inference *)
    3.27 @@ -226,7 +229,7 @@
    3.28  
    3.29  (** Simultaneous type inference: instantiations + elements + statement **)
    3.30  
    3.31 -local
    3.32 +(**)local(**)
    3.33  
    3.34  fun mk_type T = (Logic.mk_type T, []);
    3.35  fun mk_term t = (t, []);
    3.36 @@ -269,6 +272,11 @@
    3.37        (ctxt', ts))
    3.38    end;
    3.39  
    3.40 +(*WN*)
    3.41 +
    3.42 +(*WN*)
    3.43 +(* val check: (term * term list) list -> Proof.context ->
    3.44 +      (term * term list) list * Proof.context *)
    3.45  fun check cs ctxt =
    3.46    let
    3.47      val (cs', (ctxt', _)) = fold_map prep cs
    3.48 @@ -276,10 +284,11 @@
    3.49          (Proof_Context.set_mode Proof_Context.mode_schematic ctxt) (map fst cs));
    3.50    in (cs', ctxt') end;
    3.51  
    3.52 -in
    3.53 +(**)in(**)
    3.54  
    3.55  fun check_autofix insts eqnss elems concl ctxt =
    3.56    let
    3.57 +    val _ = writeln "#### Expression.check_autofix";
    3.58      val inst_cs = map extract_inst insts;
    3.59      val eqns_cs = map extract_eqns eqnss;
    3.60      val elem_css = map extract_elem elems;
    3.61 @@ -295,7 +304,7 @@
    3.62        map fst concl ~~ concl_cs'), ctxt')
    3.63    end;
    3.64  
    3.65 -end;
    3.66 +(**)end;(**)
    3.67  
    3.68  
    3.69  (** Prepare locale elements **)
     4.1 --- a/src/Pure/Isar/obtain.ML	Thu Dec 17 11:45:12 2020 +0100
     4.2 +++ b/src/Pure/Isar/obtain.ML	Thu Dec 17 18:00:27 2020 +0100
     4.3 @@ -131,9 +131,11 @@
     4.4  val parse_clause = prepare_clause Proof_Context.read_var Syntax.parse_prop mk_all_external;
     4.5  val cert_clause = prepare_clause Proof_Context.cert_var (K I) mk_all_internal;
     4.6  
     4.7 -in
     4.8 +in                              
     4.9  
    4.10 -val read_obtains = prepare_obtains parse_clause Syntax.check_terms;
    4.11 +val read_obtains =
    4.12 +  (writeln "#### Obtain.read_obtains";
    4.13 +    prepare_obtains parse_clause Syntax.check_terms);
    4.14  val cert_obtains = prepare_obtains cert_clause (K I);
    4.15  val parse_obtains = prepare_obtains parse_clause (K I);
    4.16  
     5.1 --- a/src/Pure/Isar/proof.ML	Thu Dec 17 11:45:12 2020 +0100
     5.2 +++ b/src/Pure/Isar/proof.ML	Thu Dec 17 18:00:27 2020 +0100
     5.3 @@ -146,7 +146,7 @@
     5.4    val global_future_terminal_proof: Method.text_range * Method.text_range option -> state -> context
     5.5  end;
     5.6  
     5.7 -structure Proof: PROOF =
     5.8 +structure Proof(**): PROOF(**) =
     5.9  struct
    5.10  
    5.11  type context = Proof.context;
    5.12 @@ -557,7 +557,7 @@
    5.13  
    5.14  (* let bindings *)
    5.15  
    5.16 -local
    5.17 +(**)local(**)
    5.18  
    5.19  fun gen_bind prep_terms raw_binds =
    5.20    assert_forward #> map_context (fn ctxt =>
    5.21 @@ -582,15 +582,22 @@
    5.22      in ctxt'' end)
    5.23    #> reset_facts;
    5.24  
    5.25 +(*val read_terms: context -> typ -> string list -> term list*)
    5.26  fun read_terms ctxt T =
    5.27    map (Syntax.parse_term ctxt #> Type.constraint T) #> Syntax.check_terms ctxt;
    5.28  
    5.29 -in
    5.30 +(**)in(**)
    5.31  
    5.32 -val let_bind = gen_bind (fn ctxt => fn _ => map (Proof_Context.cert_term ctxt));
    5.33 -val let_bind_cmd = gen_bind read_terms;
    5.34 +(*val let_bind: (term list * term) list -> state -> state*)
    5.35 +val let_bind =
    5.36 +  (writeln "#### Proof.let_bind";
    5.37 +    gen_bind (fn ctxt => fn _ => map (Proof_Context.cert_term ctxt)));
    5.38 +(*val let_bind_cmd: (string list * string) list -> state -> state*)
    5.39 +val let_bind_cmd =
    5.40 +  (writeln "#### Proof.let_bind_cmd";
    5.41 +    gen_bind read_terms);
    5.42  
    5.43 -end;
    5.44 +(**)end;(**)
    5.45  
    5.46  
    5.47  (* concrete syntax *)
     6.1 --- a/src/Pure/Isar/proof_context.ML	Thu Dec 17 11:45:12 2020 +0100
     6.2 +++ b/src/Pure/Isar/proof_context.ML	Thu Dec 17 18:00:27 2020 +0100
     6.3 @@ -504,7 +504,8 @@
     6.4  (* inferred types of parameters *)
     6.5  
     6.6  fun infer_type ctxt x =
     6.7 -  Term.fastype_of (singleton (Syntax.check_terms (set_mode mode_schematic ctxt)) (Free x));
     6.8 +  (writeln "#### Proof_Context.infer_type";
     6.9 +    Term.fastype_of (singleton (Syntax.check_terms (set_mode mode_schematic ctxt)) (Free x)));
    6.10  
    6.11  fun inferred_param x ctxt =
    6.12    let val p = (x, infer_type ctxt (x, dummyT))
     7.1 --- a/src/Pure/ROOT.ML	Thu Dec 17 11:45:12 2020 +0100
     7.2 +++ b/src/Pure/ROOT.ML	Thu Dec 17 18:00:27 2020 +0100
     7.3 @@ -355,3 +355,10 @@
     7.4  ML_file "Tools/jedit.ML";
     7.5  ML_file "Tools/ghc.ML";
     7.6  ML_file "Tools/generated_files.ML"
     7.7 +(* NOT during bootstrap -----------------------\\
     7.8 +ML \<open>
     7.9 +\<close> ML \<open>
    7.10 +\<close> ML \<open>
    7.11 +\<close> ML \<open>
    7.12 +\<close>
    7.13 +\\---------------------------------------------//*)
    7.14 \ No newline at end of file
     8.1 --- a/src/Pure/Syntax/syntax_phases.ML	Thu Dec 17 11:45:12 2020 +0100
     8.2 +++ b/src/Pure/Syntax/syntax_phases.ML	Thu Dec 17 18:00:27 2020 +0100
     8.3 @@ -37,7 +37,7 @@
     8.4      Context.generic -> Context.generic
     8.5  end
     8.6  
     8.7 -structure Syntax_Phases: SYNTAX_PHASES =
     8.8 +structure Syntax_Phases(**): SYNTAX_PHASES(**) =
     8.9  struct
    8.10  
    8.11  (** markup logical entities **)
    8.12 @@ -972,6 +972,7 @@
    8.13      |> Term_Sharing.typs (Proof_Context.theory_of ctxt)
    8.14    end;
    8.15  
    8.16 +(*  Syntax_Phases.check_terms: Proof.context -> term list -> term list*)
    8.17  fun check_terms ctxt raw_ts =
    8.18    let
    8.19      val (sorting_report, raw_ts') = Proof_Context.prepare_sorts ctxt raw_ts;
    8.20 @@ -992,7 +993,7 @@
    8.21        if Context_Position.is_visible ctxt
    8.22        then
    8.23          ((** )@{print} {a = "### Syntax_Phases.check_terms"};( *..NOT yet available 2 *)
    8.24 -         (**) writeln "### Syntax_Phases.check_terms";(**)
    8.25 +         (**)writeln "### Syntax_Phases.check_terms";(**)
    8.26            Output.report (sorting_report @ typing_report))
    8.27        else ();
    8.28    in Term_Sharing.terms (Proof_Context.theory_of ctxt) ts' end;
     9.1 --- a/src/Pure/Tools/rule_insts.ML	Thu Dec 17 11:45:12 2020 +0100
     9.2 +++ b/src/Pure/Tools/rule_insts.ML	Thu Dec 17 18:00:27 2020 +0100
     9.3 @@ -42,12 +42,12 @@
     9.4      (Proof.context -> Proof.method) context_parser
     9.5  end;
     9.6  
     9.7 -structure Rule_Insts: RULE_INSTS =
     9.8 +structure Rule_Insts(**): RULE_INSTS(**) =
     9.9  struct
    9.10  
    9.11  (** read instantiations **)
    9.12  
    9.13 -local
    9.14 +(**)local(**)
    9.15  
    9.16  fun error_var msg (xi, pos) =
    9.17    error (msg ^ quote (Term.string_of_vname xi) ^ Position.here pos);
    9.18 @@ -83,8 +83,11 @@
    9.19      val t' = f t;
    9.20    in if t aconv t' then NONE else SOME (v, t') end;
    9.21  
    9.22 +(*   read_terms: string list -> typ list -> Proof.context ->
    9.23 +        (term list * ((Vartab.key * sort) * typ) list) * Proof.context*)
    9.24  fun read_terms ss Ts ctxt =
    9.25    let
    9.26 +    val _ = writeln "#### Rule_Insts.read_terms";
    9.27      fun parse T = if T = propT then Syntax.parse_prop ctxt else Syntax.parse_term ctxt;
    9.28      val (ts, ctxt') = fold_map Variable.fix_dummy_patterns (map2 parse Ts ss) ctxt;
    9.29      val ts' =
    9.30 @@ -96,10 +99,12 @@
    9.31      val tyenv' = Vartab.fold (fn (xi, (S, T)) => cons ((xi, S), T)) tyenv [];
    9.32    in ((ts', tyenv'), ctxt') end;
    9.33  
    9.34 -in
    9.35 +(**)in(**)
    9.36  
    9.37 +(*  read_term: string -> Proof.context -> term * Proof.context*)
    9.38  fun read_term s ctxt =
    9.39    let
    9.40 +    val _ = writeln "#### Rule_Insts.read_term";
    9.41      val (t, ctxt') = Variable.fix_dummy_patterns (Syntax.parse_term ctxt s) ctxt;
    9.42      val t' = Syntax.check_term ctxt' t;
    9.43    in (t', ctxt') end;
    9.44 @@ -138,7 +143,7 @@
    9.45      val inst_vars = map_filter (make_inst inst2) vars2;
    9.46    in ((inst_tvars, inst_vars), ctxt2) end;
    9.47  
    9.48 -end;
    9.49 +(**)end;(**)
    9.50  
    9.51  
    9.52  
    10.1 --- a/src/Pure/simplifier.ML	Thu Dec 17 11:45:12 2020 +0100
    10.2 +++ b/src/Pure/simplifier.ML	Thu Dec 17 18:00:27 2020 +0100
    10.3 @@ -152,7 +152,9 @@
    10.4  
    10.5  in
    10.6  
    10.7 -val define_simproc = def_simproc Syntax.check_terms;
    10.8 +val define_simproc =
    10.9 +  (writeln "#### Simplifier.define_simproc";
   10.10 +    def_simproc Syntax.check_terms);
   10.11  val define_simproc_cmd = def_simproc Syntax.read_terms;
   10.12  
   10.13  end;