eliminated Syntax.binding;
authorwenzelm
Sat, 04 Sep 1999 21:12:15 +0200
changeset 7479 b482d827899c
parent 7478 02291239d627
child 7480 0a0e0dbe1269
eliminated Syntax.binding; put_thms: ignore ""; update_binds_env: Envir.norm_term ensures proper type instantiation;
src/Pure/Isar/proof_context.ML
--- a/src/Pure/Isar/proof_context.ML	Sat Sep 04 21:08:38 1999 +0200
+++ b/src/Pure/Isar/proof_context.ML	Sat Sep 04 21:12:15 1999 +0200
@@ -134,13 +134,7 @@
 fun strings_of_binds (Context {thy, binds, ...}) =
   let
     val prt_term = Sign.pretty_term (Theory.sign_of thy);
-
-    fun fix_var (x, i) =
-      (case try Syntax.dest_binding x of
-        None => Syntax.string_of_vname (x, i)
-      | Some x' => if i = 0 then "??" ^ x' else Syntax.string_of_vname (x, i));
-    fun pretty_bind (xi, (t, T)) = Pretty.block
-      [Pretty.str (fix_var xi), Pretty.str " ==", Pretty.brk 1, prt_term t];
+    fun pretty_bind (xi, (t, T)) = prt_term (Logic.mk_equals (Var (xi, T), t));
   in
     if Vartab.is_empty binds andalso not (! verbose) then []
     else [Pretty.string_of (Pretty.big_list "Term bindings:" (map pretty_bind (Vartab.dest binds)))]
@@ -394,10 +388,7 @@
             Some (u, U) =>
               if T = U then (norm u handle SAME => u)
               else raise TYPE ("norm_term: ill-typed variable assigment", [T, U], [t, u])
-          | None =>
-              if can Syntax.dest_binding (#1 xi) then
-                raise CONTEXT ("Unbound binding: " ^ Syntax.string_of_vname xi, ctxt)
-              else raise SAME)
+          | None => raise CONTEXT ("Unbound schematic variable: " ^ Syntax.string_of_vname xi, ctxt))
       | norm (Abs (a, T, body)) =  Abs (a, T, norm body)
       | norm (Abs (_, _, body) $ t) = normh (subst_bound (t, body))
       | norm (f $ t) =
@@ -432,10 +423,6 @@
 
 (* read terms *)
 
-fun warn_vars ctxt tm =
-  if null (term_vars tm) andalso null (term_tvars tm) then tm
-  else (warning "Illegal schematic variable(s) in term"; tm);
-
 fun gen_read read app is_pat (ctxt as Context {binds, defs = (types, sorts, _, used), ...}) s =
   let
     val sign = sign_of ctxt;
@@ -453,7 +440,6 @@
     |> app (intern_skolem ctxt true)
     |> app (if is_pat then I else norm_term ctxt)
     |> app (if is_pat then prepare_dummies else (reject_dummies ctxt))
-    |> app (if is_pat then I else warn_vars ctxt)
   end;
 
 val read_termTs = gen_read (read_def_termTs false) (apfst o map) false;
@@ -535,17 +521,14 @@
   end;
 
 fun update_binds bs ctxt = foldl upd_bind (ctxt, bs);
-fun update_binds_env env = update_binds (Envir.alist_of env);
+fun update_binds_env env = (*Envir.norm_term ensures proper type instantiation*)
+  update_binds (map (apsnd (Envir.norm_term env)) (Envir.alist_of env));
 
 
 (* add_binds(_i) -- sequential *)
 
 fun gen_bind prep (ctxt, (xi as (x, _), raw_t)) =
-  let val t = prep ctxt raw_t in
-    if can Syntax.dest_binding x then ctxt |> update_binds [(xi, t)]
-    else raise CONTEXT ("Illegal variable name for term binding: " ^
-      quote (Syntax.string_of_vname xi), ctxt)
-  end;
+  ctxt |> update_binds [(xi, prep ctxt raw_t)];
 
 fun gen_binds prep binds ctxt = foldl (gen_bind prep) (ctxt, binds);
 
@@ -632,9 +615,10 @@
 
 (* put_thm(s) *)
 
-fun put_thms (name, ths) = map_context
-  (fn (thy, data, asms, binds, thms, defs) =>
-    (thy, data, asms, binds, Symtab.update ((name, ths), thms), defs));
+fun put_thms ("", _) = I
+  | put_thms (name, ths) = map_context
+      (fn (thy, data, asms, binds, thms, defs) =>
+        (thy, data, asms, binds, Symtab.update ((name, ths), thms), defs));
 
 fun put_thm (name, th) = put_thms (name, [th]);