[m-rev.] For review: solver-types
Ralph Becket
rafe at cs.mu.OZ.AU
Thu Aug 19 15:55:12 AEST 2004
Here's the interdiff regarding the changes you requested:
diff -u equiv_type.m equiv_type.m
--- equiv_type.m 17 Aug 2004 23:47:45 -0000
+++ equiv_type.m 18 Aug 2004 07:18:45 -0000
@@ -407,14 +407,13 @@
solver_type(SolverTypeDetails0, MaybeUserEqComp),
solver_type(SolverTypeDetails, MaybeUserEqComp),
ContainsCirc, !VarSet, !Info) :-
- RepresentationType0 =
- SolverTypeDetails0 ^ representation_type,
+ SolverTypeDetails0 = solver_type_details(RepresentationType0, InitPred,
+ GroundInst, AnyInst),
equiv_type__replace_in_type_2(EqvMap, [TypeCtor],
- RepresentationType0, RepresentationType,
- _, ContainsCirc, !VarSet, !Info),
- SolverTypeDetails =
- SolverTypeDetails0 ^ representation_type :=
- RepresentationType.
+ RepresentationType0, RepresentationType,
+ _, ContainsCirc, !VarSet, !Info),
+ SolverTypeDetails = solver_type_details(RepresentationType, InitPred,
+ GroundInst, AnyInst).
%-----------------------------------------------------------------------------%
diff -u equiv_type_hlds.m equiv_type_hlds.m
--- equiv_type_hlds.m 17 Aug 2004 03:50:10 -0000
+++ equiv_type_hlds.m 18 Aug 2004 07:19:37 -0000
@@ -135,11 +135,12 @@
TVarSet = TVarSet0
;
Body0 = solver_type(SolverTypeDetails0, UserEq),
- RepnType0 = SolverTypeDetails0 ^ representation_type,
+ SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
+ GroundInst, AnyInst),
equiv_type__replace_in_type(EqvMap, RepnType0, RepnType, _,
TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
- SolverTypeDetails =
- SolverTypeDetails0 ^ representation_type := RepnType,
+ SolverTypeDetails = solver_type_details(RepnType, InitPred,
+ GroundInst, AnyInst),
Body = solver_type(SolverTypeDetails, UserEq)
;
Body0 = abstract_type(_),
diff -u make_hlds.m make_hlds.m
--- make_hlds.m 18 Aug 2004 01:05:45 -0000
+++ make_hlds.m 19 Aug 2004 05:38:13 -0000
@@ -524,7 +524,14 @@
constraints([], []) /* no type class constraints */
),
add_item_decl_pass_1(ToRepnTypeSigItem, Context,
- !Status, !Module, _, !IO),
+ !Status, !Module, InvalidToRepnMode, !IO),
+
+ ( InvalidToRepnMode = yes ->
+ error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+ "in ToRepn item")
+ ;
+ true
+ ),
% The `:- mode 'representation of st'(in) = out(gi) is det'
% declaration.
@@ -540,7 +547,14 @@
true /* no `where ...' */
),
add_item_decl_pass_1(ToGroundRepnModeItem, Context,
- !Status, !Module, _, !IO),
+ !Status, !Module, InvalidToGroundRepnMode, !IO),
+
+ ( InvalidToGroundRepnMode = yes ->
+ error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+ "in ToGroundRepn item")
+ ;
+ true
+ ),
% The `:- mode 'representation of st'(in(any)) =
% out(ai) is det' declaration.
@@ -556,7 +570,14 @@
true /* no `where ...' */
),
add_item_decl_pass_1(ToAnyRepnModeItem, Context,
- !Status, !Module, _, !IO),
+ !Status, !Module, InvalidToAnyRepnMode, !IO),
+
+ ( InvalidToAnyRepnMode = yes ->
+ error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+ "in ToAnyRepn item")
+ ;
+ true
+ ),
% The `:- impure
% func 'representation to ground st'(rt::in(gi)) =
@@ -580,7 +601,14 @@
constraints([], []) /* no type class constraints */
),
add_item_decl_pass_1(FromGroundRepnTypeSigItem, Context,
- !Status, !Module, _, !IO),
+ !Status, !Module, InvalidFromGroundRepnMode, !IO),
+
+ ( InvalidFromGroundRepnMode = yes ->
+ error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+ "in FromGroundRepn item")
+ ;
+ true
+ ),
% The `:- impure
% func 'representation to any st'(rt::in(ai)) =
@@ -604,7 +632,14 @@
constraints([], []) /* no type class constraints */
),
add_item_decl_pass_1(FromAnyRepnTypeSigItem, Context,
- !Status, !Module, _, !IO).
+ !Status, !Module, InvalidFromAnyRepnMode, !IO),
+
+ ( InvalidFromAnyRepnMode = yes ->
+ error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+ "in FromAnyRepn item")
+ ;
+ true
+ ).
%-----------------------------------------------------------------------------%
@@ -4078,9 +4113,9 @@
TVarSet, Type, TypeCtor, TypeBody,
Context, Status0, !Module)
;
- % rafe: XXX Should this be an error?
- %
- true
+ error("make_hlds.add_special_pred: " ++
+ "attempt to add initialise pred " ++
+ "for non-solver type")
)
)
).
reverted:
--- maybe_mlds_to_gcc.pp 14 Jul 2004 07:30:38 -0000
+++ maybe_mlds_to_gcc.pp 14 Jun 2004 04:16:16 -0000 1.8
@@ -58,7 +58,6 @@
#else
-:- import_module hlds__passes_aux.
:- import_module parse_tree__prog_out.
:- import_module string.
diff -u mercury_to_mercury.m mercury_to_mercury.m
--- mercury_to_mercury.m 18 Aug 2004 00:28:21 -0000
+++ mercury_to_mercury.m 19 Aug 2004 05:49:12 -0000
@@ -1656,68 +1656,68 @@
io__write_string(":- type ").
mercury_output_where_attributes(TVarSet,
- MaybeSolverTypeDetails, MaybeUserEqComp) -->
+ MaybeSolverTypeDetails, MaybeUserEqComp, !IO) :-
(
- { MaybeSolverTypeDetails = no },
- { MaybeUserEqComp = no }
+ MaybeSolverTypeDetails = no,
+ MaybeUserEqComp = no
->
- []
+ true
;
- { if
+ (
MaybeUserEqComp = yes(unify_compare(MaybeUnifyPred0,
MaybeComparePred0))
- then
+ ->
MaybeUnifyPred = MaybeUnifyPred0,
MaybeComparePred = MaybeComparePred0
- else
+ ;
MaybeUnifyPred = no,
MaybeComparePred = no
- },
- io__write_string("\n\twhere\t"),
+ ),
+ io__write_string("\n\twhere\t", !IO),
(
- { MaybeUserEqComp =
- yes(abstract_noncanonical_type(_)) }
+ MaybeUserEqComp =
+ yes(abstract_noncanonical_type(_))
->
- io__write_string("type_is_abstract_noncanonical")
+ io__write_string("type_is_abstract_noncanonical", !IO)
;
- { MaybeSolverTypeDetails = yes(SolverTypeDetails) }
+ MaybeSolverTypeDetails = yes(SolverTypeDetails)
->
mercury_output_solver_type_details(TVarSet,
- SolverTypeDetails),
+ SolverTypeDetails, !IO),
(
- { MaybeUnifyPred = yes(_)
+ ( MaybeUnifyPred = yes(_)
; MaybeComparePred = yes(_)
- }
+ )
->
- io__write_string(",\n\t\t")
+ io__write_string(",\n\t\t", !IO)
;
- []
+ true
)
;
- []
+ true
),
(
- { MaybeUnifyPred = yes(UnifyPredName) }
+ MaybeUnifyPred = yes(UnifyPredName)
->
- io__write_string("equality is "),
- mercury_output_bracketed_sym_name(UnifyPredName),
+ io__write_string("equality is ", !IO),
+ mercury_output_bracketed_sym_name(UnifyPredName, !IO),
(
- { MaybeComparePred = yes(_) }
+ MaybeComparePred = yes(_)
->
- io__write_string(",\n\t\t")
+ io__write_string(",\n\t\t", !IO)
;
- []
+ true
)
;
- []
+ true
),
(
- { MaybeComparePred = yes(ComparePredName) }
+ MaybeComparePred = yes(ComparePredName)
->
- io__write_string("comparison is "),
- mercury_output_bracketed_sym_name(ComparePredName)
+ io__write_string("comparison is ", !IO),
+ mercury_output_bracketed_sym_name(ComparePredName, !IO)
;
- []
+ true
)
).
diff -u modes.m modes.m
--- modes.m 7 Jul 2004 06:48:46 -0000
+++ modes.m 19 Aug 2004 00:15:49 -0000
@@ -1001,7 +1001,7 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% Modecheck a goal by abstractly interpreteting it, as explained
+% Modecheck a goal by abstractly interpreting it, as explained
% at the top of this file.
% Note: any changes here may need to be duplicated in unique_modes.m.
@@ -2129,7 +2129,6 @@
UnifyContext),
CallUnifyContext = yes(call_unify_context(Var, var(Var),
UnifyContext)),
-
(
type_util__type_is_solver_type(ModuleInfo0, VarType)
->
diff -u module_qual.m module_qual.m
--- module_qual.m 17 Aug 2004 05:08:08 -0000
+++ module_qual.m 19 Aug 2004 05:50:24 -0000
@@ -731,32 +731,28 @@
qualify_type_defn(du_type(Ctors0, MaybeUserEqComp0),
du_type(Ctors, MaybeUserEqComp),
- Info0, Info) -->
- qualify_constructors(Ctors0, Ctors, Info0, Info),
+ Info0, Info, !IO) :-
+ qualify_constructors(Ctors0, Ctors, Info0, Info, !IO),
% User-defined equality pred names will be converted into
% predicate calls and then module-qualified after type analysis
% (during mode analysis). That way they get full type overloading
% resolution, etc. Thus we don't module-qualify them here.
- { MaybeUserEqComp = MaybeUserEqComp0 }.
-qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info) -->
- qualify_type(Type0, Type, Info0, Info).
-qualify_type_defn(abstract_type(_) @ Defn, Defn, Info, Info) --> [].
-qualify_type_defn(foreign_type(_, _, _) @ Defn, Defn, Info, Info) --> [].
+ MaybeUserEqComp = MaybeUserEqComp0.
+qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info, !IO) :-
+ qualify_type(Type0, Type, Info0, Info, !IO).
+qualify_type_defn(abstract_type(_) @ Defn, Defn, Info, Info, !IO).
+qualify_type_defn(foreign_type(_, _, _) @ Defn, Defn, Info, Info, !IO).
qualify_type_defn(solver_type(SolverTypeDetails0, MaybeUserEqComp),
solver_type(SolverTypeDetails, MaybeUserEqComp),
- Info0, Info) -->
- { RepnType0 = SolverTypeDetails0 ^ representation_type },
- { GroundInst0 = SolverTypeDetails0 ^ ground_inst },
- { AnyInst0 = SolverTypeDetails0 ^ any_inst },
- qualify_type(RepnType0, RepnType, Info0, Info1),
- qualify_inst(GroundInst0, GroundInst, Info1, Info2),
- qualify_inst(AnyInst0, AnyInst, Info2, Info ),
- { SolverTypeDetails =
- (((SolverTypeDetails0
- ^ representation_type := RepnType )
- ^ ground_inst := GroundInst )
- ^ any_inst := AnyInst ) }.
+ Info0, Info, !IO) :-
+ SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
+ GroundInst0, AnyInst0),
+ qualify_type(RepnType0, RepnType, Info0, Info1, !IO),
+ qualify_inst(GroundInst0, GroundInst, Info1, Info2, !IO),
+ qualify_inst(AnyInst0, AnyInst, Info2, Info, !IO),
+ SolverTypeDetails = solver_type_details(RepnType, InitPred,
+ GroundInst, AnyInst).
:- pred qualify_constructors(list(constructor)::in, list(constructor)::out,
mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
diff -u modules.m modules.m
--- modules.m 18 Aug 2004 01:05:49 -0000
+++ modules.m 19 Aug 2004 00:20:52 -0000
@@ -7005,9 +7005,8 @@
;
TypeDefn0 = foreign_type(ForeignType, yes(_UserEqComp),
Assertions),
- TypeDefn = foreign_type(ForeignType,
- yes(abstract_noncanonical_type(
- non_solver_type)),
+ TypeDefn = foreign_type(ForeignType, yes(
+ abstract_noncanonical_type(non_solver_type)),
Assertions)
;
TypeDefn0 = solver_type(SolverTypeDetails, yes(_UserEqComp)),
diff -u prog_io.m prog_io.m
--- prog_io.m 18 Aug 2004 00:58:55 -0000
+++ prog_io.m 19 Aug 2004 05:28:55 -0000
@@ -1545,6 +1545,14 @@
WhereResult = error(String, Term),
Result = error(String, Term)
;
+ % The code to process `where'
+ % attributes will return an error
+ % result if solver attributes are
+ % given for a non-solver type.
+ % Because this is a du type, if the
+ % unification with WhereResult
+ % succeeds then _NoSolverTypeDetails
+ % is guaranteed to be `no'.
WhereResult = ok(_NoSolverTypeDetails,
MaybeUserEqComp),
process_du_type(ModuleName, H, Body, Ctors,
@@ -1750,6 +1758,10 @@
).
+ % The maybe2 wrapper allows us to return an error code or a pair
+ % of results. Either result half may be empty, hence the maybe
+ % wrapper around each of those.
+ %
:- func parse_type_decl_where_term(is_solver_type, module_name, maybe(term)) =
maybe2(maybe(solver_type_details), maybe(unify_compare)).
@@ -1853,13 +1865,13 @@
(
LHS = term__functor(term__atom(Name), [], _Context2)
->
- Result0 = Parser(RHS),
+ RHSResult = Parser(RHS),
(
- Result0 = ok(X),
- Result = ok(yes(X))
+ RHSResult = ok(ParsedRHS),
+ Result = ok(yes(ParsedRHS))
;
- Result0 = error(Msg, ProblemTerm),
- Result = error(Msg, ProblemTerm)
+ RHSResult = error(Msg, ProblemTerm),
+ Result = error(Msg, ProblemTerm)
)
;
Result = ok(no)
@@ -1873,10 +1885,8 @@
parse_where_type_is_abstract_noncanonical(Term) =
(
- Term = term__functor(
- term__atom("type_is_abstract_noncanonical"),
- [],
- _Context)
+ Term = term__functor(term__atom(
+ "type_is_abstract_noncanonical"), [], _Context)
->
ok(yes(unit))
;
@@ -1909,12 +1919,14 @@
:- func parse_where_inst_is(module_name, term) = maybe1(inst).
parse_where_inst_is(_ModuleName, Term) =
- ( if
+ (
prog_io_util__convert_inst(no_allow_constrained_inst_var,
Term, Inst),
not inst_util__inst_contains_unconstrained_var(Inst)
- then ok(Inst)
- else error("expected a ground, unconstrained inst", Term)
+ ->
+ ok(Inst)
+ ;
+ error("expected a ground, unconstrained inst", Term)
).
@@ -2049,31 +2061,6 @@
func_error("prog_io__make_maybe_where_details: " ++
"shouldn't have reached this point!")
).
-
-
-:- func solver_inst_cast_sym_name(sym_name, arity) = sym_name.
-
-solver_inst_cast_sym_name(TypeSymName, TypeArity) =
- unqualified_sym_name_with_prefix_suffix("inst cast ", TypeSymName,
- "/" ++ int_to_string(TypeArity)).
-
-
-:- func solver_inst_sym_name(sym_name, arity) = sym_name.
-
-solver_inst_sym_name(TypeSymName, TypeArity) =
- unqualified_sym_name_with_prefix_suffix("", TypeSymName,
- "/" ++ int_to_string(TypeArity) ++ " inst").
-
-
-:- func unqualified_sym_name_with_prefix_suffix(string, sym_name, string) =
- sym_name.
-
-unqualified_sym_name_with_prefix_suffix(Prefix, unqualified(Name), Suffix) =
- unqualified(Prefix ++ Name ++ Suffix).
-
-unqualified_sym_name_with_prefix_suffix(Prefix,
- qualified(ModuleSpecifier, Name), Suffix) =
- qualified(ModuleSpecifier, Prefix ++ Name ++ Suffix).
% get_determinism(Term0, Term, Determinism) binds Determinism
diff -u prog_io_pragma.m prog_io_pragma.m
--- prog_io_pragma.m 18 Aug 2004 01:05:50 -0000
+++ prog_io_pragma.m 19 Aug 2004 00:24:05 -0000
@@ -44,6 +44,13 @@
SinglePragmaTerm, VarSet, Result0)
->
(
+ % The code to process `where' attributes will
+ % return an error result if solver attributes
+ % are given for a non-solver type. Because
+ % this is a non-solver type, if the
+ % unification with WhereResult succeeds then
+ % _NoSolverTypeDetails is guaranteed to be
+ % `no'.
WherePartResult =
ok(_NoSolverTypeDetails, MaybeUserEqComp),
(
diff -u special_pred.m special_pred.m
--- special_pred.m 17 Aug 2004 06:18:21 -0000
+++ special_pred.m 19 Aug 2004 00:57:24 -0000
@@ -198,11 +198,10 @@
).
special_pred_is_generated_lazily(ModuleInfo, TypeCtor, Body, Status) :-
- % rafe: XXX Is there a cleaner way of doing this? I don't
- % want special preds for solver types to be generated lazily
- % because I have to insert calls to their initialisation preds
- % during mode analysis and I therefore require the appropriate
- % names to appear in the symbol table.
+ % We don't want special preds for solver types to be generated lazily
+ % because we have to insert calls to their initialisation preds during
+ % mode analysis and we therefore require the appropriate names to
+ % appear in the symbol table.
%
Body \= solver_type(_, _),
Body \= abstract_type(solver_type),
diff -u termination.m termination.m
--- termination.m 1 Jul 2004 02:48:24 -0000
+++ termination.m 19 Aug 2004 00:59:34 -0000
@@ -689,6 +689,9 @@
map__det_update(!.ProcTable, ProcId, ProcInfo, !:ProcTable),
set_generated_terminates(ProcIds, SpecialPredId, !ProcTable).
+ % XXX The ArgSize arguments for unify, compare and initialise
+ % are not necessarily correct since these may be user-defined.
+ %
:- pred special_pred_id_to_termination(special_pred_id::in,
list(prog_var)::in, arg_size_info::out, termination_info::out) is det.
@@ -704,8 +707,6 @@
term_util__make_bool_list(HeadVars, [no, no], OutList),
ArgSize = finite(0, OutList),
Termination = cannot_loop.
- % rafe: XXX I think the [yes] here is correct.
- %
special_pred_id_to_termination(initialise, HeadVars, ArgSize, Termination) :-
term_util__make_bool_list(HeadVars, [yes], OutList),
ArgSize = finite(0, OutList),
diff -u type_ctor_info.m type_ctor_info.m
--- type_ctor_info.m 18 Aug 2004 00:55:31 -0000
+++ type_ctor_info.m 19 Aug 2004 01:02:30 -0000
@@ -329,10 +329,9 @@
;
% We treat solver_types as being
% equivalent to their representation
- % types for RTTI purposes.
- %
- % rafe: XXX Won't this cause trouble
- % with construct etc?
+ % types for RTTI purposes. Which may
+ % cause problems with construct,
+ % similar to those for abstract types.
%
TypeBody = solver_type(SolverTypeDetails,
_MaybeUserEqComp),
diff -u type_util.m type_util.m
--- type_util.m 18 Aug 2004 00:55:43 -0000
+++ type_util.m 19 Aug 2004 04:08:32 -0000
@@ -873,8 +873,8 @@
% type_to_type_defn_body will fail for builtin types such
% as `int/0'. Such types are not solver types so
% type_util__is_solver_type fails too.
- type_util__type_to_type_defn_body(ModuleInfo, Type, TypeBody),
- type_util__type_body_is_solver_type(ModuleInfo, TypeBody).
+ type_to_type_defn_body(ModuleInfo, Type, TypeBody),
+ type_body_is_solver_type(ModuleInfo, TypeBody).
% Succeed if the type body is for a solver type.
--------------------------------------------------------------------------
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