[m-rev.] diff: cleanup LLDS backend
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Nov 11 14:34:42 AEDT 2003
This diff changes the LLDS backend to make it easier to read and to maintain,
but contains no changes in algorithms whatsoever.
compiler/basic_block.m:
compiler/dupelim.m:
compiler/frameopt.m:
compiler/jumpopt.m:
compiler/layout_out.m:
compiler/livemap.m:
compiler/peephole.m:
compiler/reassign.m:
compiler/rtti_out.m:
compiler/use_local_vars.m:
Convert these modules to our current coding standards. Use state
variable notation when appropriate, reordering arguments as necessary.
compiler/llds_out.m:
Convert these modules to our current coding standards. Use state
variable notation when appropriate, reordering arguments as necessary.
Delete predicates which are just specialized forms of foldl, using
foldl (or foldl2 etc) directly instead.
Factor out some common code.
compiler/livemap.m:
Convert these modules to our current coding standards. Use state
variable notation when appropriate, reordering arguments as necessary.
Remove some special case handling that used to be required by the value
numbering pass.
library/bintree_set.m:
Provide a function version of the initialization predicate.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/basic_block.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/basic_block.m,v
retrieving revision 1.14
diff -u -b -r1.14 basic_block.m
--- compiler/basic_block.m 14 Mar 2003 08:10:04 -0000 1.14
+++ compiler/basic_block.m 9 Nov 2003 07:59:48 -0000
@@ -55,14 +55,11 @@
:- import_module ll_backend__opt_util.
:- import_module bool, int, require.
-create_basic_blocks(Instrs0, Comments, ProcLabel, C0, C,
- LabelSeq, BlockMap) :-
+create_basic_blocks(Instrs0, Comments, ProcLabel, !C, LabelSeq, BlockMap) :-
opt_util__get_prologue(Instrs0, LabelInstr, Comments,
AfterLabelInstrs),
Instrs1 = [LabelInstr | AfterLabelInstrs],
- map__init(BlockMap0),
- build_block_map(Instrs1, LabelSeq, BlockMap0, BlockMap,
- ProcLabel, C0, C).
+ build_block_map(Instrs1, LabelSeq, ProcLabel, map__init, BlockMap, !C).
% Add labels to the given instruction sequence so that
% every basic block has labels around it.
@@ -70,27 +67,25 @@
%-----------------------------------------------------------------------------%
:- pred build_block_map(list(instruction)::in, list(label)::out,
- block_map::in, block_map::out, proc_label::in,
+ proc_label::in, block_map::in, block_map::out,
counter::in, counter::out) is det.
-build_block_map([], [], BlockMap, BlockMap, _, C, C).
-build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, BlockMap0, BlockMap,
- ProcLabel, C0, C) :-
+build_block_map([], [], _, !BlockMap, !C).
+build_block_map([OrigInstr0 | OrigInstrs0], LabelSeq, ProcLabel,
+ !BlockMap, !C) :-
( OrigInstr0 = label(OrigLabel) - _ ->
Label = OrigLabel,
LabelInstr = OrigInstr0,
- RestInstrs = OrigInstrs0,
- C1 = C0
+ RestInstrs = OrigInstrs0
;
- counter__allocate(N, C0, C1),
+ counter__allocate(N, !C),
Label = local(N, ProcLabel),
LabelInstr = label(Label) - "",
RestInstrs = [OrigInstr0 | OrigInstrs0]
),
(
take_until_end_of_block(RestInstrs, BlockInstrs, Instrs1),
- build_block_map(Instrs1, LabelSeq0,
- BlockMap0, BlockMap1, ProcLabel, C1, C),
+ build_block_map(Instrs1, LabelSeq0, ProcLabel, !BlockMap, !C),
( list__last(BlockInstrs, LastInstr) ->
LastInstr = LastUinstr - _,
opt_util__possible_targets(LastUinstr, SideLabels),
@@ -104,12 +99,11 @@
)
;
SideLabels = [],
- get_fallthrough_from_seq(LabelSeq0,
- MaybeFallThrough)
+ get_fallthrough_from_seq(LabelSeq0, MaybeFallThrough)
),
BlockInfo = block_info(Label, LabelInstr, BlockInstrs,
SideLabels, MaybeFallThrough),
- map__det_insert(BlockMap1, Label, BlockInfo, BlockMap),
+ map__det_insert(!.BlockMap, Label, BlockInfo, !:BlockMap),
LabelSeq = [Label | LabelSeq0]
).
Index: compiler/dupelim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupelim.m,v
retrieving revision 1.58
diff -u -b -r1.58 dupelim.m
--- compiler/dupelim.m 5 Nov 2003 03:17:36 -0000 1.58
+++ compiler/dupelim.m 9 Nov 2003 08:08:22 -0000
@@ -71,8 +71,8 @@
% OtherLabels must be nonempty.
:- type cluster ---> cluster(label, list(label)).
-dupelim_main(Instrs0, ProcLabel, C0, C, Instrs) :-
- create_basic_blocks(Instrs0, Comments, ProcLabel, C0, C,
+dupelim_main(Instrs0, ProcLabel, !C, Instrs) :-
+ create_basic_blocks(Instrs0, Comments, ProcLabel, !C,
LabelSeq0, BlockMap0),
map__init(StdMap0),
set__init(Fixed0),
@@ -103,21 +103,21 @@
:- pred dupelim__build_maps(list(label)::in, block_map::in,
std_map::in, std_map::out, set(label)::in, set(label)::out) is det.
-dupelim__build_maps([], _, StdMap, StdMap, Fixed, Fixed).
-dupelim__build_maps([Label | Labels], BlockMap, StdMap0, StdMap,
- Fixed0, Fixed) :-
+dupelim__build_maps([], _, !StdMap, !Fixed).
+dupelim__build_maps([Label | Labels], BlockMap, !StdMap, !Fixed) :-
map__lookup(BlockMap, Label, BlockInfo),
BlockInfo = block_info(_, _, Instrs, _, MaybeFallThrough),
standardize_instr_block(Instrs, MaybeFallThrough, StdInstrs),
- ( map__search(StdMap0, StdInstrs, Cluster) ->
- map__det_update(StdMap0, StdInstrs, [Label | Cluster], StdMap1)
+ ( map__search(!.StdMap, StdInstrs, Cluster) ->
+ map__det_update(!.StdMap, StdInstrs, [Label | Cluster],
+ !:StdMap)
;
- map__det_insert(StdMap0, StdInstrs, [Label], StdMap1)
+ map__det_insert(!.StdMap, StdInstrs, [Label], !:StdMap)
),
( MaybeFallThrough = yes(FallIntoLabel) ->
- set__insert(Fixed0, FallIntoLabel, Fixed1)
+ set__insert(!.Fixed, FallIntoLabel, !:Fixed)
;
- Fixed1 = Fixed0
+ true
),
AddPragmaReferredLabels =
(pred(Instr::in, FoldFixed0::in, FoldFixed::out) is det :-
@@ -147,10 +147,8 @@
FoldFixed = FoldFixed0
)
),
- list__foldl(AddPragmaReferredLabels, Instrs,
- Fixed1, Fixed2),
- dupelim__build_maps(Labels, BlockMap, StdMap1, StdMap,
- Fixed2, Fixed).
+ list__foldl(AddPragmaReferredLabels, Instrs, !Fixed),
+ dupelim__build_maps(Labels, BlockMap, !StdMap, !Fixed).
% For each set of labels that start basic blocks with identical standard forms,
% find_clusters finds out whether we can eliminate some of those blocks;
@@ -168,8 +166,8 @@
:- pred find_clusters(list(list(label))::in, set(label)::in,
list(cluster)::in, list(cluster)::out) is det.
-find_clusters([], _, Clusters, Clusters).
-find_clusters([Labels | LabelsList], Fixed, Clusters0, Clusters) :-
+find_clusters([], _, !Clusters).
+find_clusters([Labels | LabelsList], Fixed, !Clusters) :-
(
Labels = [_, _ | _],
% The rest of the condition is relatively expensive,
@@ -187,11 +185,11 @@
;
Cluster = cluster(FirstNonFixed, OtherNonFixed)
),
- Clusters1 = [Cluster | Clusters0]
+ !:Clusters = [Cluster | !.Clusters]
;
- Clusters1 = Clusters0
+ true
),
- find_clusters(LabelsList, Fixed, Clusters1, Clusters).
+ find_clusters(LabelsList, Fixed, !Clusters).
%-----------------------------------------------------------------------------%
@@ -205,23 +203,20 @@
block_map::in, block_map::out,
map(label, label)::in, map(label, label)::out) is det.
-process_clusters([], LabelSeq, LabelSeq, BlockMap, BlockMap,
- ReplMap, ReplMap).
-process_clusters([Cluster | Clusters], LabelSeq0, LabelSeq,
- BlockMap0, BlockMap, ReplMap0, ReplMap) :-
+process_clusters([], !LabelSeq, !BlockMap, !ReplMap).
+process_clusters([Cluster | Clusters], !LabelSeq, !BlockMap, !ReplMap) :-
Cluster = cluster(Exemplar, ElimLabels),
- map__lookup(BlockMap0, Exemplar, ExemplarInfo0),
+ map__lookup(!.BlockMap, Exemplar, ExemplarInfo0),
ExemplarInfo0 = block_info(ExLabel, ExLabelInstr, ExInstrs0,
ExSideLabels, ExMaybeFallThrough),
require(unify(Exemplar, ExLabel), "exemplar label mismatch"),
process_elim_labels(ElimLabels, ExInstrs0, ExMaybeFallThrough,
- LabelSeq0, LabelSeq1, BlockMap0, Exemplar, ReplMap0, ReplMap1,
+ !LabelSeq, !.BlockMap, Exemplar, !ReplMap,
UnifiedInstrs, UnifiedMaybeFallThrough),
ExemplarInfo = block_info(ExLabel, ExLabelInstr, UnifiedInstrs,
ExSideLabels, UnifiedMaybeFallThrough),
- map__det_update(BlockMap0, Exemplar, ExemplarInfo, BlockMap1),
- process_clusters(Clusters, LabelSeq1, LabelSeq, BlockMap1, BlockMap,
- ReplMap1, ReplMap).
+ map__det_update(!.BlockMap, Exemplar, ExemplarInfo, !:BlockMap),
+ process_clusters(Clusters, !LabelSeq, !BlockMap, !ReplMap).
% Given the current form of a basic block (instructions and fallthrough),
% compute its most specific generalization with the basic blocks headed
@@ -238,11 +233,11 @@
label::in, map(label, label)::in, map(label, label)::out,
list(instruction)::out, maybe(label)::out) is det.
-process_elim_labels([], Instrs, MaybeFT, LabelSeq, LabelSeq, _,
- _, ReplMap, ReplMap, Instrs, MaybeFT).
+process_elim_labels([], Instrs, MaybeFT, !LabelSeq, _,
+ _, !ReplMap, Instrs, MaybeFT).
process_elim_labels([ElimLabel | ElimLabels], Instrs0, MaybeFallThrough0,
- LabelSeq0, LabelSeq, BlockMap, Exemplar, ReplMap0, ReplMap,
- Instrs, MaybeFallThrough) :-
+ !LabelSeq, BlockMap, Exemplar, !ReplMap, Instrs,
+ MaybeFallThrough) :-
map__lookup(BlockMap, ElimLabel, ElimLabelInfo),
ElimLabelInfo = block_info(ElimLabel2, _, ElimInstrs,
_, ElimMaybeFallThrough),
@@ -252,11 +247,11 @@
ElimInstrs, ElimMaybeFallThrough,
Instrs1, MaybeFallThrough1)
->
- list__delete_all(LabelSeq0, ElimLabel, LabelSeq1),
- map__det_insert(ReplMap0, ElimLabel, Exemplar, ReplMap1),
+ list__delete_all(!.LabelSeq, ElimLabel, !:LabelSeq),
+ map__det_insert(!.ReplMap, ElimLabel, Exemplar, !:ReplMap),
process_elim_labels(ElimLabels, Instrs1, MaybeFallThrough1,
- LabelSeq1, LabelSeq, BlockMap,
- Exemplar, ReplMap1, ReplMap, Instrs, MaybeFallThrough)
+ !LabelSeq, BlockMap, Exemplar, !ReplMap, Instrs,
+ MaybeFallThrough)
;
error("blocks with same standard form don't antiunify")
).
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.82
diff -u -b -r1.82 frameopt.m
--- compiler/frameopt.m 15 Mar 2003 03:08:45 -0000 1.82
+++ compiler/frameopt.m 9 Nov 2003 06:07:07 -0000
@@ -114,38 +114,36 @@
:- import_module int, string, require, std_util, assoc_list, set, map, queue.
-frameopt_main(Instrs0, ProcLabel, C0, C, Instrs, Mod, Jumps) :-
+frameopt_main(Instrs0, ProcLabel, !C, Instrs, Mod, Jumps) :-
opt_util__get_prologue(Instrs0, LabelInstr, Comments0, Instrs1),
(
frameopt__detstack_setup(Instrs1, FrameSize, Msg, _, _, _)
->
map__init(BlockMap0),
- divide_into_basic_blocks([LabelInstr | Instrs1], ProcLabel, C0,
- BasicInstrs, C1),
+ divide_into_basic_blocks([LabelInstr | Instrs1], ProcLabel,
+ BasicInstrs, !C),
build_block_map(BasicInstrs, FrameSize, LabelSeq0,
- BlockMap0, BlockMap1, ProcLabel, C1, C2),
+ BlockMap0, BlockMap1, ProcLabel, !C),
analyze_block_map(LabelSeq0, BlockMap1, BlockMap2, KeepFrame),
(
KeepFrame = yes(FirstLabel - SecondLabel),
- can_clobber_succip(LabelSeq0, BlockMap2,
- CanClobberSuccip),
- keep_frame(LabelSeq0, BlockMap2,
- FirstLabel, SecondLabel, CanClobberSuccip,
- BlockMap),
+ CanClobberSuccip =
+ can_clobber_succip(LabelSeq0, BlockMap2),
+ keep_frame(LabelSeq0, FirstLabel, SecondLabel,
+ CanClobberSuccip, BlockMap2, BlockMap),
LabelSeq = LabelSeq0,
NewComment = comment("keeping stack frame") - "",
list__append(Comments0, [NewComment], Comments),
flatten_block_seq(LabelSeq, BlockMap, BodyInstrs),
list__append(Comments, BodyInstrs, Instrs),
- C = C2,
Mod = yes,
Jumps = yes
;
KeepFrame = no,
( can_delay_frame(LabelSeq0, BlockMap2, yes) ->
- delay_frame(LabelSeq0, BlockMap2,
- FrameSize, Msg, ProcLabel, C2, C,
- LabelSeq, BlockMap),
+ delay_frame(LabelSeq0, LabelSeq, FrameSize,
+ Msg, ProcLabel, !C,
+ BlockMap2, BlockMap),
NewComment = comment("delaying stack frame")
- "",
list__append(Comments0, [NewComment], Comments),
@@ -156,14 +154,12 @@
Jumps = no
;
Instrs = Instrs0,
- C = C0,
Mod = no,
Jumps = no
)
)
;
Instrs = Instrs0,
- C = C0,
Mod = no,
Jumps = no
).
@@ -221,36 +217,35 @@
% every basic block has labels around it.
:- pred divide_into_basic_blocks(list(instruction)::in, proc_label::in,
- counter::in, list(instruction)::out, counter::out) is det.
+ list(instruction)::out, counter::in, counter::out) is det.
-divide_into_basic_blocks([], _, C, [], C).
+divide_into_basic_blocks([], _, [], !C).
% Control can fall of the end of a procedure if that procedure
% ends with a call to another procedure that cannot succeed.
% This is the only situation in which the base case can be reached.
-divide_into_basic_blocks([Instr0 | Instrs0], ProcLabel, C0, Instrs, C) :-
+divide_into_basic_blocks([Instr0 | Instrs0], ProcLabel, Instrs, !C) :-
Instr0 = Uinstr0 - _Comment,
( opt_util__can_instr_branch_away(Uinstr0, yes) ->
(
Instrs0 = [Instr1 | _],
( Instr1 = label(_) - _ ->
divide_into_basic_blocks(Instrs0, ProcLabel,
- C0, Instrs1, C),
+ Instrs1, !C),
Instrs = [Instr0 | Instrs1]
;
- counter__allocate(N, C0, C1),
+ counter__allocate(N, !C),
NewLabel = local(N, ProcLabel),
NewInstr = label(NewLabel) - "",
divide_into_basic_blocks(Instrs0, ProcLabel,
- C1, Instrs1, C),
+ Instrs1, !C),
Instrs = [Instr0, NewInstr | Instrs1]
)
;
Instrs0 = [],
- Instrs = [Instr0],
- C = C0
+ Instrs = [Instr0]
)
;
- divide_into_basic_blocks(Instrs0, ProcLabel, C0, Instrs1, C),
+ divide_into_basic_blocks(Instrs0, ProcLabel, Instrs1, !C),
Instrs = [Instr0 | Instrs1]
).
@@ -280,9 +275,9 @@
block_map::in, block_map::out, proc_label::in,
counter::in, counter::out) is det.
-build_block_map([], _, [], BlockMap, BlockMap, _, C, C).
-build_block_map([Instr0 | Instrs0], FrameSize, LabelSeq, BlockMap0, BlockMap,
- ProcLabel, C0, C) :-
+build_block_map([], _, [], !BlockMap, _, !C).
+build_block_map([Instr0 | Instrs0], FrameSize, LabelSeq, !BlockMap,
+ ProcLabel, !C) :-
( Instr0 = label(Label) - _ ->
(
frameopt__detstack_setup(Instrs0, _, _, Setup,
@@ -298,17 +293,17 @@
Instrs1 = [Instr1 | _],
Instr1 = label(_) - _
->
- C1 = C0,
Instrs2 = Instrs1
;
- counter__allocate(N, C0, C1),
+ counter__allocate(N, !C),
NewLabel = local(N, ProcLabel),
NewInstr = label(NewLabel) - "",
Instrs2 = [NewInstr | Instrs1]
),
build_block_map(Instrs2, FrameSize, LabelSeq0,
- BlockMap0, BlockMap1, ProcLabel, C1, C),
- map__det_insert(BlockMap1, Label, BlockInfo, BlockMap),
+ !BlockMap, ProcLabel, !C),
+ map__det_insert(!.BlockMap, Label, BlockInfo,
+ !:BlockMap),
LabelSeq = [Label | LabelSeq0]
;
frameopt__detstack_teardown(Instrs0, FrameSize,
@@ -319,7 +314,6 @@
list__append(Succip, Teardown1, Teardown),
( Tail = [] ->
MaybeTailInfo = no,
- C1 = C0,
LabelledBlock = [Instr0 | Teardown],
TeardownLabel = Label,
TeardownInfo = block_info(TeardownLabel,
@@ -330,7 +324,7 @@
TailInfo = block_info(Label, [Instr0 | Tail],
[], no, ordinary(Needs)),
MaybeTailInfo = yes(TailInfo - Label),
- counter__allocate(N, C0, C1),
+ counter__allocate(N, !C),
NewLabel = local(N, ProcLabel),
NewInstr = label(NewLabel) - "",
LabelledBlock = [NewInstr | Teardown],
@@ -340,18 +334,18 @@
teardown(Succip, Livevals, Goto))
),
build_block_map(Remain, FrameSize, LabelSeq0,
- BlockMap0, BlockMap1, ProcLabel, C1, C),
+ !BlockMap, ProcLabel, !C),
(
MaybeTailInfo = no,
- map__det_insert(BlockMap1, TeardownLabel,
- TeardownInfo, BlockMap),
+ map__det_insert(!.BlockMap, TeardownLabel,
+ TeardownInfo, !:BlockMap),
LabelSeq = [TeardownLabel | LabelSeq0]
;
MaybeTailInfo = yes(TailInfo2 - TailLabel2),
- map__det_insert(BlockMap1, TeardownLabel,
- TeardownInfo, BlockMap2),
- map__det_insert(BlockMap2, TailLabel2,
- TailInfo2, BlockMap),
+ map__det_insert(!.BlockMap, TeardownLabel,
+ TeardownInfo, !:BlockMap),
+ map__det_insert(!.BlockMap, TailLabel2,
+ TailInfo2, !:BlockMap),
LabelSeq = [TailLabel2, TeardownLabel
| LabelSeq0]
)
@@ -361,8 +355,9 @@
BlockInfo = block_info(Label, [Instr0 | Block],
[], no, ordinary(Needs)),
build_block_map(Instrs1, FrameSize, LabelSeq0,
- BlockMap0, BlockMap1, ProcLabel, C0, C),
- map__det_insert(BlockMap1, Label, BlockInfo, BlockMap),
+ !BlockMap, ProcLabel, !C),
+ map__det_insert(!.BlockMap, Label, BlockInfo,
+ !:BlockMap),
LabelSeq = [Label | LabelSeq0]
)
;
@@ -452,9 +447,8 @@
fail
;
frameopt__detstack_teardown_2([Instr0 | Instrs0], FrameSize,
- [], [], [], [],
- ExtraPrime, SuccipPrime, DecrspPrime, LivevalsPrime,
- GotoPrime, RemainPrime)
+ [], ExtraPrime, [], SuccipPrime, [], DecrspPrime,
+ [], LivevalsPrime, GotoPrime, RemainPrime)
->
Extra = ExtraPrime,
Succip = SuccipPrime,
@@ -469,15 +463,14 @@
).
:- pred frameopt__detstack_teardown_2(list(instruction)::in, int::in,
- list(instruction)::in, list(instruction)::in,
- list(instruction)::in, list(instruction)::in,
- list(instruction)::out, list(instruction)::out,
- list(instruction)::out, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
+ list(instruction)::in, list(instruction)::out,
instruction::out, list(instruction)::out) is semidet.
frameopt__detstack_teardown_2(Instrs0, FrameSize,
- Extra0, Succip0, Decrsp0, Livevals0,
- Extra, Succip, Decrsp, Livevals, Goto, Remain) :-
+ !Extra, !Succip, !Decrsp, !Livevals, Goto, Remain) :-
opt_util__skip_comments(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
Instr1 = Uinstr1 - _,
@@ -487,41 +480,35 @@
Lval = succip,
Rval = lval(stackvar(FrameSize))
->
- Succip0 = [],
- Decrsp0 = [],
- Succip1 = [Instr1],
+ !.Succip = [],
+ !.Decrsp = [],
+ !:Succip = [Instr1],
frameopt__detstack_teardown_2(Instrs2, FrameSize,
- Extra0, Succip1, Decrsp0, Livevals0,
- Extra, Succip, Decrsp, Livevals, Goto, Remain)
+ !Extra, !Succip, !Decrsp, !Livevals,
+ Goto, Remain)
;
opt_util__lval_refers_stackvars(Lval, no),
opt_util__rval_refers_stackvars(Rval, no),
- list__append(Extra0, [Instr1], Extra1),
+ list__append(!.Extra, [Instr1], !:Extra),
frameopt__detstack_teardown_2(Instrs2, FrameSize,
- Extra1, Succip0, Decrsp0, Livevals0,
- Extra, Succip, Decrsp, Livevals, Goto, Remain)
+ !Extra, !Succip, !Decrsp, !Livevals,
+ Goto, Remain)
)
;
Uinstr1 = decr_sp(FrameSize),
- Decrsp0 = [],
- Decrsp1 = [Instr1],
+ !.Decrsp = [],
+ !:Decrsp = [Instr1],
frameopt__detstack_teardown_2(Instrs2, FrameSize,
- Extra0, Succip0, Decrsp1, Livevals0,
- Extra, Succip, Decrsp, Livevals, Goto, Remain)
+ !Extra, !Succip, !Decrsp, !Livevals, Goto, Remain)
;
Uinstr1 = livevals(_),
- Livevals0 = [],
- Livevals1 = [Instr1],
+ !.Livevals = [],
+ !:Livevals = [Instr1],
frameopt__detstack_teardown_2(Instrs2, FrameSize,
- Extra0, Succip0, Decrsp0, Livevals1,
- Extra, Succip, Decrsp, Livevals, Goto, Remain)
+ !Extra, !Succip, !Decrsp, !Livevals, Goto, Remain)
;
Uinstr1 = goto(_),
- Decrsp0 = [_],
- Extra = Extra0,
- Succip = Succip0,
- Decrsp = Decrsp0,
- Livevals = Livevals0,
+ !.Decrsp = [_],
Goto = Instr1,
Remain = Instrs2
).
@@ -586,17 +573,17 @@
% it in tailcalls that avoid the stack teardown, which is the label
% immediately after the initial stack setup block.
-:- pred analyze_block_map(list(label)::in, block_map::in,
- block_map::out, maybe(pair(label))::out) is det.
+:- pred analyze_block_map(list(label)::in, block_map::in, block_map::out,
+ maybe(pair(label))::out) is det.
-analyze_block_map(LabelSeq, BlockMap0, BlockMap, KeepFrameData) :-
+analyze_block_map(LabelSeq, !BlockMap, KeepFrameData) :-
(
LabelSeq = [FirstLabel, SecondLabel | _],
- map__search(BlockMap0, FirstLabel, FirstBlockInfo),
+ map__search(!.BlockMap, FirstLabel, FirstBlockInfo),
FirstBlockInfo = block_info(FirstLabel, _, _, _, setup)
->
- analyze_block_map_2(LabelSeq, BlockMap0, FirstLabel,
- BlockMap, no, KeepFrame),
+ analyze_block_map_2(LabelSeq, FirstLabel,
+ !BlockMap, no, KeepFrame),
( KeepFrame = yes ->
KeepFrameData = yes(FirstLabel - SecondLabel)
;
@@ -606,13 +593,12 @@
error("bad data in analyze_block_map")
).
-:- pred analyze_block_map_2(list(label)::in, block_map::in, label::in,
- block_map::out, bool::in, bool::out) is det.
+:- pred analyze_block_map_2(list(label)::in, label::in,
+ block_map::in, block_map::out, bool::in, bool::out) is det.
-analyze_block_map_2([], BlockMap, _, BlockMap, KeepFrame, KeepFrame).
-analyze_block_map_2([Label | Labels], BlockMap0, FirstLabel, BlockMap,
- KeepFrame0, KeepFrame) :-
- map__lookup(BlockMap0, Label, BlockInfo0),
+analyze_block_map_2([], _, !BlockMap, !KeepFrame).
+analyze_block_map_2([Label | Labels], FirstLabel, !BlockMap, !KeepFrame) :-
+ map__lookup(!.BlockMap, Label, BlockInfo0),
BlockInfo0 = block_info(BlockLabel, BlockInstrs, _, _, Type),
(
Label = BlockLabel, % sanity check
@@ -632,18 +618,17 @@
LastUinstr = goto(label(GotoLabel)),
same_label_ref(FirstLabel, GotoLabel)
->
- KeepFrame1 = yes
+ !:KeepFrame = yes
;
- KeepFrame1 = KeepFrame0
+ true
)
;
error("bad data in analyze_block_map_2")
),
BlockInfo = block_info(BlockLabel, BlockInstrs, SideLabels,
MaybeFallThrough, Type),
- map__det_update(BlockMap0, Label, BlockInfo, BlockMap1),
- analyze_block_map_2(Labels, BlockMap1, FirstLabel, BlockMap,
- KeepFrame1, KeepFrame).
+ map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap),
+ analyze_block_map_2(Labels, FirstLabel, !BlockMap, !KeepFrame).
% The form of a label used in a tailcall may be different from
% the form used in the initial label. The initial label may be
@@ -667,10 +652,10 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred can_clobber_succip(list(label)::in, block_map::in, bool::out) is det.
+:- func can_clobber_succip(list(label), block_map) = bool.
-can_clobber_succip([], _BlockMap, no).
-can_clobber_succip([Label | Labels], BlockMap, CanClobberSuccip) :-
+can_clobber_succip([], _BlockMap) = no.
+can_clobber_succip([Label | Labels], BlockMap) = CanClobberSuccip :-
map__lookup(BlockMap, Label, BlockInfo),
BlockInfo = block_info(_, Instrs, _, _, _),
(
@@ -686,7 +671,7 @@
->
CanClobberSuccip = yes
;
- can_clobber_succip(Labels, BlockMap, CanClobberSuccip)
+ CanClobberSuccip = can_clobber_succip(Labels, BlockMap)
).
%-----------------------------------------------------------------------------%
@@ -698,13 +683,13 @@
% (a form of which appears in existing tailcalls) and the label that
% should replace it in tailcalls that avoid the stack teardown.
-:- pred keep_frame(list(label)::in, block_map::in, label::in, label::in,
- bool::in, block_map::out) is det.
+:- pred keep_frame(list(label)::in, label::in, label::in, bool::in,
+ block_map::in, block_map::out) is det.
-keep_frame([], BlockMap, _, _, _, BlockMap).
-keep_frame([Label | Labels], BlockMap0, FirstLabel, SecondLabel,
- CanClobberSuccip, BlockMap) :-
- map__lookup(BlockMap0, Label, BlockInfo0),
+keep_frame([], _, _, _, !BlockMap).
+keep_frame([Label | Labels], FirstLabel, SecondLabel, CanClobberSuccip,
+ !BlockMap) :-
+ map__lookup(!.BlockMap, Label, BlockInfo0),
(
BlockInfo0 = block_info(Label, OrigInstrs, [_], no,
teardown(Succip, Livevals, Goto)),
@@ -730,12 +715,12 @@
Instrs = [OrigLabelInstr | BackInstrs],
BlockInfo = block_info(Label, Instrs, [SecondLabel], no,
ordinary(yes)),
- map__det_update(BlockMap0, Label, BlockInfo, BlockMap1)
+ map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
;
- BlockMap1 = BlockMap0
+ true
),
- keep_frame(Labels, BlockMap1, FirstLabel, SecondLabel,
- CanClobberSuccip, BlockMap).
+ keep_frame(Labels, FirstLabel, SecondLabel, CanClobberSuccip,
+ !BlockMap).
:- pred pick_last(list(T)::in, list(T)::out, T::out) is det.
@@ -845,26 +830,20 @@
% blocks that need them, and puts them in their correct place,
% either just before or just after the original block.
-:- pred delay_frame(list(label)::in, block_map::in, int::in, string::in,
+:- pred delay_frame(list(label)::in, list(label)::out, int::in, string::in,
proc_label::in, counter::in, counter::out,
- list(label)::out, block_map::out) is det.
+ block_map::in, block_map::out) is det.
-delay_frame(LabelSeq0, BlockMap0, FrameSize, Msg, ProcLabel, C0, C,
- LabelSeq, BlockMap) :-
- map__init(RevMap0),
- queue__init(Queue0),
- delay_frame_init(LabelSeq0, BlockMap0, RevMap0, RevMap,
- Queue0, Queue1),
- set__init(FramedLabels0),
- propagate_framed_labels(Queue1, BlockMap0, RevMap,
- FramedLabels0, FramedLabels),
- map__init(ParMap0),
- set__init(FallIntoParallel0),
- process_frame_delay(LabelSeq0, BlockMap0, ParMap0, FallIntoParallel0,
- FramedLabels, FrameSize, Msg, ProcLabel, C0, C,
- LabelSeq1, BlockMap1, ParMap, FallIntoParallel),
- create_parallels(LabelSeq1, BlockMap1, ParMap, FallIntoParallel,
- LabelSeq, BlockMap).
+delay_frame(LabelSeq0, LabelSeq, FrameSize, Msg, ProcLabel, !C, !BlockMap) :-
+ delay_frame_init(LabelSeq0, !.BlockMap, map__init, RevMap,
+ queue__init, Queue1),
+ propagate_framed_labels(Queue1, !.BlockMap, RevMap,
+ set__init, FramedLabels),
+ process_frame_delay(LabelSeq0, FramedLabels, FrameSize, Msg, ProcLabel,
+ !C, LabelSeq1, !BlockMap, map__init, ParMap,
+ set__init, FallIntoParallel),
+ create_parallels(LabelSeq1, LabelSeq, ParMap, FallIntoParallel,
+ !BlockMap).
%-----------------------------------------------------------------------------%
@@ -971,17 +950,17 @@
% implement the second phase of delay_frame. For documentation,
% see the comment at the top of delay_frame.
-:- pred process_frame_delay(list(label)::in, block_map::in,
- par_map::in, set(label)::in, set(label)::in, int::in, string::in,
- proc_label::in, counter::in, counter::out,
- list(label)::out, block_map::out, par_map::out, set(label)::out) is det.
+:- pred process_frame_delay(list(label)::in, set(label)::in, int::in,
+ string::in, proc_label::in, counter::in, counter::out,
+ list(label)::out, block_map::in, block_map::out,
+ par_map::in, par_map::out, set(label)::in, set(label)::out) is det.
-process_frame_delay([], BlockMap, ParMap, FallIntoParallel, _, _, _, _, C, C,
- [], BlockMap, ParMap, FallIntoParallel).
-process_frame_delay([Label0 | Labels0], BlockMap0, ParMap0, FallIntoParallel0,
- FramedLabels, FrameSize, Msg, ProcLabel, C0, C,
- Labels, BlockMap, ParMap, FallIntoParallel) :-
- map__lookup(BlockMap0, Label0, BlockInfo0),
+process_frame_delay([], _, _, _, _, !C, [],
+ !BlockMap, !ParMap, !FallIntoParallel).
+process_frame_delay([Label0 | Labels0], FramedLabels, FrameSize, Msg,
+ ProcLabel, !C, Labels, !BlockMap, !ParMap,
+ !FallIntoParallel) :-
+ map__lookup(!.BlockMap, Label0, BlockInfo0),
BlockInfo0 = block_info(Label0Copy, Instrs0, SideLabels0,
MaybeFallThrough0, Type),
( Label0 = Label0Copy ->
@@ -1013,20 +992,15 @@
( set__member(FallThrough, FramedLabels) ->
% we can't delay the frame setup,
% so return everything unchanged
- Labels = [Label0 | Labels0],
- C = C0,
- BlockMap = BlockMap0,
- ParMap = ParMap0,
- FallIntoParallel = FallIntoParallel0
+ Labels = [Label0 | Labels0]
;
BlockInfo = block_info(Label0, [LabelInstr],
SideLabels0, MaybeFallThrough0, ordinary(no)),
- map__det_update(BlockMap0, Label0, BlockInfo,
- BlockMap1),
- process_frame_delay(Labels0, BlockMap1,
- ParMap0, FallIntoParallel0, FramedLabels,
- FrameSize, Msg, ProcLabel, C0, C,
- Labels1, BlockMap, ParMap, FallIntoParallel),
+ map__det_update(!.BlockMap, Label0, BlockInfo,
+ !:BlockMap),
+ process_frame_delay(Labels0, FramedLabels, FrameSize,
+ Msg, ProcLabel, !C, Labels1,
+ !BlockMap, !ParMap, !FallIntoParallel),
Labels = [Label0 | Labels1]
)
;
@@ -1037,10 +1011,9 @@
% in FramedLabels, or will be a teardown block.
% We already have a stack frame, and all our
% successors expect one, so we need not do anything.
- process_frame_delay(Labels0, BlockMap0,
- ParMap0, FallIntoParallel0, FramedLabels,
- FrameSize, Msg, ProcLabel, C0, C,
- Labels1, BlockMap, ParMap, FallIntoParallel),
+ process_frame_delay(Labels0, FramedLabels, FrameSize,
+ Msg, ProcLabel, !C, Labels1,
+ !BlockMap, !ParMap, !FallIntoParallel),
Labels = [Label0 | Labels1]
;
% Every block reachable from this block, whether via
@@ -1052,31 +1025,30 @@
% make sure that we reach their non-teardown parallels
% instead.
transform_ordinary_block(Label0, Labels0, BlockInfo0,
- BlockMap0, ParMap0, FallIntoParallel0,
- FramedLabels, FrameSize, Msg, ProcLabel, C0, C,
- Labels, BlockMap, ParMap, FallIntoParallel)
+ FramedLabels, FrameSize, Msg, ProcLabel, !C,
+ Labels, !BlockMap, !ParMap, !FallIntoParallel)
)
;
Type = teardown(_, _, _),
- process_frame_delay(Labels0, BlockMap0,
- ParMap0, FallIntoParallel0, FramedLabels,
- FrameSize, Msg, ProcLabel, C0, C,
- Labels1, BlockMap, ParMap, FallIntoParallel),
+ process_frame_delay(Labels0, FramedLabels, FrameSize,
+ Msg, ProcLabel, !C, Labels1,
+ !BlockMap, !ParMap, !FallIntoParallel),
Labels = [Label0 | Labels1]
).
:- pred transform_ordinary_block(label::in, list(label)::in, block_info::in,
- block_map::in, par_map::in, set(label)::in, set(label)::in, int::in,
- string::in, proc_label::in, counter::in, counter::out,
- list(label)::out, block_map::out, par_map::out, set(label)::out) is det.
+ set(label)::in, int::in, string::in, proc_label::in,
+ counter::in, counter::out, list(label)::out,
+ block_map::in, block_map::out, par_map::in, par_map::out,
+ set(label)::in, set(label)::out) is det.
-transform_ordinary_block(Label0, Labels0, BlockInfo0, BlockMap0, ParMap0,
- FallIntoParallel0, FramedLabels, FrameSize, Msg, ProcLabel,
- C0, C, Labels, BlockMap, ParMap, FallIntoParallel) :-
+transform_ordinary_block(Label0, Labels0, BlockInfo0, FramedLabels, FrameSize,
+ Msg, ProcLabel, !C, Labels,
+ !BlockMap, !ParMap, !FallIntoParallel) :-
BlockInfo0 = block_info(_, Instrs0, SideLabels0,
MaybeFallThrough0, Type),
mark_parallels_for_teardown(SideLabels0, SideLabels,
- AssocLabelMap, BlockMap0, ProcLabel, C0, C1, ParMap0, ParMap1),
+ AssocLabelMap, !.BlockMap, ProcLabel, !C, !ParMap),
pick_last(Instrs0, PrevInstrs, LastInstr0),
map__from_assoc_list(AssocLabelMap, LabelMap),
opt_util__replace_labels_instruction(LastInstr0, LabelMap, no,
@@ -1084,21 +1056,19 @@
list__append(PrevInstrs, [LastInstr], Instrs),
(
MaybeFallThrough0 = yes(FallThrough),
- map__lookup(BlockMap0, FallThrough, FallThroughInfo),
+ map__lookup(!.BlockMap, FallThrough, FallThroughInfo),
FallThroughInfo = block_info(_, _, _, _, FallThroughType),
(
FallThroughType = setup,
error("ordinary block falls through to setup")
;
FallThroughType = ordinary(_),
- FallIntoParallel1 = FallIntoParallel0,
- ParMap2 = ParMap1,
( set__member(FallThrough, FramedLabels) ->
% We fall through from a block without a
% stack frame to a block which needs a
% stack frame, so we must create one.
- counter__allocate(N, C1, C2),
+ counter__allocate(N, !C),
NewLabel = local(N, ProcLabel),
MaybeFallThrough = yes(NewLabel),
MaybeNewLabel = yes(NewLabel),
@@ -1113,39 +1083,30 @@
],
SetupBlock = block_info(NewLabel, SetupCode,
[], MaybeFallThrough0, setup),
- map__det_insert(BlockMap0, NewLabel,
- SetupBlock, BlockMap1)
+ map__det_insert(!.BlockMap, NewLabel,
+ SetupBlock, !:BlockMap)
;
MaybeFallThrough = yes(FallThrough),
- BlockMap1 = BlockMap0,
- MaybeNewLabel = no,
- C2 = C1
+ MaybeNewLabel = no
)
;
FallThroughType = teardown(_, _, _),
MaybeFallThrough = yes(FallThrough),
- BlockMap1 = BlockMap0,
- set__insert(FallIntoParallel0,
- FallThrough, FallIntoParallel1),
+ set__insert(!.FallIntoParallel, FallThrough,
+ !:FallIntoParallel),
MaybeNewLabel = no,
- mark_parallel(FallThrough, _, ProcLabel, C1, C2,
- ParMap1, ParMap2)
+ mark_parallel(FallThrough, _, ProcLabel, !C, !ParMap)
)
;
MaybeFallThrough0 = no,
MaybeFallThrough = no,
- BlockMap1 = BlockMap0,
- FallIntoParallel1 = FallIntoParallel0,
- ParMap2 = ParMap1,
- MaybeNewLabel = no,
- C2 = C1
+ MaybeNewLabel = no
),
- BlockInfo = block_info(Label0, Instrs, SideLabels,
- MaybeFallThrough, Type),
- map__set(BlockMap1, Label0, BlockInfo, BlockMap2),
- process_frame_delay(Labels0, BlockMap2, ParMap2, FallIntoParallel1,
- FramedLabels, FrameSize, Msg, ProcLabel, C2, C,
- Labels1, BlockMap, ParMap, FallIntoParallel),
+ BlockInfo = block_info(Label0, Instrs, SideLabels, MaybeFallThrough,
+ Type),
+ map__set(!.BlockMap, Label0, BlockInfo, !:BlockMap),
+ process_frame_delay(Labels0, FramedLabels, FrameSize, Msg, ProcLabel,
+ !C, Labels1, !BlockMap, !ParMap, !FallIntoParallel),
( MaybeNewLabel = yes(NewLabel2) ->
Labels = [Label0, NewLabel2 | Labels1]
;
@@ -1167,10 +1128,10 @@
proc_label::in, counter::in, counter::out,
par_map::in, par_map::out) is det.
-mark_parallels_for_teardown([], [], [], _, _, C, C, ParMap, ParMap).
+mark_parallels_for_teardown([], [], [], _, _, !C, !ParMap).
mark_parallels_for_teardown([Label0 | Labels0], [Label | Labels],
[Label0 - Label | LabelMap], BlockMap,
- ProcLabel, C0, C, ParMap0, ParMap) :-
+ ProcLabel, !C, !ParMap) :-
map__lookup(BlockMap, Label0, BlockInfo),
BlockInfo = block_info(_, _, _, _, Type),
(
@@ -1178,16 +1139,13 @@
error("reached setup via jump from ordinary block")
;
Type = ordinary(_),
- Label = Label0,
- C1 = C0,
- ParMap1 = ParMap0
+ Label = Label0
;
Type = teardown(_, _, _),
- mark_parallel(Label0, Label, ProcLabel, C0, C1,
- ParMap0, ParMap1)
+ mark_parallel(Label0, Label, ProcLabel, !C, !ParMap)
),
mark_parallels_for_teardown(Labels0, Labels, LabelMap,
- BlockMap, ProcLabel, C1, C, ParMap1, ParMap).
+ BlockMap, ProcLabel, !C, !ParMap).
% Given the label of a teardown block, allocate a label for its
% non-teardown parallel if it doesn't already have one.
@@ -1195,16 +1153,14 @@
:- pred mark_parallel(label::in, label::out, proc_label::in,
counter::in, counter::out, par_map::in, par_map::out) is det.
-mark_parallel(Label0, Label, ProcLabel, C0, C, ParMap0, ParMap) :-
- ( map__search(ParMap0, Label0, OldParallel) ->
- Label = OldParallel,
- C = C0,
- ParMap = ParMap0
+mark_parallel(Label0, Label, ProcLabel, !C, !ParMap) :-
+ ( map__search(!.ParMap, Label0, OldParallel) ->
+ Label = OldParallel
;
- counter__allocate(N, C0, C),
+ counter__allocate(N, !C),
NewParallel = local(N, ProcLabel),
Label = NewParallel,
- map__det_insert(ParMap0, Label0, NewParallel, ParMap)
+ map__det_insert(!.ParMap, Label0, NewParallel, !:ParMap)
).
%-----------------------------------------------------------------------------%
@@ -1212,16 +1168,16 @@
% The third phase of the delay_frame optimization, creating
% the non-teardown parallel blocks.
-:- pred create_parallels(list(label)::in, block_map::in, par_map::in,
- set(label)::in, list(label)::out, block_map::out) is det.
+:- pred create_parallels(list(label)::in, list(label)::out,
+ par_map::in, set(label)::in, block_map::in, block_map::out) is det.
-create_parallels([], BlockMap, _, _, [], BlockMap).
-create_parallels([Label0 | Labels0], BlockMap0, ParMap, FallIntoParallel,
- Labels, BlockMap) :-
- create_parallels(Labels0, BlockMap0, ParMap, FallIntoParallel,
- Labels1, BlockMap1),
+create_parallels([], [], _, _, !BlockMap).
+create_parallels([Label0 | Labels0], Labels, ParMap, FallIntoParallel,
+ !BlockMap) :-
+ create_parallels(Labels0, Labels1, ParMap, FallIntoParallel,
+ !BlockMap),
( map__search(ParMap, Label0, ParallelLabel) ->
- map__lookup(BlockMap1, Label0, BlockInfo0),
+ map__lookup(!.BlockMap, Label0, BlockInfo0),
BlockInfo0 = block_info(Label0Copy, _,
SideLabels, MaybeFallThrough, Type),
( Label0 = Label0Copy ->
@@ -1241,8 +1197,8 @@
Replacement = [LabelInstr | Replacement0],
NewBlockInfo = block_info(ParallelLabel, Replacement,
SideLabels, no, ordinary(no)),
- map__det_insert(BlockMap1, ParallelLabel,
- NewBlockInfo, BlockMap),
+ map__det_insert(!.BlockMap, ParallelLabel,
+ NewBlockInfo, !:BlockMap),
( set__member(Label0, FallIntoParallel) ->
Labels = [ParallelLabel, Label0 | Labels1]
;
@@ -1252,8 +1208,7 @@
error("block with parallel is not teardown")
)
;
- Labels = [Label0 | Labels1],
- BlockMap = BlockMap1
+ Labels = [Label0 | Labels1]
).
%-----------------------------------------------------------------------------%
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.67
diff -u -b -r1.67 jumpopt.m
--- compiler/jumpopt.m 20 Oct 2003 07:29:06 -0000 1.67
+++ compiler/jumpopt.m 9 Nov 2003 05:25:58 -0000
@@ -141,88 +141,77 @@
%-----------------------------------------------------------------------------%
-:- pred jumpopt__build_maps(list(instruction), bool, bool,
- instrmap, instrmap, tailmap, tailmap, lvalmap, lvalmap,
- tailmap, tailmap, tailmap, tailmap, tailmap, tailmap).
-% :- mode jumpopt__build_maps(in, in, in, di, uo, di, uo, di, uo, di, uo,
-% di, uo, di, uo) is det.
-:- mode jumpopt__build_maps(in, in, in, in, out, in, out, in, out, in, out,
- in, out, in, out) is det.
-
-jumpopt__build_maps([], _, _,
- Instrmap, Instrmap, Blockmap, Blockmap, Lvalmap, Lvalmap,
- Procmap, Procmap, Sdprocmap, Sdprocmap, Succmap, Succmap).
-jumpopt__build_maps([Instr0 | Instrs0], Blockopt, Recjump, Instrmap0, Instrmap,
- Blockmap0, Blockmap, Lvalmap0, Lvalmap,
- Procmap0, Procmap, Sdprocmap0, Sdprocmap, Succmap0, Succmap) :-
+:- pred jumpopt__build_maps(list(instruction)::in, bool::in, bool::in,
+ instrmap::in, instrmap::out, tailmap::in, tailmap::out,
+ lvalmap::in, lvalmap::out, tailmap::in, tailmap::out,
+ tailmap::in, tailmap::out, tailmap::in, tailmap::out) is det.
+
+jumpopt__build_maps([], _, _, !Instrmap, !Blockmap, !Lvalmap, !Procmap,
+ !Sdprocmap, !Succmap).
+jumpopt__build_maps([Instr0 | Instrs0], Blockopt, Recjump, !Instrmap,
+ !Blockmap, !Lvalmap, !Procmap, !Sdprocmap, !Succmap) :-
Instr0 = Uinstr0 - _,
( Uinstr0 = label(Label) ->
opt_util__skip_comments(Instrs0, Instrs1),
( Instrs1 = [Instr1 | _], Instr1 = livevals(_) - _ ->
- map__det_insert(Lvalmap0, Label, yes(Instr1), Lvalmap1)
+ map__det_insert(!.Lvalmap, Label, yes(Instr1),
+ !:Lvalmap)
;
- map__det_insert(Lvalmap0, Label, no, Lvalmap1)
+ map__det_insert(!.Lvalmap, Label, no, !:Lvalmap)
),
opt_util__skip_comments_livevals(Instrs1, Instrs2),
( Instrs2 = [Instr2 | _] ->
- map__det_insert(Instrmap0, Label, Instr2, Instrmap1)
+ map__det_insert(!.Instrmap, Label, Instr2, !:Instrmap)
;
- Instrmap1 = Instrmap0
+ true
),
( opt_util__is_proceed_next(Instrs1, Between1) ->
- map__det_insert(Procmap0, Label, Between1, Procmap1)
+ map__det_insert(!.Procmap, Label, Between1, !:Procmap)
;
- Procmap1 = Procmap0
+ true
),
( opt_util__is_sdproceed_next(Instrs1, Between2) ->
- map__det_insert(Sdprocmap0, Label, Between2, Sdprocmap1)
+ map__det_insert(!.Sdprocmap, Label, Between2,
+ !:Sdprocmap)
;
- Sdprocmap1 = Sdprocmap0
+ true
),
( opt_util__is_succeed_next(Instrs1, Between3) ->
- map__det_insert(Succmap0, Label, Between3, Succmap1)
+ map__det_insert(!.Succmap, Label, Between3, !:Succmap)
;
- Succmap1 = Succmap0
+ true
),
% put the start of the procedure into Blockmap
% only after frameopt and value_number have had a shot at it
( Blockopt = yes, ( Label = local(_, _) ; Recjump = yes ) ->
opt_util__find_no_fallthrough(Instrs1, Block),
- map__det_insert(Blockmap0, Label, Block, Blockmap1)
+ map__det_insert(!.Blockmap, Label, Block, !:Blockmap)
;
- Blockmap1 = Blockmap0
+ true
)
;
- Instrmap1 = Instrmap0,
- Blockmap1 = Blockmap0,
- Lvalmap1 = Lvalmap0,
- Procmap1 = Procmap0,
- Sdprocmap1 = Sdprocmap0,
- Succmap1 = Succmap0
+ true
),
- jumpopt__build_maps(Instrs0, Blockopt, Recjump, Instrmap1, Instrmap,
- Blockmap1, Blockmap, Lvalmap1, Lvalmap,
- Procmap1, Procmap, Sdprocmap1, Sdprocmap, Succmap1, Succmap).
+ jumpopt__build_maps(Instrs0, Blockopt, Recjump, !Instrmap,
+ !Blockmap, !Lvalmap, !Procmap, !Sdprocmap, !Succmap).
% Find labels followed by a test of r1 where both paths set r1 to
% its original value and proceed.
-:- pred jumpopt__build_forkmap(list(instruction), tailmap, tailmap, tailmap).
-% :- mode jumpopt__build_forkmap(in, in, di, uo) is det.
-:- mode jumpopt__build_forkmap(in, in, in, out) is det.
-
-jumpopt__build_forkmap([], _Sdprocmap, Forkmap, Forkmap).
-jumpopt__build_forkmap([Instr - _Comment|Instrs], Sdprocmap,
- Forkmap0, Forkmap) :-
+:- pred jumpopt__build_forkmap(list(instruction)::in, tailmap::in,
+ tailmap::in, tailmap::out) is det.
+
+jumpopt__build_forkmap([], _Sdprocmap, !Forkmap).
+jumpopt__build_forkmap([Instr - _Comment|Instrs], Sdprocmap, !Forkmap) :-
(
Instr = label(Label),
opt_util__is_forkproceed_next(Instrs, Sdprocmap, Between)
->
- map__det_insert(Forkmap0, Label, Between, Forkmap1)
+ map__det_insert(!.Forkmap, Label, Between, !:Forkmap)
;
- Forkmap1 = Forkmap0
+ true
),
- jumpopt__build_forkmap(Instrs, Sdprocmap, Forkmap1, Forkmap).
+ jumpopt__build_forkmap(Instrs, Sdprocmap, !Forkmap).
%-----------------------------------------------------------------------------%
@@ -248,20 +237,18 @@
% do so by negating the condition and possibly also deleting a label
% between the if-val and the goto.
-:- pred jumpopt__instr_list(list(instruction), instr, instrmap, tailmap,
- lvalmap, tailmap, tailmap, tailmap, tailmap, set(label),
- may_alter_rtti, maybe(pair(proc_label, counter)),
- maybe(pair(proc_label, counter)), list(instruction)).
-:- mode jumpopt__instr_list(in, in, in, in, in, in, in, in, in, in, in,
- in, out, out) is det.
+:- pred jumpopt__instr_list(list(instruction)::in, instr::in, instrmap::in,
+ tailmap::in, lvalmap::in, tailmap::in, tailmap::in, tailmap::in,
+ tailmap::in, set(label)::in, may_alter_rtti::in,
+ maybe(pair(proc_label, counter))::in,
+ maybe(pair(proc_label, counter))::out, list(instruction)::out) is det.
jumpopt__instr_list([], _PrevInstr, _Instrmap, _Blockmap, _Lvalmap,
_Procmap, _Sdprocmap, _Forkmap, _Succmap, _LayoutLabels,
- _, CheckedNondetTailCallInfo, CheckedNondetTailCallInfo, []).
+ _, !CheckedNondetTailCallInfo, []).
jumpopt__instr_list([Instr0 | Instrs0], PrevInstr, Instrmap, Blockmap,
Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap, LayoutLabels,
- MayAlterRtti, CheckedNondetTailCallInfo0,
- CheckedNondetTailCallInfo, Instrs) :-
+ MayAlterRtti, !CheckedNondetTailCallInfo, Instrs) :-
Instr0 = Uinstr0 - Comment0,
(
Uinstr0 = call(Proc, label(RetLabel), LiveInfos, Context,
@@ -282,8 +269,7 @@
list__append(Between1, [livevals(Livevals) - "",
goto(Proc) - redirect_comment(Comment0)],
NewInstrs),
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Look for semidet style tailcalls.
CallModel = semidet,
@@ -295,8 +281,7 @@
list__append(Between, [livevals(Livevals) - "",
goto(Proc) - redirect_comment(Comment0)],
NewInstrs),
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Look for nondet style tailcalls which do not need
% a runtime check.
@@ -317,13 +302,12 @@
livevals(Livevals) - "",
goto(Proc) - redirect_comment(Comment0)
],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Look for nondet style tailcalls which do need
% a runtime check.
CallModel = nondet(checked_tail_call),
- CheckedNondetTailCallInfo0 =
+ !.CheckedNondetTailCallInfo =
yes(ProcLabel - Counter0),
map__search(Succmap, RetLabel, BetweenIncl),
BetweenIncl = [livevals(_) - _, goto(_) - _],
@@ -349,15 +333,15 @@
Instr0
],
RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = yes(ProcLabel - Counter1)
+ !:CheckedNondetTailCallInfo = yes(ProcLabel - Counter1)
;
% Short circuit the return label if possible.
map__search(Instrmap, RetLabel, RetInstr),
MayAlterRtti = may_alter_rtti,
not set__member(RetLabel, LayoutLabels)
->
- jumpopt__final_dest(RetLabel, RetInstr, Instrmap,
- DestLabel, _DestInstr),
+ jumpopt__final_dest(Instrmap, RetLabel, DestLabel,
+ RetInstr, _DestInstr),
( RetLabel = DestLabel ->
NewInstrs = [Instr0],
RemainInstrs = Instrs0
@@ -367,12 +351,10 @@
CallModel)
- redirect_comment(Comment0)],
RemainInstrs = Instrs0
- ),
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ )
;
NewInstrs = [Instr0],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
)
;
Uinstr0 = goto(label(TargetLabel))
@@ -382,8 +364,7 @@
opt_util__is_this_label_next(TargetLabel, Instrs0, _)
->
NewInstrs = [],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
PrevInstr = if_val(_, label(IfTargetLabel)),
opt_util__is_this_label_next(IfTargetLabel, Instrs0, _)
@@ -395,8 +376,7 @@
% We cannot eliminate the instruction here because
% that would require altering the if_val instruction.
NewInstrs = [Instr0],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Replace a jump to a det epilog with the epilog.
map__search(Procmap, TargetLabel, Between0)
@@ -404,8 +384,7 @@
jumpopt__adjust_livevals(PrevInstr, Between0, Between),
list__append(Between, [goto(succip) - "shortcircuit"],
NewInstrs),
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Replace a jump to a semidet epilog with the epilog.
map__search(Sdprocmap, TargetLabel, Between0)
@@ -413,16 +392,14 @@
jumpopt__adjust_livevals(PrevInstr, Between0, Between),
list__append(Between, [goto(succip) - "shortcircuit"],
NewInstrs),
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Replace a jump to a nondet epilog with the epilog.
map__search(Succmap, TargetLabel, BetweenIncl0)
->
jumpopt__adjust_livevals(PrevInstr, BetweenIncl0,
NewInstrs),
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
;
% Replace a jump to a non-epilog block with the
% block itself. These jumps are treated separately
@@ -440,8 +417,8 @@
% which is correct only if jumps to those labels
% are short-circuited everywhere.
map__search(Instrmap, TargetLabel, TargetInstr),
- jumpopt__final_dest(TargetLabel, TargetInstr,
- Instrmap, DestLabel, _DestInstr),
+ jumpopt__final_dest(Instrmap, TargetLabel, DestLabel,
+ TargetInstr, _DestInstr),
map__search(Blockmap, DestLabel, Block)
->
opt_util__filter_out_labels(Block, FilteredBlock),
@@ -455,15 +432,15 @@
jumpopt__instr_list(AdjustedBlock, comment(""),
Instrmap, CrippledBlockmap, Lvalmap, Procmap,
Sdprocmap, Forkmap, Succmap, LayoutLabels,
- MayAlterRtti, CheckedNondetTailCallInfo0,
- CheckedNondetTailCallInfo1, NewInstrs),
+ MayAlterRtti, !CheckedNondetTailCallInfo,
+ NewInstrs),
RemainInstrs = Instrs0
;
% Short-circuit the goto.
map__search(Instrmap, TargetLabel, TargetInstr)
->
- jumpopt__final_dest(TargetLabel, TargetInstr,
- Instrmap, DestLabel, DestInstr),
+ jumpopt__final_dest(Instrmap, TargetLabel, DestLabel,
+ TargetInstr, DestInstr),
DestInstr = UdestInstr - _Destcomment,
string__append("shortcircuited jump: ",
Comment0, Shorted),
@@ -487,18 +464,15 @@
[Lvalinstr | NewInstrs0], NewInstrs)
;
NewInstrs = NewInstrs0
- ),
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ )
;
NewInstrs = [Instr0],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
)
; Uinstr0 = computed_goto(Index, LabelList0) ->
% Short-circuit all the destination labels.
- jumpopt__short_labels(LabelList0, Instrmap, LabelList),
+ jumpopt__short_labels(Instrmap, LabelList0, LabelList),
RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0,
( LabelList = LabelList0 ->
NewInstrs = [Instr0]
;
@@ -526,7 +500,6 @@
% directly to L3). This may not be possible if L3 is
% a non-label code address; e.g. we cannot jump to
% non-label code addresses from computed gotos.
-
opt_util__skip_comments(Instrs0, Instrs1),
Instrs1 = [Instr1 | Instrs2],
( Instr1 = label(_) - _ ->
@@ -553,13 +526,12 @@
% the recursive call. We can't go into an infinite
% loop because each application of the transformation
% strictly reduces the size of the code.
- RemainInstrs = [NewInstr | AfterGoto],
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = [NewInstr | AfterGoto]
;
map__search(Instrmap, TargetLabel, TargetInstr)
->
- jumpopt__final_dest(TargetLabel, TargetInstr,
- Instrmap, DestLabel, _DestInstr),
+ jumpopt__final_dest(Instrmap, TargetLabel, DestLabel,
+ TargetInstr, _DestInstr),
(
% Attempt to transform code such as
%
@@ -576,7 +548,6 @@
% r1 = Cond
% <epilog>
%
-
opt_util__is_sdproceed_next(Instrs0, BetweenFT),
map__search(Blockmap, DestLabel, Block),
opt_util__is_sdproceed_next(Block, BetweenBR),
@@ -607,7 +578,6 @@
RemainInstrs = Instrs0
;
% Try to short-circuit the destination.
-
TargetLabel \= DestLabel
->
string__append("shortcircuited jump: ",
@@ -618,18 +588,15 @@
;
NewInstrs = [Instr0],
RemainInstrs = Instrs0
- ),
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ )
;
NewInstrs = [Instr0],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
)
; Uinstr0 = assign(Lval, Rval0) ->
% Any labels mentioned in Rval0 should be short-circuited.
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval),
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval),
RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0,
( Rval = Rval0 ->
NewInstrs = [Instr0]
;
@@ -638,9 +605,8 @@
NewInstrs = [assign(Lval, Rval) - Shorted]
)
; Uinstr0 = mkframe(FrameInfo, label(Label0)) ->
- jumpopt__short_label(Label0, Instrmap, Label),
+ jumpopt__short_label(Instrmap, Label0, Label),
RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0,
( Label = Label0 ->
NewInstrs = [Instr0]
;
@@ -651,8 +617,7 @@
)
;
NewInstrs = [Instr0],
- RemainInstrs = Instrs0,
- CheckedNondetTailCallInfo1 = CheckedNondetTailCallInfo0
+ RemainInstrs = Instrs0
),
( ( Uinstr0 = comment(_) ; NewInstrs = [] ) ->
NewPrevInstr = PrevInstr
@@ -661,11 +626,11 @@
),
jumpopt__instr_list(RemainInstrs, NewPrevInstr, Instrmap, Blockmap,
Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap, LayoutLabels,
- MayAlterRtti, CheckedNondetTailCallInfo1,
- CheckedNondetTailCallInfo, Instrs9),
+ MayAlterRtti, !CheckedNondetTailCallInfo, Instrs9),
list__append(NewInstrs, Instrs9, Instrs).
:- func redirect_comment(string) = string.
+
redirect_comment(Comment0) = string__append(Comment0, " (redirected return)").
% We avoid generating statements that redefine the value of a location
@@ -704,9 +669,8 @@
)
).
-:- pred jumpopt__adjust_livevals(instr, list(instruction), list(instruction)).
-% :- mode jumpopt__adjust_livevals(in, di, uo) is det.
-:- mode jumpopt__adjust_livevals(in, in, out) is det.
+:- pred jumpopt__adjust_livevals(instr::in, list(instruction)::in,
+ list(instruction)::out) is det.
jumpopt__adjust_livevals(PrevInstr, Instrs0, Instrs) :-
(
@@ -717,7 +681,8 @@
( BetweenLivevals = PrevLivevals ->
Instrs = Instrs2
;
- error("betweenLivevals and prevLivevals differ in jumpopt")
+ error("BetweenLivevals and PrevLivevals differ " ++
+ "in jumpopt")
)
;
Instrs = Instrs0
@@ -728,44 +693,40 @@
% Short-circuit the given label by following any gotos at the
% labelled instruction or by falling through consecutive labels.
-:- pred jumpopt__short_label(label, instrmap, label).
-:- mode jumpopt__short_label(in, in, out) is det.
+:- pred jumpopt__short_label(instrmap::in, label::in, label::out) is det.
-jumpopt__short_label(Label0, Instrmap, Label) :-
+jumpopt__short_label(Instrmap, Label0, Label) :-
( map__search(Instrmap, Label0, Instr0) ->
- jumpopt__final_dest(Label0, Instr0, Instrmap, Label, _Instr)
+ jumpopt__final_dest(Instrmap, Label0, Label, Instr0, _Instr)
;
Label = Label0
).
-:- pred jumpopt__short_labels(list(label), instrmap, list(label)).
-:- mode jumpopt__short_labels(in, in, out) is det.
+:- pred jumpopt__short_labels(instrmap::in, list(label)::in, list(label)::out)
+ is det.
-% XXX these uses of the Mod argument should be replaced by accumulator passing
-
-jumpopt__short_labels([], _Instrmap, []).
-jumpopt__short_labels([Label0 | Labels0], Instrmap, [Label | Labels]) :-
- jumpopt__short_label(Label0, Instrmap, Label),
- jumpopt__short_labels(Labels0, Instrmap, Labels).
+jumpopt__short_labels(_Instrmap, [], []).
+jumpopt__short_labels(Instrmap, [Label0 | Labels0], [Label | Labels]) :-
+ jumpopt__short_label(Instrmap, Label0, Label),
+ jumpopt__short_labels(Instrmap, Labels0, Labels).
%-----------------------------------------------------------------------------%
% Find the final destination of a given instruction at a given label.
% We follow gotos as well as consecutive labels.
-:- pred jumpopt__final_dest(label, instruction, instrmap, label, instruction).
-:- mode jumpopt__final_dest(in, in, in, out, out) is det.
+:- pred jumpopt__final_dest(instrmap::in, label::in, label::out,
+ instruction::in, instruction::out) is det.
+
+jumpopt__final_dest(Instrmap, SrcLabel, DestLabel, SrcInstr, DestInstr) :-
+ jumpopt__final_dest_2(Instrmap, [], SrcLabel, DestLabel,
+ SrcInstr, DestInstr).
-:- pred jumpopt__final_dest_2(label, instruction, instrmap, list(label),
- label, instruction).
-:- mode jumpopt__final_dest_2(in, in, in, in, out, out) is det.
-
-jumpopt__final_dest(SrcLabel, SrcInstr, Instrmap, DestLabel, DestInstr) :-
- jumpopt__final_dest_2(SrcLabel, SrcInstr, Instrmap, [],
- DestLabel, DestInstr).
+:- pred jumpopt__final_dest_2(instrmap::in, list(label)::in,
+ label::in, label::out, instruction::in, instruction::out) is det.
-jumpopt__final_dest_2(SrcLabel, SrcInstr, Instrmap, LabelsSofar,
- DestLabel, DestInstr) :-
+jumpopt__final_dest_2(Instrmap, LabelsSofar, SrcLabel, DestLabel,
+ SrcInstr, DestInstr) :-
(
SrcInstr = SrcUinstr - _Comment,
(
@@ -776,8 +737,8 @@
map__search(Instrmap, TargetLabel, TargetInstr),
\+ list__member(SrcLabel, LabelsSofar)
->
- jumpopt__final_dest_2(TargetLabel, TargetInstr, Instrmap,
- [SrcLabel | LabelsSofar], DestLabel, DestInstr)
+ jumpopt__final_dest_2(Instrmap, [SrcLabel | LabelsSofar],
+ TargetLabel, DestLabel, TargetInstr, DestInstr)
;
DestLabel = SrcLabel,
DestInstr = SrcInstr
@@ -785,101 +746,97 @@
%-----------------------------------------------------------------------------%
-:- pred jumpopt__short_labels_rval(rval, instrmap, rval).
-:- mode jumpopt__short_labels_rval(in, in, out) is det.
+:- pred jumpopt__short_labels_rval(instrmap::in, rval::in, rval::out) is det.
-jumpopt__short_labels_rval(lval(Lval0), Instrmap, lval(Lval)) :-
- jumpopt__short_labels_lval(Lval0, Instrmap, Lval).
-jumpopt__short_labels_rval(var(_), _, _) :-
+jumpopt__short_labels_rval(Instrmap, lval(Lval0), lval(Lval)) :-
+ jumpopt__short_labels_lval(Instrmap, Lval0, Lval).
+jumpopt__short_labels_rval(_, var(_), _) :-
error("var rval in jumpopt__short_labels_rval").
-jumpopt__short_labels_rval(mkword(Tag, Rval0), Instrmap,
- mkword(Tag, Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_rval(const(Const0), Instrmap, const(Const)) :-
- jumpopt__short_labels_const(Const0, Instrmap, Const).
-jumpopt__short_labels_rval(unop(Op, Rval0), Instrmap, unop(Op, Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_rval(binop(Op, LRval0, RRval0), Instrmap,
+jumpopt__short_labels_rval(Instrmap, mkword(Tag, Rval0), mkword(Tag, Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_rval(Instrmap, const(Const0), const(Const)) :-
+ jumpopt__short_labels_const(Instrmap, Const0, Const).
+jumpopt__short_labels_rval(Instrmap, unop(Op, Rval0), unop(Op, Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_rval(Instrmap, binop(Op, LRval0, RRval0),
binop(Op, LRval, RRval)) :-
- jumpopt__short_labels_rval(LRval0, Instrmap, LRval),
- jumpopt__short_labels_rval(RRval0, Instrmap, RRval).
-jumpopt__short_labels_rval(mem_addr(MemRef), _, mem_addr(MemRef)).
-
-:- pred jumpopt__short_labels_const(rval_const, instrmap, rval_const).
-:- mode jumpopt__short_labels_const(in, in, out) is det.
-
-jumpopt__short_labels_const(true, _, true).
-jumpopt__short_labels_const(false, _, false).
-jumpopt__short_labels_const(int_const(I), _, int_const(I)).
-jumpopt__short_labels_const(float_const(F), _, float_const(F)).
-jumpopt__short_labels_const(string_const(S), _, string_const(S)).
-jumpopt__short_labels_const(multi_string_const(L, S), _,
+ jumpopt__short_labels_rval(Instrmap, LRval0, LRval),
+ jumpopt__short_labels_rval(Instrmap, RRval0, RRval).
+jumpopt__short_labels_rval(_, mem_addr(MemRef), mem_addr(MemRef)).
+
+:- pred jumpopt__short_labels_const(instrmap::in,
+ rval_const::in, rval_const::out) is det.
+
+jumpopt__short_labels_const(_, true, true).
+jumpopt__short_labels_const(_, false, false).
+jumpopt__short_labels_const(_, int_const(I), int_const(I)).
+jumpopt__short_labels_const(_, float_const(F), float_const(F)).
+jumpopt__short_labels_const(_, string_const(S), string_const(S)).
+jumpopt__short_labels_const(_, multi_string_const(L, S),
multi_string_const(L, S)).
-jumpopt__short_labels_const(label_entry(Label0), Instrmap,
+jumpopt__short_labels_const(Instrmap, label_entry(Label0),
label_entry(Label)) :-
- jumpopt__short_label(Label0, Instrmap, Label).
-jumpopt__short_labels_const(code_addr_const(CodeAddr0), Instrmap,
+ jumpopt__short_label(Instrmap, Label0, Label).
+jumpopt__short_labels_const(Instrmap, code_addr_const(CodeAddr0),
code_addr_const(CodeAddr)) :-
( CodeAddr0 = label(Label0) ->
- jumpopt__short_label(Label0, Instrmap, Label),
+ jumpopt__short_label(Instrmap, Label0, Label),
CodeAddr = label(Label)
;
CodeAddr = CodeAddr0
).
-jumpopt__short_labels_const(data_addr_const(D, O), _, data_addr_const(D, O)).
+jumpopt__short_labels_const(_, data_addr_const(D, O), data_addr_const(D, O)).
-:- pred jumpopt__short_labels_maybe_rvals(list(maybe(rval)), instrmap,
- list(maybe(rval))).
-:- mode jumpopt__short_labels_maybe_rvals(in, in, out) is det.
+:- pred jumpopt__short_labels_maybe_rvals(instrmap::in, list(maybe(rval))::in,
+ list(maybe(rval))::out) is det.
-jumpopt__short_labels_maybe_rvals([], _, []).
-jumpopt__short_labels_maybe_rvals([MaybeRval0 | MaybeRvals0], Instrmap,
+jumpopt__short_labels_maybe_rvals(_, [], []).
+jumpopt__short_labels_maybe_rvals(Instrmap, [MaybeRval0 | MaybeRvals0],
[MaybeRval | MaybeRvals]) :-
- jumpopt__short_labels_maybe_rval(MaybeRval0, Instrmap, MaybeRval),
- jumpopt__short_labels_maybe_rvals(MaybeRvals0, Instrmap, MaybeRvals).
+ jumpopt__short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval),
+ jumpopt__short_labels_maybe_rvals(Instrmap, MaybeRvals0, MaybeRvals).
-:- pred jumpopt__short_labels_maybe_rval(maybe(rval), instrmap, maybe(rval)).
-:- mode jumpopt__short_labels_maybe_rval(in, in, out) is det.
+:- pred jumpopt__short_labels_maybe_rval(instrmap::in,
+ maybe(rval)::in, maybe(rval)::out) is det.
-jumpopt__short_labels_maybe_rval(MaybeRval0, Instrmap, MaybeRval) :-
+jumpopt__short_labels_maybe_rval(Instrmap, MaybeRval0, MaybeRval) :-
(
MaybeRval0 = no,
MaybeRval = no
;
MaybeRval0 = yes(Rval0),
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval),
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval),
MaybeRval = yes(Rval)
).
-:- pred jumpopt__short_labels_lval(lval, instrmap, lval).
-:- mode jumpopt__short_labels_lval(in, in, out) is det.
+:- pred jumpopt__short_labels_lval(instrmap::in, lval::in, lval::out) is det.
-jumpopt__short_labels_lval(reg(T, N), _, reg(T, N)).
-jumpopt__short_labels_lval(succip, _, succip).
-jumpopt__short_labels_lval(maxfr, _, maxfr).
-jumpopt__short_labels_lval(curfr, _, curfr).
-jumpopt__short_labels_lval(hp, _, hp).
-jumpopt__short_labels_lval(sp, _, sp).
-jumpopt__short_labels_lval(temp(T, N), _, temp(T, N)).
-jumpopt__short_labels_lval(stackvar(N), _, stackvar(N)).
-jumpopt__short_labels_lval(framevar(N), _, framevar(N)).
-jumpopt__short_labels_lval(succip(Rval0), Instrmap, succip(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(redoip(Rval0), Instrmap, redoip(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(redofr(Rval0), Instrmap, redofr(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(succfr(Rval0), Instrmap, succfr(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(prevfr(Rval0), Instrmap, prevfr(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(field(Tag, Rval0, Field0), Instrmap,
+jumpopt__short_labels_lval(_, reg(T, N), reg(T, N)).
+jumpopt__short_labels_lval(_, succip, succip).
+jumpopt__short_labels_lval(_, maxfr, maxfr).
+jumpopt__short_labels_lval(_, curfr, curfr).
+jumpopt__short_labels_lval(_, hp, hp).
+jumpopt__short_labels_lval(_, sp, sp).
+jumpopt__short_labels_lval(_, temp(T, N), temp(T, N)).
+jumpopt__short_labels_lval(_, stackvar(N), stackvar(N)).
+jumpopt__short_labels_lval(_, framevar(N), framevar(N)).
+jumpopt__short_labels_lval(Instrmap, succip(Rval0), succip(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(Instrmap, redoip(Rval0), redoip(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(Instrmap, redofr(Rval0), redofr(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(Instrmap, succfr(Rval0), succfr(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(Instrmap, prevfr(Rval0), prevfr(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(Instrmap, field(Tag, Rval0, Field0),
field(Tag, Rval, Field)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval),
- jumpopt__short_labels_rval(Field0, Instrmap, Field).
-jumpopt__short_labels_lval(mem_ref(Rval0), Instrmap, mem_ref(Rval)) :-
- jumpopt__short_labels_rval(Rval0, Instrmap, Rval).
-jumpopt__short_labels_lval(lvar(_), _, _) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval),
+ jumpopt__short_labels_rval(Instrmap, Field0, Field).
+jumpopt__short_labels_lval(Instrmap, mem_ref(Rval0), mem_ref(Rval)) :-
+ jumpopt__short_labels_rval(Instrmap, Rval0, Rval).
+jumpopt__short_labels_lval(_, lvar(_), _) :-
error("lvar lval in jumpopt__short_labels_lval").
%-----------------------------------------------------------------------------%
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.27
diff -u -b -r1.27 layout_out.m
--- compiler/layout_out.m 23 Oct 2003 02:02:08 -0000 1.27
+++ compiler/layout_out.m 9 Nov 2003 11:52:41 -0000
@@ -100,59 +100,55 @@
output_layout_data_defn(label_layout_data(Label, ProcLayoutAddr,
MaybePort, MaybeIsHidden, MaybeGoalPath, MaybeVarInfo),
- DeclSet0, DeclSet) -->
+ !DeclSet, !IO) :-
output_label_layout_data_defn(Label, ProcLayoutAddr,
MaybePort, MaybeIsHidden, MaybeGoalPath, MaybeVarInfo,
- DeclSet0, DeclSet).
+ !DeclSet, !IO).
output_layout_data_defn(proc_layout_data(ProcLabel, Traversal, MaybeRest),
- DeclSet0, DeclSet) -->
+ !DeclSet, !IO) :-
output_proc_layout_data_defn(ProcLabel, Traversal, MaybeRest,
- DeclSet0, DeclSet).
+ !DeclSet, !IO).
output_layout_data_defn(closure_proc_id_data(CallerProcLabel, SeqNo,
ProcLabel, ModuleName, FileName, LineNumber, GoalPath),
- DeclSet0, DeclSet) -->
+ !DeclSet, !IO) :-
output_closure_proc_id_data_defn(CallerProcLabel, SeqNo, ProcLabel,
- ModuleName, FileName, LineNumber, GoalPath, DeclSet0, DeclSet).
+ ModuleName, FileName, LineNumber, GoalPath, !DeclSet, !IO).
output_layout_data_defn(module_layout_data(ModuleName, StringTableSize,
StringTable, ProcLayoutNames, FileLayouts, TraceLevel,
- SuppressedEvents), DeclSet0, DeclSet) -->
+ SuppressedEvents), !DeclSet, !IO) :-
output_module_layout_data_defn(ModuleName, StringTableSize,
StringTable, ProcLayoutNames, FileLayouts, TraceLevel,
- SuppressedEvents, DeclSet0, DeclSet).
+ SuppressedEvents, !DeclSet, !IO).
output_layout_data_defn(proc_static_data(RttiProcLabel, FileName, LineNumber,
- IsInInterface, CallSites), DeclSet0, DeclSet) -->
+ IsInInterface, CallSites), !DeclSet, !IO) :-
output_proc_static_data_defn(RttiProcLabel, FileName, LineNumber,
- IsInInterface, CallSites, DeclSet0, DeclSet).
+ IsInInterface, CallSites, !DeclSet, !IO).
output_layout_data_defn(table_io_decl_data(RttiProcLabel, Kind, NumPTIs,
- PTIVectorRval, TypeParamsRval), DeclSet0, DeclSet) -->
+ PTIVectorRval, TypeParamsRval), !DeclSet, !IO) :-
output_table_io_decl(RttiProcLabel, Kind, NumPTIs,
- PTIVectorRval, TypeParamsRval, DeclSet0, DeclSet).
+ PTIVectorRval, TypeParamsRval, !DeclSet, !IO).
output_layout_data_defn(table_gen_data(RttiProcLabel, NumInputs, NumOutputs,
- Steps, PTIVectorRval, TypeParamsRval), DeclSet0, DeclSet) -->
+ Steps, PTIVectorRval, TypeParamsRval), !DeclSet, !IO) :-
output_table_gen(RttiProcLabel, NumInputs, NumOutputs, Steps,
- PTIVectorRval, TypeParamsRval, DeclSet0, DeclSet).
+ PTIVectorRval, TypeParamsRval, !DeclSet, !IO).
%-----------------------------------------------------------------------------%
-output_layout_name_decl(LayoutName) -->
- output_layout_name_storage_type_name(LayoutName, no),
- io__write_string(";\n").
-
-output_maybe_layout_name_decl(LayoutName, DeclSet0, DeclSet) -->
- (
- { decl_set_is_member(data_addr(layout_addr(LayoutName)),
- DeclSet0) }
- ->
- { DeclSet = DeclSet0 }
+output_layout_name_decl(LayoutName, !IO) :-
+ output_layout_name_storage_type_name(LayoutName, no, !IO),
+ io__write_string(";\n", !IO).
+
+output_maybe_layout_name_decl(LayoutName, !DeclSet, !IO) :-
+ ( decl_set_is_member(data_addr(layout_addr(LayoutName)), !.DeclSet) ->
+ true
;
- output_layout_name_decl(LayoutName),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }
+ output_layout_name_decl(LayoutName, !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet)
).
-output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet) -->
- { extract_layout_name(LayoutData, LayoutName) },
- output_maybe_layout_name_decl(LayoutName, DeclSet0, DeclSet).
+output_maybe_layout_data_decl(LayoutData, !DeclSet, !IO) :-
+ extract_layout_name(LayoutData, LayoutName),
+ output_maybe_layout_name_decl(LayoutName, !DeclSet, !IO).
:- pred extract_layout_name(layout_data::in, layout_name::out) is det.
@@ -177,28 +173,17 @@
LayoutName) :-
LayoutName = table_gen_info(RttiProcLabel).
-:- pred output_layout_decls(list(layout_name)::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
-
-output_layout_decls([], DeclSet, DeclSet) --> [].
-output_layout_decls([LayoutName | LayoutNames], DeclSet0, DeclSet) -->
- output_layout_decl(LayoutName, DeclSet0, DeclSet1),
- output_layout_decls(LayoutNames, DeclSet1, DeclSet).
-
:- pred output_layout_decl(layout_name::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_layout_decl(LayoutName, DeclSet0, DeclSet) -->
- (
- { decl_set_is_member(data_addr(layout_addr(LayoutName)),
- DeclSet0) }
+output_layout_decl(LayoutName, !DeclSet, !IO) :-
+ ( decl_set_is_member(data_addr(layout_addr(LayoutName)), !.DeclSet)
->
- { DeclSet = DeclSet0 }
+ true
;
- output_layout_name_storage_type_name(LayoutName, no),
- io__write_string(";\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }
+ output_layout_name_storage_type_name(LayoutName, no, !IO),
+ io__write_string(";\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet)
).
% This code should be kept in sync with output_layout_name/3 below.
@@ -456,77 +441,73 @@
io__state::di, io__state::uo) is det.
output_label_layout_data_defn(Label, ProcLayoutAddr, MaybePort, MaybeIsHidden,
- MaybeGoalPath, MaybeVarInfo, DeclSet0, DeclSet) -->
- output_layout_decl(ProcLayoutAddr, DeclSet0, DeclSet1),
+ MaybeGoalPath, MaybeVarInfo, !DeclSet, !IO) :-
+ output_layout_decl(ProcLayoutAddr, !DeclSet, !IO),
(
- { MaybeVarInfo = yes(VarInfo0) },
- { VarInfo0 = label_var_info(_,
- LocnsTypes0, VarNums0, TypeParams0) },
- output_rval_decls(LocnsTypes0, "", "", 0, _,
- DeclSet1, DeclSet2),
- output_rval_decls(VarNums0, "", "", 0, _,
- DeclSet2, DeclSet3),
- output_rval_decls(TypeParams0, "", "", 0, _,
- DeclSet3, DeclSet4),
- { LabelVars = label_has_var_info }
- ;
- { MaybeVarInfo = no },
- { DeclSet4 = DeclSet0 },
- { LabelVars = label_has_no_var_info }
- ),
- io__write_string("\n"),
- { LayoutName = label_layout(Label, LabelVars) },
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- io__write_string("\t(const MR_Proc_Layout *)\n\t\t&"),
- output_layout_name(ProcLayoutAddr),
- io__write_string(",\n\t"),
+ MaybeVarInfo = yes(VarInfo0),
+ VarInfo0 = label_var_info(_,
+ LocnsTypes0, VarNums0, TypeParams0),
+ output_rval_decls(LocnsTypes0, !DeclSet, !IO),
+ output_rval_decls(VarNums0, !DeclSet, !IO),
+ output_rval_decls(TypeParams0, !DeclSet, !IO),
+ LabelVars = label_has_var_info
+ ;
+ MaybeVarInfo = no,
+ LabelVars = label_has_no_var_info
+ ),
+ io__write_string("\n", !IO),
+ LayoutName = label_layout(Label, LabelVars),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ io__write_string("\t(const MR_Proc_Layout *)\n\t\t&", !IO),
+ output_layout_name(ProcLayoutAddr, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ MaybePort = yes(Port),
+ io__write_string(trace_port_to_string(Port), !IO)
+ ;
+ MaybePort = no,
+ io__write_string("MR_PORT_NONE", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
(
- { MaybePort = yes(Port) },
- io__write_string(trace_port_to_string(Port))
+ MaybeIsHidden = yes(yes),
+ io__write_string("MR_TRUE", !IO)
;
- { MaybePort = no },
- io__write_string("MR_PORT_NONE")
- ),
- io__write_string(",\n\t"),
- (
- { MaybeIsHidden = yes(yes) },
- io__write_string("MR_TRUE")
+ MaybeIsHidden = yes(no),
+ io__write_string("MR_FALSE", !IO)
;
- { MaybeIsHidden = yes(no) },
- io__write_string("MR_FALSE")
- ;
- { MaybeIsHidden = no },
+ MaybeIsHidden = no,
% the value we write here shouldn't matter
- io__write_string("MR_FALSE")
+ io__write_string("MR_FALSE", !IO)
),
- io__write_string(",\n\t"),
+ io__write_string(",\n\t", !IO),
(
- { MaybeGoalPath = yes(GoalPath) },
- io__write_int(GoalPath)
+ MaybeGoalPath = yes(GoalPath),
+ io__write_int(GoalPath, !IO)
;
- { MaybeGoalPath = no },
- io__write_string("0")
- ),
- io__write_string(",\n\t"),
- (
- { MaybeVarInfo = yes(VarInfo) },
- { VarInfo = label_var_info(EncodedVarCount,
- LocnsTypes, VarNums, TypeParams) },
- io__write_int(EncodedVarCount),
- io__write_string(",\n\t(const void *)\n\t\t"),
- output_rval(LocnsTypes),
- io__write_string(",\n\t(const MR_uint_least16_t *)\n\t\t"),
- output_rval(VarNums),
- io__write_string(",\n\t(const MR_Type_Param_Locns *)\n\t\t"),
- output_rval(TypeParams)
+ MaybeGoalPath = no,
+ io__write_string("0", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ MaybeVarInfo = yes(VarInfo),
+ VarInfo = label_var_info(EncodedVarCount,
+ LocnsTypes, VarNums, TypeParams),
+ io__write_int(EncodedVarCount, !IO),
+ io__write_string(",\n\t(const void *)\n\t\t", !IO),
+ output_rval(LocnsTypes, !IO),
+ io__write_string(",\n\t(const MR_uint_least16_t *)\n\t\t", !IO),
+ output_rval(VarNums, !IO),
+ io__write_string(",\n\t(const MR_Type_Param_Locns *)\n\t\t",
+ !IO),
+ output_rval(TypeParams, !IO)
;
- { MaybeVarInfo = no },
- io__write_int(-1)
+ MaybeVarInfo = no,
+ io__write_int(-1, !IO)
),
- io__write_string("\n};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet4, DeclSet) }.
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- func trace_port_to_string(trace_port) = string.
@@ -552,43 +533,44 @@
proc_layout_stack_traversal::in, maybe_proc_id_and_exec_trace::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_proc_layout_data_defn(ProcLabel, Traversal, MaybeRest,
- DeclSet0, DeclSet) -->
- { Kind = maybe_proc_layout_and_exec_trace_kind(MaybeRest, ProcLabel) },
- (
- { MaybeRest = no_proc_id },
- output_layout_traversal_decls(Traversal, DeclSet0, DeclSet4),
- output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal),
- output_layout_no_proc_id_group,
- output_proc_layout_data_defn_end
- ;
- { MaybeRest = proc_id_only },
- output_layout_traversal_decls(Traversal, DeclSet0, DeclSet4),
- output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal),
- output_layout_proc_id_group(ProcLabel),
- output_layout_no_exec_trace_group,
- output_proc_layout_data_defn_end
+output_proc_layout_data_defn(ProcLabel, Traversal, MaybeRest, !DeclSet, !IO) :-
+ Kind = maybe_proc_layout_and_exec_trace_kind(MaybeRest, ProcLabel),
+ (
+ MaybeRest = no_proc_id,
+ output_layout_traversal_decls(Traversal, !DeclSet, !IO),
+ output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal,
+ !IO),
+ output_layout_no_proc_id_group(!IO),
+ output_proc_layout_data_defn_end(!IO)
+ ;
+ MaybeRest = proc_id_only,
+ output_layout_traversal_decls(Traversal, !DeclSet, !IO),
+ output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal,
+ !IO),
+ output_layout_proc_id_group(ProcLabel, !IO),
+ output_layout_no_exec_trace_group(!IO),
+ output_proc_layout_data_defn_end(!IO)
;
- { MaybeRest = proc_id_and_exec_trace(ExecTrace) },
- { HeadVarNums = ExecTrace ^ head_var_nums },
+ MaybeRest = proc_id_and_exec_trace(ExecTrace),
+ HeadVarNums = ExecTrace ^ head_var_nums,
output_proc_layout_head_var_nums(ProcLabel, HeadVarNums,
- DeclSet0, DeclSet1),
- { VarNames = ExecTrace ^ var_names },
- { MaxVarNum = ExecTrace ^ max_var_num },
+ !DeclSet, !IO),
+ VarNames = ExecTrace ^ var_names,
+ MaxVarNum = ExecTrace ^ max_var_num,
output_proc_layout_var_names(ProcLabel, VarNames, MaxVarNum,
- DeclSet1, DeclSet2),
- output_layout_traversal_decls(Traversal, DeclSet2, DeclSet3),
- output_layout_exec_trace_decls(ProcLabel, ExecTrace,
- DeclSet3, DeclSet4),
-
- output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal),
- output_layout_proc_id_group(ProcLabel),
- output_layout_exec_trace_group(ProcLabel, ExecTrace),
- output_proc_layout_data_defn_end
+ !DeclSet, !IO),
+ output_layout_traversal_decls(Traversal, !DeclSet, !IO),
+ output_layout_exec_trace_decls(ProcLabel, ExecTrace, !DeclSet,
+ !IO),
+
+ output_proc_layout_data_defn_start(ProcLabel, Kind, Traversal,
+ !IO),
+ output_layout_proc_id_group(ProcLabel, !IO),
+ output_layout_exec_trace_group(ProcLabel, ExecTrace, !IO),
+ output_proc_layout_data_defn_end(!IO)
),
- { decl_set_insert(data_addr(
- layout_addr(proc_layout(ProcLabel, Kind))),
- DeclSet4, DeclSet) }.
+ decl_set_insert(data_addr(layout_addr(proc_layout(ProcLabel, Kind))),
+ !DeclSet).
:- func maybe_proc_layout_and_exec_trace_kind(maybe_proc_id_and_exec_trace,
proc_label) = proc_layout_kind.
@@ -629,47 +611,45 @@
:- pred output_layout_traversal_decls(proc_layout_stack_traversal::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_layout_traversal_decls(Traversal, DeclSet0, DeclSet) -->
- { Traversal = proc_layout_stack_traversal(MaybeEntryLabel,
- _MaybeSuccipSlot, _StackSlotCount, _Detism) },
- (
- { MaybeEntryLabel = yes(EntryLabel) },
- output_code_addr_decls(label(EntryLabel), "", "", 0, _,
- DeclSet0, DeclSet)
+output_layout_traversal_decls(Traversal, !DeclSet, !IO) :-
+ Traversal = proc_layout_stack_traversal(MaybeEntryLabel,
+ _MaybeSuccipSlot, _StackSlotCount, _Detism),
+ (
+ MaybeEntryLabel = yes(EntryLabel),
+ output_code_addr_decls(label(EntryLabel), !DeclSet, !IO)
;
- { MaybeEntryLabel = no },
- { DeclSet = DeclSet0 }
+ MaybeEntryLabel = no
).
:- pred output_layout_traversal_group(proc_layout_stack_traversal::in,
io__state::di, io__state::uo) is det.
-output_layout_traversal_group(Traversal) -->
- { Traversal = proc_layout_stack_traversal(MaybeEntryLabel,
- MaybeSuccipSlot, StackSlotCount, Detism) },
- io__write_string("\t{\n\t"),
+output_layout_traversal_group(Traversal, !IO) :-
+ Traversal = proc_layout_stack_traversal(MaybeEntryLabel,
+ MaybeSuccipSlot, StackSlotCount, Detism),
+ io__write_string("\t{\n\t", !IO),
(
- { MaybeEntryLabel = yes(EntryLabel) },
- output_code_addr(label(EntryLabel))
+ MaybeEntryLabel = yes(EntryLabel),
+ output_code_addr(label(EntryLabel), !IO)
;
- { MaybeEntryLabel = no },
+ MaybeEntryLabel = no,
% The actual code address will be put into the structure
% by module initialization code.
- io__write_string("NULL")
+ io__write_string("NULL", !IO)
),
- io__write_string(",\n\t"),
+ io__write_string(",\n\t", !IO),
(
- { MaybeSuccipSlot = yes(SuccipSlot) },
- io__write_int(SuccipSlot)
+ MaybeSuccipSlot = yes(SuccipSlot),
+ io__write_int(SuccipSlot, !IO)
;
- { MaybeSuccipSlot = no },
- io__write_int(-1)
+ MaybeSuccipSlot = no,
+ io__write_int(-1, !IO)
),
- io__write_string(",\n\t"),
- io__write_int(StackSlotCount),
- io__write_string(",\n\t"),
- io__write_string(detism_to_c_detism(Detism)),
- io__write_string("\n\t},\n").
+ io__write_string(",\n\t", !IO),
+ io__write_int(StackSlotCount, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string(detism_to_c_detism(Detism), !IO),
+ io__write_string("\n\t},\n", !IO).
:- func detism_to_c_detism(determinism) = string.
@@ -699,28 +679,26 @@
proc_layout_exec_trace::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_layout_exec_trace_decls(ProcLabel, ExecTrace, DeclSet0, DeclSet) -->
- { ExecTrace = proc_layout_exec_trace(CallLabelLayout, MaybeProcBody,
+output_layout_exec_trace_decls(ProcLabel, ExecTrace, !DeclSet, !IO) :-
+ ExecTrace = proc_layout_exec_trace(CallLabelLayout, MaybeProcBody,
MaybeTableInfo, _HeadVarNums, _VarNames, _MaxVarNum,
_MaxRegNum, _MaybeFromFullSlot, _MaybeIoSeqSlot,
_MaybeTrailSlot, _MaybeMaxfrSlot, _EvalMethod,
- _MaybeCallTableSlot) },
- { ModuleName = get_defining_module_name(ProcLabel) },
- output_layout_decl(CallLabelLayout, DeclSet0, DeclSet1),
- output_layout_decl(module_layout(ModuleName), DeclSet1, DeclSet2),
+ _MaybeCallTableSlot),
+ ModuleName = get_defining_module_name(ProcLabel),
+ output_layout_decl(CallLabelLayout, !DeclSet, !IO),
+ output_layout_decl(module_layout(ModuleName), !DeclSet, !IO),
(
- { MaybeProcBody = yes(ProcBody) },
- output_rval_decls(ProcBody, "", "", 0, _, DeclSet2, DeclSet3)
+ MaybeProcBody = yes(ProcBody),
+ output_rval_decls(ProcBody, !DeclSet, !IO)
;
- { MaybeProcBody = no },
- { DeclSet3 = DeclSet2 }
+ MaybeProcBody = no
),
(
- { MaybeTableInfo = yes(TableInfo) },
- output_layout_decl(TableInfo, DeclSet3, DeclSet)
+ MaybeTableInfo = yes(TableInfo),
+ output_layout_decl(TableInfo, !DeclSet, !IO)
;
- { MaybeTableInfo = no },
- { DeclSet = DeclSet3 }
+ MaybeTableInfo = no
).
:- pred output_layout_exec_trace_group(proc_label::in,
@@ -822,7 +800,7 @@
:- pred output_proc_layout_head_var_nums(proc_label::in, list(int)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_proc_layout_head_var_nums(ProcLabel, HeadVarNums, DeclSet0, DeclSet) -->
+output_proc_layout_head_var_nums(ProcLabel, HeadVarNums, !DeclSet) -->
io__write_string("\n"),
output_layout_name_storage_type_name(
proc_layout_head_var_nums(ProcLabel), yes),
@@ -837,13 +815,13 @@
io__write_string("};\n"),
{ decl_set_insert(data_addr(
layout_addr(proc_layout_head_var_nums(ProcLabel))),
- DeclSet0, DeclSet) }.
+ !DeclSet) }.
:- pred output_proc_layout_var_names(proc_label::in, list(int)::in, int::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_proc_layout_var_names(ProcLabel, VarNames, MaxVarNum,
- DeclSet0, DeclSet) -->
+ !DeclSet) -->
{ list__length(VarNames, VarNameCount) },
{ require(unify(VarNameCount, MaxVarNum),
"output_proc_layout_var_names: VarNameCount != MaxVarNum") },
@@ -861,7 +839,7 @@
io__write_string("};\n"),
{ decl_set_insert(data_addr(
layout_addr(proc_layout_var_names(ProcLabel))),
- DeclSet0, DeclSet) }.
+ !DeclSet) }.
:- pred output_layout_no_exec_trace_group(io__state::di, io__state::uo) is det.
@@ -876,7 +854,7 @@
output_closure_proc_id_data_defn(CallerProcLabel, SeqNo, ClosureProcLabel,
ModuleName, FileName, LineNumber, GoalPath,
- DeclSet0, DeclSet) -->
+ !DeclSet) -->
io__write_string("\n"),
{ LayoutName = closure_proc_id(CallerProcLabel, SeqNo,
ClosureProcLabel) },
@@ -894,7 +872,7 @@
quote_and_write_string(GoalPath),
io__write_string("\n};\n"),
{ decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+ !DeclSet) }.
:- pred output_proc_id(proc_label::in, io__state::di, io__state::uo) is det.
@@ -953,68 +931,65 @@
output_module_layout_data_defn(ModuleName, StringTableSize, StringTable,
ProcLayoutNames, FileLayouts, TraceLevel, SuppressedEvents,
- DeclSet0, DeclSet) -->
+ !DeclSet, !IO) :-
output_module_string_table(ModuleName, StringTableSize, StringTable,
- DeclSet0, DeclSet1),
+ !DeclSet, !IO),
output_module_layout_proc_vector_defn(ModuleName, ProcLayoutNames,
- ProcVectorName, DeclSet1, DeclSet2),
+ ProcVectorName, !DeclSet, !IO),
output_file_layout_data_defns(ModuleName, 0, FileLayouts,
- FileLayoutNames, DeclSet2, DeclSet3),
+ FileLayoutNames, !DeclSet, !IO),
output_file_layout_vector_data_defn(ModuleName, FileLayoutNames,
- FileVectorName, DeclSet3, DeclSet4),
+ FileVectorName, !DeclSet, !IO),
- { ModuleLayoutName = module_layout(ModuleName) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(ModuleLayoutName, yes),
- io__write_string(" = {\n\t"),
- { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
- quote_and_write_string(ModuleNameStr),
- io__write_string(",\n\t"),
- io__write_int(StringTableSize),
- io__write_string(",\n\t"),
- { ModuleStringTableName = module_layout_string_table(ModuleName) },
- output_layout_name(ModuleStringTableName),
- io__write_string(",\n\t"),
- { list__length(ProcLayoutNames, ProcLayoutVectorLength) },
- io__write_int(ProcLayoutVectorLength),
- io__write_string(",\n\t"),
- output_layout_name(ProcVectorName),
- io__write_string(",\n\t"),
- { list__length(FileLayouts, FileLayoutVectorLength) },
- io__write_int(FileLayoutVectorLength),
- io__write_string(",\n\t"),
- output_layout_name(FileVectorName),
- io__write_string(",\n\t"),
- io__write_string(trace_level_rep(TraceLevel)),
- io__write_string(",\n\t"),
- io__write_int(SuppressedEvents),
- io__write_string("\n};\n"),
- { decl_set_insert(data_addr(layout_addr(ModuleLayoutName)),
- DeclSet4, DeclSet) }.
+ ModuleLayoutName = module_layout(ModuleName),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(ModuleLayoutName, yes, !IO),
+ io__write_string(" = {\n\t", !IO),
+ prog_out__sym_name_to_string(ModuleName, ModuleNameStr),
+ quote_and_write_string(ModuleNameStr, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(StringTableSize, !IO),
+ io__write_string(",\n\t", !IO),
+ ModuleStringTableName = module_layout_string_table(ModuleName),
+ output_layout_name(ModuleStringTableName, !IO),
+ io__write_string(",\n\t", !IO),
+ list__length(ProcLayoutNames, ProcLayoutVectorLength),
+ io__write_int(ProcLayoutVectorLength, !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(ProcVectorName, !IO),
+ io__write_string(",\n\t", !IO),
+ list__length(FileLayouts, FileLayoutVectorLength),
+ io__write_int(FileLayoutVectorLength, !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(FileVectorName, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string(trace_level_rep(TraceLevel), !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(SuppressedEvents, !IO),
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(ModuleLayoutName)), !DeclSet).
:- pred output_module_layout_proc_vector_defn(module_name::in,
list(layout_name)::in, layout_name::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
output_module_layout_proc_vector_defn(ModuleName, ProcLayoutNames,
- VectorName, DeclSet0, DeclSet) -->
- output_layout_decls(ProcLayoutNames, DeclSet0, DeclSet1),
- { VectorName = module_layout_proc_vector(ModuleName) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(VectorName, yes),
- io__write_string(" = {\n"),
- ( { ProcLayoutNames = [] } ->
+ VectorName, !DeclSet, !IO) :-
+ list__foldl2(output_layout_decl, ProcLayoutNames, !DeclSet, !IO),
+ VectorName = module_layout_proc_vector(ModuleName),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(VectorName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ ( ProcLayoutNames = [] ->
% ANSI/ISO C doesn't allow empty arrays, so
% place a dummy value in the array.
- io__write_string("\tNULL\n")
+ io__write_string("\tNULL\n", !IO)
;
list__foldl(output_layout_name_in_vector(
- "(const MR_Proc_Layout *)\n\t&"),
- ProcLayoutNames)
+ "(const MR_Proc_Layout *)\n\t&"), ProcLayoutNames, !IO)
),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(VectorName)),
- DeclSet1, DeclSet) }.
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(VectorName)), !DeclSet).
%-----------------------------------------------------------------------------%
@@ -1026,7 +1001,7 @@
io__state::di, io__state::uo) is det.
output_module_string_table(ModuleName, StringTableSize, StringTable,
- DeclSet0, DeclSet) -->
+ !DeclSet) -->
{ TableName = module_layout_string_table(ModuleName) },
io__write_string("\n"),
output_layout_name_storage_type_name(TableName, yes),
@@ -1035,7 +1010,7 @@
StringTable),
io__write_string("};\n"),
{ decl_set_insert(data_addr(layout_addr(TableName)),
- DeclSet0, DeclSet) }.
+ !DeclSet) }.
% The jobs of this predicate is to minimize stack space consumption in
% grades that do not allow output_module_string_table_chars to be tail
@@ -1086,111 +1061,106 @@
io__state::di, io__state::uo) is det.
output_file_layout_vector_data_defn(ModuleName, FileLayoutNames, VectorName,
- DeclSet0, DeclSet) -->
- output_layout_decls(FileLayoutNames, DeclSet0, DeclSet1),
- { VectorName = module_layout_file_vector(ModuleName) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(VectorName, yes),
- io__write_string(" = {\n"),
- ( { FileLayoutNames = [] } ->
+ !DeclSet, !IO) :-
+ list__foldl2(output_layout_decl, FileLayoutNames, !DeclSet, !IO),
+ VectorName = module_layout_file_vector(ModuleName),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(VectorName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ ( FileLayoutNames = [] ->
% ANSI/ISO C doesn't allow empty arrays, so
% place a dummy value in the array.
- io__write_string("\tNULL\n")
+ io__write_string("\tNULL\n", !IO)
;
- list__foldl(output_layout_name_in_vector("&"), FileLayoutNames)
+ list__foldl(output_layout_name_in_vector("&"), FileLayoutNames,
+ !IO)
),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(VectorName)),
- DeclSet1, DeclSet) }.
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(VectorName)), !DeclSet).
:- pred output_file_layout_data_defns(module_name::in, int::in,
list(file_layout_data)::in, list(layout_name)::out,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_file_layout_data_defns(_, _, [], [], DeclSet, DeclSet) --> [].
+output_file_layout_data_defns(_, _, [], [], !DeclSet) --> [].
output_file_layout_data_defns(ModuleName, FileNum, [FileLayout | FileLayouts],
- [FileLayoutName | FileLayoutNames], DeclSet0, DeclSet) -->
+ [FileLayoutName | FileLayoutNames], !DeclSet) -->
output_file_layout_data_defn(ModuleName, FileNum, FileLayout,
- FileLayoutName, DeclSet0, DeclSet1),
+ FileLayoutName, !DeclSet),
output_file_layout_data_defns(ModuleName, FileNum + 1, FileLayouts,
- FileLayoutNames, DeclSet1, DeclSet).
+ FileLayoutNames, !DeclSet).
:- pred output_file_layout_data_defn(module_name::in, int::in,
file_layout_data::in, layout_name::out,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_file_layout_data_defn(ModuleName, FileNum, FileLayout, FileLayoutName,
- DeclSet0, DeclSet) -->
- { FileLayout = file_layout_data(FileName, LineNoLabelList) },
- { list__map2(line_no_label_to_label_layout_addr, LineNoLabelList,
- LineNos, LabelLayoutAddrs) },
- output_data_addrs_decls(LabelLayoutAddrs, "", "", 0, _,
- DeclSet0, DeclSet1),
+ !DeclSet, !IO) :-
+ FileLayout = file_layout_data(FileName, LineNoLabelList),
+ list__map2(line_no_label_to_label_layout_addr, LineNoLabelList,
+ LineNos, LabelLayoutAddrs),
+ list__foldl2(output_data_addr_decls, LabelLayoutAddrs, !DeclSet, !IO),
- { list__length(LineNoLabelList, VectorLengths) },
+ list__length(LineNoLabelList, VectorLengths),
output_file_layout_line_number_vector_defn(ModuleName, FileNum,
- LineNos, LineNumberVectorName, DeclSet1, DeclSet2),
+ LineNos, LineNumberVectorName, !DeclSet, !IO),
output_file_layout_label_layout_vector_defn(ModuleName, FileNum,
- LabelLayoutAddrs, LabelVectorName, DeclSet2, DeclSet3),
+ LabelLayoutAddrs, LabelVectorName, !DeclSet, !IO),
- { FileLayoutName = file_layout(ModuleName, FileNum) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(FileLayoutName, yes),
- io__write_string(" = {\n\t"),
- quote_and_write_string(FileName),
- io__write_string(",\n\t"),
- io__write_int(VectorLengths),
- io__write_string(",\n\t"),
- output_layout_name(LineNumberVectorName),
- io__write_string(",\n\t"),
- output_layout_name(LabelVectorName),
- io__write_string("\n};\n"),
- { decl_set_insert(data_addr(layout_addr(FileLayoutName)),
- DeclSet3, DeclSet) }.
+ FileLayoutName = file_layout(ModuleName, FileNum),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(FileLayoutName, yes, !IO),
+ io__write_string(" = {\n\t", !IO),
+ quote_and_write_string(FileName, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(VectorLengths, !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(LineNumberVectorName, !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(LabelVectorName, !IO),
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(FileLayoutName)), !DeclSet).
:- pred output_file_layout_line_number_vector_defn(module_name::in, int::in,
list(int)::in, layout_name::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
output_file_layout_line_number_vector_defn(ModuleName, FileNum, LineNumbers,
- LayoutName, DeclSet0, DeclSet) -->
- { LayoutName = file_layout_line_number_vector(ModuleName, FileNum) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- ( { LineNumbers = [] } ->
+ LayoutName, !DeclSet, !IO) :-
+ LayoutName = file_layout_line_number_vector(ModuleName, FileNum),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ ( LineNumbers = [] ->
% ANSI/ISO C doesn't allow empty arrays, so
% place a dummy value in the array.
- io__write_string("\t0\n")
+ io__write_string("\t0\n", !IO)
;
- list__foldl(output_number_in_vector, LineNumbers)
+ list__foldl(output_number_in_vector, LineNumbers, !IO)
),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_file_layout_label_layout_vector_defn(module_name::in, int::in,
list(data_addr)::in, layout_name::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
output_file_layout_label_layout_vector_defn(ModuleName, FileNum, LabelAddrs,
- LayoutName, DeclSet0, DeclSet) -->
- { LayoutName = file_layout_label_layout_vector(ModuleName, FileNum) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- ( { LabelAddrs = [] } ->
+ LayoutName, !DeclSet, !IO) :-
+ LayoutName = file_layout_label_layout_vector(ModuleName, FileNum),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ ( LabelAddrs = [] ->
% ANSI/ISO C doesn't allow empty arrays, so
% place a dummy value in the array.
- io__write_string("\tNULL\n")
+ io__write_string("\tNULL\n", !IO)
;
list__foldl(output_data_addr_in_vector(
- "(const MR_Label_Layout *)\n\t&"),
- LabelAddrs)
+ "(const MR_Label_Layout *)\n\t&"), LabelAddrs, !IO)
),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
%-----------------------------------------------------------------------------%
@@ -1240,119 +1210,111 @@
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_proc_static_data_defn(RttiProcLabel, FileName, LineNumber,
- IsInInterface, CallSites, DeclSet0, DeclSet) -->
- list__foldl2(output_call_site_static_decl, CallSites,
- DeclSet0, DeclSet1),
- output_call_site_static_array(RttiProcLabel, CallSites,
- DeclSet1, DeclSet2),
- { LayoutName = proc_static(RttiProcLabel) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- { ProcLabel = make_proc_label_from_rtti(RttiProcLabel) },
- output_layout_proc_id_group(ProcLabel),
- io__write_string("\t"),
- quote_and_write_string(FileName),
- io__write_string(",\n\t"),
- io__write_int(LineNumber),
- io__write_string(",\n\t"),
- (
- { IsInInterface = yes },
- io__write_string("MR_TRUE")
- ;
- { IsInInterface = no },
- io__write_string("MR_FALSE")
- ),
- io__write_string(",\n\t"),
- io__write_int(list__length(CallSites)),
- io__write_string(",\n\t"),
- { CallSitesLayoutName = proc_static_call_sites(RttiProcLabel) },
- output_layout_name(CallSitesLayoutName),
- io__write_string(",\n#ifdef MR_USE_ACTIVATION_COUNTS\n"),
- io__write_string("\t0,\n"),
- io__write_string("#endif\n"),
- io__write_string("\tNULL\n};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet2, DeclSet) }.
+ IsInInterface, CallSites, !DeclSet, !IO) :-
+ list__foldl2(output_call_site_static_decl, CallSites, !DeclSet, !IO),
+ output_call_site_static_array(RttiProcLabel, CallSites, !DeclSet, !IO),
+ LayoutName = proc_static(RttiProcLabel),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
+ output_layout_proc_id_group(ProcLabel, !IO),
+ io__write_string("\t", !IO),
+ quote_and_write_string(FileName, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(LineNumber, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ IsInInterface = yes,
+ io__write_string("MR_TRUE", !IO)
+ ;
+ IsInInterface = no,
+ io__write_string("MR_FALSE", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ io__write_int(list__length(CallSites), !IO),
+ io__write_string(",\n\t", !IO),
+ CallSitesLayoutName = proc_static_call_sites(RttiProcLabel),
+ output_layout_name(CallSitesLayoutName, !IO),
+ io__write_string(",\n#ifdef MR_USE_ACTIVATION_COUNTS\n", !IO),
+ io__write_string("\t0,\n", !IO),
+ io__write_string("#endif\n", !IO),
+ io__write_string("\tNULL\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_call_site_static_array(rtti_proc_label::in,
list(call_site_static_data)::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_call_site_static_array(RttiProcLabel, CallSites, DeclSet0, DeclSet) -->
- { LayoutName = proc_static_call_sites(RttiProcLabel) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- list__foldl2(output_call_site_static, CallSites, 0, _),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+output_call_site_static_array(RttiProcLabel, CallSites, !DeclSet, !IO) :-
+ LayoutName = proc_static_call_sites(RttiProcLabel),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ list__foldl2(output_call_site_static, CallSites, 0, _, !IO),
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_call_site_static(call_site_static_data::in, int::in, int::out,
io__state::di, io__state::uo) is det.
-output_call_site_static(CallSiteStatic, Index, Index + 1) -->
- io__write_string("\t{ /* "),
- io__write_int(Index),
- io__write_string(" */ "),
- (
- { CallSiteStatic = normal_call(Callee, TypeSubst,
- FileName, LineNumber, GoalPath) },
- io__write_string("MR_normal_call, (MR_ProcStatic *)\n\t &"),
- output_layout_name(proc_static(Callee)),
- ( { TypeSubst = "" } ->
- io__write_string(",\n\t NULL, ")
- ;
- io__write_string(",\n\t """),
- io__write_string(TypeSubst),
- io__write_string(""", ")
+output_call_site_static(CallSiteStatic, Index, Index + 1, !IO) :-
+ io__write_string("\t{ /* ", !IO),
+ io__write_int(Index, !IO),
+ io__write_string(" */ ", !IO),
+ (
+ CallSiteStatic = normal_call(Callee, TypeSubst,
+ FileName, LineNumber, GoalPath),
+ io__write_string("MR_normal_call, (MR_ProcStatic *)\n\t &",
+ !IO),
+ output_layout_name(proc_static(Callee), !IO),
+ ( TypeSubst = "" ->
+ io__write_string(",\n\t NULL, ", !IO)
+ ;
+ io__write_string(",\n\t """, !IO),
+ io__write_string(TypeSubst, !IO),
+ io__write_string(""", ", !IO)
)
;
- { CallSiteStatic = special_call(FileName, LineNumber,
- GoalPath) },
- io__write_string("MR_special_call, NULL,\n\t NULL, ")
- ;
- { CallSiteStatic = higher_order_call(FileName, LineNumber,
- GoalPath) },
- io__write_string("MR_higher_order_call, NULL,\n\t NULL, ")
- ;
- { CallSiteStatic = method_call(FileName, LineNumber,
- GoalPath) },
- io__write_string("MR_method_call, NULL,\n\t NULL, ")
- ;
- { CallSiteStatic = callback(FileName, LineNumber, GoalPath) },
- io__write_string("MR_callback, NULL,\n\t NULL, ")
- ),
- io__write_string(""""),
- io__write_string(FileName),
- io__write_string(""", "),
- io__write_int(LineNumber),
- io__write_string(", """),
- { goal_path_to_string(GoalPath, GoalPathStr) },
- io__write_string(GoalPathStr),
- io__write_string(""" },\n").
+ CallSiteStatic = special_call(FileName, LineNumber,
+ GoalPath),
+ io__write_string("MR_special_call, NULL,\n\t NULL, ", !IO)
+ ;
+ CallSiteStatic = higher_order_call(FileName, LineNumber,
+ GoalPath),
+ io__write_string("MR_higher_order_call, NULL,\n\t NULL, ", !IO)
+ ;
+ CallSiteStatic = method_call(FileName, LineNumber, GoalPath),
+ io__write_string("MR_method_call, NULL,\n\t NULL, ", !IO)
+ ;
+ CallSiteStatic = callback(FileName, LineNumber, GoalPath),
+ io__write_string("MR_callback, NULL,\n\t NULL, ", !IO)
+ ),
+ io__write_string("""", !IO),
+ io__write_string(FileName, !IO),
+ io__write_string(""", ", !IO),
+ io__write_int(LineNumber, !IO),
+ io__write_string(", """, !IO),
+ goal_path_to_string(GoalPath, GoalPathStr),
+ io__write_string(GoalPathStr, !IO),
+ io__write_string(""" },\n", !IO).
:- pred output_call_site_static_decl(call_site_static_data::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_call_site_static_decl(CallSiteStatic, DeclSet0, DeclSet) -->
+output_call_site_static_decl(CallSiteStatic, !DeclSet, !IO) :-
(
- { CallSiteStatic = normal_call(Callee, _, _, _, _) },
+ CallSiteStatic = normal_call(Callee, _, _, _, _),
output_maybe_layout_name_decl(proc_static(Callee),
- DeclSet0, DeclSet)
+ !DeclSet, !IO)
;
- { CallSiteStatic = special_call(_, _, _) },
- { DeclSet = DeclSet0 }
+ CallSiteStatic = special_call(_, _, _)
;
- { CallSiteStatic = higher_order_call(_, _, _) },
- { DeclSet = DeclSet0 }
+ CallSiteStatic = higher_order_call(_, _, _)
;
- { CallSiteStatic = method_call(_, _, _) },
- { DeclSet = DeclSet0 }
+ CallSiteStatic = method_call(_, _, _)
;
- { CallSiteStatic = callback(_, _, _) },
- { DeclSet = DeclSet0 }
+ CallSiteStatic = callback(_, _, _)
).
%-----------------------------------------------------------------------------%
@@ -1362,78 +1324,76 @@
io__state::di, io__state::uo) is det.
output_table_io_decl(RttiProcLabel, ProcLayoutKind, NumPTIs,
- PTIVectorRval, TypeParamsRval, DeclSet0, DeclSet) -->
- output_rval_decls(PTIVectorRval, "", "", 0, _, DeclSet0, DeclSet1),
- { LayoutName = table_io_decl(RttiProcLabel) },
- { ProcLabel = make_proc_label_from_rtti(RttiProcLabel) },
- { ProcLayoutName = proc_layout(ProcLabel, ProcLayoutKind) },
- output_layout_decl(ProcLayoutName, DeclSet1, DeclSet2),
-
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n\t(const MR_Proc_Layout *) &"),
- output_layout_name(ProcLayoutName),
- io__write_string(",\n\t"),
- io__write_int(NumPTIs),
- io__write_string(",\n\t(const MR_PseudoTypeInfo *) "),
- output_rval(PTIVectorRval),
- io__write_string(",\n\t(const MR_Type_Param_Locns *) "),
- output_rval(TypeParamsRval),
- io__write_string("\n};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet2, DeclSet) }.
+ PTIVectorRval, TypeParamsRval, !DeclSet, !IO) :-
+ output_rval_decls(PTIVectorRval, !DeclSet, !IO),
+ LayoutName = table_io_decl(RttiProcLabel),
+ ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
+ ProcLayoutName = proc_layout(ProcLabel, ProcLayoutKind),
+ output_layout_decl(ProcLayoutName, !DeclSet, !IO),
+
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n\t(const MR_Proc_Layout *) &", !IO),
+ output_layout_name(ProcLayoutName, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumPTIs, !IO),
+ io__write_string(",\n\t(const MR_PseudoTypeInfo *) ", !IO),
+ output_rval(PTIVectorRval, !IO),
+ io__write_string(",\n\t(const MR_Type_Param_Locns *) ", !IO),
+ output_rval(TypeParamsRval, !IO),
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_table_gen(rtti_proc_label::in, int::in, int::in,
list(table_trie_step)::in, rval::in, rval::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_table_gen(RttiProcLabel, NumInputs, NumOutputs, Steps,
- PTIVectorRval, TypeParamsRval, DeclSet0, DeclSet) -->
+ PTIVectorRval, TypeParamsRval, !DeclSet, !IO) :-
output_table_gen_steps_table(RttiProcLabel, Steps, MaybeEnumParams,
- DeclSet0, DeclSet1),
+ !DeclSet, !IO),
output_table_gen_enum_params_table(RttiProcLabel, MaybeEnumParams,
- DeclSet1, DeclSet2),
- output_rval_decls(PTIVectorRval, "", "", 0, _, DeclSet2, DeclSet3),
- { LayoutName = table_gen_info(RttiProcLabel) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n\t"),
- io__write_int(NumInputs),
- io__write_string(",\n\t"),
- io__write_int(NumOutputs),
- io__write_string(",\n\t"),
- output_layout_name(table_gen_steps(RttiProcLabel)),
- io__write_string(",\n\t"),
- output_layout_name(table_gen_enum_params(RttiProcLabel)),
- io__write_string(",\n\t(const MR_PseudoTypeInfo *)\n\t\t"),
- output_rval(PTIVectorRval),
- io__write_string(",\n\t(const MR_Type_Param_Locns *)\n\t\t"),
- output_rval(TypeParamsRval),
- io__write_string("\n};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet3, DeclSet) }.
+ !DeclSet, !IO),
+ output_rval_decls(PTIVectorRval, !DeclSet, !IO),
+ LayoutName = table_gen_info(RttiProcLabel),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n\t", !IO),
+ io__write_int(NumInputs, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumOutputs, !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(table_gen_steps(RttiProcLabel), !IO),
+ io__write_string(",\n\t", !IO),
+ output_layout_name(table_gen_enum_params(RttiProcLabel), !IO),
+ io__write_string(",\n\t(const MR_PseudoTypeInfo *)\n\t\t", !IO),
+ output_rval(PTIVectorRval, !IO),
+ io__write_string(",\n\t(const MR_Type_Param_Locns *)\n\t\t", !IO),
+ output_rval(TypeParamsRval, !IO),
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_table_gen_steps_table(rtti_proc_label::in,
list(table_trie_step)::in, list(maybe(int))::out,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_table_gen_steps_table(RttiProcLabel, Steps, MaybeEnumParams,
- DeclSet0, DeclSet) -->
- { LayoutName = table_gen_steps(RttiProcLabel) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- output_table_gen_steps(Steps, MaybeEnumParams),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+ !DeclSet, !IO) :-
+ LayoutName = table_gen_steps(RttiProcLabel),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ output_table_gen_steps(Steps, MaybeEnumParams, !IO),
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_table_gen_steps(list(table_trie_step)::in,
list(maybe(int))::out, io__state::di, io__state::uo) is det.
-output_table_gen_steps([], []) --> [].
-output_table_gen_steps([Step | Steps], [MaybeEnumParam | MaybeEnumParams]) -->
- {
+output_table_gen_steps([], [], !IO).
+output_table_gen_steps([Step | Steps], [MaybeEnumParam | MaybeEnumParams],
+ !IO) :-
+ (
Step = table_trie_step_int,
StepType = "MR_TABLE_STEP_INT",
MaybeEnumParam = no
@@ -1461,42 +1421,41 @@
Step = table_trie_step_poly,
StepType = "MR_TABLE_STEP_POLY",
MaybeEnumParam = no
- },
- io__write_string("\t"),
- io__write_string(StepType),
- io__write_string(",\n"),
- output_table_gen_steps(Steps, MaybeEnumParams).
+ ),
+ io__write_string("\t", !IO),
+ io__write_string(StepType, !IO),
+ io__write_string(",\n", !IO),
+ output_table_gen_steps(Steps, MaybeEnumParams, !IO).
:- pred output_table_gen_enum_params_table(rtti_proc_label::in,
list(maybe(int))::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
output_table_gen_enum_params_table(RttiProcLabel, MaybeEnumParams,
- DeclSet0, DeclSet) -->
- { LayoutName = table_gen_enum_params(RttiProcLabel) },
- io__write_string("\n"),
- output_layout_name_storage_type_name(LayoutName, yes),
- io__write_string(" = {\n"),
- output_table_gen_enum_params(MaybeEnumParams),
- io__write_string("};\n"),
- { decl_set_insert(data_addr(layout_addr(LayoutName)),
- DeclSet0, DeclSet) }.
+ !DeclSet, !IO) :-
+ LayoutName = table_gen_enum_params(RttiProcLabel),
+ io__write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io__write_string(" = {\n", !IO),
+ output_table_gen_enum_params(MaybeEnumParams, !IO),
+ io__write_string("};\n", !IO),
+ decl_set_insert(data_addr(layout_addr(LayoutName)), !DeclSet).
:- pred output_table_gen_enum_params(list(maybe(int))::in,
io__state::di, io__state::uo) is det.
-output_table_gen_enum_params([]) --> [].
-output_table_gen_enum_params([MaybeEnumParam | MaybeEnumParams]) -->
- io__write_string("\t"),
+output_table_gen_enum_params([], !IO).
+output_table_gen_enum_params([MaybeEnumParam | MaybeEnumParams], !IO) :-
+ io__write_string("\t", !IO),
(
- { MaybeEnumParam = no },
- io__write_int(-1)
+ MaybeEnumParam = no,
+ io__write_int(-1, !IO)
;
- { MaybeEnumParam = yes(EnumRange) },
- io__write_int(EnumRange)
+ MaybeEnumParam = yes(EnumRange),
+ io__write_int(EnumRange, !IO)
),
- io__write_string(",\n"),
- output_table_gen_enum_params(MaybeEnumParams).
+ io__write_string(",\n", !IO),
+ output_table_gen_enum_params(MaybeEnumParams, !IO).
%-----------------------------------------------------------------------------%
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.58
diff -u -b -r1.58 livemap.m
--- compiler/livemap.m 20 Oct 2003 07:29:06 -0000 1.58
+++ compiler/livemap.m 9 Nov 2003 06:49:28 -0000
@@ -61,9 +61,9 @@
livemap__build_2(Backinstrs, Livemap0, MaybeLivemap) :-
set__init(Livevals0),
- livemap__build_livemap(Backinstrs, Livevals0, no, DontValueNumber,
+ livemap__build_livemap(Backinstrs, Livevals0, no, ContainsUserCode,
Livemap0, Livemap1),
- ( DontValueNumber = yes ->
+ ( ContainsUserCode = yes ->
MaybeLivemap = no
; livemap__equal_livemaps(Livemap0, Livemap1) ->
MaybeLivemap = yes(Livemap1)
@@ -104,30 +104,22 @@
:- pred livemap__build_livemap(list(instruction)::in, lvalset::in,
bool::in, bool::out, livemap::in, livemap::out) is det.
-livemap__build_livemap([], _, DontValueNumber, DontValueNumber,
- Livemap, Livemap).
+livemap__build_livemap([], _, !ContainsUserCode, !Livemap).
livemap__build_livemap([Instr0 | Instrs0], Livevals0,
- DontValueNumber0, DontValueNumber, Livemap0, Livemap) :-
+ !ContainsUserCode, !Livemap) :-
livemap__build_livemap_instr(Instr0, Instrs0, Instrs1,
- Livevals0, Livevals1, DontValueNumber0, DontValueNumber1,
- Livemap0, Livemap1),
- livemap__build_livemap(Instrs1, Livevals1,
- DontValueNumber1, DontValueNumber, Livemap1, Livemap).
+ Livevals0, Livevals1, !ContainsUserCode, !Livemap),
+ livemap__build_livemap(Instrs1, Livevals1, !ContainsUserCode, !Livemap).
:- pred livemap__build_livemap_instr(instruction::in, list(instruction)::in,
list(instruction)::out, lvalset::in, lvalset::out,
bool::in, bool::out, livemap::in, livemap::out) is det.
-livemap__build_livemap_instr(Instr0, Instrs0, Instrs,
- Livevals0, Livevals, DontValueNumber0, DontValueNumber,
- Livemap0, Livemap) :-
+livemap__build_livemap_instr(Instr0, !Instrs, !Livevals, !ContainsUserCode,
+ !Livemap) :-
Instr0 = Uinstr0 - _,
(
- Uinstr0 = comment(_),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ Uinstr0 = comment(_)
;
Uinstr0 = livevals(_),
error("livevals found in backward scan in build_livemap")
@@ -144,73 +136,52 @@
% appears on the right hand side as well as the left, then we
% want make_live to put it back into the liveval set.
- set__delete(Livevals0, Lval, Livevals1),
+ set__delete(!.Livevals, Lval, !:Livevals),
opt_util__lval_access_rvals(Lval, Rvals),
- livemap__make_live_in_rvals([Rval | Rvals], Livevals1,
- Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals([Rval | Rvals], !Livevals)
;
Uinstr0 = call(_, _, _, _, _, _),
- livemap__look_for_livevals(Instrs0, Instrs,
- Livevals0, Livevals, "call", yes, _),
- Livemap = Livemap0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = mkframe(_, _),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__look_for_livevals(!Instrs, !Livevals, "call", yes, _)
+ ;
+ Uinstr0 = mkframe(_, _)
;
Uinstr0 = label(Label),
- map__set(Livemap0, Label, Livevals0, Livemap),
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ map__set(!.Livemap, Label, !.Livevals, !:Livemap)
;
Uinstr0 = goto(CodeAddr),
opt_util__livevals_addr(CodeAddr, LivevalsNeeded),
- livemap__look_for_livevals(Instrs0, Instrs,
- Livevals0, Livevals1, "goto", LivevalsNeeded, Found),
+ livemap__look_for_livevals(!Instrs, !Livevals, "goto",
+ LivevalsNeeded, Found),
( Found = yes ->
- Livevals3 = Livevals1
+ true
; CodeAddr = label(Label) ->
- set__init(Livevals2),
- livemap__insert_label_livevals([Label],
- Livemap0, Livevals2, Livevals3)
+ livemap__insert_label_livevals([Label], !.Livemap,
+ set__init, !:Livevals)
;
( CodeAddr = do_redo
; CodeAddr = do_fail
; CodeAddr = do_not_reached
)
->
- Livevals3 = Livevals1
+ true
;
error("unknown label type in build_livemap")
),
livemap__special_code_addr(CodeAddr, MaybeSpecial),
( MaybeSpecial = yes(Special) ->
- set__insert(Livevals3, Special, Livevals)
+ set__insert(!.Livevals, Special, !:Livevals)
;
- Livevals = Livevals3
- ),
- Livemap = Livemap0,
- DontValueNumber = DontValueNumber0
+ true
+ )
;
Uinstr0 = computed_goto(Rval, Labels),
- set__init(Livevals1),
- livemap__make_live_in_rvals([Rval], Livevals1, Livevals2),
- livemap__insert_label_livevals(Labels, Livemap0,
- Livevals2, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals([Rval], set__init, !:Livevals),
+ livemap__insert_label_livevals(Labels, !.Livemap, !Livevals)
;
Uinstr0 = if_val(Rval, CodeAddr),
- livemap__look_for_livevals(Instrs0, Instrs,
- Livevals0, Livevals1, "if_val", no, Found),
+ Livevals0 = !.Livevals,
+ livemap__look_for_livevals(!Instrs, !Livevals, "if_val",
+ no, Found),
(
Found = yes,
% This if_val was put here by middle_rec.
@@ -219,26 +190,23 @@
% since they will be needed at CodeAddr.
% The locations in Livevals0 may be needed
% in the fall-through continuation.
- set__union(Livevals0, Livevals1, Livevals3)
+ set__union(Livevals0, !Livevals)
;
Found = no,
- livemap__make_live_in_rvals([Rval],
- Livevals1, Livevals2),
+ livemap__make_live_in_rvals([Rval], !Livevals),
( CodeAddr = label(Label) ->
livemap__insert_label_livevals([Label],
- Livemap0, Livevals2, Livevals3)
+ !.Livemap, !Livevals)
;
- Livevals3 = Livevals2
+ true
)
),
livemap__special_code_addr(CodeAddr, MaybeSpecial),
( MaybeSpecial = yes(Special) ->
- set__insert(Livevals3, Special, Livevals)
+ set__insert(!.Livevals, Special, !:Livevals)
;
- Livevals = Livevals3
- ),
- Livemap = Livemap0,
- DontValueNumber = DontValueNumber0
+ true
+ )
;
Uinstr0 = incr_hp(Lval, _, _, Rval, _),
@@ -249,200 +217,120 @@
% to lval, but the two should never have any variables in
% common. This is why doing the deletion first works.
- set__delete(Livevals0, Lval, Livevals1),
+ set__delete(!.Livevals, Lval, !:Livevals),
opt_util__lval_access_rvals(Lval, Rvals),
- livemap__make_live_in_rvals([Rval | Rvals],
- Livevals1, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals([Rval | Rvals], !Livevals)
;
Uinstr0 = mark_hp(Lval),
- set__delete(Livevals0, Lval, Livevals1),
+ set__delete(!.Livevals, Lval, !:Livevals),
opt_util__lval_access_rvals(Lval, Rvals),
- livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals(Rvals, !Livevals)
;
Uinstr0 = restore_hp(Rval),
- livemap__make_live_in_rvals([Rval], Livevals0, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals([Rval], !Livevals)
;
Uinstr0 = free_heap(Rval),
- livemap__make_live_in_rvals([Rval], Livevals0, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals([Rval], !Livevals)
;
Uinstr0 = store_ticket(Lval),
- set__delete(Livevals0, Lval, Livevals1),
+ set__delete(!.Livevals, Lval, !:Livevals),
opt_util__lval_access_rvals(Lval, Rvals),
- livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals(Rvals, !Livevals)
;
Uinstr0 = reset_ticket(Rval, _Reason),
- livemap__make_live_in_rval(Rval, Livevals0, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = discard_ticket,
- Livevals = Livevals0,
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = prune_ticket,
- Livevals = Livevals0,
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rval(Rval, !Livevals)
+ ;
+ Uinstr0 = discard_ticket
+ ;
+ Uinstr0 = prune_ticket
;
Uinstr0 = mark_ticket_stack(Lval),
- set__delete(Livevals0, Lval, Livevals1),
+ set__delete(!.Livevals, Lval, !:Livevals),
opt_util__lval_access_rvals(Lval, Rvals),
- livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
+ livemap__make_live_in_rvals(Rvals, !Livevals)
;
Uinstr0 = prune_tickets_to(Rval),
- livemap__make_live_in_rval(Rval, Livevals0, Livevals),
- Livemap = Livemap0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = incr_sp(_, _),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = decr_sp(_),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- Uinstr0 = init_sync_term(_, _),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = DontValueNumber0
- ;
- % XXX Value numbering doesn't handle fork [yet] so
- % set DontValueNumber to yes.
- Uinstr0 = fork(_, _, _),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = yes
- ;
- % XXX Value numbering doesn't handle join_and_terminate [yet] so
- % set DontValueNumber to yes.
- Uinstr0 = join_and_terminate(_),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = yes
- ;
- % XXX Value numbering doesn't handle join_and_continue [yet] so
- % set DontValueNumber to yes.
- Uinstr0 = join_and_continue(_, _),
- Livemap = Livemap0,
- Livevals = Livevals0,
- Instrs = Instrs0,
- DontValueNumber = yes
+ livemap__make_live_in_rval(Rval, !Livevals)
+ ;
+ Uinstr0 = incr_sp(_, _)
+ ;
+ Uinstr0 = decr_sp(_)
+ ;
+ Uinstr0 = init_sync_term(_, _)
+ ;
+ Uinstr0 = fork(_, _, _)
+ ;
+ Uinstr0 = join_and_terminate(_)
+ ;
+ Uinstr0 = join_and_continue(_, _)
;
Uinstr0 = c_code(_, LiveLvalInfo),
livemap__build_live_lval_info(LiveLvalInfo,
- Livevals0, Livevals,
- DontValueNumber0, DontValueNumber),
- Livemap = Livemap0,
- Instrs = Instrs0
+ !Livevals, !ContainsUserCode)
;
Uinstr0 = pragma_c(_, Components, _, _, _, _, _, _),
livemap__build_livemap_pragma_components(Components,
- Livevals0, Livevals,
- DontValueNumber0, DontValueNumber),
- Livemap = Livemap0,
- Instrs = Instrs0
+ !Livevals, !ContainsUserCode)
).
:- pred livemap__build_livemap_pragma_components(list(pragma_c_component)::in,
lvalset::in, lvalset::out, bool::in, bool::out) is det.
-livemap__build_livemap_pragma_components([], Livevals, Livevals,
- DontValueNumber, DontValueNumber).
+livemap__build_livemap_pragma_components([], !Livevals, !ContainsUserCode).
livemap__build_livemap_pragma_components([Component | Components],
- Livevals0, Livevals, DontValueNumber0, DontValueNumber) :-
+ !Livevals, !ContainsUserCode) :-
(
Component = pragma_c_inputs(Inputs),
livemap__build_livemap_pragma_inputs(Inputs,
- Livevals0, Livevals1),
- DontValueNumber1 = DontValueNumber0
+ !Livevals)
;
- Component = pragma_c_outputs(_),
- Livevals1 = Livevals0,
- DontValueNumber1 = DontValueNumber0
+ Component = pragma_c_outputs(_)
;
Component = pragma_c_user_code(_, _),
- Livevals1 = Livevals0,
- DontValueNumber1 = yes
+ !:ContainsUserCode = yes
;
Component = pragma_c_raw_code(_, LiveLvalInfo),
livemap__build_live_lval_info(LiveLvalInfo,
- Livevals0, Livevals1,
- DontValueNumber0, DontValueNumber1)
+ !Livevals, !ContainsUserCode)
;
- Component = pragma_c_fail_to(_),
- Livevals1 = Livevals0,
- DontValueNumber1 = DontValueNumber0
- ;
- Component = pragma_c_noop,
- Livevals1 = Livevals0,
- DontValueNumber1 = DontValueNumber0
+ Component = pragma_c_fail_to(_)
+ ;
+ Component = pragma_c_noop
),
livemap__build_livemap_pragma_components(Components,
- Livevals1, Livevals, DontValueNumber1, DontValueNumber).
+ !Livevals, !ContainsUserCode).
:- pred livemap__build_live_lval_info(c_code_live_lvals::in,
lvalset::in, lvalset::out, bool::in, bool::out) is det.
-livemap__build_live_lval_info(no_live_lvals_info,
- Livevals, Livevals, _, yes).
-livemap__build_live_lval_info(live_lvals_info(LiveLvalSet),
- Livevals0, Livevals, DontValueNumber, DontValueNumber) :-
+livemap__build_live_lval_info(no_live_lvals_info, !Livevals, _, yes).
+livemap__build_live_lval_info(live_lvals_info(LiveLvalSet), !Livevals,
+ !DontValueNumber) :-
set__to_sorted_list(LiveLvalSet, LiveLvals),
- livemap__insert_proper_livevals(LiveLvals, Livevals0, Livevals).
+ livemap__insert_proper_livevals(LiveLvals, !Livevals).
:- pred livemap__build_livemap_pragma_inputs(list(pragma_c_input)::in,
lvalset::in, lvalset::out) is det.
-livemap__build_livemap_pragma_inputs([], Livevals, Livevals).
-livemap__build_livemap_pragma_inputs([Input | Inputs], Livevals0, Livevals) :-
+livemap__build_livemap_pragma_inputs([], !Livevals).
+livemap__build_livemap_pragma_inputs([Input | Inputs], !Livevals) :-
Input = pragma_c_input(_, _, Rval, _),
( Rval = lval(Lval) ->
- livemap__insert_proper_liveval(Lval, Livevals0, Livevals1)
+ livemap__insert_proper_liveval(Lval, !Livevals)
;
- Livevals1 = Livevals0
+ true
),
- livemap__build_livemap_pragma_inputs(Inputs, Livevals1, Livevals).
+ livemap__build_livemap_pragma_inputs(Inputs, !Livevals).
:- pred livemap__look_for_livevals(list(instruction)::in,
list(instruction)::out, lvalset::in, lvalset::out, string::in,
bool::in, bool::out) is det.
-livemap__look_for_livevals(Instrs0, Instrs, Livevals0, Livevals,
+livemap__look_for_livevals(Instrs0, Instrs, !Livevals,
Site, Compulsory, Found) :-
opt_util__skip_comments(Instrs0, Instrs1),
( Instrs1 = [livevals(Livevals1) - _ | Instrs2] ->
- livemap__filter_livevals(Livevals1, Livevals),
+ livemap__filter_livevals(Livevals1, !:Livevals),
Instrs = Instrs2,
Found = yes
; Compulsory = yes ->
@@ -450,7 +338,6 @@
error(Msg)
;
Instrs = Instrs1,
- Livevals = Livevals0,
Found = no
).
@@ -476,10 +363,10 @@
:- pred livemap__make_live_in_rvals(list(rval)::in, lvalset::in, lvalset::out)
is det.
-livemap__make_live_in_rvals([], Live, Live).
-livemap__make_live_in_rvals([Rval | Rvals], Live0, Live) :-
- livemap__make_live_in_rval(Rval, Live0, Live1),
- livemap__make_live_in_rvals(Rvals, Live1, Live).
+livemap__make_live_in_rvals([], !Live).
+livemap__make_live_in_rvals([Rval | Rvals], !Live) :-
+ livemap__make_live_in_rval(Rval, !Live),
+ livemap__make_live_in_rvals(Rvals, !Live).
% Set all lvals found in this rval to live, with the exception of
% fields, since they are treated specially (the later stages consider
@@ -487,35 +374,35 @@
:- pred livemap__make_live_in_rval(rval::in, lvalset::in, lvalset::out) is det.
-livemap__make_live_in_rval(lval(Lval), Live0, Live) :-
+livemap__make_live_in_rval(lval(Lval), !Live) :-
% XXX maybe we should treat mem_refs the same way as field refs
( Lval = field(_, _, _) ->
- Live1 = Live0
+ true
;
- set__insert(Live0, Lval, Live1)
+ set__insert(!.Live, Lval, !:Live)
),
opt_util__lval_access_rvals(Lval, AccessRvals),
- livemap__make_live_in_rvals(AccessRvals, Live1, Live).
-livemap__make_live_in_rval(mkword(_, Rval), Live0, Live) :-
- livemap__make_live_in_rval(Rval, Live0, Live).
-livemap__make_live_in_rval(const(_), Live, Live).
-livemap__make_live_in_rval(unop(_, Rval), Live0, Live) :-
- livemap__make_live_in_rval(Rval, Live0, Live).
-livemap__make_live_in_rval(binop(_, Rval1, Rval2), Live0, Live) :-
- livemap__make_live_in_rval(Rval1, Live0, Live1),
- livemap__make_live_in_rval(Rval2, Live1, Live).
+ livemap__make_live_in_rvals(AccessRvals, !Live).
+livemap__make_live_in_rval(mkword(_, Rval), !Live) :-
+ livemap__make_live_in_rval(Rval, !Live).
+livemap__make_live_in_rval(const(_), !Live).
+livemap__make_live_in_rval(unop(_, Rval), !Live) :-
+ livemap__make_live_in_rval(Rval, !Live).
+livemap__make_live_in_rval(binop(_, Rval1, Rval2), !Live) :-
+ livemap__make_live_in_rval(Rval1, !Live),
+ livemap__make_live_in_rval(Rval2, !Live).
livemap__make_live_in_rval(var(_), _, _) :-
error("var rval should not propagate to the optimizer").
-livemap__make_live_in_rval(mem_addr(MemRef), Live0, Live) :-
- livemap__make_live_in_mem_ref(MemRef, Live0, Live).
+livemap__make_live_in_rval(mem_addr(MemRef), !Live) :-
+ livemap__make_live_in_mem_ref(MemRef, !Live).
:- pred livemap__make_live_in_mem_ref(mem_ref::in, lvalset::in, lvalset::out)
is det.
-livemap__make_live_in_mem_ref(stackvar_ref(_), Live, Live).
-livemap__make_live_in_mem_ref(framevar_ref(_), Live, Live).
-livemap__make_live_in_mem_ref(heap_ref(Rval, _, _), Live0, Live) :-
- livemap__make_live_in_rval(Rval, Live0, Live).
+livemap__make_live_in_mem_ref(stackvar_ref(_), !Live).
+livemap__make_live_in_mem_ref(framevar_ref(_), !Live).
+livemap__make_live_in_mem_ref(heap_ref(Rval, _, _), !Live) :-
+ livemap__make_live_in_rval(Rval, !Live).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -530,35 +417,34 @@
:- pred livemap__insert_label_livevals(list(label)::in, livemap::in,
lvalset::in, lvalset::out) is det.
-livemap__insert_label_livevals([], _, Livevals, Livevals).
-livemap__insert_label_livevals([Label | Labels], Livemap, Livevals0, Livevals)
- :-
+livemap__insert_label_livevals([], _, !Livevals).
+livemap__insert_label_livevals([Label | Labels], Livemap, !Livevals) :-
( map__search(Livemap, Label, LabelLivevals) ->
set__to_sorted_list(LabelLivevals, Livelist),
- livemap__insert_proper_livevals(Livelist, Livevals0, Livevals1)
+ livemap__insert_proper_livevals(Livelist, !Livevals)
;
- Livevals1 = Livevals0
+ true
),
- livemap__insert_label_livevals(Labels, Livemap, Livevals1, Livevals).
+ livemap__insert_label_livevals(Labels, Livemap, !Livevals).
:- pred livemap__insert_proper_livevals(list(lval)::in, lvalset::in,
lvalset::out) is det.
-livemap__insert_proper_livevals([], Livevals, Livevals).
-livemap__insert_proper_livevals([Live | Livelist], Livevals0, Livevals) :-
- livemap__insert_proper_liveval(Live, Livevals0, Livevals1),
- livemap__insert_proper_livevals(Livelist, Livevals1, Livevals).
+livemap__insert_proper_livevals([], !Livevals).
+livemap__insert_proper_livevals([Live | Livelist], !Livevals) :-
+ livemap__insert_proper_liveval(Live, !Livevals),
+ livemap__insert_proper_livevals(Livelist, !Livevals).
% Don't insert references to locations on the heap.
:- pred livemap__insert_proper_liveval(lval::in, lvalset::in, lvalset::out)
is det.
-livemap__insert_proper_liveval(Live, Livevals0, Livevals) :-
+livemap__insert_proper_liveval(Live, !Livevals) :-
( Live = field(_, _, _) ->
- Livevals = Livevals0
+ true
;
- set__insert(Livevals0, Live, Livevals)
+ set__insert(!.Livevals, Live, !:Livevals)
).
%-----------------------------------------------------------------------------%
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.219
diff -u -b -r1.219 llds_out.m
--- compiler/llds_out.m 5 Nov 2003 03:17:39 -0000 1.219
+++ compiler/llds_out.m 9 Nov 2003 16:33:38 -0000
@@ -34,56 +34,39 @@
:- pred output_llds(c_file::in, map(label, data_addr)::in, maybe(rl_file)::in,
io__state::di, io__state::uo) is det.
- % output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- % DeclSet0, DeclSet) outputs the declarations of any static constants,
- % etc. that need to be declared before output_rval(Rval) is called.
- % FirstIndent is output before the first declaration, while
- % LaterIndent is output before all later declaration; N0 and N
- % give the number of declarations output before and after this call.
- %
- % Every time we emit a declaration for a symbol, we insert it into the
- % set of symbols we've already declared. That way, we avoid generating
- % the same symbol twice, which would cause an error in the C code.
-
-:- pred output_rval_decls(rval, string, string, int, int, decl_set, decl_set,
- io__state, io__state).
-:- mode output_rval_decls(in, in, in, in, out, in, out, di, uo) is det.
+ % output_rval_decls(Rval, DeclSet0, DeclSet) outputs the declarations
+ % of any static constants, etc. that need to be declared before
+ % output_rval(Rval) is called.
-:- pred output_rvals_decls(list(rval)::in, string::in, string::in,
- int::in, int::out, decl_set::in, decl_set::out,
+:- pred output_rval_decls(rval::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
% output an rval (not converted to any particular type,
% but instead output as its "natural" type)
-:- pred output_rval(rval, io__state, io__state).
-:- mode output_rval(in, di, uo) is det.
+:- pred output_rval(rval::in, io__state::di, io__state::uo) is det.
% output_code_addr_decls(CodeAddr, ...) outputs the declarations of any
% extern symbols, etc. that need to be declared before
- % output_code_addr(CodeAddr) is called. The meanings of the other
- % arguments are as above.
+ % output_code_addr(CodeAddr) is called.
-:- pred output_code_addr_decls(code_addr, string, string, int, int,
- decl_set, decl_set, io__state, io__state).
-:- mode output_code_addr_decls(in, in, in, in, out, in, out, di, uo) is det.
-
-:- pred output_code_addrs_decls(list(code_addr), string, string, int, int,
- decl_set, decl_set, io__state, io__state).
-:- mode output_code_addrs_decls(in, in, in, in, out, in, out, di, uo) is det.
+:- pred output_code_addr_decls(code_addr::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
-:- pred output_code_addr(code_addr, io__state, io__state).
-:- mode output_code_addr(in, di, uo) is det.
+:- pred output_code_addr(code_addr::in,
+ io__state::di, io__state::uo) is det.
% output_data_addr_decls(DataAddr, ...) outputs the declarations of
% any static constants, etc. that need to be declared before
- % output_data_addr(DataAddr) is called. The meanings of the other
- % arguments are as above.
+ % output_data_addr(DataAddr) is called.
:- pred output_data_addr_decls(data_addr::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
+:- pred output_data_addr_decls(data_addr::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
:- pred output_data_addrs_decls(list(data_addr)::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
@@ -104,36 +87,30 @@
% Convert an lval to a string description of that lval.
-:- pred llds_out__lval_to_string(lval, string).
-:- mode llds_out__lval_to_string(in, out) is semidet.
+:- pred llds_out__lval_to_string(lval::in, string::out) is semidet.
% Convert a register to a string description of that register.
-:- pred llds_out__reg_to_string(reg_type, int, string).
-:- mode llds_out__reg_to_string(in, in, out) is det.
+:- pred llds_out__reg_to_string(reg_type::in, int::in, string::out) is det.
% Convert a binary operator to a string description of that operator.
-:- pred llds_out__binary_op_to_string(binary_op, string).
-:- mode llds_out__binary_op_to_string(in, out) is det.
+:- pred llds_out__binary_op_to_string(binary_op::in, string::out) is det.
% Output an instruction and (if the third arg is yes) the comment.
% This predicate is provided for debugging use only.
-:- pred output_instruction_and_comment(instr, string, bool,
- io__state, io__state).
-:- mode output_instruction_and_comment(in, in, in, di, uo) is det.
+:- pred output_instruction_and_comment(instr::in, string::in, bool::in,
+ io__state::di, io__state::uo) is det.
% Output an instruction.
% This predicate is provided for debugging use only.
-:- pred output_instruction(instr, io__state, io__state).
-:- mode output_instruction(in, di, uo) is det.
+:- pred output_instruction(instr::in, io__state::di, io__state::uo) is det.
% Output a label (used by garbage collection).
-:- pred output_label(label, io__state, io__state).
-:- mode output_label(in, di, uo) is det.
+:- pred output_label(label::in, io__state::di, io__state::uo) is det.
% Convert a label to a C string. The boolean controls whether
% a prefix ("mercury__") is added to the string.
@@ -143,7 +120,8 @@
% The following are exported to rtti_out. It may be worthwhile
% to put these in a new module (maybe llds_out_util).
-:- type decl_id ---> common_type(module_name, int)
+:- type decl_id
+ ---> common_type(module_name, int)
; float_label(string)
; code_addr(code_addr)
; data_addr(data_addr)
@@ -220,350 +198,357 @@
%-----------------------------------------------------------------------------%
-output_llds(C_File, StackLayoutLabels, MaybeRLFile) -->
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
- ( { SplitFiles = yes } ->
- { C_File = c_file(ModuleName, C_HeaderInfo,
- UserForeignCodes, Exports, Vars, Datas, Modules) },
- module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName),
- dir__make_directory(ObjDirName, _),
+output_llds(C_File, StackLayoutLabels, MaybeRLFile, !IO) :-
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
+ ( SplitFiles = yes ->
+ C_File = c_file(ModuleName, C_HeaderInfo,
+ UserForeignCodes, Exports, Vars, Datas, Modules),
+ module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName,
+ !IO),
+ dir__make_directory(ObjDirName, _, !IO),
output_split_c_file_init(ModuleName, Modules, Datas,
- StackLayoutLabels, MaybeRLFile),
+ StackLayoutLabels, MaybeRLFile, !IO),
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
- C_HeaderInfo, StackLayoutLabels, 1, Num1),
+ C_HeaderInfo, StackLayoutLabels, 1, Num1, !IO),
output_split_c_exports(Exports, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num1, Num2),
+ C_HeaderInfo, StackLayoutLabels, Num1, Num2, !IO),
output_split_comp_gen_c_vars(Vars, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num2, Num3),
+ C_HeaderInfo, StackLayoutLabels, Num2, Num3, !IO),
output_split_comp_gen_c_datas(Datas, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num3, Num4),
+ C_HeaderInfo, StackLayoutLabels, Num3, Num4, !IO),
output_split_comp_gen_c_modules(Modules, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num4, Num),
+ C_HeaderInfo, StackLayoutLabels, Num4, Num, !IO),
compile_target_code__write_num_split_c_files(ModuleName,
- Num, Succeeded),
- ( { Succeeded = no } ->
+ Num, Succeeded, !IO),
+ ( Succeeded = no ->
compile_target_code__remove_split_c_output_files(
- ModuleName, Num)
+ ModuleName, Num, !IO)
;
- []
+ true
)
;
output_single_c_file(C_File, no,
- StackLayoutLabels, MaybeRLFile)
+ StackLayoutLabels, MaybeRLFile, !IO)
).
:- pred output_split_user_foreign_codes(list(user_foreign_code)::in,
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_user_foreign_codes([], _, _, _, Num, Num) --> [].
+output_split_user_foreign_codes([], _, _, _, !Num, !IO).
output_split_user_foreign_codes([UserForeignCode | UserForeignCodes],
- ModuleName, C_HeaderLines, StackLayoutLabels, Num0, Num) -->
- { CFile = c_file(ModuleName, C_HeaderLines,
- [UserForeignCode], [], [], [], []) },
- output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
- { Num1 = Num0 + 1 },
+ ModuleName, C_HeaderLines, StackLayoutLabels, !Num, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines, [UserForeignCode],
+ [], [], [], []),
+ output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ !:Num = !.Num + 1,
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
- C_HeaderLines, StackLayoutLabels, Num1, Num).
+ C_HeaderLines, StackLayoutLabels, !Num, !IO).
-:- pred output_split_c_exports(list(foreign_export)::in,
- module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
+:- pred output_split_c_exports(list(foreign_export)::in, module_name::in,
+ list(foreign_decl_code)::in, map(label, data_addr)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_c_exports([], _, _, _, Num, Num) --> [].
+output_split_c_exports([], _, _, _, !Num, !IO).
output_split_c_exports([Export | Exports], ModuleName, C_HeaderLines,
- StackLayoutLabels, Num0, Num) -->
- { CFile = c_file(ModuleName, C_HeaderLines,
- [], [Export], [], [], []) },
- output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
- { Num1 = Num0 + 1 },
+ StackLayoutLabels, !Num, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines, [], [Export], [], [], []),
+ output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ !:Num = !.Num + 1,
output_split_c_exports(Exports, ModuleName, C_HeaderLines,
- StackLayoutLabels, Num1, Num).
+ StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_vars(list(comp_gen_c_var)::in,
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_comp_gen_c_vars([], _, _, _, Num, Num) --> [].
+output_split_comp_gen_c_vars([], _, _, _, !Num, !IO).
output_split_comp_gen_c_vars([Var | Vars], ModuleName, C_HeaderLines,
- StackLayoutLabels, Num0, Num) -->
- { CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], []) },
- output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
- { Num1 = Num0 + 1 },
+ StackLayoutLabels, !Num, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], []),
+ output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ !:Num = !.Num + 1,
output_split_comp_gen_c_vars(Vars, ModuleName, C_HeaderLines,
- StackLayoutLabels, Num1, Num).
+ StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_datas(list(comp_gen_c_data)::in,
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_comp_gen_c_datas([], _, _, _, Num, Num) --> [].
+output_split_comp_gen_c_datas([], _, _, _, !Num, !IO).
output_split_comp_gen_c_datas([Data | Datas], ModuleName, C_HeaderLines,
- StackLayoutLabels, Num0, Num) -->
- { CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], []) },
- output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
- { Num1 = Num0 + 1 },
+ StackLayoutLabels, !Num, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], []),
+ output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ !:Num = !.Num + 1,
output_split_comp_gen_c_datas(Datas, ModuleName, C_HeaderLines,
- StackLayoutLabels, Num1, Num).
+ StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_modules(list(comp_gen_c_module)::in,
module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_comp_gen_c_modules([], _, _, _, Num, Num) --> [].
+output_split_comp_gen_c_modules([], _, _, _, !Num, !IO).
output_split_comp_gen_c_modules([Module | Modules], ModuleName, C_HeaderLines,
- StackLayoutLabels, Num0, Num) -->
- { CFile = c_file(ModuleName, C_HeaderLines,
- [], [], [], [], [Module]) },
- output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
- { Num1 = Num0 + 1 },
+ StackLayoutLabels, !Num, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [], [Module]),
+ output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ !:Num = !.Num + 1,
output_split_comp_gen_c_modules(Modules, ModuleName, C_HeaderLines,
- StackLayoutLabels, Num1, Num).
+ StackLayoutLabels, !Num, !IO).
-:- pred output_split_c_file_init(module_name, list(comp_gen_c_module),
- list(comp_gen_c_data), map(label, data_addr), maybe(rl_file),
- io__state, io__state).
-:- mode output_split_c_file_init(in, in, in, in, in, di, uo) is det.
+:- pred output_split_c_file_init(module_name::in, list(comp_gen_c_module)::in,
+ list(comp_gen_c_data)::in, map(label, data_addr)::in,
+ maybe(rl_file)::in, io__state::di, io__state::uo) is det.
output_split_c_file_init(ModuleName, Modules, Datas,
- StackLayoutLabels, MaybeRLFile) -->
- module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
- module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName),
-
- io__open_output(FileName, Result),
- (
- { Result = ok(FileStream) }
- ->
- { library__version(Version) },
- io__set_output_stream(FileStream, OutputStream),
- output_c_file_intro_and_grade(SourceFileName, Version),
- output_init_comment(ModuleName),
- output_c_file_mercury_headers,
- io__write_string("\n"),
- { decl_set_init(DeclSet0) },
+ StackLayoutLabels, MaybeRLFile, !IO) :-
+ module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
+ module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName, !IO),
+
+ io__open_output(FileName, Result, !IO),
+ (
+ Result = ok(FileStream)
+ ->
+ library__version(Version),
+ io__set_output_stream(FileStream, OutputStream, !IO),
+ output_c_file_intro_and_grade(SourceFileName, Version, !IO),
+ output_init_comment(ModuleName, !IO),
+ output_c_file_mercury_headers(!IO),
+ io__write_string("\n", !IO),
+ decl_set_init(DeclSet0),
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels, DeclSet0, _DeclSet),
- c_util__output_rl_file(ModuleName, MaybeRLFile),
- io__set_output_stream(OutputStream, _),
- io__close_output(FileStream)
+ StackLayoutLabels, DeclSet0, _DeclSet, !IO),
+ c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
+ io__set_output_stream(OutputStream, _, !IO),
+ io__close_output(FileStream, !IO)
;
- io__progname_base("llds.m", ProgName),
- io__write_string("\n"),
- io__write_string(ProgName),
- io__write_string(": can't open `"),
- io__write_string(FileName),
- io__write_string("' for output\n"),
- io__set_exit_status(1)
+ io__progname_base("llds.m", ProgName, !IO),
+ io__write_string("\n", !IO),
+ io__write_string(ProgName, !IO),
+ io__write_string(": can't open `", !IO),
+ io__write_string(FileName, !IO),
+ io__write_string("' for output\n", !IO),
+ io__set_exit_status(1, !IO)
).
-:- pred output_c_file_mercury_headers(io__state, io__state).
-:- mode output_c_file_mercury_headers(di, uo) is det.
+:- pred output_c_file_mercury_headers(io__state::di, io__state::uo) is det.
-output_c_file_mercury_headers -->
- globals__io_get_trace_level(TraceLevel),
- ( { given_trace_level_is_none(TraceLevel) = no } ->
- io__write_string("#include ""mercury_imp.h""\n"),
- io__write_string("#include ""mercury_trace_base.h""\n")
+output_c_file_mercury_headers(!IO) :-
+ globals__io_get_trace_level(TraceLevel, !IO),
+ ( given_trace_level_is_none(TraceLevel) = no ->
+ io__write_string("#include ""mercury_imp.h""\n", !IO),
+ io__write_string("#include ""mercury_trace_base.h""\n", !IO)
;
- io__write_string("#include ""mercury_imp.h""\n")
+ io__write_string("#include ""mercury_imp.h""\n", !IO)
),
- globals__io_lookup_bool_option(profile_deep, DeepProfile),
+ globals__io_lookup_bool_option(profile_deep, DeepProfile, !IO),
(
- { DeepProfile = yes },
- io__write_string("#include ""mercury_deep_profiling.h""\n")
+ DeepProfile = yes,
+ io__write_string("#include ""mercury_deep_profiling.h""\n", !IO)
;
- { DeepProfile = no }
+ DeepProfile = no
),
- globals__io_lookup_bool_option(generate_bytecode, GenBytecode),
+ globals__io_lookup_bool_option(generate_bytecode, GenBytecode, !IO),
(
- { GenBytecode = yes },
- io__write_string("#include ""mb_interface_stub.h""\n")
+ GenBytecode = yes,
+ io__write_string("#include ""mb_interface_stub.h""\n", !IO)
;
- { GenBytecode = no }
+ GenBytecode = no
).
-:- pred output_single_c_file(c_file, maybe(int), map(label, data_addr),
- maybe(rl_file), io__state, io__state).
-:- mode output_single_c_file(in, in, in, in, di, uo) is det.
+:- pred output_single_c_file(c_file::in, maybe(int)::in,
+ map(label, data_addr)::in, maybe(rl_file)::in,
+ io__state::di, io__state::uo) is det.
-output_single_c_file(CFile, SplitFiles, StackLayoutLabels, MaybeRLFile) -->
- { CFile = c_file(ModuleName, C_HeaderLines,
- UserForeignCode, Exports, Vars, Datas, Modules) },
- ( { SplitFiles = yes(Num) } ->
+output_single_c_file(CFile, SplitFiles, StackLayoutLabels, MaybeRLFile, !IO) :-
+ CFile = c_file(ModuleName, _, _, _, _, _, _),
+ ( SplitFiles = yes(Num) ->
module_name_to_split_c_file_name(ModuleName, Num, ".c",
- FileName)
+ FileName, !IO)
;
- module_name_to_file_name(ModuleName, ".c", yes, FileName)
+ module_name_to_file_name(ModuleName, ".c", yes, FileName, !IO)
),
- io__open_output(FileName, Result),
- (
- { Result = ok(FileStream) }
- ->
- { library__version(Version) },
- io__set_output_stream(FileStream, OutputStream),
- module_name_to_file_name(ModuleName, ".m", no, SourceFileName),
- output_c_file_intro_and_grade(SourceFileName, Version),
- ( { SplitFiles = yes(_) } ->
- []
+ io__open_output(FileName, Result, !IO),
+ ( Result = ok(FileStream) ->
+ decl_set_init(DeclSet0),
+ do_output_single_c_file(CFile, SplitFiles, StackLayoutLabels,
+ MaybeRLFile, FileStream, DeclSet0, _, !IO),
+ io__close_output(FileStream, !IO)
;
- output_init_comment(ModuleName)
+ io__progname_base("llds.m", ProgName, !IO),
+ io__write_string("\n", !IO),
+ io__write_string(ProgName, !IO),
+ io__write_string(": can't open `", !IO),
+ io__write_string(FileName, !IO),
+ io__write_string("' for output\n", !IO),
+ io__set_exit_status(1, !IO)
+ ).
+
+:- pred do_output_single_c_file(c_file::in, maybe(int)::in,
+ map(label, data_addr)::in, maybe(rl_file)::in, io__output_stream::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+do_output_single_c_file(CFile, SplitFiles, StackLayoutLabels,
+ MaybeRLFile, FileStream, !DeclSet, !IO) :-
+ CFile = c_file(ModuleName, C_HeaderLines,
+ UserForeignCode, Exports, Vars, Datas, Modules),
+ library__version(Version),
+ io__set_output_stream(FileStream, OutputStream, !IO),
+ module_name_to_file_name(ModuleName, ".m", no, SourceFileName,
+ !IO),
+ output_c_file_intro_and_grade(SourceFileName, Version, !IO),
+ ( SplitFiles = yes(_) ->
+ true
+ ;
+ output_init_comment(ModuleName, !IO)
),
- output_c_file_mercury_headers,
+ output_c_file_mercury_headers(!IO),
- output_foreign_header_include_lines(C_HeaderLines),
- io__write_string("\n"),
+ output_foreign_header_include_lines(C_HeaderLines, !IO),
+ io__write_string("\n", !IO),
- { gather_c_file_labels(Modules, Labels) },
- { decl_set_init(DeclSet0) },
- output_c_data_type_def_list(Datas, DeclSet0, DeclSet1),
- output_c_label_decl_list(Labels, StackLayoutLabels,
- DeclSet1, DeclSet2),
- output_comp_gen_c_var_list(Vars, DeclSet2, DeclSet3),
- output_comp_gen_c_data_list(Datas, DeclSet3, DeclSet4),
- output_comp_gen_c_module_list(Modules, StackLayoutLabels,
- DeclSet4, DeclSet5),
- output_user_foreign_code_list(UserForeignCode),
- output_exported_c_functions(Exports),
+ gather_c_file_labels(Modules, Labels),
+ list__foldl2(output_c_data_type_def, Datas, !DeclSet, !IO),
+ list__foldl2(output_c_label_decl(StackLayoutLabels), Labels,
+ !DeclSet, !IO),
+ list__foldl2(output_comp_gen_c_var, Vars, !DeclSet, !IO),
+ list__foldl2(output_comp_gen_c_data, Datas, !DeclSet, !IO),
+ list__foldl2(output_comp_gen_c_module(StackLayoutLabels), Modules,
+ !DeclSet, !IO),
+ list__foldl(output_user_foreign_code, UserForeignCode, !IO),
+ list__foldl(io__write_string, Exports, !IO),
- ( { SplitFiles = yes(_) } ->
- []
+ ( SplitFiles = yes(_) ->
+ true
;
- io__write_string("\n"),
+ io__write_string("\n", !IO),
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels, DeclSet5, _DeclSet)
+ StackLayoutLabels, !DeclSet, !IO)
),
- c_util__output_rl_file(ModuleName, MaybeRLFile),
- io__set_output_stream(OutputStream, _),
- io__close_output(FileStream)
- ;
- io__progname_base("llds.m", ProgName),
- io__write_string("\n"),
- io__write_string(ProgName),
- io__write_string(": can't open `"),
- io__write_string(FileName),
- io__write_string("' for output\n"),
- io__set_exit_status(1)
- ).
+ c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
+ io__set_output_stream(OutputStream, _, !IO).
:- pred output_c_module_init_list(module_name::in, list(comp_gen_c_module)::in,
list(comp_gen_c_data)::in, map(label, data_addr)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_c_module_init_list(ModuleName, Modules, Datas, StackLayoutLabels,
- DeclSet0, DeclSet) -->
- { MustInit = (pred(Module::in) is semidet :-
+ !DeclSet, !IO) :-
+ MustInit = (pred(Module::in) is semidet :-
module_defines_label_with_layout(Module, StackLayoutLabels)
- ) },
- { list__filter(MustInit, Modules,
- AlwaysInitModules, MaybeInitModules) },
- { list__chunk(AlwaysInitModules, 40, AlwaysInitModuleBunches) },
- { list__chunk(MaybeInitModules, 40, MaybeInitModuleBunches) },
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
+ ),
+ list__filter(MustInit, Modules,
+ AlwaysInitModules, MaybeInitModules),
+ list__chunk(AlwaysInitModules, 40, AlwaysInitModuleBunches),
+ list__chunk(MaybeInitModules, 40, MaybeInitModuleBunches),
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
output_init_bunch_defs(AlwaysInitModuleBunches, ModuleName,
- "always", 0, SplitFiles),
+ "always", 0, SplitFiles, !IO),
- ( { MaybeInitModuleBunches = [] } ->
- []
+ ( MaybeInitModuleBunches = [] ->
+ true
;
- io__write_string("#ifdef MR_MAY_NEED_INITIALIZATION\n\n"),
+ io__write_string("#ifdef MR_MAY_NEED_INITIALIZATION\n\n", !IO),
output_init_bunch_defs(MaybeInitModuleBunches, ModuleName,
- "maybe", 0, SplitFiles),
- io__write_string("#endif\n\n")
+ "maybe", 0, SplitFiles, !IO),
+ io__write_string("#endif\n\n", !IO)
),
- io__write_string("/* suppress gcc -Wmissing-decls warnings */\n"),
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init(void);\n"),
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init_type_tables(void);\n"),
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init_debugger(void);\n"),
- io__write_string("#ifdef MR_DEEP_PROFILING\n"),
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("write_out_proc_statics(FILE *fp);\n"),
- io__write_string("#endif\n"),
- io__write_string("\n"),
-
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init(void)\n"),
- io__write_string("{\n"),
- io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
- io__write_string("\tif (done) {\n"),
- io__write_string("\t\treturn;\n"),
- io__write_string("\t}\n"),
- io__write_string("\tdone = MR_TRUE;\n"),
+ io__write_string("/* suppress gcc -Wmissing-decls warnings */\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init(void);\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_type_tables(void);\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_debugger(void);\n", !IO),
+ io__write_string("#ifdef MR_DEEP_PROFILING\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("write_out_proc_statics(FILE *fp);\n", !IO),
+ io__write_string("#endif\n", !IO),
+ io__write_string("\n", !IO),
+
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init(void)\n", !IO),
+ io__write_string("{\n", !IO),
+ io__write_string("\tstatic MR_bool done = MR_FALSE;\n", !IO),
+ io__write_string("\tif (done) {\n", !IO),
+ io__write_string("\t\treturn;\n", !IO),
+ io__write_string("\t}\n", !IO),
+ io__write_string("\tdone = MR_TRUE;\n", !IO),
output_init_bunch_calls(AlwaysInitModuleBunches, ModuleName,
- "always", 0),
+ "always", 0, !IO),
- ( { MaybeInitModuleBunches = [] } ->
- []
+ ( MaybeInitModuleBunches = [] ->
+ true
;
- io__write_string("\n#ifdef MR_MAY_NEED_INITIALIZATION\n"),
+ io__write_string("\n#ifdef MR_MAY_NEED_INITIALIZATION\n", !IO),
output_init_bunch_calls(MaybeInitModuleBunches, ModuleName,
- "maybe", 0),
- io__write_string("#endif\n\n")
+ "maybe", 0, !IO),
+ io__write_string("#endif\n\n", !IO)
),
- output_c_data_init_list(Datas),
+ output_c_data_init_list(Datas, !IO),
% The call to the debugger initialization function
% is for bootstrapping; once the debugger has been modified
% to call do_init_modules_debugger() and all debuggable
% object files created before this change have been
% overwritten, it can be deleted.
- io__write_string("\t"),
- output_init_name(ModuleName),
- io__write_string("init_debugger();\n"),
- io__write_string("}\n\n"),
-
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init_type_tables(void)\n"),
- io__write_string("{\n"),
- io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
- io__write_string("\tif (done) {\n"),
- io__write_string("\t\treturn;\n"),
- io__write_string("\t}\n"),
- io__write_string("\tdone = MR_TRUE;\n"),
- output_type_tables_init_list(Datas, SplitFiles),
- io__write_string("}\n\n"),
-
- output_debugger_init_list_decls(Datas, DeclSet0, DeclSet1),
- io__write_string("\n"),
- io__write_string("void "),
- output_init_name(ModuleName),
- io__write_string("init_debugger(void)\n"),
- io__write_string("{\n"),
- io__write_string("\tstatic MR_bool done = MR_FALSE;\n"),
- io__write_string("\tif (done) {\n"),
- io__write_string("\t\treturn;\n"),
- io__write_string("\t}\n"),
- io__write_string("\tdone = MR_TRUE;\n"),
- output_debugger_init_list(Datas),
- io__write_string("}\n\n"),
-
- io__write_string("#ifdef MR_DEEP_PROFILING\n"),
- output_write_proc_static_list_decls(Datas, DeclSet1, DeclSet),
- io__write_string("\nvoid "),
- output_init_name(ModuleName),
- io__write_string("write_out_proc_statics(FILE *fp)\n"),
- io__write_string("{\n"),
- output_write_proc_static_list(Datas),
- io__write_string("}\n"),
- io__write_string("\n#endif\n\n"),
+ io__write_string("\t", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_debugger();\n", !IO),
+ io__write_string("}\n\n", !IO),
+
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_type_tables(void)\n", !IO),
+ io__write_string("{\n", !IO),
+ io__write_string("\tstatic MR_bool done = MR_FALSE;\n", !IO),
+ io__write_string("\tif (done) {\n", !IO),
+ io__write_string("\t\treturn;\n", !IO),
+ io__write_string("\t}\n", !IO),
+ io__write_string("\tdone = MR_TRUE;\n", !IO),
+ output_type_tables_init_list(Datas, SplitFiles, !IO),
+ io__write_string("}\n\n", !IO),
+
+ output_debugger_init_list_decls(Datas, !DeclSet, !IO),
+ io__write_string("\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_debugger(void)\n", !IO),
+ io__write_string("{\n", !IO),
+ io__write_string("\tstatic MR_bool done = MR_FALSE;\n", !IO),
+ io__write_string("\tif (done) {\n", !IO),
+ io__write_string("\t\treturn;\n", !IO),
+ io__write_string("\t}\n", !IO),
+ io__write_string("\tdone = MR_TRUE;\n", !IO),
+ output_debugger_init_list(Datas, !IO),
+ io__write_string("}\n\n", !IO),
+
+ io__write_string("#ifdef MR_DEEP_PROFILING\n", !IO),
+ output_write_proc_static_list_decls(Datas, !DeclSet, !IO),
+ io__write_string("\nvoid ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("write_out_proc_statics(FILE *fp)\n", !IO),
+ io__write_string("{\n", !IO),
+ output_write_proc_static_list(Datas, !IO),
+ io__write_string("}\n", !IO),
+ io__write_string("\n#endif\n\n", !IO),
io__write_string(
- "/* ensure everything is compiled with the same grade */\n"),
+ "/* ensure everything is compiled with the same grade */\n",
+ !IO),
io__write_string(
- "static const void *const MR_grade = &MR_GRADE_VAR;\n").
+ "static const void *const MR_grade = &MR_GRADE_VAR;\n", !IO).
:- pred module_defines_label_with_layout(comp_gen_c_module::in,
map(label, data_addr)::in) is semidet.
@@ -581,50 +566,50 @@
module_name::in, string::in, int::in, bool::in,
io__state::di, io__state::uo) is det.
-output_init_bunch_defs([], _, _, _, _) --> [].
+output_init_bunch_defs([], _, _, _, _, !IO).
output_init_bunch_defs([Bunch | Bunches], ModuleName, InitStatus, Seq,
- SplitFiles) -->
- io__write_string("static void "),
- output_bunch_name(ModuleName, InitStatus, Seq),
- io__write_string("(void)\n"),
- io__write_string("{\n"),
- output_init_bunch_def(Bunch, ModuleName, SplitFiles),
- io__write_string("}\n\n"),
- { NextSeq = Seq + 1 },
+ SplitFiles, !IO) :-
+ io__write_string("static void ", !IO),
+ output_bunch_name(ModuleName, InitStatus, Seq, !IO),
+ io__write_string("(void)\n", !IO),
+ io__write_string("{\n", !IO),
+ output_init_bunch_def(Bunch, ModuleName, SplitFiles, !IO),
+ io__write_string("}\n\n", !IO),
+ NextSeq = Seq + 1,
output_init_bunch_defs(Bunches, ModuleName, InitStatus, NextSeq,
- SplitFiles).
+ SplitFiles, !IO).
:- pred output_init_bunch_def(list(comp_gen_c_module)::in, module_name::in,
bool::in, io__state::di, io__state::uo) is det.
-output_init_bunch_def([], _, _) --> [].
-output_init_bunch_def([Module | Modules], ModuleName, SplitFiles) -->
- { Module = comp_gen_c_module(C_ModuleName, _) },
- ( { SplitFiles = yes } ->
- io__write_string("\t{ extern MR_ModuleFunc "),
- io__write_string(C_ModuleName),
- io__write_string(";\n"),
- io__write_string("\t "),
- io__write_string(C_ModuleName),
- io__write_string("(); }\n")
- ;
- io__write_string("\t"),
- io__write_string(C_ModuleName),
- io__write_string("();\n")
+output_init_bunch_def([], _, _, !IO).
+output_init_bunch_def([Module | Modules], ModuleName, SplitFiles, !IO) :-
+ Module = comp_gen_c_module(C_ModuleName, _),
+ ( SplitFiles = yes ->
+ io__write_string("\t{ extern MR_ModuleFunc ", !IO),
+ io__write_string(C_ModuleName, !IO),
+ io__write_string(";\n", !IO),
+ io__write_string("\t ", !IO),
+ io__write_string(C_ModuleName, !IO),
+ io__write_string("(); }\n", !IO)
+ ;
+ io__write_string("\t", !IO),
+ io__write_string(C_ModuleName, !IO),
+ io__write_string("();\n", !IO)
),
- output_init_bunch_def(Modules, ModuleName, SplitFiles).
+ output_init_bunch_def(Modules, ModuleName, SplitFiles, !IO).
:- pred output_init_bunch_calls(list(list(comp_gen_c_module))::in,
module_name::in, string::in, int::in, io__state::di, io__state::uo)
is det.
-output_init_bunch_calls([], _, _, _) --> [].
-output_init_bunch_calls([_ | Bunches], ModuleName, InitStatus, Seq) -->
- io__write_string("\t"),
- output_bunch_name(ModuleName, InitStatus, Seq),
- io__write_string("();\n"),
- { NextSeq = Seq + 1 },
- output_init_bunch_calls(Bunches, ModuleName, InitStatus, NextSeq).
+output_init_bunch_calls([], _, _, _, !IO).
+output_init_bunch_calls([_ | Bunches], ModuleName, InitStatus, Seq, !IO) :-
+ io__write_string("\t", !IO),
+ output_bunch_name(ModuleName, InitStatus, Seq, !IO),
+ io__write_string("();\n", !IO),
+ NextSeq = Seq + 1,
+ output_init_bunch_calls(Bunches, ModuleName, InitStatus, NextSeq, !IO).
% Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, Typector);
% for each type_ctor_info defined in this module.
@@ -632,48 +617,48 @@
:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
io__state::di, io__state::uo) is det.
-output_c_data_init_list([]) --> [].
-output_c_data_init_list([Data | Datas]) -->
- ( { Data = rtti_data(RttiData) } ->
- rtti_out__init_rtti_data_if_nec(RttiData)
+output_c_data_init_list([], !IO).
+output_c_data_init_list([Data | Datas], !IO) :-
+ ( Data = rtti_data(RttiData) ->
+ rtti_out__init_rtti_data_if_nec(RttiData, !IO)
;
- []
+ true
),
- output_c_data_init_list(Datas).
+ output_c_data_init_list(Datas, !IO).
% Output code to register each type_ctor_info defined in this module.
:- pred output_type_tables_init_list(list(comp_gen_c_data)::in,
bool::in, io__state::di, io__state::uo) is det.
-output_type_tables_init_list([], _) --> [].
-output_type_tables_init_list([Data | Datas], SplitFiles) -->
+output_type_tables_init_list([], _, !IO).
+output_type_tables_init_list([Data | Datas], SplitFiles, !IO) :-
(
- { Data = rtti_data(RttiData) }
+ Data = rtti_data(RttiData)
->
- rtti_out__register_rtti_data_if_nec(RttiData, SplitFiles)
+ rtti_out__register_rtti_data_if_nec(RttiData, SplitFiles, !IO)
;
- []
+ true
),
- output_type_tables_init_list(Datas, SplitFiles).
+ output_type_tables_init_list(Datas, SplitFiles, !IO).
% Output declarations for each module layout defined in this module
% (there should only be one, of course).
:- pred output_debugger_init_list_decls(list(comp_gen_c_data)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_debugger_init_list_decls([], DeclSet, DeclSet) --> [].
-output_debugger_init_list_decls([Data | Datas], DeclSet0, DeclSet) -->
+output_debugger_init_list_decls([], !DeclSet, !IO).
+output_debugger_init_list_decls([Data | Datas], !DeclSet, !IO) :-
(
- { Data = layout_data(LayoutData) },
- { LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_) }
+ Data = layout_data(LayoutData),
+ LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_)
->
output_data_addr_decls(layout_addr(module_layout(ModuleName)),
- "", "", 0, _, DeclSet0, DeclSet1)
+ !DeclSet, !IO)
;
- { DeclSet1 = DeclSet0 }
+ true
),
- output_debugger_init_list_decls(Datas, DeclSet1, DeclSet).
+ output_debugger_init_list_decls(Datas, !DeclSet, !IO).
% Output calls to MR_register_module_layout()
% for each module layout defined in this module
@@ -682,108 +667,99 @@
:- pred output_debugger_init_list(list(comp_gen_c_data)::in,
io__state::di, io__state::uo) is det.
-output_debugger_init_list([]) --> [].
-output_debugger_init_list([Data | Datas]) -->
+output_debugger_init_list([], !IO).
+output_debugger_init_list([Data | Datas], !IO) :-
(
- { Data = layout_data(LayoutData) },
- { LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_) }
+ Data = layout_data(LayoutData),
+ LayoutData = module_layout_data(ModuleName, _,_,_,_,_,_)
->
- io__write_string("\tif (MR_register_module_layout != NULL) {\n"),
- io__write_string("\t\t(*MR_register_module_layout)("),
- io__write_string("\n\t\t\t&"),
- output_layout_name(module_layout(ModuleName)),
- io__write_string(");\n\t}\n")
+ io__write_string("\tif (MR_register_module_layout != NULL) {\n",
+ !IO),
+ io__write_string("\t\t(*MR_register_module_layout)(", !IO),
+ io__write_string("\n\t\t\t&", !IO),
+ output_layout_name(module_layout(ModuleName), !IO),
+ io__write_string(");\n\t}\n", !IO)
;
- []
+ true
),
- output_debugger_init_list(Datas).
+ output_debugger_init_list(Datas, !IO).
:- pred output_write_proc_static_list_decls(list(comp_gen_c_data)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_write_proc_static_list_decls([], DeclSet, DeclSet) --> [].
-output_write_proc_static_list_decls([Data | Datas], DeclSet0, DeclSet) -->
+output_write_proc_static_list_decls([], !DeclSet, !IO).
+output_write_proc_static_list_decls([Data | Datas], !DeclSet, !IO) :-
(
- { Data = layout_data(LayoutData) },
- { LayoutData = proc_static_data(_, _, _, _, _) }
+ Data = layout_data(LayoutData),
+ LayoutData = proc_static_data(_, _, _, _, _)
->
- output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet1)
+ output_maybe_layout_data_decl(LayoutData, !DeclSet, !IO)
;
- { DeclSet1 = DeclSet0 }
+ true
),
- output_write_proc_static_list_decls(Datas,
- DeclSet1, DeclSet).
+ output_write_proc_static_list_decls(Datas, !DeclSet, !IO).
:- pred output_write_proc_static_list(list(comp_gen_c_data)::in,
io__state::di, io__state::uo) is det.
-output_write_proc_static_list([]) --> [].
-output_write_proc_static_list([Data | Datas]) -->
+output_write_proc_static_list([], !IO).
+output_write_proc_static_list([Data | Datas], !IO) :-
(
- { Data = layout_data(LayoutData) },
- { LayoutData = proc_static_data(RttiProcLabel, _, _, _, _) }
+ Data = layout_data(LayoutData),
+ LayoutData = proc_static_data(RttiProcLabel, _, _, _, _)
->
- io__write_string("\tMR_write_out_proc_static(fp, "),
- io__write_string("(MR_ProcStatic *)\n\t\t&"),
- output_layout_name(proc_static(RttiProcLabel)),
- io__write_string(");\n")
+ io__write_string("\tMR_write_out_proc_static(fp, ", !IO),
+ io__write_string("(MR_ProcStatic *)\n\t\t&", !IO),
+ output_layout_name(proc_static(RttiProcLabel), !IO),
+ io__write_string(");\n", !IO)
;
- []
+ true
),
- output_write_proc_static_list(Datas).
+ output_write_proc_static_list(Datas, !IO).
% Output a comment to tell mkinit what functions to
% call from <module>_init.c.
-:- pred output_init_comment(module_name, io__state, io__state).
-:- mode output_init_comment(in, di, uo) is det.
+:- pred output_init_comment(module_name::in,
+ io__state::di, io__state::uo) is det.
+
+output_init_comment(ModuleName, !IO) :-
+ io__write_string("/*\n", !IO),
+ io__write_string("INIT ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init\n", !IO),
+ globals__io_lookup_bool_option(aditi, Aditi, !IO),
+ ( Aditi = yes ->
+ RLName = make_rl_data_name(ModuleName),
+ io__write_string("ADITI_DATA ", !IO),
+ io__write_string(RLName, !IO),
+ io__write_string("\n", !IO)
+ ;
+ true
+ ),
+ io__write_string("ENDINIT\n", !IO),
+ io__write_string("*/\n\n", !IO).
+
+:- pred output_bunch_name(module_name::in, string::in, int::in,
+ io__state::di, io__state::uo) is det.
+
+output_bunch_name(ModuleName, InitStatus, Number, !IO) :-
+ io__write_string("mercury__", !IO),
+ MangledModuleName = sym_name_mangle(ModuleName),
+ io__write_string(MangledModuleName, !IO),
+ io__write_string("_", !IO),
+ io__write_string(InitStatus, !IO),
+ io__write_string("_bunch_", !IO),
+ io__write_int(Number, !IO).
-output_init_comment(ModuleName) -->
- io__write_string("/*\n"),
- io__write_string("INIT "),
- output_init_name(ModuleName),
- io__write_string("init\n"),
- globals__io_lookup_bool_option(aditi, Aditi),
- ( { Aditi = yes } ->
- { RLName = make_rl_data_name(ModuleName) },
- io__write_string("ADITI_DATA "),
- io__write_string(RLName),
- io__write_string("\n")
- ;
- []
- ),
- io__write_string("ENDINIT\n"),
- io__write_string("*/\n\n").
-
-:- pred output_bunch_name(module_name, string, int, io__state, io__state).
-:- mode output_bunch_name(in, in, in, di, uo) is det.
-
-output_bunch_name(ModuleName, InitStatus, Number) -->
- io__write_string("mercury__"),
- { MangledModuleName = sym_name_mangle(ModuleName) },
- io__write_string(MangledModuleName),
- io__write_string("_"),
- io__write_string(InitStatus),
- io__write_string("_bunch_"),
- io__write_int(Number).
-
- %
- % output_c_data_type_def_list outputs all the type definitions of
- % the module. This is needed because some compilers need the
- % data definition to appear before any use of the type in
- % forward declarations of static constants.
- %
-:- pred output_c_data_type_def_list(list(comp_gen_c_data), decl_set, decl_set,
- io__state, io__state).
-:- mode output_c_data_type_def_list(in, in, out, di, uo) is det.
-
-output_c_data_type_def_list([], DeclSet, DeclSet) --> [].
-output_c_data_type_def_list([M | Ms], DeclSet0, DeclSet) -->
- output_c_data_type_def(M, DeclSet0, DeclSet1),
- output_c_data_type_def_list(Ms, DeclSet1, DeclSet).
-
-:- pred output_c_data_type_def(comp_gen_c_data, decl_set, decl_set,
- io__state, io__state).
-:- mode output_c_data_type_def(in, in, out, di, uo) is det.
+ %
+ % output_c_data_type_def outputs the given the type definition.
+ % This is needed because some compilers need the type definition
+ % to appear before any use of the type in forward declarations
+ % of static constants.
+ %
+
+:- pred output_c_data_type_def(comp_gen_c_data::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_c_data_type_def(common_data(ModuleName, CellNum, TypeNum, ArgsTypes),
!DeclSet, !IO) :-
@@ -817,66 +793,40 @@
output_c_data_type_def(layout_data(LayoutData), !DeclSet, !IO) :-
output_maybe_layout_data_decl(LayoutData, !DeclSet, !IO).
-:- pred output_comp_gen_c_module_list(list(comp_gen_c_module)::in,
- map(label, data_addr)::in, decl_set::in, decl_set::out,
+:- pred output_comp_gen_c_module(map(label, data_addr)::in,
+ comp_gen_c_module::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_comp_gen_c_module_list([], _, DeclSet, DeclSet) --> [].
-output_comp_gen_c_module_list([Module | Modules], StackLayoutLabels,
- DeclSet0, DeclSet) -->
- output_comp_gen_c_module(Module, StackLayoutLabels,
- DeclSet0, DeclSet1),
- output_comp_gen_c_module_list(Modules, StackLayoutLabels,
- DeclSet1, DeclSet).
-
-:- pred output_comp_gen_c_module(comp_gen_c_module::in,
- map(label, data_addr)::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
-
-output_comp_gen_c_module(comp_gen_c_module(ModuleName, Procedures),
- StackLayoutLabels, DeclSet0, DeclSet) -->
- io__write_string("\n"),
- output_c_procedure_list_decls(Procedures, StackLayoutLabels,
- DeclSet0, DeclSet),
- io__write_string("\n"),
- io__write_string("MR_BEGIN_MODULE("),
- io__write_string(ModuleName),
- io__write_string(")\n"),
- { gather_c_module_labels(Procedures, Labels) },
- output_c_label_init_list(Labels, StackLayoutLabels),
- io__write_string("MR_BEGIN_CODE\n"),
- io__write_string("\n"),
- globals__io_lookup_bool_option(auto_comments, PrintComments),
- globals__io_lookup_bool_option(emit_c_loops, EmitCLoops),
- output_c_procedure_list(Procedures, PrintComments, EmitCLoops),
- io__write_string("MR_END_MODULE\n").
-
-:- pred output_comp_gen_c_var_list(list(comp_gen_c_var)::in,
- decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-
-output_comp_gen_c_var_list([], DeclSet, DeclSet) --> [].
-output_comp_gen_c_var_list([Var | Vars], DeclSet0, DeclSet) -->
- output_comp_gen_c_var(Var, DeclSet0, DeclSet1),
- output_comp_gen_c_var_list(Vars, DeclSet1, DeclSet).
+output_comp_gen_c_module(StackLayoutLabels,
+ comp_gen_c_module(ModuleName, Procedures),
+ !DeclSet, !IO) :-
+ io__write_string("\n", !IO),
+ list__foldl2(output_c_procedure_decls(StackLayoutLabels),
+ Procedures, !DeclSet, !IO),
+ io__write_string("\n", !IO),
+ io__write_string("MR_BEGIN_MODULE(", !IO),
+ io__write_string(ModuleName, !IO),
+ io__write_string(")\n", !IO),
+ gather_c_module_labels(Procedures, Labels),
+ list__foldl(output_c_label_init(StackLayoutLabels), Labels, !IO),
+ io__write_string("MR_BEGIN_CODE\n", !IO),
+ io__write_string("\n", !IO),
+ globals__io_lookup_bool_option(auto_comments, PrintComments, !IO),
+ globals__io_lookup_bool_option(emit_c_loops, EmitCLoops, !IO),
+ list__foldl(output_c_procedure(PrintComments, EmitCLoops), Procedures,
+ !IO),
+ io__write_string("MR_END_MODULE\n", !IO).
:- pred output_comp_gen_c_var(comp_gen_c_var::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_comp_gen_c_var(tabling_pointer_var(ModuleName, ProcLabel),
- DeclSet0, DeclSet) -->
- io__write_string("\nMR_TableNode "),
- output_tabling_pointer_var_name(ProcLabel),
- io__write_string(" = { 0 };\n"),
- { DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)) },
- { decl_set_insert(data_addr(DataAddr), DeclSet0, DeclSet) }.
-
-:- pred output_comp_gen_c_data_list(list(comp_gen_c_data)::in,
- decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-
-output_comp_gen_c_data_list([], DeclSet, DeclSet) --> [].
-output_comp_gen_c_data_list([Data | Datas], DeclSet0, DeclSet) -->
- output_comp_gen_c_data(Data, DeclSet0, DeclSet1),
- output_comp_gen_c_data_list(Datas, DeclSet1, DeclSet).
+ !DeclSet, !IO) :-
+ io__write_string("\nMR_TableNode ", !IO),
+ output_tabling_pointer_var_name(ProcLabel, !IO),
+ io__write_string(" = { 0 };\n", !IO),
+ DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)),
+ decl_set_insert(data_addr(DataAddr), !DeclSet).
:- pred output_comp_gen_c_data(comp_gen_c_data::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
@@ -885,7 +835,7 @@
!DeclSet, !IO) :-
io__write_string("\n", !IO),
assoc_list__keys(ArgsTypes, Args),
- output_rvals_decls(Args, "", "", 0, _, !DeclSet, !IO),
+ output_rvals_decls(Args, !DeclSet, !IO),
% The code for data local to a Mercury module
% should normally be visible only within the C file
@@ -905,33 +855,28 @@
output_comp_gen_c_data(layout_data(LayoutData), !DeclSet, !IO) :-
output_layout_data_defn(LayoutData, !DeclSet, !IO).
-:- pred output_user_foreign_code_list(list(user_foreign_code)::in,
- io__state::di, io__state::uo) is det.
-
-output_user_foreign_code_list([]) --> [].
-output_user_foreign_code_list([UserForeignCode | UserCCodes]) -->
- output_user_foreign_code(UserForeignCode),
- output_user_foreign_code_list(UserCCodes).
-
:- pred output_user_foreign_code(user_foreign_code::in,
io__state::di, io__state::uo) is det.
-output_user_foreign_code(user_foreign_code(Lang, Foreign_Code, Context)) -->
- ( { Lang = c } ->
- globals__io_lookup_bool_option(auto_comments, PrintComments),
- ( { PrintComments = yes } ->
- io__write_string("/* "),
- prog_out__write_context(Context),
- io__write_string(" pragma foreign_code */\n")
- ;
- []
- ),
- output_set_line_num(Context),
- io__write_string(Foreign_Code),
- io__write_string("\n"),
- output_reset_line_num
+output_user_foreign_code(user_foreign_code(Lang, Foreign_Code, Context),
+ !IO) :-
+ ( Lang = c ->
+ globals__io_lookup_bool_option(auto_comments, PrintComments,
+ !IO),
+ ( PrintComments = yes ->
+ io__write_string("/* ", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" pragma foreign_code */\n", !IO)
;
- { error("llds_out__output_user_foreign_code: unimplemented: foreign code other than C") }
+ true
+ ),
+ output_set_line_num(Context, !IO),
+ io__write_string(Foreign_Code, !IO),
+ io__write_string("\n", !IO),
+ output_reset_line_num(!IO)
+ ;
+ error("llds_out__output_user_foreign_code: unimplemented: " ++
+ "foreign code other than C")
).
% output_foreign_header_include_lines reverses the list of c
@@ -941,117 +886,89 @@
:- pred output_foreign_header_include_lines(list(foreign_decl_code)::in,
io__state::di, io__state::uo) is det.
-output_foreign_header_include_lines(Headers) -->
- { list__reverse(Headers, RevHeaders) },
- output_foreign_header_include_lines_2(RevHeaders).
-
-:- pred output_foreign_header_include_lines_2(list(foreign_decl_code)::in,
- io__state::di, io__state::uo) is det.
-
-output_foreign_header_include_lines_2([]) --> [].
-output_foreign_header_include_lines_2(
- [foreign_decl_code(Lang, Code, Context) | Hs]) -->
- ( { Lang = c } ->
- globals__io_lookup_bool_option(auto_comments, PrintComments),
- ( { PrintComments = yes } ->
- io__write_string("/* "),
- prog_out__write_context(Context),
- io__write_string(" pragma foreign_decl_code( "),
- io__write(Lang),
- io__write_string(" */\n")
- ;
- []
- ),
- output_set_line_num(Context),
- io__write_string(Code),
- io__write_string("\n"),
- output_reset_line_num
- ;
- { error("llds_out__output_user_foreign_code: unexpected: foreign code other than C") }
- ),
- output_foreign_header_include_lines_2(Hs).
-
-:- pred output_exported_c_functions(list(string), io__state, io__state).
-:- mode output_exported_c_functions(in, di, uo) is det.
-
-output_exported_c_functions([]) --> [].
-output_exported_c_functions([F | Fs]) -->
- io__write_string(F),
- output_exported_c_functions(Fs).
-
-:- pred output_c_label_decl_list(list(label), map(label, data_addr),
- decl_set, decl_set, io__state, io__state).
-:- mode output_c_label_decl_list(in, in, in, out, di, uo) is det.
-
-output_c_label_decl_list([], _, DeclSet, DeclSet) --> [].
-output_c_label_decl_list([Label | Labels], StackLayoutLabels,
- DeclSet0, DeclSet) -->
- output_c_label_decl(Label, StackLayoutLabels, DeclSet0, DeclSet1),
- output_c_label_decl_list(Labels, StackLayoutLabels, DeclSet1, DeclSet).
+output_foreign_header_include_lines(Headers, !IO) :-
+ list__reverse(Headers, RevHeaders),
+ list__foldl(output_foreign_header_include_lines_2, RevHeaders, !IO).
+
+:- pred output_foreign_header_include_lines_2(foreign_decl_code::in,
+ io__state::di, io__state::uo) is det.
+
+output_foreign_header_include_lines_2(Decl, !IO) :-
+ Decl = foreign_decl_code(Lang, Code, Context),
+ ( Lang = c ->
+ globals__io_lookup_bool_option(auto_comments, PrintComments,
+ !IO),
+ ( PrintComments = yes ->
+ io__write_string("/* ", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" pragma foreign_decl_code( ", !IO),
+ io__write(Lang, !IO),
+ io__write_string(" */\n", !IO)
+ ;
+ true
+ ),
+ output_set_line_num(Context, !IO),
+ io__write_string(Code, !IO),
+ io__write_string("\n", !IO),
+ output_reset_line_num(!IO)
+ ;
+ error("llds_out__output_user_foreign_code: unexpected: " ++
+ "foreign code other than C")
+ ).
-:- pred output_c_label_decl(label::in, map(label, data_addr)::in,
+:- pred output_c_label_decl(map(label, data_addr)::in, label::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_c_label_decl(Label, StackLayoutLabels, DeclSet0, DeclSet) -->
+output_c_label_decl(StackLayoutLabels, Label, !DeclSet, !IO) :-
%
% Declare the stack layout entry for this label, if needed.
%
- ( { map__search(StackLayoutLabels, Label, DataAddr) } ->
- output_stack_layout_decl(DataAddr, DeclSet0, DeclSet1)
+ ( map__search(StackLayoutLabels, Label, DataAddr) ->
+ output_stack_layout_decl(DataAddr, !DeclSet, !IO)
;
- { DeclSet1 = DeclSet0 }
+ true
),
%
% Declare the label itself.
%
(
- { Label = exported(_) },
- io__write_string("MR_define_extern_entry(")
+ Label = exported(_),
+ io__write_string("MR_define_extern_entry(", !IO)
;
- { Label = local(_) },
+ Label = local(_),
% The code for procedures local to a Mercury module
% should normally be visible only within the C file
% generated for that module. However, if we generate
% multiple C files, the code in each C file must be
% visible to the other C files for that Mercury module.
- globals__io_lookup_bool_option(split_c_files,
- SplitFiles),
- ( { SplitFiles = no } ->
- io__write_string("MR_declare_static(")
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
+ ( SplitFiles = no ->
+ io__write_string("MR_declare_static(", !IO)
;
- io__write_string("MR_define_extern_entry(")
+ io__write_string("MR_define_extern_entry(", !IO)
)
;
- { Label = c_local(_) },
- io__write_string("MR_declare_local(")
+ Label = c_local(_),
+ io__write_string("MR_declare_local(", !IO)
;
- { Label = local(_, _) },
- io__write_string("MR_declare_label(")
+ Label = local(_, _),
+ io__write_string("MR_declare_label(", !IO)
),
- { decl_set_insert(code_addr(label(Label)), DeclSet1, DeclSet) },
- output_label(Label),
- io__write_string(");\n").
+ decl_set_insert(code_addr(label(Label)), !DeclSet),
+ output_label(Label, !IO),
+ io__write_string(");\n", !IO).
:- pred output_stack_layout_decl(data_addr::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_stack_layout_decl(DataAddr, DeclSet0, DeclSet) -->
- output_data_addr_decls(DataAddr, "", "", 0, _, DeclSet0, DeclSet).
-
-:- pred output_c_label_init_list(list(label), map(label, data_addr),
- io__state, io__state).
-:- mode output_c_label_init_list(in, in, di, uo) is det.
-
-output_c_label_init_list([], _) --> [].
-output_c_label_init_list([Label | Labels], StackLayoutLabels) -->
- output_c_label_init(Label, StackLayoutLabels),
- output_c_label_init_list(Labels, StackLayoutLabels).
+output_stack_layout_decl(DataAddr, !DeclSet, !IO) :-
+ output_data_addr_decls(DataAddr, !DeclSet, !IO).
-:- pred output_c_label_init(label, map(label, data_addr), io__state, io__state).
-:- mode output_c_label_init(in, in, di, uo) is det.
+:- pred output_c_label_init(map(label, data_addr)::in, label::in,
+ io__state::di, io__state::uo) is det.
-output_c_label_init(Label, StackLayoutLabels) -->
- { map__search(StackLayoutLabels, Label, DataAddr) ->
+output_c_label_init(StackLayoutLabels, Label, !IO) :-
+ ( map__search(StackLayoutLabels, Label, DataAddr) ->
SuffixOpen = "_sl(",
( DataAddr = layout_addr(proc_layout(_, _)) ->
% Labels whose stack layouts are proc layouts may need
@@ -1067,30 +984,30 @@
SuffixOpen = "(",
% This label has no stack layout to initialize.
InitProcLayout = no
- },
+ ),
(
- { Label = exported(_) },
- { TabInitMacro = "\tMR_init_entry" }
+ Label = exported(_),
+ TabInitMacro = "\tMR_init_entry"
;
- { Label = local(_) },
- { TabInitMacro = "\tMR_init_entry" }
+ Label = local(_),
+ TabInitMacro = "\tMR_init_entry"
;
- { Label = c_local(_) },
- { TabInitMacro = "\tMR_init_local" }
+ Label = c_local(_),
+ TabInitMacro = "\tMR_init_local"
;
- { Label = local(_, _) },
- { TabInitMacro = "\tMR_init_label" }
+ Label = local(_, _),
+ TabInitMacro = "\tMR_init_label"
),
- io__write_string(TabInitMacro),
- io__write_string(SuffixOpen),
- output_label(Label),
- io__write_string(");\n"),
- ( { InitProcLayout = yes } ->
- io__write_string("\tMR_INIT_PROC_LAYOUT_ADDR("),
- output_label(Label),
- io__write_string(");\n")
+ io__write_string(TabInitMacro, !IO),
+ io__write_string(SuffixOpen, !IO),
+ output_label(Label, !IO),
+ io__write_string(");\n", !IO),
+ ( InitProcLayout = yes ->
+ io__write_string("\tMR_INIT_PROC_LAYOUT_ADDR(", !IO),
+ output_label(Label, !IO),
+ io__write_string(");\n", !IO)
;
- []
+ true
).
:- pred label_is_proc_entry(label::in, bool::out) is det.
@@ -1100,72 +1017,53 @@
label_is_proc_entry(local(_), yes).
label_is_proc_entry(exported(_), yes).
-:- pred output_c_procedure_list_decls(list(c_procedure)::in,
- map(label, data_addr)::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
-
-output_c_procedure_list_decls([], _, DeclSet, DeclSet) --> [].
-output_c_procedure_list_decls([Proc | Procs], StackLayoutLabels,
- DeclSet0, DeclSet) -->
- output_c_procedure_decls(Proc, StackLayoutLabels, DeclSet0, DeclSet1),
- output_c_procedure_list_decls(Procs, StackLayoutLabels,
- DeclSet1, DeclSet).
-
-:- pred output_c_procedure_list(list(c_procedure)::in, bool::in, bool::in,
- io__state::di, io__state::uo) is det.
-
-output_c_procedure_list([], _, _) --> [].
-output_c_procedure_list([Proc | Procs], PrintComments, EmitCLoops) -->
- output_c_procedure(Proc, PrintComments, EmitCLoops),
- output_c_procedure_list(Procs, PrintComments, EmitCLoops).
-
-:- pred output_c_procedure_decls(c_procedure::in, map(label, data_addr)::in,
+:- pred output_c_procedure_decls(map(label, data_addr)::in, c_procedure::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_c_procedure_decls(Proc, StackLayoutLabels, DeclSet0, DeclSet) -->
- { Proc = c_procedure(_Name, _Arity, _PredProcId, Instrs, _, _, _) },
- output_instruction_list_decls(Instrs, StackLayoutLabels,
- DeclSet0, DeclSet).
-
-:- pred output_c_procedure(c_procedure::in, bool::in, bool::in,
- io__state::di, io__state::uo) is det.
-
-output_c_procedure(Proc, PrintComments, EmitCLoops) -->
- { Proc = c_procedure(Name, Arity, proc(_, ProcId), Instrs, _, _, _) },
- { proc_id_to_int(ProcId, ModeNum) },
- ( { PrintComments = yes } ->
- io__write_string("\n/*-------------------------------------"),
- io__write_string("------------------------------------*/\n")
+output_c_procedure_decls(StackLayoutLabels, Proc, !DeclSet, !IO) :-
+ Proc = c_procedure(_Name, _Arity, _PredProcId, Instrs, _, _, _),
+ list__foldl2(output_instruction_decls(StackLayoutLabels), Instrs,
+ !DeclSet, !IO).
+
+:- pred output_c_procedure(bool::in, bool::in, c_procedure::in,
+ io__state::di, io__state::uo) is det.
+
+output_c_procedure(PrintComments, EmitCLoops, Proc, !IO) :-
+ Proc = c_procedure(Name, Arity, proc(_, ProcId), Instrs, _, _, _),
+ proc_id_to_int(ProcId, ModeNum),
+ ( PrintComments = yes ->
+ io__write_string("\n/*-------------------------------------",
+ !IO),
+ io__write_string("------------------------------------*/\n",
+ !IO)
;
- []
+ true
),
- io__write_string("/* code for predicate '"),
+ io__write_string("/* code for predicate '", !IO),
% Now that we have unused_args.m mangling predicate names,
% we should probably demangle them here.
- io__write_string(Name),
- io__write_string("'/"),
- io__write_int(Arity),
- io__write_string(" in mode "),
- io__write_int(ModeNum),
- io__write_string(" */\n"),
- { llds_out__find_caller_label(Instrs, CallerLabel) },
- { bintree_set__init(ContLabelSet0) },
- { llds_out__find_cont_labels(Instrs, ContLabelSet0, ContLabelSet) },
- { bintree_set__init(WhileSet0) },
- ( { EmitCLoops = yes } ->
- { llds_out__find_while_labels(Instrs, WhileSet0, WhileSet) }
+ io__write_string(Name, !IO),
+ io__write_string("'/", !IO),
+ io__write_int(Arity, !IO),
+ io__write_string(" in mode ", !IO),
+ io__write_int(ModeNum, !IO),
+ io__write_string(" */\n", !IO),
+ llds_out__find_caller_label(Instrs, CallerLabel),
+ llds_out__find_cont_labels(Instrs, bintree_set__init, ContLabelSet),
+ ( EmitCLoops = yes ->
+ llds_out__find_while_labels(Instrs,
+ bintree_set__init, WhileSet)
;
- { WhileSet = WhileSet0 }
+ WhileSet = bintree_set__init
),
output_instruction_list(Instrs, PrintComments,
- CallerLabel - ContLabelSet, WhileSet).
+ CallerLabel - ContLabelSet, WhileSet, !IO).
% Find the entry label for the procedure,
% for use as the profiling "caller label"
% field in calls within this procedure.
-:- pred llds_out__find_caller_label(list(instruction), label).
-:- mode llds_out__find_caller_label(in, out) is det.
+:- pred llds_out__find_caller_label(list(instruction)::in, label::out) is det.
llds_out__find_caller_label([], _) :-
error("cannot find caller label").
@@ -1183,13 +1081,11 @@
% Locate all the labels which are the continuation labels for calls,
% nondet disjunctions, forks or joins, and store them in ContLabelSet.
-:- pred llds_out__find_cont_labels(list(instruction),
- bintree_set(label), bintree_set(label)).
-:- mode llds_out__find_cont_labels(in, in, out) is det.
-
-llds_out__find_cont_labels([], ContLabelSet, ContLabelSet).
-llds_out__find_cont_labels([Instr - _ | Instrs], ContLabelSet0, ContLabelSet)
- :-
+:- pred llds_out__find_cont_labels(list(instruction)::in,
+ bintree_set(label)::in, bintree_set(label)::out) is det.
+
+llds_out__find_cont_labels([], !ContLabelSet).
+llds_out__find_cont_labels([Instr - _ | Instrs], !ContLabelSet) :-
(
(
Instr = call(_, label(ContLabel), _, _, _, _)
@@ -1202,20 +1098,20 @@
const(code_addr_const(label(ContLabel))))
)
->
- bintree_set__insert(ContLabelSet0, ContLabel, ContLabelSet1)
+ bintree_set__insert(!.ContLabelSet, ContLabel, !:ContLabelSet)
;
Instr = fork(Label1, Label2, _)
->
- bintree_set__insert_list(ContLabelSet0, [Label1, Label2],
- ContLabelSet1)
+ bintree_set__insert_list(!.ContLabelSet, [Label1, Label2],
+ !:ContLabelSet)
;
Instr = block(_, _, Block)
->
- llds_out__find_cont_labels(Block, ContLabelSet0, ContLabelSet1)
+ llds_out__find_cont_labels(Block, !ContLabelSet)
;
- ContLabelSet1 = ContLabelSet0
+ true
),
- llds_out__find_cont_labels(Instrs, ContLabelSet1, ContLabelSet).
+ llds_out__find_cont_labels(Instrs, !ContLabelSet).
% Locate all the labels which can be profitably turned into
% labels starting while loops. The idea is to do this transform:
@@ -1235,274 +1131,254 @@
%
% The second of these is better if we don't have fast jumps.
-:- pred llds_out__find_while_labels(list(instruction),
- bintree_set(label), bintree_set(label)).
-:- mode llds_out__find_while_labels(in, in, out) is det.
+:- pred llds_out__find_while_labels(list(instruction)::in,
+ bintree_set(label)::in, bintree_set(label)::out) is det.
-llds_out__find_while_labels([], WhileSet, WhileSet).
-llds_out__find_while_labels([Instr0 - _ | Instrs0], WhileSet0, WhileSet) :-
+llds_out__find_while_labels([], !WhileSet).
+llds_out__find_while_labels([Instr0 - _ | Instrs0], !WhileSet) :-
(
Instr0 = label(Label),
llds_out__is_while_label(Label, Instrs0, Instrs1, 0, UseCount),
UseCount > 0
->
- bintree_set__insert(WhileSet0, Label, WhileSet1),
- llds_out__find_while_labels(Instrs1, WhileSet1, WhileSet)
+ bintree_set__insert(!.WhileSet, Label, !:WhileSet),
+ llds_out__find_while_labels(Instrs1, !WhileSet)
;
- llds_out__find_while_labels(Instrs0, WhileSet0, WhileSet)
+ llds_out__find_while_labels(Instrs0, !WhileSet)
).
-:- pred llds_out__is_while_label(label, list(instruction), list(instruction),
- int, int).
-:- mode llds_out__is_while_label(in, in, out, in, out) is det.
+:- pred llds_out__is_while_label(label::in,
+ list(instruction)::in, list(instruction)::out, int::in, int::out)
+ is det.
-llds_out__is_while_label(_, [], [], Count, Count).
+llds_out__is_while_label(_, [], [], !Count).
llds_out__is_while_label(Label, [Instr0 - Comment0 | Instrs0], Instrs,
- Count0, Count) :-
+ !Count) :-
( Instr0 = label(_) ->
- Count = Count0,
Instrs = [Instr0 - Comment0 | Instrs0]
; Instr0 = goto(label(Label)) ->
- Count1 = Count0 + 1,
- llds_out__is_while_label(Label, Instrs0, Instrs, Count1, Count)
+ !:Count = !.Count + 1,
+ llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
; Instr0 = if_val(_, label(Label)) ->
- Count1 = Count0 + 1,
- llds_out__is_while_label(Label, Instrs0, Instrs, Count1, Count)
+ !:Count = !.Count + 1,
+ llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
;
- llds_out__is_while_label(Label, Instrs0, Instrs, Count0, Count)
+ llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
).
%-----------------------------------------------------------------------------%
-:- pred output_instruction_list_decls(list(instruction)::in,
- map(label, data_addr)::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
+:- pred output_instruction_decls(map(label, data_addr)::in, instruction::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_instruction_list_decls([], _, DeclSet, DeclSet) --> [].
-output_instruction_list_decls([Instr0 - _Comment0 | Instrs], StackLayoutLabels,
- DeclSet0, DeclSet) -->
- output_instruction_decls(Instr0, StackLayoutLabels,
- DeclSet0, DeclSet1),
- output_instruction_list_decls(Instrs, StackLayoutLabels,
- DeclSet1, DeclSet).
+output_instruction_decls(StackLayoutLabels, Instr - _Comment, !DeclSet, !IO) :-
+ output_instr_decls(StackLayoutLabels, Instr, !DeclSet, !IO).
-:- pred output_instruction_decls(instr::in, map(label, data_addr)::in,
+:- pred output_instr_decls(map(label, data_addr)::in, instr::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_instruction_decls(comment(_), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(livevals(_), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(block(_TempR, _TempF, Instrs), StackLayoutLabels,
- DeclSet0, DeclSet) -->
- output_instruction_list_decls(Instrs, StackLayoutLabels,
- DeclSet0, DeclSet).
-output_instruction_decls(assign(Lval, Rval), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
- output_rval_decls(Rval, "", "", 0, _, DeclSet1, DeclSet).
-output_instruction_decls(call(Target, ContLabel, _, _, _, _), _,
- DeclSet0, DeclSet) -->
- output_code_addr_decls(Target, "", "", 0, _, DeclSet0, DeclSet1),
- output_code_addr_decls(ContLabel, "", "", 0, _, DeclSet1, DeclSet).
-output_instruction_decls(c_code(_, _), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(mkframe(FrameInfo, FailureContinuation), _,
- DeclSet0, DeclSet) -->
- (
- { FrameInfo = ordinary_frame(_, _, yes(Struct)) },
- { Struct = pragma_c_struct(StructName, StructFields,
- MaybeStructFieldsContext) }
+output_instr_decls(_, comment(_), !DeclSet, !IO).
+output_instr_decls(_, livevals(_), !DeclSet, !IO).
+output_instr_decls( StackLayoutLabels, block(_TempR, _TempF, Instrs),
+ !DeclSet, !IO) :-
+ list__foldl2(output_instruction_decls(StackLayoutLabels), Instrs,
+ !DeclSet, !IO).
+output_instr_decls(_, assign(Lval, Rval), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO),
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, call(Target, ContLabel, _, _, _, _),
+ !DeclSet, !IO) :-
+ output_code_addr_decls(Target, !DeclSet, !IO),
+ output_code_addr_decls(ContLabel, !DeclSet, !IO).
+output_instr_decls(_, c_code(_, _), !DeclSet, !IO).
+output_instr_decls(_, mkframe(FrameInfo, FailureContinuation),
+ !DeclSet, !IO) :-
+ (
+ FrameInfo = ordinary_frame(_, _, yes(Struct)),
+ Struct = pragma_c_struct(StructName, StructFields,
+ MaybeStructFieldsContext)
->
- {
+ (
decl_set_is_member(pragma_c_struct(StructName),
- DeclSet0)
+ !.DeclSet)
->
string__append_list(["struct ", StructName,
" has been declared already"], Msg),
error(Msg)
;
true
- },
- io__write_string("struct "),
- io__write_string(StructName),
- io__write_string(" {\n"),
- ( { MaybeStructFieldsContext = yes(StructFieldsContext) } ->
- output_set_line_num(StructFieldsContext),
- io__write_string(StructFields),
- output_reset_line_num
- ;
- io__write_string(StructFields)
- ),
- io__write_string("\n};\n"),
- { decl_set_insert(pragma_c_struct(StructName),
- DeclSet0, DeclSet1) }
- ;
- { DeclSet1 = DeclSet0 }
- ),
- output_code_addr_decls(FailureContinuation, "", "", 0, _,
- DeclSet1, DeclSet).
-output_instruction_decls(label(_), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(goto(CodeAddr), _, DeclSet0, DeclSet) -->
- output_code_addr_decls(CodeAddr, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(computed_goto(Rval, _Labels), _,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(if_val(Rval, Target), _, DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet1),
- output_code_addr_decls(Target, "", "", 0, _, DeclSet1, DeclSet).
-output_instruction_decls(incr_hp(Lval, _Tag, _, Rval, _), _,
- DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
- output_rval_decls(Rval, "", "", 0, _, DeclSet1, DeclSet).
-output_instruction_decls(mark_hp(Lval), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(restore_hp(Rval), _, DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(free_heap(Rval), _, DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(store_ticket(Lval), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(reset_ticket(Rval, _Reason), _, DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(discard_ticket, _, DeclSet, DeclSet) --> [].
-output_instruction_decls(prune_ticket, _, DeclSet, DeclSet) --> [].
-output_instruction_decls(mark_ticket_stack(Lval), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(prune_tickets_to(Rval), _, DeclSet0, DeclSet) -->
- output_rval_decls(Rval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(incr_sp(_, _), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(decr_sp(_), _, DeclSet, DeclSet) --> [].
-output_instruction_decls(pragma_c(_, Comps, _, _,
+ ),
+ io__write_string("struct ", !IO),
+ io__write_string(StructName, !IO),
+ io__write_string(" {\n", !IO),
+ ( MaybeStructFieldsContext = yes(StructFieldsContext) ->
+ output_set_line_num(StructFieldsContext, !IO),
+ io__write_string(StructFields, !IO),
+ output_reset_line_num(!IO)
+ ;
+ io__write_string(StructFields, !IO)
+ ),
+ io__write_string("\n};\n", !IO),
+ decl_set_insert(pragma_c_struct(StructName), !DeclSet)
+ ;
+ true
+ ),
+ output_code_addr_decls(FailureContinuation, !DeclSet, !IO).
+output_instr_decls(_, label(_), !DeclSet, !IO).
+output_instr_decls(_, goto(CodeAddr), !DeclSet, !IO) :-
+ output_code_addr_decls(CodeAddr, !DeclSet, !IO).
+output_instr_decls(_, computed_goto(Rval, _Labels), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, if_val(Rval, Target), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO),
+ output_code_addr_decls(Target, !DeclSet, !IO).
+output_instr_decls(_, incr_hp(Lval, _Tag, _, Rval, _), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO),
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, mark_hp(Lval), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO).
+output_instr_decls(_, restore_hp(Rval), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, free_heap(Rval), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, store_ticket(Lval), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO).
+output_instr_decls(_, reset_ticket(Rval, _Reason), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, discard_ticket, !DeclSet, !IO).
+output_instr_decls(_, prune_ticket, !DeclSet, !IO).
+output_instr_decls(_, mark_ticket_stack(Lval), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO).
+output_instr_decls(_, prune_tickets_to(Rval), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO).
+output_instr_decls(_, incr_sp(_, _), !DeclSet, !IO).
+output_instr_decls(_, decr_sp(_), !DeclSet, !IO).
+output_instr_decls(StackLayoutLabels, pragma_c(_, Comps, _, _,
MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _),
- StackLayoutLabels, DeclSet0, DeclSet) -->
- ( { MaybeLayoutLabel = yes(Label) } ->
- { map__lookup(StackLayoutLabels, Label, DataAddr) },
- output_stack_layout_decl(DataAddr, DeclSet0, DeclSet1)
- ;
- { DeclSet1 = DeclSet0 }
- ),
- ( { MaybeOnlyLayoutLabel = yes(OnlyLabel) } ->
- { map__lookup(StackLayoutLabels, OnlyLabel, OnlyDataAddr) },
- output_stack_layout_decl(OnlyDataAddr, DeclSet1, DeclSet2)
- ;
- { DeclSet2 = DeclSet1 }
- ),
- output_pragma_c_component_list_decls(Comps, DeclSet2, DeclSet).
-output_instruction_decls(init_sync_term(Lval, _), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(fork(Child, Parent, _), _, DeclSet0, DeclSet) -->
- output_code_addr_decls(label(Child), "", "", 0, _, DeclSet0, DeclSet2),
- output_code_addr_decls(label(Parent), "", "", 0, _, DeclSet2, DeclSet).
-output_instruction_decls(join_and_terminate(Lval), _, DeclSet0, DeclSet) -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
-output_instruction_decls(join_and_continue(Lval, Label), _, DeclSet0, DeclSet)
- -->
- output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
- output_code_addr_decls(label(Label), "", "", 0, _, DeclSet1, DeclSet).
-
-:- pred output_pragma_c_component_list_decls(list(pragma_c_component),
- decl_set, decl_set, io__state, io__state).
-:- mode output_pragma_c_component_list_decls(in, in, out, di, uo) is det.
-
-output_pragma_c_component_list_decls([], DeclSet, DeclSet) --> [].
-output_pragma_c_component_list_decls([Component | Components],
- DeclSet0, DeclSet) -->
- output_pragma_c_component_decls(Component, DeclSet0, DeclSet1),
- output_pragma_c_component_list_decls(Components, DeclSet1, DeclSet).
-
-:- pred output_pragma_c_component_decls(pragma_c_component,
- decl_set, decl_set, io__state, io__state).
-:- mode output_pragma_c_component_decls(in, in, out, di, uo) is det.
-
-output_pragma_c_component_decls(pragma_c_inputs(Inputs), DeclSet0, DeclSet) -->
- output_pragma_input_rval_decls(Inputs, DeclSet0, DeclSet).
-output_pragma_c_component_decls(pragma_c_outputs(Outputs), DeclSet0, DeclSet)
- -->
- output_pragma_output_lval_decls(Outputs, DeclSet0, DeclSet).
-output_pragma_c_component_decls(pragma_c_raw_code(_, _), DeclSet, DeclSet)
- --> [].
-output_pragma_c_component_decls(pragma_c_user_code(_, _), DeclSet, DeclSet)
- --> [].
-output_pragma_c_component_decls(pragma_c_fail_to(_), DeclSet, DeclSet) --> [].
-output_pragma_c_component_decls(pragma_c_noop, DeclSet, DeclSet) --> [].
+ !DeclSet, !IO) :-
+ ( MaybeLayoutLabel = yes(Label) ->
+ map__lookup(StackLayoutLabels, Label, DataAddr),
+ output_stack_layout_decl(DataAddr, !DeclSet, !IO)
+ ;
+ true
+ ),
+ ( MaybeOnlyLayoutLabel = yes(OnlyLabel) ->
+ map__lookup(StackLayoutLabels, OnlyLabel, OnlyDataAddr),
+ output_stack_layout_decl(OnlyDataAddr, !DeclSet, !IO)
+ ;
+ true
+ ),
+ list__foldl2(output_pragma_c_component_decls, Comps, !DeclSet, !IO).
+output_instr_decls(_, init_sync_term(Lval, _), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO).
+output_instr_decls(_, fork(Child, Parent, _), !DeclSet, !IO) :-
+ output_code_addr_decls(label(Child), !DeclSet, !IO),
+ output_code_addr_decls(label(Parent), !DeclSet, !IO).
+output_instr_decls(_, join_and_terminate(Lval), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO).
+output_instr_decls(_, join_and_continue(Lval, Label), !DeclSet, !IO) :-
+ output_lval_decls(Lval, !DeclSet, !IO),
+ output_code_addr_decls(label(Label), !DeclSet, !IO).
+
+:- pred output_pragma_c_component_decls(pragma_c_component::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_pragma_c_component_decls(pragma_c_inputs(Inputs), !DeclSet, !IO) :-
+ output_pragma_input_rval_decls(Inputs, !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_outputs(Outputs), !DeclSet, !IO) :-
+ output_pragma_output_lval_decls(Outputs, !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_raw_code(_, _), !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_user_code(_, _), !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_fail_to(_), !DeclSet, !IO).
+output_pragma_c_component_decls(pragma_c_noop, !DeclSet, !IO).
%-----------------------------------------------------------------------------%
-:- pred output_instruction_list(list(instruction), bool,
- pair(label, bintree_set(label)), bintree_set(label),
- io__state, io__state).
-:- mode output_instruction_list(in, in, in, in, di, uo) is det.
+:- pred output_instruction_list(list(instruction)::in, bool::in,
+ pair(label, bintree_set(label))::in, bintree_set(label)::in,
+ io__state::di, io__state::uo) is det.
-output_instruction_list([], _, _, _) --> [].
+output_instruction_list([], _, _, _, !IO).
output_instruction_list([Instr0 - Comment0 | Instrs], PrintComments, ProfInfo,
- WhileSet) -->
+ WhileSet, !IO) :-
output_instruction_and_comment(Instr0, Comment0,
- PrintComments, ProfInfo),
- ( { Instr0 = label(Label), bintree_set__is_member(Label, WhileSet) } ->
- io__write_string("\twhile (1) {\n"),
+ PrintComments, ProfInfo, !IO),
+ (
+ Instr0 = label(Label),
+ bintree_set__is_member(Label, WhileSet)
+ ->
+ io__write_string("\twhile (1) {\n", !IO),
output_instruction_list_while(Instrs, Label,
- PrintComments, ProfInfo, WhileSet)
+ PrintComments, ProfInfo, WhileSet, !IO)
;
output_instruction_list(Instrs, PrintComments, ProfInfo,
- WhileSet)
+ WhileSet, !IO)
).
-:- pred output_instruction_list_while(list(instruction), label,
- bool, pair(label, bintree_set(label)), bintree_set(label),
- io__state, io__state).
-:- mode output_instruction_list_while(in, in, in, in, in, di, uo) is det.
+:- pred output_instruction_list_while(list(instruction)::in, label::in,
+ bool::in, pair(label, bintree_set(label))::in, bintree_set(label)::in,
+ io__state::di, io__state::uo) is det.
-output_instruction_list_while([], _, _, _, _) -->
- io__write_string("\tbreak; } /* end while */\n").
+output_instruction_list_while([], _, _, _, _, !IO) :-
+ io__write_string("\tbreak; } /* end while */\n", !IO).
output_instruction_list_while([Instr0 - Comment0 | Instrs], Label,
- PrintComments, ProfInfo, WhileSet) -->
- ( { Instr0 = label(_) } ->
- io__write_string("\tbreak; } /* end while */\n"),
+ PrintComments, ProfInfo, WhileSet, !IO) :-
+ ( Instr0 = label(_) ->
+ io__write_string("\tbreak; } /* end while */\n", !IO),
output_instruction_list([Instr0 - Comment0 | Instrs],
- PrintComments, ProfInfo, WhileSet)
- ; { Instr0 = goto(label(Label)) } ->
- io__write_string("\t/* continue */ } /* end while */\n"),
+ PrintComments, ProfInfo, WhileSet, !IO)
+ ; Instr0 = goto(label(Label)) ->
+ io__write_string("\t/* continue */ } /* end while */\n", !IO),
output_instruction_list(Instrs, PrintComments, ProfInfo,
- WhileSet)
- ; { Instr0 = if_val(Rval, label(Label)) } ->
- io__write_string("\tif ("),
- output_rval(Rval),
- io__write_string(")\n\t\tcontinue;\n"),
- ( { PrintComments = yes, Comment0 \= "" } ->
- io__write_string("\t\t/* "),
- io__write_string(Comment0),
- io__write_string(" */\n")
+ WhileSet, !IO)
+ ; Instr0 = if_val(Rval, label(Label)) ->
+ io__write_string("\tif (", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")\n\t\tcontinue;\n", !IO),
+ (
+ PrintComments = yes,
+ Comment0 \= ""
+ ->
+ io__write_string("\t\t/* ", !IO),
+ io__write_string(Comment0, !IO),
+ io__write_string(" */\n", !IO)
;
- []
+ true
),
output_instruction_list_while(Instrs, Label,
- PrintComments, ProfInfo, WhileSet)
+ PrintComments, ProfInfo, WhileSet, !IO)
;
output_instruction_and_comment(Instr0, Comment0,
- PrintComments, ProfInfo),
+ PrintComments, ProfInfo, !IO),
output_instruction_list_while(Instrs, Label,
- PrintComments, ProfInfo, WhileSet)
+ PrintComments, ProfInfo, WhileSet, !IO)
).
-:- pred output_instruction_and_comment(instr, string, bool,
- pair(label, bintree_set(label)), io__state, io__state).
-:- mode output_instruction_and_comment(in, in, in, in, di, uo) is det.
+:- pred output_instruction_and_comment(instr::in, string::in, bool::in,
+ pair(label, bintree_set(label))::in,
+ io__state::di, io__state::uo) is det.
-output_instruction_and_comment(Instr, Comment, PrintComments,
- ProfInfo) -->
+output_instruction_and_comment(Instr, Comment, PrintComments, ProfInfo, !IO) :-
(
- { PrintComments = no },
- ( { Instr = comment(_) ; Instr = livevals(_) } ->
- []
+ PrintComments = no,
+ (
+ ( Instr = comment(_)
+ ; Instr = livevals(_)
+ )
+ ->
+ true
;
- output_instruction(Instr, ProfInfo)
+ output_instruction(Instr, ProfInfo, !IO)
)
;
- { PrintComments = yes },
- output_instruction(Instr, ProfInfo),
- ( { Comment = "" } ->
- []
+ PrintComments = yes,
+ output_instruction(Instr, ProfInfo, !IO),
+ ( Comment = "" ->
+ true
;
- io__write_string("\t\t/* "),
- io__write_string(Comment),
- io__write_string(" */\n")
+ io__write_string("\t\t/* ", !IO),
+ io__write_string(Comment, !IO),
+ io__write_string(" */\n", !IO)
)
).
@@ -1529,418 +1405,404 @@
DummyPredName, 0, hlds_pred__initial_proc_id)) - ContLabelSet,
output_instruction(Instr, ProfInfo, !IO).
-:- pred output_instruction(instr, pair(label, bintree_set(label)),
- io__state, io__state).
-:- mode output_instruction(in, in, di, uo) is det.
-
-output_instruction(comment(Comment), _) -->
- io__write_strings(["/* ", Comment, " */\n"]).
-
-output_instruction(livevals(LiveVals), _) -->
- io__write_string("/*\n * Live lvalues:\n"),
- { set__to_sorted_list(LiveVals, LiveValsList) },
- output_livevals(LiveValsList),
- io__write_string(" */\n").
-
-output_instruction(block(TempR, TempF, Instrs), ProfInfo) -->
- io__write_string("\t{\n"),
- ( { TempR > 0 } ->
- io__write_string("\tMR_Word "),
- output_temp_decls(TempR, "r"),
- io__write_string(";\n")
- ;
- []
- ),
- ( { TempF > 0 } ->
- io__write_string("\tMR_Float "),
- output_temp_decls(TempF, "f"),
- io__write_string(";\n")
- ;
- []
- ),
- globals__io_lookup_bool_option(auto_comments, PrintComments),
- { bintree_set__init(WhileSet0) },
- output_instruction_list(Instrs, PrintComments, ProfInfo,
- WhileSet0),
- io__write_string("\t}\n").
-
-output_instruction(assign(Lval, Rval), _) -->
- io__write_string("\t"),
- output_lval(Lval),
- io__write_string(" = "),
- { llds__lval_type(Lval, Type) },
- output_rval_as_type(Rval, Type),
- io__write_string(";\n").
-
-output_instruction(call(Target, ContLabel, LiveVals, _, _, _), ProfInfo) -->
- { ProfInfo = CallerLabel - _ },
- output_call(Target, ContLabel, CallerLabel),
- output_gc_livevals(LiveVals).
-
-output_instruction(c_code(C_Code_String, _), _) -->
- io__write_string("\t"),
- io__write_string(C_Code_String).
-
-output_instruction(mkframe(FrameInfo, FailCont), _) -->
- (
- { FrameInfo = ordinary_frame(Msg, Num, MaybeStruct) },
- ( { MaybeStruct = yes(pragma_c_struct(StructName, _, _)) } ->
- io__write_string("\tMR_mkpragmaframe("""),
- c_util__output_quoted_string(Msg),
- io__write_string(""", "),
- io__write_int(Num),
- io__write_string(", "),
- io__write_string(StructName),
- io__write_string(", "),
- output_code_addr(FailCont),
- io__write_string(");\n")
- ;
- io__write_string("\tMR_mkframe("""),
- c_util__output_quoted_string(Msg),
- io__write_string(""", "),
- io__write_int(Num),
- io__write_string(", "),
- output_code_addr(FailCont),
- io__write_string(");\n")
- )
- ;
- { FrameInfo = temp_frame(Kind) },
- (
- { Kind = det_stack_proc },
- io__write_string("\tMR_mkdettempframe("),
- output_code_addr(FailCont),
- io__write_string(");\n")
- ;
- { Kind = nondet_stack_proc },
- io__write_string("\tMR_mktempframe("),
- output_code_addr(FailCont),
- io__write_string(");\n")
- )
- ).
+:- pred output_instruction(instr::in, pair(label, bintree_set(label))::in,
+ io__state::di, io__state::uo) is det.
-output_instruction(label(Label), ProfInfo) -->
- output_label_defn(Label),
- maybe_output_update_prof_counter(Label, ProfInfo).
-
-output_instruction(goto(CodeAddr), ProfInfo) -->
- { ProfInfo = CallerLabel - _ },
- io__write_string("\t"),
- output_goto(CodeAddr, CallerLabel).
-
-output_instruction(computed_goto(Rval, Labels), _) -->
- io__write_string("\tMR_COMPUTED_GOTO("),
- output_rval_as_type(Rval, unsigned),
- io__write_string(",\n\t\t"),
- output_label_list(Labels),
- io__write_string(");\n").
-
-output_instruction(if_val(Rval, Target), ProfInfo) -->
- { ProfInfo = CallerLabel - _ },
- io__write_string("\tif ("),
- output_rval_as_type(Rval, bool),
- io__write_string(") {\n\t\t"),
- output_goto(Target, CallerLabel),
- io__write_string("\t}\n").
+output_instruction(comment(Comment), _, !IO) :-
+ io__write_strings(["/* ", Comment, " */\n"], !IO).
-output_instruction(incr_hp(Lval, MaybeTag, MaybeOffset, Rval, TypeMsg),
- ProfInfo) -->
- (
- { MaybeTag = no },
- io__write_string("\tMR_offset_incr_hp_msg("),
- output_lval_as_word(Lval)
- ;
- { MaybeTag = yes(Tag) },
- io__write_string("\tMR_tag_offset_incr_hp_msg("),
- output_lval_as_word(Lval),
- io__write_string(", "),
- output_tag(Tag)
+output_instruction(livevals(LiveVals), _, !IO) :-
+ io__write_string("/*\n * Live lvalues:\n", !IO),
+ set__to_sorted_list(LiveVals, LiveValsList),
+ output_livevals(LiveValsList, !IO),
+ io__write_string(" */\n", !IO).
+
+output_instruction(block(TempR, TempF, Instrs), ProfInfo, !IO) :-
+ io__write_string("\t{\n", !IO),
+ ( TempR > 0 ->
+ io__write_string("\tMR_Word ", !IO),
+ output_temp_decls(TempR, "r", !IO),
+ io__write_string(";\n", !IO)
+ ;
+ true
),
- io__write_string(", "),
- (
- { MaybeOffset = no },
- io__write_string("0, ")
+ ( TempF > 0 ->
+ io__write_string("\tMR_Float ", !IO),
+ output_temp_decls(TempF, "f", !IO),
+ io__write_string(";\n", !IO)
;
- { MaybeOffset = yes(Offset) },
- io__write_int(Offset),
- io__write_string(", ")
+ true
),
- output_rval_as_type(Rval, word),
- io__write_string(", "),
- { ProfInfo = CallerLabel - _ },
- output_label(CallerLabel),
- io__write_string(", """),
- c_util__output_quoted_string(TypeMsg),
- io__write_string(""");\n").
-
-output_instruction(mark_hp(Lval), _) -->
- io__write_string("\tMR_mark_hp("),
- output_lval_as_word(Lval),
- io__write_string(");\n").
-
-output_instruction(restore_hp(Rval), _) -->
- io__write_string("\tMR_restore_hp("),
- output_rval_as_type(Rval, word),
- io__write_string(");\n").
-
-output_instruction(free_heap(Rval), _) -->
- io__write_string("\tMR_free_heap("),
- output_rval_as_type(Rval, data_ptr),
- io__write_string(");\n").
-
-output_instruction(store_ticket(Lval), _) -->
- io__write_string("\tMR_store_ticket("),
- output_lval_as_word(Lval),
- io__write_string(");\n").
-
-output_instruction(reset_ticket(Rval, Reason), _) -->
- io__write_string("\tMR_reset_ticket("),
- output_rval_as_type(Rval, word),
- io__write_string(", "),
- output_reset_trail_reason(Reason),
- io__write_string(");\n").
-
-output_instruction(discard_ticket, _) -->
- io__write_string("\tMR_discard_ticket();\n").
-
-output_instruction(prune_ticket, _) -->
- io__write_string("\tMR_prune_ticket();\n").
-
-output_instruction(mark_ticket_stack(Lval), _) -->
- io__write_string("\tMR_mark_ticket_stack("),
- output_lval_as_word(Lval),
- io__write_string(");\n").
-
-output_instruction(prune_tickets_to(Rval), _) -->
- io__write_string("\tMR_prune_tickets_to("),
- output_rval_as_type(Rval, word),
- io__write_string(");\n").
-
-output_instruction(incr_sp(N, Msg), _) -->
- io__write_string("\tMR_incr_sp_push_msg("),
- io__write_int(N),
- io__write_string(", """),
- c_util__output_quoted_string(Msg),
- io__write_string(""");\n").
-
-output_instruction(decr_sp(N), _) -->
- io__write_string("\tMR_decr_sp_pop_msg("),
- io__write_int(N),
- io__write_string(");\n").
-
-output_instruction(pragma_c(Decls, Components, _, _, _, _, _, _), _) -->
- io__write_string("\t{\n"),
- output_pragma_decls(Decls),
- output_pragma_c_components(Components),
- io__write_string("\t}\n").
-
-output_instruction(init_sync_term(Lval, N), _) -->
- io__write_string("\tMR_init_sync_term("),
- output_lval_as_word(Lval),
- io__write_string(", "),
- io__write_int(N),
- io__write_string(");\n").
+ globals__io_lookup_bool_option(auto_comments, PrintComments, !IO),
+ output_instruction_list(Instrs, PrintComments, ProfInfo,
+ bintree_set__init, !IO),
+ io__write_string("\t}\n", !IO).
-output_instruction(fork(Child, Parent, Lval), _) -->
- io__write_string("\tMR_fork_new_context("),
- output_label_as_code_addr(Child),
- io__write_string(", "),
- output_label_as_code_addr(Parent),
- io__write_string(", "),
- io__write_int(Lval),
- io__write_string(");\n").
+output_instruction(assign(Lval, Rval), _, !IO) :-
+ io__write_string("\t", !IO),
+ output_lval(Lval, !IO),
+ io__write_string(" = ", !IO),
+ llds__lval_type(Lval, Type),
+ output_rval_as_type(Rval, Type, !IO),
+ io__write_string(";\n", !IO).
-output_instruction(join_and_terminate(Lval), _) -->
- io__write_string("\tMR_join_and_terminate("),
- output_lval(Lval),
- io__write_string(");\n").
+output_instruction(call(Target, ContLabel, LiveVals, _, _, _), ProfInfo, !IO) :-
+ ProfInfo = CallerLabel - _,
+ output_call(Target, ContLabel, CallerLabel, !IO),
+ output_gc_livevals(LiveVals, !IO).
+
+output_instruction(c_code(C_Code_String, _), _, !IO) :-
+ io__write_string("\t", !IO),
+ io__write_string(C_Code_String, !IO).
+
+output_instruction(mkframe(FrameInfo, FailCont), _, !IO) :-
+ (
+ FrameInfo = ordinary_frame(Msg, Num, MaybeStruct),
+ ( MaybeStruct = yes(pragma_c_struct(StructName, _, _)) ->
+ io__write_string("\tMR_mkpragmaframe(""", !IO),
+ c_util__output_quoted_string(Msg, !IO),
+ io__write_string(""", ", !IO),
+ io__write_int(Num, !IO),
+ io__write_string(", ", !IO),
+ io__write_string(StructName, !IO),
+ io__write_string(", ", !IO),
+ output_code_addr(FailCont, !IO),
+ io__write_string(");\n", !IO)
+ ;
+ io__write_string("\tMR_mkframe(""", !IO),
+ c_util__output_quoted_string(Msg, !IO),
+ io__write_string(""", ", !IO),
+ io__write_int(Num, !IO),
+ io__write_string(", ", !IO),
+ output_code_addr(FailCont, !IO),
+ io__write_string(");\n", !IO)
+ )
+ ;
+ FrameInfo = temp_frame(Kind),
+ (
+ Kind = det_stack_proc,
+ io__write_string("\tMR_mkdettempframe(", !IO),
+ output_code_addr(FailCont, !IO),
+ io__write_string(");\n", !IO)
+ ;
+ Kind = nondet_stack_proc,
+ io__write_string("\tMR_mktempframe(", !IO),
+ output_code_addr(FailCont, !IO),
+ io__write_string(");\n", !IO)
+ )
+ ).
+
+output_instruction(label(Label), ProfInfo, !IO) :-
+ output_label_defn(Label, !IO),
+ maybe_output_update_prof_counter(Label, ProfInfo, !IO).
+
+output_instruction(goto(CodeAddr), ProfInfo, !IO) :-
+ ProfInfo = CallerLabel - _,
+ io__write_string("\t", !IO),
+ output_goto(CodeAddr, CallerLabel, !IO).
+
+output_instruction(computed_goto(Rval, Labels), _, !IO) :-
+ io__write_string("\tMR_COMPUTED_GOTO(", !IO),
+ output_rval_as_type(Rval, unsigned, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_label_list(Labels, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(if_val(Rval, Target), ProfInfo, !IO) :-
+ ProfInfo = CallerLabel - _,
+ io__write_string("\tif (", !IO),
+ output_rval_as_type(Rval, bool, !IO),
+ io__write_string(") {\n\t\t", !IO),
+ output_goto(Target, CallerLabel, !IO),
+ io__write_string("\t}\n", !IO).
-output_instruction(join_and_continue(Lval, Label), _) -->
- io__write_string("\tMR_join_and_continue("),
- output_lval(Lval),
- io__write_string(", "),
- output_label_as_code_addr(Label),
- io__write_string(");\n").
-
-:- pred output_pragma_c_components(list(pragma_c_component),
- io__state, io__state).
-:- mode output_pragma_c_components(in, di, uo) is det.
-
-output_pragma_c_components([]) --> [].
-output_pragma_c_components([C | Cs]) -->
- output_pragma_c_component(C),
- output_pragma_c_components(Cs).
-
-:- pred output_pragma_c_component(pragma_c_component, io__state, io__state).
-:- mode output_pragma_c_component(in, di, uo) is det.
-
-output_pragma_c_component(pragma_c_inputs(Inputs)) -->
- output_pragma_inputs(Inputs).
-output_pragma_c_component(pragma_c_outputs(Outputs)) -->
- output_pragma_outputs(Outputs).
-output_pragma_c_component(pragma_c_user_code(MaybeContext, C_Code)) -->
- ( { C_Code = "" } ->
- []
+output_instruction(incr_hp(Lval, MaybeTag, MaybeOffset, Rval, TypeMsg),
+ ProfInfo, !IO) :-
+ (
+ MaybeTag = no,
+ io__write_string("\tMR_offset_incr_hp_msg(", !IO),
+ output_lval_as_word(Lval, !IO)
+ ;
+ MaybeTag = yes(Tag),
+ io__write_string("\tMR_tag_offset_incr_hp_msg(", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(", ", !IO),
+ output_tag(Tag, !IO)
+ ),
+ io__write_string(", ", !IO),
+ (
+ MaybeOffset = no,
+ io__write_string("0, ", !IO)
+ ;
+ MaybeOffset = yes(Offset),
+ io__write_int(Offset, !IO),
+ io__write_string(", ", !IO)
+ ),
+ output_rval_as_type(Rval, word, !IO),
+ io__write_string(", ", !IO),
+ ProfInfo = CallerLabel - _,
+ output_label(CallerLabel, !IO),
+ io__write_string(", """, !IO),
+ c_util__output_quoted_string(TypeMsg, !IO),
+ io__write_string(""");\n", !IO).
+
+output_instruction(mark_hp(Lval), _, !IO) :-
+ io__write_string("\tMR_mark_hp(", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(restore_hp(Rval), _, !IO) :-
+ io__write_string("\tMR_restore_hp(", !IO),
+ output_rval_as_type(Rval, word, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(free_heap(Rval), _, !IO) :-
+ io__write_string("\tMR_free_heap(", !IO),
+ output_rval_as_type(Rval, data_ptr, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(store_ticket(Lval), _, !IO) :-
+ io__write_string("\tMR_store_ticket(", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(reset_ticket(Rval, Reason), _, !IO) :-
+ io__write_string("\tMR_reset_ticket(", !IO),
+ output_rval_as_type(Rval, word, !IO),
+ io__write_string(", ", !IO),
+ output_reset_trail_reason(Reason, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(discard_ticket, _, !IO) :-
+ io__write_string("\tMR_discard_ticket();\n", !IO).
+
+output_instruction(prune_ticket, _, !IO) :-
+ io__write_string("\tMR_prune_ticket();\n", !IO).
+
+output_instruction(mark_ticket_stack(Lval), _, !IO) :-
+ io__write_string("\tMR_mark_ticket_stack(", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(prune_tickets_to(Rval), _, !IO) :-
+ io__write_string("\tMR_prune_tickets_to(", !IO),
+ output_rval_as_type(Rval, word, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(incr_sp(N, Msg), _, !IO) :-
+ io__write_string("\tMR_incr_sp_push_msg(", !IO),
+ io__write_int(N, !IO),
+ io__write_string(", """, !IO),
+ c_util__output_quoted_string(Msg, !IO),
+ io__write_string(""");\n", !IO).
+
+output_instruction(decr_sp(N), _, !IO) :-
+ io__write_string("\tMR_decr_sp_pop_msg(", !IO),
+ io__write_int(N, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(pragma_c(Decls, Components, _, _, _, _, _, _), _, !IO) :-
+ io__write_string("\t{\n", !IO),
+ output_pragma_decls(Decls, !IO),
+ list__foldl(output_pragma_c_component, Components, !IO),
+ io__write_string("\t}\n", !IO).
+
+output_instruction(init_sync_term(Lval, N), _, !IO) :-
+ io__write_string("\tMR_init_sync_term(", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(", ", !IO),
+ io__write_int(N, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(fork(Child, Parent, Lval), _, !IO) :-
+ io__write_string("\tMR_fork_new_context(", !IO),
+ output_label_as_code_addr(Child, !IO),
+ io__write_string(", ", !IO),
+ output_label_as_code_addr(Parent, !IO),
+ io__write_string(", ", !IO),
+ io__write_int(Lval, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(join_and_terminate(Lval), _, !IO) :-
+ io__write_string("\tMR_join_and_terminate(", !IO),
+ output_lval(Lval, !IO),
+ io__write_string(");\n", !IO).
+
+output_instruction(join_and_continue(Lval, Label), _, !IO) :-
+ io__write_string("\tMR_join_and_continue(", !IO),
+ output_lval(Lval, !IO),
+ io__write_string(", ", !IO),
+ output_label_as_code_addr(Label, !IO),
+ io__write_string(");\n", !IO).
+
+:- pred output_pragma_c_component(pragma_c_component::in,
+ io__state::di, io__state::uo) is det.
+
+output_pragma_c_component(pragma_c_inputs(Inputs), !IO) :-
+ output_pragma_inputs(Inputs, !IO).
+output_pragma_c_component(pragma_c_outputs(Outputs), !IO) :-
+ output_pragma_outputs(Outputs, !IO).
+output_pragma_c_component(pragma_c_user_code(MaybeContext, C_Code), !IO) :-
+ ( C_Code = "" ->
+ true
;
% We should start the C_Code on a new line,
% just in case it starts with a proprocessor directive.
- ( { MaybeContext = yes(Context) } ->
- io__write_string("{\n"),
- output_set_line_num(Context),
- io__write_string(C_Code),
- io__write_string(";}\n"),
- output_reset_line_num
- ;
- io__write_string("{\n"),
- io__write_string(C_Code),
- io__write_string(";}\n")
- )
- ).
-output_pragma_c_component(pragma_c_raw_code(C_Code, _)) -->
- io__write_string(C_Code).
-output_pragma_c_component(pragma_c_fail_to(Label)) -->
- io__write_string("if (!MR_r1) MR_GOTO_LABEL("),
- output_label(Label),
- io__write_string(");\n").
-output_pragma_c_component(pragma_c_noop) --> [].
+ (
+ MaybeContext = yes(Context),
+ io__write_string("{\n", !IO),
+ output_set_line_num(Context, !IO),
+ io__write_string(C_Code, !IO),
+ io__write_string(";}\n", !IO),
+ output_reset_line_num(!IO)
+ ;
+ MaybeContext = no,
+ io__write_string("{\n", !IO),
+ io__write_string(C_Code, !IO),
+ io__write_string(";}\n", !IO)
+ )
+ ).
+output_pragma_c_component(pragma_c_raw_code(C_Code, _), !IO) :-
+ io__write_string(C_Code, !IO).
+output_pragma_c_component(pragma_c_fail_to(Label), !IO) :-
+ io__write_string("if (!MR_r1) MR_GOTO_LABEL(", !IO),
+ output_label(Label, !IO),
+ io__write_string(");\n", !IO).
+output_pragma_c_component(pragma_c_noop, !IO).
% Output the local variable declarations at the top of the
% pragma_foreign code for C.
-:- pred output_pragma_decls(list(pragma_c_decl), io__state, io__state).
-:- mode output_pragma_decls(in, di, uo) is det.
+:- pred output_pragma_decls(list(pragma_c_decl)::in,
+ io__state::di, io__state::uo) is det.
-output_pragma_decls([]) --> [].
-output_pragma_decls([D|Decls]) -->
+output_pragma_decls([], !IO).
+output_pragma_decls([Decl | Decls], !IO) :-
(
% Apart from special cases, the local variables are MR_Words
- { D = pragma_c_arg_decl(_Type, TypeString, VarName) },
- io__write_string("\t"),
- io__write_string(TypeString),
- io__write_string("\t"),
- io__write_string(VarName),
- io__write_string(";\n")
- ;
- { D = pragma_c_struct_ptr_decl(StructTag, VarName) },
- io__write_string("\tstruct "),
- io__write_string(StructTag),
- io__write_string("\t*"),
- io__write_string(VarName),
- io__write_string(";\n")
+ Decl = pragma_c_arg_decl(_Type, TypeString, VarName),
+ io__write_string("\t", !IO),
+ io__write_string(TypeString, !IO),
+ io__write_string("\t", !IO),
+ io__write_string(VarName, !IO),
+ io__write_string(";\n", !IO)
+ ;
+ Decl = pragma_c_struct_ptr_decl(StructTag, VarName),
+ io__write_string("\tstruct ", !IO),
+ io__write_string(StructTag, !IO),
+ io__write_string("\t*", !IO),
+ io__write_string(VarName, !IO),
+ io__write_string(";\n", !IO)
),
- output_pragma_decls(Decls).
+ output_pragma_decls(Decls, !IO).
% Output declarations for any rvals used to initialize the inputs
-:- pred output_pragma_input_rval_decls(list(pragma_c_input), decl_set, decl_set,
- io__state, io__state).
-:- mode output_pragma_input_rval_decls(in, in, out, di, uo) is det.
-
-output_pragma_input_rval_decls([], DeclSet, DeclSet) --> [].
-output_pragma_input_rval_decls([I | Inputs], DeclSet0, DeclSet) -->
- { I = pragma_c_input(_VarName, _Type, Rval, _) },
- output_rval_decls(Rval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
- output_pragma_input_rval_decls(Inputs, DeclSet1, DeclSet).
+:- pred output_pragma_input_rval_decls(list(pragma_c_input)::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_pragma_input_rval_decls([], !DeclSet, !IO).
+output_pragma_input_rval_decls([Input | Inputs], !DeclSet, !IO) :-
+ Input = pragma_c_input(_VarName, _Type, Rval, _),
+ output_rval_decls(Rval, "\t", "\t", 0, _N, !DeclSet, !IO),
+ output_pragma_input_rval_decls(Inputs, !DeclSet, !IO).
% Output the input variable assignments at the top of the
% pragma foreign_code code for C.
-:- pred output_pragma_inputs(list(pragma_c_input), io__state, io__state).
-:- mode output_pragma_inputs(in, di, uo) is det.
+:- pred output_pragma_inputs(list(pragma_c_input)::in,
+ io__state::di, io__state::uo) is det.
-output_pragma_inputs([]) --> [].
-output_pragma_inputs([I|Inputs]) -->
- { I = pragma_c_input(VarName, Type, Rval, MaybeForeignType) },
- io__write_string("\t"),
+output_pragma_inputs([], !IO).
+output_pragma_inputs([Input | Inputs], !IO) :-
+ Input = pragma_c_input(VarName, Type, Rval, MaybeForeignType),
+ io__write_string("\t", !IO),
(
- { MaybeForeignType = yes(ForeignType) },
+ MaybeForeignType = yes(ForeignType),
% For foreign types for which c_type_is_word_sized_int_or_ptr
% succeeds, the code in the else branch is not only correct,
% it also generates faster code than would be generated by
% the then branch, because MR_MAYBE_UNBOX_FOREIGN_TYPE
% invokes memcpy when given a word-sized type.
- \+ { c_type_is_word_sized_int_or_ptr(ForeignType) }
- ->
- io__write_string("MR_MAYBE_UNBOX_FOREIGN_TYPE("),
- io__write_string(ForeignType),
- io__write_string(", "),
- output_rval_as_type(Rval, word),
- io__write_string(", "),
- io__write_string(VarName),
- io__write_string(")")
- ;
- io__write_string(VarName),
- io__write_string(" = "),
- (
- { Type = term__functor(term__atom("string"), [], _) }
+ \+ c_type_is_word_sized_int_or_ptr(ForeignType)
->
- output_llds_type_cast(string),
- output_rval_as_type(Rval, word)
- ;
- { Type = term__functor(term__atom("float"), [], _) }
- ->
- output_rval_as_type(Rval, float)
+ io__write_string("MR_MAYBE_UNBOX_FOREIGN_TYPE(", !IO),
+ io__write_string(ForeignType, !IO),
+ io__write_string(", ", !IO),
+ output_rval_as_type(Rval, word, !IO),
+ io__write_string(", ", !IO),
+ io__write_string(VarName, !IO),
+ io__write_string(")", !IO)
+ ;
+ io__write_string(VarName, !IO),
+ io__write_string(" = ", !IO),
+ ( Type = term__functor(term__atom("string"), [], _) ->
+ output_llds_type_cast(string, !IO),
+ output_rval_as_type(Rval, word, !IO)
+ ; Type = term__functor(term__atom("float"), [], _) ->
+ output_rval_as_type(Rval, float, !IO)
;
% Note that for this cast to be correct the foreign
% type must be a word sized integer or pointer type.
- ( { MaybeForeignType = yes(ForeignTypeStr) } ->
- io__write_string("(" ++ ForeignTypeStr ++ ") ")
+ ( MaybeForeignType = yes(ForeignTypeStr) ->
+ io__write_string("(" ++ ForeignTypeStr ++ ") ",
+ !IO)
;
- []
+ true
),
- output_rval_as_type(Rval, word)
+ output_rval_as_type(Rval, word, !IO)
)
),
- io__write_string(";\n"),
- output_pragma_inputs(Inputs).
+ io__write_string(";\n", !IO),
+ output_pragma_inputs(Inputs, !IO).
% Output declarations for any lvals used for the outputs
-:- pred output_pragma_output_lval_decls(list(pragma_c_output),
- decl_set, decl_set, io__state, io__state).
-:- mode output_pragma_output_lval_decls(in, in, out, di, uo) is det.
-
-output_pragma_output_lval_decls([], DeclSet, DeclSet) --> [].
-output_pragma_output_lval_decls([O | Outputs], DeclSet0, DeclSet) -->
- { O = pragma_c_output(Lval, _Type, _VarName, _) },
- output_lval_decls(Lval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
- output_pragma_output_lval_decls(Outputs, DeclSet1, DeclSet).
+:- pred output_pragma_output_lval_decls(list(pragma_c_output)::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_pragma_output_lval_decls([], !DeclSet, !IO).
+output_pragma_output_lval_decls([O | Outputs], !DeclSet, !IO) :-
+ O = pragma_c_output(Lval, _Type, _VarName, _),
+ output_lval_decls(Lval, "\t", "\t", 0, _N, !DeclSet, !IO),
+ output_pragma_output_lval_decls(Outputs, !DeclSet, !IO).
% Output the output variable assignments at the bottom of the
% pragma foreign code for C
-:- pred output_pragma_outputs(list(pragma_c_output), io__state, io__state).
-:- mode output_pragma_outputs(in, di, uo) is det.
+:- pred output_pragma_outputs(list(pragma_c_output)::in,
+ io__state::di, io__state::uo) is det.
-output_pragma_outputs([]) --> [].
-output_pragma_outputs([O|Outputs]) -->
- { O = pragma_c_output(Lval, Type, VarName, MaybeForeignType) },
- io__write_string("\t"),
- ( { MaybeForeignType = yes(ForeignType) } ->
- io__write_string("MR_MAYBE_BOX_FOREIGN_TYPE("),
- io__write_string(ForeignType),
- io__write_string(", "),
- io__write_string(VarName),
- io__write_string(", "),
- output_lval_as_word(Lval),
- io__write_string(")")
+output_pragma_outputs([], !IO).
+output_pragma_outputs([O | Outputs], !IO) :-
+ O = pragma_c_output(Lval, Type, VarName, MaybeForeignType),
+ io__write_string("\t", !IO),
+ ( MaybeForeignType = yes(ForeignType) ->
+ io__write_string("MR_MAYBE_BOX_FOREIGN_TYPE(", !IO),
+ io__write_string(ForeignType, !IO),
+ io__write_string(", ", !IO),
+ io__write_string(VarName, !IO),
+ io__write_string(", ", !IO),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(")", !IO)
;
- output_lval_as_word(Lval),
- io__write_string(" = "),
+ output_lval_as_word(Lval, !IO),
+ io__write_string(" = ", !IO),
(
- { Type = term__functor(term__atom("string"), [], _) }
+ Type = term__functor(term__atom("string"), [], _)
->
- output_llds_type_cast(word),
- io__write_string(VarName)
+ output_llds_type_cast(word, !IO),
+ io__write_string(VarName, !IO)
;
- { Type = term__functor(term__atom("float"), [], _) }
+ Type = term__functor(term__atom("float"), [], _)
->
- io__write_string("MR_float_to_word("),
- io__write_string(VarName),
- io__write_string(")")
+ io__write_string("MR_float_to_word(", !IO),
+ io__write_string(VarName, !IO),
+ io__write_string(")", !IO)
;
- io__write_string(VarName)
+ io__write_string(VarName, !IO)
)
),
- io__write_string(";\n"),
- output_pragma_outputs(Outputs).
+ io__write_string(";\n", !IO),
+ output_pragma_outputs(Outputs, !IO).
-:- pred output_reset_trail_reason(reset_trail_reason, io__state, io__state).
-:- mode output_reset_trail_reason(in, di, uo) is det.
+:- pred output_reset_trail_reason(reset_trail_reason::in,
+ io__state::di, io__state::uo) is det.
output_reset_trail_reason(undo) -->
io__write_string("MR_undo").
@@ -1955,90 +1817,88 @@
output_reset_trail_reason(gc) -->
io__write_string("MR_gc").
-:- pred output_livevals(list(lval), io__state, io__state).
-:- mode output_livevals(in, di, uo) is det.
+:- pred output_livevals(list(lval)::in, io__state::di, io__state::uo) is det.
-output_livevals([]) --> [].
-output_livevals([Lval|Lvals]) -->
- io__write_string(" *\t"),
- output_lval(Lval),
- io__write_string("\n"),
- output_livevals(Lvals).
+output_livevals([], !IO).
+output_livevals([Lval | Lvals], !IO) :-
+ io__write_string(" *\t", !IO),
+ output_lval(Lval, !IO),
+ io__write_string("\n", !IO),
+ output_livevals(Lvals, !IO).
-:- pred output_gc_livevals(list(liveinfo), io__state, io__state).
-:- mode output_gc_livevals(in, di, uo) is det.
+:- pred output_gc_livevals(list(liveinfo)::in, io__state::di, io__state::uo)
+ is det.
-output_gc_livevals(LiveVals) -->
- globals__io_lookup_bool_option(auto_comments, PrintAutoComments),
- ( { PrintAutoComments = yes } ->
- io__write_string("/*\n"),
- io__write_string(" * Garbage collection livevals info\n"),
- output_gc_livevals_2(LiveVals),
- io__write_string(" */\n")
- ;
- []
- ).
-
-:- pred output_gc_livevals_2(list(liveinfo), io__state, io__state).
-:- mode output_gc_livevals_2(in, di, uo) is det.
-
-output_gc_livevals_2([]) --> [].
-output_gc_livevals_2([LiveInfo | LiveInfos]) -->
- { LiveInfo = live_lvalue(Locn, LiveValueType, TypeParams) },
- io__write_string(" *\t"),
- output_layout_locn(Locn),
- io__write_string("\t"),
- output_live_value_type(LiveValueType),
- io__write_string("\t"),
- { map__to_assoc_list(TypeParams, TypeParamList) },
- output_gc_livevals_params(TypeParamList),
- io__write_string("\n"),
- output_gc_livevals_2(LiveInfos).
-
-:- pred output_gc_livevals_params(assoc_list(tvar, set(layout_locn)),
- io__state, io__state).
-:- mode output_gc_livevals_params(in, di, uo) is det.
+output_gc_livevals(LiveVals, !IO) :-
+ globals__io_lookup_bool_option(auto_comments, PrintAutoComments, !IO),
+ ( PrintAutoComments = yes ->
+ io__write_string("/*\n", !IO),
+ io__write_string(" * Garbage collection livevals info\n", !IO),
+ output_gc_livevals_2(LiveVals, !IO),
+ io__write_string(" */\n", !IO)
+ ;
+ true
+ ).
-output_gc_livevals_params([]) --> [].
-output_gc_livevals_params([Var - LocnSet | Locns]) -->
- { term__var_to_int(Var, VarInt) },
- io__write_int(VarInt),
- io__write_string(" - "),
- { set__to_sorted_list(LocnSet, LocnList) },
- output_layout_locns(LocnList),
- io__write_string(" "),
- output_gc_livevals_params(Locns).
+:- pred output_gc_livevals_2(list(liveinfo)::in, io__state::di, io__state::uo)
+ is det.
-:- pred output_layout_locns(list(layout_locn), io__state, io__state).
-:- mode output_layout_locns(in, di, uo) is det.
+output_gc_livevals_2([], !IO).
+output_gc_livevals_2([LiveInfo | LiveInfos], !IO) :-
+ LiveInfo = live_lvalue(Locn, LiveValueType, TypeParams),
+ io__write_string(" *\t", !IO),
+ output_layout_locn(Locn, !IO),
+ io__write_string("\t", !IO),
+ output_live_value_type(LiveValueType, !IO),
+ io__write_string("\t", !IO),
+ map__to_assoc_list(TypeParams, TypeParamList),
+ output_gc_livevals_params(TypeParamList, !IO),
+ io__write_string("\n", !IO),
+ output_gc_livevals_2(LiveInfos, !IO).
+
+:- pred output_gc_livevals_params(assoc_list(tvar, set(layout_locn))::in,
+ io__state::di, io__state::uo) is det.
+
+output_gc_livevals_params([], !IO).
+output_gc_livevals_params([Var - LocnSet | Locns], !IO) :-
+ term__var_to_int(Var, VarInt),
+ io__write_int(VarInt, !IO),
+ io__write_string(" - ", !IO),
+ set__to_sorted_list(LocnSet, LocnList),
+ output_layout_locns(LocnList, !IO),
+ io__write_string(" ", !IO),
+ output_gc_livevals_params(Locns, !IO).
-output_layout_locns([]) --> [].
-output_layout_locns([Locn | Locns]) -->
- output_layout_locn(Locn),
- ( { Locns = [] } ->
- []
+:- pred output_layout_locns(list(layout_locn)::in,
+ io__state::di, io__state::uo) is det.
+
+output_layout_locns([], !IO).
+output_layout_locns([Locn | Locns], !IO) :-
+ output_layout_locn(Locn, !IO),
+ ( Locns = [] ->
+ true
;
- io__write_string(" and "),
- output_layout_locns(Locns)
+ io__write_string(" and ", !IO),
+ output_layout_locns(Locns, !IO)
).
-:- pred output_layout_locn(layout_locn, io__state, io__state).
-:- mode output_layout_locn(in, di, uo) is det.
+:- pred output_layout_locn(layout_locn::in, io__state::di, io__state::uo)
+ is det.
-output_layout_locn(Locn) -->
+output_layout_locn(Locn, !IO) :-
(
- { Locn = direct(Lval) },
- output_lval(Lval)
+ Locn = direct(Lval),
+ output_lval(Lval, !IO)
;
- { Locn = indirect(Lval, Offset) },
- io__write_string("offset "),
- io__write_int(Offset),
- io__write_string(" from "),
- output_lval(Lval)
+ Locn = indirect(Lval, Offset),
+ io__write_string("offset ", !IO),
+ io__write_int(Offset, !IO),
+ io__write_string(" from ", !IO),
+ output_lval(Lval, !IO)
).
-:- pred output_live_value_type(live_value_type, io__state, io__state).
-:- mode output_live_value_type(in, di, uo) is det.
+:- pred output_live_value_type(live_value_type::in,
+ io__state::di, io__state::uo) is det.
output_live_value_type(succip) --> io__write_string("type succip").
output_live_value_type(curfr) --> io__write_string("type curfr").
@@ -2071,169 +1931,186 @@
),
io__write_string(")").
-:- pred output_temp_decls(int, string, io__state, io__state).
-:- mode output_temp_decls(in, in, di, uo) is det.
+:- pred output_temp_decls(int::in, string::in,
+ io__state::di, io__state::uo) is det.
-output_temp_decls(N, Type) -->
- output_temp_decls_2(1, N, Type).
+output_temp_decls(N, Type, !IO) :-
+ output_temp_decls_2(1, N, Type, !IO).
-:- pred output_temp_decls_2(int, int, string, io__state, io__state).
-:- mode output_temp_decls_2(in, in, in, di, uo) is det.
+:- pred output_temp_decls_2(int::in, int::in, string::in,
+ io__state::di, io__state::uo) is det.
-output_temp_decls_2(Next, Max, Type) -->
- ( { Next =< Max } ->
- ( { Next > 1 } ->
- io__write_string(", ")
+output_temp_decls_2(Next, Max, Type, !IO) :-
+ ( Next =< Max ->
+ ( Next > 1 ->
+ io__write_string(", ", !IO)
;
- []
+ true
),
- io__write_string("MR_temp"),
- io__write_string(Type),
- io__write_int(Next),
- { Next1 = Next + 1 },
- output_temp_decls_2(Next1, Max, Type)
- ;
- []
- ).
-
-output_rval_decls(lval(Lval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_lval_decls(Lval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_rval_decls(var(_), _, _, _, _, _, _) -->
- { error("output_rval_decls: unexpected var") }.
-output_rval_decls(mkword(_, Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_rval_decls(const(Const), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- ( { Const = code_addr_const(CodeAddress) } ->
+ io__write_string("MR_temp", !IO),
+ io__write_string(Type, !IO),
+ io__write_int(Next, !IO),
+ output_temp_decls_2(Next + 1, Max, Type, !IO)
+ ;
+ true
+ ).
+
+output_rval_decls(Lval, !DeclSet, !IO) :-
+ output_rval_decls(Lval, "", "", 0, _, !DeclSet, !IO).
+
+ % output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
+ % DeclSet0, DeclSet) outputs the declarations of any static constants,
+ % etc. that need to be declared before output_rval(Rval) is called.
+ % FirstIndent is output before the first declaration, while
+ % LaterIndent is output before all later declaration; N0 and N
+ % give the number of declarations output before and after this call.
+ %
+ % Every time we emit a declaration for a symbol, we insert it into the
+ % set of symbols we've already declared. That way, we avoid generating
+ % the same symbol twice, which would cause an error in the C code.
+
+:- pred output_rval_decls(rval::in, string::in, string::in, int::in, int::out,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_rval_decls(lval(Lval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_lval_decls(Lval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_rval_decls(var(_), _, _, _, _, _, _, !IO) :-
+ error("output_rval_decls: unexpected var").
+output_rval_decls(mkword(_, Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_rval_decls(const(Const), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ ( Const = code_addr_const(CodeAddress) ->
output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent,
- N0, N, DeclSet0, DeclSet)
- ; { Const = data_addr_const(DataAddr, _) } ->
- output_data_addr_decls(DataAddr,
- FirstIndent, LaterIndent, N0, N, DeclSet0, DeclSet)
- ; { Const = float_const(FloatVal) } ->
+ !N, !DeclSet, !IO)
+ ; Const = data_addr_const(DataAddr, _) ->
+ output_data_addr_decls(DataAddr, FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO)
+ ; Const = float_const(FloatVal) ->
%
% If floats are boxed, and the static ground terms
% option is enabled, then for each float constant
% which we might want to box we declare a static const
% variable holding that constant.
%
- globals__io_lookup_bool_option(unboxed_float, UnboxedFloat),
+ globals__io_lookup_bool_option(unboxed_float,
+ UnboxedFloat, !IO),
globals__io_lookup_bool_option(static_ground_terms,
- StaticGroundTerms),
- ( { UnboxedFloat = no, StaticGroundTerms = yes } ->
- { llds_out__float_literal_name(FloatVal, FloatName) },
- { FloatLabel = float_label(FloatName) },
- ( { decl_set_is_member(FloatLabel, DeclSet0) } ->
- { N = N0 },
- { DeclSet = DeclSet0 }
- ;
- { decl_set_insert(FloatLabel,
- DeclSet0, DeclSet) },
- { FloatString = c_util__make_float_literal(
- FloatVal) },
- output_indent(FirstIndent, LaterIndent, N0),
- { N = N0 + 1 },
+ StaticGroundTerms, !IO),
+ (
+ UnboxedFloat = no,
+ StaticGroundTerms = yes
+ ->
+ llds_out__float_literal_name(FloatVal, FloatName),
+ FloatLabel = float_label(FloatName),
+ ( decl_set_is_member(FloatLabel, !.DeclSet) ->
+ true
+ ;
+ decl_set_insert(FloatLabel, !DeclSet),
+ FloatString = c_util__make_float_literal(
+ FloatVal),
+ output_indent(FirstIndent, LaterIndent,
+ !.N, !IO),
+ !:N = !.N + 1,
io__write_strings([
"static const MR_Float ",
"mercury_float_const_", FloatName,
" = ", FloatString, ";\n"
- ])
+ ], !IO)
)
;
- { N = N0 },
- { DeclSet = DeclSet0 }
+ true
)
;
- { N = N0 },
- { DeclSet = DeclSet0 }
- ).
-output_rval_decls(unop(_, Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_rval_decls(binop(Op, Rval1, Rval2), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval1, FirstIndent, LaterIndent, N0, N1,
- DeclSet0, DeclSet1),
- output_rval_decls(Rval2, FirstIndent, LaterIndent, N1, N2,
- DeclSet1, DeclSet2),
+ true
+ ).
+output_rval_decls(unop(_, Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_rval_decls(binop(Op, Rval1, Rval2), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval1, FirstIndent, LaterIndent, !N, !DeclSet, !IO),
+ output_rval_decls(Rval2, FirstIndent, LaterIndent, !N, !DeclSet, !IO),
%
% If floats are boxed, and the static ground terms
% option is enabled, then for each float constant
% which we might want to box we declare a static const
% variable holding that constant.
%
- ( { c_util__float_op(Op, OpStr) } ->
- globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
+ ( c_util__float_op(Op, OpStr) ->
+ globals__io_lookup_bool_option(unboxed_float, UnboxFloat, !IO),
globals__io_lookup_bool_option(static_ground_terms,
- StaticGroundTerms),
+ StaticGroundTerms, !IO),
(
- { UnboxFloat = no, StaticGroundTerms = yes },
- { llds_out__float_const_binop_expr_name(Op, Rval1, Rval2,
- FloatName) }
- ->
- { FloatLabel = float_label(FloatName) },
- ( { decl_set_is_member(FloatLabel, DeclSet2) } ->
- { N = N2 },
- { DeclSet = DeclSet2 }
- ;
- { decl_set_insert(FloatLabel, DeclSet2, DeclSet) },
- output_indent(FirstIndent, LaterIndent, N2),
- { N = N2 + 1 },
- io__write_string("static const "),
- output_llds_type(float),
- io__write_string(" mercury_float_const_"),
- io__write_string(FloatName),
- io__write_string(" = "),
- % note that we just output the expression
- % here, and let the C compiler evaluate it,
- % rather than evaluating it ourselves;
- % this avoids having to deal with some nasty
- % issues regarding floating point accuracy
- % when doing cross-compilation.
- output_rval_as_type(Rval1, float),
- io__write_string(" "),
- io__write_string(OpStr),
- io__write_string(" "),
- output_rval_as_type(Rval2, float),
- io__write_string(";\n")
+ UnboxFloat = no,
+ StaticGroundTerms = yes,
+ llds_out__float_const_binop_expr_name(Op, Rval1, Rval2,
+ FloatName)
+ ->
+ FloatLabel = float_label(FloatName),
+ ( decl_set_is_member(FloatLabel, !.DeclSet) ->
+ true
+ ;
+ decl_set_insert(FloatLabel, !DeclSet),
+ output_indent(FirstIndent, LaterIndent, !.N,
+ !IO),
+ !:N = !.N + 1,
+ io__write_string("static const ", !IO),
+ output_llds_type(float, !IO),
+ io__write_string(" mercury_float_const_", !IO),
+ io__write_string(FloatName, !IO),
+ io__write_string(" = ", !IO),
+ % note that we just output the
+ % expression here, and let the C
+ % compiler evaluate it, rather than
+ % evaluating it ourselves;
+ % this avoids having to deal with some
+ % nasty issues regarding floating point
+ % accuracy when doing
+ % cross-compilation.
+ output_rval_as_type(Rval1, float, !IO),
+ io__write_string(" ", !IO),
+ io__write_string(OpStr, !IO),
+ io__write_string(" ", !IO),
+ output_rval_as_type(Rval2, float, !IO),
+ io__write_string(";\n", !IO)
)
;
- { N = N2 },
- { DeclSet = DeclSet2 }
+ true
)
;
- { N = N2 },
- { DeclSet = DeclSet2 }
+ true
).
output_rval_decls(mem_addr(MemRef), FirstIndent, LaterIndent,
- N0, N, DeclSet0, DeclSet) -->
+ !N, !DeclSet, !IO) :-
output_mem_ref_decls(MemRef, FirstIndent, LaterIndent,
- N0, N, DeclSet0, DeclSet).
+ !N, !DeclSet, !IO).
+
+:- pred output_rvals_decls(list(rval)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
-output_rvals_decls([], _FirstIndent, _LaterIndent, N, N,
- DeclSet, DeclSet) --> [].
-output_rvals_decls([Rval | Rvals], FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N1,
- DeclSet0, DeclSet1),
- output_rvals_decls(Rvals, FirstIndent, LaterIndent, N1, N,
- DeclSet1, DeclSet).
-
-:- pred output_mem_ref_decls(mem_ref, string, string, int, int,
- decl_set, decl_set, io__state, io__state).
-:- mode output_mem_ref_decls(in, in, in, in, out, in, out, di, uo) is det.
-
-output_mem_ref_decls(stackvar_ref(_), _, _, N, N, DeclSet, DeclSet) --> [].
-output_mem_ref_decls(framevar_ref(_), _, _, N, N, DeclSet, DeclSet) --> [].
-output_mem_ref_decls(heap_ref(Rval, _, _), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
+output_rvals_decls(Rvals, !DeclSet, !IO) :-
+ output_rvals_decls(Rvals, "", "", 0, _, !DeclSet, !IO).
+
+:- pred output_rvals_decls(list(rval)::in, string::in, string::in,
+ int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_rvals_decls([], _FirstIndent, _LaterIndent, !N, !DeclSet, !IO).
+output_rvals_decls([Rval | Rvals], FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO),
+ output_rvals_decls(Rvals, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+
+:- pred output_mem_ref_decls(mem_ref::in, string::in, string::in,
+ int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_mem_ref_decls(stackvar_ref(_), _, _, !N, !DeclSet, !IO).
+output_mem_ref_decls(framevar_ref(_), _, _, !N, !DeclSet, !IO).
+output_mem_ref_decls(heap_ref(Rval, _, _), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
%-----------------------------------------------------------------------------%
@@ -2243,8 +2120,8 @@
:- pred llds_out__float_const_expr_name(rval::in, string::out) is semidet.
% Given an rval, succeed iff it is a floating point constant expression;
-% if so, return a name for that rval that is suitable for use in a C identifier.
-% Different rvals must be given different names.
+% if so, return a name for that rval that is suitable for use in a C
+% identifier. Different rvals must be given different names.
llds_out__float_const_expr_name(Expr, Name) :-
( Expr = const(float_const(Float)) ->
@@ -2289,8 +2166,7 @@
string__replace_all(FloatName1, "+", "plus", FloatName2),
string__replace_all(FloatName2, "-", "neg", FloatName).
-:- pred llds_out__float_op_name(binary_op, string).
-:- mode llds_out__float_op_name(in, out) is semidet.
+:- pred llds_out__float_op_name(binary_op::in, string::out) is semidet.
% succeed iff the binary operator is an operator whose return
% type is float; bind the output string to a name for that operator
@@ -2393,8 +2269,7 @@
data_name_may_include_non_static_code_address(common(_, _)) = no.
data_name_may_include_non_static_code_address(tabling_pointer(_)) = no.
-:- pred output_decl_id(decl_id, io__state, io__state).
-:- mode output_decl_id(in, di, uo) is det.
+:- pred output_decl_id(decl_id::in, io__state::di, io__state::uo) is det.
output_decl_id(common_type(ModuleName, TypeNum)) -->
output_common_cell_type_name(ModuleName, TypeNum).
@@ -2410,14 +2285,14 @@
:- pred output_cons_arg_types(list(llds_type)::in, string::in, int::in,
io__state::di, io__state::uo) is det.
-output_cons_arg_types([], _, _) --> [].
-output_cons_arg_types([Type | Types], Indent, ArgNum) -->
- io__write_string(Indent),
- output_llds_type(Type),
- io__write_string(" f"),
- io__write_int(ArgNum),
- io__write_string(";\n"),
- output_cons_arg_types(Types, Indent, ArgNum + 1).
+output_cons_arg_types([], _, _, !IO).
+output_cons_arg_types([Type | Types], Indent, ArgNum, !IO) :-
+ io__write_string(Indent, !IO),
+ output_llds_type(Type, !IO),
+ io__write_string(" f", !IO),
+ io__write_int(ArgNum, !IO),
+ io__write_string(";\n", !IO),
+ output_cons_arg_types(Types, Indent, ArgNum + 1, !IO).
% Given an rval, figure out the type it would have as
% an argument. Normally that's the same as its usual type;
@@ -2428,13 +2303,16 @@
:- pred llds_out__rval_type_as_arg(rval::in, llds_type::out,
io__state::di, io__state::uo) is det.
-llds_out__rval_type_as_arg(Rval, ArgType) -->
- { llds__rval_type(Rval, Type) },
- globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
- ( { Type = float, UnboxFloat = no } ->
- { ArgType = data_ptr }
+llds_out__rval_type_as_arg(Rval, ArgType, !IO) :-
+ llds__rval_type(Rval, Type),
+ globals__io_lookup_bool_option(unboxed_float, UnboxFloat, !IO),
+ (
+ Type = float,
+ UnboxFloat = no
+ ->
+ ArgType = data_ptr
;
- { ArgType = Type }
+ ArgType = Type
).
% Same as output_llds_type, but will put parentheses
@@ -2442,10 +2320,10 @@
:- pred output_llds_type_cast(llds_type::in,
io__state::di, io__state::uo) is det.
-output_llds_type_cast(LLDSType) -->
- io__write_string("("),
- output_llds_type(LLDSType),
- io__write_string(") ").
+output_llds_type_cast(LLDSType, !IO) :-
+ io__write_string("(", !IO),
+ output_llds_type(LLDSType, !IO),
+ io__write_string(") ", !IO).
:- pred output_llds_type(llds_type::in, io__state::di, io__state::uo) is det.
@@ -2487,81 +2365,72 @@
% static constants, etc. that need to be declared before
% output_lval(Lval) is called.
-:- pred output_lval_decls(lval, string, string, int, int, decl_set, decl_set,
- io__state, io__state).
-:- mode output_lval_decls(in, in, in, in, out, in, out, di, uo) is det.
-
-output_lval_decls(field(_, Rval, FieldNum), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N1,
- DeclSet0, DeclSet1),
- output_rval_decls(FieldNum, FirstIndent, LaterIndent, N1, N,
- DeclSet1, DeclSet).
-output_lval_decls(reg(_, _), _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(stackvar(_), _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(framevar(_), _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(succip, _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(maxfr, _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(curfr, _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(succfr(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_lval_decls(prevfr(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_lval_decls(redofr(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_lval_decls(redoip(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_lval_decls(succip(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-output_lval_decls(hp, _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(sp, _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(lvar(_), _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(temp(_, _), _, _, N, N, DeclSet, DeclSet) --> [].
-output_lval_decls(mem_ref(Rval), FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet).
-
-output_code_addrs_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
-output_code_addrs_decls([CodeAddress | CodeAddresses], FirstIndent, LaterIndent,
- N0, N, DeclSet0, DeclSet) -->
- output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent, N0, N1,
- DeclSet0, DeclSet1),
- output_code_addrs_decls(CodeAddresses, FirstIndent, LaterIndent, N1, N,
- DeclSet1, DeclSet).
-
-output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- ( { decl_set_is_member(code_addr(CodeAddress), DeclSet0) } ->
- { N = N0 },
- { DeclSet = DeclSet0 }
- ;
- { decl_set_insert(code_addr(CodeAddress), DeclSet0, DeclSet) },
- need_code_addr_decls(CodeAddress, NeedDecl),
- ( { NeedDecl = yes } ->
- output_indent(FirstIndent, LaterIndent, N0),
- { N = N0 + 1 },
- output_code_addr_decls(CodeAddress)
- ;
- { N = N0 }
+:- pred output_lval_decls(lval::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_lval_decls(Lval, !DeclSet, !IO) :-
+ output_lval_decls(Lval, "", "", 0, _, !DeclSet, !IO).
+
+:- pred output_lval_decls(lval::in, string::in, string::in, int::in, int::out,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_lval_decls(field(_, Rval, FieldNum), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO),
+ output_rval_decls(FieldNum, FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO).
+output_lval_decls(reg(_, _), _, _, !N, !DeclSet, !IO).
+output_lval_decls(stackvar(_), _, _, !N, !DeclSet, !IO).
+output_lval_decls(framevar(_), _, _, !N, !DeclSet, !IO).
+output_lval_decls(succip, _, _, !N, !DeclSet, !IO).
+output_lval_decls(maxfr, _, _, !N, !DeclSet, !IO).
+output_lval_decls(curfr, _, _, !N, !DeclSet, !IO).
+output_lval_decls(succfr(Rval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_lval_decls(prevfr(Rval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_lval_decls(redofr(Rval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_lval_decls(redoip(Rval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_lval_decls(succip(Rval), FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+output_lval_decls(hp, _, _, !N, !DeclSet, !IO).
+output_lval_decls(sp, _, _, !N, !DeclSet, !IO).
+output_lval_decls(lvar(_), _, _, !N, !DeclSet, !IO).
+output_lval_decls(temp(_, _), _, _, !N, !DeclSet, !IO).
+output_lval_decls(mem_ref(Rval), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO) :-
+ output_rval_decls(Rval, FirstIndent, LaterIndent, !N, !DeclSet, !IO).
+
+output_code_addr_decls(CodeAddress, !DeclSet, !IO) :-
+ output_code_addr_decls(CodeAddress, "", "", 0, _, !DeclSet, !IO).
+
+:- pred output_code_addr_decls(code_addr::in, string::in, string::in,
+ int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_code_addr_decls(CodeAddress, FirstIndent, LaterIndent, !N, !DeclSet,
+ !IO) :-
+ ( decl_set_is_member(code_addr(CodeAddress), !.DeclSet) ->
+ true
+ ;
+ decl_set_insert(code_addr(CodeAddress), !DeclSet),
+ need_code_addr_decls(CodeAddress, NeedDecl, !IO),
+ ( NeedDecl = yes ->
+ output_indent(FirstIndent, LaterIndent, !.N, !IO),
+ !:N = !.N + 1,
+ output_code_addr_decls(CodeAddress, !IO)
+ ;
+ true
)
).
-:- pred need_code_addr_decls(code_addr, bool, io__state, io__state).
-:- mode need_code_addr_decls(in, out, di, uo) is det.
+:- pred need_code_addr_decls(code_addr::in, bool::out,
+ io__state::di, io__state::uo) is det.
-need_code_addr_decls(label(Label), Need) -->
- {
+need_code_addr_decls(label(Label), Need, !IO) :-
+ (
Label = exported(_),
Need = yes
;
@@ -2573,132 +2442,137 @@
;
Label = local(_, _),
Need = no
- }.
-need_code_addr_decls(imported(_), yes) --> [].
-need_code_addr_decls(succip, no) --> [].
-need_code_addr_decls(do_succeed(_), no) --> [].
-need_code_addr_decls(do_redo, NeedDecl) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes },
- { NeedDecl = no }
- ;
- { UseMacro = no },
- { NeedDecl = yes }
- ).
-need_code_addr_decls(do_fail, NeedDecl) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes },
- { NeedDecl = no }
- ;
- { UseMacro = no },
- { NeedDecl = yes }
- ).
-need_code_addr_decls(do_trace_redo_fail_shallow, yes) --> [].
-need_code_addr_decls(do_trace_redo_fail_deep, yes) --> [].
-need_code_addr_decls(do_call_closure, yes) --> [].
-need_code_addr_decls(do_call_class_method, yes) --> [].
-need_code_addr_decls(do_not_reached, yes) --> [].
-
-:- pred output_code_addr_decls(code_addr, io__state, io__state).
-:- mode output_code_addr_decls(in, di, uo) is det.
-
-output_code_addr_decls(label(Label)) -->
- output_label_as_code_addr_decls(Label).
-output_code_addr_decls(imported(ProcLabel)) -->
- io__write_string("MR_declare_entry("),
- output_proc_label(ProcLabel),
- io__write_string(");\n").
-output_code_addr_decls(succip) --> [].
-output_code_addr_decls(do_succeed(_)) --> [].
-output_code_addr_decls(do_redo) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes }
- ;
- { UseMacro = no },
- io__write_string("MR_declare_entry("),
- io__write_string("MR_do_redo"),
- io__write_string(");\n")
- ).
-output_code_addr_decls(do_fail) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes }
- ;
- { UseMacro = no },
- io__write_string("MR_declare_entry("),
- io__write_string("MR_do_fail"),
- io__write_string(");\n")
- ).
-output_code_addr_decls(do_trace_redo_fail_shallow) -->
- io__write_string("MR_declare_entry(MR_do_trace_redo_fail_shallow);\n").
-output_code_addr_decls(do_trace_redo_fail_deep) -->
- io__write_string("MR_declare_entry(MR_do_trace_redo_fail_deep);\n").
-output_code_addr_decls(do_call_closure) -->
- io__write_string("MR_declare_entry(mercury__do_call_closure);\n").
-output_code_addr_decls(do_call_class_method) -->
- io__write_string("MR_declare_entry(mercury__do_call_class_method);\n").
-output_code_addr_decls(do_not_reached) -->
- io__write_string("MR_declare_entry(MR_do_not_reached);\n").
+ ).
+need_code_addr_decls(imported(_), yes, !IO).
+need_code_addr_decls(succip, no, !IO).
+need_code_addr_decls(do_succeed(_), no, !IO).
+need_code_addr_decls(do_redo, NeedDecl, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes,
+ NeedDecl = no
+ ;
+ UseMacro = no,
+ NeedDecl = yes
+ ).
+need_code_addr_decls(do_fail, NeedDecl, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes,
+ NeedDecl = no
+ ;
+ UseMacro = no,
+ NeedDecl = yes
+ ).
+need_code_addr_decls(do_trace_redo_fail_shallow, yes, !IO).
+need_code_addr_decls(do_trace_redo_fail_deep, yes, !IO).
+need_code_addr_decls(do_call_closure, yes, !IO).
+need_code_addr_decls(do_call_class_method, yes, !IO).
+need_code_addr_decls(do_not_reached, yes, !IO).
-:- pred output_label_as_code_addr_decls(label, io__state, io__state).
-:- mode output_label_as_code_addr_decls(in, di, uo) is det.
+:- pred output_code_addr_decls(code_addr::in, io__state::di, io__state::uo)
+ is det.
-output_label_as_code_addr_decls(exported(ProcLabel)) -->
- io__write_string("MR_declare_entry("),
- output_label(exported(ProcLabel)),
- io__write_string(");\n").
-output_label_as_code_addr_decls(local(ProcLabel)) -->
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
- ( { SplitFiles = no } ->
- []
+output_code_addr_decls(label(Label), !IO) :-
+ output_label_as_code_addr_decls(Label, !IO).
+output_code_addr_decls(imported(ProcLabel), !IO) :-
+ io__write_string("MR_declare_entry(", !IO),
+ output_proc_label(ProcLabel, !IO),
+ io__write_string(");\n", !IO).
+output_code_addr_decls(succip, !IO).
+output_code_addr_decls(do_succeed(_), !IO).
+output_code_addr_decls(do_redo, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes
+ ;
+ UseMacro = no,
+ io__write_string("MR_declare_entry(", !IO),
+ io__write_string("MR_do_redo", !IO),
+ io__write_string(");\n", !IO)
+ ).
+output_code_addr_decls(do_fail, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes
+ ;
+ UseMacro = no,
+ io__write_string("MR_declare_entry(", !IO),
+ io__write_string("MR_do_fail", !IO),
+ io__write_string(");\n", !IO)
+ ).
+output_code_addr_decls(do_trace_redo_fail_shallow, !IO) :-
+ io__write_string("MR_declare_entry(MR_do_trace_redo_fail_shallow);\n",
+ !IO).
+output_code_addr_decls(do_trace_redo_fail_deep, !IO) :-
+ io__write_string("MR_declare_entry(MR_do_trace_redo_fail_deep);\n",
+ !IO).
+output_code_addr_decls(do_call_closure, !IO) :-
+ io__write_string("MR_declare_entry(mercury__do_call_closure);\n", !IO).
+output_code_addr_decls(do_call_class_method, !IO) :-
+ io__write_string("MR_declare_entry(mercury__do_call_class_method);\n",
+ !IO).
+output_code_addr_decls(do_not_reached, !IO) :-
+ io__write_string("MR_declare_entry(MR_do_not_reached);\n", !IO).
+
+:- pred output_label_as_code_addr_decls(label::in,
+ io__state::di, io__state::uo) is det.
+
+output_label_as_code_addr_decls(exported(ProcLabel), !IO) :-
+ io__write_string("MR_declare_entry(", !IO),
+ output_label(exported(ProcLabel), !IO),
+ io__write_string(");\n", !IO).
+output_label_as_code_addr_decls(local(ProcLabel), !IO) :-
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
+ ( SplitFiles = no ->
+ true
;
- io__write_string("MR_declare_entry("),
- output_label(local(ProcLabel)),
- io__write_string(");\n")
- ).
-output_label_as_code_addr_decls(c_local(_)) --> [].
-output_label_as_code_addr_decls(local(_, _)) --> [].
-
-output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, N0, N,
- DeclSet0, DeclSet) -->
- ( { decl_set_is_member(data_addr(DataAddr), DeclSet0) } ->
- { N = N0 },
- { DeclSet = DeclSet0 }
- ;
- { decl_set_insert(data_addr(DataAddr), DeclSet0, DeclSet) },
- output_data_addr_decls_2(DataAddr,
- FirstIndent, LaterIndent, N0, N)
+ io__write_string("MR_declare_entry(", !IO),
+ output_label(local(ProcLabel), !IO),
+ io__write_string(");\n", !IO)
+ ).
+output_label_as_code_addr_decls(c_local(_), !IO).
+output_label_as_code_addr_decls(local(_, _), !IO).
+
+output_data_addr_decls(DataAddr, !DeclSet, !IO) :-
+ output_data_addr_decls(DataAddr, "", "", 0, _, !DeclSet, !IO).
+
+output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, !N, !DeclSet,
+ !IO) :-
+ ( decl_set_is_member(data_addr(DataAddr), !.DeclSet) ->
+ true
+ ;
+ decl_set_insert(data_addr(DataAddr), !DeclSet),
+ output_data_addr_decls_2(DataAddr, FirstIndent, LaterIndent,
+ !N, !IO)
).
:- pred output_data_addr_decls_2(data_addr::in, string::in, string::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_data_addr_decls_2(DataAddr, FirstIndent, LaterIndent, N0, N) -->
- output_indent(FirstIndent, LaterIndent, N0),
- { N = N0 + 1 },
+output_data_addr_decls_2(DataAddr, FirstIndent, LaterIndent, !N, !IO) :-
+ output_indent(FirstIndent, LaterIndent, !.N, !IO),
+ !:N = !.N + 1,
(
- { DataAddr = data_addr(ModuleName, DataVarName) },
+ DataAddr = data_addr(ModuleName, DataVarName),
output_data_addr_storage_type_name(ModuleName, DataVarName, no,
- LaterIndent)
+ LaterIndent, !IO)
;
- { DataAddr = rtti_addr(RttiId) },
- output_rtti_id_storage_type_name(RttiId, no)
+ DataAddr = rtti_addr(RttiId),
+ output_rtti_id_storage_type_name(RttiId, no, !IO)
;
- { DataAddr = layout_addr(LayoutName) },
- output_layout_name_storage_type_name(LayoutName, no)
+ DataAddr = layout_addr(LayoutName),
+ output_layout_name_storage_type_name(LayoutName, no, !IO)
),
- io__write_string(";\n").
-
-output_data_addrs_decls([], _, _, N, N, DeclSet, DeclSet) --> [].
-output_data_addrs_decls([DataAddr | DataAddrs], FirstIndent, LaterIndent,
- N0, N, DeclSet0, DeclSet) -->
- output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, N0, N1,
- DeclSet0, DeclSet1),
- output_data_addrs_decls(DataAddrs, FirstIndent, LaterIndent, N1, N,
- DeclSet1, DeclSet).
+ io__write_string(";\n", !IO).
+
+output_data_addrs_decls([], _, _, !N, !DeclSet, !IO).
+output_data_addrs_decls([DataAddr | DataAddrs], FirstIndent, LaterIndent, !N,
+ !DeclSet, !IO) :-
+ output_data_addr_decls(DataAddr, FirstIndent, LaterIndent, !N,
+ !DeclSet, !IO),
+ output_data_addrs_decls(DataAddrs, FirstIndent, LaterIndent, !N,
+ !DeclSet, !IO).
c_data_linkage_string(Globals, DefaultLinkage, StaticEvenIfSplit, BeingDefined)
= LinkageStr :-
@@ -2746,25 +2620,23 @@
bool::in, string::in, io__state::di, io__state::uo) is det.
output_data_addr_storage_type_name(ModuleName, DataVarName, BeingDefined,
- LaterIndent) -->
- { data_name_linkage(DataVarName, Linkage) },
- globals__io_get_globals(Globals),
- { LinkageStr = c_data_linkage_string(Globals, Linkage, no,
- BeingDefined) },
- io__write_string(LinkageStr),
-
- { InclCodeAddr =
- data_name_may_include_non_static_code_address(
- DataVarName) },
- { c_data_const_string(Globals, InclCodeAddr, ConstStr) },
- io__write_string(ConstStr),
-
- io__write_string("struct "),
- output_data_addr(ModuleName, DataVarName),
- io__write_string("_struct\n"),
- io__write_string(LaterIndent),
- io__write_string("\t"),
- output_data_addr(ModuleName, DataVarName).
+ LaterIndent, !IO) :-
+ data_name_linkage(DataVarName, Linkage),
+ globals__io_get_globals(Globals, !IO),
+ LinkageStr = c_data_linkage_string(Globals, Linkage, no, BeingDefined),
+ io__write_string(LinkageStr, !IO),
+
+ InclCodeAddr = data_name_may_include_non_static_code_address(
+ DataVarName),
+ c_data_const_string(Globals, InclCodeAddr, ConstStr),
+ io__write_string(ConstStr, !IO),
+
+ io__write_string("struct ", !IO),
+ output_data_addr(ModuleName, DataVarName, !IO),
+ io__write_string("_struct\n", !IO),
+ io__write_string(LaterIndent, !IO),
+ io__write_string("\t", !IO),
+ output_data_addr(ModuleName, DataVarName, !IO).
:- pred data_name_linkage(data_name::in, linkage::out) is det.
@@ -2773,137 +2645,140 @@
%-----------------------------------------------------------------------------%
-:- pred output_indent(string, string, int, io__state, io__state).
-:- mode output_indent(in, in, in, di, uo) is det.
+:- pred output_indent(string::in, string::in, int::in,
+ io__state::di, io__state::uo) is det.
-output_indent(FirstIndent, LaterIndent, N0) -->
- ( { N0 > 0 } ->
- io__write_string(LaterIndent)
+output_indent(FirstIndent, LaterIndent, N0, !IO) :-
+ ( N0 > 0 ->
+ io__write_string(LaterIndent, !IO)
;
- io__write_string(FirstIndent)
+ io__write_string(FirstIndent, !IO)
).
%-----------------------------------------------------------------------------%
-:- pred maybe_output_update_prof_counter(label,
- pair(label, bintree_set(label)), io__state, io__state).
-:- mode maybe_output_update_prof_counter(in, in, di, uo) is det.
+:- pred maybe_output_update_prof_counter(label::in,
+ pair(label, bintree_set(label))::in,
+ io__state::di, io__state::uo) is det.
-maybe_output_update_prof_counter(Label, CallerLabel - ContLabelSet) -->
- (
- { bintree_set__is_member(Label, ContLabelSet) }
- ->
- io__write_string("\tMR_update_prof_current_proc(MR_LABEL("),
- output_label(CallerLabel),
- io__write_string("));\n")
+maybe_output_update_prof_counter(Label, CallerLabel - ContLabelSet, !IO) :-
+ ( bintree_set__is_member(Label, ContLabelSet) ->
+ io__write_string("\tMR_update_prof_current_proc(MR_LABEL(",
+ !IO),
+ output_label(CallerLabel, !IO),
+ io__write_string("));\n", !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
-:- pred output_goto(code_addr, label, io__state, io__state).
-:- mode output_goto(in, in, di, uo) is det.
+:- pred output_goto(code_addr::in, label::in,
+ io__state::di, io__state::uo) is det.
% Note that we do some optimization here:
% instead of always outputting `MR_GOTO(<label>)', we
% output different things for each different kind of label.
-output_goto(label(Label), CallerLabel) -->
+output_goto(label(Label), CallerLabel, !IO) :-
(
- { Label = exported(_) },
- io__write_string("MR_tailcall("),
- output_label_as_code_addr(Label),
- io__write_string(",\n\t\t"),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n")
- ;
- { Label = local(_) },
- io__write_string("MR_tailcall("),
- output_label_as_code_addr(Label),
- io__write_string(",\n\t\t"),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n")
+ Label = exported(_),
+ io__write_string("MR_tailcall(", !IO),
+ output_label_as_code_addr(Label, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n", !IO)
;
- { Label = c_local(_) },
- io__write_string("MR_localtailcall("),
- output_label(Label),
- io__write_string(",\n\t\t"),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n")
+ Label = local(_),
+ io__write_string("MR_tailcall(", !IO),
+ output_label_as_code_addr(Label, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n", !IO)
;
- { Label = local(_, _) },
- io__write_string("MR_GOTO_LABEL("),
- output_label(Label),
- io__write_string(");\n")
- ).
-output_goto(imported(ProcLabel), CallerLabel) -->
- io__write_string("MR_tailcall(MR_ENTRY("),
- output_proc_label(ProcLabel),
- io__write_string("),\n\t\t"),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n").
-output_goto(succip, _) -->
- io__write_string("MR_proceed();\n").
-output_goto(do_succeed(Last), _) -->
- (
- { Last = no },
- io__write_string("MR_succeed();\n")
- ;
- { Last = yes },
- io__write_string("MR_succeed_discard();\n")
- ).
-output_goto(do_redo, _) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes },
- io__write_string("MR_redo();\n")
- ;
- { UseMacro = no },
- io__write_string("MR_GOTO(MR_ENTRY(MR_do_redo));\n")
- ).
-output_goto(do_fail, _) -->
- globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro),
- (
- { UseMacro = yes },
- io__write_string("MR_fail();\n")
- ;
- { UseMacro = no },
- io__write_string("MR_GOTO(MR_ENTRY(MR_do_fail));\n")
- ).
-output_goto(do_trace_redo_fail_shallow, _) -->
- io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_shallow));\n").
-output_goto(do_trace_redo_fail_deep, _) -->
- io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_deep));\n").
-output_goto(do_call_closure, CallerLabel) -->
+ Label = c_local(_),
+ io__write_string("MR_localtailcall(", !IO),
+ output_label(Label, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n", !IO)
+ ;
+ Label = local(_, _),
+ io__write_string("MR_GOTO_LABEL(", !IO),
+ output_label(Label, !IO),
+ io__write_string(");\n", !IO)
+ ).
+output_goto(imported(ProcLabel), CallerLabel, !IO) :-
+ io__write_string("MR_tailcall(MR_ENTRY(", !IO),
+ output_proc_label(ProcLabel, !IO),
+ io__write_string("),\n\t\t", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n", !IO).
+output_goto(succip, _, !IO) :-
+ io__write_string("MR_proceed();\n", !IO).
+output_goto(do_succeed(Last), _, !IO) :-
+ (
+ Last = no,
+ io__write_string("MR_succeed();\n", !IO)
+ ;
+ Last = yes,
+ io__write_string("MR_succeed_discard();\n", !IO)
+ ).
+output_goto(do_redo, _, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes,
+ io__write_string("MR_redo();\n", !IO)
+ ;
+ UseMacro = no,
+ io__write_string("MR_GOTO(MR_ENTRY(MR_do_redo));\n", !IO)
+ ).
+output_goto(do_fail, _, !IO) :-
+ globals__io_lookup_bool_option(use_macro_for_redo_fail, UseMacro, !IO),
+ (
+ UseMacro = yes,
+ io__write_string("MR_fail();\n", !IO)
+ ;
+ UseMacro = no,
+ io__write_string("MR_GOTO(MR_ENTRY(MR_do_fail));\n", !IO)
+ ).
+output_goto(do_trace_redo_fail_shallow, _, !IO) :-
+ io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_shallow));\n",
+ !IO).
+output_goto(do_trace_redo_fail_deep, _, !IO) :-
+ io__write_string("MR_GOTO(MR_ENTRY(MR_do_trace_redo_fail_deep));\n",
+ !IO).
+output_goto(do_call_closure, CallerLabel, !IO) :-
% see comment in output_call for why we use `noprof_' etc. here
- io__write_string("MR_set_prof_ho_caller_proc("),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n\t\t"),
+ io__write_string("MR_set_prof_ho_caller_proc(", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n\t\t", !IO),
io__write_string(
- "MR_noprof_tailcall(MR_ENTRY(mercury__do_call_closure));\n").
-output_goto(do_call_class_method, CallerLabel) -->
+ "MR_noprof_tailcall(MR_ENTRY(mercury__do_call_closure));\n",
+ !IO).
+output_goto(do_call_class_method, CallerLabel, !IO) :-
% see comment in output_call for why we use `noprof_' etc. here
- io__write_string("MR_set_prof_ho_caller_proc("),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n\t\t"),
- io__write_string(
- "MR_noprof_tailcall(MR_ENTRY(mercury__do_call_class_method));\n").
-output_goto(do_not_reached, CallerLabel) -->
- io__write_string("MR_tailcall(MR_ENTRY(MR_do_not_reached),\n\t\t"),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n").
+ io__write_string("MR_set_prof_ho_caller_proc(", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n\t\t", !IO),
+ io__write_string("MR_noprof_tailcall(" ++
+ "MR_ENTRY(mercury__do_call_class_method));\n", !IO).
+output_goto(do_not_reached, CallerLabel, !IO) :-
+ io__write_string("MR_tailcall(MR_ENTRY(MR_do_not_reached),\n\t\t",
+ !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n", !IO).
% Note that we also do some optimization here by
% outputting `localcall' rather than `call' for
% calls to local labels, or `call_localret' for
% calls which return to local labels (i.e. most of them).
-:- pred output_call(code_addr, code_addr, label, io__state, io__state).
-:- mode output_call(in, in, in, di, uo) is det.
+:- pred output_call(code_addr::in, code_addr::in, label::in,
+ io__state::di, io__state::uo) is det.
-output_call(Target, Continuation, CallerLabel) -->
- io__write_string("\t"),
+output_call(Target, Continuation, CallerLabel, !IO) :-
+ io__write_string("\t", !IO),
% For profiling, we ignore calls to do_call_closure
% and do_call_class_method, because in general they
% lead to cycles in the call graph that screw up the
@@ -2915,93 +2790,97 @@
% MR_prof_ho_caller_proc, so that the callee knows
% which proc it has been called from.
(
- { Target = do_call_closure
+ ( Target = do_call_closure
; Target = do_call_class_method
- }
+ )
->
- { ProfileCall = no },
- io__write_string("MR_set_prof_ho_caller_proc("),
- output_label_as_code_addr(CallerLabel),
- io__write_string(");\n\t"),
- io__write_string("MR_noprof_")
+ ProfileCall = no,
+ io__write_string("MR_set_prof_ho_caller_proc(", !IO),
+ output_label_as_code_addr(CallerLabel, !IO),
+ io__write_string(");\n\t", !IO),
+ io__write_string("MR_noprof_", !IO)
;
- { ProfileCall = yes },
- io__write_string("MR_")
+ ProfileCall = yes,
+ io__write_string("MR_", !IO)
),
(
- { Target = label(Label) },
+ Target = label(Label),
% We really shouldn't be calling internal labels ...
- { Label = c_local(_) ; Label = local(_, _) }
+ ( Label = c_local(_)
+ ; Label = local(_, _)
+ )
->
- io__write_string("localcall("),
- output_label(Label),
- io__write_string(",\n\t\t"),
- output_code_addr(Continuation)
+ io__write_string("localcall(", !IO),
+ output_label(Label, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_code_addr(Continuation, !IO)
;
- { Continuation = label(ContLabel) },
- { ContLabel = c_local(_) ; ContLabel = local(_, _) }
+ Continuation = label(ContLabel),
+ ( ContLabel = c_local(_)
+ ; ContLabel = local(_, _)
+ )
->
- io__write_string("call_localret("),
- output_code_addr(Target),
- io__write_string(",\n\t\t"),
- output_label(ContLabel)
+ io__write_string("call_localret(", !IO),
+ output_code_addr(Target, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_label(ContLabel, !IO)
;
- io__write_string("call("),
- output_code_addr(Target),
- io__write_string(",\n\t\t"),
- output_code_addr(Continuation)
+ io__write_string("call(", !IO),
+ output_code_addr(Target, !IO),
+ io__write_string(",\n\t\t", !IO),
+ output_code_addr(Continuation, !IO)
),
- ( { ProfileCall = yes } ->
- io__write_string(",\n\t\t"),
- output_label_as_code_addr(CallerLabel)
+ ( ProfileCall = yes ->
+ io__write_string(",\n\t\t", !IO),
+ output_label_as_code_addr(CallerLabel, !IO)
;
- []
+ true
),
- io__write_string(");\n").
+ io__write_string(");\n", !IO).
-output_code_addr(label(Label)) -->
- output_label_as_code_addr(Label).
-output_code_addr(imported(ProcLabel)) -->
- io__write_string("MR_ENTRY("),
- output_proc_label(ProcLabel),
- io__write_string(")").
-output_code_addr(succip) -->
- io__write_string("MR_succip").
-output_code_addr(do_succeed(Last)) -->
- (
- { Last = no },
- io__write_string("MR_ENTRY(MR_do_succeed)")
- ;
- { Last = yes },
- io__write_string("MR_ENTRY(MR_do_last_succeed)")
- ).
-output_code_addr(do_redo) -->
- io__write_string("MR_ENTRY(MR_do_redo)").
-output_code_addr(do_fail) -->
- io__write_string("MR_ENTRY(MR_do_fail)").
-output_code_addr(do_trace_redo_fail_shallow) -->
- io__write_string("MR_ENTRY(MR_do_trace_redo_fail_shallow)").
-output_code_addr(do_trace_redo_fail_deep) -->
- io__write_string("MR_ENTRY(MR_do_trace_redo_fail_deep)").
-output_code_addr(do_call_closure) -->
- io__write_string("MR_ENTRY(mercury__do_call_closure)").
-output_code_addr(do_call_class_method) -->
- io__write_string("MR_ENTRY(mercury__do_call_class_method)").
-output_code_addr(do_not_reached) -->
- io__write_string("MR_ENTRY(MR_do_not_reached)").
+output_code_addr(label(Label), !IO) :-
+ output_label_as_code_addr(Label, !IO).
+output_code_addr(imported(ProcLabel), !IO) :-
+ io__write_string("MR_ENTRY(", !IO),
+ output_proc_label(ProcLabel, !IO),
+ io__write_string(")", !IO).
+output_code_addr(succip, !IO) :-
+ io__write_string("MR_succip", !IO).
+output_code_addr(do_succeed(Last), !IO) :-
+ (
+ Last = no,
+ io__write_string("MR_ENTRY(MR_do_succeed)", !IO)
+ ;
+ Last = yes,
+ io__write_string("MR_ENTRY(MR_do_last_succeed)", !IO)
+ ).
+output_code_addr(do_redo, !IO) :-
+ io__write_string("MR_ENTRY(MR_do_redo)", !IO).
+output_code_addr(do_fail, !IO) :-
+ io__write_string("MR_ENTRY(MR_do_fail)", !IO).
+output_code_addr(do_trace_redo_fail_shallow, !IO) :-
+ io__write_string("MR_ENTRY(MR_do_trace_redo_fail_shallow)", !IO).
+output_code_addr(do_trace_redo_fail_deep, !IO) :-
+ io__write_string("MR_ENTRY(MR_do_trace_redo_fail_deep)", !IO).
+output_code_addr(do_call_closure, !IO) :-
+ io__write_string("MR_ENTRY(mercury__do_call_closure)", !IO).
+output_code_addr(do_call_class_method, !IO) :-
+ io__write_string("MR_ENTRY(mercury__do_call_class_method)", !IO).
+output_code_addr(do_not_reached, !IO) :-
+ io__write_string("MR_ENTRY(MR_do_not_reached)", !IO).
% Output a maybe data address, with a `no' meaning NULL.
:- pred output_maybe_data_addr(maybe(data_addr)::in,
io__state::di, io__state::uo) is det.
-output_maybe_data_addr(MaybeDataAddr) -->
+output_maybe_data_addr(MaybeDataAddr, !IO) :-
(
- { MaybeDataAddr = yes(DataAddr) },
- output_data_addr(DataAddr)
+ MaybeDataAddr = yes(DataAddr),
+ output_data_addr(DataAddr, !IO)
;
- { MaybeDataAddr = no },
- io__write_string("NULL")
+ MaybeDataAddr = no,
+ io__write_string("NULL", !IO)
).
% Output a list of maybe data addresses, with a `no' meaning NULL.
@@ -3009,62 +2888,61 @@
:- pred output_maybe_data_addrs(list(maybe(data_addr))::in,
io__state::di, io__state::uo) is det.
-output_maybe_data_addrs([]) --> [].
-output_maybe_data_addrs([MaybeDataAddr | MaybeDataAddrs]) -->
- io__write_string("\t"),
+output_maybe_data_addrs([], !IO).
+output_maybe_data_addrs([MaybeDataAddr | MaybeDataAddrs], !IO) :-
+ io__write_string("\t", !IO),
io__write_list([MaybeDataAddr | MaybeDataAddrs], ",\n\t",
- output_maybe_data_addr),
- io__write_string("\n").
+ output_maybe_data_addr, !IO),
+ io__write_string("\n", !IO).
% Output a list of data addresses.
:- pred output_data_addrs(list(data_addr)::in, io__state::di, io__state::uo)
is det.
-output_data_addrs([]) --> [].
-output_data_addrs([DataAddr | DataAddrs]) -->
- io__write_string("\t"),
- io__write_list([DataAddr | DataAddrs], ",\n\t",
- output_data_addr),
- io__write_string("\n").
+output_data_addrs([], !IO).
+output_data_addrs([DataAddr | DataAddrs], !IO) :-
+ io__write_string("\t", !IO),
+ io__write_list([DataAddr | DataAddrs], ",\n\t", output_data_addr, !IO),
+ io__write_string("\n", !IO).
% Output a data address.
-output_data_addr(data_addr(ModuleName, DataName)) -->
- output_data_addr(ModuleName, DataName).
-output_data_addr(rtti_addr(RttiId)) -->
- output_rtti_id(RttiId).
-output_data_addr(layout_addr(LayoutName)) -->
- output_layout_name(LayoutName).
+output_data_addr(data_addr(ModuleName, DataName), !IO) :-
+ output_data_addr(ModuleName, DataName, !IO).
+output_data_addr(rtti_addr(RttiId), !IO) :-
+ output_rtti_id(RttiId, !IO).
+output_data_addr(layout_addr(LayoutName), !IO) :-
+ output_layout_name(LayoutName, !IO).
:- pred output_data_addr(module_name::in, data_name::in,
io__state::di, io__state::uo) is det.
-output_data_addr(ModuleName, VarName) -->
+output_data_addr(ModuleName, VarName, !IO) :-
(
- { VarName = common(CellNum, _TypeNum) },
- { MangledModuleName = sym_name_mangle(ModuleName) },
- io__write_string(mercury_data_prefix),
- io__write_string(MangledModuleName),
- io__write_string("__common_"),
- io__write_int(CellNum)
+ VarName = common(CellNum, _TypeNum),
+ MangledModuleName = sym_name_mangle(ModuleName),
+ io__write_string(mercury_data_prefix, !IO),
+ io__write_string(MangledModuleName, !IO),
+ io__write_string("__common_", !IO),
+ io__write_int(CellNum, !IO)
;
- { VarName = tabling_pointer(ProcLabel) },
- output_tabling_pointer_var_name(ProcLabel)
+ VarName = tabling_pointer(ProcLabel),
+ output_tabling_pointer_var_name(ProcLabel, !IO)
).
:- pred output_common_cell_type_name(module_name::in, int::in,
io__state::di, io__state::uo) is det.
-output_common_cell_type_name(ModuleName, TypeNum) -->
- { MangledModuleName = sym_name_mangle(ModuleName) },
- io__write_string(mercury_data_prefix),
- io__write_string(MangledModuleName),
- io__write_string("__common_type_"),
- io__write_int(TypeNum).
+output_common_cell_type_name(ModuleName, TypeNum, !IO) :-
+ MangledModuleName = sym_name_mangle(ModuleName),
+ io__write_string(mercury_data_prefix, !IO),
+ io__write_string(MangledModuleName, !IO),
+ io__write_string("__common_type_", !IO),
+ io__write_int(TypeNum, !IO).
-:- pred output_label_as_code_addr(label, io__state, io__state).
-:- mode output_label_as_code_addr(in, di, uo) is det.
+:- pred output_label_as_code_addr(label::in, io__state::di, io__state::uo)
+ is det.
output_label_as_code_addr(exported(ProcLabel)) -->
io__write_string("MR_ENTRY("),
@@ -3083,58 +2961,57 @@
output_label(local(N, ProcLabel)),
io__write_string(")").
-:- pred output_label_list(list(label), io__state, io__state).
-:- mode output_label_list(in, di, uo) is det.
-
-output_label_list([]) --> [].
-output_label_list([Label | Labels]) -->
- io__write_string("MR_LABEL("),
- output_label(Label),
- io__write_string(")"),
- output_label_list_2(Labels).
-
-:- pred output_label_list_2(list(label), io__state, io__state).
-:- mode output_label_list_2(in, di, uo) is det.
+:- pred output_label_list(list(label)::in, io__state::di, io__state::uo)
+ is det.
-output_label_list_2([]) --> [].
-output_label_list_2([Label | Labels]) -->
- io__write_string(" MR_AND\n\t\t"),
- io__write_string("MR_LABEL("),
- output_label(Label),
- io__write_string(")"),
- output_label_list_2(Labels).
+output_label_list([], !IO).
+output_label_list([Label | Labels], !IO) :-
+ io__write_string("MR_LABEL(", !IO),
+ output_label(Label, !IO),
+ io__write_string(")", !IO),
+ output_label_list_2(Labels, !IO).
-:- pred output_label_defn(label, io__state, io__state).
-:- mode output_label_defn(in, di, uo) is det.
+:- pred output_label_list_2(list(label)::in, io__state::di, io__state::uo)
+ is det.
-output_label_defn(exported(ProcLabel)) -->
- io__write_string("MR_define_entry("),
- output_label(exported(ProcLabel)),
- io__write_string(");\n").
-output_label_defn(local(ProcLabel)) -->
+output_label_list_2([], !IO).
+output_label_list_2([Label | Labels], !IO) :-
+ io__write_string(" MR_AND\n\t\t", !IO),
+ io__write_string("MR_LABEL(", !IO),
+ output_label(Label, !IO),
+ io__write_string(")", !IO),
+ output_label_list_2(Labels, !IO).
+
+:- pred output_label_defn(label::in, io__state::di, io__state::uo) is det.
+
+output_label_defn(exported(ProcLabel), !IO) :-
+ io__write_string("MR_define_entry(", !IO),
+ output_label(exported(ProcLabel), !IO),
+ io__write_string(");\n", !IO).
+output_label_defn(local(ProcLabel), !IO) :-
% The code for procedures local to a Mercury module
% should normally be visible only within the C file
% generated for that module. However, if we generate
% multiple C files, the code in each C file must be
% visible to the other C files for that Mercury module.
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
- ( { SplitFiles = no } ->
- io__write_string("MR_define_static("),
- output_label(local(ProcLabel)),
- io__write_string(");\n")
- ;
- io__write_string("MR_define_entry("),
- output_label(local(ProcLabel)),
- io__write_string(");\n")
- ).
-output_label_defn(c_local(ProcLabel)) -->
- io__write_string("MR_define_local("),
- output_label(c_local(ProcLabel)),
- io__write_string(");\n").
-output_label_defn(local(Num, ProcLabel)) -->
- io__write_string("MR_define_label("),
- output_label(local(Num, ProcLabel)),
- io__write_string(");\n").
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
+ ( SplitFiles = no ->
+ io__write_string("MR_define_static(", !IO),
+ output_label(local(ProcLabel), !IO),
+ io__write_string(");\n", !IO)
+ ;
+ io__write_string("MR_define_entry(", !IO),
+ output_label(local(ProcLabel), !IO),
+ io__write_string(");\n", !IO)
+ ).
+output_label_defn(c_local(ProcLabel), !IO) :-
+ io__write_string("MR_define_local(", !IO),
+ output_label(c_local(ProcLabel), !IO),
+ io__write_string(");\n", !IO).
+output_label_defn(local(Num, ProcLabel), !IO) :-
+ io__write_string("MR_define_label(", !IO),
+ output_label(local(Num, ProcLabel), !IO),
+ io__write_string(");\n", !IO).
% Note that the suffixes _l and _iN used to be interpreted by mod2c,
% which generated different code depending on the suffix.
@@ -3144,9 +3021,9 @@
% is referred to as local(_) in type_info structures and as c_local(_)
% in the recursive call.
-output_label(Label) -->
- { LabelStr = llds_out__label_to_c_string(Label, yes) },
- io__write_string(LabelStr).
+output_label(Label, !IO) :-
+ LabelStr = llds_out__label_to_c_string(Label, yes),
+ io__write_string(LabelStr, !IO).
llds_out__label_to_c_string(exported(ProcLabel), AddPrefix) =
proc_label_to_c_string(ProcLabel, AddPrefix).
@@ -3160,53 +3037,51 @@
string__append("_i", NumStr, NumSuffix),
string__append(ProcLabelStr, NumSuffix, LabelStr).
-:- pred output_reg(reg_type, int, io__state, io__state).
-:- mode output_reg(in, in, di, uo) is det.
+:- pred output_reg(reg_type::in, int::in, io__state::di, io__state::uo) is det.
-output_reg(r, N) -->
- { llds_out__reg_to_string(r, N, RegName) },
- io__write_string(RegName).
-output_reg(f, _) -->
- { error("Floating point registers not implemented") }.
-
-:- pred output_tag(tag, io__state, io__state).
-:- mode output_tag(in, di, uo) is det.
-
-output_tag(Tag) -->
- io__write_string("MR_mktag("),
- io__write_int(Tag),
- io__write_string(")").
+output_reg(r, N, !IO) :-
+ llds_out__reg_to_string(r, N, RegName),
+ io__write_string(RegName, !IO).
+output_reg(f, _, !IO) :-
+ error("Floating point registers not implemented").
+
+:- pred output_tag(tag::in, io__state::di, io__state::uo) is det.
+
+output_tag(Tag, !IO) :-
+ io__write_string("MR_mktag(", !IO),
+ io__write_int(Tag, !IO),
+ io__write_string(")", !IO).
% output an rval, converted to the specified type
%
-:- pred output_rval_as_type(rval, llds_type, io__state, io__state).
-:- mode output_rval_as_type(in, in, di, uo) is det.
+:- pred output_rval_as_type(rval::in, llds_type::in,
+ io__state::di, io__state::uo) is det.
-output_rval_as_type(Rval, DesiredType) -->
- { llds__rval_type(Rval, ActualType) },
- ( { types_match(DesiredType, ActualType) } ->
+output_rval_as_type(Rval, DesiredType, !IO) :-
+ llds__rval_type(Rval, ActualType),
+ ( types_match(DesiredType, ActualType) ->
% no casting needed
- output_rval(Rval)
+ output_rval(Rval, !IO)
;
% We need to convert to the right type first.
% Convertions to/from float must be treated specially;
% for the others, we can just use a cast.
- ( { DesiredType = float } ->
- io__write_string("MR_word_to_float("),
- output_rval(Rval),
- io__write_string(")")
- ; { ActualType = float } ->
- ( { DesiredType = word } ->
- output_float_rval_as_word(Rval)
- ; { DesiredType = data_ptr } ->
- output_float_rval_as_data_ptr(Rval)
+ ( DesiredType = float ->
+ io__write_string("MR_word_to_float(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO)
+ ; ActualType = float ->
+ ( DesiredType = word ->
+ output_float_rval_as_word(Rval, !IO)
+ ; DesiredType = data_ptr ->
+ output_float_rval_as_data_ptr(Rval, !IO)
;
- { error("output_rval_as_type: type error") }
+ error("output_rval_as_type: type error")
)
;
% cast value to desired type
- output_llds_type_cast(DesiredType),
- output_rval(Rval)
+ output_llds_type_cast(DesiredType, !IO),
+ output_rval(Rval, !IO)
)
).
@@ -3214,8 +3089,7 @@
% a value of type ActualType can be used as a value of
% type DesiredType without casting.
%
-:- pred types_match(llds_type, llds_type).
-:- mode types_match(in, in) is semidet.
+:- pred types_match(llds_type::in, llds_type::in) is semidet.
types_match(Type, Type).
types_match(word, unsigned).
@@ -3228,57 +3102,60 @@
% output a float rval, converted to type `MR_Word *'
%
-:- pred output_float_rval_as_data_ptr(rval, io__state, io__state).
-:- mode output_float_rval_as_data_ptr(in, di, uo) is det.
+:- pred output_float_rval_as_data_ptr(rval::in, io__state::di, io__state::uo)
+ is det.
-output_float_rval_as_data_ptr(Rval) -->
- %
- % for float constant expressions, if we're using boxed
- % boxed floats and --static-ground-terms is enabled,
- % we just refer to the static const which we declared
- % earlier
- %
- globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
- globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms),
- (
- { UnboxFloat = no, StaticGroundTerms = yes },
- { llds_out__float_const_expr_name(Rval, FloatName) }
- ->
- output_llds_type_cast(data_ptr),
- io__write_string("&mercury_float_const_"),
- io__write_string(FloatName)
- ;
- output_llds_type_cast(data_ptr),
- io__write_string("MR_float_to_word("),
- output_rval(Rval),
- io__write_string(")")
- ).
+output_float_rval_as_data_ptr(Rval, !IO) :-
+ output_float_rval(Rval, yes, !IO).
% output a float rval, converted to type `MR_Word'
%
-:- pred output_float_rval_as_word(rval, io__state, io__state).
-:- mode output_float_rval_as_word(in, di, uo) is det.
+:- pred output_float_rval_as_word(rval::in, io__state::di, io__state::uo)
+ is det.
-output_float_rval_as_word(Rval) -->
+output_float_rval_as_word(Rval, !IO) :-
+ output_float_rval(Rval, no, !IO).
+
+ % output a float rval, converted to type `MR_Word' or `MR_Word *'
+ %
+:- pred output_float_rval(rval::in, bool::in, io__state::di, io__state::uo)
+ is det.
+
+output_float_rval(Rval, IsPtr, !IO) :-
%
% for float constant expressions, if we're using boxed
% boxed floats and --static-ground-terms is enabled,
% we just refer to the static const which we declared
% earlier
%
- globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
- globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms),
+ globals__io_lookup_bool_option(unboxed_float, UnboxFloat, !IO),
+ globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms,
+ !IO),
(
- { UnboxFloat = no, StaticGroundTerms = yes },
- { llds_out__float_const_expr_name(Rval, FloatName) }
+ UnboxFloat = no,
+ StaticGroundTerms = yes,
+ llds_out__float_const_expr_name(Rval, FloatName)
->
- output_llds_type_cast(word),
- io__write_string("&mercury_float_const_"),
- io__write_string(FloatName)
+ (
+ IsPtr = yes,
+ Cast = data_ptr
;
- io__write_string("MR_float_to_word("),
- output_rval(Rval),
- io__write_string(")")
+ IsPtr = no,
+ Cast = word
+ ),
+ output_llds_type_cast(Cast, !IO),
+ io__write_string("&mercury_float_const_", !IO),
+ io__write_string(FloatName, !IO)
+ ;
+ (
+ IsPtr = yes,
+ output_llds_type_cast(data_ptr, !IO)
+ ;
+ IsPtr = no
+ ),
+ io__write_string("MR_float_to_word(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO)
).
output_rval(const(Const)) -->
@@ -3435,15 +3312,13 @@
io__write_string(")")
).
-:- pred output_unary_op(unary_op, io__state, io__state).
-:- mode output_unary_op(in, di, uo) is det.
+:- pred output_unary_op(unary_op::in, io__state::di, io__state::uo) is det.
output_unary_op(Op) -->
{ c_util__unary_prefix_op(Op, OpString) },
io__write_string(OpString).
-:- pred output_rval_const(rval_const, io__state, io__state).
-:- mode output_rval_const(in, di, uo) is det.
+:- pred output_rval_const(rval_const::in, io__state::di, io__state::uo) is det.
output_rval_const(int_const(N)) -->
% we need to cast to (Integer) to ensure
@@ -3500,8 +3375,7 @@
output_label(Label),
io__write_string(")").
-:- pred output_lval_as_word(lval, io__state, io__state).
-:- mode output_lval_as_word(in, di, uo) is det.
+:- pred output_lval_as_word(lval::in, io__state::di, io__state::uo) is det.
output_lval_as_word(Lval) -->
{ llds__lval_type(Lval, ActualType) },
@@ -3516,8 +3390,7 @@
io__write_string(")")
).
-:- pred output_lval(lval, io__state, io__state).
-:- mode output_lval(in, di, uo) is det.
+:- pred output_lval(lval::in, io__state::di, io__state::uo) is det.
output_lval(reg(Type, Num)) -->
output_reg(Type, Num).
@@ -3600,30 +3473,28 @@
%-----------------------------------------------------------------------------%
-:- pred output_set_line_num(prog_context, io__state, io__state).
-:- mode output_set_line_num(in, di, uo) is det.
+:- pred output_set_line_num(prog_context::in, io__state::di, io__state::uo)
+ is det.
-output_set_line_num(Context) -->
- { term__context_file(Context, File) },
- { term__context_line(Context, Line) },
- c_util__set_line_num(File, Line).
+output_set_line_num(Context, !IO) :-
+ term__context_file(Context, File),
+ term__context_line(Context, Line),
+ c_util__set_line_num(File, Line, !IO).
-:- pred output_reset_line_num(io__state, io__state).
-:- mode output_reset_line_num(di, uo) is det.
+:- pred output_reset_line_num(io__state::di, io__state::uo) is det.
-output_reset_line_num -->
- c_util__reset_line_num.
+output_reset_line_num(!IO) :-
+ c_util__reset_line_num(!IO).
%-----------------------------------------------------------------------------%
-:- pred output_binary_op(binary_op, io__state, io__state).
-:- mode output_binary_op(in, di, uo) is det.
+:- pred output_binary_op(binary_op::in, io__state::di, io__state::uo) is det.
-output_binary_op(Op) -->
- ( { c_util__binary_infix_op(Op, String) } ->
- io__write_string(String)
+output_binary_op(Op, !IO) :-
+ ( c_util__binary_infix_op(Op, String) ->
+ io__write_string(String, !IO)
;
- { error("llds_out.m: invalid binary operator") }
+ error("llds_out.m: invalid binary operator")
).
llds_out__binary_op_to_string(Op, Name) :-
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.79
diff -u -b -r1.79 peephole.m
--- compiler/peephole.m 15 Mar 2003 03:09:05 -0000 1.79
+++ compiler/peephole.m 9 Nov 2003 06:18:09 -0000
@@ -21,9 +21,8 @@
% Peephole optimize a list of instructions.
-:- pred peephole__optimize(gc_method, list(instruction), list(instruction),
- bool).
-:- mode peephole__optimize(in, in, out, out) is det.
+:- pred peephole__optimize(gc_method::in, list(instruction)::in,
+ list(instruction)::out, bool::out) is det.
:- implementation.
@@ -48,9 +47,9 @@
peephole__invalid_opts(GC_Method, InvalidPatterns),
peephole__optimize_2(InvalidPatterns, Instrs0, Instrs, Mod).
-:- pred peephole__optimize_2(list(pattern), list(instruction),
- list(instruction), bool).
-:- mode peephole__optimize_2(in, in, out, out) is det.
+:- pred peephole__optimize_2(list(pattern)::in, list(instruction)::in,
+ list(instruction)::out, bool::out) is det.
+
peephole__optimize_2(_, [], [], no).
peephole__optimize_2(InvalidPatterns, [Instr0 - Comment | Instrs0],
Instrs, Mod) :-
@@ -66,9 +65,8 @@
% Try to optimize the beginning of the given instruction sequence.
% If successful, try it again.
-:- pred peephole__opt_instr(instr, string, list(pattern),
- list(instruction), list(instruction), bool).
-:- mode peephole__opt_instr(in, in, in, in, out, out) is det.
+:- pred peephole__opt_instr(instr::in, string::in, list(pattern)::in,
+ list(instruction)::in, list(instruction)::out, bool::out) is det.
peephole__opt_instr(Instr0, Comment0, InvalidPatterns, Instrs0, Instrs, Mod) :-
(
@@ -96,14 +94,14 @@
:- pred peephole__build_jump_label_map(list(label)::in, int::in,
map(label, list(int))::in, map(label, list(int))::out) is det.
-peephole__build_jump_label_map([], _, LabelMap, LabelMap).
-peephole__build_jump_label_map([Label | Labels], Val, LabelMap0, LabelMap) :-
- ( map__search(LabelMap0, Label, Vals0) ->
- map__det_update(LabelMap0, Label, [Val | Vals0], LabelMap1)
+peephole__build_jump_label_map([], _, !LabelMap).
+peephole__build_jump_label_map([Label | Labels], Val, !LabelMap) :-
+ ( map__search(!.LabelMap, Label, Vals0) ->
+ map__det_update(!.LabelMap, Label, [Val | Vals0], !:LabelMap)
;
- map__det_insert(LabelMap0, Label, [Val], LabelMap1)
+ map__det_insert(!.LabelMap, Label, [Val], !:LabelMap)
),
- peephole__build_jump_label_map(Labels, Val + 1, LabelMap1, LabelMap).
+ peephole__build_jump_label_map(Labels, Val + 1, !LabelMap).
% If one of the two labels has only one associated value, return it and
% the associated value as the first two output arguments, and the
@@ -131,9 +129,8 @@
% Look for code patterns that can be optimized, and optimize them.
-:- pred peephole__match(instr, string, list(pattern),
- list(instruction), list(instruction)).
-:- mode peephole__match(in, in, in, in, out) is semidet.
+:- pred peephole__match(instr::in, string::in, list(pattern)::in,
+ list(instruction)::in, list(instruction)::out) is semidet.
% A `computed_goto' with all branches pointing to the same
% label can be replaced with an unconditional goto.
@@ -221,8 +218,8 @@
% mkframe(NFI, label) => mkframe(NFI, label)
% if_val(test, redo) if_val(test, label)
%
- % These two patterns are mutually exclusive because if_val is not
- % straight-line code.
+ % These two classes of patterns are mutually exclusive because if_val
+ % is not straight-line code.
peephole__match(mkframe(NondetFrameInfo, Redoip1), Comment, _,
Instrs0, Instrs) :-
@@ -305,7 +302,7 @@
% assign(redoip(Fr), Redoip1) => assign(redoip(Fr), Redoip2)
% <straightline instrs> <straightline instrs>
% assign(redoip(Fr), Redoip2)
-
+ %
% If an assignment of do_fail to the redoip slot of the current frame
% is followed by straight-line instructions except possibly for if_val
% with do_fail or do_redo as target, until a goto to do_succeed(no),
@@ -353,9 +350,7 @@
peephole__match(incr_sp(N, _), _, InvalidPatterns, Instrs0, Instrs) :-
\+ list__member(incr_sp, InvalidPatterns),
- (
- opt_util__no_stackvars_til_decr_sp(Instrs0, N, Between, Remain)
- ->
+ ( opt_util__no_stackvars_til_decr_sp(Instrs0, N, Between, Remain) ->
list__append(Between, Remain, Instrs)
;
fail
@@ -366,13 +361,10 @@
% Given a GC method, return the list of invalid peephole
% optimizations.
-:- pred peephole__invalid_opts(gc_method, list(pattern)).
-:- mode peephole__invalid_opts(in, out) is det.
+:- pred peephole__invalid_opts(gc_method::in, list(pattern)::out) is det.
peephole__invalid_opts(GC_Method, InvalidPatterns) :-
- (
- GC_Method = accurate
- ->
+ ( GC_Method = accurate ->
InvalidPatterns = [incr_sp]
;
InvalidPatterns = []
Index: compiler/reassign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/reassign.m,v
retrieving revision 1.6
diff -u -b -r1.6 reassign.m
--- compiler/reassign.m 20 Oct 2003 07:29:11 -0000 1.6
+++ compiler/reassign.m 9 Nov 2003 06:55:42 -0000
@@ -351,15 +351,12 @@
:- pred clobber_dependents(lval::in, known_contents::in, known_contents::out,
dependent_lval_map::in, dependent_lval_map::out) is det.
-clobber_dependents(Target, KnownContentsMap0, KnownContentsMap,
- DepLvalMap0, DepLvalMap) :-
- ( map__search(DepLvalMap0, Target, DepLvals) ->
- set__fold(clobber_dependent, DepLvals,
- KnownContentsMap0, KnownContentsMap1),
- map__delete(DepLvalMap0, Target, DepLvalMap1)
+clobber_dependents(Target, !KnownContentsMap, !DepLvalMap) :-
+ ( map__search(!.DepLvalMap, Target, DepLvals) ->
+ set__fold(clobber_dependent, DepLvals, !KnownContentsMap),
+ map__delete(!.DepLvalMap, Target, !:DepLvalMap)
;
- KnownContentsMap1 = KnownContentsMap0,
- DepLvalMap1 = DepLvalMap0
+ true
),
% LLDS code can refer to arbitrary locations on the stack
% or in the heap with mem_ref lvals. Since we don't keep track
@@ -373,11 +370,10 @@
list__member(SubLval, SubLvals),
SubLval = mem_ref(_)
->
- KnownContentsMap = map__init,
- DepLvalMap = map__init
+ !:KnownContentsMap = map__init,
+ !:DepLvalMap = map__init
;
- KnownContentsMap = KnownContentsMap1,
- DepLvalMap = DepLvalMap1
+ true
).
:- pred clobber_dependent(lval::in, known_contents::in, known_contents::out)
@@ -390,26 +386,21 @@
known_contents::in, known_contents::out,
dependent_lval_map::in, dependent_lval_map::out) is det.
-record_known(TargetLval, SourceRval, KnownContentsMap0, KnownContentsMap,
- DepLvalMap0, DepLvalMap) :-
+record_known(TargetLval, SourceRval, !KnownContentsMap, !DepLvalMap) :-
code_util__lvals_in_rval(SourceRval, SourceSubLvals),
( list__member(TargetLval, SourceSubLvals) ->
% The act of assigning to TargetLval has modified
% the value of SourceRval, so we can't eliminate
% any copy of this assignment or its converse.
- KnownContentsMap = KnownContentsMap0,
- DepLvalMap = DepLvalMap0
+ true
;
record_known_lval_rval(TargetLval, SourceRval,
- KnownContentsMap0, KnownContentsMap1,
- DepLvalMap0, DepLvalMap1),
+ !KnownContentsMap, !DepLvalMap),
( SourceRval = lval(SourceLval) ->
record_known_lval_rval(SourceLval, lval(TargetLval),
- KnownContentsMap1, KnownContentsMap,
- DepLvalMap1, DepLvalMap)
+ !KnownContentsMap, !DepLvalMap)
;
- KnownContentsMap = KnownContentsMap1,
- DepLvalMap = DepLvalMap1
+ true
)
).
@@ -417,10 +408,9 @@
known_contents::in, known_contents::out,
dependent_lval_map::in, dependent_lval_map::out) is det.
-record_known_lval_rval(TargetLval, SourceRval,
- KnownContentsMap0, KnownContentsMap,
- DepLvalMap0, DepLvalMap) :-
- ( map__search(KnownContentsMap0, TargetLval, OldRval) ->
+record_known_lval_rval(TargetLval, SourceRval, !KnownContentsMap,
+ !DepLvalMap) :-
+ ( map__search(!.KnownContentsMap, TargetLval, OldRval) ->
% TargetLval no longer depends on the lvals in OldRval;
% it depends on the lvals in SourceRval instead. If any lvals
% occur in both, we delete TargetLval from their entries here
@@ -429,37 +419,36 @@
% TargetLval still depends on the lvals inside it.
code_util__lvals_in_rval(OldRval, OldSubLvals),
list__foldl(make_not_dependent(TargetLval), OldSubLvals,
- DepLvalMap0, DepLvalMap1)
+ !DepLvalMap)
;
- DepLvalMap1 = DepLvalMap0
+ true
),
code_util__lvals_in_lval(TargetLval, TargetSubLvals),
code_util__lvals_in_rval(SourceRval, SourceSubLvals),
list__append(TargetSubLvals, SourceSubLvals, AllSubLvals),
- list__foldl(make_dependent(TargetLval), AllSubLvals,
- DepLvalMap1, DepLvalMap),
- map__set(KnownContentsMap0, TargetLval, SourceRval,
- KnownContentsMap).
+ list__foldl(make_dependent(TargetLval), AllSubLvals, !DepLvalMap),
+ map__set(!.KnownContentsMap, TargetLval, SourceRval,
+ !:KnownContentsMap).
:- pred make_not_dependent(lval::in, lval::in,
dependent_lval_map::in, dependent_lval_map::out) is det.
-make_not_dependent(Target, SubLval, DepLvalMap0, DepLvalMap) :-
- ( map__search(DepLvalMap0, SubLval, DepLvals0) ->
+make_not_dependent(Target, SubLval, !DepLvalMap) :-
+ ( map__search(!.DepLvalMap, SubLval, DepLvals0) ->
set__delete(DepLvals0, Target, DepLvals),
- map__det_update(DepLvalMap0, SubLval, DepLvals, DepLvalMap)
+ map__det_update(!.DepLvalMap, SubLval, DepLvals, !:DepLvalMap)
;
- DepLvalMap = DepLvalMap0
+ true
).
:- pred make_dependent(lval::in, lval::in,
dependent_lval_map::in, dependent_lval_map::out) is det.
-make_dependent(Target, SubLval, DepLvalMap0, DepLvalMap) :-
- ( map__search(DepLvalMap0, SubLval, DepLvals0) ->
+make_dependent(Target, SubLval, !DepLvalMap) :-
+ ( map__search(!.DepLvalMap, SubLval, DepLvals0) ->
set__insert(DepLvals0, Target, DepLvals),
- map__det_update(DepLvalMap0, SubLval, DepLvals, DepLvalMap)
+ map__det_update(!.DepLvalMap, SubLval, DepLvals, !:DepLvalMap)
;
DepLvals = set__make_singleton_set(Target),
- map__det_insert(DepLvalMap0, SubLval, DepLvals, DepLvalMap)
+ map__det_insert(!.DepLvalMap, SubLval, DepLvals, !:DepLvalMap)
).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.39
diff -u -b -r1.39 rtti_out.m
--- compiler/rtti_out.m 23 Oct 2003 02:02:09 -0000 1.39
+++ compiler/rtti_out.m 9 Nov 2003 11:44:44 -0000
@@ -115,7 +115,7 @@
base_typeclass_info(N1, N2, N3, N4, N5, Methods),
!DeclSet, !IO) :-
CodeAddrs = list__map(make_code_addr, Methods),
- output_code_addrs_decls(CodeAddrs, "", "", 0, _, !DeclSet, !IO),
+ list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
io__write_string("\n", !IO),
RttiId = tc_rtti_id(base_typeclass_info(InstanceModuleName,
ClassId, InstanceString)),
@@ -308,7 +308,7 @@
;
MethodProcLabels = [_ | _],
MethodCodeAddrs = list__map(make_code_addr, MethodProcLabels),
- output_code_addrs_decls(MethodCodeAddrs, "", "", 0, _,
+ list__foldl2(output_code_addr_decls, MethodCodeAddrs,
!DeclSet, !IO),
output_generic_rtti_data_defn_start(TCInstanceMethodsRttiId,
!DeclSet, !IO),
@@ -555,7 +555,7 @@
det_univ_to_type(CompareUniv, CompareProcLabel),
CompareCodeAddr = make_code_addr(CompareProcLabel),
CodeAddrs = [UnifyCodeAddr, CompareCodeAddr],
- output_code_addrs_decls(CodeAddrs, "", "", 0, _, !DeclSet, !IO),
+ list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
output_generic_rtti_data_defn_start(
ctor_rtti_id(RttiTypeCtor, type_ctor_info),
!DeclSet, !IO),
@@ -1448,39 +1448,38 @@
string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_rtti_datas_decls([], _, _, N, N, !DeclSet, !IO).
+output_rtti_datas_decls([], _, _, !N, !DeclSet, !IO).
output_rtti_datas_decls([RttiData | RttiDatas], FirstIndent, LaterIndent,
- N0, N, !DeclSet, !IO) :-
+ !N, !DeclSet, !IO) :-
output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
- N0, N1, !DeclSet, !IO),
+ !N, !DeclSet, !IO),
output_rtti_datas_decls(RttiDatas, FirstIndent, LaterIndent,
- N1, N, !DeclSet, !IO).
+ !N, !DeclSet, !IO).
:- pred output_rtti_data_decls(rtti_data::in,
string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
- N0, N, !DeclSet, !IO) :-
+ !N, !DeclSet, !IO) :-
( RttiData = pseudo_type_info(type_var(_)) ->
% These just get represented as integers,
% so we don't need to declare them.
% Also rtti_data_to_name/3 does not handle this case.
- N = N0
+ true
;
rtti_data_to_id(RttiData, RttiId),
output_rtti_id_decls(RttiId, FirstIndent, LaterIndent,
- N0, N, !DeclSet, !IO)
+ !N, !DeclSet, !IO)
).
:- pred output_rtti_id_decls(rtti_id::in, string::in, string::in,
int::in, int::out, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
-output_rtti_id_decls(RttiId, FirstIndent, LaterIndent,
- N0, N1, !DeclSet, !IO) :-
+output_rtti_id_decls(RttiId, FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
output_data_addr_decls(rtti_addr(RttiId), FirstIndent, LaterIndent,
- N0, N1, !DeclSet, !IO).
+ !N, !DeclSet, !IO).
:- pred output_cast_addr_of_rtti_ids(string::in, list(rtti_id)::in,
io__state::di, io__state::uo) is det.
@@ -1671,6 +1670,7 @@
%-----------------------------------------------------------------------------%
:- func this_file = string.
+
this_file = "rtti_out.m".
%-----------------------------------------------------------------------------%
Index: compiler/use_local_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/use_local_vars.m,v
retrieving revision 1.6
diff -u -b -r1.6 use_local_vars.m
--- compiler/use_local_vars.m 20 Oct 2003 07:29:12 -0000 1.6
+++ compiler/use_local_vars.m 9 Nov 2003 06:48:43 -0000
@@ -83,31 +83,29 @@
%-----------------------------------------------------------------------------%
use_local_vars__main(Instrs0, Instrs, ProcLabel, NumRealRRegs, AccessThreshold,
- C0, C) :-
- create_basic_blocks(Instrs0, Comments, ProcLabel, C0, C1,
+ !C) :-
+ create_basic_blocks(Instrs0, Comments, ProcLabel, !C,
LabelSeq, BlockMap0),
flatten_basic_blocks(LabelSeq, BlockMap0, TentativeInstrs),
livemap__build(TentativeInstrs, MaybeLiveMap),
(
% Instrs0 must have contained C code which cannot be analyzed
MaybeLiveMap = no,
- Instrs = Instrs0,
- C = C0
+ Instrs = Instrs0
;
MaybeLiveMap = yes(LiveMap),
list__foldl(use_local_vars_block(LiveMap, NumRealRRegs,
AccessThreshold), LabelSeq, BlockMap0, BlockMap),
flatten_basic_blocks(LabelSeq, BlockMap, Instrs1),
- list__append(Comments, Instrs1, Instrs),
- C = C1
+ list__append(Comments, Instrs1, Instrs)
).
:- pred use_local_vars_block(livemap::in, int::in, int::in, label::in,
block_map::in, block_map::out) is det.
use_local_vars_block(LiveMap, NumRealRRegs, AccessThreshold, Label,
- BlockMap0, BlockMap) :-
- map__lookup(BlockMap0, Label, BlockInfo0),
+ !BlockMap) :-
+ map__lookup(!.BlockMap, Label, BlockInfo0),
BlockInfo0 = block_info(BlockLabel, LabelInstr, RestInstrs0,
JumpLabels, MaybeFallThrough),
( can_branch_to_unknown_label(RestInstrs0) ->
@@ -131,11 +129,11 @@
TempCounter0, TempCounter, NumRealRRegs, AccessThreshold,
MaybeEndLiveLvals),
( TempCounter = TempCounter0 ->
- BlockMap = BlockMap0
+ true
;
BlockInfo = block_info(BlockLabel, LabelInstr,
RestInstrs, JumpLabels, MaybeFallThrough),
- map__det_update(BlockMap0, Label, BlockInfo, BlockMap)
+ map__det_update(!.BlockMap, Label, BlockInfo, !:BlockMap)
).
:- pred can_branch_to_unknown_label(list(instruction)::in) is semidet.
@@ -160,9 +158,9 @@
:- pred find_live_lvals_at_end_labels(livemap::in, label::in,
lvalset::in, lvalset::out) is det.
-find_live_lvals_at_end_labels(LiveMap, Label, LiveLvals0, LiveLvals) :-
+find_live_lvals_at_end_labels(LiveMap, Label, !LiveLvals) :-
( map__search(LiveMap, Label, LabelLiveLvals) ->
- set__union(LiveLvals0, LabelLiveLvals, LiveLvals)
+ set__union(LabelLiveLvals, !LiveLvals)
; Label = local(_, _) ->
error("find_live_lvals_at_end_labels: local label not found")
;
@@ -170,17 +168,17 @@
% which must be preceded by livevals instructions. The
% variables live at the label will be included when we process
% the livevals instruction.
- LiveLvals = LiveLvals0
+ true
).
:- pred find_live_lvals_in_annotations(instruction::in,
lvalset::in, lvalset::out) is det.
-find_live_lvals_in_annotations(Uinstr - _, LiveLvals0, LiveLvals) :-
+find_live_lvals_in_annotations(Uinstr - _, !LiveLvals) :-
( Uinstr = livevals(InstrLiveLvals) ->
- set__union(LiveLvals0, InstrLiveLvals, LiveLvals)
+ set__union(InstrLiveLvals, !LiveLvals)
;
- LiveLvals = LiveLvals0
+ true
).
%-----------------------------------------------------------------------------%
@@ -189,17 +187,14 @@
counter::in, counter::out, int::in, int::in, maybe(lvalset)::in)
is det.
-use_local_vars_instrs(RestInstrs0, RestInstrs, TempCounter0, TempCounter,
+use_local_vars_instrs(!RestInstrs, !TempCounter,
NumRealRRegs, AccessThreshold, MaybeEndLiveLvals) :-
- opt_assign(RestInstrs0, RestInstrs1,
- TempCounter0, TempCounter1, NumRealRRegs, MaybeEndLiveLvals),
+ opt_assign(!RestInstrs, !TempCounter, NumRealRRegs, MaybeEndLiveLvals),
( AccessThreshold >= 1 ->
- opt_access(RestInstrs1, RestInstrs,
- TempCounter1, TempCounter, NumRealRRegs, set__init,
- AccessThreshold)
+ opt_access(!RestInstrs, !TempCounter, NumRealRRegs,
+ set__init, AccessThreshold)
;
- RestInstrs = RestInstrs1,
- TempCounter = TempCounter1
+ true
).
%-----------------------------------------------------------------------------%
@@ -207,9 +202,9 @@
:- pred opt_assign(list(instruction)::in, list(instruction)::out,
counter::in, counter::out, int::in, maybe(lvalset)::in) is det.
-opt_assign([], [], TempCounter, TempCounter, _, _).
-opt_assign([Instr0 | TailInstrs0], Instrs,
- TempCounter0, TempCounter, NumRealRRegs, MaybeEndLiveLvals) :-
+opt_assign([], [], !TempCounter, _, _).
+opt_assign([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
+ MaybeEndLiveLvals) :-
Instr0 = Uinstr0 - _Comment0,
(
( Uinstr0 = assign(ToLval, _FromRval)
@@ -217,7 +212,7 @@
),
base_lval_worth_replacing(NumRealRRegs, ToLval)
->
- counter__allocate(TempNum, TempCounter0, TempCounter1),
+ counter__allocate(TempNum, !TempCounter),
NewLval = temp(r, TempNum),
(
ToLval = reg(_, _),
@@ -229,8 +224,7 @@
list__map_foldl(exprn_aux__substitute_lval_in_instr(
ToLval, NewLval),
TailInstrs0, TailInstrs1, 0, _),
- opt_assign(TailInstrs1, TailInstrs,
- TempCounter1, TempCounter,
+ opt_assign(TailInstrs1, TailInstrs, !TempCounter,
NumRealRRegs, MaybeEndLiveLvals),
Instrs = [Instr | TailInstrs]
;
@@ -241,19 +235,16 @@
substitute_lval_in_defn(ToLval, NewLval,
Instr0, Instr),
CopyInstr = assign(ToLval, lval(NewLval)) - "",
- opt_assign(TailInstrs1, TailInstrs,
- TempCounter1, TempCounter,
+ opt_assign(TailInstrs1, TailInstrs, !TempCounter,
NumRealRRegs, MaybeEndLiveLvals),
Instrs = [Instr, CopyInstr | TailInstrs]
;
- opt_assign(TailInstrs0, TailInstrs,
- TempCounter0, TempCounter,
+ opt_assign(TailInstrs0, TailInstrs, !TempCounter,
NumRealRRegs, MaybeEndLiveLvals),
Instrs = [Instr0 | TailInstrs]
)
;
- opt_assign(TailInstrs0, TailInstrs,
- TempCounter0, TempCounter,
+ opt_assign(TailInstrs0, TailInstrs, !TempCounter,
NumRealRRegs, MaybeEndLiveLvals),
Instrs = [Instr0 | TailInstrs]
).
@@ -263,10 +254,9 @@
:- pred opt_access(list(instruction)::in, list(instruction)::out,
counter::in, counter::out, int::in, lvalset::in, int::in) is det.
-opt_access([], [], TempCounter, TempCounter, _, _, _).
-opt_access([Instr0 | TailInstrs0], Instrs,
- TempCounter0, TempCounter, NumRealRRegs, AlreadyTried0,
- AccessThreshold) :-
+opt_access([], [], !TempCounter, _, _, _).
+opt_access([Instr0 | TailInstrs0], Instrs, !TempCounter, NumRealRRegs,
+ AlreadyTried0, AccessThreshold) :-
Instr0 = Uinstr0 - _Comment0,
(
Uinstr0 = assign(ToLval, FromRval),
@@ -279,7 +269,7 @@
SubLvals, ReplaceableSubLvals),
ReplaceableSubLvals = [ChosenLval | ChooseableRvals]
->
- counter__allocate(TempNum, TempCounter0, TempCounter1),
+ counter__allocate(TempNum, !TempCounter),
TempLval = temp(r, TempNum),
lvals_in_lval(ChosenLval, SubChosenLvals),
require(unify(SubChosenLvals, []),
@@ -291,21 +281,19 @@
TempAssign = assign(TempLval, lval(ChosenLval))
- "factor out common sub lval",
Instrs2 = [TempAssign | Instrs1],
- opt_access(Instrs2, Instrs, TempCounter1, TempCounter,
+ opt_access(Instrs2, Instrs, !TempCounter,
NumRealRRegs, AlreadyTried1, AccessThreshold)
; ChooseableRvals = [_ | _] ->
opt_access([Instr0 | TailInstrs0], Instrs,
- TempCounter0, TempCounter,
- NumRealRRegs, AlreadyTried1, AccessThreshold)
+ !TempCounter, NumRealRRegs, AlreadyTried1,
+ AccessThreshold)
;
- opt_access(TailInstrs0, TailInstrs,
- TempCounter0, TempCounter,
+ opt_access(TailInstrs0, TailInstrs, !TempCounter,
NumRealRRegs, set__init, AccessThreshold),
Instrs = [Instr0 | TailInstrs]
)
;
- opt_access(TailInstrs0, TailInstrs,
- TempCounter0, TempCounter,
+ opt_access(TailInstrs0, TailInstrs, !TempCounter,
NumRealRRegs, set__init, AccessThreshold),
Instrs = [Instr0 | TailInstrs]
).
@@ -397,20 +385,25 @@
list(instruction)::in, list(instruction)::out, int::in, int::out)
is det.
-substitute_lval_in_instr_until_defn(_, _, [], [], N, N).
+substitute_lval_in_instr_until_defn(_, _, [], [], !N).
substitute_lval_in_instr_until_defn(OldLval, NewLval,
- [Instr0 | Instrs0], [Instr | Instrs], N0, N) :-
- Instr0 = Uinstr0 - _,
+ [Instr0 | Instrs0], [Instr | Instrs], !N) :-
+ substitute_lval_in_instr_until_defn_2(OldLval, NewLval,
+ Instr0, Instr, Instrs0, Instrs, !N).
+
+:- pred substitute_lval_in_instr_until_defn_2(lval::in, lval::in,
+ instruction::in, instruction::out,
+ list(instruction)::in, list(instruction)::out,
+ int::in, int::out) is det.
+
+substitute_lval_in_instr_until_defn_2(OldLval, NewLval, !Instr, !Instrs, !N) :-
+ !.Instr = Uinstr0 - _,
(
Uinstr0 = comment(_),
- Instr = Instr0,
substitute_lval_in_instr_until_defn(OldLval, NewLval,
- Instrs0, Instrs, N0, N)
+ !Instrs, !N)
;
- Uinstr0 = livevals(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
+ Uinstr0 = livevals(_)
;
Uinstr0 = block(_, _, _),
error("substitute_lval_in_instr_until_defn: found block")
@@ -421,45 +414,29 @@
% we must stop the substitutions. At the
% moment, the only lval OldLval contains is
% itself.
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
+ true
;
exprn_aux__substitute_lval_in_instr(OldLval, NewLval,
- Instr0, Instr, N0, N1),
+ !Instr, !N),
substitute_lval_in_instr_until_defn(OldLval, NewLval,
- Instrs0, Instrs, N1, N)
+ !Instrs, !N)
)
;
- Uinstr0 = call(_, _, _, _, _, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = mkframe(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = label(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = goto(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
+ Uinstr0 = call(_, _, _, _, _, _)
+ ;
+ Uinstr0 = mkframe(_, _)
+ ;
+ Uinstr0 = label(_)
+ ;
+ Uinstr0 = goto(_)
;
Uinstr0 = computed_goto(_, _),
exprn_aux__substitute_lval_in_instr(OldLval, NewLval,
- Instr0, Instr, N0, N),
- Instrs = Instrs0
+ !Instr, !N)
;
Uinstr0 = if_val(_, _),
exprn_aux__substitute_lval_in_instr(OldLval, NewLval,
- Instr0, Instr, N0, N),
- Instrs = Instrs0
+ !Instr, !N)
;
Uinstr0 = incr_hp(Lval, _, _, _, _),
( Lval = OldLval ->
@@ -467,98 +444,45 @@
% we must stop the substitutions. At the
% moment, the only lval OldLval contains is
% itself.
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
+ true
;
exprn_aux__substitute_lval_in_instr(OldLval, NewLval,
- Instr0, Instr, N0, N1),
+ !Instr, !N),
substitute_lval_in_instr_until_defn(OldLval, NewLval,
- Instrs0, Instrs, N1, N)
+ !Instrs, !N)
)
;
- Uinstr0 = mark_hp(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = restore_hp(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = free_heap(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = store_ticket(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = reset_ticket(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = discard_ticket,
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = prune_ticket,
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = mark_ticket_stack(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = prune_tickets_to(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = incr_sp(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = decr_sp(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = init_sync_term(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = fork(_, _, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = join_and_terminate(_),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = join_and_continue(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = c_code(_, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
- ;
- Uinstr0 = pragma_c(_, _, _, _, _, _, _, _),
- Instr = Instr0,
- Instrs = Instrs0,
- N = N0
+ Uinstr0 = mark_hp(_)
+ ;
+ Uinstr0 = restore_hp(_)
+ ;
+ Uinstr0 = free_heap(_)
+ ;
+ Uinstr0 = store_ticket(_)
+ ;
+ Uinstr0 = reset_ticket(_, _)
+ ;
+ Uinstr0 = discard_ticket
+ ;
+ Uinstr0 = prune_ticket
+ ;
+ Uinstr0 = mark_ticket_stack(_)
+ ;
+ Uinstr0 = prune_tickets_to(_)
+ ;
+ Uinstr0 = incr_sp(_, _)
+ ;
+ Uinstr0 = decr_sp(_)
+ ;
+ Uinstr0 = init_sync_term(_, _)
+ ;
+ Uinstr0 = fork(_, _, _)
+ ;
+ Uinstr0 = join_and_terminate(_)
+ ;
+ Uinstr0 = join_and_continue(_, _)
+ ;
+ Uinstr0 = c_code(_, _)
+ ;
+ Uinstr0 = pragma_c(_, _, _, _, _, _, _, _)
).
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/bintree_set.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/bintree_set.m,v
retrieving revision 1.19
diff -u -b -r1.19 bintree_set.m
--- library/bintree_set.m 12 Nov 2000 23:02:33 -0000 1.19
+++ library/bintree_set.m 9 Nov 2003 10:06:28 -0000
@@ -54,9 +54,11 @@
% `bintree_set__init(Set)' is true iff `Set' is an empty set.
-:- pred bintree_set__init(bintree_set(_T)).
+:- pred bintree_set__init(bintree_set(T)).
:- mode bintree_set__init(uo) is det.
+:- func bintree_set__init = bintree_set(T).
+
:- pred bintree_set__singleton_set(bintree_set(T), T).
:- mode bintree_set__singleton_set(out, in) is det.
@@ -287,6 +289,9 @@
% Ralph Becket <rwab1 at cl.cam.ac.uk> 29/04/99
% Function forms added.
+bintree_set__init = BT :-
+ bintree_set__init(BT).
+
bintree_set__list_to_set(Xs) = BT :-
bintree_set__list_to_set(Xs, BT).
@@ -313,5 +318,3 @@
bintree_set__intersect(BT1, BT2) = BT3 :-
bintree_set__intersect(BT1, BT2, BT3).
-
-
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
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/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
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: 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