diff: remove old code.
Tyson Richard DOWD
trd at cs.mu.oz.au
Mon May 19 18:55:08 AEST 1997
Hiya,
Someone want to review this diff?
Please note, list and term have been defined in mercury_compile
for a long time now, this change might break uncommitted code.
===================================================================
Estimated hours taken: 5
Remove support for term_to_type and type_to_term implemented as special
preds. Remove support for one-cell and one-or-two-cell type_infos (now
shared-one-or-two-cell type_infos). Move definitions that were in
mercury_builtin.m back to where they belong.
This code has been removed because it is no longer used, and was no
longer being maintained but was still quite complex.
compiler/globals.m:
compiler/handle_options.m:
compiler/mercury_compile.m:
compiler/options.m:
Remove one_cell and one_or_two_cell from type_info methods.
compiler/polymorphism.m:
Remove term_to_type and type_to_term support.
Remove one_cell and one_or_two_cell from type_info methods.
Fix documentation to reflect the new situation.
compiler/special_pred.m:
compiler/unify_proc.m:
Remove term_to_type and type_to_term support.
library/list.m:
Put the definition of `list' back into list.m
library/mercury_builtin.m:
Take the definitions of `list', `term', `var', `var__supply',
etc, out of this module.
Remove type_to_term, term_to_type, det_term_to_type,
term__init_var_supply, term__create_var, term__var_to_int
and term__context_init.
Remove references to USE_TYPE_TO_TERM and #ifdefs around
SHARED_ONE_OR_TWO_CELL_TYPE_INFO.
library/std_util.m:
Remove references ONE_OR_TWO_CELL_TYPE_INFO, and code that
handles one-cell typeinfo comparisons.
library/term.m:
Add type_to_term, term_to_type, det_term_to_type,
term__init_var_supply, term__create_var, term__var_to_int
and term__context_init back to term.m.
Add new implementation of type_to_term/2.
library/uniq_array.m:
Fix a typo in a comment - term_to_type/3 instead of term_to_type/2.
runtime/call.mod:
Remove special case code for unify, compare, index for
one-cell typeinfos.
Remove code for type_to_term/2.
runtime/type_info.h:
Remove references to ONE_CELL_TYPE_INFO or ONE_OR_TWO_CELL_TYPE_INFO.
Make sure only SHARED_ONE_OR_TWO_CELL_TYPE_INFO.
Remove references to USE_TYPE_TO_TERM.
compiler/base_type_layout.m:
compiler/bytecode_gen.m:
compiler/code_util.m:
compiler/delay_slot.m:
compiler/det_util.m:
compiler/fact_table.m:
compiler/hlds_data.m:
compiler/hlds_goal.m:
compiler/mode_debug.m:
compiler/tree.m:
library/bag.m:
library/queue.m:
tests/general/disj_disj.m:
tests/general/dnf.m:
tests/general/higher_order.m:
tests/general/nondet_disj.m:
tests/hard_coded/cc_nondet_disj.m:
tests/hard_coded/pragma_inline.m:
tests/invalid/funcs_as_preds.err_exp:
tests/misc_tests/mdemangle_test.exp:
tests/valid/agc_unbound_typevars.m:
tests/valid/middle_rec_labels.m:
tests/valid/subtype_switch.m:
tests/warnings/infinite_recursion.m:
Import module `list' or `term' (or both).
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.17
diff -u -r1.17 base_type_layout.m
--- 1.17 1997/04/27 14:41:50
+++ base_type_layout.m 1997/05/19 06:53:53
@@ -230,6 +230,7 @@
:- import_module prog_data, hlds_data, hlds_pred, hlds_out, type_util.
:- import_module llds, code_util, globals, options, special_pred, prog_util.
:- import_module assoc_list, bool, string, int, list, map, std_util, require.
+:- import_module term.
:- type layout_info --->
layout_info(
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.26
diff -u -r1.26 bytecode_gen.m
--- 1.26 1997/05/05 11:16:36
+++ bytecode_gen.m 1997/05/19 07:05:55
@@ -15,7 +15,7 @@
:- interface.
:- import_module hlds_module, bytecode.
-:- import_module io.
+:- import_module io, list.
:- pred bytecode_gen__module(module_info::in, list(byte_code)::out,
io__state::di, io__state::uo) is det.
@@ -29,7 +29,7 @@
:- import_module globals, tree.
:- import_module bool, int, string, list, assoc_list, set, map, varset.
-:- import_module std_util, require.
+:- import_module std_util, require, term.
bytecode_gen__module(ModuleInfo, Code) -->
{ module_info_predids(ModuleInfo, PredIds) },
Index: compiler/code_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_util.m,v
retrieving revision 1.85
diff -u -r1.85 code_util.m
--- 1.85 1997/05/05 11:16:42
+++ code_util.m 1997/05/19 06:56:23
@@ -151,7 +151,7 @@
:- implementation.
:- import_module prog_data, type_util, special_pred.
-:- import_module bool, char, int, string, map, varset, require, std_util.
+:- import_module bool, char, int, string, map, term, varset, require, std_util.
%---------------------------------------------------------------------------%
@@ -530,8 +530,6 @@
( PredName = "__Unify__", PredArity = 2
; PredName = "__Compare__", PredArity = 3
; PredName = "__Index__", PredArity = 2
- ; PredName = "__Term_To_Type__", PredArity = 2
- ; PredName = "__Type_To_Term__", PredArity = 2
).
%-----------------------------------------------------------------------------%
Index: compiler/delay_slot.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/delay_slot.m,v
retrieving revision 1.2
diff -u -r1.2 delay_slot.m
--- 1.2 1997/01/26 23:42:32
+++ delay_slot.m 1997/05/19 06:56:47
@@ -48,7 +48,7 @@
:- interface.
-:- import_module llds.
+:- import_module llds, list.
% Delay the construction of det stack frames as long as possible,
% in order to avoid the construction in as many cases as possible.
Index: compiler/det_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_util.m,v
retrieving revision 1.9
diff -u -r1.9 det_util.m
--- 1.9 1997/02/23 06:06:03
+++ det_util.m 1997/05/19 06:57:24
@@ -18,7 +18,7 @@
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, globals.
:- import_module instmap.
-:- import_module set.
+:- import_module set, list.
:- type maybe_changed ---> changed ; unchanged.
Index: compiler/fact_table.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/fact_table.m,v
retrieving revision 1.5
diff -u -r1.5 fact_table.m
--- 1.5 1997/04/07 05:39:18
+++ fact_table.m 1997/05/19 07:00:15
@@ -87,7 +87,7 @@
:- implementation.
:- import_module int, map, std_util, assoc_list, char, require, library, bool.
-:- import_module float, math, getopt.
+:- import_module float, math, getopt, term.
:- import_module parser, prog_out, term_io, llds_out, hlds_out, hlds_data.
:- import_module globals, options, passes_aux, arg_info, llds, mode_util.
:- import_module code_util, export.
Index: compiler/globals.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/globals.m,v
retrieving revision 1.19
diff -u -r1.19 globals.m
--- 1.19 1997/02/14 05:53:57
+++ globals.m 1997/05/19 07:41:37
@@ -35,10 +35,10 @@
---> simple
; compact.
+ % Once upon a time, there were more type_info options than this.
+
:- type type_info_method
- ---> one_cell
- ; one_or_two_cell
- ; shared_one_or_two_cell.
+ ---> shared_one_or_two_cell.
:- type prolog_dialect
---> default
@@ -175,8 +175,6 @@
convert_args_method("simple", simple).
convert_args_method("compact", compact).
-convert_type_info_method("one-cell", one_cell).
-convert_type_info_method("one-or-two-cell", one_or_two_cell).
convert_type_info_method("shared-one-or-two-cell", shared_one_or_two_cell).
convert_type_info_method("default", shared_one_or_two_cell).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.22
diff -u -r1.22 handle_options.m
--- 1.22 1997/02/28 05:30:14
+++ handle_options.m 1997/05/19 03:51:46
@@ -146,7 +146,7 @@
{ Error = yes("Invalid prolog-dialect option (must be `sicstus', `nu', or `default')") }
)
;
- { Error = yes("Invalid type-info option (must be `one-cell', `one-or-two-cell', `shared-one-or-two-cell' or `default')") }
+ { Error = yes("Invalid type-info option (must be `shared-one-or-two-cell' or `default')") }
)
;
{ Error = yes("Invalid args option (must be `simple' or `compact')") }
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.12
diff -u -r1.12 hlds_data.m
--- 1.12 1997/02/23 06:06:28
+++ hlds_data.m 1997/05/19 06:58:40
@@ -88,7 +88,7 @@
:- implementation.
:- import_module prog_util.
-:- import_module require, std_util.
+:- import_module require, std_util, term.
cons_id_and_args_to_term(int_const(Int), [], Term) :-
term__context_init(Context),
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.31
diff -u -r1.31 hlds_goal.m
--- 1.31 1997/05/05 11:17:01
+++ hlds_goal.m 1997/05/19 06:58:20
@@ -603,7 +603,7 @@
:- implementation.
-:- import_module require.
+:- import_module require, term.
goal_info_init(GoalInfo) :-
Detism = erroneous,
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.35
diff -u -r1.35 mercury_compile.m
--- 1.35 1997/05/16 05:45:23
+++ mercury_compile.m 1997/05/19 03:16:31
@@ -1688,12 +1688,9 @@
ArgsOpt = ""
},
globals__io_get_type_info_method(TypeInfoMethod),
- { TypeInfoMethod = one_cell,
- TypeInfoOpt = "-DONE_CELL_TYPE_INFO "
- ; TypeInfoMethod = shared_one_or_two_cell,
+ {
+ TypeInfoMethod = shared_one_or_two_cell,
TypeInfoOpt = "-DSHARED_ONE_OR_TWO_CELL_TYPEINFO "
- ; TypeInfoMethod = one_or_two_cell,
- TypeInfoOpt = "-DONE_OR_TWO_CELL_TYPEINFO "
},
globals__io_lookup_bool_option(type_layout, TypeLayoutOption),
{ TypeLayoutOption = no ->
Index: compiler/mode_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_debug.m,v
retrieving revision 1.4
diff -u -r1.4 mode_debug.m
--- 1.4 1997/04/03 01:17:55
+++ mode_debug.m 1997/05/19 06:59:21
@@ -33,7 +33,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module globals, std_util, assoc_list, io, bool, map.
+:- import_module globals, std_util, list, assoc_list, io, bool, map.
:- import_module modes, options, mercury_to_mercury, passes_aux.
:- import_module hlds_goal, instmap.
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.195
diff -u -r1.195 options.m
--- 1.195 1997/04/13 05:50:32
+++ options.m 1997/05/19 04:01:27
@@ -1261,19 +1261,12 @@
io__write_string("\t\tregister r<n>. The compact convention generally leads to\n"),
io__write_string("\t\tmore efficient code. Use of the simple convention requires the\n"),
io__write_string("\t\tC code to be compiled with -UCOMPACT_ARGS.\n"),
- io__write_string("\t--type-info {default, one-cell, one-or-two-cell, shared-one-or-two-cell}\n"),
- io__write_string("\t--type-info-convention {default, one-cell, one-or-two-cell,\n"),
- io__write_string("\t\t\tshared-one-or-two-cell}\n"),
+ io__write_string("\t--type-info {default, shared-one-or-two-cell}\n"),
+ io__write_string("\t--type-info-convention {default, shared-one-or-two-cell}\n"),
io__write_string("\t(This option is not for general use.)\n"),
io__write_string("\t\tUse the specified format for the automatically generated\n"),
- io__write_string("\t\ttype_info structures. The one-cell format minimizes\n"),
- io__write_string("\t\truntime memory allocation in grades that cannot use\n"),
- io__write_string("\t\tstatic ground terms, while the shared-one-or-two-cell format\n"),
- io__write_string("\t\tminimizes runtime memory allocation in grades that\n"),
- io__write_string("\t\tcan use static ground terms. Use of any alternative except\n"),
- io__write_string("\t\t`default' requires the C code to be compiled with the relevant\n"),
- io__write_string("\t\toption from `-DONE_CELL_TYPE_INFO', `-DONE_OR_TWO_CELL_TYPE_INFO'\n"),
- io__write_string("\t\tand `-DSHARED_ONE_OR_TWO_CELL_TYPE_INFO'.\n"),
+ io__write_string("\t\ttype_info structures. Only one option, shared-one-or-two-cell,\n"),
+ io__write_string("\t\tis presently available.\n"),
io__write_string("\t--no-type-layout\n"),
io__write_string("\t(This option is not for general use.)\n"),
io__write_string("\t\tDon't output base_type_layout structures or references\n"),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.104
diff -u -r1.104 polymorphism.m
--- 1.104 1997/05/12 08:18:09
+++ polymorphism.m 1997/05/19 03:56:05
@@ -20,8 +20,7 @@
% argument for every type variable in the predicate's type declaration.
% The argument gives information about the type, including higher-order
% predicate variables for each of the builtin polymorphic operations
-% (currently unify/2, compare/3, index/2, term_to_type/2 and type_to_term/2,
-% although the last two are usually omitted to improve compilation speed).
+% (currently unify/2, compare/3, index/2).
%
%-----------------------------------------------------------------------------%
%
@@ -31,26 +30,9 @@
% SIMILAR CHANGES TO THE #defines IN "runtime/type_info.h"
% AND VICE VERSA.
%
-% We can use one of two ways to represent the type information.
+% Type information is represented using one or two cells. The cell which
+% is always present is the base_type_info structure, laid out like this:
%
-% The old way has one cell, the type_info structure, laid out like this:
-%
-% word 0 <arity of type constructor>
-% e.g. 0 for `int', 1 for `list(T)', 2 for `map(K, V)'.
-% word 1 <=/2 predicate for type>
-% word 2 <index/2 predicate for type>
-% word 3 <compare/3 predicate for type>
-% word 4+ <the type_infos for the type params, if any>
-%
-% or if using type_to_term predicates:
-%
-% word 4 <term_to_type/2 predicate for type>
-% word 5 <type_to_term/2 predicate for type>
-% word 6+ <the type_infos for the type params, if any>
-%
-% The new way uses one or two cells. The cell which is always present
-% is the base_type_info structure, laid out like this:
-%
% word 0 <arity of type constructor>
% e.g. 0 for `int', 1 for `list(T)', 2 for `map(K, V)'.
% word 1 <=/2 predicate for type>
@@ -62,14 +44,6 @@
% e.g. "int" for `int', "list" for `list(T)',
% "map" for `map(K,V)'
%
-% or if using type_to_term predicates:
-%
-% word 4 <term_to_type/2 predicate for type>
-% word 5 <type_to_term/2 predicate for type>
-% word 6 <base_type_layout for type>
-% word 7 <base_type_functors for type>
-% word 8 <string name of type>
-%
% The other cell is the new type_info structure, laid out like this:
%
% word 0 <pointer to the base_type_info structure>
@@ -107,10 +81,6 @@
%
% Sharing one-or-two-cell structures:
%
-% Whereas the old type_info structures are often different for different
-% references to a type which takes one or more type parameters, the
-% base_type_info structures will be the same for all references to the type.
-%
% For compilation models that can put code addresses in static ground terms,
% we can arrange to create one copy of the base_type_info structure statically,
% avoiding the need to create other copies at runtime. For compilation models
@@ -117,9 +87,9 @@
% that cannot put code addresses in static ground terms, we have several
% options:
%
-% 1. use this one or two cell representation, allocating all cells
+% 1. use a one or two cell representation, but allocate all cells
% at runtime.
-% 2. use the old one cell representation, allocating all cells at
+% 2. use another representation, allocating all cells at
% runtime.
% 3. use a shared static base_type_info, but initialize its code
% addresses during startup (that is, during the module
@@ -126,10 +96,8 @@
% initialization code).
%
% Presently, shared-one-or-two cells are the default, with grades that
-% cannot use static code addresses using option 3. It is likely that in
-% future, support for one-cell representation, and non-shared
-% one-or-two-cell representations will be dropped, simply to reduce the
-% complexity of the polymorphism system.
+% cannot use static code addresses using option 3. Support for older
+% type_info representations has been dropped.
%
%-----------------------------------------------------------------------------%
%
@@ -144,35 +112,13 @@
%
% p(X) :- q([X]), r(0).
%
-% All three methods (one_cell, one_or_two_cell, shared_one_or_two_cell)
-% add an extra argument for each type variable:
+% Wed add an extra argument for each type variable:
%
% :- pred p(type_info(T1), T1).
% :- pred q(type_info(T2), T2).
% :- pred r(type_info(T3), T3).
%
-% With the one_cell representation, we transform the body of p to this:
-%
-% p(TypeInfoT1, X) :-
-% TypeInfoT2 = type_info(
-% 1,
-% '__Unify__'<list/1>,
-% '__Index__'<list/1>,
-% '__Compare__'<list/1>,
-% '__Term_To_Type__'<list/1>,
-% '__Type_To_Term__'<list/1>,
-% TypeInfoT1),
-% q(TypeInfoT2, [X]),
-% TypeInfoT3 = type_info(
-% 0,
-% builtin_unify_int,
-% builtin_index_int,
-% builtin_compare_int,
-% builtin_term_to_type_int,
-% builtin_type_to_term_int,
-% r(TypeInfoT3, 0).
-%
-% With the one_or_two_cell representation, we transform the body of p to this:
+% We transform the body of p to this:
%
% p(TypeInfoT1, X) :-
% BaseTypeInfoT2 = base_type_info(
@@ -180,8 +126,6 @@
% '__Unify__'<list/1>,
% '__Index__'<list/1>,
% '__Compare__'<list/1>,
-% '__Term_To_Type__'<list/1>,
-% '__Type_To_Term__'<list/1>,
% <base_type_layout for list/1>,
% <base_type_functors for list/1>,
% "list"),
@@ -194,18 +138,13 @@
% builtin_unify_int,
% builtin_index_int,
% builtin_compare_int,
-% builtin_term_to_type_int,
-% builtin_type_to_term_int,
% <base_type_layout for int/0>,
% <base_type_functors for int/0>,
% "int"),
% r(TypeInfoT3, 0).
%
-% With the shared_one_or_two_cell representation, we transform the body of p
-% to the same as one_or_two_cell, but the unifications with
-% base_type_info(...) are generated as references to the single
-% definition of base_type_info (which is generated in the module that
-% defines it).
+% Note that base_type_infos are actually generated as references to a
+% single shared base_type_info.
%
%-----------------------------------------------------------------------------%
@@ -426,8 +365,10 @@
{ special_pred_get_type(MangledPredName, ArgVars0, MainVar) },
{ map__lookup(VarTypes, MainVar, Type) },
{ Type \= term__variable(_) },
- % don't try this for type_to_term or term_to_type
- % if they're not implemented
+
+ % don't try this for any special preds if they're not
+ % implemented
+
{ special_pred_list(SpecialPredIds) },
{ list__member(SpecialPredId, SpecialPredIds) }
->
@@ -889,63 +830,6 @@
module_info_globals(ModuleInfo, Globals),
globals__get_type_info_method(Globals, TypeInfoMethod),
(
- TypeInfoMethod = one_cell,
-
- % Create a unification for the one-cell style type_info
- % variable for this type:
- % TypeInfoVar = type_info(
- % CountVar,
- % SpecialPredVars...,
- % ArgTypeInfoVars...).
- %
- % For closures, the CountVar contains the correct actual
- % arity, so no changes are necessary (this is not true
- % of other type_info representations).
-
- list__length(TypeArgs, TypeArity),
- polymorphism__make_count_var(TypeArity, VarSet1, VarTypes1,
- CountVar, CountGoal, VarSet2, VarTypes2),
- polymorphism__get_special_proc_list(Type, ModuleInfo,
- VarSet2, VarTypes2, SpecialPredVars, SpecialPredGoals,
- VarSet3, VarTypes3),
-
- list__append([CountVar | SpecialPredVars], ArgTypeInfoVars,
- ArgVars),
- polymorphism__init_type_info_var(Type, ArgVars, "type_info",
- VarSet3, VarTypes3, Var, TypeInfoGoal,
- VarSet, VarTypes),
-
- list__append([CountGoal | SpecialPredGoals],
- ArgTypeInfoGoals, ExtraGoals0),
- list__append(ExtraGoals0, [TypeInfoGoal], ExtraGoals)
- ;
- TypeInfoMethod = one_or_two_cell,
-
- % Create a unification for the base_type_info
- % variable for this type:
- % BaseVar = base_type_info(
- % CountVar,
- % SpecialPredVars...)
-
- list__length(TypeArgs, TypeArity),
- polymorphism__make_count_var(TypeArity, VarSet1, VarTypes1,
- CountVar, CountGoal, VarSet2, VarTypes2),
- polymorphism__get_special_proc_list(Type, ModuleInfo,
- VarSet2, VarTypes2, SpecialPredVars, SpecialPredGoals,
- VarSet3, VarTypes3),
-
- polymorphism__init_type_info_var(Type,
- [CountVar | SpecialPredVars], "base_type_info",
- VarSet3, VarTypes3, BaseVar, BaseGoal,
- VarSet4, VarTypes4),
-
- list__append([CountGoal | SpecialPredGoals], [BaseGoal],
- ExtraGoals0),
- polymorphism__maybe_init_second_cell(ArgTypeInfoVars,
- ArgTypeInfoGoals, Type, IsHigherOrder,
- BaseVar, VarSet4, VarTypes4, ExtraGoals0,
- Var, VarSet, VarTypes, ExtraGoals)
- ;
TypeInfoMethod = shared_one_or_two_cell,
polymorphism__init_const_base_type_info_var(Type,
@@ -1064,9 +948,7 @@
%
% SpecialPred1 = __Unify__<type>,
% SpecialPred2 = __Index__<type>,
- % SpecialPred3 = __Compare__<type>,
- % SpecialPred4 = __Term_To_Type__<type>,
- % SpecialPred5 = __Type_To_Term__<type>.
+ % SpecialPred3 = __Compare__<type>.
:- pred polymorphism__get_special_proc_list(
type, module_info, varset, map(var, type),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/special_pred.m,v
retrieving revision 1.11
diff -u -r1.11 special_pred.m
--- 1.11 1997/01/20 03:27:52
+++ special_pred.m 1997/05/19 04:22:11
@@ -24,9 +24,7 @@
:- type special_pred_id
---> unify
; index
- ; compare
- ; term_to_type
- ; type_to_term.
+ ; compare.
:- pred special_pred_info(special_pred_id, type, string, list(type),
list(mode), determinism).
@@ -53,15 +51,9 @@
special_pred_list([unify, index, compare]).
-% **** Replace the above definition of special_pred_list with the following ****
-% **** to have term_to_type and type_to_term as special preds also. ****
-% special_pred_list([unify, index, compare, term_to_type, type_to_term]).
-
special_pred_name_arity(unify, "unify", "__Unify__", 2).
special_pred_name_arity(index, "index", "__Index__", 2).
special_pred_name_arity(compare, "compare", "__Compare__", 3).
-special_pred_name_arity(type_to_term, "type_to_term", "__Type_To_Term__", 2).
-special_pred_name_arity(term_to_type, "term_to_type", "__Term_To_Type__", 2).
% mode num is 0 for semidet, 10000 for det
% see make_hlds.m
@@ -68,8 +60,6 @@
special_pred_mode_num(unify, 0).
special_pred_mode_num(index, 10000).
special_pred_mode_num(compare, 10000).
-special_pred_mode_num(type_to_term, 10000).
-special_pred_mode_num(term_to_type, 0).
special_pred_info(unify, Type, "__Unify__", [Type, Type], [In, In], semidet) :-
in_mode(In).
@@ -86,18 +76,6 @@
in_mode(In),
out_mode(Out).
-special_pred_info(term_to_type, Type,
- "__Term_To_Type__", [TermType, Type], [In, Out], semidet) :-
- construct_type(qualified("mercury_builtin", "term") - 0, [], TermType),
- in_mode(In),
- out_mode(Out).
-
-special_pred_info(type_to_term, Type,
- "__Type_To_Term__", [Type, TermType], [In, Out], det) :-
- construct_type(qualified("mercury_builtin", "term") - 0, [], TermType),
- in_mode(In),
- out_mode(Out).
-
:- pred in_mode((mode)::out) is det.
in_mode(user_defined_mode(qualified("mercury_builtin", "in"), [])).
@@ -114,9 +92,9 @@
% find the type at a known position from the end of the list
% (by using list__reverse).
- % Currently for most of the special predicates the type variable can be
- % found in the last type argument, except for index and type_to_term,
- % for which it is the second-last argument.
+ % Currently for most of the special predicates the type variable
+ % can be found in the last type argument, except for index, for
+ % which it is the second-last argument.
special_pred_get_type("__Unify__", Types, T) :-
list__reverse(Types, [T | _]).
@@ -124,9 +102,5 @@
list__reverse(Types, [_, T | _]).
special_pred_get_type("__Compare__", Types, T) :-
list__reverse(Types, [T | _]).
-special_pred_get_type("__Type_To_Term__", Types, T) :-
- list__reverse(Types, [_, T | _]).
-special_pred_get_type("__Term_To_Type__", Types, T) :-
- list__reverse(Types, [T | _]).
%-----------------------------------------------------------------------------%
Index: compiler/tree.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/tree.m,v
retrieving revision 1.7
diff -u -r1.7 tree.m
--- 1.7 1996/12/21 06:39:24
+++ tree.m 1997/05/19 06:52:36
@@ -14,11 +14,11 @@
%-----------------------------------------------------------------------------%
:- module tree.
-:- import_module list.
%-----------------------------------------------------------------------------%
:- interface.
+:- import_module list.
:- type tree(T) ---> empty
; node(T)
; tree(tree(T), tree(T)).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.56
diff -u -r1.56 unify_proc.m
--- 1.56 1997/04/08 02:26:41
+++ unify_proc.m 1997/05/19 04:24:05
@@ -382,12 +382,6 @@
; SpecialPredId = compare, Args = [Res, X, Y] ->
unify_proc__generate_compare_clauses(TypeBody, Res, X, Y,
Clauses, VarTypeInfo1, VarTypeInfo)
- ; SpecialPredId = term_to_type, Args = [Term, X] ->
- unify_proc__generate_term_to_type_clauses(TypeBody, Term, X,
- Clauses, VarTypeInfo1, VarTypeInfo)
- ; SpecialPredId = type_to_term, Args = [X, Term] ->
- unify_proc__generate_type_to_term_clauses(TypeBody, X, Term,
- Clauses, VarTypeInfo1, VarTypeInfo)
;
error("unknown special pred")
),
@@ -457,51 +451,6 @@
{ Clauses = [clause([], Body, Context)] }
).
-:- pred unify_proc__generate_term_to_type_clauses(hlds_type_body, var, var,
- list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_term_to_type_clauses(in, in, in, out, in, out)
- is det.
-
-unify_proc__generate_term_to_type_clauses(TypeBody, Term, X, Clauses) -->
- ( {TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
- unify_proc__generate_du_term_to_type_clauses(Ctors, Term, X,
- Clauses)
- ;
-
- { ArgVars = [Term, X] },
- unify_proc__build_call("term_to_type", ArgVars, Goal),
- unify_proc__info_get_varset(Varset0),
- unify_proc__info_get_types(Types0),
- { implicitly_quantify_clause_body(ArgVars, Goal,
- Varset0, Types0, Body, Varset, Types, _Warnings) },
- unify_proc__info_set_varset(Varset),
- unify_proc__info_set_types(Types),
- { term__context_init(Context) },
- { Clauses = [clause([], Body, Context)] }
- ).
-
-:- pred unify_proc__generate_type_to_term_clauses(hlds_type_body, var, var,
- list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_type_to_term_clauses(in, in, in, out, in, out)
- is det.
-
-unify_proc__generate_type_to_term_clauses(TypeBody, X, Term, Clauses) -->
- ( { TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
- unify_proc__generate_du_type_to_term_clauses(Ctors, X, Term,
- Clauses)
- ;
- { ArgVars = [X, Term] },
- unify_proc__build_call("type_to_term", ArgVars, Goal),
- unify_proc__info_get_varset(Varset0),
- unify_proc__info_get_types(Types0),
- { implicitly_quantify_clause_body(ArgVars, Goal,
- Varset0, Types0, Body, Varset, Types, _Warnings) },
- unify_proc__info_set_varset(Varset),
- unify_proc__info_set_types(Types),
- { term__context_init(Context) },
- { Clauses = [clause([], Body, Context)] }
- ).
-
%-----------------------------------------------------------------------------%
/*
@@ -862,393 +811,6 @@
unify_proc__compare_args([_|_], [], _, _) -->
{ error("unify_proc__compare_args: length mismatch") }.
-/*
- For a type such as
- type tree(T1, T2) --->
- empty
- ; tree(T1, T2, tree(T1, T2), tree(T1, T2))
-
- we want to generate code
-
- term_to_type(Term, X) :-
- (
- Term = term__functor(term__atom("empty"), [], _),
- X = empty.
- ;
- Term = term__functor(term__atom("tree"),
- [KeyTerm, ValTerm, LTreeTerm, RTreeTerm], _),
- term_to_type(KeyTerm, Key),
- term_to_type(ValTerm, Val),
- term_to_type(LTreeTerm, L),
- term_to_type(RTreeTerm, R),
- X = tree(Key, Val, L, R)
- ).
-
- The complex unification of Term to term__functor is achieved
- by atomic unifications. The code that achieves this is a
- specialized inline version of unravel_unification from
- make_hlds.m. The actual code generated for the above type is:
-
- term_to_type(Term, X) :-
- Term = term__functor(V1, V2, V3),
- V1 = term__atom(V4),
- (
- V4 = "empty",
- V2 = [],
- X = empty
- ;
- V4 = "tree",
- V2 = [KeyTerm | V5],
- V5 = [ValTerm | V6],
- V6 = [LTreeTerm | V7],
- V7 = [RTreeTerm | V8],
- V8 = [],
- term_to_type(KeyTerm, Key),
- term_to_type(ValTerm, Val),
- term_to_type(LTreeTerm, L),
- term_to_type(RTreeTerm, R),
- X = tree(Key, Val, L, R)
- ).
-*/
-
-:- pred unify_proc__generate_du_term_to_type_clauses(list(constructor),
- var, var, list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_term_to_type_clauses(in, in, in, out, in, out)
- is det.
-
-unify_proc__generate_du_term_to_type_clauses([], _Term, _X, []) --> [].
-unify_proc__generate_du_term_to_type_clauses([Ctor | Ctors], Term, X,
- [Clause]) -->
- { term__context_init(Context) },
-
- % Make V1, V2, V3, V4
- unify_proc__info_new_var(ConstType, V1),
- unify_proc__info_new_var(TermListType, V2),
- unify_proc__info_new_var(ContextType, V3),
- unify_proc__info_new_var(StringType, V4),
-
- % Make Term = term__functor(V1, V2, V3)
- { create_atomic_unification(
- Term,
- functor(cons(unqualified("term__functor"), 3), [ V1, V2, V3 ]),
- Context, explicit, [],
- TermGoal) },
-
- % Make V1 = term__atom(V4),
- { create_atomic_unification(
- V1,
- functor(cons(unqualified("term__atom"), 1), [ V4 ]),
- Context, explicit, [],
- AtomGoal) },
-
- { construct_type(qualified("mercury_builtin", "const") - 0,
- [], ConstType) },
- { construct_type(qualified("mercury_builtin", "term") - 0,
- [], TermType) },
- { construct_type(qualified("mercury_builtin", "list") - 1,
- [TermType], TermListType) },
- { construct_type(qualified("mercury_builtin", "term__context") - 0,
- [], ContextType) },
- { construct_type(unqualified("string") - 0, [], StringType) },
-
- % Make disjunctions for the difference functors of the type
- unify_proc__generate_du_term_to_type_disjunctions([Ctor | Ctors],
- V2, V4, X,
- ConstType, TermType, TermListType, ContextType, StringType,
- ListDisjunctiveGoals),
-
- % Combine goals into a clause
- { goal_info_init(GoalInfo) },
- { disj_list_to_goal(ListDisjunctiveGoals, GoalInfo, DisjunctiveGoal) },
- { conj_list_to_goal([TermGoal, AtomGoal, DisjunctiveGoal], GoalInfo,
- Goal) },
- unify_proc__info_get_varset(Varset0),
- unify_proc__info_get_types(Types0),
- { implicitly_quantify_clause_body([Term, X], Goal,
- Varset0, Types0, Body, Varset, Types, _Warnings) },
- unify_proc__info_set_varset(Varset),
- unify_proc__info_set_types(Types),
- { Clause = clause([], Body, Context) }.
-
-:- pred unify_proc__generate_du_term_to_type_disjunctions(
- list(constructor), var, var, var, term, term, term, term, term,
- list(hlds_goal),
- unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_term_to_type_disjunctions(
- in, in, in, in, in, in, in, in, in, out, in, out) is det.
-
-unify_proc__generate_du_term_to_type_disjunctions([],_,_,_,_,_,_,_,_,[]) --> [].
-unify_proc__generate_du_term_to_type_disjunctions([Ctor | Ctors], V2, V4, X,
- ConstType, TermType, TermListType, ContextType, StringType,
- [Goal | Goals]) -->
-
- { Ctor = FunctorName - ArgTypes },
- { list__length(ArgTypes, FunctorArity) },
- { unqualify_name(FunctorName, UnqualifiedFunctorName) },
- { FunctorAtom = cons(FunctorName, FunctorArity) },
- { FunctorString = string_const(UnqualifiedFunctorName) },
- { term__context_init(Context) },
-
- % Make V4 = ...
- { create_atomic_unification(
- V4,
- functor(FunctorString, []),
- Context, explicit, [],
- FunctorGoal) },
-
- % Make Key, Val, L, R
- unify_proc__make_fresh_vars(ArgTypes, ArgVars),
-
- % Make Vx = [...] and term_to_type(..., ...) recursive goals
- unify_proc__generate_du_term_to_type_recursive(
- ArgVars, V2, Context, TermType, TermListType,
- TermGoals, Term_To_TypeGoals),
-
- % Make X = ....
- { create_atomic_unification(
- X,
- functor(FunctorAtom, ArgVars),
- Context, explicit, [],
- XGoal) },
-
- { list__append(TermGoals, Term_To_TypeGoals, RecursiveGoals) },
- { goal_info_init(GoalInfo) },
- {conj_list_to_goal([FunctorGoal,XGoal|RecursiveGoals], GoalInfo, Goal)},
-
- unify_proc__generate_du_term_to_type_disjunctions(Ctors, V2, V4, X,
- ConstType, TermType, TermListType, ContextType, StringType,
- Goals).
-
-:- pred unify_proc__generate_du_term_to_type_recursive(
- list(var), var, term__context, type, type,
- list(hlds_goal), list(hlds_goal), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_term_to_type_recursive(
- in, in, in, in, in,
- out, out, in, out) is det.
-
-unify_proc__generate_du_term_to_type_recursive(
- [], Var, Context, _TermType, _TermListType,
- [ Goal ], []) -->
- { create_atomic_unification(
- Var,
- functor(cons(unqualified("[]"), 0), []),
- Context, explicit, [],
- Goal) }.
-
-unify_proc__generate_du_term_to_type_recursive(
- [ ArgVar | ArgVars ], Var, Context, TermType, TermListType,
- [ TermGoal | TermGoals], [TermToTypeGoal | Term_To_TypeGoals ]) -->
- unify_proc__info_new_var(TermType, TermVar),
- unify_proc__info_new_var(TermListType, TermListVar),
- { create_atomic_unification(
- Var,
- functor(cons(unqualified("."), 2), [ TermVar, TermListVar ]),
- Context, explicit, [],
- TermGoal) },
- unify_proc__build_call("term_to_type",[TermVar, ArgVar],TermToTypeGoal),
- unify_proc__generate_du_term_to_type_recursive(
- ArgVars, TermListVar, Context, TermType, TermListType,
- TermGoals, Term_To_TypeGoals).
-
-/*
- For a type such as
- type tree(T1, T2) --->
- empty
- ; tree(T1, T2, tree(T1, T2), tree(T1, T2))
-
- we want to generate code
-
- type_to_term(X, Term) :-
- (
- X = empty,
- term__context_init(Context),
- Term = term__functor(term__atom("empty"), [], Context)
- ;
- X = tree(Key, Val, L, R),
- type_to_term(Key, KeyTerm),
- type_to_term(Val, VeyTerm),
- type_to_term(L, LTreeTerm),
- type_to_term(R, RTreeTerm),
- term__context_init(Context),
- Term = term__functor(term__atom("tree"),
- [KeyTerm, ValTerm, LTreeTerm, RTreeTerm], Context)
- ).
-
- The complex unification of Term to term__functor is achieved
- by atomic unifications. The code that achieves this is a
- specialized inline version of unravel_unification from
- make_hlds.m. The actual code generated for the above type is:
-
- type_to_term(X, Term) :-
- (
- X = empty,
- V1 = term__atom(V4),
- V4 = "empty",
- V2 = [],
- term__context_init(V3),
- Term = term__functor(V1, V2, V3)
- ;
- X = tree(Key, Val, L, R),
- type_to_term(Key, KeyTerm),
- type_to_term(Val, ValTerm),
- type_to_term(L, LTreeTerm),
- type_to_term(R, RTreeTerm),
- V2 = [KeyTerm | V5],
- V5 = [ValTerm | V6],
- V6 = [LTreeTerm | V7],
- V7 = [RTreeTerm | V8],
- V8 = [],
- V1 = term__atom(V4),
- V4 = "tree",
- term__context_init(V3),
- Term = term__functor(V1, V2, V3).
- ).
-*/
-
-:- pred unify_proc__generate_du_type_to_term_clauses(list(constructor),
- var, var, list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_type_to_term_clauses(in, in, in, out, in, out)
- is det.
-
-unify_proc__generate_du_type_to_term_clauses([], _X, _Term, []) --> [].
-unify_proc__generate_du_type_to_term_clauses([Ctor | Ctors], X, Term,
- [Clause | Clauses]) -->
- { Ctor = FunctorName - ArgTypes },
- { unqualify_name(FunctorName, UnqualifiedFunctorName) },
- { list__length(ArgTypes, FunctorArity) },
- { FunctorAtom = cons(FunctorName, FunctorArity) },
- { FunctorString = string_const(UnqualifiedFunctorName) },
- { term__context_init(Context) },
-
- { construct_type(qualified("mercury_builtin", "const") - 0,
- [], ConstType) },
- { construct_type(qualified("mercury_builtin", "term") - 0,
- [], TermType) },
- { construct_type(qualified("mercury_builtin", "list") - 0,
- [TermType], TermListType) },
- { construct_type(qualified("mercury_builtin", "term__context") - 0,
- [], ContextType) },
- { construct_type(unqualified("string") - 0, [], StringType) },
-
- % Make Key, Val, L, R
- unify_proc__make_fresh_vars(ArgTypes, ArgVars),
-
- % Make X = ....
- { create_atomic_unification(
- X,
- functor(FunctorAtom, ArgVars),
- Context, explicit, [],
- XGoal) },
-
- % Make V2
- unify_proc__info_new_var(TermListType, V2),
-
- % Make type_to_term(..., ...) and Vx = [...] recursive goals
- unify_proc__generate_du_type_to_term_recursive_clauses(
- ArgVars, V2, Context, TermType, TermListType,
- RecursiveGoals),
-
- % Make V1, V4
- unify_proc__info_new_var(ConstType, V1),
- unify_proc__info_new_var(StringType, V4),
-
- % Make V1 = term__atom(V4),
- { create_atomic_unification(
- V1,
- functor(cons(unqualified("term__atom"), 1), [ V4 ]),
- Context, explicit, [],
- AtomGoal) },
-
- % Make V4 = ...
- { create_atomic_unification(
- V4,
- functor(FunctorString, []),
- Context, explicit, [],
- FunctorGoal) },
-
- % Make V3
- unify_proc__info_new_var(ContextType, V3),
-
- % Make term__context(V3)
- % unify_proc__build_call("term__context_init", [V3], ContextGoal),
- % --- From here ---
- unify_proc__info_new_var(StringType, ContextString),
- { construct_type(unqualified("int") - 0, [], IntType) },
- unify_proc__info_new_var(IntType, ContextInt),
- { create_atomic_unification(
- V3,
- functor(cons(unqualified("term__context"), 2),
- [ContextString,ContextInt]),
- Context, explicit, [],
- ContextGoal) },
- { create_atomic_unification(
- ContextString,
- functor(string_const(""), []),
- Context, explicit, [],
- ContextGoalString) },
- { create_atomic_unification(
- ContextInt,
- functor(int_const(0), []),
- Context, explicit, [],
- ContextGoalInt) },
- % --- To here ---
-
- % Make Term = term__functor(V1, V2, V3)
- { create_atomic_unification(
- Term,
- functor(cons(unqualified("term__functor"), 3), [ V1, V2, V3 ]),
- Context, explicit, [],
- TermGoal) },
-
- % Combine goals into a clause
- { goal_info_init(GoalInfo) },
- { conj_list_to_goal(
- [ XGoal, AtomGoal, FunctorGoal, ContextGoal, TermGoal,
- ContextGoalString, ContextGoalInt
- |RecursiveGoals],
- GoalInfo,
- Goal) },
- unify_proc__info_get_varset(VarSet0),
- unify_proc__info_get_types(Types0),
- { implicitly_quantify_clause_body([Term, X], Goal, VarSet0, Types0,
- Body, VarSet, Types, _Warnings) },
- unify_proc__info_set_varset(VarSet),
- unify_proc__info_set_types(Types),
- { Clause = clause([], Body, Context) },
-
- % Make clauses for other functors of type
- unify_proc__generate_du_type_to_term_clauses(Ctors, X, Term, Clauses).
-
-:- pred unify_proc__generate_du_type_to_term_recursive_clauses(
- list(var), var, term__context, type, type,
- list(hlds_goal), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_type_to_term_recursive_clauses(
- in, in, in, in, in,
- out, in, out) is det.
-
-unify_proc__generate_du_type_to_term_recursive_clauses(
- [], Var, Context, _TermType, _TermListType,
- [ Goal ]) -->
- { create_atomic_unification(
- Var,
- functor(cons(unqualified("[]"), 0), []),
- Context, explicit, [],
- Goal) }.
-
-unify_proc__generate_du_type_to_term_recursive_clauses(
- [ ArgVar | ArgVars ], Var, Context, TermType, TermListType,
- [ TypeToTermGoal, TermGoal | Goals ]) -->
- unify_proc__info_new_var(TermType, TermVar),
- unify_proc__info_new_var(TermListType, TermListVar),
- unify_proc__build_call("type_to_term",[ArgVar, TermVar],TypeToTermGoal),
- { create_atomic_unification(
- Var,
- functor(cons(unqualified("."), 2), [ TermVar, TermListVar ]),
- Context, explicit, [],
- TermGoal) },
- unify_proc__generate_du_type_to_term_recursive_clauses(
- ArgVars, TermListVar, Context, TermType, TermListType, Goals).
-
%-----------------------------------------------------------------------------%
:- pred unify_proc__build_call(string, list(var), hlds_goal,
Index: library/bag.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/bag.m,v
retrieving revision 1.9
diff -u -r1.9 bag.m
--- 1.9 1997/04/20 01:39:03
+++ bag.m 1997/05/19 05:10:07
@@ -16,6 +16,8 @@
:- interface.
+:- import_module list.
+
:- type bag(T).
% create an empty bag
Index: library/list.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/list.m,v
retrieving revision 1.66
diff -u -r1.66 list.m
--- 1.66 1997/02/26 08:56:57
+++ list.m 1997/05/19 04:40:41
@@ -25,12 +25,8 @@
% of type `list(T)', denoted `[Head | Tail]'.
%
-% :- type list(T) ---> [] ; [T | list(T)].
+:- type list(T) ---> [] ; [T | list(T)].
- % The definition of `list(T)' is actually in mercury_builtin.m because
- % the implementation of type_to_term/3 and term_to_type/3 means
- % that it has to be.
-
%-----------------------------------------------------------------------------%
% Some declarations for complicated modes using lists.
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.73
diff -u -r1.73 mercury_builtin.m
--- 1.73 1997/05/14 01:55:00
+++ mercury_builtin.m 1997/05/19 05:13:02
@@ -154,16 +154,6 @@
:- mode compare(uo, in, ui) is det.
:- mode compare(uo, in, in) is det.
- % The following three predicates can convert values of any
- % type to the type `term' and back again.
- % However, they are not yet implemented.
-
-:- pred term_to_type(term :: in, T :: out) is semidet.
-
-:- pred det_term_to_type(term :: in, T :: out) is det.
-
-:- pred type_to_term(T :: in, term :: out) is det.
-
%-----------------------------------------------------------------------------%
:- implementation.
@@ -187,36 +177,26 @@
:- pred builtin_unify_int(int::in, int::in) is semidet.
:- pred builtin_index_int(int::in, int::out) is det.
:- pred builtin_compare_int(comparison_result::out, int::in, int::in) is det.
-:- pred builtin_term_to_type_int(term :: in, int :: out) is semidet.
-:- pred builtin_type_to_term_int(int :: in, term :: out) is det.
:- pred builtin_unify_character(character::in, character::in) is semidet.
:- pred builtin_index_character(character::in, int::out) is det.
:- pred builtin_compare_character(comparison_result::out, character::in,
character::in) is det.
-:- pred builtin_term_to_type_character(term :: in, character :: out) is semidet.
-:- pred builtin_type_to_term_character(character :: in, term :: out) is det.
:- pred builtin_unify_string(string::in, string::in) is semidet.
:- pred builtin_index_string(string::in, int::out) is det.
:- pred builtin_compare_string(comparison_result::out, string::in, string::in)
is det.
-:- pred builtin_term_to_type_string(term :: in, string :: out) is semidet.
-:- pred builtin_type_to_term_string(string :: in, term :: out) is det.
:- pred builtin_unify_float(float::in, float::in) is semidet.
:- pred builtin_index_float(float::in, int::out) is det.
:- pred builtin_compare_float(comparison_result::out, float::in, float::in)
is det.
-:- pred builtin_term_to_type_float(term :: in, float :: out) is semidet.
-:- pred builtin_type_to_term_float(float :: in, term :: out) is det.
:- pred builtin_unify_pred((pred)::in, (pred)::in) is semidet.
:- pred builtin_index_pred((pred)::in, int::out) is det.
:- pred builtin_compare_pred(comparison_result::out, (pred)::in, (pred)::in)
is det.
-:- pred builtin_term_to_type_pred(term::in, (pred)::out) is semidet.
-:- pred builtin_type_to_term_pred((pred)::in, term::out) is det.
:- pred unused is det.
@@ -248,63 +228,6 @@
:- mode builtin_int_gt(in, in) is semidet.
:- external(builtin_int_gt/2).
-% The types term, const, var and var_supply should be defined in
-% term.m, but we define them here since they're need for implementation
-% of term_to_type/2 and type_to_term/2.
-
-:- type term ---> term__functor(const, list(term), term__context)
- ; term__variable(var).
-:- type const ---> term__atom(string)
- ; term__integer(int)
- ; term__string(string)
- ; term__float(float).
-:- type var.
-:- type var_supply.
-
-% The type list should be defined in list.m, but we define it here since
-% it is needed for the definition of type term, which is needed for the
-% implementation of term_to_type/2 and type_to_term/2.
-
-:- type list(T) ---> [] ; [T | list(T)].
-
- % At the moment, the only context we store is the line
- % number.
-
-:- type term__context ---> term__context(string, int).
- % file name, line number.
-
-%-----------------------------------------------------------------------------%
-
-% The following three predicates should be defined in term.m, but
-% type var has to be defined here for term_to_type.
-
-% To manage a supply of variables, use the following 2 predicates.
-% (We might want to give these a unique mode later.)
-
-:- pred term__init_var_supply(var_supply).
-:- mode term__init_var_supply(out) is det.
-:- mode term__init_var_supply(in) is semidet. % implied
-% term__init_var_supply(VarSupply) :
-% returns a fresh var_supply for producing fresh variables.
-
-:- pred term__create_var(var_supply, var, var_supply).
-:- mode term__create_var(in, out, out) is det.
-% term__create_var(VarSupply0, Variable, VarSupply) :
-% create a fresh variable (var) and return the
-% updated var_supply.
-
-:- pred term__var_to_int(var, int).
-:- mode term__var_to_int(in, out) is det.
-% Convert a variable to an int.
-% Different variables map to different ints.
-% Other than that, the mapping is unspecified.
-
-%-----------------------------------------------------------------------------%
-
-
-:- pred term__context_init(term__context).
-:- mode term__context_init(out) is det.
-
%-----------------------------------------------------------------------------%
:- implementation.
@@ -323,71 +246,9 @@
:- external(unify/2).
:- external(index/2).
:- external(compare/3).
-:- external(type_to_term/2).
-
-
-%-----------------------------------------------------------------------------%
-
-% XXX term_to_type and type_to_term should be moved to term.m.
-
-term_to_type(Term, Val) :-
- term_to_type_2(Term, type_of(Val), Univ),
- univ_to_type(Univ, Val).
-
-:- pred term_to_type_2(term::in, type_info::in, univ::out) is semidet.
-
-term_to_type_2(term__variable(_), _Val, _) :-
- fail.
-term_to_type_2(term__functor(term__integer(Int), _, _), _Type, Value) :-
- type_to_univ(Int, Value).
-term_to_type_2(term__functor(term__float(Float), _, _), _Type, Value) :-
- type_to_univ(Float, Value).
-term_to_type_2(term__functor(term__string(String), _, _), _Type, Value) :-
- type_to_univ(String, Value).
-term_to_type_2(term__functor(term__atom(Functor), ArgTerms, _), Type, Value) :-
- list__length(ArgTerms, Arity),
- find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes),
- term_list_to_type_list(ArgTerms, ArgTypes, Args),
- Value = construct(Type, FunctorNumber, Args).
-
-:- pred term_list_to_type_list(list(term)::in, list(type_info)::in,
- list(univ)::out) is semidet.
-
-term_list_to_type_list([], [], []).
-term_list_to_type_list([Term|Terms], [Type|Types], [Value|Values]) :-
- term_to_type_2(Term, Type, Value),
- term_list_to_type_list(Terms, Types, Values).
-
-:- pred find_functor(type_info::in, string::in, int::in, int::out,
- list(type_info)::out) is semidet.
-find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes) :-
- N = num_functors(Type),
- find_functor_2(Type, Functor, Arity, N, FunctorNumber, ArgTypes).
-
-:- pred find_functor_2(type_info::in, string::in, int::in, int::in,
- int::out, list(type_info)::out) is semidet.
-find_functor_2(TypeInfo, Functor, Arity, Num, FunctorNumber, ArgTypes) :-
- Num >= 0,
- Num1 = Num - 1,
- (
- get_functor(TypeInfo, Num1, Functor, Arity, ArgTypes1)
- ->
- ArgTypes = ArgTypes1,
- FunctorNumber = Num1
- ;
- find_functor_2(TypeInfo, Functor, Arity, Num1,
- FunctorNumber, ArgTypes)
- ).
%-----------------------------------------------------------------------------%
-det_term_to_type(Term, X) :-
- ( term_to_type(Term, X1) ->
- X = X1
- ;
- error("det_term_to_type failed as term doesn't represent a valid ground value of the appropriate type")
- ).
-
builtin_unify_int(X, X).
builtin_index_int(X, X).
@@ -401,12 +262,6 @@
R = (>)
).
-builtin_term_to_type_int(term__functor(term__integer(Int), _TermList, _Context),
- Int).
-
-builtin_type_to_term_int(Int, term__functor(term__integer(Int), [], Context)) :-
- term__context_init(Context).
-
builtin_unify_character(C, C).
builtin_index_character(C, N) :-
@@ -423,15 +278,6 @@
R = (>)
).
-builtin_term_to_type_character(
- term__functor(term__atom(String), [], _Context), Character) :-
- string__first_char(String, Character, "").
-
-builtin_type_to_term_character(
- Character, term__functor(term__atom(String), [], Context)) :-
- term__context_init(Context),
- string__char_to_string(Character, String).
-
builtin_unify_string(S, S).
builtin_index_string(_, -1).
@@ -446,13 +292,6 @@
R = (>)
).
-builtin_term_to_type_string(
- term__functor(term__string(String), [], _Context), String).
-
-builtin_type_to_term_string(
- String, term__functor(term__string(String), [], Context)) :-
- term__context_init(Context).
-
builtin_unify_float(F, F).
builtin_index_float(_, -1).
@@ -466,13 +305,6 @@
R = (=)
).
-builtin_term_to_type_float(term__functor(
- term__float(Float), _TermList, _Context), Float).
-
-builtin_type_to_term_float(
- Float, term__functor(term__float(Float), [], Context)) :-
- term__context_init(Context).
-
:- pred builtin_strcmp(int, string, string).
:- mode builtin_strcmp(out, in, in) is det.
@@ -498,26 +330,6 @@
Res = (<)
).
-builtin_term_to_type_pred(_Term, Pred) :-
- % suppress determinism warning
- ( semidet_succeed ->
- error("attempted conversion of a term to a higher-order predicate")
- ;
- % the following is never executed
- Pred = semidet_succeed,
- semidet_succeed
- ).
-
-builtin_type_to_term_pred(_Pred, Term) :-
- % suppress determinism warning
- ( semidet_succeed ->
- error("attempted comparison of higher-order predicate terms")
- ;
- % the following is never executed
- term__context_init(Context),
- Term = term__functor(term__atom(""), [], Context)
- ).
-
unused :-
( semidet_succeed ->
error("attempted use of dead predicate")
@@ -531,8 +343,6 @@
:- pragma(c_code, "
-#ifdef SHARED_ONE_OR_TWO_CELL_TYPE_INFO
-
#ifdef USE_TYPE_LAYOUT
/* base_type_layout definitions */
@@ -652,8 +462,6 @@
Declare_entry(mercury__builtin_unify_int_2_0);
Declare_entry(mercury__builtin_index_int_2_0);
Declare_entry(mercury__builtin_compare_int_3_0);
-Declare_entry(mercury__builtin_term_to_type_int_2_0);
-Declare_entry(mercury__builtin_type_to_term_int_2_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_int_0_struct {
Integer f1;
Code *f2;
@@ -673,10 +481,6 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_int_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_int_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_int_3_0)),
-#ifdef USE_TYPE_TO_TERM
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_int_2_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_int_2_0)),
-#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_int_0,
(const Word *) & mercury_data___base_type_functors_int_0,
@@ -689,8 +493,6 @@
Declare_entry(mercury__builtin_unify_character_2_0);
Declare_entry(mercury__builtin_index_character_2_0);
Declare_entry(mercury__builtin_compare_character_3_0);
-Declare_entry(mercury__builtin_term_to_type_character_2_0);
-Declare_entry(mercury__builtin_type_to_term_character_2_0);
MR_STATIC_CODE_CONST struct
mercury_data___base_type_info_character_0_struct {
Integer f1;
@@ -711,12 +513,6 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_character_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_character_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_character_3_0)),
-#ifdef USE_TYPE_TO_TERM
- MR_MAYBE_STATIC_CODE(
- ENTRY(mercury__builtin_term_to_type_character_2_0)),
- MR_MAYBE_STATIC_CODE(
- ENTRY(mercury__builtin_type_to_term_character_2_0)),
-#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_character_0,
(const Word *) & mercury_data___base_type_functors_character_0,
@@ -729,8 +525,6 @@
Declare_entry(mercury__builtin_unify_string_2_0);
Declare_entry(mercury__builtin_index_string_2_0);
Declare_entry(mercury__builtin_compare_string_3_0);
-Declare_entry(mercury__builtin_term_to_type_string_2_0);
-Declare_entry(mercury__builtin_type_to_term_string_2_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_string_0_struct {
Integer f1;
Code *f2;
@@ -750,10 +544,6 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_string_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_string_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_string_3_0)),
-#ifdef USE_TYPE_TO_TERM
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_string_2_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_string_2_0))
-#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_string_0,
(const Word *) & mercury_data___base_type_functors_string_0,
@@ -766,8 +556,6 @@
Declare_entry(mercury__builtin_unify_float_2_0);
Declare_entry(mercury__builtin_index_float_2_0);
Declare_entry(mercury__builtin_compare_float_3_0);
-Declare_entry(mercury__builtin_term_to_type_float_2_0);
-Declare_entry(mercury__builtin_type_to_term_float_2_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_float_0_struct {
Integer f1;
Code *f2;
@@ -787,10 +575,6 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_float_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_float_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_float_3_0)),
-#ifdef USE_TYPE_TO_TERM
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_float_2_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_float_2_0))
-#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_float_0,
(const Word *) & mercury_data___base_type_functors_float_0,
@@ -804,8 +588,6 @@
Declare_entry(mercury__builtin_unify_pred_2_0);
Declare_entry(mercury__builtin_index_pred_2_0);
Declare_entry(mercury__builtin_compare_pred_3_0);
-Declare_entry(mercury__builtin_term_to_type_pred_2_0);
-Declare_entry(mercury__builtin_type_to_term_pred_2_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_pred_0_struct {
Integer f1;
Code *f2;
@@ -825,10 +607,6 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
-#ifdef USE_TYPE_TO_TERM
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_pred_2_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_pred_2_0))
-#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_pred_0,
(const Word *) & mercury_data___base_type_functors_pred_0,
@@ -908,8 +686,6 @@
mercury_data___base_type_info_void_0, mercury__unused_0_0);
}
-#endif /* SHARED_ONE_OR_TWO_CELL_TYPE_INFO */
-
").
% This is used by the code that the compiler generates for compare/3.
@@ -916,20 +692,6 @@
compare_error :-
error("internal error in compare/3").
-term__context_init(term__context("", 0)).
-
-:- type var_supply == int.
-:- type var == int.
-
-% create a new supply of variables
-term__init_var_supply(0).
-
-% We number variables using sequential numbers.
-term__create_var(VarSupply0, VarSupply, VarSupply) :-
- VarSupply is VarSupply0 + 1.
-
-term__var_to_int(Var, Var).
-
%-----------------------------------------------------------------------------%
/* copy/2
Index: library/queue.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/queue.m,v
retrieving revision 1.12
diff -u -r1.12 queue.m
--- 1.12 1995/10/05 11:31:37
+++ queue.m 1997/05/19 05:10:48
@@ -20,7 +20,7 @@
:- module queue.
:- interface.
-:- import_module int.
+:- import_module int, list.
:- type queue(T).
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.87
diff -u -r1.87 std_util.m
--- 1.87 1997/05/13 09:55:35
+++ std_util.m 1997/05/19 04:00:39
@@ -706,9 +706,7 @@
{
int i, num_arg_types, comp;
Word unify_pred_1, unify_pred_2;
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
Word base_type_info_1, base_type_info_2;
-#endif
/*
** If type_infos are equal, they must represent the
@@ -719,7 +717,6 @@
/* Next find the addresses of the unify preds in the type_infos */
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
base_type_info_1 = field(mktag(0), type_info_1, 0);
base_type_info_2 = field(mktag(0), type_info_2, 0);
@@ -737,11 +734,6 @@
unify_pred_2 = field(mktag(0), base_type_info_2,
OFFSET_FOR_UNIFY_PRED);
-#else
- unify_pred_1 = field(mktag(0), type_info_1, OFFSET_FOR_UNIFY_PRED);
- unify_pred_2 = field(mktag(0), type_info_2, OFFSET_FOR_UNIFY_PRED);
-#endif
-
/* Then compare the addresses of the unify preds in the type_infos */
if (unify_pred_1 < unify_pred_2) {
return COMPARE_LESS;
@@ -754,12 +746,10 @@
** If the addresses of the unify preds are equal, we don't need to
** compare the arity of the types - they must be the same -
** unless they are higher-order (which are all mapped to
- ** pred/0 when using ONE_OR_TWO_CELL_TYPE_INFO).
+ ** pred/0).
** But we need to recursively compare the argument types, if any.
*/
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
-
/*
** Higher order preds can't be optimised into the
** type_info == base_type_info, so we don't need
@@ -810,20 +800,6 @@
}
return COMPARE_EQUAL;
}
-#else
- num_arg_types = field(mktag(0), type_info_1, OFFSET_FOR_COUNT);
- for (i = 0; i < num_arg_types; i++) {
- Word arg_type_info_1 = field(mktag(0), type_info_1,
- OFFSET_FOR_ARG_TYPE_INFOS + i);
- Word arg_type_info_2 = field(mktag(0), type_info_2,
- OFFSET_FOR_ARG_TYPE_INFOS + i);
- comp = mercury_compare_type_info(
- arg_type_info_1, arg_type_info_2);
- if (comp != COMPARE_EQUAL)
- return comp;
- }
- return COMPARE_EQUAL;
-#endif
}
").
Index: library/term.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/term.m,v
retrieving revision 1.67
diff -u -r1.67 term.m
--- 1.67 1996/06/11 06:35:13
+++ term.m 1997/05/19 06:53:37
@@ -19,9 +19,6 @@
%-----------------------------------------------------------------------------%
-% The term type is actually defined in mercury_builtin.m.
-
-/*
:- type term ---> term__functor(const, list(term), term__context)
; term__variable(var).
:- type const ---> term__atom(string)
@@ -29,10 +26,23 @@
; term__string(string)
; term__float(float).
+:- type term__context ---> term__context(string, int).
+ % file name, line number.
+
:- type var.
:- type var_supply.
-*/
+%-----------------------------------------------------------------------------%
+
+:- pred term__term_to_type(term, T).
+:- mode term__term_to_type(in, out) is semidet.
+
+:- pred term__det_term_to_type(term, T).
+:- mode term__det_term_to_type(in, out) is det.
+
+:- pred term__type_to_term(T, term).
+:- mode term__type_to_term(in, out) is det.
+
%-----------------------------------------------------------------------------%
:- pred term__vars(term, list(var)).
@@ -175,12 +185,7 @@
% the bindings in Bindings).
%-----------------------------------------------------------------------------%
-/*
-
-These are now in mercury_builtin.m to avoid module qualification
-conflicts with type var.
-
% To manage a supply of variables, use the following 2 predicates.
% (We might want to give these a unique mode later.)
@@ -201,7 +206,6 @@
% Convert a variable to an int.
% Different variables map to different ints.
% Other than that, the mapping is unspecified.
-*/
%-----------------------------------------------------------------------------%
@@ -217,14 +221,9 @@
% Used to initialize the term context when reading in
% (or otherwise constructing) a term.
- % Unify_proc__generate_du_type_to_term_clauses
- % requires the use of an initialized term__context. It
- % directly constructs an initialized term__context
- % without calling term__context_init to avoid the
- % prob of including the term module in everything.
-% :- pred term__context_init(term__context).
-% :- mode term__context_init(out) is det.
+:- pred term__context_init(term__context).
+:- mode term__context_init(out) is det.
:- pred term__context_init(string, int, term__context).
:- mode term__context_init(in, in, out) is det.
@@ -247,14 +246,110 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util, require.
+:- import_module std_util, require, uniq_array.
%-----------------------------------------------------------------------------%
-/* In mercury_builtin.m
:- type var_supply == int.
:- type var == int.
-*/
+
+%-----------------------------------------------------------------------------%
+
+term__term_to_type(Term, Val) :-
+ term__term_to_type_2(Term, type_of(Val), Univ),
+ univ_to_type(Univ, Val).
+
+:- pred term__term_to_type_2(term::in, type_info::in, univ::out) is semidet.
+
+term__term_to_type_2(term__variable(_), _Val, _) :-
+ fail.
+term__term_to_type_2(term__functor(term__integer(Int), _, _), _Type, Value) :-
+ type_to_univ(Int, Value).
+term__term_to_type_2(term__functor(term__float(Float), _, _), _Type, Value) :-
+ type_to_univ(Float, Value).
+term__term_to_type_2(term__functor(term__string(String), _, _), _Type, Value) :-
+ type_to_univ(String, Value).
+term__term_to_type_2(term__functor(term__atom(Functor), ArgTerms, _), Type,
+ Value) :-
+ list__length(ArgTerms, Arity),
+ find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes),
+ term__term_list_to_type_list(ArgTerms, ArgTypes, Args),
+ Value = construct(Type, FunctorNumber, Args).
+
+:- pred term__term_list_to_type_list(list(term)::in, list(type_info)::in,
+ list(univ)::out) is semidet.
+
+term__term_list_to_type_list([], [], []).
+term__term_list_to_type_list([Term|Terms], [Type|Types], [Value|Values]) :-
+ term__term_to_type_2(Term, Type, Value),
+ term__term_list_to_type_list(Terms, Types, Values).
+
+:- pred term__find_functor(type_info::in, string::in, int::in, int::out,
+ list(type_info)::out) is semidet.
+term__find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes) :-
+ N = num_functors(Type),
+ term__find_functor_2(Type, Functor, Arity, N, FunctorNumber, ArgTypes).
+
+:- pred term__find_functor_2(type_info::in, string::in, int::in, int::in,
+ int::out, list(type_info)::out) is semidet.
+term__find_functor_2(TypeInfo, Functor, Arity, Num, FunctorNumber, ArgTypes) :-
+ Num >= 0,
+ Num1 = Num - 1,
+ (
+ get_functor(TypeInfo, Num1, Functor, Arity, ArgTypes1)
+ ->
+ ArgTypes = ArgTypes1,
+ FunctorNumber = Num1
+ ;
+ term__find_functor_2(TypeInfo, Functor, Arity, Num1,
+ FunctorNumber, ArgTypes)
+ ).
+
+term__det_term_to_type(Term, X) :-
+ ( term__term_to_type(Term, X1) ->
+ X = X1
+ ;
+ error("term__det_term_to_type failed as term doesn't represent a valid ground value of the appropriate type")
+ ).
+
+term__type_to_term(Val, Term) :-
+ type_to_univ(Val, Univ),
+ term__type_to_term_2(Univ, Term).
+
+:- pred type_to_term_2(univ::in, term::out) is det.
+
+term__type_to_term_2(Univ, Term) :-
+ term__context_init(Context),
+ (
+ num_functors(univ_type(Univ)) < 0
+ ->
+ ( univ_to_type(Univ, Int) ->
+ Term = term__functor(term__integer(Int), [], Context)
+ ; univ_to_type(Univ, Float) ->
+ Term = term__functor(term__float(Float), [], Context)
+ ; univ_to_type(Univ, String) ->
+ Term = term__functor(term__string(String), [], Context)
+ ; univ_to_type(Univ, Character) ->
+ string__char_to_string(Character, String),
+ Term = term__functor(term__string(String), [], Context)
+ ;
+ error("term__type_to_term: unknown type")
+ )
+ ;
+ expand(Univ, FunctorString, _FunctorArity, FunctorArgs),
+ term__type_list_to_term_list(FunctorArgs, TermArgs),
+ Term = term__functor(term__atom(FunctorString), TermArgs,
+ Context)
+ ).
+
+:- pred term__type_list_to_term_list(list(univ)::in,
+ list(term)::out) is det.
+
+term__type_list_to_term_list([], []).
+term__type_list_to_term_list([Value|Values], [Term|Terms]) :-
+ term__type_to_term_2(Value, Term),
+ term__type_list_to_term_list(Values, Terms).
+
%-----------------------------------------------------------------------------%
% term__vars(Term, Vars) is true if Vars is the list of variables
@@ -339,7 +434,7 @@
% Used to initialize the term context when reading in
% (or otherwise constructing) a term.
-% term__context_init(term__context("", 0)).
+term__context_init(term__context("", 0)).
term__context_init(File, LineNumber, term__context(File, LineNumber)).
@@ -552,7 +647,6 @@
term__apply_substitution_to_list(Terms0, Substitution, Terms).
%-----------------------------------------------------------------------------%
-/* In mercury_builtin.m
% create a new supply of variables
term__init_var_supply(0).
@@ -564,11 +658,8 @@
%-----------------------------------------------------------------------------%
- % To convert a variable to an int, we want to undo the bit-reversal.
-
term__var_to_int(Var, Var).
-*/
%-----------------------------------------------------------------------------%
% substitute a variable name in a term.
Index: library/uniq_array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/uniq_array.m,v
retrieving revision 1.21
diff -u -r1.21 uniq_array.m
--- 1.21 1997/05/06 07:47:30
+++ uniq_array.m 1997/05/19 05:11:42
@@ -17,7 +17,7 @@
:- module uniq_array.
:- interface.
-:- import_module int, list.
+:- import_module int, list, term.
:- type uniq_array(T).
@@ -187,7 +187,7 @@
:- pred uniq_array_to_term(uniq_array(T), term).
:- mode uniq_array_to_term(in, out) is det.
- % term_to_type/3 for uniq_arrays
+ % term_to_type/2 for uniq_arrays
:- pred uniq_array_from_term(term, uniq_array(T)).
:- mode uniq_array_from_term(in, out) is semidet.
Index: runtime/call.mod
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/call.mod,v
retrieving revision 1.28
diff -u -r1.28 call.mod
--- 1.28 1997/05/14 01:55:18
+++ call.mod 1997/05/19 04:03:41
@@ -240,7 +240,6 @@
Word x, y;
int i;
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
Word base_type_info;
x = mercury__unify__x;
@@ -258,16 +257,6 @@
OFFSET_FOR_UNIFY_PRED);
args_base = mercury__unify__typeinfo;
}
-#else
- x = mercury__unify__x;
- y = mercury__unify__y;
-
- type_arity = field(0, mercury__unify__typeinfo, OFFSET_FOR_COUNT);
- unify_pred = (Code *) field(0, mercury__unify__typeinfo,
- OFFSET_FOR_UNIFY_PRED);
- args_base = (Word) ((Word *) mercury__unify__typeinfo
- - 1 + OFFSET_FOR_ARG_TYPE_INFOS);
-#endif
save_registers();
@@ -312,7 +301,6 @@
Word x;
int i;
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
Word base_type_info;
x = r2;
@@ -327,12 +315,6 @@
OFFSET_FOR_INDEX_PRED);
args_base = r1;
}
-#else
- x = r2;
- type_arity = field(0, r1, OFFSET_FOR_COUNT);
- index_pred = (Code *) field(0, r1, OFFSET_FOR_INDEX_PRED);
- args_base = (Word) ((Word *) r1 - 1 + OFFSET_FOR_ARG_TYPE_INFOS);
-#endif
save_registers();
@@ -424,7 +406,6 @@
Word x, y;
int i;
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
Word base_type_info;
x = mercury__compare__x;
@@ -442,16 +423,6 @@
OFFSET_FOR_COMPARE_PRED);
args_base = mercury__compare__typeinfo;
}
-#else
- x = mercury__compare__x;
- y = mercury__compare__y;
-
- type_arity = field(0, mercury__compare__typeinfo, OFFSET_FOR_COUNT);
- compare_pred = (Code *) field(0, mercury__compare__typeinfo,
- OFFSET_FOR_COMPARE_PRED);
- args_base = (Word) ((Word *) mercury__compare__typeinfo
- - 1 + OFFSET_FOR_ARG_TYPE_INFOS);
-#endif
save_registers();
@@ -492,106 +463,4 @@
#endif
}
-/*
-** mercury__type_to_term_2_0 is called as `type_to_term(TypeInfo, X, Term)'
-** in the mode `type_to_term(in, in, out) is det'.
-**
-** With both conventions, the inputs are in r1 and r2.
-** With the simple parameter convention, the output is in r3;
-** with the compact parameter convention, the output is in r1.
-**
-** We call the type-specific type_to_term routine as
-** `TypeToTermPred(...ArgTypeInfos..., X, Term)' is det.
-**
-** With both conventions, the inputs are in r1, ... rN.
-** With the simple parameter convention, the output is in rN+1;
-** with the compact parameter convention, the output is in r1.
-**
-** With the compact convention, we can make the call to the type-specific
-** routine a tail call, and we do so. With the simple convention, we can't.
-*/
-
-mercury__type_to_term_2_0:
-{
-#ifndef USE_TYPE_TO_TERM
- fatal_error("type_to_term/2 and term_to_type/2 not implemented");
-#else
-
- Code *type_to_term_pred; /* address of the type_to_term pred */
- /* for this type */
- int type_arity; /* number of type_info args */
- Word args_base; /* the address of the word before the first */
- /* type_info argument */
- Word x;
- int i;
-
- #ifdef ONE_OR_TWO_CELL_TYPE_INFO
- Word base_type_info;
-
- x = r2;
-
- base_type_info = field(0, r1, 0);
- if (base_type_info == 0) {
- type_arity = 0;
- type_to_term_pred = (Code *) field(0, r1,
- OFFSET_FOR_TYPE_TO_TERM_PRED);
- /* args_base will not be needed */
- } else {
- type_arity = field(0, base_type_info, OFFSET_FOR_COUNT);
- type_to_term_pred = (Code *) field(0, base_type_info,
- OFFSET_FOR_TYPE_TO_TERM_PRED);
- args_base = r1;
- }
- #else /* not ONE_OR_TWO_CELL_TYPE_INFO */
- x = r2;
-
- type_arity = field(0, r1, OFFSET_FOR_COUNT);
- type_to_term_pred = (Code *) field(0, r1, OFFSET_FOR_TYPE_TO_TERM_PRED);
- args_base = (Word) ((Word *) r1 - 1 + OFFSET_FOR_ARG_TYPE_INFOS);
- #endif /* not ONE_OR_TWO_CELL_TYPE_INFO */
-
- save_registers();
-
- /* we call 'TypeToTermPred(...ArgTypeInfos..., X, Term)' */
- for (i = 1; i <= type_arity; i++) {
- virtual_reg(i) = field(0, args_base, i);
- }
- virtual_reg(type_arity + 1) = x;
-
- restore_registers();
-
- #ifdef COMPACT_ARGS
- tailcall(type_to_term_pred, LABEL(mercury__type_to_term_2_0));
- #else /* not COMPACT_ARGS */
- push(succip);
- push(type_arity);
- call(type_to_term_pred, LABEL(mercury__type_to_term_2_0_i1),
- LABEL(mercury__type_to_term_2_0));
- #endif /* not COMPACT_ARGS */
-#endif /* USE_TYPE_TO_TERM */
-}
-/*
-** Since mod2c declares this label, we must define it,
-** even though it is not needed with COMPACT_ARGS.
-*/
-mercury__type_to_term_2_0_i1:
-{
-#ifndef USE_TYPE_TO_TERM
- fatal_error("type_to_term/2 and term_to_type/2 not implemented");
-#else
- #ifdef COMPACT_ARGS
- fatal_error("mercury__type_to_term_2_0_i1 reached in "
- "COMPACT_ARGS mode");
- #else
- int type_arity;
-
- type_arity = pop();
- succip = pop();
- save_registers();
- r3 = virtual_reg(type_arity + 2);
- proceed();
- #endif
-#endif
-}
-
END_MODULE
Index: runtime/type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/type_info.h,v
retrieving revision 1.25
diff -u -r1.25 type_info.h
--- 1.25 1997/04/29 07:28:20
+++ type_info.h 1997/05/19 04:16:18
@@ -22,36 +22,16 @@
/*
** Decide which type_info representation we will use.
**
-** At the end, exactly one of the two macros ONE_CELL_TYPE_INFO and
-** ONE_OR_TWO_CELL_TYPE_INFO should defined. If it is the latter, then
-** SHARED_ONE_OR_TWO_CELL_TYPE_INFO may be defined as well.
-*/
-
-#if defined(SHARED_ONE_OR_TWO_CELL_TYPE_INFO)
- /* #define SHARED_ONE_OR_TWO_CELL_TYPE_INFO */
- #define ONE_OR_TWO_CELL_TYPE_INFO
- #undef ONE_CELL_TYPE_INFO
-#elif defined(ONE_OR_TWO_CELL_TYPE_INFO)
- #undef SHARED_ONE_OR_TWO_CELL_TYPE_INFO
- /* #define ONE_OR_TWO_CELL_TYPE_INFO */
- #undef ONE_CELL_TYPE_INFO
-#elif defined(ONE_CELL_TYPE_INFO)
- #undef SHARED_ONE_OR_TWO_CELL_TYPE_INFO
- #undef ONE_OR_TWO_CELL_TYPE_INFO
- /* #define ONE_CELL_TYPE_INFO */
-#else
- /* use the default type_info representation: shared-one-or-two-cell */
- #define SHARED_ONE_OR_TWO_CELL_TYPE_INFO
- #define ONE_OR_TWO_CELL_TYPE_INFO
- #undef ONE_CELL_TYPE_INFO
-#endif
+** At present, only SHARED_ONE_OR_TWO_CELL_TYPE_INFO is available.
+**
+*/
+
+#define SHARED_ONE_OR_TWO_CELL_TYPE_INFO
/*---------------------------------------------------------------------------*/
/*
** Define offsets of fields in the base_type_info or type_info structure.
-** If ONE_OR_TWO_CELL_TYPE_INFO, these are offsets into the base_type_info,
-** otherwise they are offsets into the type_info.
** See polymorphism.m for explanation of these offsets and how the
** type_info and base_type_info structures are laid out.
**
@@ -58,48 +38,23 @@
** ANY CHANGES HERE MUST BE MATCHED BY CORRESPONDING CHANGES
** TO THE DOCUMENTATION IN compiler/polymorphism.m.
**
-** Note that USE_TYPE_TO_TERM is presently undefined. Code may break if it
-** is just redefined here - changes also need to be made to the compiler.
-**
** The one_or_two_cell type_info representation
** *depends* on OFFSET_FOR_COUNT being 0.
*/
+
#define OFFSET_FOR_COUNT 0
#define OFFSET_FOR_UNIFY_PRED 1
#define OFFSET_FOR_INDEX_PRED 2
#define OFFSET_FOR_COMPARE_PRED 3
-#ifdef USE_TYPE_TO_TERM
- #define OFFSET_FOR_TERM_TO_TYPE_PRED 4
- #define OFFSET_FOR_TYPE_TO_TERM_PRED 5
-#else
- /* tough luck, those are only defined if USE_TYPE_TO_TERM is set */
-#endif
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
- #ifdef USE_TYPE_TO_TERM
- #define OFFSET_FOR_BASE_TYPE_LAYOUT 6
- #define OFFSET_FOR_BASE_TYPE_FUNCTORS 7
- #define OFFSET_FOR_TYPE_NAME 8
- #else
- #define OFFSET_FOR_BASE_TYPE_LAYOUT 4
- #define OFFSET_FOR_BASE_TYPE_FUNCTORS 5
- #define OFFSET_FOR_TYPE_NAME 6
- #endif
-#else
- /* tough luck, those are only defined for one-or-two-cell type_infos */
-#endif
+#define OFFSET_FOR_BASE_TYPE_LAYOUT 4
+#define OFFSET_FOR_BASE_TYPE_FUNCTORS 5
+#define OFFSET_FOR_TYPE_NAME 6
/*
** Define offsets of fields in the type_info structure.
*/
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
- #define OFFSET_FOR_ARG_TYPE_INFOS 1
-#else
- #ifdef USE_TYPE_TO_TERM
- #define OFFSET_FOR_ARG_TYPE_INFOS 6
- #else
- #define OFFSET_FOR_ARG_TYPE_INFOS 4
- #endif
-#endif
+
+#define OFFSET_FOR_ARG_TYPE_INFOS 1
/*
** Where the predicate arity and args are stored in the type_info.
@@ -110,13 +65,8 @@
** For one-cell, the arity is at the same offset as the count.
*/
-#ifdef ONE_OR_TWO_CELL_TYPE_INFO
- #define TYPEINFO_OFFSET_FOR_PRED_ARITY 1
- #define TYPEINFO_OFFSET_FOR_PRED_ARGS 2
-#else
- #define TYPEINFO_OFFSET_FOR_PRED_ARITY OFFSET_FOR_COUNT
- #define TYPEINFO_OFFSET_FOR_PRED_ARGS OFFSET_FOR_ARG_TYPE_INFOS
-#endif
+#define TYPEINFO_OFFSET_FOR_PRED_ARITY 1
+#define TYPEINFO_OFFSET_FOR_PRED_ARGS 2
/*---------------------------------------------------------------------------*/
Index: tests/general/disj_disj.m
===================================================================
RCS file: /home/staff/zs/imp/tests/general/disj_disj.m,v
retrieving revision 1.4
diff -u -r1.4 disj_disj.m
--- 1.4 1996/01/19 05:52:47
+++ disj_disj.m 1997/05/19 08:13:40
@@ -8,7 +8,7 @@
:- implementation.
-:- import_module std_util.
+:- import_module std_util, list.
main -->
{ solutions(lambda([Pair::out] is multi,
Index: tests/general/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/tests/general/dnf.m,v
retrieving revision 1.1
diff -u -r1.1 dnf.m
--- 1.1 1996/03/25 04:19:48
+++ dnf.m 1997/05/19 08:25:17
@@ -9,7 +9,7 @@
:- implementation.
-:- import_module std_util.
+:- import_module std_util, list.
main -->
{ solutions(lambda([Pair::out] is multi,
Index: tests/general/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/tests/general/higher_order.m,v
retrieving revision 1.1
diff -u -r1.1 higher_order.m
--- 1.1 1995/10/03 15:58:08
+++ higher_order.m 1997/05/19 08:14:04
@@ -10,7 +10,7 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module string.
+:- import_module string, list.
:- pred map(pred(T1, T2), list(T1), list(T2)).
:- mode map(pred(in, out) is det, in, out) is det.
Index: tests/general/nondet_disj.m
===================================================================
RCS file: /home/staff/zs/imp/tests/general/nondet_disj.m,v
retrieving revision 1.4
diff -u -r1.4 nondet_disj.m
--- 1.4 1996/01/19 05:52:49
+++ nondet_disj.m 1997/05/19 08:14:41
@@ -7,7 +7,7 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module std_util.
+:- import_module std_util, list.
main -->
{ solutions(lambda([Pair::out] is multi,
Index: tests/hard_coded/cc_nondet_disj.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/cc_nondet_disj.m,v
retrieving revision 1.3
diff -u -r1.3 cc_nondet_disj.m
--- 1.3 1996/12/23 04:58:18
+++ cc_nondet_disj.m 1997/05/19 08:16:54
@@ -6,6 +6,8 @@
:- implementation.
+:- import_module list.
+
main --> io__read_line(Res),
( { Res = ok(['y'|_]) }, io__write_string("Yes\n")
; { Res = ok(['n'|_]) }, io__write_string("No\n")
Index: tests/hard_coded/pragma_inline.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/pragma_inline.m,v
retrieving revision 1.5
diff -u -r1.5 pragma_inline.m
--- 1.5 1997/02/12 03:49:05
+++ pragma_inline.m 1997/05/19 08:17:36
@@ -4,12 +4,14 @@
:- interface.
-:- import_module io, string.
+:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
+:- import_module list, string.
+
main -->
{ L = "l"},
{ append_strings(L, L, LL) },
Index: tests/invalid/funcs_as_preds.err_exp
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/funcs_as_preds.err_exp,v
retrieving revision 1.2
diff -u -r1.2 funcs_as_preds.err_exp
--- 1.2 1997/04/27 05:28:51
+++ funcs_as_preds.err_exp 1997/05/19 08:28:39
@@ -16,7 +16,7 @@
funcs_as_preds.m:030: error: undefined predicate `null/1'.
funcs_as_preds.m:030: (There is a *function* with that name, however.
funcs_as_preds.m:030: Perhaps you forgot to add ` = ...'?)
-funcs_as_preds.m:021: Inferred :- func car(list(list(T))) = list(T).
-funcs_as_preds.m:024: Inferred :- func cdr(list(T)) = list(T).
-funcs_as_preds.m:027: Inferred :- func cons(T, list(T)) = list(T).
+funcs_as_preds.m:021: Inferred :- func car((list:list((list:list(T))))) = (list:list(T)).
+funcs_as_preds.m:024: Inferred :- func cdr((list:list(T))) = (list:list(T)).
+funcs_as_preds.m:027: Inferred :- func cons(T, (list:list(T))) = (list:list(T)).
For more information, try recompiling with `-E'.
Index: tests/misc_tests/mdemangle_test.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/misc_tests/mdemangle_test.exp,v
retrieving revision 1.3
diff -u -r1.3 mdemangle_test.exp
--- 1.3 1997/03/15 06:21:04
+++ mdemangle_test.exp 1997/05/19 08:29:53
@@ -73,3 +73,10 @@
mangled name with unused args
<predicate '!'/2 mode 0 (minus unused args)>
<predicate '!'/2 mode 0 (minus unused args)>
+
+ some tests of symbols that should not be demangled
+ (this is a regression test: previous versions of mdemangle
+ seg faulted for this case)
+mercury_data_foo
+mercury_data_foo
+
Index: tests/valid/agc_unbound_typevars.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/agc_unbound_typevars.m,v
retrieving revision 1.1
diff -u -r1.1 agc_unbound_typevars.m
--- 1.1 1997/05/15 06:55:31
+++ agc_unbound_typevars.m 1997/05/19 08:30:47
@@ -22,7 +22,7 @@
:- implementation.
-:- import_module std_util, int, map.
+:- import_module std_util, int, map, list.
foo(X) :-
TypeInfo = type_of([]),
Index: tests/valid/middle_rec_labels.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/middle_rec_labels.m,v
retrieving revision 1.2
diff -u -r1.2 middle_rec_labels.m
--- 1.2 1997/02/23 06:12:14
+++ middle_rec_labels.m 1997/05/19 08:31:40
@@ -9,6 +9,8 @@
:- interface.
+:- import_module list.
+
:- type liveinfo ---> live_lvalue(
lval,
shape_num,
Index: tests/valid/subtype_switch.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/subtype_switch.m,v
retrieving revision 1.1
diff -u -r1.1 subtype_switch.m
--- 1.1 1997/04/21 05:22:32
+++ subtype_switch.m 1997/05/19 08:32:40
@@ -32,7 +32,7 @@
:- implementation.
-:- import_module string, int, require.
+:- import_module string, int, require, list.
:- pred stringify_config(tcl_interp, config, string, io__state, io__state).
:- mode stringify_config(in, in(widget), out, di, uo) is det.
Index: tests/warnings/infinite_recursion.m
===================================================================
RCS file: /home/staff/zs/imp/tests/warnings/infinite_recursion.m,v
retrieving revision 1.1
diff -u -r1.1 infinite_recursion.m
--- 1.1 1997/02/09 07:27:13
+++ infinite_recursion.m 1997/05/19 08:33:36
@@ -6,7 +6,7 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module std_util.
+:- import_module std_util, list.
main -->
( { funny_append([1,2,3], [4,5,6], [5,6,7]) } ->
--
Tyson Dowd #
# Surreal humour isn't eveyone's cup of
trd at cs.mu.oz.au # fur.
http://www.cs.mu.oz.au/~trd #
More information about the developers
mailing list