remove unused selector field from type arg
authorhuffman
Tue Mar 02 15:06:02 2010 -0800 (2010-03-02)
changeset 35519abf45a91d24d
parent 35518 3b20559d809b
child 35520 f433f18d4c41
remove unused selector field from type arg
src/HOLCF/Tools/Domain/domain_extender.ML
src/HOLCF/Tools/Domain/domain_library.ML
     1.1 --- a/src/HOLCF/Tools/Domain/domain_extender.ML	Tue Mar 02 14:59:24 2010 -0800
     1.2 +++ b/src/HOLCF/Tools/Domain/domain_extender.ML	Tue Mar 02 15:06:02 2010 -0800
     1.3 @@ -158,8 +158,7 @@
     1.4          (Binding.name_of con,  (* FIXME preverse binding (!?) *)
     1.5           mx,
     1.6           ListPair.map (fn ((lazy,sel,tp),vn) =>
     1.7 -           mk_arg ((lazy, Datatype_Aux.dtyp_of_typ new_dts tp),
     1.8 -                   Option.map Binding.name_of sel,vn))
     1.9 +           mk_arg ((lazy, Datatype_Aux.dtyp_of_typ new_dts tp), vn))
    1.10                        (args, Datatype_Prop.make_tnames (map third args))
    1.11          ) : cons;
    1.12      val eqs : eq list =
    1.13 @@ -230,8 +229,7 @@
    1.14          (Binding.name_of con,   (* FIXME preverse binding (!?) *)
    1.15           mx,
    1.16           ListPair.map (fn ((lazy,sel,tp),vn) =>
    1.17 -           mk_arg ((lazy, Datatype_Aux.dtyp_of_typ new_dts tp),
    1.18 -                   Option.map Binding.name_of sel,vn))
    1.19 +           mk_arg ((lazy, Datatype_Aux.dtyp_of_typ new_dts tp), vn))
    1.20                        (args, Datatype_Prop.make_tnames (map third args))
    1.21          ) : cons;
    1.22      val eqs : eq list =
     2.1 --- a/src/HOLCF/Tools/Domain/domain_library.ML	Tue Mar 02 14:59:24 2010 -0800
     2.2 +++ b/src/HOLCF/Tools/Domain/domain_library.ML	Tue Mar 02 15:06:02 2010 -0800
     2.3 @@ -95,11 +95,10 @@
     2.4        eqtype arg;
     2.5    type cons = string * mixfix * arg list;
     2.6    type eq = (string * typ list) * cons list;
     2.7 -  val mk_arg : (bool * Datatype.dtyp) * string option * string -> arg;
     2.8 +  val mk_arg : (bool * Datatype.dtyp) * string -> arg;
     2.9    val is_lazy : arg -> bool;
    2.10    val rec_of : arg -> int;
    2.11    val dtyp_of : arg -> Datatype.dtyp;
    2.12 -  val sel_of : arg -> string option;
    2.13    val vname : arg -> string;
    2.14    val upd_vname : (string -> string) -> arg -> arg;
    2.15    val is_rec : arg -> bool;
    2.16 @@ -186,7 +185,6 @@
    2.17  
    2.18  type arg =
    2.19       (bool * Datatype.dtyp) *   (*  (lazy, recursive element) *)
    2.20 -     string option *               (*   selector name    *)
    2.21       string;                       (*   argument name    *)
    2.22  
    2.23  type cons =
    2.24 @@ -201,15 +199,14 @@
    2.25  
    2.26  val mk_arg = I;
    2.27  
    2.28 -fun rec_of ((_,dtyp),_,_) =
    2.29 +fun rec_of ((_,dtyp),_) =
    2.30      case dtyp of Datatype_Aux.DtRec i => i | _ => ~1;
    2.31  (* FIXME: what about indirect recursion? *)
    2.32  
    2.33 -fun is_lazy arg = fst (first arg);
    2.34 -fun dtyp_of arg = snd (first arg);
    2.35 -val sel_of    =       second;
    2.36 -val     vname =       third;
    2.37 -val upd_vname =   upd_third;
    2.38 +fun is_lazy arg = fst (fst arg);
    2.39 +fun dtyp_of arg = snd (fst arg);
    2.40 +val     vname =       snd;
    2.41 +val upd_vname =   apsnd;
    2.42  fun is_rec         arg = rec_of arg >=0;
    2.43  fun is_nonlazy_rec arg = is_rec arg andalso not (is_lazy arg);
    2.44  fun nonlazy     args   = map vname (filter_out is_lazy args);
    2.45 @@ -229,7 +226,7 @@
    2.46  fun big_sprodD ds = case ds of [] => oneD | _ => foldr1 mk_sprodD ds;
    2.47  fun big_ssumD ds = case ds of [] => unitD | _ => foldr1 mk_ssumD ds;
    2.48  
    2.49 -fun dtyp_of_arg ((lazy, D), _, _) = if lazy then mk_uD D else D;
    2.50 +fun dtyp_of_arg ((lazy, D), _) = if lazy then mk_uD D else D;
    2.51  fun dtyp_of_cons (_, _, args) = big_sprodD (map dtyp_of_arg args);
    2.52  fun dtyp_of_eq (_, cons) = big_ssumD (map dtyp_of_cons cons);
    2.53