src/Pure/drule.ML
changeset 1596 4a09f4698813
parent 1499 01fdd1ea6324
child 1703 e22ad43bab5f
equal deleted inserted replaced
1595:b9984b1dbc4c 1596:4a09f4698813
    35   val forall_elim_vars	: int -> thm -> thm
    35   val forall_elim_vars	: int -> thm -> thm
    36   val implies_elim_list	: thm -> thm list -> thm
    36   val implies_elim_list	: thm -> thm list -> thm
    37   val implies_intr_list	: cterm list -> thm -> thm
    37   val implies_intr_list	: cterm list -> thm -> thm
    38   val MRL		: thm list list * thm list -> thm list
    38   val MRL		: thm list list * thm list -> thm list
    39   val MRS		: thm list * thm -> thm
    39   val MRS		: thm list * thm -> thm
    40   val pprint_cterm	: cterm -> pprint_args -> unit
       
    41   val pprint_ctyp	: ctyp -> pprint_args -> unit
       
    42   val pprint_theory	: theory -> pprint_args -> unit
       
    43   val pprint_thm	: thm -> pprint_args -> unit
       
    44   val pretty_thm	: thm -> Pretty.T
       
    45   val print_cterm	: cterm -> unit
       
    46   val print_ctyp	: ctyp -> unit
       
    47   val print_goals	: int -> thm -> unit
       
    48   val print_goals_ref	: (int -> thm -> unit) ref
       
    49   val print_syntax	: theory -> unit
       
    50   val print_theory	: theory -> unit
       
    51   val print_thm		: thm -> unit
       
    52   val prth		: thm -> thm
       
    53   val prthq		: thm Sequence.seq -> thm Sequence.seq
       
    54   val prths		: thm list -> thm list
       
    55   val read_instantiate	: (string*string)list -> thm -> thm
    40   val read_instantiate	: (string*string)list -> thm -> thm
    56   val read_instantiate_sg: Sign.sg -> (string*string)list -> thm -> thm
    41   val read_instantiate_sg: Sign.sg -> (string*string)list -> thm -> thm
    57   val read_insts	:
    42   val read_insts	:
    58           Sign.sg -> (indexname -> typ option) * (indexname -> sort option)
    43           Sign.sg -> (indexname -> typ option) * (indexname -> sort option)
    59                   -> (indexname -> typ option) * (indexname -> sort option)
    44                   -> (indexname -> typ option) * (indexname -> sort option)
    67   val rewrite_rule	: thm list -> thm -> thm
    52   val rewrite_rule	: thm list -> thm -> thm
    68   val RS		: thm * thm -> thm
    53   val RS		: thm * thm -> thm
    69   val RSN		: thm * (int * thm) -> thm
    54   val RSN		: thm * (int * thm) -> thm
    70   val RL		: thm list * thm list -> thm list
    55   val RL		: thm list * thm list -> thm list
    71   val RLN		: thm list * (int * thm list) -> thm list
    56   val RLN		: thm list * (int * thm list) -> thm list
    72   val show_hyps		: bool ref
       
    73   val size_of_thm	: thm -> int
    57   val size_of_thm	: thm -> int
    74   val standard		: thm -> thm
    58   val standard		: thm -> thm
    75   val string_of_cterm	: cterm -> string
       
    76   val string_of_ctyp	: ctyp -> string
       
    77   val string_of_thm	: thm -> string
       
    78   val symmetric_thm	: thm
    59   val symmetric_thm	: thm
    79   val thin_rl		: thm
    60   val thin_rl		: thm
    80   val transitive_thm	: thm
    61   val transitive_thm	: thm
    81   val triv_forall_equality: thm
    62   val triv_forall_equality: thm
    82   val types_sorts: thm -> (indexname-> typ option) * (indexname-> sort option)
    63   val types_sorts: thm -> (indexname-> typ option) * (indexname-> sort option)
   272 in (map (fn (ixn,T) => (ixn,ctyp_of sign T)) tye',
   253 in (map (fn (ixn,T) => (ixn,ctyp_of sign T)) tye',
   273     map (fn (ixn,T,ct) => (cterm_of sign (Var(ixn,T)), ct)) cterms)
   254     map (fn (ixn,T,ct) => (cterm_of sign (Var(ixn,T)), ct)) cterms)
   274 end;
   255 end;
   275 
   256 
   276 
   257 
   277 
       
   278 (*** Printing of theories, theorems, etc. ***)
       
   279 
       
   280 (*If false, hypotheses are printed as dots*)
       
   281 val show_hyps = ref true;
       
   282 
       
   283 fun pretty_thm th =
       
   284   let
       
   285     val {sign, hyps, prop, ...} = rep_thm th;
       
   286     val xshyps = extra_shyps th;
       
   287     val hlen = length xshyps + length hyps;
       
   288     val hsymbs =
       
   289       if hlen = 0 then []
       
   290       else if ! show_hyps then
       
   291         [Pretty.brk 2, Pretty.list "[" "]"
       
   292           (map (Sign.pretty_term sign) hyps @ map Sign.pretty_sort xshyps)]
       
   293       else
       
   294         [Pretty.brk 2, Pretty.str ("[" ^ implode (replicate hlen ".") ^ "]")];
       
   295   in
       
   296     Pretty.block (Sign.pretty_term sign prop :: hsymbs)
       
   297   end;
       
   298 
       
   299 val string_of_thm = Pretty.string_of o pretty_thm;
       
   300 val pprint_thm = Pretty.pprint o Pretty.quote o pretty_thm;
       
   301 
       
   302 
       
   303 (** Top-level commands for printing theorems **)
       
   304 val print_thm = writeln o string_of_thm;
       
   305 
       
   306 fun prth th = (print_thm th; th);
       
   307 
       
   308 (*Print and return a sequence of theorems, separated by blank lines. *)
       
   309 fun prthq thseq =
       
   310   (Sequence.prints (fn _ => print_thm) 100000 thseq; thseq);
       
   311 
       
   312 (*Print and return a list of theorems, separated by blank lines. *)
       
   313 fun prths ths = (print_list_ln print_thm ths; ths);
       
   314 
       
   315 
       
   316 (* other printing commands *)
       
   317 
       
   318 fun pprint_ctyp cT =
       
   319   let val {sign, T} = rep_ctyp cT in Sign.pprint_typ sign T end;
       
   320 
       
   321 fun string_of_ctyp cT =
       
   322   let val {sign, T} = rep_ctyp cT in Sign.string_of_typ sign T end;
       
   323 
       
   324 val print_ctyp = writeln o string_of_ctyp;
       
   325 
       
   326 fun pprint_cterm ct =
       
   327   let val {sign, t, ...} = rep_cterm ct in Sign.pprint_term sign t end;
       
   328 
       
   329 fun string_of_cterm ct =
       
   330   let val {sign, t, ...} = rep_cterm ct in Sign.string_of_term sign t end;
       
   331 
       
   332 val print_cterm = writeln o string_of_cterm;
       
   333 
       
   334 
       
   335 (* print theory *)
       
   336 
       
   337 val pprint_theory = Sign.pprint_sg o sign_of;
       
   338 
       
   339 val print_syntax = Syntax.print_syntax o syn_of;
       
   340 
       
   341 fun print_axioms thy =
       
   342   let
       
   343     val {sign, new_axioms, ...} = rep_theory thy;
       
   344     val axioms = Symtab.dest new_axioms;
       
   345 
       
   346     fun prt_axm (a, t) = Pretty.block [Pretty.str (a ^ ":"), Pretty.brk 1,
       
   347       Pretty.quote (Sign.pretty_term sign t)];
       
   348   in
       
   349     Pretty.writeln (Pretty.big_list "additional axioms:" (map prt_axm axioms))
       
   350   end;
       
   351 
       
   352 fun print_theory thy = (Sign.print_sg (sign_of thy); print_axioms thy);
       
   353 
       
   354 
       
   355 
       
   356 (** Print thm A1,...,An/B in "goal style" -- premises as numbered subgoals **)
       
   357 
       
   358 (* get type_env, sort_env of term *)
       
   359 
       
   360 local
       
   361   open Syntax;
       
   362 
       
   363   fun ins_entry (x, y) [] = [(x, [y])]
       
   364     | ins_entry (x, y) ((pair as (x', ys')) :: pairs) =
       
   365         if x = x' then (x', y ins ys') :: pairs
       
   366         else pair :: ins_entry (x, y) pairs;
       
   367 
       
   368   fun add_type_env (Free (x, T), env) = ins_entry (T, x) env
       
   369     | add_type_env (Var (xi, T), env) = ins_entry (T, string_of_vname xi) env
       
   370     | add_type_env (Abs (_, _, t), env) = add_type_env (t, env)
       
   371     | add_type_env (t $ u, env) = add_type_env (u, add_type_env (t, env))
       
   372     | add_type_env (_, env) = env;
       
   373 
       
   374   fun add_sort_env (Type (_, Ts), env) = foldr add_sort_env (Ts, env)
       
   375     | add_sort_env (TFree (x, S), env) = ins_entry (S, x) env
       
   376     | add_sort_env (TVar (xi, S), env) = ins_entry (S, string_of_vname xi) env;
       
   377 
       
   378   val sort = map (apsnd sort_strings);
       
   379 in
       
   380   fun type_env t = sort (add_type_env (t, []));
       
   381   fun sort_env t = rev (sort (it_term_types add_sort_env (t, [])));
       
   382 end;
       
   383 
       
   384 
       
   385 (* print_goals *)
       
   386 
       
   387 fun print_goals maxgoals state =
       
   388   let
       
   389     open Syntax;
       
   390 
       
   391     val {sign, prop, ...} = rep_thm state;
       
   392 
       
   393     val pretty_term = Sign.pretty_term sign;
       
   394     val pretty_typ = Sign.pretty_typ sign;
       
   395     val pretty_sort = Sign.pretty_sort;
       
   396 
       
   397     fun pretty_vars prtf (X, vs) = Pretty.block
       
   398       [Pretty.block (Pretty.commas (map Pretty.str vs)),
       
   399         Pretty.str " ::", Pretty.brk 1, prtf X];
       
   400 
       
   401     fun print_list _ _ [] = ()
       
   402       | print_list name prtf lst =
       
   403           (writeln ""; Pretty.writeln (Pretty.big_list name (map prtf lst)));
       
   404 
       
   405 
       
   406     fun print_goals (_, []) = ()
       
   407       | print_goals (n, A :: As) = (Pretty.writeln (Pretty.blk (0,
       
   408           [Pretty.str (" " ^ string_of_int n ^ ". "), pretty_term A]));
       
   409             print_goals (n + 1, As));
       
   410 
       
   411     val print_ffpairs =
       
   412       print_list "Flex-flex pairs:" (pretty_term o Logic.mk_flexpair);
       
   413 
       
   414     val print_types = print_list "Types:" (pretty_vars pretty_typ) o type_env;
       
   415     val print_sorts = print_list "Sorts:" (pretty_vars pretty_sort) o sort_env;
       
   416 
       
   417 
       
   418     val (tpairs, As, B) = Logic.strip_horn prop;
       
   419     val ngoals = length As;
       
   420 
       
   421     val orig_no_freeTs = ! show_no_free_types;
       
   422     val orig_sorts = ! show_sorts;
       
   423 
       
   424     fun restore () =
       
   425       (show_no_free_types := orig_no_freeTs; show_sorts := orig_sorts);
       
   426   in
       
   427     (show_no_free_types := true; show_sorts := false;
       
   428       Pretty.writeln (pretty_term B);
       
   429       if ngoals = 0 then writeln "No subgoals!"
       
   430       else if ngoals > maxgoals then
       
   431         (print_goals (1, take (maxgoals, As));
       
   432           writeln ("A total of " ^ string_of_int ngoals ^ " subgoals..."))
       
   433       else print_goals (1, As);
       
   434 
       
   435       print_ffpairs tpairs;
       
   436 
       
   437       if orig_sorts then
       
   438         (print_types prop; print_sorts prop)
       
   439       else if ! show_types then
       
   440         print_types prop
       
   441       else ())
       
   442     handle exn => (restore (); raise exn);
       
   443     restore ()
       
   444   end;
       
   445 
       
   446 
       
   447 (*"hook" for user interfaces: allows print_goals to be replaced*)
       
   448 val print_goals_ref = ref print_goals;
       
   449 
       
   450 (*** Find the type (sort) associated with a (T)Var or (T)Free in a term
   258 (*** Find the type (sort) associated with a (T)Var or (T)Free in a term
   451      Used for establishing default types (of variables) and sorts (of
   259      Used for establishing default types (of variables) and sorts (of
   452      type variables) when reading another term.
   260      type variables) when reading another term.
   453      Index -1 indicates that a (T)Free rather than a (T)Var is wanted.
   261      Index -1 indicates that a (T)Free rather than a (T)Var is wanted.
   454 ***)
   262 ***)