[m-dev.] for review: make unboxed enums and no-tag types optional

[Tyson Dowd]

On 09-Aug-2000, David Overton <dmo at cs.mu.OZ.AU> wrote:
> On Wed, Aug 09, 2000 at 01:19:56PM +1000, Tyson Dowd wrote:
> > --- compiler/make_tags.m	2000/03/10 13:37:46	1.30
> > +++ compiler/make_tags.m	2000/08/08 06:48:27
> > @@ -78,6 +81,7 @@
> >  		(
> >  			% assign single functor of arity one a `no_tag' tag
> >  			% (unless it is type_info/1)
> > +			globals__lookup_bool_option(Globals, no_tag_types, yes),
> >  			type_is_no_tag_type(Ctors, SingleFunc, SingleArg)
> >  		->
> >  			make_cons_id_from_qualified_sym_name(SingleFunc,
> 
> I think there are other places where you will need to do this test,  e.g.
> `mode_util:mode_to_arg_mode'.

Good point.

Here's a diff that addresses the use of type_is_no_tag_type as well.

===================================================================


Estimated hours taken: 1

Add options for 
	unboxed_enums	- turns on unboxed enums (default is yes)
	no_tag_types	- turns on no_tag_types (default is yes)

Currently every grade uses these representations.

We will set these to `no' on the IL backend (and probably the Java
backend) if using a simple implementation of the the Array of Object
representation for Mercury data structures.

compiler/make_tags.m:
	Check for these options when creating representations.

compiler/options.m:
	Add the new options.

compiler/type_util.m:
	Make sure type_is_no_tag_type checks the appropriate option.
	Add a new predicate type_constructors_are_no_tag_type which just
	does a check of the structure of the constructors (you have to
	do the option checking yourself).

compiler/higher_order.m:
compiler/mode_util.m:
	Use the new type_is_no_tag_type (this actually simplifies the
	code).

compiler/type_ctor_info.m:
	Use type_constructors_are_no_tag_type and check the globals.


Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.66
diff -u -r1.66 higher_order.m
--- compiler/higher_order.m	2000/08/08 04:44:35	1.66
+++ compiler/higher_order.m	2000/08/09 04:25:24
@@ -1717,8 +1717,8 @@
 		% be implemented in C code in the runtime system.
 
 		specializeable_special_call(SpecialId, CalledProc),
-		type_constructors(SpecialPredType, ModuleInfo, Constructors),
-		type_is_no_tag_type(Constructors, Constructor, WrappedType),
+		type_is_no_tag_type(ModuleInfo, SpecialPredType, 
+			Constructor, WrappedType),
 		\+ type_has_user_defined_equality_pred(ModuleInfo,
 			WrappedType, _),
 
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.30
diff -u -r1.30 make_tags.m
--- compiler/make_tags.m	2000/03/10 13:37:46	1.30
+++ compiler/make_tags.m	2000/08/09 04:43:07
@@ -69,6 +69,9 @@
 		% now assign them
 	map__init(CtorTags0),
 	(
+			% All the constructors must be constant, and we
+			% must be allowed to make unboxed enums.
+		globals__lookup_bool_option(Globals, unboxed_enums, yes),
 		ctors_are_all_constants(Ctors)
 	->
 		IsEnum = yes,
@@ -78,7 +81,9 @@
 		(
 			% assign single functor of arity one a `no_tag' tag
 			% (unless it is type_info/1)
-			type_is_no_tag_type(Ctors, SingleFunc, SingleArg)
+			globals__lookup_bool_option(Globals, no_tag_types, yes),
+			type_constructors_are_no_tag_type(Ctors, SingleFunc,
+				SingleArg)
 		->
 			make_cons_id_from_qualified_sym_name(SingleFunc,
 				[SingleArg], SingleConsId),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.125
diff -u -r1.125 mode_util.m
--- compiler/mode_util.m	2000/08/08 04:44:45	1.125
+++ compiler/mode_util.m	2000/08/09 04:30:20
@@ -328,8 +328,7 @@
 	%
 	(
 		% is this a no_tag type?
-		type_constructors(Type, ModuleInfo, Constructors),
-		type_is_no_tag_type(Constructors, FunctorName, ArgType),
+		type_is_no_tag_type(ModuleInfo, Type, FunctorName, ArgType),
 		% avoid infinite recursion
 		type_to_type_id(Type, TypeId, _TypeArgs),
 		\+ list__member(TypeId, ContainingTypes)
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.285
diff -u -r1.285 options.m
--- compiler/options.m	2000/07/25 09:27:24	1.285
+++ compiler/options.m	2000/08/08 06:45:31
@@ -166,6 +166,8 @@
 		;	highlevel_data
 		;	gcc_nested_functions
 		;	unboxed_float
+		;       unboxed_enums
+		;       no_tag_types
 		;	sync_term_size % in words
 		;	type_layout
 	% Options for internal use only
@@ -561,7 +563,9 @@
 	highlevel_code		-	bool(no),
 	highlevel_data		-	bool(no),
 	gcc_nested_functions	-	bool(no),
-	unboxed_float		-	bool(no)
+	unboxed_float           -       bool(no),
+	unboxed_enums           -       bool(yes),
+	no_tag_types            -       bool(yes)
 ]).
 option_defaults_2(code_gen_option, [
 		% Code Generation Options
@@ -935,7 +939,10 @@
 long_option("high-level-data",		highlevel_data).
 long_option("gcc-nested-functions",	gcc_nested_functions).
 long_option("unboxed-float",		unboxed_float).
+long_option("unboxed-enums",           unboxed_enums).
+long_option("no-tag-types",            no_tag_types).
 
+
 % code generation options
 long_option("low-level-debug",		low_level_debug).
 long_option("polymorphism",		polymorphism).
@@ -1931,7 +1938,16 @@
 		"\tThe C code needs to be compiled with `-UBOXED_FLOAT'.",
 		"\tIt may also need to be compiled with",
 		"\t`-DUSE_SINGLE_PREC_FLOAT', if double precision",
-		"\tfloats don't fit into a word."
+		"\tfloats don't fit into a word.",
+
+		"--unboxed-enums",
+		"(This option is not for general use.)",
+		"\tDon't box enumerations.  This option is set by default.",
+
+		"--no-tag-types",
+		"(This option is not for general use.)",
+		"\tDon't allow unboxed no-tag types.",
+		"\tThis option is set by default."
 	]).
 
 :- pred options_help_code_generation(io__state::di, io__state::uo) is det.
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.8
diff -u -r1.8 type_ctor_info.m
--- compiler/type_ctor_info.m	2000/07/27 04:41:44	1.8
+++ compiler/type_ctor_info.m	2000/08/09 04:48:40
@@ -247,6 +247,7 @@
 type_ctor_info__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
 		ModuleInfo, TypeCtorRep, NumFunctors,
 		FunctorsInfo, LayoutInfo, NumPtags, TypeTables) :-
+	module_info_globals(ModuleInfo, Globals),
 	hlds_data__get_type_defn_body(HldsDefn, TypeBody),
 	(
 		TypeBody = uu_type(_Alts),
@@ -297,7 +298,11 @@
 			NumPtags = -1
 		;
 			Enum = no,
-			( type_is_no_tag_type(Ctors, Name, ArgType) ->
+			globals__lookup_bool_option(Globals, no_tag_types,
+				NoTagOption),
+			( NoTagOption = yes,
+			  type_constructors_are_no_tag_type(Ctors, Name,
+			  	ArgType) ->
 				( term__is_ground(ArgType) ->
 					Inst = equiv_type_is_ground
 				;
@@ -309,7 +314,6 @@
 					TypeTables, FunctorsInfo, LayoutInfo),
 				NumPtags = -1
 			;
-				module_info_globals(ModuleInfo, Globals),
 				globals__lookup_int_option(Globals,
 					num_tag_bits, NumTagBits),
 				int__pow(2, NumTagBits, NumTags),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.85
diff -u -r1.85 type_util.m
--- compiler/type_util.m	2000/07/25 09:27:27	1.85
+++ compiler/type_util.m	2000/08/09 04:42:08
@@ -211,16 +211,29 @@
 			(type)		% functor result type
 		).
 
-	% Given a list of constructors for a type,
-	% check whether that type is a no_tag type
+	% Check whether a type is a no_tag type
 	% (i.e. one with only one constructor, and
 	% whose one constructor has only one argument,
 	% and which is not private_builtin:type_info/1),
 	% and if so, return its constructor symbol and argument type.
 
-:- pred type_is_no_tag_type(list(constructor), sym_name, type).
-:- mode type_is_no_tag_type(in, out, out) is semidet.
+:- pred type_is_no_tag_type(module_info, type, sym_name, type).
+:- mode type_is_no_tag_type(in, in, out, out) is semidet.
 
+	% Check whether some constructors are a no_tag type
+	% (i.e. one with only one constructor, and
+	% whose one constructor has only one argument,
+	% and which is not private_builtin:type_info/1),
+	% and if so, return its constructor symbol and argument type.
+	%
+	% This doesn't do any checks for options that might be set
+	% (such as turning off no_tag_types).  If you want those checks
+	% you should use type_is_no_tag_type/4, or if you really know
+	% what you are doing, perform the checks yourself.
+
+:- pred type_constructors_are_no_tag_type(list(constructor), sym_name, type).
+:- mode type_constructors_are_no_tag_type(in, out, out) is semidet.
+
 	% Unify (with occurs check) two types with respect to a type
 	% substitution and update the type bindings.
 	% The third argument is a list of type variables which cannot
@@ -385,7 +398,7 @@
 
 :- implementation.
 
-:- import_module prog_io, prog_io_goal, prog_util.
+:- import_module prog_io, prog_io_goal, prog_util, options, globals.
 :- import_module bool, char, int, string.
 :- import_module assoc_list, require, std_util, varset.
 
@@ -806,6 +819,14 @@
 	
 %-----------------------------------------------------------------------------%
 
+type_is_no_tag_type(ModuleInfo, Type, Ctor, ArgType) :-
+		% Make sure no_tag_types are allowed
+	module_info_globals(ModuleInfo, Globals),
+	globals__lookup_bool_option(Globals, no_tag_types, yes),
+		% Check for a single ctor with a single arg
+	type_constructors(Type, ModuleInfo, Ctors),
+	type_constructors_are_no_tag_type(Ctors, Ctor, ArgType).
+
 	% The checks for type_info and type_ctor_info
 	% are needed because those types lie about their
 	% arity; it might be cleaner to change that in
@@ -815,11 +836,11 @@
 	% etc. rather than just checking the unqualified type name,
 	% but I found it difficult to verify that the constructors
 	% would always be fully module-qualified at points where
-	% type_is_no_tag_type/3 is called.
+	% type_constructors_are_no_tag_type/3 is called.
 
-type_is_no_tag_type(Ctors, Ctor, Type) :-
+type_constructors_are_no_tag_type(Ctors, Ctor, ArgType) :-
 	Ctors = [SingleCtor],
-	SingleCtor = ctor(ExistQVars, _Constraints, Ctor, [_FieldName - Type]),
+	SingleCtor = ctor(ExistQVars, _Constraints, Ctor, [_FName - ArgType]),
 	ExistQVars = [],
 	unqualify_name(Ctor, Name),
 	Name \= "type_info",


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------