[m-rev.] diff: minor cleanups
Zoltan Somogyi
zs at csse.unimelb.edu.au
Sun Oct 1 14:44:17 AEST 2006
compiler/special_pred.m:
Fix grammar in the name of a predicate.
Minor cleanups.
compiler/add_special_pred.m:
Conform to the change in special_pred.m.
compiler/atsort.m:
compiler/clause_to_proc.m:
compiler/constraint.m:
compiler/deforest.m:
compiler/hlds_out.m:
compiler/loop_inv.m:
compiler/mercury_to_mercury.m:
compiler/ml_code_gen.m:
compiler/ml_tailcall.m:
compiler/mlds_to_c.m:
compiler/rtti_to_mlds.m:
compiler/type_util.m:
compiler/untupling.m:
library/dir.m:
library/eqvclass.m:
library/type_desc.m:
Minor cleanups.
library/queue.m:
Use a real type, not a pair, to represent queues, and document its
meaning.
tests/hard_coded/type_to_term_bug.exp:
Conform to the change to queue representations.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_special_pred.m,v
retrieving revision 1.16
diff -u -b -r1.16 add_special_pred.m
--- compiler/add_special_pred.m 22 Aug 2006 05:03:37 -0000 1.16
+++ compiler/add_special_pred.m 25 Sep 2006 14:06:17 -0000
@@ -302,7 +302,7 @@
adjust_types_with_special_preds_in_private_builtin(Type) = NormalizedType :-
( type_to_ctor_and_args(Type, TypeCtor, []) ->
- ( is_builtin_types_special_preds_defined_in_mercury(TypeCtor, Name) ->
+ ( is_builtin_type_special_preds_defined_in_mercury(TypeCtor, Name) ->
construct_type(type_ctor(unqualified(Name), 0), [], NormalizedType)
;
NormalizedType = Type
Index: compiler/atsort.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/atsort.m,v
retrieving revision 1.18
diff -u -b -r1.18 atsort.m
--- compiler/atsort.m 31 Jul 2006 08:31:28 -0000 1.18
+++ compiler/atsort.m 25 Sep 2006 13:19:40 -0000
@@ -93,10 +93,12 @@
Sorted) :-
atsort_repeat_source_sink(Nodes0, !Succmap, !Predmap,
[], Source1, Mid1, [], Sink1),
- ( Mid1 = [] ->
+ (
+ Mid1 = [],
list.reverse(Source1, Source1rev),
list.append(Source1rev, Sink1, Sorted)
;
+ Mid1 = [_ | _],
atsort_choose(Mid1, !Succmap, !Predmap, MustSuccmap, MustPredmap,
PrefOrder, Chosen, Mid2),
% write('Chosen: '),
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.71
diff -u -b -r1.71 clause_to_proc.m
--- compiler/clause_to_proc.m 27 Sep 2006 06:16:49 -0000 1.71
+++ compiler/clause_to_proc.m 29 Sep 2006 01:56:56 -0000
@@ -288,12 +288,16 @@
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
Clause = clause(ProcIds, _, _, _),
% An empty list here means that the clause applies to all procs.
- ( ProcIds = [] ->
+ (
+ ProcIds = [],
MatchingClauses = [Clause | MatchingClauses1]
- ; list.member(ProcId, ProcIds) ->
+ ;
+ ProcIds = [_ | _],
+ ( list.member(ProcId, ProcIds) ->
MatchingClauses = [Clause | MatchingClauses1]
;
MatchingClauses = MatchingClauses1
+ )
),
select_matching_clauses(Clauses, ProcId, MatchingClauses1).
@@ -533,8 +537,8 @@
ExistConstraints0 = [ExistConstraint | ExistConstraints]
;
ExistConstraints0 = [],
- unexpected(this_file, "introduce_exists_casts_extra: " ++
- "missing constraint")
+ unexpected(this_file,
+ "introduce_exists_casts_extra: missing constraint")
),
rtti_det_insert_typeclass_info_var(ExistConstraint, Var,
!RttiVarMaps),
@@ -545,8 +549,8 @@
maybe_add_type_info_locns(ConstraintArgs, Var, 1, !RttiVarMaps)
;
VarInfo = non_rtti_var,
- unexpected(this_file, "introduce_exists_casts_extra: " ++
- "rtti_varmaps info not found")
+ unexpected(this_file,
+ "introduce_exists_casts_extra: rtti_varmaps info not found")
)
;
Var = Var0,
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.80
diff -u -b -r1.80 constraint.m
--- compiler/constraint.m 20 Sep 2006 09:42:03 -0000 1.80
+++ compiler/constraint.m 25 Sep 2006 13:20:55 -0000
@@ -281,8 +281,7 @@
% Annotate each conjunct with the variables it produces.
%
:- pred annotate_conj_output_vars(list(hlds_goal)::in, module_info::in,
- vartypes::in, instmap::in, annotated_conj::in, annotated_conj::out)
- is det.
+ vartypes::in, instmap::in, annotated_conj::in, annotated_conj::out) is det.
annotate_conj_output_vars([], _, _, _, !RevGoals).
annotate_conj_output_vars([Goal | Goals], ModuleInfo, VarTypes, InstMap0,
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.72
diff -u -b -r1.72 deforest.m
--- compiler/deforest.m 7 Sep 2006 05:50:52 -0000 1.72
+++ compiler/deforest.m 25 Sep 2006 13:21:15 -0000
@@ -460,7 +460,7 @@
CnstrGoal = _ - CnstrGoalInfo,
goal_info_has_feature(CnstrGoalInfo, feature_constraint)
), Goals0, Constraints, Goals1),
- Constraints \= []
+ Constraints = [_ | _]
->
sym_name_to_string(SymName, SymNameString),
pd_debug_message("propagating constraints into call to %s\n",
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.403
diff -u -b -r1.403 hlds_out.m
--- compiler/hlds_out.m 10 Sep 2006 23:39:00 -0000 1.403
+++ compiler/hlds_out.m 25 Sep 2006 13:22:34 -0000
@@ -2139,7 +2139,7 @@
string.contains_char(Verbose, 's'),
goal_info_get_store_map(GoalInfo, StoreMap),
map.to_assoc_list(StoreMap, StoreMapList),
- StoreMapList \= []
+ StoreMapList = [_ | _]
->
write_indent(Indent, !IO),
io.write_string("% store map:\n", !IO),
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.37
diff -u -b -r1.37 loop_inv.m
--- compiler/loop_inv.m 22 Aug 2006 05:03:52 -0000 1.37
+++ compiler/loop_inv.m 25 Sep 2006 13:22:49 -0000
@@ -217,7 +217,7 @@
% We only apply the optimization if the set of invariant goals
% is non-empty.
%
- InvGoals \= []
+ InvGoals = [_ | _]
% NOTE! At this point it is vital that
% - none of the InvVars are used as (partially) unique
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.303
diff -u -b -r1.303 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 20 Sep 2006 09:42:07 -0000 1.303
+++ compiler/mercury_to_mercury.m 25 Sep 2006 13:25:24 -0000
@@ -2029,7 +2029,7 @@
split_types_and_modes(TypesAndModes, Types, MaybeModes),
(
MaybeModes = yes(Modes),
- ( Modes \= []
+ ( Modes = [_ | _]
; WithInst = yes(_)
)
->
@@ -2897,7 +2897,7 @@
( Vars = [_ | _]
; DotSVars = [_ | _]
),
- ColonSVars \= []
+ ColonSVars = [_ | _]
->
io.write_string(", ", !IO)
;
@@ -2923,14 +2923,13 @@
io.write_string(BangPrefix, !IO),
mercury_format_var(VarSet, AppendVarnums, SVar, !IO),
(
- SVars \= []
- ->
- io.write_string(", ", !IO)
- ;
- true
- ),
+ SVars = [_ | _],
+ io.write_string(", ", !IO),
mercury_output_state_vars_using_prefix(SVars, BangPrefix, VarSet,
- AppendVarnums, !IO).
+ AppendVarnums, !IO)
+ ;
+ SVars = []
+ ).
:- pred mercury_output_comma_if_needed(bool::in, io::di, io::uo) is det.
@@ -4278,7 +4277,7 @@
(
Items = []
;
- Items = [_|_],
+ Items = [_ | _],
output_string(Sep, !Str),
output_list(Items, Sep, Pred, !Str)
).
@@ -4549,10 +4548,10 @@
write_vars_and_types(HeadVars, VarSet, HeadVarTypes, TypeVarSet, !IO) :-
(
- HeadVars = []
- ->
+ HeadVars = [],
io.write_string("vars, types", !IO)
;
+ HeadVars = [_ | _],
io.write_string("vars(", !IO),
mercury_output_vars(HeadVars, VarSet, no, !IO),
io.write_string("), ", !IO),
@@ -4563,8 +4562,9 @@
io.write_string(")", !IO)
).
-:- pred write_type_of_var(vartypes::in, tvarset::in, prog_var::in, io::di,
- io::uo) is det.
+:- pred write_type_of_var(vartypes::in, tvarset::in, prog_var::in,
+ io::di, io::uo) is det.
+
write_type_of_var(VarTypes, TypeVarSet, Var, !IO):-
map.lookup(VarTypes, Var, VarType),
mercury_output_type(TypeVarSet, no, VarType, !IO).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.186
diff -u -b -r1.186 ml_code_gen.m
--- compiler/ml_code_gen.m 22 Aug 2006 05:03:53 -0000 1.186
+++ compiler/ml_code_gen.m 25 Sep 2006 13:26:43 -0000
@@ -993,9 +993,10 @@
;
ProcIds = pred_info_non_imported_procids(PredInfo)
),
- ( ProcIds = [] ->
- true
+ (
+ ProcIds = []
;
+ ProcIds = [_ | _],
write_pred_progress_message("% Generating MLDS code for ",
PredId, ModuleInfo, !IO),
pred_info_get_procedures(PredInfo, ProcTable),
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.41
diff -u -b -r1.41 ml_tailcall.m
--- compiler/ml_tailcall.m 7 Sep 2006 05:50:58 -0000 1.41
+++ compiler/ml_tailcall.m 25 Sep 2006 14:03:06 -0000
@@ -176,8 +176,8 @@
= mlds_function_body.
mark_tailcalls_in_function_body(body_external, _, _) = body_external.
-mark_tailcalls_in_function_body(body_defined_here(Statement0), AtTail,
- Locals) = body_defined_here(Statement) :-
+mark_tailcalls_in_function_body(body_defined_here(Statement0), AtTail, Locals)
+ = body_defined_here(Statement) :-
Statement = mark_tailcalls_in_statement(Statement0, AtTail, Locals).
:- func mark_tailcalls_in_maybe_statement(maybe(statement), at_tail, locals)
@@ -194,25 +194,27 @@
mark_tailcalls_in_statements([], _, _) = [].
mark_tailcalls_in_statements([First0 | Rest0], AtTail, Locals) =
[First | Rest] :-
- % If the First statement is followed by a `return' statement, then it is
- % in a tailcall position. If there are no statements after the first, then
- % the first statement is in a tail call position iff the statement list
- % is in a tail call position. Otherwise, i.e. if the first statement
+ % If there are no statements after the first, then the first statement
+ % is in a tail call position iff the statement list is in a tail call
+ % position. If the First statement is followed by a `return' statement,
+ % then it is in a tailcall position. Otherwise, i.e. if the first statement
% is followed by anything other than a `return' statement, then
% the first statement is not in a tail call position.
- %
- ( Rest = [statement(return(ReturnVals), _) | _] ->
- FirstAtTail = yes(ReturnVals)
- ; Rest = [] ->
+ (
+ Rest = [],
FirstAtTail = AtTail
;
+ Rest = [FirstRest | _],
+ ( FirstRest = statement(return(ReturnVals), _) ->
+ FirstAtTail = yes(ReturnVals)
+ ;
FirstAtTail = no
+ )
),
First = mark_tailcalls_in_statement(First0, FirstAtTail, Locals),
Rest = mark_tailcalls_in_statements(Rest0, AtTail, Locals).
-:- func mark_tailcalls_in_statement(statement, at_tail, locals)
- = statement.
+:- func mark_tailcalls_in_statement(statement, at_tail, locals) = statement.
mark_tailcalls_in_statement(Statement0, AtTail, Locals) = Statement :-
Statement0 = statement(Stmt0, Context),
@@ -267,9 +269,8 @@
Stmt = Stmt0
;
Stmt0 = mlcall(Sig, Func, Obj, Args, ReturnLvals, CallKind0),
- %
- % check if we can mark this call as a tail call
- %
+
+ % Check if we can mark this call as a tail call.
(
CallKind0 = ordinary_call,
@@ -318,8 +319,7 @@
list(mlds_switch_case).
mark_tailcalls_in_cases([], _, _) = [].
-mark_tailcalls_in_cases([Case0 | Cases0], AtTail, Locals) =
- [Case | Cases] :-
+mark_tailcalls_in_cases([Case0 | Cases0], AtTail, Locals) = [Case | Cases] :-
Case = mark_tailcalls_in_case(Case0, AtTail, Locals),
Cases = mark_tailcalls_in_cases(Cases0, AtTail, Locals).
@@ -350,8 +350,7 @@
% (so that assignments to them won't have any side effects),
% so that we can optimize the call into a tailcall.
-:- pred match_return_vals(list(mlds_rval)::in, list(mlds_lval)::in)
- is semidet.
+:- pred match_return_vals(list(mlds_rval)::in, list(mlds_lval)::in) is semidet.
match_return_vals([], []).
match_return_vals([Rval|Rvals], [Lval|Lvals]) :-
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.198
diff -u -b -r1.198 mlds_to_c.m
--- compiler/mlds_to_c.m 5 Sep 2006 06:21:28 -0000 1.198
+++ compiler/mlds_to_c.m 25 Sep 2006 13:38:51 -0000
@@ -975,7 +975,8 @@
mlds_output_pragma_export_output_defns(ModuleName), !IO),
% Declare a local variable or two for the return value, if needed.
- ( RetTypes = [RetType1] ->
+ (
+ RetTypes = [RetType1],
( RetType1 = mlds_foreign_type(c(_)) ->
io.write_string("\t", !IO),
mlds_output_pragma_export_type(RetType1, !IO),
@@ -989,7 +990,9 @@
io.write_string(" ret_value;\n", !IO)
)
;
- true
+ RetTypes = []
+ ;
+ RetTypes = [_, _ | _]
),
% Generate code to box any non-word-sized foreign_type input parameters;
@@ -1000,10 +1003,12 @@
% Generate code to actually call the Mercury procedure which
% is being exported
- ( RetTypes = [] ->
+ (
+ RetTypes = [],
io.write_string("\t", !IO),
mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO)
- ; RetTypes = [RetType2] ->
+ ;
+ RetTypes = [RetType2],
( RetType2 = mlds_foreign_type(c(_)) ->
io.write_string("\tboxed_ret_value = ", !IO)
;
@@ -1013,9 +1018,9 @@
),
mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO)
;
+ RetTypes = [_, _ | _],
% This is just for MLDS dumps when compiling to non-C targets.
- % So we don't need to worry about boxing/unboxing foreign types
- % here.
+ % So we don't need to worry about boxing/unboxing foreign types here.
io.write_string("\treturn (", !IO),
mlds_output_return_list(RetTypes, mlds_output_pragma_export_type, !IO),
io.write_string(") ", !IO)
@@ -1028,7 +1033,8 @@
% Generate the final statement to unbox and return the return value,
% if needed.
- ( RetTypes = [RetType3] ->
+ (
+ RetTypes = [RetType3],
( RetType3 = mlds_foreign_type(c(_)) ->
io.write_string("\tMR_MAYBE_UNBOX_FOREIGN_TYPE(", !IO),
mlds_output_pragma_export_type(RetType3, !IO),
@@ -1038,7 +1044,9 @@
),
io.write_string("\treturn ret_value;\n", !IO)
;
- true
+ RetTypes = []
+ ;
+ RetTypes = [_, _ | _]
).
:- pred mlds_output_pragma_input_arg(mlds_module_name::in, mlds_argument::in,
@@ -1111,8 +1119,7 @@
).
:- pred mlds_output_pragma_export_call(mlds_module_name::in,
- mlds_qualified_entity_name::in, mlds_arguments::in,
- io::di, io::uo) is det.
+ mlds_qualified_entity_name::in, mlds_arguments::in, io::di, io::uo) is det.
mlds_output_pragma_export_call(ModuleName, FuncName, Parameters, !IO) :-
mlds_output_fully_qualified_name(FuncName, !IO),
@@ -1168,8 +1175,7 @@
->
ReturnArgType = ReturnArgType0
;
- unexpected(this_file,
- "det_func_signature: function return type!")
+ unexpected(this_file, "det_func_signature: function return type!")
),
Params = mlds_func_params(InputArgs, [ReturnArgType]).
@@ -1737,10 +1743,13 @@
QualifiedName = qual(ModuleName, _, _),
mlds_output_params(OutputPrefix, OutputSuffix,
Indent, ModuleName, Context, Parameters, !IO),
- ( RetTypes = [RetType2] ->
+ (
+ RetTypes = [RetType2],
OutputSuffix(RetType2, !IO)
;
- true
+ RetTypes = []
+ ;
+ RetTypes = [_, _ | _]
).
:- pred mlds_output_prefix_suffix(output_type::in(output_type),
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.74
diff -u -b -r1.74 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 22 Aug 2006 05:04:06 -0000 1.74
+++ compiler/rtti_to_mlds.m 25 Sep 2006 13:43:28 -0000
@@ -894,7 +894,16 @@
map.to_assoc_list(PtagMap, PtagList),
SubDefns = list.map(gen_du_stag_ordered_table(ModuleName, RttiTypeCtor),
PtagList),
- ( PtagList = [1 - _ | _] ->
+ (
+ PtagList = [],
+ PtagInitPrefix = [],
+ FirstPtag = 0
+ ;
+ PtagList = [FirstPtag - _ | _],
+ ( FirstPtag = 0 ->
+ PtagInitPrefix = [],
+ FirstPtag = 0
+ ; FirstPtag = 1 ->
% Output a dummy ptag definition for the reserved tag first.
RttiElemName = type_ctor_du_ptag_layout(0),
RttiElemId = ctor_rtti_id(RttiTypeCtor, RttiElemName),
@@ -908,14 +917,9 @@
type_ctor_du_stag_ordered_table(0)))))]
)],
FirstPtag = 1
- ; PtagList = [0 - _ | _] ->
- PtagInitPrefix = [],
- FirstPtag = 0
- ; PtagList = [] ->
- PtagInitPrefix = [],
- FirstPtag = 0
;
unexpected(this_file, "gen_du_ptag_ordered_table: bad ptag list")
+ )
),
PtagInits = gen_du_ptag_ordered_table_body(ModuleName, RttiTypeCtor,
PtagList, FirstPtag),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.65
diff -u -b -r1.65 special_pred.m
--- compiler/special_pred.m 20 Aug 2006 08:21:29 -0000 1.65
+++ compiler/special_pred.m 25 Sep 2006 13:46:11 -0000
@@ -94,9 +94,10 @@
:- pred can_generate_special_pred_clauses_for_type(module_info::in,
type_ctor::in, hlds_type_body::in) is semidet.
- % Are the special predicates for a builtin type defined in Mercury?
+ % Is this a builtin type whose special predicates are defined in Mercury?
+ % If yes, return the name of the type.type
%
-:- pred is_builtin_types_special_preds_defined_in_mercury(type_ctor::in,
+:- pred is_builtin_type_special_preds_defined_in_mercury(type_ctor::in,
string::out) is semidet.
% Does the compiler generate the RTTI for the builtin types, or is
@@ -263,7 +264,7 @@
Ctors = Body ^ du_type_ctors,
list.member(Ctor, Ctors),
Ctor = ctor(ExistQTVars, _, _, _),
- ExistQTVars \= []
+ ExistQTVars = [_ | _]
;
SpecialPredId = spec_pred_init,
type_body_is_solver_type(ModuleInfo, Body)
@@ -273,16 +274,16 @@
(
Body \= hlds_abstract_type(_)
;
- % Only the types which have it's unification and comparison
- % predicates defined in private_builtin.m
+ % The types which have their unification and comparison
+ % predicates defined in private_builtin.m.
compiler_generated_rtti_for_builtins(ModuleInfo),
- is_builtin_types_special_preds_defined_in_mercury(TypeCtor, _)
+ is_builtin_type_special_preds_defined_in_mercury(TypeCtor, _)
),
\+ type_ctor_has_hand_defined_rtti(TypeCtor, Body),
\+ type_body_has_user_defined_equality_pred(ModuleInfo, Body,
abstract_noncanonical_type(_IsSolverType)).
-is_builtin_types_special_preds_defined_in_mercury(TypeCtor, TypeName) :-
+is_builtin_type_special_preds_defined_in_mercury(TypeCtor, TypeName) :-
Builtin = mercury_public_builtin_module,
TypeCtor = type_ctor(qualified(Builtin, TypeName), 0),
( TypeName = "int"
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.171
diff -u -b -r1.171 type_util.m
--- compiler/type_util.m 27 Sep 2006 06:17:06 -0000 1.171
+++ compiler/type_util.m 29 Sep 2006 01:56:58 -0000
@@ -439,7 +439,7 @@
type_constructors(Type, Module, Constructors),
some [Constructor] (
list.member(Constructor, Constructors),
- Constructor ^ cons_exist \= []
+ Constructor ^ cons_exist = [_ | _]
).
is_dummy_argument_type(ModuleInfo, Type) :-
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.21
diff -u -b -r1.21 untupling.m
--- compiler/untupling.m 22 Aug 2006 05:04:14 -0000 1.21
+++ compiler/untupling.m 25 Sep 2006 13:47:01 -0000
@@ -748,7 +748,7 @@
SingleCtor ^ cons_exist = [],
SingleCtorName = SingleCtor ^ cons_name,
SingleCtorArgs = SingleCtor ^ cons_args,
- SingleCtorArgs \= [],
+ SingleCtorArgs = [_ | _],
% Prevent infinite loop with recursive types.
\+ list.member(Type, ContainerTypes)
->
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/dir.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/dir.m,v
retrieving revision 1.36
diff -u -b -r1.36 dir.m
--- library/dir.m 27 Sep 2006 06:16:39 -0000 1.36
+++ library/dir.m 29 Sep 2006 01:57:02 -0000
@@ -383,7 +383,7 @@
:- pred dir.split_name_2(list(char)::in, string::out, string::out) is semidet.
dir.split_name_2(FileNameChars0, DirName, BaseName) :-
- FileNameChars0 \= [],
+ FileNameChars0 = [_ | _],
FileNameWithoutSlash = remove_trailing_dir_separator(FileNameChars0),
FileNameWithoutSlash \= string.to_char_list(dir.this_directory),
FileNameWithoutSlash \= string.to_char_list(dir.parent_directory),
@@ -631,7 +631,7 @@
dir.is_directory_separator(Sep),
list.takewhile(isnt(dir.is_directory_separator_semidet), !.FileName,
Server, !:FileName),
- Server \= [],
+ Server = [_ | _],
(
!.FileName = []
;
@@ -642,7 +642,7 @@
!.FileName = [_|_],
list.takewhile(isnt(dir.is_directory_separator_semidet),
!.FileName, Share, !:FileName),
- Share \= [],
+ Share = [_ | _],
( !.FileName = [Sep | !:FileName]
; !.FileName = []
)
Index: library/eqvclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/eqvclass.m,v
retrieving revision 1.23
diff -u -b -r1.23 eqvclass.m
--- library/eqvclass.m 19 Apr 2006 05:17:51 -0000 1.23
+++ library/eqvclass.m 25 Sep 2006 13:01:55 -0000
@@ -423,11 +423,13 @@
eqvclass.partition_list_to_eqvclass(Ps, EqvClass0),
EqvClass0 = eqvclass(Counter0, PartitionMap0, ElementMap0),
set.to_sorted_list(Partition, Elements),
- ( Elements = [] ->
+ (
+ Elements = [],
Counter = Counter0,
ElementMap0 = ElementMap,
PartitionMap0 = PartitionMap
;
+ Elements = [_ | _],
counter.allocate(Id, Counter0, Counter),
eqvclass.make_partition(Elements, Id, ElementMap0, ElementMap),
map.det_insert(PartitionMap0, Id, Partition, PartitionMap)
Index: library/queue.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/queue.m,v
retrieving revision 1.33
diff -u -b -r1.33 queue.m
--- library/queue.m 19 Apr 2006 05:17:55 -0000 1.33
+++ library/queue.m 25 Sep 2006 13:55:35 -0000
@@ -124,30 +124,33 @@
:- implementation.
:- import_module int.
-:- import_module pair.
%--------------------------------------------------------------------------%
- % This implementation is in terms of a pair of lists. We impose the
- % extra constraint that the `off' list is empty if and only if the queue
- % is empty.
-:- type queue(T) == pair(list(T)).
-
-queue.init([] - []).
-
-queue.equal(On0 - Off0, On1 - Off1) :-
- list.reverse(On0, On0R),
- list.append(Off0, On0R, Q0),
- list.reverse(On1, On1R),
- list.append(Off1, On1R, Q1),
- Q0 = Q1.
+ % This implementation is in terms of a pair of lists: the list of items
+ % in the queue is given by off_list ++ reverse(on_list). The reason for
+ % the names is that we generally get items off the off_list and put them
+ % on the on_list. We impose the extra constraint that the off_list field
+ % is empty if and only if the queue as a whole is empty.
+:- type queue(T)
+ ---> queue(
+ on_list :: list(T),
+ off_list :: list(T)
+ ).
+
+queue.init(queue([], [])).
+
+queue.equal(queue(OnA, OffA), queue(OnB, OffB)) :-
+ QA = OffA ++ list.reverse(OnA),
+ QB = OffB ++ list.reverse(OnB),
+ QA = QB.
-queue.is_empty(_ - []).
+queue.is_empty(queue(_, [])).
queue.is_full(_) :-
semidet_fail.
-queue.put(On0 - Off0, Elem, On - Off) :-
+queue.put(queue(On0, Off0), Elem, queue(On, Off)) :-
(
Off0 = [],
On = On0,
@@ -158,7 +161,7 @@
Off = Off0
).
-queue.put_list(On0 - Off0, Xs, On - Off) :-
+queue.put_list(queue(On0, Off0), Xs, queue(On, Off)) :-
(
Off0 = [],
On = On0,
@@ -175,9 +178,9 @@
queue.put_list_2([X | Xs], On0, On) :-
queue.put_list_2(Xs, [X | On0], On).
-queue.first(_ - [Elem | _], Elem).
+queue.first(queue(_, [Elem | _]), Elem).
-queue.get(On0 - [Elem | Off0], Elem, On - Off) :-
+queue.get(queue(On0, [Elem | Off0]), Elem, queue(On, Off)) :-
(
Off0 = [],
list.reverse(On0, Off),
@@ -188,18 +191,18 @@
Off = Off0
).
-queue.length(On - Off, Length) :-
+queue.length(queue(On, Off), Length) :-
list.length(On, LengthOn),
list.length(Off, LengthOff),
Length = LengthOn + LengthOff.
-queue.list_to_queue(List, [] - List).
+queue.list_to_queue(List, queue([], List)).
-queue.from_list(List) = [] - List.
+queue.from_list(List) = queue([], List).
-queue.to_list(On - Off) = Off ++ list.reverse(On).
+queue.to_list(queue(On, Off)) = Off ++ list.reverse(On).
-queue.delete_all(On0 - Off0, Elem, On - Off) :-
+queue.delete_all(queue(On0, Off0), Elem, queue(On, Off)) :-
list.delete_all(On0, Elem, On1),
list.delete_all(Off0, Elem, Off1),
(
@@ -212,17 +215,17 @@
Off = Off1
).
-queue.put_on_front(On - Off, Elem, On - [Elem | Off]).
+queue.put_on_front(queue(On, Off), Elem, queue(On, [Elem | Off])).
queue.put_on_front(Queue0, Elem) = Queue :-
queue.put_on_front(Queue0, Elem, Queue).
-queue.put_list_on_front(On - Off, Elems, On - (Elems ++ Off)).
+queue.put_list_on_front(queue(On, Off), Elems, queue(On, Elems ++ Off)).
queue.put_list_on_front(Queue0, Elems) = Queue :-
queue.put_list_on_front(Queue0, Elems, Queue).
-queue.get_from_back(On0 - Off0, Elem, On - Off) :-
+queue.get_from_back(queue(On0, Off0), Elem, queue(On, Off)) :-
(
% The On list is non-empty and the last element in the queue
% is the head of the On list.
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.42
diff -u -b -r1.42 type_desc.m
--- library/type_desc.m 31 Aug 2006 11:09:53 -0000 1.42
+++ library/type_desc.m 25 Sep 2006 13:15:19 -0000
@@ -503,14 +503,21 @@
type_arg_names([], _, []).
type_arg_names([Type | Types], IsFunc, ArgNames) :-
Name = type_name(Type),
- ( Types = [] ->
+ (
+ Types = [],
ArgNames = [Name]
- ; IsFunc = yes, Types = [FuncReturnType] ->
+ ;
+ Types = [_ | _],
+ (
+ IsFunc = yes,
+ Types = [FuncReturnType]
+ ->
FuncReturnName = type_name(FuncReturnType),
ArgNames = [Name, ") = ", FuncReturnName]
;
type_arg_names(Types, IsFunc, Names),
ArgNames = [Name, ", " | Names]
+ )
).
type_args(Type) = ArgTypes :-
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/type_to_term_bug.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/type_to_term_bug.exp,v
retrieving revision 1.1
diff -u -b -r1.1 type_to_term_bug.exp
--- tests/hard_coded/type_to_term_bug.exp 17 Feb 2000 06:38:34 -0000 1.1
+++ tests/hard_coded/type_to_term_bug.exp 25 Sep 2006 16:39:06 -0000
@@ -1 +1 @@
-functor(atom("-"), [functor(atom("[]"), [], context("", 0)), functor(atom("[]"), [], context("", 0))], context("", 0))
+functor(atom("queue"), [functor(atom("[]"), [], context("", 0)), functor(atom("[]"), [], context("", 0))], context("", 0))
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list