reject term variables explicitly
authorhaftmann
Tue, 21 Sep 2010 15:46:06 +0200
changeset 39605 6dc866b9c548
parent 39604 f17fb9ccb836
child 39606 7af0441a3a47
reject term variables explicitly
src/Tools/Code/code_runtime.ML
--- a/src/Tools/Code/code_runtime.ML	Tue Sep 21 15:46:05 2010 +0200
+++ b/src/Tools/Code/code_runtime.ML	Tue Sep 21 15:46:06 2010 +0200
@@ -60,6 +60,11 @@
 
 type 'a cookie = (Proof.context -> unit -> 'a) * ((unit -> 'a) -> Proof.context -> Proof.context) * string;
 
+fun reject_vars thy t =
+  let
+    val ctxt = ProofContext.init_global thy;
+  in ((Sign.no_frees ctxt o Sign.no_vars ctxt o map_types (K dummyT)) t; t) end;
+
 fun obtain_serializer thy some_target = Code_Target.produce_code_for thy
   (the_default target some_target) NONE "Code" [];
 
@@ -88,6 +93,7 @@
 
 fun dynamic_value_exn cookie thy some_target postproc t args =
   let
+    val _ = reject_vars thy t;
     fun evaluator naming program ((_, vs_ty), t) deps =
       base_evaluator cookie (obtain_serializer thy some_target) naming thy program (vs_ty, t) deps args;
   in Code_Thingol.dynamic_eval_value thy (Exn.map_result o postproc) evaluator t end;
@@ -103,7 +109,7 @@
     val serializer = obtain_serializer thy some_target;
     fun evaluator naming program thy ((_, vs_ty), t) deps =
       base_evaluator cookie serializer naming thy program (vs_ty, t) deps [];
-  in Code_Thingol.static_eval_value thy (Exn.map_result o postproc) consts evaluator end;
+  in Code_Thingol.static_eval_value thy (Exn.map_result o postproc) consts evaluator o reject_vars thy end;
 
 fun static_value_strict cookie thy some_target postproc consts t =
   Exn.release (static_value_exn cookie thy some_target postproc consts t);
@@ -121,6 +127,8 @@
 val put_truth = Truth_Result.put;
 val truth_cookie = (Truth_Result.get, put_truth, Long_Name.append this "put_truth");
 
+val reject_vars = fn thy => tap (reject_vars thy o Thm.term_of);
+
 fun check_holds serializer naming thy program vs_t deps ct =
   let
     val t = Thm.term_of ct;
@@ -143,7 +151,8 @@
   raw_check_holds_oracle (serializer, naming, thy, program, (vs_ty, t), deps, ct);
 
 val dynamic_holds_conv = Conv.tap_thy (fn thy => Code_Thingol.dynamic_eval_conv thy
-  (fn naming => check_holds_oracle (obtain_serializer thy NONE) naming thy));
+  (fn naming => check_holds_oracle (obtain_serializer thy NONE) naming thy)
+  o reject_vars thy);
 
 fun static_holds_conv thy consts =
   let
@@ -151,6 +160,7 @@
   in
     Code_Thingol.static_eval_conv thy consts
       (fn naming => fn program => fn thy => check_holds_oracle serializer naming thy program)
+    o reject_vars thy
   end;