[m-rev.] diff: replace "is" with "="
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri May 23 18:31:59 AEST 2003
Warning: the diff is really long and extremely boring, and so is the log
message :-) The operative part is:
Replace "is" with "=".
Add field names where relevant.
Replace integers with counters where relevant.
Zoltan.
browser/browse.m:
browser/frame.m:
browser/help.m:
browser/parse.m:
compiler/bytecode_data.m:
compiler/bytecode_gen.m:
compiler/c_util.m:
compiler/call_gen.m:
compiler/clause_to_proc.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/compile_target_code.m:
compiler/const_prop.m:
compiler/dead_proc_elim.m:
compiler/deforest.m:
compiler/delay_info.m:
compiler/dense_switch.m:
compiler/dependency_graph.m:
compiler/det_report.m:
compiler/dnf.m:
compiler/error_util.m:
compiler/export.m:
compiler/exprn_aux.m:
compiler/fact_table.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_module.m:
compiler/hlds_out.m:
compiler/hlds_pred.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/lookup_switch.m:
compiler/lp.m:
compiler/magic.m:
compiler/magic_util.m:
compiler/make_hlds.m:
compiler/make_tags.m:
compiler/mercury_compile.m:
compiler/mercury_to_mercury.m:
compiler/middle_rec.m:
compiler/ml_closure_gen.m:
compiler/ml_simplify_switch.m:
compiler/ml_string_switch.m:
compiler/ml_tag_switch.m:
compiler/mlds_to_c.m:
compiler/mode_errors.m:
compiler/mode_util.m:
compiler/modes.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/options.m:
compiler/par_conj_gen.m:
compiler/passes_aux.m:
compiler/pd_cost.m:
compiler/pd_info.m:
compiler/pd_term.m:
compiler/pd_util.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/pragma_c_gen.m:
compiler/prog_io_dcg.m:
compiler/prog_io_pragma.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/rl.m:
compiler/rl_block.m:
compiler/rl_block_opt.m:
compiler/rl_exprn.m:
compiler/rl_file.pp:
compiler/rl_gen.m:
compiler/rl_info.m:
compiler/rl_out.pp:
compiler/rl_sort.m:
compiler/rl_stream.m:
compiler/simplify.m:
compiler/store_alloc.m:
compiler/string_switch.m:
compiler/switch_util.m:
compiler/tag_switch.m:
compiler/term_errors.m:
compiler/term_pass2.m:
compiler/term_traversal.m:
compiler/term_util.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/typecheck.m:
compiler/unify_gen.m:
compiler/unify_proc.m:
compiler/unused_args.m:
library/array.m:
library/bag.m:
library/bintree.m:
library/bt_array.m:
library/dir.m:
library/eqvclass.m:
library/graph.m:
library/group.m:
library/io.m:
library/lexer.m:
library/multi_map.m:
library/parser.m:
library/pqueue.m:
library/queue.m:
library/rational.m:
library/rbtree.m:
library/relation.m:
library/set_bbbtree.m:
library/string.m:
library/term.m:
library/term_io.m:
library/tree234.m:
library/varset.m:
tests/debugger/breakpoints.m:
tests/debugger/nondet_stack.m:
tests/debugger/queens.m:
tests/debugger/queens_rep.m:
tests/debugger/retry.m:
tests/debugger/shallow2.m:
tests/general/arithmetic.m:
tests/general/commit_bug_2.m:
tests/general/complex_failure.m:
tests/general/do_while.m:
tests/general/frameopt_mkframe_bug.m:
tests/general/liveness.m:
tests/general/mode_inf.m:
tests/general/mode_inf_bug.m:
tests/general/nasty_nondet.m:
tests/general/nondet_ite.m:
tests/general/nondet_ite_2.m:
tests/general/nondet_ite_4.m:
tests/general/nondetlive.m:
tests/general/semi_fail_in_non_ite.m:
tests/general/semidet_map.m:
tests/general/string_format_test.m:
tests/hard_coded/boyer.m:
tests/hard_coded/common_type_cast.m:
tests/hard_coded/curry2.m:
tests/hard_coded/cut_test.m:
tests/hard_coded/factt.m:
tests/hard_coded/func_test.m:
tests/hard_coded/integer_test.m:
tests/hard_coded/nondet_ctrl_vn.m:
tests/hard_coded/qual_adv_test.m:
tests/hard_coded/qual_basic_test.m:
tests/hard_coded/qual_strang.m:
tests/hard_coded/qual_strung.m:
tests/hard_coded/space.m:
tests/hard_coded/string_alignment_bug.m:
tests/invalid/det_errors.m:
tests/invalid/lambda_syntax_error.m:
tests/invalid/typeclass_test_7.m:
tests/tabling/expand.m:
tests/tabling/expand_float.m:
tests/tabling/expand_poly.m:
tests/tabling/expand_tuple.m:
tests/tabling/fib.m:
tests/tabling/fib_float.m:
tests/term/dds3_14.m:
tests/term/mmatrix.m:
tests/term/money.m:
tests/term/occur.m:
tests/term/pl4_5_2.m:
tests/term/queens.m:
tests/term/queens.m:
tests/valid/complex_failure.m:
tests/valid/double_vn.m:
tests/valid/higher_order.m:
tests/valid/lambda_struct_bug.m:
tests/valid/mostly_uniq_mode_inf.m:
tests/valid/semi_fail_in_non_ite.m:
tests/valid/uniq_mode_inf_bug.m:
tests/warnings/duplicate_call.m:
tests/warnings/unused_args_test.m:
Replace "is" with "=".
Add field names where relevant.
Replace integers with counters where relevant.
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/tests
cvs diff: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.36
diff -u -b -r1.36 browse.m
--- browser/browse.m 24 Feb 2003 05:49:29 -0000 1.36
+++ browser/browse.m 31 Mar 2003 05:51:11 -0000
@@ -890,8 +890,8 @@
MaybeReturn = no,
Args = Args0
),
- CurSize1 is CurSize + 1,
- CurDepth1 is CurDepth + 1,
+ CurSize1 = CurSize + 1,
+ CurDepth1 = CurDepth + 1,
ArgNum = 1,
args_to_string_verbose_list(Args, ArgNum, MaxSize, CurSize1,
NewSize, MaxDepth, CurDepth1, ArgsFrame),
@@ -920,7 +920,7 @@
CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
browser_term_to_string_verbose_2(plain_term(Univ1), MaxSize, CurSize,
NewSize1, MaxDepth, CurDepth, TreeFrame),
- ArgNum1 is ArgNum + 1,
+ ArgNum1 = ArgNum + 1,
args_to_string_verbose_list([Univ2 | Univs], ArgNum1, MaxSize,
NewSize1, NewSize2, MaxDepth, CurDepth, RestTreesFrame),
NewSize = NewSize2,
@@ -928,7 +928,7 @@
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], BranchFrameS),
frame__vsize(TreeFrame, Height),
- Height1 is Height - 1,
+ Height1 = Height - 1,
list__duplicate(Height1, "|", VBranchFrame),
frame__vglue([BranchFrameS], VBranchFrame, LeftFrame),
frame__hglue(LeftFrame, TreeFrame, TopFrame),
Index: browser/frame.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/frame.m,v
retrieving revision 1.4
diff -u -b -r1.4 frame.m
--- browser/frame.m 13 Nov 2000 22:45:47 -0000 1.4
+++ browser/frame.m 26 Nov 2002 21:49:03 -0000
@@ -122,7 +122,7 @@
:- pred subtract(int, int, int).
:- mode subtract(in, in, out) is det.
subtract(M, X, Z) :-
- Z is M - X.
+ Z = M - X.
% Add empty lines of padding to the bottom of a frame.
:- pred frame_lower_pad(frame, int, frame).
Index: browser/help.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/help.m,v
retrieving revision 1.3
diff -u -b -r1.3 help.m
--- browser/help.m 24 Mar 2000 10:27:20 -0000 1.3
+++ browser/help.m 26 Nov 2002 21:49:12 -0000
@@ -187,7 +187,7 @@
( { Name = EntryName } ->
% We print this node, but don't search its children.
help__print_node(Node, Stream),
- { C is C0 + 1 }
+ { C = C0 + 1 }
;
help__search_node(Node, Name, C0, C1, Stream),
help__search_entry_list(Tail, Name, C1, C, Stream)
Index: browser/parse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.15
diff -u -b -r1.15 parse.m
--- browser/parse.m 1 Nov 2002 07:44:59 -0000 1.15
+++ browser/parse.m 26 Nov 2002 21:49:47 -0000
@@ -196,7 +196,7 @@
dig_to_int(C, N) :-
char__to_int('0', Zero),
char__to_int(C, CN),
- N is CN - Zero.
+ N = CN - Zero.
:- pred lexer_num(int, list(char), list(token)).
:- mode lexer_num(in, in, out) is det.
@@ -212,7 +212,7 @@
digits_to_int_acc(Acc, [], Acc).
digits_to_int_acc(Acc, [C | Cs], Num) :-
dig_to_int(C, D),
- Acc2 is 10 * Acc + D,
+ Acc2 = 10 * Acc + D,
digits_to_int_acc(Acc2, Cs, Num).
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/bytecode_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_data.m,v
retrieving revision 1.10
diff -u -b -r1.10 bytecode_data.m
--- compiler/bytecode_data.m 13 Feb 2003 08:28:42 -0000 1.10
+++ compiler/bytecode_data.m 31 Mar 2003 05:51:12 -0000
@@ -179,13 +179,13 @@
true
},
{ Bits > IntBits ->
- ZeroPadBytes is (Bits - IntBits) // bits_per_byte
+ ZeroPadBytes = (Bits - IntBits) // bits_per_byte
;
ZeroPadBytes = 0
},
output_padding_zeros(Writer, ZeroPadBytes),
{ BytesToDump = Bits // bits_per_byte },
- { FirstByteToDump is BytesToDump - ZeroPadBytes - 1 },
+ { FirstByteToDump = BytesToDump - ZeroPadBytes - 1 },
output_int_bytes(Writer, FirstByteToDump, IntVal).
:- func bytecode_int_bits = int.
@@ -210,7 +210,7 @@
output_padding_zeros(Writer, NumBytes) -->
( { NumBytes > 0 } ->
call(Writer, 0),
- { NumBytes1 is NumBytes - 1 },
+ { NumBytes1 = NumBytes - 1 },
output_padding_zeros(Writer, NumBytes1)
;
[]
@@ -222,9 +222,9 @@
output_int_bytes(Writer, ByteNum, IntVal) -->
( { ByteNum >= 0 } ->
- { BitShifts is ByteNum * bits_per_byte },
- { Byte is (IntVal >> BitShifts) mod (1 << bits_per_byte) },
- { ByteNum1 is ByteNum - 1 },
+ { BitShifts = ByteNum * bits_per_byte },
+ { Byte = (IntVal >> BitShifts) mod (1 << bits_per_byte) },
+ { ByteNum1 = ByteNum - 1 },
call(Writer, Byte),
output_int_bytes(Writer, ByteNum1, IntVal)
;
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.72
diff -u -b -r1.72 bytecode_gen.m
--- compiler/bytecode_gen.m 15 Mar 2003 07:11:55 -0000 1.72
+++ compiler/bytecode_gen.m 31 Mar 2003 05:51:12 -0000
@@ -57,7 +57,7 @@
:- import_module parse_tree__prog_out.
:- import_module bool, int, string, list, assoc_list, set, map, varset.
-:- import_module std_util, require, term.
+:- import_module std_util, require, term, counter.
%---------------------------------------------------------------------------%
@@ -813,7 +813,7 @@
bytecode_gen__create_varmap([Var | VarList], VarSet, VarTypes, N0,
VarMap0, VarMap, VarInfos) :-
map__det_insert(VarMap0, Var, N0, VarMap1),
- N1 is N0 + 1,
+ N1 = N0 + 1,
varset__lookup_name(VarSet, Var, VarName),
map__lookup(VarTypes, Var, VarType),
bytecode_gen__create_varmap(VarList, VarSet, VarTypes, N1,
@@ -824,28 +824,30 @@
:- type byte_info
---> byte_info(
- map(prog_var, byte_var),
- map(prog_var, type),
- module_info,
- int, % next label number to use
- int % next temp number to use
+ byteinfo_varmap :: map(prog_var, byte_var),
+ byteinfo_vartypes :: map(prog_var, type),
+ byteinfo_moduleinfo :: module_info,
+ byteinfo_label_counter :: counter,
+ byteinfo_temp_counter :: counter
).
:- pred bytecode_gen__init_byte_info(module_info::in,
map(prog_var, byte_var)::in, map(prog_var, type)::in,
byte_info::out) is det.
+
bytecode_gen__init_byte_info(ModuleInfo, VarMap, VarTypes, ByteInfo) :-
- ByteInfo = byte_info(VarMap, VarTypes, ModuleInfo, 0, 0).
+ ByteInfo = byte_info(VarMap, VarTypes, ModuleInfo,
+ counter__init(0), counter__init(0)).
:- pred bytecode_gen__get_module_info(byte_info::in, module_info::out) is det.
-bytecode_gen__get_module_info(byte_info(_, _, ModuleInfo, _, _), ModuleInfo).
+bytecode_gen__get_module_info(ByteInfo, ByteInfo ^ byteinfo_moduleinfo).
:- pred bytecode_gen__map_vars(byte_info::in,
list(prog_var)::in, list(byte_var)::out) is det.
-bytecode_gen__map_vars(byte_info(VarMap, _, _, _, _), Vars, ByteVars) :-
- bytecode_gen__map_vars_2(VarMap, Vars, ByteVars).
+bytecode_gen__map_vars(ByteInfo, Vars, ByteVars) :-
+ bytecode_gen__map_vars_2(ByteInfo ^ byteinfo_varmap, Vars, ByteVars).
:- pred bytecode_gen__map_vars_2(map(prog_var, byte_var)::in,
list(prog_var)::in, list(byte_var)::out) is det.
@@ -858,34 +860,38 @@
:- pred bytecode_gen__map_var(byte_info::in, prog_var::in,
byte_var::out) is det.
-bytecode_gen__map_var(byte_info(VarMap, _, _, _, _), Var, ByteVar) :-
- map__lookup(VarMap, Var, ByteVar).
+bytecode_gen__map_var(ByteInfo, Var, ByteVar) :-
+ map__lookup(ByteInfo ^ byteinfo_varmap, Var, ByteVar).
:- pred bytecode_gen__get_var_type(byte_info::in, prog_var::in,
(type)::out) is det.
-bytecode_gen__get_var_type(byte_info(_, VarTypes, _, _, _), Var, Type) :-
- map__lookup(VarTypes, Var, Type).
+bytecode_gen__get_var_type(ByteInfo, Var, Type) :-
+ map__lookup(ByteInfo ^ byteinfo_vartypes, Var, Type).
:- pred bytecode_gen__get_next_label(byte_info::in, int::out, byte_info::out)
is det.
-bytecode_gen__get_next_label(ByteInfo0, Label0, ByteInfo) :-
- ByteInfo0 = byte_info(VarMap, VarTypes, ModuleInfo, Label0, Temp),
- Label is Label0 + 1,
- ByteInfo = byte_info(VarMap, VarTypes, ModuleInfo, Label, Temp).
+bytecode_gen__get_next_label(ByteInfo0, Label, ByteInfo) :-
+ LabelCounter0 = ByteInfo0 ^ byteinfo_label_counter,
+ counter__allocate(Label, LabelCounter0, LabelCounter),
+ ByteInfo = ByteInfo0 ^ byteinfo_label_counter := LabelCounter.
:- pred bytecode_gen__get_next_temp(byte_info::in, int::out, byte_info::out)
is det.
-bytecode_gen__get_next_temp(ByteInfo0, Temp0, ByteInfo) :-
- ByteInfo0 = byte_info(VarMap, VarTypes, ModuleInfo, Label, Temp0),
- Temp is Temp0 + 1,
- ByteInfo = byte_info(VarMap, VarTypes, ModuleInfo, Label, Temp).
+bytecode_gen__get_next_temp(ByteInfo0, Temp, ByteInfo) :-
+ TempCounter0 = ByteInfo0 ^ byteinfo_temp_counter,
+ counter__allocate(Temp, TempCounter0, TempCounter),
+ ByteInfo = ByteInfo0 ^ byteinfo_temp_counter := TempCounter.
:- pred bytecode_gen__get_counts(byte_info::in, int::out, int::out) is det.
-bytecode_gen__get_counts(byte_info(_, _, _, Label, Temp), Label, Temp).
+bytecode_gen__get_counts(ByteInfo0, Label, Temp) :-
+ LabelCounter0 = ByteInfo0 ^ byteinfo_label_counter,
+ counter__allocate(Label, LabelCounter0, _LabelCounter),
+ TempCounter0 = ByteInfo0 ^ byteinfo_temp_counter,
+ counter__allocate(Temp, TempCounter0, _TempCounter).
%---------------------------------------------------------------------------%
@@ -894,9 +900,10 @@
bytecode_gen__get_is_func(PredInfo, IsFunc) :-
pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
- ( PredOrFunc = predicate
- -> IsFunc = 0
- ; IsFunc = 1
+ ( PredOrFunc = predicate ->
+ IsFunc = 0
+ ;
+ IsFunc = 1
).
%---------------------------------------------------------------------------%
Index: compiler/c_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/c_util.m,v
retrieving revision 1.17
diff -u -b -r1.17 c_util.m
--- compiler/c_util.m 21 Mar 2003 08:00:28 -0000 1.17
+++ compiler/c_util.m 31 Mar 2003 05:51:12 -0000
@@ -205,7 +205,7 @@
{ LineNumbers = yes }
->
io__write_string("#line "),
- { NextLine is Line + 1 },
+ { NextLine = Line + 1 },
io__write_int(NextLine),
io__write_string(" """),
c_util__output_quoted_string(FileName),
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.155
diff -u -b -r1.155 call_gen.m
--- compiler/call_gen.m 22 May 2003 05:54:37 -0000 1.155
+++ compiler/call_gen.m 22 May 2003 18:57:46 -0000
@@ -256,7 +256,7 @@
call_gen__extra_livevals(Reg, FirstInput, ExtraLiveVals) :-
( Reg < FirstInput ->
ExtraLiveVals = [reg(r, Reg) | ExtraLiveVals1],
- NextReg is Reg + 1,
+ NextReg = Reg + 1,
call_gen__extra_livevals(NextReg, FirstInput, ExtraLiveVals1)
;
ExtraLiveVals = []
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.35
diff -u -b -r1.35 clause_to_proc.m
--- compiler/clause_to_proc.m 15 Mar 2003 03:08:43 -0000 1.35
+++ compiler/clause_to_proc.m 31 Mar 2003 05:51:12 -0000
@@ -86,7 +86,7 @@
% fail must be explicitly declared as semidet.)
%
pred_info_arity(PredInfo0, PredArity),
- FuncArity is PredArity - 1,
+ FuncArity = PredArity - 1,
in_mode(InMode),
out_mode(OutMode),
list__duplicate(FuncArity, InMode, FuncArgModes),
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.113
diff -u -b -r1.113 code_gen.m
--- compiler/code_gen.m 20 May 2003 16:20:41 -0000 1.113
+++ compiler/code_gen.m 22 May 2003 18:57:46 -0000
@@ -742,7 +742,7 @@
% Do we need to use a general slot for storing succip?
{ CodeModel \= model_non }
->
- { SuccipSlot is MainSlots + 1 },
+ { SuccipSlot = MainSlots + 1 },
{ SaveSuccipCode = node([
assign(stackvar(SuccipSlot), lval(succip)) -
"Save the success ip"
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.277
diff -u -b -r1.277 code_info.m
--- compiler/code_info.m 9 May 2003 05:51:49 -0000 1.277
+++ compiler/code_info.m 9 May 2003 06:45:24 -0000
@@ -3674,8 +3674,8 @@
{ UsableLvals = [] },
code_info__get_var_slot_count(VarSlots),
code_info__get_max_temp_slot_count(TempSlots0),
- { TempSlots is TempSlots0 + 1 },
- { Slot is VarSlots + TempSlots },
+ { TempSlots = TempSlots0 + 1 },
+ { Slot = VarSlots + TempSlots },
code_info__stack_variable(Slot, StackVar),
code_info__set_max_temp_slot_count(TempSlots),
{ map__det_insert(TempContentMap0, StackVar, Item,
@@ -3709,7 +3709,7 @@
code_info__get_total_stackslot_count(NumSlots) -->
code_info__get_var_slot_count(SlotsForVars),
code_info__get_max_temp_slot_count(SlotsForTemps),
- { NumSlots is SlotsForVars + SlotsForTemps }.
+ { NumSlots = SlotsForVars + SlotsForTemps }.
:- pred code_info__max_var_slot(stack_slots, int).
:- mode code_info__max_var_slot(in, out) is det.
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.43
diff -u -b -r1.43 compile_target_code.m
--- compiler/compile_target_code.m 16 Mar 2003 08:01:26 -0000 1.43
+++ compiler/compile_target_code.m 31 Mar 2003 05:51:13 -0000
@@ -354,7 +354,7 @@
( { Succeeded0 = no } ->
{ Succeeded = no }
;
- { Chunk1 is Chunk + 1 },
+ { Chunk1 = Chunk + 1 },
split_c_to_obj(ErrorStream,
ModuleName, Chunk1, NumChunks, Succeeded)
)
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.17
diff -u -b -r1.17 const_prop.m
--- compiler/const_prop.m 15 Mar 2003 03:08:43 -0000 1.17
+++ compiler/const_prop.m 31 Mar 2003 05:51:13 -0000
@@ -120,25 +120,25 @@
evaluate_builtin_bi("int", "+", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- ZVal is XVal.
+ ZVal = XVal.
evaluate_builtin_bi("int", "-", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- ZVal is -XVal.
+ ZVal = -XVal.
evaluate_builtin_bi("int", "\\", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- ZVal is \ XVal.
+ ZVal = \ XVal.
% Floating point arithmetic
evaluate_builtin_bi("float", "+", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- ZVal is XVal.
+ ZVal = XVal.
evaluate_builtin_bi("float", "-", 0, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- ZVal is -XVal.
+ ZVal = -XVal.
%------------------------------------------------------------------------------%
@@ -153,101 +153,101 @@
evaluate_builtin_tri("int", "+", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal + YVal.
+ ZVal = XVal + YVal.
evaluate_builtin_tri("int", "+", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- XVal is ZVal - YVal.
+ XVal = ZVal - YVal.
evaluate_builtin_tri("int", "+", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- YVal is ZVal - XVal.
+ YVal = ZVal - XVal.
evaluate_builtin_tri("int", "-", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal - YVal.
+ ZVal = XVal - YVal.
evaluate_builtin_tri("int", "-", 1, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- XVal is YVal + ZVal.
+ XVal = YVal + ZVal.
evaluate_builtin_tri("int", "-", 2, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
- YVal is XVal - ZVal.
+ YVal = XVal - ZVal.
evaluate_builtin_tri("int", "*", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal * YVal.
+ ZVal = XVal * YVal.
% This isn't actually a builtin.
evaluate_builtin_tri("int", "//", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
- ZVal is XVal // YVal.
+ ZVal = XVal // YVal.
evaluate_builtin_tri("int", "unchecked_quotient", 0, X, Y, Z, Z,
int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
- ZVal is unchecked_quotient(XVal, YVal).
+ ZVal = unchecked_quotient(XVal, YVal).
% This isn't actually a builtin.
evaluate_builtin_tri("int", "mod", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
- ZVal is XVal mod YVal.
+ ZVal = XVal mod YVal.
% This isn't actually a builtin.
evaluate_builtin_tri("int", "rem", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
- ZVal is XVal rem YVal.
+ ZVal = XVal rem YVal.
evaluate_builtin_tri("int", "unchecked_rem", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
- ZVal is unchecked_rem(XVal, YVal).
+ ZVal = unchecked_rem(XVal, YVal).
evaluate_builtin_tri("int", "unchecked_left_shift",
0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is unchecked_left_shift(XVal, YVal).
+ ZVal = unchecked_left_shift(XVal, YVal).
% This isn't actually a builtin.
evaluate_builtin_tri("int", "<<", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal << YVal.
+ ZVal = XVal << YVal.
evaluate_builtin_tri("int", "unchecked_right_shift",
0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is unchecked_right_shift(XVal, YVal).
+ ZVal = unchecked_right_shift(XVal, YVal).
% This isn't actually a builtin.
evaluate_builtin_tri("int", ">>", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal >> YVal.
+ ZVal = XVal >> YVal.
evaluate_builtin_tri("int", "/\\", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal /\ YVal.
+ ZVal = XVal /\ YVal.
evaluate_builtin_tri("int", "\\/", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
- ZVal is XVal \/ YVal.
+ ZVal = XVal \/ YVal.
evaluate_builtin_tri("int", "^", 0, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
@@ -266,31 +266,31 @@
evaluate_builtin_tri("float", "+", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
- ZVal is XVal + YVal.
+ ZVal = XVal + YVal.
evaluate_builtin_tri("float", "-", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
- ZVal is XVal - YVal.
+ ZVal = XVal - YVal.
evaluate_builtin_tri("float", "*", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
- ZVal is XVal * YVal.
+ ZVal = XVal * YVal.
% This isn't actually a builtin.
evaluate_builtin_tri("float", "/", 0, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
- ZVal is XVal / YVal.
+ ZVal = XVal / YVal.
evaluate_builtin_tri("float", "unchecked_quotient", 0, X, Y, Z, Z,
float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
- ZVal is unchecked_quotient(XVal, YVal).
+ ZVal = unchecked_quotient(XVal, YVal).
%------------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.79
diff -u -b -r1.79 dead_proc_elim.m
--- compiler/dead_proc_elim.m 21 Mar 2003 05:52:05 -0000 1.79
+++ compiler/dead_proc_elim.m 31 Mar 2003 05:51:13 -0000
@@ -477,7 +477,7 @@
NewNotation = no
;
OldNotation = yes(Count0),
- Count is Count0 + 1,
+ Count = Count0 + 1,
NewNotation = yes(Count)
),
map__det_update(Needed0, proc(PredId, ProcId), NewNotation,
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.29
diff -u -b -r1.29 deforest.m
--- compiler/deforest.m 15 Mar 2003 03:08:44 -0000 1.29
+++ compiler/deforest.m 31 Mar 2003 05:51:13 -0000
@@ -794,7 +794,7 @@
pd_info_get_pred_info(PredInfo),
pd_info_lookup_option(deforestation_depth_limit, DepthLimitOpt),
pd_info_get_depth(Depth0),
- { Depth is Depth0 + 1 },
+ { Depth = Depth0 + 1 },
pd_info_set_depth(Depth),
pd_info_lookup_option(deforestation_size_threshold, SizeLimitOpt),
pd_info_get_module_info(ModuleInfo),
@@ -959,7 +959,7 @@
),
pd_info_incr_cost_delta(FoldCostDelta),
{ goals_size([EarlierGoal | BetweenGoals], NegSizeDelta) },
- { SizeDelta is - NegSizeDelta },
+ { SizeDelta = - NegSizeDelta },
pd_info_incr_size_delta(SizeDelta),
deforest__create_call_goal(VersionPredProcId,
VersionInfo, Renaming, TypeRenaming, Goal),
@@ -1058,7 +1058,7 @@
{ list__length(GoalVarsList1, NumVars1) },
{ list__length(GoalVarsList3, NumVars3) },
- { NumVars is NumVars1 + NumVars3 },
+ { NumVars = NumVars1 + NumVars3 },
{ VarsOpt = int(MaxVars) },
{ NumVars < MaxVars }
)
@@ -1709,7 +1709,7 @@
pd_info_get_instmap(InstMap0),
deforest__append_goal(Goal0, BetweenGoals, GoalToAppend,
NonLocals, CurrBranch, Branches, Goal),
- { NextBranch is CurrBranch + 1 },
+ { NextBranch = CurrBranch + 1 },
pd_info_set_instmap(InstMap0),
deforest__append_goal_to_disjuncts(Goals0, BetweenGoals, GoalToAppend,
NonLocals, NextBranch, Branches, Goals).
@@ -1727,7 +1727,7 @@
pd_info_bind_var_to_functor(Var, ConsId),
deforest__append_goal(Goal0, BetweenGoals,
GoalToAppend, NonLocals, CurrCase, Branches, Goal),
- { NextCase is CurrCase + 1 },
+ { NextCase = CurrCase + 1 },
pd_info_set_instmap(InstMap0),
deforest__append_goal_to_cases(Var, Cases0, BetweenGoals, GoalToAppend,
NonLocals, NextCase, Branches, Cases).
@@ -1927,7 +1927,7 @@
pd_util__simplify_goal(Simplifications, Goal3, Goal4),
pd_info_get_cost_delta(CostDelta1),
- { CostDelta is CostDelta1 - CostDelta0 },
+ { CostDelta = CostDelta1 - CostDelta0 },
{ goal_size(Goal4, GoalSize) },
{ pd_cost__call(CallCost) },
{ SizeDelta = GoalSize - CallCost },
@@ -2022,7 +2022,7 @@
% accept any amount of optimization.
CostDelta > 0
;
- PercentChange is CostDelta * 100 // OriginalCost,
+ PercentChange = CostDelta * 100 // OriginalCost,
PercentChange >= 5
).
@@ -2040,8 +2040,8 @@
% Note that folding is heavily rewarded by pd_cost.m,
% so this isn't very restrictive if a fold occurs.
pd_cost__heap_incr(HeapCost),
- ExpectedCostDelta is 1000 * HeapCost * SizeChange // 3,
- FudgedCostDelta is CostDelta * Factor,
+ ExpectedCostDelta = 1000 * HeapCost * SizeChange // 3,
+ FudgedCostDelta = CostDelta * Factor,
FudgedCostDelta >= ExpectedCostDelta
).
Index: compiler/delay_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/delay_info.m,v
retrieving revision 1.19
diff -u -b -r1.19 delay_info.m
--- compiler/delay_info.m 15 Mar 2003 03:08:44 -0000 1.19
+++ compiler/delay_info.m 31 Mar 2003 05:51:13 -0000
@@ -244,7 +244,7 @@
map__init(DelayedGoals),
stack__push(DelayedGoalStack0, DelayedGoals, DelayedGoalStack),
stack__push(NextSeqNums0, 0, NextSeqNums),
- CurrentDepth is CurrentDepth0 + 1,
+ CurrentDepth = CurrentDepth0 + 1,
DelayInfo = delay_info(CurrentDepth, DelayedGoalStack,
WaitingGoalsTable, PendingGoals, NextSeqNums),
delay_info__check_invariant(DelayInfo).
@@ -260,7 +260,7 @@
remove_delayed_goals(SeqNums, DelayedGoals, CurrentDepth0,
WaitingGoalsTable0, WaitingGoalsTable),
stack__pop_det(NextSeqNums0, _, NextSeqNums),
- CurrentDepth is CurrentDepth0 - 1,
+ CurrentDepth = CurrentDepth0 - 1,
map__values(DelayedGoals, DelayedGoalsList),
DelayInfo = delay_info(CurrentDepth, DelayedGoalStack,
WaitingGoalsTable, PendingGoals, NextSeqNums),
@@ -301,7 +301,7 @@
% Get the next sequence number
stack__pop_det(NextSeqNums0, SeqNum, NextSeqNums1),
- NextSeq is SeqNum + 1,
+ NextSeq = SeqNum + 1,
stack__push(NextSeqNums1, NextSeq, NextSeqNums),
% Store the goal in the delayed goal stack
Index: compiler/dense_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dense_switch.m,v
retrieving revision 1.44
diff -u -b -r1.44 dense_switch.m
--- compiler/dense_switch.m 15 Mar 2003 03:08:44 -0000 1.44
+++ compiler/dense_switch.m 31 Mar 2003 05:51:13 -0000
@@ -74,8 +74,8 @@
FirstCase = case(_, int_constant(FirstCaseVal), _, _),
list__index1_det(TaggedCases, NumCases, LastCase),
LastCase = case(_, int_constant(LastCaseVal), _, _),
- Span is LastCaseVal - FirstCaseVal,
- Range is Span + 1,
+ Span = LastCaseVal - FirstCaseVal,
+ Range = Span + 1,
dense_switch__calc_density(NumCases, Range, Density),
Density > ReqDensity
},
@@ -96,7 +96,7 @@
->
{ CanFail = cannot_fail },
{ FirstVal = 0 },
- { LastVal is TypeRange - 1 }
+ { LastVal = TypeRange - 1 }
;
{ CanFail = CanFail0 },
{ FirstVal = FirstCaseVal },
@@ -114,8 +114,8 @@
% and the number of cases.
dense_switch__calc_density(NumCases, Range, Density) :-
- N1 is NumCases * 100,
- Density is N1 // Range.
+ N1 = NumCases * 100,
+ Density = N1 // Range.
%---------------------------------------------------------------------------%
@@ -147,7 +147,7 @@
% appropriate range
(
{ CanFail = can_fail },
- { Difference is EndVal - StartVal },
+ { Difference = EndVal - StartVal },
code_info__fail_if_rval_is_false(
binop(unsigned_le, Index,
const(int_const(Difference))), RangeCheck)
@@ -205,7 +205,7 @@
- "branch to end of dense switch"
]) },
% generate the rest of the cases.
- { NextVal1 is NextVal + 1 },
+ { NextVal1 = NextVal + 1 },
dense_switch__generate_cases(Cases1, NextVal1, EndVal,
CodeModel, SwitchGoalInfo, EndLabel,
MaybeEnd1, MaybeEnd, Labels1, OtherCasesCode),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.59
diff -u -b -r1.59 dependency_graph.m
--- compiler/dependency_graph.m 16 Mar 2003 08:01:26 -0000 1.59
+++ compiler/dependency_graph.m 31 Mar 2003 05:51:13 -0000
@@ -493,7 +493,7 @@
io__write_int(N),
io__write_string("\n"),
dependency_graph__write_clique(Clique, ModuleInfo),
- { N1 is N + 1 },
+ { N1 = N + 1 },
dependency_graph__write_dependency_ordering(Rest, ModuleInfo, N1).
:- pred dependency_graph__write_clique(list(pred_proc_id),
@@ -951,7 +951,7 @@
aditi_scc_info_add_scc(SCC, HigherSCCs, SCCid, Info0, Info) :-
Info0 = aditi_scc_info(ModuleInfo, PredSCC0, SCCPred0, AditiPreds0,
SCCRel0, NoMerge, LastSCC),
- SCCid is LastSCC + 1,
+ SCCid = LastSCC + 1,
dependency_graph__get_scc_entry_points(SCC, HigherSCCs,
ModuleInfo, EntryPoints),
map__det_insert(SCCPred0, SCCid, SCC - EntryPoints, SCCPred),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.79
diff -u -b -r1.79 det_report.m
--- compiler/det_report.m 21 Mar 2003 05:52:05 -0000 1.79
+++ compiler/det_report.m 31 Mar 2003 05:51:14 -0000
@@ -802,7 +802,7 @@
->
{ ClausesWithSoln1 = ClausesWithSoln0 }
;
- { ClausesWithSoln1 is ClausesWithSoln0 + 1 }
+ { ClausesWithSoln1 = ClausesWithSoln0 + 1 }
),
det_diagnose_disj(Goals, Desired, Actual, SwitchContext, DetInfo,
ClausesWithSoln1, ClausesWithSoln, Diagnosed2),
@@ -1039,15 +1039,15 @@
det_report_msg(Msg, ModuleInfo),
(
{ MsgType = simple_code_warning },
- { WarnCnt1 is WarnCnt0 + 1 },
+ { WarnCnt1 = WarnCnt0 + 1 },
{ ErrCnt1 = ErrCnt0 }
;
{ MsgType = call_warning },
- { WarnCnt1 is WarnCnt0 + 1 },
+ { WarnCnt1 = WarnCnt0 + 1 },
{ ErrCnt1 = ErrCnt0 }
;
{ MsgType = error },
- { ErrCnt1 is ErrCnt0 + 1 },
+ { ErrCnt1 = ErrCnt0 + 1 },
{ WarnCnt1 = WarnCnt0 }
)
),
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.48
diff -u -b -r1.48 dnf.m
--- compiler/dnf.m 15 Mar 2003 03:08:44 -0000 1.48
+++ compiler/dnf.m 31 Mar 2003 05:51:14 -0000
@@ -73,6 +73,7 @@
:- import_module transform_hlds__dependency_graph.
:- import_module require, map, list, string, int, bool, std_util, term, varset.
+:- import_module counter.
% Traverse the module structure.
@@ -195,8 +196,8 @@
(
GoalExpr0 = conj(Goals0),
dnf__transform_conj(Goals0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, 0, _, DnfInfo,
- Goals, NewPredIds0, NewPredIds),
+ ModuleInfo0, ModuleInfo, Base, counter__init(0), _,
+ DnfInfo, Goals, NewPredIds0, NewPredIds),
Goal = conj(Goals) - GoalInfo
;
GoalExpr0 = par_conj(_Goals0),
@@ -204,33 +205,36 @@
;
GoalExpr0 = some(Vars, CanRemove, SomeGoal0),
dnf__make_goal_literal(SomeGoal0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, no, yes, Base, 0, _,
- DnfInfo, SomeGoal, NewPredIds0, NewPredIds),
+ ModuleInfo0, ModuleInfo, no, yes, Base,
+ counter__init(0), _, DnfInfo, SomeGoal,
+ NewPredIds0, NewPredIds),
Goal = some(Vars, CanRemove, SomeGoal) - GoalInfo
;
GoalExpr0 = not(NegGoal0),
dnf__make_goal_literal(NegGoal0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, yes, no, Base, 0, _,
- DnfInfo, NegGoal, NewPredIds0, NewPredIds),
+ ModuleInfo0, ModuleInfo, yes, no, Base,
+ counter__init(0), _, DnfInfo, NegGoal,
+ NewPredIds0, NewPredIds),
Goal = not(NegGoal) - GoalInfo
;
GoalExpr0 = disj(Goals0),
dnf__transform_disj(Goals0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, 0, DnfInfo,
- Goals, NewPredIds0, NewPredIds),
+ ModuleInfo0, ModuleInfo, Base, counter__init(0),
+ DnfInfo, Goals, NewPredIds0, NewPredIds),
Goal = disj(Goals) - GoalInfo
;
GoalExpr0 = switch(Var, CanFail, Cases0),
dnf__transform_switch(Cases0, InstMap0, MaybeNonAtomic,
- ModuleInfo0, ModuleInfo, Base, 0, DnfInfo,
- Cases, NewPredIds0, NewPredIds),
+ ModuleInfo0, ModuleInfo, Base, counter__init(0),
+ DnfInfo, Cases, NewPredIds0, NewPredIds),
Goal = switch(Var, CanFail, Cases) - GoalInfo
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
% XXX should handle nonempty Vars
dnf__transform_ite(Cond0, Then0, Else0, InstMap0,
- MaybeNonAtomic, ModuleInfo0, ModuleInfo, Base, 0,
- DnfInfo, Cond, Then, Else, NewPredIds0, NewPredIds),
+ MaybeNonAtomic, ModuleInfo0, ModuleInfo, Base,
+ counter__init(0), DnfInfo, Cond, Then, Else,
+ NewPredIds0, NewPredIds),
Goal = if_then_else(Vars, Cond, Then, Else) - GoalInfo
;
GoalExpr0 = generic_call(_, _, _, _),
@@ -262,7 +266,7 @@
:- pred dnf__transform_disj(list(hlds_goal)::in, instmap::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
- string::in, int::in, dnf_info::in, list(hlds_goal)::out,
+ string::in, counter::in, dnf_info::in, list(hlds_goal)::out,
list(pred_id)::in, list(pred_id)::out) is det.
dnf__transform_disj([], _, _, ModuleInfo, ModuleInfo, _, _, _, [],
@@ -282,7 +286,7 @@
:- pred dnf__transform_switch(list(case)::in, instmap::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
- string::in, int::in, dnf_info::in, list(case)::out,
+ string::in, counter::in, dnf_info::in, list(case)::out,
list(pred_id)::in, list(pred_id)::out) is det.
dnf__transform_switch([], _, _, ModuleInfo, ModuleInfo, _, _, _, [],
@@ -305,7 +309,7 @@
:- pred dnf__transform_ite(hlds_goal::in, hlds_goal::in, hlds_goal::in,
instmap::in, maybe(set(pred_proc_id))::in, module_info::in,
- module_info::out, string::in, int::in, dnf_info::in,
+ module_info::out, string::in, counter::in, dnf_info::in,
hlds_goal::out, hlds_goal::out, hlds_goal::out,
list(pred_id)::in, list(pred_id)::out) is det.
@@ -335,8 +339,8 @@
:- pred dnf__transform_conj(list(hlds_goal)::in, instmap::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
- string::in, int::in, int::out, dnf_info::in, list(hlds_goal)::out,
- list(pred_id)::in, list(pred_id)::out) is det.
+ string::in, counter::in, counter::out, dnf_info::in,
+ list(hlds_goal)::out, list(pred_id)::in, list(pred_id)::out) is det.
dnf__transform_conj([], _, _, ModuleInfo, ModuleInfo, _, Counter, Counter,
_, [], NewPreds, NewPreds).
@@ -357,8 +361,9 @@
:- pred dnf__make_goal_literal(hlds_goal::in, instmap::in,
maybe(set(pred_proc_id))::in, module_info::in, module_info::out,
- bool::in, bool::in, string::in, int::in, int::out, dnf_info::in,
- hlds_goal::out, list(pred_id)::in, list(pred_id)::out) is det.
+ bool::in, bool::in, string::in, counter::in, counter::out,
+ dnf_info::in, hlds_goal::out, list(pred_id)::in, list(pred_id)::out)
+ is det.
dnf__make_goal_literal(Goal0, InstMap0, MaybeNonAtomic, ModuleInfo0,
ModuleInfo, InNeg, InSome, Base, Counter0, Counter,
@@ -381,17 +386,17 @@
).
:- pred dnf__get_new_pred_name(predicate_table::in, string::in, string::out,
- int::in, int::out) is det.
+ counter::in, counter::out) is det.
-dnf__get_new_pred_name(PredTable, Base, Name, N0, N) :-
- string__int_to_string(N0, Suffix),
+dnf__get_new_pred_name(PredTable, Base, Name, Counter0, Counter) :-
+ counter__allocate(N, Counter0, Counter1),
+ string__int_to_string(N, Suffix),
string__append_list([Base, "__part_", Suffix], TrialName),
- N1 is N0 + 1,
( predicate_table_search_name(PredTable, TrialName, _) ->
- dnf__get_new_pred_name(PredTable, Base, Name, N1, N)
+ dnf__get_new_pred_name(PredTable, Base, Name, Counter1, Counter)
;
Name = TrialName,
- N = N1
+ Counter = Counter1
).
:- pred dnf__define_new_pred(hlds_goal::in, hlds_goal::out, instmap::in,
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.21
diff -u -b -r1.21 error_util.m
--- compiler/error_util.m 15 Mar 2003 03:08:45 -0000 1.21
+++ compiler/error_util.m 31 Mar 2003 05:51:14 -0000
@@ -247,7 +247,7 @@
{ string__pad_left("", ' ', Indent, IndentStr) },
io__write_string(IndentStr),
write_line(Line),
- { Indent2 is Indent + 2 },
+ { Indent2 = Indent + 2 },
write_nonfirst_lines(Lines, MaybeContext, Indent2).
:- pred write_nonfirst_lines(list(list(string))::in, maybe(prog_context)::in,
@@ -321,9 +321,9 @@
break_into_words_from(String, Cur, Words0, Words) :-
( find_word_start(String, Cur, Start) ->
find_word_end(String, Start, End),
- Length is End - Start + 1,
+ Length = End - Start + 1,
string__substring(String, Start, Length, Word),
- Next is End + 1,
+ Next = End + 1,
break_into_words_from(String, Next, [Word | Words0], Words)
;
Words = Words0
@@ -334,7 +334,7 @@
find_word_start(String, Cur, WordStart) :-
string__index(String, Cur, Char),
( char__is_whitespace(Char) ->
- Next is Cur + 1,
+ Next = Cur + 1,
find_word_start(String, Next, WordStart)
;
WordStart = Cur
@@ -343,7 +343,7 @@
:- pred find_word_end(string::in, int::in, int::out) is det.
find_word_end(String, Cur, WordEnd) :-
- Next is Cur + 1,
+ Next = Cur + 1,
( string__index(String, Next, Char) ->
( char__is_whitespace(Char) ->
WordEnd = Cur
@@ -378,7 +378,7 @@
get_line_of_words(FirstWord, LaterWords,
Max, Line, RestWords),
( IsFirst = yes ->
- Max2 is Max - 2
+ Max2 = Max - 2
;
Max2 = Max
),
@@ -417,7 +417,7 @@
get_later_words([], _, _, Line, Line, []).
get_later_words([Word | Words], OldLen, MaxLen, Line0, Line, RestWords) :-
string__length(Word, WordLen),
- NewLen is OldLen + 1 + WordLen,
+ NewLen = OldLen + 1 + WordLen,
( NewLen =< MaxLen ->
list__append(Line0, [Word], Line1),
get_later_words(Words, NewLen, MaxLen,
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.66
diff -u -b -r1.66 export.m
--- compiler/export.m 16 Mar 2003 08:01:26 -0000 1.66
+++ compiler/export.m 31 Mar 2003 05:51:14 -0000
@@ -440,7 +440,7 @@
get_argument_declarations_2([], _, _, _, "").
get_argument_declarations_2([AT|ATs], Num0, NameThem, Module, Result) :-
AT = ArgInfo - Type,
- Num is Num0 + 1,
+ Num = Num0 + 1,
get_argument_declaration(ArgInfo, Type, Num, NameThem, Module,
TypeString, ArgName),
(
@@ -484,7 +484,7 @@
get_input_args([AT|ATs], Num0, ModuleInfo, Result) :-
AT = ArgInfo - Type,
ArgInfo = arg_info(ArgLoc, Mode),
- Num is Num0 + 1,
+ Num = Num0 + 1,
(
Mode = top_in,
@@ -523,7 +523,7 @@
copy_output_args([AT|ATs], Num0, ModuleInfo, Result) :-
AT = ArgInfo - Type,
ArgInfo = arg_info(ArgLoc, Mode),
- Num is Num0 + 1,
+ Num = Num0 + 1,
(
Mode = top_in,
OutputArg = ""
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.48
diff -u -b -r1.48 exprn_aux.m
--- compiler/exprn_aux.m 9 May 2003 05:51:50 -0000 1.48
+++ compiler/exprn_aux.m 9 May 2003 06:45:24 -0000
@@ -911,7 +911,7 @@
exprn_aux__substitute_rvals_in_rval_1([], _, [], []).
exprn_aux__substitute_rvals_in_rval_1([Rval1 - Rval2 | RvalPairList], N0,
[Rval1 - Uniq | RvalUniqList], [Uniq - Rval2 | UniqRvalList]) :-
- N1 is N0 - 1,
+ N1 = N0 - 1,
Uniq = lval(framevar(N1)),
exprn_aux__substitute_rvals_in_rval_1(RvalPairList, N1,
RvalUniqList, UniqRvalList).
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.46
diff -u -b -r1.46 fact_table.m
--- compiler/fact_table.m 16 Mar 2003 08:01:26 -0000 1.46
+++ compiler/fact_table.m 31 Mar 2003 05:51:14 -0000
@@ -331,7 +331,7 @@
;
{ Result0 = term(_VarSet, Term) },
fact_table_size(FactTableSize),
- ( { 0 is NumFacts0 mod FactTableSize } ->
+ ( { 0 = NumFacts0 mod FactTableSize } ->
globals__io_lookup_bool_option(very_verbose,
VeryVerbose),
( { VeryVerbose = yes } ->
@@ -348,7 +348,7 @@
Result1),
{
Result1 = ok,
- NumFacts1 is NumFacts0 + 1
+ NumFacts1 = NumFacts0 + 1
;
Result1 = error,
NumFacts1 = NumFacts0
@@ -395,7 +395,7 @@
{ FuncHeadTerm = term__functor(
term__atom(PredString), Terms1, _) },
{ list__append(Terms1, [FuncResultTerm], Terms) },
- { Arity is Arity0 + 1 }
+ { Arity = Arity0 + 1 }
)
->
% Check that arity of the fact is correct
@@ -469,7 +469,7 @@
check_fact_type_and_mode(_, [], _, _, _, ok) --> [].
check_fact_type_and_mode(Types0, [Term | Terms], ArgNum0, PredOrFunc,
Context0, Result) -->
- { ArgNum is ArgNum0 + 1 },
+ { ArgNum = ArgNum0 + 1 },
(
{ Term = term__variable(_) },
prog_out__write_context(Context0),
@@ -682,7 +682,7 @@
(
{ Type = term__functor(term__atom("string"), [], _) }
->
- { I1 is I + 1 },
+ { I1 = I + 1 },
write_fact_table_struct(Infos, I1, Context,
StructContents1, Result),
{
@@ -698,7 +698,7 @@
;
{ Type = term__functor(term__atom("int"), [], _) }
->
- { I1 is I + 1 },
+ { I1 = I + 1 },
write_fact_table_struct(Infos, I1, Context,
StructContents1, Result),
{
@@ -714,7 +714,7 @@
;
{ Type = term__functor(term__atom("float"), [], _) }
->
- { I1 is I + 1 },
+ { I1 = I + 1 },
write_fact_table_struct(Infos, I1, Context,
StructContents1, Result),
{
@@ -1283,7 +1283,7 @@
write_fact_table_data(_, [], _, _) --> [].
write_fact_table_data(FactNum, [Args | ArgsList], StructName, OutputStream) -->
write_fact_data(FactNum, Args, StructName, OutputStream),
- { NextFactNum is FactNum + 1 },
+ { NextFactNum = FactNum + 1 },
write_fact_table_data(NextFactNum, ArgsList, StructName, OutputStream).
@@ -1297,7 +1297,7 @@
write_fact_data(FactNum, Args, StructName, OutputStream) -->
fact_table_size(FactTableSize),
- ( { 0 is FactNum mod FactTableSize } ->
+ ( { 0 = FactNum mod FactTableSize } ->
( { FactNum = 0 } ->
[]
;
@@ -1656,7 +1656,7 @@
TableNum0, TableNum1, IsPrimaryTable, OutputStream,
MatchingFacts, FactMap1, HashList0, HashList1),
{ list__length(MatchingFacts, Len) },
- { NextFactNum is FactNum + Len },
+ { NextFactNum = FactNum + Len },
build_hash_table_2(NextFactNum, InputArgNum, HashTableName, StructName,
TableNum1, ArgModes, ModuleInfo, Infos, IsPrimaryTable,
OutputStream, MaybeNextFact, MaybeDataStream, CreateFactMap,
@@ -1702,7 +1702,7 @@
TableNum0, TableNum1, IsPrimaryTable, OutputStream,
MatchingFacts, FactMap, HashList0, HashList1),
{ list__length(MatchingFacts, Len) },
- { NextFactNum is FactNum + Len },
+ { NextFactNum = FactNum + Len },
build_hash_table_lower_levels_2(NextFactNum, InputArgNum,
HashTableName, TableNum1, TableNum, IsPrimaryTable,
OutputStream, Facts1, FactMap, HashList1, HashList).
@@ -1742,12 +1742,12 @@
{ TableNum = TableNum0 }
;
% see if there are any more input arguments
- { NextInputArgNum is InputArgNum + 1 },
+ { NextInputArgNum = InputArgNum + 1 },
{ Fact = sort_file_line(InputArgs, _, _) },
- { N is NextInputArgNum + 1 },
+ { N = NextInputArgNum + 1 },
{ list__drop(N, InputArgs, _) }
->
- { TableNum1 is TableNum0 + 1 },
+ { TableNum1 = TableNum0 + 1 },
build_hash_table_lower_levels(FactNum, NextInputArgNum,
HashTableName, TableNum1, TableNum,
IsPrimaryTable, OutputStream, Facts, FactMap),
@@ -1875,7 +1875,7 @@
update_fact_map(FactNum, [Fact | Facts], FactMap0, FactMap) :-
Fact = sort_file_line(_, Index, _),
map__set(FactMap0, Index, FactNum, FactMap1),
- NextFactNum is FactNum + 1,
+ NextFactNum = FactNum + 1,
update_fact_map(NextFactNum, Facts, FactMap1, FactMap).
%---------------------------------------------------------------------------%
@@ -2088,7 +2088,7 @@
524309, 1048627, 2097257, 4194493, 8388949, 16777903,
33555799, 67108879, 134217757, 268435459, 536870923,
1073741827, 2147483647 ] },
- { N is (NumEntries * 100) // PercentFull },
+ { N = (NumEntries * 100) // PercentFull },
{ calculate_hash_table_size_2(N, Primes, HashTableSize) }.
:- pred calculate_hash_table_size_2(int, list(int), int).
@@ -2159,14 +2159,14 @@
get_free_hash_slot(HashTable, Start, Free) :-
HashTable = hash_table(Size, _),
- Max is Size - 1,
+ Max = Size - 1,
get_free_hash_slot_2(HashTable, Start, Max, Free).
:- pred get_free_hash_slot_2(hash_table, int, int, int).
:- mode get_free_hash_slot_2(in, in, in, out) is det.
get_free_hash_slot_2(HashTable, Start, Max, Free) :-
- Next is (Start + 1) mod Max,
+ Next = (Start + 1) mod Max,
(
hash_table_search(HashTable, Next, _)
->
@@ -2213,7 +2213,7 @@
fact_table_hash_2(_, [], HashVal, HashVal).
fact_table_hash_2(HashSize, [N | Ns], HashVal0, HashVal) :-
- HashVal1 is (N + 31 * HashVal0) mod HashSize,
+ HashVal1 = (N + 31 * HashVal0) mod HashSize,
fact_table_hash_2(HashSize, Ns, HashVal1, HashVal).
:- pred hash_list_insert_many(list(hash_entry), list(sort_file_line), bool,
@@ -2278,7 +2278,7 @@
io__set_output_stream(OutputStream, OldOutputStream),
io__write_strings([HashTableDataName, " = {\n"]),
{ HashTable = hash_table(Size, _) },
- { MaxIndex is Size - 1 },
+ { MaxIndex = Size - 1 },
write_hash_table_2(HashTable, 0, MaxIndex),
io__write_string("};\n\n"),
io__format("
@@ -2340,7 +2340,7 @@
"0, MR_FACT_TABLE_MAKE_TAGGED_POINTER(NULL, 0), -1 ")
),
io__write_string("},\n"),
- { NextIndex is CurrIndex + 1 },
+ { NextIndex = CurrIndex + 1 },
write_hash_table_2(HashTable, NextIndex, MaxIndex)
).
@@ -2386,7 +2386,7 @@
error("get_hash_table_type: invalid term")
)
;
- NextIndex is Index + 1,
+ NextIndex = Index + 1,
get_hash_table_type_2(Map, NextIndex, TableType)
).
@@ -2422,7 +2422,7 @@
io__format(OutputStream, "\t%s%d,\n",
[s(StructName), i(CurrFact)]),
fact_table_size(FactTableSize),
- { NextFact is CurrFact + FactTableSize },
+ { NextFact = CurrFact + FactTableSize },
write_fact_table_pointer_array_2(NextFact, NumFacts, StructName,
OutputStream)
).
@@ -2697,7 +2697,7 @@
string__format("\t\t%s = %s[0][0].V_%d;\n", [s(VarName), s(StructName),
i(ArgNum)], ProcCode1),
string__append(ProcCode1, ProcCode0, ProcCode2),
- NextArgNum is ArgNum + 1,
+ NextArgNum = ArgNum + 1,
generate_cc_multi_code_2(PragmaVars, StructName, NextArgNum, ProcCode2,
ProcCode).
@@ -2809,7 +2809,7 @@
generate_hash_code([pragma_var(_, Name, Mode)|PragmaVars], [Type | Types],
ModuleInfo, LabelName, LabelNum, PredName, ArgNum,
FactTableSize, C_Code) :-
- NextArgNum is ArgNum + 1,
+ NextArgNum = ArgNum + 1,
( mode_is_fully_input(ModuleInfo, Mode) ->
(
Type = term__functor(term__atom("int"), [], _)
@@ -2832,7 +2832,7 @@
;
error("generate_hash_code: unsupported type")
),
- NextLabelNum is LabelNum + 1,
+ NextLabelNum = LabelNum + 1,
generate_hash_code(PragmaVars, Types, ModuleInfo, LabelName,
NextLabelNum, PredName, NextArgNum, FactTableSize,
C_Code1),
@@ -3020,7 +3020,7 @@
error("generate_fact_lookup_code: too many types").
generate_fact_lookup_code(PredName, [pragma_var(_, VarName, Mode)|PragmaVars],
[Type | Types], ModuleInfo, ArgNum, FactTableSize, C_Code) :-
- NextArgNum is ArgNum + 1,
+ NextArgNum = ArgNum + 1,
( mode_is_fully_output(ModuleInfo, Mode) ->
TableEntryTemplate =
"mercury__%s_fact_table[ind/%d][ind%%%d].V_%d",
@@ -3241,7 +3241,7 @@
->
generate_arg_decl_code(VarName, Type, Module, DeclCode0),
( ArgMode = top_in ->
- NumInputArgs1 is NumInputArgs0 + 1,
+ NumInputArgs1 = NumInputArgs0 + 1,
generate_arg_input_code(VarName, Type, Loc,
NumInputArgs1, InputCode0, SaveRegsCode0,
GetRegsCode0),
@@ -3361,7 +3361,7 @@
CondCode1 = "",
IsFirstInputArg = IsFirstInputArg0
),
- NextArgNum is ArgNum + 1,
+ NextArgNum = ArgNum + 1,
generate_test_condition_code(FactTableName, PragmaVars, Types,
ModuleInfo, NextArgNum, IsFirstInputArg, FactTableSize,
CondCode2),
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.27
diff -u -b -r1.27 foreign.m
--- compiler/foreign.m 16 Mar 2003 08:01:26 -0000 1.27
+++ compiler/foreign.m 31 Mar 2003 05:51:14 -0000
@@ -575,7 +575,7 @@
%
% Figure out a name for the C variable which will hold this argument
%
- ArgNum is ArgNum0 + 1,
+ ArgNum = ArgNum0 + 1,
string__int_to_string(ArgNum, ArgNumString),
string__append("Arg", ArgNumString, ArgName),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.84
diff -u -b -r1.84 goal_util.m
--- compiler/goal_util.m 18 Mar 2003 02:43:35 -0000 1.84
+++ compiler/goal_util.m 31 Mar 2003 05:51:14 -0000
@@ -740,7 +740,7 @@
goals_size([Goal | Goals], Size) :-
goal_size(Goal, Size1),
goals_size(Goals, Size2),
- Size is Size1 + Size2.
+ Size = Size1 + Size2.
clause_list_size(Clauses, GoalSize) :-
GetClauseSize =
@@ -764,7 +764,7 @@
cases_size([case(_, Goal) | Cases], Size) :-
goal_size(Goal, Size1),
cases_size(Cases, Size2),
- Size is Size1 + Size2.
+ Size = Size1 + Size2.
:- pred goal_expr_size(hlds_goal_expr, int).
:- mode goal_expr_size(in, out) is det.
@@ -773,24 +773,24 @@
goals_size(Goals, Size).
goal_expr_size(par_conj(Goals), Size) :-
goals_size(Goals, Size1),
- Size is Size1 + 1.
+ Size = Size1 + 1.
goal_expr_size(disj(Goals), Size) :-
goals_size(Goals, Size1),
- Size is Size1 + 1.
+ Size = Size1 + 1.
goal_expr_size(switch(_, _, Goals), Size) :-
cases_size(Goals, Size1),
- Size is Size1 + 1.
+ Size = Size1 + 1.
goal_expr_size(if_then_else(_, Cond, Then, Else), Size) :-
goal_size(Cond, Size1),
goal_size(Then, Size2),
goal_size(Else, Size3),
- Size is Size1 + Size2 + Size3 + 1.
+ Size = Size1 + Size2 + Size3 + 1.
goal_expr_size(not(Goal), Size) :-
goal_size(Goal, Size1),
- Size is Size1 + 1.
+ Size = Size1 + 1.
goal_expr_size(some(_, _, Goal), Size) :-
goal_size(Goal, Size1),
- Size is Size1 + 1.
+ Size = Size1 + 1.
goal_expr_size(call(_, _, _, _, _, _), 1).
goal_expr_size(generic_call(_, _, _, _), 1).
goal_expr_size(unify(_, _, _, _, _), 1).
@@ -804,7 +804,7 @@
goal_expr_size_shorthand(bi_implication(LHS, RHS), Size) :-
goal_size(LHS, Size1),
goal_size(RHS, Size2),
- Size is Size1 + Size2 + 1.
+ Size = Size1 + Size2 + 1.
%-----------------------------------------------------------------------------%
%
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.106
diff -u -b -r1.106 higher_order.m
--- compiler/higher_order.m 17 May 2003 04:31:51 -0000 1.106
+++ compiler/higher_order.m 22 May 2003 18:57:47 -0000
@@ -1308,7 +1308,7 @@
find_higher_order_args(ModuleInfo, CalleeStatus, [Arg | Args],
[CalleeArgType | CalleeArgTypes], VarTypes,
PredVars, ArgNo, HOArgs0, HOArgs) :-
- NextArg is ArgNo + 1,
+ NextArg = ArgNo + 1,
(
% We don't specialize arguments whose declared type is
% polymorphic. The closure they pass cannot possibly
@@ -2559,7 +2559,7 @@
[]
),
io__write_string(" with higher-order arguments:\n"),
- { NumToDrop is ActualArity - Arity },
+ { NumToDrop = ActualArity - Arity },
output_higher_order_args(ModuleInfo, NumToDrop, 0, HOArgs).
:- pred output_higher_order_args(module_info::in, int::in, int::in,
@@ -2582,7 +2582,7 @@
{ pred_info_name(PredInfo, Name) },
{ pred_info_arity(PredInfo, Arity) },
% adjust message for type_infos
- { DeclaredArgNo is ArgNo - NumToDrop },
+ { DeclaredArgNo = ArgNo - NumToDrop },
io__write_string("HeadVar__"),
io__write_int(DeclaredArgNo),
io__write_string(" = `"),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.85
diff -u -b -r1.85 hlds_module.m
--- compiler/hlds_module.m 1 May 2003 22:50:48 -0000 1.85
+++ compiler/hlds_module.m 23 May 2003 06:20:07 -0000
@@ -498,17 +498,20 @@
:- implementation.
-:- pred module_info_get_lambda_count(module_info, int).
-:- mode module_info_get_lambda_count(in, out) is det.
+:- import_module counter.
-:- pred module_info_set_lambda_count(module_info, int, module_info).
-:- mode module_info_set_lambda_count(in, in, out) is det.
+:- pred module_info_get_lambda_counter(module_info, counter).
+:- mode module_info_get_lambda_counter(in, out) is det.
-:- pred module_info_get_model_non_pragma_count(module_info, int).
-:- mode module_info_get_model_non_pragma_count(in, out) is det.
+:- pred module_info_set_lambda_counter(module_info, counter, module_info).
+:- mode module_info_set_lambda_counter(in, in, out) is det.
-:- pred module_info_set_model_non_pragma_count(module_info, int, module_info).
-:- mode module_info_set_model_non_pragma_count(in, in, out) is det.
+:- pred module_info_get_model_non_pragma_counter(module_info, counter).
+:- mode module_info_get_model_non_pragma_counter(in, out) is det.
+
+:- pred module_info_set_model_non_pragma_counter(module_info, counter,
+ module_info).
+:- mode module_info_set_model_non_pragma_counter(in, in, out) is det.
:- pred module_info_set_maybe_dependency_info(module_info,
maybe(dependency_info), module_info).
@@ -549,7 +552,6 @@
% (that includes opt_imported procedures).
maybe_dependency_info :: maybe(dependency_info),
num_errors :: int,
- last_lambda_number :: int,
pragma_exported_procs :: list(pragma_exported_proc),
% list of the procs for which
% there is a pragma export(...)
@@ -562,7 +564,8 @@
% predicates in the current
% module which has been exported
% in .opt files.
- model_non_pragma_types_so_far :: int,
+ lambda_number_counter :: counter,
+ model_non_pragma_counter :: counter,
% number of the structure types defined
% so far for model_non pragma C codes
imported_module_specifiers :: set(module_specifier),
@@ -625,10 +628,11 @@
map__init(FieldNameTable),
map__init(NoTagTypes),
- ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], no, 0, 0, [],
- [], StratPreds, UnusedArgInfo, 0, ImportedModules,
- IndirectlyImportedModules, no_aditi_compilation,
- TypeSpecInfo, NoTagTypes, init_analysis_info(mmc)),
+ ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], no, 0, [],
+ [], StratPreds, UnusedArgInfo, counter__init(1),
+ counter__init(1), ImportedModules, IndirectlyImportedModules,
+ no_aditi_compilation, TypeSpecInfo,
+ NoTagTypes, init_analysis_info(mmc)),
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
@@ -692,14 +696,14 @@
module_info_get_maybe_dependency_info(MI,
MI ^ sub_info ^ maybe_dependency_info).
module_info_num_errors(MI, MI ^ sub_info ^ num_errors).
-module_info_get_lambda_count(MI, MI ^ sub_info ^ last_lambda_number).
module_info_get_pragma_exported_procs(MI,
MI ^ sub_info ^ pragma_exported_procs).
module_info_type_ctor_gen_infos(MI, MI ^ sub_info ^ type_ctor_gen_infos).
module_info_stratified_preds(MI, MI ^ sub_info ^ must_be_stratified_preds).
module_info_unused_arg_info(MI, MI ^ sub_info ^ unused_arg_info).
-module_info_get_model_non_pragma_count(MI,
- MI ^ sub_info ^ model_non_pragma_types_so_far).
+module_info_get_lambda_counter(MI, MI ^ sub_info ^ lambda_number_counter).
+module_info_get_model_non_pragma_counter(MI,
+ MI ^ sub_info ^ model_non_pragma_counter).
module_info_get_imported_module_specifiers(MI,
MI ^ sub_info ^ imported_module_specifiers).
module_info_get_indirectly_imported_module_specifiers(MI,
@@ -729,8 +733,6 @@
MI ^ sub_info ^ maybe_dependency_info := NewVal).
module_info_set_num_errors(MI, NewVal,
MI ^ sub_info ^ num_errors := NewVal).
-module_info_set_lambda_count(MI, NewVal,
- MI ^ sub_info ^ last_lambda_number := NewVal).
module_info_set_pragma_exported_procs(MI, NewVal,
MI ^ sub_info ^ pragma_exported_procs := NewVal).
module_info_set_type_ctor_gen_infos(MI, NewVal,
@@ -739,8 +741,10 @@
MI ^ sub_info ^ must_be_stratified_preds := NewVal).
module_info_set_unused_arg_info(MI, NewVal,
MI ^ sub_info ^ unused_arg_info := NewVal).
-module_info_set_model_non_pragma_count(MI, NewVal,
- MI ^ sub_info ^ model_non_pragma_types_so_far := NewVal).
+module_info_set_lambda_counter(MI, NewVal,
+ MI ^ sub_info ^ lambda_number_counter := NewVal).
+module_info_set_model_non_pragma_counter(MI, NewVal,
+ MI ^ sub_info ^ model_non_pragma_counter := NewVal).
module_add_imported_module_specifiers(ModuleSpecifiers, MI,
MI ^ sub_info ^ imported_module_specifiers :=
set__insert_list(
@@ -871,18 +875,18 @@
module_info_incr_errors(MI0, MI) :-
module_info_num_errors(MI0, Errs0),
- Errs is Errs0 + 1,
+ Errs = Errs0 + 1,
module_info_set_num_errors(MI0, Errs, MI).
module_info_next_lambda_count(MI0, Count, MI) :-
- module_info_get_lambda_count(MI0, Count0),
- Count is Count0 + 1,
- module_info_set_lambda_count(MI0, Count, MI).
+ module_info_get_lambda_counter(MI0, Counter0),
+ counter__allocate(Count, Counter0, Counter),
+ module_info_set_lambda_counter(MI0, Counter, MI).
module_info_next_model_non_pragma_count(MI0, Count, MI) :-
- module_info_get_model_non_pragma_count(MI0, Count0),
- Count is Count0 + 1,
- module_info_set_model_non_pragma_count(MI0, Count, MI).
+ module_info_get_model_non_pragma_counter(MI0, Counter0),
+ counter__allocate(Count, Counter0, Counter),
+ module_info_set_model_non_pragma_counter(MI0, Counter, MI).
% After we have finished constructing the symbol tables,
% we balance all the binary trees, to improve performance
@@ -1414,7 +1418,7 @@
PredN, PredNA, PredMNA, FuncN0, FuncNA0, FuncMNA0)
;
IsPredOrFunc = function,
- FuncArity is Arity - 1,
+ FuncArity = Arity - 1,
predicate_table_remove_from_index(Module, Name, FuncArity,
PredId, FuncN0, FuncN, FuncNA0, FuncNA,
FuncMNA0, FuncMNA),
@@ -1723,7 +1727,7 @@
Module, Name, Arity, PredIds).
predicate_table_search_pf_m_n_a(PredicateTable, IsFullyQualified,
function, Module, Name, Arity, PredIds) :-
- FuncArity is Arity - 1,
+ FuncArity = Arity - 1,
predicate_table_search_func_m_n_a(PredicateTable, IsFullyQualified,
Module, Name, FuncArity, PredIds).
@@ -1733,7 +1737,7 @@
PredIds).
predicate_table_search_pf_name_arity(PredicateTable, function, Name, Arity,
PredIds) :-
- FuncArity is Arity - 1,
+ FuncArity = Arity - 1,
predicate_table_search_func_name_arity(PredicateTable, Name, FuncArity,
PredIds).
@@ -1856,9 +1860,7 @@
Func_MNA_Index = Func_MNA_Index0
;
PredOrFunc = function,
-
- FuncArity is Arity - 1,
-
+ FuncArity = Arity - 1,
predicate_table_do_insert(Module, Name, FuncArity,
NeedQual, MaybeQualInfo, PredId,
Func_N_Index0, Func_N_Index,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.308
diff -u -b -r1.308 hlds_out.m
--- compiler/hlds_out.m 19 May 2003 14:24:23 -0000 1.308
+++ compiler/hlds_out.m 22 May 2003 18:57:47 -0000
@@ -559,7 +559,7 @@
io__write_string(" term")
;
io__write_string("argument "),
- { ArgNum1 is ArgNum - 1 },
+ { ArgNum1 = ArgNum - 1 },
io__write_int(ArgNum1),
io__write_string(" of the called "),
hlds_out__write_pred_or_func(PredOrFunc)
@@ -1090,7 +1090,7 @@
Lang,
Context
),
- Indent1 is Indent + 1
+ Indent1 = Indent + 1
},
globals__io_lookup_string_option(dump_hlds_options, Verbose),
( { string__contains_char(Verbose, 'm') } ->
@@ -1414,7 +1414,7 @@
io__write_string(" switch on `"),
mercury_output_var(Var, VarSet, AppendVarnums),
io__write_string("'\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
( { CasesList = [Case | Cases] } ->
hlds_out__write_case(Case, Var, ModuleInfo,
VarSet, AppendVarnums, Indent1, TypeQual),
@@ -1440,7 +1440,7 @@
[]
),
io__nl,
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
hlds_out__write_indent(Indent),
@@ -1453,7 +1453,7 @@
io__write_string("(if"),
hlds_out__write_some(Vars, VarSet),
io__write_string("\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Cond, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
hlds_out__write_indent(Indent),
@@ -1481,7 +1481,7 @@
Indent, Follow, TypeQual) -->
hlds_out__write_indent(Indent),
io__write_string("\\+ (\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
hlds_out__write_indent(Indent),
@@ -1493,7 +1493,7 @@
( { List = [Goal | Goals] } ->
globals__io_lookup_string_option(dump_hlds_options, Verbose),
( { Verbose \= "" } ->
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_indent(Indent),
io__write_string("( % conjunction\n"),
hlds_out__write_conj(Goal, Goals, ModuleInfo, VarSet,
@@ -1518,7 +1518,7 @@
hlds_out__write_indent(Indent),
( { List = [Goal | Goals] } ->
io__write_string("( % parallel conjunction\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
% See comments at hlds_out__write_goal_list.
@@ -1537,7 +1537,7 @@
hlds_out__write_indent(Indent),
( { List = [Goal | Goals] } ->
io__write_string("( % disjunction\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
hlds_out__write_goal_list(Goals, ModuleInfo, VarSet,
@@ -1824,7 +1824,7 @@
VarSet, AppendVarnums, Indent, Follow, TypeQual) -->
hlds_out__write_indent(Indent),
io__write_string("( % bi-implication\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(LHS, ModuleInfo, VarSet, AppendVarnums,
Indent1, "\n", TypeQual),
hlds_out__write_indent(Indent),
@@ -2308,7 +2308,7 @@
ModuleInfo, VarSet, InstVarSet, AppendVarnums, Indent,
MaybeType, TypeQual)
-->
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
write_purity_prefix(Purity),
{
EvalMethod = normal,
@@ -2601,7 +2601,7 @@
->
hlds_out__write_indent(Indent),
io__write_string(Separator),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet,
AppendVarnums, Indent1, "\n", TypeQual),
hlds_out__write_goal_list(Goals, ModuleInfo, VarSet,
@@ -2641,7 +2641,7 @@
->
hlds_out__write_indent(Indent),
io__write_string(";\n"),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_case(Case, Var, ModuleInfo,
VarSet, AppendVarnums, Indent1, VarTypes),
hlds_out__write_cases(Cases, Var, ModuleInfo,
@@ -2932,7 +2932,7 @@
io__write_string(":- type "),
hlds_out__write_type_name(TypeCtor),
hlds_out__write_type_params(TVarSet, TypeParams),
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_type_body(Indent1, TVarSet, TypeBody),
hlds_out__write_types_2(Indent, Types).
@@ -3393,7 +3393,7 @@
{ proc_info_is_address_taken(Proc, IsAddressTaken) },
{ proc_info_get_call_table_tip(Proc, MaybeCallTableTip) },
{ proc_info_get_maybe_deep_profile_info(Proc, MaybeDeepProfileInfo) },
- { Indent1 is Indent + 1 },
+ { Indent1 = Indent + 1 },
hlds_out__write_indent(Indent1),
io__write_string("% pred id "),
@@ -3547,7 +3547,7 @@
% ;
% hlds_out__write_indent(Indent),
% io__write_string("[\n"),
-% {Indent1 is Indent + 1},
+% {Indent1 = Indent + 1},
% hlds_out__write_varnames_2(Indent1, VarNameList),
% hlds_out__write_indent(Indent),
% io__write_string("]\n")
@@ -3561,7 +3561,7 @@
% (
% { VarNameList0 = [VarId - Name|VarNameList] }
% ->
-% { Indent1 is Indent + 1 },
+% { Indent1 = Indent + 1 },
% hlds_out__write_indent(Indent1),
% { term__var_to_int(VarId, VarNum) },
% io__write_int(VarNum),
@@ -3646,7 +3646,7 @@
[]
;
io__write_char('\t'),
- { Indent1 is Indent - 1 },
+ { Indent1 = Indent - 1 },
hlds_out__write_indent(Indent1)
).
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.125
diff -u -b -r1.125 hlds_pred.m
--- compiler/hlds_pred.m 20 May 2003 16:20:41 -0000 1.125
+++ compiler/hlds_pred.m 22 May 2003 18:57:48 -0000
@@ -925,7 +925,7 @@
hlds_pred__initial_proc_id(0).
hlds_pred__next_pred_id(PredId, NextPredId) :-
- NextPredId is PredId + 1.
+ NextPredId = PredId + 1.
pred_id_to_int(PredId, PredId).
@@ -2663,7 +2663,7 @@
VarSet = VarSet0,
Vars = []
;
- N1 is N + 1,
+ N1 = N + 1,
varset__new_var(VarSet0, Var, VarSet1),
string__int_to_string(N1, Num),
string__append(BaseName, Num, VarName),
@@ -2674,7 +2674,7 @@
pred_args_to_func_args(PredArgs, FuncArgs, FuncReturn) :-
list__length(PredArgs, NumPredArgs),
- NumFuncArgs is NumPredArgs - 1,
+ NumFuncArgs = NumPredArgs - 1,
( list__split_list(NumFuncArgs, PredArgs, FuncArgs0, [FuncReturn0]) ->
FuncArgs = FuncArgs0,
FuncReturn = FuncReturn0
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.110
diff -u -b -r1.110 inlining.m
--- compiler/inlining.m 15 Mar 2003 03:08:52 -0000 1.110
+++ compiler/inlining.m 31 Mar 2003 05:51:16 -0000
@@ -588,7 +588,7 @@
proc_info_varset(ProcInfo, CalleeVarSet),
varset__vars(CalleeVarSet, CalleeListOfVars),
list__length(CalleeListOfVars, CalleeThisMany),
- TotalVars is ThisMany + CalleeThisMany,
+ TotalVars = ThisMany + CalleeThisMany,
TotalVars =< VarThresh
->
inlining__do_inline_call(HeadTypeParams, ArgVars, PredInfo,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.140
diff -u -b -r1.140 intermod.m
--- compiler/intermod.m 19 May 2003 14:24:24 -0000 1.140
+++ compiler/intermod.m 22 May 2003 18:57:48 -0000
@@ -393,7 +393,7 @@
% simple goal in each disjunct. The
% disjunction adds one to the goal size,
% hence the `+1'.
- DeforestThreshold is InlineThreshold * 2 + 1,
+ DeforestThreshold = InlineThreshold * 2 + 1,
inlining__is_simple_clause_list(Clauses,
DeforestThreshold + Arity),
clause_list_is_deforestable(PredId, Clauses)
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.48
diff -u -b -r1.48 lookup_switch.m
--- compiler/lookup_switch.m 9 May 2003 05:51:51 -0000 1.48
+++ compiler/lookup_switch.m 21 May 2003 13:05:36 -0000
@@ -117,8 +117,8 @@
FirstCase = case(_, int_constant(FirstCaseVal), _, _),
list__index1_det(TaggedCases, NumCases, LastCase),
LastCase = case(_, int_constant(LastCaseVal), _, _),
- Span is LastCaseVal - FirstCaseVal,
- Range is Span + 1,
+ Span = LastCaseVal - FirstCaseVal,
+ Range = Span + 1,
dense_switch__calc_density(NumCases, Range, Density),
Density > ReqDensity
},
@@ -153,7 +153,7 @@
{ NeedRangeCheck = cannot_fail },
{ NeedBitVecTest = can_fail },
{ FirstVal = 0 },
- { LastVal is TypeRange - 1 }
+ { LastVal = TypeRange - 1 }
;
{ NeedRangeCheck = SwitchCanFail },
{ NeedBitVecTest = NeedBitVecTest0 },
@@ -297,7 +297,7 @@
% appropriate range.
(
{ NeedRangeCheck = can_fail },
- { Difference is EndVal - StartVal },
+ { Difference = EndVal - StartVal },
code_info__fail_if_rval_is_false(
binop(unsigned_le, Index,
const(int_const(Difference))), RangeCheck)
Index: compiler/lp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lp.m,v
retrieving revision 1.6
diff -u -b -r1.6 lp.m
--- compiler/lp.m 20 Mar 2002 12:36:35 -0000 1.6
+++ compiler/lp.m 27 Nov 2002 04:25:48 -0000
@@ -159,7 +159,7 @@
Result = Result0
;
Result0 = satisfiable(NOptVal, OptCoffs),
- OptVal is -NOptVal,
+ OptVal = -NOptVal,
Result = satisfiable(OptVal, OptCoffs)
)
).
@@ -302,11 +302,11 @@
),
Neg = lambda([Pair0::in, Pair::out] is det, (
Pair0 = V - X0,
- X is -X0,
+ X = -X0,
Pair = V - X
)),
list__map(Neg, Coeffs0, Coeffs),
- Const is -Const0.
+ Const = -Const0.
:- pred simplify(equation, equation).
:- mode simplify(in, out) is det.
@@ -335,7 +335,7 @@
;
Acc1 = 0.0
),
- Acc is Acc1 + Coeff,
+ Acc = Acc1 + Coeff,
map__set(Map0, Var, Acc, Map).
:- pred expand_urs_vars_e(equation, map(var, pair(var)), equation).
@@ -358,7 +358,7 @@
expand_urs_vars([], _Vars, Coeffs, Coeffs).
expand_urs_vars([Var - Coeff|Rest], Vars, Coeffs0, Coeffs) :-
( map__search(Vars, Var, PVar - NVar) ->
- NCoeff is -Coeff,
+ NCoeff = -Coeff,
Coeffs1 = [NVar - NCoeff, PVar - Coeff|Coeffs0]
;
Coeffs1 = [Var - Coeff|Coeffs0]
@@ -391,7 +391,7 @@
number_vars([], _, VarNums, VarNums).
number_vars([Var|Vars], N, VarNums0, VarNums) :-
map__det_insert(VarNums0, Var, N, VarNums1),
- N1 is N + 1,
+ N1 = N + 1,
number_vars(Vars, N1, VarNums1, VarNums).
:- pred insert_equations(equations, int, int, map(var, int), tableau, tableau).
@@ -402,7 +402,7 @@
Eqn = eqn(Coeffs, _Op, Const),
insert_coeffs(Coeffs, Row, VarNums, Tableau0, Tableau1),
set_index(Tableau1, Row, ConstCol, Const, Tableau2),
- Row1 is Row + 1,
+ Row1 = Row + 1,
insert_equations(Eqns, Row1, ConstCol, VarNums, Tableau2, Tableau).
:- pred insert_coeffs(list(coeff), int, map(var, int), tableau, tableau).
@@ -449,7 +449,7 @@
( map__search(Vars, Var, Pos - Neg) ->
extract_obj_var2(Tab, Pos, PosVal),
extract_obj_var2(Tab, Neg, NegVal),
- Val is PosVal - NegVal
+ Val = PosVal - NegVal
;
extract_obj_var2(Tab, Var, Val)
),
@@ -513,7 +513,7 @@
( MaxVal > 0.0 ->
rhs_col(A0, RHSC),
index(A0, Row, RHSC, MVal),
- CVal is MVal/MaxVal,
+ CVal = MVal/MaxVal,
Max = yes(Row - CVal)
;
Max = no
@@ -525,7 +525,7 @@
index(A0, Row, RHSC, MVal),
(
CellVal > 0.0,
- MaxVal1 is MVal/CellVal,
+ MaxVal1 = MVal/CellVal,
MaxVal1 =< MaxVal0
->
Max = yes(Row - MaxVal1)
@@ -568,7 +568,7 @@
solutions(FindOne, Ones),
(
Ones = [Row - Fac0|_],
- Fac is -Val/Fac0,
+ Fac = -Val/Fac0,
row_op(Fac, Row, 0, Tableau0, Tableau1),
ensure_zero_obj_coeffs(Vs, Tableau1, Tableau)
;
@@ -638,7 +638,7 @@
index(T0, J, K, Ajk),
index(T0, J, Q, Ajq),
index(T0, P, K, Apk),
- NewAjk is Ajk - Apk * Ajq / Apq,
+ NewAjk = Ajk - Apk * Ajq / Apq,
set_index(T0, J, K, NewAjk, T)
)),
aggregate(MostCells, ScaleCell, A0, A1),
@@ -654,7 +654,7 @@
PRow = all_cols0(A2),
ScaleRow = lambda([K::in, T0::in, T::out] is det, (
index(T0, P, K, Apk),
- NewApk is Apk / Apq,
+ NewApk = Apk / Apq,
set_index(T0, P, K, NewApk, T)
)),
aggregate(PRow, ScaleRow, A2, A3),
@@ -668,7 +668,7 @@
AddRow = lambda([Col::in, T0::in, T::out] is det, (
index(T0, From, Col, X),
index(T0, To, Col, Y),
- Z is Y + (Scale * X),
+ Z = Y + (Scale * X),
set_index(T0, To, Col, Z, T)
)),
aggregate(AllCols, AddRow, A0, A).
@@ -770,7 +770,7 @@
all_cols(Tableau, Col) :-
Tableau = tableau(_Rows, Cols, _, _, _, SC, _),
- Cols1 is Cols - 1,
+ Cols1 = Cols - 1,
between(0, Cols1, Col),
\+ list__member(Col, SC).
@@ -941,7 +941,7 @@
(
I = Min
;
- Min1 is Min + 1,
+ Min1 = Min + 1,
between(Min1, Max, I)
).
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.35
diff -u -b -r1.35 magic.m
--- compiler/magic.m 18 Mar 2003 02:43:37 -0000 1.35
+++ compiler/magic.m 31 Mar 2003 05:51:17 -0000
@@ -948,7 +948,7 @@
magic__interface_call_args([], _, _, _, _, []) --> [].
magic__interface_call_args([MagicInput | MagicInputs], MagicTypes, MagicModes,
CalledPredIndex, CurrVar, InputGoals) -->
- { NextVar is CurrVar + 1 },
+ { NextVar = CurrVar + 1 },
magic__interface_call_args(MagicInputs, MagicTypes, MagicModes,
CalledPredIndex, NextVar, InputGoals1),
( { CurrVar = CalledPredIndex } ->
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.27
diff -u -b -r1.27 magic_util.m
--- compiler/magic_util.m 15 Mar 2003 03:08:56 -0000 1.27
+++ compiler/magic_util.m 31 Mar 2003 05:51:17 -0000
@@ -297,7 +297,7 @@
( Attr0 < StateIndex ->
Attr = Attr0
; Attr0 > StateIndex ->
- Attr is Attr0 - 1
+ Attr = Attr0 - 1
;
error("base relation indexed on aditi__state attribute")
))),
@@ -731,7 +731,7 @@
magic_util__create_closure(CurrVar, ClosureVar, ClosureVarMode,
LambdaGoal, LambdaInputs, LambdaVars, InputGoal),
- { NextIndex is CurrVar + 1 },
+ { NextIndex = CurrVar + 1 },
magic_util__create_input_closures(MagicVars, InputArgs,
InputArgModes, SuppCall, ThisProcInfo, NextIndex,
InputGoals, ClosureVars).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.440
diff -u -b -r1.440 make_hlds.m
--- compiler/make_hlds.m 19 May 2003 14:24:24 -0000 1.440
+++ compiler/make_hlds.m 22 May 2003 18:57:48 -0000
@@ -187,7 +187,7 @@
{ mq_info_get_num_errors(MQInfo, MQ_NumErrors) },
{ module_info_num_errors(Module5, NumErrors5) },
- { NumErrors is NumErrors5 + MQ_NumErrors },
+ { NumErrors = NumErrors5 + MQ_NumErrors },
{ module_info_set_num_errors(Module5, NumErrors, Module6) },
% the predid list is constructed in reverse order, for
% efficiency, so we return it to the correct order here.
@@ -7622,13 +7622,11 @@
insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
N0, List0, VarSet0, List, VarSet,
Info0, Info, SInfo0, SInfo) -->
- { N1 is N0 + 1 },
+ { N1 = N0 + 1 },
insert_arg_unification(Var, Arg, Context, ArgContext,
N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
Info0, Info1, SInfo0, SInfo1),
- (
- { ArgUnifyConj = [] }
- ->
+ ( { ArgUnifyConj = [] } ->
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
N1, List1, VarSet1, List, VarSet,
Info1, Info, SInfo1, SInfo)
@@ -7777,7 +7775,7 @@
append_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext, N0,
List0, VarSet0, List, VarSet,
Info0, Info, SInfo0, SInfo) -->
- { N1 is N0 + 1 },
+ { N1 = N0 + 1 },
append_arg_unification(Var, Arg, Context, ArgContext,
N1, ConjList, VarSet0, VarSet1,
Info0, Info1, SInfo0, SInfo1),
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.39
diff -u -b -r1.39 make_tags.m
--- compiler/make_tags.m 15 Mar 2003 03:08:57 -0000 1.39
+++ compiler/make_tags.m 31 Mar 2003 05:51:18 -0000
@@ -180,7 +180,7 @@
ReservedAddresses, CtorTags2, CtorTags)
;
max_num_tags(NumTagBits, MaxNumTags),
- MaxTag is MaxNumTags - 1,
+ MaxTag = MaxNumTags - 1,
split_constructors(Ctors, Constants, Functors),
assign_constant_tags(Constants, CtorTags0,
CtorTags1, InitTag, NextTag),
@@ -199,7 +199,7 @@
make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
Tag = int_constant(Val),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
- Val1 is Val + 1,
+ Val1 = Val + 1,
assign_enum_constants(Rest, Val1, CtorTags1, CtorTags).
% assign the representations null_pointer, small_pointer(1),
@@ -300,7 +300,7 @@
Tag = maybe_add_reserved_addresses(ReservedAddresses,
unshared_tag(Val)),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
- Val1 is Val + 1,
+ Val1 = Val + 1,
assign_unshared_tags(Rest, Val1, MaxTag,
ReservedAddresses, CtorTags1, CtorTags)
).
@@ -317,7 +317,7 @@
Tag = maybe_add_reserved_addresses(ReservedAddresses,
shared_remote_tag(PrimaryVal, SecondaryVal)),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
- SecondaryVal1 is SecondaryVal + 1,
+ SecondaryVal1 = SecondaryVal + 1,
assign_shared_remote_tags(Rest, PrimaryVal, SecondaryVal1,
ReservedAddresses, CtorTags1, CtorTags).
@@ -332,12 +332,13 @@
make_cons_id_from_qualified_sym_name(Name, Args, ConsId),
Tag = shared_local_tag(PrimaryVal, SecondaryVal),
map__set(CtorTags0, ConsId, Tag, CtorTags1),
- SecondaryVal1 is SecondaryVal + 1,
+ SecondaryVal1 = SecondaryVal + 1,
assign_shared_local_tags(Rest, PrimaryVal, SecondaryVal1,
CtorTags1, CtorTags).
:- func maybe_add_reserved_addresses(list(reserved_address), cons_tag) =
cons_tag.
+
maybe_add_reserved_addresses(ReservedAddresses, Tag) =
( ReservedAddresses = [] ->
Tag
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.286
diff -u -b -r1.286 mercury_compile.m
--- compiler/mercury_compile.m 9 May 2003 05:51:51 -0000 1.286
+++ compiler/mercury_compile.m 9 May 2003 06:45:25 -0000
@@ -3606,7 +3606,7 @@
{ list__length(GlobalVars, CompGenVarCount) },
{ list__length(AllData, CompGenDataCount) },
{ list__length(ChunkedModules, CompGenCodeCount) },
- { ComponentCount is UserCCodeCount + ExportCount
+ { ComponentCount = UserCCodeCount + ExportCount
+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
:- pred make_decl_guards(sym_name::in,
@@ -3677,7 +3677,7 @@
string__int_to_string(Num, NumString),
string__append(ModuleName, NumString, ThisModuleName),
Module = comp_gen_c_module(ThisModuleName, Chunk),
- Num1 is Num + 1,
+ Num1 = Num + 1,
mercury_compile__combine_chunks_2(Chunks, ModuleName, Num1, Modules).
:- pred mercury_compile__output_llds(module_name, c_file,
@@ -3687,8 +3687,7 @@
mercury_compile__output_llds(ModuleName, LLDS0, StackLayoutLabels, MaybeRLFile,
Verbose, Stats) -->
- maybe_write_string(Verbose,
- "% Writing output to `"),
+ maybe_write_string(Verbose, "% Writing output to `"),
module_name_to_file_name(ModuleName, ".c", yes, FileName),
maybe_write_string(Verbose, FileName),
maybe_write_string(Verbose, "'..."),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.228
diff -u -b -r1.228 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 13 May 2003 06:25:50 -0000 1.228
+++ compiler/mercury_to_mercury.m 22 May 2003 18:57:49 -0000
@@ -3163,7 +3163,7 @@
{ PredOrFunc = predicate,
DeclaredArity = Arity
; PredOrFunc = function,
- DeclaredArity is Arity - 1
+ DeclaredArity = Arity - 1
},
add_string(":- pragma "),
add_string(PragmaName),
@@ -3776,7 +3776,7 @@
strip_trailing_primes(Name0, Name, Num) :-
( string__remove_suffix(Name0, "'", Name1) ->
strip_trailing_primes(Name1, Name, Num0),
- Num is Num0 + 1
+ Num = Num0 + 1
;
Num = 0,
Name = Name0
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.94
diff -u -b -r1.94 middle_rec.m
--- compiler/middle_rec.m 9 May 2003 05:51:51 -0000 1.94
+++ compiler/middle_rec.m 9 May 2003 06:45:25 -0000
@@ -382,7 +382,7 @@
( N < H ->
Reg = reg(r, N)
;
- N1 is N + 1,
+ N1 = N + 1,
middle_rec__find_unused_register_2(T, N1, Reg)
).
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.17
diff -u -b -r1.17 ml_closure_gen.m
--- compiler/ml_closure_gen.m 9 May 2003 00:45:04 -0000 1.17
+++ compiler/ml_closure_gen.m 9 May 2003 02:19:50 -0000
@@ -502,7 +502,7 @@
ml_stack_layout_construct_type_param_locn_vector([TVar - Locns | TVarLocns],
CurSlot, Vector) :-
term__var_to_int(TVar, TVarNum),
- NextSlot is CurSlot + 1,
+ NextSlot = CurSlot + 1,
( TVarNum = CurSlot ->
( set__remove_least(Locns, LeastLocn, _) ->
Locn = LeastLocn
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.7
diff -u -b -r1.7 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m 15 Mar 2003 03:08:59 -0000 1.7
+++ compiler/ml_simplify_switch.m 31 Mar 2003 05:51:18 -0000
@@ -169,7 +169,7 @@
:- func calc_density(int, int) = int.
calc_density(NumCases, Range) = Density :-
- Density is (NumCases * 100) // Range.
+ Density = (NumCases * 100) // Range.
%-----------------------------------------------------------------------------%
@@ -280,7 +280,7 @@
(
{ NeedRangeCheck = yes }
->
- { Difference is LastVal - FirstVal },
+ { Difference = LastVal - FirstVal },
{ InRange = binop(unsigned_le, Index,
const(int_const(Difference))) },
{ Else = yes(mlds__statement(
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.13
diff -u -b -r1.13 ml_string_switch.m
--- compiler/ml_string_switch.m 15 Mar 2003 03:08:59 -0000 1.13
+++ compiler/ml_string_switch.m 31 Mar 2003 05:51:18 -0000
@@ -97,8 +97,8 @@
list__length(Cases, NumCases),
int__log2(NumCases, LogNumCases),
int__pow(2, LogNumCases, RoundedNumCases),
- TableSize is 2 * RoundedNumCases,
- HashMask is TableSize - 1,
+ TableSize = 2 * RoundedNumCases,
+ HashMask = TableSize - 1,
% Compute the hash table
%
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.6
diff -u -b -r1.6 ml_tag_switch.m
--- compiler/ml_tag_switch.m 15 Mar 2003 03:08:59 -0000 1.6
+++ compiler/ml_tag_switch.m 31 Mar 2003 05:51:18 -0000
@@ -133,7 +133,7 @@
{ CaseCanFail = cannot_fail }
;
{ list__length(GoalList, GoalCount) },
- { FullGoalCount is MaxSecondary + 1 },
+ { FullGoalCount = MaxSecondary + 1 },
{ FullGoalCount = GoalCount }
->
{ CaseCanFail = cannot_fail }
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.147
diff -u -b -r1.147 mlds_to_c.m
--- compiler/mlds_to_c.m 9 May 2003 00:45:07 -0000 1.147
+++ compiler/mlds_to_c.m 9 May 2003 02:19:50 -0000
@@ -922,7 +922,7 @@
det_func_signature(mlds__func_params(Args, _RetTypes)) = Params :-
list__length(Args, NumArgs),
- NumFuncArgs is NumArgs - 1,
+ NumFuncArgs = NumArgs - 1,
( list__split_list(NumFuncArgs, Args, InputArgs0, [ReturnArg0]) ->
InputArgs = InputArgs0,
ReturnArg = ReturnArg0
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.74
diff -u -b -r1.74 mode_errors.m
--- compiler/mode_errors.m 15 Mar 2003 03:09:02 -0000 1.74
+++ compiler/mode_errors.m 31 Mar 2003 05:51:19 -0000
@@ -602,11 +602,13 @@
io__write_string("',\n"),
prog_out__write_context(Context),
( { PredOrFunc = predicate },
- io__write_string(" expecting higher-order pred inst (of arity "),
+ io__write_string(
+ " expecting higher-order pred inst (of arity "),
io__write_int(Arity)
; { PredOrFunc = function },
- io__write_string(" expecting higher-order func inst (of arity "),
- { Arity1 is Arity - 1 },
+ io__write_string(
+ " expecting higher-order func inst (of arity "),
+ { Arity1 = Arity - 1 },
io__write_int(Arity1)
),
io__write_string(").\n").
@@ -1061,7 +1063,7 @@
% front by polymorphism.m - we only want the last `PredArity' of them.
%
{ list__length(ArgModes0, NumArgModes) },
- { NumToDrop is NumArgModes - PredArity },
+ { NumToDrop = NumArgModes - PredArity },
( { list__drop(NumToDrop, ArgModes0, ArgModes1) } ->
{ ArgModes2 = ArgModes1 }
;
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.151
diff -u -b -r1.151 mode_util.m
--- compiler/mode_util.m 8 May 2003 03:39:55 -0000 1.151
+++ compiler/mode_util.m 8 May 2003 03:48:55 -0000
@@ -846,7 +846,7 @@
In = (ground(shared, none) -> ground(shared, none)),
Out = (free -> ground(shared, none)),
list__length(PredArgTypes, NumPredArgs),
- NumFuncArgs is NumPredArgs - 1,
+ NumFuncArgs = NumPredArgs - 1,
list__duplicate(NumFuncArgs, In, FuncArgModes),
FuncRetMode = Out,
list__append(FuncArgModes, [FuncRetMode], PredArgModes0),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.267
diff -u -b -r1.267 modes.m
--- compiler/modes.m 18 Mar 2003 02:43:39 -0000 1.267
+++ compiler/modes.m 31 Mar 2003 05:51:19 -0000
@@ -464,7 +464,7 @@
ModuleInfo3, ModuleInfo4) }
),
- { MaxIterations1 is MaxIterations - 1 },
+ { MaxIterations1 = MaxIterations - 1 },
modecheck_to_fixpoint(PredIds, MaxIterations1,
WhatToCheck, MayChangeCalledProc,
ModuleInfo4, ModuleInfo, UnsafeToContinue)
@@ -580,13 +580,13 @@
ModuleInfo3 = ModuleInfo1
;
module_info_num_errors(ModuleInfo1, ModNumErrors0),
- ModNumErrors1 is ModNumErrors0 + ErrsInThisPred,
+ ModNumErrors1 = ModNumErrors0 + ErrsInThisPred,
module_info_set_num_errors(ModuleInfo1, ModNumErrors1,
ModuleInfo2),
module_info_remove_predid(ModuleInfo2, PredId,
ModuleInfo3)
},
- { NumErrors1 is NumErrors0 + ErrsInThisPred }
+ { NumErrors1 = NumErrors0 + ErrsInThisPred }
),
modecheck_pred_modes_2(PredIds, WhatToCheck, MayChangeCalledProc,
ModuleInfo3, ModuleInfo, Changed1, Changed,
@@ -672,7 +672,7 @@
modecheck_proc_2(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
ModuleInfo0, Changed0,
ModuleInfo1, Changed1, NumErrors),
- { Errs1 is Errs0 + NumErrors },
+ { Errs1 = Errs0 + NumErrors },
% recursively process the remaining modes
modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
ModuleInfo1, Changed1, Errs1,
@@ -954,7 +954,7 @@
Var, VarInst, Inst, Reason))
)
),
- { ArgNum1 is ArgNum + 1 },
+ { ArgNum1 = ArgNum + 1 },
check_final_insts(Vars1, Insts1, VarInsts1, InferModes, ArgNum1,
ModuleInfo, Changed1, Changed)
;
@@ -1793,7 +1793,7 @@
modecheck_var_list_is_live([], [], _NeedExactMatch, _ArgNum) --> [].
modecheck_var_list_is_live([Var|Vars], [IsLive|IsLives], NeedExactMatch,
ArgNum0) -->
- { ArgNum is ArgNum0 + 1 },
+ { ArgNum = ArgNum0 + 1 },
mode_info_set_call_arg_context(ArgNum),
modecheck_var_is_live(Var, IsLive, NeedExactMatch),
modecheck_var_list_is_live(Vars, IsLives, NeedExactMatch, ArgNum).
@@ -1847,7 +1847,7 @@
modecheck_var_has_inst_list_2([], [], _Exact, _ArgNum, Subst, Subst) --> [].
modecheck_var_has_inst_list_2([Var|Vars], [Inst|Insts],
NeedExactMatch, ArgNum0, Subst0, Subst) -->
- { ArgNum is ArgNum0 + 1 },
+ { ArgNum = ArgNum0 + 1 },
mode_info_set_call_arg_context(ArgNum),
modecheck_var_has_inst(Var, Inst, NeedExactMatch, Subst0, Subst1),
modecheck_var_has_inst_list_2(Vars, Insts,
@@ -1924,7 +1924,7 @@
modecheck_set_var_inst_list_2([Var0 | Vars0], [InitialInst | InitialInsts],
[FinalInst | FinalInsts], ExtraGoals0, ArgNum0,
[Var | Vars], ExtraGoals) -->
- { ArgNum is ArgNum0 + 1 },
+ { ArgNum = ArgNum0 + 1 },
mode_info_set_call_arg_context(ArgNum),
modecheck_set_var_inst(Var0, InitialInst, FinalInst,
Var, ExtraGoals0, ExtraGoals1),
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.131
diff -u -b -r1.131 opt_debug.m
--- compiler/opt_debug.m 9 May 2003 05:51:51 -0000 1.131
+++ compiler/opt_debug.m 9 May 2003 06:45:25 -0000
@@ -525,7 +525,7 @@
;
MR_str = "no"
),
- N1 is N - 1,
+ N1 = N - 1,
opt_debug__dump_maybe_rvals(MRs, N1, MRs_str),
string__append_list([MR_str, ", ", MRs_str], Str)
;
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.120
diff -u -b -r1.120 opt_util.m
--- compiler/opt_util.m 9 May 2003 05:51:51 -0000 1.120
+++ compiler/opt_util.m 9 May 2003 06:45:26 -0000
@@ -1688,7 +1688,7 @@
opt_util__count_incr_hp_2([], N, N).
opt_util__count_incr_hp_2([Uinstr0 - _ | Instrs], N0, N) :-
( Uinstr0 = incr_hp(_, _, _, _) ->
- N1 is N0 + 1
+ N1 = N0 + 1
;
N1 = N0
),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.412
diff -u -b -r1.412 options.m
--- compiler/options.m 22 May 2003 03:57:10 -0000 1.412
+++ compiler/options.m 22 May 2003 18:57:50 -0000
@@ -2156,7 +2156,7 @@
; opt_level(N0, OptionTable0, OptionSettingsList) ->
override_options(OptionSettingsList, OptionTable0,
OptionTable1),
- N1 is N0 + 1,
+ N1 = N0 + 1,
enable_opt_levels(N1, N, OptionTable1, OptionTable)
;
error("Unknown optimization level")
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.11
diff -u -b -r1.11 par_conj_gen.m
--- compiler/par_conj_gen.m 15 Mar 2003 03:09:04 -0000 1.11
+++ compiler/par_conj_gen.m 31 Mar 2003 05:51:20 -0000
@@ -232,7 +232,7 @@
ForkCode,
tree(ThisGoalCode, tree(tree(SaveCode, CopyCode), JoinCode))
) },
- { N1 is N + 1 },
+ { N1 = N + 1 },
par_conj_gen__generate_det_par_conj_2(Goals, N1, SyncTerm, SpSlot,
Initial, MaybeEnd, RestCode),
{ Code = tree(ThisCode, RestCode) }.
@@ -267,7 +267,7 @@
(
{ SrcSlot = stackvar(SlotNum) }
->
- { NegSlotNum is (- SlotNum) },
+ { NegSlotNum = (- SlotNum) },
{ DestSlot = field(yes(0), lval(SpSlot),
const(int_const(NegSlotNum))) }
;
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.54
diff -u -b -r1.54 passes_aux.m
--- compiler/passes_aux.m 15 Mar 2003 03:09:04 -0000 1.54
+++ compiler/passes_aux.m 31 Mar 2003 05:51:20 -0000
@@ -722,7 +722,7 @@
% front by polymorphism.m - we only want the last `PredArity' of them.
%
{ list__length(ArgModes0, NumArgModes) },
- { NumToDrop is NumArgModes - Arity },
+ { NumToDrop = NumArgModes - Arity },
( { list__drop(NumToDrop, ArgModes0, ArgModes1) } ->
{ ArgModes = ArgModes1 }
;
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.15
diff -u -b -r1.15 pd_cost.m
--- compiler/pd_cost.m 15 Mar 2003 03:09:04 -0000 1.15
+++ compiler/pd_cost.m 31 Mar 2003 05:51:20 -0000
@@ -51,7 +51,7 @@
pd_cost__goal(disj(Goals) - _, Cost) :-
pd_cost__goals(Goals, 0, Cost0),
pd_cost__stack_flush(Cost1),
- Cost is Cost0 + Cost1.
+ Cost = Cost0 + Cost1.
pd_cost__goal(switch(_, _, Cases) - _, Cost) :-
pd_cost__simple_test(Cost0),
@@ -61,7 +61,7 @@
pd_cost__goal(Cond, Cost1),
pd_cost__goal(Then, Cost2),
pd_cost__goal(Else, Cost3),
- Cost is Cost1 + Cost2 + Cost3.
+ Cost = Cost1 + Cost2 + Cost3.
pd_cost__goal(call(_, _, Args, BuiltinState, _, _) - _, Cost) :-
( BuiltinState = inline_builtin ->
@@ -69,10 +69,10 @@
;
pd_cost__stack_flush(Cost1),
list__length(Args, Arity),
- InputArgs is Arity // 2, % rough
+ InputArgs = Arity // 2, % rough
pd_cost__reg_assign(AssignCost),
pd_cost__call(Cost2),
- Cost is Cost1 + Cost2 + AssignCost * InputArgs
+ Cost = Cost1 + Cost2 + AssignCost * InputArgs
).
pd_cost__goal(not(Goal) - _, Cost) :-
@@ -87,7 +87,7 @@
Cost0 = AssignCost * Arity // 2,
pd_cost__stack_flush(Cost1),
pd_cost__higher_order_call(Cost2),
- Cost is Cost0 + Cost1 + Cost2.
+ Cost = Cost0 + Cost1 + Cost2.
pd_cost__goal(unify(_, _, _, Unification, _) - GoalInfo, Cost) :-
goal_info_get_nonlocals(GoalInfo, NonLocals),
@@ -102,9 +102,9 @@
),
pd_cost__call(Cost2),
list__length(Args, Arity),
- InputArgs is Arity // 2, % rough
+ InputArgs = Arity // 2, % rough
pd_cost__reg_assign(AssignCost),
- Cost is Cost1 + Cost2 + AssignCost * InputArgs.
+ Cost = Cost1 + Cost2 + AssignCost * InputArgs.
pd_cost__goal(shorthand(_) - _, _) :-
% these should have been expanded out by now
@@ -150,7 +150,7 @@
pd_cost__goals([], Cost, Cost).
pd_cost__goals([Goal | Goals], Cost0, Cost) :-
pd_cost__goal(Goal, Cost1),
- Cost2 is Cost0 + Cost1,
+ Cost2 = Cost0 + Cost1,
pd_cost__goals(Goals, Cost2, Cost).
:- pred pd_cost__cases(list(case)::in, int::in, int::out) is det.
@@ -158,7 +158,7 @@
pd_cost__cases([], Cost, Cost).
pd_cost__cases([case(_, Goal) | Cases], Cost0, Cost) :-
pd_cost__goal(Goal, Cost1),
- Cost2 is Cost0 + Cost1,
+ Cost2 = Cost0 + Cost1,
pd_cost__cases(Cases, Cost2, Cost).
%-----------------------------------------------------------------------------%
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.10
diff -u -b -r1.10 pd_info.m
--- compiler/pd_info.m 15 Mar 2003 03:09:04 -0000 1.10
+++ compiler/pd_info.m 31 Mar 2003 05:51:20 -0000
@@ -23,6 +23,7 @@
:- import_module transform_hlds__pd_term.
:- import_module bool, map, list, io, set, std_util, getopt.
+:- import_module counter.
:- type pd_info
---> pd_info(
@@ -32,7 +33,7 @@
goal_version_index :: goal_version_index,
versions :: version_index,
proc_arg_info :: pd_arg_info,
- counter :: int,
+ counter :: counter,
global_term_info :: global_term_info,
parent_versions :: set(pred_proc_id),
depth :: int,
@@ -83,7 +84,7 @@
:- pred pd_info_get_proc_arg_info(pd_arg_info, pd_info, pd_info).
:- mode pd_info_get_proc_arg_info(out, pd_info_di, pd_info_uo) is det.
-:- pred pd_info_get_counter(int, pd_info, pd_info).
+:- pred pd_info_get_counter(counter, pd_info, pd_info).
:- mode pd_info_get_counter(out, pd_info_di, pd_info_uo) is det.
:- pred pd_info_get_global_term_info(global_term_info, pd_info, pd_info).
@@ -119,7 +120,7 @@
:- pred pd_info_set_proc_arg_info(pd_arg_info, pd_info, pd_info).
:- mode pd_info_set_proc_arg_info(in, pd_info_di, pd_info_uo) is det.
-:- pred pd_info_set_counter(int, pd_info, pd_info).
+:- pred pd_info_set_counter(counter, pd_info, pd_info).
:- mode pd_info_set_counter(in, pd_info_di, pd_info_uo) is det.
:- pred pd_info_set_global_term_info(global_term_info, pd_info, pd_info).
@@ -186,7 +187,7 @@
set__init(CreatedVersions),
set__init(UselessVersions),
PdInfo = pd_info(IO, ModuleInfo, no, GoalVersionIndex, Versions,
- ProcArgInfos, 0, GlobalInfo, ParentVersions, 0,
+ ProcArgInfos, counter__init(0), GlobalInfo, ParentVersions, 0,
CreatedVersions, UselessVersions).
pd_info_init_unfold_info(PredProcId, PredInfo, ProcInfo) -->
@@ -463,12 +464,12 @@
pd_info_incr_cost_delta(Delta1) -->
pd_info_get_cost_delta(Delta0),
- { Delta is Delta0 + Delta1 },
+ { Delta = Delta0 + Delta1 },
pd_info_set_cost_delta(Delta).
pd_info_incr_size_delta(Delta1) -->
pd_info_get_size_delta(Delta0),
- { Delta is Delta0 + Delta1 },
+ { Delta = Delta0 + Delta1 },
pd_info_set_size_delta(Delta).
%-----------------------------------------------------------------------------%
@@ -701,7 +702,7 @@
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ set__to_sorted_list(NonLocals, Args) },
pd_info_get_counter(Counter0),
- { Counter is Counter0 + 1 },
+ { counter__allocate(Count, Counter0, Counter) },
pd_info_set_counter(Counter),
pd_info_get_pred_info(PredInfo),
{ pred_info_name(PredInfo, PredName) },
@@ -710,7 +711,7 @@
pd_info_get_module_info(ModuleInfo0),
{ module_info_name(ModuleInfo0, ModuleName) },
{ make_pred_name_with_context(ModuleName, "DeforestationIn",
- predicate, PredName, Line, Counter0, SymName) },
+ predicate, PredName, Line, Count, SymName) },
{ unqualify_name(SymName, Name) },
pd_info_get_proc_info(ProcInfo),
Index: compiler/pd_term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_term.m,v
retrieving revision 1.5
diff -u -b -r1.5 pd_term.m
--- compiler/pd_term.m 15 Mar 2003 03:09:04 -0000 1.5
+++ compiler/pd_term.m 31 Mar 2003 05:51:20 -0000
@@ -269,7 +269,7 @@
pd_term__initial_sizes(_, _, [], _, []).
pd_term__initial_sizes(ModuleInfo, InstMap, [Arg | Args], ArgNo,
[ArgNo - Size | Sizes]) :-
- NextArgNo is ArgNo + 1,
+ NextArgNo = ArgNo + 1,
pd_term__initial_sizes(ModuleInfo, InstMap, Args, NextArgNo, Sizes),
instmap__lookup_var(InstMap, Arg, ArgInst),
pd_util__inst_size(ModuleInfo, ArgInst, Size).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.24
diff -u -b -r1.24 pd_util.m
--- compiler/pd_util.m 18 Mar 2003 02:43:41 -0000 1.24
+++ compiler/pd_util.m 31 Mar 2003 05:51:20 -0000
@@ -493,7 +493,7 @@
;
OpaqueArgs1 = OpaqueArgs0
),
- NextArg is ArgNo + 1,
+ NextArg = ArgNo + 1,
pd_util__get_opaque_args(ModuleInfo, NextArg, ArgModes,
ExtraInfoArgs, OpaqueArgs1, OpaqueArgs).
@@ -520,7 +520,7 @@
;
ThisProcLeftVars1 = ThisProcLeftVars0
),
- NextArgNo is ArgNo + 1,
+ NextArgNo = ArgNo + 1,
pd_util__get_extra_info_headvars(HeadVars, NextArgNo,
LeftVars, VarInfo, ThisProcArgs1, ThisProcArgs,
ThisProcLeftVars1, ThisProcLeftVars).
@@ -665,7 +665,7 @@
;
ExtraVars2 = ExtraVars1
),
- NextBranch is BranchNo + 1,
+ NextBranch = BranchNo + 1,
pd_util__get_branch_vars(ModuleInfo, Goal, InstMapDeltas, InstMap,
NextBranch, ExtraVars2, ExtraVars).
@@ -716,7 +716,7 @@
goal_to_conj_list(Goal, GoalList),
pd_util__examine_branch(ModuleInfo, ProcArgInfo, BranchNo, GoalList,
VarTypes, InstMap, Vars0, Vars1),
- NextBranch is BranchNo + 1,
+ NextBranch = BranchNo + 1,
pd_util__examine_branch_list(ModuleInfo, ProcArgInfo, NextBranch,
Goals, VarTypes, InstMap, Vars1, Vars).
@@ -735,7 +735,7 @@
goal_to_conj_list(Goal, GoalList),
pd_util__examine_branch(ModuleInfo1, ProcArgInfo, BranchNo, GoalList,
VarTypes, InstMap1, Vars0, Vars1),
- NextBranch is BranchNo + 1,
+ NextBranch = BranchNo + 1,
pd_util__examine_case_list(ModuleInfo1, ProcArgInfo, NextBranch,
Var, Goals, VarTypes, InstMap, Vars1, Vars, ModuleInfo).
@@ -970,7 +970,7 @@
Expansions, Size0, Size) :-
pd_util__inst_list_size(ModuleInfo, ArgInsts,
Expansions, Size0, Size1),
- Size2 is Size1 + 1,
+ Size2 = Size1 + 1,
pd_util__bound_inst_size(ModuleInfo, Insts, Expansions, Size2, Size).
pd_util__inst_list_size(ModuleInfo, Insts, Size) :-
@@ -984,7 +984,7 @@
pd_util__inst_list_size(ModuleInfo, [Inst | Insts],
Expansions, Size0, Size) :-
pd_util__inst_size_2(ModuleInfo, Inst, Expansions, Size1),
- Size2 is Size0 + Size1,
+ Size2 = Size0 + Size1,
pd_util__inst_list_size(ModuleInfo, Insts, Expansions, Size2, Size).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.235
diff -u -b -r1.235 polymorphism.m
--- compiler/polymorphism.m 18 Mar 2003 02:43:41 -0000 1.235
+++ compiler/polymorphism.m 31 Mar 2003 05:51:21 -0000
@@ -420,7 +420,7 @@
pred_info_arg_types(PredInfo0, TypeVarSet, ExistQVars, ArgTypes0),
list__length(ArgTypes0, NumOldArgs),
list__length(HeadVars, NumNewArgs),
- NumExtraArgs is NumNewArgs - NumOldArgs,
+ NumExtraArgs = NumNewArgs - NumOldArgs,
(
list__split_list(NumExtraArgs, HeadVars, ExtraHeadVars0,
OldHeadVars0)
@@ -1631,9 +1631,9 @@
% sanity check
list__length(UnivCs, NUCs),
list__length(ExistCs, NECs),
- NCs is NUCs + NECs,
+ NCs = NUCs + NECs,
list__length(PredTypeVars, NTs),
- NEVs is NCs + NTs,
+ NEVs = NCs + NTs,
require(unify(NEVs, NumExtraVars),
"list length mismatch in polymorphism processing pragma_c"),
@@ -3140,12 +3140,12 @@
% The first type_info will be just after the superclass
% infos
- First is NumSuperClasses + 1,
+ First = NumSuperClasses + 1,
term__vars_list(ClassTypes, ClassTypeVars0),
MakeIndex = (pred(Elem0::in, Elem::out,
Index0::in, Index::out) is det :-
Elem = Elem0 - Index0,
- Index is Index0 + 1,
+ Index = Index0 + 1,
% the following call is a work-around for a
% compiler bug with intermodule optimization:
% it is needed to resolve a type ambiguity
@@ -3407,15 +3407,13 @@
map__det_update(PredTable0, PredId, PredInfo, PredTable),
module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo),
- ProcNum is ProcNum0 + 1.
+ ProcNum = ProcNum0 + 1.
:- pred delete_nth(list(T)::in, int::in, list(T)::out) is semidet.
delete_nth([X|Xs], N0, Result) :-
- (
- N0 > 1
- ->
- N is N0 - 1,
+ ( N0 > 1 ->
+ N = N0 - 1,
delete_nth(Xs, N, TheRest),
Result = [X|TheRest]
;
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.51
diff -u -b -r1.51 post_typecheck.m
--- compiler/post_typecheck.m 19 May 2003 14:24:26 -0000 1.51
+++ compiler/post_typecheck.m 22 May 2003 18:57:51 -0000
@@ -225,7 +225,7 @@
[]
),
- { NumErrors1 is NumErrors0 + UnboundTypeErrsInThisPred }
+ { NumErrors1 = NumErrors0 + UnboundTypeErrsInThisPred }
),
{ module_info_set_pred_info(ModuleInfo0, PredId,
PredInfo, ModuleInfo1) },
@@ -535,7 +535,7 @@
AdjustArgTypes =
(pred(Types0::in, Types::out) is det :-
list__length(Types0, Length),
- HalfLength is Length // 2,
+ HalfLength = Length // 2,
( list__split_list(HalfLength, Types0, Types1, _) ->
Types = Types1
;
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.58
diff -u -b -r1.58 pragma_c_gen.m
--- compiler/pragma_c_gen.m 7 May 2003 00:50:22 -0000 1.58
+++ compiler/pragma_c_gen.m 7 May 2003 01:17:53 -0000
@@ -824,7 +824,7 @@
CountSemis = lambda([Char::in, Count0::in, Count::out]
is det,
( Char = (;) ->
- Count is Count0 + 1
+ Count = Count0 + 1
;
Count = Count0
)
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.21
diff -u -b -r1.21 prog_io_dcg.m
--- compiler/prog_io_dcg.m 15 Mar 2003 03:09:07 -0000 1.21
+++ compiler/prog_io_dcg.m 22 May 2003 19:37:44 -0000
@@ -44,16 +44,17 @@
:- import_module parse_tree__prog_io_goal.
:- import_module parse_tree__prog_util.
-:- import_module int, map, string, std_util, list.
+:- import_module int, map, string, std_util, list, counter.
%-----------------------------------------------------------------------------%
parse_dcg_clause(ModuleName, VarSet0, DCG_Head, DCG_Body, DCG_Context,
Result) :-
varset__coerce(VarSet0, ProgVarSet0),
- new_dcg_var(ProgVarSet0, 0, ProgVarSet1, N0, DCG_0_Var),
- parse_dcg_goal(DCG_Body, ProgVarSet1, N0, DCG_0_Var,
- Body, ProgVarSet, _N, DCG_Var),
+ new_dcg_var(ProgVarSet0, counter__init(0), ProgVarSet1,
+ Counter0, DCG_0_Var),
+ parse_dcg_goal(DCG_Body, ProgVarSet1, Counter0, DCG_0_Var,
+ Body, ProgVarSet, _Counter, DCG_Var),
parse_implicitly_qualified_term(ModuleName,
DCG_Head, DCG_Body, "DCG clause head", HeadResult),
process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var,
@@ -63,33 +64,33 @@
%-----------------------------------------------------------------------------%
parse_dcg_pred_goal(GoalTerm, VarSet0, Goal, DCGVar0, DCGVar, VarSet) :-
- new_dcg_var(VarSet0, 0, VarSet1, N0, DCGVar0),
- parse_dcg_goal(GoalTerm, VarSet1, N0, DCGVar0,
- Goal, VarSet, _N, DCGVar).
+ new_dcg_var(VarSet0, counter__init(0), VarSet1, Counter0, DCGVar0),
+ parse_dcg_goal(GoalTerm, VarSet1, Counter0, DCGVar0,
+ Goal, VarSet, _Counter, DCGVar).
%-----------------------------------------------------------------------------%
% Used to allocate fresh variables needed for the DCG expansion.
-:- pred new_dcg_var(prog_varset, int, prog_varset, int, prog_var).
+:- pred new_dcg_var(prog_varset, counter, prog_varset, counter, prog_var).
:- mode new_dcg_var(in, in, out, out, out) is det.
-new_dcg_var(VarSet0, N0, VarSet, N, DCG_0_Var) :-
- string__int_to_string(N0, StringN),
+new_dcg_var(VarSet0, Counter0, VarSet, Counter, DCG_0_Var) :-
+ counter__allocate(N, Counter0, Counter),
+ string__int_to_string(N, StringN),
string__append("DCG_", StringN, VarName),
varset__new_var(VarSet0, DCG_0_Var, VarSet1),
- varset__name_var(VarSet1, DCG_0_Var, VarName, VarSet),
- N is N0 + 1.
+ varset__name_var(VarSet1, DCG_0_Var, VarName, VarSet).
%-----------------------------------------------------------------------------%
% Expand a DCG goal.
-:- pred parse_dcg_goal(term, prog_varset, int, prog_var, goal,
- prog_varset, int, prog_var).
+:- pred parse_dcg_goal(term, prog_varset, counter, prog_var, goal,
+ prog_varset, counter, prog_var).
:- mode parse_dcg_goal(in, in, in, in, out, out, out, out) is det.
-parse_dcg_goal(Term, VarSet0, N0, Var0, Goal, VarSet, N, Var) :-
+parse_dcg_goal(Term, VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var) :-
% first, figure out the context for the goal
(
Term = term__functor(_, _, Context)
@@ -107,18 +108,19 @@
SymName = unqualified(Functor),
list__map(term__coerce, Args0, Args1),
parse_dcg_goal_2(Functor, Args1, Context,
- VarSet0, N0, Var0, Goal1, VarSet1, N1, Var1)
+ VarSet0, Counter0, Var0, Goal1,
+ VarSet1, Counter1, Var1)
->
Goal = Goal1,
VarSet = VarSet1,
- N = N1,
+ Counter = Counter1,
Var = Var1
;
% It's the ordinary case of non-terminal.
% Create a fresh var as the DCG output var from this
% goal, and append the DCG argument pair to the
% non-terminal's argument list.
- new_dcg_var(VarSet0, N0, VarSet, N, Var),
+ new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
list__append(Args0,
[term__variable(Var0),
term__variable(Var)], Args),
@@ -128,17 +130,17 @@
% A call to a free variable, or to a number or string.
% Just translate it into a call to call/3 - the typechecker
% will catch calls to numbers and strings.
- new_dcg_var(VarSet0, N0, VarSet, N, Var),
+ new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
term__coerce(Term, ProgTerm),
Goal = call(unqualified("call"), [ProgTerm,
term__variable(Var0), term__variable(Var)],
pure) - Context
).
- % parse_dcg_goal_2(Functor, Args, Context, VarSet0, N0, Var0,
- % Goal, VarSet, N, Var):
+ % parse_dcg_goal_2(Functor, Args, Context, VarSet0, Counter0, Var0,
+ % Goal, VarSet, Counter, Var):
% VarSet0/VarSet are an accumulator pair which we use to
- % allocate fresh DCG variables; N0 and N are an accumulator pair
+ % allocate fresh DCG variables; Counter0 and Counter are a pair
% we use to keep track of the number to give to the next DCG
% variable (so that we can give it a semi-meaningful name "DCG_<N>"
% for use in error messages, debugging, etc.).
@@ -146,51 +148,53 @@
% the current DCG variable.
:- pred parse_dcg_goal_2(string, list(term), prog_context, prog_varset,
- int, prog_var, goal, prog_varset, int, prog_var).
+ counter, prog_var, goal, prog_varset, counter, prog_var).
:- mode parse_dcg_goal_2(in, in, in, in, in, in, out, out, out, out)
is semidet.
% Ordinary goal inside { curly braces }.
-parse_dcg_goal_2("{}", [G0 | Gs], Context, VarSet0, N, Var,
- Goal, VarSet, N, Var) :-
+parse_dcg_goal_2("{}", [G0 | Gs], Context, VarSet0, Counter, Var,
+ Goal, VarSet, Counter, Var) :-
% The parser treats '{}/N' terms as tuples, so we need
% to undo the parsing of the argument conjunction here.
list_to_conjunction(Context, G0, Gs, G),
parse_goal(G, VarSet0, Goal, VarSet).
-parse_dcg_goal_2("impure", [G], _, VarSet0, N0, Var0, Goal, VarSet, N, Var) :-
- parse_dcg_goal_with_purity(G, VarSet0, N0, Var0, (impure),
- Goal, VarSet, N, Var).
-parse_dcg_goal_2("semipure", [G], _, VarSet0, N0, Var0, Goal, VarSet, N,
- Var) :-
- parse_dcg_goal_with_purity(G, VarSet0, N0, Var0, (semipure),
- Goal, VarSet, N, Var).
+parse_dcg_goal_2("impure", [G], _, VarSet0, Counter0, Var0, Goal,
+ VarSet, Counter, Var) :-
+ parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, (impure),
+ Goal, VarSet, Counter, Var).
+parse_dcg_goal_2("semipure", [G], _, VarSet0, Counter0, Var0, Goal,
+ VarSet, Counter, Var) :-
+ parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, (semipure),
+ Goal, VarSet, Counter, Var).
% Empty list - just unify the input and output DCG args.
-parse_dcg_goal_2("[]", [], Context, VarSet0, N0, Var0,
- Goal, VarSet, N, Var) :-
- new_dcg_var(VarSet0, N0, VarSet, N, Var),
+parse_dcg_goal_2("[]", [], Context, VarSet0, Counter0, Var0,
+ Goal, VarSet, Counter, Var) :-
+ new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
Goal = unify(term__variable(Var0), term__variable(Var), pure) - Context.
% Non-empty list of terminals. Append the DCG output arg
% as the new tail of the list, and unify the result with
% the DCG input arg.
-parse_dcg_goal_2("[|]", [X, Xs], Context, VarSet0, N0, Var0,
- Goal, VarSet, N, Var) :-
- new_dcg_var(VarSet0, N0, VarSet, N, Var),
+parse_dcg_goal_2("[|]", [X, Xs], Context, VarSet0, Counter0, Var0,
+ Goal, VarSet, Counter, Var) :-
+ new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
ConsTerm0 = term__functor(term__atom("[|]"), [X, Xs], Context),
term__coerce(ConsTerm0, ConsTerm),
term_list_append_term(ConsTerm, term__variable(Var), Term),
Goal = unify(term__variable(Var0), Term, pure) - Context.
% Call to '='/1 - unify argument with DCG input arg.
-parse_dcg_goal_2("=", [A0], Context, VarSet, N, Var, Goal, VarSet, N, Var) :-
+parse_dcg_goal_2("=", [A0], Context, VarSet, Counter, Var,
+ Goal, VarSet, Counter, Var) :-
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
% Call to ':='/1 - unify argument with DCG output arg.
-parse_dcg_goal_2(":=", [A0], Context, VarSet0, N0, _Var0,
- Goal, VarSet, N, Var) :-
- new_dcg_var(VarSet0, N0, VarSet, N, Var),
+parse_dcg_goal_2(":=", [A0], Context, VarSet0, Counter0, _Var0,
+ Goal, VarSet, Counter, Var) :-
+ new_dcg_var(VarSet0, Counter0, VarSet, Counter, Var),
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
@@ -201,10 +205,10 @@
Since (A -> B) has different semantics in standard Prolog
(A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
for the moment we'll just disallow it.
-parse_dcg_goal_2("->", [Cond0, Then0], Context, VarSet0, N0, Var0,
- Goal, VarSet, N, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, N0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, N, Var),
+parse_dcg_goal_2("->", [Cond0, Then0], Context, VarSet0, Counter0, Var0,
+ Goal, VarSet, Counter, Var) :-
+ parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
+ SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
( Var = Var0 ->
Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
;
@@ -217,9 +221,10 @@
% If-then (NU-Prolog syntax).
parse_dcg_goal_2("if", [
term__functor(term__atom("then"), [Cond0, Then0], _)
- ], Context, VarSet0, N0, Var0, Goal, VarSet, N, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, N0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, N, Var),
+ ], Context, VarSet0, Counter0, Var0, Goal,
+ VarSet, Counter, Var) :-
+ parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
+ SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
( Var = Var0 ->
Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
;
@@ -229,29 +234,29 @@
).
% Conjunction.
-parse_dcg_goal_2(",", [A0, B0], Context, VarSet0, N0, Var0,
- (A, B) - Context, VarSet, N, Var) :-
- parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet1, N1, Var1),
- parse_dcg_goal(B0, VarSet1, N1, Var1, B, VarSet, N, Var).
-
-parse_dcg_goal_2("&", [A0, B0], Context, VarSet0, N0, Var0,
- (A & B) - Context, VarSet, N, Var) :-
- parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet1, N1, Var1),
- parse_dcg_goal(B0, VarSet1, N1, Var1, B, VarSet, N, Var).
+parse_dcg_goal_2(",", [A0, B0], Context, VarSet0, Counter0, Var0,
+ (A, B) - Context, VarSet, Counter, Var) :-
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet1, Counter1, Var1),
+ parse_dcg_goal(B0, VarSet1, Counter1, Var1, B, VarSet, Counter, Var).
+
+parse_dcg_goal_2("&", [A0, B0], Context, VarSet0, Counter0, Var0,
+ (A & B) - Context, VarSet, Counter, Var) :-
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet1, Counter1, Var1),
+ parse_dcg_goal(B0, VarSet1, Counter1, Var1, B, VarSet, Counter, Var).
% Disjunction or if-then-else (Prolog syntax).
-parse_dcg_goal_2(";", [A0, B0], Context, VarSet0, N0, Var0,
- Goal, VarSet, N, Var) :-
+parse_dcg_goal_2(";", [A0, B0], Context, VarSet0, Counter0, Var0,
+ Goal, VarSet, Counter, Var) :-
(
A0 = term__functor(term__atom("->"), [Cond0, Then0], _Context)
->
parse_dcg_if_then_else(Cond0, Then0, B0, Context,
- VarSet0, N0, Var0, Goal, VarSet, N, Var)
+ VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var)
;
- parse_dcg_goal(A0, VarSet0, N0, Var0,
- A1, VarSet1, N1, VarA),
- parse_dcg_goal(B0, VarSet1, N1, Var0,
- B1, VarSet, N, VarB),
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0,
+ A1, VarSet1, Counter1, VarA),
+ parse_dcg_goal(B0, VarSet1, Counter1, Var0,
+ B1, VarSet, Counter, VarB),
( VarA = Var0, VarB = Var0 ->
Var = Var0,
Goal = (A1 ; B1) - Context
@@ -280,26 +285,26 @@
term__functor(term__atom("then"), [Cond0, Then0], _)
], Context),
Else0
- ], _, VarSet0, N0, Var0, Goal, VarSet, N, Var) :-
+ ], _, VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var) :-
parse_dcg_if_then_else(Cond0, Then0, Else0, Context,
- VarSet0, N0, Var0, Goal, VarSet, N, Var).
+ VarSet0, Counter0, Var0, Goal, VarSet, Counter, Var).
% Negation (NU-Prolog syntax).
-parse_dcg_goal_2( "not", [A0], Context, VarSet0, N0, Var0,
- not(A) - Context, VarSet, N, Var ) :-
- parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet, N, _),
+parse_dcg_goal_2( "not", [A0], Context, VarSet0, Counter0, Var0,
+ not(A) - Context, VarSet, Counter, Var ) :-
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet, Counter, _),
Var = Var0.
% Negation (Prolog syntax).
-parse_dcg_goal_2( "\\+", [A0], Context, VarSet0, N0, Var0,
- not(A) - Context, VarSet, N, Var ) :-
- parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet, N, _),
+parse_dcg_goal_2( "\\+", [A0], Context, VarSet0, Counter0, Var0,
+ not(A) - Context, VarSet, Counter, Var ) :-
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A, VarSet, Counter, _),
Var = Var0.
% Universal quantification.
parse_dcg_goal_2("all", [QVars, A0], Context,
- VarSet0, N0, Var0, GoalExpr - Context,
- VarSet, N, Var) :-
+ VarSet0, Counter0, Var0, GoalExpr - Context,
+ VarSet, Counter, Var) :-
% Extract any state variables in the quantifier.
%
@@ -307,8 +312,8 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, VarSet0, N0, Var0, A @ (GoalExprA - ContextA),
- VarSet, N, Var),
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A @ (GoalExprA - ContextA),
+ VarSet, Counter, Var),
(
Vars = [], StateVars = [],
@@ -326,8 +331,8 @@
% Existential quantification.
parse_dcg_goal_2("some", [QVars, A0], Context,
- VarSet0, N0, Var0, GoalExpr - Context,
- VarSet, N, Var) :-
+ VarSet0, Counter0, Var0, GoalExpr - Context,
+ VarSet, Counter, Var) :-
% Extract any state variables in the quantifier.
%
@@ -335,8 +340,8 @@
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, VarSet0, N0, Var0, A @ (GoalExprA - ContextA),
- VarSet, N, Var),
+ parse_dcg_goal(A0, VarSet0, Counter0, Var0, A @ (GoalExprA - ContextA),
+ VarSet, Counter, Var),
(
Vars = [], StateVars = [],
@@ -352,14 +357,15 @@
GoalExpr = some(Vars, some_state_vars(StateVars, A) - ContextA)
).
-:- pred parse_dcg_goal_with_purity(term, prog_varset, int, prog_var,
- purity, goal, prog_varset, int, prog_var).
+:- pred parse_dcg_goal_with_purity(term, prog_varset, counter, prog_var,
+ purity, goal, prog_varset, counter, prog_var).
:- mode parse_dcg_goal_with_purity(in, in, in, in, in, out, out, out, out)
is det.
-parse_dcg_goal_with_purity(G, VarSet0, N0, Var0, Purity, Goal, VarSet,
- N, Var) :-
- parse_dcg_goal(G, VarSet0, N0, Var0, Goal1, VarSet, N, Var),
+parse_dcg_goal_with_purity(G, VarSet0, Counter0, Var0, Purity, Goal, VarSet,
+ Counter, Var) :-
+ parse_dcg_goal(G, VarSet0, Counter0, Var0, Goal1,
+ VarSet, Counter, Var),
( Goal1 = call(Pred, Args, pure) - Context ->
Goal = call(Pred, Args, Purity) - Context
; Goal1 = unify(ProgTerm1, ProgTerm2, pure) - Context ->
@@ -387,11 +393,12 @@
).
:- pred parse_some_vars_dcg_goal(term, list(prog_var), list(prog_var),
- prog_varset, int, prog_var, goal, prog_varset, int, prog_var).
+ prog_varset, counter, prog_var, goal, prog_varset, counter, prog_var).
:- mode parse_some_vars_dcg_goal(in, out, out, in, in, in, out, out, out, out)
is det.
-parse_some_vars_dcg_goal(A0, SomeVars, StateVars, VarSet0, N0, Var0,
- A, VarSet, N, Var) :-
+
+parse_some_vars_dcg_goal(A0, SomeVars, StateVars, VarSet0, Counter0, Var0,
+ A, VarSet, Counter, Var) :-
( A0 = term__functor(term__atom("some"), [QVars0, A1], _Context) ->
term__coerce(QVars0, QVars),
( if parse_quantifier_vars(QVars, StateVars0, SomeVars0) then
@@ -409,7 +416,7 @@
StateVars = [],
A2 = A0
),
- parse_dcg_goal(A2, VarSet0, N0, Var0, A, VarSet, N, Var).
+ parse_dcg_goal(A2, VarSet0, Counter0, Var0, A, VarSet, Counter, Var).
% Parse the "if" and the "then" part of an if-then or an
% if-then-else.
@@ -431,39 +438,39 @@
% )
% so that the implicit quantification of DCG_2 is correct.
-:- pred parse_dcg_if_then(term, term, prog_context, prog_varset, int,
+:- pred parse_dcg_if_then(term, term, prog_context, prog_varset, counter,
prog_var, list(prog_var), list(prog_var), goal, goal,
- prog_varset, int, prog_var).
+ prog_varset, counter, prog_var).
:- mode parse_dcg_if_then(in, in, in, in, in, in, out, out, out, out, out, out,
out) is det.
-parse_dcg_if_then(Cond0, Then0, Context, VarSet0, N0, Var0,
- SomeVars, StateVars, Cond, Then, VarSet, N, Var) :-
- parse_some_vars_dcg_goal(Cond0, SomeVars, StateVars, VarSet0, N0, Var0,
- Cond, VarSet1, N1, Var1),
- parse_dcg_goal(Then0, VarSet1, N1, Var1, Then1, VarSet2, N2,
- Var2),
+parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
+ SomeVars, StateVars, Cond, Then, VarSet, Counter, Var) :-
+ parse_some_vars_dcg_goal(Cond0, SomeVars, StateVars,
+ VarSet0, Counter0, Var0, Cond, VarSet1, Counter1, Var1),
+ parse_dcg_goal(Then0, VarSet1, Counter1, Var1, Then1, VarSet2,
+ Counter2, Var2),
( Var0 \= Var1, Var1 = Var2 ->
- new_dcg_var(VarSet2, N2, VarSet, N, Var),
+ new_dcg_var(VarSet2, Counter2, VarSet, Counter, Var),
Unify = unify(term__variable(Var), term__variable(Var2), pure),
Then = (Then1, Unify - Context) - Context
;
Then = Then1,
- N = N2,
+ Counter = Counter2,
Var = Var2,
VarSet = VarSet2
).
:- pred parse_dcg_if_then_else(term, term, term, prog_context,
- prog_varset, int, prog_var, goal, prog_varset, int, prog_var).
+ prog_varset, counter, prog_var, goal, prog_varset, counter, prog_var).
:- mode parse_dcg_if_then_else(in, in, in, in, in, in, in,
out, out, out, out) is det.
-parse_dcg_if_then_else(Cond0, Then0, Else0, Context, VarSet0, N0, Var0,
- Goal, VarSet, N, Var) :-
- parse_dcg_if_then(Cond0, Then0, Context, VarSet0, N0, Var0,
- SomeVars, StateVars, Cond, Then1, VarSet1, N1, VarThen),
- parse_dcg_goal(Else0, VarSet1, N1, Var0, Else1, VarSet, N,
+parse_dcg_if_then_else(Cond0, Then0, Else0, Context, VarSet0, Counter0, Var0,
+ Goal, VarSet, Counter, Var) :-
+ parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
+ SomeVars, StateVars, Cond, Then1, VarSet1, Counter1, VarThen),
+ parse_dcg_goal(Else0, VarSet1, Counter1, Var0, Else1, VarSet, Counter,
VarElse),
( VarThen = Var0, VarElse = Var0 ->
Var = Var0,
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.58
diff -u -b -r1.58 prog_io_pragma.m
--- compiler/prog_io_pragma.m 19 May 2003 14:24:27 -0000 1.58
+++ compiler/prog_io_pragma.m 22 May 2003 18:57:51 -0000
@@ -1554,7 +1554,7 @@
PredAndModesResult = ok(PredName - PredOrFunc, Modes),
list__length(Modes, Arity0),
( PredOrFunc = function ->
- Arity is Arity0 - 1
+ Arity = Arity0 - 1
;
Arity = Arity0
),
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.62
diff -u -b -r1.62 prog_util.m
--- compiler/prog_util.m 18 Mar 2003 02:43:42 -0000 1.62
+++ compiler/prog_util.m 31 Mar 2003 05:51:22 -0000
@@ -421,7 +421,7 @@
string__left(String, LeftLength, ModuleName),
string__length(String, StringLength),
string__length(ModuleSeparator, SeparatorLength),
- RightLength is StringLength - LeftLength - SeparatorLength,
+ RightLength = StringLength - LeftLength - SeparatorLength,
string__right(String, RightLength, Name),
string_to_sym_name(Name, ModuleSeparator, NameSym),
insert_module_qualifier(ModuleName, NameSym, Result)
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.58
diff -u -b -r1.58 purity.m
--- compiler/purity.m 19 May 2003 14:24:27 -0000 1.58
+++ compiler/purity.m 22 May 2003 18:57:52 -0000
@@ -284,7 +284,7 @@
check_preds_purity_2(PredIds, ModuleInfo1, ModuleInfo2,
NumErrors1, NumErrors),
{ module_info_num_errors(ModuleInfo2, Errs0) },
- { Errs is Errs0 + NumErrors },
+ { Errs = Errs0 + NumErrors },
{ module_info_set_num_errors(ModuleInfo2, Errs, ModuleInfo) }.
:- pred check_preds_purity_2(list(pred_id), module_info, module_info,
@@ -377,7 +377,7 @@
{ perform_pred_purity_checks(PredInfo, Purity, DeclPurity,
PromisedPurity, PurityCheckResult) },
( { PurityCheckResult = inconsistent_promise },
- { NumErrors is NumErrors0 + 1 },
+ { NumErrors = NumErrors0 + 1 },
error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
DeclPurity)
; { PurityCheckResult = unnecessary_decl },
@@ -385,7 +385,7 @@
warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
DeclPurity, WorstPurity)
; { PurityCheckResult = insufficient_decl },
- { NumErrors is NumErrors0 + 1 },
+ { NumErrors = NumErrors0 + 1 },
error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity)
; { PurityCheckResult = unnecessary_promise_pure },
{ NumErrors = NumErrors0 },
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.22
diff -u -b -r1.22 rl.m
--- compiler/rl.m 16 Mar 2003 08:01:30 -0000 1.22
+++ compiler/rl.m 31 Mar 2003 05:51:22 -0000
@@ -777,7 +777,7 @@
GetAttr =
lambda([_::in, Attr::out, Index0::in, Index::out] is det, (
Attr = Index0 - ascending,
- Index is Index0 + 1
+ Index = Index0 + 1
)),
list__map_foldl(GetAttr, Schema, Attrs, 1, _).
@@ -789,7 +789,7 @@
rl__attr_list_2(_, [], []).
rl__attr_list_2(Index, [_ | Types], [Index | Attrs]) :-
- NextIndex is Index + 1,
+ NextIndex = Index + 1,
rl__attr_list_2(NextIndex, Types, Attrs).
%-----------------------------------------------------------------------------%
Index: compiler/rl_block.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_block.m,v
retrieving revision 1.4
diff -u -b -r1.4 rl_block.m
--- compiler/rl_block.m 15 Mar 2003 03:09:08 -0000 1.4
+++ compiler/rl_block.m 31 Mar 2003 05:51:22 -0000
@@ -607,7 +607,7 @@
map__sorted_keys(RelationInfoMap, RelationIds),
( list__last(RelationIds, HighestRelationId) ->
- NextRelationId is HighestRelationId + 1
+ NextRelationId = HighestRelationId + 1
;
NextRelationId = 0
),
@@ -621,7 +621,7 @@
rl_opt_info_get_next_block_id(BlockId1, Info0, Info) :-
Info0 = rl_opt_info(BlockId,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
- BlockId1 is BlockId + 1,
+ BlockId1 = BlockId + 1,
Info = rl_opt_info(BlockId1,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q).
%-----------------------------------------------------------------------------%
@@ -680,7 +680,7 @@
rl_opt_info_get_new_label(Label, Block) -->
rl_opt_info_get_next_block_id(Block),
rl_opt_info_get_highest_label_id(Label0),
- { Label is Label0 + 1 },
+ { Label = Label0 + 1 },
rl_opt_info_set_highest_label_id(Label).
%-----------------------------------------------------------------------------%
@@ -696,7 +696,7 @@
rl_opt_info_add_relation(Schema, RelationId) -->
rl_opt_info_get_next_relation_id(RelationId),
- { NextRelationId is RelationId + 1 },
+ { NextRelationId = RelationId + 1 },
rl_opt_info_set_next_relation_id(NextRelationId),
{ rl__relation_id_to_string(RelationId, RelName) },
rl_opt_info_get_module_info(ModuleInfo),
Index: compiler/rl_block_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_block_opt.m,v
retrieving revision 1.9
diff -u -b -r1.9 rl_block_opt.m
--- compiler/rl_block_opt.m 15 Mar 2003 03:09:08 -0000 1.9
+++ compiler/rl_block_opt.m 31 Mar 2003 05:51:22 -0000
@@ -291,7 +291,7 @@
Outputs = Outputs0
;
OutputRel = OutputRel0,
- Index is Index0 + 1,
+ Index = Index0 + 1,
rl_block_opt__add_output(Outputs0, Index, TheIndex,
Relation, RelIndex, Outputs)
).
@@ -458,7 +458,7 @@
{ map__det_insert(Locs0, OutputId, InputRel, Locs) },
dag_set_output_loc_map(Locs)
),
- { Index is Index0 + 1 },
+ { Index = Index0 + 1 },
dag_get_rel_node_map(RelNodeMap0),
{ map__set(RelNodeMap0, Output, OutputId, RelNodeMap) },
dag_set_rel_node_map(RelNodeMap).
@@ -695,7 +695,7 @@
{ call(Update, Schema, Index0, Index, AddedIndexes) },
{ OutputRel = output_node(Schema, Index, RelationIds0) },
- { N is OutputNo + 1 },
+ { N = OutputNo + 1 },
{ list__replace_nth(OutputRels0, N, OutputRel, OutputRels1) ->
OutputRels = OutputRels1
;
@@ -872,7 +872,7 @@
;
{ OutputProjns1 = OutputProjns0 }
),
- { NextIndex is Index + 1 },
+ { NextIndex = Index + 1 },
rl_block_opt__find_output_project_nodes(NodeId, NextIndex,
OutputNodes, OutputProjns1, OutputProjns).
@@ -1034,8 +1034,8 @@
rl_block_opt__rename_node(ProjNode, OldOutputLoc,
input_node(NewNode, NewIndex0)),
- { OutputIndex is OutputIndex0 + 1 },
- { NewIndex1 is NewIndex0 + 1 },
+ { OutputIndex = OutputIndex0 + 1 },
+ { NewIndex1 = NewIndex0 + 1 },
rl_block_opt__collect_project_outputs_2(ProjNode, OutputIndex,
OutputNodes, NewNode, NewIndex1, NewIndex,
[OutputNode | NewOutputs0], NewOutputs).
@@ -1115,7 +1115,7 @@
{ Goal = Goal0 },
{ OutputRel = OutputRel0 }
),
- { Index is Index0 + 1 },
+ { Index = Index0 + 1 },
rl_block_opt__get_single_projects(Node, Index,
FoundSingle1, FoundSingle, Goals0, Goals,
OutputRels0, OutputRels).
@@ -1711,12 +1711,12 @@
dag_get_next_node_id(A0, Dag0, Dag) :-
Dag0 = dag(A0,B,C,D,E,F,G,H,I,J,K,L,M),
- A is A0 + 1,
+ A = A0 + 1,
Dag = dag(A,B,C,D,E,F,G,H,I,J,K,L,M).
dag_get_next_output_id(B0, Dag0, Dag) :-
Dag0 = dag(A,B0,C,D,E,F,G,H,I,J,K,L,M),
- B is B0 + 1,
+ B = B0 + 1,
Dag = dag(A,B,C,D,E,F,G,H,I,J,K,L,M).
:- pred dag_get_relation_info(relation_id::in, relation_info::out,
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.29
diff -u -b -r1.29 rl_exprn.m
--- compiler/rl_exprn.m 21 Mar 2003 05:52:07 -0000 1.29
+++ compiler/rl_exprn.m 31 Mar 2003 05:51:23 -0000
@@ -381,7 +381,7 @@
rl_exprn__generate_bound_3(ModuleInfo, MaybeArgTypes, IsSubTerm,
Index0, TupleNum, Attr, AttrCode, Depth),
{ int__max(MaxDepth0, Depth, MaxDepth1) },
- { Index is Index0 + 1 },
+ { Index = Index0 + 1 },
rl_exprn__generate_bound_2(ModuleInfo, MaybeArgTypes, TupleNum,
IsSubTerm, Attrs, tree(Code0, AttrCode),
Code, Index, MaxDepth1, MaxDepth).
@@ -422,7 +422,7 @@
;
Code = Code0
},
- { Depth is Depth0 + 1 }.
+ { Depth = Depth0 + 1 }.
:- pred rl_exprn__get_key_arg(maybe(list(T))::in, int::in, T::out) is det.
@@ -783,7 +783,7 @@
;
{ Code0 = empty }
),
- { NextField is FieldNo + 1 },
+ { NextField = FieldNo + 1 },
rl_exprn__deconstruct_input_tuple(TupleNo, NextField, Vars,
NonLocals, Code1),
{ Code = tree(Code0, Code1) }.
@@ -812,7 +812,7 @@
rl_exprn_info_lookup_var(Var, VarReg),
rl_exprn_info_lookup_var_type(Var, Type),
rl_exprn__assign(output_field(FieldNo), reg(VarReg), Type, Code0),
- { NextField is FieldNo + 1 },
+ { NextField = FieldNo + 1 },
rl_exprn__construct_output_tuple_2(NextField, Vars, Code1),
{ Code = tree(Code0, Code1) }.
@@ -1307,7 +1307,7 @@
rl_exprn__handle_functor_args([], [], _, _, _, empty) --> [].
rl_exprn__handle_functor_args([Arg | Args], [Mode | Modes], NonLocals,
Index, ConsId, Code) -->
- { NextIndex is Index + 1 },
+ { NextIndex = Index + 1 },
rl_exprn__handle_functor_args(Args, Modes, NonLocals,
NextIndex, ConsId, Code0),
( { set__member(Arg, NonLocals) } ->
@@ -2122,7 +2122,7 @@
PC1 = PC0
;
functor(Instr, _, Arity),
- PC1 is PC0 + Arity + 1 % +1 for the opcode
+ PC1 = PC0 + Arity + 1 % +1 for the opcode
),
rl_exprn__get_exprn_labels_list(PC1, PC, Labels0, Labels1,
Instrs0, Instrs1),
@@ -2321,7 +2321,7 @@
Added = no
;
IdIndex = Index0,
- Index is Index0 + 1,
+ Index = Index0 + 1,
Added = yes,
map__det_insert(Map0, Id, Index0, Map)
).
@@ -2384,7 +2384,7 @@
rl_exprn_info_get_free_reg(Type, Loc, Info0, Info) :-
Info0 = rl_exprn_info(A,B,C,D,VarMap0,F,G,H,I,RegTypes0),
VarMap0 = Map - Loc,
- Loc1 is Loc + 1,
+ Loc1 = Loc + 1,
VarMap = Map - Loc1,
RegTypes = [Type | RegTypes0],
Info = rl_exprn_info(A,B,C,D,VarMap,F,G,H,I,RegTypes).
@@ -2400,7 +2400,7 @@
Info = rl_exprn_info(A,B,VarTypes,D,VarMap,F,G,H,I,RegTypes).
rl_exprn_info_get_next_label_id(Label0, Info0, Info) :-
Info0 = rl_exprn_info(A,B,C,D,E,Label0,G,H,I,J),
- Label is Label0 + 1,
+ Label = Label0 + 1,
Info = rl_exprn_info(A,B,C,D,E,Label,G,H,I,J).
rl_exprn_info_lookup_const(Const, Loc, Info0, Info) :-
Info0 = rl_exprn_info(A,B,C,D,E,F,Consts0,H,I,J),
Index: compiler/rl_file.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_file.pp,v
retrieving revision 1.4
diff -u -b -r1.4 rl_file.pp
--- compiler/rl_file.pp 10 Jan 2003 10:36:28 -0000 1.4
+++ compiler/rl_file.pp 23 May 2003 06:56:49 -0000
@@ -131,7 +131,7 @@
Writer =
lambda([Byte::in, Pair0::di, Pair::uo] is det, (
Pair0 = Len0 - IOState0,
- Len is Len0 + 1,
+ Len = Len0 + 1,
call(ByteWriter, Byte, IOState0, IOState),
Pair = Len - IOState
)),
@@ -509,7 +509,7 @@
io__state::di, io__state::uo) is det.
rl_file__write_exprn(Exprn, ExprnNum0, ExprnNum) -->
- { ExprnNum is ExprnNum0 + 1 },
+ { ExprnNum = ExprnNum0 + 1 },
io__write_string(",\n\n\t"),
rl_file__write_exprn_2(Exprn, ExprnNum0).
Index: compiler/rl_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_gen.m,v
retrieving revision 1.10
diff -u -b -r1.10 rl_gen.m
--- compiler/rl_gen.m 15 Mar 2003 03:09:09 -0000 1.10
+++ compiler/rl_gen.m 31 Mar 2003 05:51:23 -0000
@@ -70,7 +70,7 @@
rl_gen__scc_list(SubModule, EntryPoints, RLProcId0,
Procs0, Procs1, RLInfo0, RLInfo),
rl_info_get_io_state(IO1, RLInfo, _),
- RLProcId is RLProcId0 + 1,
+ RLProcId = RLProcId0 + 1,
rl_gen__scc_lists(SubModules, ModuleInfo, RLProcId,
Procs1, Procs, IO1, IO).
@@ -156,7 +156,7 @@
{ string__int_to_string(RLProcId, ProcStr) },
{ string__append("rl_proc_", ProcStr, Name) },
{ list__length(EntryPoints, NumEntries) },
- { ProcArity is NumEntries * 2 },
+ { ProcArity = NumEntries * 2 },
{ ProcName = rl_proc_name(Owner, ModuleName, Name, ProcArity) }
;
{ error("rl_gen__proc_name: module with no entry-points") }
@@ -247,7 +247,7 @@
{ RevInputRels1 = RevInputRels0 },
{ InputMap1 = InputMap0 }
),
- { NextArgNo is ArgNo + 1 },
+ { NextArgNo = ArgNo + 1 },
rl_gen__scc_list_input_args(EntryPoint, NextArgNo, Modes,
Types, RevInputRels1, InputRels, InputMap1, InputMap)
;
@@ -810,7 +810,7 @@
rl_gen__proc_input_args([Arg | Args], ArgNo, InputMap) -->
{ map__lookup(InputMap, ArgNo, InputRel) },
rl_info_bind_var_to_relation(Arg, InputRel),
- { NextArgNo is ArgNo + 1 },
+ { NextArgNo = ArgNo + 1 },
rl_gen__proc_input_args(Args, NextArgNo, InputMap).
%-----------------------------------------------------------------------------%
@@ -835,7 +835,7 @@
RuleCode, RuleType, Rel),
rl_info_set_var_rels(VarRels0),
rl_info_set_var_stats(VarStat0),
- { NextRule is RuleNo + 1 },
+ { NextRule = RuleNo + 1 },
rl_gen__rules(Rules, NextRule, NonRecRLCode1, RecRLCode1,
NonRecRels1, RecRels1),
(
Index: compiler/rl_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_info.m,v
retrieving revision 1.4
diff -u -b -r1.4 rl_info.m
--- compiler/rl_info.m 16 Mar 2003 08:01:30 -0000 1.4
+++ compiler/rl_info.m 31 Mar 2003 05:51:23 -0000
@@ -395,12 +395,12 @@
rl_info_get_next_label_id(NextLabelId, RLInfo0, RLInfo) :-
RLInfo0 = rl_info(A,B,C,D,E,F,G,H,I,J,K,LabelId,M,N,O,P,Q,R,S),
- NextLabelId is LabelId + 1,
+ NextLabelId = LabelId + 1,
RLInfo = rl_info(A,B,C,D,E,F,G,H,I,J,K,NextLabelId,M,N,O,P,Q,R,S).
rl_info_get_next_relation_id(NextRelationId, RLInfo0, RLInfo) :-
RLInfo0 = rl_info(A,B,C,D,E,F,G,H,I,J,K,L,RelationId,N,O,P,Q,R,S),
- NextRelationId is RelationId + 1,
+ NextRelationId = RelationId + 1,
RLInfo = rl_info(A,B,C,D,E,F,G,H,I,J,K,L,NextRelationId,N,O,P,Q,R,S).
rl_info_get_pred_proc_id(PredProcId, RLInfo, RLInfo) :-
Index: compiler/rl_out.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_out.pp,v
retrieving revision 1.20
diff -u -b -r1.20 rl_out.pp
--- compiler/rl_out.pp 16 Mar 2003 08:01:30 -0000 1.20
+++ compiler/rl_out.pp 23 May 2003 06:56:49 -0000
@@ -252,7 +252,7 @@
{ assoc_list__reverse_members(ConstsAL, ConstsLA0) },
{ list__sort(ConstsLA0, ConstsLA) },
{ list__length(ConstsLA, ConstTableSize0) },
- { ConstTableSize is ConstTableSize0 + 1 },
+ { ConstTableSize = ConstTableSize0 + 1 },
{ set__to_sorted_list(PermRelsSet, PermRels) },
{ list__length(PermRels, NumPermRels) },
{ list__length(RLProcs, NumProcs) },
@@ -778,7 +778,7 @@
% relations before dropping the pointers to them.
{ DropCode = rl_PROC_unsetrel(Addr) },
- { Counter is Counter0 + 1 },
+ { Counter = Counter0 + 1 },
rl_out__collect_memoed_relations(Owner, ProcName, Rels, Counter,
GetCodes, NameCodes).
@@ -2065,7 +2065,7 @@
{ InstrCode = node([rl_PROC_var(Addr, LockSpec)]) }
;
{ list__length(Inputs, NumInputs) },
- { SplitPoint is NumInputs // 2 },
+ { SplitPoint = NumInputs // 2 },
( { list__split_list(SplitPoint, Inputs, Inputs1, Inputs2) } ->
rl_out__generate_union(UnionCode, Exprn,
Inputs1, StreamCode1),
@@ -2170,13 +2170,13 @@
AddSize = lambda([Instr::in, S0::in, S::out] is det, (
bytecode_to_intlist(Instr, IntList),
list__length(IntList, S1),
- S is S0 + S1
+ S = S0 + S1
)),
list__foldl(AddSize, Instrs, 0, Size).
rl_out__instr_code_size(tree(CodeA, CodeB), Size) :-
rl_out__instr_code_size(CodeA, SizeA),
rl_out__instr_code_size(CodeB, SizeB),
- Size is SizeA + SizeB.
+ Size = SizeA + SizeB.
%-----------------------------------------------------------------------------%
@@ -2309,7 +2309,7 @@
% Terms take 2 slots in the stack, so to be safe we
% multiply the depth by 2. The +10 is for temporary storage
% and probably isn't used.
- { StackSize is TermDepth * 2 + 10 },
+ { StackSize = TermDepth * 2 + 10 },
rl_out__package_exprn(ExprnCode, NumParams, generate2,
Output1SchemaOffset, Output2SchemaOffset, StackSize,
Decls, RangeExprn).
Index: compiler/rl_sort.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_sort.m,v
retrieving revision 1.11
diff -u -b -r1.11 rl_sort.m
--- compiler/rl_sort.m 15 Mar 2003 03:09:09 -0000 1.11
+++ compiler/rl_sort.m 31 Mar 2003 05:51:23 -0000
@@ -1043,7 +1043,7 @@
rl_sort__all_positions([], _, _, []).
rl_sort__all_positions([Arg | Args], Index0, Var, Attrs) :-
- Index is Index0 + 1,
+ Index = Index0 + 1,
( Arg = Var ->
Attrs = [Index0 | Attrs1],
rl_sort__all_positions(Args, Index, Var, Attrs1)
Index: compiler/rl_stream.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_stream.m,v
retrieving revision 1.8
diff -u -b -r1.8 rl_stream.m
--- compiler/rl_stream.m 15 Mar 2003 03:09:09 -0000 1.8
+++ compiler/rl_stream.m 31 Mar 2003 05:51:23 -0000
@@ -242,7 +242,7 @@
BlockIds, InsideLaterCalledBlocks) :-
(
list__nth_member_search(BlockIds, BlockId, N),
- N1 is N - 1,
+ N1 = N - 1,
list__split_list(N1, BlockIds, _, AfterBlockIds0),
AfterBlockIds0 = [BlockId | AfterBlockIds]
->
@@ -338,7 +338,7 @@
( set__empty(Intersect) ->
set__to_sorted_list(Relations, RelationsList),
list__map(bag__count_value(Uses), RelationsList, Counts),
- list__foldl(lambda([X::in, Y::in, Z::out] is det, Z is X + Y),
+ list__foldl(lambda([X::in, Y::in, Z::out] is det, Z = X + Y),
Counts, 0, NumUses),
( NumUses = 1 ->
Materialise = Materialise0
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.116
diff -u -b -r1.116 simplify.m
--- compiler/simplify.m 21 Mar 2003 05:52:07 -0000 1.116
+++ compiler/simplify.m 31 Mar 2003 05:51:23 -0000
@@ -2418,10 +2418,8 @@
simplify_info_enter_lambda(SI, SI^lambdas := SI^lambdas + 1).
simplify_info_leave_lambda(SI, SI^lambdas := LambdaCount) :-
- LambdaCount1 is SI^lambdas - 1,
- (
- LambdaCount1 >= 0
- ->
+ LambdaCount1 = SI^lambdas - 1,
+ ( LambdaCount1 >= 0 ->
LambdaCount = LambdaCount1
;
error("simplify_info_leave_lambda: Left too many lambdas")
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.82
diff -u -b -r1.82 store_alloc.m
--- compiler/store_alloc.m 7 May 2003 00:50:22 -0000 1.82
+++ compiler/store_alloc.m 7 May 2003 01:17:55 -0000
@@ -459,7 +459,7 @@
next_free_reg(N0, Values, N) :-
( set__member(reg(r, N0), Values) ->
- N1 is N0 + 1,
+ N1 = N0 + 1,
next_free_reg(N1, Values, N)
;
N = N0
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.11
diff -u -b -r1.11 switch_util.m
--- compiler/switch_util.m 15 Mar 2003 03:09:11 -0000 1.11
+++ compiler/switch_util.m 31 Mar 2003 05:51:24 -0000
@@ -162,7 +162,7 @@
error("switch_util__string_hash_cases: non-string case?")
),
string__hash(String, HashVal0),
- HashVal is HashVal0 /\ HashMask,
+ HashVal = HashVal0 /\ HashMask,
( map__search(Map0, HashVal, CaseList0) ->
map__det_update(Map0, HashVal, [Case | CaseList0], Map)
;
@@ -248,7 +248,7 @@
:- mode switch_util__next_free_hash_slot(in, in, in, out) is det.
switch_util__next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
- NextSlot is LastUsed + 1,
+ NextSlot = LastUsed + 1,
(
\+ map__contains(Map, NextSlot),
\+ map__contains(H_Map, NextSlot)
@@ -541,7 +541,7 @@
switch_util__order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
( MaxPtag >= Ptag ->
- NextPtag is Ptag + 1,
+ NextPtag = Ptag + 1,
( map__search(PtagCaseMap0, Ptag, PtagCase) ->
map__delete(PtagCaseMap0, Ptag, PtagCaseMap1),
switch_util__order_ptags_by_value(NextPtag, MaxPtag,
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.55
diff -u -b -r1.55 tag_switch.m
--- compiler/tag_switch.m 15 Mar 2003 03:09:11 -0000 1.55
+++ compiler/tag_switch.m 31 Mar 2003 05:51:24 -0000
@@ -504,7 +504,7 @@
{ Labels = [] },
{ Code = empty }
;
- { NextPrimary is CurPrimary + 1 },
+ { NextPrimary = CurPrimary + 1 },
( { PtagGroups = [CurPrimary - PrimaryInfo | PtagGroups1] } ->
{ PrimaryInfo = StagLoc - StagGoalMap },
{ map__lookup(PtagCountMap, CurPrimary, CountInfo) },
@@ -607,8 +607,8 @@
{ error("caselist not singleton or empty when binary search ends") }
)
;
- { LowRangeEnd is (MinPtag + MaxPtag) // 2 },
- { HighRangeStart is LowRangeEnd + 1 },
+ { LowRangeEnd = (MinPtag + MaxPtag) // 2 },
+ { HighRangeStart = LowRangeEnd + 1 },
{ InLowGroup = lambda([PtagGroup::in] is semidet, (
PtagGroup = Ptag - _,
Ptag =< LowRangeEnd
@@ -753,7 +753,7 @@
(
{ list__length(GoalList, GoalCount) },
- { FullGoalCount is MaxSecondary + 1 },
+ { FullGoalCount = MaxSecondary + 1 },
{ FullGoalCount = GoalCount }
->
{ CanFail = cannot_fail }
@@ -981,7 +981,7 @@
{ Labels = [] },
{ Code = empty }
;
- { NextSecondary is CurSecondary + 1 },
+ { NextSecondary = CurSecondary + 1 },
( { CaseList = [CurSecondary - Goal | CaseList1] } ->
code_info__get_next_label(NewLabel),
{ LabelCode = node([
@@ -1075,8 +1075,8 @@
{ error("goallist not singleton or empty when binary search ends") }
)
;
- { LowRangeEnd is (MinStag + MaxStag) // 2 },
- { HighRangeStart is LowRangeEnd + 1 },
+ { LowRangeEnd = (MinStag + MaxStag) // 2 },
+ { HighRangeStart = LowRangeEnd + 1 },
{ InLowGroup = lambda([StagGoal::in] is semidet, (
StagGoal = Stag - _,
Stag =< LowRangeEnd
Index: compiler/term_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_errors.m,v
retrieving revision 1.18
diff -u -b -r1.18 term_errors.m
--- compiler/term_errors.m 15 Mar 2003 03:09:11 -0000 1.18
+++ compiler/term_errors.m 31 Mar 2003 05:51:24 -0000
@@ -231,7 +231,7 @@
term_errors__output_errors([Error | Errors], Single, ErrNum0, Indent, Module)
-->
term_errors__output_error(Error, Single, yes(ErrNum0), Indent, Module),
- { ErrNum1 is ErrNum0 + 1 },
+ { ErrNum1 = ErrNum0 + 1 },
term_errors__output_errors(Errors, Single, ErrNum1, Indent, Module).
:- pred term_errors__output_error(term_errors__error::in,
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass2.m,v
retrieving revision 1.11
diff -u -b -r1.11 term_pass2.m
--- compiler/term_pass2.m 15 Mar 2003 03:09:11 -0000 1.11
+++ compiler/term_pass2.m 31 Mar 2003 05:51:24 -0000
@@ -189,7 +189,7 @@
( Termination = cannot_loop ->
true
;
- ArgNum1 is ArgNum0 + 1,
+ ArgNum1 = ArgNum0 + 1,
prove_termination_in_scc_single_arg_2(TrialPPId, RestSCC,
ArgNum1, Module, PassInfo)
).
@@ -235,7 +235,7 @@
mode_is_input(Module, Mode),
ArgNum > 1
->
- NextArgNum is ArgNum - 1
+ NextArgNum = ArgNum - 1
;
fail
)
@@ -562,7 +562,7 @@
zero_or_positive_weight_cycles_from_neighbour(CurPPId - (Context - EdgeWeight),
LookforPPId, ProcContext, WeightSoFar0, VisitedCalls,
CallWeights, Cycles) :-
- WeightSoFar1 is WeightSoFar0 + EdgeWeight,
+ WeightSoFar1 = WeightSoFar0 + EdgeWeight,
(
CurPPId = LookforPPId
->
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.22
diff -u -b -r1.22 term_traversal.m
--- compiler/term_traversal.m 15 Mar 2003 03:09:11 -0000 1.22
+++ compiler/term_traversal.m 31 Mar 2003 05:51:24 -0000
@@ -143,7 +143,7 @@
Gamma0, InVars0, OutVars)
->
bag__insert(InVars0, InVar, InVars),
- Gamma is 0 - Gamma0,
+ Gamma = 0 - Gamma0,
record_change(InVars, OutVars, Gamma, [], Info0, Info)
;
error("higher order deconstruction")
@@ -482,7 +482,7 @@
Path0 = path_info(ProcData, Start, Gamma0, PPIds0, Vars0),
( bag__intersect(OutVars, Vars0) ->
% The change produces some active variables.
- Gamma is CallGamma + Gamma0,
+ Gamma = CallGamma + Gamma0,
list__append(CallPPIds, PPIds0, PPIds),
bag__subtract(Vars0, OutVars, Vars1),
bag__union(InVars, Vars1, Vars),
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.24
diff -u -b -r1.24 term_util.m
--- compiler/term_util.m 15 Mar 2003 03:09:11 -0000 1.24
+++ compiler/term_util.m 31 Mar 2003 05:51:24 -0000
@@ -335,7 +335,7 @@
NonRecArgs = NonRecArgs0,
ArgInfo = [yes | ArgInfo0]
;
- NonRecArgs is NonRecArgs0 + 1,
+ NonRecArgs = NonRecArgs0 + 1,
ArgInfo = [no | ArgInfo0]
).
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.116
diff -u -b -r1.116 type_util.m
--- compiler/type_util.m 15 Mar 2003 03:09:12 -0000 1.116
+++ compiler/type_util.m 31 Mar 2003 05:51:24 -0000
@@ -973,7 +973,7 @@
% to a machine with a different size character.
char__max_char_value(MaxChar),
char__min_char_value(MinChar),
- NumFunctors is MaxChar - MinChar + 1
+ NumFunctors = MaxChar - MinChar + 1
; type_ctor_is_tuple(TypeCtor) ->
NumFunctors = 1
;
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.337
diff -u -b -r1.337 typecheck.m
--- compiler/typecheck.m 19 May 2003 14:24:27 -0000 1.337
+++ compiler/typecheck.m 22 May 2003 18:57:52 -0000
@@ -2062,7 +2062,7 @@
typecheck_var_has_arg_type_list([Var|Vars], ArgNum, ArgTypeAssignSet0) -->
typecheck_info_set_arg_num(ArgNum),
typecheck_var_has_arg_type(Var, ArgTypeAssignSet0, ArgTypeAssignSet1),
- { ArgNum1 is ArgNum + 1 },
+ { ArgNum1 = ArgNum + 1 },
typecheck_var_has_arg_type_list(Vars, ArgNum1, ArgTypeAssignSet1).
:- pred convert_args_type_assign_set(args_type_assign_set, type_assign_set).
@@ -2206,7 +2206,7 @@
typecheck_var_has_type_list([Var|Vars], [Type|Types], ArgNum) -->
typecheck_info_set_arg_num(ArgNum),
typecheck_var_has_type(Var, Type),
- { ArgNum1 is ArgNum + 1 },
+ { ArgNum1 = ArgNum + 1 },
typecheck_var_has_type_list(Vars, Types, ArgNum1).
:- pred typecheck_var_has_type(prog_var, type, typecheck_info, typecheck_info).
@@ -3153,7 +3153,7 @@
)
;
IsPredOrFunc = function,
- PredAsFuncArity is PredArity - 1,
+ PredAsFuncArity = PredArity - 1,
PredAsFuncArity >= FuncArity,
% We don't support first-class polymorphism,
% so you can't take the address of an existentially
@@ -3203,7 +3203,7 @@
; ApplyName = "semipure_apply", Purity = (semipure)
),
Arity >= 1,
- Arity1 is Arity - 1,
+ Arity1 = Arity - 1,
higher_order_func_type(Purity, Arity1, normal, TypeVarSet,
FuncType, ArgTypes, RetType),
ExistQVars = [],
@@ -4582,7 +4582,7 @@
Constraint = constraint(ClassName, Types),
map__set(Proofs0, Constraint, NewProof, Proofs)
;
- N is N0 + 1,
+ N = N0 + 1,
find_matching_instance_rule_2(Is, N, ClassName,
Types, TVarSet, NewTVarSet, Proofs0,
Proofs, NewConstraints)
@@ -5260,7 +5260,7 @@
;
io__write_string("(_"),
{ list__length(ArgVars, NumArgVars) },
- { NumArgVars1 is NumArgVars - 1 },
+ { NumArgVars1 = NumArgVars - 1 },
{ list__duplicate(NumArgVars1, ", _", Strings) },
io__write_strings(Strings),
io__write_string(")")
@@ -5274,7 +5274,7 @@
;
io__write_string("(_"),
{ list__length(FuncArgs2, NumArgVars) },
- { NumArgVars1 is NumArgVars - 1 },
+ { NumArgVars1 = NumArgVars - 1 },
{ list__duplicate(NumArgVars1, ", _", Strings) },
io__write_strings(Strings),
io__write_string(")")
@@ -5388,7 +5388,7 @@
find_mismatched_args([], _, _, []).
find_mismatched_args([Arg - ExpType | ArgExpTypes], TypeAssignSet, ArgNum0,
Mismatched) :-
- ArgNum1 is ArgNum0 + 1,
+ ArgNum1 = ArgNum0 + 1,
find_mismatched_args(ArgExpTypes, TypeAssignSet, ArgNum1, Mismatched1),
get_type_stuff(TypeAssignSet, Arg, TypeStuffList),
TypeStuffList = [type_stuff(ArgType, TVarSet, TypeBindings,
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.128
diff -u -b -r1.128 unify_gen.m
--- compiler/unify_gen.m 9 May 2003 05:51:52 -0000 1.128
+++ compiler/unify_gen.m 9 May 2003 06:45:27 -0000
@@ -553,7 +553,7 @@
{ Three = const(int_const(3)) },
{ list__length(CallArgs, NumNewArgs) },
{ NumNewArgs_Rval = const(int_const(NumNewArgs)) },
- { NumNewArgsPlusThree is NumNewArgs + 3 },
+ { NumNewArgsPlusThree = NumNewArgs + 3 },
{ NumNewArgsPlusThree_Rval =
const(int_const(NumNewArgsPlusThree)) },
code_info__produce_variable(CallPred, OldClosureCode,
@@ -775,7 +775,7 @@
[F | Fs], [A | As]) :-
F = lval(field(yes(TagNum), Rval, const(int_const(Field0)))),
A = ref(Var),
- Field1 is Field0 + 1,
+ Field1 = Field0 + 1,
unify_gen__make_fields_and_argvars(Vars, Rval, Field1, TagNum, Fs, As).
%---------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.119
diff -u -b -r1.119 unify_proc.m
--- compiler/unify_proc.m 31 Mar 2003 09:25:06 -0000 1.119
+++ compiler/unify_proc.m 2 Apr 2003 22:58:53 -0000
@@ -1142,7 +1142,7 @@
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) },
unify_proc__quantify_clause_body([X, Index], Goal, Context, Clause),
- { N1 is N + 1 },
+ { N1 = N + 1 },
unify_proc__generate_du_index_clauses(Ctors, X, Index, Context, N1,
Clauses).
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.84
diff -u -b -r1.84 unused_args.m
--- compiler/unused_args.m 21 Mar 2003 05:52:09 -0000 1.84
+++ compiler/unused_args.m 31 Mar 2003 05:51:25 -0000
@@ -1161,7 +1161,7 @@
;
(
List0 = [Head | Tail],
- NextArg is ArgNo + 1,
+ NextArg = ArgNo + 1,
(
list__member(ArgNo, ElemsToRemove)
->
@@ -1183,7 +1183,7 @@
get_unused_arg_nos(_, [], _, []).
get_unused_arg_nos(LocalVars, [HeadVar | HeadVars], ArgNo, UnusedArgs) :-
- NextArg is ArgNo + 1,
+ NextArg = ArgNo + 1,
(
map__contains(LocalVars, HeadVar)
->
@@ -1579,7 +1579,7 @@
string__sub_string_search(Name, "__ho",
Position),
string__length(Name, Length),
- IdLen is Length - Position - 4,
+ IdLen = Length - Position - 4,
string__right(Name, IdLen, Id),
string__to_int(Id, _)
)
@@ -1647,7 +1647,7 @@
% Strip off the extra type_info arguments
% inserted at the front by polymorphism.m
pred_info_arity(PredInfo, Arity),
- NumToDrop is NumHeadVars - Arity,
+ NumToDrop = NumHeadVars - Arity,
adjust_unused_args(NumToDrop,
UnusedArgs0, UnusedArgs)
},
@@ -1701,10 +1701,8 @@
adjust_unused_args(_, [], []).
adjust_unused_args(NumToDrop, [UnusedArgNo | UnusedArgNos0], AdjUnusedArgs) :-
- NewArg is UnusedArgNo - NumToDrop,
- (
- NewArg < 1
- ->
+ NewArg = UnusedArgNo - NumToDrop,
+ ( NewArg < 1 ->
AdjUnusedArgs = AdjUnusedArgs1
;
AdjUnusedArgs = [NewArg | AdjUnusedArgs1]
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
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/graphics
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/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/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/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/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.121
diff -u -b -r1.121 array.m
--- library/array.m 9 May 2003 09:10:34 -0000 1.121
+++ library/array.m 13 May 2003 00:53:05 -0000
@@ -1283,7 +1283,7 @@
;
% Otherwise find the middle element of the range
% and check against that.
- Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
+ Mid = (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
array__lookup(Array, Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
Index: library/bag.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bag.m,v
retrieving revision 1.21
diff -u -b -r1.21 bag.m
--- library/bag.m 12 Nov 2000 08:51:32 -0000 1.21
+++ library/bag.m 26 Nov 2002 10:50:43 -0000
@@ -243,10 +243,8 @@
%---------------------------------------------------------------------------%
bag__insert(Bag0, Item, Bag) :-
- (
- map__search(Bag0, Item, Count0)
- ->
- Count is Count0 + 1
+ ( map__search(Bag0, Item, Count0) ->
+ Count = Count0 + 1
;
Count = 1
),
@@ -275,7 +273,7 @@
( Int =< 0 ->
bag__to_list_2(Xs, Out)
;
- NewInt is Int - 1,
+ NewInt = Int - 1,
bag__to_list_2([X - NewInt | Xs], Out0),
Out = [X | Out0]
).
@@ -300,7 +298,7 @@
(
Count0 > 1
->
- Count is Count0 - 1,
+ Count = Count0 - 1,
map__set(Bag0, Item, Count, Bag)
;
map__delete(Bag0, Item, Bag)
@@ -367,7 +365,7 @@
bag__union(A, B, Out) :-
( map__remove_smallest(B, Key, BVal, B0) ->
( map__search(A, Key, AVal) ->
- NewVal is AVal + BVal,
+ NewVal = AVal + BVal,
map__det_update(A, Key, NewVal, A0)
;
map__det_insert(A, Key, BVal, A0)
Index: library/bintree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bintree.m,v
retrieving revision 1.43
diff -u -b -r1.43 bintree.m
--- library/bintree.m 19 Aug 2002 06:33:16 -0000 1.43
+++ library/bintree.m 26 Nov 2002 09:37:34 -0000
@@ -377,7 +377,7 @@
bintree__right_depth(empty, 0).
bintree__right_depth(tree(_K, _V, _Left, Right), N) :-
bintree__right_depth(Right, M),
- N is M + 1.
+ N = M + 1.
:- pred bintree__left_depth(bintree(_K,_V), int).
:- mode bintree__left_depth(in, out) is det.
@@ -385,7 +385,7 @@
bintree__left_depth(empty, 0).
bintree__left_depth(tree(_K, _V, Left, _Right), N) :-
bintree__left_depth(Left, M),
- N is M + 1.
+ N = M + 1.
:- pred bintree__knock_left(bintree(K,V), K, V, bintree(K, V)).
:- mode bintree__knock_left(in, out, out, out) is det.
@@ -454,9 +454,9 @@
List = List0,
Tree = empty
;
- Num1 is Num - 1,
- SmallHalf is Num1 // 2,
- BigHalf is Num1 - SmallHalf,
+ Num1 = Num - 1,
+ SmallHalf = Num1 // 2,
+ BigHalf = Num1 - SmallHalf,
bintree__from_sorted_list_2(SmallHalf, List0, LeftSubTree,
List1),
( List1 = [HeadKey - HeadValue | List2] ->
@@ -542,15 +542,15 @@
bintree__count(tree(_K, _V, Left, Right), Count) :-
bintree__count(Right, RightCount),
bintree__count(Left, LeftCount),
- ChildCount is LeftCount + RightCount,
- Count is ChildCount + 1.
+ ChildCount = LeftCount + RightCount,
+ Count = ChildCount + 1.
bintree__depth(empty, 0).
bintree__depth(tree(_K, _V, Left, Right), Depth) :-
bintree__depth(Right, RightDepth),
bintree__depth(Left, LeftDepth),
int__max(LeftDepth, RightDepth, SubDepth),
- Depth is SubDepth + 1.
+ Depth = SubDepth + 1.
bintree__branching_factor(empty, 0, 0).
bintree__branching_factor(tree(_K, _V, L, R), Ones, Twos) :-
@@ -564,20 +564,20 @@
Twos = 0
;
bintree__branching_factor(R, Ones0, Twos),
- Ones is Ones0 + 1
+ Ones = Ones0 + 1
)
;
(
R = empty
->
bintree__branching_factor(L, Ones0, Twos),
- Ones is Ones0 + 1
+ Ones = Ones0 + 1
;
bintree__branching_factor(L, Ones1, Twos1),
bintree__branching_factor(R, Ones2, Twos2),
- Ones is Ones1 + Ones2,
- Twos0 is Twos1 + Twos2,
- Twos is Twos0 + 1
+ Ones = Ones1 + Ones2,
+ Twos0 = Twos1 + Twos2,
+ Twos = Twos0 + 1
)
).
Index: library/bt_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bt_array.m,v
retrieving revision 1.10
diff -u -b -r1.10 bt_array.m
--- library/bt_array.m 16 Sep 2002 06:07:44 -0000 1.10
+++ library/bt_array.m 26 Nov 2002 10:50:54 -0000
@@ -192,12 +192,12 @@
%-----------------------------------------------------------------------------%
bt_array__make_empty_array(Low, bt_array(Low, High, ListOut)) :-
- High is Low - 1,
+ High = Low - 1,
ra_list_nil(ListOut).
bt_array__init(Low, High, Item, bt_array(Low, High, ListOut)) :-
ra_list_nil(ListIn),
- ElemsToAdd is High - Low + 1,
+ ElemsToAdd = High - Low + 1,
bt_array__add_elements(ElemsToAdd, Item, ListIn, ListOut).
:- pred bt_array__add_elements(int, T, ra_list(T), ra_list(T)).
@@ -208,7 +208,7 @@
RaList0 = RaList
;
ra_list_cons(Item, RaList0, RaList1),
- ElemsToAdd1 is ElemsToAdd - 1,
+ ElemsToAdd1 = ElemsToAdd - 1,
bt_array__add_elements(ElemsToAdd1, Item, RaList1, RaList)
).
@@ -219,7 +219,7 @@
bt_array__max(bt_array(_, High, _), High).
bt_array__size(bt_array(Low, High, _), Size) :-
- Size is High - Low + 1.
+ Size = High - Low + 1.
bt_array__bounds(bt_array(Low, High, _), Low, High).
@@ -233,7 +233,7 @@
:- mode actual_position(in, in, in, out) is det.
actual_position(Low, High, Index, Pos) :-
- Pos is High - Low - Index.
+ Pos = High - Low - Index.
bt_array__lookup(bt_array(Low, High, RaList), Index, Item) :-
actual_position(Low, High, Index, Pos),
@@ -270,7 +270,7 @@
% the same.
( H < H0 ->
- SizeDiff is H0 - H,
+ SizeDiff = H0 - H,
( ra_list_drop(SizeDiff, RaList0, RaList1) ->
RaList = RaList1
;
@@ -278,7 +278,7 @@
),
Array = bt_array(L, H, RaList)
; H > H0 ->
- SizeDiff is H - H0,
+ SizeDiff = H - H0,
bt_array__add_elements(SizeDiff, Item, RaList0, RaList),
Array = bt_array(L, H, RaList)
;
@@ -300,7 +300,7 @@
% Optimise the common case where the lower bounds are
% the same.
- SizeDiff is H0 - H,
+ SizeDiff = H0 - H,
( ra_list_drop(SizeDiff, RaList0, RaList1) ->
RaList = RaList1
;
@@ -324,7 +324,7 @@
bt_array__from_list(Low, List, bt_array(Low, High, RaList)) :-
list__length(List, Len),
- High is Low + Len - 1,
+ High = Low + Len - 1,
ra_list_nil(RaList0),
bt_array__reverse_into_ra_list(List, RaList0, RaList).
@@ -344,7 +344,7 @@
bt_array__insert_items(Array, _N, [], Array).
bt_array__insert_items(Array0, N, [Head|Tail], Array) :-
bt_array__set(Array0, N, Head, Array1),
- N1 is N + 1,
+ N1 = N + 1,
bt_array__insert_items(Array1, N1, Tail, Array).
%-----------------------------------------------------------------------------%
@@ -372,7 +372,7 @@
;
actual_position(ALow, AHigh, High, Drop),
ra_list_drop(Drop, RaList0, RaList),
- Take is High - Low + 1,
+ Take = High - Low + 1,
bt_array__reverse_from_ra_list_count(Take, RaList, [], List0)
->
List = List0
@@ -388,7 +388,7 @@
ra_list_head_tail(RaList0, X, RaList1),
I >= 0
->
- I1 is I - 1,
+ I1 = I - 1,
bt_array__reverse_from_ra_list_count(I1, RaList1, [X | Xs0], Xs)
;
Xs0 = Xs
@@ -408,7 +408,7 @@
:- mode bt_array__bsearch_2(in, in, in, in, pred(in, in, out) is det,
out) is semidet.
bt_array__bsearch_2(A, Lo, Hi, El, Compare, I) :-
- Width is Hi - Lo,
+ Width = Hi - Lo,
% If Width < 0, there is no range left.
Width >= 0,
@@ -430,16 +430,16 @@
% 2. Until such time as we implement strength
% reduction, the >> 1 stays.
- Mid is (Lo + Hi) >> 1,
+ Mid = (Lo + Hi) >> 1,
bt_array__lookup(A, Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
- Mid1 is Mid + 1,
+ Mid1 = Mid + 1,
bt_array__bsearch_2(A, Mid1, Hi, El, Compare, I)
; Comp = (=),
bt_array__bsearch_2(A, Lo, Mid, El, Compare, I)
; Comp = (>),
- Mid1 is Mid - 1,
+ Mid1 = Mid - 1,
bt_array__bsearch_2(A, Lo, Mid1, El, Compare, I)
)
).
@@ -522,7 +522,7 @@
List0 = cons(Size1, T1, cons(Size2, T2, Rest)),
Size1 = Size2
->
- NewSize is 1 + Size1 + Size2,
+ NewSize = 1 + Size1 + Size2,
List = cons(NewSize, node(X, T1, T2), Rest)
;
List = cons(1, leaf(X), List0)
@@ -562,7 +562,7 @@
( I < Size ->
ra_list_bintree_lookup(Size, T, I, X)
;
- NewI is I - Size,
+ NewI = I - Size,
ra_list_lookup_2(NewI, Rest, X)
).
@@ -576,10 +576,10 @@
;
Size2 = Size // 2,
( I =< Size2 ->
- NewI is I - 1,
+ NewI = I - 1,
ra_list_bintree_lookup(Size2, T1, NewI, X)
;
- NewI is I - 1 - Size2,
+ NewI = I - 1 - Size2,
ra_list_bintree_lookup(Size2, T2, NewI, X)
)
).
@@ -600,7 +600,7 @@
ra_list_bintree_update(Size, T0, I, X, T),
List = cons(Size, T, Rest)
;
- NewI is I - Size,
+ NewI = I - Size,
ra_list_update_2(Rest, NewI, X, List0),
List = cons(Size, T0, List0)
).
@@ -616,11 +616,11 @@
;
Size2 = Size // 2,
( I =< Size2 ->
- NewI is I - 1,
+ NewI = I - 1,
ra_list_bintree_update(Size2, T1, NewI, X, T0),
T = node(X0, T0, T2)
;
- NewI is I - 1 - Size2,
+ NewI = I - 1 - Size2,
ra_list_bintree_update(Size2, T2, NewI, X, T0),
T = node(X0, T1, T0)
)
@@ -634,7 +634,7 @@
->
As = cons(Size, _, Cs),
( Size < N ->
- N1 is N - Size,
+ N1 = N - Size,
ra_list_drop(N1, Cs, Bs)
;
ra_list_slow_drop(N, As, Bs)
@@ -650,7 +650,7 @@
(
N > 0
->
- N1 is N - 1,
+ N1 = N - 1,
ra_list_tail(As, Cs),
ra_list_slow_drop(N1, Cs, Bs)
;
Index: library/dir.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/dir.m,v
retrieving revision 1.15
diff -u -b -r1.15 dir.m
--- library/dir.m 7 May 2003 06:42:42 -0000 1.15
+++ library/dir.m 8 May 2003 03:49:06 -0000
@@ -84,7 +84,7 @@
is det.
dir__split_name_2(FileName, N, DirName, BaseName) :-
- N1 is N - 1,
+ N1 = N - 1,
(
N1 < 0
->
Index: library/eqvclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/eqvclass.m,v
retrieving revision 1.11
diff -u -b -r1.11 eqvclass.m
--- library/eqvclass.m 12 Nov 2000 08:51:33 -0000 1.11
+++ library/eqvclass.m 26 Nov 2002 09:45:39 -0000
@@ -159,7 +159,7 @@
eqvclass__add_element(EqvClass0, Element, Id, EqvClass) :-
EqvClass0 = eqvclass(NextId0, PartitionMap0, ElementMap0),
Id = NextId0,
- NextId is NextId0 + 1,
+ NextId = NextId0 + 1,
map__det_insert(ElementMap0, Element, Id, ElementMap),
set__singleton_set(Partition, Element),
map__det_insert(PartitionMap0, NextId0, Partition, PartitionMap),
@@ -299,7 +299,7 @@
PartitionMap0 = PartitionMap
;
Id = NextId0,
- NextId is NextId0 + 1,
+ NextId = NextId0 + 1,
eqvclass__make_partition(Elements, Id, ElementMap0, ElementMap),
map__det_insert(PartitionMap0, Id, Partition, PartitionMap)
),
Index: library/graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/graph.m,v
retrieving revision 1.21
diff -u -b -r1.21 graph.m
--- library/graph.m 12 Nov 2000 08:51:34 -0000 1.21
+++ library/graph.m 26 Nov 2002 09:46:18 -0000
@@ -195,7 +195,7 @@
graph__set_node(G0, NInfo, node(N), G) :-
graph__get_node_supply(G0, NS0),
- NS is NS0 + 1,
+ NS = NS0 + 1,
N = NS,
graph__set_node_supply(G0, NS, G1),
@@ -225,7 +225,7 @@
\+ map__member(Nodes0, _, NInfo),
graph__get_node_supply(G0, NS0),
- NS is NS0 + 1,
+ NS = NS0 + 1,
N = NS,
graph__set_node_supply(G0, NS, G1),
@@ -285,7 +285,7 @@
graph__set_edge(G0, Start, End, Info, Arc, G) :-
graph__get_arc_supply(G0, AS0),
- AS is AS0 + 1,
+ AS = AS0 + 1,
Arc = arc(AS),
graph__set_arc_supply(G0, AS, G1),
@@ -313,7 +313,7 @@
graph__insert_edge(G0, Start, End, Info, Arc, G) :-
graph__get_arc_supply(G0, AS0),
- AS is AS0 + 1,
+ AS = AS0 + 1,
Arc = arc(AS),
graph__set_arc_supply(G0, AS, G1),
Index: library/group.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/group.m,v
retrieving revision 1.19
diff -u -b -r1.19 group.m
--- library/group.m 12 Nov 2000 08:51:34 -0000 1.19
+++ library/group.m 26 Nov 2002 09:46:29 -0000
@@ -120,7 +120,7 @@
group__insert(G0, S, G) :-
group__get_group_count(G0, C0),
- C is C0 + 1,
+ C = C0 + 1,
group__get_sets(G0, Ss0),
map__set(Ss0, C, S, Ss),
group__get_elements(G0, Es0),
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.296
diff -u -b -r1.296 io.m
--- library/io.m 20 May 2003 03:18:09 -0000 1.296
+++ library/io.m 22 May 2003 18:57:57 -0000
@@ -1781,7 +1781,7 @@
%
io__stream_file_size(Stream, FileSize),
{ FileSize >= 0 ->
- BufferSize0 is FileSize + 1
+ BufferSize0 = FileSize + 1
;
BufferSize0 = 4000
},
@@ -1821,7 +1821,7 @@
{ Buffer = Buffer1 }
; { Pos1 = Size0 } ->
% full buffer
- { Size1 is Size0 * 2 },
+ { Size1 = Size0 * 2 },
{ io__resize_buffer(Buffer1, Size0, Size1, Buffer2) },
io__read_file_as_string_2(Stream, Buffer2, Pos1, Size1,
Buffer, Pos, Size)
Index: library/lexer.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/lexer.m,v
retrieving revision 1.37
diff -u -b -r1.37 lexer.m
--- library/lexer.m 15 Feb 2003 21:56:53 -0000 1.37
+++ library/lexer.m 31 Mar 2003 05:51:32 -0000
@@ -251,9 +251,9 @@
Posn0 = posn(LineNum0, LineOffset0, Offset0),
Offset0 < Len,
string__unsafe_index(String, Offset0, Char),
- Offset is Offset0 + 1,
+ Offset = Offset0 + 1,
( Char = '\n' ->
- LineNum is LineNum0 + 1,
+ LineNum = LineNum0 + 1,
Posn = posn(LineNum, Offset, Offset)
;
Posn = posn(LineNum0, LineOffset0, Offset)
@@ -264,10 +264,10 @@
lexer__string_ungetchar(String, Posn0, Posn) :-
Posn0 = posn(LineNum0, LineOffset0, Offset0),
- Offset is Offset0 - 1,
+ Offset = Offset0 - 1,
string__unsafe_index(String, Offset, Char),
( Char = '\n' ->
- LineNum is LineNum0 - 1,
+ LineNum = LineNum0 - 1,
Posn = posn(LineNum, Offset, Offset)
;
Posn = posn(LineNum0, LineOffset0, Offset)
@@ -279,7 +279,7 @@
lexer__grab_string(String, Posn0, SubString, Posn, Posn) :-
Posn0 = posn(_, _, Offset0),
Posn = posn(_, _, Offset),
- Count is Offset - Offset0,
+ Count = Offset - Offset0,
string__unsafe_substring(String, Offset0, Count, SubString).
:- pred lexer__string_set_line_number(int, posn, posn).
Index: library/multi_map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/multi_map.m,v
retrieving revision 1.9
diff -u -b -r1.9 multi_map.m
--- library/multi_map.m 20 Aug 2002 00:44:15 -0000 1.9
+++ library/multi_map.m 26 Nov 2002 09:46:43 -0000
@@ -298,7 +298,7 @@
multi_map__count_list([], X, X).
multi_map__count_list([_A|As], Count0, Count) :-
- Count1 is Count0 + 1,
+ Count1 = Count0 + 1,
multi_map__count_list(As, Count1, Count).
%-----------------------------------------------------------------------------%
Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.41
diff -u -b -r1.41 parser.m
--- library/parser.m 15 Mar 2003 07:11:34 -0000 1.41
+++ library/parser.m 31 Mar 2003 05:51:32 -0000
@@ -337,7 +337,7 @@
parser__get_token(integer(X), _IntContext)
->
parser__get_term_context(Context, TermContext),
- { NegX is 0 - X },
+ { NegX = 0 - X },
{ Term = ok(term__functor(term__integer(NegX), [],
TermContext)) },
{ OpPriority = 0 }
@@ -347,7 +347,7 @@
parser__get_token(float(F), _FloatContext)
->
parser__get_term_context(Context, TermContext),
- { NegF is 0.0 - F },
+ { NegF = 0.0 - F },
{ Term = ok(term__functor(term__float(NegF), [],
TermContext)) },
{ OpPriority = 0 }
@@ -1014,7 +1014,7 @@
parser__adjust_priority(y, Priority, Priority).
parser__adjust_priority(x, OldPriority, NewPriority) :-
- NewPriority is OldPriority - 1.
+ NewPriority = OldPriority - 1.
:- pred parser__check_priority(ops__assoc, int, int).
:- mode parser__check_priority(in, in, in) is semidet.
Index: library/pqueue.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/pqueue.m,v
retrieving revision 1.13
diff -u -b -r1.13 pqueue.m
--- library/pqueue.m 12 Nov 2000 08:51:35 -0000 1.13
+++ library/pqueue.m 26 Nov 2002 09:47:07 -0000
@@ -77,7 +77,7 @@
pqueue__insert(empty, K, V, pqueue(0, K, V, empty, empty)).
pqueue__insert(pqueue(D0, K0, V0, L0, R0), K, V, PQ) :-
- D is D0 + 1,
+ D = D0 + 1,
compare(CMP, K, K0),
(
CMP = (<)
@@ -130,12 +130,12 @@
(
CMP = (<)
->
- D0M1 is D0 - 1,
+ D0M1 = D0 - 1,
int__max(D0M1, D1, D),
pqueue__remove_2(L0, R0, PQ0),
PQ = pqueue(D, K0, V0, PQ0, pqueue(D1, K1, V1, L1, R1))
;
- D1M1 is D0 - 1,
+ D1M1 = D0 - 1,
int__max(D1M1, D1, D),
pqueue__remove_2(L1, R1, PQ1),
PQ = pqueue(D, K1, V1, PQ1, pqueue(D0, K0, V0, L0, R0))
Index: library/queue.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/queue.m,v
retrieving revision 1.22
diff -u -b -r1.22 queue.m
--- library/queue.m 12 Nov 2000 08:51:35 -0000 1.22
+++ library/queue.m 26 Nov 2002 09:47:19 -0000
@@ -172,7 +172,7 @@
queue__length(On - Off, Length) :-
list__length(On, LengthOn),
list__length(Off, LengthOff),
- Length is LengthOn + LengthOff.
+ Length = LengthOn + LengthOff.
queue__list_to_queue(List, [] - List).
Index: library/rational.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rational.m,v
retrieving revision 1.4
diff -u -b -r1.4 rational.m
--- library/rational.m 29 Aug 2002 10:09:07 -0000 1.4
+++ library/rational.m 25 Nov 2002 16:38:31 -0000
@@ -117,7 +117,7 @@
rational:'-'(r(Num, Den)) = r(-Num, Den).
rational:'+'(r(An, Ad), r(Bn, Bd)) = rational_norm(Numer, M) :-
- Numer is An * CA + Bn * CB,
+ Numer = An * CA + Bn * CB,
M = lcm(Ad, Bd),
CA = M // Ad,
CB = M // Bd.
@@ -127,8 +127,8 @@
% XXX: need we call rational_norm here?
rational:'*'(r(An, Ad), r(Bn, Bd)) = rational_norm(Numer, Denom) :-
- Numer is (An//G1) * (Bn//G2),
- Denom is (Ad//G2) * (Bd//G1),
+ Numer = (An//G1) * (Bn//G2),
+ Denom = (Ad//G2) * (Bd//G1),
G1 = gcd(An, Bd),
G2 = gcd(Ad, Bn).
Index: library/rbtree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rbtree.m,v
retrieving revision 1.14
diff -u -b -r1.14 rbtree.m
--- library/rbtree.m 12 Nov 2000 08:51:35 -0000 1.14
+++ library/rbtree.m 26 Nov 2002 09:47:37 -0000
@@ -965,11 +965,11 @@
rbtree__count(red(_K, _V, L, R), N) :-
rbtree__count(L, NO),
rbtree__count(R, N1),
- N is 1 + NO + N1.
+ N = 1 + NO + N1.
rbtree__count(black(_K, _V, L, R), N) :-
rbtree__count(L, NO),
rbtree__count(R, N1),
- N is 1 + NO + N1.
+ N = 1 + NO + N1.
%-----------------------------------------------------------------------------%
Index: library/relation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/relation.m,v
retrieving revision 1.26
diff -u -b -r1.26 relation.m
--- library/relation.m 15 Feb 2002 08:23:54 -0000 1.26
+++ library/relation.m 26 Nov 2002 09:47:48 -0000
@@ -345,7 +345,7 @@
Key = Key0, NewKey = NewKey0, ElMap = ElMap0
;
NewKey = Key0,
- Key is Key0 + 1,
+ Key = Key0 + 1,
bimap__set(ElMap0, Elem, NewKey, ElMap)
).
Index: library/set_bbbtree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/set_bbbtree.m,v
retrieving revision 1.18
diff -u -b -r1.18 set_bbbtree.m
--- library/set_bbbtree.m 19 Feb 2002 09:25:28 -0000 1.18
+++ library/set_bbbtree.m 26 Nov 2002 09:49:08 -0000
@@ -511,13 +511,13 @@
% delete X from left subtree
Result = (<),
set_bbbtree__delete(L, X, NewL), % X in left tree
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, NewL, R)
;
% delete X from right subtree
Result = (>),
set_bbbtree__delete(R, X, NewR), % X in right tree
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, L, NewR)
;
% found X so just concatenate its two subtrees together
@@ -565,13 +565,13 @@
% remove X from left subtree
Result = (<),
set_bbbtree__remove(L, X, NewL), % X in left tree
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, NewL, R)
;
% remove X from right subtree
Result = (>),
set_bbbtree__remove(R, X, NewR), % X in right tree
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, L, NewR)
;
% found X so just concatenate its two subtrees together
@@ -604,7 +604,7 @@
% search further in the left subtree
L = tree(_V, _N, _L, _R),
set_bbbtree__remove_least(L, X, NewL),
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, NewL, R)
).
@@ -625,7 +625,7 @@
% search further in the right subtree
R = tree(_V, _N, _L, _R),
set_bbbtree__remove_largest(R, X, NewR),
- NewN is N - 1,
+ NewN = N - 1,
Set = tree(V, NewN, L, NewR)
).
@@ -685,8 +685,8 @@
(
N > 3
->
- NL is N//2,
- NR is N - NL - 1,
+ NL = N//2,
+ NR = N - NL - 1,
set_bbbtree__sorted_list_to_set_len2(List, RestOfList0, NL, L),
(
RestOfList0 = [V | RestOfList1],
@@ -963,7 +963,7 @@
set_bbbtree__build_node(X, L, R, Tree) :-
set_bbbtree__size(L, LSize),
set_bbbtree__size(R, RSize),
- N is 1 + LSize + RSize,
+ N = 1 + LSize + RSize,
Tree0 = tree(X, N, L, R),
unsafe_promise_unique(Tree0, Tree).
@@ -1077,13 +1077,13 @@
set_bbbtree__size(L, LSize),
set_bbbtree__size(R, RSize),
(
- Val is LSize + RSize,
+ Val = LSize + RSize,
Val < 2
->
% The two trees are too small to bother rebalancing
set_bbbtree__build_node(V, L, R, Set)
;
- Val is Ratio * LSize,
+ Val = Ratio * LSize,
RSize > Val
->
(
@@ -1103,7 +1103,7 @@
error("set_bbbtree__balance.1")
)
;
- Val is Ratio * RSize,
+ Val = Ratio * RSize,
LSize > Val
->
(
@@ -1207,14 +1207,14 @@
;
R = tree(RV, RN, RL, RR),
(
- Val is Ratio * LN, % Right too big
+ Val = Ratio * LN, % Right too big
Val < RN
->
set_bbbtree__concat4(tree(LV,LN,LL,LR), RL, V,
NewL, Ratio),
set_bbbtree__balance(RV, NewL, RR, Set, Ratio)
;
- Val is Ratio * RN, % Left too big
+ Val = Ratio * RN, % Left too big
Val < LN
->
set_bbbtree__concat4(LR, tree(RV,RN,RL,RR), V,
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.200
diff -u -b -r1.200 string.m
--- library/string.m 20 May 2003 12:29:53 -0000 1.200
+++ library/string.m 22 May 2003 18:57:58 -0000
@@ -781,7 +781,7 @@
string__right(String, RightCount, RightString) :-
string__length(String, Length),
- LeftCount is Length - RightCount,
+ LeftCount = Length - RightCount,
string__split(String, LeftCount, _LeftString, RightString).
string__remove_suffix(A, B, C) :-
@@ -888,7 +888,7 @@
string__int_to_base_string_2(N, Base, Str1),
string__append("-", Str1, Str)
;
- N1 is 0 - N,
+ N1 = 0 - N,
string__int_to_base_string_2(N1, Base, Str)
).
@@ -899,12 +899,12 @@
(
NegN > -Base
->
- N is -NegN,
+ N = -NegN,
char__det_int_to_digit(N, DigitChar),
string__char_to_string(DigitChar, Str)
;
- NegN1 is NegN // Base,
- N10 is (NegN1 * Base) - NegN,
+ NegN1 = NegN // Base,
+ N10 = (NegN1 * Base) - NegN,
char__det_int_to_digit(N10, DigitChar),
string__char_to_string(DigitChar, DigitString),
string__int_to_base_string_2(NegN1, Base, Str1),
@@ -1133,7 +1133,7 @@
string__pad_left(String0, PadChar, Width, String) :-
string__length(String0, Length),
( Length < Width ->
- Count is Width - Length,
+ Count = Width - Length,
string__duplicate_char(PadChar, Count, PadString),
string__append(PadString, String0, String)
;
@@ -1143,7 +1143,7 @@
string__pad_right(String0, PadChar, Width, String) :-
string__length(String0, Length),
( Length < Width ->
- Count is Width - Length,
+ Count = Width - Length,
string__duplicate_char(PadChar, Count, PadString),
string__append(String0, PadString, String)
;
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.101
diff -u -b -r1.101 term.m
--- library/term.m 9 Jul 2002 01:30:24 -0000 1.101
+++ library/term.m 26 Nov 2002 09:42:48 -0000
@@ -1077,7 +1077,7 @@
% We number variables using sequential numbers,
term__create_var(var_supply(V0), var(V), var_supply(V)) :-
- V is V0 + 1.
+ V = V0 + 1.
%------------------------------------------------------------------------------%
Index: library/term_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.66
diff -u -b -r1.66 term_io.m
--- library/term_io.m 17 Jan 2003 05:56:50 -0000 1.66
+++ library/term_io.m 31 Mar 2003 05:51:33 -0000
@@ -221,7 +221,7 @@
{ string__int_to_string(VarNum, Num) },
{ string__append("_", Num, VarName) },
{ varset__name_var(VarSet0, Id, VarName, VarSet) },
- { N is N0 + 1 },
+ { N = N0 + 1 },
io__write_string(VarName)
).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.36
diff -u -b -r1.36 tree234.m
--- library/tree234.m 19 Aug 2002 06:33:17 -0000 1.36
+++ library/tree234.m 26 Nov 2002 03:09:31 -0000
@@ -2497,18 +2497,18 @@
tree234__count(two(_, _, T0, T1), N) :-
tree234__count(T0, N0),
tree234__count(T1, N1),
- N is 1 + N0 + N1.
+ N = 1 + N0 + N1.
tree234__count(three(_, _, _, _, T0, T1, T2), N) :-
tree234__count(T0, N0),
tree234__count(T1, N1),
tree234__count(T2, N2),
- N is 2 + N0 + N1 + N2.
+ N = 2 + N0 + N1 + N2.
tree234__count(four(_, _, _, _, _, _, T0, T1, T2, T3), N) :-
tree234__count(T0, N0),
tree234__count(T1, N1),
tree234__count(T2, N2),
tree234__count(T3, N3),
- N is 3 + N0 + N1 + N2 + N3.
+ N = 3 + N0 + N1 + N2 + N3.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/varset.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.67
diff -u -b -r1.67 varset.m
--- library/varset.m 7 Apr 2003 11:28:28 -0000 1.67
+++ library/varset.m 7 May 2003 01:18:00 -0000
@@ -293,7 +293,7 @@
(
NumVars > 0
->
- NumVars1 is NumVars - 1,
+ NumVars1 = NumVars - 1,
varset__new_var(Varset0, Var, Varset1),
varset__new_vars_2(Varset1, NumVars1, [Var | NewVars0],
NewVars, Varset)
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 tests
cvs diff: Diffing tests/benchmarks
Index: tests/benchmarks/cqueens.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/cqueens.m,v
retrieving revision 1.6
diff -u -b -r1.6 cqueens.m
--- tests/benchmarks/cqueens.m 6 Sep 2002 06:01:57 -0000 1.6
+++ tests/benchmarks/cqueens.m 27 Nov 2002 15:05:41 -0000
@@ -14,6 +14,8 @@
:- implementation.
+:- import_module prolog.
+
main1(Out) :-
data(Data),
queen(Data, Out).
Index: tests/benchmarks/crypt.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/crypt.m,v
retrieving revision 1.7
diff -u -b -r1.7 crypt.m
--- tests/benchmarks/crypt.m 6 Sep 2002 06:01:58 -0000 1.7
+++ tests/benchmarks/crypt.m 27 Nov 2002 15:05:11 -0000
@@ -29,7 +29,7 @@
:- implementation.
-:- import_module require.
+:- import_module prolog, require.
main1(Out) :-
crypt(Out).
Index: tests/benchmarks/deriv.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/deriv.m,v
retrieving revision 1.4
diff -u -b -r1.4 deriv.m
--- tests/benchmarks/deriv.m 4 Sep 2000 04:48:43 -0000 1.4
+++ tests/benchmarks/deriv.m 27 Nov 2002 15:05:59 -0000
@@ -33,6 +33,8 @@
:- implementation.
+:- import_module prolog.
+
main -->
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
Index: tests/benchmarks/deriv2.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/deriv2.m,v
retrieving revision 1.4
diff -u -b -r1.4 deriv2.m
--- tests/benchmarks/deriv2.m 4 Sep 2000 04:48:43 -0000 1.4
+++ tests/benchmarks/deriv2.m 27 Nov 2002 15:06:09 -0000
@@ -33,6 +33,8 @@
:- implementation.
+:- import_module prolog.
+
main -->
( { main4(E1, E2, E3, E4) } ->
print_expr(E1),
Index: tests/benchmarks/poly.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/poly.m,v
retrieving revision 1.3
diff -u -b -r1.3 poly.m
--- tests/benchmarks/poly.m 15 Mar 2002 07:28:30 -0000 1.3
+++ tests/benchmarks/poly.m 27 Nov 2002 15:06:31 -0000
@@ -26,6 +26,8 @@
:- implementation.
+:- import_module prolog.
+
main --> main3(_).
main3(Out) -->
Index: tests/benchmarks/primes.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/primes.m,v
retrieving revision 1.4
diff -u -b -r1.4 primes.m
--- tests/benchmarks/primes.m 6 Sep 2002 06:01:58 -0000 1.4
+++ tests/benchmarks/primes.m 27 Nov 2002 15:06:53 -0000
@@ -2,12 +2,14 @@
:- interface.
-:- import_module list, int, io.
+:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
+
+:- import_module int, list, prolog.
main --> main3(_).
Index: tests/benchmarks/queens.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/queens.m,v
retrieving revision 1.6
diff -u -b -r1.6 queens.m
--- tests/benchmarks/queens.m 6 Sep 2002 06:01:58 -0000 1.6
+++ tests/benchmarks/queens.m 27 Nov 2002 15:07:02 -0000
@@ -14,6 +14,8 @@
:- implementation.
+:- import_module prolog.
+
main1(Out) :-
data(Data),
queen(Data, Out).
Index: tests/benchmarks/query.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/query.m,v
retrieving revision 1.5
diff -u -b -r1.5 query.m
--- tests/benchmarks/query.m 6 Sep 2002 06:01:58 -0000 1.5
+++ tests/benchmarks/query.m 27 Nov 2002 15:07:21 -0000
@@ -16,7 +16,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
:- type quad ---> quad(string, int, string, int).
Index: tests/benchmarks/tak.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/tak.m,v
retrieving revision 1.3
diff -u -b -r1.3 tak.m
--- tests/benchmarks/tak.m 6 Sep 2002 06:01:58 -0000 1.3
+++ tests/benchmarks/tak.m 27 Nov 2002 15:07:39 -0000
@@ -9,7 +9,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
main -->
{ main1(Out) },
cvs diff: Diffing tests/debugger
Index: tests/debugger/breakpoints.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/breakpoints.m,v
retrieving revision 1.3
diff -u -b -r1.3 breakpoints.m
--- tests/debugger/breakpoints.m 11 Feb 2002 12:52:54 -0000 1.3
+++ tests/debugger/breakpoints.m 27 Nov 2002 15:08:30 -0000
@@ -64,8 +64,8 @@
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
- NmB is N - B,
- BmN is B - N,
+ NmB = N - B,
+ BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
@@ -73,7 +73,7 @@
;
true
),
- D1 is D + 1,
+ D1 = D + 1,
nodiag(B, D1, L).
X / _ = X.
Index: tests/debugger/nondet_stack.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/nondet_stack.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondet_stack.m
--- tests/debugger/nondet_stack.m 4 Dec 2001 00:44:38 -0000 1.1
+++ tests/debugger/nondet_stack.m 27 Nov 2002 15:08:40 -0000
@@ -74,8 +74,8 @@
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
- NmB is N - B,
- BmN is B - N,
+ NmB = N - B,
+ BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
@@ -83,7 +83,7 @@
;
true
),
- D1 is D + 1,
+ D1 = D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
Index: tests/debugger/queens.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/queens.m,v
retrieving revision 1.4
diff -u -b -r1.4 queens.m
--- tests/debugger/queens.m 29 Jan 2001 15:38:55 -0000 1.4
+++ tests/debugger/queens.m 25 Nov 2002 20:51:42 -0000
@@ -59,8 +59,8 @@
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
- NmB is N - B,
- BmN is B - N,
+ NmB = N - B,
+ BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
@@ -68,7 +68,7 @@
;
true
),
- D1 is D + 1,
+ D1 = D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
Index: tests/debugger/queens_rep.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/queens_rep.m,v
retrieving revision 1.1
diff -u -b -r1.1 queens_rep.m
--- tests/debugger/queens_rep.m 3 Apr 2002 07:08:22 -0000 1.1
+++ tests/debugger/queens_rep.m 27 Nov 2002 15:08:53 -0000
@@ -59,8 +59,8 @@
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
- NmB is N - B,
- BmN is B - N,
+ NmB = N - B,
+ BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
@@ -68,7 +68,7 @@
;
true
),
- D1 is D + 1,
+ D1 = D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
Index: tests/debugger/retry.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/retry.m,v
retrieving revision 1.2
diff -u -b -r1.2 retry.m
--- tests/debugger/retry.m 16 Oct 2000 02:09:46 -0000 1.2
+++ tests/debugger/retry.m 27 Nov 2002 15:08:59 -0000
@@ -117,7 +117,7 @@
;
fib(N - 1, F1),
fib(N - 2, F2),
- F is F1 + F2
+ F = F1 + F2
).
%---------------------------------------------------------------------------%
Index: tests/debugger/shallow2.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/shallow2.m,v
retrieving revision 1.1
diff -u -b -r1.1 shallow2.m
--- tests/debugger/shallow2.m 30 Jul 2002 08:25:20 -0000 1.1
+++ tests/debugger/shallow2.m 27 Nov 2002 15:09:07 -0000
@@ -21,8 +21,8 @@
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
- NmB is N - B,
- BmN is B - N,
+ NmB = N - B,
+ BmN = B - N,
( D = NmB ->
fail
; D = BmN ->
@@ -30,5 +30,5 @@
;
true
),
- D1 is D + 1,
+ D1 = D + 1,
nodiag(B, D1, L).
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
Index: tests/general/arithmetic.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/arithmetic.m,v
retrieving revision 1.4
diff -u -b -r1.4 arithmetic.m
--- tests/general/arithmetic.m 13 Mar 2000 04:00:43 -0000 1.4
+++ tests/general/arithmetic.m 25 Nov 2002 20:51:23 -0000
@@ -25,19 +25,19 @@
test(X, Y) -->
{
- Plus is X + Y,
- Times is X * Y,
- Minus is X - Y,
- Div is X // Y,
- Mod is X mod Y,
- LeftShift is X << Y,
- RightShift is X >> Y,
- BitAnd is X /\ Y,
- BitOr is X \/ Y,
- BitXor is X `xor` Y,
- X is BitXor2 `xor` Y,
- Y is X `xor` BitXor3,
- BitNeg is \ X
+ Plus = X + Y,
+ Times = X * Y,
+ Minus = X - Y,
+ Div = X // Y,
+ Mod = X mod Y,
+ LeftShift = X << Y,
+ RightShift = X >> Y,
+ BitAnd = X /\ Y,
+ BitOr = X \/ Y,
+ BitXor = X `xor` Y,
+ X = BitXor2 `xor` Y,
+ Y = X `xor` BitXor3,
+ BitNeg = \ X
},
write_message("X: ", X),
write_message("Y: ", Y),
@@ -60,4 +60,3 @@
write_message(String, Int) -->
io__write_string(String), io__write_int(Int), io__write_string("\n").
-
Index: tests/general/commit_bug_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/commit_bug_2.m,v
retrieving revision 1.1
diff -u -b -r1.1 commit_bug_2.m
--- tests/general/commit_bug_2.m 8 Jan 1997 07:55:51 -0000 1.1
+++ tests/general/commit_bug_2.m 27 Nov 2002 15:09:30 -0000
@@ -31,7 +31,7 @@
p(A),
some [B] (
q(A, B),
- C is B + 1,
+ C = B + 1,
some [D] (
r(C, D),
D > 25
Index: tests/general/complex_failure.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/complex_failure.m,v
retrieving revision 1.2
diff -u -b -r1.2 complex_failure.m
--- tests/general/complex_failure.m 7 Aug 1998 05:13:11 -0000 1.2
+++ tests/general/complex_failure.m 27 Nov 2002 15:09:41 -0000
@@ -46,10 +46,10 @@
( if
some [B] ( q(A, B) ; r(A, B) )
then
- C is B * 10
+ C = B * 10
% s(B, C)
else
- C is A * 10
+ C = A * 10
% s(A, C)
),
% The second if-then-else cannot hijack the redoip/redofr slots
@@ -90,9 +90,9 @@
s(F, G) :-
F < 695,
(
- G is 10 * F
+ G = 10 * F
;
- G is 10 * F + 1
+ G = 10 * F + 1
).
:- pred print_list(list(int), io__state, io__state).
Index: tests/general/do_while.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/do_while.m,v
retrieving revision 1.1
diff -u -b -r1.1 do_while.m
--- tests/general/do_while.m 20 Oct 1999 03:14:35 -0000 1.1
+++ tests/general/do_while.m 27 Nov 2002 15:09:45 -0000
@@ -37,7 +37,7 @@
r(Mult, Z) :-
q(X, Y),
- Z is X * Mult + Y.
+ Z = X * Mult + Y.
:- pred q(int::out, int::out) is nondet.
Index: tests/general/frameopt_mkframe_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/frameopt_mkframe_bug.m,v
retrieving revision 1.1
diff -u -b -r1.1 frameopt_mkframe_bug.m
--- tests/general/frameopt_mkframe_bug.m 24 Nov 1996 16:30:57 -0000 1.1
+++ tests/general/frameopt_mkframe_bug.m 27 Nov 2002 15:09:54 -0000
@@ -49,8 +49,8 @@
q(2).
r(3).
-s(X, Y4) :- Y4 is X + 10.
-t(X, Y5, Z) :- Z is X * 100 + Y5.
+s(X, Y4) :- Y4 = X + 10.
+t(X, Y5, Z) :- Z = X * 100 + Y5.
u(A) :-
A > 30.
v(yes).
Index: tests/general/liveness.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/liveness.m,v
retrieving revision 1.1
diff -u -b -r1.1 liveness.m
--- tests/general/liveness.m 24 Nov 1996 14:30:23 -0000 1.1
+++ tests/general/liveness.m 27 Nov 2002 15:10:03 -0000
@@ -71,9 +71,9 @@
q(2).
r(3).
-s(X, Y4) :- Y4 is X + 10.
-t(X, Y5, Z) :- Z is X * 100 + Y5.
+s(X, Y4) :- Y4 = X + 10.
+t(X, Y5, Z) :- Z = X * 100 + Y5.
u(A,B,C,D,E) :-
- Sum is A+B+C+D+E,
+ Sum = A+B+C+D+E,
Sum > 200.
v(yes).
Index: tests/general/mode_inf.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/mode_inf.m,v
retrieving revision 1.2
diff -u -b -r1.2 mode_inf.m
--- tests/general/mode_inf.m 15 Jan 1998 01:44:08 -0000 1.2
+++ tests/general/mode_inf.m 27 Nov 2002 15:10:20 -0000
@@ -21,10 +21,9 @@
array__set(A0, 37, X, A1),
array__lookup(A1, 37, Y).
-some_backtracking_stuff(X, Y, Z) :- Y is X + 1, p(Z).
-some_backtracking_stuff(X, Y, Z) :- Y is X + 2, p(Z).
-some_backtracking_stuff(X, Y, Z) :- Y is X + 3, p(Z).
+some_backtracking_stuff(X, Y, Z) :- Y = X + 1, p(Z).
+some_backtracking_stuff(X, Y, Z) :- Y = X + 2, p(Z).
+some_backtracking_stuff(X, Y, Z) :- Y = X + 3, p(Z).
p(1).
p(2).
-
Index: tests/general/mode_inf_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/mode_inf_bug.m,v
retrieving revision 1.4
diff -u -b -r1.4 mode_inf_bug.m
--- tests/general/mode_inf_bug.m 9 Aug 1997 03:36:26 -0000 1.4
+++ tests/general/mode_inf_bug.m 27 Nov 2002 15:10:45 -0000
@@ -75,7 +75,7 @@
L = []
;
L = [a|R],
- N1 is N - 1,
+ N1 = N - 1,
gen_a_list(N1,R)
).
Index: tests/general/nasty_nondet.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/nasty_nondet.m,v
retrieving revision 1.1
diff -u -b -r1.1 nasty_nondet.m
--- tests/general/nasty_nondet.m 23 Jun 1995 10:49:13 -0000 1.1
+++ tests/general/nasty_nondet.m 27 Nov 2002 15:10:48 -0000
@@ -18,7 +18,7 @@
X = R
)
then
- Y is X * X + R
+ Y = X * X + R
else
Y = 42
).
Index: tests/general/nondet_ite.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/nondet_ite.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondet_ite.m
--- tests/general/nondet_ite.m 23 Jun 1995 10:49:14 -0000 1.1
+++ tests/general/nondet_ite.m 27 Nov 2002 15:10:53 -0000
@@ -29,7 +29,7 @@
r(Z) :-
q(X, Y),
- Z is X * 100 + Y.
+ Z = X * 100 + Y.
main -->
{ solutions(r, List) },
Index: tests/general/nondet_ite_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/nondet_ite_2.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondet_ite_2.m
--- tests/general/nondet_ite_2.m 22 Jan 1996 05:18:46 -0000 1.1
+++ tests/general/nondet_ite_2.m 27 Nov 2002 15:10:56 -0000
@@ -37,7 +37,7 @@
r(Z) :-
q(X, Y),
- Z is X * 100 + Y.
+ Z = X * 100 + Y.
main -->
{ solutions(r, List) },
Index: tests/general/nondet_ite_4.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/nondet_ite_4.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondet_ite_4.m
--- tests/general/nondet_ite_4.m 16 Jun 1997 09:12:32 -0000 1.1
+++ tests/general/nondet_ite_4.m 27 Nov 2002 15:10:59 -0000
@@ -39,7 +39,7 @@
r(Z) :-
q(X, Y),
- Z is X * 100 + Y.
+ Z = X * 100 + Y.
main -->
{ solutions(r, List) },
Index: tests/general/nondetlive.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/nondetlive.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondetlive.m
--- tests/general/nondetlive.m 20 May 1996 00:17:28 -0000 1.1
+++ tests/general/nondetlive.m 27 Nov 2002 15:11:07 -0000
@@ -33,10 +33,10 @@
;
Y = 2
),
- Z is Y + W
+ Z = Y + W
),
q(V),
- X is Z * V.
+ X = Z * V.
:- pred q(int::out) is multi.
Index: tests/general/semi_fail_in_non_ite.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/semi_fail_in_non_ite.m,v
retrieving revision 1.1
diff -u -b -r1.1 semi_fail_in_non_ite.m
--- tests/general/semi_fail_in_non_ite.m 7 Aug 1998 05:13:17 -0000 1.1
+++ tests/general/semi_fail_in_non_ite.m 27 Nov 2002 15:11:17 -0000
@@ -42,10 +42,10 @@
( if
some [B] ( q(A, B) ; r(A, B) )
then
- C is B * 10
+ C = B * 10
% s(B, C)
else
- C is A * 10
+ C = A * 10
% s(A, C)
),
% The second if-then-else cannot hijack the redoip/redofr slots
@@ -91,9 +91,9 @@
s(F, G) :-
F < 695,
(
- G is 10 * F
+ G = 10 * F
;
- G is 10 * F + 1
+ G = 10 * F + 1
).
:- pred print_list(list(int), io__state, io__state).
Index: tests/general/semidet_map.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/semidet_map.m,v
retrieving revision 1.3
diff -u -b -r1.3 semidet_map.m
--- tests/general/semidet_map.m 28 May 1998 14:29:46 -0000 1.3
+++ tests/general/semidet_map.m 27 Nov 2002 15:11:31 -0000
@@ -31,7 +31,9 @@
call(P, T, S0), string__append_list(["yes(", S0, ")"], S).
:- pred pos_inc(int::in, int::out) is semidet.
-pos_inc(X, Y) :- X > 0, Y is X + 1.
+pos_inc(X, Y) :-
+ X > 0,
+ Y = X + 1.
meta_semidet_map(_, [], []).
meta_semidet_map(P, [H0|T0], [H|T]) :-
Index: tests/general/string_format_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/string_format_test.m,v
retrieving revision 1.5
diff -u -b -r1.5 string_format_test.m
--- tests/general/string_format_test.m 2 Sep 2001 12:20:13 -0000 1.5
+++ tests/general/string_format_test.m 27 Nov 2002 15:12:01 -0000
@@ -6,17 +6,19 @@
:- interface.
-:- import_module string, io, list, int, float.
+:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
+:- import_module string, list, int, float.
+
main -->
- { Numba_0 is 32} ,
- { Numba_1 is Numba_0 - 5 } ,
- { Numba_2 is Numba_0 + 5 } ,
+ { Numba_0 = 32} ,
+ { Numba_1 = Numba_0 - 5 } ,
+ { Numba_2 = Numba_0 + 5 } ,
{ Mg_poly = s("In the beginning there was the text, and the text was words, and yea, verily, I say unto you, there was too much of it and it had to be compressed.") } ,
[],
{ Num_nr_1 = 9.9999 } ,
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/boyer.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/boyer.m,v
retrieving revision 1.3
diff -u -b -r1.3 boyer.m
--- tests/hard_coded/boyer.m 8 Jul 1999 10:03:54 -0000 1.3
+++ tests/hard_coded/boyer.m 7 May 2003 03:04:03 -0000
@@ -13,23 +13,23 @@
% in Mercury by Bart Demoen - started 17 Jan 1997
-:- module boyer .
+:- module boyer.
:- interface.
-:- import_module io, int.
+:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-% :- type list(T) ---> [] ; [T|list(T)].
-:- import_module list.
+
+:- import_module int, list.
main --> b(3) .
% :- pred b(int,io__state,io__state) .
:- mode b(in,di,uo) is det .
-b(X) --> {X > 0} -> boyer , {Y is X - 1} , b(Y) ; {true} .
+b(X) --> {X > 0} -> boyer , {Y = X - 1} , b(Y) ; {true} .
:- pred boyer(io__state::di, io__state::uo) is det .
@@ -91,7 +91,6 @@
% :- pred rewrite(type_wff,type_wff) .
:- mode rewrite(in,out) is det .
-
rewrite(a1,a1) .
rewrite(b1,b1) .
rewrite(c1,c1) .
@@ -318,7 +317,4 @@
(U = V -> true ;
U = my_times(A,B) , (B = V -> true ; A = V)
) .
-
-
-
Index: tests/hard_coded/common_type_cast.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/common_type_cast.m,v
retrieving revision 1.1
diff -u -b -r1.1 common_type_cast.m
--- tests/hard_coded/common_type_cast.m 10 Mar 1998 11:09:27 -0000 1.1
+++ tests/hard_coded/common_type_cast.m 27 Nov 2002 15:13:23 -0000
@@ -19,7 +19,7 @@
:- import_module int, float.
main -->
- { Pred = lambda([Int::in, Float::out] is det, Float is float(Int)) },
+ { Pred = lambda([Int::in, Float::out] is det, Float = float(Int)) },
{ test(Pred, error("error"), Output1) },
{ test(Pred, ok(1), Output2) },
io__write(Output1),
Index: tests/hard_coded/curry2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/curry2.m,v
retrieving revision 1.1
diff -u -b -r1.1 curry2.m
--- tests/hard_coded/curry2.m 9 Dec 1996 14:31:48 -0000 1.1
+++ tests/hard_coded/curry2.m 27 Nov 2002 15:13:37 -0000
@@ -58,23 +58,22 @@
:- mode foo(in, in, out) is det.
foo(X, Y, Z) :-
- Z is 100 * X + 10 * Y.
+ Z = 100 * X + 10 * Y.
:- pred bar(int, int, int, int).
:- mode bar(in, in, in, out) is det.
bar(A, B, C, D) :-
- D is 1000 * A + 100 * B + 10 * C.
+ D = 1000 * A + 100 * B + 10 * C.
:- pred foo2(int, int, int).
:- mode foo2(in, out, in) is det.
foo2(X, Z, Y) :-
- Z is 100 * X + 10 * Y.
+ Z = 100 * X + 10 * Y.
:- pred bar2(int, int, int, int).
:- mode bar2(in, in, out, in) is det.
bar2(A, B, D, C) :-
- D is 1000 * A + 100 * B + 10 * C.
-
+ D = 1000 * A + 100 * B + 10 * C.
Index: tests/hard_coded/cut_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/cut_test.m,v
retrieving revision 1.1
diff -u -b -r1.1 cut_test.m
--- tests/hard_coded/cut_test.m 20 Jul 1998 10:04:02 -0000 1.1
+++ tests/hard_coded/cut_test.m 27 Nov 2002 15:14:07 -0000
@@ -71,11 +71,11 @@
middle(A0) :-
(
- A1 is A0 + 10
+ A1 = A0 + 10
;
- A1 is A0 + 20
+ A1 = A0 + 20
;
- A1 is A0 + 30
+ A1 = A0 + 30
),
test(A1, _).
@@ -89,11 +89,11 @@
addsome(A0, A1) :-
(
- A1 is A0 + 10
+ A1 = A0 + 10
;
- A1 is A0 + 20
+ A1 = A0 + 20
;
- A1 is A0 + 30
+ A1 = A0 + 30
).
:- pred test(int::in, int::out) is nondet.
@@ -101,9 +101,9 @@
test(A, B) :-
A > 200,
(
- B is A
+ B = A
;
- B is A * 2
+ B = A * 2
;
- B is A * 3
+ B = A * 3
).
Index: tests/hard_coded/factt.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/factt.m,v
retrieving revision 1.1
diff -u -b -r1.1 factt.m
--- tests/hard_coded/factt.m 8 Feb 1999 23:36:47 -0000 1.1
+++ tests/hard_coded/factt.m 27 Nov 2002 15:14:12 -0000
@@ -25,7 +25,7 @@
print("Example call failed."),nl
),
- {Num1 is Num + 1},
+ {Num1 = Num + 1},
({Num1 < 51} ->
show_examples(Num1);
Index: tests/hard_coded/func_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/func_test.m,v
retrieving revision 1.1
diff -u -b -r1.1 func_test.m
--- tests/hard_coded/func_test.m 14 May 1996 13:03:00 -0000 1.1
+++ tests/hard_coded/func_test.m 27 Nov 2002 15:14:23 -0000
@@ -24,7 +24,7 @@
:- func f(int) = int.
:- mode f(in) = test2 is det.
-f(X) = Y :- Y is X + 1.
+f(X) = Y :- Y = X + 1.
:- func g(int) = int.
@@ -39,4 +39,3 @@
% test type inference
test2 = 456.
-
Index: tests/hard_coded/integer_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/integer_test.m,v
retrieving revision 1.1
diff -u -b -r1.1 integer_test.m
--- tests/hard_coded/integer_test.m 16 Apr 1998 12:00:28 -0000 1.1
+++ tests/hard_coded/integer_test.m 27 Nov 2002 15:14:35 -0000
@@ -26,11 +26,11 @@
test(X, Y, Z) -->
{
- Plus is X + Y,
- Times is X * Y,
- Minus is X - Y,
- Div is Y // X,
- Rem is Y rem X,
+ Plus = X + Y,
+ Times = X * Y,
+ Minus = X - Y,
+ Div = Y // X,
+ Rem = Y rem X,
integer:pow(X,Z,Pow),
fac(Z,Fac)
},
Index: tests/hard_coded/nondet_ctrl_vn.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/nondet_ctrl_vn.m,v
retrieving revision 1.1
diff -u -b -r1.1 nondet_ctrl_vn.m
--- tests/hard_coded/nondet_ctrl_vn.m 26 Aug 1998 07:52:01 -0000 1.1
+++ tests/hard_coded/nondet_ctrl_vn.m 27 Nov 2002 15:15:12 -0000
@@ -29,13 +29,13 @@
middle(A0) :-
(
- A is A0 + 10
+ A = A0 + 10
;
- A is A0 + 20
+ A = A0 + 20
),
A > 200,
(
- B is A
+ _B = A
;
- B is A * 2
+ _B = A * 2
).
Index: tests/hard_coded/qual_adv_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_adv_test.m,v
retrieving revision 1.3
diff -u -b -r1.3 qual_adv_test.m
--- tests/hard_coded/qual_adv_test.m 23 Feb 1997 06:11:50 -0000 1.3
+++ tests/hard_coded/qual_adv_test.m 27 Nov 2002 15:15:51 -0000
@@ -9,11 +9,13 @@
%
:- interface.
-:- import_module io, list, string, qual_strang, qual_strung.
+:- import_module io.
:- pred qual_adv_test:main(io__state::di, io__state::uo) is det.
:- implementation.
+
+:- import_module list, string, qual_strang, qual_strung.
main -->
{ String = "asdfjkfhaslks" },
Index: tests/hard_coded/qual_basic_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_basic_test.m,v
retrieving revision 1.3
diff -u -b -r1.3 qual_basic_test.m
--- tests/hard_coded/qual_basic_test.m 23 Feb 1997 06:11:53 -0000 1.3
+++ tests/hard_coded/qual_basic_test.m 27 Nov 2002 15:15:59 -0000
@@ -15,8 +15,8 @@
qual_basic_test:main -->
io:write_string("Gotcha1!\n"),
- { A is qual_basic_test:test },
- { X is int:(A + 2) },
+ { A = qual_basic_test:test },
+ { X = int:(A + 2) },
io:write_int(X),
io__write_string("\n"),
{ Pred = int:max },
Index: tests/hard_coded/qual_strang.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_strang.m,v
retrieving revision 1.5
diff -u -b -r1.5 qual_strang.m
--- tests/hard_coded/qual_strang.m 2 Sep 2001 12:20:13 -0000 1.5
+++ tests/hard_coded/qual_strang.m 27 Nov 2002 15:17:03 -0000
@@ -241,9 +241,9 @@
(
I < 0
->
- Mv_width is 1
+ Mv_width = 1
;
- Mv_width is 0
+ Mv_width = 0
)
;
@@ -264,7 +264,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'x' ,
Poly_t = i(I),
@@ -285,7 +285,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'X',
Poly_t = i(I),
@@ -305,7 +305,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'u' ,
Poly_t = i(I),
@@ -373,9 +373,9 @@
),
length(S, L),
( first_char(S, '-', _) ->
- Xzeros is Prec - L + 1
+ Xzeros = Prec - L + 1
;
- Xzeros is Prec - L
+ Xzeros = Prec - L
),
Added_width = Xzeros,
( Xzeros > 0 ->
@@ -405,12 +405,12 @@
first_char(Fstring, '-', Tst)
;
( F < 1.0 ->
- Texp is Exp - 1,
+ Texp = Exp - 1,
FF = F * 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
( F >= 10.0 ->
- Texp is Exp + 1,
+ Texp = Exp + 1,
FF = F / 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
@@ -445,10 +445,10 @@
(
find_index( Istring, '.', Index)
->
- Spa is Prec + Index
+ Spa = Prec + Index
;
length(Istring, Spa_0),
- Spa is Spa_0 + 1
+ Spa = Spa_0 + 1
% This branch should never be called if mercury is implemented
% in ansi-C, according to Kernighan and Ritchie p244, as a
% float converted to a string using sprintf should always have
@@ -472,7 +472,7 @@
(
Precision = 0
->
- Space is Spa - 1
+ Space = Spa - 1
;
Space = Spa
),
@@ -497,7 +497,7 @@
Index = 1
;
find_index_2(Xs, C, Index0),
- Index is Index0 + 1
+ Index = Index0 + 1
).
%find_index( A, Ch, Check, Ret) :-
@@ -523,7 +523,7 @@
:- mode format_add_sign( out, in, in, in, in, out) is det.
% Mvw is the prefix-length in front of the number.
format_add_sign( Ostring, Istring, Flags, _V, Mvw1, Mvw2) :-
- T1 is Mvw1 - 1,
+ T1 = Mvw1 - 1,
(
index(Istring, T1, '-')
->
@@ -536,14 +536,14 @@
->
append( "+", Rstring, Astring),
append( Lstring, Astring, Ostring),
- Mvw2 is Mvw1 + 1
+ Mvw2 = Mvw1 + 1
;
(
list__member(' ', Flags)
->
append( " ", Rstring, Astring),
append( Lstring, Astring, Ostring),
- Mvw2 is Mvw1 + 1
+ Mvw2 = Mvw1 + 1
;
Ostring = Istring,
Mvw2 = Mvw1
@@ -562,7 +562,7 @@
length(Istring, Len),
(Len < Width ->
% time for some FLAG tests
- Xspace is Width - Len,
+ Xspace = Width - Len,
(
list__member('0', Flags)
->
Index: tests/hard_coded/qual_strung.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/qual_strung.m,v
retrieving revision 1.5
diff -u -b -r1.5 qual_strung.m
--- tests/hard_coded/qual_strung.m 2 Sep 2001 12:20:14 -0000 1.5
+++ tests/hard_coded/qual_strung.m 27 Nov 2002 15:17:54 -0000
@@ -243,9 +243,9 @@
(
I < 0
->
- Mv_width is 1
+ Mv_width = 1
;
- Mv_width is 0
+ Mv_width = 0
)
;
@@ -266,7 +266,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'x' ,
Poly_t = i(I),
@@ -287,7 +287,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'X',
Poly_t = i(I),
@@ -307,7 +307,7 @@
Pfix_len = 0
)
),
- ( I < 0 -> Mv_width is Pfix_len + 1 ; Mv_width is Pfix_len )
+ ( I < 0 -> Mv_width = Pfix_len + 1 ; Mv_width = Pfix_len )
;
Conv_c = 'u' ,
Poly_t = i(I),
@@ -374,9 +374,9 @@
),
length(S, L),
( first_char(S, '-', _) ->
- Xzeros is Prec - L + 1
+ Xzeros = Prec - L + 1
;
- Xzeros is Prec - L
+ Xzeros = Prec - L
),
Added_width = Xzeros,
( Xzeros > 0 ->
@@ -406,12 +406,12 @@
first_char(Fstring, '-', Tst)
;
( F < 1.0 ->
- Texp is Exp - 1,
+ Texp = Exp - 1,
FF = F * 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
( F >= 10.0 ->
- Texp is Exp + 1,
+ Texp = Exp + 1,
FF = F / 10.0,
format_calc_exp( FF, Fstring, Precision, Texp)
;
@@ -446,10 +446,10 @@
(
find_index( Istring, '.', Index)
->
- Spa is Prec + Index
+ Spa = Prec + Index
;
length(Istring, Spa_0),
- Spa is Spa_0 + 1
+ Spa = Spa_0 + 1
% This branch should never be called if mercury is implemented
% in ansi-C, according to Kernighan and Ritchie p244, as a
% float converted to a string using sprintf should always have
@@ -473,7 +473,7 @@
(
Precision = 0
->
- Space is Spa - 1
+ Space = Spa - 1
;
Space = Spa
),
@@ -498,7 +498,7 @@
Index = 1
;
find_index_2(Xs, C, Index0),
- Index is Index0 + 1
+ Index = Index0 + 1
).
%find_index( A, Ch, Check, Ret) :-
@@ -524,7 +524,7 @@
:- mode format_add_sign( out, in, in, in, in, out) is det.
% Mvw is the prefix-length in front of the number.
format_add_sign( Ostring, Istring, Flags, _V, Mvw1, Mvw2) :-
- T1 is Mvw1 - 1,
+ T1 = Mvw1 - 1,
(
index(Istring, T1, '-')
->
@@ -537,14 +537,14 @@
->
append( "+", Rstring, Astring),
append( Lstring, Astring, Ostring),
- Mvw2 is Mvw1 + 1
+ Mvw2 = Mvw1 + 1
;
(
list__member(' ', Flags)
->
append( " ", Rstring, Astring),
append( Lstring, Astring, Ostring),
- Mvw2 is Mvw1 + 1
+ Mvw2 = Mvw1 + 1
;
Ostring = Istring,
Mvw2 = Mvw1
@@ -563,7 +563,7 @@
length(Istring, Len),
(Len < Width ->
% time for some FLAG tests
- Xspace is Width - Len,
+ Xspace = Width - Len,
(
list__member('0', Flags)
->
Index: tests/hard_coded/space.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/space.m,v
retrieving revision 1.2
diff -u -b -r1.2 space.m
--- tests/hard_coded/space.m 12 Aug 1998 04:05:07 -0000 1.2
+++ tests/hard_coded/space.m 27 Nov 2002 15:19:34 -0000
@@ -174,7 +174,7 @@
{ random_random(I, Rnd0, Rnd) },
{ next_chord(Chord0, Qual, I, Chord1) }
->
- { N1 is N - 1 },
+ { N1 = N - 1 },
doit(N1, Trans, Qual, Chord1, Rnd)
;
io__write_string("next_chord failed\n")
@@ -200,7 +200,7 @@
:- mode write_note(in, in, in, di, uo) is det.
write_note(c, flat, Oct) -->
- { Oct1 is Oct - 1 },
+ { Oct1 = Oct - 1 },
{ string__format("b%d", [i(Oct1)], Str) },
io__write_string(Str).
write_note(c, natural, Oct) -->
@@ -261,7 +261,7 @@
{ string__format("b%d", [i(Oct)], Str) },
io__write_string(Str).
write_note(b, sharp, Oct) -->
- { Oct1 is Oct + 1 },
+ { Oct1 = Oct + 1 },
{ string__format("c%d", [i(Oct1)], Str) },
io__write_string(Str).
@@ -288,7 +288,7 @@
solutions(try_next_chord(Qual, Int0, TopNote0), List),
list__length(List, Len),
Len > 0,
- Ind is Pr mod Len,
+ Ind = Pr mod Len,
list__index0(List, Ind, Chord).
:- pred try_next_chord(qualifier::in, interval::in, note::in, chord::out)
@@ -310,13 +310,13 @@
I > 0
->
list__append(Xs, [X], Ys),
- I1 is I - 1,
+ I1 = I - 1,
rotate(I1, Ys, Zs)
;
I < 0
->
list__append(Xs, [X], Ys),
- I1 is I + 1,
+ I1 = I + 1,
rotate(I1, Ys, Zs)
;
Zs = [X|Xs]
@@ -423,7 +423,7 @@
:- mode adj_interval(in, in, out, out) is multi.
adj_interval(i, Oct, vii, Oct1) :-
- Oct1 is Oct - 1.
+ Oct1 = Oct - 1.
adj_interval(i, Oct, ii, Oct).
adj_interval(ii, Oct, i, Oct).
adj_interval(ii, Oct, iii, Oct).
@@ -437,7 +437,7 @@
adj_interval(vi, Oct, vii, Oct).
adj_interval(vii, Oct, vi, Oct).
adj_interval(vii, Oct, i, Oct1) :-
- Oct1 is Oct + 1.
+ Oct1 = Oct + 1.
%------------------------------------------------------------------------------%
@@ -522,7 +522,7 @@
transpose(Trans, Qual, Note0, Note) :-
interval_to_int(Trans, Qual, TNum),
note_to_int(Note0, NNum0),
- NNum is TNum + NNum0,
+ NNum = TNum + NNum0,
int_to_note(NNum, Note).
:- pred trans(note, note, note).
@@ -531,7 +531,7 @@
trans(Trans, Note0, Note) :-
note_to_int(Trans, TNum),
note_to_int(Note0, NNum0),
- NNum is TNum + NNum0,
+ NNum = TNum + NNum0,
int_to_note(NNum, Note).
%------------------------------------------------------------------------------%
@@ -559,14 +559,14 @@
->
shift(Dir, Note0, Note),
list__append(Notes1, [Note], Notes2),
- N1 is N - 1,
+ N1 = N - 1,
invert_list(Notes2, Dir, N1, Notes)
;
N < 0,
last(Notes0, Note0, Notes1)
->
shift(Dir, Note0, Note),
- N1 is N + 1,
+ N1 = N + 1,
invert_list([Note|Notes1], Dir, N1, Notes)
;
Notes = Notes0
@@ -576,9 +576,9 @@
:- mode shift(in, in, out) is det.
shift(up, note(Rank, Mod, Oct), note(Rank, Mod, Oct1)) :-
- Oct1 is Oct + 1.
+ Oct1 = Oct + 1.
shift(down, note(Rank, Mod, Oct), note(Rank, Mod, Oct1)) :-
- Oct1 is Oct - 1.
+ Oct1 = Oct - 1.
:- pred last(list(T), T, list(T)).
:- mode last(in, out, out) is semidet.
@@ -622,54 +622,54 @@
:- mode note_to_int(in, out) is det.
note_to_int(note(c, flat, Oct), I) :-
- I is -1 + 12 * Oct.
+ I = -1 + 12 * Oct.
note_to_int(note(c, natural, Oct), I) :-
- I is 0 + 12 * Oct.
+ I = 0 + 12 * Oct.
note_to_int(note(c, sharp, Oct), I) :-
- I is 1 + 12 * Oct.
+ I = 1 + 12 * Oct.
note_to_int(note(d, flat, Oct), I) :-
- I is 1 + 12 * Oct.
+ I = 1 + 12 * Oct.
note_to_int(note(d, natural, Oct), I) :-
- I is 2 + 12 * Oct.
+ I = 2 + 12 * Oct.
note_to_int(note(d, sharp, Oct), I) :-
- I is 3 + 12 * Oct.
+ I = 3 + 12 * Oct.
note_to_int(note(e, flat, Oct), I) :-
- I is 3 + 12 * Oct.
+ I = 3 + 12 * Oct.
note_to_int(note(e, natural, Oct), I) :-
- I is 4 + 12 * Oct.
+ I = 4 + 12 * Oct.
note_to_int(note(f, flat, Oct), I) :-
- I is 4 + 12 * Oct.
+ I = 4 + 12 * Oct.
note_to_int(note(e, sharp, Oct), I) :-
- I is 5 + 12 * Oct.
+ I = 5 + 12 * Oct.
note_to_int(note(f, natural, Oct), I) :-
- I is 5 + 12 * Oct.
+ I = 5 + 12 * Oct.
note_to_int(note(f, sharp, Oct), I) :-
- I is 6 + 12 * Oct.
+ I = 6 + 12 * Oct.
note_to_int(note(g, flat, Oct), I) :-
- I is 6 + 12 * Oct.
+ I = 6 + 12 * Oct.
note_to_int(note(g, natural, Oct), I) :-
- I is 7 + 12 * Oct.
+ I = 7 + 12 * Oct.
note_to_int(note(g, sharp, Oct), I) :-
- I is 8 + 12 * Oct.
+ I = 8 + 12 * Oct.
note_to_int(note(a, flat, Oct), I) :-
- I is 8 + 12 * Oct.
+ I = 8 + 12 * Oct.
note_to_int(note(a, natural, Oct), I) :-
- I is 9 + 12 * Oct.
+ I = 9 + 12 * Oct.
note_to_int(note(a, sharp, Oct), I) :-
- I is 10 + 12 * Oct.
+ I = 10 + 12 * Oct.
note_to_int(note(b, flat, Oct), I) :-
- I is 10 + 12 * Oct.
+ I = 10 + 12 * Oct.
note_to_int(note(b, natural, Oct), I) :-
- I is 11 + 12 * Oct.
+ I = 11 + 12 * Oct.
note_to_int(note(b, sharp, Oct), I) :-
- I is 12 + 12 * Oct.
+ I = 12 + 12 * Oct.
:- pred int_to_note(int, note).
:- mode int_to_note(in, out) is det.
int_to_note(Num, note(Rank, Mod, Oct)) :-
- Oct is Num // 12,
- Off is Num mod 12,
+ Oct = Num // 12,
+ Off = Num mod 12,
(
(
Off = 0, Rank0 = c, Mod0 = natural
@@ -766,9 +766,9 @@
random_random(Value, Supply0, Supply) :-
Value = Supply0,
( Supply0 < 100 ->
- Supply is Supply0 + 1
+ Supply = Supply0 + 1
;
- Supply is 0
+ Supply = 0
).
%------------------------------------------------------------------------------%
Index: tests/hard_coded/string_alignment_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/string_alignment_bug.m,v
retrieving revision 1.2
diff -u -b -r1.2 string_alignment_bug.m
--- tests/hard_coded/string_alignment_bug.m 15 Jan 2001 00:39:50 -0000 1.2
+++ tests/hard_coded/string_alignment_bug.m 27 Nov 2002 15:19:38 -0000
@@ -73,7 +73,7 @@
(
I = Min
;
- Min1 is Min + 1,
+ Min1 = Min + 1,
between(Min1, Max, I)
).
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
Index: tests/invalid/det_errors.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/det_errors.m,v
retrieving revision 1.1
diff -u -b -r1.1 det_errors.m
--- tests/invalid/det_errors.m 11 Jul 1995 13:11:58 -0000 1.1
+++ tests/invalid/det_errors.m 27 Nov 2002 15:29:45 -0000
@@ -13,7 +13,6 @@
p1(42).
p2(X) :- X = 42.
-p3(X) :- X is 42.
-p4(X) :- X is 21 + 21.
+p3(X) :- X = 42.
+p4(X) :- X = 21 + 21.
p5(_) :- true.
-
Index: tests/invalid/lambda_syntax_error.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/lambda_syntax_error.m,v
retrieving revision 1.1
diff -u -b -r1.1 lambda_syntax_error.m
--- tests/invalid/lambda_syntax_error.m 18 Sep 2000 16:38:26 -0000 1.1
+++ tests/invalid/lambda_syntax_error.m 27 Nov 2002 15:26:25 -0000
@@ -13,4 +13,3 @@
baz2(X) = (pred(Y::in) :- X > Y). % determinism not specified
baz3(X) = (pred(Y) is semidet :- X > Y). % mode not specified
baz4(X) = (pred(A) = B :- X = A + B). % mixing `func' and `pred' notation
-
Index: tests/invalid/typeclass_test_7.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/typeclass_test_7.m,v
retrieving revision 1.1
diff -u -b -r1.1 typeclass_test_7.m
--- tests/invalid/typeclass_test_7.m 22 Jun 1998 08:45:21 -0000 1.1
+++ tests/invalid/typeclass_test_7.m 27 Nov 2002 15:26:02 -0000
@@ -8,7 +8,7 @@
p(X, Y) :-
F = 42,
N = type_num(X), % error should be reported on *this* line
- N2 is N * 2,
+ N2 = N * 2,
Y = N2 + F.
:- typeclass numbered_type(T) where [
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/recompilation
cvs diff: Diffing tests/tabling
Index: tests/tabling/expand.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/expand.m,v
retrieving revision 1.2
diff -u -b -r1.2 expand.m
--- tests/tabling/expand.m 16 Feb 2000 08:17:58 -0000 1.2
+++ tests/tabling/expand.m 27 Nov 2002 15:25:08 -0000
@@ -67,5 +67,5 @@
F = 1
;
sum(N - 1, F1),
- F is N + F1
+ F = N + F1
).
Index: tests/tabling/expand_float.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/expand_float.m,v
retrieving revision 1.2
diff -u -b -r1.2 expand_float.m
--- tests/tabling/expand_float.m 16 Feb 2000 08:17:59 -0000 1.2
+++ tests/tabling/expand_float.m 27 Nov 2002 15:25:12 -0000
@@ -67,5 +67,5 @@
F = 1.0
;
sum(N - 1.0, F1),
- F is N + F1
+ F = N + F1
).
Index: tests/tabling/expand_poly.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/expand_poly.m,v
retrieving revision 1.2
diff -u -b -r1.2 expand_poly.m
--- tests/tabling/expand_poly.m 16 Feb 2000 08:17:59 -0000 1.2
+++ tests/tabling/expand_poly.m 27 Nov 2002 15:25:16 -0000
@@ -89,5 +89,5 @@
F = 1
;
sum(N - 1, A, F1),
- F is N + F1
+ F = N + F1
).
Index: tests/tabling/expand_tuple.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/expand_tuple.m,v
retrieving revision 1.1
diff -u -b -r1.1 expand_tuple.m
--- tests/tabling/expand_tuple.m 20 Sep 2000 02:53:11 -0000 1.1
+++ tests/tabling/expand_tuple.m 27 Nov 2002 15:25:19 -0000
@@ -86,5 +86,5 @@
F = 1
;
sum(N - 1, A, F1),
- F is N + F1
+ F = N + F1
).
Index: tests/tabling/fib.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/fib.m,v
retrieving revision 1.3
diff -u -b -r1.3 fib.m
--- tests/tabling/fib.m 30 Oct 2002 01:26:26 -0000 1.3
+++ tests/tabling/fib.m 27 Nov 2002 15:25:25 -0000
@@ -58,7 +58,7 @@
;
fib(N - 1, F1),
fib(N - 2, F2),
- F is F1 + F2
+ F = F1 + F2
).
:- pred mfib(int::in, int::out) is det.
@@ -70,5 +70,5 @@
;
mfib(N - 1, F1),
mfib(N - 2, F2),
- F is F1 + F2
+ F = F1 + F2
).
Index: tests/tabling/fib_float.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/fib_float.m,v
retrieving revision 1.1
diff -u -b -r1.1 fib_float.m
--- tests/tabling/fib_float.m 3 Jan 2000 08:53:13 -0000 1.1
+++ tests/tabling/fib_float.m 27 Nov 2002 15:25:31 -0000
@@ -58,7 +58,7 @@
;
fib(N - 1.0, F1),
fib(N - 2.0, F2),
- F is F1 + F2
+ F = F1 + F2
).
:- pred mfib(float::in, float::out) is det.
@@ -70,5 +70,5 @@
;
mfib(N - 1.0, F1),
mfib(N - 2.0, F2),
- F is F1 + F2
+ F = F1 + F2
).
cvs diff: Diffing tests/term
Index: tests/term/dds3_14.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/dds3_14.m,v
retrieving revision 1.1
diff -u -b -r1.1 dds3_14.m
--- tests/term/dds3_14.m 22 Dec 1997 09:58:01 -0000 1.1
+++ tests/term/dds3_14.m 27 Nov 2002 15:24:49 -0000
@@ -8,7 +8,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
sum([], [], []).
sum([X1 | Y1], [X2 | Y2], [X3 | Y3]) :-
Index: tests/term/mmatrix.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/mmatrix.m,v
retrieving revision 1.1
diff -u -b -r1.1 mmatrix.m
--- tests/term/mmatrix.m 22 Dec 1997 09:58:35 -0000 1.1
+++ tests/term/mmatrix.m 27 Nov 2002 15:23:23 -0000
@@ -17,7 +17,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
mmultiply([], _, []).
mmultiply([V0 | Rest], V1, [Result | Others]) :-
Index: tests/term/money.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/money.m,v
retrieving revision 1.1
diff -u -b -r1.1 money.m
--- tests/term/money.m 22 Dec 1997 09:58:38 -0000 1.1
+++ tests/term/money.m 27 Nov 2002 15:23:48 -0000
@@ -22,7 +22,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
solve([S, E, N, D, M, O, R, Y]) :-
money(S, E, N, D, M, O, R, Y).
Index: tests/term/occur.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/occur.m,v
retrieving revision 1.1
diff -u -b -r1.1 occur.m
--- tests/term/occur.m 22 Dec 1997 09:58:44 -0000 1.1
+++ tests/term/occur.m 27 Nov 2002 15:23:58 -0000
@@ -19,7 +19,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
occurall([], _X, []).
occurall([X | Y], Z, [[X, W] | V]) :-
Index: tests/term/pl4_5_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/pl4_5_2.m,v
retrieving revision 1.1
diff -u -b -r1.1 pl4_5_2.m
--- tests/term/pl4_5_2.m 22 Dec 1997 09:59:21 -0000 1.1
+++ tests/term/pl4_5_2.m 27 Nov 2002 15:24:16 -0000
@@ -9,7 +9,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
s(A+(B+C), D) :-
s((A+B)+C, D).
Index: tests/term/queens.m
===================================================================
RCS file: /home/mercury1/repository/tests/term/queens.m,v
retrieving revision 1.1
diff -u -b -r1.1 queens.m
--- tests/term/queens.m 22 Dec 1997 10:00:02 -0000 1.1
+++ tests/term/queens.m 27 Nov 2002 15:24:26 -0000
@@ -9,7 +9,7 @@
:- implementation.
-:- import_module int.
+:- import_module int, prolog.
queens(X, Y) :-
perm(X, Y),
cvs diff: Diffing tests/valid
Index: tests/valid/complex_failure.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/complex_failure.m,v
retrieving revision 1.1
diff -u -b -r1.1 complex_failure.m
--- tests/valid/complex_failure.m 3 Nov 1998 01:35:58 -0000 1.1
+++ tests/valid/complex_failure.m 27 Nov 2002 15:21:13 -0000
@@ -49,10 +49,10 @@
( if
some [B] ( q(A, B) ; r(A, B) )
then
- C is B * 10
+ C = B * 10
% s(B, C)
else
- C is A * 10
+ C = A * 10
% s(A, C)
),
% The second if-then-else cannot hijack the redoip/redofr slots
@@ -93,9 +93,9 @@
s(F, G) :-
F < 695,
(
- G is 10 * F
+ G = 10 * F
;
- G is 10 * F + 1
+ G = 10 * F + 1
).
:- pred print_list(list(int), io__state, io__state).
Index: tests/valid/double_vn.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/double_vn.m,v
retrieving revision 1.1
diff -u -b -r1.1 double_vn.m
--- tests/valid/double_vn.m 23 Jul 1997 08:38:17 -0000 1.1
+++ tests/valid/double_vn.m 27 Nov 2002 15:21:16 -0000
@@ -9,4 +9,4 @@
:- import_module int.
p(X) :-
- X is 1 \/ 1 \/ 1.
+ X = 1 \/ 1 \/ 1.
Index: tests/valid/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/higher_order.m,v
retrieving revision 1.1
diff -u -b -r1.1 higher_order.m
--- tests/valid/higher_order.m 14 Nov 1995 08:03:29 -0000 1.1
+++ tests/valid/higher_order.m 27 Nov 2002 15:21:20 -0000
@@ -11,7 +11,7 @@
:- pred plus2(int, int).
:- mode plus2(in, out) is det.
-plus2(X, Y) :- Y is X + 2.
+plus2(X, Y) :- Y = X + 2.
:- pred test(list(int), list(int)).
:- mode test(in, out) is det.
Index: tests/valid/lambda_struct_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/lambda_struct_bug.m,v
retrieving revision 1.1
diff -u -b -r1.1 lambda_struct_bug.m
--- tests/valid/lambda_struct_bug.m 25 Jun 1997 08:45:56 -0000 1.1
+++ tests/valid/lambda_struct_bug.m 27 Nov 2002 15:21:30 -0000
@@ -28,16 +28,16 @@
adj(pos(X, Y), Adjs) :-
Pred = lambda([Adj::out] is nondet, (
(
- X1 is X - 1,
+ X1 = X - 1,
Adj = adj(pos(X1, Y), pos(X, Y))
;
- X1 is X + 1,
+ X1 = X + 1,
Adj = adj(pos(X1, Y), pos(X, Y))
;
- Y1 is Y + 1,
+ Y1 = Y + 1,
Adj = adj(pos(X, Y1), pos(X, Y))
;
- Y1 is Y - 1,
+ Y1 = Y - 1,
Adj = adj(pos(X, Y1), pos(X, Y))
),
Adj = adj(pos(A, B), _),
Index: tests/valid/mostly_uniq_mode_inf.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/mostly_uniq_mode_inf.m,v
retrieving revision 1.2
diff -u -b -r1.2 mostly_uniq_mode_inf.m
--- tests/valid/mostly_uniq_mode_inf.m 5 Jan 1998 07:26:32 -0000 1.2
+++ tests/valid/mostly_uniq_mode_inf.m 27 Nov 2002 15:21:40 -0000
@@ -16,7 +16,7 @@
foo(X, Y) :- foo2(X, Y).
-foo2(X, Y) :- Y is X + 10.
+foo2(X, Y) :- Y = X + 10.
foo2(X, Y) :- Y = X.
baz(X, X).
Index: tests/valid/semi_fail_in_non_ite.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/semi_fail_in_non_ite.m,v
retrieving revision 1.1
diff -u -b -r1.1 semi_fail_in_non_ite.m
--- tests/valid/semi_fail_in_non_ite.m 3 Nov 1998 01:36:00 -0000 1.1
+++ tests/valid/semi_fail_in_non_ite.m 27 Nov 2002 15:21:50 -0000
@@ -45,10 +45,10 @@
( if
some [B] ( q(A, B) ; r(A, B) )
then
- C is B * 10
+ C = B * 10
% s(B, C)
else
- C is A * 10
+ C = A * 10
% s(A, C)
),
% The second if-then-else cannot hijack the redoip/redofr slots
@@ -94,9 +94,9 @@
s(F, G) :-
F < 695,
(
- G is 10 * F
+ G = 10 * F
;
- G is 10 * F + 1
+ G = 10 * F + 1
).
:- pred print_list(list(int), io__state, io__state).
Index: tests/valid/uniq_mode_inf_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/uniq_mode_inf_bug.m,v
retrieving revision 1.1
diff -u -b -r1.1 uniq_mode_inf_bug.m
--- tests/valid/uniq_mode_inf_bug.m 11 Nov 1998 00:28:02 -0000 1.1
+++ tests/valid/uniq_mode_inf_bug.m 27 Nov 2002 15:22:00 -0000
@@ -31,7 +31,7 @@
count(X,Y,A),
occur(X,Z,B)
->
- W is A + B
+ W = A + B
;
fail
).
@@ -45,6 +45,6 @@
).
addx(X,X,W1,W) :-
- W is W1 + 1.
+ W = W1 + 1.
addx(X,Y,W1,W1) :-
X \= Y.
cvs diff: Diffing tests/warnings
Index: tests/warnings/duplicate_call.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/duplicate_call.m,v
retrieving revision 1.2
diff -u -b -r1.2 duplicate_call.m
--- tests/warnings/duplicate_call.m 21 May 1997 02:16:51 -0000 1.2
+++ tests/warnings/duplicate_call.m 27 Nov 2002 15:22:17 -0000
@@ -13,7 +13,7 @@
dup_call(Int1, Int2, Int) :-
called(Int1, Int2, Int3),
called(Int1, Int2, Int4),
- Int is Int3 + Int4.
+ Int = Int3 + Int4.
called(Int1, Int2, Int) :-
- Int is Int1 + Int2.
+ Int = Int1 + Int2.
Index: tests/warnings/unused_args_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/unused_args_test.m,v
retrieving revision 1.2
diff -u -b -r1.2 unused_args_test.m
--- tests/warnings/unused_args_test.m 21 May 1997 02:16:53 -0000 1.2
+++ tests/warnings/unused_args_test.m 27 Nov 2002 15:22:25 -0000
@@ -26,9 +26,8 @@
Used1 = f2(_)
),
nonrecursive(Useless),
- Used3 is Used2 + 1,
+ Used3 = Used2 + 1,
recursive(Useless, Used1, Used3).
-
nonrecursive(Useless) :-
(
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: 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