[m-rev.] for review: fix another dead proc elim problem
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Aug 10 18:39:11 AEST 2007
My previous fix to dead proc elimination helped fixed some compiler aborts,
but a related problem remained.
The problem involved an unused procedure that was kept around so that the code
generator would create the table associated with it. Since the procedure was
unused, its body was thought to be unused too. If it contained a reference to a
procedure that wasn't referred to from anywhere else, that procedure would be
removed, leaving a dangling reference. This would cause a code generator abort.
We can't fix the abort by replacing the kept-around procedure's body with
"true", since that would cause a different code generator abort when moving the
(now unbound) output variables to their argument registers. We could avoid
generating any code for the procedure at all by e.g. marking it as
opt_imported, but this would (a) be inconsistent and (b) require special case
coding to still generate the table structure.
The fix is to generate the global variable used for tabling *independently* of
the procedure that enters things in the table.
compiler/hlds_module.m:
Add a field to the module_info (actually module_sub_info) that records
the information the backends need to create the global variables
representing call tables.
Name all the fields of the module_info and module_sub_info during
initialization, to make it easier to know where to add a new field.
Put the initializations of the fields in the same order as the fields
themselves.
compiler/hlds_pred.m:
Keep only the info for I/O tabling in procedures, since such tabling
does not require defining a per-procedure global variable.
Since the info for the forms of tabling that *do* require a
per-procedure global variable are now divorced from the procedure,
change their definition to avoid storing prog_vars in them, since
those prog_vars would be separated from their varset. Instead, we
record their numbers and their names (both are used only for debug
support).
On the other hand, some info from the pred_info and proc_info are
to create the global variable; copy them into the data structure stored
in hlds_module.
Rename some fields to avoid ambiguities.
compiler/table_gen.m:
Continue to record information about I/O tabling in the proc_info,
but record information about other forms of tabling in the new field
in the module_info.
compiler/rtti.m:
compiler/hlds_rtti.m:
Move the functions for constructing and deconstructing rtti_proc_labels
from rtti.m (which is in backend_libs) to hlds_rtti.m (which is in
hlds); the definition of rtti_proc_label was already in hlds_rtti.m.
The move is needed to allow table_gen to put an rtti_proc_label
in the data structures it puts in the module_info.
compiler/hlds_out.m:
Print out the new module_info field, and conform to the change to
hlds_pred and table_arg_info.
Always print variable numbers for type variables in table_arg_infos.
compiler/continuation_info.m:
Make room for either kind of tabling info for a procedure.
(While the LLDS code generator doesn't need to know about the global
variable representing the call table in order to create it, it does
need to know about it in order to describe it to the debugger.)
Conform to the change in table_arg_info.
Rename some fields to avoid ambiguities.
compiler/proc_gen.m:
When generating code for procedures, do not try to create a
per-procedure tabling struct, but do fill in the slot describing it
in the continuation_info.
Add a predicate to define all the tabling structs in a module.
compiler/mercury_compile.m:
Call proc_gen separately to define all the tabling structs.
compiler/ml_code_gen.m:
As with proc_gen, define tabling structs directly from the module_info
and not when generating code from each proc_info.
(The code for handling each proc is now logically not contiguous;
I will address that in a separate change, to make the diff for this one
easier to read.)
compiler/dead_proc_elim.m:
Don't keep unused tabled procedures alive, since that leads to the
problem described up top.
Keep track of which tabling structs are live, but don't yet act on that
information, since some uses are hidden (for now).
Add conditionally compiled tracing code that helped me trace down the
problem.
Fix an oversight in the severity level of an error spec.
compiler/base_typeclass_info.m:
compiler/code_util.m:
compiler/deep_profiling.m:
compiler/ml_code_util.m:
compiler/proc_label.m:
compiler/type_ctor_info.m:
Conform to the move of make_rtti_proc_label.
compiler/optimize.m:
Conform to the change to continuation_info.
compiler/stack_layout.m:
Conform to the data structure changes above.
doc/user_guide.texi:
Document 'Z' as the character in -D arguments that tells hlds_out
to dump the global structures needed for tabling.
Fix an old oversight: document 'S' as the character in -D arguments
that tells hlds_out to dump info about structure sharing.
compiler/handle_options.m:
Include 'Z' in -DALL -and -Dall.
tests/tabling/mercury_java_parser_dead_proc_elim_bug.{m,exp}:
Move this test case here from valid, since compiling all the way to
executable doesn't work in valid (in yields link errors unrelated to
the bug we are testing for).
tests/tabling/mercury_java_parser_dead_proc_elim_bug2.{m,exp}:
Add this new test case that in unfixed compilers gives the problem
described up top.
tests/tabling/Mmakefile:
Enable the new tests.
tests/valid/Mmakefile:
tests/valid/Mercury.options:
Remove references to the moved tests.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/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/base_typeclass_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.50
diff -u -r1.50 base_typeclass_info.m
--- compiler/base_typeclass_info.m 13 Oct 2006 04:52:16 -0000 1.50
+++ compiler/base_typeclass_info.m 9 Aug 2007 09:09:07 -0000
@@ -146,7 +146,7 @@
construct_proc_labels([], _, []).
construct_proc_labels([proc(PredId, ProcId) | Procs], ModuleInfo,
[ProcLabel | ProcLabels]) :-
- ProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ ProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
construct_proc_labels(Procs, ModuleInfo, ProcLabels).
%----------------------------------------------------------------------------%
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.179
diff -u -r1.179 code_util.m
--- compiler/code_util.m 7 Aug 2007 07:09:48 -0000 1.179
+++ compiler/code_util.m 9 Aug 2007 09:12:08 -0000
@@ -104,7 +104,7 @@
%---------------------------------------------------------------------------%
make_entry_label(ModuleInfo, PredId, ProcId, Immed) = ProcAddr :-
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
ProcAddr = make_entry_label_from_rtti(RttiProcLabel, Immed).
make_entry_label_from_rtti(RttiProcLabel, Immed) = ProcAddr :-
@@ -117,7 +117,7 @@
).
make_local_entry_label(ModuleInfo, PredId, ProcId, Immed) = Label :-
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
Label = make_local_entry_label_from_rtti(RttiProcLabel, Immed).
:- func make_local_entry_label_from_rtti(rtti_proc_label, immed) = label.
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.89
diff -u -r1.89 continuation_info.m
--- compiler/continuation_info.m 31 Jul 2007 01:56:34 -0000 1.89
+++ compiler/continuation_info.m 9 Aug 2007 06:45:24 -0000
@@ -82,76 +82,84 @@
%
:- type proc_layout_info
---> proc_layout_info(
- rtti_proc_label :: rtti_proc_label,
+ pli_rtti_proc_label :: rtti_proc_label,
% The identity of the procedure.
- entry_label :: label,
+ pli_entry_label :: label,
- detism :: determinism,
+ pli_detism :: determinism,
% Determines which stack is used.
- stack_slot_count :: int,
+ pli_stack_slot_count :: int,
% Number of stack slots.
- succip_slot :: maybe(int),
+ pli_succip_slot :: maybe(int),
% Location of succip on stack.
- eval_method :: eval_method,
+ pli_eval_method :: eval_method,
% The evaluation method of the procedure.
- eff_trace_level :: trace_level,
+ pli_eff_trace_level :: trace_level,
% The effective trace level of the procedure.
- call_label :: maybe(label),
+ pli_call_label :: maybe(label),
% If the trace level is not none, this contains the label
% associated with the call event, whose stack layout says
% which variables were live and where on entry.
- max_trace_reg :: int,
+ pli_max_trace_reg :: int,
% The number of the highest numbered rN register that can
% contain useful information during a call to MR_trace from
% within this procedure.
- head_vars :: list(prog_var),
+ pli_head_vars :: list(prog_var),
% The head variables, in order, including the ones introduced
% by the compiler.
- arg_modes :: list(mer_mode),
+ pli_arg_modes :: list(mer_mode),
% The modes of the head variables.
- proc_body :: hlds_goal,
+ pli_proc_body :: hlds_goal,
% The body of the procedure.
- needs_body_rep :: bool,
+ pli_needs_body_rep :: bool,
% Do we need to include a representation of the procedure body
% in the exec trace layout?
- initial_instmap :: instmap,
+ pli_initial_instmap :: instmap,
% The instmap at the start of the procedure body.
- trace_slot_info :: trace_slot_info,
+ pli_trace_slot_info :: trace_slot_info,
% Info about the stack slots used for tracing.
- need_proc_id :: bool,
+ pli_need_proc_id :: bool,
% Do we require the procedure id section of the procedure
% layout to be present, even if the option procid_stack_layout
% is not set?
- varset :: prog_varset,
- vartypes :: vartypes,
+ pli_varset :: prog_varset,
+ pli_vartypes :: vartypes,
% The names and types of all the variables.
- internal_map :: proc_label_layout_info,
+ pli_internal_map :: proc_label_layout_info,
% Info for each internal label, needed for basic_stack_layouts.
- maybe_table_info :: maybe(proc_table_info),
+ pli_maybe_table_info :: maybe(proc_layout_table_info),
- need_all_names :: bool,
+ pli_need_all_names :: bool,
% True iff we need the names of all the variables.
- deep_prof :: maybe(proc_layout_proc_static)
+ pli_deep_prof :: maybe(proc_layout_proc_static)
).
+:- type proc_layout_table_info
+ ---> proc_table_io_decl(
+ proc_table_io_info
+ )
+ ; proc_table_struct(
+ proc_table_struct_info
+ ).
+
% Information about the labels internal to a procedure.
%
:- type proc_label_layout_info == map(int, internal_layout_info).
@@ -442,7 +450,7 @@
process_proc_llds(PredProcId, Instructions, WantReturnInfo, !GlobalData) :-
% Get all the continuation info from the call instructions.
global_data_get_proc_layout(!.GlobalData, PredProcId, ProcLayoutInfo0),
- Internals0 = ProcLayoutInfo0^internal_map,
+ Internals0 = ProcLayoutInfo0 ^ pli_internal_map,
GetCallInfo = (pred(Instr::in, Call::out) is semidet :-
Instr = llds_instr(llcall(Target, code_label(ReturnLabel), LiveInfo,
Context, GoalPath, _), _Comment),
@@ -454,7 +462,7 @@
list.foldl(process_continuation(WantReturnInfo), Calls,
Internals0, Internals),
- ProcLayoutInfo = ProcLayoutInfo0^internal_map := Internals,
+ ProcLayoutInfo = ProcLayoutInfo0 ^ pli_internal_map := Internals,
global_data_update_proc_layout(PredProcId, ProcLayoutInfo, !GlobalData).
%-----------------------------------------------------------------------------%
@@ -823,27 +831,31 @@
%---------------------------------------------------------------------------%
generate_table_arg_type_info(ProcInfo, NumberedVars, TableArgInfos) :-
+ proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_vartypes(ProcInfo, VarTypes),
set.init(TypeVars0),
- build_table_arg_info(VarTypes, NumberedVars, ArgLayouts,
+ build_table_arg_info(VarSet, VarTypes, NumberedVars, ArgLayouts,
TypeVars0, TypeVars),
set.to_sorted_list(TypeVars, TypeVarsList),
find_typeinfos_for_tvars_table(TypeVarsList, NumberedVars, ProcInfo,
TypeInfoDataMap),
TableArgInfos = table_arg_infos(ArgLayouts, TypeInfoDataMap).
-:- pred build_table_arg_info(vartypes::in,
+:- pred build_table_arg_info(prog_varset::in, vartypes::in,
assoc_list(prog_var, int)::in, list(table_arg_info)::out,
set(tvar)::in, set(tvar)::out) is det.
-build_table_arg_info(_, [], [], !TypeVars).
-build_table_arg_info(VarTypes, [Var - SlotNum | NumberedVars],
+build_table_arg_info(_, _, [], [], !TypeVars).
+build_table_arg_info(VarSet, VarTypes, [Var - SlotNum | NumberedVars],
[ArgLayout | ArgLayouts], !TypeVars) :-
+ term.var_to_int(Var, VarNum),
+ varset.lookup_name(VarSet, Var, VarName),
map.lookup(VarTypes, Var, Type),
- ArgLayout = table_arg_info(Var, SlotNum, Type),
+ ArgLayout = table_arg_info(VarNum, VarName, SlotNum, Type),
type_vars(Type, VarTypeVars),
svset.insert_list(VarTypeVars, !TypeVars),
- build_table_arg_info(VarTypes, NumberedVars, ArgLayouts, !TypeVars).
+ build_table_arg_info(VarSet, VarTypes, NumberedVars,
+ ArgLayouts, !TypeVars).
%---------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.123
diff -u -r1.123 dead_proc_elim.m
--- compiler/dead_proc_elim.m 8 Aug 2007 05:08:39 -0000 1.123
+++ compiler/dead_proc_elim.m 9 Aug 2007 09:27:53 -0000
@@ -61,6 +61,7 @@
:- type entity
---> entity_proc(pred_id, proc_id)
+ ; entity_table_struct(pred_id, proc_id)
; entity_type_ctor(module_name, string, int).
:- type needed_map == map(entity, maybe_needed).
@@ -324,6 +325,9 @@
PredProcId = proc(PredId, ProcId),
dead_proc_examine_proc(PredProcId, ModuleInfo, !Queue, !Needed)
;
+ Entity = entity_table_struct(_PredId, _ProcId)
+ % Nothing further to examine.
+ ;
Entity = entity_type_ctor(Module, Type, Arity),
dead_proc_examine_type_ctor_info(Module, Type, Arity,
ModuleInfo, !Queue, !Needed)
@@ -402,10 +406,41 @@
pred_info_get_procedures(PredInfo, ProcTable),
map.lookup(ProcTable, ProcId, ProcInfo)
->
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("examining proc ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ ),
proc_info_get_goal(ProcInfo, Goal),
- dead_proc_examine_goal(Goal, proc(PredId, ProcId), !Queue, !Needed)
+ dead_proc_examine_goal(Goal, proc(PredId, ProcId), !Queue, !Needed),
+
+ proc_info_get_eval_method(ProcInfo, EvalMethod),
+ HasPerProcTablingPtr =
+ eval_method_has_per_proc_tabling_pointer(EvalMethod),
+ (
+ HasPerProcTablingPtr = no
+ ;
+ HasPerProcTablingPtr = yes,
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("need table struct for proc ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ ),
+ TableStructEntity = entity_table_struct(PredId, ProcId),
+ svmap.set(TableStructEntity, not_eliminable, !Needed)
+ )
;
- true
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("not examining proc ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ )
).
:- pred dead_proc_examine_goals(list(hlds_goal)::in, pred_proc_id::in,
@@ -459,6 +494,13 @@
Entity = entity_proc(PredId, ProcId),
queue.put(!.Queue, Entity, !:Queue),
( proc(PredId, ProcId) = CurrProc ->
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("plain_call recursive ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ ),
% If it's reachable and recursive, then we can't eliminate it
% or inline it.
NewNotation = not_eliminable,
@@ -466,37 +508,105 @@
; map.search(!.Needed, Entity, OldNotation) ->
(
OldNotation = not_eliminable,
- NewNotation = not_eliminable
+ NewNotation = not_eliminable,
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("plain_call old not_eliminable ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ )
;
OldNotation = maybe_eliminable(Count),
- NewNotation = maybe_eliminable(Count + 1)
+ NewNotation = maybe_eliminable(Count + 1),
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("plain_call incr maybe_eliminable ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ )
),
svmap.det_update(Entity, NewNotation, !Needed)
;
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("plain_call init maybe_eliminable ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ ),
NewNotation = maybe_eliminable(1),
svmap.set(Entity, NewNotation, !Needed)
).
dead_proc_examine_expr(call_foreign_proc(_, PredId, ProcId, _, _, _, _),
_CurrProc, !Queue, !Needed) :-
Entity = entity_proc(PredId, ProcId),
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("foreign_proc ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ ),
svqueue.put(Entity, !Queue),
svmap.set(Entity, not_eliminable, !Needed).
dead_proc_examine_expr(unify(_,_,_, Uni, _), _CurrProc, !Queue, !Needed) :-
(
Uni = construct(_, ConsId, _, _, _, _, _),
(
- ConsId = pred_const(ShroudedPredProcId, _),
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
- Entity = entity_proc(PredId, ProcId)
+ (
+ ConsId = pred_const(ShroudedPredProcId, _),
+ proc(PredId, ProcId) =
+ unshroud_pred_proc_id(ShroudedPredProcId),
+ Entity = entity_proc(PredId, ProcId),
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("pred_const ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ )
+ ;
+ ConsId = type_ctor_info_const(Module, TypeName, Arity),
+ Entity = entity_type_ctor(Module, TypeName, Arity)
+ ;
+ ConsId = tabling_info_const(ShroudedPredProcId),
+ proc(PredId, ProcId) =
+ unshroud_pred_proc_id(ShroudedPredProcId),
+ Entity = entity_table_struct(PredId, ProcId),
+ trace [io(!IO), compile_time(flag("dead_proc_elim"))] (
+ io.write_string("table struct const ", !IO),
+ io.write_int(pred_id_to_int(PredId), !IO),
+ io.write_string(" ", !IO),
+ io.write_int(proc_id_to_int(ProcId), !IO),
+ io.nl(!IO)
+ )
+ ),
+ svqueue.put(Entity, !Queue),
+ svmap.set(Entity, not_eliminable, !Needed)
;
- ConsId = type_ctor_info_const(Module, TypeName, Arity),
- Entity = entity_type_ctor(Module, TypeName, Arity)
+ ( ConsId = cons(_, _)
+ ; ConsId = int_const(_)
+ ; ConsId = string_const(_)
+ ; ConsId = float_const(_)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ )
+ % Do nothing.
)
- ->
- svqueue.put(Entity, !Queue),
- svmap.set(Entity, not_eliminable, !Needed)
;
- true
+ ( Uni = deconstruct(_, _, _, _, _, _)
+ ; Uni = assign(_, _)
+ ; Uni = simple_test(_, _)
+ )
+ % Do nothing.
+ ;
+ Uni = complicated_unify(_, _, _),
+ unexpected(this_file, "dead_proc_examine_expr: complicated_unify")
).
dead_proc_examine_expr(shorthand(_), _, !Queue, !Needed) :-
% These should have been expanded out by now.
@@ -544,6 +654,12 @@
dead_proc_eliminate_type_ctor_infos(TypeCtorGenInfos0, !.Needed,
TypeCtorGenInfos),
module_info_set_type_ctor_gen_infos(TypeCtorGenInfos, !ModuleInfo),
+
+ % We could also eliminate eliminate table structs, but we don't do that
+ % yet, because some references to such structs are currently visible
+ % only in C code embedded in compiler-generated foreign_procs, and
+ % therefore we might accidentally create dangling references.
+
(
Changed = yes,
% The dependency graph will still contain references to the eliminated
@@ -624,14 +740,11 @@
ProcIds = pred_info_procids(PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
- % Reduce memory usage by replacing the goals with conj([]).
- % XXX this looks fishy to me - zs
+ % Reduce memory usage by replacing the goals with "true".
DestroyGoal =
(pred(Id::in, PTable0::in, PTable::out) is det :-
map.lookup(ProcTable0, Id, ProcInfo0),
- goal_info_init(GoalInfo),
- Goal = hlds_goal(true_goal_expr, GoalInfo),
- proc_info_set_goal(Goal, ProcInfo0, ProcInfo),
+ proc_info_set_goal(true_goal, ProcInfo0, ProcInfo),
map.det_update(PTable0, Id, ProcInfo, PTable)
),
list.foldl(DestroyGoal, ProcIds, ProcTable0, ProcTable),
@@ -676,20 +789,6 @@
;
% Or if it is to be kept because it is exported.
Keep = yes(ProcId)
- ;
- % Or if its elimination could cause a link error.
- % Some eval methods cause the procedure implementation to include
- % a global variable representing the root of the per-procedure call
- % and answer tables. In some rare cases, the code of a tabled
- % procedure may be dead, but other predicates (such as the
- % predicate to reset the table) that refer to the global are
- % still alive. In such cases, we cannot eliminate the tabled
- % procedure itself, since doing so would also eliminate the
- % definition of the global variable, leaving a dangling reference.
-
- map.lookup(!.ProcTable, ProcId, ProcInfo),
- proc_info_get_eval_method(ProcInfo, EvalMethod),
- eval_method_has_per_proc_tabling_pointer(EvalMethod) = yes
)
->
true
@@ -707,9 +806,10 @@
;
VeryVerbose = no
),
+ map.lookup(!.ProcTable, ProcId, ProcInfo0),
(
WarnForThisProc = yes,
- proc_info_get_context(!.ProcTable ^ det_elem(ProcId), Context),
+ proc_info_get_context(ProcInfo0, Context),
Spec = warn_dead_proc(PredId, ProcId, Context, ModuleInfo),
!:Specs = [Spec | !.Specs]
;
@@ -728,7 +828,9 @@
[words("is never called."), nl],
Msg = simple_msg(Context,
[option_is_set(warn_dead_procs, yes, [always(Pieces)])]),
- Spec = error_spec(severity_warning, phase_dead_code, [Msg]).
+ Severity = severity_conditional(warn_dead_procs, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_dead_code, [Msg]).
:- pred dead_proc_eliminate_type_ctor_infos(list(type_ctor_gen_info)::in,
needed_map::in, list(type_ctor_gen_info)::out) is det.
@@ -823,6 +925,7 @@
queue(pred_id)::out, set(pred_id)::in, set(pred_id)::out) is det.
dead_pred_elim_add_entity(entity_type_ctor(_, _, _), !Queue, !Preds).
+dead_pred_elim_add_entity(entity_table_struct(_, _), !Queue, !Preds).
dead_pred_elim_add_entity(entity_proc(PredId, _), !Queue, !Preds) :-
svqueue.put(PredId, !Queue),
svset.insert(PredId, !Preds).
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.64
diff -u -r1.64 deep_profiling.m
--- compiler/deep_profiling.m 7 Aug 2007 07:09:50 -0000 1.64
+++ compiler/deep_profiling.m 9 Aug 2007 09:13:17 -0000
@@ -36,6 +36,7 @@
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.pred_table.
:- import_module libs.compiler_util.
@@ -1148,7 +1149,7 @@
PredProcId = !.DeepInfo ^ deep_pred_proc_id
->
OuterPredProcId = proc(OuterPredId, OuterProcId),
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo,
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo,
OuterPredId, OuterProcId)
;
MaybeRecInfo = yes(RecInfo2),
@@ -1157,11 +1158,10 @@
->
OuterPredProcId = !.DeepInfo ^ deep_pred_proc_id,
OuterPredProcId = proc(OuterPredId, OuterProcId),
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo,
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo,
OuterPredId, OuterProcId)
;
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo,
- PredId, ProcId)
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId)
),
CallSite = normal_call(RttiProcLabel, TypeSubst,
FileName, LineNumber, GoalPath),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.307
diff -u -r1.307 handle_options.m
--- compiler/handle_options.m 31 Jul 2007 07:58:41 -0000 1.307
+++ compiler/handle_options.m 9 Aug 2007 23:35:14 -0000
@@ -2583,9 +2583,9 @@
:- pred convert_dump_alias(string::in, string::out) is semidet.
-convert_dump_alias("ALL", "abcdfgilmnprstuvzBCDIMPRSTU").
+convert_dump_alias("ALL", "abcdfgilmnprstuvzBCDIMPRSTUZ").
convert_dump_alias("allD", "abcdfgilmnprstuvzBCDMPT").
-convert_dump_alias("all", "abcdfgilmnprstuvzBCMPST").
+convert_dump_alias("all", "abcdfgilmnprstuvzBCMPSTZ").
convert_dump_alias("most", "bcdfgilmnprstuvzP").
convert_dump_alias("trans", "bcdglmnstuvz").
convert_dump_alias("codegen", "dfnprsu").
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.153
diff -u -r1.153 hlds_module.m
--- compiler/hlds_module.m 6 Aug 2007 12:50:25 -0000 1.153
+++ compiler/hlds_module.m 9 Aug 2007 05:40:39 -0000
@@ -119,9 +119,19 @@
proc_maybe_trail_analysis_status :: maybe(analysis_status)
).
- % Map from a proc to a indication of whether or not it (or one of
- % its subgoals) calls a procedure that is tabled using minimal
- % model tabling.
+ % For every procedure that requires its own tabling structure,
+ % this field records the information needed to define that
+ % structure.
+:- type table_struct_map == map(pred_proc_id, table_struct_info).
+
+:- type table_struct_info
+ ---> table_struct_info(
+ table_struct_proc :: proc_table_struct_info,
+ table_struct_attrs :: table_attributes
+ ).
+
+ % Map from a proc to a indication of whether or not it (or one of its
+ % subgoals) calls a procedure that is tabled using minimal model tabling.
%
:- type mm_tabling_info == map(pred_proc_id, proc_mm_tabling_info).
@@ -407,6 +417,9 @@
:- pred module_info_get_trailing_info(module_info::in, trailing_info::out)
is det.
+:- pred module_info_get_table_struct_map(module_info::in,
+ table_struct_map::out) is det.
+
:- pred module_info_get_mm_tabling_info(module_info::in, mm_tabling_info::out)
is det.
@@ -422,6 +435,9 @@
:- pred module_info_set_trailing_info(trailing_info::in,
module_info::in, module_info::out) is det.
+:- pred module_info_set_table_struct_map(table_struct_map::in,
+ module_info::in, module_info::out) is det.
+
:- pred module_info_set_mm_tabling_info(mm_tabling_info::in,
module_info::in, module_info::out) is det.
@@ -727,6 +743,11 @@
% NOTE: this includes opt_imported procedures.
trailing_info :: trailing_info,
+ % For every procedure that requires its own tabling structure,
+ % this field records the information needed to define that
+ % structure.
+ table_struct_map :: table_struct_map,
+
% Information about if procedures in the current module make
% calls to procedures that are evaluted using minimal model
% tabling.
@@ -800,18 +821,30 @@
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
ModuleInfo) :-
- predicate_table_init(PredicateTable),
- unify_proc.init_requests(Requests),
- map.init(UnifyPredMap),
- map.init(Types),
- inst_table_init(Insts),
- mode_table_init(Modes),
- map.init(Ctors),
+ ContainsParConj = no,
+ ContainsUserEvent = no,
+ ContainsForeignType = no,
+ ForeignDeclInfo = [],
+ ForeignBodyInfo = [],
+ ForeignImportModules = [],
+ FactTableFiles = [],
+ MaybeDependencyInfo = no,
+ NumErrors = 0,
+ PragmaExportedProcs = [],
+ MustBeStratifiedPreds = [],
set.init(StratPreds),
map.init(UnusedArgInfo),
map.init(ExceptionInfo),
map.init(TrailingInfo),
+ map.init(TablingStructMap),
map.init(MM_TablingInfo),
+ map.init(LambdasPerContext),
+ counter.init(1, ModelNonPragmaCounter),
+
+ % The builtin modules are automatically imported.
+ get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
+ set.list_to_set(ImportDeps ++ UseDeps, ImportedModules),
+ set.init(IndirectlyImportedModules),
set.init(TypeSpecPreds),
set.init(TypeSpecForcePreds),
@@ -820,26 +853,45 @@
TypeSpecInfo = type_spec_info(TypeSpecPreds, TypeSpecForcePreds,
SpecMap, PragmaMap),
- map.init(ClassTable),
- map.init(InstanceTable),
+ map.init(NoTagTypes),
- % The builtin modules are automatically imported.
- get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
- set.list_to_set(ImportDeps ++ UseDeps, ImportedModules),
- set.init(IndirectlyImportedModules),
+ MaybeComplexityMap = no,
+ ComplexityProcInfos = [],
+ AnalysisInfo = init_analysis_info(mmc),
+ UserInitPredCNames = [],
+ UserFinalPredCNames = [],
+ map.init(StructureReuseMap),
+ UsedModules = used_modules_init,
+ set.init(InterfaceModuleSpecs),
+ ExportedEnums = [],
+ EventSet = event_set("", map.init),
+
+ ModuleSubInfo = module_sub_info(Name, Globals,
+ ContainsParConj, ContainsUserEvent, ContainsForeignType,
+ ForeignDeclInfo, ForeignBodyInfo, ForeignImportModules, FactTableFiles,
+ MaybeDependencyInfo, NumErrors, PragmaExportedProcs,
+ MustBeStratifiedPreds, StratPreds, UnusedArgInfo,
+ ExceptionInfo, TrailingInfo, TablingStructMap, MM_TablingInfo,
+ LambdasPerContext, ModelNonPragmaCounter, ImportedModules,
+ IndirectlyImportedModules, TypeSpecInfo, NoTagTypes,
+ MaybeComplexityMap, ComplexityProcInfos,
+ AnalysisInfo, UserInitPredCNames, UserFinalPredCNames,
+ StructureReuseMap, UsedModules, InterfaceModuleSpecs,
+ ExportedEnums, EventSet),
+ predicate_table_init(PredicateTable),
+ unify_proc.init_requests(Requests),
+ map.init(UnifyPredMap),
+ map.init(Types),
+ inst_table_init(Insts),
+ mode_table_init(Modes),
+ map.init(Ctors),
+ map.init(ClassTable),
+ map.init(InstanceTable),
assertion_table_init(AssertionTable),
exclusive_table_init(ExclusiveTable),
map.init(FieldNameTable),
- map.init(NoTagTypes),
- EventSet = event_set("", map.init),
- ModuleSubInfo = module_sub_info(Name, Globals, no, no, no, [], [], [], [],
- no, 0, [], [], StratPreds, UnusedArgInfo, ExceptionInfo, TrailingInfo,
- MM_TablingInfo, map.init, counter.init(1), ImportedModules,
- IndirectlyImportedModules, TypeSpecInfo, NoTagTypes, no, [],
- init_analysis_info(mmc), [], [],
- map.init, used_modules_init, set.init, [], EventSet),
ModuleInfo = module_info(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, InstanceTable, AssertionTable, ExclusiveTable,
@@ -913,6 +965,7 @@
module_info_get_unused_arg_info(MI, MI ^ sub_info ^ unused_arg_info).
module_info_get_exception_info(MI, MI ^ sub_info ^ exception_info).
module_info_get_trailing_info(MI, MI ^ sub_info ^ trailing_info).
+module_info_get_table_struct_map(MI, MI ^ sub_info ^ table_struct_map).
module_info_get_mm_tabling_info(MI, MI ^ sub_info ^ mm_tabling_info).
module_info_get_lambdas_per_context(MI, MI ^ sub_info ^ lambdas_per_context).
module_info_get_model_non_pragma_counter(MI,
@@ -1041,6 +1094,8 @@
MI ^ sub_info ^ exception_info := NewVal).
module_info_set_trailing_info(NewVal, MI,
MI ^ sub_info ^ trailing_info := NewVal).
+module_info_set_table_struct_map(NewVal, MI,
+ MI ^ sub_info ^ table_struct_map := NewVal).
module_info_set_mm_tabling_info(NewVal, MI,
MI ^ sub_info ^ mm_tabling_info := NewVal).
module_info_set_lambdas_per_context(NewVal, MI,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.429
diff -u -r1.429 hlds_out.m
--- compiler/hlds_out.m 7 Aug 2007 07:09:55 -0000 1.429
+++ compiler/hlds_out.m 9 Aug 2007 23:33:39 -0000
@@ -640,6 +640,7 @@
module_info_get_mode_table(Module, ModeTable),
module_info_get_class_table(Module, ClassTable),
module_info_get_instance_table(Module, InstanceTable),
+ module_info_get_table_struct_map(Module, TableStructMap),
module_info_get_globals(Module, Globals),
globals.lookup_accumulating_option(Globals, dump_hlds_pred_id,
DumpPredIdStrs),
@@ -679,6 +680,12 @@
io.write_string("\n", !IO)
;
true
+ ),
+ ( string.contains_char(Verbose, 'Z') ->
+ write_table_structs(Module, TableStructMap, !IO),
+ io.write_string("\n", !IO)
+ ;
+ true
)
),
write_preds(Indent, Module, PredTable, !IO),
@@ -3579,6 +3586,102 @@
%-----------------------------------------------------------------------------%
+:- pred write_table_structs(module_info::in, table_struct_map::in,
+ io::di, io::uo) is det.
+
+write_table_structs(ModuleInfo, TableStructMap, !IO) :-
+ map.to_assoc_list(TableStructMap, TableStructs),
+ io.write_string("%-------- Table structs --------\n", !IO),
+ list.foldl(write_table_struct_info(ModuleInfo), TableStructs, !IO),
+ io.nl(!IO).
+
+:- pred write_table_struct_info(module_info::in,
+ pair(pred_proc_id, table_struct_info)::in, io::di, io::uo) is det.
+
+write_table_struct_info(ModuleInfo, PredProcId - TableStructInfo, !IO) :-
+ io.nl(!IO),
+ io.write_string("% table struct info for ", !IO),
+ write_pred_proc_id(ModuleInfo, PredProcId, !IO),
+ io.nl(!IO),
+ TableStructInfo = table_struct_info(ProcTableStructInfo, Attributes),
+ ProcTableStructInfo = proc_table_struct_info(_ProcLabel, TVarSet, _Context,
+ NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, ArgInfos,
+ _EvalMethod),
+ io.format("%% #inputs: %d, #outputs: %d\n", [i(NumInputs), i(NumOutputs)],
+ !IO),
+ io.write_string("% input steps:", !IO),
+ list.foldl(write_space_and_table_trie_step(TVarSet), InputSteps, !IO),
+ io.nl(!IO),
+ (
+ MaybeOutputSteps = yes(OutputSteps),
+ io.write_string("% output steps:", !IO),
+ list.foldl(write_space_and_table_trie_step(TVarSet), OutputSteps, !IO),
+ io.nl(!IO)
+ ;
+ MaybeOutputSteps = no,
+ io.write_string("% no output steps", !IO)
+ ),
+ write_table_arg_infos(TVarSet, ArgInfos, !IO),
+
+ Attributes = table_attributes(Strictness, SizeLimit, Stats, AllowReset),
+ (
+ Strictness = all_strict,
+ io.write_string("% all strict\n", !IO)
+ ;
+ Strictness = all_fast_loose,
+ io.write_string("% all fast_loose\n", !IO)
+ ;
+ Strictness = specified(ArgMethods),
+ write_arg_tabling_methods("", ArgMethods, !IO),
+ io.write_string("% specified [", !IO),
+
+ io.write_string("]\n", !IO)
+ ),
+ (
+ SizeLimit = no,
+ io.write_string("% no size limit\n", !IO)
+ ;
+ SizeLimit = yes(Limit),
+ io.format("%% size limit %d\n", [i(Limit)], !IO)
+ ),
+ (
+ Stats = table_gather_statistics,
+ io.write_string("% gather statistics\n", !IO)
+ ;
+ Stats = table_dont_gather_statistics,
+ io.write_string("% do not gather statistics\n", !IO)
+ ),
+ (
+ AllowReset = table_allow_reset,
+ io.write_string("% allow reset\n", !IO)
+ ;
+ AllowReset = table_dont_allow_reset,
+ io.write_string("% do not allow reset\n", !IO)
+ ).
+
+:- pred write_arg_tabling_methods(string::in,
+ list(maybe(arg_tabling_method))::in, io::di, io::uo) is det.
+
+write_arg_tabling_methods(_Prefix, [], !IO).
+write_arg_tabling_methods(Prefix, [MaybeMethod | MaybeMethods], !IO) :-
+ io.write_string(Prefix, !IO),
+ (
+ MaybeMethod = no,
+ io.write_string("output", !IO)
+ ;
+ MaybeMethod = yes(arg_value),
+ io.write_string("value", !IO)
+ ;
+ MaybeMethod = yes(arg_addr),
+ io.write_string("addr", !IO)
+ ;
+ MaybeMethod = yes(arg_promise_implied),
+ io.write_string("promise_implied", !IO)
+ ),
+ write_arg_tabling_methods(", ", MaybeMethods, !IO).
+
+%-----------------------------------------------------------------------------%
+
:- pred write_procs(int::in, bool::in, module_info::in, pred_id::in,
import_status::in, pred_info::in, io::di, io::uo) is det.
@@ -3626,7 +3729,7 @@
proc_info_get_is_address_taken(Proc, IsAddressTaken),
proc_info_get_has_parallel_conj(Proc, HasParallelConj),
proc_info_get_has_user_event(Proc, HasUserEvent),
- proc_info_get_maybe_proc_table_info(Proc, MaybeProcTableInfo),
+ proc_info_get_maybe_proc_table_io_info(Proc, MaybeProcTableIOInfo),
proc_info_get_call_table_tip(Proc, MaybeCallTableTip),
proc_info_get_maybe_deep_profile_info(Proc, MaybeDeepProfileInfo),
proc_info_get_maybe_untuple_info(Proc, MaybeUntupleInfo),
@@ -3710,11 +3813,10 @@
),
(
- MaybeProcTableInfo = yes(ProcTableInfo),
- write_proc_table_info(VarSet, TVarSet, AppendVarNums, ProcTableInfo,
- !IO)
+ MaybeProcTableIOInfo = yes(ProcTableIOInfo),
+ write_proc_table_io_info(TVarSet, ProcTableIOInfo, !IO)
;
- MaybeProcTableInfo = no
+ MaybeProcTableIOInfo = no
),
(
@@ -3867,75 +3969,51 @@
%-----------------------------------------------------------------------------%
-:- pred write_proc_table_info(prog_varset::in, tvarset::in, bool::in,
- proc_table_info::in, io::di, io::uo) is det.
+:- pred write_proc_table_io_info(tvarset::in, proc_table_io_info::in,
+ io::di, io::uo) is det.
-write_proc_table_info(VarSet, TVarSet, AppendVarNums, ProcTableInfo, !IO) :-
- io.write_string("% proc table info: ", !IO),
- (
- ProcTableInfo = table_io_decl_info(ArgInfos),
- io.write_string(" io tabled\n", !IO),
- write_table_arg_infos(VarSet, TVarSet, AppendVarNums, ArgInfos, !IO)
- ;
- ProcTableInfo = table_gen_info(NumInputs, NumOutputs,
- InputSteps, MaybeOutputSteps, ArgInfos),
- io.format("#inputs: %d, #outputs: %d\n", [i(NumInputs), i(NumOutputs)],
- !IO),
- io.write_string("% input steps:", !IO),
- list.foldl(write_space_and_table_trie_step(TVarSet, AppendVarNums),
- InputSteps, !IO),
- io.nl(!IO),
- (
- MaybeOutputSteps = yes(OutputSteps),
- io.write_string("% output steps:", !IO),
- list.foldl(write_space_and_table_trie_step(TVarSet, AppendVarNums),
- OutputSteps, !IO),
- io.nl(!IO)
- ;
- MaybeOutputSteps = no,
- io.write_string("% no output steps", !IO)
- ),
- write_table_arg_infos(VarSet, TVarSet, AppendVarNums, ArgInfos, !IO)
- ).
+write_proc_table_io_info(TVarSet, ProcTableIOInfo, !IO) :-
+ ProcTableIOInfo = proc_table_io_info(ArgInfos),
+ io.write_string("% proc table io info: io tabled\n", !IO),
+ write_table_arg_infos(TVarSet, ArgInfos, !IO).
-:- pred write_table_arg_infos(prog_varset::in, tvarset::in, bool::in,
- table_arg_infos::in, io::di, io::uo) is det.
+:- pred write_table_arg_infos(tvarset::in, table_arg_infos::in,
+ io::di, io::uo) is det.
-write_table_arg_infos(VarSet, TVarSet, AppendVarNums, TableArgInfos, !IO) :-
+write_table_arg_infos(TVarSet, TableArgInfos, !IO) :-
TableArgInfos = table_arg_infos(ArgInfos, TVarMap),
io.write_string("% arg infos:\n", !IO),
- list.foldl(write_table_arg_info(VarSet, TVarSet, AppendVarNums), ArgInfos,
- !IO),
+ list.foldl(write_table_arg_info(TVarSet), ArgInfos, !IO),
map.to_assoc_list(TVarMap, TVarPairs),
(
TVarPairs = []
;
TVarPairs = [_ | _],
io.write_string("% type var map:\n", !IO),
- list.foldl(write_table_tvar_map_entry(TVarSet, AppendVarNums),
- TVarPairs, !IO)
+ list.foldl(write_table_tvar_map_entry(TVarSet), TVarPairs, !IO)
).
-:- pred write_table_arg_info(prog_varset::in, tvarset::in, bool::in,
- table_arg_info::in, io::di, io::uo) is det.
+:- pred write_table_arg_info(tvarset::in, table_arg_info::in, io::di, io::uo)
+ is det.
-write_table_arg_info(VarSet, TVarSet, AppendVarNums, ArgInfo, !IO) :-
- ArgInfo = table_arg_info(HeadVar, SlotNum, Type),
+write_table_arg_info(TVarSet, ArgInfo, !IO) :-
+ ArgInfo = table_arg_info(HeadVarNum, HeadVarName, SlotNum, Type),
io.write_string("% ", !IO),
- HeadVarStr = mercury_var_to_string(VarSet, AppendVarNums, HeadVar),
- io.write_string(HeadVarStr, !IO),
+ io.write_string(HeadVarName, !IO),
+ io.write_string("/", !IO),
+ io.write_int(HeadVarNum, !IO),
io.write_string(" in slot ", !IO),
io.write_int(SlotNum, !IO),
io.write_string(", type ", !IO),
- io.write_string(mercury_type_to_string(TVarSet, AppendVarNums, Type), !IO),
+ io.write_string(mercury_type_to_string(TVarSet, yes, Type), !IO),
io.nl(!IO).
-:- pred write_table_tvar_map_entry(tvarset::in, bool::in,
+:- pred write_table_tvar_map_entry(tvarset::in,
pair(tvar, table_locn)::in, io::di, io::uo) is det.
-write_table_tvar_map_entry(TVarSet, AppendVarNums, TVar - Locn, !IO) :-
+write_table_tvar_map_entry(TVarSet, TVar - Locn, !IO) :-
io.write_string("% typeinfo for ", !IO),
- io.write_string(mercury_var_to_string(TVarSet, AppendVarNums, TVar), !IO),
+ io.write_string(mercury_var_to_string(TVarSet, yes, TVar), !IO),
io.write_string(" -> ", !IO),
(
Locn = table_locn_direct(N),
@@ -3945,37 +4023,31 @@
io.format("indirect from register %d, offset %d\n", [i(N), i(O)], !IO)
).
-:- pred write_space_and_table_trie_step(tvarset::in, bool::in,
+:- pred write_space_and_table_trie_step(tvarset::in,
table_trie_step::in, io::di, io::uo) is det.
-write_space_and_table_trie_step(TVarSet, AppendVarNums, TrieStep, !IO) :-
+write_space_and_table_trie_step(TVarSet, TrieStep, !IO) :-
io.write_string(" ", !IO),
- io.write_string(table_trie_step_desc(TVarSet, AppendVarNums, TrieStep),
- !IO).
+ io.write_string(table_trie_step_desc(TVarSet, TrieStep), !IO).
-:- func table_trie_step_desc(tvarset, bool, table_trie_step) = string.
+:- func table_trie_step_desc(tvarset, table_trie_step) = string.
-table_trie_step_desc(_, _, table_trie_step_int) = "int".
-table_trie_step_desc(_, _, table_trie_step_char) = "char".
-table_trie_step_desc(_, _, table_trie_step_string) = "string".
-table_trie_step_desc(_, _, table_trie_step_float) = "float".
-table_trie_step_desc(_, _, table_trie_step_dummy) = "dummy".
-table_trie_step_desc(_, _, table_trie_step_enum(N)) =
- "enum(" ++ int_to_string(N) ++ ")".
-table_trie_step_desc(TVarSet, AppendVarNums,
- table_trie_step_user(Type)) =
- "user(" ++ mercury_type_to_string(TVarSet, AppendVarNums, Type) ++ ")".
-table_trie_step_desc(TVarSet, AppendVarNums,
- table_trie_step_user_fast_loose(Type)) =
- "user_fast_loose(" ++ mercury_type_to_string(TVarSet, AppendVarNums, Type)
- ++ ")".
-table_trie_step_desc(_, _, table_trie_step_poly) = "poly".
-table_trie_step_desc(_, _, table_trie_step_poly_fast_loose) =
- "poly_fast_loose".
-table_trie_step_desc(_, _, table_trie_step_typeinfo) = "typeinfo".
-table_trie_step_desc(_, _, table_trie_step_typeclassinfo) = "typeclassinfo".
-table_trie_step_desc(_, _, table_trie_step_promise_implied) =
- "promise_implied".
+table_trie_step_desc(_, table_trie_step_int) = "int".
+table_trie_step_desc(_, table_trie_step_char) = "char".
+table_trie_step_desc(_, table_trie_step_string) = "string".
+table_trie_step_desc(_, table_trie_step_float) = "float".
+table_trie_step_desc(_, table_trie_step_dummy) = "dummy".
+table_trie_step_desc(_, table_trie_step_enum(N)) =
+ "enum(" ++ int_to_string(N) ++ ")".
+table_trie_step_desc(TVarSet, table_trie_step_user(Type)) =
+ "user(" ++ mercury_type_to_string(TVarSet, yes, Type) ++ ")".
+table_trie_step_desc(TVarSet, table_trie_step_user_fast_loose(Type)) =
+ "user_fast_loose(" ++ mercury_type_to_string(TVarSet, yes, Type) ++ ")".
+table_trie_step_desc(_, table_trie_step_poly) = "poly".
+table_trie_step_desc(_, table_trie_step_poly_fast_loose) = "poly_fast_loose".
+table_trie_step_desc(_, table_trie_step_typeinfo) = "typeinfo".
+table_trie_step_desc(_, table_trie_step_typeclassinfo) = "typeclassinfo".
+table_trie_step_desc(_, table_trie_step_promise_implied) = "promise_implied".
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.229
diff -u -r1.229 hlds_pred.m
--- compiler/hlds_pred.m 7 Aug 2007 07:09:55 -0000 1.229
+++ compiler/hlds_pred.m 9 Aug 2007 23:24:19 -0000
@@ -1707,9 +1707,16 @@
% MR_ProcStatic structures.
).
+:- type table_arg_infos
+ ---> table_arg_infos(
+ list(table_arg_info),
+ map(tvar, table_locn)
+ ).
+
:- type table_arg_info
---> table_arg_info(
- headvar :: prog_var,
+ orig_var_num :: int,
+ orig_var_name :: string,
slot_num :: int,
arg_type :: mer_type
).
@@ -1742,37 +1749,56 @@
; table_trie_step_typeclassinfo
; table_trie_step_promise_implied.
-:- type table_arg_infos
- ---> table_arg_infos(
- list(table_arg_info),
- map(tvar, table_locn)
- ).
-
-:- type proc_table_info
- ---> table_io_decl_info(
+:- type proc_table_io_info
+ ---> proc_table_io_info(
% The information we need to display an I/O action to the user.
%
- % The table_arg_type_infos correspond one to one to the
- % elements of the block saved for an I/O action. The first
- % element will be the pointer to the proc_layout of the
- % action's procedure.
+ % The table_arg_infos correspond one to one to the elements
+ % of the block saved for an I/O action. The first element
+ % will be the pointer to the proc_layout of the action's
+ % procedure.
+ %
+ % The right tvarset for interpreting the types in the
+ % table_arg_infos is the one in the proc_info in which
+ % the proc_table_io_info is stored.
table_arg_infos
- )
- ; table_gen_info(
- % The information we need to interpret the data structures
- % created by tabling for a procedure, except the information
- % (such as determinism) that is already available from
- % proc_layout structures.
+ ).
+
+:- type proc_table_struct_info
+ ---> proc_table_struct_info(
+ % The information we need to create the data structures
+ % created by tabling for a procedure, and to interpret them
+ % for the debugger (except the information -such as
+ % determinism- that is already available from proc_layout
+ % structures.
%
- % The table_arg_type_infos list first all the input arguments,
+ % The table_arg_infos list first all the input arguments,
% then all the output arguments.
-
- num_inputs :: int,
- num_outputs :: int,
- input_steps :: list(table_trie_step),
- maybe_output_steps :: maybe(list(table_trie_step)),
- gen_arg_infos :: table_arg_infos
+ %
+ % The right tvarset for interpreting the types in the
+ % table_arg_infos is the one stored below. It is taken from
+ % the proc_info of the procedure whose table this structure
+ % describes. Since we care only about the shapes of the types,
+ % we don't care about neither the actual numerical values
+ % nor the names of the type variables, so we don't care if
+ % the tvarset in that proc_info changes after table_gen.m
+ % takes the snapshot stored here.
+ %
+ % We record the rtti_proc_label of the procedure whose table
+ % this is. We can't record its identity in the form of a
+ % pred_proc_id, since that won't work if the procedure is
+ % deleted before the code generation phase.
+
+ ptsi_proc_label :: rtti_proc_label,
+ ptsi_tvarset :: tvarset,
+ ptsi_context :: prog_context,
+ ptsi_num_inputs :: int,
+ ptsi_num_outputs :: int,
+ ptsi_input_steps :: list(table_trie_step),
+ ptsi_maybe_output_steps :: maybe(list(table_trie_step)),
+ ptsi_gen_arg_infos :: table_arg_infos,
+ ptsi_eval_method :: eval_method
).
:- type special_proc_return
@@ -1843,8 +1869,8 @@
:- pred proc_info_get_has_parallel_conj(proc_info::in, bool::out) is det.
:- pred proc_info_get_call_table_tip(proc_info::in,
maybe(prog_var)::out) is det.
-:- pred proc_info_get_maybe_proc_table_info(proc_info::in,
- maybe(proc_table_info)::out) is det.
+:- pred proc_info_get_maybe_proc_table_io_info(proc_info::in,
+ maybe(proc_table_io_info)::out) is det.
:- pred proc_info_get_table_attributes(proc_info::in,
maybe(table_attributes)::out) is det.
:- pred proc_info_get_maybe_special_return(proc_info::in,
@@ -1902,7 +1928,7 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_call_table_tip(maybe(prog_var)::in,
proc_info::in, proc_info::out) is det.
-:- pred proc_info_set_maybe_proc_table_info(maybe(proc_table_info)::in,
+:- pred proc_info_set_maybe_proc_table_io_info(maybe(proc_table_io_info)::in,
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_table_attributes(maybe(table_attributes)::in,
proc_info::in, proc_info::out) is det.
@@ -2204,18 +2230,19 @@
% accessible to the debugger, if debugging is enabled.
call_table_tip :: maybe(prog_var),
- % If set, it means that procedure has been subject to a tabling
- % transformation, either I/O tabling or the regular kind.
- % In the former case, the argument will contain all the
+ % If set, it means that procedure has been subject to the I/O
+ % tabling transformation. The argument will contain all the
% information we need to display I/O actions involving
- % this procedure; in the latter case, it will contain
- % all the information we need to display the call tables,
- % answer tables and answer blocks of the procedure.
+ % this procedure.
+ %
+ % (If the procedure has been subject to other kinds of tabling
+ % transformations, the corresponding information will be
+ % recorded in a map in the module_info.)
% XXX For now, the compiler fully supports only procedures
% whose arguments are all either ints, floats or strings.
% However, this is still sufficient for debugging most problems
% in the tabling system.
- maybe_table_info :: maybe(proc_table_info),
+ maybe_table_io_info :: maybe(proc_table_io_info),
table_attributes :: maybe(table_attributes),
@@ -2401,7 +2428,8 @@
proc_info_get_has_parallel_conj(PI,
PI ^ proc_sub_info ^ proc_has_parallel_conj).
proc_info_get_call_table_tip(PI, PI ^ proc_sub_info ^ call_table_tip).
-proc_info_get_maybe_proc_table_info(PI, PI ^ proc_sub_info ^ maybe_table_info).
+proc_info_get_maybe_proc_table_io_info(PI,
+ PI ^ proc_sub_info ^ maybe_table_io_info).
proc_info_get_table_attributes(PI, PI ^ proc_sub_info ^ table_attributes).
proc_info_get_maybe_special_return(PI,
PI ^ proc_sub_info ^ maybe_special_return).
@@ -2441,8 +2469,8 @@
PI ^ proc_sub_info ^ proc_has_parallel_conj := HPC).
proc_info_set_call_table_tip(CTT, PI,
PI ^ proc_sub_info ^ call_table_tip := CTT).
-proc_info_set_maybe_proc_table_info(MTI, PI,
- PI ^ proc_sub_info ^ maybe_table_info := MTI).
+proc_info_set_maybe_proc_table_io_info(MTI, PI,
+ PI ^ proc_sub_info ^ maybe_table_io_info := MTI).
proc_info_set_table_attributes(TA, PI,
PI ^ proc_sub_info ^ table_attributes := TA).
proc_info_set_maybe_special_return(MSR, PI,
Index: compiler/hlds_rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_rtti.m,v
retrieving revision 1.11
diff -u -r1.11 hlds_rtti.m
--- compiler/hlds_rtti.m 1 Dec 2006 15:04:00 -0000 1.11
+++ compiler/hlds_rtti.m 9 Aug 2007 09:05:58 -0000
@@ -17,6 +17,7 @@
:- module hlds.hlds_rtti.
:- interface.
+:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
@@ -82,6 +83,15 @@
proc_is_imported :: bool
).
+ % Construct an rtti_proc_label for a given procedure.
+ %
+:- func make_rtti_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
+
+ % The inverse of make_rtti_proc_label.
+ %
+:- pred proc_label_pred_proc_id(rtti_proc_label::in,
+ pred_id::out, proc_id::out) is det.
+
%-----------------------------------------------------------------------------%
%
% Types and predicates to store information about RTTI.
@@ -310,13 +320,61 @@
:- implementation.
+:- import_module check_hlds.mode_util.
:- import_module libs.compiler_util.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_subst.
+:- import_module pair.
:- import_module solutions.
:- import_module svmap.
:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+make_rtti_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
+ module_info_get_name(ModuleInfo, ThisModule),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredModule = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
+ Arity = pred_info_orig_arity(PredInfo),
+ pred_info_get_arg_types(PredInfo, ArgTypes),
+ proc_info_get_varset(ProcInfo, ProcVarSet),
+ proc_info_get_headvars(ProcInfo, ProcHeadVars),
+ proc_info_get_argmodes(ProcInfo, ProcModes),
+ proc_info_interface_determinism(ProcInfo, ProcDetism),
+ modes_to_arg_modes(ModuleInfo, ProcModes, ArgTypes, ProcArgModes),
+ PredIsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
+ PredIsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
+ ProcIsExported = (procedure_is_exported(ModuleInfo, PredInfo, ProcId)
+ -> yes ; no),
+ pred_info_get_origin(PredInfo, Origin),
+ ProcHeadVarsWithNames = list.map((func(Var) = Var - Name :-
+ Name = varset.lookup_name(ProcVarSet, Var)
+ ), ProcHeadVars),
+ (
+ (
+ PredIsImported = yes
+ ;
+ PredIsPseudoImp = yes,
+ hlds_pred.in_in_unification_proc_id(ProcId)
+ )
+ ->
+ ProcIsImported = yes
+ ;
+ ProcIsImported = no
+ ),
+ ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
+ PredName, Arity, ArgTypes, PredId, ProcId,
+ ProcHeadVarsWithNames, ProcArgModes, ProcDetism,
+ PredIsImported, PredIsPseudoImp, Origin,
+ ProcIsExported, ProcIsImported).
+
+proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
+ PredId = ProcLabel ^ pred_id,
+ ProcId = ProcLabel ^ proc_id.
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.447
diff -u -r1.447 mercury_compile.m
--- compiler/mercury_compile.m 8 Aug 2007 16:41:20 -0000 1.447
+++ compiler/mercury_compile.m 9 Aug 2007 06:23:30 -0000
@@ -2701,13 +2701,14 @@
maybe_dump_hlds(!.HLDS, 305, "args_to_regs", !DumpInfo, !IO),
globals.io_lookup_bool_option(trad_passes, TradPasses, !IO),
+ add_all_tabling_info_structs(!.HLDS, GlobalData0, GlobalData1),
(
TradPasses = no,
- backend_pass_by_phases(!HLDS, GlobalData0, GlobalData, LLDS, !DumpInfo,
+ backend_pass_by_phases(!HLDS, GlobalData1, GlobalData, LLDS, !DumpInfo,
!IO)
;
TradPasses = yes,
- backend_pass_by_preds(!HLDS, GlobalData0, GlobalData, LLDS, !IO)
+ backend_pass_by_preds(!HLDS, GlobalData1, GlobalData, LLDS, !IO)
).
%-----------------------------------------------------------------------------%
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.202
diff -u -r1.202 ml_code_gen.m
--- compiler/ml_code_gen.m 7 Aug 2007 07:09:58 -0000 1.202
+++ compiler/ml_code_gen.m 9 Aug 2007 09:17:17 -0000
@@ -912,8 +912,9 @@
ml_gen_defns(ModuleInfo, Defns, !IO) :-
ml_gen_types(ModuleInfo, TypeDefns, !IO),
+ ml_gen_table_structs(ModuleInfo, TableStructDefns),
ml_gen_preds(ModuleInfo, PredDefns, !IO),
- Defns = list.append(TypeDefns, PredDefns).
+ Defns = TypeDefns ++ TableStructDefns ++ PredDefns.
%-----------------------------------------------------------------------------%
%
@@ -1026,64 +1027,56 @@
DeclFlags = ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId),
ml_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcDefnBody, ExtraDefns),
ProcDefn = mlds_defn(Name, MLDS_Context, DeclFlags, ProcDefnBody),
- !:Defns = list.append(ExtraDefns, [ProcDefn | !.Defns]),
- ml_gen_maybe_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, !Defns).
+ !:Defns = list.append(ExtraDefns, [ProcDefn | !.Defns]).
-:- pred ml_gen_maybe_add_table_var(module_info::in, pred_id::in, proc_id::in,
- proc_info::in, mlds_defns::in, mlds_defns::out) is det.
+%-----------------------------------------------------------------------------%
+%
+% Code for handling tabling structures
+%
-ml_gen_maybe_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, !Defns) :-
- proc_info_get_eval_method(ProcInfo, EvalMethod),
- HasTablingPointer = eval_method_has_per_proc_tabling_pointer(EvalMethod),
+:- pred ml_gen_table_structs(module_info::in, mlds_defns::out) is det.
+
+ml_gen_table_structs(ModuleInfo, Defns) :-
+ module_info_get_table_struct_map(ModuleInfo, TableStructMap),
+ map.to_assoc_list(TableStructMap, TableStructs),
(
- HasTablingPointer = yes,
- ml_gen_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, EvalMethod,
- !Defns)
+ TableStructs = [],
+ Defns = []
;
- HasTablingPointer = no
- ).
-
-:- pred ml_gen_add_table_var(module_info::in, pred_id::in, proc_id::in,
- proc_info::in, eval_method::in, mlds_defns::in, mlds_defns::out) is det.
+ TableStructs = [_ | _],
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_gc_method(Globals, GC_Method),
+ % XXX To handle accurate GC properly, the GC would need to trace
+ % through the global variables that we generate for the tables.
+ % Support for this is not yet implemented. Also, we would need to add
+ % GC support (stack frame registration, and calls to MR_GC_check()) to
+ % MR_make_long_lived() and MR_deep_copy() so that we do garbage
+ % collection of the "global heap" which is used to store the tables.
+ expect(isnt(unify(gc_accurate), GC_Method), this_file,
+ "tabling and `--gc accurate'"),
+
+ list.foldl(ml_gen_add_table_var(ModuleInfo), TableStructs, [], Defns)
+ ).
+
+:- pred ml_gen_add_table_var(module_info::in,
+ pair(pred_proc_id, table_struct_info)::in,
+ mlds_defns::in, mlds_defns::out) is det.
-ml_gen_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, EvalMethod,
- !Defns) :-
+ml_gen_add_table_var(ModuleInfo, PredProcId - TableStructInfo, !Defns) :-
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, _PredModule),
- ProcLabel = mlds_proc_label(PredLabel, ProcId),
- proc_info_get_context(ProcInfo, Context),
- MLDS_Context = mlds_make_context(Context),
+ PredProcId = proc(_PredId, ProcId),
- module_info_get_globals(ModuleInfo, Globals),
- globals.get_gc_method(Globals, GC_Method),
- % XXX To handle accurate GC properly, the GC would need to trace through
- % the global variable that we generate for the table pointer. Support
- % for this is not yet implemented. Also, we would need to add GC support
- % (stack frame registration, and calls to MR_GC_check()) to
- % MR_make_long_lived() and MR_deep_copy() so that we do garbage collection
- % of the "global heap" which is used to store the tables.
- expect(isnt(unify(gc_accurate), GC_Method), this_file,
- "tabling and `--gc accurate'"),
+ TableStructInfo = table_struct_info(ProcTableStructInfo, _Attributes),
+ ProcTableStructInfo = proc_table_struct_info(RttiProcLabel, _TVarSet,
+ Context, NumInputs, NumOutputs, InputSteps, MaybeOutputSteps,
+ _ArgInfos, EvalMethod),
+ ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel, PredLabel,
+ _PredModule),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ MLDS_Context = mlds_make_context(Context),
TableTypeStr = eval_method_to_table_type(EvalMethod),
- proc_info_get_maybe_proc_table_info(ProcInfo, MaybeTableInfo),
- (
- MaybeTableInfo = yes(TableInfo),
- (
- % The _ArgInfos argument is intended for the debugger,
- % which isn't supported by the this backend.
- TableInfo = table_gen_info(NumInputs, NumOutputs,
- InputSteps, MaybeOutputSteps, _ArgInfos)
- ;
- TableInfo = table_io_decl_info(_),
- unexpected(this_file, "ml_gen_add_table_var: bad TableInfo")
- )
- ;
- MaybeTableInfo = no,
- unexpected(this_file, "ml_gen_add_table_var: no TableInfo")
- ),
-
(
InputSteps = [],
% We don't want to generate arrays with zero elements.
@@ -1296,6 +1289,11 @@
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
+%-----------------------------------------------------------------------------%
+%
+% Code for handling individual procedures (continued)
+%
+
% Return the declaration flags appropriate for a procedure definition.
%
:- func ml_gen_proc_decl_flags(module_info, pred_id, proc_id)
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.123
diff -u -r1.123 ml_code_util.m
--- compiler/ml_code_util.m 7 Aug 2007 07:09:59 -0000 1.123
+++ compiler/ml_code_util.m 9 Aug 2007 09:12:57 -0000
@@ -1315,7 +1315,7 @@
% Generate the mlds_pred_label and module name for a given procedure.
%
ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, MLDS_Module) :-
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel,
MLDS_PredLabel, MLDS_Module).
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.62
diff -u -r1.62 optimize.m
--- compiler/optimize.m 23 Jan 2007 07:00:38 -0000 1.62
+++ compiler/optimize.m 9 Aug 2007 07:19:46 -0000
@@ -81,7 +81,7 @@
global_data_maybe_get_proc_layout(GlobalData,
PredProcId, ProcLayout)
->
- LabelMap = ProcLayout ^ internal_map,
+ LabelMap = ProcLayout ^ pli_internal_map,
map.sorted_keys(LabelMap, LayoutLabelNums),
LayoutLabels = list.map(
make_internal_label_for_proc_label(ProcLabel),
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.21
diff -u -r1.21 proc_gen.m
--- compiler/proc_gen.m 7 Aug 2007 07:10:03 -0000 1.21
+++ compiler/proc_gen.m 9 Aug 2007 09:16:49 -0000
@@ -60,6 +60,12 @@
%
:- func push_msg(module_info, pred_id, proc_id) = string.
+ % Add all the global variables required for tabling by the procedures
+ % of the module.
+ %
+:- pred add_all_tabling_info_structs(module_info::in,
+ global_data::in, global_data::out) is det.
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -74,6 +80,7 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
:- import_module libs.globals.
@@ -383,14 +390,14 @@
Instructions = Instructions0
),
- proc_info_get_maybe_proc_table_info(ProcInfo, MaybeTableInfo),
+ proc_info_get_maybe_proc_table_io_info(ProcInfo, MaybeTableIOInfo),
(
( BasicStackLayout = yes
- ; MaybeTableInfo = yes(table_io_decl_info(_TableIoDeclInfo))
+ ; MaybeTableIOInfo = yes(_TableIODeclInfo)
)
->
% Create the procedure layout structure.
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
code_info.get_layout_info(CodeInfo, InternalMap),
EntryLabel = make_local_entry_label(ModuleInfo, PredId, ProcId, no),
proc_info_get_eval_method(ProcInfo, EvalMethod),
@@ -423,6 +430,26 @@
),
EffTraceLevel = eff_trace_level(ModuleInfo, PredInfo, ProcInfo,
TraceLevel),
+ module_info_get_table_struct_map(ModuleInfo, TableStructMap),
+ PredProcId = proc(PredId, ProcId),
+ (
+ MaybeTableIOInfo = no,
+ ( map.search(TableStructMap, PredProcId, TableStructInfo) ->
+ TableStructInfo = table_struct_info(ProcTableStructInfo,
+ _Attributes),
+ MaybeTableInfo = yes(proc_table_struct(ProcTableStructInfo))
+ ;
+ MaybeTableInfo = no
+ )
+ ;
+ MaybeTableIOInfo = yes(TableIOInfo),
+ ( map.search(TableStructMap, PredProcId, _TableStructInfo) ->
+ unexpected(this_file,
+ "generate_proc_code: conflicting kinds of tabling")
+ ;
+ MaybeTableInfo = yes(proc_table_io_decl(TableIOInfo))
+ )
+ ),
ProcLayout = proc_layout_info(RttiProcLabel, EntryLabel,
Detism, TotalSlots, MaybeSuccipSlot, EvalMethod,
EffTraceLevel, MaybeTraceCallLabel, MaxTraceReg,
@@ -439,8 +466,6 @@
code_info.get_closure_layouts(CodeInfo, ClosureLayouts),
global_data_add_new_closure_layouts(ClosureLayouts, !GlobalData),
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
- maybe_add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo,
- ProcLabel, !GlobalData),
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
@@ -546,65 +571,6 @@
OldOutermostSlotNum),
DeepProfInfo = proc_layout_proc_static(HLDSProcStatic, DeepExcpSlots).
-:- pred maybe_add_tabling_info_struct(module_info::in,
- pred_id::in, proc_id::in, proc_info::in, proc_label::in,
- global_data::in, global_data::out) is det.
-
-maybe_add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
- !GlobalData) :-
- proc_info_get_eval_method(ProcInfo, EvalMethod),
- HasTablingPointer = eval_method_has_per_proc_tabling_pointer(EvalMethod),
- (
- HasTablingPointer = yes,
- add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo,
- ProcLabel, EvalMethod, !GlobalData)
- ;
- HasTablingPointer = no
- ).
-
-:- pred add_tabling_info_struct(module_info::in, pred_id::in, proc_id::in,
- proc_info::in, proc_label::in, eval_method::in,
- global_data::in, global_data::out) is det.
-
-add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
- EvalMethod, !GlobalData) :-
- proc_info_get_maybe_proc_table_info(ProcInfo, MaybeTableInfo),
- (
- MaybeTableInfo = yes(TableInfo),
- (
- TableInfo = table_gen_info(NumInputs, NumOutputs,
- InputSteps, MaybeOutputSteps, ArgInfos)
- ;
- TableInfo = table_io_decl_info(_),
- unexpected(this_file, "add_tabling_info_struct: bad TableInfo")
- )
- ;
- MaybeTableInfo = no,
- unexpected(this_file, "add_tabling_info_struct: no TableInfo")
- ),
- global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
- convert_table_arg_info(ArgInfos, NumPTIs, PTIVectorRval,
- TVarVectorRval, StaticCellInfo0, StaticCellInfo),
- global_data_set_static_cell_info(StaticCellInfo, !GlobalData),
- NumArgs = NumInputs + NumOutputs,
- expect(unify(NumArgs, NumPTIs), this_file,
- "add_tabling_info_struct: args mismatch"),
-
- module_info_get_name(ModuleInfo, ModuleName),
- proc_info_get_table_attributes(ProcInfo, MaybeAttributes),
- (
- MaybeAttributes = yes(Attributes)
- ;
- MaybeAttributes = no,
- Attributes = default_memo_table_attributes
- ),
- MaybeSizeLimit = Attributes ^ table_attr_size_limit,
- Statistics = Attributes ^ table_attr_statistics,
- Var = tabling_info_struct(ModuleName, ProcLabel, EvalMethod,
- NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, PTIVectorRval,
- TVarVectorRval, MaybeSizeLimit, Statistics),
- global_data_add_new_proc_var(proc(PredId, ProcId), Var, !GlobalData).
-
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -1329,6 +1295,40 @@
string.append_list([TypeCtorName, "_", ArityStr], TypeName).
%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+add_all_tabling_info_structs(ModuleInfo, !GlobalData) :-
+ module_info_get_table_struct_map(ModuleInfo, TableStructMap),
+ map.to_assoc_list(TableStructMap, TableStructs),
+ list.foldl(add_tabling_info_struct, TableStructs, !GlobalData).
+
+:- pred add_tabling_info_struct(pair(pred_proc_id, table_struct_info)::in,
+ global_data::in, global_data::out) is det.
+
+add_tabling_info_struct(PredProcId - TableStructInfo, !GlobalData) :-
+ TableStructInfo = table_struct_info(ProcTableStructInfo, TableAttributes),
+ ProcTableStructInfo = proc_table_struct_info(RttiProcLabel, _TVarSet,
+ _Context, NumInputs, NumOutputs, InputSteps, MaybeOutputSteps,
+ ArgInfos, EvalMethod),
+
+ global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
+ convert_table_arg_info(ArgInfos, NumPTIs, PTIVectorRval,
+ TVarVectorRval, StaticCellInfo0, StaticCellInfo),
+ global_data_set_static_cell_info(StaticCellInfo, !GlobalData),
+ NumArgs = NumInputs + NumOutputs,
+ expect(unify(NumArgs, NumPTIs), this_file,
+ "add_tabling_info_struct: args mismatch"),
+
+ MaybeSizeLimit = TableAttributes ^ table_attr_size_limit,
+ Statistics = TableAttributes ^ table_attr_statistics,
+ ModuleName = RttiProcLabel ^ proc_module,
+ ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
+ Var = tabling_info_struct(ModuleName, ProcLabel, EvalMethod,
+ NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, PTIVectorRval,
+ TVarVectorRval, MaybeSizeLimit, Statistics),
+ global_data_add_new_proc_var(PredProcId, Var, !GlobalData).
+
+%---------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/proc_label.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_label.m,v
retrieving revision 1.23
diff -u -r1.23 proc_label.m
--- compiler/proc_label.m 2 Oct 2006 05:21:20 -0000 1.23
+++ compiler/proc_label.m 9 Aug 2007 09:09:27 -0000
@@ -111,7 +111,7 @@
).
make_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
- RttiProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
make_proc_label_from_rtti(RttiProcLabel) = ProcLabel.
make_user_proc_label(ThisModule, PredIsImported, PredOrFunc, PredModule,
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.82
diff -u -r1.82 rtti.m
--- compiler/rtti.m 1 Jun 2007 04:12:50 -0000 1.82
+++ compiler/rtti.m 9 Aug 2007 09:04:31 -0000
@@ -28,7 +28,6 @@
:- import_module hlds.
:- import_module hlds.hlds_data.
-:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module mdbcomp.
@@ -695,15 +694,6 @@
:- func ctor_rtti_name_is_exported(ctor_rtti_name) = bool.
:- func tc_rtti_name_is_exported(tc_rtti_name) = bool.
- % Construct an rtti_proc_label for a given procedure.
- %
-:- func make_rtti_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
-
- % The inverse of make_rtti_proc_label.
- %
-:- pred proc_label_pred_proc_id(rtti_proc_label::in,
- pred_id::out, proc_id::out) is det.
-
% Return the C variable name of the RTTI data structure identified
% by the input argument.
%
@@ -1121,49 +1111,6 @@
pseudo_type_info_is_exported(var_arity_pseudo_type_info(_, _)) = no.
pseudo_type_info_is_exported(type_var(_)) = no.
-make_rtti_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
- module_info_get_name(ModuleInfo, ThisModule),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- PredModule = pred_info_module(PredInfo),
- PredName = pred_info_name(PredInfo),
- Arity = pred_info_orig_arity(PredInfo),
- pred_info_get_arg_types(PredInfo, ArgTypes),
- proc_info_get_varset(ProcInfo, ProcVarSet),
- proc_info_get_headvars(ProcInfo, ProcHeadVars),
- proc_info_get_argmodes(ProcInfo, ProcModes),
- proc_info_interface_determinism(ProcInfo, ProcDetism),
- modes_to_arg_modes(ModuleInfo, ProcModes, ArgTypes, ProcArgModes),
- PredIsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
- PredIsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
- ProcIsExported = (procedure_is_exported(ModuleInfo, PredInfo, ProcId)
- -> yes ; no),
- pred_info_get_origin(PredInfo, Origin),
- ProcHeadVarsWithNames = list.map((func(Var) = Var - Name :-
- Name = varset.lookup_name(ProcVarSet, Var)
- ), ProcHeadVars),
- (
- (
- PredIsImported = yes
- ;
- PredIsPseudoImp = yes,
- hlds_pred.in_in_unification_proc_id(ProcId)
- )
- ->
- ProcIsImported = yes
- ;
- ProcIsImported = no
- ),
- ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
- PredName, Arity, ArgTypes, PredId, ProcId,
- ProcHeadVarsWithNames, ProcArgModes, ProcDetism,
- PredIsImported, PredIsPseudoImp, Origin,
- ProcIsExported, ProcIsImported).
-
-proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
- PredId = ProcLabel ^ pred_id,
- ProcId = ProcLabel ^ proc_id.
-
id_to_c_identifier(ctor_rtti_id(RttiTypeCtor, RttiName), Str) :-
Str = name_to_string(RttiTypeCtor, RttiName).
id_to_c_identifier(tc_rtti_id(TCName, TCRttiName), Str) :-
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.136
diff -u -r1.136 stack_layout.m
--- compiler/stack_layout.m 31 Jul 2007 01:56:41 -0000 1.136
+++ compiler/stack_layout.m 9 Aug 2007 07:27:50 -0000
@@ -198,7 +198,7 @@
:- pred valid_proc_layout(proc_layout_info::in) is semidet.
valid_proc_layout(ProcLayoutInfo) :-
- EntryLabel = ProcLayoutInfo ^ entry_label,
+ EntryLabel = ProcLayoutInfo ^ pli_entry_label,
ProcLabel = get_proc_label(EntryLabel),
(
ProcLabel = ordinary_proc_label(_, _, DeclModule, Name, Arity, _),
@@ -567,7 +567,7 @@
eval_method::in, trace_level::in, maybe(label)::in, int::in,
list(prog_var)::in, list(mer_mode)::in,
trace_slot_info::in, prog_varset::in, vartypes::in,
- maybe(proc_table_info)::in, bool::in, var_num_map::in,
+ maybe(proc_layout_table_info)::in, bool::in, var_num_map::in,
list(internal_label_info)::in, proc_layout_exec_trace::out,
stack_layout_info::in, stack_layout_info::out) is det.
@@ -609,10 +609,10 @@
;
MaybeTableInfo = yes(TableInfo),
(
- TableInfo = table_io_decl_info(_),
+ TableInfo = proc_table_io_decl(_),
MaybeTableDataAddr = yes(layout_addr(table_io_decl(RttiProcLabel)))
;
- TableInfo = table_gen_info(_, _, _, _, _),
+ TableInfo = proc_table_struct(_),
module_info_get_name(ModuleInfo, ModuleName),
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
MaybeTableDataAddr = yes(data_addr(ModuleName,
@@ -1370,22 +1370,22 @@
%---------------------------------------------------------------------------%
:- pred make_table_data(rtti_proc_label::in,
- proc_layout_kind::in, proc_table_info::in, maybe(layout_data)::out,
+ proc_layout_kind::in, proc_layout_table_info::in, maybe(layout_data)::out,
static_cell_info::in, static_cell_info::out) is det.
make_table_data(RttiProcLabel, Kind, TableInfo, MaybeTableData,
!StaticCellInfo) :-
(
- TableInfo = table_io_decl_info(TableArgInfo),
- convert_table_arg_info(TableArgInfo, NumPTIs, PTIVectorRval,
+ TableInfo = proc_table_io_decl(TableIOInfo),
+ TableIOInfo = proc_table_io_info(TableArgInfos),
+ convert_table_arg_info(TableArgInfos, NumPTIs, PTIVectorRval,
TVarVectorRval, !StaticCellInfo),
TableData = table_io_decl_data(RttiProcLabel, Kind,
NumPTIs, PTIVectorRval, TVarVectorRval),
MaybeTableData = yes(TableData)
;
- TableInfo = table_gen_info(_NumInputs, _NumOutputs,
- _InputSteps, _MaybeOutputSteps, _TableArgInfo),
- % This structure is generated in add_tabling_info_struct in proc_gen.m.
+ TableInfo = proc_table_struct(_TableStructInfo),
+ % This structure is generated by add_tabling_info_struct in proc_gen.m.
MaybeTableData = no
).
@@ -1419,7 +1419,7 @@
construct_table_arg_pti_rval(ClosureArg, ArgRval - ArgRvalType,
!StaticCellInfo) :-
- ClosureArg = table_arg_info(_, _, Type),
+ ClosureArg = table_arg_info(_, _, _, Type),
ExistQTvars = [],
NumUnivQTvars = -1,
ll_pseudo_type_info.construct_typed_llds_pseudo_type_info(Type,
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.134
diff -u -r1.134 table_gen.m
--- compiler/table_gen.m 7 Aug 2007 07:10:06 -0000 1.134
+++ compiler/table_gen.m 9 Aug 2007 09:03:42 -0000
@@ -64,6 +64,7 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.pred_table.
:- import_module libs.compiler_util.
@@ -438,18 +439,20 @@
create_new_io_goal(OrigGoal, Decl, Unitize, TableIoStates,
PredId, ProcId, HeadVarModes, NumberedInputVars,
NumberedOutputVars, VarSet0, VarSet, VarTypes0, VarTypes,
- TableInfo0, TableInfo, Goal, MaybeProcTableInfo),
- MaybeCallTableTip = no
+ TableInfo0, TableInfo, Goal, MaybeProcTableIOInfo),
+ MaybeCallTableTip = no,
+ MaybeProcTableStructInfo = no
;
EvalMethod = eval_loop_check,
create_new_loop_goal(Detism, OrigGoal, Statistics,
PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
VarSet0, VarSet, VarTypes0, VarTypes,
TableInfo0, TableInfo, CallTableTip, Goal, InputSteps),
- generate_gen_proc_table_info(TableInfo, InputSteps, no,
- InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
+ generate_gen_proc_table_info(TableInfo, PredId, ProcId, InputSteps, no,
+ InputVarModeMethods, OutputVarModeMethods, ProcTableStructInfo),
MaybeCallTableTip = yes(CallTableTip),
- MaybeProcTableInfo = yes(ProcTableInfo)
+ MaybeProcTableIOInfo = no,
+ MaybeProcTableStructInfo = yes(ProcTableStructInfo)
;
EvalMethod = eval_memo,
( CodeModel = model_non ->
@@ -458,19 +461,21 @@
HeadVars, NumberedInputVars, NumberedOutputVars,
VarSet0, VarSet, VarTypes0, VarTypes, TableInfo0, TableInfo,
CallTableTip, Goal, InputSteps, OutputSteps),
- MaybeOutputSteps = yes(OutputSteps)
+ MaybeOutputSteps = yes(OutputSteps)
;
create_new_memo_goal(Detism, OrigGoal, Statistics, MaybeSizeLimit,
PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars,
VarSet0, VarSet, VarTypes0, VarTypes,
TableInfo0, TableInfo, CallTableTip, Goal, InputSteps),
- MaybeOutputSteps = no
+ MaybeOutputSteps = no
),
- generate_gen_proc_table_info(TableInfo, InputSteps, MaybeOutputSteps,
- InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
+ generate_gen_proc_table_info(TableInfo, PredId, ProcId, InputSteps,
+ MaybeOutputSteps, InputVarModeMethods, OutputVarModeMethods,
+ ProcTableStructInfo),
MaybeCallTableTip = yes(CallTableTip),
- MaybeProcTableInfo = yes(ProcTableInfo)
+ MaybeProcTableIOInfo = no,
+ MaybeProcTableStructInfo = yes(ProcTableStructInfo)
;
EvalMethod = eval_minimal(MinimalMethod),
expect(unify(CodeModel, model_non), this_file,
@@ -483,10 +488,10 @@
CallTableTip, Goal, InputSteps, OutputSteps),
MaybeCallTableTip = yes(CallTableTip),
MaybeOutputSteps = yes(OutputSteps),
- generate_gen_proc_table_info(TableInfo, InputSteps,
+ generate_gen_proc_table_info(TableInfo, PredId, ProcId, InputSteps,
MaybeOutputSteps, InputVarModeMethods, OutputVarModeMethods,
- ProcTableInfo),
- MaybeProcTableInfo = yes(ProcTableInfo)
+ ProcTableStructInfo),
+ MaybeProcTableStructInfo = yes(ProcTableStructInfo)
;
MinimalMethod = own_stacks_consumer,
do_own_stack_transform(Detism, OrigGoal, Statistics,
@@ -495,7 +500,7 @@
VarSet0, VarSet, VarTypes0, VarTypes, TableInfo0, TableInfo,
!GenMap, Goal, _InputSteps, _OutputSteps),
MaybeCallTableTip = no,
- MaybeProcTableInfo = no
+ MaybeProcTableStructInfo = no
;
MinimalMethod = own_stacks_generator,
% The own_stacks_generator minimal_method is only ever introduced
@@ -503,7 +508,8 @@
% been transformed yet should not have this eval_method.
unexpected(this_file,
"table_gen_transform_proc: own stacks generator")
- )
+ ),
+ MaybeProcTableIOInfo = no
),
table_info_extract(TableInfo, !:ModuleInfo, !:PredInfo, !:ProcInfo),
@@ -514,10 +520,27 @@
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_call_table_tip(MaybeCallTableTip, !ProcInfo),
- proc_info_set_maybe_proc_table_info(MaybeProcTableInfo, !ProcInfo),
+
+ (
+ MaybeProcTableIOInfo = no
+ ;
+ MaybeProcTableIOInfo = yes(FinalProcTableIOInfo),
+ proc_info_set_maybe_proc_table_io_info(yes(FinalProcTableIOInfo),
+ !ProcInfo)
+ ),
+
+ (
+ MaybeProcTableStructInfo = no
+ ;
+ MaybeProcTableStructInfo = yes(FinalProcTableStructInfo),
+ PredProcId = proc(PredId, ProcId),
+ add_proc_table_struct(PredProcId, FinalProcTableStructInfo, !.ProcInfo,
+ !ModuleInfo)
+ ),
% Some of the instmap_deltas generated in this module are pretty dodgy
% (especially those for if-then-elses), so recompute them here.
+ % XXX Fix this: generate correct-by-construction instmap_deltas.
RecomputeAtomic = no,
recompute_instmap_delta_proc(RecomputeAtomic, !ProcInfo, !ModuleInfo),
@@ -1172,11 +1195,11 @@
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out,
- hlds_goal::out, maybe(proc_table_info)::out) is det.
+ hlds_goal::out, maybe(proc_table_io_info)::out) is det.
create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
PredId, ProcId, HeadVarModes, OrigInputVars, OrigOutputVars,
- !VarSet, !VarTypes, !TableInfo, Goal, MaybeProcTableInfo) :-
+ !VarSet, !VarTypes, !TableInfo, Goal, MaybeProcTableIOInfo) :-
OrigGoal = hlds_goal(_, OrigGoalInfo),
ModuleInfo0 = !.TableInfo ^ table_module_info,
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
@@ -1256,15 +1279,15 @@
continuation_info.generate_table_arg_type_info(ProcInfo0,
list.map(project_var_pos, NumberedSavedHeadVars),
TableArgTypeInfo),
- ProcTableInfo = table_io_decl_info(TableArgTypeInfo),
- MaybeProcTableInfo = yes(ProcTableInfo)
+ ProcTableIOInfo = proc_table_io_info(TableArgTypeInfo),
+ MaybeProcTableIOInfo = yes(ProcTableIOInfo)
;
TableDecl = table_io_proc,
TableIoDeclGoal = true_goal,
NumberedRestoreVars =
list.map(project_out_arg_method, SavedOutputVars),
NumberedSaveVars = list.map(project_out_arg_method, SavedOutputVars),
- MaybeProcTableInfo = no
+ MaybeProcTableIOInfo = no
),
list.length(NumberedSaveVars, BlockSize),
OrigInstMapDelta = goal_info_get_instmap_delta(OrigGoalInfo),
@@ -1787,9 +1810,13 @@
InputVarModeMethods = list.map(project_out_pos, NumberedInputVars),
OutputVarModeMethods = list.map(project_out_pos, NumberedOutputVars),
- generate_gen_proc_table_info(!.TableInfo, InputSteps, yes(OutputSteps),
- InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
- proc_info_set_maybe_proc_table_info(yes(ProcTableInfo), !ProcInfo),
+ generate_gen_proc_table_info(!.TableInfo, PredId, ProcId, InputSteps,
+ yes(OutputSteps), InputVarModeMethods, OutputVarModeMethods,
+ ProcTableStructInfo),
+
+ PredProcId = proc(PredId, ProcId),
+ add_proc_table_struct(PredProcId, ProcTableStructInfo, !.ProcInfo,
+ ModuleInfo0, ModuleInfo1),
SpecialReturn = generator_return(returning_generator_locn, DebugArgStr),
proc_info_set_maybe_special_return(yes(SpecialReturn), !ProcInfo),
@@ -1799,9 +1826,9 @@
map.det_insert(ProcTable0, ProcId, !.ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, !PredInfo),
- module_info_preds(ModuleInfo0, PredTable0),
+ module_info_preds(ModuleInfo1, PredTable0),
map.det_update(PredTable0, PredId, !.PredInfo, PredTable),
- module_info_set_preds(PredTable, ModuleInfo0, ModuleInfo),
+ module_info_set_preds(PredTable, ModuleInfo1, ModuleInfo),
!:TableInfo = !.TableInfo ^ table_module_info := ModuleInfo.
:- pred clone_pred_info(pred_id::in, pred_info::in, list(prog_var)::in,
@@ -1945,14 +1972,23 @@
%-----------------------------------------------------------------------------%
-:- pred generate_gen_proc_table_info(table_info::in,
+:- pred generate_gen_proc_table_info(table_info::in, pred_id::in, proc_id::in,
list(table_trie_step)::in, maybe(list(table_trie_step))::in,
list(var_mode_method)::in, list(var_mode_method)::in,
- proc_table_info::out) is det.
+ proc_table_struct_info::out) is det.
+
+generate_gen_proc_table_info(TableInfo, PredId, ProcId,
+ InputSteps, MaybeOutputSteps, InputVars, OutputVars,
+ ProcTableStructInfo) :-
+ ModuleInfo = TableInfo ^ table_module_info,
+ RTTIProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
-generate_gen_proc_table_info(TableInfo, InputSteps, MaybeOutputSteps,
- InputVars, OutputVars, ProcTableInfo) :-
+ PredInfo = TableInfo ^ table_cur_pred_info,
+ pred_info_get_typevarset(PredInfo, TVarSet),
ProcInfo = TableInfo ^ table_cur_proc_info,
+ proc_info_get_eval_method(ProcInfo, EvalMethod),
+ proc_info_get_context(ProcInfo, Context),
+
InOutHeadVars = InputVars ++ OutputVars,
allocate_slot_numbers(InOutHeadVars, 1, NumberedInOutHeadVars),
ArgInfos = list.map(project_var_pos, NumberedInOutHeadVars),
@@ -1960,8 +1996,10 @@
TableArgTypeInfo),
NumInputs = list.length(InputVars),
NumOutputs = list.length(OutputVars),
- ProcTableInfo = table_gen_info(NumInputs, NumOutputs, InputSteps,
- MaybeOutputSteps, TableArgTypeInfo).
+
+ ProcTableStructInfo = proc_table_struct_info(RTTIProcLabel, TVarSet,
+ Context, NumInputs, NumOutputs, InputSteps, MaybeOutputSteps,
+ TableArgTypeInfo, EvalMethod).
%-----------------------------------------------------------------------------%
@@ -3189,6 +3227,27 @@
%-----------------------------------------------------------------------------%
+:- pred add_proc_table_struct(pred_proc_id::in, proc_table_struct_info::in,
+ proc_info::in, module_info::in, module_info::out) is det.
+
+add_proc_table_struct(PredProcId, ProcTableStructInfo, ProcInfo,
+ !ModuleInfo) :-
+ module_info_get_table_struct_map(!.ModuleInfo, TableStructMap0),
+ proc_info_get_table_attributes(ProcInfo, MaybeTableAttributes),
+ (
+ MaybeTableAttributes = yes(TableAttributes)
+ ;
+ MaybeTableAttributes = no,
+ TableAttributes = default_memo_table_attributes
+ ),
+ TableStructInfo = table_struct_info(ProcTableStructInfo,
+ TableAttributes),
+ map.det_insert(TableStructMap0, PredProcId, TableStructInfo,
+ TableStructMap),
+ module_info_set_table_struct_map(TableStructMap, !ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
:- type var_mode_method
---> var_mode_method(
prog_var, % The head variable.
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.88
diff -u -r1.88 type_ctor_info.m
--- compiler/type_ctor_info.m 13 Feb 2007 01:58:51 -0000 1.88
+++ compiler/type_ctor_info.m 9 Aug 2007 09:09:46 -0000
@@ -456,7 +456,7 @@
make_rtti_proc_label(PredProcId, ModuleInfo, ProcLabel) :-
PredProcId = proc(PredId, ProcId),
- ProcLabel = rtti.make_rtti_proc_label(ModuleInfo, PredId, ProcId).
+ ProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId).
%---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.539
diff -u -r1.539 user_guide.texi
--- doc/user_guide.texi 8 Aug 2007 16:41:22 -0000 1.539
+++ doc/user_guide.texi 9 Aug 2007 23:33:41 -0000
@@ -6792,8 +6792,10 @@
I - imported predicates,
M - mode and inst information,
P - path information,
+S - information about structure sharing
T - type and typeclass information,
-U - unify and compare predicates.
+U - unify and compare predicates,
+Z - information about globals structs representing call and answer tables.
@sp 1
@item --dump-hlds-pred-id @var{predid}
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
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 tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.44
diff -u -r1.44 Mmakefile
--- tests/tabling/Mmakefile 31 Jul 2007 07:58:45 -0000 1.44
+++ tests/tabling/Mmakefile 9 Aug 2007 14:55:53 -0000
@@ -18,6 +18,8 @@
fib_string \
loopcheck_no_loop \
loopcheck_nondet_no_loop \
+ mercury_java_parser_dead_proc_elim_bug \
+ mercury_java_parser_dead_proc_elim_bug2 \
oota \
table_foreign_output \
test_enum \
Index: tests/tabling/mercury_java_parser_dead_proc_elim_bug.exp
===================================================================
RCS file: tests/tabling/mercury_java_parser_dead_proc_elim_bug.exp
diff -N tests/tabling/mercury_java_parser_dead_proc_elim_bug.exp
Index: tests/tabling/mercury_java_parser_dead_proc_elim_bug.m
===================================================================
RCS file: tests/tabling/mercury_java_parser_dead_proc_elim_bug.m
diff -N tests/tabling/mercury_java_parser_dead_proc_elim_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/mercury_java_parser_dead_proc_elim_bug.m 8 Aug 2007 05:08:45 -0000
@@ -0,0 +1,2124 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+%
+% This is a regression test. In versions of the compiler before 7 Aug 2007,
+% it used to cause a link error.
+%
+% Some eval methods cause the procedure implementation to include
+% a global variable representing the root of the per-procedure call
+% and answer tables. Since the code of a tabled procedure may
+% become dead after having been inlined in other procedures, and
+% that inlined code will refer to this global variable, we cannot
+% eliminate the procedure itself, since doing so would also
+% eliminate the definition of the global variable.
+%
+%-----------------------------------------------------------------------------%
+% mercury_java_parser_memoed.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Mon Feb 21 09:42:40 EST 2005
+%
+% Java grammar taken from
+% http://java.sun.com/docs/books/jls/second_edition/html/syntax.doc.html
+% and converted to Mercury DCGs. And then corrected because the grammar
+% at the above page contains bugs...
+%
+% Usage: parse_java <filename> ...
+%
+% This implementation only recognises Java programs; it does not construct an
+% ADT or perform any kind of analysis. However, it has been written in a
+% style that should make it fairly easy to add construction of an ADT.
+%
+% To compile this as a packrat parser, uncomment all of the pragma memo
+% lines.
+%
+% To compile this as a partial packrat parser, uncomment all of the
+% pragma memo lines except those for literal/2, qualified_identifier/2, and
+% punct/2.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mercury_java_parser_dead_proc_elim_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module pair.
+:- import_module std_util.
+:- import_module string.
+
+ % The parser "state". This is just the offset into the input string,
+ % which (depending on the version) may be passed around or stored in
+ % a C global variable.
+ %
+ % We do the latter to (a) avoid memoizing the input string if we are
+ % memoing any rules and (b) to obtain a fair timing comparison with the
+ % Rats! Java parser (www.cs.nyu.edu/rgrimm/xtc/rats.html).
+ %
+:- type ps == int.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ list.foldl(parse_file, Args, !IO).
+
+:- pred parse_file(string::in, io::di, io::uo) is det.
+
+parse_file(Filename, !IO) :-
+ global_table_reset(!IO),
+ io.write_string(Filename, !IO),
+ io.see(Filename, _, !IO),
+ io.read_file_as_string(Result, !IO),
+ ( if Result = ok(Str) then
+ promise_pure ( impure set_input_string(Str),
+ ( if compilation_unit(0, _)
+ then
+ io.print(" parsed successfully\n", !IO)
+ else
+ io.print(" failed to parse\n", !IO)
+ )
+ )
+ else
+ throw(Result)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Low-level predicates.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+
+:- pragma foreign_decl("C", "
+
+ MR_String input_string = NULL;
+ MR_Word input_length = (MR_Word) 0;
+
+").
+
+%-----------------------------------------------------------------------------%
+
+:- impure pred set_input_string(string::in) is det.
+
+:- pragma foreign_proc("C",
+ set_input_string(Str::in),
+ [will_not_call_mercury],
+"
+ input_string = Str;
+ input_length = strlen(Str);
+").
+
+%-----------------------------------------------------------------------------%
+
+:- semipure pred input_string_and_length(string::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ input_string_and_length(Str::out, Length::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ Str = input_string;
+ Length = input_length;
+").
+
+
+%-----------------------------------------------------------------------------%
+
+:- pred current_offset(int::out, int::in, int::out) is det.
+
+current_offset(Offset, Offset, Offset).
+
+%-----------------------------------------------------------------------------%
+
+:- pred eof(ps::in, ps::out) is semidet.
+
+eof(Offset, Offset) :-
+ promise_pure ( semipure input_string_and_length(_Str, Length),
+ Offset = Length
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % XXX These are really semipure, but I'm being naughty and promising them
+ % to be pure because I don't want to pollute my code with impurity
+ % annotations.
+ %
+ % XXX Also, I do not check for negative offsets. I probably should.
+ %
+:- pred char(char::out, ps::in, ps::out) is semidet.
+
+char(Char, Offset, Offset + 1) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ Offset < Length,
+ Char = Str ^ unsafe_elem(Offset)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred input_substring(int::in, int::in, string::out,
+ ps::in, ps::out) is semidet.
+
+input_substring(Start, End, Substring, Offset, Offset) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ End =< Length,
+ Substring = unsafe_substring(Str, Start, End - Start)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred match_string(string::in, int::in, int::out) is semidet.
+
+match_string(MatchStr, Offset, Offset + N) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ N = length(MatchStr),
+ Offset + N =< Length,
+ match_string_2(0, N, MatchStr, Offset, Str)
+ ).
+
+:- pred match_string_2(int::in, int::in, string::in, int::in, string::in)
+ is semidet.
+
+match_string_2(I, N, MatchStr, Offset, Str) :-
+ ( if I < N then
+ MatchStr ^ unsafe_elem(I) = Str ^ unsafe_elem(Offset + I),
+ match_string_2(I + 1, N, MatchStr, Offset, Str)
+ else
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Utility predicates.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred optional_det(
+ pred(ps, ps):: in(pred(in, out) is semidet),
+ ps::in, ps::out) is det.
+
+optional_det(P) -->
+ ( if P then
+ []
+ else
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred zero_or_more_det(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is det.
+
+zero_or_more_det(P) -->
+ ( if P then
+ zero_or_more_det(P)
+ else
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred one_or_more(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+one_or_more(P) -->
+ P,
+ zero_or_more_det(P).
+
+%-----------------------------------------------------------------------------%
+
+:- pred brackets(string::in,
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ string::in, ps::in, ps::out) is semidet.
+
+brackets(L, P, R) -->
+ punct(L),
+ P,
+ punct(R).
+
+:- pred brackets_detarg(string::in,
+ pred(ps, ps)::in(pred(in, out) is det),
+ string::in, ps::in, ps::out) is semidet.
+
+brackets_detarg(L, P, R) -->
+ punct(L),
+ P,
+ punct(R).
+
+%-----------------------------------------------------------------------------%
+
+:- pred seq(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+:- pragma inline(seq/4).
+
+seq(P, Q) -->
+ P,
+ Q.
+
+%-----------------------------------------------------------------------------%
+
+:- pred comma_separated_list(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+comma_separated_list(P) -->
+ P,
+ zero_or_more_det(seq(punct(","), P)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred whitespace(ps::in, ps::out) is semidet.
+
+whitespace -->
+ ( if char(C1), { char.is_whitespace(C1) } then
+ whitespace
+ else if char('/'), char('/') then
+ skip_to_eol,
+ whitespace
+ else if char('/'), char('*') then
+ skip_to_end_of_trad_comment,
+ whitespace
+ else
+ []
+ ).
+
+:- pred skip_to_eol(ps::in, ps::out) is semidet.
+
+skip_to_eol -->
+ char(C),
+ ( if { C = ('\n') } then
+ []
+ else
+ skip_to_eol
+ ).
+
+:- pred skip_to_end_of_trad_comment(ps::in, ps::out) is semidet.
+
+skip_to_end_of_trad_comment -->
+ ( if char('*'), char('/') then
+ []
+ else
+ char(_),
+ skip_to_end_of_trad_comment
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred punct(string::in, ps::in, ps::out) is semidet.
+
+punct(Punct) -->
+ match_string(Punct),
+ whitespace.
+
+%-----------------------------------------------------------------------------%
+
+:- pred keyword(string::in, ps::in, ps::out) is semidet.
+
+keyword(Keyword) -->
+ match_string(Keyword),
+ not(java_identifier_part),
+ whitespace.
+
+%-----------------------------------------------------------------------------%
+
+:- pred keyword(string::in,
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+keyword(Keyword, P) -->
+ match_string(Keyword),
+ not(java_identifier_part),
+ whitespace,
+ P.
+
+%-----------------------------------------------------------------------------%
+
+:- pred java_identifier( /*string::out,*/ ps::in, ps::out)
+ is semidet.
+
+
+java_identifier/*(Identifier)*/ -->
+% current_offset(Start),
+ java_identifier_start,
+ zero_or_more_det(java_identifier_part),
+% current_offset(End),
+% input_substring(Start, End, Identifier),
+ whitespace.
+
+:- pred java_identifier_start(ps::in, ps::out) is semidet.
+
+java_identifier_start -->
+ char(C),
+ { char.is_alpha_or_underscore(C) ; C = ('$') }.
+
+:- pred java_identifier_part(ps::in, ps::out) is semidet.
+
+java_identifier_part -->
+ char(C),
+ { char.is_alnum_or_underscore(C) ; C = ('$') }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred floating_point_literal(ps::in, ps::out) is semidet.
+
+floating_point_literal -->
+ ( if
+ optional_det(digits(10)),
+ char('.'),
+ digits(10)
+ then
+ optional_det(exponent_part),
+ optional_det(float_type_suffix)
+ else
+ digits(10),
+ ( if exponent_part then
+ optional_det(float_type_suffix)
+ else
+ float_type_suffix
+ )
+ ).
+
+:- pred exponent_part(ps::in, ps::out) is semidet.
+
+exponent_part -->
+ char(C),
+ { C = ('E') ; C = ('e') },
+ optional_det(sign),
+ one_or_more(digit(10)).
+
+:- pred sign(ps::in, ps::out) is semidet.
+
+sign -->
+ char(C),
+ { C = ('+') ; C = ('-') }.
+
+:- pred float_type_suffix(ps::in, ps::out) is semidet.
+
+float_type_suffix -->
+ char(C),
+ { C = ('F') ; C = ('f') ; C = ('D') ; C = ('d') }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred integer_literal(ps::in, ps::out) is semidet.
+
+integer_literal -->
+ ( if
+ hex_literal
+ then
+ []
+ else if
+ oct_literal
+ then
+ []
+ else
+ dec_literal
+ ).
+
+:- pred hex_literal(ps::in, ps::out) is semidet.
+
+hex_literal -->
+ char('0'),
+ char('x'),
+ digits(16),
+ optional_det(integer_type_suffix).
+
+:- pred oct_literal(ps::in, ps::out) is semidet.
+
+oct_literal -->
+ char('0'),
+ digits(8),
+ optional_det(integer_type_suffix).
+
+:- pred dec_literal(ps::in, ps::out) is semidet.
+
+dec_literal -->
+ ( if char('0') then
+ not digit(16)
+ else
+ digits(10)
+ ),
+ optional_det(integer_type_suffix).
+
+:- pred integer_type_suffix(ps::in, ps::out) is semidet.
+
+integer_type_suffix -->
+ char(C),
+ { C = ('L') ; C = ('l') }.
+
+:- pred digits(int::in, ps::in, ps::out) is semidet.
+
+digits(Base) -->
+ one_or_more(digit(Base)).
+
+:- pred digit(int::in, ps::in, ps::out) is semidet.
+
+digit(Base) -->
+ char(C),
+ { char.digit_to_int(C, D), D < Base }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred character_literal(ps::in, ps::out) is semidet.
+
+character_literal -->
+ char('\''),
+ not char('\''),
+ possibly_escaped_char,
+ char('\'').
+
+:- pred possibly_escaped_char(ps::in, ps::out) is semidet.
+
+possibly_escaped_char -->
+ char(C1),
+ ( if
+ { C1 = ('\\') }
+ then
+ ( if
+ digits(8)
+ then
+ []
+ else if
+ char('u'),
+ one_or_more(digits(16)) then
+ []
+ else
+ char(C2),
+ { member(C2,
+ [('b'), ('t'), ('n'), ('f'), ('r'), ('\"'), ('\''), ('\\')]) }
+ )
+ else
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred string_literal(ps::in, ps::out) is semidet.
+
+string_literal -->
+ char('\"'),
+ zero_or_more_det(string_char),
+ char('\"').
+
+:- pred string_char(ps::in, ps::out) is semidet.
+
+string_char -->
+ not(char('"')),
+ possibly_escaped_char.
+
+%-----------------------------------------------------------------------------%
+
+:- pred boolean_literal(ps::in, ps::out) is semidet.
+
+boolean_literal -->
+ ( if
+ keyword("true")
+ then
+ []
+ else
+ keyword("false")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred null_literal(ps::in, ps::out) is semidet.
+
+null_literal -->
+ keyword("null").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Taken from
+% http://java.sun.com/docs/books/jls/second_edition/html/syntax.doc.html
+
+% _________________________________________________________________
+%
+% [5]Contents | [6]Prev | [7]Next | [8]Index Java Language Specification
+% Second Edition
+%
+% [9]Copyright 2000 Sun Microsystems, Inc. All rights reserved
+% Please send any comments or corrections to the [10]JLS team
+
+% Syntax
+% _________________________________________________________________
+%
+% This chapter presents a grammar for the Java programming language.
+%
+% The grammar presented piecemeal in the preceding chapters is much
+% better for exposition, but it is not ideally suited as a basis for a
+% parser. The grammar presented in this chapter is the basis for the
+% reference implementation.
+%
+% The grammar below uses the following BNF-style conventions:
+%
+% * [x] denotes zero or one occurrences of x.
+% * {x} denotes zero or more occurrences of x.
+% * x | y means one of either x or y.
+
+% Identifier:
+% IDENTIFIER
+%
+% QualifiedIdentifier:
+% Identifier { . Identifier }
+
+:- pred qualified_identifier(ps::in, ps::out) is semidet.
+
+qualified_identifier -->
+ java_identifier,
+ zero_or_more_det(dot_java_identifier).
+
+:- pred dot_java_identifier(ps::in, ps::out) is semidet.
+
+dot_java_identifier -->
+ punct("."),
+ java_identifier.
+
+% Literal:
+% IntegerLiteral
+% FloatingPointLiteral
+% CharacterLiteral
+% StringLiteral
+% BooleanLiteral
+% NullLiteral
+
+:- pred literal(ps::in, ps::out) is semidet.
+
+literal -->
+ ( if
+ floating_point_literal
+ then
+ []
+ else if
+ integer_literal
+ then
+ []
+ else if
+ character_literal
+ then
+ []
+ else if
+ string_literal
+ then
+ []
+ else if
+ boolean_literal
+ then
+ []
+ else
+ null_literal
+ ),
+ whitespace.
+
+% Expression:
+% Expression1 [AssignmentOperator Expression1]]
+% XXX I think that should be
+% Expression1 {AssignmentOperator Expression1}
+
+:- pred expression(ps::in, ps::out) is semidet.
+
+expression -->
+ expression1,
+ zero_or_more_det(assignment_operator_expression1).
+
+:- pred assignment_operator_expression1(ps::in, ps::out)
+ is semidet.
+
+assignment_operator_expression1 -->
+ assignment_operator,
+ expression1.
+
+% AssignmentOperator:
+% =
+% +=
+% -=
+% *=
+% /=
+% &=
+% |=
+% ^=
+% %=
+% <<=
+% >>=
+% >>>=
+
+:- pred assignment_operator(ps::in, ps::out) is semidet.
+
+assignment_operator -->
+ ( if
+ punct("=")
+ then
+ []
+ else if
+ punct("+=")
+ then
+ []
+ else if
+ punct("-=")
+ then
+ []
+ else if
+ punct("*=")
+ then
+ []
+ else if
+ punct("/=")
+ then
+ []
+ else if
+ punct("&=")
+ then
+ []
+ else if
+ punct("|=")
+ then
+ []
+ else if
+ punct("^=")
+ then
+ []
+ else if
+ punct("%=")
+ then
+ []
+ else if
+ punct("<<=")
+ then
+ []
+ else if
+ punct(">>=")
+ then
+ []
+ else
+ punct(">>>=")
+ ).
+
+% Type:
+% Identifier { . Identifier } BracketsOpt
+% BasicType
+
+:- pred java_type(ps::in, ps::out) is semidet.
+
+java_type -->
+ ( if
+ qualified_identifier,
+ brackets_opt
+ then
+ []
+ else
+ basic_type
+ ).
+
+% StatementExpression:
+% Expression
+
+:- pred statement_expression(ps::in, ps::out) is semidet.
+
+statement_expression -->
+ expression.
+
+% ConstantExpression:
+% Expression
+
+:- pred constant_expression(ps::in, ps::out) is semidet.
+
+constant_expression -->
+ expression.
+
+% Expression1:
+% Expression2 [Expression1Rest]
+
+:- pred expression1(ps::in, ps::out) is semidet.
+
+expression1 -->
+ expression2,
+ optional_det(expression1_rest).
+
+% Expression1Rest:
+% [ ? Expression : Expression1]
+
+:- pred expression1_rest(ps::in, ps::out) is semidet.
+
+expression1_rest -->
+ punct("?"),
+ expression,
+ punct(":"),
+ expression1.
+
+% Expression2 :
+% Expression3 [Expression2Rest]
+
+:- pred expression2(ps::in, ps::out) is semidet.
+
+expression2 -->
+ expression3,
+ optional_det(expression2_rest).
+
+% Expression2Rest:
+% {Infixop Expression3}
+% Expression3 instanceof Type
+% XXX The Expression3 here must be wrong...
+% XXX And {Infixop Expression3} should be allowed after Type.
+
+:- pred expression2_rest(ps::in, ps::out) is semidet.
+
+expression2_rest -->
+ ( if
+ keyword("instanceof"),
+ java_type,
+ optional_det(expression2_rest)
+ then
+ []
+ else
+ zero_or_more_det(infix_op_expression3),
+ { semidet_succeed }
+ ).
+
+:- pred infix_op_expression3(ps::in, ps::out) is semidet.
+
+infix_op_expression3 -->
+ infix_op,
+ expression3.
+
+% Infixop:
+% ||
+% &&
+% |
+% ^
+% &
+% ==
+% !=
+% <
+% >
+% <=
+% >=
+% <<
+% >>
+% >>>
+% +
+% -
+% *
+% /
+% %
+
+:- pred infix_op(ps::in, ps::out) is semidet.
+
+infix_op -->
+ ( if
+ punct("||")
+ then
+ []
+ else if
+ punct("&&")
+ then
+ []
+ else if
+ punct("|")
+ then
+ []
+ else if
+ punct("^")
+ then
+ []
+ else if
+ punct("&")
+ then
+ []
+ else if
+ punct("==")
+ then
+ []
+ else if
+ punct("!=")
+ then
+ []
+ else if
+ punct("<=")
+ then
+ []
+ else if
+ punct(">=")
+ then
+ []
+ else if
+ punct("<<")
+ then
+ []
+ else if
+ punct(">>>")
+ then
+ []
+ else if
+ punct(">>")
+ then
+ []
+ else if
+ punct("<")
+ then
+ []
+ else if
+ punct(">")
+ then
+ []
+ else if
+ punct("+")
+ then
+ []
+ else if
+ punct("-")
+ then
+ []
+ else if
+ punct("*")
+ then
+ []
+ else if
+ punct("/")
+ then
+ []
+ else
+ punct("%")
+ ).
+
+% Expression3:
+% PrefixOp Expression3
+% ( Expr | Type ) Expression3
+% Primary {Selector} {PostfixOp}
+
+:- pred expression3(ps::in, ps::out) is semidet.
+
+expression3 -->
+ ( if
+ prefix_op,
+ expression3
+ then
+ []
+ else if
+ brackets(
+ "(",
+ expression_or_java_type,
+ ")"),
+ expression3
+ then
+ []
+ else
+ primary,
+ zero_or_more_det(selector),
+ zero_or_more_det(postfix_op)
+ ).
+
+:- pred expression_or_java_type(ps::in, ps::out) is semidet.
+
+expression_or_java_type -->
+ ( if
+ java_type
+ then
+ []
+ else
+ expression
+ ).
+
+% Primary:
+% ( Expression )
+% this [Arguments]
+% super SuperSuffix
+% Literal
+% new Creator
+% Identifier { . Identifier }[ IdentifierSuffix]
+% BasicType BracketsOpt .class
+% void.class
+
+:- pred primary(ps::in, ps::out) is semidet.
+
+primary -->
+ ( if
+ brackets(
+ "(",
+ expression,
+ ")")
+ then
+ []
+ else if
+ keyword("this"),
+ optional_det(arguments)
+ then
+ []
+ else if
+ keyword("super"),
+ super_suffix
+ then
+ []
+ else if
+ keyword("new"),
+ creator
+ then
+ []
+ else if
+ keyword("void"),
+ punct("."),
+ keyword("class")
+ then
+ []
+ else if
+ basic_type,
+ brackets_opt,
+ punct("."),
+ keyword("class")
+ then
+ []
+ else if
+ literal
+ then
+ []
+ else
+ qualified_identifier,
+ optional_det(identifier_suffix)
+ ).
+
+% XXX I don't understand how to read this rule:
+%
+% IdentifierSuffix:
+% [ ( ] BracketsOpt . class | Expression ])
+% Arguments
+% . ( class | this | super Arguments | new InnerCreator )
+
+:- pred identifier_suffix(ps::in, ps::out) is semidet.
+
+identifier_suffix -->
+ ( if
+ brackets_opt,
+ punct("."),
+ ( if
+ keyword("class")
+ then
+ []
+ else
+ expression
+ )
+ then
+ []
+ else if
+ arguments
+ then
+ []
+ else
+ punct("."),
+ ( if
+ keyword("class")
+ then
+ []
+ else if
+ keyword("this")
+ then
+ []
+ else if
+ keyword("super"),
+ arguments
+ then
+ []
+ else
+ keyword("new"),
+ inner_creator
+ )
+ ).
+
+% PrefixOp:
+% ,
+% --
+% !
+% ~
+% +
+% -
+
+:- pred prefix_op(ps::in, ps::out) is semidet.
+
+prefix_op -->
+ ( if
+ punct("++")
+ then
+ []
+ else if
+ punct("--")
+ then
+ []
+ else if
+ punct("!")
+ then
+ []
+ else if
+ punct("~")
+ then
+ []
+ else if
+ punct("+")
+ then
+ []
+ else
+ punct("-")
+ ).
+
+% PostfixOp:
+% ,
+% --
+
+:- pred postfix_op(ps::in, ps::out) is semidet.
+
+postfix_op -->
+ ( if
+ punct("++")
+ then
+ []
+ else
+ punct("--")
+ ).
+
+% Selector:
+% . Identifier [Arguments]
+% . this
+% . super SuperSuffix
+% . new InnerCreator
+% [ Expression ]
+
+:- pred selector(ps::in, ps::out) is semidet.
+
+selector -->
+ ( if
+ brackets(
+ "[",
+ expression,
+ "]")
+ then
+ []
+ else
+ punct("."),
+ ( if
+ keyword("this")
+ then
+ []
+ else if
+ keyword("super"),
+ super_suffix
+ then
+ []
+ else if
+ keyword("new"),
+ inner_creator
+ then
+ []
+ else
+ java_identifier,
+ optional_det(arguments)
+ )
+ ).
+
+% SuperSuffix:
+% Arguments
+% . Identifier [Arguments]
+
+:- pred super_suffix(ps::in, ps::out) is semidet.
+
+super_suffix -->
+ ( if
+ arguments
+ then
+ []
+ else
+ punct("."),
+ java_identifier,
+ optional_det(arguments)
+ ).
+
+% BasicType:
+% byte
+% short
+% char
+% int
+% long
+% float
+% double
+% boolean
+
+:- pred basic_type(ps::in, ps::out) is semidet.
+
+basic_type -->
+ ( if
+ punct("byte")
+ then
+ []
+ else if
+ punct("short")
+ then
+ []
+ else if
+ punct("char")
+ then
+ []
+ else if
+ punct("int")
+ then
+ []
+ else if
+ punct("long")
+ then
+ []
+ else if
+ punct("float")
+ then
+ []
+ else if
+ punct("double")
+ then
+ []
+ else
+ punct("boolean")
+ ).
+
+% Arguments:
+% ( [Expression { , Expression }] )
+
+:- pred arguments(ps::in, ps::out) is semidet.
+
+arguments -->
+ brackets_detarg(
+ "(",
+ optional_det(comma_separated_list(expression)),
+ ")").
+
+% BracketsOpt:
+% {[]}
+
+:- pred brackets_opt(ps::in, ps::out) is det.
+
+brackets_opt -->
+ zero_or_more_det(empty_brackets).
+
+:- pred empty_brackets(ps::in, ps::out) is semidet.
+
+empty_brackets -->
+ punct("["),
+ punct("]").
+
+% Creator:
+% QualifiedIdentifier ( ArrayCreatorRest | ClassCreatorRest )
+
+:- pred creator(ps::in, ps::out) is semidet.
+
+creator -->
+ qualified_identifier,
+ creator_rest.
+
+:- pred creator_rest(ps::in, ps::out) is semidet.
+
+creator_rest -->
+ ( if
+ array_creator_rest
+ then
+ []
+ else
+ class_creator_rest
+ ).
+
+% InnerCreator:
+% Identifier ClassCreatorRest
+
+:- pred inner_creator(ps::in, ps::out) is semidet.
+
+inner_creator -->
+ java_identifier,
+ class_creator_rest.
+
+% XXX I don't understand how to read this rule:
+%
+% ArrayCreatorRest:
+% [ ( ] BracketsOpt ArrayInitializer | Expression ] {[ Expression ]} BracketsOpt )
+
+:- pred array_creator_rest(ps::in, ps::out) is semidet.
+
+array_creator_rest -->
+ one_or_more(
+ brackets_detarg(
+ "[",
+ optional_det(expression),
+ "]")),
+ optional_det(array_initializer).
+
+% ClassCreatorRest:
+% Arguments [ClassBody]
+
+:- pred class_creator_rest(ps::in, ps::out) is semidet.
+
+class_creator_rest -->
+ arguments,
+ optional_det(class_body).
+
+% ArrayInitializer:
+% { [VariableInitializer {, VariableInitializer} [,]] }
+
+:- pred array_initializer(ps::in, ps::out) is semidet.
+
+array_initializer -->
+ brackets_detarg(
+ "{",
+ optional_det(array_initializer_body),
+ "}").
+
+:- pred array_initializer_body(ps::in, ps::out) is semidet.
+
+array_initializer_body -->
+ comma_separated_list(variable_initializer),
+ optional_det(punct(",")).
+
+% VariableInitializer:
+% ArrayInitializer
+% Expression
+
+:- pred variable_initializer(ps::in, ps::out) is semidet.
+
+variable_initializer -->
+ ( if
+ array_initializer
+ then
+ []
+ else
+ expression
+ ).
+
+% ParExpression:
+% ( Expression )
+
+:- pred par_expression(ps::in, ps::out) is semidet.
+
+par_expression -->
+ brackets(
+ "(",
+ expression,
+ ")").
+
+% Block:
+% { BlockStatements }
+
+:- pred block(ps::in, ps::out) is semidet.
+
+block -->
+ brackets_detarg(
+ "{",
+ block_statements,
+ "}").
+
+% BlockStatements:
+% { BlockStatement }
+
+:- pred block_statements(ps::in, ps::out) is det.
+
+block_statements -->
+ zero_or_more_det(block_statement).
+
+% BlockStatement :
+% LocalVariableDeclarationStatement
+% ClassOrInterfaceDeclaration
+% [Identifier :] Statement
+
+:- pred block_statement(ps::in, ps::out) is semidet.
+
+block_statement -->
+ ( if
+ local_variable_declaration_statement
+ then
+ []
+ else if
+ class_or_interface_declaration
+ then
+ []
+ else
+ optional_det(label),
+ statement
+ ).
+
+:- pred label(ps::in, ps::out) is semidet.
+
+label -->
+ java_identifier,
+ punct(":").
+
+% LocalVariableDeclarationStatement:
+% [final] Type VariableDeclarators ;
+% XXX I think this is wrong: [final] should be ModifiersOpt, surely?
+
+:- pred local_variable_declaration_statement(ps::in, ps::out)
+ is semidet.
+
+local_variable_declaration_statement -->
+ modifiers_opt,
+ java_type,
+ variable_declarators,
+ punct(";").
+
+% Statement:
+% Block
+% if ParExpression Statement [else if Statement]
+% for ( ForInitOpt ; [Expression] ; ForUpdateOpt ) Statement
+% while ParExpression Statement
+% do Statement while ParExpression ;
+% try Block ( Catches | [Catches] finally Block )
+% switch ParExpression { SwitchBlockStatementGroups }
+% synchronized ParExpression Block
+% return [Expression] ;
+% throw Expression ;
+% break [Identifier]
+% continue [Identifier]
+% ;
+% ExpressionStatement
+% Identifier : Statement
+
+:- pred statement(ps::in, ps::out) is semidet.
+
+statement -->
+ ( if
+ block
+ then
+ []
+ else if
+ keyword("if"),
+ par_expression,
+ statement,
+ optional_det(else_statement)
+ then
+ []
+ else if
+ keyword("for"),
+ punct("("),
+ optional_det(for_init),
+ punct(";"),
+ optional_det(expression),
+ punct(";"),
+ optional_det(for_update),
+ punct(")"),
+ statement
+ then
+ []
+ else if
+ keyword("while"),
+ par_expression,
+ statement
+ then
+ []
+ else if
+ keyword("do"),
+ statement,
+ keyword("while"),
+ par_expression,
+ punct(";")
+ then
+ []
+ else if
+ keyword("try"),
+ block,
+ catches_finally
+ then
+ []
+ else if
+ keyword("switch"),
+ par_expression,
+ brackets_detarg(
+ "{",
+ switch_block_statement_groups,
+ "}")
+ then
+ []
+ else if
+ keyword("synchronized"),
+ par_expression,
+ block
+ then
+ []
+ else if
+ keyword("return"),
+ optional_det(expression),
+ punct(";")
+ then
+ []
+ else if
+ keyword("throw"),
+ expression,
+ punct(";")
+ then
+ []
+ else if
+ keyword("break"),
+ optional_det(java_identifier),
+ punct(";")
+ then
+ []
+ else if
+ keyword("continue"),
+ optional_det(java_identifier),
+ punct(";")
+ then
+ []
+ else if
+ punct(";")
+ then
+ []
+ else if
+ expression,
+ punct(";")
+ then
+ []
+ else
+ java_identifier,
+ punct(":"),
+ statement
+ ).
+
+:- pred else_statement(ps::in, ps::out) is semidet.
+
+else_statement -->
+ keyword("else"),
+ statement.
+
+:- pred catches_finally(ps::in, ps::out) is semidet.
+
+catches_finally -->
+ ( if
+ catches,
+ optional_det(finally_block)
+ then
+ []
+ else
+ finally_block
+ ).
+
+:- pred finally_block(ps::in, ps::out) is semidet.
+
+finally_block -->
+ keyword("finally"),
+ block.
+
+% Catches:
+% CatchClause {CatchClause}
+
+:- pred catches(ps::in, ps::out) is semidet.
+
+catches -->
+ one_or_more(catch_clause).
+
+% CatchClause:
+% catch ( FormalParameter ) Block
+
+:- pred catch_clause(ps::in, ps::out) is semidet.
+
+catch_clause -->
+ keyword("catch"),
+ brackets(
+ "(",
+ formal_parameter,
+ ")"),
+ block.
+
+% SwitchBlockStatementGroups:
+% { SwitchBlockStatementGroup }
+
+:- pred switch_block_statement_groups(ps::in, ps::out) is det.
+
+switch_block_statement_groups -->
+ zero_or_more_det(switch_block_statement_group).
+
+% SwitchBlockStatementGroup:
+% SwitchLabel BlockStatements
+
+:- pred switch_block_statement_group(ps::in, ps::out) is semidet.
+
+switch_block_statement_group -->
+ switch_label,
+ block_statements.
+
+% SwitchLabel:
+% case ConstantExpression :
+% default:
+
+:- pred switch_label(ps::in, ps::out) is semidet.
+
+switch_label -->
+ ( if
+ keyword("case"),
+ constant_expression,
+ punct(":")
+ then
+ []
+ else
+ keyword("default"),
+ punct(":")
+ ).
+
+% MoreStatementExpressions:
+% { , StatementExpression }
+%
+% ForInit:
+% StatementExpression MoreStatementExpressions
+% [final] Type VariableDeclarators
+
+:- pred for_init(ps::in, ps::out) is semidet.
+
+for_init -->
+ ( if
+ comma_separated_list(for_init_statement_expression)
+ then
+ []
+ else
+ optional_det(keyword("final")),
+ java_type,
+ variable_declarators
+ ).
+
+:- pred for_init_statement_expression(ps::in, ps::out) is semidet.
+
+for_init_statement_expression -->
+ ( if
+ java_type,
+ java_identifier,
+ equals_variable_initializer
+ then
+ []
+ else
+ statement_expression
+ ).
+
+% ForUpdate:
+% StatementExpression MoreStatementExpressions
+
+:- pred for_update(ps::in, ps::out) is semidet.
+
+for_update -->
+ comma_separated_list(statement_expression).
+
+% ModifiersOpt:
+% { Modifier }
+
+:- pred modifiers_opt(ps::in, ps::out) is det.
+
+modifiers_opt -->
+ zero_or_more_det(modifier).
+
+% Modifier:
+% public
+% protected
+% private
+% static
+% abstract
+% final
+% native
+% synchronized
+% transient
+% volatile
+% strictfp
+
+:- pred modifier(ps::in, ps::out) is semidet.
+
+modifier -->
+ ( if
+ keyword("public")
+ then
+ []
+ else if
+ keyword("protected")
+ then
+ []
+ else if
+ keyword("private")
+ then
+ []
+ else if
+ keyword("static")
+ then
+ []
+ else if
+ keyword("abstract")
+ then
+ []
+ else if
+ keyword("final")
+ then
+ []
+ else if
+ keyword("native")
+ then
+ []
+ else if
+ keyword("synchronized")
+ then
+ []
+ else if
+ keyword("transient")
+ then
+ []
+ else if
+ keyword("volatile")
+ then
+ []
+ else
+ keyword("strictfp")
+ ).
+
+% VariableDeclarators:
+% VariableDeclarator { , VariableDeclarator }
+
+:- pred variable_declarators(ps::in, ps::out) is semidet.
+
+variable_declarators -->
+ comma_separated_list(variable_declarator).
+
+% ConstantDeclaratorsRest:
+% ConstantDeclaratorRest { , ConstantDeclarator }
+
+:- pred constant_declarators_rest(ps::in, ps::out) is semidet.
+
+constant_declarators_rest -->
+ comma_separated_list(constant_declarator_rest).
+
+% VariableDeclarator:
+% Identifier VariableDeclaratorRest
+
+:- pred variable_declarator(ps::in, ps::out) is semidet.
+
+variable_declarator -->
+ java_identifier,
+ variable_declarator_rest.
+
+% ConstantDeclarator:
+% Identifier ConstantDeclaratorRest
+
+:- pred constant_declarator(ps::in, ps::out) is semidet.
+
+:- pragma memo(constant_declarator/2, [allow_reset,
+ specified([addr, output])]).
+
+constant_declarator -->
+ java_identifier,
+ constant_declarator_rest.
+
+% VariableDeclaratorRest:
+% BracketsOpt [ = VariableInitializer]
+
+:- pred variable_declarator_rest(ps::in, ps::out) is det.
+
+variable_declarator_rest -->
+ brackets_opt,
+ optional_det(equals_variable_initializer).
+
+:- pred equals_variable_initializer(ps::in, ps::out) is semidet.
+
+equals_variable_initializer -->
+ punct("="),
+ variable_initializer.
+
+% ConstantDeclaratorRest:
+% BracketsOpt = VariableInitializer
+
+:- pred constant_declarator_rest(ps::in, ps::out) is semidet.
+
+constant_declarator_rest -->
+ brackets_opt,
+ punct("="),
+ variable_initializer.
+
+% VariableDeclaratorId:
+% Identifier BracketsOpt
+
+:- pred variable_declarator_id(ps::in, ps::out) is semidet.
+
+variable_declarator_id -->
+ java_identifier,
+ brackets_opt.
+
+% CompilationUnit:
+% [package QualifiedIdentifier ; ] {ImportDeclaration} {TypeDeclaration}
+
+:- pred compilation_unit(ps::in, ps::out) is semidet.
+
+compilation_unit -->
+ whitespace,
+ optional_det(package_declaration),
+ zero_or_more_det(import_declaration),
+ zero_or_more_det(type_declaration),
+ eof.
+
+:- pred package_declaration(ps::in, ps::out) is semidet.
+
+package_declaration -->
+ keyword("package"),
+ qualified_identifier,
+ punct(";").
+
+% ImportDeclaration:
+% import Identifier { . Identifier } [ . * ] ;
+
+:- pred import_declaration(ps::in, ps::out) is semidet.
+
+import_declaration -->
+ keyword("import"),
+ qualified_identifier,
+ optional_det(dot_star),
+ punct(";").
+
+:- pred dot_star(ps::in, ps::out) is semidet.
+
+dot_star -->
+ punct("."),
+ punct("*").
+
+% TypeDeclaration:
+% ClassOrInterfaceDeclaration
+
+:- pred type_declaration(ps::in, ps::out) is semidet.
+
+type_declaration -->
+ class_or_interface_declaration.
+
+% ClassOrInterfaceDeclaration:
+% ModifiersOpt (ClassDeclaration | InterfaceDeclaration)
+
+:- pred class_or_interface_declaration(ps::in, ps::out)
+ is semidet.
+
+class_or_interface_declaration -->
+ modifiers_opt,
+ ( if
+ class_declaration
+ then
+ []
+ else
+ interface_declaration
+ ).
+
+% ClassDeclaration:
+% class Identifier [extends Type] [implements TypeList] ClassBody
+
+:- pred class_declaration(ps::in, ps::out) is semidet.
+
+class_declaration -->
+ keyword("class"),
+ java_identifier,
+ optional_det(keyword("extends", java_type)),
+ optional_det(keyword("implements", java_type_list)),
+ class_body.
+
+% InterfaceDeclaration:
+% interface Identifier [extends TypeList] InterfaceBody
+
+:- pred interface_declaration(ps::in, ps::out) is semidet.
+
+interface_declaration -->
+ keyword("interface"),
+ java_identifier,
+ optional_det(keyword("extends", java_type_list)),
+ interface_body.
+
+% TypeList:
+% Type { , Type}
+
+:- pred java_type_list(ps::in, ps::out) is semidet.
+
+java_type_list -->
+ comma_separated_list(java_type).
+
+% ClassBody:
+% { {ClassBodyDeclaration} }
+
+:- pred class_body(ps::in, ps::out) is semidet.
+
+class_body -->
+ brackets_detarg(
+ "{",
+ zero_or_more_det(class_body_declaration),
+ "}").
+
+% InterfaceBody:
+% { {InterfaceBodyDeclaration} }
+
+:- pred interface_body(ps::in, ps::out) is semidet.
+
+interface_body -->
+ brackets_detarg(
+ "{",
+ zero_or_more_det(interface_body_declaration),
+ "}").
+
+% ClassBodyDeclaration:
+% ;
+% [static] Block
+% ModifiersOpt MemberDecl
+
+:- pred class_body_declaration(ps::in, ps::out) is semidet.
+
+class_body_declaration -->
+ ( if
+ punct(";")
+ then
+ []
+ else if
+ optional_det(keyword("static")),
+ block
+ then
+ []
+ else
+ modifiers_opt,
+ member_decl
+ ).
+
+% MemberDecl:
+% MethodOrFieldDecl
+% void Identifier MethodDeclaratorRest
+% Identifier ConstructorDeclaratorRest
+% ClassOrInterfaceDeclaration
+
+:- pred member_decl(ps::in, ps::out) is semidet.
+
+member_decl -->
+ ( if
+ class_or_interface_declaration
+ then
+ []
+ else if
+ method_or_field_decl
+ then
+ []
+ else if
+ keyword("void"),
+ java_identifier,
+ method_declarator_rest
+ then
+ []
+ else
+ java_identifier,
+ constructor_declarator_rest
+ ).
+
+% MethodOrFieldDecl:
+% Type Identifier MethodOrFieldRest
+
+:- pred method_or_field_decl(ps::in, ps::out) is semidet.
+
+method_or_field_decl -->
+ java_type,
+ java_identifier,
+ method_or_field_rest.
+
+% MethodOrFieldRest:
+% VariableDeclaratorRest
+% MethodDeclaratorRest
+% XXX First should be
+% VariableDeclaratorRest [',' VariableDeclarators]
+
+:- pred method_or_field_rest(ps::in, ps::out) is semidet.
+
+method_or_field_rest -->
+ ( if
+ method_declarator_rest
+ then
+ []
+ else
+ variable_declarator_rest,
+ ( if punct(",") then
+ variable_declarators
+ else
+ []
+ )
+ ).
+
+% InterfaceBodyDeclaration:
+% ;
+% ModifiersOpt InterfaceMemberDecl
+
+:- pred interface_body_declaration(ps::in, ps::out) is semidet.
+
+interface_body_declaration -->
+ ( if
+ punct(";")
+ then
+ []
+ else
+ modifiers_opt,
+ interface_member_decl
+ ).
+
+% InterfaceMemberDecl:
+% InterfaceMethodOrFieldDecl
+% void Identifier VoidInterfaceMethodDeclaratorRest
+% ClassOrInterfaceDeclaration
+
+:- pred interface_member_decl(ps::in, ps::out) is semidet.
+
+interface_member_decl -->
+ ( if
+ interface_method_or_field_decl
+ then
+ []
+ else if
+ keyword("void"),
+ java_identifier,
+ void_interface_method_declarator_rest
+ then
+ []
+ else
+ class_or_interface_declaration
+ ).
+
+% InterfaceMethodOrFieldDecl:
+% Type Identifier InterfaceMethodOrFieldRest
+
+:- pred interface_method_or_field_decl(ps::in, ps::out)
+ is semidet.
+
+interface_method_or_field_decl -->
+ java_type,
+ java_identifier,
+ interface_method_or_field_rest.
+
+% InterfaceMethodOrFieldRest:
+% ConstantDeclaratorsRest ;
+% InterfaceMethodDeclaratorRest
+
+:- pred interface_method_or_field_rest(ps::in, ps::out)
+ is semidet.
+
+interface_method_or_field_rest -->
+ ( if
+ constant_declarator_rest
+ then
+ []
+ else
+ interface_method_declarator_rest
+ ).
+
+% MethodDeclaratorRest:
+% FormalParameters BracketsOpt [throws QualifiedIdentifierList] ( MethodBody | ; )
+
+:- pred method_declarator_rest(ps::in, ps::out) is semidet.
+
+method_declarator_rest -->
+ formal_parameters,
+ brackets_opt,
+ optional_det(throws_qualified_identifier_list),
+ method_body_or_semicolon.
+
+:- pred method_body_or_semicolon(ps::in, ps::out) is semidet.
+
+method_body_or_semicolon -->
+ ( if
+ method_body
+ then
+ []
+ else
+ punct(";")
+ ).
+
+% VoidMethodDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] ( MethodBody | ; )
+
+:- pred void_method_declarator_rest(ps::in, ps::out) is semidet.
+
+void_method_declarator_rest -->
+ formal_parameters,
+ optional_det(throws_qualified_identifier_list),
+ method_body_or_semicolon.
+
+% InterfaceMethodDeclaratorRest:
+% FormalParameters BracketsOpt [throws QualifiedIdentifierList] ;
+
+:- pred interface_method_declarator_rest(ps::in, ps::out)
+ is semidet.
+
+interface_method_declarator_rest -->
+ formal_parameters,
+ brackets_opt,
+ optional_det(throws_qualified_identifier_list),
+ punct(";").
+
+% VoidInterfaceMethodDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] ;
+
+:- pred void_interface_method_declarator_rest(ps::in, ps::out)
+ is semidet.
+
+void_interface_method_declarator_rest -->
+ formal_parameters,
+ optional_det(throws_qualified_identifier_list),
+ punct(";").
+
+% ConstructorDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] MethodBody
+
+:- pred constructor_declarator_rest(ps::in, ps::out) is semidet.
+
+constructor_declarator_rest -->
+ formal_parameters,
+ optional_det(throws_qualified_identifier_list),
+ method_body.
+
+:- pred throws_qualified_identifier_list(ps::in, ps::out)
+ is semidet.
+
+throws_qualified_identifier_list -->
+ keyword("throws"),
+ qualified_identifier_list.
+
+% QualifiedIdentifierList:
+% QualifiedIdentifier { , QualifiedIdentifier}
+
+:- pred qualified_identifier_list(ps::in, ps::out) is semidet.
+
+qualified_identifier_list -->
+ comma_separated_list(qualified_identifier).
+
+% FormalParameters:
+% ( [FormalParameter { , FormalParameter}] )
+
+:- pred formal_parameters(ps::in, ps::out) is semidet.
+
+formal_parameters -->
+ brackets_detarg(
+ "(",
+ optional_det(comma_separated_list(formal_parameter)),
+ ")").
+
+% FormalParameter:
+% [final] Type VariableDeclaratorId
+
+:- pred formal_parameter(ps::in, ps::out) is semidet.
+
+formal_parameter -->
+ optional_det(keyword("final")),
+ java_type,
+ variable_declarator_id.
+
+% MethodBody:
+% Block
+
+:- pred method_body(ps::in, ps::out) is semidet.
+
+method_body -->
+ block.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred global_table_reset(io::di, io::uo) is det.
+
+global_table_reset(!IO) :-
+ table_reset_for_constant_declarator_2(!IO),
+ true.
Index: tests/tabling/mercury_java_parser_dead_proc_elim_bug2.exp
===================================================================
RCS file: tests/tabling/mercury_java_parser_dead_proc_elim_bug2.exp
diff -N tests/tabling/mercury_java_parser_dead_proc_elim_bug2.exp
Index: tests/tabling/mercury_java_parser_dead_proc_elim_bug2.m
===================================================================
RCS file: tests/tabling/mercury_java_parser_dead_proc_elim_bug2.m
diff -N tests/tabling/mercury_java_parser_dead_proc_elim_bug2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/mercury_java_parser_dead_proc_elim_bug2.m 9 Aug 2007 11:53:18 -0000
@@ -0,0 +1,2114 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+%
+% This is a regression test. In versions of the compiler before 9 Aug 2007,
+% it used to cause a compiler abort.
+%
+% The problem involved an unused procedure (in this case, the procedure
+% constant_declarators_rest) that was kept around so that the code generator
+% would create the table associated with it. Since the procedure was unused,
+% its body was thought to be unused too. If it contained a reference to a
+% procedure that wasn't referred to from anywhere else, that procedure
+% would be removed, leaving a dangling reference.
+%
+%-----------------------------------------------------------------------------%
+% mercury_java_parser_memoed.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Mon Feb 21 09:42:40 EST 2005
+%
+% Java grammar taken from
+% http://java.sun.com/docs/books/jls/second_edition/html/syntax.doc.html
+% and converted to Mercury DCGs. And then corrected because the grammar
+% at the above page contains bugs...
+%
+% Usage: parse_java <filename> ...
+%
+% This implementation only recognises Java programs; it does not construct an
+% ADT or perform any kind of analysis. However, it has been written in a
+% style that should make it fairly easy to add construction of an ADT.
+%
+% To compile this as a packrat parser, uncomment all of the pragma memo
+% lines.
+%
+% To compile this as a partial packrat parser, uncomment all of the
+% pragma memo lines except those for literal/2, qualified_identifier/2, and
+% punct/2.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mercury_java_parser_dead_proc_elim_bug2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module exception.
+:- import_module int.
+:- import_module list.
+:- import_module pair.
+:- import_module std_util.
+:- import_module string.
+
+ % The parser "state". This is just the offset into the input string,
+ % which (depending on the version) may be passed around or stored in
+ % a C global variable.
+ %
+ % We do the latter to (a) avoid memoizing the input string if we are
+ % memoing any rules and (b) to obtain a fair timing comparison with the
+ % Rats! Java parser (www.cs.nyu.edu/rgrimm/xtc/rats.html).
+ %
+:- type ps == int.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ list.foldl(parse_file, Args, !IO).
+
+:- pred parse_file(string::in, io::di, io::uo) is det.
+
+parse_file(Filename, !IO) :-
+ global_table_reset(!IO),
+ io.write_string(Filename, !IO),
+ io.see(Filename, _, !IO),
+ io.read_file_as_string(Result, !IO),
+ ( if Result = ok(Str) then
+ promise_pure ( impure set_input_string(Str),
+ ( if compilation_unit(0, _)
+ then
+ io.print(" parsed successfully\n", !IO)
+ else
+ io.print(" failed to parse\n", !IO)
+ )
+ )
+ else
+ throw(Result)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Low-level predicates.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+
+:- pragma foreign_decl("C", "
+
+ MR_String input_string = NULL;
+ MR_Word input_length = (MR_Word) 0;
+
+").
+
+%-----------------------------------------------------------------------------%
+
+:- impure pred set_input_string(string::in) is det.
+
+:- pragma foreign_proc("C",
+ set_input_string(Str::in),
+ [will_not_call_mercury],
+"
+ input_string = Str;
+ input_length = strlen(Str);
+").
+
+%-----------------------------------------------------------------------------%
+
+:- semipure pred input_string_and_length(string::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ input_string_and_length(Str::out, Length::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ Str = input_string;
+ Length = input_length;
+").
+
+
+%-----------------------------------------------------------------------------%
+
+:- pred current_offset(int::out, int::in, int::out) is det.
+
+current_offset(Offset, Offset, Offset).
+
+%-----------------------------------------------------------------------------%
+
+:- pred eof(ps::in, ps::out) is semidet.
+
+eof(Offset, Offset) :-
+ promise_pure ( semipure input_string_and_length(_Str, Length),
+ Offset = Length
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % XXX These are really semipure, but I'm being naughty and promising them
+ % to be pure because I don't want to pollute my code with impurity
+ % annotations.
+ %
+ % XXX Also, I do not check for negative offsets. I probably should.
+ %
+:- pred char(char::out, ps::in, ps::out) is semidet.
+
+char(Char, Offset, Offset + 1) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ Offset < Length,
+ Char = Str ^ unsafe_elem(Offset)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred input_substring(int::in, int::in, string::out,
+ ps::in, ps::out) is semidet.
+
+input_substring(Start, End, Substring, Offset, Offset) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ End =< Length,
+ Substring = unsafe_substring(Str, Start, End - Start)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred match_string(string::in, int::in, int::out) is semidet.
+
+match_string(MatchStr, Offset, Offset + N) :-
+ promise_pure ( semipure input_string_and_length(Str, Length),
+ N = length(MatchStr),
+ Offset + N =< Length,
+ match_string_2(0, N, MatchStr, Offset, Str)
+ ).
+
+:- pred match_string_2(int::in, int::in, string::in, int::in, string::in)
+ is semidet.
+
+match_string_2(I, N, MatchStr, Offset, Str) :-
+ ( if I < N then
+ MatchStr ^ unsafe_elem(I) = Str ^ unsafe_elem(Offset + I),
+ match_string_2(I + 1, N, MatchStr, Offset, Str)
+ else
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Utility predicates.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred optional(
+ pred(ps, ps):: in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+optional(P) -->
+ ( if P then
+ []
+ else
+ { semidet_succeed }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred zero_or_more(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+zero_or_more(P) -->
+ ( if P then
+ zero_or_more(P)
+ else
+ { semidet_succeed }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred one_or_more(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+one_or_more(P) -->
+ P,
+ zero_or_more(P).
+
+%-----------------------------------------------------------------------------%
+
+:- pred brackets(string::in,
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ string::in, ps::in, ps::out) is semidet.
+
+brackets(L, P, R) -->
+ punct(L),
+ P,
+ punct(R).
+
+%-----------------------------------------------------------------------------%
+
+:- pred seq(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+:- pragma inline(seq/4).
+
+seq(P, Q) -->
+ P,
+ Q.
+
+%-----------------------------------------------------------------------------%
+
+:- pred comma_separated_list(
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+comma_separated_list(P) -->
+ P,
+ zero_or_more(seq(punct(","), P)).
+
+%-----------------------------------------------------------------------------%
+
+:- pred whitespace(ps::in, ps::out) is semidet.
+
+whitespace -->
+ ( if char(C1), { char.is_whitespace(C1) } then
+ whitespace
+ else if char('/'), char('/') then
+ skip_to_eol,
+ whitespace
+ else if char('/'), char('*') then
+ skip_to_end_of_trad_comment,
+ whitespace
+ else
+ []
+ ).
+
+:- pred skip_to_eol(ps::in, ps::out) is semidet.
+
+skip_to_eol -->
+ char(C),
+ ( if { C = ('\n') } then
+ []
+ else
+ skip_to_eol
+ ).
+
+:- pred skip_to_end_of_trad_comment(ps::in, ps::out) is semidet.
+
+skip_to_end_of_trad_comment -->
+ ( if char('*'), char('/') then
+ []
+ else
+ char(_),
+ skip_to_end_of_trad_comment
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred punct(string::in, ps::in, ps::out) is semidet.
+
+punct(Punct) -->
+ match_string(Punct),
+ whitespace.
+
+%-----------------------------------------------------------------------------%
+
+:- pred keyword(string::in, ps::in, ps::out) is semidet.
+
+keyword(Keyword) -->
+ match_string(Keyword),
+ not(java_identifier_part),
+ whitespace.
+
+%-----------------------------------------------------------------------------%
+
+:- pred keyword(string::in,
+ pred(ps, ps)::in(pred(in, out) is semidet),
+ ps::in, ps::out) is semidet.
+
+keyword(Keyword, P) -->
+ match_string(Keyword),
+ not(java_identifier_part),
+ whitespace,
+ P.
+
+%-----------------------------------------------------------------------------%
+
+:- pred java_identifier( /*string::out,*/ ps::in, ps::out)
+ is semidet.
+
+
+java_identifier/*(Identifier)*/ -->
+% current_offset(Start),
+ java_identifier_start,
+ zero_or_more(java_identifier_part),
+% current_offset(End),
+% input_substring(Start, End, Identifier),
+ whitespace.
+
+:- pred java_identifier_start(ps::in, ps::out) is semidet.
+
+java_identifier_start -->
+ char(C),
+ { char.is_alpha_or_underscore(C) ; C = ('$') }.
+
+:- pred java_identifier_part(ps::in, ps::out) is semidet.
+
+java_identifier_part -->
+ char(C),
+ { char.is_alnum_or_underscore(C) ; C = ('$') }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred floating_point_literal(ps::in, ps::out) is semidet.
+
+floating_point_literal -->
+ ( if
+ optional(digits(10)),
+ char('.'),
+ digits(10)
+ then
+ optional(exponent_part),
+ optional(float_type_suffix)
+ else
+ digits(10),
+ ( if exponent_part then
+ optional(float_type_suffix)
+ else
+ float_type_suffix
+ )
+ ).
+
+:- pred exponent_part(ps::in, ps::out) is semidet.
+
+exponent_part -->
+ char(C),
+ { C = ('E') ; C = ('e') },
+ optional(sign),
+ one_or_more(digit(10)).
+
+:- pred sign(ps::in, ps::out) is semidet.
+
+sign -->
+ char(C),
+ { C = ('+') ; C = ('-') }.
+
+:- pred float_type_suffix(ps::in, ps::out) is semidet.
+
+float_type_suffix -->
+ char(C),
+ { C = ('F') ; C = ('f') ; C = ('D') ; C = ('d') }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred integer_literal(ps::in, ps::out) is semidet.
+
+integer_literal -->
+ ( if
+ hex_literal
+ then
+ []
+ else if
+ oct_literal
+ then
+ []
+ else
+ dec_literal
+ ).
+
+:- pred hex_literal(ps::in, ps::out) is semidet.
+
+hex_literal -->
+ char('0'),
+ char('x'),
+ digits(16),
+ optional(integer_type_suffix).
+
+:- pred oct_literal(ps::in, ps::out) is semidet.
+
+oct_literal -->
+ char('0'),
+ digits(8),
+ optional(integer_type_suffix).
+
+:- pred dec_literal(ps::in, ps::out) is semidet.
+
+dec_literal -->
+ ( if char('0') then
+ not digit(16)
+ else
+ digits(10)
+ ),
+ optional(integer_type_suffix).
+
+:- pred integer_type_suffix(ps::in, ps::out) is semidet.
+
+integer_type_suffix -->
+ char(C),
+ { C = ('L') ; C = ('l') }.
+
+:- pred digits(int::in, ps::in, ps::out) is semidet.
+
+digits(Base) -->
+ one_or_more(digit(Base)).
+
+:- pred digit(int::in, ps::in, ps::out) is semidet.
+
+digit(Base) -->
+ char(C),
+ { char.digit_to_int(C, D), D < Base }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred character_literal(ps::in, ps::out) is semidet.
+
+character_literal -->
+ char('\''),
+ not char('\''),
+ possibly_escaped_char,
+ char('\'').
+
+:- pred possibly_escaped_char(ps::in, ps::out) is semidet.
+
+possibly_escaped_char -->
+ char(C1),
+ ( if
+ { C1 = ('\\') }
+ then
+ ( if
+ digits(8)
+ then
+ []
+ else if
+ char('u'),
+ one_or_more(digits(16)) then
+ []
+ else
+ char(C2),
+ { member(C2,
+ [('b'), ('t'), ('n'), ('f'), ('r'), ('\"'), ('\''), ('\\')]) }
+ )
+ else
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred string_literal(ps::in, ps::out) is semidet.
+
+string_literal -->
+ char('\"'),
+ zero_or_more(string_char),
+ char('\"').
+
+:- pred string_char(ps::in, ps::out) is semidet.
+
+string_char -->
+ not(char('"')),
+ possibly_escaped_char.
+
+%-----------------------------------------------------------------------------%
+
+:- pred boolean_literal(ps::in, ps::out) is semidet.
+
+boolean_literal -->
+ ( if
+ keyword("true")
+ then
+ []
+ else
+ keyword("false")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred null_literal(ps::in, ps::out) is semidet.
+
+null_literal -->
+ keyword("null").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Taken from
+% http://java.sun.com/docs/books/jls/second_edition/html/syntax.doc.html
+
+% _________________________________________________________________
+%
+% [5]Contents | [6]Prev | [7]Next | [8]Index Java Language Specification
+% Second Edition
+%
+% [9]Copyright 2000 Sun Microsystems, Inc. All rights reserved
+% Please send any comments or corrections to the [10]JLS team
+
+% Syntax
+% _________________________________________________________________
+%
+% This chapter presents a grammar for the Java programming language.
+%
+% The grammar presented piecemeal in the preceding chapters is much
+% better for exposition, but it is not ideally suited as a basis for a
+% parser. The grammar presented in this chapter is the basis for the
+% reference implementation.
+%
+% The grammar below uses the following BNF-style conventions:
+%
+% * [x] denotes zero or one occurrences of x.
+% * {x} denotes zero or more occurrences of x.
+% * x | y means one of either x or y.
+
+% Identifier:
+% IDENTIFIER
+%
+% QualifiedIdentifier:
+% Identifier { . Identifier }
+
+:- pred qualified_identifier(ps::in, ps::out) is semidet.
+
+qualified_identifier -->
+ java_identifier,
+ zero_or_more(dot_java_identifier).
+
+:- pred dot_java_identifier(ps::in, ps::out) is semidet.
+
+dot_java_identifier -->
+ punct("."),
+ java_identifier.
+
+% Literal:
+% IntegerLiteral
+% FloatingPointLiteral
+% CharacterLiteral
+% StringLiteral
+% BooleanLiteral
+% NullLiteral
+
+:- pred literal(ps::in, ps::out) is semidet.
+
+literal -->
+ ( if
+ floating_point_literal
+ then
+ []
+ else if
+ integer_literal
+ then
+ []
+ else if
+ character_literal
+ then
+ []
+ else if
+ string_literal
+ then
+ []
+ else if
+ boolean_literal
+ then
+ []
+ else
+ null_literal
+ ),
+ whitespace.
+
+% Expression:
+% Expression1 [AssignmentOperator Expression1]]
+% XXX I think that should be
+% Expression1 {AssignmentOperator Expression1}
+
+:- pred expression(ps::in, ps::out) is semidet.
+
+expression -->
+ expression1,
+ zero_or_more(assignment_operator_expression1).
+
+:- pred assignment_operator_expression1(ps::in, ps::out)
+ is semidet.
+
+assignment_operator_expression1 -->
+ assignment_operator,
+ expression1.
+
+% AssignmentOperator:
+% =
+% +=
+% -=
+% *=
+% /=
+% &=
+% |=
+% ^=
+% %=
+% <<=
+% >>=
+% >>>=
+
+:- pred assignment_operator(ps::in, ps::out) is semidet.
+
+assignment_operator -->
+ ( if
+ punct("=")
+ then
+ []
+ else if
+ punct("+=")
+ then
+ []
+ else if
+ punct("-=")
+ then
+ []
+ else if
+ punct("*=")
+ then
+ []
+ else if
+ punct("/=")
+ then
+ []
+ else if
+ punct("&=")
+ then
+ []
+ else if
+ punct("|=")
+ then
+ []
+ else if
+ punct("^=")
+ then
+ []
+ else if
+ punct("%=")
+ then
+ []
+ else if
+ punct("<<=")
+ then
+ []
+ else if
+ punct(">>=")
+ then
+ []
+ else
+ punct(">>>=")
+ ).
+
+% Type:
+% Identifier { . Identifier } BracketsOpt
+% BasicType
+
+:- pred java_type(ps::in, ps::out) is semidet.
+
+java_type -->
+ ( if
+ qualified_identifier,
+ brackets_opt
+ then
+ []
+ else
+ basic_type
+ ).
+
+% StatementExpression:
+% Expression
+
+:- pred statement_expression(ps::in, ps::out) is semidet.
+
+statement_expression -->
+ expression.
+
+% ConstantExpression:
+% Expression
+
+:- pred constant_expression(ps::in, ps::out) is semidet.
+
+constant_expression -->
+ expression.
+
+% Expression1:
+% Expression2 [Expression1Rest]
+
+:- pred expression1(ps::in, ps::out) is semidet.
+
+expression1 -->
+ expression2,
+ optional(expression1_rest).
+
+% Expression1Rest:
+% [ ? Expression : Expression1]
+
+:- pred expression1_rest(ps::in, ps::out) is semidet.
+
+expression1_rest -->
+ punct("?"),
+ expression,
+ punct(":"),
+ expression1.
+
+% Expression2 :
+% Expression3 [Expression2Rest]
+
+:- pred expression2(ps::in, ps::out) is semidet.
+
+expression2 -->
+ expression3,
+ optional(expression2_rest).
+
+% Expression2Rest:
+% {Infixop Expression3}
+% Expression3 instanceof Type
+% XXX The Expression3 here must be wrong...
+% XXX And {Infixop Expression3} should be allowed after Type.
+
+:- pred expression2_rest(ps::in, ps::out) is semidet.
+
+expression2_rest -->
+ ( if
+ keyword("instanceof"),
+ java_type,
+ optional(expression2_rest)
+ then
+ []
+ else
+ zero_or_more(infix_op_expression3)
+ ).
+
+:- pred infix_op_expression3(ps::in, ps::out) is semidet.
+
+infix_op_expression3 -->
+ infix_op,
+ expression3.
+
+% Infixop:
+% ||
+% &&
+% |
+% ^
+% &
+% ==
+% !=
+% <
+% >
+% <=
+% >=
+% <<
+% >>
+% >>>
+% +
+% -
+% *
+% /
+% %
+
+:- pred infix_op(ps::in, ps::out) is semidet.
+
+infix_op -->
+ ( if
+ punct("||")
+ then
+ []
+ else if
+ punct("&&")
+ then
+ []
+ else if
+ punct("|")
+ then
+ []
+ else if
+ punct("^")
+ then
+ []
+ else if
+ punct("&")
+ then
+ []
+ else if
+ punct("==")
+ then
+ []
+ else if
+ punct("!=")
+ then
+ []
+ else if
+ punct("<=")
+ then
+ []
+ else if
+ punct(">=")
+ then
+ []
+ else if
+ punct("<<")
+ then
+ []
+ else if
+ punct(">>>")
+ then
+ []
+ else if
+ punct(">>")
+ then
+ []
+ else if
+ punct("<")
+ then
+ []
+ else if
+ punct(">")
+ then
+ []
+ else if
+ punct("+")
+ then
+ []
+ else if
+ punct("-")
+ then
+ []
+ else if
+ punct("*")
+ then
+ []
+ else if
+ punct("/")
+ then
+ []
+ else
+ punct("%")
+ ).
+
+% Expression3:
+% PrefixOp Expression3
+% ( Expr | Type ) Expression3
+% Primary {Selector} {PostfixOp}
+
+:- pred expression3(ps::in, ps::out) is semidet.
+
+expression3 -->
+ ( if
+ prefix_op,
+ expression3
+ then
+ []
+ else if
+ brackets(
+ "(",
+ expression_or_java_type,
+ ")"),
+ expression3
+ then
+ []
+ else
+ primary,
+ zero_or_more(selector),
+ zero_or_more(postfix_op)
+ ).
+
+:- pred expression_or_java_type(ps::in, ps::out) is semidet.
+
+expression_or_java_type -->
+ ( if
+ java_type
+ then
+ []
+ else
+ expression
+ ).
+
+% Primary:
+% ( Expression )
+% this [Arguments]
+% super SuperSuffix
+% Literal
+% new Creator
+% Identifier { . Identifier }[ IdentifierSuffix]
+% BasicType BracketsOpt .class
+% void.class
+
+:- pred primary(ps::in, ps::out) is semidet.
+
+primary -->
+ ( if
+ brackets(
+ "(",
+ expression,
+ ")")
+ then
+ []
+ else if
+ keyword("this"),
+ optional(arguments)
+ then
+ []
+ else if
+ keyword("super"),
+ super_suffix
+ then
+ []
+ else if
+ keyword("new"),
+ creator
+ then
+ []
+ else if
+ keyword("void"),
+ punct("."),
+ keyword("class")
+ then
+ []
+ else if
+ basic_type,
+ brackets_opt,
+ punct("."),
+ keyword("class")
+ then
+ []
+ else if
+ literal
+ then
+ []
+ else
+ qualified_identifier,
+ optional(identifier_suffix)
+ ).
+
+% XXX I don't understand how to read this rule:
+%
+% IdentifierSuffix:
+% [ ( ] BracketsOpt . class | Expression ])
+% Arguments
+% . ( class | this | super Arguments | new InnerCreator )
+
+:- pred identifier_suffix(ps::in, ps::out) is semidet.
+
+identifier_suffix -->
+ ( if
+ brackets_opt,
+ punct("."),
+ ( if
+ keyword("class")
+ then
+ []
+ else
+ expression
+ )
+ then
+ []
+ else if
+ arguments
+ then
+ []
+ else
+ punct("."),
+ ( if
+ keyword("class")
+ then
+ []
+ else if
+ keyword("this")
+ then
+ []
+ else if
+ keyword("super"),
+ arguments
+ then
+ []
+ else
+ keyword("new"),
+ inner_creator
+ )
+ ).
+
+% PrefixOp:
+% ,
+% --
+% !
+% ~
+% +
+% -
+
+:- pred prefix_op(ps::in, ps::out) is semidet.
+
+prefix_op -->
+ ( if
+ punct("++")
+ then
+ []
+ else if
+ punct("--")
+ then
+ []
+ else if
+ punct("!")
+ then
+ []
+ else if
+ punct("~")
+ then
+ []
+ else if
+ punct("+")
+ then
+ []
+ else
+ punct("-")
+ ).
+
+% PostfixOp:
+% ,
+% --
+
+:- pred postfix_op(ps::in, ps::out) is semidet.
+
+postfix_op -->
+ ( if
+ punct("++")
+ then
+ []
+ else
+ punct("--")
+ ).
+
+% Selector:
+% . Identifier [Arguments]
+% . this
+% . super SuperSuffix
+% . new InnerCreator
+% [ Expression ]
+
+:- pred selector(ps::in, ps::out) is semidet.
+
+selector -->
+ ( if
+ brackets(
+ "[",
+ expression,
+ "]")
+ then
+ []
+ else
+ punct("."),
+ ( if
+ keyword("this")
+ then
+ []
+ else if
+ keyword("super"),
+ super_suffix
+ then
+ []
+ else if
+ keyword("new"),
+ inner_creator
+ then
+ []
+ else
+ java_identifier,
+ optional(arguments)
+ )
+ ).
+
+% SuperSuffix:
+% Arguments
+% . Identifier [Arguments]
+
+:- pred super_suffix(ps::in, ps::out) is semidet.
+
+super_suffix -->
+ ( if
+ arguments
+ then
+ []
+ else
+ punct("."),
+ java_identifier,
+ optional(arguments)
+ ).
+
+% BasicType:
+% byte
+% short
+% char
+% int
+% long
+% float
+% double
+% boolean
+
+:- pred basic_type(ps::in, ps::out) is semidet.
+
+basic_type -->
+ ( if
+ punct("byte")
+ then
+ []
+ else if
+ punct("short")
+ then
+ []
+ else if
+ punct("char")
+ then
+ []
+ else if
+ punct("int")
+ then
+ []
+ else if
+ punct("long")
+ then
+ []
+ else if
+ punct("float")
+ then
+ []
+ else if
+ punct("double")
+ then
+ []
+ else
+ punct("boolean")
+ ).
+
+% Arguments:
+% ( [Expression { , Expression }] )
+
+:- pred arguments(ps::in, ps::out) is semidet.
+
+arguments -->
+ brackets(
+ "(",
+ optional(comma_separated_list(expression)),
+ ")").
+
+% BracketsOpt:
+% {[]}
+
+:- pred brackets_opt(ps::in, ps::out) is semidet.
+
+brackets_opt -->
+ zero_or_more(empty_brackets).
+
+:- pred empty_brackets(ps::in, ps::out) is semidet.
+
+empty_brackets -->
+ punct("["),
+ punct("]").
+
+% Creator:
+% QualifiedIdentifier ( ArrayCreatorRest | ClassCreatorRest )
+
+:- pred creator(ps::in, ps::out) is semidet.
+
+creator -->
+ qualified_identifier,
+ creator_rest.
+
+:- pred creator_rest(ps::in, ps::out) is semidet.
+
+creator_rest -->
+ ( if
+ array_creator_rest
+ then
+ []
+ else
+ class_creator_rest
+ ).
+
+% InnerCreator:
+% Identifier ClassCreatorRest
+
+:- pred inner_creator(ps::in, ps::out) is semidet.
+
+inner_creator -->
+ java_identifier,
+ class_creator_rest.
+
+% XXX I don't understand how to read this rule:
+%
+% ArrayCreatorRest:
+% [ ( ] BracketsOpt ArrayInitializer | Expression ] {[ Expression ]} BracketsOpt )
+
+:- pred array_creator_rest(ps::in, ps::out) is semidet.
+
+array_creator_rest -->
+ one_or_more(
+ brackets(
+ "[",
+ optional(expression),
+ "]")),
+ optional(array_initializer).
+
+% ClassCreatorRest:
+% Arguments [ClassBody]
+
+:- pred class_creator_rest(ps::in, ps::out) is semidet.
+
+class_creator_rest -->
+ arguments,
+ optional(class_body).
+
+% ArrayInitializer:
+% { [VariableInitializer {, VariableInitializer} [,]] }
+
+:- pred array_initializer(ps::in, ps::out) is semidet.
+
+array_initializer -->
+ brackets(
+ "{",
+ optional(array_initializer_body),
+ "}").
+
+:- pred array_initializer_body(ps::in, ps::out) is semidet.
+
+array_initializer_body -->
+ comma_separated_list(variable_initializer),
+ optional(punct(",")).
+
+% VariableInitializer:
+% ArrayInitializer
+% Expression
+
+:- pred variable_initializer(ps::in, ps::out) is semidet.
+
+variable_initializer -->
+ ( if
+ array_initializer
+ then
+ []
+ else
+ expression
+ ).
+
+% ParExpression:
+% ( Expression )
+
+:- pred par_expression(ps::in, ps::out) is semidet.
+
+par_expression -->
+ brackets(
+ "(",
+ expression,
+ ")").
+
+% Block:
+% { BlockStatements }
+
+:- pred block(ps::in, ps::out) is semidet.
+
+block -->
+ brackets(
+ "{",
+ block_statements,
+ "}").
+
+% BlockStatements:
+% { BlockStatement }
+
+:- pred block_statements(ps::in, ps::out) is semidet.
+
+block_statements -->
+ zero_or_more(block_statement).
+
+% BlockStatement :
+% LocalVariableDeclarationStatement
+% ClassOrInterfaceDeclaration
+% [Identifier :] Statement
+
+:- pred block_statement(ps::in, ps::out) is semidet.
+
+block_statement -->
+ ( if
+ local_variable_declaration_statement
+ then
+ []
+ else if
+ class_or_interface_declaration
+ then
+ []
+ else
+ optional(label),
+ statement
+ ).
+
+:- pred label(ps::in, ps::out) is semidet.
+
+label -->
+ java_identifier,
+ punct(":").
+
+% LocalVariableDeclarationStatement:
+% [final] Type VariableDeclarators ;
+% XXX I think this is wrong: [final] should be ModifiersOpt, surely?
+
+:- pred local_variable_declaration_statement(ps::in, ps::out)
+ is semidet.
+
+local_variable_declaration_statement -->
+ modifiers_opt,
+ java_type,
+ variable_declarators,
+ punct(";").
+
+% Statement:
+% Block
+% if ParExpression Statement [else if Statement]
+% for ( ForInitOpt ; [Expression] ; ForUpdateOpt ) Statement
+% while ParExpression Statement
+% do Statement while ParExpression ;
+% try Block ( Catches | [Catches] finally Block )
+% switch ParExpression { SwitchBlockStatementGroups }
+% synchronized ParExpression Block
+% return [Expression] ;
+% throw Expression ;
+% break [Identifier]
+% continue [Identifier]
+% ;
+% ExpressionStatement
+% Identifier : Statement
+
+:- pred statement(ps::in, ps::out) is semidet.
+
+statement -->
+ ( if
+ block
+ then
+ []
+ else if
+ keyword("if"),
+ par_expression,
+ statement,
+ optional(else_statement)
+ then
+ []
+ else if
+ keyword("for"),
+ punct("("),
+ optional(for_init),
+ punct(";"),
+ optional(expression),
+ punct(";"),
+ optional(for_update),
+ punct(")"),
+ statement
+ then
+ []
+ else if
+ keyword("while"),
+ par_expression,
+ statement
+ then
+ []
+ else if
+ keyword("do"),
+ statement,
+ keyword("while"),
+ par_expression,
+ punct(";")
+ then
+ []
+ else if
+ keyword("try"),
+ block,
+ catches_finally
+ then
+ []
+ else if
+ keyword("switch"),
+ par_expression,
+ brackets(
+ "{",
+ switch_block_statement_groups,
+ "}")
+ then
+ []
+ else if
+ keyword("synchronized"),
+ par_expression,
+ block
+ then
+ []
+ else if
+ keyword("return"),
+ optional(expression),
+ punct(";")
+ then
+ []
+ else if
+ keyword("throw"),
+ expression,
+ punct(";")
+ then
+ []
+ else if
+ keyword("break"),
+ optional(java_identifier),
+ punct(";")
+ then
+ []
+ else if
+ keyword("continue"),
+ optional(java_identifier),
+ punct(";")
+ then
+ []
+ else if
+ punct(";")
+ then
+ []
+ else if
+ expression,
+ punct(";")
+ then
+ []
+ else
+ java_identifier,
+ punct(":"),
+ statement
+ ).
+
+:- pred else_statement(ps::in, ps::out) is semidet.
+
+else_statement -->
+ keyword("else"),
+ statement.
+
+:- pred catches_finally(ps::in, ps::out) is semidet.
+
+catches_finally -->
+ ( if
+ catches,
+ optional(finally_block)
+ then
+ []
+ else
+ finally_block
+ ).
+
+:- pred finally_block(ps::in, ps::out) is semidet.
+
+finally_block -->
+ keyword("finally"),
+ block.
+
+% Catches:
+% CatchClause {CatchClause}
+
+:- pred catches(ps::in, ps::out) is semidet.
+
+catches -->
+ one_or_more(catch_clause).
+
+% CatchClause:
+% catch ( FormalParameter ) Block
+
+:- pred catch_clause(ps::in, ps::out) is semidet.
+
+catch_clause -->
+ keyword("catch"),
+ brackets(
+ "(",
+ formal_parameter,
+ ")"),
+ block.
+
+% SwitchBlockStatementGroups:
+% { SwitchBlockStatementGroup }
+
+:- pred switch_block_statement_groups(ps::in, ps::out) is semidet.
+
+switch_block_statement_groups -->
+ zero_or_more(switch_block_statement_group).
+
+% SwitchBlockStatementGroup:
+% SwitchLabel BlockStatements
+
+:- pred switch_block_statement_group(ps::in, ps::out) is semidet.
+
+switch_block_statement_group -->
+ switch_label,
+ block_statements.
+
+% SwitchLabel:
+% case ConstantExpression :
+% default:
+
+:- pred switch_label(ps::in, ps::out) is semidet.
+
+switch_label -->
+ ( if
+ keyword("case"),
+ constant_expression,
+ punct(":")
+ then
+ []
+ else
+ keyword("default"),
+ punct(":")
+ ).
+
+% MoreStatementExpressions:
+% { , StatementExpression }
+%
+% ForInit:
+% StatementExpression MoreStatementExpressions
+% [final] Type VariableDeclarators
+
+:- pred for_init(ps::in, ps::out) is semidet.
+
+for_init -->
+ ( if
+ comma_separated_list(for_init_statement_expression)
+ then
+ []
+ else
+ optional(keyword("final")),
+ java_type,
+ variable_declarators
+ ).
+
+:- pred for_init_statement_expression(ps::in, ps::out) is semidet.
+
+for_init_statement_expression -->
+ ( if
+ java_type,
+ java_identifier,
+ equals_variable_initializer
+ then
+ []
+ else
+ statement_expression
+ ).
+
+% ForUpdate:
+% StatementExpression MoreStatementExpressions
+
+:- pred for_update(ps::in, ps::out) is semidet.
+
+for_update -->
+ comma_separated_list(statement_expression).
+
+% ModifiersOpt:
+% { Modifier }
+
+:- pred modifiers_opt(ps::in, ps::out) is semidet.
+
+modifiers_opt -->
+ zero_or_more(modifier).
+
+% Modifier:
+% public
+% protected
+% private
+% static
+% abstract
+% final
+% native
+% synchronized
+% transient
+% volatile
+% strictfp
+
+:- pred modifier(ps::in, ps::out) is semidet.
+
+modifier -->
+ ( if
+ keyword("public")
+ then
+ []
+ else if
+ keyword("protected")
+ then
+ []
+ else if
+ keyword("private")
+ then
+ []
+ else if
+ keyword("static")
+ then
+ []
+ else if
+ keyword("abstract")
+ then
+ []
+ else if
+ keyword("final")
+ then
+ []
+ else if
+ keyword("native")
+ then
+ []
+ else if
+ keyword("synchronized")
+ then
+ []
+ else if
+ keyword("transient")
+ then
+ []
+ else if
+ keyword("volatile")
+ then
+ []
+ else
+ keyword("strictfp")
+ ).
+
+% VariableDeclarators:
+% VariableDeclarator { , VariableDeclarator }
+
+:- pred variable_declarators(ps::in, ps::out) is semidet.
+
+variable_declarators -->
+ comma_separated_list(variable_declarator).
+
+% ConstantDeclaratorsRest:
+% ConstantDeclaratorRest { , ConstantDeclarator }
+
+:- pred constant_declarators_rest(ps::in, ps::out) is semidet.
+
+:- pragma memo(constant_declarators_rest/2, [allow_reset,
+ specified([addr, output])]).
+
+constant_declarators_rest -->
+ comma_separated_list(constant_declarator_rest).
+
+% VariableDeclarator:
+% Identifier VariableDeclaratorRest
+
+:- pred variable_declarator(ps::in, ps::out) is semidet.
+
+variable_declarator -->
+ java_identifier,
+ variable_declarator_rest.
+
+% ConstantDeclarator:
+% Identifier ConstantDeclaratorRest
+
+:- pred constant_declarator(ps::in, ps::out) is semidet.
+
+constant_declarator -->
+ java_identifier,
+ constant_declarator_rest.
+
+% VariableDeclaratorRest:
+% BracketsOpt [ = VariableInitializer]
+
+:- pred variable_declarator_rest(ps::in, ps::out) is semidet.
+
+variable_declarator_rest -->
+ brackets_opt,
+ optional(equals_variable_initializer).
+
+:- pred equals_variable_initializer(ps::in, ps::out) is semidet.
+
+equals_variable_initializer -->
+ punct("="),
+ variable_initializer.
+
+% ConstantDeclaratorRest:
+% BracketsOpt = VariableInitializer
+
+:- pred constant_declarator_rest(ps::in, ps::out) is semidet.
+
+constant_declarator_rest -->
+ brackets_opt,
+ punct("="),
+ variable_initializer.
+
+% VariableDeclaratorId:
+% Identifier BracketsOpt
+
+:- pred variable_declarator_id(ps::in, ps::out) is semidet.
+
+variable_declarator_id -->
+ java_identifier,
+ brackets_opt.
+
+% CompilationUnit:
+% [package QualifiedIdentifier ; ] {ImportDeclaration} {TypeDeclaration}
+
+:- pred compilation_unit(ps::in, ps::out) is semidet.
+
+compilation_unit -->
+ whitespace,
+ optional(package_declaration),
+ zero_or_more(import_declaration),
+ zero_or_more(type_declaration),
+ eof.
+
+:- pred package_declaration(ps::in, ps::out) is semidet.
+
+package_declaration -->
+ keyword("package"),
+ qualified_identifier,
+ punct(";").
+
+% ImportDeclaration:
+% import Identifier { . Identifier } [ . * ] ;
+
+:- pred import_declaration(ps::in, ps::out) is semidet.
+
+import_declaration -->
+ keyword("import"),
+ qualified_identifier,
+ optional(dot_star),
+ punct(";").
+
+:- pred dot_star(ps::in, ps::out) is semidet.
+
+dot_star -->
+ punct("."),
+ punct("*").
+
+% TypeDeclaration:
+% ClassOrInterfaceDeclaration
+
+:- pred type_declaration(ps::in, ps::out) is semidet.
+
+type_declaration -->
+ class_or_interface_declaration.
+
+% ClassOrInterfaceDeclaration:
+% ModifiersOpt (ClassDeclaration | InterfaceDeclaration)
+
+:- pred class_or_interface_declaration(ps::in, ps::out)
+ is semidet.
+
+class_or_interface_declaration -->
+ modifiers_opt,
+ ( if
+ class_declaration
+ then
+ []
+ else
+ interface_declaration
+ ).
+
+% ClassDeclaration:
+% class Identifier [extends Type] [implements TypeList] ClassBody
+
+:- pred class_declaration(ps::in, ps::out) is semidet.
+
+class_declaration -->
+ keyword("class"),
+ java_identifier,
+ optional(keyword("extends", java_type)),
+ optional(keyword("implements", java_type_list)),
+ class_body.
+
+% InterfaceDeclaration:
+% interface Identifier [extends TypeList] InterfaceBody
+
+:- pred interface_declaration(ps::in, ps::out) is semidet.
+
+interface_declaration -->
+ keyword("interface"),
+ java_identifier,
+ optional(keyword("extends", java_type_list)),
+ interface_body.
+
+% TypeList:
+% Type { , Type}
+
+:- pred java_type_list(ps::in, ps::out) is semidet.
+
+java_type_list -->
+ comma_separated_list(java_type).
+
+% ClassBody:
+% { {ClassBodyDeclaration} }
+
+:- pred class_body(ps::in, ps::out) is semidet.
+
+class_body -->
+ brackets(
+ "{",
+ zero_or_more(class_body_declaration),
+ "}").
+
+% InterfaceBody:
+% { {InterfaceBodyDeclaration} }
+
+:- pred interface_body(ps::in, ps::out) is semidet.
+
+interface_body -->
+ brackets(
+ "{",
+ zero_or_more(interface_body_declaration),
+ "}").
+
+% ClassBodyDeclaration:
+% ;
+% [static] Block
+% ModifiersOpt MemberDecl
+
+:- pred class_body_declaration(ps::in, ps::out) is semidet.
+
+class_body_declaration -->
+ ( if
+ punct(";")
+ then
+ []
+ else if
+ optional(keyword("static")),
+ block
+ then
+ []
+ else
+ modifiers_opt,
+ member_decl
+ ).
+
+% MemberDecl:
+% MethodOrFieldDecl
+% void Identifier MethodDeclaratorRest
+% Identifier ConstructorDeclaratorRest
+% ClassOrInterfaceDeclaration
+
+:- pred member_decl(ps::in, ps::out) is semidet.
+
+member_decl -->
+ ( if
+ class_or_interface_declaration
+ then
+ []
+ else if
+ method_or_field_decl
+ then
+ []
+ else if
+ keyword("void"),
+ java_identifier,
+ method_declarator_rest
+ then
+ []
+ else
+ java_identifier,
+ constructor_declarator_rest
+ ).
+
+% MethodOrFieldDecl:
+% Type Identifier MethodOrFieldRest
+
+:- pred method_or_field_decl(ps::in, ps::out) is semidet.
+
+method_or_field_decl -->
+ java_type,
+ java_identifier,
+ method_or_field_rest.
+
+% MethodOrFieldRest:
+% VariableDeclaratorRest
+% MethodDeclaratorRest
+% XXX First should be
+% VariableDeclaratorRest [',' VariableDeclarators]
+
+:- pred method_or_field_rest(ps::in, ps::out) is semidet.
+
+method_or_field_rest -->
+ ( if
+ method_declarator_rest
+ then
+ []
+ else
+ variable_declarator_rest,
+ ( if punct(",") then
+ variable_declarators
+ else
+ []
+ )
+ ).
+
+% InterfaceBodyDeclaration:
+% ;
+% ModifiersOpt InterfaceMemberDecl
+
+:- pred interface_body_declaration(ps::in, ps::out) is semidet.
+
+interface_body_declaration -->
+ ( if
+ punct(";")
+ then
+ []
+ else
+ modifiers_opt,
+ interface_member_decl
+ ).
+
+% InterfaceMemberDecl:
+% InterfaceMethodOrFieldDecl
+% void Identifier VoidInterfaceMethodDeclaratorRest
+% ClassOrInterfaceDeclaration
+
+:- pred interface_member_decl(ps::in, ps::out) is semidet.
+
+interface_member_decl -->
+ ( if
+ interface_method_or_field_decl
+ then
+ []
+ else if
+ keyword("void"),
+ java_identifier,
+ void_interface_method_declarator_rest
+ then
+ []
+ else
+ class_or_interface_declaration
+ ).
+
+% InterfaceMethodOrFieldDecl:
+% Type Identifier InterfaceMethodOrFieldRest
+
+:- pred interface_method_or_field_decl(ps::in, ps::out)
+ is semidet.
+
+interface_method_or_field_decl -->
+ java_type,
+ java_identifier,
+ interface_method_or_field_rest.
+
+% InterfaceMethodOrFieldRest:
+% ConstantDeclaratorsRest ;
+% InterfaceMethodDeclaratorRest
+
+:- pred interface_method_or_field_rest(ps::in, ps::out)
+ is semidet.
+
+interface_method_or_field_rest -->
+ ( if
+ constant_declarator_rest
+ then
+ []
+ else
+ interface_method_declarator_rest
+ ).
+
+% MethodDeclaratorRest:
+% FormalParameters BracketsOpt [throws QualifiedIdentifierList] ( MethodBody | ; )
+
+:- pred method_declarator_rest(ps::in, ps::out) is semidet.
+
+method_declarator_rest -->
+ formal_parameters,
+ brackets_opt,
+ optional(throws_qualified_identifier_list),
+ method_body_or_semicolon.
+
+:- pred method_body_or_semicolon(ps::in, ps::out) is semidet.
+
+method_body_or_semicolon -->
+ ( if
+ method_body
+ then
+ []
+ else
+ punct(";")
+ ).
+
+% VoidMethodDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] ( MethodBody | ; )
+
+:- pred void_method_declarator_rest(ps::in, ps::out) is semidet.
+
+void_method_declarator_rest -->
+ formal_parameters,
+ optional(throws_qualified_identifier_list),
+ method_body_or_semicolon.
+
+% InterfaceMethodDeclaratorRest:
+% FormalParameters BracketsOpt [throws QualifiedIdentifierList] ;
+
+:- pred interface_method_declarator_rest(ps::in, ps::out)
+ is semidet.
+
+interface_method_declarator_rest -->
+ formal_parameters,
+ brackets_opt,
+ optional(throws_qualified_identifier_list),
+ punct(";").
+
+% VoidInterfaceMethodDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] ;
+
+:- pred void_interface_method_declarator_rest(ps::in, ps::out)
+ is semidet.
+
+void_interface_method_declarator_rest -->
+ formal_parameters,
+ optional(throws_qualified_identifier_list),
+ punct(";").
+
+% ConstructorDeclaratorRest:
+% FormalParameters [throws QualifiedIdentifierList] MethodBody
+
+:- pred constructor_declarator_rest(ps::in, ps::out) is semidet.
+
+constructor_declarator_rest -->
+ formal_parameters,
+ optional(throws_qualified_identifier_list),
+ method_body.
+
+:- pred throws_qualified_identifier_list(ps::in, ps::out)
+ is semidet.
+
+throws_qualified_identifier_list -->
+ keyword("throws"),
+ qualified_identifier_list.
+
+% QualifiedIdentifierList:
+% QualifiedIdentifier { , QualifiedIdentifier}
+
+:- pred qualified_identifier_list(ps::in, ps::out) is semidet.
+
+qualified_identifier_list -->
+ comma_separated_list(qualified_identifier).
+
+% FormalParameters:
+% ( [FormalParameter { , FormalParameter}] )
+
+:- pred formal_parameters(ps::in, ps::out) is semidet.
+
+formal_parameters -->
+ brackets(
+ "(",
+ optional(
+ comma_separated_list(formal_parameter)),
+ ")").
+
+% FormalParameter:
+% [final] Type VariableDeclaratorId
+
+:- pred formal_parameter(ps::in, ps::out) is semidet.
+
+formal_parameter -->
+ optional(keyword("final")),
+ java_type,
+ variable_declarator_id.
+
+% MethodBody:
+% Block
+
+:- pred method_body(ps::in, ps::out) is semidet.
+
+method_body -->
+ block.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred global_table_reset(io::di, io::uo) is det.
+
+global_table_reset(!IO) :-
+ table_reset_for_constant_declarators_rest_2(!IO),
+ true.
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.38
diff -u -r1.38 Mercury.options
--- tests/valid/Mercury.options 8 Aug 2007 05:08:44 -0000 1.38
+++ tests/valid/Mercury.options 9 Aug 2007 14:54:11 -0000
@@ -79,7 +79,6 @@
MCFLAGS-mc_graph = --prop-mode-constraints
MCFLAGS-mc_hhf_nonlocals_bug = --prop-mode-constraints
MCFLAGS-mc_implied_modes = --prop-mode-constraints
-MCFLAGS-mercury_java_parser_dead_proc_elim_bug = --no-target-code-only
MCFLAGS-middle_rec_labels = --middle-rec
MCFLAGS-mostly_uniq_mode_inf = --infer-all
MCFLAGS-mpj6 = --infer-all
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.192
diff -u -r1.192 Mmakefile
--- tests/valid/Mmakefile 8 Aug 2007 05:08:44 -0000 1.192
+++ tests/valid/Mmakefile 9 Aug 2007 14:54:21 -0000
@@ -241,7 +241,6 @@
#
TABLE_PROGS=\
table_wrong_func_arity \
- mercury_java_parser_dead_proc_elim_bug \
mercury_java_parser_follow_code_bug
# These tests only work in grades that support parallel conjunction.
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