[m-dev.] for review: tuples [1]
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Aug 1 14:16:10 AEST 2000
Hi,
This is the implementation of the tuple syntax I talked about
at the last Mercury meeting. The syntax itself would be easy
to change, so feel free to make suggestions.
The main problem with the current syntax is that the parsing
of the arguments of tuples is not entirely consistent with
the parsing of arguments of other constructors. The hacks in
the parser to deal with operators such as `::' in arguments
of functors can't be used for `{}/N' terms because they mess
up the parsing of goals in DCG escapes. If the suggestions from
the "Syntactic sugar for higher order types and modes" thread
on mercury-users are implemented, this problem will go away.
Simon.
Estimated hours taken: 30
Implement builtin tuple types, similar to those in Haskell.
Tuples are constructed and deconstructed using
the syntax X = {Arg1, Arg2, ...}.
Tuples have type `{Arg1, Arg2, ...}'.
Unary tuples (X = {Arg}) do work, unlike in Haskell. The rationale
for this is that it is useful to be able to construct unary tuples
to be passed to a polymorphic predicate which uses std_util__deconstruct
to deal with a tuple of any arity. Since this is probably the only
use for unary tuples, it's not really worth the effort of treating
them as no_tag types, so we don't.
The type-infos for tuples have the same structure as for higher-order
types. There is a single type_ctor_info for tuples, and the arity
is placed before the argument type_infos.
library/parser.m:
Change the way '{}/N' terms are parsed, so that the parsed
representation is consistent with the way other functors
are represented (previously the arguments were left as
unparsed ','/2 terms). This avoids special case code
in prog_io__parse_qualified_term, term__term_to_type
and term__type_to_term.
compiler/prog_io_dcg.m:
compiler/prog_io_util.m:
Handle the new structure of '{}/N' terms when parsing DCG escapes
by converting the argument list back into a single ','/2 term.
compiler/module_qual.m:
Treat tuples as a builtin type.
compiler/typecheck.m:
Typecheck tuple constructors.
compiler/mode_util.m:
Propagate types into tuple bound insts.
compiler/type_util.m:
Add type_is_tuple/2 and type_id_is_tuple/1 to identify tuple types.
Add tuples to the list of types which are not atomic types.
Handle tuple types in `type_constructors' and
`get_cons_id_arg_types' and `switch_type_num_functors'.
compiler/tabling.m:
Handle tabling of tuples.
compiler/term_util.m:
Handle tuples in the code to compute functor norms.
compiler/magic_util.m:
compiler/rl.m:
compiler/rl_key.m:
Handle tuple types in the Aditi back end.
compiler/mercury_to_mercury.m:
library/io.m:
library/term_io.m:
Handle output of '{}/N' terms.
compiler/higher_order.m:
compiler/simplify.m:
Don't specialize complicated unifications of tuple
types into calls to a specific unification procedure --
even if the procedure were implemented, it probably
wouldn't be that much more efficient.
compiler/unify_proc.m:
Generate unification procedures for complicated unifications
of tuples (other than in-in unifications). These are generated
lazily as required.
compiler/make_hlds.m:
Export add_special_pred for use by unify_proc.m.
compiler/polymorphism.m:
Export polymorphism__process_pred for use by unify_proc.m.
compiler/bytecode_gen.m:
compiler/code_util.m:
compiler/ml_code_util.m:
Handle unify procedure names and tags for tuple types.
compiler/mlds_to_c.m:
Output tuple types as MR_Tuple.
compiler/ml_unify_gen.m:
Compute the field types for tuples.
compiler/polymorphism.m:
compiler/pseudo_type_info.m:
Treat tuple type_infos in a similar way to higher-order type_infos.
compiler/hlds_data.m:
Document how cons_ids for tuple types are represented.
compiler/switch_gen.m:
compiler/table_gen.m:
Add tuple types to switches on type_util__builtin_type.
compiler/llds_out.m:
util/mdemangle.c:
profiler/demangle.m:
Transform items named "{}" to "f_tuple" when mangling symbols.
library/builtin.m:
Define the type_ctor_info used for tuples.
library/private_builtin.m:
Add `builtin_unify_tuple/2' and `builtin_compare_tuple/3',
both of which abort. All comparisons and in-in unifications
of tuples are performed by the generic unification functions
in runtime/mercury_ho_call.c and runtime/mercury.c.
library/std_util.m:
Implement the various RTTI functions for tuples.
Encode tuple `TypeCtorDesc's in a similar way to that
used for higher-order types. This has the consequence that the limit
on the arity of higher-order types is now MAX_VIRTUAL_REG,
rather than 2*MAX_VIRTUAL_REG.
Avoid calling MR_GC_free for the type-info vector returned
from ML_expand() for tuples because unlike the vectors
for du types, it is not copied.
runtime/mercury_type_info.h:
Add macros for extracting fields from tuple type-infos.
These just call the macros for extracting fields from higher-order
type-infos.
Add a macro MR_type_ctor_rep_is_variable_arity(), which
returns TRUE for tuples and higher-order types.
The distinction between higher-order and first-order types
is now misnamed -- the distinction is really between fixed arity
types and builtin variable arity types. I'm not sure whether
it's worth renaming everything.
runtime/mercury.h:
runtime/mercury.c:
Define unification and comparison of tuples in
high-level code grades.
runtime/mercury_deep_copy_body.h:
runtime/mercury_make_type_info_body.h:
runtime/mercury_tabling.c:
runtime/mercury_unify_compare_body.h:
Handle tuple types in code which traverses data using RTTI.
tests/hard_coded/construct.{m,exp}:
tests/hard_coded/expand.{m,exp}:
Test RTTI functions from std_util.m applied to tuples.
tests/hard_coded/tuple_test.{m,exp}:
Test unification, comparison, term_to_type etc. applied to tuples.
tests/hard_coded/deep_copy.{m,exp}:
Test deep copy of tuples.
tests/hard_coded/typeclasses/tuple_instance.{m,exp}:
Test instance declarations for tuples.
tests/tabling/expand_tuple.{m,exp}:
Test tabling of tuples.
tests/hard_coded/write.m:
Add some module qualifications for code which uses
`{}/1' constructors which are not tuples.
tests/invalid/errors2.{m,err_exp,err_exp2}:
Test handling of tuples in type errors messages.
NEWS:
doc/reference_manual.texi:
w3/news/newsdb.inc:
Document tuples.
doc/transition_guide.texi:
Document the change to the parsing of '{}/N' terms.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.168
diff -u -u -r1.168 NEWS
--- NEWS 2000/05/24 05:18:25 1.168
+++ NEWS 2000/08/01 02:48:39
@@ -14,6 +14,14 @@
`Value =^ field' is now the syntax for DCG field selection,
rather than `Value := ^ field'.
+* We've added support for tuple types, similar to those in most
+ other functional languages.
+
+* The behaviour of the parser__read_term applied to terms with
+ functor `{}/N' has been changed. The parser from Mercury 0.9
+ parsed "{1, 2, 3}" as `{}(','(1, ','(2, 3)))'. It is now
+ parsed as `{}(1, 2, 3)'.
+
* You can now declare functions by giving a determinism but without
supplying the modes. The default function modes will be assumed.
This is particularly useful for partial functions.
@@ -26,6 +34,9 @@
a variable.
Changes to the standard library:
+
+* We've added a new function to the Mercury standard library:
+ std_util__construct_tuple/1.
* Functions `int:^/2' and `integer:^/2' have been removed.
Use `int__xor/2' and `integer__xor/2' instead.
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.47
diff -u -u -r1.47 bytecode_gen.m
--- compiler/bytecode_gen.m 2000/03/15 08:30:51 1.47
+++ compiler/bytecode_gen.m 2000/07/22 23:54:05
@@ -39,7 +39,7 @@
:- import_module arg_info, call_gen. % XXX for arg passing convention
:- import_module llds. % XXX for code_model
:- import_module code_util. % XXX for cons_id_to_tag
-:- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
+:- import_module hlds_pred, hlds_goal, hlds_data, prog_data, type_util.
:- import_module passes_aux, mode_util, goal_util, builtin_ops.
:- import_module globals, tree.
@@ -610,10 +610,13 @@
bytecode_gen__get_module_info(ByteInfo, ModuleInfo),
(
ConsId = cons(Functor, Arity),
+ bytecode_gen__get_var_type(ByteInfo, Var, Type),
(
- % Everything other than characters should
+ % Everything other than characters and tuples should
% be module qualified.
Functor = unqualified(FunctorName),
+ \+ type_is_tuple(Type, _)
+ ->
string__to_char_list(FunctorName, FunctorList),
( FunctorList = [Char] ->
ByteConsId = char_const(Char)
@@ -621,8 +624,12 @@
error("bytecode_gen__map_cons_id: unqualified cons_id is not a char_const")
)
;
- Functor = qualified(ModuleName, FunctorName),
- bytecode_gen__get_var_type(ByteInfo, Var, Type),
+ (
+ Functor = unqualified(FunctorName),
+ ModuleName = unqualified("builtin")
+ ;
+ Functor = qualified(ModuleName, FunctorName)
+ ),
code_util__cons_id_to_tag(ConsId,
Type, ModuleInfo, ConsTag),
bytecode_gen__map_cons_tag(ConsTag, ByteConsTag),
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.121
diff -u -u -r1.121 code_util.m
--- compiler/code_util.m 2000/04/19 03:54:03 1.121
+++ compiler/code_util.m 2000/07/26 04:46:35
@@ -182,7 +182,7 @@
:- implementation.
-:- import_module builtin_ops, type_util, special_pred.
+:- import_module builtin_ops, prog_util, type_util, special_pred.
:- import_module char, int, string, set, map, term, varset.
:- import_module require, std_util, assoc_list.
@@ -289,11 +289,18 @@
(
special_pred_get_type(PredName, ArgTypes, Type),
type_to_type_id(Type, TypeId, _),
- % All type_ids here should be module qualified,
- % since builtin types are handled separately in
- % polymorphism.m.
- TypeId = qualified(TypeModule, TypeName) - TypeArity
+ % All type_ids other than tuples here should be
+ % module qualified, since builtin types are
+ % handled separately in polymorphism.m.
+ (
+ TypeId = unqualified(TypeName) - _,
+ type_id_is_tuple(TypeId),
+ mercury_public_builtin_module(TypeModule)
+ ;
+ TypeId = qualified(TypeModule, TypeName) - _
+ )
->
+ TypeId = _ - TypeArity,
(
ThisModule \= TypeModule,
PredName = "__Unify__",
@@ -547,6 +554,13 @@
->
char__to_int(Char, CharCode),
Tag = int_constant(CharCode)
+ ;
+ % Tuples do not need a tag. Note that unary tuples are not
+ % treated as no_tag types. There's no reason why they
+ % couldn't be, it's just not worth the effort.
+ type_is_tuple(Type, _)
+ ->
+ Tag = unshared_tag(0)
;
% Use the type to determine the type_id
( type_to_type_id(Type, TypeId0, _) ->
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.64
diff -u -u -r1.64 higher_order.m
--- compiler/higher_order.m 2000/04/11 07:56:56 1.64
+++ compiler/higher_order.m 2000/07/24 06:20:24
@@ -1615,6 +1615,15 @@
special_pred_get_type(PredName, Args, Var),
map__lookup(VarTypes, Var, SpecialPredType),
SpecialPredType \= term__variable(_),
+
+ % Don't specialize tuple types -- the code to unify
+ % them only exists in the generic unification routine
+ % in the runtime. `private_builtin__builtin_unify_tuple/2'
+ % and `private_builtin__builtin_compare_tuple/3' always abort.
+ % It might be worth inlining complicated unifications of
+ % small tuples (or any other small type).
+ \+ type_is_tuple(SpecialPredType, _),
+
Args = [TypeInfoVar | SpecialPredArgs],
map__search(PredVars, TypeInfoVar,
constant(_TypeInfoConsId, TypeInfoVarArgs)),
@@ -1843,6 +1852,9 @@
;
TypeCategory = pred_type,
error("pred type in find_builtin_type_with_equivalent_compare")
+ ;
+ TypeCategory = tuple_type,
+ error("tuple type in find_builtin_type_with_equivalent_compare")
;
TypeCategory = enum_type,
construct_type(unqualified("int") - 0, [], EqvType),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.46
diff -u -u -r1.46 hlds_data.m
--- compiler/hlds_data.m 2000/06/06 05:45:07 1.46
+++ compiler/hlds_data.m 2000/07/22 23:54:06
@@ -26,6 +26,9 @@
:- type cons_table == map(cons_id, list(hlds_cons_defn)).
:- type cons_id ---> cons(sym_name, arity) % name, arity
+ % Tuples have cons_id
+ % `cons(unqualified("{}"), Arity)'.
+
; int_const(int)
; string_const(string)
; float_const(float)
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.145
diff -u -u -r1.145 llds_out.m
--- compiler/llds_out.m 2000/06/14 14:54:05 1.145
+++ compiler/llds_out.m 2000/07/26 04:59:03
@@ -4184,6 +4184,7 @@
llds_out__name_conversion_table(",", "f_comma").
llds_out__name_conversion_table(";", "f_semicolon").
llds_out__name_conversion_table("!", "f_cut").
+llds_out__name_conversion_table("{}", "f_tuple").
% This is the fall-back method.
% Given a string, produce a C identifier
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.10
diff -u -u -r1.10 magic_util.m
--- compiler/magic_util.m 2000/05/22 17:59:40 1.10
+++ compiler/magic_util.m 2000/07/22 23:54:07
@@ -1308,6 +1308,9 @@
; { type_is_higher_order(ArgType, _, _, _) } ->
% Higher-order types are not allowed.
{ set__insert(Errors0, higher_order, Errors) }
+ ; { type_is_tuple(ArgType, TupleArgTypes) } ->
+ list__foldl2(magic_util__traverse_type(no, Parents),
+ TupleArgTypes, Errors0, Errors)
; { type_is_aditi_state(ArgType) } ->
( { IsTopLevel = no } ->
{ set__insert(Errors0, embedded_aditi_state, Errors) }
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.338
diff -u -u -r1.338 make_hlds.m
--- compiler/make_hlds.m 2000/07/20 11:24:03 1.338
+++ compiler/make_hlds.m 2000/07/22 23:54:08
@@ -22,7 +22,7 @@
:- module make_hlds.
:- interface.
-:- import_module prog_data, hlds_module, hlds_pred.
+:- import_module prog_data, hlds_data, hlds_module, hlds_pred, special_pred.
:- import_module equiv_type, module_qual.
:- import_module io, std_util, list, bool.
@@ -47,16 +47,25 @@
:- pred next_mode_id(proc_table, maybe(determinism), proc_id).
:- mode next_mode_id(in, in, out) is det.
+ % Add the declaration and clauses for a unification or
+ % comparison predicate. This is called by unify_proc.m
+ % to generate unification procedures for complicated
+ % unifications of partially instantiated tuples.
+:- pred add_special_pred(special_pred_id,
+ module_info, tvarset, type, type_id, hlds_type_body,
+ prog_context, import_status, module_info).
+:- mode add_special_pred(in, in, in, in, in, in, in, in, out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, hlds_goal.
+:- import_module hlds_goal.
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
:- import_module modules, module_qual, prog_util, options, hlds_out.
:- import_module make_tags, quantification, (inst), globals.
-:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
+:- import_module code_util, unify_proc, mode_util, type_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds.
:- import_module error_util.
@@ -2792,11 +2801,6 @@
TVarSet, Type, TypeId, Body, Context, Status, Module1),
add_special_pred_list(SpecialPredIds, Module1,
TVarSet, Type, TypeId, Body, Context, Status, Module).
-
-:- pred add_special_pred(special_pred_id,
- module_info, tvarset, type, type_id, hlds_type_body,
- prog_context, import_status, module_info).
-:- mode add_special_pred(in, in, in, in, in, in, in, in, out) is det.
add_special_pred(SpecialPredId, Module0, TVarSet, Type, TypeId, TypeBody,
Context, Status0, Module) :-
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.170
diff -u -u -r1.170 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2000/07/20 11:24:05 1.170
+++ compiler/mercury_to_mercury.m 2000/07/22 23:54:08
@@ -2506,6 +2506,23 @@
mercury_output_list_args(Xs, VarSet, AppendVarnums),
io__write_string("]")
;
+ { Functor = term__atom("{}") },
+ { Args = [X] }
+ ->
+ % A unary tuple is usually a DCG escape,
+ % so add some extra space.
+ io__write_string("{ "),
+ mercury_output_term(X, VarSet, AppendVarnums),
+ io__write_string(" }")
+ ;
+ { Functor = term__atom("{}") },
+ { Args = [X | Xs] }
+ ->
+ io__write_string("{"),
+ mercury_output_term(X, VarSet, AppendVarnums),
+ mercury_output_remaining_terms(Xs, VarSet, AppendVarnums),
+ io__write_string("}")
+ ;
{ Args = [PrefixArg] },
{ Functor = term__atom(FunctorName) },
{ mercury_unary_prefix_op(FunctorName) }
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.18
diff -u -u -r1.18 ml_code_util.m
--- compiler/ml_code_util.m 2000/07/27 15:13:45 1.18
+++ compiler/ml_code_util.m 2000/07/30 08:29:00
@@ -937,10 +937,17 @@
(
special_pred_get_type(PredName, ArgTypes, Type),
type_to_type_id(Type, TypeId, _),
- % All type_ids here should be module qualified,
- % since builtin types are handled separately in
- % polymorphism.m.
- TypeId = qualified(TypeModule, TypeName) - TypeArity
+ % All type_ids other than tuples here should be
+ % module qualified, since builtin types are handled
+ % separately in polymorphism.m.
+ (
+ TypeId = unqualified(TypeName) - TypeArity,
+ type_id_is_tuple(TypeId),
+ mercury_public_builtin_module(TypeModule)
+ ;
+ TypeId = qualified(TypeModule, TypeName)
+ - TypeArity
+ )
->
(
ThisModule \= TypeModule,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.14
diff -u -u -r1.14 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2000/06/06 05:45:22 1.14
+++ compiler/ml_unify_gen.m 2000/07/24 06:16:27
@@ -1184,23 +1184,35 @@
%
% Lookup the field types for the arguments of this cons_id
%
- =(Info),
- { ml_gen_info_get_module_info(Info, ModuleInfo) },
- { type_util__get_type_and_cons_defn(ModuleInfo, Type, ConsId,
- _TypeDefn, ConsDefn) },
- { ConsDefn = hlds_cons_defn(_, _, Fields0, _, _) },
- %
- % Add the fields for any type_infos and/or typeclass_infos
- % inserted for existentially quantified data types.
- % For these, we just copy the types from the ArgTypes.
- %
- { NumArgs = list__length(ArgTypes) },
- { NumFieldTypes0 = list__length(Fields0) },
- { NumExtraTypes = NumArgs - NumFieldTypes0 },
- { ExtraFieldTypes = list__take_upto(NumExtraTypes, ArgTypes) },
- { ExtraFields = list__map(func(FieldType) = no - FieldType,
- ExtraFieldTypes) },
- { Fields = list__append(ExtraFields, Fields0) }.
+ { MakeUnnamedField = (func(FieldType) = no - FieldType) },
+ (
+ { type_is_tuple(Type, _) },
+ { list__length(ArgTypes, TupleArity) }
+ ->
+ % The argument types for tuples are unbound type variables.
+ { varset__init(TypeVarSet0) },
+ { varset__new_vars(TypeVarSet0, TupleArity,
+ TVars, _TypeVarSet) },
+ { term__var_list_to_term_list(TVars, FieldTypes) },
+ { Fields = list__map(MakeUnnamedField, FieldTypes) }
+ ;
+ =(Info),
+ { ml_gen_info_get_module_info(Info, ModuleInfo) },
+ { type_util__get_type_and_cons_defn(ModuleInfo, Type, ConsId,
+ _TypeDefn, ConsDefn) },
+ { ConsDefn = hlds_cons_defn(_, _, Fields0, _, _) },
+ %
+ % Add the fields for any type_infos and/or typeclass_infos
+ % inserted for existentially quantified data types.
+ % For these, we just copy the types from the ArgTypes.
+ %
+ { NumArgs = list__length(ArgTypes) },
+ { NumFieldTypes0 = list__length(Fields0) },
+ { NumExtraTypes = NumArgs - NumFieldTypes0 },
+ { ExtraFieldTypes = list__take_upto(NumExtraTypes, ArgTypes) },
+ { ExtraFields = list__map(MakeUnnamedField, ExtraFieldTypes) },
+ { Fields = list__append(ExtraFields, Fields0) }
+ ).
:- pred ml_gen_unify_args(cons_id, prog_vars, list(uni_mode), list(prog_type),
list(constructor_arg), prog_type, mlds__lval, int, int,
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.45
diff -u -u -r1.45 mlds_to_c.m
--- compiler/mlds_to_c.m 2000/07/25 09:46:11 1.45
+++ compiler/mlds_to_c.m 2000/07/31 03:19:25
@@ -1508,6 +1508,9 @@
{ TypeCategory = polymorphic_type },
io__write_string("MR_Box")
;
+ { TypeCategory = tuple_type },
+ io__write_string("MR_Tuple")
+ ;
{ TypeCategory = pred_type },
globals__io_lookup_bool_option(highlevel_data, HighLevelData),
( { HighLevelData = yes } ->
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.123
diff -u -u -r1.123 mode_util.m
--- compiler/mode_util.m 2000/05/05 06:07:47 1.123
+++ compiler/mode_util.m 2000/07/31 05:55:51
@@ -827,6 +827,30 @@
propagate_ctor_info_2(BoundInsts0, Type, ModuleInfo, BoundInsts) :-
(
+ type_is_tuple(Type, TupleArgTypes)
+ ->
+ list__map(
+ (pred(BoundInst0::in, BoundInst::out) is det :-
+ BoundInst0 = functor(Functor, ArgInsts0),
+ (
+ Functor = cons(unqualified("{}"), _),
+ list__length(ArgInsts0,
+ list__length(TupleArgTypes))
+ ->
+ map__init(Subst),
+ propagate_types_into_inst_list(TupleArgTypes,
+ Subst, ModuleInfo, ArgInsts0, ArgInsts)
+ ;
+ % The bound_inst's arity does not match the
+ % tuple's arity, so leave it alone. This can
+ % only happen in a user defined bound_inst.
+ % A mode error should be reported if anything
+ % tries to match with the inst.
+ ArgInsts = ArgInsts0
+ ),
+ BoundInst = functor(Functor, ArgInsts)
+ ), BoundInsts0, BoundInsts)
+ ;
type_to_type_id(Type, TypeId, TypeArgs),
TypeId = qualified(TypeModule, _) - _,
module_info_types(ModuleInfo, TypeTable),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.56
diff -u -u -r1.56 module_qual.m
--- compiler/module_qual.m 2000/07/06 06:25:12 1.56
+++ compiler/module_qual.m 2000/07/22 23:54:10
@@ -838,6 +838,9 @@
; { type_id_is_higher_order(TypeId0, _, _) } ->
{ TypeId = TypeId0 },
{ Info1 = Info0 }
+ ; { type_id_is_tuple(TypeId0) } ->
+ { TypeId = TypeId0 },
+ { Info1 = Info0 }
;
{ mq_info_get_types(Info0, Types) },
find_unique_match(TypeId0, TypeId, Types,
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.190
diff -u -u -r1.190 polymorphism.m
--- compiler/polymorphism.m 2000/07/20 11:24:08 1.190
+++ compiler/polymorphism.m 2000/08/01 02:50:42
@@ -190,6 +190,26 @@
io__state, io__state).
:- mode polymorphism__process_module(in, out, di, uo) is det.
+% Run the polymorphism pass over a single pred.
+% This is used to transform clauses introduced by unify_proc.m
+% for complicated unification predicates for types such as tuples
+% for which unification predicates are generated lazily.
+% It may be worth generating unification predicates for other
+% types lazily -- most of the predicates for imported types
+% are not used.
+%
+% This predicate should be used with caution. polymorphism.m
+% expects that the argument types of called predicates have not
+% been transformed yet. This predicate will not work correctly
+% after the original pass of polymorphism has been run if the
+% predicate to be processed calls any polymorphic predicates
+% which require type_infos or typeclass_infos to be added to
+% the argument list.
+
+:- pred polymorphism__process_generated_pred(pred_id,
+ module_info, module_info).
+:- mode polymorphism__process_generated_pred(in, in, out) is det.
+
% Add the type_info variables for a complicated unification to
% the appropriate fields in the unification and the goal_info.
@@ -410,9 +430,16 @@
:- pred polymorphism__fixup_preds(list(pred_id), module_info, module_info).
:- mode polymorphism__fixup_preds(in, in, out) is det.
+
+polymorphism__fixup_preds(PredIds, ModuleInfo0, ModuleInfo) :-
+ list__foldl(polymorphism__fixup_pred,
+ PredIds, ModuleInfo0, ModuleInfo).
-polymorphism__fixup_preds([], ModuleInfo, ModuleInfo).
-polymorphism__fixup_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
+:- pred polymorphism__fixup_pred(pred_id, module_info, module_info).
+:- mode polymorphism__fixup_pred(in, in, out) is det.
+
+polymorphism__fixup_pred(PredId, ModuleInfo0, ModuleInfo) :-
+
%
% Recompute the arg types by finding the headvars and
% the var->type mapping (from the clauses_info) and
@@ -446,9 +473,7 @@
pred_info_set_arg_types(PredInfo0, TypeVarSet, ExistQVars,
ArgTypes, PredInfo),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1),
-
- polymorphism__fixup_preds(PredIds, ModuleInfo1, ModuleInfo).
+ module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo).
%---------------------------------------------------------------------------%
@@ -457,38 +482,46 @@
:- mode polymorphism__process_pred(in, in, out, di, uo) is det.
polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) -->
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
-
write_pred_progress_message("% Transforming polymorphism for ",
PredId, ModuleInfo0),
+ { polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) }.
+
+polymorphism__process_generated_pred(PredId, ModuleInfo0, ModuleInfo) :-
+ polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo1),
+ polymorphism__fixup_pred(PredId, ModuleInfo1, ModuleInfo).
+
+:- pred polymorphism__process_pred(pred_id, module_info, module_info).
+:- mode polymorphism__process_pred(in, in, out) is det.
+polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
%
% run the polymorphism pass over the clauses_info,
% updating the headvars, goals, varsets, types, etc.,
% and computing some information in the poly_info.
%
- { pred_info_clauses_info(PredInfo0, ClausesInfo0) },
- { polymorphism__process_clause_info(
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ polymorphism__process_clause_info(
ClausesInfo0, PredInfo0, ModuleInfo0,
- ClausesInfo, PolyInfo, ExtraArgModes) },
- { poly_info_get_module_info(PolyInfo, ModuleInfo1) },
- { poly_info_get_typevarset(PolyInfo, TypeVarSet) },
- { pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1) },
- { pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2) },
+ ClausesInfo, PolyInfo, ExtraArgModes),
+ poly_info_get_module_info(PolyInfo, ModuleInfo1),
+ poly_info_get_typevarset(PolyInfo, TypeVarSet),
+ pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
+ pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
%
% do a pass over the proc_infos, copying the relevant information
% from the clauses_info and the poly_info, and updating all
% the argmodes with modes for the extra arguments.
%
- { pred_info_procids(PredInfo2, ProcIds) },
- { pred_info_procedures(PredInfo2, Procs0) },
- { polymorphism__process_procs(ProcIds, Procs0, PredInfo2, ClausesInfo,
- ExtraArgModes, Procs) },
- { pred_info_set_procedures(PredInfo2, Procs, PredInfo) },
+ pred_info_procids(PredInfo2, ProcIds),
+ pred_info_procedures(PredInfo2, Procs0),
+ polymorphism__process_procs(ProcIds, Procs0, PredInfo2, ClausesInfo,
+ ExtraArgModes, Procs),
+ pred_info_set_procedures(PredInfo2, Procs, PredInfo),
- { module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
- ModuleInfo) }.
+ module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
+ ModuleInfo).
:- pred polymorphism__process_clause_info(clauses_info, pred_info, module_info,
clauses_info, poly_info, list(mode)).
@@ -2390,20 +2423,28 @@
% (i.e. types which are not type variables)
%
(
- type_is_higher_order(Type, PredOrFunc, _, TypeArgs)
+ ( type_is_higher_order(Type, PredOrFunc, _, TypeArgs0) ->
+ TypeArgs = TypeArgs0,
+ hlds_out__pred_or_func_to_str(PredOrFunc,
+ PredOrFuncStr),
+ TypeId = unqualified(PredOrFuncStr) - 0
+ ; type_is_tuple(Type, TypeArgs1) ->
+ TypeArgs = TypeArgs1,
+ TypeId = unqualified("tuple") - 0
+ ;
+ fail
+ )
->
% This occurs for code where a predicate calls a polymorphic
- % predicate with a known higher-order value of the type
- % variable.
+ % predicate with a known higher-order or tuple value of the
+ % type variable.
% The transformation we perform is basically the same as
% in the first-order case below, except that we map
- % pred/func types to builtin pred/0 or func/0 for the
- % purposes of creating type_infos.
+ % pred types to pred/0, func types to func/0 and tuple
+ % types to tuple/0 for the purposes of creating type_infos.
% To allow univ_to_type to check the type_infos
% correctly, the actual arity of the pred is added to
% the type_info of higher-order types.
- hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
- TypeId = unqualified(PredOrFuncStr) - 0,
polymorphism__construct_type_info(Type, TypeId, TypeArgs,
yes, Context, Var, ExtraGoals, Info0, Info)
;
@@ -2455,7 +2496,7 @@
:- mode polymorphism__construct_type_info(in, in, in, in, in, out, out,
in, out) is det.
-polymorphism__construct_type_info(Type, TypeId, TypeArgs, IsHigherOrder,
+polymorphism__construct_type_info(Type, TypeId, TypeArgs, IsHigherOrderOrTuple,
Context, Var, ExtraGoals, Info0, Info) :-
% Create the typeinfo vars for the arguments
@@ -2470,7 +2511,7 @@
TypeId, ModuleInfo, VarSet1, VarTypes1,
BaseVar, BaseGoal, VarSet2, VarTypes2),
polymorphism__maybe_init_second_cell(ArgTypeInfoVars,
- ArgTypeInfoGoals, Type, IsHigherOrder,
+ ArgTypeInfoGoals, Type, IsHigherOrderOrTuple,
BaseVar, VarSet2, VarTypes2, [BaseGoal],
Var, VarSet, VarTypes, ExtraGoals),
@@ -2493,12 +2534,12 @@
out, out, out, out) is det.
polymorphism__maybe_init_second_cell(ArgTypeInfoVars, ArgTypeInfoGoals, Type,
- IsHigherOrder, BaseVar, VarSet0, VarTypes0, ExtraGoals0,
+ IsHigherOrderOrTuple, BaseVar, VarSet0, VarTypes0, ExtraGoals0,
Var, VarSet, VarTypes, ExtraGoals) :-
% Unfortunately, if we have higher order terms, we
% can no longer just optimise them to be the actual
% type_ctor_info
- ( IsHigherOrder = yes ->
+ ( IsHigherOrderOrTuple = yes ->
list__length(ArgTypeInfoVars, PredArity),
polymorphism__make_count_var(PredArity,
VarSet0, VarTypes0, ArityVar, ArityGoal,
@@ -2612,6 +2653,7 @@
polymorphism__get_category_name(float_type, "float").
polymorphism__get_category_name(str_type, "string").
polymorphism__get_category_name(pred_type, "pred").
+polymorphism__get_category_name(tuple_type, "tuple").
polymorphism__get_category_name(polymorphic_type, _) :-
error("polymorphism__get_category_name: polymorphic type").
polymorphism__get_category_name(user_type, _) :-
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.15
diff -u -u -r1.15 prog_io_dcg.m
--- compiler/prog_io_dcg.m 2000/04/22 07:12:00 1.15
+++ compiler/prog_io_dcg.m 2000/07/22 23:54:11
@@ -141,8 +141,12 @@
is semidet.
% Ordinary goal inside { curly braces }.
-parse_dcg_goal_2("{}", [G], _, VarSet0, N, Var, Goal, VarSet, N, Var) :-
- parse_goal(G, VarSet0, Goal, VarSet).
+parse_dcg_goal_2("{}", [G0 | Gs], Context, VarSet0, N, Var,
+ Goal, VarSet, N, Var) :-
+ % The parser treats '{}/N' terms as tuples, so we need
+ % to undo the parsing of the argument conjunction here.
+ list_to_conjunction(Context, G0, Gs, G),
+ parse_goal(G, VarSet0, Goal, VarSet).
parse_dcg_goal_2("impure", [G], _, VarSet0, N0, Var0, Goal, VarSet, N, Var) :-
parse_dcg_goal_with_purity(G, VarSet0, N0, Var0, (impure),
Goal, VarSet, N, Var).
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.16
diff -u -u -r1.16 prog_io_util.m
--- compiler/prog_io_util.m 1999/12/27 11:07:29 1.16
+++ compiler/prog_io_util.m 2000/07/22 23:54:11
@@ -106,6 +106,12 @@
:- pred conjunction_to_list(term(T), list(term(T))).
:- mode conjunction_to_list(in, out) is det.
+ % list_to_conjunction(Context, First, Rest, Term).
+ % convert a list to a "conjunction" (bunch of terms separated by ','s)
+
+:- pred list_to_conjunction(prog_context, term(T), list(term(T)), term(T)).
+:- mode list_to_conjunction(in, in, in, out) is det.
+
% convert a "sum" (bunch of terms separated by '+' operators) to a list
:- pred sum_to_list(term(T), list(term(T))).
@@ -426,6 +432,11 @@
conjunction_to_list(Term, List) :-
binop_term_to_list(",", Term, List).
+
+list_to_conjunction(_, Term, [], Term).
+list_to_conjunction(Context, First, [Second | Rest], Term) :-
+ list_to_conjunction(Context, Second, Rest, Tail),
+ Term = term__functor(term__atom(","), [First, Tail], Context).
sum_to_list(Term, List) :-
binop_term_to_list("+", Term, List).
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.3
diff -u -u -r1.3 pseudo_type_info.m
--- compiler/pseudo_type_info.m 2000/04/02 14:54:38 1.3
+++ compiler/pseudo_type_info.m 2000/07/27 02:57:44
@@ -58,9 +58,9 @@
)
; higher_order_type_info(
%
- % This represents a higher-order type.
- % The rtti_type_id field will be pred/0
- % or func/0; the real arity is
+ % This represents a higher-order or tuple type.
+ % The rtti_type_id field will be pred/0,
+ % func/0 or tuple/0; the real arity is
% given in the arity field.
%
rtti_type_id,
@@ -104,14 +104,20 @@
% defined pred_0 type_ctor_info, have an extra
% argument for their real arity, and then type
% arguments according to their types.
+ % Tuples are similar -- they use the tuple_0
+ % type_ctor_info.
% polymorphism.m has a detailed explanation.
% XXX polymorphism.m does not have a
% detailed explanation.
- type_is_higher_order(Type, _PredFunc,
- _EvalMethod, _TypeArgs)
+ ( type_is_higher_order(Type, _, _, _) ->
+ TypeName = "pred"
+ ; type_is_tuple(Type, _) ->
+ TypeName = "tuple"
+ ;
+ fail
+ )
->
TypeModule = unqualified(""),
- TypeName = "pred",
Arity = 0,
RttiTypeId = rtti_type_id(TypeModule, TypeName, Arity),
TypeId = _QualTypeName - RealArity,
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.15
diff -u -u -r1.15 rl.m
--- compiler/rl.m 2000/06/16 05:12:09 1.15
+++ compiler/rl.m 2000/07/26 00:51:39
@@ -1276,61 +1276,77 @@
Decls = Decls0,
ThisType = ":S"
;
+ ClassifiedType = tuple_type,
+ rl__gather_du_type(ModuleInfo, Parents, Type, GatheredTypes0,
+ GatheredTypes, RecursiveTypes0, RecursiveTypes,
+ Decls0, Decls, ThisType)
+ ;
ClassifiedType = pred_type,
error("rl__gather_type: pred type")
;
ClassifiedType = user_type,
+ % We can't handle abstract types here. magic_util.m
+ % checks that there are none.
+ rl__gather_du_type(ModuleInfo, Parents, Type, GatheredTypes0,
+ GatheredTypes, RecursiveTypes0, RecursiveTypes,
+ Decls0, Decls, ThisType)
+ ).
+
+:- pred rl__gather_du_type(module_info::in, set(full_type_id)::in,
+ (type)::in, gathered_types::in, gathered_types::out,
+ set(full_type_id)::in, set(full_type_id)::out,
+ string::in, string::out, string::out) is det.
+
+rl__gather_du_type(ModuleInfo, Parents, Type, GatheredTypes0, GatheredTypes,
+ RecursiveTypes0, RecursiveTypes, Decls0, Decls, ThisType) :-
+ (
+ type_to_type_id(Type, TypeId, Args),
+ type_constructors(Type, ModuleInfo, Ctors)
+ ->
+ ( set__member(TypeId - Args, Parents) ->
+ set__insert(RecursiveTypes0, TypeId - Args,
+ RecursiveTypes1)
+ ;
+ RecursiveTypes1 = RecursiveTypes0
+ ),
(
- type_to_type_id(Type, TypeId, Args),
- type_constructors(Type, ModuleInfo, Ctors)
+ map__search(GatheredTypes0, TypeId - Args,
+ MangledTypeName0)
->
- ( set__member(TypeId - Args, Parents) ->
- set__insert(RecursiveTypes0, TypeId - Args,
- RecursiveTypes1)
- ;
- RecursiveTypes1 = RecursiveTypes0
- ),
- (
- map__search(GatheredTypes0, TypeId - Args,
- MangledTypeName0)
- ->
- GatheredTypes = GatheredTypes0,
- Decls = Decls0,
- MangledTypeName = MangledTypeName0,
- RecursiveTypes = RecursiveTypes1
+ GatheredTypes = GatheredTypes0,
+ Decls = Decls0,
+ MangledTypeName = MangledTypeName0,
+ RecursiveTypes = RecursiveTypes1
+ ;
+ set__insert(Parents, TypeId - Args, Parents1),
+ rl__mangle_and_quote_type_name(TypeId,
+ Args, MangledTypeName),
+
+ % Record that we have seen this type
+ % before processing the sub-terms.
+ map__det_insert(GatheredTypes0, TypeId - Args,
+ MangledTypeName, GatheredTypes1),
+
+ rl__gather_constructors(ModuleInfo,
+ Parents1, Ctors, GatheredTypes1,
+ GatheredTypes, RecursiveTypes1,
+ RecursiveTypes, Decls0, Decls1,
+ "", CtorDecls),
+
+ % Recursive types are marked by a
+ % second colon before their declaration.
+ ( set__member(TypeId - Args, RecursiveTypes) ->
+ RecursiveSpec = ":"
;
- set__insert(Parents, TypeId - Args,
- Parents1),
- rl__mangle_and_quote_type_name(TypeId,
- Args, MangledTypeName),
-
- % Record that we have seen this type
- % before processing the sub-terms.
- map__det_insert(GatheredTypes0, TypeId - Args,
- MangledTypeName, GatheredTypes1),
-
- rl__gather_constructors(ModuleInfo,
- Parents1, Ctors, GatheredTypes1,
- GatheredTypes, RecursiveTypes1,
- RecursiveTypes, Decls0, Decls1,
- "", CtorDecls),
-
- % Recursive types are marked by a
- % second colon before their declaration.
- ( set__member(TypeId - Args, RecursiveTypes) ->
- RecursiveSpec = ":"
- ;
- RecursiveSpec = ""
- ),
- string__append_list(
- [Decls1, RecursiveSpec, ":",
- MangledTypeName, "=", CtorDecls, " "],
- Decls)
+ RecursiveSpec = ""
),
- string__append(":T", MangledTypeName, ThisType)
- ;
- error("rl__gather_type: type_constructors failed")
- )
+ string__append_list([Decls1, RecursiveSpec, ":",
+ MangledTypeName, "=", CtorDecls, " "],
+ Decls)
+ ),
+ string__append(":T", MangledTypeName, ThisType)
+ ;
+ error("rl__gather_type: type_constructors failed")
).
:- pred rl__gather_constructors(module_info::in, set(full_type_id)::in,
@@ -1349,8 +1365,7 @@
list__length(Args, Arity),
rl__mangle_and_quote_ctor_name(CtorName, Arity, MangledCtorName),
- Snd = lambda([Pair::in, Second::out] is det, Pair = _ - Second),
- list__map(Snd, Args, ArgTypes),
+ assoc_list__values(Args, ArgTypes),
rl__gather_types(ModuleInfo, Parents, ArgTypes, GatheredTypes0,
GatheredTypes1, RecursiveTypes0, RecursiveTypes1,
Decls0, Decls1, "", ArgList),
Index: compiler/rl_key.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_key.m,v
retrieving revision 1.6
diff -u -u -r1.6 rl_key.m
--- compiler/rl_key.m 2000/03/01 01:04:50 1.6
+++ compiler/rl_key.m 2000/07/22 23:54:12
@@ -114,6 +114,10 @@
list__map(rl_key__remove_useless_info(ModuleInfo),
ArgBounds0, ArgBounds),
(
+ type_is_tuple(Type, _)
+ ->
+ Bound = var - Vars
+ ;
\+ (
list__member(ArgBound, ArgBounds),
ArgBound \= var - _
@@ -124,7 +128,7 @@
),
module_info_types(ModuleInfo, Types),
type_to_type_id(Type, TypeId, _),
- map__lookup(Types, TypeId, TypeDefn),
+ map__search(Types, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
Body = du_type(Ctors, _, _, _),
Ctors = [_]
@@ -1019,7 +1023,7 @@
->
module_info_types(ModuleInfo, Types),
type_to_type_id(Type, TypeId, _),
- map__lookup(Types, TypeId, TypeDefn),
+ map__search(Types, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
% If there's a user defined equality pred we're in trouble.
Body = du_type(Ctors, _, _, no),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.77
diff -u -u -r1.77 simplify.m
--- compiler/simplify.m 2000/04/05 06:28:28 1.77
+++ compiler/simplify.m 2000/07/22 23:54:12
@@ -1180,7 +1180,12 @@
{ globals__lookup_bool_option(Globals, special_preds,
SpecialPreds) },
(
- { SpecialPreds = no },
+ %
+ % Always use the generic procedure for in-in
+ % unification of tuples -- a type specific
+ % version would not be any more efficient.
+ %
+ { SpecialPreds = no ; type_id_is_tuple(TypeId) },
{ proc_id_to_int(ProcId, ProcIdInt) },
{ ProcIdInt = 0 }
->
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.71
diff -u -u -r1.71 switch_gen.m
--- compiler/switch_gen.m 1999/07/13 08:53:33 1.71
+++ compiler/switch_gen.m 2000/07/22 23:54:13
@@ -180,6 +180,7 @@
switch_gen__type_cat_to_switch_cat(pred_type, other_switch).
switch_gen__type_cat_to_switch_cat(user_type, tag_switch).
switch_gen__type_cat_to_switch_cat(polymorphic_type, other_switch).
+switch_gen__type_cat_to_switch_cat(tuple_type, other_switch).
%---------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.19
diff -u -u -r1.19 table_gen.m
--- compiler/table_gen.m 2000/04/03 16:22:10 1.19
+++ compiler/table_gen.m 2000/07/22 23:54:13
@@ -1327,6 +1327,7 @@
not_builtin_type(pred_type).
not_builtin_type(enum_type).
not_builtin_type(polymorphic_type).
+not_builtin_type(tuple_type).
not_builtin_type(user_type).
:- pred builtin_type_to_string(builtin_type::in, string::out) is det.
@@ -1336,6 +1337,7 @@
builtin_type_to_string(str_type, "string").
builtin_type_to_string(float_type, "float").
builtin_type_to_string(pred_type, "pred").
+builtin_type_to_string(tuple_type, "any").
builtin_type_to_string(enum_type, "enum").
builtin_type_to_string(polymorphic_type, "any").
builtin_type_to_string(user_type, "any").
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.13
diff -u -u -r1.13 term_util.m
--- compiler/term_util.m 1999/07/13 08:53:35 1.13
+++ compiler/term_util.m 2000/07/26 00:52:10
@@ -306,6 +306,13 @@
ConsId = cons(SymName, Arity),
map__det_insert(Weights0, TypeId - ConsId, WeightInfo, Weights).
+:- pred find_weights_for_tuple(arity::in, weight_info::out) is det.
+
+find_weights_for_tuple(Arity, weight(Weight, ArgInfos)) :-
+ % None of the tuple arguments are recursive.
+ Weight = Arity,
+ list__duplicate(Arity, yes, ArgInfos).
+
:- pred find_and_count_nonrec_args(list(constructor_arg)::in,
type_id::in, list(type_param)::in,
int::out, list(bool)::out) is det.
@@ -330,6 +337,19 @@
Id = ArgTypeId,
list__perm(Params, ArgTypeParams).
+:- pred search_weight_table(weight_table::in, type_id::in, cons_id::in,
+ weight_info::out) is semidet.
+
+search_weight_table(WeightMap, TypeId, ConsId, WeightInfo) :-
+ ( map__search(WeightMap, TypeId - ConsId, WeightInfo0) ->
+ WeightInfo = WeightInfo0
+ ; type_id_is_tuple(TypeId) ->
+ TypeId = _ - Arity,
+ find_weights_for_tuple(Arity, WeightInfo)
+ ;
+ fail
+ ).
+
%-----------------------------------------------------------------------------%
% Although the module info is not used in either of these norms, it could
@@ -352,14 +372,14 @@
).
functor_norm(use_map(WeightMap), TypeId, ConsId, _Module, Int,
Args, Args, Modes, Modes) :-
- ( map__search(WeightMap, TypeId - ConsId, WeightInfo) ->
+ ( search_weight_table(WeightMap, TypeId, ConsId, WeightInfo) ->
WeightInfo = weight(Int, _)
;
Int = 0
).
functor_norm(use_map_and_args(WeightMap), TypeId, ConsId, _Module, Int,
Args0, Args, Modes0, Modes) :-
- ( map__search(WeightMap, TypeId - ConsId, WeightInfo) ->
+ ( search_weight_table(WeightMap, TypeId, ConsId, WeightInfo) ->
WeightInfo = weight(Int, UseArgList),
(
functor_norm_filter_args(UseArgList, Args0, Args1,
@@ -569,6 +589,7 @@
zero_size_type_category(str_type, _, _, yes).
zero_size_type_category(float_type, _, _, yes).
zero_size_type_category(pred_type, _, _, no).
+zero_size_type_category(tuple_type, _, _, no).
zero_size_type_category(enum_type, _, _, yes).
zero_size_type_category(polymorphic_type, _, _, no).
zero_size_type_category(user_type, _, _, no).
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.85
diff -u -u -r1.85 type_util.m
--- compiler/type_util.m 2000/07/25 09:27:27 1.85
+++ compiler/type_util.m 2000/07/26 00:58:07
@@ -39,12 +39,20 @@
lambda_eval_method, list(type)).
:- mode type_is_higher_order(in, out, out, out) is semidet.
+ % Succeed if the given type is a tuple type, returning
+ % the argument types.
+:- pred type_is_tuple(type, list(type)).
+:- mode type_is_tuple(in, out) is semidet.
+
% type_id_is_higher_order(TypeId, PredOrFunc) succeeds iff
% TypeId is a higher-order predicate or function type.
-
:- pred type_id_is_higher_order(type_id, pred_or_func, lambda_eval_method).
:- mode type_id_is_higher_order(in, out, out) is semidet.
+ % type_id_is_tuple(TypeId) succeeds iff TypeId is a tuple type.
+:- pred type_id_is_tuple(type_id).
+:- mode type_id_is_tuple(in) is semidet.
+
% return true iff there was a `where equality is <predname>'
% declaration for the specified type, and return the name of
% the equality predicate and the context of the type declaration.
@@ -105,6 +113,7 @@
; str_type
; float_type
; pred_type
+ ; tuple_type
; enum_type
; polymorphic_type
; user_type.
@@ -163,9 +172,9 @@
:- pred type_util__type_id_arity(module_info, type_id, arity).
:- mode type_util__type_id_arity(in, in, out) is det.
-
- % If the type is a du type, return the list of its constructors.
+ % If the type is a du type or a tuple type,
+ % return the list of its constructors.
:- pred type_constructors(type, module_info, list(constructor)).
:- mode type_constructors(in, in, out) is semidet.
@@ -400,6 +409,7 @@
type_is_atomic(Type, ModuleInfo) :-
classify_type(Type, ModuleInfo, BuiltinType),
BuiltinType \= polymorphic_type,
+ BuiltinType \= tuple_type,
BuiltinType \= pred_type,
BuiltinType \= user_type.
@@ -445,6 +455,8 @@
Type = str_type
; type_id_is_higher_order(TypeId, _, _) ->
Type = pred_type
+ ; type_id_is_tuple(TypeId) ->
+ Type = tuple_type
; type_id_is_enumeration(TypeId, ModuleInfo) ->
Type = enum_type
;
@@ -472,6 +484,10 @@
PredOrFunc = predicate
).
+type_is_tuple(Type, ArgTypes) :-
+ type_to_type_id(Type, TypeId, ArgTypes),
+ type_id_is_tuple(TypeId).
+
% From the type of a lambda expression, work out how it should
% be evaluated.
:- pred get_lambda_eval_method((type), lambda_eval_method, (type)) is det.
@@ -516,6 +532,8 @@
PredOrFunc = function
).
+type_id_is_tuple(unqualified("{}") - _).
+
type_has_user_defined_equality_pred(ModuleInfo, Type, SymName) :-
module_info_types(ModuleInfo, TypeTable),
type_to_type_id(Type, TypeId, _TypeArgs),
@@ -687,14 +705,24 @@
% If the type is a du type, return the list of its constructors.
type_constructors(Type, ModuleInfo, Constructors) :-
- type_to_type_id(Type, TypeId, TypeArgs),
- module_info_types(ModuleInfo, TypeTable),
- map__search(TypeTable, TypeId, TypeDefn),
- hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
- hlds_data__get_type_defn_body(TypeDefn, TypeBody),
- TypeBody = du_type(Constructors0, _, _, _),
- substitute_type_args(TypeParams, TypeArgs, Constructors0,
- Constructors).
+ ( type_is_tuple(Type, TupleArgTypes) ->
+ % tuples are never existentially typed.
+ ExistQVars = [],
+ ClassConstraints = [],
+ CtorArgs = list__map((func(ArgType) = no - ArgType),
+ TupleArgTypes),
+ Constructors = [ctor(ExistQVars, ClassConstraints,
+ unqualified("{}"), CtorArgs)]
+ ;
+ type_to_type_id(Type, TypeId, TypeArgs),
+ module_info_types(ModuleInfo, TypeTable),
+ map__search(TypeTable, TypeId, TypeDefn),
+ hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
+ hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+ TypeBody = du_type(Constructors0, _, _, _),
+ substitute_type_args(TypeParams, TypeArgs, Constructors0,
+ Constructors)
+ ).
%-----------------------------------------------------------------------------%
@@ -706,6 +734,8 @@
char__max_char_value(MaxChar),
char__min_char_value(MinChar),
NumFunctors is MaxChar - MinChar + 1
+ ; type_is_tuple(Type, _) ->
+ NumFunctors = 1
;
type_to_type_id(Type, TypeId, _),
module_info_types(ModuleInfo, TypeTable),
@@ -719,6 +749,12 @@
type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :-
(
+ % The argument types of a tuple cons_id are the
+ % arguments of the tuple type.
+ type_is_tuple(VarType, TupleTypeArgs)
+ ->
+ ArgTypes = TupleTypeArgs
+ ;
type_to_type_id(VarType, _, TypeArgs),
type_util__do_get_type_and_cons_defn(ModuleInfo, VarType,
ConsId, TypeDefn, ConsDefn),
@@ -825,7 +861,12 @@
Name \= "type_info",
Name \= "type_ctor_info",
Name \= "typeclass_info",
- Name \= "base_typeclass_info".
+ Name \= "base_typeclass_info",
+
+ % We don't handle unary tuples as no_tag types --
+ % they are rare enough that it's not worth
+ % the implementation effort.
+ Name \= "{}".
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.277
diff -u -u -r1.277 typecheck.m
--- compiler/typecheck.m 2000/06/06 05:45:23 1.277
+++ compiler/typecheck.m 2000/07/22 23:54:15
@@ -3719,6 +3719,34 @@
ConsInfoList2 = ConsInfoList1
),
+ %
+ % Check if Functor is a tuple constructor.
+ %
+ (
+ Functor = cons(unqualified("{}"), TupleArity)
+ ->
+ %
+ % Make some fresh type variables for the argument types.
+ %
+ varset__init(TupleConsTypeVarSet0),
+ varset__new_vars(TupleConsTypeVarSet0, TupleArity,
+ TupleArgTVars, TupleConsTypeVarSet),
+ term__var_list_to_term_list(TupleArgTVars, TupleArgTypes),
+
+ construct_type(unqualified("{}") - TupleArity, TupleArgTypes,
+ TupleConsType),
+
+ % Tuples can't have existentially typed arguments.
+ TupleExistQVars = [],
+
+ TupleConsInfo = cons_type_info(TupleConsTypeVarSet,
+ TupleExistQVars, TupleConsType,
+ TupleArgTypes, constraints([], [])),
+ ConsInfoList3 = [TupleConsInfo | ConsInfoList2]
+ ;
+ ConsInfoList3 = ConsInfoList2
+ ),
+
% Check if Functor is the name of a predicate which takes at least
% Arity arguments. If so, insert the resulting cons_type_info
% at the start of the list.
@@ -3726,9 +3754,9 @@
builtin_pred_type(TypeCheckInfo, Functor, Arity,
PredConsInfoList)
->
- list__append(ConsInfoList2, PredConsInfoList, ConsInfoList3)
+ list__append(ConsInfoList3, PredConsInfoList, ConsInfoList4)
;
- ConsInfoList3 = ConsInfoList2
+ ConsInfoList4 = ConsInfoList3
),
%
@@ -3741,11 +3769,11 @@
InvalidFieldUpdates0)
->
list__append(FieldAccessConsInfoList,
- ConsInfoList3, ConsInfoList),
+ ConsInfoList4, ConsInfoList),
InvalidFieldUpdates = InvalidFieldUpdates0
;
InvalidFieldUpdates = [],
- ConsInfoList = ConsInfoList3
+ ConsInfoList = ConsInfoList4
).
:- pred flip_quantifiers(cons_type_info, cons_type_info).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.83
diff -u -u -r1.83 unify_proc.m
--- compiler/unify_proc.m 2000/04/18 03:35:36 1.83
+++ compiler/unify_proc.m 2000/07/25 05:34:38
@@ -231,7 +231,7 @@
module_info_name(ModuleInfo0, ModuleName),
ModuleName = TypeModuleName,
module_info_types(ModuleInfo0, TypeTable),
- map__lookup(TypeTable, TypeId, TypeDefn),
+ map__search(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody = abstract_type
;
@@ -240,19 +240,37 @@
->
ModuleInfo = ModuleInfo0
;
+ TypeId = TypeName - TypeArity,
+
%
% lookup the pred_id for the unification procedure
% that we are going to generate
%
module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
- map__lookup(SpecialPredMap, unify - TypeId, PredId),
+ ( map__search(SpecialPredMap, unify - TypeId, PredId0) ->
+ PredId = PredId0,
+ ModuleInfo1 = ModuleInfo0
+ ; type_id_is_tuple(TypeId) ->
+ %
+ % We generate unify predicates for tuple types lazily.
+ %
+ unify_proc__generate_tuple_unify_pred(Context,
+ TypeId, PredId, ModuleInfo0, ModuleInfo1)
+ ;
+ prog_out__sym_name_and_arity_to_string(TypeName/TypeArity,
+ TypeIdStr),
+ Msg = string__append_list([
+ "unify_proc__request_unify: unify predicate for `",
+ TypeIdStr,
+ "' not found"]),
+ error(Msg)
+ ),
% convert from `uni_mode' to `list(mode)'
UnifyMode = ((X_Initial - Y_Initial) -> (X_Final - Y_Final)),
ArgModes0 = [(X_Initial -> X_Final), (Y_Initial -> Y_Final)],
% for polymorphic types, add extra modes for the type_infos
- TypeId = _TypeName - TypeArity,
in_mode(InMode),
list__duplicate(TypeArity, InMode, TypeInfoModes),
list__append(TypeInfoModes, ArgModes0, ArgModes),
@@ -260,17 +278,17 @@
ArgLives = no, % XXX ArgLives should be part of the UnifyId
unify_proc__request_proc(PredId, ArgModes, ArgLives,
- yes(Determinism), Context, ModuleInfo0,
- ProcId, ModuleInfo1),
+ yes(Determinism), Context, ModuleInfo1,
+ ProcId, ModuleInfo2),
%
% save the proc_id for this unify_proc_id
%
- module_info_get_proc_requests(ModuleInfo1, Requests0),
+ module_info_get_proc_requests(ModuleInfo2, Requests0),
unify_proc__get_unify_req_map(Requests0, UnifyReqMap0),
map__set(UnifyReqMap0, UnifyId, ProcId, UnifyReqMap),
unify_proc__set_unify_req_map(Requests0, UnifyReqMap, Requests),
- module_info_set_proc_requests(ModuleInfo1, Requests,
+ module_info_set_proc_requests(ModuleInfo2, Requests,
ModuleInfo)
).
@@ -466,6 +484,55 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+
+:- pred unify_proc__generate_tuple_unify_pred(prog_context, type_id, pred_id,
+ module_info, module_info).
+:- mode unify_proc__generate_tuple_unify_pred(in, in, out, in, out) is det.
+
+unify_proc__generate_tuple_unify_pred(Context, TypeId,
+ PredId, ModuleInfo0, ModuleInfo) :-
+
+ TypeId = _ - TupleArity,
+
+ %
+ % Build a hlds_type_body for the tuple constructor, which will
+ % be used by unify_proc__generate_clause_info.
+ %
+
+ varset__init(TVarSet0),
+ varset__new_vars(TVarSet0, TupleArity, TupleArgTVars, TVarSet),
+ term__var_list_to_term_list(TupleArgTVars, TupleArgTypes),
+
+ % Tuple constructors can't be existentially quantified.
+ ExistQVars = [],
+ ClassConstraints = [],
+
+ MakeUnamedField = (func(ArgType) = no - ArgType),
+ CtorArgs = list__map(MakeUnamedField, TupleArgTypes),
+
+ Ctor = ctor(ExistQVars, ClassConstraints,
+ CtorSymName, CtorArgs),
+
+ CtorSymName = unqualified("{}"),
+ ConsId = cons(CtorSymName, TupleArity),
+ map__from_assoc_list([ConsId - unshared_tag(0)], ConsTagValues),
+ UnifyPred = no,
+ IsEnum = no,
+ TypeBody = du_type([Ctor], ConsTagValues, IsEnum, UnifyPred),
+
+ %
+ % Call make_hlds.m to add the special pred.
+ % Unification procedures for tuple types never need
+ % to be typechecked -- they don't have user-defined
+ % equality and they don't have existentially typed
+ % constructors.
+ %
+ construct_type(TypeId, TupleArgTypes, Type),
+ make_hlds__add_special_pred(unify, ModuleInfo0, TVarSet, Type,
+ TypeId, TypeBody, Context, imported(interface), ModuleInfo1),
+ module_info_get_special_pred_map(ModuleInfo1, SpecialPredMap),
+ map__lookup(SpecialPredMap, unify - TypeId, PredId),
+ polymorphism__process_generated_pred(PredId, ModuleInfo1, ModuleInfo).
unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, Context,
ModuleInfo, ClauseInfo) :-
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.183
diff -u -u -r1.183 reference_manual.texi
--- doc/reference_manual.texi 2000/06/01 08:47:35 1.183
+++ doc/reference_manual.texi 2000/08/01 02:13:53
@@ -317,7 +317,7 @@
A functor is an integer, a float, a string, a name, a compound term,
or a higher-order term.
-A compound term is a simple compound term, an operator term,
+A compound term is a simple compound term, a tuple term, an operator term,
or a parenthesized term.
A simple compound term is a name followed without any intervening
@@ -325,6 +325,10 @@
a sequence of argument terms separated by commas, and a close
parenthesis.
+A tuple term is a left curly bracket (i.e. an open_curly token)
+followed by a sequence of argument terms separated by commas,
+and a right curly bracket.
+
An operator term is a term specified using operator notation, as in Prolog.
Operators can also be formed by enclosing a variable or name between grave
accents (backquotes). Any variable or name may
@@ -1040,6 +1044,14 @@
These higher-order function and predicate types are used to pass procedure
addresses and closures to other predicates. @xref{Higher-order}.
+ at item Tuple types: @code{@{@}}, @code{@{T@}}, @code{@{T1, T2@}}, @dots{}.
+A tuple type is equivalent to a discriminated union type
+(@pxref{Discriminated unions}) with declaration
+ at example
+:- type @{Arg1, Arg2, @dots{}, ArgN@}
+ ---> @{ @{Arg1, Arg2, @dots{}, ArgN@} @}.
+ at end example
+
@item The universal type: @code{univ}.
The type @code{univ} is defined in the standard library module @code{std_util},
along with the predicates @code{type_to_univ/2} and @code{univ_to_type/2}.
@@ -1154,7 +1166,9 @@
@end example
This defines a type with two constructors, @code{';'/2} and @code{'@{@}'/1},
-whose argument types are all @code{int}.
+whose argument types are all @code{int}. We recommend against using
+constructors named @code{'@{@}'} because of the possibility of confusion
+with the builtin tuple types.
Each discriminated union type definition introduces a distinct type.
Mercury considers two discriminated union types that have the same bodies
Index: doc/transition_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/transition_guide.texi,v
retrieving revision 1.33
diff -u -u -r1.33 transition_guide.texi
--- doc/transition_guide.texi 2000/01/25 04:10:05 1.33
+++ doc/transition_guide.texi 2000/07/24 06:51:38
@@ -196,6 +196,11 @@
all Vars Goal
@end example
+Terms with functor '@{@}/@var{N}' are treated slightly differently in Mercury
+than in ISO Prolog. ISO Prolog specifies that ``@{1, 2, 3@}'' is parsed as
+ at code{'@{@}'(','(1, ','(2, 3)))}. In Mercury, it is parsed as
+ at code{'@{@}'(1, 2, 3)}.
+
Mercury does not (yet) allow users to define their own operators.
@node IO
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.37
diff -u -u -r1.37 builtin.m
--- library/builtin.m 2000/07/12 13:54:40 1.37
+++ library/builtin.m 2000/07/22 23:54:17
@@ -24,6 +24,7 @@
% TYPES.
% The types `character', `int', `float', and `string',
+% and tuple types `{}', `{T}', `{T1, T2}', ...
% and the types `pred', `pred(T)', `pred(T1, T2)', `pred(T1, T2, T3)', ...
% and `func(T1) = T2', `func(T1, T2) = T3', `func(T1, T2, T3) = T4', ...
% are builtin and are implemented using special code in the
@@ -270,6 +271,14 @@
mercury__builtin_unify_pred_2_0,
mercury__builtin_compare_pred_3_0);
+ /*
+ ** All tuple types use the following type_ctor_info.
+ */
+MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, tuple, 0,
+ MR_TYPECTOR_REP_TUPLE,
+ mercury__builtin_unify_tuple_2_0,
+ mercury__builtin_compare_tuple_3_0);
+
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(void, 0, MR_TYPECTOR_REP_VOID);
#ifdef NATIVE_GC
@@ -324,6 +333,8 @@
mercury_data___type_ctor_info_pred_0, _pred_);
MR_INIT_BUILTIN_TYPE_CTOR_INFO(
mercury_data___type_ctor_info_func_0, _pred_);
+ MR_INIT_BUILTIN_TYPE_CTOR_INFO(
+ mercury_data___type_ctor_info_tuple_0, _tuple_);
MR_INIT_TYPE_CTOR_INFO_WITH_PRED(
mercury_data___type_ctor_info_void_0, mercury__unused_0_0);
}
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.199
diff -u -u -r1.199 io.m
--- library/io.m 2000/07/20 10:39:34 1.199
+++ library/io.m 2000/07/28 00:19:48
@@ -2000,6 +2000,14 @@
io__write_univ(BracedTerm),
io__write_string(" }")
;
+ { Functor = "{}" },
+ { Args = [BracedHead | BracedTail] }
+ ->
+ io__write_char('{'),
+ io__write_arg(BracedHead),
+ io__write_term_args(BracedTail),
+ io__write_char('}')
+ ;
{ Args = [PrefixArg] },
{ ops__lookup_prefix_op(OpTable, Functor,
OpPriority, OpAssoc) }
Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.35
diff -u -u -r1.35 parser.m
--- library/parser.m 2000/02/16 08:36:14 1.35
+++ library/parser.m 2000/07/23 13:44:59
@@ -531,11 +531,18 @@
( parser__get_token(close_curly) ->
parser__parse_special_atom("{}", TermContext, Term)
;
+ % This is a slight departure from ISO Prolog
+ % syntax -- instead of parsing "{1,2,3}"
+ % as "'{}'(','(1, ','(2, 3)))" we parse
+ % it as "'{}'(1,2,3)". This makes the
+ % structure of tuple functors the same
+ % as other functors.
parser__parse_term(SubTerm0),
( { SubTerm0 = ok(SubTerm) } ->
+ { conjunction_to_list(SubTerm, ArgTerms) },
( parser__get_token(close_curly) ->
{ Term = ok(term__functor(term__atom("{}"),
- [SubTerm], TermContext)) }
+ ArgTerms, TermContext)) }
;
parser__unexpected("expecting `}' or operator",
Term)
@@ -544,6 +551,17 @@
% propagate error upwards
{ Term = SubTerm0 }
)
+ ).
+
+:- pred parser__conjunction_to_list(term(T), list(term(T))).
+:- mode parser__conjunction_to_list(in, out) is det.
+
+parser__conjunction_to_list(Term, ArgTerms) :-
+ ( Term = term__functor(term__atom(","), [LeftTerm, RightTerm], _) ->
+ parser__conjunction_to_list(RightTerm, ArgTerms0),
+ ArgTerms = [LeftTerm | ArgTerms0]
+ ;
+ ArgTerms = [Term]
).
:- pred parser__check_for_higher_order_term(parse(term(T)), token_context,
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.52
diff -u -u -r1.52 private_builtin.m
--- library/private_builtin.m 2000/05/08 16:10:59 1.52
+++ library/private_builtin.m 2000/07/24 06:25:40
@@ -69,6 +69,12 @@
:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
is det.
+ % These should never be called -- the compiler never
+ % specializes them because the generic compare is just
+ % as good as anything we could put here.
+:- pred builtin_unify_tuple(T::in, T::in) is semidet.
+:- pred builtin_compare_tuple(comparison_result::uo, T::in, T::in) is det.
+
% The following pred is used for compare/3
% on non-canonical types (types for which there is a
% `where equality is ...' declaration).
@@ -148,6 +154,13 @@
R = (>)
).
+:- pred builtin_strcmp(int, string, string).
+:- mode builtin_strcmp(out, in, in) is det.
+
+:- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
+ [will_not_call_mercury, thread_safe],
+ "Res = strcmp(S1, S2);").
+
builtin_unify_float(F, F).
builtin_compare_float(R, F1, F2) :-
@@ -159,12 +172,25 @@
R = (=)
).
-:- pred builtin_strcmp(int, string, string).
-:- mode builtin_strcmp(out, in, in) is det.
+builtin_unify_tuple(_, _) :-
+ ( semidet_succeed ->
+ % The generic unification function in the runtime
+ % should handle this itself.
+ error("builtin_unify_tuple called")
+ ;
+ % the following is never executed
+ semidet_succeed
+ ).
-:- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
- [will_not_call_mercury, thread_safe],
- "Res = strcmp(S1, S2);").
+builtin_compare_tuple(Res, _, _) :-
+ ( semidet_succeed ->
+ % The generic comparison function in the runtime
+ % should handle this itself.
+ error("builtin_compare_tuple called")
+ ;
+ % the following is never executed
+ Res = (<)
+ ).
:- pragma no_inline(builtin_unify_pred/2).
builtin_unify_pred(_X, _Y) :-
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list