for review: Aditi round 2 [2]
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Jul 30 13:44:44 AEST 1998
Index: options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.238
diff -u -t -u -r1.238 options.m
--- options.m 1998/07/28 23:38:16 1.238
+++ options.m 1998/07/29 05:00:11
@@ -72,6 +72,8 @@
; debug_opt
; debug_vn % vn = value numbering
; debug_pd % pd = partial deduction/deforestation
+ ; debug_rl_gen
+ ; debug_rl_opt
% Output options
; make_short_interface
; make_interface
@@ -86,6 +88,7 @@
; errorcheck_only
; compile_to_c
; compile_only
+ ; aditi_only
; output_grade_string
% Auxiliary output options
; assume_gmake
@@ -98,6 +101,9 @@
; show_dependency_graph
; dump_hlds
; verbose_dump_hlds
+ ; generate_schemas
+ ; dump_rl
+ ; dump_rl_bytecode
% Language semantics options
; reorder_conj
; reorder_disj
@@ -185,7 +191,6 @@
; cflags_for_gotos
; c_debug
; c_include_directory
- ; aditi
; fact_table_max_array_size
% maximum number of elements in a single
% fact table data array
@@ -266,6 +271,11 @@
; optimize_vnrepeat
; pred_value_number
; vn_fudge
+ % - RL
+ ; optimize_rl
+ ; optimize_rl_cse
+ ; optimize_rl_invariants
+ ; detect_rl_streams
% - C
; use_macro_for_redo_fail
; emit_c_loops
@@ -284,7 +294,10 @@
; search_directories
; intermod_directories
; use_search_directories_for_intermod
+ ; filenames_from_stdin
; use_subdirs
+ ; aditi
+ ; aditi_user
; help.
:- implementation.
@@ -349,7 +362,9 @@
debug_det - bool(no),
debug_opt - bool(no),
debug_vn - int(0),
- debug_pd - bool(no)
+ debug_pd - bool(no),
+ debug_rl_gen - bool(no),
+ debug_rl_opt - bool(no)
]).
option_defaults_2(output_option, [
% Output Options (mutually exclusive)
@@ -366,6 +381,7 @@
errorcheck_only - bool(no),
compile_to_c - bool(no),
compile_only - bool(no),
+ aditi_only - bool(no),
output_grade_string - bool(no)
]).
option_defaults_2(aux_output_option, [
@@ -379,7 +395,10 @@
auto_comments - bool(no),
show_dependency_graph - bool(no),
dump_hlds - accumulating([]),
- verbose_dump_hlds - string("")
+ verbose_dump_hlds - string(""),
+ dump_rl - bool(no),
+ dump_rl_bytecode - bool(no),
+ generate_schemas - bool(no)
]).
option_defaults_2(language_semantics_option, [
strict_sequential - special,
@@ -480,7 +499,6 @@
% the `mmc' script will override the
% above default with a value determined
% at configuration time
- aditi - bool(no),
fact_table_max_array_size - int(1024),
fact_table_hash_percent_full - int(90)
]).
@@ -581,7 +599,12 @@
procs_per_c_function - int(1),
everything_in_one_c_function - special,
c_optimize - bool(no),
- inline_alloc - bool(no)
+ inline_alloc - bool(no),
+% RL - not yet implemented
+ optimize_rl - bool(no),
+ optimize_rl_cse - bool(no),
+ optimize_rl_invariants - bool(no),
+ detect_rl_streams - bool(no)
]).
option_defaults_2(link_option, [
% Link Options
@@ -597,11 +620,14 @@
option_defaults_2(miscellaneous_option, [
% Miscellaneous Options
heap_space - int(0),
+ filenames_from_stdin - bool(no),
search_directories - accumulating(["."]),
intermod_directories - accumulating([]),
use_search_directories_for_intermod
- bool(yes),
use_subdirs - bool(no),
+ aditi - bool(no),
+ aditi_user - string(""),
help - bool(no)
]).
@@ -664,6 +690,8 @@
long_option("debug-opt", debug_opt).
long_option("debug-vn", debug_vn).
long_option("debug-pd", debug_pd).
+long_option("debug-rl-gen", debug_rl_gen).
+long_option("debug-rl-opt", debug_rl_opt).
% output options (mutually exclusive)
long_option("generate-dependencies", generate_dependencies).
@@ -694,6 +722,7 @@
long_option("compile-to-c", compile_to_c).
long_option("compile-to-C", compile_to_c).
long_option("compile-only", compile_only).
+long_option("aditi-only", aditi_only).
long_option("output-grade-string", output_grade_string).
% aux output options
@@ -708,6 +737,9 @@
long_option("show-dependency-graph", show_dependency_graph).
long_option("dump-hlds", dump_hlds).
long_option("verbose-dump-hlds", verbose_dump_hlds).
+long_option("dump-rl", dump_rl).
+long_option("dump-rl-bytecode", dump_rl_bytecode).
+long_option("generate-schemas", generate_schemas).
% language semantics options
long_option("reorder-conj", reorder_conj).
@@ -905,6 +937,12 @@
long_option("pred-value-number", pred_value_number).
long_option("vn-fudge", vn_fudge).
+% RL optimizations
+long_option("optimize-rl", optimize_rl).
+long_option("optimize-rl-cse", optimize_rl_cse).
+long_option("optimize-rl-invariants", optimize_rl_invariants).
+long_option("detect-rl-streams", detect_rl_streams).
+
% LLDS->C optimizations
long_option("use-macro-for-redo-fail", use_macro_for_redo_fail).
long_option("emit-c-loops", emit_c_loops).
@@ -932,7 +970,10 @@
long_option("intermod-directory", intermod_directories).
long_option("use-search-directories-for-intermod",
use_search_directories_for_intermod).
+long_option("filenames-from-stdin", filenames_from_stdin).
long_option("use-subdirs", use_subdirs).
+long_option("aditi", aditi).
+long_option("aditi-user", aditi_user).
%-----------------------------------------------------------------------------%
@@ -1206,6 +1247,7 @@
options_help_hlds_hlds_optimization,
options_help_hlds_llds_optimization,
options_help_llds_llds_optimization,
+ options_help_rl_rl_optimization,
options_help_output_optimization,
options_help_object_optimization,
options_help_link,
@@ -1299,6 +1341,12 @@
"--debug-pd",
"\tOutput detailed debugging traces of the partial",
"\tdeduction and deforestation process."
+/***** ADITI is not yet useful
+ "--debug-rl-gen",
+ "\tOutput detailed debugging traces of Aditi-RL code generation.",
+ "--debug-rl-opt",
+ "\tOutput detailed debugging traces of Aditi-RL optimization."
+*****/
]).
:- pred options_help_output(io__state::di, io__state::uo) is det.
@@ -1354,6 +1402,11 @@
"-c, --compile-only",
"\tGenerate C code in `<module>.c' and object code in `<module>.o'",
"\tbut do not attempt to link the named modules.",
+/***** ADITI is not yet useful.
+ "--aditi-only"),
+ "\tWrite Aditi-RL bytecode to `<module>.rlo' and",
+ "\tdo not compile to C.",
+*****/
"\t--output-grade-string",
"\tCompute the grade of the library to link with based on",
"\tthe command line options, and print it to the standard",
@@ -1401,6 +1454,21 @@
"\tEach type of detail is included in the dump if its",
"\tcorresponding letter occurs in the option argument",
"\t(see the Mercury User's Guide for details)."
+/***** ADITI is not yet useful.
+ "--dump-rl",
+ "\tOutput a human readable form of the compiler's internal",
+ "\trepresentation of the generated Aditi-RL to `<module>.rl_dump'.",
+ "--dump-rl-bytecode",
+ "\tOutput a human readable representation of the generated",
+ "\tAditi-RL bytecodes to `<module>.rla'.",
+ "\tAditi-RL bytecodes are directly executed by the Aditi system.",
+ "--generate-schemas",
+ "\tOutput schema strings for Aditi base relations",
+ "\tto `<module>.base_schema' and for Aditi derived",
+ "\trelations to `<module>.derived_schema'.",
+ "\tA schema string is a representation of the types",
+ "\tof a relation."
+*****/
]).
:- pred options_help_semantics(io__state::di, io__state::uo) is det.
@@ -1900,6 +1968,26 @@
"\tExtend value numbering to entire predicates."
]).
+:- pred options_help_rl_rl_optimization(io__state::di, io__state::uo) is det.
+
+options_help_rl_rl_optimization -->
+ [].
+/***** ADITI is not yet useful
+ io__write_string("\n Aditi-RL optimizations:\n"),
+ write_tabbed_lines([
+ "--optimize-rl",
+ "\tEnable the optimizations of Aditi-RL procedures",
+ "\tdescribed below.",
+ "--optimize-rl-cse",
+ "\tOptimize common subexpressions in Aditi-RL procedures.",
+ "\t--optimize-rl-invariants",
+ "\tOptimize loop invariants in Aditi-RL procedures.",
+ "\t--detect-rl-streams",
+ "\tDetect cases where intermediate results in Aditi-RL",
+ "\tprocedures do not need to be materialised."
+ ]).
+*****/
+
:- pred options_help_output_optimization(io__state::di, io__state::uo) is det.
options_help_output_optimization -->
@@ -1983,7 +2071,27 @@
"\tdirectories given by `--intermod-directory'.",
"--use-subdirs",
"\tGenerate intermediate files in a `Mercury' subdirectory,",
- "\trather than generating them in the current directory."
+ "\trather than generating them in the current directory.",
+ "--filenames-from-stdin",
+ "\tRead then compile a newline terminated module name or",
+ "\tfile name from the standard input. Repeat this until EOF",
+ "\tis reached. (This allows a program or user to interactively",
+ "\tcompile several modules without the overhead of process",
+ "\tcreation for each one.)"
+/***** ADITI is not yet useful.
+ "--aditi",
+ "\tEnable Aditi compilation. You need to enable this",
+ "\toption if you are making use of the Aditi deductive",
+ "\tdatabase interface.",
+ "--aditi-user",
+ "\tSpecify the Aditi login of the owner of the predicates",
+ "\tin any Aditi RL files produced. The owner field is",
+ "\tused along with module, name and arity to identify",
+ "\tpredicates, and is also used for security checks.",
+ "\tDefaults to the value of the `USER' environment",
+ "\tvariable. If `$USER' is not set, `--aditi-user'",
+ "\tdefaults to the string ""guest"".".
+*****/
]).
:- pred write_tabbed_lines(list(string), io__state, io__state).
Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.139
diff -u -t -u -r1.139 polymorphism.m
--- polymorphism.m 1998/07/08 20:57:03 1.139
+++ polymorphism.m 1998/07/21 03:43:15
@@ -305,13 +305,35 @@
:- module polymorphism.
:- interface.
-:- import_module hlds_module, prog_data.
-:- import_module io.
+:- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
+:- import_module io, list, term.
:- pred polymorphism__process_module(module_info, module_info,
io__state, io__state).
:- mode polymorphism__process_module(in, out, di, uo) is det.
+% Given a list of types, create a list of variables to hold the type_info
+% for those types, and create a list of goals to initialize those type_info
+% variables to the appropriate type_info structures for the types.
+% Update the varset and vartypes accordingly.
+
+:- pred polymorphism__make_type_info_vars(list(type), existq_tvars,
+ term__context, list(var), list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__make_type_info_vars(in, in, in, out, out, in, out) is det.
+
+:- type poly_info.
+
+ % Extract some fields from a pred_info and proc_info for use
+ % by the polymorphism transformation.
+:- pred init_poly_info(module_info, pred_info, proc_info, poly_info).
+:- mode init_poly_info(in, in, in, out) is det.
+
+ % Update the fields in a pred_info and proc_info with
+ % the values in a poly_info.
+:- pred poly_info_extract(poly_info, pred_info, pred_info,
+ proc_info, proc_info, module_info).
+:- mode poly_info_extract(in, in, out, in, out, out) is det.
+
% unsafe_type_cast and unsafe_promise_unique are polymorphic
% builtins which do not need their type_infos. unsafe_type_cast
% can be introduced by common.m after polymorphism is run, so it
@@ -326,13 +348,13 @@
:- implementation.
-:- import_module hlds_pred, hlds_goal, hlds_data, llds, (lambda).
+:- import_module hlds_data, llds, (lambda).
:- import_module type_util, mode_util, quantification, instmap.
:- import_module code_util, unify_proc, special_pred, prog_util, make_hlds.
:- import_module (inst), hlds_out, base_typeclass_info, goal_util, passes_aux.
-:- import_module bool, int, string, list, set, map.
-:- import_module term, varset, std_util, require, assoc_list.
+:- import_module bool, int, string, set, map.
+:- import_module varset, std_util, require, assoc_list.
%-----------------------------------------------------------------------------%
@@ -351,8 +373,12 @@
IO0, IO),
module_info_preds(ModuleInfo1, Preds1),
map__keys(Preds1, PredIds1),
+
polymorphism__fixup_preds(PredIds1, ModuleInfo1, ModuleInfo2),
- polymorphism__expand_class_method_bodies(ModuleInfo2, ModuleInfo).
+ polymorphism__expand_class_method_bodies(ModuleInfo2, ModuleInfo3),
+
+ % Need update the dependency graph to include the lambda predicates.
+ module_info_clobber_dependency_info(ModuleInfo3, ModuleInfo).
:- pred polymorphism__process_preds(list(pred_id), module_info, module_info,
io__state, io__state).
@@ -369,12 +395,27 @@
polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo, IO0, IO) :-
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
- pred_info_module(PredInfo, PredModule),
- pred_info_name(PredInfo, PredName),
- pred_info_arity(PredInfo, PredArity),
(
- polymorphism__no_type_info_builtin(PredModule,
- PredName, PredArity)
+ (
+ % Leave Aditi aggregates alone, since
+ % calls to them must be monomorphic. This avoids
+ % unnecessarily creating type_infos in Aditi code,
+ % since they will just be stripped out later.
+ % The input to an aggregate must be a closure holding
+ % the address of an Aditi procedure. The
+ % monomorphism of Aditi procedures is checked by
+ % magic.m.
+ % Other Aditi procedures should still be processed
+ % to remove complicated unifications and
+ % lambda expressions.
+ hlds_pred__pred_info_is_aditi_aggregate(PredInfo)
+ ;
+ pred_info_module(PredInfo, PredModule),
+ pred_info_name(PredInfo, PredName),
+ pred_info_arity(PredInfo, PredArity),
+ polymorphism__no_type_info_builtin(PredModule,
+ PredName, PredArity)
+ )
->
ModuleInfo = ModuleInfo0,
IO = IO0
@@ -490,7 +531,7 @@
(
( pred_info_is_imported(PredInfo0)
; pred_info_is_pseudo_imported(PredInfo0),
- in_in_unification_proc_id(ProcId)
+ hlds_pred__in_in_unification_proc_id(ProcId)
)
->
Goal = Goal0,
@@ -550,18 +591,11 @@
%
% set the new values of the fields in proc_info and pred_info
%
- Info = poly_info(VarSet, VarTypes, TypeVarSet,
- TypeInfoMap, TypeClassInfoMap,
- _Proofs, _PredName, ModuleInfo),
proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo1),
proc_info_set_goal(ProcInfo1, Goal, ProcInfo2),
- proc_info_set_varset(ProcInfo2, VarSet, ProcInfo3),
- proc_info_set_vartypes(ProcInfo3, VarTypes, ProcInfo4),
- proc_info_set_argmodes(ProcInfo4, ArgModes, ProcInfo5),
- proc_info_set_typeinfo_varmap(ProcInfo5, TypeInfoMap, ProcInfo6),
- proc_info_set_typeclass_info_varmap(ProcInfo6, TypeClassInfoMap,
- ProcInfo),
- pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo).
+ proc_info_set_argmodes(ProcInfo2, ArgModes, ProcInfo3),
+ poly_info_extract(Info, PredInfo0, PredInfo,
+ ProcInfo3, ProcInfo, ModuleInfo).
% XXX the following code ought to be rewritten to handle
% existential/universal type_infos and type_class_infos
@@ -1200,6 +1234,12 @@
% some builtins don't need the type_info
polymorphism__no_type_info_builtin(PredModule,
PredName, PredArity)
+ ;
+ % Leave Aditi relations alone, since they must
+ % be monomorphic. This is checked by magic.m.
+ hlds_pred__pred_info_is_aditi_relation(PredInfo)
+ ;
+ hlds_pred__pred_info_is_aditi_aggregate(PredInfo)
)
->
PredId = PredId0,
@@ -1428,7 +1468,8 @@
NonLocalTypeInfos, LambdaGoal, Unification0, Functor,
Unification, PolyInfo0, PolyInfo) :-
PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap,
- TCVarMap, _Proofs, PredName, ModuleInfo0),
+ TCVarMap, _Proofs, PredName, ModuleInfo0,
+ Markers, Owner),
% Calculate the constraints which apply to this lambda
% expression.
@@ -1444,7 +1485,7 @@
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
OrigNonLocals, NonLocalTypeInfos, LambdaGoal, Unification0,
VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
- ModuleInfo0, Functor, Unification, ModuleInfo),
+ Markers, Owner, ModuleInfo0, Functor, Unification, ModuleInfo),
poly_info_set_module_info(ModuleInfo, PolyInfo0, PolyInfo).
:- pred polymorphism__constraint_contains_vars(list(var), class_constraint).
@@ -1583,7 +1624,8 @@
NewC = constraint(ClassName, ConstrainedTypes),
Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet0, TypeInfoMap0,
- TypeClassInfoMap0, Proofs, PredName, ModuleInfo),
+ TypeClassInfoMap0, Proofs, PredName,
+ ModuleInfo, Markers, Owner),
(
map__search(TypeClassInfoMap0, NewC, Location)
@@ -1630,8 +1672,8 @@
PredProcId0 = hlds_class_proc(PredId0, _),
module_info_pred_info(ModuleInfo, PredId0,
PredInfo),
- pred_info_get_markers(PredInfo, Markers),
- check_marker(Markers, class_method),
+ pred_info_get_markers(PredInfo, CalleeMarkers),
+ check_marker(CalleeMarkers, class_method),
% enabling this optimisation causes a bug
% where implied instances are concerned.
@@ -1754,8 +1796,8 @@
SubClassId = class_id(SubClassName, SubClassArity),
Info1 = poly_info(VarSet1, VarTypes1, TypeVarSet0,
- TypeInfoMap0, TypeClassInfoMap0, Proofs,
- PredName, ModuleInfo),
+ TypeInfoMap0, TypeClassInfoMap0,
+ Proofs, PredName, ModuleInfo, Markers, Owner),
% Make the typeclass_info for the subclass
polymorphism__make_typeclass_info_var(
@@ -2023,10 +2065,6 @@
% variables to the appropriate type_info structures for the types.
% Update the varset and vartypes accordingly.
-:- pred polymorphism__make_type_info_vars(list(type), existq_tvars,
- term__context, list(var), list(hlds_goal), poly_info, poly_info).
-:- mode polymorphism__make_type_info_vars(in, in, in, out, out, in, out) is det.
-
polymorphism__make_type_info_vars([], _, _, [], [], Info, Info).
polymorphism__make_type_info_vars([Type | Types], ExistQVars, Context,
ExtraVars, ExtraGoals, Info0, Info) :-
@@ -2942,112 +2980,137 @@
% polymorphism.m
string, % pred name
- module_info
+ module_info,
+ pred_markers, % from the pred_info
+ string % Aditi owner
).
-:- pred init_poly_info(module_info, pred_info, proc_info, poly_info).
-:- mode init_poly_info(in, in, in, out) is det.
-
init_poly_info(ModuleInfo, PredInfo, ProcInfo, PolyInfo) :-
pred_info_name(PredInfo, PredName),
pred_info_typevarset(PredInfo, TypeVarSet),
pred_info_get_constraint_proofs(PredInfo, Proofs),
+ pred_info_get_markers(PredInfo, Markers),
+ pred_info_get_aditi_owner(PredInfo, Owner),
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
map__init(TypeInfoMap),
map__init(TypeClassInfoMap),
PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet,
- TypeInfoMap, TypeClassInfoMap,
- Proofs, PredName, ModuleInfo).
+ TypeInfoMap, TypeClassInfoMap,
+ Proofs, PredName, ModuleInfo, Markers, Owner).
+
+poly_info_extract(Info, PredInfo0, PredInfo,
+ ProcInfo0, ProcInfo, ModuleInfo) :-
+ Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap,
+ TypeclassInfoLocations, _Proofs, _Name, ModuleInfo, _, _),
+
+ % set the new values of the fields in proc_info and pred_info
+ proc_info_set_varset(ProcInfo0, VarSet, ProcInfo1),
+ proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo2),
+ proc_info_set_typeinfo_varmap(ProcInfo2, TypeInfoMap, ProcInfo3),
+ proc_info_set_typeclass_info_varmap(ProcInfo3, TypeclassInfoLocations,
+ ProcInfo),
+ pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo).
:- pred poly_info_get_varset(poly_info, varset).
:- mode poly_info_get_varset(in, out) is det.
poly_info_get_varset(PolyInfo, VarSet) :-
- PolyInfo = poly_info(VarSet, _, _, _, _, _, _, _).
+ PolyInfo = poly_info(VarSet, _, _, _, _, _, _, _, _, _).
:- pred poly_info_get_var_types(poly_info, map(var, type)).
:- mode poly_info_get_var_types(in, out) is det.
poly_info_get_var_types(PolyInfo, VarTypes) :-
- PolyInfo = poly_info(_, VarTypes, _, _, _, _, _, _).
+ PolyInfo = poly_info(_, VarTypes, _, _, _, _, _, _, _, _).
:- pred poly_info_get_typevarset(poly_info, tvarset).
:- mode poly_info_get_typevarset(in, out) is det.
poly_info_get_typevarset(PolyInfo, TypeVarSet) :-
- PolyInfo = poly_info(_, _, TypeVarSet, _, _, _, _, _).
+ PolyInfo = poly_info(_, _, TypeVarSet, _, _, _, _, _, _, _).
:- pred poly_info_get_type_info_map(poly_info, map(tvar, type_info_locn)).
:- mode poly_info_get_type_info_map(in, out) is det.
poly_info_get_type_info_map(PolyInfo, TypeInfoMap) :-
- PolyInfo = poly_info(_, _, _, TypeInfoMap, _, _, _, _).
+ PolyInfo = poly_info(_, _, _, TypeInfoMap, _, _, _, _, _, _).
:- pred poly_info_get_typeclass_info_map(poly_info,
map(class_constraint, var)).
:- mode poly_info_get_typeclass_info_map(in, out) is det.
poly_info_get_typeclass_info_map(PolyInfo, TypeClassInfoMap) :-
- PolyInfo = poly_info(_, _, _, _, TypeClassInfoMap, _, _, _).
+ PolyInfo = poly_info(_, _, _, _, TypeClassInfoMap, _, _, _, _, _).
:- pred poly_info_get_proofs(poly_info,
map(class_constraint, constraint_proof)).
:- mode poly_info_get_proofs(in, out) is det.
poly_info_get_proofs(PolyInfo, Proofs) :-
- PolyInfo = poly_info(_, _, _, _, _, Proofs, _, _).
+ PolyInfo = poly_info(_, _, _, _, _, Proofs, _, _, _, _).
:- pred poly_info_get_pred_name(poly_info, string).
:- mode poly_info_get_pred_name(in, out) is det.
poly_info_get_pred_name(PolyInfo, PredName) :-
- PolyInfo = poly_info(_, _, _, _, _, _, PredName, _).
+ PolyInfo = poly_info(_, _, _, _, _, _, PredName, _, _, _).
:- pred poly_info_get_module_info(poly_info, module_info).
:- mode poly_info_get_module_info(in, out) is det.
poly_info_get_module_info(PolyInfo, ModuleInfo) :-
- PolyInfo = poly_info(_, _, _, _, _, _, _, ModuleInfo).
+ PolyInfo = poly_info(_, _, _, _, _, _, _, ModuleInfo, _, _).
+
+:- pred poly_info_get_markers(poly_info, pred_markers).
+:- mode poly_info_get_markers(in, out) is det.
+
+poly_info_get_markers(PolyInfo, Markers) :-
+ PolyInfo = poly_info(_, _, _, _, _, _, _, _, Markers, _).
+
+:- pred poly_info_get_aditi_owner(poly_info, aditi_owner).
+:- mode poly_info_get_aditi_owner(in, out) is det.
+poly_info_get_aditi_owner(PolyInfo, Owner) :-
+ PolyInfo = poly_info(_, _, _, _, _, _, _, _, _, Owner).
:- pred poly_info_set_varset(varset, poly_info, poly_info).
:- mode poly_info_set_varset(in, in, out) is det.
poly_info_set_varset(VarSet, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(_, B, C, D, E, F, G, H),
- PolyInfo = poly_info(VarSet, B, C, D, E, F, G, H).
+ PolyInfo0 = poly_info(_, B, C, D, E, F, G, H, I, J),
+ PolyInfo = poly_info(VarSet, B, C, D, E, F, G, H, I, J).
:- pred poly_info_set_varset_and_types(varset, map(var, type),
poly_info, poly_info).
:- mode poly_info_set_varset_and_types(in, in, in, out) is det.
poly_info_set_varset_and_types(VarSet, VarTypes, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(_, _, C, D, E, F, G, H),
- PolyInfo = poly_info(VarSet, VarTypes, C, D, E, F, G, H).
+ PolyInfo0 = poly_info(_, _, C, D, E, F, G, H, I, J),
+ PolyInfo = poly_info(VarSet, VarTypes, C, D, E, F, G, H, I, J).
:- pred poly_info_set_typevarset(tvarset, poly_info, poly_info).
:- mode poly_info_set_typevarset(in, in, out) is det.
poly_info_set_typevarset(TypeVarSet, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(A, B, _, D, E, F, G, H),
- PolyInfo = poly_info(A, B, TypeVarSet, D, E, F, G, H).
+ PolyInfo0 = poly_info(A, B, _, D, E, F, G, H, I, J),
+ PolyInfo = poly_info(A, B, TypeVarSet, D, E, F, G, H, I, J).
:- pred poly_info_set_type_info_map(map(tvar, type_info_locn),
poly_info, poly_info).
:- mode poly_info_set_type_info_map(in, in, out) is det.
poly_info_set_type_info_map(TypeInfoMap, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(A, B, C, _, E, F, G, H),
- PolyInfo = poly_info(A, B, C, TypeInfoMap, E, F, G, H).
+ PolyInfo0 = poly_info(A, B, C, _, E, F, G, H, I, J),
+ PolyInfo = poly_info(A, B, C, TypeInfoMap, E, F, G, H, I, J).
:- pred poly_info_set_typeclass_info_map(map(class_constraint, var),
poly_info, poly_info).
:- mode poly_info_set_typeclass_info_map(in, in, out) is det.
poly_info_set_typeclass_info_map(TypeClassInfoMap, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(A, B, C, D, _, F, G, H),
- PolyInfo = poly_info(A, B, C, D, TypeClassInfoMap, F, G, H).
+ PolyInfo0 = poly_info(A, B, C, D, _, F, G, H, I, J),
+ PolyInfo = poly_info(A, B, C, D, TypeClassInfoMap, F, G, H, I, J).
:- pred poly_info_set_proofs(map(class_constraint, constraint_proof),
@@ -3055,15 +3118,15 @@
:- mode poly_info_set_proofs(in, in, out) is det.
poly_info_set_proofs(Proofs, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(A, B, C, D, E, _, G, H),
- PolyInfo = poly_info(A, B, C, D, E, Proofs, G, H).
+ PolyInfo0 = poly_info(A, B, C, D, E, _, G, H, I, J),
+ PolyInfo = poly_info(A, B, C, D, E, Proofs, G, H, I, J).
:- pred poly_info_set_module_info(module_info, poly_info, poly_info).
:- mode poly_info_set_module_info(in, in, out) is det.
poly_info_set_module_info(ModuleInfo, PolyInfo0, PolyInfo) :-
- PolyInfo0 = poly_info(A, B, C, D, E, F, G, _),
- PolyInfo = poly_info(A, B, C, D, E, F, G, ModuleInfo).
+ PolyInfo0 = poly_info(A, B, C, D, E, F, G, _, I, J),
+ PolyInfo = poly_info(A, B, C, D, E, F, G, ModuleInfo, I, J).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.37
diff -u -t -u -r1.37 prog_data.m
--- prog_data.m 1998/07/08 20:57:09 1.37
+++ prog_data.m 1998/07/17 01:52:00
@@ -141,6 +141,40 @@
; fact_table(sym_name, arity, string)
% Predname, Arity, Fact file name.
+ ; aditi(sym_name, arity)
+ % Predname, Arity
+
+ ; base_relation(sym_name, arity)
+ % Predname, Arity
+ %
+ % Eventually, these should only occur in
+ % automatically generated database interface
+ % files, but for now there's no such thing,
+ % so they can occur in user programs.
+
+ ; naive(sym_name, arity)
+ % Predname, Arity
+ % Use naive evaluation.
+
+ ; psn(sym_name, arity)
+ % Predname, Arity
+ % Use predicate semi-naive evaluation.
+
+ ; aditi_memo(sym_name, arity)
+ % Predname, Arity
+
+ ; aditi_no_memo(sym_name, arity)
+ % Predname, Arity
+
+ ; supp_magic(sym_name, arity)
+ % Predname, Arity
+
+ ; context(sym_name, arity)
+ % Predname, Arity
+
+ ; owner(sym_name, arity, string)
+ % PredName, Arity, String.
+
; tabled(eval_method, sym_name, int, maybe(pred_or_func),
maybe(list(mode)))
% Tabling type, Predname, Arity, PredOrFunc?, Mode?
Index: compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.20
diff -u -t -u -r1.20 compiler_design.html
--- compiler_design.html 1998/06/04 17:26:23 1.20
+++ compiler_design.html 1998/07/30 03:39:27
@@ -32,12 +32,12 @@
stages:
<ol>
-<li> parsing (source files -> HLDS)
-<li> semantic analysis and error checking (HLDS -> annotated HLDS)
-<li> high-level transformations (annotated HLDS -> annotated HLDS)
-<li> code generation (annotated HLDS -> LLDS)
-<li> low-level optimizations (LLDS -> LLDS)
-<li> output C code (LLDS -> C)
+<li> parsing (source files -> HLDS)
+<li> semantic analysis and error checking (HLDS -> annotated HLDS)
+<li> high-level transformations (annotated HLDS -> annotated HLDS)
+<li> code generation (annotated HLDS -> LLDS or RL)
+<li> low-level optimizations (LLDS -> LLDS or RL -> RL)
+<li> output code (LLDS -> C or RL -> bytecode)
</ol>
<p>
@@ -144,8 +144,8 @@
<li> reading and writing of optimization interfaces (intermod.m). <br>
<module>.opt contains clauses for exported preds suitable for
- inlining or higher-order specialization. The .opt file for the
- current module is written after type-checking. .opt files
+ inlining or higher-order specialization. The `.opt' file for the
+ current module is written after type-checking. `.opt' files
for imported modules are read here.
<li> expansion of equivalence types (equiv_type.m) <br>
@@ -452,15 +452,21 @@
<li> issue warnings about unused arguments from predicates, and create
specialized versions without them (unused_args.m); type_infos are
- often unused
+ often unused.
<li> elimination of dead procedures (dead_proc_elim.m). Inlining, higher-order
specialization and the elimination of unused args can make procedures dead
even the user doesn't, and automatically constructed unification and
comparison predicates are often dead as well.
-<li> elimination of useless assignments, assignments that merely introduce
- another name for an already existing variable (excess.m).
+<li> conversion of Aditi procedures into disjunctive normal form (dnf.m).
+ The supplementary magic sets and context transformations are only defined
+ for predicates in DNF.
+
+<li> supplementary magic sets or supplementary context transformation of
+ Aditi procedures (magic.m, magic_util.m, context.m).
+ The magic sets or context transformations must be applied to convert the
+ program to a form for which Aditi-RL bytecode can be generated.
<li> reducing the number of variables that have to be saved across
procedure calls (saved_vars.m). We do this by putting the code that
@@ -478,14 +484,6 @@
<p>
-Eventually we plan to make Mercury the programming language of the Aditi
-deductive database system. When this happens, we will need to be able to
-apply the magic set transformation, which is defined for predicates
-whose definitions are disjunctive normal form. The module dnf.m translates
-definitions into DNF, introducing auxiliary predicates as necessary.
-
-<p>
-
<h3> 4. Code generation </h3>
<p>
@@ -737,6 +735,47 @@
<li> Final generation of C code is done in llds_out.m.
</ul>
+<p>
+
+<h3> 7. Aditi-RL generation </h3>
+
+<ul>
+<li> rl.m contains the definition of the representation of Aditi-RL
+ used within the Mercury compiler. There are some slight differences
+ between rl.m and Aditi-RL to make optimization easier.
+
+<li> rl_dump.m writes the RL type defined in rl.m to <module>.rl_dump.
+
+<li> rl_gen.m converts HLDS to RL.
+ <ul>
+ <li> rl_exprn.m converts top down Mercury code to bytecode.
+ <li> rl_info.m defines a state type.
+ </ul>
+
+<li> rl_code.m contains the definition of the bytecodes interpreted
+ by Aditi.
+
+<li> rl_out.m converts from the instructions defined in rl.m
+ to bytecode either as character data in the <module>.c file or
+ to <module>.rlo and outputs a text representation to
+ <module>.rla.
+
+<li> rl_file.m contains routines to output the bytecodes defined in rl_code.m.
+</ul>
+
+<h3> 8. Aditi-RL optimization </h3>
+
+<ul>
+<li> rl_block.m converts an RL procedure into basic blocks, and performs
+ other tasks such as detecting the loops in those basic blocks.
+
+<li> rl_analyse.m contains a generic data-flow analysis procedure for
+ RL procedures.
+
+<li> rl_liveness.m uses rl_analyse.m to insert code to initialise relations
+ and clear references to them when they are no longer needed.
+</ul>
+
<hr>
<!-------------------------->
@@ -754,8 +793,8 @@
<ul>
<li> bytecode.m defines the internal representation of bytecodes, and contains
the predicates to emit them in two forms. The raw bytecode form is emitted
- into <filename>.bytecode for interpretation, while a human-readable form
- is emitted into <filename>.bytedebug for visual inspection.
+ into <filename>.bytecode for interpretation, while a human-readable
+ form is emitted into <filename>.bytedebug for visual inspection.
<li> bytecode_gen.m contains the predicates that translate HLDS into bytecode.
</ul>
@@ -820,6 +859,15 @@
(For some of them its hard to say which!)
<dl>
+
+ <dt> excess.m:
+ <dd>
+ This eliminates assignments that merely introduce another
+ name for an already existing variable. The functionality of
+ this module has been included in simplify.m, however sometime
+ in the future it may be necessary to provide a version which
+ maintains superhomogeneous form.
+
<dt> lco.m:
<dd>
This finds predicates whose implementations would benefit
%-----------------------------------------------------------------------------%
--- mkinit.c 1998/07/29 04:41:27 1.2
+++ mkinit.c 1998/07/29 04:41:43
@@ -32,10 +32,11 @@
#define MAXLINE 256 /* maximum number of characters per line */
/* (characters after this limit are ignored) */
+/* --- used to collect Aditi data constant names --- */
-typedef struct String_List_ {
+typedef struct String_List_struct {
char *data;
- struct String_List_ *next;
+ struct String_List_struct *next;
} String_List;
/* --- global variables --- */
@@ -495,19 +496,20 @@
if (strncmp(line, init_str, init_strlen) == 0) {
int j;
- for (j = init_strlen; isalnum(line[j]) || line[j] == '_'; j++)
+ for (j = init_strlen;
+ MR_isalnum(line[j]) || line[j] == '_'; j++)
{
/* VOID */
}
line[j] = '\0';
- output_init_function(line+init_strlen);
+ output_init_function(line + init_strlen);
} else if (aditi
&& strncmp(line, aditi_init_str, aditi_init_strlen) == 0) {
int j;
for (j = aditi_init_strlen;
- isalnum(line[j]) || line[j] == '_'; j++)
+ MR_isalnum(line[j]) || line[j] == '_'; j++)
{
/* VOID */
}
More information about the developers
mailing list