clarified errors;
authorwenzelm
Mon, 25 Oct 2021 19:23:09 +0200
changeset 74579 bf703bfc065c
parent 74578 9bfbb5f7ec99
child 74580 d114553793df
clarified errors;
src/Pure/ML/ml_antiquotations.ML
--- a/src/Pure/ML/ml_antiquotations.ML	Mon Oct 25 17:40:49 2021 +0200
+++ b/src/Pure/ML/ml_antiquotations.ML	Mon Oct 25 19:23:09 2021 +0200
@@ -13,9 +13,9 @@
   type insts = ((indexname * sort) * typ) list * ((indexname * typ) * term) list
   type cinsts = ((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list
   val instantiate_typ: insts -> typ -> typ
-  val instantiate_ctyp: cinsts -> ctyp -> ctyp
+  val instantiate_ctyp: Position.T -> cinsts -> ctyp -> ctyp
   val instantiate_term: insts -> term -> term
-  val instantiate_cterm: cinsts -> cterm -> cterm
+  val instantiate_cterm: Position.T -> cinsts -> cterm -> cterm
 end;
 
 structure ML_Antiquotations: ML_ANTIQUOTATIONS =
@@ -235,8 +235,12 @@
 type insts = ((indexname * sort) * typ) list * ((indexname * typ) * term) list
 type cinsts = ((indexname * sort) * ctyp) list * ((indexname * typ) * cterm) list
 
-fun instantiate_typ (insts: insts) = Term_Subst.instantiateT (TVars.make (#1 insts));
-fun instantiate_ctyp (cinsts: cinsts) = Thm.instantiate_ctyp (TVars.make (#1 cinsts));
+fun instantiate_typ (insts: insts) =
+  Term_Subst.instantiateT (TVars.make (#1 insts));
+
+fun instantiate_ctyp pos (cinsts: cinsts) cT =
+  Thm.instantiate_ctyp (TVars.make (#1 cinsts)) cT
+  handle CTERM (msg, args) => Exn.reraise (CTERM (msg ^ Position.here pos, args));
 
 fun instantiate_term (insts: insts) =
   let
@@ -245,12 +249,13 @@
     val inst = Vars.make ((map o apfst o apsnd) instantiateT (#2 insts));
   in Term_Subst.instantiate_beta (instT, inst) end;
 
-fun instantiate_cterm (cinsts: cinsts) =
+fun instantiate_cterm pos (cinsts: cinsts) ct =
   let
     val cinstT = TVars.make (#1 cinsts);
     val instantiateT = Term_Subst.instantiateT (TVars.map (K Thm.typ_of) cinstT);
     val cinst = Vars.make ((map o apfst o apsnd) instantiateT (#2 cinsts));
-  in Thm.instantiate_beta_cterm (cinstT, cinst) end;
+  in Thm.instantiate_beta_cterm (cinstT, cinst) ct end
+  handle CTERM (msg, args) => Exn.reraise (CTERM (msg ^ Position.here pos, args));
 
 
 local
@@ -338,19 +343,25 @@
     val (ml_insts, t') = prepare_insts ctxt1 ctxt insts t;
   in prepare_ml range arg (ML_Syntax.print_term t') ml_insts ctxt end;
 
-fun typ_ml kind = (kind, "", "ML_Antiquotations.instantiate_typ");
-fun term_ml kind = (kind, "", "ML_Antiquotations.instantiate_term");
-fun ctyp_ml kind =
-  (kind, "ML_Antiquotations.make_ctyp ML_context", "ML_Antiquotations.instantiate_ctyp");
-fun cterm_ml kind =
-  (kind, "ML_Antiquotations.make_cterm ML_context", "ML_Antiquotations.instantiate_cterm");
+val ml_here = ML_Syntax.atomic o ML_Syntax.print_position;
+
+fun typ_ml (kind, _: Position.T) = (kind, "", "ML_Antiquotations.instantiate_typ ");
+fun term_ml (kind, _: Position.T) = (kind, "", "ML_Antiquotations.instantiate_term ");
+fun ctyp_ml (kind, pos) =
+  (kind, "ML_Antiquotations.make_ctyp ML_context",
+    "ML_Antiquotations.instantiate_ctyp " ^ ml_here pos);
+fun cterm_ml (kind, pos) =
+  (kind, "ML_Antiquotations.make_cterm ML_context",
+    "ML_Antiquotations.instantiate_cterm " ^ ml_here pos);
+
+val command_name = Parse.position o Parse.command_name;
 
 fun parse_body range =
-  (Parse.command_name "typ" >> typ_ml || Parse.command_name "ctyp" >> ctyp_ml) --
+  (command_name "typ" >> typ_ml || command_name "ctyp" >> ctyp_ml) --
     Parse.!!! Parse.typ >> prepare_type range ||
-  (Parse.command_name "term" >> term_ml || Parse.command_name "cterm" >> cterm_ml)
+  (command_name "term" >> term_ml || command_name "cterm" >> cterm_ml)
     -- Parse.!!! (Parse.term -- Parse.for_fixes) >> prepare_term Syntax.read_term range ||
-  (Parse.command_name "prop" >> term_ml || Parse.command_name "cprop" >> cterm_ml)
+  (command_name "prop" >> term_ml || command_name "cprop" >> cterm_ml)
     -- Parse.!!! (Parse.term -- Parse.for_fixes) >> prepare_term Syntax.read_prop range;
 
 val _ = Theory.setup