eliminated odd type constraint for read_const (see also 79c1d2bbe5a9);
authorwenzelm
Thu, 06 Mar 2014 14:38:54 +0100
changeset 55955 e8f1bf005661
parent 55954 a29aefc88c8d
child 55956 94d384d621b0
eliminated odd type constraint for read_const (see also 79c1d2bbe5a9);
src/Doc/ProgProve/LaTeXsugar.thy
src/HOL/Library/LaTeXsugar.thy
src/HOL/Tools/Datatype/rep_datatype.ML
src/Pure/Isar/args.ML
src/Pure/Isar/proof.ML
src/Pure/Isar/proof_context.ML
src/Pure/Isar/specification.ML
src/Pure/ML/ml_antiquote.ML
src/Pure/Syntax/syntax_phases.ML
src/Tools/adhoc_overloading.ML
--- a/src/Doc/ProgProve/LaTeXsugar.thy	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Doc/ProgProve/LaTeXsugar.thy	Thu Mar 06 14:38:54 2014 +0100
@@ -46,7 +46,7 @@
 setup{*
   let
     fun pretty ctxt c =
-      let val tc = Proof_Context.read_const ctxt {proper = true, strict = false} dummyT c
+      let val tc = Proof_Context.read_const ctxt {proper = true, strict = false} c
       in Pretty.block [Thy_Output.pretty_term ctxt tc, Pretty.str " ::",
             Pretty.brk 1, Syntax.pretty_typ ctxt (fastype_of tc)]
       end
--- a/src/HOL/Library/LaTeXsugar.thy	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/HOL/Library/LaTeXsugar.thy	Thu Mar 06 14:38:54 2014 +0100
@@ -100,7 +100,7 @@
 setup{*
   let
     fun pretty ctxt c =
-      let val tc = Proof_Context.read_const ctxt {proper = true, strict = false} dummyT c
+      let val tc = Proof_Context.read_const ctxt {proper = true, strict = false} c
       in Pretty.block [Thy_Output.pretty_term ctxt tc, Pretty.str " ::",
             Pretty.brk 1, Syntax.pretty_typ ctxt (fastype_of tc)]
       end
--- a/src/HOL/Tools/Datatype/rep_datatype.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/HOL/Tools/Datatype/rep_datatype.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -535,9 +535,9 @@
 
     val ctxt = Proof_Context.init_global thy9;
     val case_combs =
-      map (Proof_Context.read_const ctxt {proper = false, strict = false} dummyT) case_names;
+      map (Proof_Context.read_const ctxt {proper = false, strict = false}) case_names;
     val constrss = map (fn (dtname, {descr, index, ...}) =>
-      map (Proof_Context.read_const ctxt {proper = false, strict = false} dummyT o fst)
+      map (Proof_Context.read_const ctxt {proper = false, strict = false} o fst)
         (#3 (the (AList.lookup op = descr index)))) dt_infos;
   in
     thy9
--- a/src/Pure/Isar/args.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/Isar/args.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -212,7 +212,7 @@
   >> (fn Type (c, _) => c | TFree (a, _) => a | _ => "");
 
 fun const flags =
-  Scan.peek (fn ctxt => named_term (Proof_Context.read_const (Context.proof_of ctxt) flags dummyT))
+  Scan.peek (fn ctxt => named_term (Proof_Context.read_const (Context.proof_of ctxt) flags))
   >> (fn Const (c, _) => c | Free (x, _) => x | _ => "");
 
 
--- a/src/Pure/Isar/proof.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/Isar/proof.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -575,13 +575,17 @@
   #> map_context (fn ctxt => ctxt |> Proof_Context.notation true mode (map (prep_arg ctxt) args))
   #> reset_facts;
 
+fun read_arg ctxt (c, mx) =
+  (case Proof_Context.read_const ctxt {proper = false, strict = false} c of
+    Free (x, _) =>
+      let val T = Proof_Context.infer_type ctxt (x, Mixfix.mixfixT mx)
+      in (Free (x, T), mx) end
+  | t => (t, mx));
+
 in
 
 val write = gen_write (K I);
-
-val write_cmd =
-  gen_write (fn ctxt => fn (c, mx) =>
-    (Proof_Context.read_const ctxt {proper = false, strict = false} (Mixfix.mixfixT mx) c, mx));
+val write_cmd = gen_write read_arg;
 
 end;
 
--- a/src/Pure/Isar/proof_context.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/Isar/proof_context.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -72,8 +72,8 @@
     xstring * Position.T -> typ * Position.report list
   val read_type_name: Proof.context -> {proper: bool, strict: bool} -> string -> typ
   val check_const: Proof.context -> {proper: bool, strict: bool} ->
-    typ -> xstring * Position.T -> term * Position.report list
-  val read_const: Proof.context -> {proper: bool, strict: bool} -> typ -> string -> term
+    xstring * Position.T -> term * Position.report list
+  val read_const: Proof.context -> {proper: bool, strict: bool} -> string -> term
   val read_arity: Proof.context -> xstring * string list * string -> arity
   val cert_arity: Proof.context -> arity -> arity
   val allow_dummies: Proof.context -> Proof.context
@@ -469,7 +469,7 @@
 
 (* constant names *)
 
-fun check_const ctxt {proper, strict} ty (c, pos) =
+fun check_const ctxt {proper, strict} (c, pos) =
   let
     fun err msg = error (msg ^ Position.here pos);
     val consts = consts_of ctxt;
@@ -483,7 +483,7 @@
               if Context_Position.is_reported ctxt pos then
                 [(pos, Markup.name x (if Name.is_skolem x then Markup.skolem else Markup.free))]
               else [];
-          in (Free (x, infer_type ctxt (x, ty)), reports) end
+          in (Free (x, infer_type ctxt (x, dummyT)), reports) end
       | (_, SOME d) =>
           let
             val T = Consts.type_scheme consts d handle TYPE (msg, _, _) => err msg;
@@ -499,10 +499,10 @@
       | _ => ());
   in (t, reports) end;
 
-fun read_const ctxt flags ty text =
+fun read_const ctxt flags text =
   let
     val (t, reports) =
-      check_const ctxt flags ty (Symbol_Pos.source_content (Syntax.read_token text));
+      check_const ctxt flags (Symbol_Pos.source_content (Syntax.read_token text));
     val _ = Position.reports reports;
   in t end;
 
--- a/src/Pure/Isar/specification.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/Isar/specification.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -281,7 +281,7 @@
 
 val notation = gen_notation (K I);
 val notation_cmd =
-  gen_notation (fn ctxt => Proof_Context.read_const ctxt {proper = false, strict = false} dummyT);
+  gen_notation (fn ctxt => Proof_Context.read_const ctxt {proper = false, strict = false});
 
 end;
 
--- a/src/Pure/ML/ml_antiquote.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/ML/ml_antiquote.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -151,7 +151,7 @@
 fun const_name check = Args.context -- Scan.lift (Parse.position Args.name_inner_syntax)
   >> (fn (ctxt, (s, pos)) =>
     let
-      val Const (c, _) = Proof_Context.read_const ctxt {proper = true, strict = false} dummyT s;
+      val Const (c, _) = Proof_Context.read_const ctxt {proper = true, strict = false} s;
       val res = check (Proof_Context.consts_of ctxt, c)
         handle TYPE (msg, _, _) => error (msg ^ Position.here pos);
     in ML_Syntax.print_string res end);
@@ -176,7 +176,7 @@
       >> (fn ((ctxt, raw_c), Ts) =>
         let
           val Const (c, _) =
-            Proof_Context.read_const ctxt {proper = true, strict = true} dummyT raw_c;
+            Proof_Context.read_const ctxt {proper = true, strict = true} raw_c;
           val consts = Proof_Context.consts_of ctxt;
           val n = length (Consts.typargs consts (c, Consts.type_scheme consts c));
           val _ = length Ts <> n andalso
--- a/src/Pure/Syntax/syntax_phases.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -224,7 +224,7 @@
 fun decode_const ctxt c =
   let
     val (Const (c', _), _) =
-      Proof_Context.check_const ctxt {proper = true, strict = false} dummyT (c, Position.none);
+      Proof_Context.check_const ctxt {proper = true, strict = false} (c, Position.none);
   in c' end;
 
 fun decode_term _ (result as (_: Position.report_text list, Exn.Exn _)) = result
--- a/src/Tools/adhoc_overloading.ML	Thu Mar 06 13:44:01 2014 +0100
+++ b/src/Tools/adhoc_overloading.ML	Thu Mar 06 14:38:54 2014 +0100
@@ -221,7 +221,7 @@
 fun adhoc_overloading_cmd add raw_args lthy =
   let
     fun const_name ctxt =
-      fst o dest_Const o Proof_Context.read_const ctxt {proper = false, strict = false} dummyT;
+      fst o dest_Const o Proof_Context.read_const ctxt {proper = false, strict = false};
     fun read_term ctxt = singleton (Variable.polymorphic ctxt) o Syntax.read_term ctxt;
     val args =
       raw_args