[m-rev.] for review: use cords instead of tree.m
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Jan 5 16:35:09 AEDT 2009
I am looking for views on the concept more than the code changes, which are
mostly trivial.
Note that when this diff is committed, you will need to remove libs.tree.*
from the compiler directory in every updated workspace. If you do "mmake
depend" after the update, you will need to do so manually; an "mmake realclean"
won't do it.
Zoltan.
Delete the old tree.m module (which did a small subset of what cords now do),
and switch to using cords instead. This is more standard, as well as very
slightly more efficient, because with cords, e.g. concatenating ten code
fragments of which eight are empty doesn't allocate ten cons cells.
My measurements show a 0.1% reduction in executable size and a 0.3% reduction
in compilation time. Both of those are in the noise; the main reason for the
change is more convenient coding.
compiler/tree.m:
Remove this module.
compiler/libs.m:
Remove the inclusion of tree.m.
compiler/notes/compiler_design.html:
Remove the description of tree.m.
compiler/bytecode.m:
Switch to using cords to represent code in the bytecode backend.
compiler/llds.m:
Switch to using cords to represent code in the LLDS backend.
compiler/mlds_to_il.m:
Switch to using cords to represent IL code being built.
compiler/bytecode_gen.m:
compiler/call_gen.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/commit_gen.m:
compiler/dense_switch.m:
compiler/disj_gen.m:
compiler/ite_gen.m:
compiler/lookup_switch.m:
compiler/lookup_util.m:
compiler/middle_rec.m:
compiler/par_conj_gen.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/string_switch.m:
compiler/switch_case.m:
compiler/switch_gen.m:
compiler/tag_switch.m:
compiler/trace_gen.m:
compiler/unify_gen.m:
compiler/var_locn.m:
Conform to the changes above.
library/cord.m:
Add a predicate form of map.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.74
diff -u -b -r1.74 bytecode.m
--- compiler/bytecode.m 30 Dec 2007 08:23:31 -0000 1.74
+++ compiler/bytecode.m 4 Jan 2009 10:24:02 -0000
@@ -20,21 +20,20 @@
:- import_module backend_libs.builtin_ops.
:- import_module hlds.
:- import_module hlds.hlds_data.
-:- import_module libs.
-:- import_module libs.tree.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module char.
+:- import_module cord.
:- import_module io.
:- import_module list.
:- import_module pair.
%---------------------------------------------------------------------------%
-:- type byte_tree == tree(list(byte_code)).
+:- type byte_tree == cord(byte_code).
:- type byte_code
---> byte_enter_pred(byte_pred_id, int, byte_is_func, int)
@@ -153,6 +152,7 @@
:- import_module backend_libs.bytecode_data.
:- import_module backend_libs.c_util.
+:- import_module libs.
:- import_module libs.compiler_util.
:- import_module assoc_list.
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.120
diff -u -b -r1.120 bytecode_gen.m
--- compiler/bytecode_gen.m 3 Apr 2008 05:26:42 -0000 1.120
+++ compiler/bytecode_gen.m 4 Jan 2009 10:46:27 -0000
@@ -59,7 +59,6 @@
:- import_module hlds.passes_aux.
:- import_module libs.
:- import_module libs.compiler_util.
-:- import_module libs.tree.
:- import_module ll_backend. % bytecode_gen uses ll_backend__call_gen.m
:- import_module ll_backend.call_gen. % XXX for arg passing convention
:- import_module mdbcomp.
@@ -69,6 +68,7 @@
:- import_module parse_tree.prog_type.
:- import_module assoc_list.
+:- import_module cord.
:- import_module counter.
:- import_module deconstruct.
:- import_module int.
@@ -85,8 +85,7 @@
gen_module(!ModuleInfo, Code, !IO) :-
module_info_predids(PredIds, !ModuleInfo),
gen_preds(PredIds, !.ModuleInfo, CodeTree, !IO),
- tree.flatten(CodeTree, CodeList),
- list.condense(CodeList, Code).
+ Code = cord.list(CodeTree).
:- pred gen_preds(list(pred_id)::in, module_info::in, byte_tree::out,
io::di, io::uo) is det.
@@ -106,13 +105,13 @@
list.length(ProcIds, ProcsCount),
Arity = pred_info_orig_arity(PredInfo),
get_is_func(PredInfo, IsFunc),
- EnterCode = node([byte_enter_pred(PredName, Arity, IsFunc,
- ProcsCount)]),
- EndofCode = node([byte_endof_pred]),
- PredCode = tree_list([EnterCode, ProcsCode, EndofCode])
+ EnterCode = singleton(byte_enter_pred(PredName, Arity, IsFunc,
+ ProcsCount)),
+ EndofCode = singleton(byte_endof_pred),
+ PredCode = EnterCode ++ ProcsCode ++ EndofCode
),
gen_preds(PredIds, ModuleInfo, OtherCode, !IO),
- Code = tree(PredCode, OtherCode).
+ Code = PredCode ++ OtherCode.
:- pred gen_pred(pred_id::in, list(proc_id)::in, pred_info::in,
module_info::in, byte_tree::out, io::di, io::uo) is det.
@@ -123,7 +122,7 @@
PredId, ProcId, ModuleInfo, !IO),
gen_proc(ProcId, PredInfo, ModuleInfo, ProcCode),
gen_pred(PredId, ProcIds, PredInfo, ModuleInfo, ProcsCode, !IO),
- Code = tree(ProcCode, ProcsCode).
+ Code = ProcCode ++ ProcsCode.
:- pred gen_proc(proc_id::in, pred_info::in,
module_info::in, byte_tree::out) is det.
@@ -172,29 +171,28 @@
get_next_label(EndLabel, ByteInfo3, ByteInfo),
get_counts(ByteInfo, LabelCount, TempCount),
- ZeroLabelCode = node([byte_label(ZeroLabel)]),
- BodyTree = tree_list([PickupCode, ZeroLabelCode, GoalCode, PlaceCode]),
- tree.flatten(BodyTree, BodyList),
- list.condense(BodyList, BodyCode0),
- ( list.member(byte_not_supported, BodyCode0) ->
- BodyCode = node([byte_not_supported])
+ ZeroLabelCode = singleton(byte_label(ZeroLabel)),
+ BodyCode0 = PickupCode ++ ZeroLabelCode ++ GoalCode ++ PlaceCode,
+ BodyInstrs = cord.list(BodyCode0),
+ ( list.member(byte_not_supported, BodyInstrs) ->
+ BodyCode = singleton(byte_not_supported)
;
- BodyCode = node(BodyCode0)
+ BodyCode = BodyCode0
),
proc_id_to_int(ProcId, ProcInt),
- EnterCode = node([byte_enter_proc(ProcInt, Detism, LabelCount, EndLabel,
- TempCount, VarInfos)]),
+ EnterCode = singleton(byte_enter_proc(ProcInt, Detism, LabelCount,
+ EndLabel, TempCount, VarInfos)),
(
CodeModel = model_semi,
- EndofCode = node([byte_semidet_succeed, byte_label(EndLabel),
+ EndofCode = from_list([byte_semidet_succeed, byte_label(EndLabel),
byte_endof_proc])
;
( CodeModel = model_det
; CodeModel = model_non
),
- EndofCode = node([byte_label(EndLabel), byte_endof_proc])
+ EndofCode = from_list([byte_label(EndLabel), byte_endof_proc])
),
- Code = tree_list([EnterCode, BodyCode, EndofCode]).
+ Code = EnterCode ++ BodyCode ++ EndofCode.
%---------------------------------------------------------------------------%
@@ -205,7 +203,7 @@
gen_goal_expr(GoalExpr, GoalInfo, !ByteInfo, GoalCode),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
- Code = tree(node([byte_context(Line)]), GoalCode).
+ Code = singleton(byte_context(Line)) ++ GoalCode.
:- pred gen_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
byte_info::in, byte_info::out, byte_tree::out) is det.
@@ -228,7 +226,7 @@
% "bytecode for ", GenericCallFunctor, " calls"], Msg),
% sorry(this_file, Msg)
functor(GenericCallType, canonicalize, _GenericCallFunctor, _),
- Code = node([byte_not_supported])
+ Code = singleton(byte_not_supported)
)
;
GoalExpr = plain_call(PredId, ProcId, ArgVars, BuiltinState, _, _),
@@ -250,10 +248,10 @@
gen_goal(Goal, !ByteInfo, SomeCode),
get_next_label(EndLabel, !ByteInfo),
get_next_temp(FrameTemp, !ByteInfo),
- EnterCode = node([byte_enter_negation(FrameTemp, EndLabel)]),
- EndofCode = node([byte_endof_negation_goal(FrameTemp),
+ EnterCode = singleton(byte_enter_negation(FrameTemp, EndLabel)),
+ EndofCode = from_list([byte_endof_negation_goal(FrameTemp),
byte_label(EndLabel), byte_endof_negation]),
- Code = tree_list([EnterCode, SomeCode, EndofCode])
+ Code = EnterCode ++ SomeCode ++ EndofCode
;
GoalExpr = scope(_, InnerGoal),
gen_goal(InnerGoal, !ByteInfo, InnerCode),
@@ -266,9 +264,9 @@
Code = InnerCode
;
get_next_temp(Temp, !ByteInfo),
- EnterCode = node([byte_enter_commit(Temp)]),
- EndofCode = node([byte_endof_commit(Temp)]),
- Code = tree_list([EnterCode, InnerCode, EndofCode])
+ EnterCode = singleton(byte_enter_commit(Temp)),
+ EndofCode = singleton(byte_endof_commit(Temp)),
+ Code = EnterCode ++ InnerCode ++ EndofCode
)
;
GoalExpr = conj(plain_conj, GoalList),
@@ -280,23 +278,24 @@
GoalExpr = disj(GoalList),
(
GoalList = [],
- Code = node([byte_fail])
+ Code = singleton(byte_fail)
;
GoalList = [_ | _],
get_next_label(EndLabel, !ByteInfo),
gen_disj(GoalList, EndLabel, !ByteInfo, DisjCode),
- EnterCode = node([byte_enter_disjunction(EndLabel)]),
- EndofCode = node([byte_endof_disjunction, byte_label(EndLabel)]),
- Code = tree_list([EnterCode, DisjCode, EndofCode])
+ EnterCode = singleton(byte_enter_disjunction(EndLabel)),
+ EndofCode = from_list([byte_endof_disjunction,
+ byte_label(EndLabel)]),
+ Code = EnterCode ++ DisjCode ++ EndofCode
)
;
GoalExpr = switch(Var, _, CasesList),
get_next_label(EndLabel, !ByteInfo),
gen_switch(CasesList, Var, EndLabel, !ByteInfo, SwitchCode),
map_var(!.ByteInfo, Var, ByteVar),
- EnterCode = node([byte_enter_switch(ByteVar, EndLabel)]),
- EndofCode = node([byte_endof_switch, byte_label(EndLabel)]),
- Code = tree_list([EnterCode, SwitchCode, EndofCode])
+ EnterCode = singleton(byte_enter_switch(ByteVar, EndLabel)),
+ EndofCode = from_list([byte_endof_switch, byte_label(EndLabel)]),
+ Code = EnterCode ++ SwitchCode ++ EndofCode
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
get_next_label(EndLabel, !ByteInfo),
@@ -305,16 +304,16 @@
gen_goal(Cond, !ByteInfo, CondCode),
gen_goal(Then, !ByteInfo, ThenCode),
gen_goal(Else, !ByteInfo, ElseCode),
- EnterIfCode = node([byte_enter_if(ElseLabel, EndLabel, FrameTemp)]),
- EnterThenCode = node([byte_enter_then(FrameTemp)]),
- EndofThenCode = node([byte_endof_then(EndLabel), byte_label(ElseLabel),
- byte_enter_else(FrameTemp)]),
- EndofIfCode = node([byte_endof_if, byte_label(EndLabel)]),
- Code = tree_list([EnterIfCode, CondCode, EnterThenCode, ThenCode,
- EndofThenCode, ElseCode, EndofIfCode])
+ EnterIfCode = singleton(byte_enter_if(ElseLabel, EndLabel, FrameTemp)),
+ EnterThenCode = singleton(byte_enter_then(FrameTemp)),
+ EndofThenCode = from_list([byte_endof_then(EndLabel),
+ byte_label(ElseLabel), byte_enter_else(FrameTemp)]),
+ EndofIfCode = from_list([byte_endof_if, byte_label(EndLabel)]),
+ Code = EnterIfCode ++ CondCode ++ EnterThenCode ++ ThenCode ++
+ EndofThenCode ++ ElseCode ++ EndofIfCode
;
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
- Code = node([byte_not_supported])
+ Code = singleton(byte_not_supported)
;
GoalExpr = shorthand(_),
% These should have been expanded out by now.
@@ -330,7 +329,7 @@
gen_places([Var - Loc | OutputArgs], ByteInfo, Code) :-
gen_places(OutputArgs, ByteInfo, OtherCode),
map_var(ByteInfo, Var, ByteVar),
- Code = tree(node([byte_place_arg(byte_reg_r, Loc, ByteVar)]), OtherCode).
+ Code = singleton(byte_place_arg(byte_reg_r, Loc, ByteVar)) ++ OtherCode.
:- pred gen_pickups(list(pair(prog_var, arg_loc))::in,
byte_info::in, byte_tree::out) is det.
@@ -339,7 +338,7 @@
gen_pickups([Var - Loc | OutputArgs], ByteInfo, Code) :-
gen_pickups(OutputArgs, ByteInfo, OtherCode),
map_var(ByteInfo, Var, ByteVar),
- Code = tree(node([byte_pickup_arg(byte_reg_r, Loc, ByteVar)]), OtherCode).
+ Code = singleton(byte_pickup_arg(byte_reg_r, Loc, ByteVar)) ++ OtherCode.
%---------------------------------------------------------------------------%
@@ -366,14 +365,14 @@
gen_pickups(OutputArgs, ByteInfo, PickupArgs),
map_var(ByteInfo, PredVar, BytePredVar),
- Call = node([byte_higher_order_call(BytePredVar, NInVars, NOutVars,
- Detism)]),
+ Call = singleton(byte_higher_order_call(BytePredVar, NInVars, NOutVars,
+ Detism)),
( CodeModel = model_semi ->
- Check = node([byte_semidet_success_check])
+ Check = singleton(byte_semidet_success_check)
;
Check = empty
),
- Code = tree(PlaceArgs, tree(Call, tree(Check, PickupArgs))).
+ Code = PlaceArgs ++ Call ++ Check ++ PickupArgs.
% Generate bytecode for an ordinary call.
%
@@ -397,14 +396,14 @@
predicate_id(ModuleInfo, PredId, ModuleName, PredName, Arity),
proc_id_to_int(ProcId, ProcInt),
- Call = node([byte_call(ModuleName, PredName, Arity, IsFunc, ProcInt)]),
+ Call = singleton(byte_call(ModuleName, PredName, Arity, IsFunc, ProcInt)),
determinism_to_code_model(Detism, CodeModel),
( CodeModel = model_semi ->
- Check = node([byte_semidet_success_check])
+ Check = singleton(byte_semidet_success_check)
;
Check = empty
),
- Code = tree(PlaceArgs, tree(Call, tree(Check, PickupArgs))).
+ Code = PlaceArgs ++ Call ++ Check ++ PickupArgs.
% Generate bytecode for a call to a builtin.
%
@@ -430,7 +429,7 @@
unexpected(this_file, "ref_assign")
;
SimpleCode = noop(_DefinedVars),
- Code = node([])
+ Code = empty
)
;
string.append("unknown builtin predicate ", PredName, Msg),
@@ -445,11 +444,11 @@
TestExpr = binary(Binop, X, Y),
map_arg(ByteInfo, X, ByteX),
map_arg(ByteInfo, Y, ByteY),
- Code = node([byte_builtin_bintest(Binop, ByteX, ByteY)])
+ Code = singleton(byte_builtin_bintest(Binop, ByteX, ByteY))
;
TestExpr = unary(Unop, X),
map_arg(ByteInfo, X, ByteX),
- Code = node([byte_builtin_untest(Unop, ByteX)])
+ Code = singleton(byte_builtin_untest(Unop, ByteX))
).
:- pred map_assign(byte_info::in, prog_var::in,
@@ -461,17 +460,17 @@
map_arg(ByteInfo, X, ByteX),
map_arg(ByteInfo, Y, ByteY),
map_var(ByteInfo, Var, ByteVar),
- Code = node([byte_builtin_binop(Binop, ByteX, ByteY, ByteVar)])
+ Code = singleton(byte_builtin_binop(Binop, ByteX, ByteY, ByteVar))
;
Expr = unary(Unop, X),
map_arg(ByteInfo, X, ByteX),
map_var(ByteInfo, Var, ByteVar),
- Code = node([byte_builtin_unop(Unop, ByteX, ByteVar)])
+ Code = singleton(byte_builtin_unop(Unop, ByteX, ByteVar))
;
Expr = leaf(X),
map_var(ByteInfo, X, ByteX),
map_var(ByteInfo, Var, ByteVar),
- Code = node([byte_assign(ByteVar, ByteX)])
+ Code = singleton(byte_assign(ByteVar, ByteX))
).
:- pred map_arg(byte_info::in, simple_expr(prog_var)::in(simple_arg_expr),
@@ -503,17 +502,18 @@
map_vars(ByteInfo, Args, ByteArgs),
map_cons_id(ByteInfo, Var, ConsId, ByteConsId),
( ByteConsId = byte_pred_const(_, _, _, _, _) ->
- Code = node([byte_construct(ByteVar, ByteConsId, ByteArgs)])
+ Code = singleton(byte_construct(ByteVar, ByteConsId, ByteArgs))
;
% Don't call map_uni_modes until after
% the pred_const test fails, since the arg-modes on
% unifications that create closures aren't like other arg-modes.
map_uni_modes(UniModes, Args, ByteInfo, Dirs),
( all_dirs_same(Dirs, to_var) ->
- Code = node([byte_construct(ByteVar, ByteConsId, ByteArgs)])
+ Code = singleton(byte_construct(ByteVar, ByteConsId, ByteArgs))
;
assoc_list.from_corresponding_lists(ByteArgs, Dirs, Pairs),
- Code = node([byte_complex_construct(ByteVar, ByteConsId, Pairs)])
+ Code = singleton(byte_complex_construct(ByteVar, ByteConsId,
+ Pairs))
)
).
gen_unify(deconstruct(Var, ConsId, Args, UniModes, _, _), _, _,
@@ -523,15 +523,15 @@
map_cons_id(ByteInfo, Var, ConsId, ByteConsId),
map_uni_modes(UniModes, Args, ByteInfo, Dirs),
( all_dirs_same(Dirs, to_arg) ->
- Code = node([byte_deconstruct(ByteVar, ByteConsId, ByteArgs)])
+ Code = singleton(byte_deconstruct(ByteVar, ByteConsId, ByteArgs))
;
assoc_list.from_corresponding_lists(ByteArgs, Dirs, Pairs),
- Code = node([byte_complex_deconstruct(ByteVar, ByteConsId, Pairs)])
+ Code = singleton(byte_complex_deconstruct(ByteVar, ByteConsId, Pairs))
).
gen_unify(assign(Target, Source), _, _, ByteInfo, Code) :-
map_var(ByteInfo, Target, ByteTarget),
map_var(ByteInfo, Source, ByteSource),
- Code = node([byte_assign(ByteTarget, ByteSource)]).
+ Code = singleton(byte_assign(ByteTarget, ByteSource)).
gen_unify(simple_test(Var1, Var2), _, _, ByteInfo, Code) :-
map_var(ByteInfo, Var1, ByteVar1),
map_var(ByteInfo, Var2, ByteVar2),
@@ -591,7 +591,7 @@
TypeCategory = ctor_cat_system(_),
unexpected(this_file, "system type in simple_test")
),
- Code = node([byte_test(ByteVar1, ByteVar2, TestId)]).
+ Code = singleton(byte_test(ByteVar1, ByteVar2, TestId)).
gen_unify(complicated_unify(_,_,_), _Var, _RHS, _ByteInfo, _Code) :-
unexpected(this_file, "complicated unifications " ++
"should have been handled by polymorphism.m").
@@ -649,7 +649,7 @@
gen_conj([Goal | Goals], !ByteInfo, Code) :-
gen_goal(Goal, !ByteInfo, ThisCode),
gen_conj(Goals, !ByteInfo, OtherCode),
- Code = tree(ThisCode, OtherCode).
+ Code = ThisCode ++ OtherCode.
%---------------------------------------------------------------------------%
@@ -664,17 +664,17 @@
gen_goal(Disjunct, !ByteInfo, ThisCode),
(
Disjuncts = [],
- EnterCode = node([byte_enter_disjunct(-1)]),
- EndofCode = node([byte_endof_disjunct(EndLabel)]),
- Code = tree_list([EnterCode, ThisCode, EndofCode])
+ EnterCode = singleton(byte_enter_disjunct(-1)),
+ EndofCode = singleton(byte_endof_disjunct(EndLabel)),
+ Code = EnterCode ++ ThisCode ++ EndofCode
;
Disjuncts = [_ | _],
gen_disj(Disjuncts, EndLabel, !ByteInfo, OtherCode),
get_next_label(NextLabel, !ByteInfo),
- EnterCode = node([byte_enter_disjunct(NextLabel)]),
- EndofCode = node([byte_endof_disjunct(EndLabel),
+ EnterCode = singleton(byte_enter_disjunct(NextLabel)),
+ EndofCode = from_list([byte_endof_disjunct(EndLabel),
byte_label(NextLabel)]),
- Code = tree_list([EnterCode, ThisCode, EndofCode, OtherCode])
+ Code = EnterCode ++ ThisCode ++ EndofCode ++ OtherCode
).
%---------------------------------------------------------------------------%
@@ -692,10 +692,11 @@
gen_goal(Goal, !ByteInfo, GoalCode),
gen_switch(Cases, Var, EndLabel, !ByteInfo, CasesCode),
get_next_label(NextLabel, !ByteInfo),
- EnterCode = node([
- byte_enter_switch_arm(ByteMainConsId, ByteOtherConsIds, NextLabel)]),
- EndofCode = node([byte_endof_switch_arm(EndLabel), byte_label(NextLabel)]),
- Code = tree_list([EnterCode, GoalCode, EndofCode, CasesCode]).
+ EnterCode = singleton(byte_enter_switch_arm(ByteMainConsId,
+ ByteOtherConsIds, NextLabel)),
+ EndofCode = from_list([byte_endof_switch_arm(EndLabel),
+ byte_label(NextLabel)]),
+ Code = EnterCode ++ GoalCode ++ EndofCode ++ CasesCode.
%---------------------------------------------------------------------------%
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.195
diff -u -b -r1.195 call_gen.m
--- compiler/call_gen.m 25 Nov 2008 07:46:38 -0000 1.195
+++ compiler/call_gen.m 4 Jan 2009 10:51:26 -0000
@@ -31,15 +31,15 @@
%---------------------------------------------------------------------------%
:- pred generate_call(code_model::in, pred_id::in, proc_id::in,
- list(prog_var)::in, hlds_goal_info::in, code_tree::out,
+ list(prog_var)::in, hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is det.
:- pred generate_generic_call(code_model::in, generic_call::in,
list(prog_var)::in, list(mer_mode)::in, determinism::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
+ hlds_goal_info::in, llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_builtin(code_model::in, pred_id::in, proc_id::in,
- list(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ list(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
:- type known_call_variant
---> ho_call_known_num
@@ -70,13 +70,13 @@
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.trace_gen.
:- import_module parse_tree.prog_event.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module maybe.
:- import_module pair.
@@ -107,7 +107,7 @@
call_gen.call_comment(!.CI, PredId, CodeModel, CallComment),
Context = goal_info_get_context(GoalInfo),
GoalPath = goal_info_get_goal_path(GoalInfo),
- CallCode = node([
+ CallCode = from_list([
llds_instr(livevals(LiveVals), ""),
llds_instr(llcall(Address, code_label(ReturnLabel), ReturnLiveLvalues,
Context, GoalPath, CallModel), CallComment),
@@ -134,15 +134,14 @@
->
generate_tailrec_event_code(TraceInfo, ArgsInfos, GoalPath, Context,
TraceTailRecResetAndEventCode, TailRecLabel, !CI),
- JumpCode = node([
+ JumpCode = from_list([
llds_instr(livevals(LiveVals), ""),
llds_instr(goto(code_label(TailRecLabel)),
"tail recursive jump")
]),
- Code = tree_list([SetupCode, TraceTailRecResetAndEventCode, JumpCode])
+ Code = SetupCode ++ TraceTailRecResetAndEventCode ++ JumpCode
;
- Code = tree_list([SetupCode, TraceResetCode, CallCode,
- FailHandlingCode])
+ Code = SetupCode ++ TraceResetCode ++ CallCode ++ FailHandlingCode
).
%---------------------------------------------------------------------------%
@@ -179,7 +178,7 @@
:- pred generate_main_generic_call(code_model::in, generic_call::in,
list(prog_var)::in, list(mer_mode)::in, determinism::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
+ hlds_goal_info::in, llds_code::out, code_info::in, code_info::out)
is det.
generate_main_generic_call(_OuterCodeModel, GenericCall, Args, Modes, Det,
@@ -240,7 +239,7 @@
handle_return(OutArgsInfos, GoalInfo, NonLiveOutputs,
ReturnInstMap, ReturnLiveLvalues, !CI),
- CallCode = node([
+ CallCode = from_list([
llds_instr(livevals(LiveVals), ""),
llds_instr(llcall(CodeAddr, code_label(ReturnLabel), ReturnLiveLvalues,
Context, GoalPath, CallModel), "Setup and call"),
@@ -250,13 +249,13 @@
% If the call can fail, generate code to check for and handle the failure.
handle_call_failure(CodeModel, GoalInfo, FailHandlingCode, !CI),
- Code = tree_list([SetupCode, NonVarCode, TraceCode, CallCode,
- FailHandlingCode]).
+ Code = SetupCode ++ NonVarCode ++ TraceCode ++ CallCode ++
+ FailHandlingCode.
%---------------------------------------------------------------------------%
:- pred generate_event_call(string::in, list(prog_var)::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_event_call(EventName, Args, GoalInfo, Code, !CI) :-
get_module_info(!.CI, ModuleInfo),
@@ -270,13 +269,13 @@
AttrCodes, !CI),
UserEventInfo = user_event_info(EventNumber, MaybeUserAttributes),
generate_user_event_code(UserEventInfo, GoalInfo, EventCode, !CI),
- Code = tree(tree_list(AttrCodes), EventCode)
+ Code = cord_list_to_cord(AttrCodes) ++ EventCode
;
unexpected(this_file, "generate_event_call: bad event name")
).
:- pred generate_event_attributes(list(event_attribute)::in,
- list(prog_var)::in, list(maybe(user_attribute))::out, list(code_tree)::out,
+ list(prog_var)::in, list(maybe(user_attribute))::out, list(llds_code)::out,
code_info::in, code_info::out) is det.
generate_event_attributes([], !.Vars, [], [], !CI) :-
@@ -387,7 +386,7 @@
% constants.
%
:- pred generic_call_nonvar_setup(generic_call::in, known_call_variant::in,
- list(prog_var)::in, list(prog_var)::in, code_tree::out,
+ list(prog_var)::in, list(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
generic_call_nonvar_setup(higher_order(_, _, _, _), HoCallVariant,
@@ -399,25 +398,25 @@
HoCallVariant = ho_call_unknown,
clobber_regs([reg(reg_r, 2)], !CI),
list.length(InVars, NInVars),
- Code = node([
+ Code = singleton(
llds_instr(assign(reg(reg_r, 2), const(llconst_int(NInVars))),
"Assign number of immediate input arguments")
- ])
+ )
).
generic_call_nonvar_setup(class_method(_, Method, _, _), HoCallVariant,
InVars, _OutVars, Code, !CI) :-
(
HoCallVariant = ho_call_known_num,
clobber_regs([reg(reg_r, 2)], !CI),
- Code = node([
+ Code = singleton(
llds_instr(assign(reg(reg_r, 2), const(llconst_int(Method))),
"Index of class method in typeclass info")
- ])
+ )
;
HoCallVariant = ho_call_unknown,
clobber_regs([reg(reg_r, 2), reg(reg_r, 3)], !CI),
list.length(InVars, NInVars),
- Code = node([
+ Code = from_list([
llds_instr(assign(reg(reg_r, 2), const(llconst_int(Method))),
"Index of class method in typeclass info"),
llds_instr(assign(reg(reg_r, 3), const(llconst_int(NInVars))),
@@ -432,7 +431,7 @@
%---------------------------------------------------------------------------%
:- pred prepare_for_call(code_model::in, call_model::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
prepare_for_call(CodeModel, CallModel, TraceCode, !CI) :-
succip_is_used(!CI),
@@ -451,7 +450,7 @@
trace_prepare_for_call(!.CI, TraceCode).
:- pred handle_call_failure(code_model::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
handle_call_failure(CodeModel, GoalInfo, FailHandlingCode, !CI) :-
(
@@ -461,16 +460,15 @@
generate_failure(FailHandlingCode, !CI)
;
get_next_label(ContLab, !CI),
- FailTestCode = node([
+ FailTestCode = singleton(
llds_instr(if_val(lval(reg(reg_r, 1)), code_label(ContLab)),
"test for success")
- ]),
+ ),
generate_failure(FailCode, !CI),
- ContLabelCode = node([
+ ContLabelCode = singleton(
llds_instr(label(ContLab), "")
- ]),
- FailHandlingCode = tree_list([FailTestCode,
- FailCode, ContLabelCode])
+ ),
+ FailHandlingCode = FailTestCode ++ FailCode ++ ContLabelCode
)
;
( CodeModel = model_det
@@ -622,15 +620,15 @@
produce_variable(AddrVar, AddrVarCode, AddrRval, !CI),
produce_variable(ValueVar, ValueVarCode, ValueRval, !CI),
StoreInstr = llds_instr(assign(mem_ref(AddrRval), ValueRval), ""),
- StoreCode = node([StoreInstr]),
- Code = tree_list([AddrVarCode, ValueVarCode, StoreCode])
+ StoreCode = singleton(StoreInstr),
+ Code = AddrVarCode ++ ValueVarCode ++ StoreCode
;
SimpleCode = test(_),
unexpected(this_file, "malformed model_det builtin predicate")
;
SimpleCode = noop(DefinedVars),
list.foldl(magically_put_var_in_unused_reg, DefinedVars, !CI),
- Code = node([])
+ Code = empty
)
;
CodeModel = model_semi,
@@ -638,7 +636,7 @@
SimpleCode = test(TestExpr),
generate_simple_test(TestExpr, Rval, ArgCode, !CI),
fail_if_rval_is_false(Rval, TestCode, !CI),
- Code = tree(ArgCode, TestCode)
+ Code = ArgCode ++ TestCode
;
SimpleCode = assign(_, _),
unexpected(this_file, "malformed model_semi builtin predicate")
@@ -655,7 +653,7 @@
).
:- pred generate_assign_builtin(prog_var::in, simple_expr(prog_var)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_assign_builtin(Var, AssignExpr, Code, !CI) :-
( variable_is_forward_live(!.CI, Var) ->
@@ -676,7 +674,7 @@
binop(BinOp, convert_simple_expr(Expr1), convert_simple_expr(Expr2)).
:- pred generate_simple_test(simple_expr(prog_var)::in(simple_test_expr),
- rval::out, code_tree::out, code_info::in, code_info::out) is det.
+ rval::out, llds_code::out, code_info::in, code_info::out) is det.
generate_simple_test(TestExpr, Rval, ArgCode, !CI) :-
(
@@ -686,7 +684,7 @@
generate_builtin_arg(X1, X, CodeX, !CI),
generate_builtin_arg(Y1, Y, CodeY, !CI),
Rval = binop(BinOp, X, Y),
- ArgCode = tree(CodeX, CodeY)
+ ArgCode = CodeX ++ CodeY
;
TestExpr = unary(UnOp, X0),
X1 = convert_simple_expr(X0),
@@ -694,7 +692,7 @@
Rval = unop(UnOp, X)
).
-:- pred generate_builtin_arg(rval::in, rval::out, code_tree::out,
+:- pred generate_builtin_arg(rval::in, rval::out, llds_code::out,
code_info::in, code_info::out) is det.
generate_builtin_arg(Rval0, Rval, Code, !CI) :-
@@ -745,14 +743,13 @@
%---------------------------------------------------------------------------%
:- pred generate_call_vn_livevals(list(arg_loc)::in, set(prog_var)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_call_vn_livevals(InputArgLocs, OutputArgs, Code, !CI) :-
- generate_call_vn_livevals(!.CI, InputArgLocs, OutputArgs,
- LiveVals),
- Code = node([
+ generate_call_vn_livevals(!.CI, InputArgLocs, OutputArgs, LiveVals),
+ Code = singleton(
llds_instr(livevals(LiveVals), "")
- ]).
+ ).
%---------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.179
diff -u -b -r1.179 code_gen.m
--- compiler/code_gen.m 5 Jan 2009 01:28:48 -0000 1.179
+++ compiler/code_gen.m 5 Jan 2009 03:54:30 -0000
@@ -34,7 +34,7 @@
% Translate a HLDS goal to LLDS.
%
-:- pred generate_goal(code_model::in, hlds_goal::in, code_tree::out,
+:- pred generate_goal(code_model::in, hlds_goal::in, llds_code::out,
code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
@@ -47,7 +47,6 @@
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
:- import_module libs.globals.
-:- import_module libs.tree.
:- import_module ll_backend.call_gen.
:- import_module ll_backend.commit_gen.
:- import_module ll_backend.disj_gen.
@@ -60,6 +59,7 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
+:- import_module cord.
:- import_module io.
:- import_module list.
:- import_module map.
@@ -145,7 +145,7 @@
get_maybe_trace_info(!.CI, yes(_))
->
save_variables_on_stack([CallTableVar], TipSaveCode, !CI),
- CodeUptoTip = tree(GoalCode, TipSaveCode)
+ CodeUptoTip = GoalCode ++ TipSaveCode
;
CodeUptoTip = GoalCode
),
@@ -167,7 +167,7 @@
( set.member(feature_save_deep_excp_vars, Features) ->
DeepSaveVars = compute_deep_save_excp_vars(ProcInfo),
save_variables_on_stack(DeepSaveVars, DeepSaveCode, !CI),
- Code = tree(CodeUptoTip, DeepSaveCode)
+ Code = CodeUptoTip ++ DeepSaveCode
;
Code = CodeUptoTip
),
@@ -187,8 +187,7 @@
( should_trace_code_gen(!.CI) ->
io.format("\nGOAL FINISH: %s\n", [s(GoalDesc)], !IO),
- InstrLists = tree.flatten(Code),
- list.condense(InstrLists, Instrs),
+ Instrs = cord.list(Code),
write_instrs(Instrs, no, yes, !IO)
;
true
@@ -230,7 +229,7 @@
%---------------------------------------------------------------------------%
:- pred generate_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
- code_model::in, set(prog_var)::in, code_tree::out,
+ code_model::in, set(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_goal_2(GoalExpr, GoalInfo, CodeModel, ForwardLiveVarsBeforeGoal,
@@ -242,7 +241,8 @@
GoalExpr = conj(ConjType, Goals),
(
ConjType = plain_conj,
- generate_goals(Goals, CodeModel, Code, !CI)
+ generate_goals(Goals, CodeModel, Codes, !CI),
+ Code = cord_list_to_cord(Codes)
;
ConjType = parallel_conj,
par_conj_gen.generate_par_conj(Goals, GoalInfo, CodeModel, Code,
@@ -318,17 +318,16 @@
% to the next.
%
:- pred generate_goals(hlds_goals::in, code_model::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ list(llds_code)::out, code_info::in, code_info::out) is det.
-generate_goals([], _, empty, !CI).
-generate_goals([Goal | Goals], CodeModel, Code, !CI) :-
- generate_goal(CodeModel, Goal, Code1, !CI),
+generate_goals([], _, [], !CI).
+generate_goals([Goal | Goals], CodeModel, [Code | Codes], !CI) :-
+ generate_goal(CodeModel, Goal, Code, !CI),
get_instmap(!.CI, Instmap),
( instmap_is_unreachable(Instmap) ->
- Code = Code1
+ Codes = []
;
- generate_goals(Goals, CodeModel, Code2, !CI),
- Code = tree(Code1, Code2)
+ generate_goals(Goals, CodeModel, Codes, !CI)
).
%---------------------------------------------------------------------------%
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.371
diff -u -b -r1.371 code_info.m
--- compiler/code_info.m 5 Jan 2009 01:28:48 -0000 1.371
+++ compiler/code_info.m 5 Jan 2009 01:32:52 -0000
@@ -72,13 +72,13 @@
:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module libs.trace_params.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.opt_debug.
:- import_module ll_backend.var_locn.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.mercury_to_mercury.
+:- import_module cord.
:- import_module int.
:- import_module pair.
:- import_module set.
@@ -1200,12 +1200,12 @@
code_info::in, code_info::out) is det.
:- pred generate_branch_end(abs_store_map::in, branch_end::in, branch_end::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred after_all_branches(abs_store_map::in, branch_end::in,
code_info::in, code_info::out) is det.
-:- pred save_hp_in_branch(code_tree::out, lval::out,
+:- pred save_hp_in_branch(llds_code::out, lval::out,
position_info::in, position_info::out, code_info::in, code_info::out)
is det.
@@ -1390,11 +1390,11 @@
:- type disj_hijack_info.
:- pred prepare_for_disj_hijack(code_model::in,
- disj_hijack_info::out, code_tree::out,
+ disj_hijack_info::out, llds_code::out,
code_info::in, code_info::out) is det.
:- pred undo_disj_hijack(disj_hijack_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
% `prepare_for_ite_hijack' should be called before entering
% an if-then-else. It saves the values of any nondet stack slots
@@ -1415,11 +1415,11 @@
:- type ite_hijack_info.
:- pred prepare_for_ite_hijack(code_model::in,
- maybe(embedded_stack_frame_id)::in, ite_hijack_info::out, code_tree::out,
+ maybe(embedded_stack_frame_id)::in, ite_hijack_info::out, llds_code::out,
code_info::in, code_info::out) is det.
:- pred ite_enter_then(ite_hijack_info::in, resume_point_info::in,
- code_tree::out, code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, llds_code::out, code_info::in, code_info::out) is det.
% `enter_simple_neg' and `leave_simple_neg' should be called before
% and after generating the code for a negated unification, in
@@ -1449,10 +1449,10 @@
:- pred prepare_for_det_commit(add_trail_ops::in, add_region_ops::in,
set(prog_var)::in, hlds_goal_info::in, det_commit_info::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_det_commit(det_commit_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
% `prepare_for_semi_commit' and `generate_semi_commit' should be
% called before and after generating the code for the nondet goal
@@ -1466,17 +1466,17 @@
:- pred prepare_for_semi_commit(add_trail_ops::in, add_region_ops::in,
set(prog_var)::in, hlds_goal_info::in, semi_commit_info::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_semi_commit(semi_commit_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
% Put the given resume point into effect, by pushing it on to
% the resume point stack, and if necessary generating code to
% override the redoip of the top nondet stack frame.
%
:- pred effect_resume_point(resume_point_info::in, code_model::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred pop_resume_point(code_info::in, code_info::out) is det.
@@ -1502,13 +1502,13 @@
% Generate code for executing a failure that is appropriate for the
% current failure environment.
%
-:- pred generate_failure(code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_failure(llds_code::out, code_info::in, code_info::out) is det.
% Generate code that checks if the given rval is false, and if yes,
% executes a failure that is appropriate for the current failure
% environment.
%
-:- pred fail_if_rval_is_false(rval::in, code_tree::out,
+:- pred fail_if_rval_is_false(rval::in, llds_code::out,
code_info::in, code_info::out) is det.
% Checks whether the appropriate code for failure in the current
@@ -1525,13 +1525,13 @@
% Materialize the given variables into registers or stack slots.
%
-:- pred produce_vars(set(prog_var)::in, resume_map::out, code_tree::out,
+:- pred produce_vars(set(prog_var)::in, resume_map::out, llds_code::out,
code_info::in, code_info::out) is det.
% Put the variables needed in enclosing failure continuations
% into their stack slots.
%
-:- pred flush_resume_vars_to_stack(code_tree::out,
+:- pred flush_resume_vars_to_stack(llds_code::out,
code_info::in, code_info::out) is det.
% Set up the resume_point_info structure.
@@ -1541,7 +1541,7 @@
% Generate the code for a resume point.
%
-:- pred generate_resume_point(resume_point_info::in, code_tree::out,
+:- pred generate_resume_point(resume_point_info::in, llds_code::out,
code_info::in, code_info::out) is det.
% List the variables that need to be preserved for the given resume point.
@@ -1640,9 +1640,9 @@
; CodeModel = model_semi
),
HijackInfo = disj_no_hijack,
- Code = node([
+ Code = singleton(
llds_instr(comment("disj no hijack"), "")
- ])
+ )
;
CodeModel = model_non,
(
@@ -1661,10 +1661,10 @@
TopResumePoint = stack_only(_, do_fail)
->
HijackInfo = disj_quarter_hijack,
- Code = node([
+ Code = singleton(
llds_instr(comment("disj quarter hijack of do_fail"),
"")
- ])
+ )
;
HijackInfo = disj_temp_frame,
create_temp_frame(do_fail, "prepare for disjunction", Code,
@@ -1677,9 +1677,9 @@
(
ResumeKnown = resume_point_known(has_been_done),
HijackInfo = disj_quarter_hijack,
- Code = node([
+ Code = singleton(
llds_instr(comment("disj quarter hijack"), "")
- ])
+ )
;
( ResumeKnown = resume_point_known(wont_be_done)
; ResumeKnown = resume_point_unknown
@@ -1687,11 +1687,11 @@
acquire_temp_slot(slot_lval(redoip_slot(lval(curfr))),
non_persistent_temp_slot, RedoipSlot, !CI),
HijackInfo = disj_half_hijack(RedoipSlot),
- Code = node([
+ Code = singleton(
llds_instr(assign(RedoipSlot,
lval(redoip_slot(lval(curfr)))),
"prepare for half disj hijack")
- ])
+ )
)
;
CurfrMaxfr = may_be_different,
@@ -1700,7 +1700,7 @@
acquire_temp_slot(slot_lval(redofr_slot(lval(maxfr))),
non_persistent_temp_slot, RedofrSlot, !CI),
HijackInfo = disj_full_hijack(RedoipSlot, RedofrSlot),
- Code = node([
+ Code = from_list([
llds_instr(
assign(RedoipSlot, lval(redoip_slot(lval(maxfr)))),
"prepare for full disj hijack"),
@@ -1725,10 +1725,10 @@
Code = empty
;
HijackInfo = disj_temp_frame,
- Code = node([
+ Code = singleton(
llds_instr(assign(maxfr, lval(prevfr_slot(lval(maxfr)))),
"restore maxfr for temp frame disj")
- ])
+ )
;
HijackInfo = disj_quarter_hijack,
expect(unify(CurfrMaxfr, must_be_equal), this_file,
@@ -1737,10 +1737,10 @@
pick_stack_resume_point(ResumePoint, _, StackLabel),
LabelConst = const(llconst_code_addr(StackLabel)),
% peephole.m looks for the "curfr==maxfr" pattern in the comment.
- Code = node([
+ Code = singleton(
llds_instr(assign(redoip_slot(lval(curfr)), LabelConst),
"restore redoip for quarter disj hijack (curfr==maxfr)")
- ])
+ )
;
HijackInfo = disj_half_hijack(RedoipSlot),
expect(unify(ResumeKnown, resume_point_unknown), this_file,
@@ -1748,15 +1748,15 @@
expect(unify(CurfrMaxfr, must_be_equal), this_file,
"maxfr may differ from curfr in disj_half_hijack"),
% peephole.m looks for the "curfr==maxfr" pattern in the comment.
- Code = node([
+ Code = singleton(
llds_instr(assign(redoip_slot(lval(curfr)), lval(RedoipSlot)),
"restore redoip for half disj hijack (curfr==maxfr)")
- ])
+ )
;
HijackInfo = disj_full_hijack(RedoipSlot, RedofrSlot),
expect(unify(CurfrMaxfr, may_be_different), this_file,
"maxfr same as curfr in disj_full_hijack"),
- Code = node([
+ Code = from_list([
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
"restore redoip for full disj hijack"),
llds_instr(assign(redofr_slot(lval(maxfr)), lval(RedofrSlot)),
@@ -1830,9 +1830,9 @@
expect(unify(MaybeEmbeddedFrameId, no), this_file,
"prepare_for_ite_hijack: MaybeEmbeddedFrameId in model_semi"),
HijackType = ite_no_hijack,
- Code = node([
+ Code = singleton(
llds_instr(comment("ite no hijack"), "")
- ]),
+ ),
MaybeRegionInfo = no
;
CondCodeModel = model_non,
@@ -1846,19 +1846,19 @@
MaxfrSlot, !CI),
HijackType = ite_temp_frame(MaxfrSlot),
create_temp_frame(do_fail, "prepare for ite", TempFrameCode, !CI),
- MaxfrCode = node([
+ MaxfrCode = singleton(
llds_instr(assign(MaxfrSlot, lval(maxfr)), "prepare for ite")
- ]),
+ ),
(
MaybeEmbeddedFrameId = yes(EmbeddedFrameId),
% Note that this slot is intentionally not released anywhere.
acquire_temp_slot(slot_success_record, persistent_temp_slot,
SuccessRecordSlot, !CI),
- InitSuccessCode = node([
+ InitSuccessCode = singleton(
llds_instr(
assign(SuccessRecordSlot, const(llconst_false)),
"record no success of the condition yes")
- ]),
+ ),
MaybeRegionInfo =
yes(ite_region_info(EmbeddedFrameId, SuccessRecordSlot))
;
@@ -1866,30 +1866,26 @@
InitSuccessCode = empty,
MaybeRegionInfo = no
),
- Code = tree_list([
- TempFrameCode,
- MaxfrCode,
- InitSuccessCode
- ])
+ Code = TempFrameCode ++ MaxfrCode ++ InitSuccessCode
;
(
CurfrMaxfr = must_be_equal,
(
ResumeKnown = resume_point_known(_),
HijackType = ite_quarter_hijack,
- Code = node([
+ Code = singleton(
llds_instr(comment("ite quarter hijack"), "")
- ])
+ )
;
ResumeKnown = resume_point_unknown,
acquire_temp_slot(slot_lval(redoip_slot(lval(curfr))),
non_persistent_temp_slot, RedoipSlot, !CI),
HijackType = ite_half_hijack(RedoipSlot),
- Code = node([
+ Code = singleton(
llds_instr(
assign(RedoipSlot, lval(redoip_slot(lval(curfr)))),
"prepare for half ite hijack")
- ])
+ )
)
;
CurfrMaxfr = may_be_different,
@@ -1901,7 +1897,7 @@
non_persistent_temp_slot, MaxfrSlot, !CI),
HijackType = ite_full_hijack(RedoipSlot, RedofrSlot,
MaxfrSlot),
- Code = node([
+ Code = from_list([
llds_instr(
assign(MaxfrSlot, lval(maxfr)),
"prepare for full ite hijack"),
@@ -1938,24 +1934,24 @@
HijackType = ite_temp_frame(MaxfrSlot),
(
MaybeRegionInfo = no,
- ThenCode = node([
+ ThenCode = singleton(
% We can't remove the frame, it may not be on top.
llds_instr(assign(redoip_slot(lval(MaxfrSlot)),
const(llconst_code_addr(do_fail))),
"soft cut for temp frame ite")
- ]),
- ElseCode = node([
+ ),
+ ElseCode = singleton(
% XXX search for assignments to maxfr
llds_instr(assign(maxfr, lval(prevfr_slot(lval(MaxfrSlot)))),
"restore maxfr for temp frame ite")
- ])
+ )
;
MaybeRegionInfo = yes(RegionInfo),
RegionInfo = ite_region_info(EmbeddedStackFrameId,
SuccessRecordSlot),
% XXX replace do_fail with ref to ResumePoint stack label
resume_point_stack_addr(ITEResumePoint, ITEStackResumeCodeAddr),
- ThenCode = node([
+ ThenCode = from_list([
llds_instr(assign(SuccessRecordSlot, const(llconst_true)),
"record success of the condition"),
llds_instr(assign(redoip_slot(lval(MaxfrSlot)),
@@ -1963,7 +1959,7 @@
"redirect to cut for temp frame ite")
]),
get_next_label(AfterRegionOp, !CI),
- ElseCode = node([
+ ElseCode = from_list([
llds_instr(assign(maxfr, lval(prevfr_slot(lval(MaxfrSlot)))),
"restore maxfr for temp frame ite"),
llds_instr(if_val(unop(logical_not, lval(SuccessRecordSlot)),
@@ -1985,10 +1981,10 @@
stack.top_det(ResumePoints, ResumePoint),
( maybe_pick_stack_resume_point(ResumePoint, _, StackLabel) ->
LabelConst = const(llconst_code_addr(StackLabel)),
- ThenCode = node([
+ ThenCode = singleton(
llds_instr(assign(redoip_slot(lval(curfr)), LabelConst),
"restore redoip for quarter ite hijack")
- ])
+ )
;
% This can happen only if ResumePoint is unreachable from here.
ThenCode = empty
@@ -1998,22 +1994,22 @@
HijackType = ite_half_hijack(RedoipSlot),
expect(unify(MaybeRegionInfo, no), this_file,
"ite_enter_then: MaybeRegionInfo ite_half_hijack"),
- ThenCode = node([
+ ThenCode = singleton(
llds_instr(assign(redoip_slot(lval(curfr)), lval(RedoipSlot)),
"restore redoip for half ite hijack")
- ]),
+ ),
ElseCode = ThenCode
;
HijackType = ite_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
expect(unify(MaybeRegionInfo, no), this_file,
"ite_enter_then: MaybeRegionInfo ite_full_hijack"),
- ThenCode = node([
+ ThenCode = from_list([
llds_instr(assign(redoip_slot(lval(MaxfrSlot)), lval(RedoipSlot)),
"restore redoip for full ite hijack"),
llds_instr(assign(redofr_slot(lval(MaxfrSlot)), lval(RedofrSlot)),
"restore redofr for full ite hijack")
]),
- ElseCode = node([
+ ElseCode = from_list([
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
"restore redoip for full ite hijack"),
llds_instr(assign(redofr_slot(lval(maxfr)), lval(RedofrSlot)),
@@ -2049,7 +2045,7 @@
make_fake_resume_map(ResumeVarList, ResumeMap0, ResumeMap),
ResumePoint = orig_only(ResumeMap, do_redo),
effect_resume_point(ResumePoint, model_semi, Code, !CI),
- expect(unify(Code, empty), this_file, "nonempty code for simple neg"),
+ expect(is_empty(Code), this_file, "nonempty code for simple neg"),
pre_goal_update(GoalInfo, does_not_have_subgoals, !CI).
leave_simple_neg(GoalInfo, FailInfo, !CI) :-
@@ -2102,9 +2098,9 @@
CurfrMaxfr = may_be_different,
acquire_temp_slot(slot_lval(maxfr), non_persistent_temp_slot,
MaxfrSlot, !CI),
- SaveMaxfrCode = node([
+ SaveMaxfrCode = singleton(
llds_instr(save_maxfr(MaxfrSlot), "save the value of maxfr")
- ]),
+ ),
MaybeMaxfrSlot = yes(MaxfrSlot)
;
CurfrMaxfr = must_be_equal,
@@ -2117,37 +2113,29 @@
!CI),
DetCommitInfo = det_commit_info(MaybeMaxfrSlot, MaybeTrailSlots,
MaybeRegionCommitFrameInfo),
- Code = tree_list([
- SaveMaxfrCode,
- SaveTrailCode,
- SaveRegionCommitFrameCode
- ]).
+ Code = SaveMaxfrCode ++ SaveTrailCode ++ SaveRegionCommitFrameCode.
generate_det_commit(DetCommitInfo, Code, !CI) :-
DetCommitInfo = det_commit_info(MaybeMaxfrSlot, MaybeTrailSlots,
MaybeRegionCommitFrameInfo),
(
MaybeMaxfrSlot = yes(MaxfrSlot),
- RestoreMaxfrCode = node([
+ RestoreMaxfrCode = singleton(
llds_instr(restore_maxfr(MaxfrSlot),
"restore the value of maxfr - perform commit")
- ]),
+ ),
release_temp_slot(MaxfrSlot, non_persistent_temp_slot, !CI)
;
MaybeMaxfrSlot = no,
- RestoreMaxfrCode = node([
+ RestoreMaxfrCode = singleton(
llds_instr(assign(maxfr, lval(curfr)),
"restore the value of maxfr - perform commit")
- ])
+ )
),
maybe_restore_trail_info(MaybeTrailSlots, CommitTrailCode, _, !CI),
maybe_restore_region_commit_frame(MaybeRegionCommitFrameInfo,
SuccessRegionCode, _FailureRegionCode, !CI),
- Code = tree_list([
- RestoreMaxfrCode,
- CommitTrailCode,
- SuccessRegionCode
- ]).
+ Code = RestoreMaxfrCode ++ CommitTrailCode ++ SuccessRegionCode.
%---------------------------------------------------------------------------%
@@ -2201,10 +2189,10 @@
->
acquire_temp_slot(slot_lval(maxfr), non_persistent_temp_slot,
MaxfrSlot, !CI),
- MaxfrCode = node([
+ MaxfrCode = singleton(
llds_instr(save_maxfr(MaxfrSlot),
"prepare for temp frame commit")
- ]),
+ ),
create_temp_frame(StackLabel,
"prepare for temp frame commit", TempFrameCode, !CI),
get_globals(!.CI, Globals),
@@ -2233,26 +2221,26 @@
"\t\tMR_restore_transient_registers();\n")
],
MD = proc_may_duplicate,
- MarkCode = node([
+ MarkCode = singleton(
llds_instr(foreign_proc_code([], Components,
proc_will_not_call_mercury, no, no, no, no, no, MD), "")
- ])
+ )
;
UseMinimalModelStackCopyCut = no,
MarkCode = empty
),
- HijackCode = tree(MaxfrCode, tree(TempFrameCode, MarkCode))
+ HijackCode = MaxfrCode ++ TempFrameCode ++ MarkCode
;
(
CurfrMaxfr = must_be_equal,
(
ResumeKnown = resume_point_known(has_been_done),
HijackInfo = commit_quarter_hijack,
- HijackCode = node([
+ HijackCode = singleton(
llds_instr(assign(redoip_slot(lval(curfr)),
StackLabelConst),
"hijack the redofr slot")
- ])
+ )
;
( ResumeKnown = resume_point_known(wont_be_done)
; ResumeKnown = resume_point_unknown
@@ -2260,7 +2248,7 @@
acquire_temp_slot(slot_lval(redoip_slot(lval(curfr))),
non_persistent_temp_slot, RedoipSlot, !CI),
HijackInfo = commit_half_hijack(RedoipSlot),
- HijackCode = node([
+ HijackCode = from_list([
llds_instr(assign(RedoipSlot,
lval(redoip_slot(lval(curfr)))),
"prepare for half commit hijack"),
@@ -2278,7 +2266,7 @@
acquire_temp_slot(slot_lval(maxfr),
non_persistent_temp_slot, MaxfrSlot, !CI),
HijackInfo = commit_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
- HijackCode = node([
+ HijackCode = from_list([
llds_instr(assign(RedoipSlot, lval(redoip_slot(lval(maxfr)))),
"prepare for full commit hijack"),
llds_instr(assign(RedofrSlot, lval(redofr_slot(lval(maxfr)))),
@@ -2298,11 +2286,7 @@
!CI),
SemiCommitInfo = semi_commit_info(FailInfo0, NewResumePoint,
HijackInfo, MaybeTrailSlots, MaybeRegionCommitFrameInfo),
- Code = tree_list([
- HijackCode,
- SaveTrailCode,
- SaveRegionCommitFrameCode
- ]).
+ Code = HijackCode ++ SaveTrailCode ++ SaveRegionCommitFrameCode.
generate_semi_commit(SemiCommitInfo, Code, !CI) :-
SemiCommitInfo = semi_commit_info(FailInfo, ResumePoint,
@@ -2312,10 +2296,10 @@
% XXX Should release the temp slots in each arm of the switch.
(
HijackInfo = commit_temp_frame(MaxfrSlot, UseMinimalModel),
- MaxfrCode = node([
+ MaxfrCode = singleton(
llds_instr(restore_maxfr(MaxfrSlot),
"restore maxfr for temp frame hijack")
- ]),
+ ),
(
UseMinimalModel = yes,
% See the comment in prepare_for_semi_commit above.
@@ -2325,48 +2309,48 @@
"\t\tMR_commit_cut();\n")
],
MD = proc_may_duplicate,
- CutCode = node([
+ CutCode = singleton(
llds_instr(foreign_proc_code([], Components,
proc_will_not_call_mercury, no, no, no, no, no, MD),
"commit for temp frame hijack")
- ])
+ )
;
UseMinimalModel = no,
CutCode = empty
),
- SuccessUndoCode = tree(MaxfrCode, CutCode),
- FailureUndoCode = tree(MaxfrCode, CutCode)
+ SuccessUndoCode = MaxfrCode ++ CutCode,
+ FailureUndoCode = MaxfrCode ++ CutCode
;
HijackInfo = commit_quarter_hijack,
FailInfo = fail_info(ResumePoints, _, _, _, _),
stack.top_det(ResumePoints, TopResumePoint),
pick_stack_resume_point(TopResumePoint, _, StackLabel),
StackLabelConst = const(llconst_code_addr(StackLabel)),
- SuccessUndoCode = node([
+ SuccessUndoCode = from_list([
llds_instr(assign(maxfr, lval(curfr)),
"restore maxfr for quarter commit hijack"),
llds_instr(assign(redoip_slot(lval(maxfr)), StackLabelConst),
"restore redoip for quarter commit hijack")
]),
- FailureUndoCode = node([
+ FailureUndoCode = singleton(
llds_instr(assign(redoip_slot(lval(maxfr)), StackLabelConst),
"restore redoip for quarter commit hijack")
- ])
+ )
;
HijackInfo = commit_half_hijack(RedoipSlot),
- SuccessUndoCode = node([
+ SuccessUndoCode = from_list([
llds_instr(assign(maxfr, lval(curfr)),
"restore maxfr for half commit hijack"),
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
"restore redoip for half commit hijack")
]),
- FailureUndoCode = node([
+ FailureUndoCode = singleton(
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
"restore redoip for half commit hijack")
- ])
+ )
;
HijackInfo = commit_full_hijack(RedoipSlot, RedofrSlot, MaxfrSlot),
- SuccessUndoCode = node([
+ SuccessUndoCode = from_list([
llds_instr(restore_maxfr(MaxfrSlot),
"restore maxfr for full commit hijack"),
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
@@ -2374,7 +2358,7 @@
llds_instr(assign(redofr_slot(lval(maxfr)), lval(RedofrSlot)),
"restore redofr for full commit hijack")
]),
- FailureUndoCode = node([
+ FailureUndoCode = from_list([
llds_instr(assign(redoip_slot(lval(maxfr)), lval(RedoipSlot)),
"restore redoip for full commit hijack"),
llds_instr(assign(redofr_slot(lval(maxfr)), lval(RedofrSlot)),
@@ -2393,35 +2377,21 @@
SuccessRegionCode, FailureRegionCode, !CI),
get_next_label(SuccLabel, !CI),
- GotoSuccLabel = node([
+ GotoSuccLabel = singleton(
llds_instr(goto(code_label(SuccLabel)), "Jump to success continuation")
- ]),
- SuccLabelCode = node([
+ ),
+ SuccLabelCode = singleton(
llds_instr(label(SuccLabel), "Success continuation")
- ]),
- SuccessCode = tree_list([
- SuccessUndoCode,
- CommitTrailCode,
- SuccessRegionCode
- ]),
- FailureCode = tree_list([
- ResumePointCode,
- FailureUndoCode,
- RestoreTrailCode,
- FailureRegionCode,
- FailCode
- ]),
- Code = tree_list([
- SuccessCode,
- GotoSuccLabel,
- FailureCode,
- SuccLabelCode
- ]).
+ ),
+ SuccessCode = SuccessUndoCode ++ CommitTrailCode ++ SuccessRegionCode,
+ FailureCode = ResumePointCode ++ FailureUndoCode ++ RestoreTrailCode ++
+ FailureRegionCode ++ FailCode,
+ Code = SuccessCode ++ GotoSuccLabel ++ FailureCode ++ SuccLabelCode.
%---------------------------------------------------------------------------%
:- pred maybe_save_region_commit_frame(add_region_ops::in, set(prog_var)::in,
- hlds_goal_info::in, maybe(region_commit_stack_frame)::out, code_tree::out,
+ hlds_goal_info::in, maybe(region_commit_stack_frame)::out, llds_code::out,
code_info::in, code_info::out) is det.
maybe_save_region_commit_frame(AddRegionOps, _ForwardLiveVarsBeforeGoal,
@@ -2460,7 +2430,7 @@
EmbeddedStackFrame, FixedSize),
acquire_reg(reg_r, NumRegLval, !CI),
acquire_reg(reg_r, AddrRegLval, !CI),
- PushInitCode = node([
+ PushInitCode = from_list([
llds_instr(
push_region_frame(region_stack_commit, EmbeddedStackFrame),
"Save stack pointer of embedded region commit stack"),
@@ -2474,12 +2444,12 @@
]),
save_unprotected_live_regions(NumRegLval, AddrRegLval,
EmbeddedStackFrame, RemovedRegionVarList, FillCode, !CI),
- SetCode = node([
+ SetCode = singleton(
llds_instr(
region_set_fixed_slot(region_set_commit_num_entries,
EmbeddedStackFrame, lval(NumRegLval)),
"Store the number of unprotected live regions")
- ]),
+ ),
release_reg(NumRegLval, !CI),
release_reg(AddrRegLval, !CI),
@@ -2487,34 +2457,30 @@
region_commit_stack_frame(EmbeddedStackFrame, StackVars),
MaybeRegionCommitFrameInfo = yes(RegionCommitFrameInfo),
- Code = tree_list([
- PushInitCode,
- FillCode,
- SetCode
- ])
+ Code = PushInitCode ++ FillCode ++ SetCode
)
).
:- pred save_unprotected_live_regions(lval::in, lval::in,
- embedded_stack_frame_id::in, list(prog_var)::in, code_tree::out,
+ embedded_stack_frame_id::in, list(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
save_unprotected_live_regions(_, _, _, [], empty, !CI).
save_unprotected_live_regions(NumLval, AddrLval, EmbeddedStackFrame,
- [RegionVar | RegionVars], tree(Code, Codes), !CI) :-
+ [RegionVar | RegionVars], Code ++ Codes, !CI) :-
produce_variable(RegionVar, ProduceVarCode, RegionVarRval, !CI),
- SaveCode = node([
+ SaveCode = singleton(
llds_instr(
region_fill_frame(region_fill_commit, EmbeddedStackFrame,
RegionVarRval, NumLval, AddrLval),
"Save the region in the commit stack frame if it is unprotected")
- ]),
- Code = tree(ProduceVarCode, SaveCode),
+ ),
+ Code = ProduceVarCode ++ SaveCode,
save_unprotected_live_regions(NumLval, AddrLval, EmbeddedStackFrame,
RegionVars, Codes, !CI).
:- pred maybe_restore_region_commit_frame(maybe(region_commit_stack_frame)::in,
- code_tree::out, code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, llds_code::out, code_info::in, code_info::out) is det.
maybe_restore_region_commit_frame(MaybeRegionCommitFrameInfo,
SuccessCode, FailureCode, !CI) :-
@@ -2526,18 +2492,18 @@
MaybeRegionCommitFrameInfo = yes(RegionCommitFrameInfo),
RegionCommitFrameInfo = region_commit_stack_frame(EmbeddedStackFrame,
StackVars),
- SuccessCode = node([
+ SuccessCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_commit_success,
EmbeddedStackFrame),
"Destroy removed regions protected by cut away disjunctions")
- ]),
- FailureCode = node([
+ ),
+ FailureCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_commit_failure,
EmbeddedStackFrame),
"Undo the creation of the commit frame")
- ]),
+ ),
release_several_temp_slots(StackVars, non_persistent_temp_slot, !CI)
).
@@ -2552,7 +2518,7 @@
inside_non_condition, Allow),
set_fail_info(FailInfo, !CI).
-:- pred create_temp_frame(code_addr::in, string::in, code_tree::out,
+:- pred create_temp_frame(code_addr::in, string::in, llds_code::out,
code_info::in, code_info::out) is det.
create_temp_frame(Redoip, Comment, Code, !CI) :-
@@ -2561,9 +2527,9 @@
;
Kind = det_stack_proc
),
- Code = node([
+ Code = singleton(
llds_instr(mkframe(temp_frame(Kind), yes(Redoip)), Comment)
- ]),
+ ),
set_created_temp_frame(yes, !CI),
get_fail_info(!.CI, FailInfo0),
FailInfo0 = fail_info(ResumePoints, ResumeKnown, _, CondEnv, Allow),
@@ -2594,10 +2560,10 @@
CodeModel = model_non,
pick_stack_resume_point(ResumePoint, _, StackLabel),
LabelConst = const(llconst_code_addr(StackLabel)),
- Code = node([
+ Code = singleton(
llds_instr(assign(redoip_slot(lval(maxfr)), LabelConst),
"hijack redoip to effect resume point")
- ]),
+ ),
RedoipUpdate = has_been_done
;
( CodeModel = model_det
@@ -2658,11 +2624,11 @@
pick_and_place_vars(AssocList, _, PlaceCode, !CI),
reset_to_position(CurPos, !CI)
),
- BranchCode = node([llds_instr(goto(FailureAddress), "fail")]),
- Code = tree(PlaceCode, BranchCode)
+ BranchCode = singleton(llds_instr(goto(FailureAddress), "fail")),
+ Code = PlaceCode ++ BranchCode
;
ResumeKnown = resume_point_unknown,
- Code = node([llds_instr(goto(do_redo), "fail")])
+ Code = singleton(llds_instr(goto(do_redo), "fail"))
).
fail_if_rval_is_false(Rval0, Code, !CI) :-
@@ -2674,9 +2640,9 @@
( pick_matching_resume_addr(!.CI, TopResumePoint, FailureAddress0) ->
% We branch away if the test *fails*
code_util.neg_rval(Rval0, Rval),
- Code = node([
+ Code = singleton(
llds_instr(if_val(Rval, FailureAddress0), "Test for failure")
- ])
+ )
;
pick_first_resume_point(TopResumePoint, Map, FailureAddress),
map.to_assoc_list(Map, AssocList),
@@ -2689,22 +2655,22 @@
% succeeds, we branch around the code that moves variables to
% their failure locations and branches away to the failure
% continuation.
- TestCode = node([
+ TestCode = singleton(
llds_instr(if_val(Rval0, SuccessAddress), "Test for failure")
- ]),
- TailCode = node([
+ ),
+ TailCode = from_list([
llds_instr(goto(FailureAddress), "Goto failure"),
llds_instr(label(SuccessLabel), "Success continuation")
]),
- Code = tree(TestCode, tree(PlaceCode, TailCode))
+ Code = TestCode ++ PlaceCode ++ TailCode
)
;
ResumeKnown = resume_point_unknown,
% We branch away if the test *fails*
code_util.neg_rval(Rval0, Rval),
- Code = node([
+ Code = singleton(
llds_instr(if_val(Rval, do_redo), "Test for failure")
- ])
+ )
).
%---------------------------------------------------------------------------%
@@ -2831,16 +2797,16 @@
:- pred produce_vars_2(list(prog_var)::in,
map(prog_var, set(lval))::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
produce_vars_2([], Map, empty, !CI) :-
map.init(Map).
-produce_vars_2([V | Vs], Map, Code, !CI) :-
- produce_vars_2(Vs, Map0, Code0, !CI),
- produce_variable_in_reg_or_stack(V, Code1, Lval, !CI),
+produce_vars_2([Var | Vars], Map, Code, !CI) :-
+ produce_vars_2(Vars, Map0, CodeVars, !CI),
+ produce_variable_in_reg_or_stack(Var, CodeVar, Lval, !CI),
set.singleton_set(Lvals, Lval),
- map.set(Map0, V, Lvals, Map),
- Code = tree(Code0, Code1).
+ map.set(Map0, Var, Lvals, Map),
+ Code = CodeVars ++ CodeVar.
flush_resume_vars_to_stack(Code, !CI) :-
compute_resume_var_stack_locs(!.CI, VarLocs),
@@ -3043,50 +3009,50 @@
(
ResumePoint = orig_only(Map1, Addr1),
extract_label_from_code_addr(Addr1, Label1),
- Code = node([
+ Code = singleton(
llds_instr(label(Label1), "orig only failure continuation")
- ]),
+ ),
set_var_locations(Map1, !CI)
;
ResumePoint = stack_only(Map1, Addr1),
extract_label_from_code_addr(Addr1, Label1),
- Code = node([
+ Code = singleton(
llds_instr(label(Label1), "stack only failure continuation")
- ]),
+ ),
set_var_locations(Map1, !CI),
generate_resume_layout(Label1, Map1, !CI)
;
ResumePoint = stack_and_orig(Map1, Addr1, Map2, Addr2),
extract_label_from_code_addr(Addr1, Label1),
extract_label_from_code_addr(Addr2, Label2),
- Label1Code = node([
+ Label1Code = singleton(
llds_instr(label(Label1), "stack failure continuation before orig")
- ]),
+ ),
set_var_locations(Map1, !CI),
generate_resume_layout(Label1, Map1, !CI),
map.to_assoc_list(Map2, AssocList2),
place_resume_vars(AssocList2, PlaceCode, !CI),
- Label2Code = node([
+ Label2Code = singleton(
llds_instr(label(Label2), "orig failure continuation after stack")
- ]),
+ ),
set_var_locations(Map2, !CI),
- Code = tree_list([Label1Code, PlaceCode, Label2Code])
+ Code = Label1Code ++ PlaceCode ++ Label2Code
;
ResumePoint = orig_and_stack(Map1, Addr1, Map2, Addr2),
extract_label_from_code_addr(Addr1, Label1),
extract_label_from_code_addr(Addr2, Label2),
- Label1Code = node([
+ Label1Code = singleton(
llds_instr(label(Label1), "orig failure continuation before stack")
- ]),
+ ),
set_var_locations(Map1, !CI),
map.to_assoc_list(Map2, AssocList2),
place_resume_vars(AssocList2, PlaceCode, !CI),
- Label2Code = node([
+ Label2Code = singleton(
llds_instr(label(Label2), "stack failure continuation after orig")
- ]),
+ ),
set_var_locations(Map2, !CI),
generate_resume_layout(Label2, Map2, !CI),
- Code = tree_list([Label1Code, PlaceCode, Label2Code])
+ Code = Label1Code ++ PlaceCode ++ Label2Code
).
:- pred extract_label_from_code_addr(code_addr::in, label::out) is det.
@@ -3099,23 +3065,23 @@
).
:- pred place_resume_vars(assoc_list(prog_var, set(lval))::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
place_resume_vars([], empty, !CI).
place_resume_vars([Var - TargetSet | Rest], Code, !CI) :-
set.to_sorted_list(TargetSet, Targets),
place_resume_var(Var, Targets, FirstCode, !CI),
- Code = tree(FirstCode, RestCode),
- place_resume_vars(Rest, RestCode, !CI).
+ place_resume_vars(Rest, RestCode, !CI),
+ Code = FirstCode ++ RestCode.
:- pred place_resume_var(prog_var::in, list(lval)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
place_resume_var(_Var, [], empty, !CI).
place_resume_var(Var, [Target | Targets], Code, !CI) :-
place_var(Var, Target, FirstCode, !CI),
place_resume_var(Var, Targets, RestCode, !CI),
- Code = tree(FirstCode, RestCode).
+ Code = FirstCode ++ RestCode.
% Reset the code generator's database of what is where.
% Remember that the variables in the map are available in their
@@ -3158,7 +3124,7 @@
%---------------------------------------------------------------------------%
:- pred maybe_save_trail_info(add_trail_ops::in, maybe(pair(lval))::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
maybe_save_trail_info(AddTrailOps, MaybeTrailSlots, SaveTrailCode, !CI) :-
(
@@ -3168,7 +3134,7 @@
acquire_temp_slot(slot_ticket, non_persistent_temp_slot,
TrailPtrSlot, !CI),
MaybeTrailSlots = yes(CounterSlot - TrailPtrSlot),
- SaveTrailCode = node([
+ SaveTrailCode = from_list([
llds_instr(mark_ticket_stack(CounterSlot),
"save the ticket counter"),
llds_instr(store_ticket(TrailPtrSlot),
@@ -3181,7 +3147,7 @@
).
:- pred maybe_restore_trail_info(maybe(pair(lval))::in,
- code_tree::out, code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, llds_code::out, code_info::in, code_info::out) is det.
maybe_restore_trail_info(MaybeTrailSlots, CommitCode, RestoreCode, !CI) :-
(
@@ -3190,13 +3156,13 @@
RestoreCode = empty
;
MaybeTrailSlots = yes(CounterSlot - TrailPtrSlot),
- CommitCode = node([
+ CommitCode = from_list([
llds_instr(reset_ticket(lval(TrailPtrSlot), reset_reason_commit),
"discard trail entries and restore trail ptr"),
llds_instr(prune_tickets_to(lval(CounterSlot)),
"restore ticket counter (but not high water mark)")
]),
- RestoreCode = node([
+ RestoreCode = from_list([
llds_instr(reset_ticket(lval(TrailPtrSlot), reset_reason_undo),
"apply trail entries and restore trail ptr"),
llds_instr(discard_ticket,
@@ -3363,73 +3329,73 @@
:- interface.
-:- pred save_hp(code_tree::out, lval::out,
+:- pred save_hp(llds_code::out, lval::out,
code_info::in, code_info::out) is det.
-:- pred restore_hp(lval::in, code_tree::out) is det.
+:- pred restore_hp(lval::in, llds_code::out) is det.
:- pred release_hp(lval::in, code_info::in, code_info::out) is det.
-:- pred restore_and_release_hp(lval::in, code_tree::out,
+:- pred restore_and_release_hp(lval::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred maybe_save_hp(bool::in, code_tree::out, maybe(lval)::out,
+:- pred maybe_save_hp(bool::in, llds_code::out, maybe(lval)::out,
code_info::in, code_info::out) is det.
-:- pred maybe_restore_hp(maybe(lval)::in, code_tree::out) is det.
+:- pred maybe_restore_hp(maybe(lval)::in, llds_code::out) is det.
:- pred maybe_release_hp(maybe(lval)::in,
code_info::in, code_info::out) is det.
:- pred maybe_restore_and_release_hp(maybe(lval)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
-:- pred save_ticket(code_tree::out, lval::out,
+:- pred save_ticket(llds_code::out, lval::out,
code_info::in, code_info::out) is det.
-:- pred reset_ticket(lval::in, reset_trail_reason::in, code_tree::out) is det.
+:- pred reset_ticket(lval::in, reset_trail_reason::in, llds_code::out) is det.
:- pred release_ticket(lval::in, code_info::in, code_info::out) is det.
:- pred reset_and_prune_ticket(lval::in, reset_trail_reason::in,
- code_tree::out) is det.
+ llds_code::out) is det.
:- pred reset_prune_and_release_ticket(lval::in, reset_trail_reason::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred reset_and_discard_ticket(lval::in, reset_trail_reason::in,
- code_tree::out) is det.
+ llds_code::out) is det.
:- pred reset_discard_and_release_ticket(lval::in, reset_trail_reason::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
-:- pred discard_and_release_ticket(lval::in, code_tree::out,
+:- pred discard_and_release_ticket(lval::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred maybe_save_ticket(add_trail_ops::in, code_tree::out,
+:- pred maybe_save_ticket(add_trail_ops::in, llds_code::out,
maybe(lval)::out, code_info::in, code_info::out) is det.
:- pred maybe_reset_ticket(maybe(lval)::in, reset_trail_reason::in,
- code_tree::out) is det.
+ llds_code::out) is det.
:- pred maybe_release_ticket(maybe(lval)::in,
code_info::in, code_info::out) is det.
:- pred maybe_reset_and_prune_ticket(maybe(lval)::in,
- reset_trail_reason::in, code_tree::out) is det.
+ reset_trail_reason::in, llds_code::out) is det.
:- pred maybe_reset_prune_and_release_ticket(maybe(lval)::in,
- reset_trail_reason::in, code_tree::out, code_info::in, code_info::out)
+ reset_trail_reason::in, llds_code::out, code_info::in, code_info::out)
is det.
:- pred maybe_reset_and_discard_ticket(maybe(lval)::in,
- reset_trail_reason::in, code_tree::out) is det.
+ reset_trail_reason::in, llds_code::out) is det.
:- pred maybe_reset_discard_and_release_ticket(maybe(lval)::in,
- reset_trail_reason::in, code_tree::out, code_info::in, code_info::out)
+ reset_trail_reason::in, llds_code::out, code_info::in, code_info::out)
is det.
-:- pred maybe_discard_and_release_ticket(maybe(lval)::in, code_tree::out,
+:- pred maybe_discard_and_release_ticket(maybe(lval)::in, llds_code::out,
code_info::in, code_info::out) is det.
% Should we add trail ops to the code we generate for the goal with the
@@ -3448,14 +3414,14 @@
save_hp(Code, HpSlot, !CI) :-
acquire_temp_slot(slot_lval(hp), non_persistent_temp_slot, HpSlot, !CI),
- Code = node([
+ Code = singleton(
llds_instr(mark_hp(HpSlot), "Save heap pointer")
- ]).
+ ).
restore_hp(HpSlot, Code) :-
- Code = node([
+ Code = singleton(
llds_instr(restore_hp(lval(HpSlot)), "Restore heap pointer")
- ]).
+ ).
release_hp(HpSlot, !CI) :-
release_temp_slot(HpSlot, non_persistent_temp_slot, !CI).
@@ -3507,48 +3473,48 @@
save_ticket(Code, TicketSlot, !CI) :-
acquire_temp_slot(slot_ticket, non_persistent_temp_slot, TicketSlot, !CI),
- Code = node([
+ Code = singleton(
llds_instr(store_ticket(TicketSlot), "Save trail state")
- ]).
+ ).
reset_ticket(TicketSlot, Reason, Code) :-
- Code = node([
+ Code = singleton(
llds_instr(reset_ticket(lval(TicketSlot), Reason), "Reset trail")
- ]).
+ ).
release_ticket(TicketSlot, !CI) :-
release_temp_slot(TicketSlot, non_persistent_temp_slot, !CI).
reset_and_prune_ticket(TicketSlot, Reason, Code) :-
- Code = node([
+ Code = from_list([
llds_instr(reset_ticket(lval(TicketSlot), Reason), "Restore trail"),
llds_instr(prune_ticket, "Prune ticket stack")
]).
reset_prune_and_release_ticket(TicketSlot, Reason, Code, !CI) :-
- Code = node([
+ Code = from_list([
llds_instr(reset_ticket(lval(TicketSlot), Reason), "Release trail"),
llds_instr(prune_ticket, "Prune ticket stack")
]),
release_temp_slot(TicketSlot, non_persistent_temp_slot, !CI).
reset_and_discard_ticket(TicketSlot, Reason, Code) :-
- Code = node([
+ Code = from_list([
llds_instr(reset_ticket(lval(TicketSlot), Reason), "Restore trail"),
llds_instr(discard_ticket, "Pop ticket stack")
]).
reset_discard_and_release_ticket(TicketSlot, Reason, Code, !CI) :-
- Code = node([
+ Code = from_list([
llds_instr(reset_ticket(lval(TicketSlot), Reason), "Release trail"),
llds_instr(discard_ticket, "Pop ticket stack")
]),
release_temp_slot(TicketSlot, non_persistent_temp_slot, !CI).
discard_and_release_ticket(TicketSlot, Code, !CI) :-
- Code = node([
+ Code = singleton(
llds_instr(discard_ticket, "Pop ticket stack")
- ]),
+ ),
release_temp_slot(TicketSlot, non_persistent_temp_slot, !CI).
%---------------------------------------------------------------------------%
@@ -3659,13 +3625,13 @@
:- pred assign_var_to_var(prog_var::in, prog_var::in,
code_info::in, code_info::out) is det.
-:- pred assign_lval_to_var(prog_var::in, lval::in, code_tree::out,
+:- pred assign_lval_to_var(prog_var::in, lval::in, llds_code::out,
code_info::in, code_info::out) is det.
:- pred assign_const_to_var(prog_var::in, rval::in,
code_info::in, code_info::out) is det.
-:- pred assign_expr_to_var(prog_var::in, rval::in, code_tree::out,
+:- pred assign_expr_to_var(prog_var::in, rval::in, llds_code::out,
code_info::in, code_info::out) is det.
% assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals, MaybeSize,
@@ -3673,26 +3639,26 @@
%
:- pred assign_cell_to_var(prog_var::in, bool::in, tag::in,
list(maybe(rval))::in, how_to_construct::in, maybe(term_size_value)::in,
- list(int)::in, string::in, may_use_atomic_alloc::in, code_tree::out,
+ list(int)::in, string::in, may_use_atomic_alloc::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred save_reused_cell_fields(prog_var::in, lval::in, code_tree::out,
+:- pred save_reused_cell_fields(prog_var::in, lval::in, llds_code::out,
list(lval)::out, code_info::in, code_info::out) is det.
-:- pred place_var(prog_var::in, lval::in, code_tree::out,
+:- pred place_var(prog_var::in, lval::in, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred produce_variable(prog_var::in, code_tree::out, rval::out,
+:- pred produce_variable(prog_var::in, llds_code::out, rval::out,
code_info::in, code_info::out) is det.
-:- pred produce_variable_in_reg(prog_var::in, code_tree::out,
+:- pred produce_variable_in_reg(prog_var::in, llds_code::out,
lval::out, code_info::in, code_info::out) is det.
:- pred produce_variable_in_reg_or_stack(prog_var::in,
- code_tree::out, lval::out, code_info::in, code_info::out) is det.
+ llds_code::out, lval::out, code_info::in, code_info::out) is det.
:- pred materialize_vars_in_lval(lval::in, lval::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred acquire_reg_for_var(prog_var::in, lval::out,
code_info::in, code_info::out) is det.
@@ -3705,9 +3671,9 @@
:- pred release_reg(lval::in, code_info::in, code_info::out) is det.
-:- pred reserve_r1(code_tree::out, code_info::in, code_info::out) is det.
+:- pred reserve_r1(llds_code::out, code_info::in, code_info::out) is det.
-:- pred clear_r1(code_tree::out, code_info::in, code_info::out) is det.
+:- pred clear_r1(llds_code::out, code_info::in, code_info::out) is det.
:- type call_direction
---> caller
@@ -3727,13 +3693,13 @@
% - The input arguments will be moved to their registers.
%
:- pred setup_call(hlds_goal_info::in, assoc_list(prog_var, arg_info)::in,
- set(lval)::out, code_tree::out, code_info::in, code_info::out) is det.
+ set(lval)::out, llds_code::out, code_info::in, code_info::out) is det.
% Move the output arguments of the current procedure to where
% they need to be at return.
%
:- pred setup_return(assoc_list(prog_var, arg_info)::in,
- set(lval)::out, code_tree::out, code_info::in, code_info::out) is det.
+ set(lval)::out, llds_code::out, code_info::in, code_info::out) is det.
:- pred lock_regs(int::in, assoc_list(prog_var, lval)::in,
code_info::in, code_info::out) is det.
@@ -3749,10 +3715,10 @@
:- pred clobber_regs(list(lval)::in, code_info::in, code_info::out) is det.
-:- pred save_variables(set(prog_var)::in, set(lval)::out, code_tree::out,
+:- pred save_variables(set(prog_var)::in, set(lval)::out, llds_code::out,
code_info::in, code_info::out) is det.
-:- pred save_variables_on_stack(list(prog_var)::in, code_tree::out,
+:- pred save_variables_on_stack(list(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
:- pred max_reg_in_use(code_info::in, int::out) is det.
@@ -3845,7 +3811,7 @@
set_var_locn_info(VarLocnInfo, !CI).
:- pred pick_and_place_vars(assoc_list(prog_var, set(lval))::in,
- set(lval)::out, code_tree::out, code_info::in, code_info::out) is det.
+ set(lval)::out, llds_code::out, code_info::in, code_info::out) is det.
pick_and_place_vars(VarLocSets, LiveLocs, Code, !CI) :-
pick_var_places(VarLocSets, VarLocs),
@@ -3869,7 +3835,7 @@
).
:- pred place_vars(assoc_list(prog_var, lval)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
place_vars(VarLocs, Code, !CI) :-
get_var_locn_info(!.CI, VarLocnInfo0),
@@ -4056,7 +4022,7 @@
).
:- pred setup_call_args(assoc_list(prog_var, arg_info)::in,
- call_direction::in, set(lval)::out, code_tree::out,
+ call_direction::in, set(lval)::out, llds_code::out,
code_info::in, code_info::out) is det.
setup_call_args(AllArgsInfos, Direction, LiveLocs, Code, !CI) :-
Index: compiler/commit_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/commit_gen.m,v
retrieving revision 1.20
diff -u -b -r1.20 commit_gen.m
--- compiler/commit_gen.m 9 Oct 2007 07:59:46 -0000 1.20
+++ compiler/commit_gen.m 4 Jan 2009 11:07:05 -0000
@@ -27,7 +27,7 @@
%---------------------------------------------------------------------------%
:- pred generate_scope(scope_reason::in, code_model::in, hlds_goal_info::in,
- set(prog_var)::in, hlds_goal::in, code_tree::out,
+ set(prog_var)::in, hlds_goal::in, llds_code::out,
code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
@@ -36,9 +36,9 @@
:- implementation.
:- import_module libs.compiler_util.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
+:- import_module cord.
:- import_module list.
:- import_module maybe.
:- import_module pair.
@@ -61,7 +61,7 @@
).
:- pred generate_commit(code_model::in, hlds_goal_info::in, set(prog_var)::in,
- hlds_goal::in, code_tree::out, code_info::in, code_info::out) is det.
+ hlds_goal::in, llds_code::out, code_info::in, code_info::out) is det.
generate_commit(OuterCodeModel, OuterGoalInfo, ForwardLiveVarsBeforeGoal,
Goal, Code, !CI) :-
@@ -86,7 +86,7 @@
PreCommit, !CI),
code_gen.generate_goal(InnerCodeModel, Goal, GoalCode, !CI),
generate_det_commit(CommitInfo, Commit, !CI),
- Code = tree_list([PreCommit, GoalCode, Commit])
+ Code = PreCommit ++ GoalCode ++ Commit
)
;
OuterCodeModel = model_semi,
@@ -103,7 +103,7 @@
PreCommit, !CI),
code_gen.generate_goal(InnerCodeModel, Goal, GoalCode, !CI),
generate_semi_commit(CommitInfo, Commit, !CI),
- Code = tree_list([PreCommit, GoalCode, Commit])
+ Code = PreCommit ++ GoalCode ++ Commit
)
;
OuterCodeModel = model_non,
Index: compiler/dense_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dense_switch.m,v
retrieving revision 1.70
diff -u -b -r1.70 dense_switch.m
--- compiler/dense_switch.m 30 Dec 2007 08:23:35 -0000 1.70
+++ compiler/dense_switch.m 4 Jan 2009 11:08:38 -0000
@@ -42,7 +42,7 @@
%
:- pred generate_dense_switch(list(tagged_case)::in, rval::in, string::in,
code_model::in, hlds_goal_info::in, dense_switch_info::in,
- label::in, branch_end::in, branch_end::out, code_tree::out,
+ label::in, branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -58,12 +58,12 @@
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_out.
:- import_module libs.compiler_util.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.trace_gen.
:- import_module parse_tree.prog_type.
:- import_module assoc_list.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -153,16 +153,16 @@
list.map_foldl3(generate_dense_case(VarName, CodeModel, SwitchGoalInfo,
EndLabel), TaggedCases, CasesCodes,
map.init, IndexMap, MaybeEnd0, MaybeEnd, !CI),
- CasesCode = tree_list(CasesCodes),
+ CasesCode = cord_list_to_cord(CasesCodes),
% Generate the jump table.
map.to_assoc_list(IndexMap, IndexPairs),
generate_dense_jump_table(FirstVal, LastVal, IndexPairs, Targets,
no, MaybeFailLabel, !CI),
- JumpCode = node([
+ JumpCode = singleton(
llds_instr(computed_goto(IndexRval, Targets),
"switch (using dense jump table)")
- ]),
+ ),
% If there is no case for any index value in range, generate the failure
% code we execute for such cases.
@@ -172,25 +172,24 @@
;
MaybeFailLabel = yes(FailLabel),
FailComment = "compiler-introduced `fail' case of dense switch",
- FailLabelCode = node([
+ FailLabelCode = singleton(
llds_instr(label(FailLabel), FailComment)
- ]),
+ ),
generate_failure(FailureCode, !CI),
- FailCode = tree(FailLabelCode, FailureCode)
+ FailCode = FailLabelCode ++ FailureCode
),
- EndLabelCode = node([
+ EndLabelCode = singleton(
llds_instr(label(EndLabel), "end of dense switch")
- ]),
+ ),
% Assemble the code fragments.
- Code = tree_list([RangeCheckCode, JumpCode, CasesCode, FailCode,
- EndLabelCode]).
+ Code = RangeCheckCode ++ JumpCode ++ CasesCode ++ FailCode ++ EndLabelCode.
%---------------------------------------------------------------------------%
:- pred generate_dense_case(string::in, code_model::in, hlds_goal_info::in,
- label::in, tagged_case::in, code_tree::out,
+ label::in, tagged_case::in, llds_code::out,
map(int, label)::in, map(int, label)::out,
branch_end::in, branch_end::out,
code_info::in, code_info::out) is det.
@@ -206,22 +205,21 @@
record_dense_label_for_cons_tag(Label, MainConsTag, !IndexMap),
list.foldl(record_dense_label_for_cons_tag(Label), OtherConsTags,
!IndexMap),
- LabelCode = node([
+ LabelCode = singleton(
llds_instr(label(Label), LabelComment)
- ]),
+ ),
% We need to save the expression cache, etc.,
% and restore them when we've finished.
remember_position(!.CI, BranchStart),
maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode, !CI),
code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- BranchToEndCode = node([
+ BranchToEndCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"branch to end of dense switch")
- ]),
+ ),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
- BranchToEndCode]),
+ Code = LabelCode ++ TraceCode ++ GoalCode ++ SaveCode ++ BranchToEndCode,
reset_to_position(BranchStart, !CI).
:- pred record_dense_label_for_cons_tag(label::in, cons_tag::in,
Index: compiler/disj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/disj_gen.m,v
retrieving revision 1.111
diff -u -b -r1.111 disj_gen.m
--- compiler/disj_gen.m 6 Jun 2008 07:51:51 -0000 1.111
+++ compiler/disj_gen.m 4 Jan 2009 11:14:44 -0000
@@ -26,7 +26,7 @@
%-----------------------------------------------------------------------------%
:- pred generate_disj(code_model::in, list(hlds_goal)::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -39,8 +39,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.exprn_aux.
@@ -50,6 +48,7 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -108,16 +107,16 @@
lds_cur_slot :: lval,
lds_resume_map :: resume_map,
- lds_flush_code :: code_tree,
+ lds_flush_code :: llds_code,
- lds_save_ticket_code :: code_tree,
+ lds_save_ticket_code :: llds_code,
lds_maybe_ticket_slot :: maybe(lval),
- lds_save_hp_code :: code_tree,
+ lds_save_hp_code :: llds_code,
lds_maybe_hp_slot :: maybe(lval),
lds_hijack_info :: disj_hijack_info,
- lds_prepare_hijack_code :: code_tree,
+ lds_prepare_hijack_code :: llds_code,
ldi_solns :: list(list(rval)),
ldi_field_types :: list(llds_type)
@@ -192,7 +191,7 @@
Solns, LLDSTypes).
:- pred generate_lookup_disj(set(prog_var)::in, lookup_disj_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
LookupDisjInfo = lookup_disj_info(OutVars, StoreMap, MaybeEnd, Liveness,
@@ -213,15 +212,15 @@
% generate_branch_end won't want to overwrite BaseReg.
acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
- BaseRegInitCode = node([
+ BaseRegInitCode = singleton(
llds_instr(assign(BaseReg,
mem_addr(heap_ref(SolnVectorAddrRval, 0, const(llconst_int(0))))),
"Compute base address for this case")
- ]),
- SaveSlotCode = node([
+ ),
+ SaveSlotCode = singleton(
llds_instr(assign(CurSlot, const(llconst_int(NumOutVars))),
"Setup current slot in the solution array")
- ]),
+ ),
remember_position(!.CI, DisjEntry),
@@ -243,9 +242,9 @@
FirstBranchEndCode, !CI),
release_reg(BaseReg, !CI),
- GotoEndCode = node([
+ GotoEndCode = singleton(
llds_instr(goto(code_label(EndLabel)), "goto end of lookup disj")
- ]),
+ ),
reset_to_position(DisjEntry, !CI),
generate_resume_point(ResumePoint, ResumePointCode, !CI),
@@ -257,7 +256,7 @@
get_next_label(UndoLabel, !CI),
get_next_label(AfterUndoLabel, !CI),
MaxSlot = (NumSolns - 1) * NumOutVars,
- TestMoreSolnsCode = node([
+ TestMoreSolnsCode = from_list([
llds_instr(assign(LaterBaseReg, lval(CurSlot)),
"Init later base register"),
llds_instr(if_val(binop(int_ge, lval(LaterBaseReg),
@@ -273,7 +272,7 @@
"Undo hijack code")
]),
undo_disj_hijack(HijackInfo, UndoHijackCode, !CI),
- AfterUndoLabelCode = node([
+ AfterUndoLabelCode = from_list([
llds_instr(label(AfterUndoLabel),
"Return later answer code"),
llds_instr(assign(LaterBaseReg,
@@ -303,37 +302,40 @@
after_all_branches(StoreMap, MaybeEnd, !CI),
- EndLabelCode = node([llds_instr(label(EndLabel), "end of lookup disj")]),
- Comment = node([llds_instr(comment("lookup disj"), "")]),
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel), "end of lookup disj")
+ ),
+ Comment = singleton(
+ llds_instr(comment("lookup disj"), "")
+ ),
- Code = tree_list([
- Comment,
- FlushCode,
- BaseRegInitCode,
- SaveSlotCode,
- SaveTicketCode,
- SaveHpCode,
- PrepareHijackCode,
- UpdateRedoipCode,
- FirstFlushResumeVarsCode,
- FirstBranchEndCode,
- GotoEndCode,
- ResumePointCode,
- RestoreTicketCode,
- RestoreHpCode,
- TestMoreSolnsCode,
- UndoHijackCode,
- AfterUndoLabelCode,
- LaterFlushResumeVarsCode,
- LaterBranchEndCode,
- EndLabelCode
- ]).
+ Code =
+ Comment ++
+ FlushCode ++
+ BaseRegInitCode ++
+ SaveSlotCode ++
+ SaveTicketCode ++
+ SaveHpCode ++
+ PrepareHijackCode ++
+ UpdateRedoipCode ++
+ FirstFlushResumeVarsCode ++
+ FirstBranchEndCode ++
+ GotoEndCode ++
+ ResumePointCode ++
+ RestoreTicketCode ++
+ RestoreHpCode ++
+ TestMoreSolnsCode ++
+ UndoHijackCode ++
+ AfterUndoLabelCode ++
+ LaterFlushResumeVarsCode ++
+ LaterBranchEndCode ++
+ EndLabelCode.
%---------------------------------------------------------------------------%
:- pred generate_real_disj(add_trail_ops::in, add_region_ops::in,
code_model::in, set(prog_var)::in, list(hlds_goal)::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_real_disj(AddTrailOps, AddRegionOps, CodeModel, ResumeVars, Goals,
DisjGoalInfo, Code, !CI) :-
@@ -444,21 +446,15 @@
% The resume point is unchanged.
),
- Code = tree_list([
- FlushCode,
- SaveTicketCode,
- SaveHpCode,
- BeforeEnterRegionCode,
- PrepareHijackCode,
- GoalsCode
- ]).
+ Code = FlushCode ++ SaveTicketCode ++ SaveHpCode ++
+ BeforeEnterRegionCode ++ PrepareHijackCode ++ GoalsCode.
:- pred generate_disjuncts(list(hlds_goal)::in, code_model::in,
resume_map::in, maybe(resume_point_info)::in, disj_hijack_info::in,
hlds_goal_info::in, commit_disj_region_cleanup::in, label::in, bool::in,
- maybe(lval)::in, maybe(lval)::in, code_tree::in, code_tree::in,
+ maybe(lval)::in, maybe(lval)::in, llds_code::in, llds_code::in,
position_info::in, maybe(branch_end_info)::in, maybe(branch_end_info)::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_disjuncts([], _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
unexpected(this_file, "generate_disjuncts: empty disjunction!").
@@ -527,9 +523,9 @@
save_hp_in_branch(BranchSaveHpCode, BranchHpSlot,
BranchStart0, BranchStart, !CI),
- tree.flatten(SaveHpCode, HpCodeList),
- tree.flatten(BranchSaveHpCode, BranchHpCodeList),
- expect(unify(HpCodeList, BranchHpCodeList), this_file,
+ HpCodeInstrs = cord.list(SaveHpCode),
+ BranchHpCodeInstrs = cord.list(BranchSaveHpCode),
+ expect(unify(HpCodeInstrs, BranchHpCodeInstrs), this_file,
"cannot use same code for saving hp"),
expect(unify(HpSlot, BranchHpSlot), this_file,
"cannot allocate same slot for saved hp")
@@ -589,17 +585,17 @@
(
RegionCommitDisjCleanup = no_commit_disj_region_cleanup,
- BranchCode = node([
+ BranchCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"skip to end of disjunction")
- ])
+ )
;
RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
_CleanupCode),
- BranchCode = node([
+ BranchCode = singleton(
llds_instr(goto(code_label(CleanupLabel)),
"skip to end of disjunction after nonlast region disjunct")
- ])
+ )
),
generate_disjuncts(Goals, CodeModel, FullResumeMap,
@@ -609,21 +605,20 @@
LaterRegionCode, LastRegionCode, BranchStart,
MaybeEnd1, MaybeEnd, RestCode, !CI),
- Code = tree_list([
- EntryResumePointCode,
- RestoreHpCode,
- RestoreTicketCode,
- SaveHpCode,
- ThisDisjunctRegionCode,
- ModContCode,
- TraceCode,
- GoalCode,
- ResumeVarsCode,
- PruneTicketCode,
- SaveCode,
- BranchCode,
+ Code =
+ EntryResumePointCode ++
+ RestoreHpCode ++
+ RestoreTicketCode ++
+ SaveHpCode ++
+ ThisDisjunctRegionCode ++
+ ModContCode ++
+ TraceCode ++
+ GoalCode ++
+ ResumeVarsCode ++
+ PruneTicketCode ++
+ SaveCode ++
+ BranchCode ++
RestCode
- ])
;
Resume = no_resume_point,
@@ -648,32 +643,31 @@
;
RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
CleanupCode),
- RegionCleanupStartCode = node([
+ RegionCleanupStartCode = from_list([
llds_instr(goto(code_label(EndLabel)),
"Skip over cleanup code at end of disjunction"),
llds_instr(label(CleanupLabel),
"Cleanup at end of disjunction")
]),
- RegionCleanupCode = tree(RegionCleanupStartCode, CleanupCode)
+ RegionCleanupCode = RegionCleanupStartCode ++ CleanupCode
),
- EndLabelCode = node([
+ EndLabelCode = singleton(
llds_instr(label(EndLabel),
"End of disjunction")
- ]),
+ ),
- Code = tree_list([
- EntryResumePointCode,
- TraceCode, % XXX Should this be after LastRegionCode?
- RestoreHpCode,
- RestoreTicketCode,
- LastRegionCode,
- UndoCode,
- GoalCode,
- SaveCode,
- RegionCleanupCode,
+ Code =
+ EntryResumePointCode ++
+ TraceCode ++ % XXX Should this be after LastRegionCode?
+ RestoreHpCode ++
+ RestoreTicketCode ++
+ LastRegionCode ++
+ UndoCode ++
+ GoalCode ++
+ SaveCode ++
+ RegionCleanupCode ++
EndLabelCode
- ])
).
%-----------------------------------------------------------------------------%
@@ -682,11 +676,11 @@
---> no_commit_disj_region_cleanup
; commit_disj_region_cleanup(
cleanup_label :: label,
- cleanup_code :: code_tree
+ cleanup_code :: llds_code
).
:- pred maybe_create_disj_region_frame_nondet(add_region_ops::in,
- hlds_goal_info::in, code_tree::out, code_tree::out, code_tree::out,
+ hlds_goal_info::in, llds_code::out, llds_code::out, llds_code::out,
code_info::in, code_info::out) is det.
maybe_create_disj_region_frame_nondet(DisjRegionOps, _DisjGoalInfo,
@@ -730,7 +724,7 @@
first_nonfixed_embedded_slot_addr(EmbeddedStackFrame, FixedSize),
acquire_reg(reg_r, SnapshotNumRegLval, !CI),
acquire_reg(reg_r, AddrRegLval, !CI),
- PushInitCode = node([
+ PushInitCode = from_list([
llds_instr(
push_region_frame(region_stack_disj, EmbeddedStackFrame),
"Save stack pointer of embedded region nondet stack"),
@@ -744,37 +738,33 @@
disj_alloc_snapshot_regions(SnapshotNumRegLval, AddrRegLval,
EmbeddedStackFrame, SnapshotRegionVarList, SnapshotRegionCode,
!CI),
- SetCode = node([
+ SetCode = singleton(
llds_instr(
region_set_fixed_slot(region_set_disj_num_snapshots,
EmbeddedStackFrame, lval(SnapshotNumRegLval)),
"Store the number of snapshot_infos")
- ]),
+ ),
release_reg(SnapshotNumRegLval, !CI),
release_reg(AddrRegLval, !CI),
- BeforeEnterCode = tree_list([
- PushInitCode,
- SnapshotRegionCode,
- SetCode
- ]),
- LaterCode = node([
+ BeforeEnterCode = PushInitCode ++ SnapshotRegionCode ++ SetCode,
+ LaterCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_disj_later,
EmbeddedStackFrame),
"region enter later disjunct")
- ]),
- LastCode = node([
+ ),
+ LastCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_disj_last,
EmbeddedStackFrame),
"region enter last disjunct")
- ])
+ )
).
:- pred maybe_create_disj_region_frame_semi(add_region_ops::in,
- set(prog_var)::in, set(prog_var)::in, code_tree::out, code_tree::out,
- code_tree::out, list(lval)::out, commit_disj_region_cleanup::out,
+ set(prog_var)::in, set(prog_var)::in, llds_code::out, llds_code::out,
+ llds_code::out, list(lval)::out, commit_disj_region_cleanup::out,
code_info::in, code_info::out) is det.
maybe_create_disj_region_frame_semi(DisjRegionOps, DisjRemovedRegionVars,
@@ -832,7 +822,7 @@
acquire_reg(reg_r, ProtectNumRegLval, !CI),
acquire_reg(reg_r, SnapshotNumRegLval, !CI),
acquire_reg(reg_r, AddrRegLval, !CI),
- PushInitCode = node([
+ PushInitCode = from_list([
llds_instr(
push_region_frame(region_stack_disj, EmbeddedStackFrame),
"Save stack pointer of embedded region nondet stack"),
@@ -852,7 +842,7 @@
disj_alloc_snapshot_regions(SnapshotNumRegLval, AddrRegLval,
EmbeddedStackFrame, SnapshotRegionVarList, SnapshotRegionCode,
!CI),
- SetCode = node([
+ SetCode = from_list([
llds_instr(
region_set_fixed_slot(region_set_disj_num_protects,
EmbeddedStackFrame, lval(ProtectNumRegLval)),
@@ -866,68 +856,64 @@
release_reg(SnapshotNumRegLval, !CI),
release_reg(AddrRegLval, !CI),
- BeforeEnterCode = tree_list([
- PushInitCode,
- ProtectRegionCode,
- SnapshotRegionCode,
- SetCode
- ]),
- LaterCode = node([
+ BeforeEnterCode = PushInitCode ++ ProtectRegionCode ++
+ SnapshotRegionCode ++ SetCode,
+ LaterCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_disj_later,
EmbeddedStackFrame),
"region enter later disjunct")
- ]),
- LastCode = node([
+ ),
+ LastCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(region_disj_last,
EmbeddedStackFrame),
"region enter last disjunct")
- ]),
+ ),
get_next_label(CleanupLabel, !CI),
- CleanupCode = node([
+ CleanupCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(
region_disj_nonlast_semi_commit, EmbeddedStackFrame),
"region cleanup commit for nonlast disjunct")
- ]),
+ ),
RegionCommitDisjCleanup = commit_disj_region_cleanup(CleanupLabel,
CleanupCode)
).
:- pred disj_protect_regions(lval::in, lval::in, embedded_stack_frame_id::in,
- list(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ list(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
disj_protect_regions(_, _, _, [], empty, !CI).
disj_protect_regions(NumLval, AddrLval, EmbeddedStackFrame,
- [RegionVar | RegionVars], tree(Code, Codes), !CI) :-
+ [RegionVar | RegionVars], Code ++ Codes, !CI) :-
produce_variable(RegionVar, ProduceVarCode, RegionVarRval, !CI),
- SaveCode = node([
+ SaveCode = singleton(
llds_instr(
region_fill_frame(region_fill_semi_disj_protect,
EmbeddedStackFrame, RegionVarRval, NumLval, AddrLval),
"disj protect the region if needed")
- ]),
- Code = tree(ProduceVarCode, SaveCode),
+ ),
+ Code = ProduceVarCode ++ SaveCode,
disj_protect_regions(NumLval, AddrLval, EmbeddedStackFrame,
RegionVars, Codes, !CI).
:- pred disj_alloc_snapshot_regions(lval::in, lval::in,
- embedded_stack_frame_id::in, list(prog_var)::in, code_tree::out,
+ embedded_stack_frame_id::in, list(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
disj_alloc_snapshot_regions(_, _, _, [], empty, !CI).
disj_alloc_snapshot_regions(NumLval, AddrLval, EmbeddedStackFrame,
- [RegionVar | RegionVars], tree(Code, Codes), !CI) :-
+ [RegionVar | RegionVars], Code ++ Codes, !CI) :-
produce_variable(RegionVar, ProduceVarCode, RegionVarRval, !CI),
- SaveCode = node([
+ SaveCode = singleton(
llds_instr(
region_fill_frame(region_fill_disj_snapshot,
EmbeddedStackFrame, RegionVarRval, NumLval, AddrLval),
"take alloc snapshot of the region")
- ]),
- Code = tree(ProduceVarCode, SaveCode),
+ ),
+ Code = ProduceVarCode ++ SaveCode,
disj_alloc_snapshot_regions(NumLval, AddrLval, EmbeddedStackFrame,
RegionVars, Codes, !CI).
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.107
diff -u -b -r1.107 ite_gen.m
--- compiler/ite_gen.m 23 Dec 2008 01:37:35 -0000 1.107
+++ compiler/ite_gen.m 4 Jan 2009 11:18:28 -0000
@@ -27,10 +27,10 @@
:- pred generate_ite(code_model::in,
hlds_goal::in, hlds_goal::in, hlds_goal::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_negation(code_model::in, hlds_goal::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -46,7 +46,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.opt_debug.
@@ -58,6 +57,7 @@
:- import_module transform_hlds.rbmm.region_transformation.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module io.
:- import_module list.
@@ -217,8 +217,7 @@
trace [compiletime(flag("codegen_goal")), io(!S)] (
( should_trace_code_gen(!.CI) ->
- ResumeInstrLists = tree.flatten(ResumeCode),
- list.condense(ResumeInstrLists, ResumeInstrs),
+ ResumeInstrs = cord.list(ResumeCode),
io.write_string("\nRESUME INSTRS:\n", !S),
write_instrs(ResumeInstrs, no, yes, !S)
;
@@ -239,8 +238,7 @@
trace [compiletime(flag("codegen_goal")), io(!S)] (
( should_trace_code_gen(!.CI) ->
- ElseSaveInstrLists = tree.flatten(ElseSaveCode),
- list.condense(ElseSaveInstrLists, ElseSaveInstrs),
+ ElseSaveInstrs = cord.list(ElseSaveCode),
io.write_string("\nBRANCH END INSTRS:\n", !S),
write_instrs(ElseSaveInstrs, no, yes, !S)
;
@@ -249,43 +247,43 @@
),
get_next_label(EndLabel, !CI),
- JumpToEndCode = node([
+ JumpToEndCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"Jump to the end of if-then-else")
- ]),
- EndLabelCode = node([
+ ),
+ EndLabelCode = singleton(
llds_instr(label(EndLabel), "end of if-then-else")
- ]),
+ ),
make_pneg_context_wrappers(Globals, CondInfo, PNegCondCode, PNegThenCode,
PNegElseCode),
- Code = tree_list([
- FlushCode,
- SaveHpCode,
- SaveTicketCode,
- RegionCondCode,
- PrepareHijackCode,
- EffectResumeCode,
- CondTraceCode,
- PNegCondCode,
- CondCode,
- ThenNeckCode,
- ResetTicketCode,
- RegionThenCode,
- ThenTraceCode,
- PNegThenCode,
- ThenCode,
- ThenSaveCode,
- JumpToEndCode,
- ResumeCode,
- ElseNeckCode,
- RestoreHpCode,
- RestoreTicketCode,
- RegionElseCode,
- ElseTraceCode,
- PNegElseCode,
- ElseCode,
- ElseSaveCode,
- EndLabelCode]),
+ Code =
+ FlushCode ++
+ SaveHpCode ++
+ SaveTicketCode ++
+ RegionCondCode ++
+ PrepareHijackCode ++
+ EffectResumeCode ++
+ CondTraceCode ++
+ PNegCondCode ++
+ CondCode ++
+ ThenNeckCode ++
+ ResetTicketCode ++
+ RegionThenCode ++
+ ThenTraceCode ++
+ PNegThenCode ++
+ ThenCode ++
+ ThenSaveCode ++
+ JumpToEndCode ++
+ ResumeCode ++
+ ElseNeckCode ++
+ RestoreHpCode ++
+ RestoreTicketCode ++
+ RegionElseCode ++
+ ElseTraceCode ++
+ PNegElseCode ++
+ ElseCode ++
+ ElseSaveCode ++
+ EndLabelCode,
after_all_branches(StoreMap, MaybeEnd, !CI).
%-----------------------------------------------------------------------------%
@@ -339,16 +337,12 @@
;
Op = eq
),
- TestCode = node([
+ TestCode = singleton(
llds_instr(if_val(binop(Op, ValL, ValR), CodeAddr),
"test inequality")
- ]),
+ ),
leave_simple_neg(GoalInfo, SimpleNeg, !CI),
- Code = tree_list([
- CodeL,
- CodeR,
- TestCode
- ])
+ Code = CodeL ++ CodeR ++ TestCode
;
generate_negation_general(CodeModel, Goal, NotGoalInfo,
ResumeVars, ResumeLocs, Code, !CI)
@@ -359,7 +353,7 @@
%
:- pred generate_negation_general(code_model::in,
hlds_goal::in, hlds_goal_info::in, set(prog_var)::in,
- resume_locs::in, code_tree::out, code_info::in, code_info::out) is det.
+ resume_locs::in, llds_code::out, code_info::in, code_info::out) is det.
generate_negation_general(CodeModel, Goal, NotGoalInfo, ResumeVars, ResumeLocs,
Code, !CI) :-
@@ -459,30 +453,29 @@
make_pneg_context_wrappers(Globals, NotGoalInfo, PNegCondCode,
PNegThenCode, PNegElseCode),
- Code = tree_list([
- FlushCode,
- PrepareHijackCode,
- EffectResumeCode,
- SaveHpCode,
- SaveTicketCode,
- RegionCondCode,
- EnterTraceCode,
- PNegCondCode,
- GoalCode,
- ThenNeckCode,
- PruneTicketCode,
- RegionThenCode,
- FailTraceCode,
- PNegThenCode,
- FailCode,
- ResumeCode,
- ElseNeckCode,
- RestoreTicketCode,
- RestoreHpCode,
- RegionElseCode,
- SuccessTraceCode,
- PNegElseCode
- ]).
+ Code =
+ FlushCode ++
+ PrepareHijackCode ++
+ EffectResumeCode ++
+ SaveHpCode ++
+ SaveTicketCode ++
+ RegionCondCode ++
+ EnterTraceCode ++
+ PNegCondCode ++
+ GoalCode ++
+ ThenNeckCode ++
+ PruneTicketCode ++
+ RegionThenCode ++
+ FailTraceCode ++
+ PNegThenCode ++
+ FailCode ++
+ ResumeCode ++
+ ElseNeckCode ++
+ RestoreTicketCode ++
+ RestoreHpCode ++
+ RegionElseCode ++
+ SuccessTraceCode ++
+ PNegElseCode.
%---------------------------------------------------------------------------%
@@ -499,7 +492,7 @@
% MR_pneg_enter_{cond,then,exit}.
%
:- pred make_pneg_context_wrappers(globals::in, hlds_goal_info::in,
- code_tree::out, code_tree::out, code_tree::out) is det.
+ llds_code::out, llds_code::out, llds_code::out) is det.
make_pneg_context_wrappers(Globals, GoalInfo, PNegCondCode, PNegThenCode,
PNegElseCode) :-
@@ -537,18 +530,18 @@
wrap_transient("\t\tMR_pneg_enter_else(" ++ CtxtStr ++ ");\n"))
],
MD = proc_may_duplicate,
- PNegCondCode = node([
+ PNegCondCode = singleton(
llds_instr(foreign_proc_code([], PNegCondComponents,
proc_will_not_call_mercury, no, no, no, no, yes, MD), "")
- ]),
- PNegThenCode = node([
+ ),
+ PNegThenCode = singleton(
llds_instr(foreign_proc_code([], PNegThenComponents,
proc_will_not_call_mercury, no, no, no, no, yes, MD), "")
- ]),
- PNegElseCode = node([
+ ),
+ PNegElseCode = singleton(
llds_instr(foreign_proc_code([], PNegElseComponents,
proc_will_not_call_mercury, no, no, no, no, yes, MD), "")
- ])
+ )
;
PNegCondCode = empty,
PNegThenCode = empty,
@@ -567,7 +560,7 @@
:- pred maybe_create_ite_region_frame(add_region_ops::in,
hlds_goal_info::in, list(hlds_goal)::in, list(hlds_goal)::in,
- code_tree::out, code_tree::out, code_tree::out, list(lval)::out,
+ llds_code::out, llds_code::out, llds_code::out, list(lval)::out,
maybe(embedded_stack_frame_id)::out, code_info::in, code_info::out) is det.
maybe_create_ite_region_frame(IteRegionOps, CondGoalInfo, CondGoals, ElseGoals,
@@ -663,7 +656,7 @@
acquire_reg(reg_r, ProtectNumRegLval, !CI),
acquire_reg(reg_r, SnapshotNumRegLval, !CI),
acquire_reg(reg_r, AddrRegLval, !CI),
- PushInitCode = node([
+ PushInitCode = from_list([
llds_instr(
push_region_frame(region_stack_ite,
EmbeddedStackFrameId),
@@ -685,7 +678,7 @@
ite_alloc_snapshot_regions(SnapshotNumRegLval, AddrRegLval,
EmbeddedStackFrameId, RemovedAtStartOfElse,
SnapshotRegionVarList, SnapshotRegionCode, !CI),
- SetCode = node([
+ SetCode = from_list([
llds_instr(
region_set_fixed_slot(region_set_ite_num_protects,
EmbeddedStackFrameId, lval(ProtectNumRegLval)),
@@ -714,26 +707,22 @@
"maybe_create_ite_region_frame: det cond")
),
- CondCode = tree_list([
- PushInitCode,
- ProtectRegionCode,
- SnapshotRegionCode,
- SetCode
- ]),
- ThenCode = node([
+ CondCode = PushInitCode ++ ProtectRegionCode ++
+ SnapshotRegionCode ++ SetCode,
+ ThenCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(
region_ite_then(CondKind),
EmbeddedStackFrameId),
"region enter then")
- ]),
- ElseCode = node([
+ ),
+ ElseCode = singleton(
llds_instr(
use_and_maybe_pop_region_frame(
region_ite_else(CondKind),
EmbeddedStackFrameId),
"region enter else")
- ])
+ )
% XXX A model_non condition can succeed more than once, so
% the region_ite_then(region_ite_nondet_cond) operation
@@ -769,42 +758,42 @@
).
:- pred ite_protect_regions(lval::in, lval::in, embedded_stack_frame_id::in,
- list(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ list(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
ite_protect_regions(_, _, _, [], empty, !CI).
ite_protect_regions(NumLval, AddrLval, EmbeddedStackFrameId,
- [RegionVar | RegionVars], tree(Code, Codes), !CI) :-
+ [RegionVar | RegionVars], Code ++ Codes, !CI) :-
produce_variable(RegionVar, ProduceVarCode, RegionVarRval, !CI),
- SaveCode = node([
+ SaveCode = singleton(
llds_instr(
region_fill_frame(region_fill_ite_protect,
EmbeddedStackFrameId, RegionVarRval, NumLval, AddrLval),
"ite protect the region if needed")
- ]),
- Code = tree(ProduceVarCode, SaveCode),
+ ),
+ Code = ProduceVarCode ++ SaveCode,
ite_protect_regions(NumLval, AddrLval, EmbeddedStackFrameId,
RegionVars, Codes, !CI).
:- pred ite_alloc_snapshot_regions(lval::in, lval::in,
embedded_stack_frame_id::in, set(prog_var)::in,
- list(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ list(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
ite_alloc_snapshot_regions(_, _, _, _, [], empty, !CI).
ite_alloc_snapshot_regions(NumLval, AddrLval, EmbeddedStackFrameId,
- RemovedVars, [RegionVar | RegionVars], tree(Code, Codes), !CI) :-
+ RemovedVars, [RegionVar | RegionVars], Code ++ Codes, !CI) :-
produce_variable(RegionVar, ProduceVarCode, RegionVarRval, !CI),
( set.member(RegionVar, RemovedVars) ->
RemovedAtStartOfElse = removed_at_start_of_else
;
RemovedAtStartOfElse = not_removed_at_start_of_else
),
- SaveCode = node([
+ SaveCode = singleton(
llds_instr(
region_fill_frame(region_fill_ite_snapshot(RemovedAtStartOfElse),
EmbeddedStackFrameId, RegionVarRval, NumLval, AddrLval),
"take alloc snapshot of the region")
- ]),
- Code = tree(ProduceVarCode, SaveCode),
+ ),
+ Code = ProduceVarCode ++ SaveCode,
ite_alloc_snapshot_regions(NumLval, AddrLval, EmbeddedStackFrameId,
RemovedVars, RegionVars, Codes, !CI).
Index: compiler/libs.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/libs.m,v
retrieving revision 1.10
diff -u -b -r1.10 libs.m
--- compiler/libs.m 25 Jul 2008 00:47:56 -0000 1.10
+++ compiler/libs.m 4 Jan 2009 04:54:03 -0000
@@ -27,7 +27,6 @@
:- include_module file_util.
:- include_module graph_colour.
:- include_module pickle.
-:- include_module tree.
% OS interfaces not provided by the standard library.
:- include_module process_util.
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.361
diff -u -b -r1.361 llds.m
--- compiler/llds.m 2 Jun 2008 02:27:27 -0000 1.361
+++ compiler/llds.m 4 Jan 2009 04:54:42 -0000
@@ -25,7 +25,6 @@
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_pred.
-:- import_module libs.tree.
:- import_module ll_backend.layout.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
@@ -33,6 +32,7 @@
:- import_module parse_tree.prog_foreign.
:- import_module bool.
+:- import_module cord.
:- import_module list.
:- import_module assoc_list.
:- import_module map.
@@ -204,7 +204,7 @@
% We build up instructions as trees and then flatten the tree to a list.
%
-:- type code_tree == tree(list(instruction)).
+:- type llds_code == cord(instruction).
:- type instruction
---> llds_instr(
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.81
diff -u -b -r1.81 lookup_switch.m
--- compiler/lookup_switch.m 2 Jun 2008 02:27:27 -0000 1.81
+++ compiler/lookup_switch.m 4 Jan 2009 11:21:22 -0000
@@ -65,7 +65,7 @@
% Generate code for the switch that the lookup_switch_info came from.
%
:- pred generate_lookup_switch(rval::in, abs_store_map::in, branch_end::in,
- lookup_switch_info::in, code_tree::out, code_info::in, code_info::out)
+ lookup_switch_info::in, llds_code::out, code_info::in, code_info::out)
is det.
%-----------------------------------------------------------------------------%
@@ -81,7 +81,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.dense_switch.
:- import_module ll_backend.global_data.
@@ -90,6 +89,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -419,7 +419,9 @@
(
CaseConsts = all_one_soln(CaseValues),
- Comment = node([llds_instr(comment("simple lookup switch"), "")]),
+ Comment = singleton(
+ llds_instr(comment("simple lookup switch"), "")
+ ),
generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
StartVal, EndVal, CaseValues, OutVars, LLDSTypes,
NeedBitVecCheck, Liveness, RestCode, !CI)
@@ -434,19 +436,19 @@
GoalsMayModifyTrail = no,
AddTrailOps = do_not_add_trail_ops
),
- Comment = node([
+ Comment = singleton(
llds_instr(comment("several soln lookup switch"), "")
- ]),
+ ),
generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
LLDSTypes, NeedBitVecCheck, Liveness, RestCode, !CI)
),
- Code = tree_list([Comment, RangeCheckCode, RestCode]).
+ Code = Comment ++ RangeCheckCode ++ RestCode.
:- pred generate_simple_lookup_switch(rval::in, abs_store_map::in,
branch_end::in, int::in, int::in, assoc_list(int, list(rval))::in,
list(prog_var)::in, list(llds_type)::in, need_bit_vec_check::in,
- set(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ set(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0, StartVal, EndVal,
CaseValues, OutVars, LLDSTypes, NeedBitVecCheck, Liveness, Code,
@@ -491,7 +493,7 @@
MaybeBaseReg = yes(FinalBaseReg),
release_reg(FinalBaseReg, !CI)
),
- Code = tree_list([CheckBitVecCode, BaseRegInitCode, BranchEndCode]).
+ Code = CheckBitVecCode ++ BaseRegInitCode ++ BranchEndCode.
% Add an expression to the expression cache in the code_info structure
% for each of the output variables of the lookup switch. This is done by
@@ -500,7 +502,7 @@
%
:- pred generate_simple_terms(rval::in, list(prog_var)::in,
list(llds_type)::in, assoc_list(int, list(rval))::in, int::in,
- lval::in, code_tree::out, code_info::in, code_info::out) is det.
+ lval::in, llds_code::out, code_info::in, code_info::out) is det.
generate_simple_terms(IndexRval, OutVars, OutTypes, CaseVals, Start, BaseReg,
Code, !CI) :-
@@ -515,11 +517,11 @@
;
BaseRval = binop(int_mul, IndexRval, const(llconst_int(NumOutVars)))
),
- Code = node([
+ Code = singleton(
llds_instr(
assign(BaseReg, mem_addr(heap_ref(VectorAddrRval, 0, BaseRval))),
"Compute base address for this case")
- ]),
+ ),
generate_offset_assigns(OutVars, 0, BaseReg, !CI).
:- pred construct_simple_vector(int::in, list(llds_type)::in,
@@ -545,7 +547,7 @@
branch_end::in, int::in, int::in, assoc_list(int, soln_consts)::in,
set(prog_var)::in, add_trail_ops::in, list(prog_var)::in,
list(llds_type)::in, need_bit_vec_check::in, set(prog_var)::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
@@ -610,12 +612,12 @@
non_persistent_temp_slot, MaxSlot, !CI),
% IndexRval has already had Start subtracted from it.
BaseRval = binop(int_mul, IndexRval, const(llconst_int(MainRowWidth))),
- BaseRegInitCode = node([
+ BaseRegInitCode = singleton(
llds_instr(
assign(BaseReg,
mem_addr(heap_ref(MainVectorAddrRval, 0, BaseRval))),
"Compute base address for this case")
- ]),
+ ),
list.sort([FailCaseCount - kind_zero_solns,
OneSolnCaseCount - kind_one_soln,
@@ -630,10 +632,10 @@
KindsCode, !CI),
set_resume_point_to_unknown(!CI),
- EndLabelCode = node([
+ EndLabelCode = singleton(
llds_instr(label(EndLabel), "end of several_soln lookup switch")
- ]),
- Code = tree_list([BaseRegInitCode, KindsCode, EndLabelCode]).
+ ),
+ Code = BaseRegInitCode ++ KindsCode ++ EndLabelCode.
:- type case_kind
---> kind_zero_solns
@@ -649,7 +651,7 @@
:- pred generate_code_for_each_kind(assoc_list(int, case_kind)::in,
lval::in, lval::in, lval::in, rval::in, label::in, position_info::in,
set(prog_var)::in, add_trail_ops::in, list(prog_var)::in,
- abs_store_map::in, branch_end::in, set(prog_var)::in, code_tree::out,
+ abs_store_map::in, branch_end::in, set(prog_var)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_code_for_each_kind([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
@@ -671,11 +673,11 @@
set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
BranchEndCode, !CI),
release_reg(BaseReg, !CI),
- GotoEndCode = node([
+ GotoEndCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"goto end of switch from one_soln")
- ]),
- KindCode = tree_list([BranchEndCode, GotoEndCode])
+ ),
+ KindCode = BranchEndCode ++ GotoEndCode
;
Kind = kind_several_solns,
TestOp = int_le,
@@ -686,7 +688,7 @@
% specialized for the situation here.
produce_vars(ResumeVars, ResumeMap, FlushCode, !CI),
- SaveSlotsCode = node([
+ SaveSlotsCode = from_list([
llds_instr(assign(CurSlot,
lval(field(yes(0), lval(BaseReg), const(llconst_int(0))))),
"Setup current slot in the later solution array"),
@@ -723,10 +725,10 @@
FirstBranchEndCode, !CI),
release_reg(BaseReg, !CI),
- GotoEndCode = node([
+ GotoEndCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"goto end of switch from several_soln")
- ]),
+ ),
reset_to_position(DisjEntry, !CI),
generate_resume_point(ResumePoint, ResumePointCode, !CI),
@@ -739,7 +741,7 @@
get_next_label(UndoLabel, !CI),
get_next_label(AfterUndoLabel, !CI),
list.length(OutVars, NumOutVars),
- TestMoreSolnsCode = node([
+ TestMoreSolnsCode = from_list([
llds_instr(assign(LaterBaseReg, lval(CurSlot)),
"Init later base register"),
llds_instr(if_val(binop(int_ge, lval(LaterBaseReg), lval(MaxSlot)),
@@ -754,7 +756,7 @@
"Undo hijack code")
]),
undo_disj_hijack(HijackInfo, UndoHijackCode, !CI),
- AfterUndoLabelCode = node([
+ AfterUndoLabelCode = from_list([
llds_instr(label(AfterUndoLabel),
"Return later answer code"),
llds_instr(assign(LaterBaseReg,
@@ -784,12 +786,13 @@
set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
LaterBranchEndCode, !CI),
- KindCode = tree_list([FlushCode, SaveSlotsCode,
- SaveTicketCode, SaveHpCode, PrepareHijackCode,
- UpdateRedoipCode, FirstFlushResumeVarsCode, FirstBranchEndCode,
- GotoEndCode, ResumePointCode, RestoreTicketCode, RestoreHpCode,
- TestMoreSolnsCode, UndoHijackCode, AfterUndoLabelCode,
- LaterFlushResumeVarsCode, LaterBranchEndCode, GotoEndCode])
+ KindCode = FlushCode ++ SaveSlotsCode ++
+ SaveTicketCode ++ SaveHpCode ++ PrepareHijackCode ++
+ UpdateRedoipCode ++ FirstFlushResumeVarsCode ++
+ FirstBranchEndCode ++ GotoEndCode ++ ResumePointCode ++
+ RestoreTicketCode ++ RestoreHpCode ++
+ TestMoreSolnsCode ++ UndoHijackCode ++ AfterUndoLabelCode ++
+ LaterFlushResumeVarsCode ++ LaterBranchEndCode ++ GotoEndCode
),
(
Kinds = [],
@@ -800,7 +803,7 @@
TestRval = binop(TestOp,
lval(field(yes(0), lval(BaseReg), const(llconst_int(0)))),
const(llconst_int(0))),
- TestCode = node([
+ TestCode = from_list([
llds_instr(if_val(TestRval, code_label(NextKindLabel)),
"skip to next kind in several_soln lookup switch"),
llds_instr(comment("This kind is " ++ case_kind_to_string(Kind)),
@@ -810,15 +813,14 @@
LaterVectorAddrRval, EndLabel, BranchStart, ResumeVars,
AddTrailOps, OutVars, StoreMap, MaybeEnd0, Liveness,
LaterKindsCode, !CI),
- NextKindLabelCode = node([
+ NextKindLabelCode = from_list([
llds_instr(label(NextKindLabel),
"next kind in several_soln lookup switch"),
llds_instr(comment("Next kind is "
++ case_kind_to_string(NextKind)),
"")
]),
- Code = tree_list([TestCode, KindCode, NextKindLabelCode,
- LaterKindsCode])
+ Code = TestCode ++ KindCode ++ NextKindLabelCode ++ LaterKindsCode
).
% Note that we specify --optimise-constructor-last-call for this module
@@ -903,7 +905,7 @@
% tag value.
%
:- pred generate_bitvec_test(rval::in, assoc_list(int, T)::in,
- int::in, int::in, code_tree::out, code_info::in, code_info::out) is det.
+ int::in, int::in, llds_code::out, code_info::in, code_info::out) is det.
generate_bitvec_test(IndexRval, CaseVals, Start, _End, CheckCode, !CI) :-
get_word_bits(!.CI, WordBits, Log2WordBits),
Index: compiler/lookup_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_util.m,v
retrieving revision 1.8
diff -u -b -r1.8 lookup_util.m
--- compiler/lookup_util.m 23 Dec 2008 01:37:35 -0000 1.8
+++ compiler/lookup_util.m 4 Jan 2009 11:22:15 -0000
@@ -67,7 +67,7 @@
code_info::in, code_info::out) is semidet.
:- pred set_liveness_and_end_branch(abs_store_map::in, branch_end::in,
- set(prog_var)::in, code_tree::out, code_info::in, code_info::out) is det.
+ set(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_offset_assigns(list(prog_var)::in, int::in, lval::in,
code_info::in, code_info::out) is det.
@@ -81,11 +81,11 @@
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
:- import_module libs.globals.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.exprn_aux.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module pair.
:- import_module solutions.
@@ -150,7 +150,7 @@
Goal = hlds_goal(_GoalExpr, GoalInfo),
CodeModel = goal_info_get_code_model(GoalInfo),
code_gen.generate_goal(CodeModel, Goal, Code, !CI),
- tree.tree_of_lists_is_empty(Code),
+ cord.is_empty(Code),
get_forward_live_vars(!.CI, Liveness),
get_exprn_opts(!.CI, ExprnOpts),
@@ -190,7 +190,7 @@
get_arm_rvals([], [], !CI, _ExprnOpts).
get_arm_rvals([Var | Vars], [Rval | Rvals], !CI, ExprnOpts) :-
produce_variable(Var, Code, Rval, !CI),
- tree.tree_of_lists_is_empty(Code),
+ cord.is_empty(Code),
rval_is_constant(Rval, ExprnOpts),
get_arm_rvals(Vars, Rvals, !CI, ExprnOpts).
@@ -224,7 +224,7 @@
generate_offset_assigns([Var | Vars], Offset, BaseReg, !CI) :-
LookupLval = field(yes(0), lval(BaseReg), const(llconst_int(Offset))),
assign_lval_to_var(Var, LookupLval, Code, !CI),
- expect(tree.is_empty(Code), this_file,
+ expect(cord.is_empty(Code), this_file,
"generate_offset_assigns: nonempty code"),
generate_offset_assigns(Vars, Offset + 1, BaseReg, !CI).
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.136
diff -u -b -r1.136 middle_rec.m
--- compiler/middle_rec.m 23 Dec 2008 01:37:36 -0000 1.136
+++ compiler/middle_rec.m 4 Jan 2009 11:35:22 -0000
@@ -20,7 +20,7 @@
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
-:- pred match_and_generate(hlds_goal::in, code_tree::out,
+:- pred match_and_generate(hlds_goal::in, llds_code::out,
code_info::in, code_info::out) is semidet.
%---------------------------------------------------------------------------%
@@ -34,7 +34,6 @@
:- import_module hlds.code_model.
:- import_module hlds.hlds_llds.
:- import_module libs.compiler_util.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.code_util.
:- import_module ll_backend.llds_out.
@@ -45,6 +44,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module maybe.
@@ -236,11 +236,11 @@
%---------------------------------------------------------------------------%
:- pred middle_rec_generate_switch(prog_var::in, cons_id::in, hlds_goal::in,
- hlds_goal::in, hlds_goal_info::in, code_tree::out,
+ hlds_goal::in, hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is semidet.
middle_rec_generate_switch(Var, BaseConsId, Base, Recursive, SwitchGoalInfo,
- Instrs, !CI) :-
+ Code, !CI) :-
get_stack_slots(!.CI, StackSlots),
get_varset(!.CI, VarSet),
SlotsComment = explain_stack_slots(StackSlots, VarSet),
@@ -254,8 +254,7 @@
CheaperTagTest = lookup_cheaper_tag_test(!.CI, VarType),
generate_tag_test(Var, BaseConsId, CheaperTagTest, branch_on_success,
BaseLabel, EntryTestCode, !CI),
- tree.flatten(EntryTestCode, EntryTestListList),
- list.condense(EntryTestListList, EntryTestList),
+ EntryTestInstrs = cord.list(EntryTestCode),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
remember_position(!.CI, BranchStart),
@@ -273,148 +272,146 @@
assoc_list.from_corresponding_lists(HeadVars, ArgModes, Args),
setup_return(Args, LiveArgs, EpilogCode, !CI),
- BaseCode = tree_list([BaseGoalCode, BaseSaveCode, EpilogCode]),
- RecCode = tree_list([RecGoalCode, RecSaveCode, EpilogCode]),
- LiveValCode = [llds_instr(livevals(LiveArgs), "")],
-
- tree.flatten(BaseCode, BaseListList),
- list.condense(BaseListList, BaseList),
- tree.flatten(RecCode, RecListList),
- list.condense(RecListList, RecList),
+ BaseCode = BaseGoalCode ++ BaseSaveCode ++ EpilogCode,
+ RecCode = RecGoalCode ++ RecSaveCode ++ EpilogCode,
+ LiveValCode = singleton(
+ llds_instr(livevals(LiveArgs), "")
+ ),
+
+ BaseInstrs = cord.list(BaseCode),
+ RecInstrs = cord.list(RecCode),
% In the code we generate, the base instruction sequence is executed
% in situations where this procedure has no stack frame. If this
% sequence refers to the stack frame, it will be to some other procedure's
% variables, which is obviously incorrect.
- opt_util.block_refers_to_stack(BaseList) = no,
+ opt_util.block_refers_to_stack(BaseInstrs) = no,
- list.append(BaseList, RecList, AvoidList),
- find_unused_register(AvoidList, AuxReg),
+ AvoidInstrs = BaseInstrs ++ RecInstrs,
+ find_unused_register(AvoidInstrs, AuxReg),
- split_rec_code(RecList, BeforeList0, AfterList),
- add_counter_to_livevals(BeforeList0, AuxReg, BeforeList),
+ split_rec_code(RecInstrs, BeforeInstrs0, AfterInstrs),
+ add_counter_to_livevals(BeforeInstrs0, AuxReg, BeforeInstrs),
get_next_label(Loop1Label, !CI),
get_next_label(Loop2Label, !CI),
get_total_stackslot_count(!.CI, FrameSize),
- generate_downloop_test(EntryTestList, Loop1Label, Loop1Test),
+ generate_downloop_test(EntryTestInstrs, Loop1Label, Loop1Test),
( FrameSize = 0 ->
- MaybeIncrSp = [],
- MaybeDecrSp = [],
- InitAuxReg = [
+ MaybeIncrSp = empty,
+ MaybeDecrSp = empty,
+ InitAuxReg = singleton(
llds_instr(assign(AuxReg, const(llconst_int(0))),
"initialize counter register")
- ],
- IncrAuxReg = [
+ ),
+ IncrAuxReg = singleton(
llds_instr(
assign(AuxReg,
binop(int_add, lval(AuxReg), const(llconst_int(1)))),
"increment loop counter")
- ],
- DecrAuxReg = [
+ ),
+ DecrAuxReg = singleton(
llds_instr(
assign(AuxReg,
binop(int_sub, lval(AuxReg), const(llconst_int(1)))),
"decrement loop counter")
- ],
- TestAuxReg = [
+ ),
+ TestAuxReg = singleton(
llds_instr(
if_val(binop(int_gt, lval(AuxReg), const(llconst_int(0))),
code_label(Loop2Label)),
"test on upward loop")
- ]
+ )
;
PushMsg = proc_gen.push_msg(ModuleInfo, PredId, ProcId),
- MaybeIncrSp = [
+ MaybeIncrSp = singleton(
llds_instr(incr_sp(FrameSize, PushMsg, stack_incr_nonleaf), "")
- ],
- MaybeDecrSp = [llds_instr(decr_sp(FrameSize), "")],
- InitAuxReg = [
- llds_instr(assign(AuxReg, lval(sp)),
- "initialize counter register")
- ],
- IncrAuxReg = [],
- DecrAuxReg = [],
- TestAuxReg = [
+ ),
+ MaybeDecrSp = singleton(
+ llds_instr(decr_sp(FrameSize), "")
+ ),
+ InitAuxReg = singleton(
+ llds_instr(assign(AuxReg, lval(sp)), "initialize counter register")
+ ),
+ IncrAuxReg = empty,
+ DecrAuxReg = empty,
+ TestAuxReg = singleton(
llds_instr(if_val(binop(int_gt, lval(sp), lval(AuxReg)),
code_label(Loop2Label)),
"test on upward loop")
- ]
+ )
),
% Even though the recursive call is followed by some goals in the HLDS,
% these goals may generate no LLDS code, so it is in fact possible for
- % AfterList to be empty. There is no point in testing BeforeList for empty,
- % since if it is, the code is an infinite loop anyway.
+ % AfterInstrs to be empty. There is no point in testing BeforeInstrs
+ % for empty, since if it is, the code is an infinite loop anyway.
(
- AfterList = [],
- list.condense([
- [
+ AfterInstrs = [],
+ Code =
+ from_list([
llds_instr(label(EntryLabel), "Procedure entry point"),
llds_instr(comment(SlotsComment), "")
- ],
- EntryTestList,
- [
+ ]) ++
+ from_list(EntryTestInstrs) ++
+ singleton(
llds_instr(label(Loop1Label), "start of the down loop")
- ],
- BeforeList,
- Loop1Test,
- [
+ ) ++
+ from_list(BeforeInstrs) ++
+ from_list(Loop1Test) ++
+ singleton(
llds_instr(label(BaseLabel), "start of base case")
- ],
- BaseList,
- LiveValCode,
- [
+ ) ++
+ from_list(BaseInstrs) ++
+ LiveValCode ++
+ singleton(
llds_instr(goto(code_succip), "exit from base case")
- ]
- ], InstrList)
+ )
;
- AfterList = [_ | _],
+ AfterInstrs = [_ | _],
% The instruction list we are constructing has two copies of BaseList.
% If this list of instructions defines any labels, we must either not
% apply this version of the optimization, or we must consistently
% substitute the labels (which will be referred to only from within the
% BaseList instructions themselves). We choose the former course.
- find_labels(BaseList, BaseLabels),
+ find_labels(BaseInstrs, BaseLabels),
BaseLabels = [],
- list.condense([
- [
+ Code =
+ from_list([
llds_instr(label(EntryLabel), "Procedure entry point"),
llds_instr(comment(SlotsComment), "")
- ],
- EntryTestList,
- InitAuxReg,
- [
+ ]) ++
+ from_list(EntryTestInstrs) ++
+ InitAuxReg ++
+ singleton(
llds_instr(label(Loop1Label), "start of the down loop")
- ],
- MaybeIncrSp,
- IncrAuxReg,
- BeforeList,
- Loop1Test,
- BaseList,
- [
+ ) ++
+ MaybeIncrSp ++
+ IncrAuxReg ++
+ from_list(BeforeInstrs) ++
+ from_list(Loop1Test) ++
+ from_list(BaseInstrs) ++
+ singleton(
llds_instr(label(Loop2Label), "")
- ],
- AfterList,
- MaybeDecrSp,
- DecrAuxReg,
- TestAuxReg,
- LiveValCode,
- [
+ ) ++
+ from_list(AfterInstrs) ++
+ MaybeDecrSp ++
+ DecrAuxReg ++
+ TestAuxReg ++
+ LiveValCode ++
+ from_list([
llds_instr(goto(code_succip), "exit from recursive case"),
llds_instr(label(BaseLabel), "start of base case")
- ],
- BaseList,
- LiveValCode,
- [
+ ]) ++
+ from_list(BaseInstrs) ++
+ LiveValCode ++
+ singleton(
llds_instr(goto(code_succip), "exit from base case")
- ]
- ], InstrList)
- ),
- Instrs = node(InstrList).
+ )
+ ).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.199
diff -u -b -r1.199 mlds_to_il.m
--- compiler/mlds_to_il.m 5 Jan 2009 01:30:52 -0000 1.199
+++ compiler/mlds_to_il.m 5 Jan 2009 01:32:53 -0000
@@ -152,7 +152,6 @@
:- import_module hlds.code_model.
:- import_module libs.compiler_util.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module mdbcomp.prim_data.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_type_gen.
@@ -164,6 +163,7 @@
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
+:- import_module cord.
:- import_module counter.
:- import_module deconstruct.
:- import_module int.
@@ -177,7 +177,7 @@
% We build up lists of instructions using a tree to make
% insertion easy.
%
-:- type instr_tree == tree(list(instr)).
+:- type instr_tree == cord(instr).
% The state of the il code generator.
%
@@ -653,8 +653,8 @@
% executed by the class constructor.
( EntityName = wrapper_class_name ->
Imports = !.Info ^ imports,
- InitInstrs = list.condense(tree.flatten(!.Info ^ init_instrs)),
- AllocInstrs = list.condense(tree.flatten(!.Info ^ alloc_instrs)),
+ InitInstrs = cord.list(!.Info ^ init_instrs),
+ AllocInstrs = cord.list(!.Info ^ alloc_instrs),
% Generate a field that records whether we have finished
% RTTI initialization.
@@ -1015,32 +1015,30 @@
%
% Note that here we have to set the field.
- ( AllocInstrsTree = node([]) ->
- StoreAllocTree = node([]),
- StoreInitTree = node([stsfld(FieldRef)]),
- LoadTree = node([])
- ;
- StoreAllocTree = node([stsfld(FieldRef)]),
- StoreInitTree = node([pop]),
- LoadTree = node([ldsfld(FieldRef)])
+ ( cord.is_empty(AllocInstrsTree) ->
+ StoreAllocTree = empty,
+ StoreInitTree = singleton(stsfld(FieldRef)),
+ LoadTree = empty
+ ;
+ StoreAllocTree = singleton(stsfld(FieldRef)),
+ StoreInitTree = singleton(pop),
+ LoadTree = singleton(ldsfld(FieldRef))
),
% Add a store after the alloc instrs (if necessary)
- AllocInstrs = list.condense(tree.flatten(
- tree_list([
- context_node(Context),
- comment_node(string.append("allocation for ", FieldName)),
- AllocInstrsTree,
- StoreAllocTree]))),
+ AllocInstrs = cord.list(
+ context_node(Context) ++
+ comment_node(string.append("allocation for ", FieldName)) ++
+ AllocInstrsTree ++
+ StoreAllocTree),
% Add a load before the init instrs (if necessary)
- InitInstrs = list.condense(tree.flatten(
- tree_list([
- context_node(Context),
- comment_node(string.append("initializer for ", FieldName)),
- LoadTree,
- InitInstrTree,
- StoreInitTree]))),
+ InitInstrs = cord.list(
+ context_node(Context) ++
+ comment_node(string.append("initializer for ", FieldName)) ++
+ LoadTree ++
+ InitInstrTree ++
+ StoreInitTree),
% Add these instructions to the lists of allocation/initialization
% instructions. They will be put into the class constructor later.
@@ -1121,7 +1119,7 @@
% Need to insert a ret for functions returning void (MLDS doesn't).
(
Returns = [],
- MaybeRet = instr_node(ret)
+ MaybeRet = singleton(ret)
;
Returns = [_ | _],
MaybeRet = empty
@@ -1145,26 +1143,24 @@
(pred(_::in, Instr::out, Num::in, Num+1::out) is det :-
Instr = ldarg(index(Num))
), TypeParams, LoadInstrs, 0, _),
- InstrsTree1 = tree_list([
- comment_node("external -- call handwritten version"),
- node(LoadInstrs),
- instr_node(call(get_static_methodref(ClassName,
- CSharpMemberName, ILRetType, TypeParams)))
- ]),
- MaybeRet = instr_node(ret)
+ InstrsTree1 =
+ comment_node("external -- call handwritten version") ++
+ from_list(LoadInstrs) ++
+ singleton(call(get_static_methodref(ClassName,
+ CSharpMemberName, ILRetType, TypeParams))),
+ MaybeRet = singleton(ret)
),
% Retrieve the locals, put them in the enclosing scope.
il_info_get_locals_list(!.Info, Locals),
- InstrsTree2 = tree_list([
- context_node(Context),
- node(CtorInstrs),
- context_node(Context),
- instr_node(start_block(scope(Locals), BlockId)),
- InstrsTree1,
- MaybeRet,
- instr_node(end_block(scope(Locals), BlockId))
- ]),
+ InstrsTree2 =
+ context_node(Context) ++
+ from_list(CtorInstrs) ++
+ context_node(Context) ++
+ singleton(start_block(scope(Locals), BlockId)) ++
+ InstrsTree1 ++
+ MaybeRet ++
+ singleton(end_block(scope(Locals), BlockId)),
% If this is main, add the entrypoint, set a flag, wrap the code
% in an exception handler and call the initialization instructions
@@ -1203,8 +1199,6 @@
non_foreign_type(UnivMercuryType)),
UnivType = mlds_type_to_ilds_type(DataRep, UnivMLDSType),
- RenameNode = (func(N) = list.map(RenameRets, N)),
-
MercuryExceptionClassName = mercury_runtime_name(["Exception"]),
ExceptionClassName = structured_name(il_system_assembly_name,
@@ -1231,36 +1225,32 @@
% A code block to catch any exception at all.
- CatchAnyException = tree_list([
- instr_node(start_block(
- catch(ExceptionClassName),
- OuterCatchBlockId)),
- instr_node(ldstr("\nUncaught system exception: \n")),
- instr_node(call(WriteString)),
- instr_node(call(WriteObject)),
- instr_node(ldc(int32, i(1))),
- instr_node(call(il_set_exit_code)),
-
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(catch(ExceptionClassName), OuterCatchBlockId))
+ CatchAnyException =
+ from_list([
+ start_block(catch(ExceptionClassName), OuterCatchBlockId),
+ ldstr("\nUncaught system exception: \n"),
+ call(WriteString),
+ call(WriteObject),
+ ldc(int32, i(1)),
+ call(il_set_exit_code),
+ leave(label_target(DoneLabel)),
+ end_block(catch(ExceptionClassName), OuterCatchBlockId)
]),
% Code to catch Mercury exceptions.
- CatchUserException = tree_list([
- instr_node(start_block(
- catch(MercuryExceptionClassName),
- InnerCatchBlockId)),
- instr_node(ldfld(FieldRef)),
-
- instr_node(call(WriteUncaughtException)),
-
- instr_node(ldc(int32, i(1))),
- instr_node(call(il_set_exit_code)),
-
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(
- catch(MercuryExceptionClassName),
- InnerCatchBlockId))
+ CatchUserException =
+ from_list([
+ start_block(catch(MercuryExceptionClassName),
+ InnerCatchBlockId),
+ ldfld(FieldRef),
+ call(WriteUncaughtException),
+
+ ldc(int32, i(1)),
+ call(il_set_exit_code),
+
+ leave(label_target(DoneLabel)),
+ end_block(catch(MercuryExceptionClassName),
+ InnerCatchBlockId)
]),
% Wrap an exception handler around the main code. This allows us
@@ -1289,27 +1279,30 @@
% System.Environment.ExitCode = 1;
% }
- InstrsTree = tree_list([
+ InstrsTree =
+ from_list([
% outer try block
- instr_node(start_block(try, OuterTryBlockId)),
+ start_block(try, OuterTryBlockId),
% inner try block
- instr_node(start_block(try, InnerTryBlockId)),
- tree.map(RenameNode, InstrsTree2),
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(try, InnerTryBlockId)),
-
+ start_block(try, InnerTryBlockId)
+ ]) ++
+ cord.map(RenameRets, InstrsTree2) ++
+ from_list([
+ leave(label_target(DoneLabel)),
+ end_block(try, InnerTryBlockId)
+ ]) ++
% inner catch block
- CatchUserException,
-
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(try, OuterTryBlockId)),
-
+ CatchUserException ++
+ from_list([
+ leave(label_target(DoneLabel)),
+ end_block(try, OuterTryBlockId)
+ ]) ++
% outer catch block
- CatchAnyException,
-
- instr_node(label(DoneLabel)),
- instr_node(ret)
+ CatchAnyException ++
+ from_list([
+ label(DoneLabel),
+ ret
])
;
EntryPoint = [],
@@ -1495,22 +1488,20 @@
;
LoadMemRefInstrs = throw_unimplemented(
"initializer_for_non_var_data_name"),
- StoreLvalInstrs = node([]),
+ StoreLvalInstrs = empty,
NameString = "unknown"
),
data_initializer_to_instrs(Initializer, MLDSType,
AllocInstrs, InitInstrs, !Info),
- string.append("initializer for ", NameString,
- Comment),
- !:Tree = tree_list([
- !.Tree,
- context_node(Context),
- comment_node(Comment),
- LoadMemRefInstrs,
- AllocInstrs,
- InitInstrs,
+ Comment = "initializer for " ++ NameString,
+ !:Tree =
+ !.Tree ++
+ context_node(Context) ++
+ comment_node(Comment) ++
+ LoadMemRefInstrs ++
+ AllocInstrs ++
+ InitInstrs ++
StoreLvalInstrs
- ])
)
;
unexpected(this_file, "defn not data(...) in block")
@@ -1523,7 +1514,7 @@
:- pred data_initializer_to_instrs(mlds_initializer::in, mlds_type::in,
instr_tree::out, instr_tree::out, il_info::in, il_info::out) is det.
-data_initializer_to_instrs(init_obj(Rval), _Type, node([]), InitInstrs,
+data_initializer_to_instrs(init_obj(Rval), _Type, empty, InitInstrs,
!Info) :-
load(Rval, InitInstrs, !Info).
@@ -1575,9 +1566,10 @@
%
% The initialization will leave the array on the stack.
%
- AllocInstrs = node([
+ AllocInstrs = from_list([
ldc(int32, i(list.length(InitList))),
- newarr(ILElemType)]),
+ newarr(ILElemType)
+ ]),
AddInitializer =
(pred(Init0::in, X0 - Tree0::in, (X0 + 1) - Tree::out,
Info0::in, Info::out) is det :-
@@ -1590,11 +1582,11 @@
),
data_initializer_to_instrs(Init, ElemType,
ATree1, ITree1, Info0, Info),
- Tree = tree(tree(Tree0, node([dup, ldc(int32, i(X0))])),
- tree(tree(ATree1, ITree1), node([stelem(ILElemSimpleType)])))
+ Tree = Tree0 ++ from_list([dup, ldc(int32, i(X0))]) ++
+ ATree1 ++ ITree1 ++ singleton(stelem(ILElemSimpleType))
),
list.foldl2(AddInitializer, InitList, 0 - empty, _ - InitInstrs, !Info).
-data_initializer_to_instrs(no_initializer, _, node([]), node([]), !Info).
+data_initializer_to_instrs(no_initializer, _, empty, empty, !Info).
% If we are initializing an array or struct, we need to box
% all the things inside it.
@@ -1639,7 +1631,7 @@
il_info::in, il_info::out) is det.
statements_to_il([], empty, !Info).
-statements_to_il([HeadStmt | TailStmts], tree(HeadCode, TailCode), !Info) :-
+statements_to_il([HeadStmt | TailStmts], HeadCode ++ TailCode, !Info) :-
statement_to_il(HeadStmt, HeadCode, !Info),
statements_to_il(TailStmts, TailCode, !Info).
@@ -1659,19 +1651,18 @@
list.map((pred((K - V)::in, (K - W)::out) is det :-
W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals),
Scope = scope(ILLocals),
- Instrs = tree_list([
- context_node(Context),
- instr_node(start_block(Scope, BlockId)),
- InitInstrsTree,
- comment_node("block body"),
- BlockInstrs,
- node([end_block(Scope, BlockId)])
- ]),
+ Instrs =
+ context_node(Context) ++
+ singleton(start_block(Scope, BlockId)) ++
+ InitInstrsTree ++
+ comment_node("block body") ++
+ BlockInstrs ++
+ singleton(end_block(Scope, BlockId)),
il_info_remove_locals(Locals, !Info).
statement_to_il(statement(ml_stmt_atomic(Atomic), Context), Instrs, !Info) :-
atomic_statement_to_il(Atomic, AtomicInstrs, !Info),
- Instrs = tree(context_node(Context), AtomicInstrs).
+ Instrs = context_node(Context) ++ AtomicInstrs.
statement_to_il(statement(CallStmt, Context), Instrs, !Info) :-
CallStmt = ml_stmt_call(Sig, Function, _This, Args, Returns, CallKind),
@@ -1738,7 +1729,7 @@
LoadMemRefInstrs, ReturnsStoredInstrs, !Info)
),
list.map_foldl(load, Args, ArgsLoadInstrsTrees, !Info),
- ArgsLoadInstrs = tree_list(ArgsLoadInstrsTrees),
+ ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees),
( Function = const(Const) ->
FunctionLoadInstrs = empty,
const_rval_to_function(Const, MemberName),
@@ -1753,17 +1744,16 @@
Instrs0 = [calli(signature(call_conv(no, default),
ReturnParam, ParamsList))]
),
- Instrs = tree_list([
- context_node(Context),
- comment_node("call"),
- LoadMemRefInstrs,
- ArgsLoadInstrs,
- FunctionLoadInstrs,
- node(TailCallInstrs),
- node(Instrs0),
- node(RetInstrs),
- ReturnsStoredInstrs
- ]).
+ Instrs =
+ context_node(Context) ++
+ comment_node("call") ++
+ LoadMemRefInstrs ++
+ ArgsLoadInstrs ++
+ FunctionLoadInstrs ++
+ from_list(TailCallInstrs) ++
+ from_list(Instrs0) ++
+ from_list(RetInstrs) ++
+ ReturnsStoredInstrs.
statement_to_il(statement(IfThenElseStmt, Context), Instrs, !Info) :-
IfThenElseStmt = ml_stmt_if_then_else(Condition, ThenCase, ElseCase),
@@ -1771,19 +1761,18 @@
il_info_make_next_label(DoneLabel, !Info),
statement_to_il(ThenCase, ThenInstrs, !Info),
maybe_map_fold(statement_to_il, ElseCase, empty, ElseInstrs, !Info),
- Instrs = tree_list([
- context_node(Context),
- comment_node("if then else"),
- ConditionInstrs,
- comment_node("then case"),
- ThenInstrs,
- instr_node(br(label_target(DoneLabel))),
- instr_node(label(ElseLabel)),
- comment_node("else case"),
- ElseInstrs,
- comment_node("end if then else"),
- instr_node(label(DoneLabel))
- ]).
+ Instrs =
+ context_node(Context) ++
+ comment_node("if then else") ++
+ ConditionInstrs ++
+ comment_node("then case") ++
+ ThenInstrs ++
+ singleton(br(label_target(DoneLabel))) ++
+ singleton(label(ElseLabel)) ++
+ comment_node("else case") ++
+ ElseInstrs ++
+ comment_node("end if then else") ++
+ singleton(label(DoneLabel)).
statement_to_il(statement(SwitchStmt, _Context), _Instrs, !Info) :-
SwitchStmt = ml_stmt_switch(_Type, _Val, _Range, _Cases, _Default),
@@ -1799,27 +1788,25 @@
statement_to_il(Body, BodyInstrs, !Info),
(
AtLeastOnce = no,
- Instrs = tree_list([
- context_node(Context),
- comment_node("while"),
- instr_node(label(StartLabel)),
- ConditionInstrs,
- BodyInstrs,
- instr_node(br(label_target(StartLabel))),
- instr_node(label(EndLabel))
- ])
+ Instrs =
+ context_node(Context) ++
+ comment_node("while") ++
+ singleton(label(StartLabel)) ++
+ ConditionInstrs ++
+ BodyInstrs ++
+ singleton(br(label_target(StartLabel))) ++
+ singleton(label(EndLabel))
;
AtLeastOnce = yes,
% XXX This generates a branch over branch which is suboptimal.
- Instrs = tree_list([
- context_node(Context),
- comment_node("while (actually do ... while)"),
- instr_node(label(StartLabel)),
- BodyInstrs,
- ConditionInstrs,
- instr_node(br(label_target(StartLabel))),
- instr_node(label(EndLabel))
- ])
+ Instrs =
+ context_node(Context) ++
+ comment_node("while (actually do ... while)") ++
+ singleton(label(StartLabel)) ++
+ BodyInstrs ++
+ ConditionInstrs ++
+ singleton(br(label_target(StartLabel))) ++
+ singleton(label(EndLabel))
).
statement_to_il(statement(ml_stmt_return(Rvals), Context), Instrs, !Info) :-
@@ -1829,11 +1816,10 @@
;
Rvals = [Rval],
load(Rval, LoadInstrs, !Info),
- Instrs = tree_list([
- context_node(Context),
- LoadInstrs,
- instr_node(ret)
- ])
+ Instrs =
+ context_node(Context) ++
+ LoadInstrs ++
+ singleton(ret)
;
Rvals = [_, _ | _],
% MS IL doesn't support multiple return values
@@ -1842,7 +1828,7 @@
statement_to_il(statement(ml_stmt_label(Label), Context), Instrs, !Info) :-
string.format("label %s", [s(Label)], Comment),
- Instrs = node([
+ Instrs = from_list([
comment(Comment),
context_instr(Context),
label(Label)
@@ -1851,7 +1837,7 @@
statement_to_il(statement(GotoLabelStmt, Context), Instrs, !Info) :-
GotoLabelStmt = ml_stmt_goto(label(Label)),
string.format("goto %s", [s(Label)], Comment),
- Instrs = node([
+ Instrs = from_list([
comment(Comment),
context_instr(Context),
br(label_target(Label))
@@ -1880,12 +1866,11 @@
% throw
%
NewObjInstr = newobj_constructor(il_commit_class_name, []),
- Instrs = tree_list([
- context_node(Context),
- comment_node("do_commit/1"),
- instr_node(NewObjInstr),
- instr_node(throw)
- ]).
+ Instrs =
+ context_node(Context) ++
+ comment_node("do_commit/1") ++
+ singleton(NewObjInstr) ++
+ singleton(throw).
statement_to_il(statement(TryCommitStmt, Context), Instrs, !Info) :-
TryCommitStmt = ml_stmt_try_commit(_Ref, GoalToTry, CommitHandlerGoal),
@@ -1912,44 +1897,42 @@
il_info_make_next_label(DoneLabel, !Info),
ClassName = il_commit_class_name,
- Instrs = tree_list([
- context_node(Context),
- comment_node("try_commit/3"),
-
- instr_node(start_block(try, TryBlockId)),
- GoalInstrsTree,
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(try, TryBlockId)),
-
- instr_node(start_block(catch(ClassName), CatchBlockId)),
- comment_node("discard the exception object"),
- instr_node(pop),
- HandlerInstrsTree,
- instr_node(leave(label_target(DoneLabel))),
- instr_node(end_block(catch(ClassName), CatchBlockId)),
- instr_node(label(DoneLabel))
- ]).
+ Instrs =
+ context_node(Context) ++
+ comment_node("try_commit/3") ++
+
+ singleton(start_block(try, TryBlockId)) ++
+ GoalInstrsTree ++
+ singleton(leave(label_target(DoneLabel))) ++
+ singleton(end_block(try, TryBlockId)) ++
+
+ singleton(start_block(catch(ClassName), CatchBlockId)) ++
+ comment_node("discard the exception object") ++
+ singleton(pop) ++
+ HandlerInstrsTree ++
+ singleton(leave(label_target(DoneLabel))) ++
+ singleton(end_block(catch(ClassName), CatchBlockId)) ++
+ singleton(label(DoneLabel)).
statement_to_il(statement(ComputedGotoStmt, Context), Instrs, !Info) :-
ComputedGotoStmt = ml_stmt_computed_goto(Rval, MLDSLabels),
load(Rval, RvalLoadInstrs, !Info),
Targets = list.map(func(L) = label_target(L), MLDSLabels),
- Instrs = tree_list([
- context_node(Context),
- comment_node("computed goto"),
- RvalLoadInstrs,
- instr_node(switch(Targets))
- ]).
+ Instrs =
+ context_node(Context) ++
+ comment_node("computed goto") ++
+ RvalLoadInstrs ++
+ singleton(switch(Targets)).
:- pred atomic_statement_to_il(mlds_atomic_statement::in, instr_tree::out,
il_info::in, il_info::out) is det.
-atomic_statement_to_il(gc_check, node(Instrs), !Info) :-
- Instrs = [comment("gc check -- not relevant for this backend")].
-atomic_statement_to_il(mark_hp(_), node(Instrs), !Info) :-
- Instrs = [comment("mark hp -- not relevant for this backend")].
-atomic_statement_to_il(restore_hp(_), node(Instrs), !Info) :-
- Instrs = [comment("restore hp -- not relevant for this backend")].
+atomic_statement_to_il(gc_check, singleton(Instr), !Info) :-
+ Instr = comment("gc check -- not relevant for this backend").
+atomic_statement_to_il(mark_hp(_), singleton(Instr), !Info) :-
+ Instr = comment("mark hp -- not relevant for this backend").
+atomic_statement_to_il(restore_hp(_), singleton(Instr), !Info) :-
+ Instr = comment("restore hp -- not relevant for this backend").
atomic_statement_to_il(outline_foreign_proc(Lang, _, ReturnLvals, _Code),
Instrs, !Info) :-
@@ -1974,7 +1957,7 @@
( RetType = void ->
StoreInstrs = empty
;
- StoreInstrs = instr_node(stloc(name("SUCCESS_INDICATOR")))
+ StoreInstrs = singleton(stloc(name("SUCCESS_INDICATOR")))
)
;
ReturnLvals = [ReturnLval],
@@ -1990,14 +1973,13 @@
Num::in, Num + 1::out) is det :-
Instr = ldarg(index(Num))),
TypeParams, LoadArgInstrs, 0, _),
- Instrs = tree_list([
- comment_node("outline foreign proc -- call handwritten version"),
- LoadInstrs,
- node(LoadArgInstrs),
- instr_node(call(get_static_methodref(
- ClassName, MethodName, RetType, TypeParams))),
+ Instrs =
+ comment_node("outline foreign proc -- call handwritten version") ++
+ LoadInstrs ++
+ from_list(LoadArgInstrs) ++
+ singleton(call(get_static_methodref(ClassName, MethodName, RetType,
+ TypeParams))) ++
StoreInstrs
- ])
;
!.Info ^ method_foreign_lang = yes(_),
Instrs = comment_node("outline foreign proc -- already called")
@@ -2029,18 +2011,17 @@
load(Rval, LoadRvalInstrs, !Info),
get_load_store_lval_instrs(Lval, LoadMemRefInstrs, StoreLvalInstrs,
!Info),
- Instrs = tree_list([
- comment_node("assign"),
- LoadMemRefInstrs,
- LoadRvalInstrs,
- StoreLvalInstrs
- ]).
+ Instrs =
+ comment_node("assign") ++
+ LoadMemRefInstrs ++
+ LoadRvalInstrs ++
+ StoreLvalInstrs.
atomic_statement_to_il(assign_if_in_heap(_, _), _, !Info) :-
sorry(this_file, "assign_if_in_heap").
atomic_statement_to_il(comment(Comment), Instrs, !Info) :-
- Instrs = node([comment(Comment)]).
+ Instrs = singleton(comment(Comment)).
atomic_statement_to_il(delete_object(_Target), Instrs, !Info) :-
% XXX We assume the code generator knows what it is doing and is only
@@ -2056,7 +2037,7 @@
% instead of an lval
%
% get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs, !Info),
- % Instrs = tree_list([LoadInstrs, instr_node(ldnull), StoreInstrs]).
+ % Instrs = LoadInstrs ++ singleton(ldnull) ++ StoreInstrs.
Instrs = empty.
atomic_statement_to_il(new_object(Target0, _MaybeTag, HasSecTag, Type, Size,
@@ -2082,7 +2063,7 @@
% ... load each argument ...
% call ClassName::.ctor
% ... store to memory reference ...
- %
+
ClassName0 = mlds_type_to_ilds_class_name(DataRep, Type),
(
MaybeCtorName = yes(QualifiedCtorName),
@@ -2113,11 +2094,10 @@
),
ILArgTypes = list.map(mlds_type_to_ilds_type(DataRep), ArgTypes),
list.map_foldl(load, Args, ArgsLoadInstrsTrees, !Info),
- ArgsLoadInstrs = tree_list(ArgsLoadInstrsTrees),
- %
+ ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees),
+
% If the new object is being assigned to private_builtin.dummy_var
% then we need to cast it to il_generic_type.
- %
(
Target0 = var(qual(MLDS_Module, QualKind, VarName), _),
VarName = mlds_var_name("dummy_var", _),
@@ -2125,7 +2105,7 @@
MLDS_PrivateBuiltin = mercury_module_name_to_mlds(PrivateBuiltin),
mlds_append_wrapper_class(MLDS_PrivateBuiltin) = MLDS_Module
->
- MaybeCastInstrs = node([castclass(il_generic_type)]),
+ MaybeCastInstrs = singleton(castclass(il_generic_type)),
Target = var(qual(MLDS_Module, QualKind, VarName),
mlds_generic_type)
;
@@ -2135,14 +2115,13 @@
get_load_store_lval_instrs(Target, LoadMemRefInstrs,
StoreLvalInstrs, !Info),
CallCtor = newobj_constructor(ClassName, ILArgTypes),
- Instrs = tree_list([
- LoadMemRefInstrs,
- comment_node("new object (call constructor)"),
- ArgsLoadInstrs,
- instr_node(CallCtor),
- MaybeCastInstrs,
+ Instrs =
+ LoadMemRefInstrs ++
+ comment_node("new object (call constructor)") ++
+ ArgsLoadInstrs ++
+ singleton(CallCtor) ++
+ MaybeCastInstrs ++
StoreLvalInstrs
- ])
;
% Otherwise this is a generic mercury object -- we use an array
% of System::Object to represent it.
@@ -2167,17 +2146,18 @@
% the arguments if needed.
% Load each rval.
- % (XXX We do almost exactly the same code when initializing array
+ % XXX We do almost exactly the same code when initializing array
% data structures -- we should reuse that code.
- LoadInArray = (pred(Rval::in, I::out, Arg0::in, Arg::out) is det :-
+ LoadInArray =
+ (pred(Rval::in, I::out, Arg0::in, Arg::out) is det :-
Arg0 = Index - S0,
- I0 = instr_node(dup),
+ I0 = singleton(dup),
load(const(mlconst_int(Index)), I1, S0, S1),
- % XXX the MLDS code generator is meant to be responsible for boxing
- % the args, but when compiled with the highlevel_data where we have
- % overridden the type to use a lowlevel representation it doesn't
- % get this right.
+ % XXX the MLDS code generator is meant to be responsible for
+ % boxing the args, but when compiled with the highlevel_data
+ % where we have overridden the type to use a lowlevel
+ % representation it doesn't get this right.
rval_to_type(Rval, RvalType),
ILRvalType = mlds_type_to_ilds_type(DataRep, RvalType),
( already_boxed(ILRvalType) ->
@@ -2187,13 +2167,13 @@
),
load(NewRval, I2, S1, S),
- I3 = instr_node(stelem(il_generic_simple_type)),
- I = tree_list([I0, I1, I2, I3]),
+ I3 = singleton(stelem(il_generic_simple_type)),
+ I = I0 ++ I1 ++ I2 ++ I3,
Arg = (Index + 1) - S
),
list.map_foldl(LoadInArray, Args0, ArgsLoadInstrsTrees,
0 - !.Info, _ - !:Info),
- ArgsLoadInstrs = tree_list(ArgsLoadInstrsTrees),
+ ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees),
% Get the instructions to load and store the target.
get_load_store_lval_instrs(Target0, LoadMemRefInstrs, StoreLvalInstrs,
@@ -2209,31 +2189,30 @@
),
load(SizeInWordsRval, LoadSizeInstrs, !Info),
- Instrs = tree_list([
- LoadMemRefInstrs,
- comment_node("new object"),
- LoadSizeInstrs,
- instr_node(newarr(il_generic_type)),
- ArgsLoadInstrs,
+ Instrs =
+ LoadMemRefInstrs ++
+ comment_node("new object") ++
+ LoadSizeInstrs ++
+ singleton(newarr(il_generic_type)) ++
+ ArgsLoadInstrs ++
StoreLvalInstrs
- ])
).
:- func inline_code_to_il_asm(list(target_code_component)) = instr_tree.
inline_code_to_il_asm([]) = empty.
-inline_code_to_il_asm([T | Ts]) = tree(Instrs, Rest) :-
+inline_code_to_il_asm([T | Ts]) = Instrs ++ Rest :-
(
T = user_target_code(Code, MaybeContext, Attrs),
( yes(max_stack_size(N)) = get_max_stack_attribute(Attrs) ->
- Instrs = tree_list([
- ( MaybeContext = yes(Context) ->
- context_node(mlds_make_context( Context))
+ (
+ MaybeContext = yes(Context),
+ Instrs0 = context_node(mlds_make_context(Context))
;
- empty
+ MaybeContext = no,
+ Instrs0 = empty
),
- instr_node(il_asm_code(Code, N))
- ])
+ Instrs = Instrs0 ++ singleton(il_asm_code(Code, N))
;
unexpected(this_file, "max_stack_size not set")
)
@@ -2242,7 +2221,7 @@
MaybeMaxStack = get_max_stack_attribute(Attrs),
(
MaybeMaxStack = yes(max_stack_size(N)),
- Instrs = instr_node(il_asm_code(Code, N))
+ Instrs = singleton(il_asm_code(Code, N))
;
MaybeMaxStack = no,
unexpected(this_file, "max_stack_size not set")
@@ -2270,8 +2249,8 @@
get_all_load_store_lval_instrs([], empty, empty, !Info).
get_all_load_store_lval_instrs([Lval | Lvals],
- tree(LoadMemRefNode, LoadMemRefTree),
- tree(StoreLvalNode, StoreLvalTree), !Info) :-
+ LoadMemRefNode ++ LoadMemRefTree,
+ StoreLvalNode ++ StoreLvalTree, !Info) :-
get_load_store_lval_instrs(Lval, LoadMemRefNode, StoreLvalNode, !Info),
get_all_load_store_lval_instrs(Lvals, LoadMemRefTree, StoreLvalTree,
!Info).
@@ -2292,18 +2271,20 @@
( Lval = mem_ref(Rval0, MLDS_Type) ->
load(Rval0, LoadMemRefInstrs, !Info),
SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
- StoreLvalInstrs = instr_node(stind(SimpleType))
+ StoreLvalInstrs = singleton(stind(SimpleType))
; Lval = field(_MaybeTag, FieldRval, FieldNum, FieldType, ClassType) ->
ClassILType = mlds_type_to_ilds_type(DataRep, ClassType),
( ClassILType = il_type(_, '[]'(_, _)) ->
- ( FieldNum = offset(OffsetRval),
+ (
+ FieldNum = offset(OffsetRval),
FieldILType = mlds_type_to_ilds_simple_type(DataRep,
FieldType),
load(FieldRval, LoadArrayRval, !Info),
load(OffsetRval, LoadIndexRval, !Info),
- LoadMemRefInstrs = tree_list([LoadArrayRval, LoadIndexRval]),
- StoreLvalInstrs = node([stelem(FieldILType)])
- ; FieldNum = named_field(_, _),
+ LoadMemRefInstrs = LoadArrayRval ++ LoadIndexRval,
+ StoreLvalInstrs = singleton(stelem(FieldILType))
+ ;
+ FieldNum = named_field(_, _),
unexpected(this_file,
"named_field for a type with an array representation.")
)
@@ -2311,13 +2292,9 @@
get_fieldref(DataRep, FieldNum, FieldType, ClassType, FieldRef,
CastClassInstrs),
load(FieldRval, LoadMemRefInstrs0, !Info),
- LoadMemRefInstrs = tree_list([
- LoadMemRefInstrs0,
- CastClassInstrs
- ]),
- StoreLvalInstrs = instr_node(stfld(FieldRef))
+ LoadMemRefInstrs = LoadMemRefInstrs0 ++ CastClassInstrs,
+ StoreLvalInstrs = singleton(stfld(FieldRef))
)
-
;
LoadMemRefInstrs = empty,
store(Lval, StoreLvalInstrs, !Info)
@@ -2341,14 +2318,14 @@
Lval = var(Var, VarType),
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
- Instrs = instr_node(ldloc(name(MangledVarStr)))
+ Instrs = singleton(ldloc(name(MangledVarStr)))
; is_argument(MangledVarStr, !.Info) ->
- Instrs = instr_node(ldarg(name(MangledVarStr)))
+ Instrs = singleton(ldarg(name(MangledVarStr)))
; is_local_field(Var, VarType, !.Info, FieldRef) ->
- Instrs = instr_node(ldsfld(FieldRef))
+ Instrs = singleton(ldsfld(FieldRef))
;
FieldRef = make_static_fieldref(DataRep, Var, VarType),
- Instrs = instr_node(ldsfld(FieldRef))
+ Instrs = singleton(ldsfld(FieldRef))
)
;
Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
@@ -2365,20 +2342,16 @@
LoadInstruction = ldfld(FieldRef),
OffSetLoadInstrs = empty
),
- Instrs = tree_list([
- RvalLoadInstrs,
- CastClassInstrs,
- OffSetLoadInstrs,
- instr_node(LoadInstruction)
- ])
+ Instrs =
+ RvalLoadInstrs ++
+ CastClassInstrs ++
+ OffSetLoadInstrs ++
+ singleton(LoadInstruction)
;
Lval = mem_ref(Rval, MLDS_Type),
SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
load(Rval, RvalLoadInstrs, !Info),
- Instrs = tree_list([
- RvalLoadInstrs,
- instr_node(ldind(SimpleType))
- ])
+ Instrs = RvalLoadInstrs ++ singleton(ldind(SimpleType))
;
Lval = global_var_ref(_),
Instrs = throw_unimplemented("load lval mem_ref")
@@ -2394,22 +2367,22 @@
% True and false are just the integers 1 and 0.
(
Const = mlconst_true,
- Instrs = instr_node(ldc(bool, i(1)))
+ Instrs = singleton(ldc(bool, i(1)))
;
Const = mlconst_false,
- Instrs = instr_node(ldc(bool, i(0)))
+ Instrs = singleton(ldc(bool, i(0)))
;
Const = mlconst_string(Str),
- Instrs = instr_node(ldstr(Str))
+ Instrs = singleton(ldstr(Str))
;
Const = mlconst_int(Int),
- Instrs = instr_node(ldc(int32, i(Int)))
+ Instrs = singleton(ldc(int32, i(Int)))
;
Const = mlconst_foreign(_Lang, _F, _T),
sorry(this_file, "NYI IL backend and foreign tags.")
;
Const = mlconst_float(Float),
- Instrs = instr_node(ldc(float64, f(Float)))
+ Instrs = singleton(ldc(float64, f(Float)))
;
Const = mlconst_multi_string(_MultiString),
Instrs = throw_unimplemented("load multi_string_const")
@@ -2419,27 +2392,27 @@
;
Const = mlconst_code_addr(CodeAddr),
MethodRef = code_addr_constant_to_methodref(DataRep, CodeAddr),
- Instrs = instr_node(ldftn(MethodRef))
+ Instrs = singleton(ldftn(MethodRef))
;
Const = mlconst_data_addr(DataAddr),
data_addr_constant_to_fieldref(DataAddr, FieldRef),
- Instrs = instr_node(ldsfld(FieldRef))
+ Instrs = singleton(ldsfld(FieldRef))
;
Const = mlconst_null(_MLDSType),
% We might consider loading an integer for null function types.
- Instrs = instr_node(ldnull)
+ Instrs = singleton(ldnull)
).
load(unop(Unop, Rval), Instrs, !Info) :-
load(Rval, RvalLoadInstrs, !Info),
unaryop_to_il(Unop, Rval, UnOpInstrs, !Info),
- Instrs = tree_list([RvalLoadInstrs, UnOpInstrs]).
+ Instrs = RvalLoadInstrs ++ UnOpInstrs.
load(binop(BinOp, R1, R2), Instrs, !Info) :-
load(R1, R1LoadInstrs, !Info),
load(R2, R2LoadInstrs, !Info),
binaryop_to_il(BinOp, BinaryOpInstrs, !Info),
- Instrs = tree_list([R1LoadInstrs, R2LoadInstrs, BinaryOpInstrs]).
+ Instrs = R1LoadInstrs ++ R2LoadInstrs ++ BinaryOpInstrs.
load(mem_addr(Lval), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
@@ -2447,25 +2420,24 @@
Lval = var(Var, VarType),
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
- Instrs = instr_node(ldloca(name(MangledVarStr)))
+ Instrs = singleton(ldloca(name(MangledVarStr)))
; is_argument(MangledVarStr, !.Info) ->
- Instrs = instr_node(ldarga(name(MangledVarStr)))
+ Instrs = singleton(ldarga(name(MangledVarStr)))
; is_local_field(Var, VarType, !.Info, FieldRef) ->
- Instrs = instr_node(ldsfld(FieldRef))
+ Instrs = singleton(ldsfld(FieldRef))
;
FieldRef = make_static_fieldref(DataRep, Var, VarType),
- Instrs = instr_node(ldsfld(FieldRef))
+ Instrs = singleton(ldsfld(FieldRef))
)
;
Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
load(Rval, RvalLoadInstrs, !Info),
- Instrs = tree_list([
- RvalLoadInstrs,
- CastClassInstrs,
- instr_node(ldflda(FieldRef))
- ])
+ Instrs =
+ RvalLoadInstrs ++
+ CastClassInstrs ++
+ singleton(ldflda(FieldRef))
;
Lval = mem_ref(_, _),
% XXX Implement this.
@@ -2475,7 +2447,7 @@
Instrs = throw_unimplemented("load mem_addr lval global_var_ref")
).
-load(self(_), tree_list([instr_node(ldarg(index(0)))]), !Info).
+load(self(_), singleton(ldarg(index(0))), !Info).
:- pred store(mlds_lval::in, instr_tree::out, il_info::in, il_info::out)
is det.
@@ -2485,11 +2457,10 @@
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
load(Rval, RvalLoadInstrs, !Info),
- Instrs = tree_list([
- CastClassInstrs,
- RvalLoadInstrs,
- instr_node(stfld(FieldRef))
- ]).
+ Instrs =
+ CastClassInstrs ++
+ RvalLoadInstrs ++
+ singleton(stfld(FieldRef)).
store(mem_ref(_Rval, _Type), _Instrs, !Info) :-
% You always need load the reference first, then the value, then stind it.
@@ -2503,12 +2474,12 @@
DataRep = !.Info ^ il_data_rep,
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
- Instrs = instr_node(stloc(name(MangledVarStr)))
+ Instrs = singleton(stloc(name(MangledVarStr)))
; is_argument(MangledVarStr, !.Info) ->
- Instrs = instr_node(starg(name(MangledVarStr)))
+ Instrs = singleton(starg(name(MangledVarStr)))
;
FieldRef = make_static_fieldref(DataRep, Var, VarType),
- Instrs = instr_node(stsfld(FieldRef))
+ Instrs = singleton(stsfld(FieldRef))
).
%-----------------------------------------------------------------------------%
@@ -2535,14 +2506,14 @@
unaryop_to_il(std_unop(mkbody), _, comment_node("mkbody (a no-op)"), !Info).
unaryop_to_il(std_unop(unmkbody), _, comment_node("unmkbody (a no-op)"),
!Info).
-unaryop_to_il(std_unop(hash_string), _, node([call(il_mercury_string_hash)]),
- !Info).
-unaryop_to_il(std_unop(bitwise_complement), _, node([bitwise_not]), !Info).
+unaryop_to_il(std_unop(hash_string), _,
+ singleton(call(il_mercury_string_hash)), !Info).
+unaryop_to_il(std_unop(bitwise_complement), _, singleton(bitwise_not), !Info).
% Might want to revisit this and define not to be only valid on 1 or 0,
% then we can use ldc.i4.1 and xor, which might be more efficient.
unaryop_to_il(std_unop(logical_not), _,
- node([ldc(int32, i(1)), clt(unsigned)]), !Info).
+ from_list([ldc(int32, i(1)), clt(unsigned)]), !Info).
% XXX Should detect casts to System.Array from array types
% and ignore them, as they are not necessary.
@@ -2567,7 +2538,7 @@
;
% Cast to refany: use "mkrefany" instruction.
( SrcILType = il_type(_Qual, '&'(ReferencedType)) ->
- Instrs = node([mkrefany(ReferencedType)])
+ Instrs = singleton(mkrefany(ReferencedType))
;
unexpected(this_file, "cast from non-ref type to refany")
)
@@ -2581,7 +2552,7 @@
->
% Cast from refany: use "refanyval" instruction.
( DestILType = il_type(_Qual, '&'(ReferencedType)) ->
- Instrs = node([refanyval(ReferencedType)])
+ Instrs = singleton(refanyval(ReferencedType))
;
unexpected(this_file, "cast from non-ref type to refany")
)
@@ -2612,14 +2583,13 @@
Instrs = empty
;
% Cast one boxed type to another boxed type.
- Instrs = node([castclass(DestILType)])
+ Instrs = singleton(castclass(DestILType))
)
;
% Convert an unboxed type to a boxed type: box it first, then cast.
- Instrs = tree_list([
- convert_to_object(SrcILType),
- instr_node(castclass(DestILType))
- ])
+ Instrs =
+ convert_to_object(SrcILType) ++
+ singleton(castclass(DestILType))
)
;
( already_boxed(SrcILType) ->
@@ -2636,26 +2606,23 @@
% so we don't need to do this.
% XXX This looks wrong for --high-level-data.
% -fjh.
- Instrs = tree_list([
- comment_node("loading out of an MR_Word"),
- instr_node(ldc(int32, i(0))),
- instr_node(ldelem(il_generic_simple_type)),
- comment_node("turning a cast into an unbox"),
+ Instrs =
+ comment_node("loading out of an MR_Word") ++
+ singleton(ldc(int32, i(0))) ++
+ singleton(ldelem(il_generic_simple_type)) ++
+ comment_node("turning a cast into an unbox") ++
convert_from_object(DestILType)
- ])
;
% XXX It would be nicer if the MLDS used an unbox to do this.
- Instrs = tree_list([
- comment_node("turning a cast into an unbox"),
+ Instrs =
+ comment_node("turning a cast into an unbox") ++
convert_from_object(DestILType)
- ])
)
;
DestILType = il_type(_, DestSimpleType),
- Instrs = tree_list([
- comment_node("cast between value types"),
- instr_node(conv(DestSimpleType))
- ])
+ Instrs =
+ comment_node("cast between value types") ++
+ singleton(conv(DestSimpleType))
)
).
@@ -2679,7 +2646,7 @@
Instrs = empty
;
% We have a different boxed type.
- Instrs = instr_node(castclass(UnboxedILType))
+ Instrs = singleton(castclass(UnboxedILType))
)
;
Instrs = convert_from_object(UnboxedILType)
@@ -2699,48 +2666,48 @@
:- pred binaryop_to_il(binary_op::in, instr_tree::out,
il_info::in, il_info::out) is det.
-binaryop_to_il(int_add, instr_node(I), !Info) :-
+binaryop_to_il(int_add, singleton(I), !Info) :-
I = add(nocheckoverflow, signed).
-binaryop_to_il(int_sub, instr_node(I), !Info) :-
+binaryop_to_il(int_sub, singleton(I), !Info) :-
I = sub(nocheckoverflow, signed).
-binaryop_to_il(int_mul, instr_node(I), !Info) :-
+binaryop_to_il(int_mul, singleton(I), !Info) :-
I = mul(nocheckoverflow, signed).
-binaryop_to_il(int_div, instr_node(I), !Info) :-
+binaryop_to_il(int_div, singleton(I), !Info) :-
I = div(signed).
-binaryop_to_il(int_mod, instr_node(I), !Info) :-
+binaryop_to_il(int_mod, singleton(I), !Info) :-
I = rem(signed).
-binaryop_to_il(unchecked_left_shift, instr_node(I), !Info) :-
+binaryop_to_il(unchecked_left_shift, singleton(I), !Info) :-
I = shl.
-binaryop_to_il(unchecked_right_shift, instr_node(I), !Info) :-
+binaryop_to_il(unchecked_right_shift, singleton(I), !Info) :-
I = shr(signed).
-binaryop_to_il(bitwise_and, instr_node(I), !Info) :-
+binaryop_to_il(bitwise_and, singleton(I), !Info) :-
I = bitwise_and.
-binaryop_to_il(bitwise_or, instr_node(I), !Info) :-
+binaryop_to_il(bitwise_or, singleton(I), !Info) :-
I = bitwise_or.
-binaryop_to_il(bitwise_xor, instr_node(I), !Info) :-
+binaryop_to_il(bitwise_xor, singleton(I), !Info) :-
I = bitwise_xor.
-binaryop_to_il(logical_and, instr_node(I), !Info) :-
+binaryop_to_il(logical_and, singleton(I), !Info) :-
% XXX
I = bitwise_and.
-binaryop_to_il(logical_or, instr_node(I), !Info) :-
+binaryop_to_il(logical_or, singleton(I), !Info) :-
% XXX
I = bitwise_or.
-binaryop_to_il(eq, instr_node(I), !Info) :-
+binaryop_to_il(eq, singleton(I), !Info) :-
I = ceq.
-binaryop_to_il(ne, node(Instrs), !Info) :-
+binaryop_to_il(ne, from_list(Instrs), !Info) :-
Instrs = [
ceq,
ldc(int32, i(0)),
@@ -2750,70 +2717,72 @@
binaryop_to_il(body, _, !Info) :-
unexpected(this_file, "binop: body").
-binaryop_to_il(array_index(ElemType), instr_node(I), !Info) :-
+binaryop_to_il(array_index(ElemType), singleton(I), !Info) :-
DataRep = !.Info ^ il_data_rep,
MLDS_Type = ml_gen_array_elem_type(ElemType),
ILSimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
I = ldelem(ILSimpleType).
% String operations.
-binaryop_to_il(str_eq, node([
+binaryop_to_il(str_eq, from_list([
call(il_string_equals)
]), !Info).
-binaryop_to_il(str_ne, node([
+binaryop_to_il(str_ne, from_list([
call(il_string_equals),
ldc(int32, i(0)),
ceq
]), !Info).
-binaryop_to_il(str_lt, node([
+binaryop_to_il(str_lt, from_list([
call(il_string_compare),
ldc(int32, i(0)),
clt(signed)
]), !Info).
-binaryop_to_il(str_gt, node([
+binaryop_to_il(str_gt, from_list([
call(il_string_compare),
ldc(int32, i(0)),
cgt(signed)
]), !Info).
-binaryop_to_il(str_le, node([
+binaryop_to_il(str_le, from_list([
call(il_string_compare),
ldc(int32, i(1)), clt(signed)
]), !Info).
-binaryop_to_il(str_ge, node([
+binaryop_to_il(str_ge, from_list([
call(il_string_compare),
ldc(int32, i(-1)),
cgt(signed)
]), !Info).
% Integer comparison
-binaryop_to_il(int_lt, node([clt(signed)]), !Info).
-binaryop_to_il(int_gt, node([cgt(signed)]), !Info).
-binaryop_to_il(int_le, node([cgt(signed), ldc(int32, i(0)), ceq]), !Info).
-binaryop_to_il(int_ge, node([clt(signed), ldc(int32, i(0)), ceq]), !Info).
-binaryop_to_il(unsigned_le, node([cgt(unsigned), ldc(int32, i(0)), ceq]),
+binaryop_to_il(int_lt, singleton(clt(signed)), !Info).
+binaryop_to_il(int_gt, singleton(cgt(signed)), !Info).
+binaryop_to_il(int_le, from_list([cgt(signed), ldc(int32, i(0)), ceq]), !Info).
+binaryop_to_il(int_ge, from_list([clt(signed), ldc(int32, i(0)), ceq]), !Info).
+binaryop_to_il(unsigned_le, from_list([cgt(unsigned), ldc(int32, i(0)), ceq]),
!Info).
% Floating pointer operations.
-binaryop_to_il(float_plus, instr_node(I), !Info) :-
+binaryop_to_il(float_plus, singleton(I), !Info) :-
I = add(nocheckoverflow, signed).
-binaryop_to_il(float_minus, instr_node(I), !Info) :-
+binaryop_to_il(float_minus, singleton(I), !Info) :-
I = sub(nocheckoverflow, signed).
-binaryop_to_il(float_times, instr_node(I), !Info) :-
+binaryop_to_il(float_times, singleton(I), !Info) :-
I = mul(nocheckoverflow, signed).
-binaryop_to_il(float_divide, instr_node(I), !Info) :-
+binaryop_to_il(float_divide, singleton(I), !Info) :-
I = div(signed).
-binaryop_to_il(float_eq, instr_node(I), !Info) :-
+binaryop_to_il(float_eq, singleton(I), !Info) :-
I = ceq.
-binaryop_to_il(float_ne, node(Instrs), !Info) :-
+binaryop_to_il(float_ne, from_list(Instrs), !Info) :-
Instrs = [
ceq,
ldc(int32, i(0)),
ceq
].
-binaryop_to_il(float_lt, node([clt(signed)]), !Info).
-binaryop_to_il(float_gt, node([cgt(signed)]), !Info).
-binaryop_to_il(float_le, node([cgt(signed), ldc(int32, i(0)), ceq]), !Info).
-binaryop_to_il(float_ge, node([clt(signed), ldc(int32, i(0)), ceq]), !Info).
+binaryop_to_il(float_lt, singleton(clt(signed)), !Info).
+binaryop_to_il(float_gt, singleton(cgt(signed)), !Info).
+binaryop_to_il(float_le, from_list([cgt(signed), ldc(int32, i(0)), ceq]),
+ !Info).
+binaryop_to_il(float_ge, from_list([clt(signed), ldc(int32, i(0)), ceq]),
+ !Info).
binaryop_to_il(compound_eq, _, !Info) :-
unexpected(this_file, "binop: compound_eq").
@@ -2859,19 +2828,19 @@
->
load(Operand1, Op1Instr, !Info),
load(Operand2, Op2Instr, !Info),
- OpInstr = instr_node(bne(unsigned, label_target(ElseLabel))),
- Instrs = tree_list([Op1Instr, Op2Instr, OpInstr])
+ OpInstr = singleton(bne(unsigned, label_target(ElseLabel))),
+ Instrs = Op1Instr ++ Op2Instr ++ OpInstr
;
Rval = binop(ne, Operand1, Operand2)
->
load(Operand1, Op1Instr, !Info),
load(Operand2, Op2Instr, !Info),
- OpInstr = instr_node(beq(label_target(ElseLabel))),
- Instrs = tree_list([Op1Instr, Op2Instr, OpInstr])
+ OpInstr = singleton(beq(label_target(ElseLabel))),
+ Instrs = Op1Instr ++ Op2Instr ++ OpInstr
;
load(Rval, RvalLoadInstrs, !Info),
- ExtraInstrs = instr_node(brfalse(label_target(ElseLabel))),
- Instrs = tree_list([RvalLoadInstrs, ExtraInstrs])
+ ExtraInstrs = singleton(brfalse(label_target(ElseLabel))),
+ Instrs = RvalLoadInstrs ++ ExtraInstrs
).
%-----------------------------------------------------------------------------%
@@ -3856,7 +3825,7 @@
( PtrClassName = CtorClassName ->
CastClassInstrs = empty
;
- CastClassInstrs = instr_node(
+ CastClassInstrs = singleton(
castclass(il_type([], class(ClassName))))
)
),
@@ -3936,13 +3905,13 @@
:- func convert_to_object(il_type) = instr_tree.
-convert_to_object(Type) = instr_node(box(ValueType)) :-
+convert_to_object(Type) = singleton(box(ValueType)) :-
Type = il_type(_, SimpleType),
ValueType = simple_type_to_valuetype(SimpleType).
:- func convert_from_object(il_type) = instr_tree.
-convert_from_object(Type) = node([unbox(Type), ldobj(Type)]).
+convert_from_object(Type) = from_list([unbox(Type), ldobj(Type)]).
:- func simple_type_to_valuetype(simple_type) = il_type.
simple_type_to_valuetype(int8) =
@@ -4345,7 +4314,7 @@
DebugIlAsm = no,
Add = 0
),
- Instrs = list.condense(tree.flatten(InstrTree)),
+ Instrs = cord.list(InstrTree),
MaxStack = maxstack(int32(calculate_max_stack(Instrs) + Add)),
% .zeroinit (which initializes all variables to zero) is required for
% verifiable code. But if we're generating non-verifiable code, then
@@ -4381,7 +4350,7 @@
:- func throw_unimplemented(string) = instr_tree.
throw_unimplemented(String) =
- node([
+ from_list([
ldstr(String),
newobj(get_instance_methodref(il_exception_class_name,
ctor, void, [il_string_type])),
@@ -4477,16 +4446,17 @@
il_info_new_class(ClassDefn, !Info) :-
ClassDefn = mlds_class_defn(_, _, _, _, _, Members),
- list.filter_map((pred(M::in, S::out) is semidet :-
+ list.filter_map(
+ (pred(M::in, S::out) is semidet :-
M = mlds_defn(Name, _, _, mlds_data(_, _, _)),
S = entity_name_to_ilds_id(Name)
), Members, FieldNames),
- !:Info = !.Info ^ alloc_instrs := empty,
- !:Info = !.Info ^ init_instrs := empty,
- !:Info = !.Info ^ class_members := [],
- !:Info = !.Info ^ has_main := no_main,
- !:Info = !.Info ^ class_foreign_langs := set.init,
- !:Info = !.Info ^ field_names := set.list_to_set(FieldNames).
+ !Info ^ alloc_instrs := empty,
+ !Info ^ init_instrs := empty,
+ !Info ^ class_members := [],
+ !Info ^ has_main := no_main,
+ !Info ^ class_foreign_langs := set.init,
+ !Info ^ field_names := set.list_to_set(FieldNames).
% Reset the il_info for processing a new method.
%
@@ -4498,28 +4468,28 @@
Info0 = !.Info,
(
!.Info ^ method_foreign_lang = yes(SomeLang),
- !:Info = !.Info ^ file_foreign_langs :=
+ !Info ^ file_foreign_langs :=
set.insert(Info0 ^ file_foreign_langs, SomeLang),
- !:Info = !.Info ^ class_foreign_langs :=
+ !Info ^ class_foreign_langs :=
set.insert(Info0 ^ class_foreign_langs, SomeLang)
;
!.Info ^ method_foreign_lang = no
),
- !:Info = !.Info ^ locals := map.init,
- !:Info = !.Info ^ instr_tree := empty,
- !:Info = !.Info ^ label_counter := counter.init(1),
- !:Info = !.Info ^ block_counter := counter.init(1),
- !:Info = !.Info ^ method_foreign_lang := no,
- !:Info = !.Info ^ arguments := ILArgs,
- !:Info = !.Info ^ method_name := MethodName,
- !:Info = !.Info ^ csharp_method_name := CSharpMethodName,
- !:Info = !.Info ^ signature := ILSignature.
+ !Info ^ locals := map.init,
+ !Info ^ instr_tree := empty,
+ !Info ^ label_counter := counter.init(1),
+ !Info ^ block_counter := counter.init(1),
+ !Info ^ method_foreign_lang := no,
+ !Info ^ arguments := ILArgs,
+ !Info ^ method_name := MethodName,
+ !Info ^ csharp_method_name := CSharpMethodName,
+ !Info ^ signature := ILSignature.
:- pred il_info_set_arguments(assoc_list(ilds.id, mlds_type)::in,
il_info::in, il_info::out) is det.
il_info_set_arguments(Arguments, !Info) :-
- !:Info = !.Info ^ arguments := Arguments.
+ !Info ^ arguments := Arguments.
:- pred il_info_get_arguments(il_info::in, arguments_map::out) is det.
@@ -4551,13 +4521,13 @@
il_info::in, il_info::out) is det.
il_info_set_modulename(ModuleName, !Info) :-
- !:Info = !.Info ^ module_name := ModuleName.
+ !Info ^ module_name := ModuleName.
:- pred il_info_add_locals(assoc_list(ilds.id, mlds_type)::in,
il_info::in, il_info::out) is det.
il_info_add_locals(NewLocals, !Info) :-
- !:Info = !.Info ^ locals :=
+ !Info ^ locals :=
map.det_insert_from_assoc_list(!.Info ^ locals, NewLocals).
:- pred il_info_remove_locals(assoc_list(ilds.id, mlds_type)::in,
@@ -4566,37 +4536,37 @@
il_info_remove_locals(RemoveLocals, !Info) :-
assoc_list.keys(RemoveLocals, Keys),
map.delete_list(!.Info ^ locals, Keys, NewLocals),
- !:Info = !.Info ^ locals := NewLocals.
+ !Info ^ locals := NewLocals.
:- pred il_info_add_class_member(list(class_member)::in,
il_info::in, il_info::out) is det.
il_info_add_class_member(ClassMembers, !Info) :-
- !:Info = !.Info ^ class_members :=
+ !Info ^ class_members :=
list.append(ClassMembers, !.Info ^ class_members).
:- pred il_info_add_instructions(list(instr)::in,
il_info::in, il_info::out) is det.
il_info_add_instructions(NewInstrs, !Info) :-
- !:Info = !.Info ^ instr_tree :=
- tree(!.Info ^ instr_tree, node(NewInstrs)).
+ !Info ^ instr_tree :=
+ !.Info ^ instr_tree ++ from_list(NewInstrs).
:- pred il_info_add_init_instructions(list(instr)::in,
il_info::in, il_info::out) is det.
il_info_add_init_instructions(NewInstrs, !Info) :-
- !:Info = !.Info ^ init_instrs :=
- tree(!.Info ^ init_instrs, node(NewInstrs)).
+ !Info ^ init_instrs :=
+ !.Info ^ init_instrs ++ from_list(NewInstrs).
:- pred il_info_add_alloc_instructions(list(instr)::in,
il_info::in, il_info::out) is det.
il_info_add_alloc_instructions(NewInstrs, !Info) :-
- !:Info = !.Info ^ alloc_instrs :=
- tree(!.Info ^ alloc_instrs, node(NewInstrs)).
+ !Info ^ alloc_instrs :=
+ !.Info ^ alloc_instrs ++ from_list(NewInstrs).
-:- pred il_info_get_instructions(il_info::in, tree(list(instr))::out) is det.
+:- pred il_info_get_instructions(il_info::in, cord(instr)::out) is det.
il_info_get_instructions(Info, Instrs) :-
Instrs = Info ^ instr_tree.
@@ -4642,13 +4612,13 @@
%
:- func comment_node(string) = instr_tree.
-comment_node(S) = node([comment(S)]).
+comment_node(S) = singleton(comment(S)).
% Use this to make contexts into trees easily.
%
:- func context_node(mlds_context) = instr_tree.
-context_node(Context) = node([context_instr(Context)]).
+context_node(Context) = singleton(context_instr(Context)).
:- func context_instr(mlds_context) = instr.
@@ -4657,12 +4627,6 @@
term.context_file(ProgContext, FileName),
term.context_line(ProgContext, LineNumber).
- % Use this to make instructions into trees easily.
- %
-:- func instr_node(instr) = instr_tree.
-
-instr_node(I) = node([I]).
-
% Maybe fold T into U, and map it to V.
% U remains untouched if T is `no'.
%
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.38
diff -u -b -r1.38 par_conj_gen.m
--- compiler/par_conj_gen.m 23 Dec 2008 01:37:38 -0000 1.38
+++ compiler/par_conj_gen.m 4 Jan 2009 11:45:56 -0000
@@ -97,7 +97,7 @@
%---------------------------------------------------------------------------%
:- pred generate_par_conj(list(hlds_goal)::in, hlds_goal_info::in,
- code_model::in, code_tree::out, code_info::in, code_info::out) is det.
+ code_model::in, llds_code::out, code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -112,13 +112,13 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.exprn_aux.
:- import_module parse_tree.prog_data.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module map.
@@ -151,16 +151,16 @@
( Depth = 0 ->
acquire_temp_slot(slot_lval(parent_sp),
non_persistent_temp_slot, ParentSpSlot, !CI),
- MaybeSetParentSpCode = node([
+ MaybeSetParentSpCode = from_list([
llds_instr(assign(ParentSpSlot, lval(parent_sp)),
"save the old parent stack pointer"),
llds_instr(assign(parent_sp, lval(sp)),
"set the parent stack pointer")
]),
- MaybeRestoreParentSpCode = node([
+ MaybeRestoreParentSpCode = singleton(
llds_instr(assign(parent_sp, lval(ParentSpSlot)),
"restore old parent stack pointer")
- ]),
+ ),
MaybeReleaseParentSpSlot = yes(ParentSpSlot)
;
MaybeSetParentSpCode = empty,
@@ -196,10 +196,10 @@
),
NumGoals = list.length(Goals),
- MakeSyncTermCode = node([
+ MakeSyncTermCode = singleton(
llds_instr(init_sync_term(SyncTermBaseSlot, NumGoals),
"initialize sync term")
- ]),
+ ),
set_par_conj_depth(Depth+1, !CI),
get_next_label(EndLabel, !CI),
@@ -208,17 +208,16 @@
no, GoalCode, !CI),
set_par_conj_depth(Depth, !CI),
- EndLabelCode = node([
+ EndLabelCode = singleton(
llds_instr(label(EndLabel), "end of parallel conjunction")
- ]),
- Code = tree_list([
- MaybeSetParentSpCode,
- SaveCode,
- MakeSyncTermCode,
- GoalCode,
- EndLabelCode,
- MaybeRestoreParentSpCode
- ]),
+ ),
+ Code =
+ MaybeSetParentSpCode ++
+ SaveCode ++
+ MakeSyncTermCode ++
+ GoalCode ++
+ EndLabelCode ++
+ MaybeRestoreParentSpCode,
% We can't release the sync slot right now, in case we are in a
% nested parallel conjunction. Consider:
@@ -237,7 +236,7 @@
% top level.
%
% XXX release sync slots of nested parallel conjunctions
- %
+
( Depth = 0 ->
release_several_temp_slots(SyncTermSlots, persistent_temp_slot, !CI)
;
@@ -253,7 +252,7 @@
place_all_outputs(Outputs, !CI).
:- pred generate_det_par_conj_2(list(hlds_goal)::in,
- lval::in, label::in, instmap::in, branch_end::in, code_tree::out,
+ lval::in, label::in, instmap::in, branch_end::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_det_par_conj_2([], _ParentSyncTermBaseSlot, _EndLabel,
@@ -276,11 +275,11 @@
Goals = [_ | _],
get_next_label(NextConjunct, !CI),
reset_to_position(StartPos, !CI),
- ForkCode = node([
+ ForkCode = singleton(
llds_instr(fork_new_child(ParentSyncTermBaseSlot, NextConjunct),
"fork off a child")
- ]),
- JoinCode = node([
+ ),
+ JoinCode = from_list([
llds_instr(join_and_continue(ParentSyncTermBaseSlot, EndLabel),
"finish"),
llds_instr(label(NextConjunct),
@@ -289,15 +288,15 @@
;
Goals = [],
ForkCode = empty,
- JoinCode = node([
+ JoinCode = singleton(
llds_instr(join_and_continue(ParentSyncTermBaseSlot, EndLabel),
"finish")
- ])
+ )
),
- ThisCode = tree_list([ForkCode, ThisGoalCode, SaveCode, JoinCode]),
+ ThisCode = ForkCode ++ ThisGoalCode ++ SaveCode ++ JoinCode,
generate_det_par_conj_2(Goals, ParentSyncTermBaseSlot, EndLabel, Initial,
MaybeEnd, RestCode, !CI),
- Code = tree(ThisCode, RestCode).
+ Code = ThisCode ++ RestCode.
%-----------------------------------------------------------------------------%
@@ -306,18 +305,17 @@
% usual `sp' register, as the conjunct could be running in a different
% context.
%
-:- pred replace_stack_vars_by_parent_sv(code_tree::in, code_tree::out) is det.
+:- pred replace_stack_vars_by_parent_sv(llds_code::in, llds_code::out) is det.
replace_stack_vars_by_parent_sv(!Code) :-
- tree.map(replace_stack_vars_by_parent_sv_instrs, !Code).
+ cord.map_pred(replace_stack_vars_by_parent_sv_instr, !Code).
-:- pred replace_stack_vars_by_parent_sv_instrs(list(instruction)::in,
- list(instruction)::out) is det.
+:- pred replace_stack_vars_by_parent_sv_instr(instruction::in,
+ instruction::out) is det.
-replace_stack_vars_by_parent_sv_instrs(!Instrs) :-
- list.map_foldl(
- transform_lval_in_instr(replace_stack_vars_by_parent_sv_lval),
- !Instrs, unit, _).
+replace_stack_vars_by_parent_sv_instr(!Instr) :-
+ transform_lval_in_instr(replace_stack_vars_by_parent_sv_lval,
+ !Instr, unit, _).
:- pred replace_stack_vars_by_parent_sv_lval(lval::in, lval::out,
unit::in, unit::out) is det.
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.112
diff -u -b -r1.112 pragma_c_gen.m
--- compiler/pragma_c_gen.m 11 Feb 2008 21:26:07 -0000 1.112
+++ compiler/pragma_c_gen.m 4 Jan 2009 11:49:53 -0000
@@ -40,7 +40,7 @@
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in,
maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
- hlds_goal_info::in, code_tree::out,
+ hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is det.
:- func foreign_proc_struct_name(module_name, string, int, proc_id) = string.
@@ -69,7 +69,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.llds_out.
:- import_module ll_backend.trace_gen.
@@ -77,6 +76,7 @@
:- import_module parse_tree.prog_type.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module pair.
@@ -402,22 +402,22 @@
%---------------------------------------------------------------------------%
:- pred generate_trace_runtime_cond_foreign_proc_code(
- trace_expr(trace_runtime)::in, code_tree::out,
+ trace_expr(trace_runtime)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_trace_runtime_cond_foreign_proc_code(RuntimeExpr, Code, !CI) :-
generate_runtime_cond_code(RuntimeExpr, CondRval, !CI),
get_next_label(SuccessLabel, !CI),
generate_failure(FailCode, !CI),
- CondCode = node([
+ CondCode = singleton(
llds_instr(if_val(CondRval, code_label(SuccessLabel)),
"environment variable tests")
- ]),
- SuccessLabelCode = node([
+ ),
+ SuccessLabelCode = singleton(
llds_instr(label(SuccessLabel),
"environment variable tests successful")
- ]),
- Code = tree_list([CondCode, FailCode, SuccessLabelCode]).
+ ),
+ Code = CondCode ++ FailCode ++ SuccessLabelCode.
:- pred generate_runtime_cond_code(trace_expr(trace_runtime)::in,
rval::out, code_info::in, code_info::out) is det.
@@ -454,7 +454,7 @@
:- pred generate_ordinary_foreign_proc_code(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
- maybe(prog_context)::in, hlds_goal_info::in, bool::in, code_tree::out,
+ maybe(prog_context)::in, hlds_goal_info::in, bool::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_ordinary_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
@@ -660,11 +660,11 @@
;
RefersToLLDSSTack = no
),
- PragmaCCode = node([
+ PragmaCCode = singleton(
llds_instr(foreign_proc_code(Decls, Components, MayCallMercury,
no, no, no, MaybeFailLabel, RefersToLLDSSTack, MayDupl),
"foreign_proc inclusion")
- ]),
+ ),
% For semidet code, we need to insert the failure handling code here:
%
@@ -682,13 +682,17 @@
MaybeFailLabel = yes(TheFailLabel),
get_next_label(SkipLabel, !CI),
generate_failure(FailCode, !CI),
- GotoSkipLabelCode = node([
+ GotoSkipLabelCode = singleton(
llds_instr(goto(code_label(SkipLabel)), "Skip past failure code")
- ]),
- SkipLabelCode = node([llds_instr(label(SkipLabel), "")]),
- FailLabelCode = node([llds_instr(label(TheFailLabel), "")]),
- FailureCode = tree_list([GotoSkipLabelCode, FailLabelCode,
- FailCode, SkipLabelCode])
+ ),
+ SkipLabelCode = singleton(
+ llds_instr(label(SkipLabel), "")
+ ),
+ FailLabelCode = singleton(
+ llds_instr(label(TheFailLabel), "")
+ ),
+ FailureCode = GotoSkipLabelCode ++ FailLabelCode ++ FailCode ++
+ SkipLabelCode
;
MaybeFailLabel = no,
( Detism = detism_failure ->
@@ -699,7 +703,7 @@
),
% Join all code fragments together.
- Code = tree_list([SaveVarsCode, InputVarsCode, PragmaCCode, FailureCode]).
+ Code = SaveVarsCode ++ InputVarsCode ++ PragmaCCode ++ FailureCode.
:- pred make_proc_label_hash_define(module_info::in, pred_id::in, proc_id::in,
foreign_proc_component::out, foreign_proc_component::out) is det.
@@ -735,7 +739,7 @@
string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in,
foreign_proc_shared_code_treatment::in,
- string::in, maybe(prog_context)::in, bool::in, code_tree::out,
+ string::in, maybe(prog_context)::in, bool::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_nondet_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
@@ -787,14 +791,14 @@
InitSaveStruct),
get_next_label(RetryLabel, !CI),
- ModFrameCode = node([
+ ModFrameCode = singleton(
llds_instr(assign(redoip_slot(lval(curfr)),
const(llconst_code_addr(code_label(RetryLabel)))),
"Set up backtracking to retry label")
- ]),
- RetryLabelCode = node([
+ ),
+ RetryLabelCode = singleton(
llds_instr(label(RetryLabel), "Start of the retry block")
- ]),
+ ),
get_globals(!.CI, Globals),
@@ -823,10 +827,8 @@
maybe_generate_foreign_proc_event_code(nondet_foreign_proc_later,
ActualLaterContext, LaterTraceCode, !CI),
- FirstDisjunctCode = tree_list([SaveHeapCode, SaveTicketCode,
- FirstTraceCode]),
- LaterDisjunctCode = tree_list([RestoreHeapCode, RestoreTicketCode,
- LaterTraceCode]),
+ FirstDisjunctCode = SaveHeapCode ++ SaveTicketCode ++ FirstTraceCode,
+ LaterDisjunctCode = RestoreHeapCode ++ RestoreTicketCode ++ LaterTraceCode,
% MR_save_registers(); /* see notes (1) and (2) above */
% MR_restore_registers(); /* see notes (1) and (3) above */
@@ -944,11 +946,11 @@
proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
ProcLabelUndef
],
- CallBlockCode = node([
+ CallBlockCode = singleton(
llds_instr(foreign_proc_code(CallDecls, CallComponents,
MayCallMercury, no, no, no, no, yes, MD),
"Call and shared foreign_proc inclusion")
- ]),
+ ),
RetryDecls = [SaveStructDecl | OutDecls],
RetryComponents = [
@@ -995,19 +997,19 @@
proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
ProcLabelUndef
],
- RetryBlockCode = node([
+ RetryBlockCode = singleton(
llds_instr(foreign_proc_code(RetryDecls, RetryComponents,
MayCallMercury, no, no, no, no, yes, MD),
"Retry and shared foreign_proc inclusion")
- ]),
+ ),
- Code = tree_list([ModFrameCode, FirstDisjunctCode, CallBlockCode,
- RetryLabelCode, LaterDisjunctCode, RetryBlockCode])
+ Code = ModFrameCode ++ FirstDisjunctCode ++ CallBlockCode ++
+ RetryLabelCode ++ LaterDisjunctCode ++ RetryBlockCode
;
get_next_label(SharedLabel, !CI),
- SharedLabelCode = node([
+ SharedLabelCode = singleton(
llds_instr(label(SharedLabel), "Start of the shared block")
- ]),
+ ),
SharedDef1 =
"#define\tSUCCEED \tgoto MR_shared_success_"
@@ -1074,11 +1076,11 @@
proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
ProcLabelUndef
],
- CallBlockCode = node([
+ CallBlockCode = singleton(
llds_instr(foreign_proc_code(CallDecls, CallComponents,
MayCallMercury, yes(SharedLabel), no, no, no, yes, MD),
"Call foreign_proc inclusion")
- ]),
+ ),
RetryDecls = [SaveStructDecl | OutDecls],
RetryComponents = [
@@ -1127,11 +1129,11 @@
proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
ProcLabelUndef
],
- RetryBlockCode = node([
+ RetryBlockCode = singleton(
llds_instr(foreign_proc_code(RetryDecls, RetryComponents,
MayCallMercury, yes(SharedLabel), no, no, no, yes, MD),
"Retry foreign_proc inclusion")
- ]),
+ ),
SharedDecls = [SaveStructDecl | OutDecls],
SharedComponents = [
@@ -1181,15 +1183,15 @@
proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
ProcLabelUndef
],
- SharedBlockCode = node([
+ SharedBlockCode = singleton(
llds_instr(foreign_proc_code(SharedDecls, SharedComponents,
MayCallMercury, no, no, no, no, yes, MD),
"Shared foreign_proc inclusion")
- ]),
+ ),
- Code = tree_list([ModFrameCode, FirstDisjunctCode, CallBlockCode,
- RetryLabelCode, LaterDisjunctCode, RetryBlockCode, SharedLabelCode,
- SharedBlockCode])
+ Code = ModFrameCode ++ FirstDisjunctCode ++ CallBlockCode ++
+ RetryLabelCode ++ LaterDisjunctCode ++ RetryBlockCode ++
+ SharedLabelCode ++ SharedBlockCode
).
%---------------------------------------------------------------------------%
@@ -1273,8 +1275,8 @@
%---------------------------------------------------------------------------%
- % foreign_proc_select_out_args returns the list of variables which are outputs
- % for a procedure.
+ % foreign_proc_select_out_args returns the list of variables which are
+ % outputs for a procedure.
%
:- pred foreign_proc_select_out_args(list(c_arg)::in, list(c_arg)::out) is det.
@@ -1403,7 +1405,7 @@
% to those (C) variables.
%
:- pred get_foreign_proc_input_vars(list(c_arg)::in,
- list(foreign_proc_input)::out, bool::in, code_tree::out,
+ list(foreign_proc_input)::out, bool::in, llds_code::out,
code_info::in, code_info::out) is det.
get_foreign_proc_input_vars([], [], _, empty, !CI).
@@ -1423,7 +1425,7 @@
get_foreign_proc_input_vars(Args, Inputs1, CanOptAwayUnnamedArgs,
RestCode, !CI),
Inputs = [Input | Inputs1],
- Code = tree(FirstCode, RestCode)
+ Code = FirstCode ++ RestCode
;
MaybeName = no,
% Just ignore the argument.
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.30
diff -u -b -r1.30 proc_gen.m
--- compiler/proc_gen.m 23 Dec 2008 01:37:39 -0000 1.30
+++ compiler/proc_gen.m 4 Jan 2009 11:54:30 -0000
@@ -87,7 +87,6 @@
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.trace_params.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.code_info.
:- import_module ll_backend.code_util.
@@ -105,6 +104,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module counter.
:- import_module int.
:- import_module map.
@@ -375,11 +375,7 @@
true
),
- % Turn the code tree into a list.
- tree.flatten(CodeTree, FragmentList),
- % Now the code is a list of code fragments (== list(instr)),
- % so we need to do a level of unwinding to get a flat list.
- list.condense(FragmentList, Instructions0),
+ Instructions0 = cord.list(CodeTree),
FrameInfo = frame(TotalSlots, MaybeSuccipSlot, _),
(
MaybeSuccipSlot = yes(SuccipSlot),
@@ -620,7 +616,7 @@
% for the failure continuation at all times.)
%
:- pred generate_category_code(code_model::in, prog_context::in, hlds_goal::in,
- resume_point_info::in, trace_slot_info::in, code_tree::out,
+ resume_point_info::in, trace_slot_info::in, llds_code::out,
maybe(label)::out, frame_info::out, code_info::in, code_info::out) is det.
generate_category_code(model_det, ProcContext, Goal, ResumePoint,
@@ -644,9 +640,9 @@
get_trace_maybe_tail_rec_info(TraceInfo, MaybeTailRecInfo),
(
MaybeTailRecInfo = yes(_TailRecLval - TailRecLabel),
- TailRecLabelCode = node([
+ TailRecLabelCode = singleton(
llds_instr(label(TailRecLabel), "tail recursion label")
- ])
+ )
;
MaybeTailRecInfo = no,
TailRecLabelCode = empty
@@ -662,14 +658,14 @@
EntryCode),
generate_exit(model_det, FrameInfo, TraceSlotInfo, ProcContext,
_, ExitCode, !CI),
- Code = tree_list([EntryCode, TraceCallCode, TailRecLabelCode,
- BodyCode, ExitCode])
+ Code = EntryCode ++ TraceCallCode ++ TailRecLabelCode ++
+ BodyCode ++ ExitCode
).
generate_category_code(model_semi, ProcContext, Goal, ResumePoint,
TraceSlotInfo, Code, MaybeTraceCallLabel, FrameInfo, !CI) :-
set.singleton_set(FailureLiveRegs, reg(reg_r, 1)),
- FailCode = node([
+ FailCode = from_list([
llds_instr(assign(reg(reg_r, 1), const(llconst_false)), "Fail"),
llds_instr(livevals(FailureLiveRegs), ""),
llds_instr(goto(code_succip), "Return from procedure call")
@@ -682,9 +678,9 @@
get_trace_maybe_tail_rec_info(TraceInfo, MaybeTailRecInfo),
(
MaybeTailRecInfo = yes(_TailRecLval - TailRecLabel),
- TailRecLabelCode = node([
+ TailRecLabelCode = singleton(
llds_instr(label(TailRecLabel), "tail recursion label")
- ])
+ )
;
MaybeTailRecInfo = no,
TailRecLabelCode = empty
@@ -710,9 +706,9 @@
MaybeFailExternalInfo = no,
TraceFailCode = empty
),
- Code = tree_list([EntryCode, TraceCallCode, TailRecLabelCode,
- BodyCode, ExitCode, ResumeCode, TraceFailCode,
- RestoreDeallocCode, FailCode])
+ Code = EntryCode ++ TraceCallCode ++ TailRecLabelCode ++
+ BodyCode ++ ExitCode ++ ResumeCode ++ TraceFailCode ++
+ RestoreDeallocCode ++ FailCode
;
MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
@@ -722,8 +718,8 @@
generate_exit(model_semi, FrameInfo, TraceSlotInfo,
ProcContext, RestoreDeallocCode, ExitCode, !CI),
generate_resume_point(ResumePoint, ResumeCode, !CI),
- Code = tree_list([EntryCode, BodyCode, ExitCode,
- ResumeCode, RestoreDeallocCode, FailCode])
+ Code = EntryCode ++ BodyCode ++ ExitCode ++ ResumeCode ++
+ RestoreDeallocCode ++ FailCode
).
generate_category_code(model_non, ProcContext, Goal, ResumePoint,
@@ -766,7 +762,7 @@
FromFullSlotLval =
llds.stack_slot_num_to_lval(nondet_stack, FromFullSlot),
get_next_label(SkipLabel, !CI),
- DiscardTraceTicketCode = node([
+ DiscardTraceTicketCode = from_list([
llds_instr(
if_val(unop(logical_not, lval(FromFullSlotLval)),
code_label(SkipLabel)), ""),
@@ -775,18 +771,18 @@
])
;
MaybeFromFull = no,
- DiscardTraceTicketCode = node([
+ DiscardTraceTicketCode = singleton(
llds_instr(discard_ticket, "discard retry ticket")
- ])
+ )
)
;
DiscardTraceTicketCode = empty
),
- FailCode = node([
+ FailCode = singleton(
llds_instr(goto(do_fail), "fail after fail trace port")
- ]),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode,
- ResumeCode, TraceFailCode, DiscardTraceTicketCode, FailCode])
+ ),
+ Code = EntryCode ++ TraceCallCode ++ BodyCode ++ ExitCode ++
+ ResumeCode ++ TraceFailCode ++ DiscardTraceTicketCode ++ FailCode
;
MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
@@ -795,11 +791,11 @@
FrameInfo, EntryCode),
generate_exit(model_non, FrameInfo, TraceSlotInfo,
ProcContext, _, ExitCode, !CI),
- Code = tree_list([EntryCode, BodyCode, ExitCode])
+ Code = EntryCode ++ BodyCode ++ ExitCode
).
:- pred generate_call_event(trace_info::in, prog_context::in,
- maybe(label)::out, code_tree::out, code_info::in, code_info::out) is det.
+ maybe(label)::out, llds_code::out, code_info::in, code_info::out) is det.
generate_call_event(TraceInfo, ProcContext, MaybeTraceCallLabel, TraceCallCode,
!CI) :-
@@ -840,14 +836,14 @@
% to fill in the succip slot is subsumed by the mkframe.
:- pred generate_entry(code_info::in, code_model::in, hlds_goal::in,
- resume_point_info::in, frame_info::out, code_tree::out) is det.
+ resume_point_info::in, frame_info::out, llds_code::out) is det.
generate_entry(CI, CodeModel, Goal, OutsideResumePoint, FrameInfo,
EntryCode) :-
get_stack_slots(CI, StackSlots),
get_varset(CI, VarSet),
SlotsComment = explain_stack_slots(StackSlots, VarSet),
- StartComment = node([
+ StartComment = from_list([
llds_instr(comment("Start of procedure prologue"), ""),
llds_instr(comment(SlotsComment), "")
]),
@@ -856,9 +852,9 @@
get_proc_id(CI, ProcId),
get_module_info(CI, ModuleInfo),
EntryLabel = make_local_entry_label(ModuleInfo, PredId, ProcId, no),
- LabelCode = node([
+ LabelCode = singleton(
llds_instr(label(EntryLabel), "Procedure entry point")
- ]),
+ ),
get_succip_used(CI, Used),
(
% Do we need to save the succip across calls?
@@ -867,10 +863,10 @@
CodeModel \= model_non
->
SuccipSlot = MainSlots + 1,
- SaveSuccipCode = node([
+ SaveSuccipCode = singleton(
llds_instr(assign(stackvar(SuccipSlot), lval(succip)),
"Save the success ip")
- ]),
+ ),
TotalSlots = SuccipSlot,
MaybeSuccipSlot = yes(SuccipSlot)
;
@@ -911,7 +907,7 @@
DefineStr)],
NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, yes(Struct)),
MD = proc_may_not_duplicate,
- AllocCode = node([
+ AllocCode = from_list([
llds_instr(mkframe(NondetFrameInfo, yes(OutsideResumeAddress)),
"Allocate stack frame"),
llds_instr(foreign_proc_code([], DefineComponents,
@@ -920,10 +916,10 @@
NondetPragma = yes
;
NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, no),
- AllocCode = node([
+ AllocCode = singleton(
llds_instr(mkframe(NondetFrameInfo, yes(OutsideResumeAddress)),
"Allocate stack frame")
- ]),
+ ),
NondetPragma = no
)
;
@@ -939,21 +935,21 @@
StackIncrKind = stack_incr_leaf
),
( TotalSlots > 0 ->
- AllocCode = node([
+ AllocCode = singleton(
llds_instr(incr_sp(TotalSlots, PushMsg, StackIncrKind),
"Allocate stack frame")
- ])
+ )
;
AllocCode = empty
),
NondetPragma = no
),
FrameInfo = frame(TotalSlots, MaybeSuccipSlot, NondetPragma),
- EndComment = node([
+ EndComment = singleton(
llds_instr(comment("End of procedure prologue"), "")
- ]),
- EntryCode = tree_list([StartComment, LabelCode, AllocCode,
- SaveSuccipCode, TraceFillCode, EndComment]).
+ ),
+ EntryCode = StartComment ++ LabelCode ++ AllocCode ++
+ SaveSuccipCode ++ TraceFillCode ++ EndComment.
%---------------------------------------------------------------------------%
@@ -987,17 +983,17 @@
% we need only #undef a macro defined by the procedure prologue.
:- pred generate_exit(code_model::in, frame_info::in,
- trace_slot_info::in, prog_context::in, code_tree::out, code_tree::out,
+ trace_slot_info::in, prog_context::in, llds_code::out, llds_code::out,
code_info::in, code_info::out) is det.
generate_exit(CodeModel, FrameInfo, TraceSlotInfo, ProcContext,
RestoreDeallocCode, ExitCode, !CI) :-
- StartComment = node([
+ StartComment = singleton(
llds_instr(comment("Start of procedure epilogue"), "")
- ]),
- EndComment = node([
+ ),
+ EndComment = singleton(
llds_instr(comment("End of procedure epilogue"), "")
- ]),
+ ),
FrameInfo = frame(TotalSlots, MaybeSuccipSlot, NondetPragma),
(
NondetPragma = yes,
@@ -1006,12 +1002,12 @@
proc_does_not_affect_liveness, live_lvals_info(set.init),
UndefStr)],
MD = proc_may_not_duplicate,
- UndefCode = node([
+ UndefCode = singleton(
llds_instr(foreign_proc_code([], UndefComponents,
proc_will_not_call_mercury, no, no, no, no, no, MD), "")
- ]),
+ ),
RestoreDeallocCode = empty, % always empty for nondet code
- ExitCode = tree_list([StartComment, UndefCode, EndComment])
+ ExitCode = StartComment ++ UndefCode ++ EndComment
;
NondetPragma = no,
get_instmap(!.CI, InstMap),
@@ -1026,10 +1022,10 @@
),
(
MaybeSuccipSlot = yes(SuccipSlot),
- RestoreSuccipCode = node([
+ RestoreSuccipCode = singleton(
llds_instr(assign(succip, lval(stackvar(SuccipSlot))),
"restore the success ip")
- ])
+ )
;
MaybeSuccipSlot = no,
RestoreSuccipCode = empty
@@ -1041,9 +1037,9 @@
->
DeallocCode = empty
;
- DeallocCode = node([
+ DeallocCode = singleton(
llds_instr(decr_sp(TotalSlots), "Deallocate stack frame")
- ])
+ )
),
(
TraceSlotInfo ^ slot_trail = yes(_),
@@ -1065,13 +1061,13 @@
llds.stack_slot_num_to_lval(StackId, FromFullSlot),
get_next_label(SkipLabel, !CI),
get_next_label(SkipLabelCopy, !CI),
- PruneTraceTicketCode = node([
+ PruneTraceTicketCode = from_list([
llds_instr(if_val(unop(logical_not, lval(FromFullSlotLval)),
code_label(SkipLabel)), ""),
llds_instr(prune_ticket, "prune retry ticket"),
llds_instr(label(SkipLabel), "")
]),
- PruneTraceTicketCodeCopy = node([
+ PruneTraceTicketCodeCopy = from_list([
llds_instr(if_val(unop(logical_not, lval(FromFullSlotLval)),
code_label(SkipLabelCopy)), ""),
llds_instr(prune_ticket, "prune retry ticket"),
@@ -1079,9 +1075,9 @@
])
;
MaybeFromFull = no,
- PruneTraceTicketCode = node([
+ PruneTraceTicketCode = singleton(
llds_instr(prune_ticket, "prune retry ticket")
- ]),
+ ),
PruneTraceTicketCodeCopy = PruneTraceTicketCode
)
;
@@ -1089,10 +1085,10 @@
PruneTraceTicketCodeCopy = empty
),
- RestoreDeallocCode = tree_list([RestoreSuccipCode,
- PruneTraceTicketCode, DeallocCode]),
- RestoreDeallocCodeCopy = tree_list([RestoreSuccipCode,
- PruneTraceTicketCodeCopy, DeallocCode]),
+ RestoreDeallocCode = RestoreSuccipCode ++
+ PruneTraceTicketCode ++ DeallocCode,
+ RestoreDeallocCodeCopy = RestoreSuccipCode ++
+ PruneTraceTicketCodeCopy ++ DeallocCode,
get_maybe_trace_info(!.CI, MaybeTraceInfo),
(
@@ -1134,25 +1130,25 @@
CodeModel = model_det,
expect(unify(MaybeSpecialReturn, no), this_file,
"generate_exit: det special_return"),
- SuccessCode = node([
+ SuccessCode = from_list([
llds_instr(livevals(LiveLvals), ""),
llds_instr(goto(code_succip), "Return from procedure call")
]),
- AllSuccessCode = tree_list([TraceExitCode, RestoreDeallocCodeCopy,
- SuccessCode])
+ AllSuccessCode = TraceExitCode ++ RestoreDeallocCodeCopy ++
+ SuccessCode
;
CodeModel = model_semi,
expect(unify(MaybeSpecialReturn, no), this_file,
"generate_exit: semi special_return"),
set.insert(LiveLvals, reg(reg_r, 1), SuccessLiveRegs),
- SuccessCode = node([
+ SuccessCode = from_list([
llds_instr(assign(reg(reg_r, 1), const(llconst_true)),
"Succeed"),
llds_instr(livevals(SuccessLiveRegs), ""),
llds_instr(goto(code_succip), "Return from procedure call")
]),
- AllSuccessCode = tree_list([TraceExitCode, RestoreDeallocCodeCopy,
- SuccessCode])
+ AllSuccessCode = TraceExitCode ++ RestoreDeallocCodeCopy ++
+ SuccessCode
;
CodeModel = model_non,
(
@@ -1171,24 +1167,23 @@
Component = foreign_proc_user_code(no,
proc_does_not_affect_liveness, ReturnCodeStr),
MD = proc_may_not_duplicate,
- SuccessCode = node([
+ SuccessCode = from_list([
llds_instr(livevals(LiveLvals), ""),
llds_instr(foreign_proc_code([], [Component],
proc_may_call_mercury, no, no, no, no, no, MD), "")
])
;
MaybeSpecialReturn = no,
- SuccessCode = node([
+ SuccessCode = from_list([
llds_instr(livevals(LiveLvals), ""),
llds_instr(goto(do_succeed(no)),
"Return from procedure call")
])
),
- AllSuccessCode = tree_list([SetupRedoCode, TraceExitCode,
- SuccessCode])
+ AllSuccessCode = SetupRedoCode ++ TraceExitCode ++
+ SuccessCode
),
- ExitCode = tree_list([StartComment, FlushCode, AllSuccessCode,
- EndComment])
+ ExitCode = StartComment ++ FlushCode ++ AllSuccessCode ++ EndComment
).
%---------------------------------------------------------------------------%
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.64
diff -u -b -r1.64 string_switch.m
--- compiler/string_switch.m 30 Dec 2007 08:23:57 -0000 1.64
+++ compiler/string_switch.m 4 Jan 2009 11:55:26 -0000
@@ -27,7 +27,7 @@
:- pred generate_string_switch(list(tagged_case)::in, rval::in, string::in,
code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -41,11 +41,11 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module libs.compiler_util.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.switch_case.
:- import_module ll_backend.trace_gen.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -108,9 +108,9 @@
% Generate the code for the cases.
map.foldl(add_remaining_case, CaseLabelMap, empty, CasesCode),
- EndLabelCode = node([
+ EndLabelCode = singleton(
llds_instr(label(EndLabel), "end of hashed string switch")
- ]),
+ ),
% Generate the code for the hash table lookup.
% XXX We should be using one vector cell, not two scalar cells.
@@ -118,7 +118,7 @@
add_scalar_static_cell_natural_types(Strings, StringTableAddr, !CI),
NextSlotsTable = const(llconst_data_addr(NextSlotsTableAddr, no)),
StringTable = const(llconst_data_addr(StringTableAddr, no)),
- HashLookupCode = node([
+ HashLookupCode = from_list([
llds_instr(comment("hashed string switch"), ""),
llds_instr(assign(SlotReg,
binop(bitwise_and, unop(hash_string, VarRval),
@@ -144,13 +144,13 @@
llds_instr(label(FailLabel), "no match, so fail")
]),
- JumpCode = node([
+ JumpCode = from_list([
llds_instr(label(JumpLabel), "we found a match"),
llds_instr(computed_goto(lval(SlotReg), Targets),
"jump to the corresponding code")
]),
- Code = tree_list([HashLookupCode, FailCode, JumpCode, CasesCode,
- EndLabelCode]).
+ Code = HashLookupCode ++ FailCode ++ JumpCode ++ CasesCode ++
+ EndLabelCode.
:- pred gen_string_hash_slots(int::in, int::in,
map(int, string_hash_slot(label))::in, label::in,
Index: compiler/switch_case.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_case.m,v
retrieving revision 1.1
diff -u -b -r1.1 switch_case.m
--- compiler/switch_case.m 30 Dec 2007 08:23:58 -0000 1.1
+++ compiler/switch_case.m 4 Jan 2009 11:56:54 -0000
@@ -41,7 +41,7 @@
:- type case_label_info
---> case_label_info(
case_description :: string,
- case_code :: code_tree,
+ case_code :: llds_code,
case_code_included :: case_code_included
).
@@ -65,11 +65,11 @@
% generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap):
%
-:- pred generate_case_code_or_jump(label::in, code_tree::out,
+:- pred generate_case_code_or_jump(label::in, llds_code::out,
case_label_map::in, case_label_map::out) is det.
:- pred add_remaining_case(label::in, case_label_info::in,
- code_tree::in, code_tree::out) is det.
+ llds_code::in, llds_code::out) is det.
%-----------------------------------------------------------------------------%
@@ -79,10 +79,10 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_out.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.trace_gen.
+:- import_module cord.
:- import_module list.
:- import_module string.
:- import_module svmap.
@@ -98,16 +98,18 @@
Comment = case_comment(SwitchVarName, MainConsName, OtherConsNames),
reset_to_position(BranchStart, !CI),
get_next_label(Label, !CI),
- LabelCode = node([llds_instr(label(Label), Comment)]),
+ LabelCode = singleton(
+ llds_instr(label(Label), Comment)
+ ),
maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode, !CI),
generate_goal(CodeModel, Goal, GoalCode, !CI),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoEndCode = node([
+ GotoEndCode = singleton(
llds_instr(goto(code_label(EndLabel)),
"goto end of switch on " ++ SwitchVarName)
- ]),
- Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode, GotoEndCode]),
+ ),
+ Code = LabelCode ++ TraceCode ++ GoalCode ++ SaveCode ++ GotoEndCode,
CaseInfo = case_label_info(Comment, Code, case_code_not_yet_included),
svmap.det_insert(Label, CaseInfo, !CaseLabelMap).
@@ -124,16 +126,16 @@
CaseIncluded = case_code_already_included,
% We cannot include the case's code, since it has already been included
% somewhere else.
- Code = node([
+ Code = singleton(
llds_instr(goto(code_label(CaseLabel)), "goto " ++ Comment)
- ])
+ )
).
add_remaining_case(_Label, CaseInfo, !Code) :-
CaseInfo = case_label_info(_Comment, CaseCode, CaseIncluded),
(
CaseIncluded = case_code_not_yet_included,
- !:Code = tree(!.Code, CaseCode)
+ !:Code = !.Code ++ CaseCode
;
CaseIncluded = case_code_already_included
).
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.108
diff -u -b -r1.108 switch_gen.m
--- compiler/switch_gen.m 11 Feb 2008 21:26:09 -0000 1.108
+++ compiler/switch_gen.m 4 Jan 2009 11:58:25 -0000
@@ -56,7 +56,7 @@
%-----------------------------------------------------------------------------%
:- pred generate_switch(code_model::in, prog_var::in, can_fail::in,
- list(case)::in, hlds_goal_info::in, code_tree::out,
+ list(case)::in, hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -73,7 +73,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.dense_switch.
:- import_module ll_backend.lookup_switch.
@@ -85,6 +84,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -200,7 +200,7 @@
no, MaybeEnd, SwitchCode, !CI)
)
),
- Code = tree(VarCode, SwitchCode),
+ Code = VarCode ++ SwitchCode,
after_all_branches(StoreMap, MaybeEnd, !CI).
%-----------------------------------------------------------------------------%
@@ -246,7 +246,7 @@
%
:- pred order_and_generate_cases(list(tagged_case)::in, rval::in, mer_type::in,
string::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
order_and_generate_cases(TaggedCases, VarRval, VarType, VarName, CodeModel,
@@ -530,7 +530,7 @@
:- pred generate_if_then_else_chain_cases(list(tagged_case)::in,
rval::in, mer_type::in, string::in, maybe_cheaper_tag_test::in,
code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
generate_if_then_else_chain_cases(Cases, VarRval, VarType, VarName,
@@ -549,7 +549,7 @@
generate_raw_tag_test_case(VarRval, VarType, VarName,
MainTaggedConsId, OtherTaggedConsIds, CheaperTagTest,
branch_on_failure, NextLabel, TestCode, !CI),
- ElseCode = node([
+ ElseCode = from_list([
llds_instr(goto(code_label(EndLabel)),
"skip to the end of the switch on " ++ VarName),
llds_instr(label(NextLabel), "next case")
@@ -562,9 +562,9 @@
list.map2(project_cons_name_and_tag, OtherTaggedConsIds,
OtherConsNames, _),
Comment = case_comment(VarName, MainConsName, OtherConsNames),
- TestCode = node([
+ TestCode = singleton(
llds_instr(comment(Comment), "")
- ]),
+ ),
ElseCode = empty
),
@@ -572,13 +572,13 @@
!CI),
generate_goal(CodeModel, Goal, GoalCode, !CI),
generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- HeadCaseCode = tree_list([TestCode, TraceCode, GoalCode, SaveCode,
- ElseCode]),
+ HeadCaseCode = TestCode ++ TraceCode ++ GoalCode ++ SaveCode ++
+ ElseCode,
reset_to_position(BranchStart, !CI),
generate_if_then_else_chain_cases(TailCases, VarRval, VarType, VarName,
CheaperTagTest, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
!MaybeEnd, TailCasesCode, !CI),
- Code = tree(HeadCaseCode, TailCasesCode)
+ Code = HeadCaseCode ++ TailCasesCode
;
Cases = [],
(
@@ -591,9 +591,11 @@
CanFail = cannot_fail,
FailCode = empty
),
- EndCode = node([llds_instr(label(EndLabel),
- "end of the switch on " ++ VarName)]),
- Code = tree(FailCode, EndCode)
+ EndCode = singleton(
+ llds_instr(label(EndLabel),
+ "end of the switch on " ++ VarName)
+ ),
+ Code = FailCode ++ EndCode
).
%-----------------------------------------------------------------------------%
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.81
diff -u -b -r1.81 tag_switch.m
--- compiler/tag_switch.m 30 Dec 2007 08:23:59 -0000 1.81
+++ compiler/tag_switch.m 4 Jan 2009 12:03:48 -0000
@@ -30,7 +30,7 @@
%
:- pred generate_tag_switch(list(tagged_case)::in, rval::in, mer_type::in,
string::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -48,13 +48,13 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.switch_case.
:- import_module ll_backend.trace_gen.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -260,10 +260,10 @@
)
)
->
- PtagCode = node([
+ PtagCode = singleton(
llds_instr(assign(PtagReg, unop(tag, VarRval)),
"compute tag to switch on")
- ]),
+ ),
PtagRval = lval(PtagReg)
;
PtagCode = empty,
@@ -272,7 +272,9 @@
% We generate EndCode (and if needed, FailCode) here because the last
% case within a primary tag may not be the last case overall.
- EndCode = node([llds_instr(label(EndLabel), "end of tag switch")]),
+ EndCode = singleton(
+ llds_instr(label(EndLabel), "end of tag switch")
+ ),
(
CanFail = cannot_fail,
MaybeFailLabel = no,
@@ -281,14 +283,14 @@
CanFail = can_fail,
get_next_label(FailLabel, !CI),
MaybeFailLabel = yes(FailLabel),
- FailLabelCode = node([
+ FailLabelCode = singleton(
llds_instr(label(FailLabel), "switch has failed")
- ]),
+ ),
% We must generate the failure code in the context in which none of the
% switch arms have been executed yet.
reset_to_position(BranchStart, !CI),
generate_failure(FailureCode, !CI),
- FailCode = tree(FailLabelCode, FailureCode)
+ FailCode = FailLabelCode ++ FailureCode
),
(
@@ -303,11 +305,11 @@
generate_primary_jump_table(PtagCaseList, 0, MaxPrimary, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, Targets, TableCode,
CaseLabelMap1, CaseLabelMap, !CI),
- SwitchCode = node([
+ SwitchCode = singleton(
llds_instr(computed_goto(PtagRval, Targets),
"switch on primary tag")
- ]),
- CasesCode = tree(SwitchCode, TableCode)
+ ),
+ CasesCode = SwitchCode ++ TableCode
;
PrimaryMethod = try_chain,
order_ptags_by_count(PtagCountList, PtagCaseMap, PtagCaseList0),
@@ -330,8 +332,7 @@
CaseLabelMap1, CaseLabelMap, !CI)
),
map.foldl(add_remaining_case, CaseLabelMap, empty, RemainingCasesCode),
- Code = tree_list([PtagCode, CasesCode, RemainingCasesCode, FailCode,
- EndCode]).
+ Code = PtagCode ++ CasesCode ++ RemainingCasesCode ++ FailCode ++ EndCode.
%-----------------------------------------------------------------------------%
@@ -339,7 +340,7 @@
%
:- pred generate_primary_try_me_else_chain(ptag_case_list(label)::in,
rval::in, lval::in, rval::in, maybe(label)::in,
- ptag_count_map::in, code_tree::out,
+ ptag_count_map::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -362,7 +363,7 @@
generate_primary_try_me_else_chain(PtagGroups, PtagRval, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, OtherTagsCode,
!CaseLabelMap, !CI),
- Code = tree(ThisTagCode, OtherTagsCode)
+ Code = ThisTagCode ++ OtherTagsCode
;
PtagGroups = [],
(
@@ -373,11 +374,11 @@
% FailLabel ought to be the next label anyway, so this goto
% will be optimized away (unless the layout of the failcode
% in the caller changes).
- FailCode = node([
+ FailCode = singleton(
llds_instr(goto(code_label(FailLabel)),
"primary tag with no code to handle it")
- ]),
- Code = tree(ThisTagCode, FailCode)
+ ),
+ Code = ThisTagCode ++ FailCode
;
MaybeFailLabel = no,
generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
@@ -388,7 +389,7 @@
:- pred generate_primary_try_me_else_chain_case(rval::in, lval::in, int::in,
ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
- code_tree::out,
+ llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -397,18 +398,18 @@
get_next_label(ElseLabel, !CI),
TestRval = binop(ne, PtagRval,
unop(mktag, const(llconst_int(Primary)))),
- TestCode = node([
+ TestCode = singleton(
llds_instr(if_val(TestRval, code_label(ElseLabel)),
"test primary tag only")
- ]),
+ ),
PtagCase = ptag_case(StagLoc, StagGoalMap),
generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
!CaseLabelMap, !CI),
- ElseCode = node([
+ ElseCode = singleton(
llds_instr(label(ElseLabel), "handle next primary tag")
- ]),
- Code = tree_list([TestCode, TagCode, ElseCode]).
+ ),
+ Code = TestCode ++ TagCode ++ ElseCode.
%-----------------------------------------------------------------------------%
@@ -416,7 +417,7 @@
%
:- pred generate_primary_try_chain(ptag_case_list(label)::in,
rval::in, lval::in, rval::in, maybe(label)::in,
- ptag_count_map::in, code_tree::in, code_tree::in, code_tree::out,
+ ptag_count_map::in, llds_code::in, llds_code::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -448,29 +449,28 @@
PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
PrevTestsCode0, PrevTestsCode1, PrevCasesCode0, PrevCasesCode1,
!CaseLabelMap, !CI),
- FailCode = node([
+ FailCode = singleton(
llds_instr(goto(code_label(FailLabel)),
"primary tag with no code to handle it")
- ]),
- Code = tree_list([PrevTestsCode1, FailCode, PrevCasesCode1])
+ ),
+ Code = PrevTestsCode1 ++ FailCode ++ PrevCasesCode1
;
MaybeFailLabel = no,
Comment = "fallthrough to last primary tag value: " ++
string.int_to_string(Primary),
- CommentCode = node([
+ CommentCode = singleton(
llds_instr(comment(Comment), "")
- ]),
+ ),
generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
!CaseLabelMap, !CI),
- Code = tree_list([PrevTestsCode0, CommentCode,
- TagCode, PrevCasesCode0])
+ Code = PrevTestsCode0 ++ CommentCode ++ TagCode ++ PrevCasesCode0
)
).
:- pred generate_primary_try_chain_case(rval::in, lval::in, int::in,
ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
- code_tree::in, code_tree::out, code_tree::in, code_tree::out,
+ llds_code::in, llds_code::out, llds_code::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -481,20 +481,20 @@
get_next_label(ThisPtagLabel, !CI),
TestRval = binop(eq, PtagRval,
unop(mktag, const(llconst_int(Primary)))),
- TestCode = node([
+ TestCode = singleton(
llds_instr(if_val(TestRval, code_label(ThisPtagLabel)),
"test primary tag only")
- ]),
+ ),
Comment = "primary tag value: " ++ string.int_to_string(Primary),
- LabelCode = node([
+ LabelCode = singleton(
llds_instr(label(ThisPtagLabel), Comment)
- ]),
+ ),
PtagCase = ptag_case(StagLoc, StagGoalMap),
generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
!CaseLabelMap, !CI),
- PrevTestsCode = tree(PrevTestsCode0, TestCode),
- PrevCasesCode = tree_list([LabelCode, TagCode, PrevCasesCode0]).
+ PrevTestsCode = PrevTestsCode0 ++ TestCode,
+ PrevCasesCode = LabelCode ++ TagCode ++ PrevCasesCode0.
%-----------------------------------------------------------------------------%
@@ -503,7 +503,7 @@
%
:- pred generate_primary_jump_table(ptag_case_list(label)::in, int::in,
int::in, lval::in, rval::in, maybe(label)::in, ptag_count_map::in,
- list(maybe(label))::out, code_tree::out,
+ list(maybe(label))::out, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -525,10 +525,10 @@
"secondary tag locations differ " ++
"in generate_primary_jump_table"),
get_next_label(NewLabel, !CI),
- LabelCode = node([
+ LabelCode = singleton(
llds_instr(label(NewLabel),
"start of a case in primary tag switch")
- ]),
+ ),
generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, ThisTagCode,
!CaseLabelMap, !CI),
@@ -536,7 +536,7 @@
MaxPrimary, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
TailTargets, TailCode, !CaseLabelMap, !CI),
Targets = [yes(NewLabel) | TailTargets],
- Code = tree_list([LabelCode, ThisTagCode, TailCode])
+ Code = LabelCode ++ ThisTagCode ++ TailCode
;
generate_primary_jump_table(PtagGroups, NextPrimary, MaxPrimary,
StagReg, VarRval, MaybeFailLabel, PtagCountMap,
@@ -554,7 +554,7 @@
%
:- pred generate_primary_binary_search(ptag_case_list(label)::in, int::in,
int::in, rval::in, lval::in, rval::in, maybe(label)::in,
- ptag_count_map::in, code_tree::out,
+ ptag_count_map::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -569,7 +569,9 @@
MaybeFailLabel = yes(FailLabel),
string.int_to_string(CurPrimary, PtagStr),
Comment = "no code for ptag " ++ PtagStr,
- Code = node([llds_instr(goto(code_label(FailLabel)), Comment)])
+ Code = singleton(
+ llds_instr(goto(code_label(FailLabel)), Comment)
+ )
;
MaybeFailLabel = no,
% The switch is cannot_fail, which means this case cannot
@@ -612,10 +614,12 @@
HighStartStr ++ " to " ++ HighEndStr,
LowRangeEndConst = const(llconst_int(LowRangeEnd)),
TestRval = binop(int_gt, PtagRval, LowRangeEndConst),
- IfCode = node([
+ IfCode = singleton(
llds_instr(if_val(TestRval, code_label(NewLabel)), IfComment)
- ]),
- LabelCode = node([llds_instr(label(NewLabel), LabelComment)]),
+ ),
+ LabelCode = singleton(
+ llds_instr(label(NewLabel), LabelComment)
+ ),
generate_primary_binary_search(LowGroups, MinPtag, LowRangeEnd,
PtagRval, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
@@ -623,7 +627,7 @@
generate_primary_binary_search(HighGroups, HighRangeStart, MaxPtag,
PtagRval, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
HighRangeCode, !CaseLabelMap, !CI),
- Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
+ Code = IfCode ++ LowRangeCode ++ LabelCode ++ HighRangeCode
).
%-----------------------------------------------------------------------------%
@@ -634,7 +638,7 @@
%
:- pred generate_primary_tag_code(stag_goal_map(label)::in, tag_bits::in,
int::in, lval::in, sectag_locn::in, rval::in, maybe(label)::in,
- code_tree::out, case_label_map::in, case_label_map::out,
+ llds_code::out, case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagReg, StagLoc,
@@ -704,9 +708,9 @@
)
)
->
- StagCode = node([
+ StagCode = singleton(
llds_instr(assign(StagReg, OrigStagRval), Comment)
- ]),
+ ),
StagRval = lval(StagReg)
;
StagCode = empty,
@@ -732,10 +736,10 @@
SecondaryMethod = jump_table,
generate_secondary_jump_table(StagGoalList, 0, MaxSecondary,
MaybeSecFailLabel, Targets),
- Code = node([
+ Code = singleton(
llds_instr(computed_goto(StagRval, Targets),
"switch on secondary tag")
- ])
+ )
;
SecondaryMethod = binary_search,
generate_secondary_binary_search(StagGoalList, 0, MaxSecondary,
@@ -744,12 +748,12 @@
SecondaryMethod = try_chain,
generate_secondary_try_chain(StagGoalList, StagRval,
MaybeSecFailLabel, empty, Codes, !CaseLabelMap),
- Code = tree(StagCode, Codes)
+ Code = StagCode ++ Codes
;
SecondaryMethod = try_me_else_chain,
generate_secondary_try_me_else_chain(StagGoalList, StagRval,
MaybeSecFailLabel, Codes, !CaseLabelMap, !CI),
- Code = tree(StagCode, Codes)
+ Code = StagCode ++ Codes
)
).
@@ -758,7 +762,7 @@
% Generate a switch on a secondary tag value using a try-me-else chain.
%
:- pred generate_secondary_try_me_else_chain(stag_goal_list(label)::in,
- rval::in, maybe(label)::in, code_tree::out,
+ rval::in, maybe(label)::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -774,18 +778,18 @@
Secondary, ThisCode, !CaseLabelMap, !CI),
generate_secondary_try_me_else_chain(Cases, StagRval,
MaybeFailLabel, OtherCode, !CaseLabelMap, !CI),
- Code = tree(ThisCode, OtherCode)
+ Code = ThisCode ++ OtherCode
;
Cases = [],
(
MaybeFailLabel = yes(FailLabel),
generate_secondary_try_me_else_chain_case(CaseLabel, StagRval,
Secondary, ThisCode, !CaseLabelMap, !CI),
- FailCode = node([
+ FailCode = singleton(
llds_instr(goto(code_label(FailLabel)),
"secondary tag does not match")
- ]),
- Code = tree(ThisCode, FailCode)
+ ),
+ Code = ThisCode ++ FailCode
;
MaybeFailLabel = no,
generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap)
@@ -793,7 +797,7 @@
).
:- pred generate_secondary_try_me_else_chain_case(label::in, rval::in, int::in,
- code_tree::out, case_label_map::in, case_label_map::out,
+ llds_code::out, case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
generate_secondary_try_me_else_chain_case(CaseLabel, StagRval, Secondary,
@@ -801,23 +805,23 @@
generate_case_code_or_jump(CaseLabel, CaseCode, !CaseLabelMap),
% XXX Optimize what we generate when CaseCode = goto(CaseLabel).
get_next_label(ElseLabel, !CI),
- TestCode = node([
+ TestCode = singleton(
llds_instr(
if_val(binop(ne, StagRval, const(llconst_int(Secondary))),
code_label(ElseLabel)),
"test remote sec tag only")
- ]),
- ElseLabelCode = node([
+ ),
+ ElseLabelCode = singleton(
llds_instr(label(ElseLabel), "handle next secondary tag")
- ]),
- Code = tree_list([TestCode, CaseCode, ElseLabelCode]).
+ ),
+ Code = TestCode ++ CaseCode ++ ElseLabelCode.
%-----------------------------------------------------------------------------%
% Generate a switch on a secondary tag value using a try chain.
%
:- pred generate_secondary_try_chain(stag_goal_list(label)::in, rval::in,
- maybe(label)::in, code_tree::in, code_tree::out,
+ maybe(label)::in, llds_code::in, llds_code::out,
case_label_map::in, case_label_map::out) is det.
generate_secondary_try_chain([], _, _, _, _, !CaseLabelMap) :-
@@ -837,32 +841,32 @@
MaybeFailLabel = yes(FailLabel),
generate_secondary_try_chain_case(CaseLabel, StagRval, Secondary,
PrevTestsCode0, PrevTestsCode1, !.CaseLabelMap),
- FailCode = node([
+ FailCode = singleton(
llds_instr(goto(code_label(FailLabel)),
"secondary tag with no code to handle it")
- ]),
- Code = tree(PrevTestsCode1, FailCode)
+ ),
+ Code = PrevTestsCode1 ++ FailCode
;
MaybeFailLabel = no,
generate_case_code_or_jump(CaseLabel, ThisCode, !CaseLabelMap),
- Code = tree(PrevTestsCode0, ThisCode)
+ Code = PrevTestsCode0 ++ ThisCode
)
).
:- pred generate_secondary_try_chain_case(label::in, rval::in, int::in,
- code_tree::in, code_tree::out, case_label_map::in) is det.
+ llds_code::in, llds_code::out, case_label_map::in) is det.
generate_secondary_try_chain_case(CaseLabel, StagRval, Secondary,
PrevTestsCode0, PrevTestsCode, CaseLabelMap) :-
map.lookup(CaseLabelMap, CaseLabel, CaseInfo0),
CaseInfo0 = case_label_info(Comment, _CaseCode, _CaseGenerated),
- TestCode = node([
+ TestCode = singleton(
llds_instr(
if_val(binop(eq, StagRval, const(llconst_int(Secondary))),
code_label(CaseLabel)),
"test remote sec tag only for " ++ Comment)
- ]),
- PrevTestsCode = tree(PrevTestsCode0, TestCode).
+ ),
+ PrevTestsCode = PrevTestsCode0 ++ TestCode.
%-----------------------------------------------------------------------------%
@@ -898,7 +902,7 @@
% MinPtag to MaxPtag (including both boundary values).
%
:- pred generate_secondary_binary_search(stag_goal_list(label)::in,
- int::in, int::in, rval::in, maybe(label)::in, code_tree::out,
+ int::in, int::in, rval::in, maybe(label)::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
@@ -913,7 +917,9 @@
MaybeFailLabel = yes(FailLabel),
string.int_to_string(CurSec, StagStr),
Comment = "no code for ptag " ++ StagStr,
- Code = node([llds_instr(goto(code_label(FailLabel)), Comment)])
+ Code = singleton(
+ llds_instr(goto(code_label(FailLabel)), Comment)
+ )
;
MaybeFailLabel = no,
Code = empty
@@ -948,17 +954,19 @@
HighStartStr ++ " to " ++ HighEndStr,
LowRangeEndConst = const(llconst_int(LowRangeEnd)),
TestRval = binop(int_gt, StagRval, LowRangeEndConst),
- IfCode = node([
+ IfCode = singleton(
llds_instr(if_val(TestRval, code_label(NewLabel)), IfComment)
- ]),
- LabelCode = node([llds_instr(label(NewLabel), LabelComment)]),
+ ),
+ LabelCode = singleton(
+ llds_instr(label(NewLabel), LabelComment)
+ ),
generate_secondary_binary_search(LowGoals, MinStag, LowRangeEnd,
StagRval, MaybeFailLabel, LowRangeCode, !CaseLabelMap, !CI),
generate_secondary_binary_search(HighGoals, HighRangeStart, MaxStag,
StagRval, MaybeFailLabel, HighRangeCode, !CaseLabelMap, !CI),
- Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
+ Code = IfCode ++ LowRangeCode ++ LabelCode ++ HighRangeCode
).
%-----------------------------------------------------------------------------%
Index: compiler/trace_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_gen.m,v
retrieving revision 1.27
diff -u -b -r1.27 trace_gen.m
--- compiler/trace_gen.m 23 Dec 2008 01:37:41 -0000 1.27
+++ compiler/trace_gen.m 4 Jan 2009 12:06:14 -0000
@@ -170,41 +170,41 @@
% Generate code to fill in the reserved stack slots.
%
:- pred generate_slot_fill_code(code_info::in, trace_info::in,
- code_tree::out) is det.
+ llds_code::out) is det.
% If we are doing execution tracing, generate code to prepare for a call.
%
-:- pred trace_prepare_for_call(code_info::in, code_tree::out) is det.
+:- pred trace_prepare_for_call(code_info::in, llds_code::out) is det.
% If we are doing execution tracing, generate code for an internal
% trace event. This predicate must be called just before generating code
% for the given goal.
%
:- pred maybe_generate_internal_event_code(hlds_goal::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
+ hlds_goal_info::in, llds_code::out, code_info::in, code_info::out) is det.
% If we are doing execution tracing, generate code for an trace event
% that represents leaving a negated goal (via success or failure).
%
:- pred maybe_generate_negated_event_code(hlds_goal::in,
- hlds_goal_info::in, negation_end_port::in, code_tree::out,
+ hlds_goal_info::in, negation_end_port::in, llds_code::out,
code_info::in, code_info::out) is det.
% If we are doing execution tracing, generate code for a nondet
% foreign_proc trace event.
%
:- pred maybe_generate_foreign_proc_event_code(
- nondet_foreign_proc_trace_port::in, prog_context::in, code_tree::out,
+ nondet_foreign_proc_trace_port::in, prog_context::in, llds_code::out,
code_info::in, code_info::out) is det.
% Generate code for a user-defined trace event.
%
:- pred generate_user_event_code(user_event_info::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_tailrec_event_code(trace_info::in,
assoc_list(prog_var, arg_info)::in, goal_path::in, prog_context::in,
- code_tree::out, label::out, code_info::in, code_info::out) is det.
+ llds_code::out, label::out, code_info::in, code_info::out) is det.
:- type external_event_info
---> external_event_info(
@@ -217,7 +217,7 @@
map(tvar, set(layout_locn)),
% The code generated for the event.
- code_tree
+ llds_code
).
% Generate code for an external trace event.
@@ -235,7 +235,7 @@
% address of one of the labels in the runtime that calls MR_trace
% for a redo event. Otherwise, generate empty code.
%
-:- pred maybe_setup_redo_event(trace_info::in, code_tree::out) is det.
+:- pred maybe_setup_redo_event(trace_info::in, llds_code::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -252,7 +252,6 @@
:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module libs.trace_params.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.layout_out.
:- import_module ll_backend.llds_out.
@@ -682,17 +681,17 @@
),
TraceComponents1 = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init), TraceStmt1)],
- TraceCode1 = node([
+ TraceCode1 = singleton(
llds_instr(foreign_proc_code([], TraceComponents1,
proc_will_not_call_mercury, no, no, MaybeLayoutLabel,
no, yes, proc_may_not_duplicate), "")
- ]),
+ ),
% Stage 6.
(
MaybeMaxfrLval = yes(MaxfrLval),
- TraceCode2 = node([
+ TraceCode2 = singleton(
llds_instr(assign(MaxfrLval, lval(maxfr)), "save initial maxfr")
- ])
+ )
;
MaybeMaxfrLval = no,
TraceCode2 = empty
@@ -712,12 +711,12 @@
TraceComponents3 = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init),
TraceStmt3)],
- TraceCode3 = node([
+ TraceCode3 = singleton(
llds_instr(foreign_proc_code([], TraceComponents3,
proc_will_not_call_mercury, no, no, no, no, yes,
proc_may_not_duplicate),
"initialize tail recursion count")
- ])
+ )
;
MaybeTailRecInfo = no,
TraceCode3 = empty
@@ -730,16 +729,16 @@
TraceComponents4 = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init),
TraceStmt4)],
- TraceCode4 = node([
+ TraceCode4 = singleton(
llds_instr(foreign_proc_code([], TraceComponents4,
proc_will_not_call_mercury, no, no, no, no, yes,
proc_may_not_duplicate), "")
- ])
+ )
;
MaybeCallTableLval = no,
TraceCode4 = empty
),
- TraceCode = tree_list([TraceCode1, TraceCode2, TraceCode3, TraceCode4]).
+ TraceCode = TraceCode1 ++ TraceCode2 ++ TraceCode3 ++ TraceCode4.
trace_prepare_for_call(CI, TraceCode) :-
get_maybe_trace_info(CI, MaybeTraceInfo),
@@ -757,10 +756,10 @@
MacroStr = "MR_trace_reset_depth_from_full"
),
ResetStmt = MacroStr ++ "(" ++ CallDepthStr ++ ");\n",
- TraceCode = node([
+ TraceCode = singleton(
llds_instr(arbitrary_c_code(proc_does_not_affect_liveness,
live_lvals_info(set.init), ResetStmt), "")
- ])
+ )
;
MaybeTraceInfo = no,
TraceCode = empty
@@ -925,7 +924,7 @@
).
:- pred generate_tailrec_reset_slots_code(trace_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_tailrec_reset_slots_code(TraceInfo, Code, !CI) :-
% We reset all the debugging slots that need to be reset. We handle them
@@ -979,9 +978,9 @@
MaybeMaxfrLval = TraceInfo ^ maxfr_lval,
(
MaybeMaxfrLval = yes(MaxfrLval),
- MaxfrCode = node([
+ MaxfrCode = singleton(
llds_instr(assign(MaxfrLval, lval(maxfr)), "save initial maxfr")
- ])
+ )
;
MaybeMaxfrLval = no,
MaxfrCode = empty
@@ -990,11 +989,11 @@
TailRecInfo = TraceInfo ^ tail_rec_info,
(
TailRecInfo = yes(TailRecLval - _),
- TailRecLvalCode = node([
+ TailRecLvalCode = singleton(
llds_instr(assign(TailRecLval,
binop(int_add, lval(TailRecLval), const(llconst_int(1)))),
"increment tail recursion counter")
- ])
+ )
;
TailRecInfo = no,
unexpected(this_file,
@@ -1015,17 +1014,17 @@
ForeignLangComponents = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init),
ForeignLangCodeStr)],
- ForeignLangCode = node([
+ ForeignLangCode = singleton(
llds_instr(foreign_proc_code([], ForeignLangComponents,
proc_will_not_call_mercury, no, no, no,
no, yes, proc_may_duplicate), "")
- ]),
- Code = tree_list([ForeignLangCode, MaxfrCode, TailRecLvalCode]).
+ ),
+ Code = ForeignLangCode ++ MaxfrCode ++ TailRecLvalCode.
:- pred generate_event_code(trace_port::in, trace_port_info::in,
maybe(trace_info)::in, prog_context::in, bool::in,
maybe(user_event_info)::in, label::out,
- map(tvar, set(layout_locn))::out, code_tree::out,
+ map(tvar, set(layout_locn))::out, llds_code::out,
code_info::in, code_info::out) is det.
generate_event_code(Port, PortInfo, MaybeTraceInfo, Context, HideEvent,
@@ -1147,7 +1146,7 @@
proc_does_not_affect_liveness, live_lvals_info(LiveLvalSet),
TraceStmt)],
TraceCode =
- node([
+ from_list([
llds_instr(label(Label),
"A label to hang trace liveness on"),
% Referring to the label from the foreign_proc_code
@@ -1159,7 +1158,7 @@
proc_may_call_mercury, no, no, yes(Label), no, yes,
proc_may_not_duplicate), "")
]),
- Code = tree_list([ProduceCode, TailRecResetCode, TraceCode]).
+ Code = ProduceCode ++ TailRecResetCode ++ TraceCode.
:- pred find_output_vars(assoc_list(prog_var, arg_info)::in,
list(prog_var)::in, list(prog_var)::out) is det.
@@ -1198,18 +1197,18 @@
% framevar 5; see the comment before reserved_slots.
expect(unify(Lval, framevar(5)), this_file,
"from-full flag not stored in expected slot"),
- Code = node([
+ Code = singleton(
llds_instr(mkframe(temp_frame(nondet_stack_proc),
yes(do_trace_redo_fail_shallow)),
"set up shallow redo event")
- ])
+ )
;
MaybeFromFullSlot = no,
- Code = node([
+ Code = singleton(
llds_instr(mkframe(temp_frame(nondet_stack_proc),
yes(do_trace_redo_fail_deep)),
"set up deep redo event")
- ])
+ )
)
;
TraceRedoLabel = no,
@@ -1219,11 +1218,11 @@
:- pred trace_produce_vars(list(prog_var)::in, prog_varset::in, vartypes::in,
instmap::in, trace_port::in, set(tvar)::in, set(tvar)::out,
list(layout_var_info)::in, list(layout_var_info)::out,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
trace_produce_vars([], _, _, _, _, !TVars, !VarInfos, empty, !CI).
trace_produce_vars([Var | Vars], VarSet, VarTypes, InstMap, Port,
- !TVars, !VarInfos, tree(VarCode, VarsCode), !CI) :-
+ !TVars, !VarInfos, VarCode ++ VarsCode, !CI) :-
map.lookup(VarTypes, Var, Type),
get_module_info(!.CI, ModuleInfo),
IsDummy = check_dummy_type(ModuleInfo, Type),
@@ -1239,7 +1238,7 @@
!VarInfos, VarsCode, !CI).
:- pred trace_produce_var(prog_var::in, prog_varset::in, instmap::in,
- set(tvar)::in, set(tvar)::out, layout_var_info::out, code_tree::out,
+ set(tvar)::in, set(tvar)::out, layout_var_info::out, llds_code::out,
code_info::in, code_info::out) is det.
trace_produce_var(Var, VarSet, InstMap, !Tvars, VarInfo, VarCode, !CI) :-
Index: compiler/tree.m
===================================================================
RCS file: compiler/tree.m
diff -N compiler/tree.m
--- compiler/tree.m 31 Jul 2006 08:32:07 -0000 1.21
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,190 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 1993-2001, 2003-2006 The University of Melbourne.
-% This file may only be copied under the terms of the GNU General
-% Public License - see the file COPYING in the Mercury distribution.
-%-----------------------------------------------------------------------------%
-%
-% File: tree.m.
-% Main authors: conway, fjh, zs.
-%
-% This file provides a 'tree' data type.
-% The code generater uses this to build a tree of instructions and
-% then flatten them into a list.
-%
-%-----------------------------------------------------------------------------%
-
-:- module libs.tree.
-:- interface.
-
-:- import_module bool.
-:- import_module list.
-
-:- type tree(T)
- ---> empty
- ; node(T)
- ; tree(tree(T), tree(T))
- ; tree_list(list(tree(T))).
-
-:- func tree.flatten(tree(T)) = list(T).
-:- pred tree.flatten(tree(T)::in, list(T)::out) is det.
-
-:- func tree.is_empty(tree(T)) = bool.
-:- pred tree.is_empty(tree(T)::in) is semidet.
-
-:- func tree.tree_of_lists_is_empty(tree(list(T))) = bool.
-:- pred tree.tree_of_lists_is_empty(tree(list(T))::in) is semidet.
-
-:- pred tree.foldl(pred(T, A, A)::in(pred(in, in, out) is det), tree(T)::in,
- A::in, A::out) is det.
-
-:- func tree.map(func(T) = U, tree(T)) = tree(U).
-:- pred tree.map(pred(T, U)::in(pred(in, out) is det),
- tree(T)::in, tree(U)::out) is det.
-
-:- pred tree.map_foldl(pred(T, U, A, A)::in(pred(in, out, in, out) is det),
- tree(T)::in, tree(U)::out, A::in, A::out) is det.
-
-:- pred tree.map_foldl2(
- pred(T, U, A, A, B, B)::in(pred(in, out, in, out, in, out) is det),
- tree(T)::in, tree(U)::out, A::in, A::out, B::in, B::out) is det.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-tree.flatten(T) = L :-
- tree.flatten(T, L).
-
-tree.flatten(T, L) :-
- tree.flatten_2(T, [], L).
-
- % flatten_2(T, !Flat) is true iff !:Flat is the list that results from
- % traversing T left-to-right depth-first, and then appending !.Flat.
- %
-:- pred tree.flatten_2(tree(T)::in, list(T)::in, list(T)::out) is det.
-
-tree.flatten_2(empty, !Flat).
-tree.flatten_2(node(Item), !Flat) :-
- !:Flat = [Item | !.Flat].
-tree.flatten_2(tree(T1, T2), !Flat) :-
- tree.flatten_2(T2, !Flat),
- tree.flatten_2(T1, !Flat).
-tree.flatten_2(tree_list(List), !Flat) :-
- tree.flatten_list(List, !Flat).
-
- % flatten_list(List, !Flat) is true iff !:Flat is the list that results
- % from traversing List left-to-right depth-first, and then appending
- % !.Flat.
- %
-:- pred tree.flatten_list(list(tree(T))::in, list(T)::in, list(T)::out) is det.
-
-tree.flatten_list([], !Flat).
-tree.flatten_list([Head | Tail], !Flat) :-
- tree.flatten_list(Tail, !Flat),
- tree.flatten_2(Head, !Flat).
-
-%-----------------------------------------------------------------------------%
-
-tree.is_empty(T) :-
- tree.is_empty(T) = yes.
-
-tree.is_empty(empty) = yes.
-tree.is_empty(node(_)) = no.
-tree.is_empty(tree(Left, Right)) =
- ( tree.is_empty(Left) = no ->
- no
- ;
- tree.is_empty(Right)
- ).
-tree.is_empty(tree_list(List)) = tree.list_is_empty(List).
-
-:- func tree.list_is_empty(list(tree(T))) = bool.
-
-tree.list_is_empty([]) = yes.
-tree.list_is_empty([Head | Tail]) =
- ( tree.is_empty(Head) = no ->
- no
- ;
- tree.list_is_empty(Tail)
- ).
-
-%-----------------------------------------------------------------------------%
-
-% Unfortunately, we can't factor out the common code between tree.is_empty
-% and tree.tree_of_lists_is_empty because their signatures are different,
-% and the signatures of their helpers must therefore be different too.
-
-tree.tree_of_lists_is_empty(T) :-
- tree.tree_of_lists_is_empty(T) = yes.
-
-tree.tree_of_lists_is_empty(empty) = yes.
-tree.tree_of_lists_is_empty(node([])) = yes.
-tree.tree_of_lists_is_empty(node([_ | _])) = no.
-tree.tree_of_lists_is_empty(tree(Left, Right)) =
- ( tree.tree_of_lists_is_empty(Left) = no ->
- no
- ;
- tree.is_empty(Right)
- ).
-tree.tree_of_lists_is_empty(tree_list(List)) =
- tree.list_tree_of_lists_is_empty(List).
-
-:- func tree.list_tree_of_lists_is_empty(list(tree(list(T)))) = bool.
-
-tree.list_tree_of_lists_is_empty([]) = yes.
-tree.list_tree_of_lists_is_empty([Head | Tail]) =
- ( tree.tree_of_lists_is_empty(Head) = no ->
- no
- ;
- tree.list_tree_of_lists_is_empty(Tail)
- ).
-
-%-----------------------------------------------------------------------------%
-
-tree.foldl(_P, empty, !A).
-tree.foldl(P, node(Node), !A) :-
- P(Node, !A).
-tree.foldl(P, tree(Left, Right), !A) :-
- tree.foldl(P, Left, !A),
- tree.foldl(P, Right, !A).
-tree.foldl(P, tree_list(List), !A) :-
- list.foldl(tree.foldl(P), List, !A).
-
-tree.map(_F, empty) = empty.
-tree.map(F, node(T)) = node(F(T)).
-tree.map(F, tree(L, R)) = tree(tree.map(F, L), tree.map(F, R)).
-tree.map(F, tree_list(L)) = tree_list(list.map(tree.map(F), L)).
-
-tree.map(_P, empty, empty).
-tree.map(P, node(Node0), node(Node)) :-
- P(Node0, Node).
-tree.map(P, tree(Left0, Right0), tree(Left, Right)) :-
- tree.map(P, Left0, Left),
- tree.map(P, Right0, Right).
-tree.map(P, tree_list(List0), tree_list(List)) :-
- list.map(tree.map(P), List0, List).
-
-tree.map_foldl(_P, empty, empty, !A).
-tree.map_foldl(P, node(Node0), node(Node), !A) :-
- P(Node0, Node, !A).
-tree.map_foldl(P, tree(Left0, Right0), tree(Left, Right), !A) :-
- tree.map_foldl(P, Left0, Left, !A),
- tree.map_foldl(P, Right0, Right, !A).
-tree.map_foldl(P, tree_list(List0), tree_list(List), !A) :-
- list.map_foldl(tree.map_foldl(P), List0, List, !A).
-
-tree.map_foldl2(_P, empty, empty, !A, !B).
-tree.map_foldl2(P, node(Node0), node(Node), !A, !B) :-
- P(Node0, Node, !A, !B).
-tree.map_foldl2(P, tree(Left0, Right0), tree(Left, Right), !A, !B) :-
- tree.map_foldl2(P, Left0, Left, !A, !B),
- tree.map_foldl2(P, Right0, Right, !A, !B).
-tree.map_foldl2(P, tree_list(List0), tree_list(List), !A, !B) :-
- list.map_foldl2(tree.map_foldl2(P), List0, List, !A, !B).
-
-%-----------------------------------------------------------------------------%
-:- end_module tree.
-%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.190
diff -u -b -r1.190 unify_gen.m
--- compiler/unify_gen.m 5 Jan 2009 01:28:48 -0000 1.190
+++ compiler/unify_gen.m 5 Jan 2009 01:32:54 -0000
@@ -37,15 +37,15 @@
; branch_on_failure.
:- pred generate_unification(code_model::in, unification::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
+ hlds_goal_info::in, llds_code::out, code_info::in, code_info::out) is det.
:- pred generate_tag_test(prog_var::in, cons_id::in,
- maybe_cheaper_tag_test::in, test_sense::in, label::out, code_tree::out,
+ maybe_cheaper_tag_test::in, test_sense::in, label::out, llds_code::out,
code_info::in, code_info::out) is det.
:- pred generate_raw_tag_test_case(rval::in, mer_type::in, string::in,
tagged_cons_id::in, list(tagged_cons_id)::in, maybe_cheaper_tag_test::in,
- test_sense::in, label::out, code_tree::out, code_info::in, code_info::out)
+ test_sense::in, label::out, llds_code::out, code_info::in, code_info::out)
is det.
:- pred generate_ground_term(prog_var::in, hlds_goal::in,
@@ -70,7 +70,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.global_data.
@@ -83,6 +82,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
@@ -157,11 +157,11 @@
% This seems to be fine.
list.foldl(release_reg, Regs, !CI),
% XXX avoid strip_tag when we know what tag it will have
- FreeVar = node([
+ FreeVar = singleton(
llds_instr(free_heap(unop(strip_tag, VarRval)),
"Free " ++ VarName)
- ]),
- Code = tree_list([Code0, ProduceVar, SaveArgs, FreeVar])
+ ),
+ Code = Code0 ++ ProduceVar ++ SaveArgs ++ FreeVar
;
Code = Code0
)
@@ -189,7 +189,7 @@
% variable as the expression that generates the free variable.
% No immediate code is generated.
%
-:- pred generate_assignment(prog_var::in, prog_var::in, code_tree::out,
+:- pred generate_assignment(prog_var::in, prog_var::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_assignment(VarA, VarB, empty, !CI) :-
@@ -209,7 +209,7 @@
% point if the two values are not the same. Simple tests are in-in
% unifications on enumerations, integers, strings and floats.
%
-:- pred generate_test(prog_var::in, prog_var::in, code_tree::out,
+:- pred generate_test(prog_var::in, prog_var::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_test(VarA, VarB, Code, !CI) :-
@@ -230,7 +230,7 @@
Op = eq
),
fail_if_rval_is_false(binop(Op, ValA, ValB), FailCode, !CI),
- Code = tree_list([CodeA, CodeB, FailCode])
+ Code = CodeA ++ CodeB ++ FailCode
).
%---------------------------------------------------------------------------%
@@ -263,9 +263,9 @@
Sense = branch_on_failure,
code_util.neg_rval(TestRval, TheRval)
),
- Code = node([
+ Code = singleton(
llds_instr(if_val(TheRval, code_label(ElseLabel)), Comment)
- ])
+ )
).
:- pred disjoin_tag_tests(rval::in, list(rval)::in, rval::out) is det.
@@ -288,11 +288,11 @@
VarName = variable_name(!.CI, Var),
generate_raw_tag_test(VarRval, VarType, VarName, ConsId, no,
CheaperTagTest, Sense, ElseLabel, TestCode, !CI),
- Code = tree(VarCode, TestCode).
+ Code = VarCode ++ TestCode.
:- pred generate_raw_tag_test(rval::in, mer_type::in, string::in,
cons_id::in, maybe(cons_tag)::in,
- maybe_cheaper_tag_test::in, test_sense::in, label::out, code_tree::out,
+ maybe_cheaper_tag_test::in, test_sense::in, label::out, llds_code::out,
code_info::in, code_info::out) is det.
generate_raw_tag_test(VarRval, VarType, VarName, ConsId, MaybeConsTag,
@@ -331,9 +331,9 @@
Sense = branch_on_failure,
code_util.neg_rval(TestRval, TheRval)
),
- Code = node([
+ Code = singleton(
llds_instr(if_val(TheRval, code_label(ElseLabel)), Comment)
- ]).
+ ).
:- func branch_sense_comment(test_sense) = string.
@@ -445,7 +445,7 @@
:- pred generate_construction(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, how_to_construct::in,
list(int)::in, maybe(term_size_value)::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_construction(Var, ConsId, Args, Modes, HowToConstruct,
TakeAddr, MaybeSize, GoalInfo, Code, !CI) :-
@@ -456,7 +456,7 @@
:- pred generate_construction_2(cons_tag::in, prog_var::in,
list(prog_var)::in, list(uni_mode)::in, how_to_construct::in,
list(int)::in, maybe(term_size_value)::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_construction_2(ConsTag, Var, Args, Modes, HowToConstruct,
TakeAddr, MaybeSize, GoalInfo, Code, !CI) :-
@@ -607,7 +607,7 @@
% The structure of closures is defined in runtime/mercury_ho_call.h.
%
:- pred generate_closure(pred_id::in, proc_id::in, lambda_eval_method::in,
- prog_var::in, list(prog_var)::in, hlds_goal_info::in, code_tree::out,
+ prog_var::in, list(prog_var)::in, hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_closure(PredId, ProcId, EvalMethod, Var, Args, GoalInfo, Code, !CI) :-
@@ -690,7 +690,7 @@
produce_variable(CallPred, OldClosureCode, OldClosure, !CI),
% The new closure contains a pointer to the old closure.
NewClosureMayUseAtomic = may_not_use_atomic_alloc,
- NewClosureCode = node([
+ NewClosureCode = from_list([
llds_instr(comment("build new closure from old closure"), ""),
llds_instr(
assign(NumOldArgs, lval(field(yes(0), OldClosure, Two))),
@@ -741,8 +741,8 @@
release_reg(NumOldArgs, !CI),
release_reg(NewClosure, !CI),
assign_lval_to_var(Var, NewClosure, AssignCode, !CI),
- Code = tree_list([OldClosureCode, NewClosureCode, ExtraArgsCode,
- AssignCode])
+ Code = OldClosureCode ++ NewClosureCode ++ ExtraArgsCode ++
+ AssignCode
)
;
CodeAddr = make_proc_entry_label(!.CI, ModuleInfo, PredId, ProcId, no),
@@ -789,7 +789,7 @@
).
:- pred generate_extra_closure_args(list(prog_var)::in, lval::in,
- lval::in, code_tree::out, code_info::in, code_info::out) is det.
+ lval::in, llds_code::out, code_info::in, code_info::out) is det.
generate_extra_closure_args([], _, _, empty, !CI).
generate_extra_closure_args([Var | Vars], LoopCounter, NewClosure, Code,
@@ -799,25 +799,25 @@
(
IsDummy = is_dummy_type,
ProduceCode = empty,
- AssignCode = node([
+ AssignCode = singleton(
llds_instr(assign(FieldLval, const(llconst_int(0))),
"set new argument field (dummy type)")
- ])
+ )
;
IsDummy = is_not_dummy_type,
produce_variable(Var, ProduceCode, Value, !CI),
- AssignCode = node([
+ AssignCode = singleton(
llds_instr(assign(FieldLval, Value),
"set new argument field")
- ])
+ )
),
- IncrCode = node([
+ IncrCode = singleton(
llds_instr(assign(LoopCounter,
binop(int_add, lval(LoopCounter), const(llconst_int(1)))),
"increment argument counter")
- ]),
+ ),
generate_extra_closure_args(Vars, LoopCounter, NewClosure, VarsCode, !CI),
- Code = tree_list([ProduceCode, AssignCode, IncrCode, VarsCode]).
+ Code = ProduceCode ++ AssignCode ++ IncrCode ++ VarsCode.
:- pred generate_pred_args(code_info::in, vartypes::in, list(prog_var)::in,
list(arg_info)::in, list(maybe(rval))::out,
@@ -935,7 +935,7 @@
:- pred construct_cell(prog_var::in, tag::in, list(maybe(rval))::in,
how_to_construct::in, maybe(term_size_value)::in,
assoc_list(int, prog_var)::in, may_use_atomic_alloc::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
construct_cell(Var, Ptag, MaybeRvals, HowToConstruct, MaybeSize, FieldAddrs,
MayUseAtomic, Code, !CI) :-
@@ -972,16 +972,16 @@
% into static data.
generate_field_take_address_assigns(FieldAddrs, Var, Ptag,
FieldCode, !CI),
- Code = tree(CellCode, FieldCode)
+ Code = CellCode ++ FieldCode
).
:- pred generate_field_take_address_assigns(assoc_list(int, prog_var)::in,
- prog_var::in, int::in, code_tree::out, code_info::in, code_info::out)
+ prog_var::in, int::in, llds_code::out, code_info::in, code_info::out)
is det.
generate_field_take_address_assigns([], _, _, empty, !CI).
generate_field_take_address_assigns([FieldNum - Var | FieldAddrs],
- CellVar, CellPtag, tree(ThisCode, RestCode), !CI) :-
+ CellVar, CellPtag, ThisCode ++ RestCode, !CI) :-
FieldNumRval = const(llconst_int(FieldNum)),
Addr = mem_addr(heap_ref(var(CellVar), CellPtag, FieldNumRval)),
assign_expr_to_var(Var, Addr, ThisCode, !CI),
@@ -1025,7 +1025,7 @@
% are cached.
%
:- pred generate_det_deconstruction(prog_var::in, cons_id::in,
- list(prog_var)::in, list(uni_mode)::in, code_tree::out,
+ list(prog_var)::in, list(uni_mode)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_det_deconstruction(Var, Cons, Args, Modes, Code, !CI) :-
@@ -1034,7 +1034,7 @@
:- pred generate_det_deconstruction_2(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, cons_tag::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ llds_code::out, code_info::in, code_info::out) is det.
generate_det_deconstruction_2(Var, Cons, Args, Modes, Tag, Code, !CI) :-
% For constants, if the deconstruction is det, then we already know
@@ -1123,7 +1123,7 @@
% followed by a deterministic deconstruction.
%
:- pred generate_semi_deconstruction(prog_var::in, cons_id::in,
- list(prog_var)::in, list(uni_mode)::in, code_tree::out,
+ list(prog_var)::in, list(uni_mode)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_semi_deconstruction(Var, Tag, Args, Modes, Code, !CI) :-
@@ -1135,8 +1135,8 @@
generate_failure(FailCode, !CI),
reset_to_position(AfterUnify, !CI),
generate_det_deconstruction(Var, Tag, Args, Modes, DeconsCode, !CI),
- SuccessLabelCode = node([llds_instr(label(SuccLabel), "")]),
- Code = tree_list([TagTestCode, FailCode, SuccessLabelCode, DeconsCode]).
+ SuccessLabelCode = singleton(llds_instr(label(SuccLabel), "")),
+ Code = TagTestCode ++ FailCode ++ SuccessLabelCode ++ DeconsCode.
%---------------------------------------------------------------------------%
@@ -1144,7 +1144,7 @@
% for the arguments of a construction.
%
:- pred generate_unify_args(list(uni_val)::in, list(uni_val)::in,
- list(uni_mode)::in, list(mer_type)::in, code_tree::out,
+ list(uni_mode)::in, list(mer_type)::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_unify_args(Ls, Rs, Ms, Ts, Code, !CI) :-
@@ -1155,21 +1155,21 @@
).
:- pred generate_unify_args_2(list(uni_val)::in, list(uni_val)::in,
- list(uni_mode)::in, list(mer_type)::in, code_tree::out,
+ list(uni_mode)::in, list(mer_type)::in, llds_code::out,
code_info::in, code_info::out) is semidet.
generate_unify_args_2([], [], [], [], empty, !CI).
generate_unify_args_2([L | Ls], [R | Rs], [M | Ms], [T | Ts], Code, !CI) :-
generate_sub_unify(L, R, M, T, CodeA, !CI),
generate_unify_args_2(Ls, Rs, Ms, Ts, CodeB, !CI),
- Code = tree(CodeA, CodeB).
+ Code = CodeA ++ CodeB.
%---------------------------------------------------------------------------%
% Generate a subunification between two [field | variable].
%
:- pred generate_sub_unify(uni_val::in, uni_val::in, uni_mode::in,
- mer_type::in, code_tree::out, code_info::in, code_info::out) is det.
+ mer_type::in, llds_code::out, code_info::in, code_info::out) is det.
generate_sub_unify(L, R, Mode, Type, Code, !CI) :-
Mode = ((LI - RI) -> (LF - RF)),
@@ -1210,7 +1210,7 @@
%---------------------------------------------------------------------------%
-:- pred generate_sub_assign(uni_val::in, uni_val::in, code_tree::out,
+:- pred generate_sub_assign(uni_val::in, uni_val::in, llds_code::out,
code_info::in, code_info::out) is det.
generate_sub_assign(Left, Right, Code, !CI) :-
@@ -1226,8 +1226,8 @@
% so generate immediately.
produce_variable(Var, SourceCode, Source, !CI),
materialize_vars_in_lval(Lval0, Lval, MaterializeCode, !CI),
- CopyCode = node([llds_instr(assign(Lval, Source), "Copy value")]),
- Code = tree_list([SourceCode, MaterializeCode, CopyCode])
+ CopyCode = singleton(llds_instr(assign(Lval, Source), "Copy value")),
+ Code = SourceCode ++ MaterializeCode ++ CopyCode
;
Left = ref(Lvar),
( variable_is_forward_live(!.CI, Lvar) ->
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.66
diff -u -b -r1.66 var_locn.m
--- compiler/var_locn.m 2 Jan 2009 03:12:07 -0000 1.66
+++ compiler/var_locn.m 4 Jan 2009 12:23:17 -0000
@@ -141,7 +141,7 @@
% will be returned in Code.
%
:- pred var_locn_assign_lval_to_var(module_info::in, prog_var::in, lval::in,
- static_cell_info::in, code_tree::out,
+ static_cell_info::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_assign_const_to_var(ExprnOpts, Var, ConstRval,
@@ -161,7 +161,7 @@
% Expr must contain no lvals, although it may (and typically will) refer
% to the values of other variables through rvals of the form var(_).
%
-:- pred var_locn_assign_expr_to_var(prog_var::in, rval::in, code_tree::out,
+:- pred var_locn_assign_expr_to_var(prog_var::in, rval::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var,
@@ -183,7 +183,7 @@
:- pred var_locn_assign_cell_to_var(module_info::in, exprn_opts::in,
prog_var::in, bool::in, tag::in, list(maybe(rval))::in,
how_to_construct::in, maybe(term_size_value)::in, list(int)::in,
- string::in, may_use_atomic_alloc::in, label::in, code_tree::out,
+ string::in, may_use_atomic_alloc::in, label::in, llds_code::out,
static_cell_info::in, static_cell_info::out,
var_locn_info::in, var_locn_info::out) is det.
@@ -194,7 +194,7 @@
% registers so that they are available after ReuseLval is clobbered.
%
:- pred var_locn_save_cell_fields(module_info::in, prog_var::in, lval::in,
- code_tree::out, list(lval)::out, var_locn_info::in, var_locn_info::out)
+ llds_code::out, list(lval)::out, var_locn_info::in, var_locn_info::out)
is det.
% var_locn_place_var(ModuleInfo, Var, Lval, Code, !VarLocnInfo):
@@ -203,7 +203,7 @@
% to reflect this.
%
:- pred var_locn_place_var(module_info::in, prog_var::in, lval::in,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_place_vars(ModuleInfo, VarLocns, Code, !VarLocnInfo):
%
@@ -211,7 +211,7 @@
% into the corresponding location, and update !VarLocnInfo to reflect this.
%
:- pred var_locn_place_vars(module_info::in, assoc_list(prog_var, lval)::in,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_produce_var(ModuleInfo, Var, Rval, Code, !VarLocnInfo):
%
@@ -226,7 +226,7 @@
% Code will be empty.
%
:- pred var_locn_produce_var(module_info::in, prog_var::in, rval::out,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_produce_var_in_reg(ModuleInfo, Var, Lval, Code, !VarLocnInfo):
%
@@ -234,7 +234,7 @@
% and provide it as an Lval of the form reg(_).
%
:- pred var_locn_produce_var_in_reg(module_info::in, prog_var::in, lval::out,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_produce_var_in_reg_or_stack(ModuleInfo, Var, FollowVars, Lval,
% Code, !VarLocnInfo):
@@ -243,7 +243,7 @@
% as an Lval of the form reg(_), stackvar(_), or framevar(_).
%
:- pred var_locn_produce_var_in_reg_or_stack(module_info::in, prog_var::in,
- lval::out, code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ lval::out, llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_acquire_reg(Lval, !VarLocnInfo):
%
@@ -304,7 +304,7 @@
% Produces a code fragment Code to move whatever is in r1 to some other
% register, if r1 is live. This is used prior to semidet pragma c_codes.
%
-:- pred var_locn_clear_r1(module_info::in, code_tree::out,
+:- pred var_locn_clear_r1(module_info::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
% var_locn_materialize_vars_in_lval(ModuleInfo, Lval, FinalLval, Code,
@@ -317,7 +317,7 @@
% in Code.
%
:- pred var_locn_materialize_vars_in_lval(module_info::in, lval::in, lval::out,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
% var_locn_get_var_locations(VarLocnInfo, Locations):
%
@@ -373,10 +373,10 @@
:- import_module check_hlds.type_util.
:- import_module libs.compiler_util.
:- import_module libs.options.
-:- import_module libs.tree.
:- import_module ll_backend.code_util.
:- import_module ll_backend.exprn_aux.
+:- import_module cord.
:- import_module getopt_io.
:- import_module int.
:- import_module pair.
@@ -855,7 +855,7 @@
:- pred var_locn_assign_dynamic_cell_to_var(module_info::in, prog_var::in,
bool::in, tag::in, list(maybe(rval))::in, how_to_construct::in,
maybe(int)::in, string::in, may_use_atomic_alloc::in, label::in,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
var_locn_assign_dynamic_cell_to_var(ModuleInfo, Var, ReserveWordAtStart, Ptag,
Vector, HowToConstruct, MaybeOffset, TypeMsg, MayUseAtomic, Label,
@@ -893,27 +893,37 @@
% reused_cell case, otherwise `var_locn_save_cell_fields' won't know not to
% use Lval as a temporary register (if Lval is a register).
var_locn_set_magic_var_location(Var, Lval, !VLI),
- (
+ % XXX The code at the end of the first three cases is the same.
+ % Switch detection could recognize this code as a switch on HowToConstruct
+ % before the change from tree.m to cord.m to represent code, but it cannot
+ % recognize it afterwards.
(
HowToConstruct = construct_in_region(RegionVar),
var_locn_produce_var(ModuleInfo, RegionVar, RegionRval,
RegionVarCode, !VLI),
MaybeRegionRval = yes(RegionRval),
MaybeReuse = no_llds_reuse,
- LldsComment = "Allocating region for "
+ LldsComment = "Allocating region for ",
+ assign_all_cell_args(ModuleInfo, Vector, yes(Ptag), lval(Lval),
+ StartOffset, ArgsCode, !VLI),
+ SetupReuseCode = empty,
+ MaybeReuse = no_llds_reuse
;
HowToConstruct = construct_dynamically,
RegionVarCode = empty,
MaybeRegionRval = no,
- LldsComment = "Allocating heap for "
+ LldsComment = "Allocating heap for ",
+ assign_all_cell_args(ModuleInfo, Vector, yes(Ptag), lval(Lval),
+ StartOffset, ArgsCode, !VLI),
+ SetupReuseCode = empty,
+ MaybeReuse = no_llds_reuse
;
% XXX We should probably throw an exception if we find
% construct_statically here.
HowToConstruct = construct_statically(_),
RegionVarCode = empty,
MaybeRegionRval = no,
- LldsComment = "Allocating heap for "
- ),
+ LldsComment = "Allocating heap for ",
assign_all_cell_args(ModuleInfo, Vector, yes(Ptag), lval(Lval),
StartOffset, ArgsCode, !VLI),
SetupReuseCode = empty,
@@ -942,18 +952,18 @@
MaybeReuse = no_llds_reuse
)
),
- CellCode = node([
+ CellCode = singleton(
llds_instr(
incr_hp(Lval, yes(Ptag), TotalOffset,
const(llconst_int(TotalSize)), TypeMsg, MayUseAtomic,
MaybeRegionRval, MaybeReuse),
LldsComment ++ VarName)
- ]),
- Code = tree_list([SetupReuseCode, CellCode, RegionVarCode, ArgsCode]).
+ ),
+ Code = SetupReuseCode ++ CellCode ++ RegionVarCode ++ ArgsCode.
:- pred assign_reused_cell_to_var(module_info::in, lval::in, tag::in,
- list(maybe(rval))::in, cell_to_reuse::in, lval::in, code_tree::in,
- int::in, label::in, llds_reuse::out, code_tree::out, code_tree::out,
+ list(maybe(rval))::in, cell_to_reuse::in, lval::in, llds_code::in,
+ int::in, label::in, llds_reuse::out, llds_code::out, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
assign_reused_cell_to_var(ModuleInfo, Lval, Ptag, Vector, CellToReuse,
@@ -965,7 +975,7 @@
% temporary registers.
var_locn_save_cell_fields(ModuleInfo, ReuseVar, ReuseLval, SaveArgsCode,
TempRegs0, !VLI),
- SetupReuseCode = tree(ReuseVarCode, SaveArgsCode),
+ SetupReuseCode = ReuseVarCode ++ SaveArgsCode,
% If it's possible to avoid some field assignments, we'll need an extra
% temporary register to record whether we actually are reusing a structure
@@ -997,18 +1007,17 @@
assign_some_cell_args(ModuleInfo, Vector, NeedsUpdates, yes(Ptag),
lval(Lval), StartOffset, CannotSkipArgsCode, CanSkipArgsCode,
!VLI),
- ArgsCode = tree_list([
- node([
+ ArgsCode =
+ singleton(
llds_instr(if_val(lval(FlagLval), code_label(Label)),
"skip some field assignments")
- ]),
- CanSkipArgsCode,
- node([
+ ) ++
+ CanSkipArgsCode ++
+ singleton(
llds_instr(label(Label),
"past skipped field assignments")
- ]),
+ ) ++
CannotSkipArgsCode
- ])
;
MaybeFlag = no,
assign_all_cell_args(ModuleInfo, Vector, yes(Ptag), lval(Lval),
@@ -1018,7 +1027,7 @@
list.foldl(var_locn_release_reg, TempRegs, !VLI).
:- pred assign_all_cell_args(module_info::in, list(maybe(rval))::in,
- maybe(tag)::in, rval::in, int::in, code_tree::out,
+ maybe(tag)::in, rval::in, int::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
assign_all_cell_args(_, [], _, _, _, empty, !VLI).
@@ -1033,11 +1042,11 @@
),
assign_all_cell_args(ModuleInfo, MaybeRvals, Ptag, Base, Offset + 1,
RestCode, !VLI),
- Code = tree(ThisCode, RestCode).
+ Code = ThisCode ++ RestCode.
:- pred assign_some_cell_args(module_info::in, list(maybe(rval))::in,
- list(needs_update)::in, maybe(tag)::in, rval::in, int::in, code_tree::out,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ list(needs_update)::in, maybe(tag)::in, rval::in, int::in, llds_code::out,
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
assign_some_cell_args(_, [], [], _, _, _, empty, empty, !VLI).
assign_some_cell_args(ModuleInfo,
@@ -1054,12 +1063,12 @@
Offset + 1, RestCannotSkipArgsCode, RestCanSkipArgsCode, !VLI),
(
NeedsUpdate = needs_update,
- CannotSkipArgsCode = tree(ThisCode, RestCannotSkipArgsCode),
+ CannotSkipArgsCode = ThisCode ++ RestCannotSkipArgsCode,
CanSkipArgsCode = RestCanSkipArgsCode
;
NeedsUpdate = does_not_need_update,
CannotSkipArgsCode = RestCannotSkipArgsCode,
- CanSkipArgsCode = tree(ThisCode, RestCanSkipArgsCode)
+ CanSkipArgsCode = ThisCode ++ RestCanSkipArgsCode
).
assign_some_cell_args(_, [], [_ | _], _, _, _, _, _, !VLI) :-
@@ -1068,7 +1077,7 @@
unexpected(this_file, "assign_some_cell_args: mismatch lists").
:- pred assign_cell_arg(module_info::in, rval::in, maybe(tag)::in, rval::in,
- int::in, code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ int::in, llds_code::out, var_locn_info::in, var_locn_info::out) is det.
assign_cell_arg(ModuleInfo, Rval0, Ptag, Base, Offset, Code, !VLI) :-
Target = field(Ptag, Base, const(llconst_int(Offset))),
@@ -1094,13 +1103,13 @@
add_additional_lval_for_var(Var, Target, !VLI),
get_var_name(!.VLI, Var, VarName),
Comment = "assigning from " ++ VarName,
- AssignCode = node([llds_instr(assign(Target, Rval), Comment)])
+ AssignCode = singleton(llds_instr(assign(Target, Rval), Comment))
)
;
Rval0 = const(_),
EvalCode = empty,
Comment = "assigning field from const",
- AssignCode = node([llds_instr(assign(Target, Rval0), Comment)])
+ AssignCode = singleton(llds_instr(assign(Target, Rval0), Comment))
;
( Rval0 = mkword(_, _)
; Rval0 = binop(_, _, _)
@@ -1110,7 +1119,7 @@
),
unexpected(this_file, "assign_cell_args: unknown rval")
),
- Code = tree(EvalCode, AssignCode).
+ Code = EvalCode ++ AssignCode.
var_locn_save_cell_fields(ModuleInfo, ReuseVar, ReuseLval, Code, Regs, !VLI) :-
var_locn_get_var_state_map(!.VLI, VarStateMap),
@@ -1119,10 +1128,10 @@
DepVars = set.to_sorted_list(DepVarsSet),
list.map_foldl2(var_locn_save_cell_fields_2(ModuleInfo, ReuseLval),
DepVars, SaveArgsCode, [], Regs, !VLI),
- Code = tree_list(SaveArgsCode).
+ Code = cord_list_to_cord(SaveArgsCode).
:- pred var_locn_save_cell_fields_2(module_info::in, lval::in, prog_var::in,
- code_tree::out, list(lval)::in, list(lval)::out,
+ llds_code::out, list(lval)::in, list(lval)::out,
var_locn_info::in, var_locn_info::out) is det.
var_locn_save_cell_fields_2(ModuleInfo, ReuseLval, DepVar, SaveDepVarCode,
@@ -1151,16 +1160,16 @@
var_locn_acquire_reg(Target, !VLI),
add_additional_lval_for_var(DepVar, Target, !VLI),
get_var_name(!.VLI, DepVar, DepVarName),
- AssignCode = node([
+ AssignCode = singleton(
llds_instr(assign(Target, DepVarRval),
"saving " ++ DepVarName)
- ]),
+ ),
!:Regs = [Target | !.Regs]
;
AssignCode = empty
)
),
- SaveDepVarCode = tree(EvalCode, AssignCode).
+ SaveDepVarCode = EvalCode ++ AssignCode.
%----------------------------------------------------------------------------%
@@ -1345,19 +1354,19 @@
var_locn_unlock_regs(!VLI).
:- pred actually_place_vars(module_info::in, assoc_list(prog_var, lval)::in,
- code_tree::out, var_locn_info::in, var_locn_info::out) is det.
+ llds_code::out, var_locn_info::in, var_locn_info::out) is det.
actually_place_vars(_, [], empty, !VLI).
actually_place_vars(ModuleInfo, [Var - Lval | Rest], Code, !VLI) :-
var_locn_place_var(ModuleInfo, Var, Lval, FirstCode, !VLI),
actually_place_vars(ModuleInfo, Rest, RestCode, !VLI),
- Code = tree(FirstCode, RestCode).
+ Code = FirstCode ++ RestCode.
var_locn_place_var(ModuleInfo, Var, Target, Code, !VLI) :-
actually_place_var(ModuleInfo, Var, Target, [], Code, !VLI).
:- pred actually_place_var(module_info::in, prog_var::in, lval::in,
- list(lval)::in, code_tree::out, var_locn_info::in, var_locn_info::out)
+ list(lval)::in, llds_code::out, var_locn_info::in, var_locn_info::out)
is det.
actually_place_var(ModuleInfo, Var, Target, ForbiddenLvals, Code, !VLI) :-
@@ -1420,10 +1429,10 @@
AssignCode = empty
;
IsDummy = is_not_dummy_type,
- AssignCode = node([llds_instr(assign(Target, Rval), Msg)])
+ AssignCode = singleton(llds_instr(assign(Target, Rval), Msg))
)
),
- Code = tree(FreeCode, tree(EvalCode, AssignCode))
+ Code = FreeCode ++ EvalCode ++ AssignCode
).
:- pred record_clobbering(lval::in, list(prog_var)::in,
@@ -1462,7 +1471,7 @@
% generate an assignment such as Lval := field(Ptag, Lval, Offset).
%
:- pred free_up_lval(module_info::in, lval::in, list(prog_var)::in,
- list(lval)::in, code_tree::out, var_locn_info::in, var_locn_info::out)
+ list(lval)::in, llds_code::out, var_locn_info::in, var_locn_info::out)
is det.
free_up_lval(ModuleInfo, Lval, ToBeAssignedVars, ForbiddenLvals, Code, !VLI) :-
@@ -1499,7 +1508,7 @@
% recursively free up Pref, and then move OccupyingVar there.
%
:- pred free_up_lval_with_copy(module_info::in, lval::in, list(prog_var)::in,
- list(lval)::in, code_tree::out, var_locn_info::in, var_locn_info::out)
+ list(lval)::in, llds_code::out, var_locn_info::in, var_locn_info::out)
is det.
free_up_lval_with_copy(ModuleInfo, Lval, ToBeAssignedVars, ForbiddenLvals,
@@ -1552,10 +1561,10 @@
% if we assigned Lval to it.
Code = empty
;
- Code = node([
+ Code = singleton(
llds_instr(assign(Target, lval(Lval)),
"Freeing up the source lval")
- ])
+ )
)
).
@@ -2133,7 +2142,7 @@
!VLI).
:- pred var_locn_materialize_vars_in_lval_avoid(module_info::in, lval::in,
- list(lval)::in, lval::out, code_tree::out,
+ list(lval)::in, lval::out, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
var_locn_materialize_vars_in_lval_avoid(ModuleInfo, Lval0, Avoid, Lval, Code,
@@ -2190,7 +2199,7 @@
var_locn_materialize_vars_in_rval_avoid(ModuleInfo, RvalB0, no, Avoid,
RvalB, CodeB, !VLI),
Lval = field(Tag, RvalA, RvalB),
- Code = tree(CodeA, CodeB)
+ Code = CodeA ++ CodeB
;
Lval0 = temp(_, _),
unexpected(this_file, "var_locn_materialize_vars_in_lval_avoid: temp")
@@ -2202,7 +2211,7 @@
% Rval is Rval0 with all variables in Rval0 replaced by their values.
%
:- pred var_locn_materialize_vars_in_rval_avoid(module_info::in,
- rval::in, maybe(lval)::in, list(lval)::in, rval::out, code_tree::out,
+ rval::in, maybe(lval)::in, list(lval)::in, rval::out, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
var_locn_materialize_vars_in_rval_avoid(ModuleInfo, Rval0, MaybePrefer, Avoid,
@@ -2229,7 +2238,7 @@
var_locn_materialize_vars_in_rval_avoid(ModuleInfo, SubRvalB0, no,
Avoid, SubRvalB, CodeB, !VLI),
Rval = binop(Binop, SubRvalA, SubRvalB),
- Code = tree(CodeA, CodeB)
+ Code = CodeA ++ CodeB
;
Rval0 = const(_),
Rval = Rval0,
@@ -2255,7 +2264,7 @@
% MemRef is MemRef0 with all variables in MemRef replaced by their values.
%
:- pred var_locn_materialize_vars_in_mem_ref_avoid(module_info::in,
- mem_ref::in, mem_ref::out, list(lval)::in, code_tree::out,
+ mem_ref::in, mem_ref::out, list(lval)::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
var_locn_materialize_vars_in_mem_ref_avoid(ModuleInfo, MemRef0, MemRef, Avoid,
@@ -2274,7 +2283,7 @@
Avoid, PtrRval, PtrCode, !VLI),
var_locn_materialize_vars_in_rval_avoid(ModuleInfo, FieldNumRval0, no,
Avoid, FieldNumRval, FieldNumCode, !VLI),
- Code = tree(PtrCode, FieldNumCode),
+ Code = PtrCode ++ FieldNumCode,
MemRef = heap_ref(PtrRval, Ptag, FieldNumRval)
).
@@ -2305,7 +2314,7 @@
).
:- pred materialize_var(module_info::in, prog_var::in, maybe(lval)::in,
- bool::in, list(lval)::in, rval::out, code_tree::out,
+ bool::in, list(lval)::in, rval::out, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
materialize_var(ModuleInfo, Var, MaybePrefer, StoreIfReq, Avoid, Rval, Code,
@@ -2330,7 +2339,7 @@
select_preferred_reg_avoid(!.VLI, Var, Avoid, Lval),
var_locn_place_var(ModuleInfo, Var, Lval, PlaceCode, !VLI),
Rval = lval(Lval),
- Code = tree(ExprCode, PlaceCode)
+ Code = ExprCode ++ PlaceCode
;
Rval = Rval0,
Code = ExprCode
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.140
diff -u -b -r1.140 compiler_design.html
--- compiler/notes/compiler_design.html 3 Dec 2008 05:01:45 -0000 1.140
+++ compiler/notes/compiler_design.html 4 Jan 2009 13:07:34 -0000
@@ -1372,8 +1372,7 @@
The result of code generation is the Low Level Data Structure (llds.m),
which may also contains some data structures whose types are defined in rtti.m.
The code for each procedure is generated as a tree of code fragments
-which is then flattened (tree.m).
-
+which is then flattened.
<h4> 5a. Low-level optimization (LLDS). </h4>
@@ -1793,12 +1792,6 @@
Graph colouring. <br>
This is used by the LLDS back-end for register allocation
- <dt> tree.m
- <dd>
- A simple tree data type. <br>
- Used by the LLDS, and IL back-ends for collecting
- together the different fragments of the generated code.
-
<dt> lp.m
<dd>
Implements the linear programming algorithm for optimizing
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/cord.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/cord.m,v
retrieving revision 1.12
diff -u -b -r1.12 cord.m
--- library/cord.m 6 Aug 2008 08:15:04 -0000 1.12
+++ library/cord.m 4 Jan 2009 11:43:17 -0000
@@ -123,6 +123,8 @@
% list(map(F, C)) = list.map(F, list(C))
%
:- func map(func(T) = U, cord(T)) = cord(U).
+:- pred map_pred(pred(T, U)::in(pred(in, out) is det),
+ cord(T)::in, cord(U)::out) is det.
% foldl(F, C, A) = list.foldl(F, list(C), A).
%
@@ -340,6 +342,25 @@
map(F, leaves(Xs) ) = leaves(map(F, Xs)).
map(F, branch(CA, CB)) = branch(map(F, CA), map(F, CB)).
+map_pred(P, !Cord) :-
+ (
+ !.Cord = nil,
+ !:Cord = nil
+ ;
+ !.Cord = leaf(X),
+ P(X, PX),
+ !:Cord = leaf(PX)
+ ;
+ !.Cord = leaves(Xs),
+ list.map(P, Xs, PXs),
+ !:Cord = leaves(PXs)
+ ;
+ !.Cord = branch(CA, CB),
+ cord.map_pred(P, CA, PCA),
+ cord.map_pred(P, CB, PCB),
+ !:Cord = branch(PCA, PCB)
+ ).
+
%-----------------------------------------------------------------------------%
foldl(_, nil, A) = A.
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list