[m-rev.] for post-commit review: rbmm disjunct commit fix
Zoltan Somogyi
zs at csse.unimelb.edu.au
Sun Dec 30 15:08:53 AEDT 2007
For post-commit review by Quan.
Zoltan.
Fix a problem in region handling spotted by Quan Phan: when a model_semi
disjunction commits to a non-last disjunct, we need to clean up the disj frame
it allocated.
This diff should have no effect in non-rbmm grades.
compiler/disj_gen.m:
In model_semi disjunctions, invoke a cleanup instruction on exit from
non-last disjuncts.
compiler/llds.m:
Add a representation for this cleanup instruction as a new region op.
compiler/llds_out.m:
compiler/opt_debug.m:
Handle the new region op.
runtime/mercury_region.h:
Add a draft implementation of this cleanup instruction; the remainder
is up to Quan.
tests/hard_coded/semi_disj.{m,exp}:
New test case to test the fix (for now, only by examining the generated
C code).
tests/hard_coded/Mmakefile:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/disj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/disj_gen.m,v
retrieving revision 1.107
diff -u -b -r1.107 disj_gen.m
--- compiler/disj_gen.m 26 Nov 2007 05:13:19 -0000 1.107
+++ compiler/disj_gen.m 29 Dec 2007 10:36:14 -0000
@@ -362,8 +362,9 @@
maybe_save_hp(ReclaimHeap, SaveHpCode, MaybeHpSlot, !CI),
maybe_create_disj_region_frame(AddRegionOps, DisjGoalInfo,
- FirstRegionCode, LaterRegionCode, LastRegionCode,
- _RegionStackVars, !CI),
+ do_not_commit_at_end_of_disjunct,
+ BeforeEnterRegionCode, LaterRegionCode, LastRegionCode,
+ _RegionStackVars, RegionCommitDisjCleanup, !CI),
% We can't release any of the stack slots holding the embedded stack
% frame, since we can't let code to the right of the disjunction reuse
% any of those slots.
@@ -385,10 +386,11 @@
MaybeRbmmInfo = goal_info_get_maybe_rbmm(DisjGoalInfo),
(
MaybeRbmmInfo = no,
- FirstRegionCode = empty,
+ BeforeEnterRegionCode = empty,
LaterRegionCode = empty,
LastRegionCode = empty,
- RegionStackVarsToRelease = []
+ RegionStackVarsToRelease = [],
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup
;
MaybeRbmmInfo = yes(RbmmInfo),
RbmmInfo = rbmm_goal_info(DisjCreatedRegionVars,
@@ -399,16 +401,18 @@
set.empty(DisjRemovedRegionVars),
set.empty(DisjAllocRegionVars)
->
- FirstRegionCode = empty,
+ BeforeEnterRegionCode = empty,
LaterRegionCode = empty,
LastRegionCode = empty,
- RegionStackVarsToRelease = []
+ RegionStackVarsToRelease = [],
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup
;
% We only need region support for backtracking if some disjunct
% performs some region operations (allocation or removal).
maybe_create_disj_region_frame(AddRegionOps, DisjGoalInfo,
- FirstRegionCode, LaterRegionCode, LastRegionCode,
- RegionStackVars, !CI),
+ commit_at_end_of_disjunct,
+ BeforeEnterRegionCode, LaterRegionCode, LastRegionCode,
+ RegionStackVars, RegionCommitDisjCleanup, !CI),
RegionStackVarsToRelease = RegionStackVars
)
)
@@ -422,9 +426,9 @@
remember_position(!.CI, BranchStart),
generate_disjuncts(Goals, CodeModel, ResumeMap, no, HijackInfo,
- DisjGoalInfo, EndLabel, ReclaimHeap, MaybeHpSlot, MaybeTicketSlot,
- LaterRegionCode, LastRegionCode, BranchStart, no, MaybeEnd, GoalsCode,
- !CI),
+ DisjGoalInfo, RegionCommitDisjCleanup, EndLabel, ReclaimHeap,
+ MaybeHpSlot, MaybeTicketSlot, LaterRegionCode, LastRegionCode,
+ BranchStart, no, MaybeEnd, GoalsCode, !CI),
goal_info_get_store_map(DisjGoalInfo, StoreMap),
after_all_branches(StoreMap, MaybeEnd, !CI),
@@ -444,22 +448,23 @@
FlushCode,
SaveTicketCode,
SaveHpCode,
- FirstRegionCode,
+ BeforeEnterRegionCode,
PrepareHijackCode,
GoalsCode
]).
:- pred generate_disjuncts(list(hlds_goal)::in, code_model::in,
resume_map::in, maybe(resume_point_info)::in, disj_hijack_info::in,
- hlds_goal_info::in, label::in, bool::in, maybe(lval)::in,
- maybe(lval)::in, code_tree::in, code_tree::in,
+ hlds_goal_info::in, commit_disj_region_cleanup::in, label::in, bool::in,
+ maybe(lval)::in, maybe(lval)::in, code_tree::in, code_tree::in,
position_info::in, maybe(branch_end_info)::in, maybe(branch_end_info)::out,
code_tree::out, code_info::in, code_info::out) is det.
-generate_disjuncts([], _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_disjuncts([], _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
unexpected(this_file, "generate_disjuncts: empty disjunction!").
generate_disjuncts([Goal0 | Goals], CodeModel, FullResumeMap,
- MaybeEntryResumePoint, HijackInfo, DisjGoalInfo, EndLabel, ReclaimHeap,
+ MaybeEntryResumePoint, HijackInfo, DisjGoalInfo,
+ RegionCommitDisjCleanup, EndLabel, ReclaimHeap,
MaybeHpSlot0, MaybeTicketSlot, LaterRegionCode, LastRegionCode,
BranchStart0, MaybeEnd0, MaybeEnd, Code, !CI) :-
@@ -582,14 +587,25 @@
goal_info_get_store_map(DisjGoalInfo, StoreMap),
generate_branch_end(StoreMap, MaybeEnd0, MaybeEnd1, SaveCode, !CI),
+ (
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup,
BranchCode = node([
llds_instr(goto(code_label(EndLabel)),
- "skip to end of nondet disj")
- ]),
+ "skip to end of disjunction")
+ ])
+ ;
+ RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
+ _CleanupCode),
+ BranchCode = node([
+ llds_instr(goto(code_label(CleanupLabel)),
+ "skip to end of disjunction after nonlast region disjunct")
+ ])
+ ),
generate_disjuncts(Goals, CodeModel, FullResumeMap,
yes(NextResumePoint), HijackInfo, DisjGoalInfo,
- EndLabel, ReclaimHeap, MaybeHpSlot, MaybeTicketSlot,
+ RegionCommitDisjCleanup, EndLabel,
+ ReclaimHeap, MaybeHpSlot, MaybeTicketSlot,
LaterRegionCode, LastRegionCode, BranchStart,
MaybeEnd1, MaybeEnd, RestCode, !CI),
@@ -626,9 +642,26 @@
goal_info_get_store_map(DisjGoalInfo, StoreMap),
generate_branch_end(StoreMap, MaybeEnd0, MaybeEnd, SaveCode, !CI),
- EndCode = node([
- llds_instr(label(EndLabel), "End of nondet disj")
+ (
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup,
+ RegionCleanupCode = empty
+ ;
+ RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
+ CleanupCode),
+ RegionCleanupStartCode = node([
+ llds_instr(goto(code_label(EndLabel)),
+ "Skip over cleanup code at end of disjunction"),
+ llds_instr(label(CleanupLabel),
+ "Cleanup at end of disjunction")
+ ]),
+ RegionCleanupCode = tree(RegionCleanupStartCode, CleanupCode)
+ ),
+
+ EndLabelCode = node([
+ llds_instr(label(EndLabel),
+ "End of disjunction")
]),
+
Code = tree_list([
EntryResumePointCode,
TraceCode, % XXX Should this be after LastRegionCode?
@@ -638,24 +671,39 @@
UndoCode,
GoalCode,
SaveCode,
- EndCode
+ RegionCleanupCode,
+ EndLabelCode
])
).
%-----------------------------------------------------------------------------%
+:- type commit_at_end_of_disjunct
+ ---> commit_at_end_of_disjunct
+ ; do_not_commit_at_end_of_disjunct.
+
+:- type commit_disj_region_cleanup
+ ---> no_commit_disj_region_cleanup
+ ; commit_disj_region_cleanup(
+ cleanup_label :: label,
+ cleanup_code :: code_tree
+ ).
+
:- pred maybe_create_disj_region_frame(add_region_ops::in, hlds_goal_info::in,
+ commit_at_end_of_disjunct::in,
code_tree::out, code_tree::out, code_tree::out, list(lval)::out,
- code_info::in, code_info::out) is det.
+ commit_disj_region_cleanup::out, code_info::in, code_info::out) is det.
maybe_create_disj_region_frame(DisjRegionOps, _DisjGoalInfo,
- FirstCode, LaterCode, LastCode, StackVars, !CI) :-
+ CommitAtEndOfDisjunct, BeforeEnterCode, LaterCode, LastCode,
+ StackVars, RegionCommitDisjCleanup, !CI) :-
(
DisjRegionOps = do_not_add_region_ops,
- FirstCode = empty,
+ BeforeEnterCode = empty,
LaterCode = empty,
LastCode = empty,
- StackVars = []
+ StackVars = [],
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup
;
DisjRegionOps = add_region_ops,
get_forward_live_vars(!.CI, ForwardLiveVars),
@@ -735,7 +783,7 @@
release_reg(SnapshotNumRegLval, !CI),
release_reg(AddrRegLval, !CI),
- FirstCode = tree_list([
+ BeforeEnterCode = tree_list([
PushInitCode,
ProtectRegionCode,
SnapshotRegionCode,
@@ -752,7 +800,23 @@
use_and_maybe_pop_region_frame(region_disj_last,
EmbeddedStackFrame),
"region enter last disjunct")
- ])
+ ]),
+
+ (
+ CommitAtEndOfDisjunct = do_not_commit_at_end_of_disjunct,
+ RegionCommitDisjCleanup = no_commit_disj_region_cleanup
+ ;
+ CommitAtEndOfDisjunct = commit_at_end_of_disjunct,
+ get_next_label(CleanupLabel, !CI),
+ CleanupCode = node([
+ llds_instr(
+ use_and_maybe_pop_region_frame(
+ region_disj_nonlast_semi_commit, EmbeddedStackFrame),
+ "region cleanup commit for nonlast disjunct")
+ ]),
+ RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
+ CleanupCode)
+ )
).
:- pred disj_protect_regions(lval::in, lval::in, embedded_stack_frame_id::in,
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.354
diff -u -b -r1.354 llds.m
--- compiler/llds.m 11 Oct 2007 11:45:18 -0000 1.354
+++ compiler/llds.m 29 Dec 2007 03:36:00 -0000
@@ -788,6 +788,7 @@
; region_ite_nondet_cond_fail % pops
; region_disj_later % uses
; region_disj_last % uses and pops
+ ; region_disj_nonlast_semi_commit % uses and pops
; region_commit_success % uses and pops
; region_commit_failure. % only pops
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.319
diff -u -b -r1.319 llds_out.m
--- compiler/llds_out.m 23 Nov 2007 07:35:09 -0000 1.319
+++ compiler/llds_out.m 29 Dec 2007 03:37:42 -0000
@@ -2668,6 +2668,9 @@
UseOp = region_disj_last,
io.write_string("\tMR_use_region_disj_last", !IO)
;
+ UseOp = region_disj_nonlast_semi_commit,
+ io.write_string("\tMR_use_region_disj_nonlast_semi_commit", !IO)
+ ;
UseOp = region_commit_success,
io.write_string("\tMR_use_region_commit_success", !IO)
;
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.201
diff -u -b -r1.201 opt_debug.m
--- compiler/opt_debug.m 23 Nov 2007 04:30:01 -0000 1.201
+++ compiler/opt_debug.m 29 Dec 2007 03:40:32 -0000
@@ -892,6 +892,9 @@
UseOp = region_disj_last,
UseOpStr = "region_disj_last"
;
+ UseOp = region_disj_nonlast_semi_commit,
+ UseOpStr = "region_disj_nonlast_semi_commit"
+ ;
UseOp = region_commit_success,
UseOpStr = "region_commit_success"
;
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/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/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/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_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/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
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_region.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_region.h,v
retrieving revision 1.9
diff -u -b -r1.9 mercury_region.h
--- runtime/mercury_region.h 21 Dec 2007 14:18:59 -0000 1.9
+++ runtime/mercury_region.h 29 Dec 2007 03:35:41 -0000
@@ -613,6 +613,17 @@
MR_region_debug_end("use_region_disj_later"); \
} while (0)
+#define MR_use_region_disj_nonlast_semi_commit(disj_sp) \
+ do { \
+ MR_RegionDisjFixedFrame *top_disj_frame; \
+ \
+ MR_region_debug_start("use_region_disj_nonlast_semi_commit"); \
+ top_disj_frame = (MR_RegionDisjFixedFrame *) (disj_sp); \
+ /* XXX destroy any regions protected by the disj frame */ \
+ MR_pop_region_disj_frame(top_disj_frame); \
+ MR_region_debug_end("use_region_disj_nonlast_semi_commit"); \
+ } while (0)
+
#define MR_use_region_disj_last(disj_sp) \
do { \
MR_RegionDisjFixedFrame *top_disj_frame; \
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/diff
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/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.337
diff -u -b -r1.337 Mmakefile
--- tests/hard_coded/Mmakefile 24 Oct 2007 00:50:01 -0000 1.337
+++ tests/hard_coded/Mmakefile 29 Dec 2007 14:16:20 -0000
@@ -11,8 +11,8 @@
array_test \
backquoted_qualified_ops \
bag_various \
- big_array_from_list \
bidirectional \
+ big_array_from_list \
boyer \
brace \
builtin_inst_rename \
@@ -191,6 +191,7 @@
rtree_test \
rtti_strings \
seek_test \
+ semi_disj \
setjmp_test \
shift_test \
solve_quadratic \
Index: tests/hard_coded/semi_disj.exp
===================================================================
RCS file: tests/hard_coded/semi_disj.exp
diff -N tests/hard_coded/semi_disj.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/semi_disj.exp 29 Dec 2007 14:15:20 -0000
@@ -0,0 +1,4 @@
+success: 11
+failure
+success: 13
+failure
Index: tests/hard_coded/semi_disj.m
===================================================================
RCS file: tests/hard_coded/semi_disj.m
diff -N tests/hard_coded/semi_disj.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/semi_disj.m 29 Dec 2007 14:08:17 -0000
@@ -0,0 +1,67 @@
+% vim: ft=mercury ts=4 sw=4 et
+
+:- module semi_disj.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+:- type t
+ ---> f(int)
+ ; g(int, int)
+ ; h(float)
+ ; i(string).
+
+:- type x
+ ---> xa
+ ; xb
+ ; xc
+ ; xd.
+
+main(!IO) :-
+ make_t(xa, 1, T1),
+ test(T1, 1, "a", !IO),
+ make_t(xb, 2, T2),
+ test(T2, 2, "b", !IO),
+ make_t(xc, 3, T3),
+ test(T3, 3, "c", !IO),
+ make_t(xd, 4, T4),
+ test(T4, 4, "d", !IO).
+
+:- pred test(t::in, int::in, string::in, io::di, io::uo) is det.
+
+test(T, I, S, !IO) :-
+ ( p(T, I, S, X) ->
+ io.format("success: %d\n", [i(X)], !IO)
+ ;
+ io.write_string("failure\n", !IO)
+ ).
+
+:- pred make_t(x::in, int::in, t::out) is det.
+
+make_t(xa, _, f(0)).
+make_t(xb, I, g(I, 1)).
+make_t(xc, _, h(2.2)).
+make_t(xd, _, i("three")).
+
+:- pred p(t::in, int::in, string::in, int::out) is semidet.
+
+p(T, I, S, X) :-
+ (
+ T = f(N),
+ P = [N],
+ list.length(P) < 2
+ ;
+ I = 3
+ ;
+ S = "cc"
+ ),
+ X = I + 10.
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list