[m-dev.] for review: --no-special-preds

Zoltan Somogyi zs at cs.mu.OZ.AU
Wed Mar 22 15:35:15 AEDT 2000


This is for Fergus or Tyson.

Change the way --no-special-preds works, to prepare for the day (soon) when
unification by RTTI makes it possible to turn on this option and still get
a working program.

compiler/make_hlds.m:
	If --no-special-preds is given, do not define or declare any
	type-specific index or compare predicates, and make the unify
	predicates pseudo_imported. This way, the compiler can generate
	modes of this predicate other than (in,in), but the (in,in) case
	will be handled by RTTI.

	Also, delete an unused predicate.

compiler/type_ctor_info.m:
	Allow the unify, index and compare predicates to not be present.

compiler/unify_proc.m:
	Never lie and generate empty clauses for special preds. Always create
	them as make_hlds asks them to be created; it simply won't ask for
	them with --no-special-preds.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.326
diff -u -b -r1.326 make_hlds.m
--- compiler/make_hlds.m	2000/03/14 11:21:25	1.326
+++ compiler/make_hlds.m	2000/03/21 13:13:20
@@ -1941,21 +1941,6 @@
 		Status = abstract_imported
 	).
 
-:- pred add_special_preds(module_info, tvarset, type, type_id, 
-		hlds_type_body, prog_context, import_status, module_info).
-:- mode add_special_preds(in, in, in, in, in, in, in, out) is det.
-
-add_special_preds(Module0, TVarSet, Type, TypeId,
-			Body, Context, Status, Module) :-
-	special_pred_list(SpecialPredIds),
-	( Body = abstract_type ->
-		add_special_pred_decl_list(SpecialPredIds, Module0, TVarSet,
-				Type, TypeId, Context, Status, Module)
-	;
-		add_special_pred_list(SpecialPredIds, Module0, TVarSet, Type,
-				TypeId, Body, Context, Status, Module)
-	).
-	
 :- pred convert_type_defn(type_defn, globals,
 			sym_name, list(type_param), hlds_type_body).
 :- mode convert_type_defn(in, in, out, out, out) is det.
@@ -2775,8 +2760,28 @@
 			module_info, tvarset, type, type_id, hlds_type_body,
 			prog_context, import_status, module_info).
 :- mode add_special_pred(in, in, in, in, in, in, in, in, out) is det.
+
+add_special_pred(SpecialPredId, Module0, TVarSet, Type, TypeId, TypeBody,
+		Context, Status0, Module) :-
+	module_info_globals(Module0, Globals),
+	globals__lookup_bool_option(Globals, special_preds, GenSpecialPreds),
+	( GenSpecialPreds = yes ->
+		add_special_pred_for_real(SpecialPredId, Module0, TVarSet,
+			Type, TypeId, TypeBody, Context, Status0, Module)
+	; SpecialPredId = unify ->
+		add_special_pred_for_real(SpecialPredId, Module0, TVarSet,
+			Type, TypeId, TypeBody, Context, pseudo_imported,
+			Module)
+	;
+		Module = Module0
+	).
 
-add_special_pred(SpecialPredId,
+:- pred add_special_pred_for_real(special_pred_id,
+			module_info, tvarset, type, type_id, hlds_type_body,
+			prog_context, import_status, module_info).
+:- mode add_special_pred_for_real(in, in, in, in, in, in, in, in, out) is det.
+
+add_special_pred_for_real(SpecialPredId,
 		Module0, TVarSet, Type, TypeId, TypeBody, Context, Status0,
 		Module) :-
 	adjust_special_pred_status(Status0, SpecialPredId, Status),
@@ -2784,7 +2789,7 @@
 	( map__contains(SpecialPredMap0, SpecialPredId - TypeId) ->
 		Module1 = Module0
 	;
-		add_special_pred_decl(SpecialPredId,
+		add_special_pred_decl_for_real(SpecialPredId,
 			Module0, TVarSet, Type, TypeId, Context, Status,
 			Module1)
 	),
@@ -2822,8 +2827,28 @@
 		module_info, tvarset, type, type_id, prog_context,
 		import_status, module_info).
 :- mode add_special_pred_decl(in, in, in, in, in, in, in, out) is det.
+
+add_special_pred_decl(SpecialPredId, Module0, TVarSet, Type, TypeId,
+		Context, Status0, Module) :-
+	module_info_globals(Module0, Globals),
+	globals__lookup_bool_option(Globals, special_preds, GenSpecialPreds),
+	( GenSpecialPreds = yes ->
+		add_special_pred_decl_for_real(SpecialPredId, Module0,
+			TVarSet, Type, TypeId, Context, Status0, Module)
+	; SpecialPredId = unify ->
+		add_special_pred_decl_for_real(SpecialPredId, Module0,
+			TVarSet, Type, TypeId, Context, pseudo_imported,
+			Module)
+	;
+		Module = Module0
+	).
+
+:- pred add_special_pred_decl_for_real(special_pred_id,
+		module_info, tvarset, type, type_id, prog_context,
+		import_status, module_info).
+:- mode add_special_pred_decl_for_real(in, in, in, in, in, in, in, out) is det.
 
-add_special_pred_decl(SpecialPredId,
+add_special_pred_decl_for_real(SpecialPredId,
 			Module0, TVarSet, Type, TypeId, Context, Status0,
 			Module) :-
 	module_info_name(Module0, ModuleName),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.1
diff -u -b -r1.1 type_ctor_info.m
--- compiler/type_ctor_info.m	2000/03/10 13:37:54	1.1
+++ compiler/type_ctor_info.m	2000/03/21 13:33:41
@@ -120,22 +120,27 @@
 		ModuleName, ModuleInfo, TypeCtorGenInfo) :-
 	hlds_data__get_type_defn_status(TypeDefn, Status),
 	module_info_get_special_pred_map(ModuleInfo, SpecMap),
-
-	map__lookup(SpecMap, unify - TypeId, UnifyPredId),
+	( map__search(SpecMap, unify - TypeId, UnifyPredId) ->
 	special_pred_mode_num(unify, UnifyProcInt),
 	proc_id_to_int(UnifyProcId, UnifyProcInt),
-	MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
-
-	map__lookup(SpecMap, index - TypeId, IndexPredId),
+		MaybeUnify = yes(proc(UnifyPredId, UnifyProcId))
+	;
+		MaybeUnify = no
+	),
+	( map__search(SpecMap, index - TypeId, IndexPredId) ->
 	special_pred_mode_num(index, IndexProcInt),
 	proc_id_to_int(IndexProcId, IndexProcInt),
-	MaybeIndex = yes(proc(IndexPredId, IndexProcId)),
-
-	map__lookup(SpecMap, compare - TypeId, ComparePredId),
+		MaybeIndex = yes(proc(IndexPredId, IndexProcId))
+	;
+		MaybeIndex = no
+	),
+	( map__search(SpecMap, compare - TypeId, ComparePredId) ->
 	special_pred_mode_num(compare, CompareProcInt),
 	proc_id_to_int(CompareProcId, CompareProcInt),
-	MaybeCompare = yes(proc(ComparePredId, CompareProcId)),
-
+		MaybeCompare = yes(proc(ComparePredId, CompareProcId))
+	;
+		MaybeCompare = no
+	),
 	TypeCtorGenInfo = type_ctor_gen_info(TypeId, ModuleName,
 		TypeName, TypeArity, Status, TypeDefn,
 		MaybeUnify, MaybeIndex, MaybeCompare,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.80
diff -u -b -r1.80 unify_proc.m
--- compiler/unify_proc.m	2000/02/08 06:59:29	1.80
+++ compiler/unify_proc.m	2000/03/21 13:11:15
@@ -468,8 +468,6 @@
 
 unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, Context,
 		ModuleInfo, ClauseInfo) :-
-	module_info_globals(ModuleInfo, Globals),
-	globals__lookup_bool_option(Globals, special_preds, SpecialPredsOpt),
 	( TypeBody = eqv_type(EqvType) ->
 		HeadVarType = EqvType
 	;
@@ -480,7 +478,6 @@
 	unify_proc__info_init(ModuleInfo, VarTypeInfo0),
 	unify_proc__make_fresh_named_vars_from_types(ArgTypes, "HeadVar__", 1,
 		Args, VarTypeInfo0, VarTypeInfo1),
-	( SpecialPredsOpt = yes ->
 		( SpecialPredId = unify, Args = [H1, H2] ->
 			unify_proc__generate_unify_clauses(TypeBody, H1, H2,
 				Context, Clauses, VarTypeInfo1, VarTypeInfo)
@@ -494,10 +491,6 @@
 				VarTypeInfo)
 		;
 			error("unknown special pred")
-		)
-	;
-		Clauses = [],
-		VarTypeInfo = VarTypeInfo1
 	),
 	unify_proc__info_extract(VarTypeInfo, VarSet, Types),
 	map__init(TI_VarMap),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: [15:13:22] waiting for zs's lock in /home/mercury1/repository/mercury/samples/rot13
cvs diff: [15:13:52] obtained lock in /home/mercury1/repository/mercury/samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the developers mailing list