refrain from quantifying outer fixes, to enable nesting of contexts like "context fixes x context assumes A x";
authorwenzelm
Thu, 11 Oct 2012 16:09:44 +0200
changeset 49819 97b572c10fe9
parent 49818 db42a1147986
child 49820 f7a1e1745b7b
refrain from quantifying outer fixes, to enable nesting of contexts like "context fixes x context assumes A x"; tuned;
src/Pure/Isar/expression.ML
--- a/src/Pure/Isar/expression.ML	Thu Oct 11 15:26:33 2012 +0200
+++ b/src/Pure/Isar/expression.ML	Thu Oct 11 16:09:44 2012 +0200
@@ -287,6 +287,13 @@
 
 (** Finish locale elements **)
 
+fun finish_inst ctxt (loc, (prfx, inst)) =
+  let
+    val thy = Proof_Context.theory_of ctxt;
+    val (parm_names, parm_types) = Locale.params_of thy loc |> map #1 |> split_list;
+    val (morph, _) = inst_morph (parm_names, parm_types) (prfx, inst) ctxt;
+  in (loc, morph) end;
+
 fun finish_fixes (parms: (string * typ) list) = map (fn (binding, _, mx) =>
   let val x = Binding.name_of binding
   in (binding, AList.lookup (op =) parms x, mx) end);
@@ -294,14 +301,15 @@
 local
 
 fun closeup _ _ false elem = elem
-  | closeup ctxt parms true elem =
+  | closeup (outer_ctxt, ctxt) parms true elem =
       let
         (* FIXME consider closing in syntactic phase -- before type checking *)
         fun close_frees t =
           let
             val rev_frees =
               Term.fold_aterms (fn Free (x, T) =>
-                if AList.defined (op =) parms x then I else insert (op =) (x, T) | _ => I) t [];
+                if Variable.is_fixed outer_ctxt x orelse AList.defined (op =) parms x then I
+                else insert (op =) (x, T) | _ => I) t [];
           in fold (Logic.all o Free) rev_frees t end;
 
         fun no_binds [] = []
@@ -316,27 +324,14 @@
         | e => e)
       end;
 
+in
+
 fun finish_elem _ parms _ (Fixes fixes) = Fixes (finish_fixes parms fixes)
   | finish_elem _ _ _ (Constrains _) = Constrains []
-  | finish_elem ctxt parms do_close (Assumes asms) = closeup ctxt parms do_close (Assumes asms)
-  | finish_elem ctxt parms do_close (Defines defs) = closeup ctxt parms do_close (Defines defs)
+  | finish_elem ctxts parms do_close (Assumes asms) = closeup ctxts parms do_close (Assumes asms)
+  | finish_elem ctxts parms do_close (Defines defs) = closeup ctxts parms do_close (Defines defs)
   | finish_elem _ _ _ (Notes facts) = Notes facts;
 
-fun finish_inst ctxt (loc, (prfx, inst)) =
-  let
-    val thy = Proof_Context.theory_of ctxt;
-    val (parm_names, parm_types) = Locale.params_of thy loc |> map #1 |> split_list;
-    val (morph, _) = inst_morph (parm_names, parm_types) (prfx, inst) ctxt;
-  in (loc, morph) end;
-
-in
-
-fun finish ctxt parms do_close insts elems =
-  let
-    val deps = map (finish_inst ctxt) insts;
-    val elems' = map (finish_elem ctxt parms do_close) elems;
-  in (deps, elems') end;
-
 end;
 
 
@@ -407,7 +402,8 @@
 
     val fors' = finish_fixes parms fors;
     val fixed = map (fn (b, SOME T, mx) => ((Binding.name_of b, T), mx)) fors';
-    val (deps, elems'') = finish ctxt6 parms do_close insts elems';
+    val deps = map (finish_inst ctxt6) insts;
+    val elems'' = map (finish_elem (ctxt1, ctxt6) parms do_close) elems';
 
   in ((fixed, deps, elems'', concl), (parms, ctxt7)) end