[m-rev.] diff: updates for things related to the mantis 103 bug fix

Zoltan Somogyi zs at csse.unimelb.edu.au
Tue Mar 8 18:42:25 AEDT 2011


Fix some things I found while chasing Mantis bug 103.

compiler/handle_options.m:
	Add a dump alias to make debugging lco easier.

compiler/instmap.m:
	Add a utility predicate for use by (a now-unneeded version of) lco.m.

compiler/unify_gen.m:
	Minor cleanups.

library/require.m:
	Add four-argument versions of expect and expect_not, to allow
	all uses of this_file to be replaced by $module, $pred.

NEWS:
	Document the new predicates in require.m, as well as expect_not/3,
	which I added earlier.

Zoltan.

cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.556
diff -u -b -r1.556 NEWS
--- NEWS	17 Feb 2011 07:19:30 -0000	1.556
+++ NEWS	8 Mar 2011 07:32:44 -0000
@@ -127,6 +127,13 @@
   the absence of a feature, while the predicates unexpected/2 and unexpected/3
   report an internal error in the program; all have function versions too.
   The predicate expect/3 calls unexpected if a condition isn't satisfied.
+  We now have expect/4 as well as expect/3. For expect/4 as well as expect/3,
+  the first and last arguments are the expected condition and the error message
+  respectively, but with expect/4, there are two arguments in the middle
+  to specify the location of the error (normally the name of the module
+  and of the predicate respectively). We also added expect_not/3 and
+  expect_not/4, which are like expect/3 and expect/4 respectively,
+  except they expect the condition to be *false*, not true.
 
 Changes to the Mercury compiler:
 
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/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.361
diff -u -b -r1.361 handle_options.m
--- compiler/handle_options.m	7 Mar 2011 03:59:24 -0000	1.361
+++ compiler/handle_options.m	7 Mar 2011 09:00:53 -0000
@@ -3045,6 +3045,7 @@
 convert_dump_alias("ctgc", "cdinpGDRS").
 convert_dump_alias("vars", "npBis").    % Var instantiations, liveness etc.
 convert_dump_alias("statevar", "gvCP").
+convert_dump_alias("lco", "agiuvzD").
 
 %-----------------------------------------------------------------------------%
 :- end_module handle_options.
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.69
diff -u -b -r1.69 instmap.m
--- compiler/instmap.m	15 Dec 2010 06:29:40 -0000	1.69
+++ compiler/instmap.m	7 Mar 2011 08:45:48 -0000
@@ -139,6 +139,12 @@
 :- pred instmap_delta_search_var(instmap_delta::in, prog_var::in,
     mer_inst::out) is semidet.
 
+    % Given an instmap_delta and a variable, determine the new inst
+    % of that variable (which must have one).
+    %
+:- pred instmap_delta_lookup_var(instmap_delta::in, prog_var::in,
+    mer_inst::out) is det.
+
     % Given an instmap and a list of variables, return a list
     % containing the insts of those variable.
     %
@@ -430,9 +436,9 @@
 
 instmap_delta_from_mode_list_2([], [], _, !InstMapDelta).
 instmap_delta_from_mode_list_2([], [_ | _], _, !InstMapDelta) :-
-    unexpected(this_file, "instmap_delta_from_mode_list_2").
+    unexpected($module, $pred, "length mismatch").
 instmap_delta_from_mode_list_2([_ | _], [], _, !InstMapDelta) :-
-    unexpected(this_file, "instmap_delta_from_mode_list_2").
+    unexpected($module, $pred, "length mismatch").
 instmap_delta_from_mode_list_2([Var | Vars], [Mode | Modes], ModuleInfo,
         !InstMapDelta) :-
     mode_get_insts(ModuleInfo, Mode, Inst1, Inst2),
@@ -541,6 +547,13 @@
 instmap_delta_search_var(reachable(InstMap), Var, Inst) :-
     map.search(InstMap, Var, Inst).
 
+instmap_delta_lookup_var(InstMapDelta, Var, Inst) :-
+    ( instmap_delta_search_var(InstMapDelta, Var, InstPrime) ->
+        Inst = InstPrime
+    ;
+        unexpected($module, $pred, "var not in instmap")
+    ).
+
 instmap_lookup_vars(_InstMap, [], []).
 instmap_lookup_vars(InstMap, [Arg | Args], [Inst | Insts]) :-
     instmap_lookup_var(InstMap, Arg, Inst),
@@ -565,8 +578,7 @@
 
 instmapping_set_vars([], !InstMapping).
 instmapping_set_vars([Var - Inst | VarsInsts], !InstMapping) :-
-    expect(negate(unify(Inst, not_reached)), this_file,
-        "instmapping_set_vars: not_reached"),
+    expect(negate(unify(Inst, not_reached)), $module, $pred, "not_reached"),
     svmap.set(Var, Inst, !InstMapping),
     instmapping_set_vars(VarsInsts, !InstMapping).
 
@@ -588,16 +600,13 @@
 instmapping_set_vars_corresponding([], [], !InstMapping).
 instmapping_set_vars_corresponding([Var | Vars], [Inst | Insts],
         !InstMapping) :-
-    expect(negate(unify(Inst, not_reached)), this_file,
-        "instmapping_set_vars_corresponding: not_reached"),
+    expect(negate(unify(Inst, not_reached)), $module, $pred, "not_reached"),
     svmap.set(Var, Inst, !InstMapping),
     instmapping_set_vars_corresponding(Vars, Insts, !InstMapping).
 instmapping_set_vars_corresponding([_ | _], [], !InstMapping) :-
-    unexpected(this_file,
-        "instmapping_set_vars_corresponding: length mismatch (1)").
+    unexpected($module, $pred, "length mismatch (1)").
 instmapping_set_vars_corresponding([], [_ | _], !InstMapingp) :-
-    unexpected(this_file,
-        "instmapping_set_vars_corresponding: length mismatch (2)").
+    unexpected($module, $pred, "length mismatch (2)").
 
 instmap_set_vars_same(Inst, Vars, !InstMap) :-
     (
@@ -605,8 +614,8 @@
         % Leave the instmap as it is.
     ;
         !.InstMap = reachable(InstMapping0),
-        expect(negate(unify(Inst, not_reached)), this_file,
-            "instmap_set_vars_same: not_reached"),
+        expect(negate(unify(Inst, not_reached)), $module, $pred,
+            "not_reached"),
         instmapping_set_vars_same(Inst, Vars, InstMapping0, InstMapping),
         !:InstMap = reachable(InstMapping)
     ).
@@ -634,8 +643,8 @@
         % Leave the instmap as it is.
     ;
         !.InstMapDelta = reachable(InstMapping0),
-        expect(negate(unify(Inst, not_reached)), this_file,
-            "instmap_delta_set_vars_same: not_reached"),
+        expect(negate(unify(Inst, not_reached)), $module, $pred,
+            "not_reached"),
         instmapping_set_vars_same(Inst, Vars, InstMapping0, InstMapping),
         !:InstMapDelta = reachable(InstMapping)
     ).
@@ -731,7 +740,7 @@
     ->
         true
     ;
-        unexpected(this_file, "bind_inst_to_functor: mode error")
+        unexpected($module, $pred, "mode error")
     ).
 
 :- pred bind_inst_to_functors(mer_type::in, cons_id::in, list(cons_id)::in,
@@ -754,8 +763,7 @@
         % should come only after mode checking has been done without finding
         % any errors. Finding an error now would mean that some compiler pass
         % executed between mode checking and how has screwed up.
-        unexpected(this_file,
-            "bind_inst_to_functors: no MaybeMergedInst")
+        unexpected($module, $pred, "no MaybeMergedInst")
     ).
 
 :- pred bind_inst_to_functors_others(mer_type::in, list(cons_id)::in,
@@ -1036,8 +1044,7 @@
         [], MergedDeltas, !ModuleInfo),
     (
         MergedDeltas = [],
-        unexpected(this_file,
-            "merge_instmap_deltas: empty instmap_delta list.")
+        unexpected($module, $pred, "empty instmap_delta list.")
     ;
         MergedDeltas = [MergedDelta]
     ;
@@ -1327,7 +1334,7 @@
         term.var_to_int(Var, VarInt),
         string.format("merge_instmapping_delta_2: error merging var %i",
             [i(VarInt)], Msg),
-        unexpected(this_file, Msg)
+        unexpected($module, $pred, Msg)
     ),
     merge_instmapping_delta_2(Vars, InstMap, VarTypes,
         InstMappingA, InstMappingB, !InstMapping, !ModuleInfo).
@@ -1380,8 +1387,7 @@
             ->
                 svmap.det_insert(Var, Inst, !InstMapping)
             ;
-                unexpected(this_file,
-                    "unify_instmapping_delta_2: unexpected error")
+                unexpected($module, $pred, "unexpected error")
             )
         ;
             svmap.det_insert(Var, InstA, !InstMapping)
@@ -1453,9 +1459,3 @@
     inst_is_bound(ModuleInfo, VarInst).
 
 %-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "instmap.m".
-
-%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.201
diff -u -b -r1.201 unify_gen.m
--- compiler/unify_gen.m	13 Jan 2011 00:36:54 -0000	1.201
+++ compiler/unify_gen.m	7 Mar 2011 05:57:37 -0000
@@ -109,7 +109,7 @@
         CodeModel = model_semi
     ;
         CodeModel = model_non,
-        unexpected(this_file, "nondet unification in generate_unification")
+        unexpected($module, $pred, "nondet unification")
     ),
     (
         Uni = assign(Left, Right),
@@ -174,7 +174,7 @@
     ;
         Uni = simple_test(Var1, Var2),
         ( CodeModel = model_det ->
-            unexpected(this_file, "det simple_test during code generation")
+            unexpected($module, $pred, "det simple_test")
         ;
             generate_test(Var1, Var2, Code, !CI)
         )
@@ -182,7 +182,7 @@
         % These should have been transformed into calls to unification
         % procedures by polymorphism.m.
         Uni = complicated_unify(_UniMode, _CanFail, _TypeInfoVars),
-        unexpected(this_file, "complicated unify during code generation")
+        unexpected($module, $pred, "complicated unify")
     ).
 
 %---------------------------------------------------------------------------%
@@ -361,7 +361,7 @@
         TestRval = binop(eq, Rval, const(llconst_int(Int)))
     ;
         ConsTag = foreign_tag(ForeignLang, ForeignVal),
-        expect(unify(ForeignLang, lang_c), this_file,
+        expect(unify(ForeignLang, lang_c), $module, $pred,
             "foreign tag for language other than C"),
         TestRval = binop(eq, Rval,
             const(llconst_foreign(ForeignVal, lt_integer)))
@@ -369,23 +369,23 @@
         ConsTag = closure_tag(_, _, _),
         % This should never happen, since the error will be detected
         % during mode checking.
-        unexpected(this_file, "Attempted higher-order unification")
+        unexpected($module, $pred, "Attempted higher-order unification")
     ;
         ConsTag = type_ctor_info_tag(_, _, _),
-        unexpected(this_file, "Attempted type_ctor_info unification")
+        unexpected($module, $pred, "Attempted type_ctor_info unification")
     ;
         ConsTag = base_typeclass_info_tag(_, _, _),
-        unexpected(this_file, "Attempted base_typeclass_info unification")
+        unexpected($module, $pred, "Attempted base_typeclass_info unification")
     ;
         ConsTag = tabling_info_tag(_, _),
-        unexpected(this_file, "Attempted tabling_info unification")
+        unexpected($module, $pred, "Attempted tabling_info unification")
     ;
         ConsTag = deep_profiling_proc_layout_tag(_, _),
-        unexpected(this_file,
+        unexpected($module, $pred,
             "Attempted deep_profiling_proc_layout_tag unification")
     ;
         ConsTag = table_io_decl_tag(_, _),
-        unexpected(this_file, "Attempted table_io_decl_tag unification")
+        unexpected($module, $pred, "Attempted table_io_decl_tag unification")
     ;
         ConsTag = no_tag,
         TestRval = const(llconst_true)
@@ -433,7 +433,7 @@
 generate_reserved_address(small_pointer(N)) = const(llconst_int(N)).
 generate_reserved_address(reserved_object(_, _, _)) = _ :-
     % These should only be used for the MLDS back-end.
-    unexpected(this_file, "reserved_object").
+    unexpected($module, $pred, "reserved_object").
 
 %---------------------------------------------------------------------------%
 
@@ -475,7 +475,7 @@
         Code = empty
     ;
         ConsTag = foreign_tag(Lang, Val),
-        expect(unify(Lang, lang_c), this_file,
+        expect(unify(Lang, lang_c), $module, $pred,
             "foreign_tag for language other than C"),
         ForeignConst = const(llconst_foreign(Val, lt_integer)),
         assign_const_to_var(Var, ForeignConst, !CI),
@@ -496,12 +496,10 @@
                 generate_sub_unify(ref(Var), ref(Arg), Mode, Type, Code, !CI)
             ;
                 TakeAddr = [_ | _],
-                unexpected(this_file,
-                    "generate_construction_2: notag: take_addr")
+                unexpected($module, $pred, "notag: take_addr")
             )
         ;
-            unexpected(this_file,
-                "generate_construction_2: no_tag: arity != 1")
+            unexpected($module, $pred, "no_tag: arity != 1")
         )
     ;
         (
@@ -532,7 +530,7 @@
         Code = empty
     ;
         ConsTag = type_ctor_info_tag(ModuleName, TypeName, TypeArity),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: type_ctor_info constant has args"),
         RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
         DataId = rtti_data_id(ctor_rtti_id(RttiTypeCtor,
@@ -541,7 +539,7 @@
         Code = empty
     ;
         ConsTag = base_typeclass_info_tag(ModuleName, ClassId, Instance),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: base_typeclass_info constant has args"),
         TCName = generate_class_name(ClassId),
         DataId = rtti_data_id(tc_rtti_id(TCName,
@@ -550,7 +548,7 @@
         Code = empty
     ;
         ConsTag = tabling_info_tag(PredId, ProcId),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: tabling_info constant has args"),
         get_module_info(!.CI, ModuleInfo),
         ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
@@ -559,7 +557,7 @@
         Code = empty
     ;
         ConsTag = deep_profiling_proc_layout_tag(PredId, ProcId),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: deep_profiling_proc_static has args"),
         get_module_info(!.CI, ModuleInfo),
         RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
@@ -575,7 +573,7 @@
         Code = empty
     ;
         ConsTag = table_io_decl_tag(PredId, ProcId),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: table_io_decl has args"),
         PredProcId = proc(PredId, ProcId),
         DataId = layout_slot_id(table_io_decl_id, PredProcId),
@@ -583,7 +581,7 @@
         Code = empty
     ;
         ConsTag = reserved_address_tag(RA),
-        expect(unify(Args, []), this_file,
+        expect(unify(Args, []), $module, $pred,
             "generate_construction_2: reserved_address constant has args"),
         assign_const_to_var(Var, generate_reserved_address(RA), !CI),
         Code = empty
@@ -596,9 +594,9 @@
             TakeAddr, MaybeSize, GoalInfo, Code, !CI)
     ;
         ConsTag = closure_tag(PredId, ProcId, EvalMethod),
-        expect(unify(TakeAddr, []), this_file,
+        expect(unify(TakeAddr, []), $module, $pred,
             "generate_construction_2: closure_tag has take_addr"),
-        expect(unify(MaybeSize, no), this_file,
+        expect(unify(MaybeSize, no), $module, $pred,
             "generate_construction_2: closure_tag has size"),
         generate_closure(PredId, ProcId, EvalMethod, Var, Args, GoalInfo,
             Code, !CI)
@@ -828,7 +826,7 @@
 
 generate_pred_args(_, _, [], _, [], !MayUseAtomic).
 generate_pred_args(_, _, [_ | _], [], _, !MayUseAtomic) :-
-    unexpected(this_file, "generate_pred_args: insufficient args").
+    unexpected($module, $pred, "insufficient args").
 generate_pred_args(CI, VarTypes, [Var | Vars], [ArgInfo | ArgInfos],
         [MaybeRval | MaybeRvals], !MayUseAtomic) :-
     ArgInfo = arg_info(_, ArgMode),
@@ -870,7 +868,7 @@
     ->
         true
     ;
-        unexpected(this_file, "generate_cons_args: length mismatch")
+        unexpected($module, $pred, "length mismatch")
     ).
 
     % Create a list of maybe(rval) for the arguments for a construction
@@ -1059,7 +1057,7 @@
         Code = empty
     ;
         Tag = table_io_decl_tag(_, _),
-        unexpected(this_file, "generate_det_deconstruction: table_io_decl_tag")
+        unexpected($module, $pred, "table_io_decl_tag")
     ;
         Tag = no_tag,
         (
@@ -1091,8 +1089,7 @@
                     !CI)
             )
         ;
-            unexpected(this_file,
-                "generate_det_deconstruction: no_tag: arity != 1")
+            unexpected($module, $pred, "no_tag: arity != 1")
         )
     ;
         Tag = single_functor_tag,
@@ -1155,7 +1152,7 @@
     ( generate_unify_args_2(Ls, Rs, Ms, Ts, Code0, !CI) ->
         Code = Code0
     ;
-        unexpected(this_file, "generate_unify_args: length mismatch")
+        unexpected($module, $pred, "length mismatch")
     ).
 
 :- pred generate_unify_args_2(list(uni_val)::in, list(uni_val)::in,
@@ -1188,7 +1185,7 @@
         % This shouldn't happen, since mode analysis should avoid creating
         % any tests in the arguments of a construction or deconstruction
         % unification.
-        unexpected(this_file, "test in arg of [de]construction")
+        unexpected($module, $pred, "test in arg of [de]construction")
     ;
         % Input - Output== assignment ->
         LeftMode = top_in,
@@ -1209,7 +1206,7 @@
         % free-free - ignore
         % XXX I think this will have to change if we start to support aliasing.
     ;
-        unexpected(this_file, "generate_sub_unify: some strange unify")
+        unexpected($module, $pred, "some strange unify")
     ).
 
 %---------------------------------------------------------------------------%
@@ -1222,7 +1219,7 @@
         Left = lval(_Lval),
         Right = lval(_Rval),
         % Assignment between two lvalues - cannot happen.
-        unexpected(this_file, "generate_sub_assign: lval/lval")
+        unexpected($module, $pred, "lval/lval")
     ;
         Left = lval(Lval0),
         Right = ref(Var),
@@ -1282,18 +1279,17 @@
                     GroundTerm = Rval - _,
                     assign_const_to_var(TermVar, Rval, !CI)
                 ;
-                    unexpected(this_file,
-                        "generate_ground_term: no active pairs")
+                    unexpected($module, $pred, "no active pairs")
                 )
             ;
-                unexpected(this_file, "generate_ground_term: malformed goal")
+                unexpected($module, $pred, "malformed goal")
             )
         ;
-            unexpected(this_file, "generate_ground_term: unexpected nonlocal")
+            unexpected($module, $pred, "unexpected nonlocal")
         )
     ;
         NonLocalList = [_, _ | _],
-        unexpected(this_file, "generate_ground_term: unexpected nonlocals")
+        unexpected($module, $pred, "unexpected nonlocals")
     ).
 
 :- pred generate_ground_term_conjuncts(module_info::in,
@@ -1327,8 +1323,7 @@
         generate_ground_term_conjunct_tag(Var, ConsTag, Args, UnboxedFloats,
             !StaticCellInfo, !ActiveMap)
     ;
-        unexpected(this_file,
-            "generate_ground_term_conjunct: malformed goal")
+        unexpected($module, $pred, "malformed goal")
     ).
 
 :- pred generate_ground_term_conjunct_tag(prog_var::in, cons_tag::in,
@@ -1349,7 +1344,7 @@
             Type = lt_integer
         ;
             ConsTag = foreign_tag(Lang, Val),
-            expect(unify(Lang, lang_c), this_file,
+            expect(unify(Lang, lang_c), $module, $pred,
                 "foreign_tag for language other than C"),
             Const = llconst_foreign(Val, lt_integer),
             Type = lt_integer
@@ -1385,16 +1380,14 @@
         ConsTag = no_tag,
         (
             Args = [],
-            unexpected(this_file,
-                "generate_ground_term_conjunct_tag: no_tag arity != 1")
+            unexpected($module, $pred, "no_tag arity != 1")
         ;
             Args = [Arg],
             svmap.det_remove(Arg, RvalType, !ActiveMap),
             svmap.det_insert(Var, RvalType, !ActiveMap)
         ;
             Args = [_, _ | _],
-            unexpected(this_file,
-                "generate_ground_term_conjunct_tag: no_tag arity != 1")
+            unexpected($module, $pred, "no_tag arity != 1")
         )
     ;
         (
@@ -1429,8 +1422,7 @@
         ; ConsTag = table_io_decl_tag(_, _)
         ; ConsTag = deep_profiling_proc_layout_tag(_, _)
         ),
-        unexpected(this_file,
-            "generate_ground_term_conjunct_tag: unexpected tag")
+        unexpected($module, $pred, "unexpected tag")
     ).
 
 :- pred generate_ground_term_args(list(prog_var)::in,
@@ -1453,15 +1445,10 @@
         string.int_to_string(TypeArity, TypeArityStr),
         string.append_list([TypeSymStr, "/", TypeArityStr], Msg)
     ;
-        unexpected(this_file, "type is still a type variable in var_type_msg")
+        unexpected($module, $pred,
+            "type is still a type variable in var_type_msg")
     ).
 
 %---------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "unify_gen.m".
-
-%---------------------------------------------------------------------------%
 :- end_module unify_gen.
 %---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
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/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/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/require.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/require.m,v
retrieving revision 1.44
diff -u -b -r1.44 require.m
--- library/require.m	7 Mar 2011 03:59:35 -0000	1.44
+++ library/require.m	7 Mar 2011 05:50:39 -0000
@@ -45,7 +45,7 @@
 :- func sorry(string, string) = _ is erroneous.
 :- pred sorry(string::in, string::in) is erroneous.
 
-    % sorry(Module, Proc What):
+    % sorry(Module, Proc, What):
     %
     % Call error/1 with the string
     % "Module: Proc: Sorry, not implemented: What".
@@ -94,12 +94,26 @@
     %
 :- pred expect((pred)::((pred) is semidet), string::in, string::in) is det.
 
+    % expect(Goal, Module, Proc, Message):
+    %
+    % Call Goal, and call unexpected(Module, Proc, Message) if Goal fails.
+    %
+:- pred expect((pred)::((pred) is semidet), string::in, string::in,
+    string::in) is det.
+
     % expect_not(Goal, Module, Message):
     %
     % Call Goal, and call unexpected(Module, Message) if Goal succeeds.
     %
 :- pred expect_not((pred)::((pred) is semidet), string::in, string::in) is det.
 
+    % expect_not(Goal, Module, Proc, Message):
+    %
+    % Call Goal, and call unexpected(Module, Proc, Message) if Goal succeeds.
+    %
+:- pred expect_not((pred)::((pred) is semidet), string::in, string::in,
+    string::in) is det.
+
 %-----------------------------------------------------------------------------%
 
     % report_lookup_error(Message, Key):
@@ -194,6 +208,13 @@
         unexpected(Module, Message)
     ).
 
+expect(Goal, Module, Proc, Message) :-
+    ( Goal ->
+        true
+    ;
+        unexpected(Module, Proc, Message)
+    ).
+
 expect_not(Goal, Module, Message) :-
     ( Goal ->
         unexpected(Module, Message)
@@ -201,6 +222,13 @@
         true
     ).
 
+expect_not(Goal, Module, Proc, Message) :-
+    ( Goal ->
+        unexpected(Module, Proc, Message)
+    ;
+        true
+    ).
+
 %-----------------------------------------------------------------------------%
 
 report_lookup_error(Msg, K) :-
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list