src/Pure/Isar/locale.ML

--- a/src/Pure/Isar/locale.ML	Sat Jan 12 16:38:42 2002 +0100
+++ b/src/Pure/Isar/locale.ML	Sat Jan 12 16:40:02 2002 +0100
@@ -62,7 +62,6 @@
 structure Locale: LOCALE =
 struct
 
-
 (** locale elements and expressions **)
 
 type context = ProofContext.context;
@@ -270,7 +269,7 @@
       | paramify (i, Some T) = apsnd Some (Type.paramify_dummies (i, T));
 
     val (maxidx', Ts') = foldl_map paramify (maxidx, Ts);
-    val (maxidx'', Us') = foldl_map paramify (maxidx, Us);
+    val (maxidx'', Us') = foldl_map paramify (maxidx', Us);
     val (unifier, _) = foldl unify ((Vartab.empty, maxidx''), Ts' ~~ Us');
     val Vs = map (apsome (Envir.norm_type unifier)) Us';
     val unifier' = Vartab.extend (unifier, frozen_tvars ctxt (mapfilter I Vs));
@@ -332,7 +331,7 @@
         val envs = unify_parms ctxt fixed_parms (map (#2 o #1) elemss);
         fun inst (((name, ps), elems), env) =
           ((name, map (apsnd (apsome (inst_type env))) ps), map (inst_elem env) elems);
-      in map inst (elemss ~~ envs) end;
+      in map2 inst (elemss, envs) end;
 
 fun flatten_expr ctxt (prev_idents, expr) =
   let
@@ -463,10 +462,10 @@
 
 local
 
-fun declare_int_elem i (ctxt, Fixes fixes) =
+fun declare_int_elem (ctxt, Fixes fixes) =
       (ctxt |> ProofContext.add_fixes (map (fn (x, T, mx) =>
-        (x, apsome (Term.map_type_tfree (Type.param i)) T, mx)) fixes), [])
-  | declare_int_elem _ (ctxt, _) = (ctxt, []);
+        (x, apsome (Term.map_type_tfree (Type.param 0)) T, mx)) fixes), [])
+  | declare_int_elem (ctxt, _) = (ctxt, []);
 
 fun declare_ext_elem prep_fixes (ctxt, Fixes fixes) =
       (ctxt |> ProofContext.add_fixes (prep_fixes ctxt fixes), [])
@@ -474,13 +473,24 @@
   | declare_ext_elem _ (ctxt, Defines defs) = (ctxt, map (fn (_, (t, ps)) => [(t, (ps, []))]) defs)
   | declare_ext_elem _ (ctxt, Notes facts) = (ctxt, []);
 
-fun declare_elems prep_fixes ((ctxt, i), ((name, ps), elems)) =
+fun declare_elems prep_fixes (ctxt, ((name, ps), elems)) =
   let val (ctxt', propps) =
     (case elems of
-      Int es => foldl_map (declare_int_elem i) (ctxt, es)
+      Int es => foldl_map declare_int_elem (ctxt, es)
     | Ext e => foldl_map (declare_ext_elem prep_fixes) (ctxt, [e]))
     handle ProofContext.CONTEXT (msg, ctxt) => err_in_locale ctxt msg [(name, map fst ps)]
-  in ((ctxt', i + 1), propps) end;
+  in (ctxt', propps) end;
+
+fun declare_elemss prep_fixes fixed_params raw_elemss ctxt =
+  let
+    val int_elemss =
+      raw_elemss
+      |> mapfilter (fn (id, Int es) => Some (id, es) | _ => None)
+      |> unify_elemss ctxt fixed_params;
+    val (_, raw_elemss') =
+      foldl_map (fn ((_, es) :: elemss, (id, Int _)) => (elemss, (id, Int es)) | x => x)
+        (int_elemss, raw_elemss);
+  in foldl_map (declare_elems prep_fixes) (ctxt, raw_elemss') end;
 
 
 fun close_frees ctxt t =
@@ -488,7 +498,8 @@
   in Term.list_all_free (frees, t) end;
 
 fun no_binds _ [] = []
-  | no_binds ctxt _ = raise ProofContext.CONTEXT ("Illegal term bindings in locale element", ctxt);
+  | no_binds ctxt (_ :: _) =
+      raise ProofContext.CONTEXT ("Illegal term bindings in locale element", ctxt);
 
 fun closeup ctxt (Assumes asms) = Assumes (asms |> map (fn (a, propps) =>
       (a, map (fn (t, (ps, qs)) => (close_frees ctxt t,
@@ -497,27 +508,26 @@
       (a, (close_frees ctxt (#2 (ProofContext.cert_def ctxt t)), no_binds ctxt ps))))
   | closeup ctxt elem = elem;
 
-fun finish_elem parms _ (Fixes fixes, _) = Ext (Fixes (map (fn (x, _, mx) =>
-      (x, assoc_string (parms, x), mx)) fixes))
-  | finish_elem _ close (Assumes asms, propp) = Ext (close (Assumes (map #1 asms ~~ propp)))
+fun finish_elem parms _ (Fixes fixes, _) = Fixes (map (fn (x, _, mx) =>
+      (x, assoc_string (parms, x), mx)) fixes)
+  | finish_elem _ close (Assumes asms, propp) = close (Assumes (map #1 asms ~~ propp))
   | finish_elem _ close (Defines defs, propp) =
-      Ext (close (Defines (map #1 defs ~~ map (fn [(t, (ps, []))] => (t, ps)) propp)))
-  | finish_elem _ _ (Notes facts, _) = Ext (Notes facts);
+      close (Defines (map #1 defs ~~ map (fn [(t, (ps, []))] => (t, ps)) propp))
+  | finish_elem _ _ (Notes facts, _) = Notes facts;
 
 fun finish_elems ctxt parms close (((name, ps), elems), propps) =
   let
     val elems' =
       (case elems of
         Int es => map Int (#2 (hd (unify_elemss ctxt parms [((name, ps), es)])))
-      | Ext e => [finish_elem parms close (e, hd propps)]);
+      | Ext e => [Ext (finish_elem parms close (e, hd propps))]);
     val ps' = map (fn (x, _) => (x, assoc (parms, x))) ps;
   in ((name, ps'), elems') end;
 
 
 fun prep_elemss prep_fixes prepp do_close context fixed_params raw_elemss raw_concl =
   let
-    val ((raw_ctxt, maxidx), raw_proppss) =
-      foldl_map (declare_elems prep_fixes) ((context, 0), raw_elemss);
+    val (raw_ctxt, raw_proppss) = declare_elemss prep_fixes fixed_params raw_elemss context;
     val raw_propps = map flat raw_proppss;
     val raw_propp = flat raw_propps;
     val (ctxt, all_propp) =
@@ -533,7 +543,7 @@
     val proppss = map2 (uncurry unflat) (raw_proppss, propps);
 
     val xs = map #1 (params_of raw_elemss);
-    val typing = unify_frozen ctxt maxidx
+    val typing = unify_frozen ctxt 0
       (map (ProofContext.default_type raw_ctxt) xs)
       (map (ProofContext.default_type ctxt) xs);
     val parms = param_types (xs ~~ typing);