src/Pure/sign.ML
changeset 24674 4ade7ac6a21c
parent 24517 eaed6ac5f7f2
child 24707 dfeb98f84e93
equal deleted inserted replaced
24673:62b75508eb66 24674:4ade7ac6a21c
   129   val arity_sorts: theory -> string -> sort -> sort list
   129   val arity_sorts: theory -> string -> sort -> sort list
   130   val certify_class: theory -> class -> class
   130   val certify_class: theory -> class -> class
   131   val certify_sort: theory -> sort -> sort
   131   val certify_sort: theory -> sort -> sort
   132   val certify_typ: theory -> typ -> typ
   132   val certify_typ: theory -> typ -> typ
   133   val certify_typ_mode: Type.mode -> theory -> typ -> typ
   133   val certify_typ_mode: Type.mode -> theory -> typ -> typ
   134   val certify': bool -> bool -> Pretty.pp -> Consts.T -> theory -> term -> term * typ * int
   134   val certify': bool -> Pretty.pp -> bool -> Consts.T -> theory -> term -> term * typ * int
   135   val certify_term: theory -> term -> term * typ * int
   135   val certify_term: theory -> term -> term * typ * int
   136   val certify_prop: theory -> term -> term * typ * int
   136   val certify_prop: theory -> term -> term * typ * int
   137   val cert_term: theory -> term -> term
   137   val cert_term: theory -> term -> term
   138   val cert_prop: theory -> term -> term
   138   val cert_prop: theory -> term -> term
   139   val no_frees: Pretty.pp -> term -> term
   139   val no_frees: Pretty.pp -> term -> term
   435       if i < 0 then err ("Malformed variable: " ^ quote (Term.string_of_vname xi)) else ()
   435       if i < 0 then err ("Malformed variable: " ^ quote (Term.string_of_vname xi)) else ()
   436   | check_vars _ = ();
   436   | check_vars _ = ();
   437 
   437 
   438 in
   438 in
   439 
   439 
   440 fun certify' normalize prop pp consts thy tm =
   440 fun certify' prop pp do_expand consts thy tm =
   441   let
   441   let
   442     val _ = check_vars tm;
   442     val _ = check_vars tm;
   443     val tm' = Term.map_types (certify_typ thy) tm;
   443     val tm' = Term.map_types (certify_typ thy) tm;
   444     val T = type_check pp tm';
   444     val T = type_check pp tm';
   445     val _ = if prop andalso T <> propT then err "Term not of type prop" else ();
   445     val _ = if prop andalso T <> propT then err "Term not of type prop" else ();
   446     val tm'' = Consts.certify pp (tsig_of thy) consts tm';
   446     val tm'' = Consts.certify pp (tsig_of thy) do_expand consts tm';
   447     val tm'' = if normalize then tm'' else tm';
       
   448   in (if tm = tm'' then tm else tm'', T, Term.maxidx_of_term tm'') end;
   447   in (if tm = tm'' then tm else tm'', T, Term.maxidx_of_term tm'') end;
   449 
   448 
   450 fun certify_term thy = certify' true false (pp thy) (consts_of thy) thy;
   449 fun certify_term thy = certify' false (pp thy) true (consts_of thy) thy;
   451 fun certify_prop thy = certify' true true (pp thy) (consts_of thy) thy;
   450 fun certify_prop thy = certify' true (pp thy) true (consts_of thy) thy;
   452 
   451 
   453 fun cert_term_abbrev thy = #1 o certify' false false (pp thy) (consts_of thy) thy;
   452 fun cert_term_abbrev thy = #1 o certify' false (pp thy) false (consts_of thy) thy;
   454 val cert_term = #1 oo certify_term;
   453 val cert_term = #1 oo certify_term;
   455 val cert_prop = #1 oo certify_prop;
   454 val cert_prop = #1 oo certify_prop;
   456 
   455 
   457 end;
   456 end;
   458 
   457 
   589 
   588 
   590 fun read_def_terms (thy, types, sorts) used freeze sTs =
   589 fun read_def_terms (thy, types, sorts) used freeze sTs =
   591   let
   590   let
   592     val pp = pp thy;
   591     val pp = pp thy;
   593     val consts = consts_of thy;
   592     val consts = consts_of thy;
   594     val cert_consts = Consts.certify pp (tsig_of thy) consts;
   593     val cert_consts = Consts.certify pp (tsig_of thy) true consts;
   595     fun map_free x = if is_some (types (x, ~1)) then SOME x else NONE;
   594     fun map_free x = if is_some (types (x, ~1)) then SOME x else NONE;
   596     val (ts, inst) =
   595     val (ts, inst) =
   597       read_def_terms' pp (is_logtype thy) (syn_of thy) consts map_free
   596       read_def_terms' pp (is_logtype thy) (syn_of thy) consts map_free
   598         (ProofContext.init thy) (types, sorts) (Name.make_context used) freeze sTs;
   597         (ProofContext.init thy) (types, sorts) (Name.make_context used) freeze sTs;
   599   in (map cert_consts ts, inst) end;
   598   in (map cert_consts ts, inst) end;