tuning names
authorblanchet
Thu, 02 May 2013 16:14:14 +0200
changeset 53000d77cf35c27ac
parent 52999 b9a8c3b92a62
child 53001 9761deff11bc
tuning names
src/HOL/BNF/Tools/bnf_fp_def_sugar.ML
src/HOL/BNF/Tools/bnf_fp_util.ML
src/HOL/BNF/Tools/bnf_gfp.ML
src/HOL/BNF/Tools/bnf_lfp.ML
     1.1 --- a/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML	Thu May 02 15:28:11 2013 +0200
     1.2 +++ b/src/HOL/BNF/Tools/bnf_fp_def_sugar.ML	Thu May 02 16:14:14 2013 +0200
     1.3 @@ -48,7 +48,7 @@
     1.4      * (thm list list * thm list list * Args.src list)
     1.5      * (thm list list * thm list list * Args.src list)
     1.6  
     1.7 -  val datatypes: bool ->
     1.8 +  val co_datatypes: bool ->
     1.9      (mixfix list -> (string * sort) list option -> binding list -> binding list -> binding list ->
    1.10        binding list list -> typ list * typ list list -> BNF_Def.bnf list -> local_theory ->
    1.11        BNF_FP_Util.fp_result * local_theory) ->
    1.12 @@ -56,7 +56,7 @@
    1.13        ((((binding * binding) * (binding * typ) list) * (binding * term) list) *
    1.14          mixfix) list) list ->
    1.15      local_theory -> local_theory
    1.16 -  val parse_datatype_cmd: bool ->
    1.17 +  val parse_co_datatype_cmd: bool ->
    1.18      (mixfix list -> (string * sort) list option -> binding list -> binding list -> binding list ->
    1.19        binding list list -> typ list * typ list list -> BNF_Def.bnf list -> local_theory ->
    1.20        BNF_FP_Util.fp_result * local_theory) ->
    1.21 @@ -805,7 +805,7 @@
    1.22       (sel_unfold_thmss, sel_corec_thmss, simp_attrs))
    1.23    end;
    1.24  
    1.25 -fun define_datatypes prepare_constraint prepare_typ prepare_term lfp construct_fp
    1.26 +fun define_co_datatypes prepare_constraint prepare_typ prepare_term lfp construct_fp
    1.27      (wrap_opts as (no_dests, rep_compat), specs) no_defs_lthy0 =
    1.28    let
    1.29      (* TODO: sanity checks on arguments *)
    1.30 @@ -1387,14 +1387,15 @@
    1.31            else derive_and_note_coinduct_unfold_corec_thms_for_types);
    1.32  
    1.33      val timer = time (timer ("Constructors, discriminators, selectors, etc., for the new " ^
    1.34 -      (if lfp then "" else "co") ^ "datatype"));
    1.35 +      datatype_word lfp));
    1.36    in
    1.37      timer; lthy'
    1.38    end;
    1.39  
    1.40 -val datatypes = define_datatypes (K I) (K I) (K I);
    1.41 +val co_datatypes = define_co_datatypes (K I) (K I) (K I);
    1.42  
    1.43 -val datatype_cmd = define_datatypes Typedecl.read_constraint Syntax.parse_typ Syntax.parse_term;
    1.44 +val co_datatype_cmd =
    1.45 +  define_co_datatypes Typedecl.read_constraint Syntax.parse_typ Syntax.parse_term;
    1.46  
    1.47  val parse_ctr_arg =
    1.48    @{keyword "("} |-- parse_binding_colon -- Parse.typ --| @{keyword ")"} ||
    1.49 @@ -1436,8 +1437,8 @@
    1.50    parse_type_args_named_constrained -- parse_binding -- parse_map_rel_bindings --
    1.51    Parse.opt_mixfix -- (@{keyword "="} |-- Parse.enum1 "|" parse_ctr_spec);
    1.52  
    1.53 -val parse_datatype = parse_wrap_options -- Parse.and_list1 parse_spec;
    1.54 +val parse_co_datatype = parse_wrap_options -- Parse.and_list1 parse_spec;
    1.55  
    1.56 -fun parse_datatype_cmd lfp construct_fp = parse_datatype >> datatype_cmd lfp construct_fp;
    1.57 +fun parse_co_datatype_cmd lfp construct_fp = parse_co_datatype >> co_datatype_cmd lfp construct_fp;
    1.58  
    1.59  end;
     2.1 --- a/src/HOL/BNF/Tools/bnf_fp_util.ML	Thu May 02 15:28:11 2013 +0200
     2.2 +++ b/src/HOL/BNF/Tools/bnf_fp_util.ML	Thu May 02 16:14:14 2013 +0200
     2.3 @@ -120,6 +120,8 @@
     2.4    val mk_dtor_set_inductN: int -> string
     2.5    val mk_set_inductN: int -> string
     2.6  
     2.7 +  val datatype_word: bool -> string
     2.8 +
     2.9    val base_name_of_typ: typ -> string
    2.10    val mk_common_name: string list -> string
    2.11  
    2.12 @@ -320,6 +322,8 @@
    2.13  val sel_unfoldN = selN ^ "_" ^ unfoldN
    2.14  val sel_corecN = selN ^ "_" ^ corecN
    2.15  
    2.16 +fun datatype_word lfp = (if lfp then "" else "co") ^ "datatype";
    2.17 +
    2.18  fun add_components_of_typ (Type (s, Ts)) =
    2.19      fold add_components_of_typ Ts #> cons (Long_Name.base_name s)
    2.20    | add_components_of_typ _ = I;
     3.1 --- a/src/HOL/BNF/Tools/bnf_gfp.ML	Thu May 02 15:28:11 2013 +0200
     3.2 +++ b/src/HOL/BNF/Tools/bnf_gfp.ML	Thu May 02 16:14:14 2013 +0200
     3.3 @@ -3040,6 +3040,6 @@
     3.4  
     3.5  val _ =
     3.6    Outer_Syntax.local_theory @{command_spec "codatatype"} "define BNF-based coinductive datatypes"
     3.7 -    (parse_datatype_cmd false construct_gfp);
     3.8 +    (parse_co_datatype_cmd false construct_gfp);
     3.9  
    3.10  end;
     4.1 --- a/src/HOL/BNF/Tools/bnf_lfp.ML	Thu May 02 15:28:11 2013 +0200
     4.2 +++ b/src/HOL/BNF/Tools/bnf_lfp.ML	Thu May 02 16:14:14 2013 +0200
     4.3 @@ -1862,6 +1862,6 @@
     4.4  
     4.5  val _ =
     4.6    Outer_Syntax.local_theory @{command_spec "datatype_new"} "define BNF-based inductive datatypes"
     4.7 -    (parse_datatype_cmd true construct_lfp);
     4.8 +    (parse_co_datatype_cmd true construct_lfp);
     4.9  
    4.10  end;