[m-rev.] for review: predicate equivalence type and inst declarations
Simon Taylor
stayl at cs.mu.OZ.AU
Mon Mar 11 15:49:00 AEDT 2002
Estimated hours taken: 40
Branches: main
Allow declarations of the form
:- pred p `with_type` higher_order_type `with_inst` higher_order_inst.
To do: we should allow `with_inst` annotations on higher-order terms.
compiler/prog_data.m:
Add fields to `pred_or_func' and `pred_or_func_mode'
items to hold the `with_type` and `with_inst` annotations.
compiler/prog_io.m:
compiler/prog_io_typeclass.m:
Parse the annotations.
compiler/module_qual.m:
Module qualify the annotations.
compiler/equiv_type.m:
Expand away `with_type` and `with_inst`. Report errors.
Strip items containing errors from the item list.
Record smart recompilation dependencies on the types and
modes expanded. Also record a dependency on the arity of
predicate and function declarations before expansion.
Use error_util for error messages.
compiler/mercury_to_mercury.m:
Write `with_type` and `with_inst` annotations to interface files.
compiler/make_hlds.m:
Ignore `with_type` and `with_inst` fields in predicate and
function declarations.
compiler/recompilation.m:
Changes to allow equiv_type.m to record dependencies on
arbitrary items, not just types.
compiler/recompilation_usage.m:
compiler/recompilation_check.m:
Allow searches in the sets of used predicates and functions using
name, not name and arity, as the key. This is needed because
the actual arity of a predicate defined using `with_type` is
not known when writing the interface files.
compiler/recompilation_version.m:
Handle `with_inst` and `with_type`.
Pragmas now need to be recorded in the version_numbers even
if there is no matching `:- pred' or `:- func' declaration --
the pragma may apply to a predicate or function declared using
`with_type`.
compiler/mode_util.m:
Export inst_subsitute_arg_list for use by equiv_type.m.
compiler/error_util.m:
Add predicate `pred_or_func_to_string'.
library/std_util.m:
Add std_util__map_foldl_maybe and std_util__map_foldl2_maybe,
which are like list__map_foldl and list__map_foldl2, but
apply to the item stored in a value of type std_util__maybe.
NEWS:
doc/reference_manual.texi:
Document the new syntax and library predicates.
tests/invalid/Mmakefile:
tests/invalid/with_type.m:
tests/invalid/with_type.err_exp:
tests/recompilation/TESTS:
tests/recompilation/unchanged_with_type_nr*:
tests/recompilation/with_type_re*:
Test cases.
tests/invalid/errors1.err_exp:
tests/invalid/type_loop.err_exp:
tests/invalid/vars_in_wrong_places.err_exp:
Update expected output.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.248
diff -u -u -r1.248 NEWS
--- NEWS 8 Mar 2002 01:10:58 -0000 1.248
+++ NEWS 8 Mar 2002 07:02:49 -0000
@@ -3,6 +3,21 @@
Changes to the Mercury language:
+* Predicate and function types and modes can now be defined in terms of
+ higher-order predicate and function types and insts. This is useful
+ where several predicates or functions must have the the same type and
+ mode signature.
+
+ For example:
+ :- type foldl_pred(T, U) == pred(T, U, U).
+ :- inst foldl_pred == pred(in, in, out) is det.
+ :- pred p `with_type` foldl_pred(T, U) `with_inst` foldl_pred.
+
+ For more information see the "Predicate and function type declarations"
+ section of the "Types" chapter and the "Predicate and function mode
+ declarations" section of the "Modes chapter" of the Mercury Language
+ Reference Manual.
+
* If a higher-order function term has inst 'ground' it is now assumed to have
the standard higher-order function inst 'func(in, .., in) = out is det'.
This makes higher-order functional programming much easier, particularly when
@@ -102,6 +117,7 @@
Also beware that std_util__functor and std_util__deconstruct now
return `[|]' rather than `.' for lists, and calls to std_util__construct
which construct lists may need to be updated.
+* We've added a predicate list__map_foldl2.
* We've added a function version of error/1, called func_error/1, to require.m.
@@ -142,9 +158,11 @@
comparison of values of type `tm' whose `tm_dst' fields are identical
is equivalent to comparison of the times those values represent.
-* We've added a predicate `std_util__map_maybe/3' and a function
- `std_util__map_maybe/2' to apply a predicate or a function to
- a value stored in a term of type `std_util__maybe'.
+* We've added predicates `std_util__map_maybe/3',
+ `std_util__map_foldl_maybe/5' and `std_util__map_foldl2_maybe/7',
+ and function `std_util__map_maybe/2' which are analogous to
+ `list__map', `list__map_foldl' and `list__map_foldl2', but which
+ work on the value stored in a term of type `std_util__maybe'.
* We've added added several new predicates for deconstructing terms to
std_util.m. `named_argument' and `det_named_argument' are analogous
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.28
diff -u -u -r1.28 equiv_type.m
--- compiler/equiv_type.m 7 Mar 2002 08:29:47 -0000 1.28
+++ compiler/equiv_type.m 10 Mar 2002 15:35:37 -0000
@@ -49,7 +49,7 @@
:- implementation.
:- import_module assoc_list, bool, require, std_util, map, set, term, varset.
-:- import_module prog_data, prog_util, prog_out.
+:- import_module prog_data, prog_util, prog_out, (inst), mode_util, error_util.
% XXX we shouldn't import the HLDS here.
:- import_module hlds_data, type_util.
@@ -61,40 +61,72 @@
% definitions. Then we go through the item list and replace
% them.
-equiv_type__expand_eqv_types(ModuleName, Items0, Items, CircularTypes, EqvMap,
+equiv_type__expand_eqv_types(ModuleName, Items0, Items, Error, EqvMap,
Info0, Info) -->
{ map__init(EqvMap0) },
- { equiv_type__build_eqv_map(Items0, EqvMap0, EqvMap) },
+ { map__init(EqvInstMap0) },
+ { equiv_type__build_eqv_map(Items0, EqvMap0, EqvMap,
+ EqvInstMap0, EqvInstMap) },
{ equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
- [], RevItems, [], RevCircularTypeList, Info0, Info) },
+ EqvInstMap, [], RevItems, [], ErrorList, Info0, Info) },
{ list__reverse(RevItems, Items) },
(
- { RevCircularTypeList = [] }
+ { ErrorList = [] }
->
- { CircularTypes = no }
+ { Error = no }
;
- { list__reverse(RevCircularTypeList, CircularTypeList) },
- equiv_type__report_circular_types(CircularTypeList),
- { CircularTypes = yes },
+ list__foldl(equiv_type__report_error,
+ list__reverse(ErrorList)),
+ { Error = yes },
io__set_exit_status(1)
).
:- type eqv_type_body ---> eqv_type_body(tvarset, list(type_param), type).
:- type eqv_map == map(type_ctor, eqv_type_body).
-:- pred equiv_type__build_eqv_map(list(item_and_context), eqv_map, eqv_map).
-:- mode equiv_type__build_eqv_map(in, in, out) is det.
-
-equiv_type__build_eqv_map([], EqvMap, EqvMap).
-equiv_type__build_eqv_map([Item - _Context | Items], EqvMap0, EqvMap) :-
+ % We need to expand equivalence insts in
+ % `:- pred p `with_inst` i' declarations.
+:- type eqv_inst_body ---> eqv_inst_body(inst_varset, list(inst_var), inst).
+:- type eqv_inst_map == map(inst_id, eqv_inst_body).
+
+:- type pred_or_func_decl_type
+ ---> type_decl
+ ; mode_decl
+ .
+
+:- type eqv_error == pair(eqv_error_type, prog_context).
+
+:- type eqv_error_type
+ ---> circular_equivalence(item)
+ ; invalid_with_type(sym_name, pred_or_func)
+ ; invalid_with_inst(pred_or_func_decl_type,
+ sym_name, maybe(pred_or_func))
+ ; non_matching_with_type_with_inst(sym_name, pred_or_func)
+ .
+
+:- pred equiv_type__build_eqv_map(list(item_and_context), eqv_map, eqv_map,
+ eqv_inst_map, eqv_inst_map).
+:- mode equiv_type__build_eqv_map(in, in, out, in, out) is det.
+
+equiv_type__build_eqv_map([], EqvMap, EqvMap, EqvInstMap, EqvInstMap).
+equiv_type__build_eqv_map([Item - _Context | Items], EqvMap0, EqvMap,
+ EqvInstMap0, EqvInstMap) :-
( Item = type_defn(VarSet, Name, Args, eqv_type(Body), _Cond) ->
list__length(Args, Arity),
map__set(EqvMap0, Name - Arity,
- eqv_type_body(VarSet, Args, Body), EqvMap1)
- ;
+ eqv_type_body(VarSet, Args, Body), EqvMap1),
+ EqvInstMap1 = EqvInstMap0
+ ; Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
+ list__length(Args, Arity),
+ map__set(EqvInstMap0, Name - Arity,
+ eqv_inst_body(VarSet, Args, Body), EqvInstMap1),
EqvMap1 = EqvMap0
+ ;
+ EqvMap1 = EqvMap0,
+ EqvInstMap1 = EqvInstMap0
),
- equiv_type__build_eqv_map(Items, EqvMap1, EqvMap).
+ equiv_type__build_eqv_map(Items, EqvMap1, EqvMap,
+ EqvInstMap1, EqvInstMap).
% The following predicate equiv_type__replace_in_item_list
% performs substititution of equivalence types on a list
@@ -102,110 +134,158 @@
% follow perform substitution of equivalence types on <foo>s.
:- pred equiv_type__replace_in_item_list(module_name, list(item_and_context),
- eqv_map, list(item_and_context), list(item_and_context),
- list(item_and_context), list(item_and_context),
+ eqv_map, eqv_inst_map, list(item_and_context), list(item_and_context),
+ list(eqv_error), list(eqv_error),
maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__replace_in_item_list(in, in, in, in, out,
+:- mode equiv_type__replace_in_item_list(in, in, in, in, in, out,
in, out, in, out) is det.
-equiv_type__replace_in_item_list(_, [], _, Items, Items,
- Circ, Circ, Info, Info).
+equiv_type__replace_in_item_list(_, [], _, _, Items, Items,
+ Errors, Errors, Info, Info).
equiv_type__replace_in_item_list(ModuleName, [ItemAndContext0 | Items0],
- EqvMap, ReplItems0, ReplItems, Circ0, Circ, Info0, Info) :-
+ EqvMap, EqvInstMap, ReplItems0, ReplItems,
+ Errors0, Errors, Info0, Info) :-
ItemAndContext0 = Item0 - Context,
(
- equiv_type__replace_in_item(ModuleName, Item0, EqvMap, Item,
- ContainsCirc, Info0, Info1)
+ equiv_type__replace_in_item(ModuleName, Item0, Context, EqvMap,
+ EqvInstMap, Item, Errors1, Info0, Info1)
->
Info2 = Info1,
ItemAndContext = Item - Context,
- ( ContainsCirc = yes ->
- Circ1 = [ItemAndContext | Circ0]
+
+ % Discard the item if there were any errors.
+ ( Errors1 = [] ->
+ ReplItems1 = [ItemAndContext | ReplItems0]
;
- Circ1 = Circ0
- )
+ ReplItems1 = ReplItems0
+ ),
+
+ Errors2 = Errors1 ++ Errors0
;
ItemAndContext = ItemAndContext0,
- Circ1 = Circ0,
- Info2 = Info0
+ Errors2 = Errors0,
+ Info2 = Info0,
+ ReplItems1 = [ItemAndContext | ReplItems0]
),
- ReplItems1 = [ItemAndContext | ReplItems0],
equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
- ReplItems1, ReplItems, Circ1, Circ, Info2, Info).
+ EqvInstMap, ReplItems1, ReplItems, Errors2, Errors,
+ Info2, Info).
-:- pred equiv_type__replace_in_item(module_name, item, eqv_map, item, bool,
- maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__replace_in_item(in, in, in, out, out, in, out) is semidet.
+:- pred equiv_type__replace_in_item(module_name, item, prog_context,
+ eqv_map, eqv_inst_map, item, list(eqv_error), maybe(recompilation_info),
+ maybe(recompilation_info)).
+:- mode equiv_type__replace_in_item(in, in, in, in, in, out, out,
+ in, out) is semidet.
equiv_type__replace_in_item(ModuleName,
- type_defn(VarSet0, Name, TArgs, TypeDefn0, Cond),
- EqvMap, type_defn(VarSet, Name, TArgs, TypeDefn, Cond),
- ContainsCirc, Info0, Info) :-
+ type_defn(VarSet0, Name, TArgs, TypeDefn0, Cond) @ Item,
+ Context, EqvMap, _EqvInstMap, type_defn(VarSet, Name, TArgs,
+ TypeDefn, Cond), Error, Info0, Info) :-
list__length(TArgs, Arity),
- equiv_type__maybe_record_used_equivalences(ModuleName, Name,
+ equiv_type__maybe_record_expanded_items(ModuleName, Name,
Info0, UsedTypeCtors0),
equiv_type__replace_in_type_defn(Name - Arity, TypeDefn0,
VarSet0, EqvMap, TypeDefn, VarSet, ContainsCirc,
UsedTypeCtors0, UsedTypeCtors),
- equiv_type__finish_recording_used_equivalences(
+ ( ContainsCirc = yes ->
+ Error = [circular_equivalence(Item) - Context]
+ ;
+ Error = []
+ ),
+ equiv_type__finish_recording_expanded_items(
item_id(type_body, Name - Arity), UsedTypeCtors, Info0, Info).
equiv_type__replace_in_item(ModuleName,
pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
- PredName, TypesAndModes0, Det, Cond,
- Purity, ClassContext0),
- EqvMap,
+ PredName, TypesAndModes0, MaybeWithType0,
+ MaybeWithInst0, Det0, Cond, Purity, ClassContext0),
+ Context, EqvMap, EqvInstMap,
pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
- PredName, TypesAndModes, Det, Cond,
- Purity, ClassContext),
- no, Info0, Info) :-
- list__length(TypesAndModes0, Arity),
- equiv_type__maybe_record_used_equivalences(ModuleName, PredName,
- Info0, UsedTypeCtors0),
- equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1,
- UsedTypeCtors0, UsedTypeCtors1),
- equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet, UsedTypeCtors1, UsedTypeCtors),
+ PredName, TypesAndModes, MaybeWithType,
+ MaybeWithInst, Det, Cond, Purity, ClassContext),
+ Errors, Info0, Info) :-
+ equiv_type__maybe_record_expanded_items(ModuleName, PredName,
+ Info0, ExpandedItems0),
+
+ equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
+ EqvInstMap, ClassContext0, ClassContext,
+ TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
+ MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
+ Det0, Det, ExpandedItems0, ExpandedItems, Errors),
+
ItemType = pred_or_func_to_item_type(PredOrFunc),
+ list__length(TypesAndModes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
- equiv_type__finish_recording_used_equivalences(
+ equiv_type__finish_recording_expanded_items(
item_id(ItemType, PredName - OrigArity),
- UsedTypeCtors, Info0, Info).
+ ExpandedItems, Info0, Info).
+
+equiv_type__replace_in_item(ModuleName,
+ pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
+ Modes0, WithInst0, Det0, Cond),
+ Context, _EqvMap, EqvInstMap,
+ pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
+ Modes, WithInst, Det, Cond),
+ Errors, Info0, Info) :-
+ equiv_type__maybe_record_expanded_items(ModuleName, PredName,
+ Info0, ExpandedItems0),
+
+ equiv_type__replace_in_pred_mode(PredName, length(Modes0), Context,
+ mode_decl, EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc,
+ ExtraModes, WithInst0, WithInst, Det0, Det,
+ ExpandedItems0, ExpandedItems, Errors),
+ ( ExtraModes = [] ->
+ Modes = Modes0
+ ;
+ Modes = Modes0 ++ ExtraModes
+ ),
+
+ ( MaybePredOrFunc = yes(PredOrFunc) ->
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ list__length(Modes, Arity),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
+ equiv_type__finish_recording_expanded_items(
+ item_id(ItemType, PredName - OrigArity),
+ ExpandedItems, Info0, Info)
+ ;
+ Info = Info0
+ ).
equiv_type__replace_in_item(ModuleName,
typeclass(Constraints0, ClassName, Vars,
ClassInterface0, VarSet0),
- EqvMap,
+ _Context, EqvMap, EqvInstMap,
typeclass(Constraints, ClassName, Vars,
ClassInterface, VarSet),
- no, Info0, Info) :-
+ Errors, Info0, Info) :-
list__length(Vars, Arity),
- equiv_type__maybe_record_used_equivalences(ModuleName, ClassName,
- Info0, UsedTypeCtors0),
+ equiv_type__maybe_record_expanded_items(ModuleName, ClassName,
+ Info0, ExpandedItems0),
equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
- EqvMap, Constraints, VarSet, UsedTypeCtors0, UsedTypeCtors1),
+ EqvMap, Constraints, VarSet, ExpandedItems0, ExpandedItems1),
(
ClassInterface0 = abstract,
ClassInterface = abstract,
- UsedTypeCtors = UsedTypeCtors1
+ ExpandedItems = ExpandedItems1,
+ Errors = []
;
ClassInterface0 = concrete(Methods0),
equiv_type__replace_in_class_interface(Methods0,
- EqvMap, Methods, UsedTypeCtors1, UsedTypeCtors),
+ EqvMap, EqvInstMap, Methods, [], Errors,
+ ExpandedItems1, ExpandedItems),
ClassInterface = concrete(Methods)
),
- equiv_type__finish_recording_used_equivalences(
+ equiv_type__finish_recording_expanded_items(
item_id(typeclass, ClassName - Arity),
- UsedTypeCtors, Info0, Info).
+ ExpandedItems, Info0, Info).
equiv_type__replace_in_item(ModuleName,
instance(Constraints0, ClassName, Ts0,
InstanceBody, VarSet0, ModName),
- EqvMap,
+ _Context, EqvMap, _EqvInstMap,
instance(Constraints, ClassName, Ts,
InstanceBody, VarSet, ModName),
- no, Info0, Info) :-
+ [], Info0, Info) :-
( (Info0 = no ; ModName = ModuleName) ->
UsedTypeCtors0 = no
;
@@ -216,29 +296,29 @@
equiv_type__replace_in_type_list(Ts0, VarSet1, EqvMap, Ts, VarSet, _,
UsedTypeCtors1, UsedTypeCtors),
list__length(Ts0, Arity),
- equiv_type__finish_recording_used_equivalences(
+ equiv_type__finish_recording_expanded_items(
item_id(typeclass, ClassName - Arity),
UsedTypeCtors, Info0, Info).
equiv_type__replace_in_item(ModuleName,
pragma(type_spec(PredName, B, Arity, D, E,
- Subst0, VarSet0, TypeCtors0)),
- EqvMap,
+ Subst0, VarSet0, ItemIds0)),
+ _Context, EqvMap, _EqvInstMap,
pragma(type_spec(PredName, B, Arity, D, E,
- Subst, VarSet, TypeCtors)),
- no, Info, Info) :-
+ Subst, VarSet, ItemIds)),
+ [], Info, Info) :-
( (Info = no ; PredName = qualified(ModuleName, _)) ->
- UsedTypeCtors0 = no
+ ExpandedItems0 = no
;
- UsedTypeCtors0 = yes(ModuleName - TypeCtors0)
+ ExpandedItems0 = yes(ModuleName - ItemIds0)
),
equiv_type__replace_in_subst(Subst0, VarSet0, EqvMap, Subst, VarSet,
- UsedTypeCtors0, UsedTypeCtors),
+ ExpandedItems0, ExpandedItems),
(
- UsedTypeCtors = no,
- TypeCtors = TypeCtors0
+ ExpandedItems = no,
+ ItemIds = ItemIds0
;
- UsedTypeCtors = yes(_ - TypeCtors)
+ ExpandedItems = yes(_ - ItemIds)
).
:- pred equiv_type__replace_in_type_defn(type_ctor, type_defn, tvarset,
@@ -305,36 +385,56 @@
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_class_interface(list(class_method), eqv_map,
- list(class_method), equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_interface(in, in, out, in, out) is det.
-
-equiv_type__replace_in_class_interface(ClassInterface0, EqvMap,
- ClassInterface, Info0, Info) :-
- list__map_foldl(equiv_type__replace_in_class_method(EqvMap),
- ClassInterface0, ClassInterface, Info0, Info).
-
-:- pred equiv_type__replace_in_class_method(eqv_map, class_method,
- class_method, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_method(in, in, out, in, out) is det.
+:- pred equiv_type__replace_in_class_interface(list(class_method),
+ eqv_map, eqv_inst_map, list(class_method),
+ list(eqv_error), list(eqv_error),
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_interface(in,
+ in, in, out, in, out, in, out) is det.
+
+equiv_type__replace_in_class_interface(ClassInterface0, EqvMap, EqvInstMap,
+ ClassInterface, Errors0, Errors, Info0, Info) :-
+ list__map_foldl2(
+ equiv_type__replace_in_class_method(EqvMap, EqvInstMap),
+ ClassInterface0, ClassInterface, Errors0, Errors, Info0, Info).
-equiv_type__replace_in_class_method(EqvMap,
+:- pred equiv_type__replace_in_class_method(eqv_map, eqv_inst_map,
+ class_method, class_method, list(eqv_error), list(eqv_error),
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_method(in, in, in, out,
+ in, out, in, out) is det.
+
+equiv_type__replace_in_class_method(EqvMap, EqvInstMap,
pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
- PredName, TypesAndModes0, Det, Cond, Purity,
- ClassContext0, Context),
+ PredName, TypesAndModes0, WithType0, WithInst0,
+ Det0, Cond, Purity, ClassContext0, Context),
pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
- PredName, TypesAndModes, Det, Cond, Purity,
- ClassContext, Context),
- Info0, Info) :-
- equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1, Info0, Info1),
- equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet, Info1, Info).
-
-equiv_type__replace_in_class_method(_,
- pred_or_func_mode(A,B,C,D,E,F,G),
- pred_or_func_mode(A,B,C,D,E,F,G),
- Info, Info).
+ PredName, TypesAndModes, WithType, WithInst,
+ Det, Cond, Purity, ClassContext, Context),
+ Errors0, Errors, Info0, Info) :-
+ equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
+ EqvInstMap, ClassContext0, ClassContext,
+ TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
+ WithType0, WithType, WithInst0, WithInst, Det0, Det,
+ Info0, Info, Errors1),
+ Errors = Errors1 ++ Errors0.
+
+equiv_type__replace_in_class_method(_, EqvInstMap,
+ pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
+ Modes0, WithInst0, Det0, Cond, Context),
+ pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
+ Modes, WithInst, Det, Cond, Context),
+ Errors0, Errors, Info0, Info) :-
+ equiv_type__replace_in_pred_mode(PredName, length(Modes0), Context,
+ mode_decl, EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc,
+ ExtraModes, WithInst0, WithInst, Det0, Det, Info0, Info,
+ Errors1),
+ ( ExtraModes = [] ->
+ Modes = Modes0
+ ;
+ Modes = Modes0 ++ ExtraModes
+ ),
+ Errors = Errors1 ++ Errors0.
%-----------------------------------------------------------------------------%
@@ -510,8 +610,8 @@
Circ0 = no,
Circ1 = no
->
- map_maybe(equiv_type__record_used_type(EqvTypeCtor),
- Info1, Info2),
+ equiv_type__record_expanded_item(
+ item_id(type, EqvTypeCtor), Info1, Info2),
term__term_list_to_var_list(Args, ArgVars),
term__substitute_corresponding(ArgVars, TArgs1,
Body, Type1),
@@ -531,21 +631,197 @@
Circ = no
).
-:- pred equiv_type__record_used_type(type_ctor,
- pair(module_name, set(type_ctor)), pair(module_name, set(type_ctor))).
-:- mode equiv_type__record_used_type(in, in, out) is det.
-
-equiv_type__record_used_type(TypeCtor, UsedTypes0, UsedTypes) :-
- UsedTypes0 = ModuleName - Types0,
- ( TypeCtor = qualified(ModuleName, _) - _ ->
- % We don't need to record local types.
- UsedTypes = UsedTypes0
+:- pred equiv_type__replace_in_inst(inst, eqv_inst_map, inst,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_inst(in, in, out, in, out) is det.
+
+equiv_type__replace_in_inst(Inst0, EqvInstMap, Inst, Info0, Info) :-
+ equiv_type__replace_in_inst(Inst0, EqvInstMap, set__init,
+ Inst, Info0, Info).
+
+:- pred equiv_type__replace_in_inst(inst, eqv_inst_map,
+ set(inst_id), inst, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_inst(in, in, in, out, in, out) is det.
+
+equiv_type__replace_in_inst(Inst0, EqvInstMap, ExpandedInstIds,
+ Inst, Info0, Info) :-
+ (
+ Inst0 = defined_inst(user_inst(SymName, ArgInsts))
+ ->
+ InstId = SymName - length(ArgInsts),
+ (
+ set__member(InstId, ExpandedInstIds)
+ ->
+ Info = Info0,
+ Inst = Inst0
+ ;
+ map__search(EqvInstMap, InstId,
+ eqv_inst_body(_, EqvInstParams, EqvInst))
+ ->
+ inst_substitute_arg_list(EqvInst, EqvInstParams,
+ ArgInsts, Inst1),
+ equiv_type__record_expanded_item(item_id(inst, InstId),
+ Info0, Info1),
+ equiv_type__replace_in_inst(Inst1, EqvInstMap,
+ set__insert(ExpandedInstIds, InstId), Inst,
+ Info1, Info)
+ ;
+ Info = Info0,
+ Inst = Inst0
+ )
;
- UsedTypes = ModuleName - set__insert(Types0, TypeCtor)
+ Info = Info0,
+ Inst = Inst0
).
%-----------------------------------------------------------------------------%
+:- pred equiv_type__replace_in_pred_type(sym_name, pred_or_func, prog_context,
+ eqv_map, eqv_inst_map, class_constraints, class_constraints,
+ list(type_and_mode), list(type_and_mode), tvarset, tvarset,
+ maybe(type), maybe(type), maybe(inst), maybe(inst),
+ maybe(determinism), maybe(determinism),
+ equiv_type_info, equiv_type_info, list(eqv_error)).
+:- mode equiv_type__replace_in_pred_type(in, in, in, in, in, in, out, in, out,
+ in, out, in, out, in, out, in, out, in, out, out) is det.
+
+equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
+ EqvInstMap, ClassContext0, ClassContext,
+ TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
+ MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
+ Det0, Det, Info0, Info, Errors) :-
+ equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
+ EqvMap, ClassContext, TypeVarSet1, Info0, Info1),
+ equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
+ TypesAndModes1, TypeVarSet2, Info1, Info2),
+
+ (
+ MaybeWithType0 = yes(WithType0),
+ equiv_type__replace_in_type(WithType0, TypeVarSet2,
+ EqvMap, WithType, TypeVarSet,
+ Info2, Info3),
+ ( type_is_higher_order(WithType, PredOrFunc, _, ExtraTypes0) ->
+ ExtraTypes = ExtraTypes0,
+ Errors0 = []
+ ;
+ ExtraTypes = [],
+ Errors0 = [invalid_with_type(PredName, PredOrFunc)
+ - Context]
+ )
+ ;
+ MaybeWithType0 = no,
+ Info3 = Info2,
+ ExtraTypes = [],
+ TypeVarSet = TypeVarSet2,
+ Errors0 = []
+ ),
+
+ equiv_type__replace_in_pred_mode(PredName, length(TypesAndModes0),
+ Context, type_decl, EqvInstMap, yes(PredOrFunc), _, ExtraModes,
+ MaybeWithInst0, _, Det0, Det, Info3, Info4, ModeErrors),
+ Errors1 = Errors0 ++ ModeErrors,
+
+ ( Errors1 \= [] ->
+ Errors = Errors1,
+ ExtraTypesAndModes = []
+ ; ExtraModes = [] ->
+ Errors = Errors1,
+ ExtraTypesAndModes = list__map((func(Type) = type_only(Type)),
+ ExtraTypes)
+ ; length(ExtraTypes) `with_type` int = length(ExtraModes) ->
+ Errors = Errors1,
+ assoc_list__from_corresponding_lists(ExtraTypes,
+ ExtraModes, ExtraTypesModes),
+ ExtraTypesAndModes = list__map(
+ (func(Type - Mode) = type_and_mode(Type, Mode)),
+ ExtraTypesModes)
+ ;
+ Errors = [non_matching_with_type_with_inst(PredName,
+ PredOrFunc) - Context | Errors1],
+ ExtraTypesAndModes = []
+ ),
+
+ ( Errors = [] ->
+ MaybeWithType = no,
+ MaybeWithInst = no
+ ;
+ % Leave the `with_type` and `with_inst` fields so
+ % that make_hlds knows to discard this declaration.
+ MaybeWithType = MaybeWithType0,
+ MaybeWithInst = MaybeWithInst0
+ ),
+
+ ( ExtraTypesAndModes = [] ->
+ Info = Info4,
+ TypesAndModes = TypesAndModes1
+ ;
+ OrigItemId = item_id(pred_or_func_to_item_type(PredOrFunc),
+ PredName - list__length(TypesAndModes0)),
+ equiv_type__record_expanded_item(OrigItemId,
+ Info4, Info),
+ TypesAndModes = TypesAndModes1 ++ ExtraTypesAndModes
+ ).
+
+:- pred equiv_type__replace_in_pred_mode(sym_name, arity, prog_context,
+ pred_or_func_decl_type, eqv_inst_map, maybe(pred_or_func),
+ maybe(pred_or_func), list(mode), maybe(inst),
+ maybe(inst), maybe(determinism), maybe(determinism),
+ equiv_type_info, equiv_type_info, list(eqv_error)).
+:- mode equiv_type__replace_in_pred_mode(in, in, in, in, in, in, out, out,
+ in, out, in, out, in, out, out) is det.
+
+equiv_type__replace_in_pred_mode(PredName, OrigArity, Context, DeclType,
+ EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc, ExtraModes,
+ MaybeWithInst0, MaybeWithInst, Det0, Det,
+ Info0, Info, Errors) :-
+ (
+ MaybeWithInst0 = yes(WithInst0),
+ equiv_type__replace_in_inst(WithInst0, EqvInstMap, WithInst,
+ Info0, Info1),
+ (
+ WithInst = ground(_, higher_order(pred_inst_info(
+ PredOrFunc, ExtraModes0, Det1))),
+ ( MaybePredOrFunc0 = no
+ ; MaybePredOrFunc0 = yes(PredOrFunc)
+ )
+ ->
+ Det = yes(Det1),
+ MaybeWithInst = no,
+ MaybePredOrFunc = yes(PredOrFunc),
+ Errors = [],
+ ExtraModes = ExtraModes0,
+ (
+ MaybePredOrFunc0 = no,
+ RecordedPredOrFunc = predicate
+ ;
+ MaybePredOrFunc0 = yes(RecordedPredOrFunc)
+ ),
+ OrigItemId = item_id(
+ pred_or_func_to_item_type(RecordedPredOrFunc),
+ PredName - OrigArity),
+ equiv_type__record_expanded_item(OrigItemId,
+ Info1, Info)
+ ;
+ ExtraModes = [],
+ MaybePredOrFunc = MaybePredOrFunc0,
+ % Leave the `with_inst` fields so that make_hlds
+ % knows to discard this declaration.
+ MaybeWithInst = MaybeWithInst0,
+ Info = Info1,
+ Det = Det0,
+ Errors = [invalid_with_inst(DeclType, PredName,
+ MaybePredOrFunc0) - Context]
+ )
+ ;
+ MaybeWithInst0 = no,
+ MaybeWithInst = MaybeWithInst0,
+ MaybePredOrFunc = MaybePredOrFunc0,
+ Info = Info0,
+ Errors = [],
+ Det = Det0,
+ ExtraModes = []
+ ).
+
:- pred equiv_type__replace_in_tms(list(type_and_mode), tvarset, eqv_map,
list(type_and_mode), tvarset, equiv_type_info, equiv_type_info).
:- mode equiv_type__replace_in_tms(in, in, in, out, out, in, out) is det.
@@ -575,14 +851,14 @@
%-----------------------------------------------------------------------------%
-:- type equiv_type_info == maybe(pair(module_name, set(type_ctor))).
+:- type equiv_type_info == maybe(pair(module_name, set(item_id))).
-:- pred equiv_type__maybe_record_used_equivalences(module_name, sym_name,
+:- pred equiv_type__maybe_record_expanded_items(module_name, sym_name,
maybe(recompilation_info), equiv_type_info).
-:- mode equiv_type__maybe_record_used_equivalences(in, in, in, out) is det.
+:- mode equiv_type__maybe_record_expanded_items(in, in, in, out) is det.
-equiv_type__maybe_record_used_equivalences(_, _, no, no).
-equiv_type__maybe_record_used_equivalences(ModuleName, SymName,
+equiv_type__maybe_record_expanded_items(_, _, no, no).
+equiv_type__maybe_record_expanded_items(ModuleName, SymName,
yes(_), MaybeInfo) :-
( SymName = qualified(ModuleName, _) ->
MaybeInfo = no
@@ -590,42 +866,99 @@
MaybeInfo = yes(ModuleName - set__init)
).
-:- pred equiv_type__finish_recording_used_equivalences(item_id,
+:- pred equiv_type__record_expanded_item(item_id,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__record_expanded_item(in, in, out) is det.
+
+equiv_type__record_expanded_item(Item, Info0, Info) :-
+ map_maybe(equiv_type__record_expanded_item_2(Item), Info0, Info).
+
+:- pred equiv_type__record_expanded_item_2(item_id,
+ pair(module_name, set(item_id)),
+ pair(module_name, set(item_id))).
+:- mode equiv_type__record_expanded_item_2(in, in, out) is det.
+
+equiv_type__record_expanded_item_2(ItemId, ModuleName - Items0,
+ ModuleName - Items) :-
+ ItemId = item_id(_, ItemName),
+ ( ItemName = qualified(ModuleName, _) - _ ->
+ % We don't need to record local types.
+ Items = Items0
+ ;
+ Items = set__insert(Items0, ItemId)
+ ).
+
+:- pred equiv_type__finish_recording_expanded_items(item_id,
equiv_type_info, maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__finish_recording_used_equivalences(in, in, in, out) is det.
+:- mode equiv_type__finish_recording_expanded_items(in, in, in, out) is det.
-equiv_type__finish_recording_used_equivalences(_, no, no, no).
-equiv_type__finish_recording_used_equivalences(_, no, yes(Info), yes(Info)).
-equiv_type__finish_recording_used_equivalences(_, yes(_), no, _) :-
- error("equiv_type__finish_recording_used_equivalences").
-equiv_type__finish_recording_used_equivalences(Item, yes(_ - UsedTypeCtors),
+equiv_type__finish_recording_expanded_items(_, no, no, no).
+equiv_type__finish_recording_expanded_items(_, no, yes(Info), yes(Info)).
+equiv_type__finish_recording_expanded_items(_, yes(_), no, _) :-
+ error("equiv_type__finish_recording_expanded_items").
+equiv_type__finish_recording_expanded_items(Item, yes(_ - ExpandedItems),
yes(Info0), yes(Info)) :-
- recompilation__record_used_equivalence_types(Item, UsedTypeCtors,
- Info0, Info).
+ recompilation__record_expanded_items(Item, ExpandedItems, Info0, Info).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__report_circular_types(list(item_and_context)::in,
+:- pred equiv_type__report_error(eqv_error::in,
io__state::di, io__state::uo) is det.
-equiv_type__report_circular_types([]) --> [].
-equiv_type__report_circular_types([Circ | Circs]) -->
+equiv_type__report_error(circular_equivalence(Item) - Context) -->
(
- { Circ = type_defn(_, SymName, Params,
- TypeDefn, _) - Context },
+ { Item = type_defn(_, SymName, Params,
+ TypeDefn, _) },
{ TypeDefn = eqv_type(_) }
->
- { list__length(Params, Arity) },
- prog_out__write_context(Context),
- io__write_string("Error: circular equivalence type `"),
- prog_out__write_sym_name(SymName),
- io__write_string("'/"),
- io__write_int(Arity),
- io__write_string(".\n"),
- equiv_type__report_circular_types(Circs)
+ { Pieces = append_punctuation([
+ words("Error: circular equivalence type"),
+ fixed(error_util__describe_sym_name_and_arity(
+ SymName / length(Params)))
+ ], '.') },
+ error_util__write_error_pieces(Context, 0, Pieces)
;
- { error("equiv_type__report_circular_types: invalid item") }
+ { error("equiv_type__report_error: invalid item") }
).
+equiv_type__report_error(invalid_with_type(SymName, PredOrFunc) - Context) -->
+ { FirstLine = append_punctuation([words("In type declaration for"),
+ words(error_util__pred_or_func_to_string(PredOrFunc)),
+ fixed(error_util__describe_sym_name(SymName))
+ ], ':') },
+ { Rest = [nl, words("error: expected higher order"),
+ words(error_util__pred_or_func_to_string(PredOrFunc)),
+ words("type after `with_type`.")] },
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
+equiv_type__report_error(invalid_with_inst(DeclType,
+ SymName, MaybePredOrFunc) - Context) -->
+ { DeclType = type_decl, DeclStr = "declaration"
+ ; DeclType = mode_decl, DeclStr = "mode declaration"
+ },
+ {
+ MaybePredOrFunc = no, PredOrFuncStr = ""
+ ;
+ MaybePredOrFunc = yes(PredOrFunc),
+ PredOrFuncStr = error_util__pred_or_func_to_string(PredOrFunc)
+ },
+ { FirstLine = append_punctuation([words("In"), words(DeclStr),
+ words("for"),
+ words(PredOrFuncStr),
+ fixed(error_util__describe_sym_name(SymName))
+ ], ':') },
+ { Rest = [nl, words("error: expected higher order "),
+ words(PredOrFuncStr),
+ words("inst after `with_inst`.")] },
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
+equiv_type__report_error(non_matching_with_type_with_inst(SymName,
+ PredOrFunc) - Context) -->
+ { FirstLine = append_punctuation([words("In type declaration for"),
+ words(error_util__pred_or_func_to_string(PredOrFunc)),
+ fixed(error_util__describe_sym_name(SymName))
+ ], ':') },
+ { Rest = [nl,
+ words("error: the `with_type` and `with_inst`"),
+ words("annotations are incompatible.")] },
+ error_util__write_error_pieces(Context, 0, FirstLine ++ Rest).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.16
diff -u -u -r1.16 error_util.m
--- compiler/error_util.m 22 Feb 2002 01:20:40 -0000 1.16
+++ compiler/error_util.m 24 Feb 2002 09:52:55 -0000
@@ -99,6 +99,8 @@
:- func error_util__describe_sym_name_and_arity(sym_name_and_arity) = string.
+:- func error_util__pred_or_func_to_string(pred_or_func) = string.
+
% Append a punctuation character to a message, avoiding unwanted
% line splitting between the message and the punctuation.
:- func error_util__append_punctuation(list(format_component), char) =
@@ -406,15 +408,8 @@
pred_info_name(PredInfo, PredName),
pred_info_arity(PredInfo, Arity),
pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
- (
- PredOrFunc = predicate,
- PredOrFuncPart = "predicate",
- OrigArity = Arity
- ;
- PredOrFunc = function,
- PredOrFuncPart = "function",
- OrigArity is Arity - 1
- ),
+ PredOrFuncPart = pred_or_func_to_string(PredOrFunc),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
(
pred_info_get_goal_type(PredInfo, promise(PromiseType))
->
@@ -472,6 +467,8 @@
string__append_list(["`", SymNameString, "'"]) :-
sym_name_to_string(SymName, SymNameString).
+error_util__pred_or_func_to_string(predicate) = "predicate".
+error_util__pred_or_func_to_string(function) = "function".
error_util__append_punctuation([], _) = _ :-
error(
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.402
diff -u -u -r1.402 make_hlds.m
--- compiler/make_hlds.m 7 Mar 2002 08:29:58 -0000 1.402
+++ compiler/make_hlds.m 7 Mar 2002 14:17:26 -0000
@@ -234,8 +234,8 @@
Cond, Context, Status, Module).
add_item_decl_pass_1(pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond,
- Purity, ClassContext),
+ PredOrFunc, PredName, TypesAndModes, _WithType, _WithInst,
+ MaybeDet, Cond, Purity, ClassContext),
Context, Status, Module0, Status, Module) -->
{ init_markers(Markers) },
module_add_pred_or_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
@@ -243,13 +243,21 @@
Purity, ClassContext, Markers, Context, Status, _, Module).
add_item_decl_pass_1(
- pred_or_func_mode(VarSet, PredOrFunc, PredName,
- Modes, MaybeDet, Cond),
+ pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
+ Modes, _WithInst, MaybeDet, Cond),
Context, Status, Module0, Status, Module) -->
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = no },
- module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, Cond,
- ImportStatus, Context, PredOrFunc, IsClassMethod, _, Module).
+ ( { MaybePredOrFunc = yes(PredOrFunc) } ->
+ { Status = item_status(ImportStatus, _) },
+ { IsClassMethod = no },
+ module_add_mode(Module0, VarSet, PredName, Modes,
+ MaybeDet, Cond, ImportStatus, Context, PredOrFunc,
+ IsClassMethod, _, Module)
+ ;
+ % equiv_type.m should have either set the pred_or_func
+ % or removed the item from the list.
+ { error(
+ "add_item_decl_pass_1: no pred_or_func on mode declaration") }
+ ).
add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module) --> [].
@@ -581,7 +589,8 @@
add_item_decl_pass_2(
pred_or_func(_TypeVarSet, _InstVarSet, _ExistQVars,
- PredOrFunc, SymName, TypesAndModes, _MaybeDet,
+ PredOrFunc, SymName, TypesAndModes,
+ _WithType, _WithInst, _MaybeDet,
_Cond, _Purity, _ClassContext),
_Context, Status, Module0, Status, Module) -->
%
@@ -609,7 +618,6 @@
error("make_hlds.m: can't find func declaration")
)
}.
-
add_item_decl_pass_2(promise(_, _, _, _), _, Status, Module, Status, Module)
--> [].
add_item_decl_pass_2(clause(_, _, _, _, _), _, Status, Module, Status,
@@ -618,7 +626,7 @@
Status, Module) --> [].
add_item_decl_pass_2(mode_defn(_, _, _, _, _), _, Status, Module,
Status, Module) --> [].
-add_item_decl_pass_2(pred_or_func_mode(_, _, _, _, _, _), _,
+add_item_decl_pass_2(pred_or_func_mode(_, _, _, _, _, _, _), _,
Status, Module, Status, Module) --> [].
add_item_decl_pass_2(nothing(_), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(typeclass(_, _, _, _, _)
@@ -704,7 +712,7 @@
Module, Module, Info, Info) --> [].
add_item_clause(
pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes,
- _, _, _, _),
+ _WithType, _WithInst, _, _, _, _),
Status, Status, Context, Module, Module, Info, Info) -->
(
{ PredOrFunc = predicate }
@@ -716,7 +724,7 @@
Status, Context, Module)
).
-add_item_clause(pred_or_func_mode(_, _, _, _, _, _), Status, Status, _,
+add_item_clause(pred_or_func_mode(_, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(module_defn(_, Defn), Status0, Status, _,
Module0, Module, Info0, Info) -->
@@ -986,7 +994,7 @@
add_pragma_type_spec_2(Pragma0, Context, PredId,
transform_info(ModuleInfo0, Info0), TransformInfo) -->
{ Pragma0 = type_spec(SymName, SpecName, Arity, _,
- MaybeModes, Subst, TVarSet0, UsedEquivTypes) },
+ MaybeModes, Subst, TVarSet0, ExpandedItems) },
{ module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
TVarSet, Types, ExistQVars, ClassContext, SubstOk,
@@ -1103,7 +1111,7 @@
Pragma = type_spec(SymName, SpecName, Arity,
yes(PredOrFunc), MaybeModes,
map__to_assoc_list(RenamedSubst), TVarSet,
- UsedEquivTypes),
+ ExpandedItems),
multi_map__set(PragmaMap0, PredId, Pragma, PragmaMap),
TypeSpecInfo = type_spec_info(ProcsToSpec,
ForceVersions, SpecMap, PragmaMap),
@@ -1114,9 +1122,9 @@
( status_is_imported(Status, yes) ->
ItemType = pred_or_func_to_item_type(PredOrFunc),
apply_to_recompilation_info(
- recompilation__record_used_equivalence_types(
+ recompilation__record_expanded_items(
item_id(ItemType, SymName - Arity),
- UsedEquivTypes),
+ ExpandedItems),
TransformInfo1, TransformInfo)
;
TransformInfo = TransformInfo1
@@ -2557,8 +2565,9 @@
Module0, Module) -->
(
{ Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeDet,
- Cond, Purity, ClassContext, Context) },
+ PredOrFunc, PredName, TypesAndModes, _WithType,
+ _WithInst, MaybeDet, Cond, Purity, ClassContext,
+ Context) },
{ term__var_list_to_term_list(Vars, VarTerms) },
{ ClassContext = constraints(UnivCnstrs, ExistCnstrs) },
{ NewUnivCnstrs = [constraint(Name, VarTerms) | UnivCnstrs] },
@@ -2570,14 +2579,22 @@
MaybeDet, Cond, Purity, NewClassContext, Markers,
Context, Status, MaybePredIdProcId, Module)
;
- { Method = pred_or_func_mode(VarSet, PredOrFunc, PredName,
- Modes, MaybeDet, Cond, Context) },
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = yes },
- module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet,
- Cond, ImportStatus, Context, PredOrFunc,
- IsClassMethod, PredIdProcId, Module),
- { MaybePredIdProcId = yes(PredIdProcId) }
+ { Method = pred_or_func_mode(VarSet, MaybePredOrFunc, PredName,
+ Modes, _WithInst, MaybeDet, Cond, Context) },
+ ( { MaybePredOrFunc = yes(PredOrFunc) } ->
+ { Status = item_status(ImportStatus, _) },
+ { IsClassMethod = yes },
+ module_add_mode(Module0, VarSet, PredName, Modes,
+ MaybeDet, Cond, ImportStatus, Context,
+ PredOrFunc, IsClassMethod, PredIdProcId,
+ Module),
+ { MaybePredIdProcId = yes(PredIdProcId) }
+ ;
+ % equiv_type.m should have either set the
+ % pred_or_func or removed the item from the list.
+ { error(
+ "module_add_class_method: no pred_or_func on mode declaration") }
+ )
).
% Go through the list of class methods, looking for
@@ -2594,7 +2611,7 @@
check_method_modes([M|Ms], PredProcIds0, PredProcIds, Module0, Module) -->
(
{ M = pred_or_func(_, _, _, PorF, QualName, TypesAndModes,
- _, _, _, _, _) }
+ _WithType, _WithInst, _, _, _, _, _) }
->
{ QualName = qualified(ModuleName0, Name0) ->
ModuleName = ModuleName0,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.206
diff -u -u -r1.206 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 26 Feb 2002 02:45:45 -0000 1.206
+++ compiler/mercury_to_mercury.m 11 Mar 2002 04:05:08 -0000
@@ -415,39 +415,51 @@
mercury_output_item(UnqualifiedItemNames,
pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName0, TypesAndModes, Det,
+ PredOrFunc, PredName0, TypesAndModes,
+ WithType, WithInst, Det,
_Cond, Purity, ClassContext),
Context) -->
{ maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName) },
maybe_output_line_number(Context),
(
- { PredOrFunc = predicate },
- mercury_format_pred_decl(TypeVarSet, InstVarSet, ExistQVars,
- PredName, TypesAndModes, Det, Purity,
- ClassContext, Context,
+ (
+ { PredOrFunc = predicate }
+ ;
+ { PredOrFunc = function },
+ { WithType = yes(_) }
+ )
+ ->
+ mercury_format_pred_or_func_decl(PredOrFunc, TypeVarSet,
+ InstVarSet, ExistQVars, PredName, TypesAndModes,
+ WithType, WithInst, Det, Purity, ClassContext, Context,
":- ", ".\n", ".\n")
;
- { PredOrFunc = function },
{ pred_args_to_func_args(TypesAndModes, FuncTypesAndModes,
RetTypeAndMode) },
mercury_format_func_decl(TypeVarSet, InstVarSet, ExistQVars,
- PredName, FuncTypesAndModes, RetTypeAndMode,
- Det, Purity, ClassContext, Context,
- ":- ", ".\n", ".\n")
+ PredName, FuncTypesAndModes, RetTypeAndMode, Det,
+ Purity, ClassContext, Context, ":- ", ".\n", ".\n")
).
mercury_output_item(UnqualifiedItemNames,
pred_or_func_mode(VarSet, PredOrFunc, PredName0,
- Modes, MaybeDet, _Cond),
+ Modes, WithInst, MaybeDet, _Cond),
Context) -->
{ maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName) },
maybe_output_line_number(Context),
(
- { PredOrFunc = predicate },
+ {
+ PredOrFunc = no
+ ;
+ PredOrFunc = yes(predicate)
+ ;
+ PredOrFunc = yes(function),
+ WithInst = yes(_)
+ }
+ ->
mercury_output_pred_mode_decl(VarSet, PredName, Modes,
- MaybeDet, Context)
+ WithInst, MaybeDet, Context)
;
- { PredOrFunc = function },
{ pred_args_to_func_args(Modes, FuncModes, RetMode) },
mercury_output_func_mode_decl(VarSet, PredName,
FuncModes, RetMode, MaybeDet, Context)
@@ -727,41 +739,56 @@
io__write_string("\t"),
(
{ Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, Name0, TypesAndModes, Detism, _Condition,
- Purity, ClassContext, Context) },
+ PredOrFunc, Name0, TypesAndModes, WithType, WithInst,
+ Detism, _Condition, Purity, ClassContext, Context) },
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
{ unqualify_name(Name0, Name) },
(
- { PredOrFunc = predicate },
- mercury_format_pred_decl(TypeVarSet, InstVarSet,
- ExistQVars, unqualified(Name), TypesAndModes,
- Detism, Purity, ClassContext, Context,
- "", ",\n\t", "")
+ (
+ { PredOrFunc = predicate }
+ ;
+ { PredOrFunc = function },
+ { WithType = yes(_) }
+ )
+ ->
+ mercury_format_pred_or_func_decl(PredOrFunc,
+ TypeVarSet, InstVarSet, ExistQVars,
+ unqualified(Name), TypesAndModes,
+ WithType, WithInst, Detism, Purity,
+ ClassContext, Context, "", ",\n\t", "")
;
- { PredOrFunc = function },
{ pred_args_to_func_args(TypesAndModes,
FuncTypesAndModes, RetTypeAndMode) },
mercury_format_func_decl(TypeVarSet, InstVarSet,
ExistQVars, unqualified(Name),
- FuncTypesAndModes, RetTypeAndMode, Detism,
- Purity, ClassContext, Context, "", ",\n\t", "")
+ FuncTypesAndModes, RetTypeAndMode,
+ Detism, Purity, ClassContext, Context,
+ "", ",\n\t", "")
)
;
{ Method = pred_or_func_mode(VarSet, PredOrFunc,
- Name0, Modes, Detism, _Condition, Context) },
+ Name0, Modes, WithInst,
+ Detism, _Condition, Context) },
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
{ unqualify_name(Name0, Name) },
(
- { PredOrFunc = predicate },
- mercury_format_pred_mode_decl_2(VarSet,
+ (
+ { PredOrFunc = no }
+ ;
+ { PredOrFunc = yes(predicate) }
+ ;
+ { PredOrFunc = yes(function) },
+ { WithInst = yes(_) }
+ )
+ ->
+ mercury_format_pred_or_func_mode_decl_2(VarSet,
unqualified(Name), Modes,
- Detism, Context, "", "")
+ WithInst, Detism, Context, "", "")
;
- { PredOrFunc = function },
{ pred_args_to_func_args(Modes, FuncModes, RetMode) },
mercury_format_func_mode_decl_2(VarSet,
unqualified(Name), FuncModes, RetMode,
@@ -1688,61 +1715,71 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_format_pred_decl(tvarset::in, inst_varset::in, existq_tvars::in,
- sym_name::in, list(type_and_mode)::in, maybe(determinism)::in,
- purity::in, class_constraints::in, prog_context::in,
- string::in, string::in, string::in, U::di, U::uo) is det <= output(U).
-
-mercury_format_pred_decl(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Purity, ClassContext, Context,
- StartString, Separator, Terminator) -->
+:- pred mercury_format_pred_or_func_decl(pred_or_func::in, tvarset::in,
+ inst_varset::in, existq_tvars::in, sym_name::in,
+ list(type_and_mode)::in, maybe(type)::in, maybe(inst)::in,
+ maybe(determinism)::in, purity::in, class_constraints::in,
+ prog_context::in, string::in, string::in,
+ string::in, U::di, U::uo) is det <= output(U).
+
+mercury_format_pred_or_func_decl(PredOrFunc, TypeVarSet, InstVarSet,
+ ExistQVars, PredName, TypesAndModes, WithType, WithInst,
+ MaybeDet, Purity, ClassContext, Context, StartString,
+ Separator, Terminator) -->
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
(
{ MaybeModes = yes(Modes) },
- { Modes \= [] }
+ { Modes \= []
+ ; WithInst = yes(_)
+ }
->
{ AppendVarnums = no },
- mercury_format_pred_type_2(TypeVarSet, ExistQVars, PredName,
- Types, MaybeDet, Purity, ClassContext, Context,
- AppendVarnums, StartString, Separator),
- mercury_format_pred_mode_decl_2(InstVarSet, PredName, Modes,
- MaybeDet, Context, StartString, Terminator)
+ mercury_format_pred_or_func_type_2(PredOrFunc, TypeVarSet,
+ ExistQVars, PredName, Types, WithType, MaybeDet,
+ Purity, ClassContext, Context, AppendVarnums,
+ StartString, Separator),
+ mercury_format_pred_or_func_mode_decl_2(InstVarSet,
+ PredName, Modes, WithInst, MaybeDet, Context,
+ StartString, Terminator)
;
{ AppendVarnums = no },
- mercury_format_pred_type_2(TypeVarSet, ExistQVars, PredName,
- Types, MaybeDet, Purity, ClassContext, Context,
- AppendVarnums, StartString, Terminator)
+ mercury_format_pred_or_func_type_2(PredOrFunc, TypeVarSet,
+ ExistQVars, PredName, Types, WithType, MaybeDet,
+ Purity, ClassContext, Context, AppendVarnums,
+ StartString, Terminator)
).
mercury_output_pred_type(VarSet, ExistQVars, PredName, Types, MaybeDet, Purity,
ClassContext, Context, AppendVarnums) -->
- mercury_format_pred_type(VarSet, ExistQVars, PredName, Types, MaybeDet,
- Purity, ClassContext, Context, AppendVarnums).
+ mercury_format_pred_type(VarSet, ExistQVars, PredName, Types,
+ no, MaybeDet, Purity, ClassContext, Context, AppendVarnums).
mercury_pred_type_to_string(VarSet, ExistQVars, PredName, Types, MaybeDet,
Purity, ClassContext, Context, AppendVarnums) = String :-
- mercury_format_pred_type(VarSet, ExistQVars, PredName, Types, MaybeDet,
- Purity, ClassContext, Context, AppendVarnums, "", String).
+ mercury_format_pred_type(VarSet, ExistQVars, PredName, Types,
+ no, MaybeDet, Purity, ClassContext, Context,
+ AppendVarnums, "", String).
:- pred mercury_format_pred_type(tvarset::in, existq_tvars::in, sym_name::in,
- list(type)::in, maybe(determinism)::in, purity::in,
+ list(type)::in, maybe(type)::in, maybe(determinism)::in, purity::in,
class_constraints::in, prog_context::in, bool::in, U::di, U::uo)
is det <= output(U).
-mercury_format_pred_type(VarSet, ExistQVars, PredName, Types, MaybeDet, Purity,
- ClassContext, Context, AppendVarnums) -->
- mercury_format_pred_type_2(VarSet, ExistQVars, PredName, Types,
- MaybeDet, Purity, ClassContext, Context, AppendVarnums,
- ":- ", ".\n").
-
-:- pred mercury_format_pred_type_2(tvarset::in, existq_tvars::in, sym_name::in,
- list(type)::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, bool::in,
- string::in, string::in, U::di, U::uo) is det <= output(U).
+mercury_format_pred_type(VarSet, ExistQVars, PredName, Types, WithType,
+ MaybeDet, Purity, ClassContext, Context, AppendVarnums) -->
+ mercury_format_pred_or_func_type_2(predicate, VarSet, ExistQVars,
+ PredName, Types, WithType, MaybeDet, Purity, ClassContext,
+ Context, AppendVarnums, ":- ", ".\n").
+
+:- pred mercury_format_pred_or_func_type_2(pred_or_func::in, tvarset::in,
+ existq_tvars::in, sym_name::in, list(type)::in, maybe(type)::in,
+ maybe(determinism)::in, purity::in, class_constraints::in,
+ prog_context::in, bool::in, string::in, string::in,
+ U::di, U::uo) is det <= output(U).
-mercury_format_pred_type_2(VarSet, ExistQVars, PredName, Types, MaybeDet,
- Purity, ClassContext, _Context, AppendVarnums,
- StartString, Separator) -->
+mercury_format_pred_or_func_type_2(PredOrFunc, VarSet, ExistQVars, PredName,
+ Types, MaybeWithType, MaybeDet, Purity, ClassContext, _Context,
+ AppendVarnums, StartString, Separator) -->
add_string(StartString),
mercury_format_quantifier(VarSet, AppendVarnums, ExistQVars),
( { ExistQVars = [], ClassContext = constraints(_, []) } ->
@@ -1751,7 +1788,15 @@
add_string("(")
),
add_purity_prefix(Purity),
- add_string("pred "),
+
+ (
+ { PredOrFunc = predicate },
+ add_string("pred ")
+ ;
+ { PredOrFunc = function },
+ add_string("func ")
+ ),
+
(
{ Types = [Type | Rest] }
->
@@ -1790,6 +1835,14 @@
;
[]
),
+ (
+ { MaybeWithType = yes(WithType) },
+ add_string(" `with_type` ("),
+ mercury_format_term(WithType, VarSet, AppendVarnums),
+ add_string(")")
+ ;
+ { MaybeWithType = no }
+ ),
add_string(Separator).
%-----------------------------------------------------------------------------%
@@ -1810,16 +1863,19 @@
{ MaybeRetMode = yes(RetMode) }
->
{ AppendVarnums = no },
- mercury_format_func_type_2(TypeVarSet, ExistQVars, FuncName,
- Types, RetType, no, Purity, ClassContext,
- Context, AppendVarnums, StartString, Separator),
- mercury_format_func_mode_decl_2(InstVarSet, FuncName, Modes,
- RetMode, MaybeDet, Context, StartString, Terminator)
+ mercury_format_func_type_2(TypeVarSet, ExistQVars,
+ FuncName, Types, RetType, no, Purity,
+ ClassContext, Context, AppendVarnums,
+ StartString, Separator),
+ mercury_format_func_mode_decl_2(InstVarSet, FuncName,
+ Modes, RetMode, MaybeDet, Context, StartString,
+ Terminator)
;
{ AppendVarnums = no },
- mercury_format_func_type_2(TypeVarSet, ExistQVars, FuncName,
- Types, RetType, MaybeDet, Purity, ClassContext,
- Context, AppendVarnums, StartString, Terminator)
+ mercury_format_func_type_2(TypeVarSet, ExistQVars,
+ FuncName, Types, RetType, MaybeDet, Purity,
+ ClassContext, Context, AppendVarnums,
+ StartString, Terminator)
).
mercury_output_func_type(VarSet, ExistQVars, FuncName, Types, RetType,
@@ -2038,8 +2094,8 @@
MaybeDet, Context) -->
(
{ PredOrFunc = predicate },
- mercury_format_pred_mode_subdecl(InstVarSet, Name, Modes,
- MaybeDet, Context)
+ mercury_format_pred_or_func_mode_subdecl(InstVarSet, Name,
+ Modes, no, MaybeDet, Context)
; { PredOrFunc = function },
{ pred_args_to_func_args(Modes, ArgModes, RetMode) },
mercury_format_func_mode_subdecl(InstVarSet, Name, ArgModes,
@@ -2049,42 +2105,53 @@
% Output a mode declaration for a predicate.
mercury_output_pred_mode_decl(VarSet, PredName, Modes, MaybeDet, Context) -->
- mercury_format_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet,
- Context, ":- ", ".\n").
+ mercury_output_pred_mode_decl(VarSet, PredName, Modes, no,
+ MaybeDet, Context).
+
+:- pred mercury_output_pred_mode_decl(inst_varset, sym_name, list(mode),
+ maybe(inst), maybe(determinism), prog_context,
+ io__state, io__state).
+:- mode mercury_output_pred_mode_decl(in, in, in, in, in, in, di, uo) is det.
+
+mercury_output_pred_mode_decl(VarSet, PredName, Modes, WithInst,
+ MaybeDet, Context) -->
+ mercury_format_pred_or_func_mode_decl_2(VarSet, PredName, Modes,
+ WithInst, MaybeDet, Context, ":- ", ".\n").
mercury_pred_mode_decl_to_string(VarSet, PredName, Modes, MaybeDet, Context)
= String :-
- mercury_format_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet,
- Context, ":- ", ".\n", "", String).
+ mercury_format_pred_or_func_mode_decl_2(VarSet, PredName, Modes, no,
+ MaybeDet, Context, ":- ", ".\n", "", String).
-:- pred mercury_format_pred_mode_decl_2(inst_varset::in, sym_name::in,
- list(mode)::in, maybe(determinism)::in, prog_context::in,
- string::in, string::in, U::di, U::uo) is det <= output(U).
+:- pred mercury_format_pred_or_func_mode_decl_2(inst_varset::in, sym_name::in,
+ list(mode)::in, maybe(inst)::in, maybe(determinism)::in,
+ prog_context::in, string::in, string::in,
+ U::di, U::uo) is det <= output(U).
-mercury_format_pred_mode_decl_2(VarSet, PredName, Modes, MaybeDet, Context,
- StartString, Separator) -->
+mercury_format_pred_or_func_mode_decl_2(VarSet, PredName, Modes, WithInst,
+ MaybeDet, Context, StartString, Separator) -->
add_string(StartString),
add_string("mode "),
- mercury_format_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
- Context),
+ mercury_format_pred_or_func_mode_subdecl(VarSet, PredName, Modes,
+ WithInst, MaybeDet, Context),
add_string(Separator).
mercury_output_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
Context) -->
- mercury_format_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
- Context).
+ mercury_format_pred_or_func_mode_subdecl(VarSet, PredName,
+ Modes, no, MaybeDet, Context).
mercury_pred_mode_subdecl_to_string(VarSet, PredName, Modes, MaybeDet, Context)
= String :-
- mercury_format_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
- Context, "", String).
+ mercury_format_pred_or_func_mode_subdecl(VarSet, PredName, Modes, no,
+ MaybeDet, Context, "", String).
-:- pred mercury_format_pred_mode_subdecl(inst_varset::in, sym_name::in,
- list(mode)::in, maybe(determinism)::in, prog_context::in,
- U::di, U::uo) is det <= output(U).
+:- pred mercury_format_pred_or_func_mode_subdecl(inst_varset::in, sym_name::in,
+ list(mode)::in, maybe(inst)::in, maybe(determinism)::in,
+ prog_context::in, U::di, U::uo) is det <= output(U).
-mercury_format_pred_mode_subdecl(VarSet, PredName, Modes, MaybeDet,
- _Context) -->
+mercury_format_pred_or_func_mode_subdecl(VarSet, PredName, Modes,
+ MaybeWithInst, MaybeDet, _Context) -->
(
{ Modes = [_|_] },
mercury_format_sym_name(PredName),
@@ -2094,6 +2161,14 @@
;
{ Modes = [] },
mercury_format_bracketed_sym_name(PredName)
+ ),
+ (
+ { MaybeWithInst = yes(WithInst) },
+ add_string(" `with_inst` ("),
+ mercury_format_inst(WithInst, VarSet),
+ add_string(")")
+ ;
+ { MaybeWithInst = no }
),
mercury_format_det_annotation(MaybeDet).
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.140
diff -u -u -r1.140 mode_util.m
--- compiler/mode_util.m 7 Mar 2002 08:30:07 -0000 1.140
+++ compiler/mode_util.m 7 Mar 2002 14:17:32 -0000
@@ -29,6 +29,13 @@
:- pred mode_get_insts_semidet(module_info, mode, inst, inst).
:- mode mode_get_insts_semidet(in, in, out, out) is semidet.
+ % inst_substitute_arg_list(Inst0, Params, Args, Inst) is true
+ % iff Inst is the inst that results from substituting all
+ % occurrences of Params in Inst0 with the corresponding
+ % value in Args.
+:- pred inst_substitute_arg_list(inst, list(inst_var), list(inst), inst).
+:- mode inst_substitute_arg_list(in, in, in, out) is det.
+
% a mode is considered input if the initial inst is bound
:- pred mode_is_input(module_info, mode).
:- mode mode_is_input(in, in) is semidet.
@@ -996,14 +1003,6 @@
map__from_corresponding_lists(Params, Args, Subst),
mode_apply_substitution(Mode0, Subst, Mode)
).
-
- % inst_substitute_arg_list(Inst0, Params, Args, Inst) is true
- % iff Inst is the inst that results from substituting all
- % occurrences of Params in Inst0 with the corresponding
- % value in Args.
-
-:- pred inst_substitute_arg_list(inst, list(inst_var), list(inst), inst).
-:- mode inst_substitute_arg_list(in, in, in, out) is det.
inst_substitute_arg_list(Inst0, Params, Args, Inst) :-
( Params = [] ->
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.74
diff -u -u -r1.74 module_qual.m
--- compiler/module_qual.m 7 Mar 2002 08:30:12 -0000 1.74
+++ compiler/module_qual.m 7 Mar 2002 14:17:33 -0000
@@ -244,8 +244,8 @@
mq_info_set_modes(Info0, Modes, Info).
collect_mq_info_2(module_defn(_, ModuleDefn), Info0, Info) :-
process_module_defn(ModuleDefn, Info0, Info).
-collect_mq_info_2(pred_or_func(_,_,__,_,_,_,_,_,_,_), Info, Info).
-collect_mq_info_2(pred_or_func_mode(_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(pred_or_func(_,_,_,_,__,_,_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(pred_or_func_mode(_,_,_,_,_,_,_), Info, Info).
collect_mq_info_2(pragma(Pragma), Info0, Info) :-
( Pragma = foreign_type(_, Type, SymName) ->
( type_to_ctor_and_args(Type, _ - Arity0, _) ->
@@ -542,28 +542,31 @@
module_qualify_item(
pred_or_func(A, IVs, B, PredOrFunc, SymName, TypesAndModes0,
- C, D, E, Constraints0) - Context,
+ WithType0, WithInst0, C, D, E, Constraints0) - Context,
pred_or_func(A, IVs, B, PredOrFunc, SymName, TypesAndModes,
- C, D, E, Constraints) - Context,
+ WithType, WithInst, C, D, E, Constraints) - Context,
Info0, Info, yes) -->
{ list__length(TypesAndModes0, Arity) },
{ mq_info_set_error_context(Info0,
pred_or_func(PredOrFunc, SymName - Arity) - Context,
Info1) },
qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info2),
- qualify_class_constraints(Constraints0, Constraints, Info2, Info).
+ qualify_class_constraints(Constraints0, Constraints, Info2, Info3),
+ map_foldl2_maybe(qualify_type, WithType0, WithType, Info3, Info4),
+ map_foldl2_maybe(qualify_inst, WithInst0, WithInst, Info4, Info).
module_qualify_item(
pred_or_func_mode(A, PredOrFunc, SymName, Modes0,
- C, D) - Context,
+ WithInst0, C, D) - Context,
pred_or_func_mode(A, PredOrFunc, SymName, Modes,
- C, D) - Context,
+ WithInst, C, D) - Context,
Info0, Info, yes) -->
{ list__length(Modes0, Arity) },
{ mq_info_set_error_context(Info0,
pred_or_func_mode(PredOrFunc, SymName- Arity) - Context,
Info1) },
- qualify_mode_list(Modes0, Modes, Info1, Info).
+ qualify_mode_list(Modes0, Modes, Info1, Info2),
+ map_foldl2_maybe(qualify_inst, WithInst0, WithInst, Info2, Info).
module_qualify_item(pragma(Pragma0) - Context, pragma(Pragma) - Context,
Info0, Info, yes) -->
@@ -1044,25 +1047,28 @@
% done when the item is parsed.
qualify_class_method(
pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
- Name, TypesAndModes0, MaybeDet, Cond, Purity,
- ClassContext0, Context),
+ Name, TypesAndModes0, WithType0, WithInst0, MaybeDet,
+ Cond, Purity, ClassContext0, Context),
pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
- Name, TypesAndModes, MaybeDet, Cond, Purity,
- ClassContext, Context),
+ Name, TypesAndModes, WithType, WithInst, MaybeDet,
+ Cond, Purity, ClassContext, Context),
MQInfo0, MQInfo
) -->
qualify_types_and_modes(TypesAndModes0, TypesAndModes,
MQInfo0, MQInfo1),
qualify_class_constraints(ClassContext0, ClassContext,
- MQInfo1, MQInfo).
+ MQInfo1, MQInfo2),
+ map_foldl2_maybe(qualify_type, WithType0, WithType, MQInfo2, MQInfo3),
+ map_foldl2_maybe(qualify_inst, WithInst0, WithInst, MQInfo3, MQInfo).
qualify_class_method(
pred_or_func_mode(Varset, PredOrFunc, Name, Modes0,
- MaybeDet, Cond, Context),
+ WithInst0, MaybeDet, Cond, Context),
pred_or_func_mode(Varset, PredOrFunc, Name, Modes,
- MaybeDet, Cond, Context),
+ WithInst, MaybeDet, Cond, Context),
MQInfo0, MQInfo
) -->
- qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo).
+ qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo1),
+ map_foldl2_maybe(qualify_inst, WithInst0, WithInst, MQInfo1, MQInfo).
:- pred qualify_instance_body(sym_name::in, instance_body::in,
instance_body::out) is det.
@@ -1194,7 +1200,7 @@
; inst(id)
; mode(id)
; pred_or_func(pred_or_func, id)
- ; pred_or_func_mode(pred_or_func, id)
+ ; pred_or_func_mode(maybe(pred_or_func), id)
; (pragma)
; lambda_expr
; clause_mode_annotation
@@ -1290,11 +1296,17 @@
io__write_string(" "),
{ adjust_func_arity(PredOrFunc, OrigArity, Arity) },
write_id(SymName - OrigArity).
-write_error_context2(pred_or_func_mode(PredOrFunc, SymName - Arity)) -->
+write_error_context2(pred_or_func_mode(MaybePredOrFunc, SymName - Arity)) -->
io__write_string("mode declaration for "),
- io__write(PredOrFunc),
- io__write_string(" "),
- { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ (
+ { MaybePredOrFunc = yes(PredOrFunc) },
+ io__write(PredOrFunc),
+ io__write_string(" "),
+ { adjust_func_arity(PredOrFunc, OrigArity, Arity) }
+ ;
+ { MaybePredOrFunc = no },
+ { OrigArity = Arity }
+ ),
write_id(SymName - OrigArity).
write_error_context2(lambda_expr) -->
io__write_string("mode declaration for lambda expression").
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.80
diff -u -u -r1.80 prog_data.m
--- compiler/prog_data.m 7 Mar 2002 08:30:16 -0000 1.80
+++ compiler/prog_data.m 7 Mar 2002 14:27:49 -0000
@@ -60,16 +60,30 @@
; module_defn(prog_varset, module_defn)
; pred_or_func(tvarset, inst_varset, existq_tvars, pred_or_func,
- sym_name, list(type_and_mode), maybe(determinism),
+ sym_name, list(type_and_mode), maybe(type),
+ maybe(inst), maybe(determinism),
condition, purity, class_constraints)
% TypeVarNames, InstVarNames,
% ExistentiallyQuantifiedTypeVars, PredOrFunc, PredName,
- % ArgTypes, Determinism, Cond, Purity, TypeClassContext
-
- ; pred_or_func_mode(inst_varset, pred_or_func, sym_name,
- list(mode), maybe(determinism), condition)
- % VarNames, PredOrFunc, PredName, ArgModes,
+ % ArgTypesAndModes, WithType, WithInst, Determinism,
+ % Cond, Purity, TypeClassContext
+ %
+ % The WithType and WithInst fields are set to `no' by
+ % equiv_type.m unless there was an error in the
+ % `with_type` and `with_inst` annotations.
+
+ ; pred_or_func_mode(inst_varset, maybe(pred_or_func), sym_name,
+ list(mode), maybe(inst), maybe(determinism), condition)
+ % VarNames, PredOrFunc, PredName, ArgModes, WithInst,
% Determinism, Cond
+ %
+ % For mode declarations using `with_inst` we don't
+ % know whether it's a predicate or function until
+ % we've expanded the inst.
+ %
+ % The WithInst field is set to `no' by
+ % equiv_type.m unless there was an error in the
+ % `with_type` and `with_inst` annotations.
; pragma(pragma_type)
@@ -194,7 +208,7 @@
% foreign function name.
; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
- maybe(list(mode)), type_subst, tvarset, set(type_ctor))
+ maybe(list(mode)), type_subst, tvarset, set(item_id))
% PredName, SpecializedPredName, Arity,
% PredOrFunc, Modes if a specific procedure was
% specified, type substitution (using the variable
@@ -515,19 +529,24 @@
:- type class_method
---> pred_or_func(tvarset, inst_varset, existq_tvars, pred_or_func,
- sym_name, list(type_and_mode), maybe(determinism),
+ sym_name, list(type_and_mode), maybe(type),
+ maybe(inst), maybe(determinism),
condition, purity, class_constraints, prog_context)
% TypeVarNames, InstVarNames,
% ExistentiallyQuantifiedTypeVars,
% PredOrFunc, PredName, ArgTypes, Determinism, Cond
% Purity, ClassContext, Context
- ; pred_or_func_mode(inst_varset, pred_or_func, sym_name,
- list(mode), maybe(determinism), condition,
- prog_context)
+ ; pred_or_func_mode(inst_varset, maybe(pred_or_func), sym_name,
+ list(mode), maybe(inst), maybe(determinism),
+ condition, prog_context)
% InstVarNames, PredOrFunc, PredName, ArgModes,
- % Determinism, Cond
+ % Determinism, WithInst, Cond
% Context
+ %
+ % For mode declarations using `with_inst` we don't
+ % know whether it's a predicate or function until
+ % we've expanded the inst.
.
:- type instance_method
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.201
diff -u -u -r1.201 prog_io.m
--- compiler/prog_io.m 26 Feb 2002 02:45:50 -0000 1.201
+++ compiler/prog_io.m 10 Mar 2002 16:26:12 -0000
@@ -1357,19 +1357,56 @@
parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, R) :-
get_condition(Pred, Body, Condition),
get_determinism(Body, Body2, MaybeDeterminism),
- process_type_decl_pred(ModuleName, MaybeDeterminism, VarSet, Body2,
- Condition, Attributes, R).
+ get_with_inst(Body2, Body3, WithInst),
+ get_with_type(Body3, Body4, WithType),
+ process_type_decl_pred_or_func(predicate, ModuleName,
+ WithType, WithInst, MaybeDeterminism, VarSet, Body4,
+ Condition, Attributes, R).
+
+:- pred process_type_decl_pred_or_func(pred_or_func, module_name, maybe(type),
+ maybe1(maybe(inst)), maybe1(maybe(determinism)), varset,
+ term, condition, decl_attrs, maybe1(item)).
+:- mode process_type_decl_pred_or_func(in, in, in, in, in, in,
+ in, in, in, out) is det.
-:- pred process_type_decl_pred(module_name, maybe1(maybe(determinism)), varset,
- term, condition, decl_attrs, maybe1(item)).
-:- mode process_type_decl_pred(in, in, in, in, in, in, out) is det.
-
-process_type_decl_pred(_MNm, error(Term, Reason), _, _, _, _,
- error(Term, Reason)).
-process_type_decl_pred(ModuleName, ok(MaybeDeterminism), VarSet, Body,
+process_type_decl_pred_or_func(PredOrFunc, ModuleName, WithType, WithInst0,
+ MaybeDeterminism0, VarSet, Body,
Condition, Attributes, R) :-
- process_pred(ModuleName, VarSet, Body, Condition, MaybeDeterminism,
- Attributes, R).
+ (
+ MaybeDeterminism0 = ok(MaybeDeterminism),
+ (
+ WithInst0 = ok(WithInst),
+ ( MaybeDeterminism = yes(_), WithInst = yes(_) ->
+ R = error("`with_inst` and determinism both specified", Body)
+ ; MaybeDeterminism = yes(_), WithType = yes(_) ->
+ R = error("`with_type` and determinism both specified", Body)
+ ; WithInst = yes(_), WithType = no ->
+ R = error("`with_inst` specified without `with_type`", Body)
+ ;
+ (
+ (
+ PredOrFunc = predicate
+ ;
+ PredOrFunc = function,
+ WithType = yes(_)
+ )
+ ->
+ process_pred_or_func(PredOrFunc, ModuleName, VarSet,
+ Body, Condition, WithType, WithInst,
+ MaybeDeterminism, Attributes, R)
+ ;
+ process_func(ModuleName, VarSet, Body, Condition,
+ WithInst, MaybeDeterminism, Attributes, R)
+ )
+ )
+ ;
+ WithInst0 = error(E, T),
+ R = error(E, T)
+ )
+ ;
+ MaybeDeterminism0 = error(E, T),
+ R = error(E, T)
+ ).
%-----------------------------------------------------------------------------%
@@ -1383,8 +1420,11 @@
parse_type_decl_func(ModuleName, VarSet, Func, Attributes, R) :-
get_condition(Func, Body, Condition),
get_determinism(Body, Body2, MaybeDeterminism),
- process_maybe1_to_t(process_func(ModuleName, VarSet, Body2, Condition,
- Attributes), MaybeDeterminism, R).
+ get_with_inst(Body2, Body3, WithInst),
+ get_with_type(Body3, Body4, WithType),
+ process_type_decl_pred_or_func(function, ModuleName,
+ WithType, WithInst, MaybeDeterminism, VarSet, Body4,
+ Condition, Attributes, R).
%-----------------------------------------------------------------------------%
@@ -1396,10 +1436,31 @@
:- mode parse_mode_decl_pred(in, in, in, out) is det.
parse_mode_decl_pred(ModuleName, VarSet, Pred, Result) :-
- get_condition(Pred, Body, Condition),
- get_determinism(Body, Body2, MaybeDeterminism),
- process_maybe1_to_t(process_mode(ModuleName, VarSet, Body2, Condition),
- MaybeDeterminism, Result).
+ get_condition(Pred, Body, Condition),
+ get_determinism(Body, Body2, MaybeDeterminism0),
+ get_with_inst(Body2, Body3, WithInst0),
+ (
+ MaybeDeterminism0 = ok(MaybeDeterminism),
+ (
+ WithInst0 = ok(WithInst),
+ (
+ MaybeDeterminism = yes(_),
+ WithInst = yes(_)
+ ->
+ Result = error("`with_inst` and determinism both specified",
+ Body)
+ ;
+ process_mode(ModuleName, VarSet, Body3, Condition,
+ WithInst, MaybeDeterminism, Result)
+ )
+ ;
+ WithInst0 = error(E, T),
+ Result = error(E, T)
+ )
+ ;
+ MaybeDeterminism0 = error(E, T),
+ Result = error(E, T)
+ ).
%-----------------------------------------------------------------------------%
@@ -1469,6 +1530,44 @@
Determinism = ok(no)
).
+ % Process the `with_inst` part of a declaration of the form:
+ % :- mode p(int) `with_inst` (pred(in, out) is det).
+:- pred get_with_inst(term, term, maybe1(maybe(inst))).
+:- mode get_with_inst(in, out, out) is det.
+
+get_with_inst(Body0, Body, WithInst) :-
+ (
+ Body0 = term__functor(term__atom("with_inst"),
+ [Body1, Inst1], _)
+ ->
+ ( convert_inst(Inst1, Inst) ->
+ WithInst = ok(yes(Inst))
+ ;
+ WithInst = error("invalid inst in `with_inst`",
+ Inst1)
+ ),
+ Body = Body1
+ ;
+ Body = Body0,
+ WithInst = ok(no)
+ ).
+
+:- pred get_with_type(term, term, maybe(type)).
+:- mode get_with_type(in, out, out) is det.
+
+get_with_type(Body0, Body, WithType) :-
+ (
+ Body0 = term__functor(term__atom("with_type"),
+ [Body1, Type1], _)
+ ->
+ Body = Body1,
+ convert_type(Type1, Type),
+ WithType = yes(Type)
+ ;
+ Body = Body0,
+ WithType = no
+ ).
+
%-----------------------------------------------------------------------------%
% get_condition(Term0, Term, Condition) binds Condition
@@ -1773,52 +1872,76 @@
%-----------------------------------------------------------------------------%
- % parse a `:- pred p(...)' declaration
+ % parse a `:- pred p(...)' declaration or a
+ % `:- func f(...) `with_type` t' declaration
-:- pred process_pred(module_name, varset, term, condition, maybe(determinism),
- decl_attrs, maybe1(item)).
-:- mode process_pred(in, in, in, in, in, in, out) is det.
+:- pred process_pred_or_func(pred_or_func, module_name, varset, term,
+ condition, maybe(type), maybe(inst), maybe(determinism),
+ decl_attrs, maybe1(item)).
+:- mode process_pred_or_func(in, in, in, in, in, in, in, in, in, out) is det.
-process_pred(ModuleName, VarSet, PredType, Cond, MaybeDet, Attributes0,
- Result) :-
+process_pred_or_func(PredOrFunc, ModuleName, VarSet, PredType, Cond, WithType,
+ WithInst, MaybeDet, Attributes0, Result) :-
get_class_context(ModuleName, Attributes0, Attributes, MaybeContext),
(
MaybeContext = ok(ExistQVars, Constraints),
parse_implicitly_qualified_term(ModuleName,
- PredType, PredType, "`:- pred' declaration",
- R),
- process_pred_2(R, PredType, VarSet, MaybeDet, Cond,
- ExistQVars, Constraints, Attributes, Result)
+ PredType, PredType,
+ pred_or_func_decl_string(PredOrFunc), R),
+ process_pred_or_func_2(PredOrFunc, R, PredType, VarSet,
+ WithType, WithInst, MaybeDet, Cond, ExistQVars,
+ Constraints, Attributes, Result)
;
MaybeContext = error(String, Term),
Result = error(String, Term)
).
-:- pred process_pred_2(maybe_functor, term, varset, maybe(determinism),
- condition, existq_tvars, class_constraints, decl_attrs,
- maybe1(item)).
-:- mode process_pred_2(in, in, in, in, in, in, in, in, out) is det.
+:- pred process_pred_or_func_2(pred_or_func, maybe_functor, term, varset,
+ maybe(type), maybe(inst), maybe(determinism), condition,
+ existq_tvars, class_constraints, decl_attrs, maybe1(item)).
+:- mode process_pred_or_func_2(in, in, in, in, in, in, in,
+ in, in, in, in, out) is det.
-process_pred_2(ok(F, As0), PredType, VarSet0, MaybeDet, Cond, ExistQVars,
+process_pred_or_func_2(PredOrFunc, ok(F, As0), PredType, VarSet0,
+ WithType, WithInst, MaybeDet, Cond, ExistQVars,
ClassContext, Attributes0, Result) :-
( convert_type_and_mode_list(As0, As) ->
( verify_type_and_mode_list(As) ->
- get_purity(Attributes0, Purity, Attributes),
- varset__coerce(VarSet0, TVarSet),
- varset__coerce(VarSet0, IVarSet),
- Result0 = ok(pred_or_func(TVarSet, IVarSet, ExistQVars,
- predicate, F, As, MaybeDet, Cond, Purity,
- ClassContext)),
- check_no_attributes(Result0, Attributes, Result)
+ (
+ WithInst = yes(_),
+ As = [type_only(_) | _]
+ ->
+ Result = error(
+ "`with_inst` specified without argument modes",
+ PredType)
+ ;
+ WithInst = no,
+ WithType = yes(_),
+ As = [type_and_mode(_, _) | _]
+ ->
+ Result = error(
+ "arguments have modes but `with_inst` not specified",
+ PredType)
+ ;
+ get_purity(Attributes0, Purity, Attributes),
+ varset__coerce(VarSet0, TVarSet),
+ varset__coerce(VarSet0, IVarSet),
+ Result0 = ok(pred_or_func(TVarSet, IVarSet,
+ ExistQVars, PredOrFunc, F, As,
+ WithType, WithInst, MaybeDet, Cond,
+ Purity, ClassContext)),
+ check_no_attributes(Result0, Attributes, Result)
+ )
;
Result = error("some but not all arguments have modes",
PredType)
)
;
- Result = error("syntax error in `:- pred' declaration",
+ Result = error("syntax error in " ++
+ pred_or_func_decl_string(PredOrFunc),
PredType)
).
-process_pred_2(error(M, T), _, _, _, _, _, _, _, error(M, T)).
+process_pred_or_func_2(_, error(M, T), _, _, _, _, _, _, _, _, _, error(M, T)).
:- pred get_purity(decl_attrs, purity, decl_attrs).
:- mode get_purity(in, out, out) is det.
@@ -1832,6 +1955,11 @@
Attributes = Attributes0
).
+:- func pred_or_func_decl_string(pred_or_func) = string.
+
+pred_or_func_decl_string(function) = "`:- func' declaration".
+pred_or_func_decl_string(predicate) = "`:- pred' declaration".
+
%-----------------------------------------------------------------------------%
% We could perhaps get rid of some code duplication between here and
@@ -2007,28 +2135,29 @@
% parse a `:- func p(...)' declaration
-:- pred process_func(module_name, varset, term, condition, decl_attrs,
- maybe(determinism), maybe1(item)).
-:- mode process_func(in, in, in, in, in, in, out) is det.
+:- pred process_func(module_name, varset, term, condition,
+ maybe(inst), maybe(determinism), decl_attrs, maybe1(item)).
+:- mode process_func(in, in, in, in, in, in, in, out) is det.
-process_func(ModuleName, VarSet, Term, Cond, Attributes0, MaybeDet, Result) :-
+process_func(ModuleName, VarSet, Term, Cond, WithInst, MaybeDet,
+ Attributes0, Result) :-
get_class_context(ModuleName, Attributes0, Attributes, MaybeContext),
(
MaybeContext = ok(ExistQVars, Constraints),
- process_func_2(ModuleName, VarSet, Term,
- Cond, MaybeDet, ExistQVars, Constraints, Attributes,
- Result)
+ process_func_2(ModuleName, VarSet, Term, Cond,
+ WithInst, MaybeDet, ExistQVars,
+ Constraints, Attributes, Result)
;
MaybeContext = error(String, ErrorTerm),
Result = error(String, ErrorTerm)
).
:- pred process_func_2(module_name, varset, term, condition,
- maybe(determinism), existq_tvars, class_constraints, decl_attrs,
- maybe1(item)).
-:- mode process_func_2(in, in, in, in, in, in, in, in, out) is det.
+ maybe(inst), maybe(determinism), existq_tvars,
+ class_constraints, decl_attrs, maybe1(item)).
+:- mode process_func_2(in, in, in, in, in, in, in, in, in, out) is det.
-process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet,
+process_func_2(ModuleName, VarSet, Term, Cond, WithInst, MaybeDet,
ExistQVars, Constraints, Attributes, Result) :-
(
Term = term__functor(term__atom("="),
@@ -2036,21 +2165,22 @@
->
parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"`:- func' declaration", R),
- process_func_3(R, FuncTerm, ReturnTypeTerm, VarSet, MaybeDet,
- Cond, ExistQVars, Constraints, Attributes,
- Result)
+ process_func_3(R, FuncTerm, ReturnTypeTerm, VarSet, WithInst,
+ MaybeDet, Cond, ExistQVars, Constraints,
+ Attributes, Result)
;
Result = error("`=' expected in `:- func' declaration", Term)
).
-:- pred process_func_3(maybe_functor, term, term, varset, maybe(determinism),
- condition, existq_tvars, class_constraints, decl_attrs,
- maybe1(item)).
-:- mode process_func_3(in, in, in, in, in, in, in, in, in, out) is det.
-
-process_func_3(ok(F, As0), FuncTerm, ReturnTypeTerm, VarSet0, MaybeDet, Cond,
- ExistQVars, ClassContext, Attributes0, Result) :-
+:- pred process_func_3(maybe_functor, term, term, varset, maybe(inst),
+ maybe(determinism), condition, existq_tvars,
+ class_constraints, decl_attrs, maybe1(item)).
+:- mode process_func_3(in, in, in, in, in, in, in, in, in, in, out) is det.
+
+process_func_3(ok(F, As0), FuncTerm, ReturnTypeTerm, VarSet0, WithInst,
+ MaybeDet, Cond, ExistQVars, ClassContext,
+ Attributes0, Result) :-
( convert_type_and_mode_list(As0, As) ->
( \+ verify_type_and_mode_list(As) ->
Result = error("some but not all arguments have modes",
@@ -2071,13 +2201,21 @@
"function result has mode, but function arguments don't",
FuncTerm)
;
+ As = [type_only(_) | _],
+ WithInst = yes(_)
+ ->
+ Result = error(
+ "`with_inst` specified, but function arguments don't have modes",
+ FuncTerm)
+ ;
get_purity(Attributes0, Purity, Attributes),
varset__coerce(VarSet0, TVarSet),
varset__coerce(VarSet0, IVarSet),
list__append(As, [ReturnType], Args),
Result0 = ok(pred_or_func(TVarSet, IVarSet,
ExistQVars, function, F, Args,
- MaybeDet, Cond, Purity, ClassContext)),
+ no, WithInst, MaybeDet, Cond,
+ Purity, ClassContext)),
check_no_attributes(Result0, Attributes,
Result)
)
@@ -2091,18 +2229,19 @@
"syntax error in arguments of `:- func' declaration",
FuncTerm)
).
-process_func_3(error(M, T), _, _, _, _, _, _, _, _, error(M, T)).
+process_func_3(error(M, T), _, _, _, _, _, _, _, _, _, error(M, T)).
%-----------------------------------------------------------------------------%
% parse a `:- mode p(...)' declaration
-:- pred process_mode(module_name, varset, term, condition, maybe(determinism),
- maybe1(item)).
-:- mode process_mode(in, in, in, in, in, out) is det.
+:- pred process_mode(module_name, varset, term, condition, maybe(inst),
+ maybe(determinism), maybe1(item)).
+:- mode process_mode(in, in, in, in, in, in, out) is det.
-process_mode(ModuleName, VarSet, Term, Cond, MaybeDet, Result) :-
+process_mode(ModuleName, VarSet, Term, Cond, WithInst, MaybeDet, Result) :-
(
+ WithInst = no,
Term = term__functor(term__atom("="),
[FuncTerm, ReturnTypeTerm], _Context)
->
@@ -2112,27 +2251,38 @@
Cond, Result)
;
parse_implicitly_qualified_term(ModuleName, Term, Term,
- "predicate `:- mode' declaration", R),
- process_pred_mode(R, Term, VarSet, MaybeDet, Cond, Result)
+ "`:- mode' declaration", R),
+ process_pred_or_func_mode(R, Term, VarSet, WithInst,
+ MaybeDet, Cond, Result)
).
-:- pred process_pred_mode(maybe_functor, term, varset, maybe(determinism),
- condition, maybe1(item)).
-:- mode process_pred_mode(in, in, in, in, in, out) is det.
+:- pred process_pred_or_func_mode(maybe_functor, term, varset,
+ maybe(inst), maybe(determinism), condition, maybe1(item)).
+:- mode process_pred_or_func_mode(in, in, in, in, in, in, out) is det.
-process_pred_mode(ok(F, As0), PredMode, VarSet0, MaybeDet, Cond, Result) :-
+process_pred_or_func_mode(ok(F, As0), PredMode, VarSet0, WithInst,
+ MaybeDet, Cond, Result) :-
(
convert_mode_list(As0, As1)
->
list__map(constrain_inst_vars_in_mode, As1, As),
varset__coerce(VarSet0, VarSet),
- Result = ok(pred_or_func_mode(VarSet, predicate, F, As,
- MaybeDet, Cond))
+ (
+ WithInst = no,
+ PredOrFunc = yes(predicate)
+ ;
+ WithInst = yes(_),
+ % We don't know whether it's a predicate or
+ % a function until we expand out the inst.
+ PredOrFunc = no
+ ),
+ Result = ok(pred_or_func_mode(VarSet, PredOrFunc, F, As,
+ WithInst, MaybeDet, Cond))
;
- Result = error("syntax error in predicate mode declaration",
+ Result = error("syntax error in mode declaration",
PredMode)
).
-process_pred_mode(error(M, T), _, _, _, _, error(M, T)).
+process_pred_or_func_mode(error(M, T), _, _, _, _, _, error(M, T)).
:- pred process_func_mode(maybe_functor, term, term, varset, maybe(determinism),
condition, maybe1(item)).
@@ -2148,8 +2298,8 @@
constrain_inst_vars_in_mode(RetMode1, RetMode),
varset__coerce(VarSet0, VarSet),
list__append(As, [RetMode], ArgModes),
- Result = ok(pred_or_func_mode(VarSet, function, F,
- ArgModes, MaybeDet, Cond))
+ Result = ok(pred_or_func_mode(VarSet, yes(function),
+ F, ArgModes, no, MaybeDet, Cond))
;
Result = error(
"syntax error in return mode of function mode declaration",
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.21
diff -u -u -r1.21 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 25 Sep 2001 09:36:54 -0000 1.21
+++ compiler/prog_io_typeclass.m 16 Feb 2002 17:03:44 -0000
@@ -220,13 +220,14 @@
item_to_class_method(error(String, Term), _, error(String, Term)).
item_to_class_method(ok(Item, Context), Term, Result) :-
(
- Item = pred_or_func(A, B, C, D, E, F, G, H, I, J)
+ Item = pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L)
->
- Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, Context))
+ Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L,
+ Context))
;
- Item = pred_or_func_mode(A, B, C, D, E, F)
+ Item = pred_or_func_mode(A, B, C, D, E, F, G)
->
- Result = ok(pred_or_func_mode(A, B, C, D, E, F, Context))
+ Result = ok(pred_or_func_mode(A, B, C, D, E, F, G, Context))
;
Result = error("Only pred, func and mode declarations allowed in class interface", Term)
).
Index: compiler/recompilation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.m,v
retrieving revision 1.3
diff -u -u -r1.3 recompilation.m
--- compiler/recompilation.m 7 Mar 2002 08:30:17 -0000 1.3
+++ compiler/recompilation.m 7 Mar 2002 14:27:27 -0000
@@ -123,9 +123,14 @@
% are used because equiv_type.m removes all references to the
% equivalence types, and at that point we don't know which imported
% items are going to be used by the compilation.
-:- pred recompilation__record_used_equivalence_types(item_id::in,
- set(type_ctor)::in, recompilation_info::in,
- recompilation_info::out) is det.
+ %
+ % For predicates declared using `with_type` annotations,
+ % the version number in the interface file and the
+ % version_numbers map will refer tothe arity before expansion
+ % of the `with_type` annotation, so that needs to be recorded
+ % here as well.
+:- pred recompilation__record_expanded_items(item_id::in, set(item_id)::in,
+ recompilation_info::in, recompilation_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -374,8 +379,8 @@
^ used_items := ItemSet
).
-recompilation__record_used_equivalence_types(Item, UsedTypes, Info0, Info) :-
- ( set__empty(UsedTypes) ->
+recompilation__record_expanded_items(Item, ExpandedItems, Info0, Info) :-
+ ( set__empty(ExpandedItems) ->
Info = Info0
;
DepsMap0 = Info0 ^ dependencies,
@@ -384,10 +389,7 @@
;
set__init(Deps1)
),
- UsedItems = list__map(
- (func(TypeCtor) = item_id(type, TypeCtor)),
- set__to_sorted_list(UsedTypes)),
- set__insert_list(Deps1, UsedItems, Deps),
+ set__union(Deps1, ExpandedItems, Deps),
map__set(DepsMap0, Item, Deps, DepsMap),
Info = Info0 ^ dependencies := DepsMap
).
Index: compiler/recompilation_check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_check.m,v
retrieving revision 1.10
diff -u -u -r1.10 recompilation_check.m
--- compiler/recompilation_check.m 7 Mar 2002 08:30:17 -0000 1.10
+++ compiler/recompilation_check.m 7 Mar 2002 15:55:00 -0000
@@ -455,21 +455,8 @@
resolved_pred_or_func_set::out) is det.
parse_pred_or_func_item(Info, Term, Set0, Set) :-
- (
- Term = term__functor(term__atom("-"),
- [NameArityTerm, MatchesTerm], _),
- parse_name_and_arity(NameArityTerm, SymName, Arity)
- ->
- unqualify_name(SymName, Name),
- conjunction_to_list(MatchesTerm, MatchTermList),
- list__foldl(parse_pred_or_func_item_match(Info),
- MatchTermList, map__init, Matches),
- map__det_insert(Set0, Name - Arity, Matches, Set)
- ;
- Reason = syntax_error(get_term_context(Term),
- "error in pred or func match"),
- throw_syntax_error(Reason, Info)
- ).
+ parse_resolved_item_set(Info, parse_pred_or_func_item_match,
+ Term, Set0, Set).
:- pred parse_pred_or_func_item_match(recompilation_check_info::in, term::in,
resolved_pred_or_func_map::in, resolved_pred_or_func_map::out) is det.
@@ -506,39 +493,7 @@
resolved_functor_set::in, resolved_functor_set::out) is det.
parse_functor_item(Info, Term, Set0, Set) :-
- (
- Term = term__functor(term__atom("-"),
- [NameTerm, MatchesTerm], _),
- NameTerm = term__functor(term__atom(Name), [], _)
- ->
- conjunction_to_list(MatchesTerm, MatchTermList),
- list__map(parse_functor_arity_matches(Info),
- MatchTermList, Matches),
- map__det_insert(Set0, Name, Matches, Set)
- ;
- Reason = syntax_error(get_term_context(Term),
- "error in functor matches"),
- throw_syntax_error(Reason, Info)
- ).
-
-:- pred parse_functor_arity_matches(recompilation_check_info::in, term::in,
- pair(arity, resolved_functor_map)::out) is det.
-
-parse_functor_arity_matches(Info, Term, Arity - MatchMap) :-
- (
- Term = term__functor(term__atom("-"),
- [ArityTerm, MatchesTerm], _),
- ArityTerm = term__functor(term__integer(Arity0), [], _),
- conjunction_to_list(MatchesTerm, MatchTermList)
- ->
- Arity = Arity0,
- list__foldl(parse_functor_matches(Info),
- MatchTermList, map__init, MatchMap)
- ;
- Reason = syntax_error(get_term_context(Term),
- "error in functor match"),
- throw_syntax_error(Reason, Info)
- ).
+ parse_resolved_item_set(Info, parse_functor_matches, Term, Set0, Set).
:- pred parse_functor_matches(recompilation_check_info::in, term::in,
resolved_functor_map::in, resolved_functor_map::out) is det.
@@ -594,6 +549,56 @@
throw_syntax_error(Reason, Info)
).
+:- type parse_resolved_item_matches(T) ==
+ pred(recompilation_check_info, term, resolved_item_map(T),
+ resolved_item_map(T)).
+:- inst parse_resolved_item_matches == (pred(in, in, in, out) is det).
+
+:- pred parse_resolved_item_set(recompilation_check_info::in,
+ parse_resolved_item_matches(T)::in(parse_resolved_item_matches),
+ term::in, resolved_item_set(T)::in, resolved_item_set(T)::out) is det.
+
+parse_resolved_item_set(Info, ParseMatches, Term, Set0, Set) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [NameTerm, MatchesTerm], _),
+ NameTerm = term__functor(term__atom(Name), [], _)
+ ->
+ conjunction_to_list(MatchesTerm, MatchTermList),
+ list__map(
+ parse_resolved_item_arity_matches(Info, ParseMatches),
+ MatchTermList, Matches),
+ map__det_insert(Set0, Name, Matches, Set)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in resolved item matches"),
+ throw_syntax_error(Reason, Info)
+ ).
+
+:- pred parse_resolved_item_arity_matches(recompilation_check_info::in,
+ parse_resolved_item_matches(T)::in(parse_resolved_item_matches),
+ term::in, pair(arity, resolved_item_map(T))::out) is det.
+
+parse_resolved_item_arity_matches(Info, ParseMatches,
+ Term, Arity - MatchMap) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [ArityTerm, MatchesTerm], _),
+ ArityTerm = term__functor(term__integer(Arity0), [], _),
+ conjunction_to_list(MatchesTerm, MatchTermList)
+ ->
+ Arity = Arity0,
+ list__foldl(
+ (pred(MatchTerm::in, Map0::in, Map::out) is det :-
+ ParseMatches(Info, MatchTerm, Map0, Map)
+ ),
+ MatchTermList, map__init, MatchMap)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in resolved item matches"),
+ throw_syntax_error(Reason, Info)
+ ).
+
%-----------------------------------------------------------------------------%
%
@@ -863,8 +868,8 @@
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
type_defn(_, Name, Params, Body, _) - _) -->
{ Arity = list__length(Params) },
- check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
- (type), Name, Arity, NeedsCheck),
+ check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
+ VersionNumbers, (type), Name, Arity, NeedsCheck),
( { NeedsCheck = yes } ->
check_type_defn_ambiguity_with_functor(NeedQualifier,
Name - Arity, Body)
@@ -873,30 +878,31 @@
).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
inst_defn(_, Name, Params, _, _) - _) -->
- check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
- (inst), Name, list__length(Params), _).
+ check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
+ VersionNumbers, (inst), Name, list__length(Params), _).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
mode_defn(_, Name, Params, _, _) - _) -->
- check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
- (mode), Name, list__length(Params), _).
+ check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
+ VersionNumbers, (mode), Name, list__length(Params), _).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
typeclass(_, Name, Params, Interface, _) - _) -->
- check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
- (typeclass), Name, list__length(Params), NeedsCheck),
+ check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
+ VersionNumbers, (typeclass), Name, list__length(Params),
+ NeedsCheck),
( { NeedsCheck = yes, Interface = concrete(Methods) } ->
list__foldl(
(pred(ClassMethod::in, in, out) is det -->
(
{ ClassMethod = pred_or_func(_, _, _,
PredOrFunc, MethodName, MethodArgs,
- _, _, _, _, _) },
+ MethodWithType, _, _, _, _, _, _) },
check_for_pred_or_func_item_ambiguity(yes,
NeedQualifier, OldTimestamp,
VersionNumbers, PredOrFunc,
- MethodName, MethodArgs)
+ MethodName, MethodArgs, MethodWithType)
;
{ ClassMethod = pred_or_func_mode(_, _, _, _,
- _, _, _) }
+ _, _, _, _) }
)
),
Methods)
@@ -904,125 +910,73 @@
[]
).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
- pred_or_func(_, _, _, PredOrFunc, Name, Args, _, _, _, _) - _)
+ pred_or_func(_, _, _, PredOrFunc, Name, Args,
+ WithType, _, _, _, _, _) - _)
-->
check_for_pred_or_func_item_ambiguity(no, NeedQualifier, OldTimestamp,
- VersionNumbers, PredOrFunc, Name, Args).
-check_for_ambiguities(_, _, _, pred_or_func_mode(_, _, _, _, _, _) - _) --> [].
+ VersionNumbers, PredOrFunc, Name, Args, WithType).
+check_for_ambiguities(_, _, _,
+ pred_or_func_mode(_, _, _, _, _, _, _) - _) --> [].
check_for_ambiguities(_, _, _, pragma(_) - _) --> [].
check_for_ambiguities(_, _, _, promise(_, _, _, _) - _) --> [].
check_for_ambiguities(_, _, _, module_defn(_, _) - _) --> [].
check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _) --> [].
check_for_ambiguities(_, _, _, nothing(_) - _) --> [].
-:- pred check_for_pred_or_func_item_ambiguity(bool::in, need_qualifier::in,
- timestamp::in, item_version_numbers::in, pred_or_func::in,
- sym_name::in, list(T)::in, recompilation_check_info::in,
- recompilation_check_info::out) is det.
+:- pred item_is_new_or_changed(timestamp::in, item_version_numbers::in,
+ item_type::in, sym_name::in, arity::in) is semidet.
-check_for_pred_or_func_item_ambiguity(NeedsCheck0, NeedQualifier, OldTimestamp,
- VersionNumbers, PredOrFunc, Name, Args) -->
- { adjust_func_arity(PredOrFunc, Arity, list__length(Args)) },
- check_for_ambiguity(NeedsCheck0, NeedQualifier, OldTimestamp,
- VersionNumbers, pred_or_func_to_item_type(PredOrFunc),
- Name, Arity, NeedsCheck),
- ( { NeedsCheck = yes } ->
- { invalid_pred_id(PredId) },
- ( { Name = qualified(ModuleName, _) } ->
- check_functor_ambiguities(NeedQualifier, Name,
- less_than_or_equal(Arity),
- pred_or_func(PredId, ModuleName,
- PredOrFunc, Arity))
- ;
- { error(
- "check_for_pred_or_func_item_ambiguity: unqualified predicate name") }
- )
+item_is_new_or_changed(UsedFileTimestamp, UsedVersionNumbers,
+ ItemType, SymName, Arity) :-
+ unqualify_name(SymName, Name),
+ (
+ map__search(extract_ids(UsedVersionNumbers, ItemType),
+ Name - Arity, UsedVersionNumber)
+ ->
+ % XXX This assumes that version numbers are timestamps.
+ compare((>), UsedVersionNumber, UsedFileTimestamp)
;
- []
+ true
).
-:- pred check_for_ambiguity(need_qualifier::in, timestamp::in,
- item_version_numbers::in, item_type::in, sym_name::in,
- arity::in, bool::out, recompilation_check_info::in,
- recompilation_check_info::out) is det.
-
-check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
- ItemType, SymName, Arity, NeedsCheck) -->
- check_for_ambiguity(no, NeedQualifier, OldTimestamp, VersionNumbers,
- ItemType, SymName, Arity, NeedsCheck).
-
-:- pred check_for_ambiguity(bool::in, need_qualifier::in, timestamp::in,
- item_version_numbers::in, item_type::in, sym_name::in,
+:- pred check_for_simple_item_ambiguity(need_qualifier::in, timestamp::in,
+ item_version_numbers::in, item_type::in(simple_item), sym_name::in,
arity::in, bool::out, recompilation_check_info::in,
recompilation_check_info::out) is det.
-check_for_ambiguity(IsClassMethod, NeedQualifier, UsedFileTimestamp,
- UsedVersionNumbers, ItemType, SymName, Arity, NeedsCheck) -->
- { unqualify_name(SymName, Name) },
+check_for_simple_item_ambiguity(NeedQualifier, UsedFileTimestamp,
+ VersionNumbers, ItemType, SymName, Arity, NeedsCheck) -->
(
- % For a typeclass method, we've already found out
- % that the typeclass declaration has changed.
- { IsClassMethod = no },
-
- %
- % If the item has not changed since the last time we read the
- % file we don't need to check for ambiguities.
- %
- { map__search(extract_ids(UsedVersionNumbers, ItemType),
- Name - Arity, UsedVersionNumber) },
-
- % XXX This assumes that version numbers are timestamps.
- { compare(Result, UsedVersionNumber, UsedFileTimestamp) },
- { Result = (=)
- ; Result = (<)
- }
+ { item_is_new_or_changed(UsedFileTimestamp, VersionNumbers,
+ ItemType, SymName, Arity) }
->
- { NeedsCheck = no }
- ;
+ { NeedsCheck = yes },
UsedItems =^ used_items,
- ( { is_simple_item_type(ItemType) } ->
- { UsedItemMap = extract_simple_item_set(UsedItems,
- ItemType) },
- (
- { map__search(UsedItemMap, Name - Arity,
- MatchingQualifiers) }
- ->
- map__foldl(
- check_for_simple_item_ambiguity(
- ItemType, Name, NeedQualifier,
- SymName, Arity),
- MatchingQualifiers)
- ;
- []
- )
- ; { is_pred_or_func_item_type(ItemType) } ->
- { UsedItemMap = extract_pred_or_func_set(UsedItems,
- ItemType) },
- (
- { map__search(UsedItemMap, Name - Arity,
- MatchingQualifiers) }
- ->
- map__foldl(
- check_for_pred_or_func_ambiguity(
- ItemType, Name, NeedQualifier,
+ { UsedItemMap = extract_simple_item_set(UsedItems, ItemType) },
+ { unqualify_name(SymName, Name) },
+ (
+ { map__search(UsedItemMap, Name - Arity,
+ MatchingQualifiers) }
+ ->
+ map__foldl(
+ check_for_simple_item_ambiguity_2(
+ ItemType, NeedQualifier,
SymName, Arity),
MatchingQualifiers)
- ;
- []
- )
;
[]
- ),
- { NeedsCheck = yes }
+ )
+ ;
+ { NeedsCheck = no }
).
-:- pred check_for_simple_item_ambiguity(item_type::in, string::in,
- need_qualifier::in, sym_name::in, arity::in, module_qualifier::in,
- module_name::in, recompilation_check_info::in,
- recompilation_check_info::out) is det.
+:- pred check_for_simple_item_ambiguity_2(item_type::in, need_qualifier::in,
+ sym_name::in, arity::in, module_qualifier::in, module_name::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
-check_for_simple_item_ambiguity(ItemType, Name, NeedQualifier, SymName, Arity,
- OldModuleQualifier, OldMatchingModuleName) -->
+check_for_simple_item_ambiguity_2(ItemType, NeedQualifier,
+ SymName, Arity, OldModuleQualifier, OldMatchingModuleName) -->
+ { unqualify_name(SymName, Name) },
(
% XXX This is a bit conservative in the
% case of partially qualified names but that
@@ -1046,13 +1000,87 @@
[]
).
-:- pred check_for_pred_or_func_ambiguity(item_type::in, string::in,
+:- pred check_for_pred_or_func_item_ambiguity(bool::in, need_qualifier::in,
+ timestamp::in, item_version_numbers::in, pred_or_func::in,
+ sym_name::in, list(type_and_mode)::in, maybe(type)::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_for_pred_or_func_item_ambiguity(NeedsCheck, NeedQualifier, OldTimestamp,
+ VersionNumbers, PredOrFunc, SymName, Args, WithType) -->
+ {
+ WithType = no,
+ adjust_func_arity(PredOrFunc, Arity, list__length(Args))
+ ;
+ WithType = yes(_),
+ Arity = list__length(Args)
+ },
+ { ItemType = pred_or_func_to_item_type(PredOrFunc) },
+ (
+ { NeedsCheck = yes
+ ; item_is_new_or_changed(OldTimestamp, VersionNumbers,
+ ItemType, SymName, Arity)
+ }
+ ->
+ UsedItems =^ used_items,
+ { UsedItemMap = extract_pred_or_func_set(UsedItems,
+ ItemType) },
+ { unqualify_name(SymName, Name) },
+ ( { map__search(UsedItemMap, Name, MatchingArityList) } ->
+ list__foldl(
+ (pred((MatchArity - MatchingQualifiers)::in,
+ in, out) is det -->
+ (
+ {
+ WithType = yes(_),
+ MatchArity >= Arity
+ ;
+ WithType = no,
+ MatchArity = Arity
+ }
+ ->
+ map__foldl(
+ check_for_pred_or_func_item_ambiguity_2(
+ ItemType, NeedQualifier,
+ SymName, MatchArity),
+ MatchingQualifiers)
+ ;
+ []
+ )
+ ), MatchingArityList)
+ ;
+ []
+ ),
+
+ { invalid_pred_id(PredId) },
+ ( { SymName = qualified(ModuleName, _) } ->
+ {
+ WithType = yes(_),
+ % We don't know the actual arity.
+ AritiesToMatch = any
+ ;
+ WithType = no,
+ AritiesToMatch = less_than_or_equal(Arity)
+ },
+ check_functor_ambiguities(NeedQualifier,
+ SymName, AritiesToMatch,
+ pred_or_func(PredId, ModuleName,
+ PredOrFunc, Arity))
+ ;
+ { error(
+ "check_for_pred_or_func_item_ambiguity: unqualified predicate name") }
+ )
+ ;
+ []
+ ).
+
+:- pred check_for_pred_or_func_item_ambiguity_2(item_type::in,
need_qualifier::in, sym_name::in, arity::in, module_qualifier::in,
set(pair(pred_id, module_name))::in, recompilation_check_info::in,
recompilation_check_info::out) is det.
-check_for_pred_or_func_ambiguity(ItemType, Name, NeedQualifier,
+check_for_pred_or_func_item_ambiguity_2(ItemType, NeedQualifier,
SymName, Arity, OldModuleQualifier, OldMatchingModuleNames) -->
+ { unqualify_name(SymName, Name) },
(
% XXX This is a bit conservative in the
% case of partially qualified names but that
@@ -1141,6 +1169,7 @@
:- type functor_match_arity
---> exact(arity)
; less_than_or_equal(arity)
+ ; any
.
:- pred check_functor_ambiguities(need_qualifier::in, sym_name::in,
@@ -1188,6 +1217,10 @@
Check = no,
Continue = no
}
+ ;
+ { MatchArity = any },
+ { Check = yes },
+ { Continue = yes }
),
( { Check = yes } ->
map__foldl(
Index: compiler/recompilation_usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_usage.m,v
retrieving revision 1.6
diff -u -u -r1.6 recompilation_usage.m
--- compiler/recompilation_usage.m 7 Mar 2002 08:30:17 -0000 1.6
+++ compiler/recompilation_usage.m 7 Mar 2002 14:17:37 -0000
@@ -26,25 +26,25 @@
resolved_functor_set).
:- type resolved_pred_or_func_set ==
- map(pair(string, arity), resolved_pred_or_func_map).
-
+ resolved_item_set(set(pair(pred_id, module_name))).
:- type resolved_pred_or_func_map ==
- map(module_qualifier, set(pair(pred_id, module_name))).
+ resolved_item_map(set(pair(pred_id, module_name))).
% A resolved_functor_set records all possible matches
% for each functor application.
-:- type resolved_functor_set == map(string, resolved_functor_list).
+:- type resolved_functor_set == resolved_item_set(set(resolved_functor)).
+:- type resolved_functor_map == resolved_item_map(set(resolved_functor)).
+
+:- type resolved_item_set(T) == map(string, resolved_item_list(T)).
% The list is sorted on arity.
% This is useful because when determining whether
% there is an ambiguity we need to test a predicate or
% function against all used functors with equal or
% lower arity.
-:- type resolved_functor_list ==
- assoc_list(arity, resolved_functor_map).
+:- type resolved_item_list(T) == assoc_list(arity, resolved_item_map(T)).
-:- type resolved_functor_map ==
- map(module_qualifier, set(resolved_functor)).
+:- type resolved_item_map(T) == map(module_qualifier, T).
:- type resolved_functor
---> pred_or_func(
@@ -337,38 +337,20 @@
io__state::di, io__state::uo) is det.
write_pred_or_func_matches_2(ItemType, ItemSet) -->
- { string_to_item_type(ItemTypeStr, ItemType) },
- io__write_string(ItemTypeStr),
- io__write_string("(\n\t\t"),
- { map__to_assoc_list(ItemSet, ItemList) },
- io__write_list(ItemList, ",\n\t\t",
- (pred(((Name - Arity) - Matches)::in, di, uo) is det -->
- mercury_output_bracketed_sym_name(unqualified(Name),
- next_to_graphic_token),
- io__write_string("/"),
- io__write_int(Arity),
- io__write_string(" - ("),
- { map__to_assoc_list(Matches, MatchList) },
- io__write_list(MatchList, ",\n\t\t\t",
- (pred((Qualifier - PredIdModuleNames)::in,
- di, uo) is det -->
- { ModuleNames = assoc_list__values(set__to_sorted_list(
+ write_resolved_item_set(ItemType, ItemSet,
+ (pred((Qualifier - PredIdModuleNames)::in, di, uo) is det -->
+ { ModuleNames = assoc_list__values(set__to_sorted_list(
PredIdModuleNames)) },
- mercury_output_bracketed_sym_name(Qualifier),
- ( { ModuleNames = [Qualifier] } ->
- []
- ;
- io__write_string(" => ("),
- io__write_list(ModuleNames, ", ",
- mercury_output_bracketed_sym_name),
- io__write_string(")")
- )
- )
- ),
- io__write_string(")")
- )
- ),
- io__write_string("\n\t)").
+ mercury_output_bracketed_sym_name(Qualifier),
+ ( { ModuleNames = [Qualifier] } ->
+ []
+ ;
+ io__write_string(" => ("),
+ io__write_list(ModuleNames, ", ",
+ mercury_output_bracketed_sym_name),
+ io__write_string(")")
+ )
+ )).
:- pred write_functor_matches(resolved_functor_set::in,
bool::in, bool::out, io__state::di, io__state::uo) is det.
@@ -383,14 +365,29 @@
[]
),
{ WriteComma = yes },
- write_functor_matches_2(Ids)
+ write_resolved_item_set(functor, Ids,
+ (pred((Qualifier - MatchingCtors)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(Qualifier),
+ io__write_string(" => ("),
+ io__write_list(
+ set__to_sorted_list(MatchingCtors),
+ ", ", write_resolved_functor),
+ io__write_string(")")
+ ))
).
-:- pred write_functor_matches_2(resolved_functor_set::in,
- io__state::di, io__state::uo) is det.
+:- type write_resolved_item(T) ==
+ pred(pair(module_qualifier, T), io__state, io__state).
+:- inst write_resolved_item == (pred(in, di, uo) is det).
+
+:- pred write_resolved_item_set(item_type::in, resolved_item_set(T)::in,
+ write_resolved_item(T)::in(write_resolved_item),
+ io__state::di, io__state::uo) is det.
-write_functor_matches_2(ItemSet) -->
- io__write_string("functor(\n\t\t"),
+write_resolved_item_set(ItemType, ItemSet, WriteMatches) -->
+ { string_to_item_type(ItemTypeStr, ItemType) },
+ io__write_string(ItemTypeStr),
+ io__write_string("(\n\t\t"),
{ map__to_assoc_list(ItemSet, ItemList) },
io__write_list(ItemList, ",\n\t\t",
(pred((Name - MatchesAL)::in, di, uo) is det -->
@@ -402,16 +399,7 @@
io__write_string(" - ("),
{ map__to_assoc_list(Matches, MatchList) },
io__write_list(MatchList, ",\n\t\t\t\t",
- (pred((Qualifier - MatchingCtors)::in,
- di, uo) is det -->
- mercury_output_bracketed_sym_name(Qualifier),
- io__write_string(" => ("),
- io__write_list(
- set__to_sorted_list(MatchingCtors),
- ", ", write_resolved_functor),
- io__write_string(")")
- )
- ),
+ WriteMatches),
io__write_string(")")
)),
io__write_string(")")
@@ -446,7 +434,7 @@
io__write_int(ConsArity),
io__write_string(")").
-usage_file_version_number = 1.
+usage_file_version_number = 2.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -550,7 +538,7 @@
=(Info),
{ NameArity = Name - Arity },
( { item_is_local(Info, NameArity) } ->
- recompilation_usage__record_equivalence_types_used_by_item(
+ recompilation_usage__record_expanded_items_used_by_item(
(typeclass), NameArity),
list__foldl(
recompilation_usage__find_items_used_by_instance(
@@ -624,30 +612,30 @@
recompilation_usage__record_used_pred_or_func(PredOrFunc, Id) -->
{ ItemType = pred_or_func_to_item_type(PredOrFunc) },
-
ItemSet0 =^ used_items,
{ IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType) },
{ Id = SymName - Arity },
- { unqualify_name(SymName, UnqualifiedName) },
- { ModuleQualifier = find_module_qualifier(SymName) },
- { UnqualifiedId = UnqualifiedName - Arity },
+ record_resolved_item(SymName, Arity,
+ recompilation_usage__do_record_used_pred_or_func(PredOrFunc),
+ IdSet0, IdSet),
+ { ItemSet = update_pred_or_func_set(ItemSet0, ItemType, IdSet) },
+ ^ used_items := ItemSet.
+
+:- pred recompilation_usage__do_record_used_pred_or_func(pred_or_func::in,
+ module_qualifier::in, sym_name::in, arity::in, bool::out,
+ resolved_pred_or_func_map::in, resolved_pred_or_func_map::out,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
- { map__search(IdSet0, UnqualifiedId, MatchingNames0) ->
- MatchingNames1 = MatchingNames0
- ;
- map__init(MatchingNames1)
- },
+recompilation_usage__do_record_used_pred_or_func(PredOrFunc, ModuleQualifier,
+ SymName, Arity, Recorded, MatchingNames0, MatchingNames) -->
ModuleInfo =^ module_info,
(
- { map__contains(MatchingNames1, ModuleQualifier) }
- ->
- []
- ;
{ module_info_get_predicate_table(ModuleInfo, PredTable) },
{ adjust_func_arity(PredOrFunc, OrigArity, Arity) },
{ predicate_table_search_pf_sym_arity(PredTable,
PredOrFunc, SymName, OrigArity, MatchingPredIds) }
->
+ { Recorded = yes },
{ PredModules = set__list_to_set(list__map(
(func(PredId) = PredId - PredModule :-
module_info_pred_info(ModuleInfo,
@@ -655,18 +643,16 @@
pred_info_module(PredInfo, PredModule)
),
MatchingPredIds)) },
- { map__det_insert(MatchingNames1, ModuleQualifier,
+ { map__det_insert(MatchingNames0, ModuleQualifier,
PredModules, MatchingNames) },
- { map__set(IdSet0, UnqualifiedId, MatchingNames, IdSet) },
- { ItemSet = update_pred_or_func_set(ItemSet0,
- ItemType, IdSet) },
- ^ used_items := ItemSet,
+ { unqualify_name(SymName, Name) },
set__fold(
recompilation_usage__find_items_used_by_pred(
- PredOrFunc, UnqualifiedId),
+ PredOrFunc, Name - Arity),
PredModules)
;
- []
+ { Recorded = no },
+ { MatchingNames = MatchingNames0 }
).
%-----------------------------------------------------------------------------%
@@ -677,99 +663,37 @@
recompilation_usage__record_used_functor(SymName - Arity) -->
ItemSet0 =^ used_items,
{ IdSet0 = ItemSet0 ^ functors },
- { unqualify_name(SymName, UnqualifiedName) },
- { ModuleQualifier = find_module_qualifier(SymName) },
- { map__search(IdSet0, UnqualifiedName, MatchingNames0) ->
- MatchingNames1 = MatchingNames0
- ;
- MatchingNames1 = []
- },
- recompilation_usage__record_used_functor_2(ModuleQualifier,
- SymName, Arity, Recorded, MatchingNames1, MatchingNames),
- ( { Recorded = yes } ->
- { map__set(IdSet0, UnqualifiedName, MatchingNames, IdSet) },
- { ItemSet = ItemSet0 ^ functors := IdSet },
- ^ used_items := ItemSet
- ;
- []
- ).
-
-:- pred recompilation_usage__record_used_functor_2(module_qualifier::in,
- sym_name::in, arity::in, bool::out, resolved_functor_list::in,
- resolved_functor_list::out, recompilation_usage_info::in,
- recompilation_usage_info::out) is det.
-
-recompilation_usage__record_used_functor_2(ModuleQualifier,
- SymName, Arity, Recorded, [], CtorList) -->
- { map__init(CtorMap0) },
- recompilation_usage__record_used_functor_3(ModuleQualifier,
- SymName, Arity, Recorded, CtorMap0, CtorMap),
- { Recorded = yes ->
- CtorList = [Arity - CtorMap]
- ;
- CtorList = []
- }.
-recompilation_usage__record_used_functor_2(ModuleQualifier,
- SymName, Arity, Recorded, CtorList0, CtorList) -->
- { CtorList0 = [CtorArity - ArityCtorMap0 | CtorListRest0] },
- ( { Arity < CtorArity } ->
- { map__init(NewArityCtorMap0) },
- recompilation_usage__record_used_functor_3(ModuleQualifier,
- SymName, Arity, Recorded, NewArityCtorMap0,
- NewArityCtorMap),
- { Recorded = yes ->
- CtorList = [Arity - NewArityCtorMap | CtorList0]
- ;
- CtorList = CtorList0
- }
- ; { Arity = CtorArity } ->
- recompilation_usage__record_used_functor_3(ModuleQualifier,
- SymName, Arity, Recorded, ArityCtorMap0, ArityCtorMap),
- { Recorded = yes ->
- CtorList = [CtorArity - ArityCtorMap | CtorListRest0]
- ;
- CtorList = CtorList0
- }
- ;
- recompilation_usage__record_used_functor_2(ModuleQualifier,
- SymName, Arity, Recorded, CtorListRest0, CtorListRest),
- { Recorded = yes ->
- CtorList = [CtorArity - ArityCtorMap0 | CtorListRest]
- ;
- CtorList = CtorList0
- }
- ).
+ record_resolved_item(SymName, Arity,
+ recompilation_usage__do_record_used_functor,
+ IdSet0, IdSet),
+ { ItemSet = ItemSet0 ^ functors := IdSet },
+ ^ used_items := ItemSet.
-:- pred recompilation_usage__record_used_functor_3(module_qualifier::in,
+:- pred recompilation_usage__do_record_used_functor(module_qualifier::in,
sym_name::in, arity::in, bool::out, resolved_functor_map::in,
resolved_functor_map::out, recompilation_usage_info::in,
recompilation_usage_info::out) is det.
-recompilation_usage__record_used_functor_3(ModuleQualifier, SymName, Arity,
+recompilation_usage__do_record_used_functor(ModuleQualifier, SymName, Arity,
Recorded, ResolvedCtorMap0, ResolvedCtorMap) -->
- ( { map__contains(ResolvedCtorMap0, ModuleQualifier) } ->
- { Recorded = no },
- { ResolvedCtorMap = ResolvedCtorMap0 }
- ;
- ModuleInfo =^ module_info,
- { recompilation_usage__find_matching_functors(ModuleInfo,
- SymName, Arity, MatchingCtors) },
- { unqualify_name(SymName, Name) },
+ ModuleInfo =^ module_info,
- set__fold(
- recompilation_usage__find_items_used_by_functor(
- Name, Arity),
- MatchingCtors),
-
- { set__empty(MatchingCtors) ->
- Recorded = no,
- ResolvedCtorMap = ResolvedCtorMap0
- ;
- Recorded = yes,
- map__det_insert(ResolvedCtorMap0, ModuleQualifier,
- MatchingCtors, ResolvedCtorMap)
- }
- ).
+ { recompilation_usage__find_matching_functors(ModuleInfo,
+ SymName, Arity, MatchingCtors) },
+ { unqualify_name(SymName, Name) },
+ set__fold(
+ recompilation_usage__find_items_used_by_functor(
+ Name, Arity),
+ MatchingCtors),
+
+ { set__empty(MatchingCtors) ->
+ Recorded = no,
+ ResolvedCtorMap = ResolvedCtorMap0
+ ;
+ Recorded = yes,
+ map__det_insert(ResolvedCtorMap0, ModuleQualifier,
+ MatchingCtors, ResolvedCtorMap)
+ }.
:- pred recompilation_usage__find_matching_functors(module_info::in,
sym_name::in, arity::in, set(resolved_functor)::out) is det.
@@ -876,6 +800,103 @@
%-----------------------------------------------------------------------------%
+:- type record_resolved_item(T) ==
+ pred(module_qualifier, sym_name, arity, bool,
+ resolved_item_map(T), resolved_item_map(T),
+ recompilation_usage_info, recompilation_usage_info).
+:- inst record_resolved_item ==
+ (pred(in, in, in, out, in, out, in, out) is det).
+
+
+:- pred record_resolved_item(sym_name::in, arity::in,
+ record_resolved_item(T)::in(record_resolved_item),
+ resolved_item_set(T)::in, resolved_item_set(T)::out,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+record_resolved_item(SymName, Arity, RecordItem, IdSet0, IdSet) -->
+ { unqualify_name(SymName, UnqualifiedName) },
+ { ModuleQualifier = find_module_qualifier(SymName) },
+ { map__search(IdSet0, UnqualifiedName, MatchingNames0) ->
+ MatchingNames1 = MatchingNames0
+ ;
+ MatchingNames1 = []
+ },
+ recompilation_usage__record_resolved_item_2(ModuleQualifier, SymName,
+ Arity, RecordItem, Recorded,
+ MatchingNames1, MatchingNames),
+ { Recorded = yes ->
+ map__set(IdSet0, UnqualifiedName, MatchingNames, IdSet)
+ ;
+ IdSet = IdSet0
+ }.
+
+:- pred recompilation_usage__record_resolved_item_2(
+ module_qualifier::in, sym_name::in, arity::in,
+ record_resolved_item(T)::in(record_resolved_item),
+ bool::out, resolved_item_list(T)::in, resolved_item_list(T)::out,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__record_resolved_item_2(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded, [], List) -->
+ { map__init(Map0) },
+ recompilation_usage__record_resolved_item_3(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded, Map0, Map),
+ { Recorded = yes ->
+ List = [Arity - Map]
+ ;
+ List = []
+ }.
+recompilation_usage__record_resolved_item_2(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded, List0, List) -->
+ { List0 = [ThisArity - ArityMap0 | ListRest0] },
+ ( { Arity < ThisArity } ->
+ { map__init(NewArityMap0) },
+ recompilation_usage__record_resolved_item_3(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded,
+ NewArityMap0, NewArityMap),
+ { Recorded = yes ->
+ List = [Arity - NewArityMap | List0]
+ ;
+ List = List0
+ }
+ ; { Arity = ThisArity } ->
+ recompilation_usage__record_resolved_item_3(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded,
+ ArityMap0, ArityMap),
+ { Recorded = yes ->
+ List = [Arity - ArityMap | ListRest0]
+ ;
+ List = List0
+ }
+ ;
+ recompilation_usage__record_resolved_item_2(ModuleQualifier,
+ SymName, Arity, RecordItem, Recorded,
+ ListRest0, ListRest),
+ { Recorded = yes ->
+ List = [ThisArity - ArityMap0 | ListRest]
+ ;
+ List = List0
+ }
+ ).
+
+:- pred recompilation_usage__record_resolved_item_3(
+ module_qualifier::in, sym_name::in, arity::in,
+ record_resolved_item(T)::in(record_resolved_item), bool::out,
+ resolved_item_map(T)::in, resolved_item_map(T)::out,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__record_resolved_item_3(ModuleQualifier, SymName, Arity,
+ RecordItem, Recorded, ResolvedMap0, ResolvedMap) -->
+ ( { map__contains(ResolvedMap0, ModuleQualifier) } ->
+ { Recorded = no },
+ { ResolvedMap = ResolvedMap0 }
+ ;
+ RecordItem(ModuleQualifier, SymName, Arity, Recorded,
+ ResolvedMap0, ResolvedMap)
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred recompilation_usage__find_items_used_by_item(item_type::in,
item_name::in, recompilation_usage_info::in,
recompilation_usage_info::out) is det.
@@ -938,14 +959,10 @@
[]
).
- %
- % It's simplest to deal with items used by predicates, functions
- % and functors as we resolve the predicates, functions and functors.
- %
-recompilation_usage__find_items_used_by_item(predicate, _) -->
- { error("recompilation_usage__find_items_used_by_item: predicate") }.
-recompilation_usage__find_items_used_by_item(function, _) -->
- { error("recompilation_usage__find_items_used_by_item: function") }.
+recompilation_usage__find_items_used_by_item(predicate, ItemId) -->
+ recompilation_usage__record_used_pred_or_func(predicate, ItemId).
+recompilation_usage__find_items_used_by_item(function, ItemId) -->
+ recompilation_usage__record_used_pred_or_func(function, ItemId).
recompilation_usage__find_items_used_by_item(functor, _) -->
{ error("recompilation_usage__find_items_used_by_item: functor") }.
@@ -988,8 +1005,8 @@
recompilation_usage_info::out) is det.
recompilation_usage__find_items_used_by_class_method(
- pred_or_func(_, _, _, _, _, ArgTypesAndModes,
- _, _, _, Constraints, _)) -->
+ pred_or_func(_, _, _, _, _, ArgTypesAndModes, _,
+ _, _, _, _, Constraints, _)) -->
recompilation_usage__find_items_used_by_class_context(
Constraints),
list__foldl(
@@ -1003,7 +1020,7 @@
recompilation_usage__find_items_used_by_type(Type)
), ArgTypesAndModes).
recompilation_usage__find_items_used_by_class_method(
- pred_or_func_mode(_, _, _, Modes, _, _, _)) -->
+ pred_or_func_mode(_, _, _, Modes, _, _, _, _)) -->
recompilation_usage__find_items_used_by_modes(Modes).
:- pred recompilation_usage__find_items_used_by_type_body(hlds_type_body::in,
@@ -1109,7 +1126,7 @@
typeclass, ClassName - ClassArity)
;
{ NameArity = qualified(PredModule, Name) - Arity },
- recompilation_usage__record_equivalence_types_used_by_item(
+ recompilation_usage__record_expanded_items_used_by_item(
ItemType, NameArity),
recompilation_usage__record_imported_item(ItemType, NameArity),
{ pred_info_arg_types(PredInfo, ArgTypes) },
@@ -1386,7 +1403,7 @@
^ item_queue := Queue,
recompilation_usage__record_imported_item(ItemType, NameArity),
- recompilation_usage__record_equivalence_types_used_by_item(
+ recompilation_usage__record_expanded_items_used_by_item(
ItemType, NameArity)
).
@@ -1436,11 +1453,11 @@
% Uses of equivalence types have been expanded away by equiv_type.m.
% equiv_type.m records which equivalence types were used by each
% imported item.
-:- pred recompilation_usage__record_equivalence_types_used_by_item(
+:- pred recompilation_usage__record_expanded_items_used_by_item(
item_type::in, item_name::in, recompilation_usage_info::in,
recompilation_usage_info::out) is det.
-recompilation_usage__record_equivalence_types_used_by_item(ItemType,
+recompilation_usage__record_expanded_items_used_by_item(ItemType,
NameArity) -->
Dependencies =^ dependencies,
(
Index: compiler/recompilation_version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_version.m,v
retrieving revision 1.15
diff -u -u -r1.15 recompilation_version.m
--- compiler/recompilation_version.m 10 Mar 2002 14:56:08 -0000 1.15
+++ compiler/recompilation_version.m 10 Mar 2002 16:41:40 -0000
@@ -155,7 +155,16 @@
GatheredItems0, GatheredItems) :-
ItemId = MaybePredOrFunc - SymName / Arity,
ItemAndContext = Item - ItemContext,
- AddIfNotExisting = no,
+
+ % For predicates defined using `with_type` annotations
+ % we don't know the actual arity, so always we need to add
+ % entries for pragmas, even if the pragma doesn't match any
+ % recorded predicate. For pragmas which don't include enough
+ % information to work out whether they apply to a predicate
+ % or a function this will result in an extra entry in the
+ % version numbers. Pragmas in the interface aren't common
+ % so this won't be too much of a problem.
+ AddIfNotExisting = yes,
(
MaybePredOrFunc = yes(PredOrFunc),
ItemType = pred_or_func_to_item_type(PredOrFunc),
@@ -186,12 +195,20 @@
Interface = concrete(Methods),
list__member(Method, Methods),
Method = pred_or_func(_, _, _, MethodPredOrFunc,
- SymName, TypesAndModes, _, _, _, _, _),
+ SymName, TypesAndModes, WithType, _,
+ _, _, _, _, _),
( MaybePredOrFunc = yes(MethodPredOrFunc)
; MaybePredOrFunc = no
),
- adjust_func_arity(MethodPredOrFunc,
- Arity, list__length(TypesAndModes))
+ (
+ WithType = no,
+ adjust_func_arity(MethodPredOrFunc,
+ Arity, list__length(TypesAndModes))
+ ;
+ % We don't know the actual arity, so just
+ % match on the name and pred_or_func.
+ WithType = yes(_)
+ )
->
% XXX O(N^2), but shouldn't happen too often.
ClassItems = ClassItems0 ++ [ItemAndContext]
@@ -270,6 +287,27 @@
[Item - ItemContext | InstanceItems], Instances) },
^ instances := Instances
;
+ % For predicates or functions defined using `with_inst`
+ % annotations the pred_or_func and arity here won't be
+ % correct, but equiv_type.m will record the dependency
+ % on the version number with the `incorrect' pred_or_func
+ % and arity, so this will work.
+ { Item = pred_or_func_mode(_, MaybePredOrFunc,
+ SymName, Modes, WithInst, _, _) },
+ { MaybePredOrFunc = no },
+ { WithInst = yes(_) }
+ ->
+ GatheredItems0 =^ gathered_items,
+ { ItemName = SymName - list__length(Modes) },
+ { recompilation_version__add_gathered_item(Item,
+ item_id(predicate, ItemName), ItemContext,
+ yes, GatheredItems0, GatheredItems1) },
+ { recompilation_version__add_gathered_item(Item,
+ item_id(function, ItemName), ItemContext,
+ yes, GatheredItems1, GatheredItems) },
+ ^ gathered_items := GatheredItems
+ ;
+
{ item_to_item_id(Item, ItemId) }
->
GatheredItems0 =^ gathered_items,
@@ -324,19 +362,32 @@
% the item list generated here.
(
Item = pred_or_func(TVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, Det,
- Cond, Purity, ClassContext),
+ PredOrFunc, PredName, TypesAndModes, WithType,
+ WithInst, Det, Cond, Purity, ClassContext),
split_types_and_modes(TypesAndModes, Types, MaybeModes),
- MaybeModes = yes(Modes)
+ MaybeModes = yes(Modes),
+ ( Modes \= []
+ ; WithInst = yes(_)
+ )
->
TypesWithoutModes = list__map(
(func(Type) = type_only(Type)), Types),
varset__init(EmptyInstVarSet),
PredOrFuncItem = pred_or_func(TVarSet, EmptyInstVarSet,
ExistQVars, PredOrFunc, PredName, TypesWithoutModes,
- no, Cond, Purity, ClassContext),
+ WithType, no, no, Cond, Purity, ClassContext),
+ (
+ WithInst = yes(_),
+ % MaybePredOrFunc needs to be `no' here because when
+ % the item is read from the interface file we won't
+ % know whether it is a predicate or a function mode.
+ MaybePredOrFunc = no
+ ;
+ WithInst = no,
+ MaybePredOrFunc = yes(PredOrFunc)
+ ),
PredOrFuncModeItem = pred_or_func_mode(InstVarSet,
- PredOrFunc, PredName, Modes, Det, Cond),
+ MaybePredOrFunc, PredName, Modes, WithInst, Det, Cond),
MatchingItems =
[PredOrFuncItem - ItemContext,
PredOrFuncModeItem - ItemContext
@@ -366,16 +417,30 @@
% Always strip the context from the item -- this is needed
% so the items can be easily tested for equality.
Method0 = pred_or_func(TVarSet, InstVarSet, ExistQVars,
- PredOrFunc, SymName, TypesAndModes, MaybeDet,
- Cond, Purity, ClassContext, _),
+ PredOrFunc, SymName, TypesAndModes, WithType, WithInst,
+ MaybeDet, Cond, Purity, ClassContext, _),
(
split_types_and_modes(TypesAndModes, Types, MaybeModes),
- MaybeModes = yes(Modes)
+ MaybeModes = yes(Modes),
+ ( Modes \= []
+ ; WithInst = yes(_)
+ )
->
TypesWithoutModes = list__map(
(func(Type) = type_only(Type)), Types),
- PredOrFuncModeItem = pred_or_func_mode(InstVarSet, PredOrFunc,
- SymName, Modes, MaybeDet, Cond, term__context_init),
+ (
+ WithInst = yes(_),
+ % MaybePredOrFunc needs to be `no' here because when
+ % the item is read from the interface file we won't
+ % know whether it is a predicate or a function mode.
+ MaybePredOrFunc = no
+ ;
+ WithInst = no,
+ MaybePredOrFunc = yes(PredOrFunc)
+ ),
+ PredOrFuncModeItem = pred_or_func_mode(InstVarSet,
+ MaybePredOrFunc, SymName, Modes, WithInst,
+ MaybeDet, Cond, term__context_init),
PredOrFuncModeItems = [PredOrFuncModeItem]
;
TypesWithoutModes = TypesAndModes,
@@ -384,14 +449,14 @@
varset__init(EmptyInstVarSet),
PredOrFuncItem = pred_or_func(TVarSet, EmptyInstVarSet,
ExistQVars, PredOrFunc, SymName,
- TypesWithoutModes, no, Cond, Purity,
+ TypesWithoutModes, WithType, no, no, Cond, Purity,
ClassContext, term__context_init),
Items = [PredOrFuncItem | PredOrFuncModeItems].
split_class_method_types_and_modes(Method0) = [Method] :-
% Always strip the context from the item -- this is needed
% so the items can be easily tested for equality.
- Method0 = pred_or_func_mode(A, B, C, D, E, F, _),
- Method = pred_or_func_mode(A, B, C, D, E, F, term__context_init).
+ Method0 = pred_or_func_mode(A, B, C, D, E, F, G, _),
+ Method = pred_or_func_mode(A, B, C, D, E, F, G, term__context_init).
:- pred item_to_item_id(item::in, item_id::out) is semidet.
@@ -413,14 +478,35 @@
item_to_item_id_2(module_defn(_, _), no).
item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :-
Item = pred_or_func(_, _, _, PredOrFunc, SymName,
- TypesAndModes, _, _, _, _),
- adjust_func_arity(PredOrFunc, Arity, list__length(TypesAndModes)),
- ItemType = pred_or_func_to_item_type(PredOrFunc).
-item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :-
- Item = pred_or_func_mode(_, PredOrFunc, SymName, Modes, _, _),
- adjust_func_arity(PredOrFunc, Arity, list__length(Modes)),
+ TypesAndModes, WithType, _, _, _, _, _),
+ % For predicates or functions defined using `with_type` annotations
+ % the arity here won't be correct, but equiv_type.m will record
+ % the dependency on the version number with the `incorrect' arity,
+ % so this will work.
+ (
+ WithType = no,
+ adjust_func_arity(PredOrFunc, Arity,
+ list__length(TypesAndModes))
+ ;
+ WithType = yes(_),
+ Arity = list__length(TypesAndModes)
+ ),
ItemType = pred_or_func_to_item_type(PredOrFunc).
+item_to_item_id_2(Item, ItemId) :-
+ Item = pred_or_func_mode(_, MaybePredOrFunc, SymName, Modes,
+ _, _, _),
+ ( MaybePredOrFunc = yes(PredOrFunc) ->
+ adjust_func_arity(PredOrFunc, Arity, list__length(Modes)),
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ ItemId = yes(item_id(ItemType, SymName - Arity))
+ ;
+ % We need to handle these separately because a `:- mode'
+ % declaration with a `with_inst` annotation could be
+ % for a predicate or a funciton.
+ ItemId = no
+ ).
+
% We need to handle these separately because some pragmas
% may affect a predicate and a function.
item_to_item_id_2(pragma(_), no).
@@ -428,6 +514,7 @@
item_to_item_id_2(Item, yes(item_id((typeclass), ClassName - ClassArity))) :-
Item = typeclass(_, ClassName, ClassVars, _, _),
list__length(ClassVars, ClassArity).
+
% Instances are handled separately (unlike other items, the module
% qualifier on an instance declaration is the module containing
% the class, not the module containing the instance).
@@ -582,10 +669,12 @@
item_is_unchanged(Item1, Item2) = Result :-
Item1 = pred_or_func(TVarSet1, _, ExistQVars1, PredOrFunc,
- Name, TypesAndModes1, Det1, Cond, Purity, Constraints1),
+ Name, TypesAndModes1, WithType1, _,
+ Det1, Cond, Purity, Constraints1),
(
Item2 = pred_or_func(TVarSet2, _, ExistQVars2,
- PredOrFunc, Name, TypesAndModes2, Det2, Cond, Purity,
+ PredOrFunc, Name, TypesAndModes2, WithType2,
+ _, Det2, Cond, Purity,
Constraints2),
% For predicates, ignore the determinism -- the modes and
@@ -605,8 +694,8 @@
),
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1,
- TypesAndModes1, Constraints1, TVarSet2,
- ExistQVars2, TypesAndModes2, Constraints2)
+ TypesAndModes1, WithType1, Constraints1, TVarSet2,
+ ExistQVars2, TypesAndModes2, WithType2, Constraints2)
->
Result = yes
;
@@ -615,12 +704,12 @@
item_is_unchanged(Item1, Item2) = Result :-
Item1 = pred_or_func_mode(InstVarSet1, PredOrFunc, Name, Modes1,
- Det, Cond),
+ WithInst1, Det, Cond),
(
Item2 = pred_or_func_mode(InstVarSet2, PredOrFunc,
- Name, Modes2, Det, Cond),
- pred_or_func_mode_is_unchanged(InstVarSet1, Modes1,
- InstVarSet2, Modes2)
+ Name, Modes2, WithInst2, Det, Cond),
+ pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1,
+ InstVarSet2, Modes2, WithInst2)
->
Result = yes
;
@@ -653,13 +742,13 @@
% declaration in a single varset (it doesn't know which are which).
%
:- pred pred_or_func_type_is_unchanged(tvarset::in, existq_tvars::in,
- list(type_and_mode)::in, class_constraints::in,
- tvarset::in, existq_tvars::in, list(type_and_mode)::in,
- class_constraints::in) is semidet.
+ list(type_and_mode)::in, maybe(type)::in, class_constraints::in,
+ tvarset::in, existq_tvars::in, list(type_and_mode)::in,
+ maybe(type)::in, class_constraints::in) is semidet.
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1, TypesAndModes1,
- Constraints1, TVarSet2, ExistQVars2,
- TypesAndModes2, Constraints2) :-
+ MaybeWithType1, Constraints1, TVarSet2, ExistQVars2,
+ TypesAndModes2, MaybeWithType2, Constraints2) :-
GetArgTypes =
(func(TypeAndMode0) = Type :-
@@ -675,8 +764,19 @@
),
Types1 = list__map(GetArgTypes, TypesAndModes1),
Types2 = list__map(GetArgTypes, TypesAndModes2),
+ (
+ MaybeWithType1 = yes(WithType1),
+ MaybeWithType2 = yes(WithType2),
+ AllTypes1 = [WithType1 | Types1],
+ AllTypes2 = [WithType2 | Types2]
+ ;
+ MaybeWithType1 = no,
+ MaybeWithType2 = no,
+ AllTypes1 = Types1,
+ AllTypes2 = Types2
+ ),
- type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2,
+ type_list_is_unchanged(TVarSet1, AllTypes1, TVarSet2, AllTypes2,
_TVarSet, RenameSubst, Types2ToTypes1Subst),
%
@@ -760,9 +860,11 @@
).
:- pred pred_or_func_mode_is_unchanged(inst_varset::in, list(mode)::in,
- inst_varset::in, list(mode)::in) is semidet.
+ maybe(inst)::in, inst_varset::in, list(mode)::in,
+ maybe(inst)::in) is semidet.
-pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, InstVarSet2, Modes2) :-
+pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, MaybeWithInst1,
+ InstVarSet2, Modes2, MaybeWithInst2) :-
varset__coerce(InstVarSet1, VarSet1),
varset__coerce(InstVarSet2, VarSet2),
@@ -781,10 +883,24 @@
ModeToTerm = (func(Mode) = term__coerce(mode_to_term(Mode))),
ModeTerms1 = list__map(ModeToTerm, Modes1),
ModeTerms2 = list__map(ModeToTerm, Modes2),
- term__apply_substitution_to_list(ModeTerms2,
- InstSubst, SubstModeTerms2),
- type_list_subsumes(ModeTerms1, SubstModeTerms2, _),
- type_list_subsumes(SubstModeTerms2, ModeTerms1, _).
+ (
+ MaybeWithInst1 = yes(Inst1),
+ MaybeWithInst2 = yes(Inst2),
+ WithInstTerm1 = term__coerce(mode_to_term(free -> Inst1)),
+ WithInstTerm2 = term__coerce(mode_to_term(free -> Inst2)),
+ AllModeTerms1 = [WithInstTerm1 | ModeTerms1],
+ AllModeTerms2 = [WithInstTerm2 | ModeTerms2]
+ ;
+ MaybeWithInst1 = no,
+ MaybeWithInst2 = no,
+ AllModeTerms1 = ModeTerms1,
+ AllModeTerms2 = ModeTerms2
+ ),
+
+ term__apply_substitution_to_list(AllModeTerms2,
+ InstSubst, SubstAllModeTerms2),
+ type_list_subsumes(AllModeTerms1, SubstAllModeTerms2, _),
+ type_list_subsumes(SubstAllModeTerms2, AllModeTerms1, _).
%
% Combined typeclass method type and mode declarations are split
@@ -806,21 +922,22 @@
class_methods_are_unchanged([Method1 | Methods1], [Method2 | Methods2]) :-
(
Method1 = pred_or_func(TVarSet1, _, ExistQVars1, PredOrFunc,
- Name, TypesAndModes1, Detism, Cond, Purity,
- Constraints1, _),
+ Name, TypesAndModes1, WithType1, _,
+ Detism, Cond, Purity, Constraints1, _),
Method2 = pred_or_func(TVarSet2, _, ExistQVars2, PredOrFunc,
- Name, TypesAndModes2, Detism, Cond, Purity,
- Constraints2, _),
+ Name, TypesAndModes2, WithType2, _,
+ Detism, Cond, Purity, Constraints2, _),
pred_or_func_type_is_unchanged(TVarSet1, ExistQVars1,
- TypesAndModes1, Constraints1, TVarSet2, ExistQVars2,
- TypesAndModes2, Constraints2)
+ TypesAndModes1, WithType1, Constraints1,
+ TVarSet2, ExistQVars2, TypesAndModes2, WithType2,
+ Constraints2)
;
Method1 = pred_or_func_mode(InstVarSet1, PredOrFunc, Name,
- Modes1, Det, Cond, _),
+ Modes1, WithInst1, Det, Cond, _),
Method2 = pred_or_func_mode(InstVarSet2, PredOrFunc, Name,
- Modes2, Det, Cond, _),
- pred_or_func_mode_is_unchanged(InstVarSet1, Modes1,
- InstVarSet2, Modes2)
+ Modes2, WithInst2, Det, Cond, _),
+ pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1,
+ InstVarSet2, Modes2, WithInst2)
),
class_methods_are_unchanged(Methods1, Methods2).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.243
diff -u -u -r1.243 reference_manual.texi
--- doc/reference_manual.texi 5 Mar 2002 16:55:14 -0000 1.243
+++ doc/reference_manual.texi 6 Mar 2002 14:35:44 -0000
@@ -1555,6 +1555,31 @@
:- func length(list(T)) = int.
@end example
+A predicate or function can by declared to have a given higher-order
+type by using `with_type` in the type declaration. This is useful
+where several predicates or functions need to have the same type
+signature, which often occurs for typeclass method implementations
+(@pxref{Type classes}, and for predicates to be passed as higher-order
+terms (@pxref{Higher-order}).
+
+For example,
+
+ at example
+:- type foldl_pred(T, U) == pred(T, U, U).
+:- type foldl_func(T, U) == (func(T, U) = U).
+
+:- pred p(int) `with_type` foldl_pred(T, U).
+:- pred f(int) `with_type` foldl_func(T, U).
+ at end example
+
+ at noindent
+is equivalent to
+
+ at example
+:- pred p(int, T, U, U).
+:- pred f(int, T, U) = U.
+ at end example
+
Type variables in predicate and function declarations
are implicitly universally quantified by default;
that is, the predicate or function may be called with arguments
@@ -2029,6 +2054,30 @@
@example
:- func length(list(T)::in) = (int::out).
:- pred append(list(T)::in, list(T)::in, list(T)::out).
+
+:- pred p `with_type` foldl_pred(T, U) `with_inst` foldl_pred.
+ at end example
+
+As for type declarations, a predicate or function can be defined
+to have a given higher-order inst by using `with_inst` in the
+mode declaration.
+
+For example,
+
+ at example
+:- inst foldl_pred == (pred(in, in, out) is det).
+:- inst foldl_func == (func(in, in) = out is det).
+
+:- mode p(in) `with_inst` foldl_pred.
+:- mode f(in) `with_inst` foldl_func.
+ at end example
+
+ at noindent
+is equivalent to
+
+ at example
+:- mode p(in, in, in, out) is det.
+:- mode f(in, in, in) = out is det.
@end example
If there is no mode declaration for a function, the compiler assumes
Index: library/list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.104
diff -u -u -r1.104 list.m
--- library/list.m 8 Feb 2002 01:37:00 -0000 1.104
+++ library/list.m 16 Feb 2002 17:18:11 -0000
@@ -573,6 +573,17 @@
:- mode list__map_foldl(pred(in, out, in, out) is nondet, in, out, in, out)
is nondet.
+ % Same as list__map_foldl, but with two accumulators.
+:- pred list__map_foldl2(pred(X, Y, A, A, B, B), list(X), list(Y), A, A, B, B).
+:- mode list__map_foldl2(pred(in, out, in, out, di, uo) is det,
+ in, out, in, out, di, uo) is det.
+:- mode list__map_foldl2(pred(in, out, in, out, in, out) is det,
+ in, out, in, out, in, out) is det.
+:- mode list__map_foldl2(pred(in, out, in, out, in, out) is semidet,
+ in, out, in, out, in, out) is semidet.
+:- mode list__map_foldl2(pred(in, out, in, out, in, out) is nondet,
+ in, out, in, out, in, out) is nondet.
+
% list__filter(Pred, List, TrueList) takes a closure with one
% input argument and for each member of List `X', calls the closure.
% Iff call(Pred, X) is true, then X is included in TrueList.
@@ -1335,6 +1346,11 @@
list__map_foldl(P, [H0|T0], [H|T]) -->
call(P, H0, H),
list__map_foldl(P, T0, T).
+
+list__map_foldl2(_, [], [], A, A) --> [].
+list__map_foldl2(P, [H0|T0], [H|T], A0, A) -->
+ call(P, H0, H, A0, A1),
+ list__map_foldl2(P, T0, T, A1, A).
list__foldr(_, [], Acc, Acc).
list__foldr(P, [H|T], Acc0, Acc) :-
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.263
diff -u -u -r1.263 std_util.m
--- library/std_util.m 18 Feb 2002 07:01:07 -0000 1.263
+++ library/std_util.m 19 Feb 2002 14:18:47 -0000
@@ -102,6 +102,22 @@
%
:- func map_maybe(func(T) = U, maybe(T)) = maybe(U).
+ % map_maybe(P, yes(Value0), yes(Value), Acc0, Acc) :-
+ % P(Value, Value, Acc0, Acc).
+ % map_maybe(_, no, no, Acc, Acc).
+ %
+:- pred map_foldl_maybe(pred(T, U, Acc, Acc), maybe(T), maybe(U), Acc, Acc).
+:- mode map_foldl_maybe(pred(in, out, in, out) is det, in, out, in, out) is det.
+:- mode map_foldl_maybe(pred(in, out, di, uo) is det, in, out, di, uo) is det.
+
+ % As above, but with two accumulators.
+:- pred map_foldl2_maybe(pred(T, U, Acc1, Acc1, Acc2, Acc2),
+ maybe(T), maybe(U), Acc1, Acc1, Acc2, Acc2).
+:- mode map_foldl2_maybe(pred(in, out, in, out, in, out) is det, in, out,
+ in, out, in, out) is det.
+:- mode map_foldl2_maybe(pred(in, out, in, out, di, uo) is det,
+ in, out, in, out, di, uo) is det.
+
%-----------------------------------------------------------------------------%
% The "unit" type - stores no information at all.
@@ -712,6 +728,14 @@
map_maybe(_, no) = no.
map_maybe(F, yes(T)) = yes(F(T)).
+
+map_foldl_maybe(_, no, no, Acc, Acc).
+map_foldl_maybe(P, yes(T0), yes(T), Acc0, Acc) :-
+ P(T0, T, Acc0, Acc).
+
+map_foldl2_maybe(_, no, no, A, A, B, B).
+map_foldl2_maybe(P, yes(T0), yes(T), A0, A, B0, B) :-
+ P(T0, T, A0, A, B0, B).
/****
Is this really useful?
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.104
diff -u -u -r1.104 Mmakefile
--- tests/invalid/Mmakefile 5 Mar 2002 20:25:42 -0000 1.104
+++ tests/invalid/Mmakefile 6 Mar 2002 14:35:55 -0000
@@ -127,7 +127,8 @@
uniq_modes.m \
uniq_neg.m \
uu_type.m \
- vars_in_wrong_places.m
+ vars_in_wrong_places.m \
+ with_type.m
SOURCES= $(SINGLEMODULE_SOURCES) $(MULTIMODULE_SOURCES)
Index: tests/invalid/circ_type.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/circ_type.err_exp,v
retrieving revision 1.1
diff -u -u -r1.1 circ_type.err_exp
--- tests/invalid/circ_type.err_exp 4 Nov 1996 07:14:35 -0000 1.1
+++ tests/invalid/circ_type.err_exp 7 Mar 2002 18:34:05 -0000
@@ -1,4 +1,4 @@
-circ_type.m:006: Error: circular equivalence type `circ_type:circ'/0.
-circ_type.m:008: Error: circular equivalence type `circ_type:circ1'/0.
-circ_type.m:010: Error: circular equivalence type `circ_type:circ2'/0.
+circ_type.m:006: Error: circular equivalence type `circ_type:circ/0'.
+circ_type.m:008: Error: circular equivalence type `circ_type:circ1/0'.
+circ_type.m:010: Error: circular equivalence type `circ_type:circ2/0'.
For more information, try recompiling with `-E'.
Index: tests/invalid/errors.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/errors.err_exp,v
retrieving revision 1.6
diff -u -u -r1.6 errors.err_exp
--- tests/invalid/errors.err_exp 12 Nov 1998 03:36:57 -0000 1.6
+++ tests/invalid/errors.err_exp 7 Mar 2002 18:34:06 -0000
@@ -10,9 +10,11 @@
errors.m:053: error: undefined type `undefined_type'/0.
errors.m:100: In definition of type `errors:needs_qualification'/0:
errors.m:100: error: undefined type `state'/0.
-errors.m:055: Error: circular equivalence type `errors:circular_eqv_type'/0.
-errors.m:057: Error: circular equivalence type `errors:indirectly_circular_eqv_type_1'/0.
-errors.m:058: Error: circular equivalence type `errors:indirectly_circular_eqv_type_2'/0.
+errors.m:055: Error: circular equivalence type `errors:circular_eqv_type/0'.
+errors.m:057: Error: circular equivalence type
+errors.m:057: `errors:indirectly_circular_eqv_type_1/0'.
+errors.m:058: Error: circular equivalence type
+errors.m:058: `errors:indirectly_circular_eqv_type_2/0'.
errors.m:028: Error: mode declaration for predicate `errors:mode_declaration_without_pred_declaration/0'
errors.m:028: without preceding `pred' declaration.
errors.m:032: Error: mode declaration for predicate `errors:missing_pred_declaration/0'
Index: tests/invalid/errors1.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/errors1.err_exp,v
retrieving revision 1.3
diff -u -u -r1.3 errors1.err_exp
--- tests/invalid/errors1.err_exp 30 Oct 1998 04:38:43 -0000 1.3
+++ tests/invalid/errors1.err_exp 24 Feb 2002 10:53:54 -0000
@@ -3,9 +3,11 @@
errors1.m:051: error: undefined type `undefined_type'/0.
errors1.m:053: In definition of type `errors1:eqv_type_which_references_undefined_type'/0:
errors1.m:053: error: undefined type `undefined_type'/0.
-errors1.m:055: Error: circular equivalence type `errors1:circular_eqv_type'/0.
-errors1.m:057: Error: circular equivalence type `errors1:indirectly_circular_eqv_type_1'/0.
-errors1.m:058: Error: circular equivalence type `errors1:indirectly_circular_eqv_type_2'/0.
+errors1.m:055: Error: circular equivalence type `errors1:circular_eqv_type/0'.
+errors1.m:057: Error: circular equivalence type
+errors1.m:057: `errors1:indirectly_circular_eqv_type_1/0'.
+errors1.m:058: Error: circular equivalence type
+errors1.m:058: `errors1:indirectly_circular_eqv_type_2/0'.
errors1.m:028: Error: mode declaration for predicate `errors1:mode_declaration_without_pred_declaration/0'
errors1.m:028: without preceding `pred' declaration.
errors1.m:032: Error: mode declaration for predicate `errors1:missing_pred_declaration/0'
Index: tests/invalid/type_loop.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/type_loop.err_exp,v
retrieving revision 1.1
diff -u -u -r1.1 type_loop.err_exp
--- tests/invalid/type_loop.err_exp 20 Jan 1997 04:37:55 -0000 1.1
+++ tests/invalid/type_loop.err_exp 24 Feb 2002 10:54:00 -0000
@@ -1,2 +1,2 @@
-type_loop.m:016: Error: circular equivalence type `type_loop:foo'/0.
+type_loop.m:016: Error: circular equivalence type `type_loop:foo/0'.
For more information, try recompiling with `-E'.
Index: tests/invalid/vars_in_wrong_places.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/vars_in_wrong_places.err_exp,v
retrieving revision 1.3
diff -u -u -r1.3 vars_in_wrong_places.err_exp
--- tests/invalid/vars_in_wrong_places.err_exp 12 Nov 1998 03:36:57 -0000 1.3
+++ tests/invalid/vars_in_wrong_places.err_exp 16 Feb 2002 19:37:27 -0000
@@ -3,7 +3,7 @@
vars_in_wrong_places.m:004: Error: atom expected in equation head: _1 = 42.
Error: atom expected in `:- pred' declaration: _1.
vars_in_wrong_places.m:006: Error: atom expected in `:- func' declaration: _1 = int.
-Error: atom expected in predicate `:- mode' declaration: _1.
+Error: atom expected in `:- mode' declaration: _1.
vars_in_wrong_places.m:008: Error: atom expected in function `:- mode' declaration: _1 = int.
vars_in_wrong_places.m: 1: Warning: interface for module `vars_in_wrong_places' does not export anything.
For more information, try recompiling with `-E'.
Index: tests/invalid/with_type.err_exp
===================================================================
RCS file: tests/invalid/with_type.err_exp
diff -N tests/invalid/with_type.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/with_type.err_exp 11 Mar 2002 04:43:25 -0000
@@ -0,0 +1,18 @@
+with_type.m:012: In type declaration for predicate `with_type:with_type_1':
+with_type.m:012: error: expected higher order predicate type after
+with_type.m:012: `with_type`.
+with_type.m:013: In mode declaration for `with_type:with_type_1':
+with_type.m:013: error: expected higher order inst after `with_inst`.
+with_type.m:018: In type declaration for function `with_type:with_type_2':
+with_type.m:018: error: expected higher order function type after
+with_type.m:018: `with_type`.
+with_type.m:021: In type declaration for predicate `with_type:with_type_3':
+with_type.m:021: error: the `with_type` and `with_inst` annotations are
+with_type.m:021: incompatible.
+with_type.m:019: Error: mode declaration for function `with_type:with_type_2/3'
+with_type.m:019: without preceding `func' declaration.
+with_type.m:026: Error: clause for predicate `with_type:with_type_1/4'
+with_type.m:026: without preceding `pred' declaration.
+with_type.m:030: Error: clause for predicate `with_type:with_type_3/4'
+with_type.m:030: without preceding `pred' declaration.
+For more information, try recompiling with `-E'.
Index: tests/invalid/with_type.m
===================================================================
RCS file: tests/invalid/with_type.m
diff -N tests/invalid/with_type.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/with_type.m 11 Mar 2002 04:42:43 -0000
@@ -0,0 +1,30 @@
+:- module with_type.
+
+:- interface.
+
+:- import_module list.
+
+:- type map_pred(T, U) == pred(T, U).
+:- inst map_pred = (pred(in, out) is det).
+:- type foldl_pred(T, U) == pred(T, U, U).
+:- inst foldl_pred = (pred(in, in, out) is det).
+
+:- pred with_type_1(T, list(_)) `with_type` int.
+:- mode with_type_1(in, in) `with_inst` ground.
+
+:- type map_func(T, U) == (func(T) = U).
+:- inst map_func = (func(in) = out is det).
+
+:- func with_type_2(T, list(_)) `with_type` map_pred(string, string).
+:- mode with_type_2(in, in) `with_inst` map_func.
+
+:- pred with_type_3(T::in, list(_)::in) `with_type` map_pred(string, string)
+ `with_inst` foldl_pred.
+
+:- implementation.
+
+with_type_1(_, _, X, X).
+
+with_type_2(_, _, X) = X.
+
+with_type_3(_, _, X, X).
Index: tests/recompilation/TESTS
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/TESTS,v
retrieving revision 1.9
diff -u -u -r1.9 TESTS
--- tests/recompilation/TESTS 5 Jan 2002 12:00:00 -0000 1.9
+++ tests/recompilation/TESTS 24 Feb 2002 08:49:58 -0000
@@ -25,7 +25,8 @@
typeclass_method_pragma_r \
type_spec_rename_var_r \
type_spec_unname_var_r \
- unchanged_pred_nr"
+ unchanged_pred_nr \
+ unchanged_with_type_nr"
# Parallel mmake with nested sub-modules is broken.
# The commands to create `.c' files from the `.m' file containing the
@@ -38,6 +39,7 @@
TESTS_SHOULD_FAIL="\
add_type_re \
remove_type_re \
- type_qual_re"
+ type_qual_re \
+ with_type_re"
ALL_TESTS="$TESTS_SHOULD_SUCCEED $NO_PARALLEL_MAKE_TESTS $TESTS_SHOULD_FAIL"
Index: tests/recompilation/unchanged_with_type_nr.err_exp.2
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr.err_exp.2
diff -N tests/recompilation/unchanged_with_type_nr.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr.err_exp.2 23 Feb 2002 13:56:21 -0000
@@ -0,0 +1 @@
+Not recompiling module unchanged_with_type_nr.
Index: tests/recompilation/unchanged_with_type_nr.exp.1
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr.exp.1
diff -N tests/recompilation/unchanged_with_type_nr.exp.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr.exp.1 10 Mar 2002 15:42:41 -0000
@@ -0,0 +1,5 @@
+OK
+OK
+OK
+OK
+OK
Index: tests/recompilation/unchanged_with_type_nr.exp.2
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr.exp.2
diff -N tests/recompilation/unchanged_with_type_nr.exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr.exp.2 10 Mar 2002 15:42:48 -0000
@@ -0,0 +1,5 @@
+OK
+OK
+OK
+OK
+OK
Index: tests/recompilation/unchanged_with_type_nr.m.1
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr.m.1
diff -N tests/recompilation/unchanged_with_type_nr.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr.m.1 10 Mar 2002 15:57:08 -0000
@@ -0,0 +1,29 @@
+:- module unchanged_with_type_nr.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module unchanged_with_type_nr_2.
+:- import_module list.
+
+main -->
+ { with_type_1([1], [1], "OK\n", Str1) },
+ io__write_string(Str1),
+
+ { Str2 = with_type_2([1], [1], "OK\n") },
+ io__write_string(Str2),
+
+ { with_type_3([1], [1], "OK\n", Str3) },
+ io__write_string(Str3),
+
+ { with_type_4("OK\n", Str4) },
+ io__write_string(Str4),
+
+ { Str5 = with_type_5("OK\n") },
+ io__write_string(Str5).
+
Index: tests/recompilation/unchanged_with_type_nr_2.err_exp.2
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr_2.err_exp.2
diff -N tests/recompilation/unchanged_with_type_nr_2.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr_2.err_exp.2 17 Feb 2002 15:45:49 -0000
@@ -0,0 +1,2 @@
+Recompiling module `unchanged_with_type_nr_2':
+ file `unchanged_with_type_nr_2.m' has changed.
Index: tests/recompilation/unchanged_with_type_nr_2.m.1
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr_2.m.1
diff -N tests/recompilation/unchanged_with_type_nr_2.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr_2.m.1 10 Mar 2002 16:11:50 -0000
@@ -0,0 +1,37 @@
+:- module unchanged_with_type_nr_2.
+
+:- interface.
+
+:- import_module list.
+
+:- type map_pred(T, U) == pred(T, U).
+:- inst map_pred = (pred(in, out) is det).
+
+:- pred with_type_1(T, list(_)) `with_type` map_pred(string, string).
+:- mode with_type_1(in, in) `with_inst` map_pred.
+:- pragma type_spec(with_type_1/4, T = list(_)).
+
+:- type map_func(T, U) == (func(T) = U).
+:- inst map_func = (func(in) = out is det).
+
+:- func with_type_2(T, list(_)) `with_type` map_func(string, string).
+:- mode with_type_2(in, in) `with_inst` map_func.
+
+:- pred with_type_3(T::in, list(_)::in) `with_type` map_pred(string, string)
+ `with_inst` map_pred.
+
+:- pred with_type_4 `with_type` map_pred(T, T) `with_inst` map_pred.
+
+:- func with_type_5 `with_type` map_func(T, T) `with_inst` map_func.
+
+:- implementation.
+
+with_type_1(_, _, X, X).
+
+with_type_2(_, _, X) = X.
+
+with_type_3(_, _, X, X).
+
+with_type_4(X, X).
+
+with_type_5(X) = X.
Index: tests/recompilation/unchanged_with_type_nr_2.m.2
===================================================================
RCS file: tests/recompilation/unchanged_with_type_nr_2.m.2
diff -N tests/recompilation/unchanged_with_type_nr_2.m.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/unchanged_with_type_nr_2.m.2 10 Mar 2002 16:12:09 -0000
@@ -0,0 +1,39 @@
+:- module unchanged_with_type_nr_2.
+
+:- interface.
+
+:- import_module list.
+
+:- type map_pred(T, U) == pred(T, U).
+:- inst map_pred = (pred(in, out) is det).
+
+:- pred with_type_1(T, list(_)) `with_type` map_pred(string, string).
+:- mode with_type_1(in, in) `with_inst` map_pred.
+:- pragma type_spec(with_type_1/4, T = list(_)).
+
+:- type map_func(T, U) == (func(T) = U).
+:- inst map_func = (func(in) = out is det).
+
+:- func with_type_2(T, list(_)) `with_type` map_func(string, string).
+:- mode with_type_2(in, in) `with_inst` map_func.
+
+:- pred with_type_3(T::in, list(_)::in) `with_type` map_pred(string, string)
+ `with_inst` map_pred.
+
+:- pred with_type_4 `with_type` map_pred(T, T) `with_inst` map_pred.
+
+:- func with_type_5 `with_type` map_func(T, T) `with_inst` map_func.
+
+:- type t == int.
+
+:- implementation.
+
+with_type_1(_, _, X, X).
+
+with_type_2(_, _, X) = X.
+
+with_type_3(_, _, X, X).
+
+with_type_4(X, X).
+
+with_type_5(X) = X.
Index: tests/recompilation/with_type_re.err_exp.2
===================================================================
RCS file: tests/recompilation/with_type_re.err_exp.2
diff -N tests/recompilation/with_type_re.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re.err_exp.2 24 Feb 2002 09:14:00 -0000
@@ -0,0 +1,13 @@
+Recompiling module `with_type_re':
+ type `with_type_re_2:map_pred/2' was modified.
+Recompiling module `with_type_re':
+ inst `with_type_re_2:map_pred/0' was modified.
+Recompiling module `with_type_re':
+ function `with_type_re_2:with_type_2/2' was modified.
+Recompiling module `with_type_re':
+ addition of predicate `with_type_re_2:with_type_3/4' could cause an ambiguity
+ with predicate `with_type_re:with_type_3/4'.
+with_type_re.m:015: In clause for predicate `with_type_re:main/2':
+with_type_re.m:015: error: wrong number of arguments (4; should be 5)
+with_type_re.m:015: in call to predicate `with_type_1'.
+For more information, try recompiling with `-E'.
Index: tests/recompilation/with_type_re.exp.1
===================================================================
RCS file: tests/recompilation/with_type_re.exp.1
diff -N tests/recompilation/with_type_re.exp.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re.exp.1 24 Feb 2002 08:52:13 -0000
@@ -0,0 +1,3 @@
+OK
+OK
+OK
Index: tests/recompilation/with_type_re.m.1
===================================================================
RCS file: tests/recompilation/with_type_re.m.1
diff -N tests/recompilation/with_type_re.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re.m.1 24 Feb 2002 08:52:03 -0000
@@ -0,0 +1,26 @@
+:- module with_type_re.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module with_type_re_2.
+:- import_module list, string.
+
+main -->
+ { with_type_1([1], [1], "OK\n", Str1) },
+ io__write_string(Str1),
+
+ { Str2 = with_type_2([1], [1], "OK\n") },
+ io__write_string(Str2),
+
+ { with_type_3([1], [1], "OK\n", Str3) },
+ io__write_string(Str3).
+
+:- pred with_type_3(T::in, list(_)::in, string::in, string::out) is det.
+
+with_type_3(_, _, X, X).
Index: tests/recompilation/with_type_re_2.err_exp.2
===================================================================
RCS file: tests/recompilation/with_type_re_2.err_exp.2
diff -N tests/recompilation/with_type_re_2.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re_2.err_exp.2 24 Feb 2002 09:07:39 -0000
@@ -0,0 +1,2 @@
+Recompiling module `with_type_re_2':
+ file `with_type_re_2.m' has changed.
Index: tests/recompilation/with_type_re_2.m.1
===================================================================
RCS file: tests/recompilation/with_type_re_2.m.1
diff -N tests/recompilation/with_type_re_2.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re_2.m.1 24 Feb 2002 09:13:33 -0000
@@ -0,0 +1,23 @@
+:- module with_type_re_2.
+
+:- interface.
+
+:- import_module list.
+
+:- type map_pred(T, U) == pred(T, U).
+:- inst map_pred = (pred(in, out) is det).
+
+:- pred with_type_1(T, list(_)) `with_type` map_pred(string, string).
+:- mode with_type_1(in, in) `with_inst` map_pred.
+
+:- type map_func(T, U) == (func(T) = U).
+:- inst map_func = (func(in) = out is det).
+
+:- func with_type_2(T, list(int)) `with_type` map_func(string, string).
+:- mode with_type_2(in, in) `with_inst` map_func.
+
+:- implementation.
+
+with_type_1(_, _, X, X).
+
+with_type_2(_, _, X) = X.
Index: tests/recompilation/with_type_re_2.m.2
===================================================================
RCS file: tests/recompilation/with_type_re_2.m.2
diff -N tests/recompilation/with_type_re_2.m.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/with_type_re_2.m.2 24 Feb 2002 08:52:55 -0000
@@ -0,0 +1,28 @@
+:- module with_type_re_2.
+
+:- interface.
+
+:- import_module list.
+
+:- type map_pred(T, U) == pred(T, T, U).
+:- inst map_pred = (pred(in, in, out) is det).
+
+:- pred with_type_1(T, list(_)) `with_type` map_pred(string, string).
+:- mode with_type_1(in, in) `with_inst` map_pred.
+
+:- type map_func(T, U) == (func(T) = U).
+:- inst map_func = (func(in) = out is det).
+
+:- func with_type_2(T, list(_)) `with_type` map_func(string, string).
+:- mode with_type_2(in, in) `with_inst` map_func.
+
+:- pred with_type_3(T::in, list(_)::in) `with_type` map_pred(string, string)
+ `with_inst` map_pred.
+
+:- implementation.
+
+with_type_1(_, _, _, X, X).
+
+with_type_2(_, _, X) = X.
+
+with_type_3(_, _, _, X, X).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list