[m-rev.] for post-commit review: ground terms as constant structures
Zoltan Somogyi
zs at unimelb.edu.au
Mon Jun 11 13:12:13 AEST 2012
For post-commit review by anyone.
Zoltan.
If the backend supports constant structures, and we do not need unifications
to retain their original shapes, then convert each from_ground_term scope
into a unification with a cons_id that represents the ground term being
built up.
This speeds up the compilation of training_cars_full.m by about 6%.
compiler/simplify.m:
Make the conversion if enabled. By doing the conversion in this phase,
we don't have to teach the semantic analysis passes about unifications
with the new cons_id, but we do get the benefit of later passes being
faster, because they have less code to process.
compiler/const_struct.m:
The declarative debugger does not yet know how to handle the new
cons_id, so do not introduce it if we are preparing for declarative
debugging.
compiler/trace_params.m:
Export a predicate for const_struct.m.
compiler/prog_data.m:
Add the new cons_id, ground_term_const.
compiler/hlds_data.m:
Add the tag of the new cons_id, ground_term_const_tag.
compiler/hlds_code_util.m:
Convert the new cons_id to the new cons_tag.
Fix an old problem with that conversion process: it always converted
tuple_cons to single_functor_tag. However, arity-zero tuples are
(dummy) constants, not heap cells, so we now convert them to a (dummy)
integer tag. This matters now because the process that generates
code (actually data) for constant structures handles the cons_tags that
build constants and heap cells separately. As a side benefit, we
no longer reserve a word-sized heap cell for arity-zero tuples.
compiler/unify_gen.m:
compiler/ml_unify_gen.m:
Implement the generation of code for arbitrary constant structures,
not just those that can implement typeinfos and typeclass_infos.
compiler/term_norm.m:
Compute the sizes of ground terms for each of our norms.
compiler/term_traversal.m:
Manage the computation of sizes of ground terms.
Simplify and thereby speed up a predicate.
compiler/term_constr_build.m:
Note that we should manage the computation of sizes of ground terms.
compiler/term_util.m:
Simplify the style of a predicate.
compiler/layout.m:
Give some field names prefixes to avoid ambiguities.
compiler/bytecode_gen.m:
compiler/ctgc.selector.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/erl_unify_gen.m:
compiler/export.m:
compiler/higher_order.m:
compiler/hlds_out_mode.m:
compiler/hlds_out_util.m:
compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/mercury_to_mercury.m:
compiler/ml_global_data.m:
compiler/ml_type_gen.m:
compiler/mode_util.m:
compiler/module_qual.m:
compiler/polymorphism.m:
compiler/prog_rep.m:
compiler/prog_type.m:
compiler/prog_util.m:
compiler/rbmm.execution_path.m:
compiler/switch_gen.m:
compiler/switch_util.m:
compiler/type_ctor_info.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the changes above.
tests/hard_coded/ground_terms.{m,exp}:
A new test case to test the handling of ground terms.
tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing analysis
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/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.133
diff -u -b -r1.133 bytecode_gen.m
--- compiler/bytecode_gen.m 8 Jun 2012 15:36:54 -0000 1.133
+++ compiler/bytecode_gen.m 11 Jun 2012 03:03:01 -0000
@@ -781,6 +781,9 @@
ConsId = typeclass_info_const(_),
sorry($module, $pred, "bytecode doesn't implement typeclass_info_const")
;
+ ConsId = ground_term_const(_, _),
+ sorry($module, $pred, "bytecode doesn't implement ground_term_const")
+ ;
ConsId = tabling_info_const(_),
sorry($module, $pred, "bytecode cannot implement tabling")
;
@@ -828,6 +831,9 @@
map_cons_tag(typeclass_info_const_tag(_), _) :-
unexpected($module, $pred, "typeclass_info_const cons tag " ++
"for non-typeclass_info_const cons id").
+map_cons_tag(ground_term_const_tag(_, _), _) :-
+ unexpected($module, $pred, "ground_term_const cons tag " ++
+ "for non-ground_term_const cons id").
map_cons_tag(tabling_info_tag(_, _), _) :-
unexpected($module, $pred, "tabling_info_tag cons tag " ++
"for non-tabling_info_constant cons id").
Index: compiler/const_struct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/const_struct.m,v
retrieving revision 1.2
diff -u -b -r1.2 const_struct.m
--- compiler/const_struct.m 9 Jun 2012 04:45:38 -0000 1.2
+++ compiler/const_struct.m 11 Jun 2012 03:03:01 -0000
@@ -50,7 +50,7 @@
:- type const_instance_id
---> ciid(
- % The instance number. This is first because tests on it
+ % The instance number. This field is first because tests on it
% are cheap.
int,
@@ -67,14 +67,18 @@
%
:- pred const_struct_db_init(globals::in, const_struct_db::out) is det.
- % Return whether the generation of separate constant structures is enabled.
- % If it is not, the lookup_insert_const_struct and
- % const_struct_db_get_structs predicates should never be called.
- %
-:- pred const_struct_db_get_enabled(const_struct_db::in, bool::out) is det.
+ % Return whether the generation of separate constant structures is enabled
+ % for (a) structures created by polymorphism, and (b) for structures
+ % created in from_ground_term_construct scopes. If it is not, then
+ % lookup_insert_const_struct should not be called from polymorphism.m
+ % and simplify.m respectively.
+ %
+:- pred const_struct_db_get_poly_enabled(const_struct_db::in,
+ bool::out) is det.
+:- pred const_struct_db_get_ground_term_enabled(const_struct_db::in,
+ bool::out) is det.
- % Look up a constant structure in the database. If it is not there,
- % add it.
+ % Look up a constant structure in the database. If it is not there, add it.
%
:- pred lookup_insert_const_struct(const_struct::in, int::out,
const_struct_db::in, const_struct_db::out) is det.
@@ -114,6 +118,7 @@
:- implementation.
:- import_module libs.options.
+:- import_module libs.trace_params.
:- import_module int.
:- import_module pair.
@@ -130,16 +135,40 @@
(
Tags = tags_low,
globals.lookup_bool_option(Globals, enable_const_struct,
- Enabled)
+ OptionEnabled),
+ PolyEnabled = OptionEnabled,
+
+ globals.get_trace_level(Globals, TraceLevel),
+ globals.get_trace_suppress(Globals, TraceSuppress),
+ Bodies = trace_needs_proc_body_reps(TraceLevel, TraceSuppress),
+ (
+ Bodies = no,
+ GroundTermEnabled = OptionEnabled
+ ;
+ Bodies = yes,
+ % We generate representations of procedure bodies for the
+ % declarative debugger and for the profiler. When
+ % traverse_primitives in browser/declarative_tree.m
+ % looks for the Nth argument of variable X and X is built
+ % with a unification such as X = ground_term_const(...),
+ % it crashes. It should be taught not to do that,
+ % but in the meantime, we prevent the situation from
+ % arising in the first place. (We never look for the
+ % original sources of type infos and typeclass infos,
+ % so we can use constant structures for them.)
+ GroundTermEnabled = no
+ )
;
( Tags = tags_high
; Tags = tags_none
),
- Enabled = no
+ PolyEnabled = no,
+ GroundTermEnabled = no
)
;
HighLevelData = yes,
- Enabled = no
+ PolyEnabled = no,
+ GroundTermEnabled = no
)
;
( Target = target_il
@@ -149,9 +178,11 @@
; Target = target_x86_64
; Target = target_erlang
),
- Enabled = no
+ PolyEnabled = no,
+ GroundTermEnabled = no
),
- Db = const_struct_db(Enabled, 0, map.init, map.init, map.init).
+ Db = const_struct_db(PolyEnabled, GroundTermEnabled, 0,
+ map.init, map.init, map.init).
lookup_insert_const_struct(ConstStruct, ConstNum, !Db) :-
const_struct_db_get_struct_map(!.Db, StructMap0),
@@ -162,7 +193,7 @@
% we don't test the enabled flag on every search. We just test
% it on insertions. Without successful insertions, searches
% cannot succeed, so this is enough.
- const_struct_db_get_enabled(!.Db, Enabled),
+ const_struct_db_get_poly_enabled(!.Db, Enabled),
(
Enabled = no,
unexpected($module, $pred, "not enabled")
@@ -210,7 +241,8 @@
:- type const_struct_db
---> const_struct_db(
- csdb_enabled :: bool,
+ csdb_poly_enabled :: bool,
+ csdb_ground_term_enabled :: bool,
csdb_next_num :: int,
csdb_struct_map :: map(const_struct, int),
csdb_num_map :: map(int, const_struct),
@@ -225,7 +257,8 @@
:- pred const_struct_db_get_instance_map(const_struct_db::in,
const_instance_map::out) is det.
-const_struct_db_get_enabled(Db, Db ^ csdb_enabled).
+const_struct_db_get_poly_enabled(Db, Db ^ csdb_poly_enabled).
+const_struct_db_get_ground_term_enabled(Db, Db ^ csdb_ground_term_enabled).
const_struct_db_get_next_num(Db, Db ^ csdb_next_num).
const_struct_db_get_struct_map(Db, Db ^ csdb_struct_map).
const_struct_db_get_num_map(Db, Db ^ csdb_num_map).
Index: compiler/ctgc.selector.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.35
diff -u -b -r1.35 ctgc.selector.m
--- compiler/ctgc.selector.m 8 Jun 2012 15:46:20 -0000 1.35
+++ compiler/ctgc.selector.m 11 Jun 2012 03:03:01 -0000
@@ -123,6 +123,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = table_io_decl(_)
; ConsId = deep_profiling_proc_layout(_)
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.146
diff -u -b -r1.146 dead_proc_elim.m
--- compiler/dead_proc_elim.m 9 Jun 2012 04:45:39 -0000 1.146
+++ compiler/dead_proc_elim.m 11 Jun 2012 03:03:01 -0000
@@ -644,6 +644,7 @@
;
( ConsId = type_info_const(ConstNum)
; ConsId = typeclass_info_const(ConstNum)
+ ; ConsId = ground_term_const(ConstNum, _)
),
Entity = entity_const_struct(ConstNum),
queue.put(Entity, !Queue),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.112
diff -u -b -r1.112 dependency_graph.m
--- compiler/dependency_graph.m 8 Jun 2012 15:36:54 -0000 1.112
+++ compiler/dependency_graph.m 11 Jun 2012 03:03:01 -0000
@@ -497,6 +497,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = table_io_decl(_)
; ConsId = deep_profiling_proc_layout(_)
Index: compiler/erl_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_unify_gen.m,v
retrieving revision 1.20
diff -u -b -r1.20 erl_unify_gen.m
--- compiler/erl_unify_gen.m 8 Jun 2012 15:46:20 -0000 1.20
+++ compiler/erl_unify_gen.m 11 Jun 2012 03:03:01 -0000
@@ -328,6 +328,9 @@
ConsId = typeclass_info_const(_),
unexpected($module, $pred, "typeclass_info_const")
;
+ ConsId = ground_term_const(_, _),
+ unexpected($module, $pred, "ground_term_const")
+ ;
( ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.133
diff -u -b -r1.133 export.m
--- compiler/export.m 8 Jun 2012 15:36:55 -0000 1.133
+++ compiler/export.m 11 Jun 2012 03:03:01 -0000
@@ -925,6 +925,7 @@
; TagVal = base_typeclass_info_tag(_, _, _)
; TagVal = type_info_const_tag(_)
; TagVal = typeclass_info_const_tag(_)
+ ; TagVal = ground_term_const_tag(_, _)
; TagVal = tabling_info_tag(_, _)
; TagVal = deep_profiling_proc_layout_tag(_, _)
; TagVal = table_io_decl_tag(_, _)
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.203
diff -u -b -r1.203 higher_order.m
--- compiler/higher_order.m 8 Jun 2012 15:36:55 -0000 1.203
+++ compiler/higher_order.m 11 Jun 2012 03:03:01 -0000
@@ -914,6 +914,7 @@
; ConsId = char_const(_)
; ConsId = string_const(_)
; ConsId = impl_defined_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.48
diff -u -b -r1.48 hlds_code_util.m
--- compiler/hlds_code_util.m 8 Jun 2012 15:36:55 -0000 1.48
+++ compiler/hlds_code_util.m 11 Jun 2012 03:03:01 -0000
@@ -108,6 +108,10 @@
ConsId = typeclass_info_const(TCIConstNum),
Tag = typeclass_info_const_tag(TCIConstNum)
;
+ ConsId = ground_term_const(ConstNum, SubConsId),
+ SubConsTag = cons_id_to_tag(ModuleInfo, SubConsId),
+ Tag = ground_term_const_tag(ConstNum, SubConsTag)
+ ;
ConsId = tabling_info_const(ShroudedPredProcId),
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
Tag = tabling_info_tag(PredId, ProcId)
@@ -120,11 +124,15 @@
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
Tag = table_io_decl_tag(PredId, ProcId)
;
- ConsId = tuple_cons(_Arity),
+ ConsId = tuple_cons(Arity),
% Tuples do not need a tag. Note that unary tuples are not treated
% as no_tag types. There is no reason why they couldn't be, it is
% just not worth the effort.
+ ( Arity = 0 ->
+ Tag = int_tag(0)
+ ;
Tag = single_functor_tag
+ )
;
ConsId = cons(_Name, _Arity, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeTable),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.145
diff -u -b -r1.145 hlds_data.m
--- compiler/hlds_data.m 8 Jun 2012 15:36:55 -0000 1.145
+++ compiler/hlds_data.m 11 Jun 2012 03:03:01 -0000
@@ -619,6 +619,8 @@
; type_info_const_tag(int)
; typeclass_info_const_tag(int)
+ ; ground_term_const_tag(int, cons_tag)
+
; tabling_info_tag(pred_id, proc_id)
% This is how we refer to the global structures containing
% tabling pointer variables and related data. The word just
@@ -772,6 +774,9 @@
),
MaybePrimaryTag = no
;
+ Tag = ground_term_const_tag(_, SubTag),
+ MaybePrimaryTag = get_primary_tag(SubTag)
+ ;
Tag = single_functor_tag,
MaybePrimaryTag = yes(0)
;
@@ -808,6 +813,9 @@
),
MaybeSecondaryTag = no
;
+ Tag = ground_term_const_tag(_, SubTag),
+ MaybeSecondaryTag = get_secondary_tag(SubTag)
+ ;
( Tag = shared_remote_tag(_PrimaryTag, SecondaryTag)
; Tag = shared_local_tag(_PrimaryTag, SecondaryTag)
),
Index: compiler/hlds_out_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_mode.m,v
retrieving revision 1.9
diff -u -b -r1.9 hlds_out_mode.m
--- compiler/hlds_out_mode.m 8 Jun 2012 15:36:56 -0000 1.9
+++ compiler/hlds_out_mode.m 11 Jun 2012 03:03:01 -0000
@@ -577,17 +577,31 @@
Term = term.functor(term.string(FunctorName), [], Context)
;
ConsId = type_info_const(TIConstNum),
+ expect(unify(ArgTerms, []), $module, $pred,
+ "type_info_const arity != 0"),
term.context_init(Context),
FunctorName = "type_info_const",
Arg = term.functor(term.integer(TIConstNum), [], Context),
Term = term.functor(term.string(FunctorName), [Arg], Context)
;
ConsId = typeclass_info_const(TCIConstNum),
+ expect(unify(ArgTerms, []), $module, $pred,
+ "typeclass_info_const arity != 0"),
term.context_init(Context),
FunctorName = "typeclass_info_const",
Arg = term.functor(term.integer(TCIConstNum), [], Context),
Term = term.functor(term.string(FunctorName), [Arg], Context)
;
+ ConsId = ground_term_const(TCIConstNum, SubConsId),
+ expect(unify(ArgTerms, []), $module, $pred,
+ "ground_term_const arity != 0"),
+ cons_id_and_args_to_term_full(SubConsId, [], SubArg),
+ term.context_init(Context),
+ FunctorName = "ground_term_const",
+ NumArg = term.functor(term.integer(TCIConstNum), [], Context),
+ Term = term.functor(term.string(FunctorName), [NumArg, SubArg],
+ Context)
+ ;
ConsId = tabling_info_const(_),
term.context_init(Context),
FunctorName = "tabling_info_const",
Index: compiler/hlds_out_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_util.m,v
retrieving revision 1.7
diff -u -b -r1.7 hlds_out_util.m
--- compiler/hlds_out_util.m 8 Jun 2012 15:36:56 -0000 1.7
+++ compiler/hlds_out_util.m 11 Jun 2012 03:03:01 -0000
@@ -702,6 +702,12 @@
ConsId = typeclass_info_const(TCIConstNum),
Str = "typeclass_info_const(" ++ int_to_string(TCIConstNum) ++ ")"
;
+ ConsId = ground_term_const(ConstNum, SubConsId),
+ SubStr = functor_cons_id_to_string(SubConsId, [], VarSet,
+ ModuleInfo, AppendVarNums),
+ Str = "ground_term_const(" ++ int_to_string(ConstNum) ++ ", " ++
+ SubStr ++ ")"
+ ;
ConsId = tabling_info_const(ShroudedPredProcId),
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
proc_id_to_int(ProcId, ProcIdInt),
@@ -793,6 +799,9 @@
ConsId = typeclass_info_const(_),
String = "<typeclass_info_const>"
;
+ ConsId = ground_term_const(_, _),
+ String = "<ground_term_const>"
+ ;
ConsId = tabling_info_const(PredProcId),
PredProcId = shrouded_pred_proc_id(PredId, ProcId),
String =
@@ -917,6 +926,9 @@
ConsId = typeclass_info_const(_),
String = "<typeclass_info_const>"
;
+ ConsId = ground_term_const(_, _),
+ String = "<ground_term_const>"
+ ;
ConsId = tabling_info_const(PredProcId),
PredProcId = shrouded_pred_proc_id(PredId, ProcId),
String =
Index: compiler/implementation_defined_literals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implementation_defined_literals.m,v
retrieving revision 1.13
diff -u -b -r1.13 implementation_defined_literals.m
--- compiler/implementation_defined_literals.m 8 Jun 2012 15:36:56 -0000 1.13
+++ compiler/implementation_defined_literals.m 11 Jun 2012 03:03:01 -0000
@@ -111,6 +111,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.18
diff -u -b -r1.18 inst_check.m
--- compiler/inst_check.m 8 Jun 2012 15:36:56 -0000 1.18
+++ compiler/inst_check.m 11 Jun 2012 03:03:01 -0000
@@ -322,6 +322,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
Index: compiler/layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout.m,v
retrieving revision 1.45
diff -u -b -r1.45 layout.m
--- compiler/layout.m 17 Oct 2011 04:31:29 -0000 1.45
+++ compiler/layout.m 11 Jun 2012 03:03:01 -0000
@@ -277,20 +277,20 @@
:- type module_layout_data
---> module_layout_common_data(
% defines MR_ModuleCommonLayout
- module_common_name :: module_name,
- string_table_size :: int,
- string_table :: string_with_0s
+ mlcd_module_common_name :: module_name,
+ mlcd_string_table_size :: int,
+ mlcd_string_table :: string_with_0s
)
; module_layout_data(
% defines MR_ModuleLayout
- module_name :: module_name,
- module_common :: layout_name,
- proc_layout_names :: list(layout_name),
- file_layouts :: list(file_layout_data),
- trace_level :: trace_level,
- suppressed_events :: int,
- num_label_exec_count :: int,
- maybe_event_specs :: maybe(event_set_layout_data)
+ mld_module_name :: module_name,
+ mld_module_common :: layout_name,
+ mld_proc_layout_names :: list(layout_name),
+ mld_file_layouts :: list(file_layout_data),
+ mld_trace_level :: trace_level,
+ mld_suppressed_events :: int,
+ mld_num_label_exec_count :: int,
+ mld_maybe_event_specs :: maybe(event_set_layout_data)
).
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.358
diff -u -b -r1.358 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 8 Jun 2012 15:36:56 -0000 1.358
+++ compiler/mercury_to_mercury.m 11 Jun 2012 03:03:01 -0000
@@ -1676,6 +1676,12 @@
add_string("<typeclass_info_cell_constructor " ++
int_to_string(TCIConstNum) ++ ">", !U)
;
+ ConsId = ground_term_const(ConstNum, SubConsId),
+ add_string("<ground_term_cell_constructor " ++
+ int_to_string(ConstNum) ++ ", ", !U),
+ mercury_format_cons_id(SubConsId, does_not_need_brackets, !U),
+ add_string(">", !U)
+ ;
ConsId = tabling_info_const(_),
add_string("<tabling info>", !U)
;
Index: compiler/ml_global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_global_data.m,v
retrieving revision 1.14
diff -u -b -r1.14 ml_global_data.m
--- compiler/ml_global_data.m 8 Jun 2012 15:46:20 -0000 1.14
+++ compiler/ml_global_data.m 11 Jun 2012 03:03:01 -0000
@@ -784,6 +784,9 @@
ConsId = typeclass_info_const(_),
TypeStr = "typeclass_info_const"
;
+ ConsId = ground_term_const(_, _),
+ TypeStr = "ground_term_const"
+ ;
( ConsId = int_const(_)
; ConsId = float_const(_)
; ConsId = char_const(_)
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.62
diff -u -b -r1.62 ml_switch_gen.m
--- compiler/ml_switch_gen.m 8 Jun 2012 15:46:20 -0000 1.62
+++ compiler/ml_switch_gen.m 11 Jun 2012 03:03:01 -0000
@@ -573,6 +573,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.103
diff -u -b -r1.103 ml_type_gen.m
--- compiler/ml_type_gen.m 8 Jun 2012 15:46:20 -0000 1.103
+++ compiler/ml_type_gen.m 11 Jun 2012 03:03:01 -0000
@@ -322,6 +322,7 @@
; TagVal = base_typeclass_info_tag(_, _, _)
; TagVal = type_info_const_tag(_)
; TagVal = typeclass_info_const_tag(_)
+ ; TagVal = ground_term_const_tag(_, _)
; TagVal = tabling_info_tag(_, _)
; TagVal = deep_profiling_proc_layout_tag(_, _)
; TagVal = table_io_decl_tag(_, _)
@@ -860,6 +861,9 @@
Tag = shared_with_reserved_addresses_tag(_RAs, SubTag),
UsesBaseClass = ml_tag_uses_base_class(SubTag)
;
+ Tag = ground_term_const_tag(_ConstNum, SubTag),
+ UsesBaseClass = ml_tag_uses_base_class(SubTag)
+ ;
( Tag = string_tag(_)
; Tag = float_tag(_)
; Tag = int_tag(_)
@@ -1251,6 +1255,7 @@
; TagVal = base_typeclass_info_tag(_, _, _)
; TagVal = type_info_const_tag(_)
; TagVal = typeclass_info_const_tag(_)
+ ; TagVal = ground_term_const_tag(_, _)
; TagVal = tabling_info_tag(_, _)
; TagVal = deep_profiling_proc_layout_tag(_, _)
; TagVal = table_io_decl_tag(_, _)
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.166
diff -u -b -r1.166 ml_unify_gen.m
--- compiler/ml_unify_gen.m 8 Jun 2012 15:46:20 -0000 1.166
+++ compiler/ml_unify_gen.m 11 Jun 2012 03:03:01 -0000
@@ -351,12 +351,14 @@
)
)
;
+ (
Tag = no_tag,
unexpected($module, $pred, "no_tag: arity != 1")
;
Tag = direct_arg_tag(_),
unexpected($module, $pred, "direct_arg_tag: arity != 1")
)
+ )
;
% Ordinary compound terms.
(
@@ -382,6 +384,7 @@
;
( Tag = type_info_const_tag(ConstNum)
; Tag = typeclass_info_const_tag(ConstNum)
+ ; Tag = ground_term_const_tag(ConstNum, _)
),
ml_gen_info_get_const_struct_map(!.Info, ConstStructMap),
map.lookup(ConstStructMap, ConstNum, GroundTerm0),
@@ -511,6 +514,7 @@
; Tag = closure_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
),
unexpected($module, $pred, "unexpected tag")
).
@@ -1557,6 +1561,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
@@ -1640,9 +1645,11 @@
Offset = offset(1),
ArgNum = 1
;
- Tag = shared_with_reserved_addresses_tag(_, ThisTag),
- % Just recurse on ThisTag.
- ml_tag_offset_and_argnum(ThisTag, TagBits, Offset, ArgNum)
+ Tag = shared_with_reserved_addresses_tag(_, SubTag),
+ ml_tag_offset_and_argnum(SubTag, TagBits, Offset, ArgNum)
+ ;
+ Tag = ground_term_const_tag(_, SubTag),
+ ml_tag_offset_and_argnum(SubTag, TagBits, Offset, ArgNum)
;
( Tag = string_tag(_String)
; Tag = int_tag(_Int)
@@ -2267,6 +2274,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
@@ -2582,6 +2590,7 @@
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
@@ -2898,8 +2907,13 @@
; ConsTag = direct_arg_tag(_)
),
(
- Args = [_Arg],
- unexpected($module, $pred, "NYI")
+ Args = [Arg],
+ DoubleWidth = no,
+ ml_gen_const_struct_arg(Info, !.ConstStructMap,
+ Arg, DoubleWidth, ArgRval, !GlobalData),
+ Rval = ml_cast_cons_tag(MLDS_Type, ConsTag, ArgRval),
+ GroundTerm = ml_ground_term(Rval, Type, MLDS_Type),
+ map.det_insert(ConstNum, GroundTerm, !ConstStructMap)
;
( Args = []
; Args = [_, _ | _]
@@ -2957,6 +2971,7 @@
% These tags should never occur in constant data in this position.
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
% These tags should never occur in MLDS grades.
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
@@ -3072,17 +3087,18 @@
ml_gen_const_struct_args(Info, ConstStructMap,
[Arg - ConsArgWidth | ArgConsArgWidths], [ArgRval | ArgRvals],
!GlobalData) :-
+ arg_width_is_double(ConsArgWidth, DoubleWidth),
ml_gen_const_struct_arg(Info, ConstStructMap,
- Arg, ConsArgWidth, ArgRval, !GlobalData),
+ Arg, DoubleWidth, ArgRval, !GlobalData),
ml_gen_const_struct_args(Info, ConstStructMap,
ArgConsArgWidths, ArgRvals, !GlobalData).
:- pred ml_gen_const_struct_arg(ml_const_struct_info::in,
- ml_const_struct_map::in, const_struct_arg::in, arg_width::in,
+ ml_const_struct_map::in, const_struct_arg::in, bool::in,
mlds_rval::out, ml_global_data::in, ml_global_data::out) is det.
-ml_gen_const_struct_arg(Info, ConstStructMap,
- ConstArg, ConsArgWidth, Rval, !GlobalData) :-
+ml_gen_const_struct_arg(Info, ConstStructMap, ConstArg, DoubleWidth,
+ Rval, !GlobalData) :-
ModuleInfo = Info ^ mcsi_module_info,
(
ConstArg = csa_const_struct(StructNum),
@@ -3095,7 +3111,6 @@
ml_gen_const_struct_arg_tag(ModuleInfo, ConsId, ConsTag,
Type, MLDS_Type, Rval0)
),
- arg_width_is_double(ConsArgWidth, DoubleWidth),
ml_gen_box_const_rval(ModuleInfo, term.context_init, MLDS_Type,
DoubleWidth, Rval0, Rval, !GlobalData).
@@ -3156,6 +3171,7 @@
% csa_const_structs.
( ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
% These tags build heap cells, not constants.
; ConsTag = no_tag
; ConsTag = direct_arg_tag(_)
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.224
diff -u -b -r1.224 mode_util.m
--- compiler/mode_util.m 8 Jun 2012 15:36:59 -0000 1.224
+++ compiler/mode_util.m 11 Jun 2012 03:03:01 -0000
@@ -1648,6 +1648,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = table_io_decl(_)
; ConsId = deep_profiling_proc_layout(_)
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.192
diff -u -b -r1.192 module_qual.m
--- compiler/module_qual.m 8 Jun 2012 15:36:59 -0000 1.192
+++ compiler/module_qual.m 11 Jun 2012 03:03:01 -0000
@@ -1277,6 +1277,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = table_io_decl(_)
; ConsId = deep_profiling_proc_layout(_)
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.380
diff -u -b -r1.380 polymorphism.m
--- compiler/polymorphism.m 8 Jun 2012 15:36:59 -0000 1.380
+++ compiler/polymorphism.m 11 Jun 2012 03:03:01 -0000
@@ -2916,7 +2916,7 @@
ConsId = typeclass_info_cell_constructor,
poly_info_get_const_struct_db(!.Info, ConstStructDb0),
- const_struct_db_get_enabled(ConstStructDb0, ConstStructEnabled),
+ const_struct_db_get_poly_enabled(ConstStructDb0, ConstStructEnabled),
(
ConstStructEnabled = yes,
all_are_const_struct_args(ArgVarsMCAs, VarConstArgs)
@@ -3322,7 +3322,7 @@
ConsId = cell_cons_id(Cell),
poly_info_get_const_struct_db(!.Info, ConstStructDb0),
- const_struct_db_get_enabled(ConstStructDb0, Enabled),
+ const_struct_db_get_poly_enabled(ConstStructDb0, Enabled),
(
Enabled = yes,
all_are_const_struct_args(ArgTypeInfoVarsMCAs,
@@ -4172,7 +4172,7 @@
ConsId = typeclass_info_const(InstanceIdConstNum),
RHS = rhs_functor(ConsId, no, []),
Unification = construct(Var, ConsId, [], [],
- construct_dynamically, cell_is_shared, no_construct_sub_info),
+ construct_statically, cell_is_shared, no_construct_sub_info),
UnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(umc_explicit, []),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.241
diff -u -b -r1.241 prog_data.m
--- compiler/prog_data.m 8 Jun 2012 15:37:00 -0000 1.241
+++ compiler/prog_data.m 11 Jun 2012 03:03:01 -0000
@@ -1587,6 +1587,8 @@
; type_info_const(int)
; typeclass_info_const(int)
+ ; ground_term_const(int, cons_id)
+
; tabling_info_const(shrouded_pred_proc_id)
% The address of the static structure that holds information
% about the table that implements memoization, loop checking
@@ -1662,6 +1664,8 @@
;
ConsId = typeclass_info_const(ConstNum)
;
+ ConsId = ground_term_const(ConstNum, _)
+ ;
( ConsId = cons(_, _, _)
; ConsId = tuple_cons(_)
; ConsId = closure_cons(_, _)
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.78
diff -u -b -r1.78 prog_rep.m
--- compiler/prog_rep.m 8 Jun 2012 15:37:00 -0000 1.78
+++ compiler/prog_rep.m 11 Jun 2012 03:03:01 -0000
@@ -676,6 +676,7 @@
"$typeclass_info_cell_constructor".
cons_id_rep(type_info_const(_)) = "$type_info_const".
cons_id_rep(typeclass_info_const(_)) = "$typeclass_info_const".
+cons_id_rep(ground_term_const(_, _)) = "$ground_term_const".
cons_id_rep(tabling_info_const(_)) = "$tabling_info_const".
cons_id_rep(table_io_decl(_)) = "$table_io_decl".
cons_id_rep(deep_profiling_proc_layout(_)) = "$deep_profiling_proc_layout".
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.60
diff -u -b -r1.60 prog_type.m
--- compiler/prog_type.m 8 Jun 2012 15:37:00 -0000 1.60
+++ compiler/prog_type.m 11 Jun 2012 03:03:01 -0000
@@ -952,6 +952,7 @@
; ConsId0 = base_typeclass_info_const(_, _, _, _)
; ConsId0 = type_info_const(_)
; ConsId0 = typeclass_info_const(_)
+ ; ConsId0 = ground_term_const(_, _)
; ConsId0 = table_io_decl(_)
; ConsId0 = tabling_info_const(_)
; ConsId0 = deep_profiling_proc_layout(_)
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.117
diff -u -b -r1.117 prog_util.m
--- compiler/prog_util.m 8 Jun 2012 15:37:00 -0000 1.117
+++ compiler/prog_util.m 11 Jun 2012 03:03:01 -0000
@@ -612,6 +612,9 @@
;
ConsId = tuple_cons(Arity)
;
+ ConsId = ground_term_const(_, SubConsId),
+ Arity = cons_id_arity(SubConsId)
+ ;
( ConsId = int_const(_)
; ConsId = float_const(_)
; ConsId = char_const(_)
@@ -648,6 +651,8 @@
cons_id_maybe_arity(typeclass_info_cell_constructor) = no.
cons_id_maybe_arity(type_info_const(_)) = no.
cons_id_maybe_arity(typeclass_info_const(_)) = no.
+cons_id_maybe_arity(ground_term_const(_, ConsId)) =
+ cons_id_maybe_arity(ConsId).
cons_id_maybe_arity(tabling_info_const(_)) = no.
cons_id_maybe_arity(deep_profiling_proc_layout(_)) = no.
cons_id_maybe_arity(table_io_decl(_)) = no.
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.18
diff -u -b -r1.18 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m 8 Jun 2012 15:37:00 -0000 1.18
+++ compiler/rbmm.execution_path.m 11 Jun 2012 03:03:01 -0000
@@ -246,6 +246,7 @@
; MainConsId = typeclass_info_cell_constructor
; MainConsId = type_info_const(_)
; MainConsId = typeclass_info_const(_)
+ ; MainConsId = ground_term_const(_, _)
; MainConsId = tabling_info_const(_)
; MainConsId = table_io_decl(_)
; MainConsId = deep_profiling_proc_layout(_)
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.278
diff -u -b -r1.278 simplify.m
--- compiler/simplify.m 23 Apr 2012 03:34:49 -0000 1.278
+++ compiler/simplify.m 11 Jun 2012 03:03:01 -0000
@@ -133,6 +133,7 @@
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.type_util.
:- import_module check_hlds.unify_proc.
+:- import_module hlds.const_struct.
:- import_module hlds.goal_form.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_data.
@@ -1915,13 +1916,18 @@
simplify_goal_scope(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !Info) :-
GoalExpr0 = scope(Reason0, SubGoal0),
( Reason0 = from_ground_term(TermVar, from_ground_term_construct) ->
- simplify_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
+ simplify_info_get_module_info(!.Info, ModuleInfo0),
+ module_info_get_const_struct_db(ModuleInfo0, ConstStructDb0),
+ const_struct_db_get_ground_term_enabled(ConstStructDb0,
+ ConstStructEnabled),
+ (
+ ConstStructEnabled = no,
+ module_info_get_globals(ModuleInfo0, Globals),
globals.lookup_bool_option(Globals, common_struct, CommonStruct),
(
CommonStruct = yes,
- % Traversing the construction unifications inside the scope would
- % allow common.m to
+ % Traversing the construction unifications inside the scope
+ % would allow common.m to
%
% - replace some of those constructions with references to other
% variables that were constructed the same way, and
@@ -1929,16 +1935,17 @@
% outside the scope could be replaced with references to
% variables built inside the scope.
%
- % Since unifying a variable with a statically constructed ground
- % term yields code that is at least as fast as unifying that
- % variable with another variable that is already bound to that
- % term, and probably faster because it does not require saving the
- % other variable across calls, neither of these actions would be
- % an advantage. On the other hand, both would complicate the
- % required treatment of from_ground_term_construct scopes in
- % liveness.m, slowing down the liveness pass, as well as this pass.
- % Since the code inside the scope is already as simple as
- % it can be, we leave it alone.
+ % Since unifying a variable with a statically constructed
+ % ground term yields code that is at least as fast as unifying
+ % that variable with another variable that is already bound to
+ % that term, and probably faster because it does not require
+ % saving the other variable across calls, neither of these
+ % actions would be an advantage. On the other hand, both would
+ % complicate the required treatment of
+ % from_ground_term_construct scopes in liveness.m, slowing down
+ % the liveness pass, as well as this pass. Since the code
+ % inside the scope is already as simple as it can be, we
+ % leave it alone.
GoalExpr = GoalExpr0,
GoalInfo = GoalInfo0
;
@@ -1948,15 +1955,68 @@
% improvement in the generated code trumps the cost in compile
% time. However, we need to update the reason, since leaving it
% as from_ground_term_construct would tell liveness.m that the
- % code inside the scope hasn't had either of the actions mentioned
- % in the comment above applied to it, and in this case, we cannot
- % guarantee that.
+ % code inside the scope hasn't had either of the actions
+ % mentioned in the comment above applied to it, and in this
+ % case, we cannot guarantee that.
simplify_goal(SubGoal0, SubGoal, !Info),
NewReason = from_ground_term(TermVar, from_ground_term_other),
GoalExpr = scope(NewReason, SubGoal),
GoalInfo = GoalInfo0
)
;
+ ConstStructEnabled = yes,
+ (
+ SubGoal0 = hlds_goal(SubGoalExpr, _),
+ SubGoalExpr = conj(plain_conj, Conjuncts),
+ Conjuncts = [HeadConjunctPrime | TailConjunctsPrime]
+ ->
+ HeadConjunct = HeadConjunctPrime,
+ TailConjuncts = TailConjunctsPrime
+ ;
+ unexpected($module, $pred,
+ "from_ground_term_construct scope is not conjunction")
+ ),
+ simplify_info_get_var_types(!.Info, VarTypes),
+ % XXX We could record _ElimVars in !Info as being eliminated.
+ % When we have finished simplifying the code of a procedure,
+ % we could delete all the eliminated vars from the varset
+ % and the vartypes. This would speed up all future lookups.
+ % However, it is not (yet) clear whether the savings on those
+ % lookups would pay for cost of the deletions themselves,
+ % as well as the cost of having an extra field in !Info.
+ simplify_construct_ground_terms(TermVar, VarTypes,
+ HeadConjunct, TailConjuncts, [], _ElimVars,
+ map.init, VarArgMap, ConstStructDb0, ConstStructDb),
+ module_info_set_const_struct_db(ConstStructDb,
+ ModuleInfo0, ModuleInfo),
+ simplify_info_set_module_info(ModuleInfo, !Info),
+
+ map.to_assoc_list(VarArgMap, VarArgs),
+ (
+ VarArgs = [TermVar - TermArg],
+ TermArg = csa_const_struct(TermConstNumPrime)
+ ->
+ TermConstNum = TermConstNumPrime
+ ;
+ unexpected($module, $pred, "unexpected VarArgMap")
+ ),
+
+ lookup_const_struct_num(ConstStructDb, TermConstNum,
+ TermConstStruct),
+ TermConsId = TermConstStruct ^ cs_cons_id,
+ ConsId = ground_term_const(TermConstNum, TermConsId),
+ RHS = rhs_functor(ConsId, no, []),
+ Unification = construct(TermVar, ConsId, [], [],
+ construct_statically, cell_is_shared, no_construct_sub_info),
+ InstMapDelta = goal_info_get_instmap_delta(GoalInfo0),
+ instmap_delta_lookup_var(InstMapDelta, TermVar, TermInst),
+ UnifyMode = (free -> TermInst) - (TermInst -> TermInst),
+ UnifyContext = unify_context(umc_explicit, []),
+ GoalExpr = unify(TermVar, RHS, UnifyMode, Unification,
+ UnifyContext),
+ GoalInfo = GoalInfo0
+ )
+ ;
simplify_info_get_common_info(!.Info, Common),
simplify_goal(SubGoal0, SubGoal, !Info),
nested_scopes(Reason0, SubGoal, GoalInfo0, Goal1),
@@ -2012,6 +2072,53 @@
Goal = hlds_goal(GoalExpr, GoalInfo)
).
+:- type var_to_arg_map == map(prog_var, const_struct_arg).
+
+:- pred simplify_construct_ground_terms(prog_var::in, vartypes::in,
+ hlds_goal::in, list(hlds_goal)::in,
+ list(prog_var)::in, list(prog_var)::out,
+ var_to_arg_map::in, var_to_arg_map::out,
+ const_struct_db::in, const_struct_db::out) is det.
+
+simplify_construct_ground_terms(TermVar, VarTypes, Conjunct, Conjuncts,
+ !ElimVars, !VarArgMap, !ConstStructDb) :-
+ Conjunct = hlds_goal(GoalExpr, GoalInfo),
+ (
+ GoalExpr = unify(_, _, _, Unify, _),
+ Unify = construct(LHSVarPrime, ConsIdPrime, RHSVarsPrime, _, _, _, _)
+ ->
+ LHSVar = LHSVarPrime,
+ ConsId = ConsIdPrime,
+ RHSVars = RHSVarsPrime
+ ;
+ unexpected($module, $pred, "not construction unification")
+ ),
+ map.lookup(VarTypes, LHSVar, TermType),
+ (
+ RHSVars = [],
+ Arg = csa_constant(ConsId, TermType)
+ ;
+ RHSVars = [_ | _],
+ list.map_foldl(map.det_remove, RHSVars, RHSArgs, !VarArgMap),
+ InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
+ instmap_delta_lookup_var(InstMapDelta, LHSVar, TermInst),
+ ConstStruct = const_struct(ConsId, RHSArgs, TermType, TermInst),
+ lookup_insert_const_struct(ConstStruct, ConstNum, !ConstStructDb),
+ Arg = csa_const_struct(ConstNum)
+ ),
+ map.det_insert(LHSVar, Arg, !VarArgMap),
+ (
+ Conjuncts = [],
+ expect(unify(TermVar, LHSVar), $module, $pred,
+ "last var is not TermVar")
+ ;
+ Conjuncts = [HeadConjunct | TailConjuncts],
+ !:ElimVars = [LHSVar | !.ElimVars],
+ simplify_construct_ground_terms(TermVar, VarTypes,
+ HeadConjunct, TailConjuncts,
+ !ElimVars, !VarArgMap, !ConstStructDb)
+ ).
+
:- pred simplify_goal_trace_goal(maybe(trace_expr(trace_compiletime))::in,
maybe(trace_expr(trace_runtime))::in, hlds_goal::in, hlds_goal::in,
hlds_goal::out, simplify_info::in, simplify_info::out) is det.
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.123
diff -u -b -r1.123 switch_gen.m
--- compiler/switch_gen.m 8 Jun 2012 15:46:21 -0000 1.123
+++ compiler/switch_gen.m 11 Jun 2012 03:03:01 -0000
@@ -439,7 +439,8 @@
list_contains_reserved_addr_tag([]) = no.
list_contains_reserved_addr_tag([TaggedConsId | TaggedConsIds]) = Contains :-
- HeadContains = is_reserved_addr_tag(TaggedConsId),
+ TaggedConsId = tagged_cons_id(_, ConsTag),
+ HeadContains = is_reserved_addr_tag(ConsTag),
(
HeadContains = yes,
Contains = yes
@@ -448,14 +449,16 @@
Contains = list_contains_reserved_addr_tag(TaggedConsIds)
).
-:- func is_reserved_addr_tag(tagged_cons_id) = bool.
+:- func is_reserved_addr_tag(cons_tag) = bool.
-is_reserved_addr_tag(TaggedConsId) = IsReservedAddr :-
- TaggedConsId = tagged_cons_id(_, ConsTag),
+is_reserved_addr_tag(ConsTag) = IsReservedAddr :-
(
ConsTag = reserved_address_tag(_),
IsReservedAddr = yes
;
+ ConsTag = ground_term_const_tag(_, SubConsTag),
+ IsReservedAddr = is_reserved_addr_tag(SubConsTag)
+ ;
( ConsTag = int_tag(_)
; ConsTag = float_tag(_)
; ConsTag = string_tag(_)
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.62
diff -u -b -r1.62 switch_util.m
--- compiler/switch_util.m 8 Jun 2012 15:46:21 -0000 1.62
+++ compiler/switch_util.m 11 Jun 2012 03:03:01 -0000
@@ -577,6 +577,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
@@ -1163,6 +1164,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
@@ -1266,6 +1268,7 @@
; Tag = base_typeclass_info_tag(_, _, _)
; Tag = type_info_const_tag(_)
; Tag = typeclass_info_const_tag(_)
+ ; Tag = ground_term_const_tag(_, _)
; Tag = tabling_info_tag(_, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
; Tag = table_io_decl_tag(_, _)
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.35
diff -u -b -r1.35 term_constr_build.m
--- compiler/term_constr_build.m 8 Jun 2012 15:37:01 -0000 1.35
+++ compiler/term_constr_build.m 11 Jun 2012 03:03:01 -0000
@@ -214,8 +214,7 @@
Context, VarTypes, Zeros, SizeVarMap, SCC,
Options ^ tbo_failure_constrs, Options ^ tbo_arg_size_only),
- % Traverse the HLDS and construct the abstract version of
- % this procedure.
+ % Traverse the HLDS and construct the abstract version of this procedure.
build_abstract_goal(Goal, AbstractBody0, Info0, Info),
IntermodStatus = Info ^ tti_intermod_status,
HeadSizeVars = prog_vars_to_size_vars(SizeVarMap, HeadProgVars),
@@ -883,6 +882,8 @@
% The only valid higher-order unifications are assignments.
% For the purposes of the IR analysis, we can ignore them.
% We can also ignore unifications that build constant terms.
+ % XXX Should we process constant terms that are NOT typeinfos
+ % or typeclass infos? We have no test cases (yet) that need that.
( type_is_higher_order(Type)
; cons_id_is_const_struct(ConsId, _)
)
@@ -1048,8 +1049,8 @@
% Procedures for manipulating sets of size_vars.
%
- % Create the size_vars corresponding to the given prog_vars. Also
- % create map from the prog_vars to the size_vars.
+ % Create the size_vars corresponding to the given prog_vars.
+ % Also create map from the prog_vars to the size_vars.
%
% As termination analysis is (currently) carried out before unused
% argument analysis it is possible that some variables in the head
@@ -1135,10 +1136,10 @@
:- pred find_failure_constraint_for_goal_2(tti_traversal_info::in,
hlds_goal::in, abstract_goal::out) is semidet.
+find_failure_constraint_for_goal_2(Info, Goal, AbstractGoal) :-
% XXX We could factor out a lot of the code used for
% substitutions below as the same code is used elsewhere.
- %
-find_failure_constraint_for_goal_2(Info, Goal, AbstractGoal) :-
+
Goal = hlds_goal(GoalExpr, _),
(
GoalExpr = plain_call(PredId, ProcId, CallArgs, _, _, _),
Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.35
diff -u -b -r1.35 term_norm.m
--- compiler/term_norm.m 16 Jun 2011 06:42:15 -0000 1.35
+++ compiler/term_norm.m 11 Jun 2012 03:03:01 -0000
@@ -71,6 +71,7 @@
:- implementation.
:- import_module check_hlds.type_util.
+:- import_module hlds.const_struct.
:- import_module hlds.hlds_data.
:- import_module parse_tree.prog_type.
@@ -92,11 +93,12 @@
% XXX Actually we currently only use three of them. `use_map/1' is unused.
:- type functor_info
- ---> simple % All non-constant functors have weight 1,
- % while constants have weight 0.
- % Use the size of all subterms (I = {1, ..., n}.
+ ---> simple
+ % All non-constant functors have weight 1, while constants
+ % have weight 0. Use the size of all subterms (I = {1, ..., n}.
- ; total % All functors have weight = arity of the functor.
+ ; total
+ % All functors have weight = arity of the functor.
% Use the size of all subterms (I = {1, ..., n}.
; use_map(weight_table)
@@ -104,10 +106,9 @@
% Use the size of all subterms (I = {1, ..., n}.
; use_map_and_args(weight_table).
- % The weight of each functor is given by the table,
- % and so is the set of arguments of the functor whose
- % size should be counted (I is given by the table
- % entry of the functor).
+ % The weight of each functor is given by the table, and so is
+ % the set of arguments of the functor whose size should be counted
+ % (I is given by the table entry of the functor).
%-----------------------------------------------------------------------------%
@@ -251,44 +252,63 @@
%-----------------------------------------------------------------------------%
-functor_norm(_ModuleInfo, FunctorInfo, TypeCtor, ConsId, Int, !Args, !Modes) :-
- % Although the module info is not used in any of these norms, it could
- % be needed for other norms, so it should not be removed.
+functor_norm(ModuleInfo, FunctorInfo, TypeCtor, ConsId, Gamma,
+ !Args, !Modes) :-
(
FunctorInfo = simple,
(
ConsId = cons(_, Arity, _),
Arity \= 0
->
- Int = 1
+ Gamma = 1
+ ;
+ ConsId = ground_term_const(ConstNum, _)
+ ->
+ module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
+ const_struct_count_cells(ConstStructDb, ConstNum, 0, Gamma)
;
- Int = 0
+ Gamma = 0
)
;
FunctorInfo = total,
( ConsId = cons(_, Arity, _) ->
- Int = Arity
+ Gamma = Arity
+ ; ConsId = ground_term_const(ConstNum, _) ->
+ module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
+ const_struct_count_cell_arities(ConstStructDb, ConstNum, 0, Gamma)
;
- Int = 0
+ Gamma = 0
)
;
FunctorInfo = use_map(WeightMap),
( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
- WeightInfo = weight(Int, _)
+ WeightInfo = weight(Gamma, _)
+ ; ConsId = ground_term_const(ConstNum, _) ->
+ module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
+ const_struct_count_cell_weights(ConstStructDb, WeightMap,
+ ConstNum, 0, Gamma)
;
- Int = 0
+ Gamma = 0
)
;
FunctorInfo = use_map_and_args(WeightMap),
( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
- WeightInfo = weight(Int, UseArgList),
+ WeightInfo = weight(Gamma, UseArgList),
( functor_norm_filter_args(UseArgList, !Args, !Modes) ->
true
;
unexpected($module, $pred, "unmatched lists")
)
+ ; ConsId = ground_term_const(ConstNum, _) ->
+ % XXX Since ground_term_consts have no argument variables,
+ % we cannot filter those argument variables. I (zs) *think* that
+ % returning the !.Args and !.Modes (which should both be empty
+ % to begin with) does the right thing, but I am not sure.
+ module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
+ const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
+ ConstNum, 0, Gamma)
;
- Int = 0
+ Gamma = 0
)
).
@@ -309,6 +329,144 @@
%-----------------------------------------------------------------------------%
+:- pred const_struct_count_cells(const_struct_db::in, int::in,
+ int::in, int::out) is det.
+
+const_struct_count_cells(ConstStructDb, ConstNum, !Gamma) :-
+ lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
+ ConstStruct = const_struct(_ConsId, Args, _, _),
+ !:Gamma = !.Gamma + 1,
+ const_struct_count_cells_args(ConstStructDb, Args, !Gamma).
+
+:- pred const_struct_count_cells_args(const_struct_db::in,
+ list(const_struct_arg)::in, int::in, int::out) is det.
+
+const_struct_count_cells_args(_ConstStructDb, [], !Gamma).
+const_struct_count_cells_args(ConstStructDb, [Arg | Args], !Gamma) :-
+ (
+ Arg = csa_constant(_, _)
+ ;
+ Arg = csa_const_struct(ArgConstNum),
+ const_struct_count_cells(ConstStructDb, ArgConstNum, !Gamma)
+ ),
+ const_struct_count_cells_args(ConstStructDb, Args, !Gamma).
+
+:- pred const_struct_count_cell_arities(const_struct_db::in, int::in,
+ int::in, int::out) is det.
+
+const_struct_count_cell_arities(ConstStructDb, ConstNum, !Gamma) :-
+ lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
+ ConstStruct = const_struct(_ConsId, Args, _, _),
+ !:Gamma = !.Gamma + list.length(Args),
+ const_struct_count_cell_arities_args(ConstStructDb, Args, !Gamma).
+
+:- pred const_struct_count_cell_arities_args(const_struct_db::in,
+ list(const_struct_arg)::in, int::in, int::out) is det.
+
+const_struct_count_cell_arities_args(_ConstStructDb, [], !Gamma).
+const_struct_count_cell_arities_args(ConstStructDb, [Arg | Args], !Gamma) :-
+ (
+ Arg = csa_constant(_, _)
+ ;
+ Arg = csa_const_struct(ArgConstNum),
+ const_struct_count_cell_arities(ConstStructDb, ArgConstNum, !Gamma)
+ ),
+ const_struct_count_cell_arities_args(ConstStructDb, Args, !Gamma).
+
+:- pred const_struct_count_cell_weights(const_struct_db::in,
+ weight_table::in, int::in, int::in, int::out) is det.
+
+const_struct_count_cell_weights(ConstStructDb, WeightMap, ConstNum, !Gamma) :-
+ lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
+ ConstStruct = const_struct(ConsId, Args, Type, _),
+ type_to_ctor_det(Type, TypeCtor),
+ ( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
+ WeightInfo = weight(ConsIdGamma, _),
+ !:Gamma = !.Gamma + ConsIdGamma,
+ const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
+ Args, !Gamma)
+ ;
+ true
+ ).
+
+:- pred const_struct_count_cell_weights_args(const_struct_db::in,
+ weight_table::in, list(const_struct_arg)::in, int::in, int::out) is det.
+
+const_struct_count_cell_weights_args(_ConstStructDb, _WeightMap, [], !Gamma).
+const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
+ [Arg | Args], !Gamma) :-
+ (
+ Arg = csa_constant(ConsId, Type),
+ type_to_ctor_det(Type, TypeCtor),
+ ( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
+ WeightInfo = weight(ConsIdGamma, _),
+ !:Gamma = !.Gamma + ConsIdGamma
+ ;
+ true
+ )
+ ;
+ Arg = csa_const_struct(ArgConstNum),
+ const_struct_count_cell_weights(ConstStructDb, WeightMap,
+ ArgConstNum, !Gamma)
+ ),
+ const_struct_count_cell_weights_args(ConstStructDb, WeightMap,
+ Args, !Gamma).
+
+:- pred const_struct_count_cell_filtered_weights(const_struct_db::in,
+ weight_table::in, int::in, int::in, int::out) is det.
+
+const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
+ ConstNum, !Gamma) :-
+ lookup_const_struct_num(ConstStructDb, ConstNum, ConstStruct),
+ ConstStruct = const_struct(ConsId, Args, Type, _),
+ type_to_ctor_det(Type, TypeCtor),
+ ( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
+ WeightInfo = weight(ConsIdGamma, UseArgs),
+ !:Gamma = !.Gamma + ConsIdGamma,
+ const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
+ Args, UseArgs, !Gamma)
+ ;
+ true
+ ).
+
+:- pred const_struct_count_cell_filtered_weights_args(const_struct_db::in,
+ weight_table::in, list(const_struct_arg)::in, list(bool)::in,
+ int::in, int::out) is det.
+
+const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
+ [], [], !Gamma).
+const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
+ [], [_ | _], !Gamma) :-
+ unexpected($module, $pred, "mismatched lists").
+const_struct_count_cell_filtered_weights_args(_ConstStructDb, _WeightMap,
+ [_ | _], [], !Gamma) :-
+ unexpected($module, $pred, "mismatched lists").
+const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
+ [Arg | Args], [UseArg | UseArgs], !Gamma) :-
+ (
+ UseArg = no
+ ;
+ UseArg = yes,
+ (
+ Arg = csa_constant(ConsId, Type),
+ type_to_ctor_det(Type, TypeCtor),
+ ( search_weight_table(WeightMap, TypeCtor, ConsId, WeightInfo) ->
+ WeightInfo = weight(ConsIdGamma, _),
+ !:Gamma = !.Gamma + ConsIdGamma
+ ;
+ true
+ )
+ ;
+ Arg = csa_const_struct(ArgConstNum),
+ const_struct_count_cell_filtered_weights(ConstStructDb, WeightMap,
+ ArgConstNum, !Gamma)
+ )
+ ),
+ const_struct_count_cell_filtered_weights_args(ConstStructDb, WeightMap,
+ Args, UseArgs, !Gamma).
+
+%-----------------------------------------------------------------------------%
+
functor_lower_bound(_ModuleInfo, FunctorInfo, TypeCtor, ConsId) = Weight :-
(
FunctorInfo = simple,
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.68
diff -u -b -r1.68 term_traversal.m
--- compiler/term_traversal.m 8 Jun 2012 15:37:01 -0000 1.68
+++ compiler/term_traversal.m 11 Jun 2012 03:03:01 -0000
@@ -526,25 +526,41 @@
params_get_var_types(Params, VarTypes),
map.lookup(VarTypes, OutVar, Type),
\+ type_is_higher_order(Type),
- \+ cons_id_is_const_struct(ConsId, _),
+ \+ (
+ ConsId = type_info_const(_)
+ ;
+ ConsId = typeclass_info_const(_)
+ ),
+ require_det (
type_to_ctor_det(Type, TypeCtor),
- filter_args_and_modes(VarTypes, Args0, Args1, Modes0, Modes1),
+ filter_typeinfos_from_args_and_modes(VarTypes, Args0, Args1,
+ Modes0, Modes1),
functor_norm(ModuleInfo, FunctorInfo, TypeCtor, ConsId, Gamma,
Args1, Args, Modes1, Modes),
- split_unification_vars(Args, Modes, ModuleInfo, InVars, OutVars).
+ split_unification_vars(ModuleInfo, Args, Modes, InVars, OutVars)
+ ).
-:- pred filter_args_and_modes(vartypes::in,
+:- pred filter_typeinfos_from_args_and_modes(vartypes::in,
list(prog_var)::in, list(prog_var)::out,
list(uni_mode)::in, list(uni_mode)::out) is det.
-filter_args_and_modes(VarTypes, Args0, Args, Modes0, Modes) :-
- assoc_list.from_corresponding_lists(Args0, Modes0, ArgsAndModes0),
- IsNotTypeInfo = (pred(ArgMode::in) is semidet :-
- map.lookup(VarTypes, fst(ArgMode), Type),
- not is_introduced_type_info_type(Type)
- ),
- list.filter(IsNotTypeInfo, ArgsAndModes0, ArgsAndModes),
- assoc_list.keys_and_values(ArgsAndModes, Args, Modes).
+filter_typeinfos_from_args_and_modes(_, [], [], [], []).
+filter_typeinfos_from_args_and_modes(_, [], _, [_ | _], _) :-
+ unexpected($module, $pred, "list length mismatch").
+filter_typeinfos_from_args_and_modes(_, [_ | _], _, [], _) :-
+ unexpected($module, $pred, "list length mismatch").
+filter_typeinfos_from_args_and_modes(VarTypes, [Arg0 | Args0], Args,
+ [Mode0 | Modes0], Modes) :-
+ filter_typeinfos_from_args_and_modes(VarTypes, Args0, TailArgs,
+ Modes0, TailModes),
+ map.lookup(VarTypes, Arg0, Type),
+ ( is_introduced_type_info_type(Type) ->
+ Args = TailArgs,
+ Modes = TailModes
+ ;
+ Args = [Arg0 | TailArgs],
+ Modes = [Mode0 | TailModes]
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.63
diff -u -b -r1.63 term_util.m
--- compiler/term_util.m 23 May 2011 05:08:14 -0000 1.63
+++ compiler/term_util.m 11 Jun 2012 03:03:01 -0000
@@ -82,8 +82,9 @@
% Given a list of variables from a unification, this predicate divides the
% list into a bag of input variables, and a bag of output variables.
%
-:- pred split_unification_vars(list(prog_var)::in, list(uni_mode)::in,
- module_info::in, bag(prog_var)::out, bag(prog_var)::out) is det.
+:- pred split_unification_vars(module_info::in,
+ list(prog_var)::in, list(uni_mode)::in,
+ bag(prog_var)::out, bag(prog_var)::out) is det.
% Used to create lists of boolean values, which are used for used_args.
% make_bool_list(HeadVars, BoolIn, BoolOut) creates a bool list which is
@@ -225,19 +226,15 @@
% current implementation does not correctly handle partially instantiated
% data structures.
%
-split_unification_vars([], Modes, _, Vars, Vars) :-
- bag.init(Vars),
- (
- Modes = []
- ;
- Modes = [_ | _],
- unexpected($module, $pred, "unmatched variables")
- ).
-split_unification_vars([Arg | Args], Modes, ModuleInfo,
+split_unification_vars(_, [], [], Vars, Vars) :-
+ bag.init(Vars).
+split_unification_vars(_, [], [_ | _], _, _) :-
+ unexpected($module, $pred, "unmatched variables").
+split_unification_vars(_, [_ | _], [], _, _) :-
+ unexpected($module, $pred, "unmatched variables").
+split_unification_vars(ModuleInfo, [Arg | Args], [UniMode | UniModes],
InVars, OutVars):-
- (
- Modes = [UniMode | UniModes],
- split_unification_vars(Args, UniModes, ModuleInfo, InVars0, OutVars0),
+ split_unification_vars(ModuleInfo, Args, UniModes, InVars0, OutVars0),
UniMode = ((_VarInit - ArgInit) -> (_VarFinal - ArgFinal)),
(
inst_is_bound(ModuleInfo, ArgInit)
@@ -255,10 +252,6 @@
;
InVars = InVars0,
OutVars = OutVars0
- )
- ;
- Modes = [],
- unexpected($module, $pred, "unmatched variables")
).
%-----------------------------------------------------------------------------%
Index: compiler/trace_params.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_params.m,v
retrieving revision 1.44
diff -u -b -r1.44 trace_params.m
--- compiler/trace_params.m 26 Sep 2011 04:30:45 -0000 1.44
+++ compiler/trace_params.m 11 Jun 2012 03:03:01 -0000
@@ -1,7 +1,7 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
-% Copyright (C) 2000-2008, 2011 The University of Melbourne.
+% Copyright (C) 2000-2008,2011-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -79,6 +79,10 @@
%
:- func trace_level_needs_meaningful_var_names(trace_level) = bool.
+ % This function checks for a property of the global trace level.
+ %
+:- func trace_needs_proc_body_reps(trace_level, trace_suppress_items) = bool.
+
% These functions check for various properties of the given procedure's
% effective trace level.
%
@@ -337,7 +341,6 @@
:- func trace_level_needs_fixed_slots(trace_level) = bool.
:- func trace_level_needs_from_full_slot(trace_level) = bool.
:- func trace_needs_all_var_names(trace_level, trace_suppress_items) = bool.
-:- func trace_needs_proc_body_reps(trace_level, trace_suppress_items) = bool.
:- func trace_needs_port(trace_level, trace_suppress_items, trace_port) = bool.
trace_level_is_none(none) = yes.
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.111
diff -u -b -r1.111 type_ctor_info.m
--- compiler/type_ctor_info.m 8 Jun 2012 15:46:21 -0000 1.111
+++ compiler/type_ctor_info.m 11 Jun 2012 03:03:01 -0000
@@ -709,6 +709,7 @@
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
@@ -891,6 +892,7 @@
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.212
diff -u -b -r1.212 unify_gen.m
--- compiler/unify_gen.m 8 Jun 2012 15:37:01 -0000 1.212
+++ compiler/unify_gen.m 11 Jun 2012 03:03:01 -0000
@@ -433,6 +433,10 @@
unexpected($module, $pred,
"Attempted typeclass_info_const_tag unification")
;
+ ConsTag = ground_term_const_tag(_, _),
+ unexpected($module, $pred,
+ "Attempted ground_term_const_tag unification")
+ ;
ConsTag = tabling_info_tag(_, _),
unexpected($module, $pred, "Attempted tabling_info unification")
;
@@ -635,6 +639,7 @@
;
( ConsTag = type_info_const_tag(ConstNum)
; ConsTag = typeclass_info_const_tag(ConstNum)
+ ; ConsTag = ground_term_const_tag(ConstNum, _)
),
get_const_struct_map(!.CI, ConstStructMap),
map.lookup(ConstStructMap, ConstNum, typed_rval(Rval, _Type)),
@@ -1285,6 +1290,9 @@
Tag = typeclass_info_const_tag(_),
unexpected($module, $pred, "typeclass_info_const_tag")
;
+ Tag = ground_term_const_tag(_, _),
+ unexpected($module, $pred, "ground_term_const_tag")
+ ;
Tag = table_io_decl_tag(_, _),
unexpected($module, $pred, "table_io_decl_tag")
;
@@ -1696,29 +1704,29 @@
TypedRval, !StaticCellInfo)
;
ConsTag = no_tag,
- generate_const_struct_args(ModuleInfo, UnboxedFloats, ConstStructMap,
- ConstArgs, ArgTypedRvals),
(
- ArgTypedRvals = [ArgTypedRval],
+ ConstArgs = [ConstArg],
+ generate_const_struct_arg(ModuleInfo, UnboxedFloats,
+ ConstStructMap, ConstArg, ArgTypedRval),
TypedRval = ArgTypedRval
;
- ( ArgTypedRvals = []
- ; ArgTypedRvals = [_, _ | _]
+ ( ConstArgs = []
+ ; ConstArgs = [_, _ | _]
),
unexpected($module, $pred, "no_tag arity != 1")
)
;
ConsTag = direct_arg_tag(Ptag),
- generate_const_struct_args(ModuleInfo, UnboxedFloats, ConstStructMap,
- ConstArgs, ArgTypedRvals),
(
- ArgTypedRvals = [ArgTypedRval],
+ ConstArgs = [ConstArg],
+ generate_const_struct_arg(ModuleInfo, UnboxedFloats,
+ ConstStructMap, ConstArg, ArgTypedRval),
ArgTypedRval = typed_rval(ArgRval, _RvalType),
Rval = mkword(Ptag, ArgRval),
TypedRval = typed_rval(Rval, lt_data_ptr)
;
- ( ArgTypedRvals = []
- ; ArgTypedRvals = [_, _ | _]
+ ( ConstArgs = []
+ ; ConstArgs = [_, _ | _]
),
unexpected($module, $pred, "direct_arg_tag: arity != 1")
)
@@ -1761,6 +1769,7 @@
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
@@ -1864,6 +1873,7 @@
; ConsTag = shared_remote_tag(_, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = closure_tag(_, _, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
@@ -2063,6 +2073,7 @@
; ConsTag = base_typeclass_info_tag(_, _, _)
; ConsTag = type_info_const_tag(_)
; ConsTag = typeclass_info_const_tag(_)
+ ; ConsTag = ground_term_const_tag(_, _)
; ConsTag = tabling_info_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.32
diff -u -b -r1.32 unused_imports.m
--- compiler/unused_imports.m 8 Jun 2012 15:37:02 -0000 1.32
+++ compiler/unused_imports.m 11 Jun 2012 03:03:01 -0000
@@ -494,6 +494,7 @@
; ConsId = typeclass_info_cell_constructor
; ConsId = type_info_const(_)
; ConsId = typeclass_info_const(_)
+ ; ConsId = ground_term_const(_, _)
; ConsId = tabling_info_const(_)
; ConsId = table_io_decl(_)
; ConsId = deep_profiling_proc_layout(_)
Index: compiler/xml_documentation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/xml_documentation.m,v
retrieving revision 1.33
diff -u -b -r1.33 xml_documentation.m
--- compiler/xml_documentation.m 8 Jun 2012 15:37:02 -0000 1.33
+++ compiler/xml_documentation.m 11 Jun 2012 03:03:01 -0000
@@ -665,6 +665,7 @@
nyi("typeclass_info_cell_constructor").
cons_id(type_info_const(_)) = nyi("type_info_const").
cons_id(typeclass_info_const(_)) = nyi("typeclass_info_const").
+cons_id(ground_term_const(_, _)) = nyi("ground_term_const").
cons_id(tabling_info_const(_)) = nyi("tabling_info_const").
cons_id(table_io_decl(_)) = nyi("table_io_decl").
cons_id(deep_profiling_proc_layout(_)) = nyi("deep_profiling_proc_layout").
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
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/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
cvs diff: Diffing extras/graphics/mercury_glut
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/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
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/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
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/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.57
diff -u -b -r1.57 Mercury.options
--- tests/hard_coded/Mercury.options 13 Feb 2012 00:11:56 -0000 1.57
+++ tests/hard_coded/Mercury.options 11 Jun 2012 03:03:01 -0000
@@ -25,6 +25,7 @@
MCFLAGS-direct_arg_intermod1 = --intermodule-optimization
MCFLAGS-direct_arg_intermod2 = --intermodule-optimization
MCFLAGS-direct_arg_intermod3 = --intermodule-optimization
+MCFLAGS-ground_terms = --from-ground-term-threshold=2
# --intermodule-optimization causes impl_def_literal to abort during
# the STM transformation (bug #136). Its use here is disabled until
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.429
diff -u -b -r1.429 Mmakefile
--- tests/hard_coded/Mmakefile 14 May 2012 06:30:06 -0000 1.429
+++ tests/hard_coded/Mmakefile 11 Jun 2012 03:03:01 -0000
@@ -129,6 +129,7 @@
func_test \
getopt_test \
ground_dd \
+ ground_terms \
hash_bug \
hash_init_bug \
hash_table_delete \
Index: tests/hard_coded/from_ground_term_bug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/from_ground_term_bug.m,v
retrieving revision 1.1
diff -u -b -r1.1 from_ground_term_bug.m
--- tests/hard_coded/from_ground_term_bug.m 25 Sep 2009 03:55:06 -0000 1.1
+++ tests/hard_coded/from_ground_term_bug.m 11 Jun 2012 03:03:01 -0000
@@ -4,7 +4,7 @@
% 22 Sep 2009 used to throw "Unexpected: do_unravel_unification:
% from_ground_term not conj" on this code. The reason is that the
% unification introduced for the first argument of the call to log_tf
-% has a ground term above the size % threshold specified in Mercury.options
+% has a ground term above the size threshold specified in Mercury.options
% on the right hand side, but unraveling it yields not a conjunction of
% construct unifications, but a single unification with an rhs_lambda_goal
% right hand side.
Index: tests/hard_coded/ground_terms.exp
===================================================================
RCS file: tests/hard_coded/ground_terms.exp
diff -N tests/hard_coded/ground_terms.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/ground_terms.exp 11 Jun 2012 03:03:01 -0000
@@ -0,0 +1,16 @@
+[yes(yes), yes(no), no, yes(no), yes(yes), yes(yes)]
+notag([yes(yes), yes(no), no, yes(no), yes(yes), yes(yes)])
+[notag(yes(yes)), notag(yes(no)), notag(no), notag(yes(no)), notag(yes(yes)), notag(yes(yes))]
+[yes(notag(yes)), yes(notag(no)), no, yes(notag(no)), yes(notag(yes)), yes(notag(yes))]
+da1({1, 2, 3, 4})
+da2(no)
+da2(yes({no, yes, no}))
+da6(["a", "bb", "ccc", "dddd"])
+da8(yes({yes, yes, no}))
+da6(["A", "BB", "CCC", "DDDD"])
+da1(56.78)
+da2(no)
+da2(yes({no, yes, no}))
+da6(["a", "bb", "ccc", "dddd"])
+da8(yes({yes, yes, no}))
+da6(["A", "BB", "CCC", "DDDD"])
Index: tests/hard_coded/ground_terms.m
===================================================================
RCS file: tests/hard_coded/ground_terms.m
diff -N tests/hard_coded/ground_terms.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/ground_terms.m 11 Jun 2012 03:03:01 -0000
@@ -0,0 +1,144 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module ground_terms.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module maybe.
+:- import_module bool.
+
+main(!IO) :-
+ list_maybe_bool_term(A1),
+ io.write(A1, !IO),
+ io.nl(!IO),
+
+ notag_list_maybe_bool_term(B1),
+ io.write(B1, !IO),
+ io.nl(!IO),
+ list_notag_maybe_bool_term(B2),
+ io.write(B2, !IO),
+ io.nl(!IO),
+ list_maybe_notag_bool_term(B3),
+ io.write(B3, !IO),
+ io.nl(!IO),
+
+ da_i_mb_ls_term_1(C1),
+ io.write(C1, !IO),
+ io.nl(!IO),
+ da_i_mb_ls_term_2a(C2),
+ io.write(C2, !IO),
+ io.nl(!IO),
+ da_i_mb_ls_term_2b(C3),
+ io.write(C3, !IO),
+ io.nl(!IO),
+ da_i_mb_ls_term_6(C4),
+ io.write(C4, !IO),
+ io.nl(!IO),
+ da_i_mb_ls_term_8(C5),
+ io.write(C5, !IO),
+ io.nl(!IO),
+ da_i_mb_ls_term_9(C6),
+ io.write(C6, !IO),
+ io.nl(!IO),
+
+ da_f_mb_ls_term_1(D1),
+ io.write(D1, !IO),
+ io.nl(!IO),
+ da_f_mb_ls_term_2a(D2),
+ io.write(D2, !IO),
+ io.nl(!IO),
+ da_f_mb_ls_term_2b(D3),
+ io.write(D3, !IO),
+ io.nl(!IO),
+ da_f_mb_ls_term_6(D4),
+ io.write(D4, !IO),
+ io.nl(!IO),
+ da_f_mb_ls_term_8(D5),
+ io.write(D5, !IO),
+ io.nl(!IO),
+ da_f_mb_ls_term_9(D6),
+ io.write(D6, !IO),
+ io.nl(!IO).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- pred list_maybe_bool_term(list(maybe(bool))::out) is det.
+
+list_maybe_bool_term([yes(yes), yes(no), no, yes(no), yes(yes), yes(yes)]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- type notag(T)
+ ---> notag(T).
+
+:- pred notag_list_maybe_bool_term(notag(list(maybe(bool)))::out) is det.
+
+notag_list_maybe_bool_term(notag([yes(yes), yes(no), no, yes(no), yes(yes),
+ yes(yes)])).
+
+:- pred list_notag_maybe_bool_term(list(notag(maybe(bool)))::out) is det.
+
+list_notag_maybe_bool_term([notag(yes(yes)), notag(yes(no)), notag(no),
+ notag(yes(no)), notag(yes(yes)), notag(yes(yes))]).
+
+:- pred list_maybe_notag_bool_term(list(maybe(notag(bool)))::out) is det.
+
+list_maybe_notag_bool_term([yes(notag(yes)), yes(notag(no)), no,
+ yes(notag(no)), yes(notag(yes)), yes(notag(yes))]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- type datag(T1, T2, T3)
+ ---> da1(T1)
+ ; da2(T2)
+ ; da3(T3)
+ ; da4(T1)
+ ; da5(T2)
+ ; da6(T3)
+ ; da7(T1)
+ ; da8(T2)
+ ; da9(T3).
+
+:- type da_i_mb_ls ==
+ datag({int, int, int, int}, maybe({bool, bool, bool}), list(string)).
+
+:- pred da_i_mb_ls_term_1(da_i_mb_ls::out) is det.
+:- pred da_i_mb_ls_term_2a(da_i_mb_ls::out) is det.
+:- pred da_i_mb_ls_term_2b(da_i_mb_ls::out) is det.
+:- pred da_i_mb_ls_term_6(da_i_mb_ls::out) is det.
+:- pred da_i_mb_ls_term_8(da_i_mb_ls::out) is det.
+:- pred da_i_mb_ls_term_9(da_i_mb_ls::out) is det.
+
+da_i_mb_ls_term_1(da1({1, 2, 3, 4})).
+da_i_mb_ls_term_2a(da2(no)).
+da_i_mb_ls_term_2b(da2(yes({no, yes, no}))).
+da_i_mb_ls_term_6(da6(["a", "bb", "ccc", "dddd"])).
+da_i_mb_ls_term_8(da8(yes({yes, yes, no}))).
+da_i_mb_ls_term_9(da6(["A", "BB", "CCC", "DDDD"])).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- type da_f_mb_ls ==
+ datag(float, maybe({bool, bool, bool}), list(string)).
+
+:- pred da_f_mb_ls_term_1(da_f_mb_ls::out) is det.
+:- pred da_f_mb_ls_term_2a(da_f_mb_ls::out) is det.
+:- pred da_f_mb_ls_term_2b(da_f_mb_ls::out) is det.
+:- pred da_f_mb_ls_term_6(da_f_mb_ls::out) is det.
+:- pred da_f_mb_ls_term_8(da_f_mb_ls::out) is det.
+:- pred da_f_mb_ls_term_9(da_f_mb_ls::out) is det.
+
+da_f_mb_ls_term_1(da1(56.78)).
+da_f_mb_ls_term_2a(da2(no)).
+da_f_mb_ls_term_2b(da2(yes({no, yes, no}))).
+da_f_mb_ls_term_6(da6(["a", "bb", "ccc", "dddd"])).
+da_f_mb_ls_term_8(da8(yes({yes, yes, no}))).
+da_f_mb_ls_term_9(da6(["A", "BB", "CCC", "DDDD"])).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list