[m-dev.] for review: EDCGs - diff part 2
Peter Nicholas MALKIN
pnmalk at cat.cs.mu.OZ.AU
Fri Dec 24 14:11:08 AEDT 1999
Detailed Desciption of Change:
compiler/make_hlds.m:
The EDCG transformation occurs in this file. The main predicates to do
this are transform/22, transform_goal/12 and transform_goal_2/13 (the
most important).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.320
diff -u -r1.320 make_hlds.m
--- compiler/make_hlds.m 1999/12/10 02:17:57 1.320
+++ compiler/make_hlds.m 1999/12/23 05:21:32
@@ -27,6 +27,8 @@
:- import_module io, std_util, list, bool.
+:- type qual_info.
+
% parse_tree_to_hlds(ParseTree, MQInfo, EqvMap, HLDS, UndefTypes, UndefModes):
% Given MQInfo (returned by module_qual.m) and EqvMap (returned by
% equiv_type.m), converts ParseTree to HLDS.
@@ -58,7 +60,7 @@
:- import_module hlds_data.
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
-:- import_module modules, module_qual, prog_util, options, hlds_out.
+:- import_module modules, module_qual, prog_util, options, hlds_out, edcg.
:- import_module make_tags, quantification, (inst), globals.
:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
@@ -66,36 +68,37 @@
:- import_module error_util.
:- import_module string, char, int, set, bintree, map, multi_map, require.
-:- import_module bag, term, varset, getopt, assoc_list, term_io.
+:- import_module term, varset, getopt, assoc_list, term_io.
parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module,
UndefTypes, UndefModes) -->
globals__io_get_globals(Globals),
{ mq_info_get_partial_qualifier_info(MQInfo0, PQInfo) },
{ module_info_init(Name, Globals, PQInfo, Module0) },
+ add_item_list_decls_pass_0(Items, Module0, Module1),
add_item_list_decls_pass_1(Items,
- item_status(local, may_be_unqualified), Module0, Module1),
+ item_status(local, may_be_unqualified), Module1, Module2),
globals__io_lookup_bool_option(statistics, Statistics),
maybe_report_stats(Statistics),
add_item_list_decls_pass_2(Items,
- item_status(local, may_be_unqualified), Module1, Module2),
+ item_status(local, may_be_unqualified), Module2, Module3),
maybe_report_stats(Statistics),
% balance the binary trees
- { module_info_optimize(Module2, Module3) },
+ { module_info_optimize(Module3, Module4) },
maybe_report_stats(Statistics),
{ init_qual_info(MQInfo0, EqvMap, Info0) },
- add_item_list_clauses(Items, local, Module3, Module4,
+ add_item_list_clauses(Items, local, Module4, Module5,
Info0, Info),
{ qual_info_get_mq_info(Info, MQInfo) },
{ mq_info_get_type_error_flag(MQInfo, UndefTypes) },
{ mq_info_get_mode_error_flag(MQInfo, UndefModes) },
{ mq_info_get_num_errors(MQInfo, MQ_NumErrors) },
- { module_info_num_errors(Module4, NumErrors0) },
+ { module_info_num_errors(Module5, NumErrors0) },
{ NumErrors is NumErrors0 + MQ_NumErrors },
- { module_info_set_num_errors(Module4, NumErrors, Module5) },
+ { module_info_set_num_errors(Module5, NumErrors, Module6) },
% the predid list is constructed in reverse order, for
% efficiency, so we return it to the correct order here.
- { module_info_reverse_predids(Module5, Module) }.
+ { module_info_reverse_predids(Module6, Module) }.
%-----------------------------------------------------------------------------%
@@ -106,6 +109,20 @@
%-----------------------------------------------------------------------------%
+ % pass 0:
+ % Add the hidden declarations one by one to the module.
+ % Must be done before the pred declarations.
+
+:- pred add_item_list_decls_pass_0(item_list, module_info, module_info,
+ io__state, io__state).
+:- mode add_item_list_decls_pass_0(in, in, out, di, uo) is det.
+
+add_item_list_decls_pass_0([], Module, Module) --> [].
+add_item_list_decls_pass_0([Item - Context | Items], Module0, Module)
+ -->
+ add_item_decl_pass_0(Item, Context, Module0, Module1),
+ add_item_list_decls_pass_0(Items, Module1, Module).
+
% pass 1:
% Add the declarations one by one to the module,
% except for type definitions and pragmas.
@@ -122,7 +139,7 @@
add_item_list_decls_pass_1(Items, Status1, Module1, Module).
% pass 2:
- % Add the type definitions and pragmas one by one to the module,
+ % Add the type definitions and pragmas one by one to the module
% and add default modes for functions with no mode declaration.
%
% Adding type definitions needs to come after we have added the
@@ -166,6 +183,21 @@
%-----------------------------------------------------------------------------%
+:- pred add_item_decl_pass_0(item, term__context, module_info, module_info,
+ io__state, io__state).
+:- mode add_item_decl_pass_0(in, in, in, out, di, uo) is det.
+
+add_item_decl_pass_0(Item, Context, Module0, Module) -->
+ ( { Item = htype_defn(_VarSet, Name, Htype) } ->
+ module_add_htype_defn(Module0, Name, Htype, Context, Module)
+ ; { Item = hmode_defn(_VarSet, Name, Hmode) } ->
+ module_add_hmode_defn(Module0, Name, Hmode, Context, Module)
+ ;
+ { Module = Module0 }
+ ).
+
+%-----------------------------------------------------------------------------%
+
% dispatch on the different types of items
:- pred add_item_decl_pass_1(item, prog_context, item_status,
@@ -173,14 +205,20 @@
:- mode add_item_decl_pass_1(in, in, in, in, out, out, di, uo) is det.
% skip clauses
-add_item_decl_pass_1(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_1(pred_clause(_, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_1(func_clause(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_1(type_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
+add_item_decl_pass_1(htype_defn(_, _, _), _, Status,
+ Module, Status, Module) --> [].
+
+add_item_decl_pass_1(hmode_defn(_, _, _), _, Status,
+ Module, Status, Module) --> [].
+
add_item_decl_pass_1(inst_defn(VarSet, InstDefn, Cond), Context,
Status, Module0, Status, Module) -->
module_add_inst_defn(Module0, VarSet, InstDefn, Cond, Context,
@@ -192,12 +230,12 @@
Status, Module).
add_item_decl_pass_1(pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext),
- Context, Status, Module0, Status, Module) -->
+ TypesAndModes, HiddenForms, MaybeDet, Cond, Purity,
+ ClassContext), Context, Status, Module0, Status, Module) -->
{ init_markers(Markers) },
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, Status, _, Module).
+ TypesAndModes, HiddenForms, MaybeDet, Cond, Purity,
+ ClassContext, Markers, Context, Status, _, Module).
add_item_decl_pass_1(func(TypeVarSet, InstVarSet, ExistQVars, FuncName,
TypesAndModes, RetTypeAndMode, MaybeDet, Cond, Purity,
@@ -333,6 +371,12 @@
module_add_type_defn(Module0, VarSet, TypeDefn, Cond, Context, Status,
Module).
+add_item_decl_pass_2(htype_defn(_,_,_), _Context,
+ Status, Module, Status, Module) --> [].
+
+add_item_decl_pass_2(hmode_defn(_,_,_), _Context,
+ Status, Module, Status, Module) --> [].
+
add_item_decl_pass_2(pragma(Pragma), Context, Status, Module0, Status, Module)
-->
%
@@ -521,13 +565,13 @@
add_item_decl_pass_2(assertion(_, _), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(func_clause(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
-add_item_decl_pass_2(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_2(pred_clause(_, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_2(inst_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
add_item_decl_pass_2(mode_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
-add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _),
+add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _, _),
_, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
@@ -614,20 +658,24 @@
{ IsAssertion = no },
module_add_func_clause(Module0, VarSet, PredName, Args, Result, Body,
Status, Context, IsAssertion, Module, Info0, Info).
-add_item_clause(pred_clause(VarSet, PredName, Args, Body), Status, Status,
- Context, Module0, Module, Info0, Info) -->
+add_item_clause(pred_clause(VarSet, PredName, Args, Body, MaybeEDCG), Status,
+ Status, Context, Module0, Module, Info0, Info) -->
check_not_exported(Status, Context, "clause"),
{ IsAssertion = no },
module_add_pred_clause(Module0, VarSet, PredName, Args, Body, Status,
- Context, IsAssertion, Module, Info0, Info).
+ Context, IsAssertion, Module, MaybeEDCG, Info0, Info).
add_item_clause(type_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(inst_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(mode_defn(_, _, _), Status, Status, _,
+ Module, Module, Info, Info) --> [].
+add_item_clause(htype_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(pred(_, _, _, _, _, _, _, _, _), Status, Status, _,
+add_item_clause(hmode_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
+add_item_clause(pred(_, _, _, _, _, _, _, _, _, _), Status, Status, _,
+ Module, Module, Info, Info) --> [].
add_item_clause(func(_, _, _, _, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(pred_mode(_, _, _, _, _), Status, Status, _,
@@ -735,7 +783,7 @@
{ IsAssertion = yes },
module_add_pred_clause(Module0, VarSet, unqualified(Name),
HeadVars, Goal, Status, Context, IsAssertion, Module,
- Info0, Info).
+ no, Info0, Info).
add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
add_item_clause(typeclass(_, _, _, _, _),
@@ -2041,17 +2089,17 @@
%-----------------------------------------------------------------------------%
:- pred module_add_pred(module_info, tvarset, inst_varset, existq_tvars,
- sym_name, list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints, pred_markers, prog_context,
- item_status, maybe(pair(pred_id, proc_id)), module_info,
- io__state, io__state).
+ sym_name, list(type_and_mode), list(hidden_form_and_name),
+ maybe(determinism), condition, purity, class_constraints,
+ pred_markers, prog_context, item_status, maybe(pair(pred_id,
+ proc_id)), module_info, io__state, io__state).
:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, in, in, in,
- out, out, di, uo) is det.
+ in, out, out, di, uo) is det.
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, item_status(Status, NeedQual), MaybePredProcId,
- Module) -->
+ TypesAndModes, FormAndName, MaybeDet, Cond, Purity,
+ ClassContext, Markers, Context, item_status(Status, NeedQual),
+ MaybePredProcId, Module) -->
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -2061,9 +2109,9 @@
DeclStatus = Status
},
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types, Cond,
- Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- predicate, Module1),
+ add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types,
+ FormAndName, Cond, Purity, ClassContext, Markers, Context,
+ DeclStatus, NeedQual, predicate, Module1),
(
{ MaybeModes = yes(Modes) },
@@ -2106,9 +2154,9 @@
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode) },
{ list__append(Types, [RetType], Types1) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, FuncName, Types1, Cond,
- Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- function, Module1),
+ add_new_pred(Module0, TypeVarSet, ExistQVars, FuncName, Types1, [],
+ Cond, Purity, ClassContext, Markers, Context, DeclStatus,
+ NeedQual, function, Module1),
(
{ MaybeModes = yes(Modes) },
{ MaybeRetMode = yes(RetMode) }
@@ -2242,7 +2290,7 @@
{ init_markers(Markers0) },
{ add_marker(Markers0, class_method, Markers) },
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars,
- PredName, TypesAndModes, MaybeDet, Cond, pure,
+ PredName, TypesAndModes, [], MaybeDet, Cond, pure,
NewClassContext, Markers, Context, Status,
MaybePredIdProcId, Module)
;
@@ -2404,32 +2452,46 @@
%-----------------------------------------------------------------------------%
:- pred add_new_pred(module_info, tvarset, existq_tvars, sym_name, list(type),
- condition, purity, class_constraints, pred_markers,
- prog_context, import_status, need_qualifier,
- pred_or_func, module_info, io__state, io__state).
-:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+ list(hidden_form_and_name), condition, purity,
+ class_constraints, pred_markers, prog_context, import_status,
+ need_qualifier, pred_or_func, module_info, io__state,
+ io__state).
+:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
+ out, di, uo) is det.
% NB. Predicates are also added in lambda.m, which converts
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(Module0, TVarSet, ExistQVars, PredName, Types, Cond, Purity,
- ClassContext, Markers0, Context, Status, NeedQual,
+add_new_pred(Module0, TVarSet, ExistQVars, PredName, Types0, FormsAndNames,
+ Cond, Purity, ClassContext, Markers0, Context, Status, NeedQual,
PredOrFunc, Module) -->
{ module_info_name(Module0, ModuleName) },
- { list__length(Types, Arity) },
- (
- { PredName = unqualified(_PName) },
+ % This is the visual arity.
+ { list__length(Types0, VisualArity) },
+ { edcg__check_for_dups(FormsAndNames, HiddenNames) },
+ (
+ { HiddenNames = [_] }
+ ->
+ { module_info_incr_errors(Module0, Module) },
+ edcg__dup_error(HiddenNames, PredName, VisualArity, Context)
+ ;
+ { PredName = unqualified(_PName) }
+ ->
{ module_info_incr_errors(Module0, Module) },
- unqualified_pred_error(PredName, Arity, Context)
+ unqualified_pred_error(PredName, VisualArity, Context)
% All predicate names passed into this predicate should have
% been qualified by prog_io.m, when they were first read.
- ;
- { PredName = qualified(MNameOfPred, PName) },
+ ;
+ { edcg__get_hidden_pred_types(Module0, FormsAndNames,
+ HiddenTypes) },
+ { PredName = qualified(MNameOfPred, PName) }
+ ->
+ { list__append(Types0, HiddenTypes, Types) },
+ { list__length(Types, TotalArity) },
{ Module1 = Module0 },
{ module_info_get_predicate_table(Module1, PredicateTable0) },
- { clauses_info_init(Arity, ClausesInfo) },
+ { clauses_info_init(TotalArity, ClausesInfo) },
{ map__init(Proofs) },
{ purity_to_markers(Purity, PurityMarkers) },
{ markers_to_marker_list(PurityMarkers, MarkersList) },
@@ -2440,14 +2502,14 @@
)) },
{ list__foldl(AddMarker, MarkersList, Markers0, Markers) },
globals__io_lookup_string_option(aditi_user, Owner),
- { pred_info_init(ModuleName, PredName, Arity, TVarSet,
- ExistQVars, Types,
- Cond, Context, ClausesInfo, Status, Markers,
- none, PredOrFunc, ClassContext, Proofs,
- Owner, PredInfo0) },
+ { pred_info_init(ModuleName, PredName, TotalArity, VisualArity,
+ TVarSet, ExistQVars, Types, FormsAndNames, Cond,
+ Context, ClausesInfo, Status, Markers, none,
+ PredOrFunc, ClassContext, Proofs, Owner,
+ PredInfo0) },
(
- { predicate_table_search_pf_m_n_a(PredicateTable0,
- PredOrFunc, MNameOfPred, PName, Arity,
+ { predicate_table_search_pf_m_n_a( PredicateTable0,
+ PredOrFunc, MNameOfPred, PName, TotalArity,
[OrigPred|_]) }
->
( { Status \= opt_imported } ->
@@ -2458,12 +2520,31 @@
OrigContext) },
{ hlds_out__pred_or_func_to_str(PredOrFunc,
DeclString) },
- multiple_def_error(PredName, Arity, DeclString,
- Context, OrigContext)
+ multiple_def_error(PredName, VisualArity,
+ DeclString, Context, OrigContext)
;
% This can happen for exported external preds.
{ Module = Module0 }
)
+ ;
+ { predicate_table_search_pf_m_n_a( PredicateTable0,
+ PredOrFunc, MNameOfPred, PName, VisualArity,
+ [OrigPred|_]) }
+ ->
+ ( { Status \= opt_imported } ->
+ { module_info_incr_errors(Module1, Module) },
+ { module_info_pred_info(Module, OrigPred,
+ OrigPredInfo) },
+ { pred_info_context(OrigPredInfo,
+ OrigContext) },
+ { hlds_out__pred_or_func_to_str(PredOrFunc,
+ DeclString) },
+ multiple_def_error(PredName, VisualArity,
+ DeclString, Context, OrigContext)
+ ;
+ % This can happen for exported external preds.
+ { Module = Module0 }
+ )
;
{ module_info_get_partial_qualifier_info(Module1,
PQInfo) },
@@ -2486,6 +2567,11 @@
{ module_info_set_predicate_table(Module1,
PredicateTable, Module) }
)
+ ;
+ % This is a result of a previous hidden
+ % argument ambiguity error hence no error message
+ % is written.
+ { module_info_incr_errors(Module0, Module) }
).
%-----------------------------------------------------------------------------%
@@ -2710,6 +2796,7 @@
{ module_info_name(ModuleInfo0, ModuleName0) },
{ sym_name_get_module_name(PredName, ModuleName0, ModuleName) },
+ % This is the visual arity.
{ list__length(Modes, Arity) },
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
@@ -2731,40 +2818,43 @@
% Lookup the pred_info for this predicate
{ predicate_table_get_preds(PredicateTable1, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
-
- module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext,
- PredInfo, ProcId),
+ module_do_add_mode(PredInfo0, Modes, MaybeDet, MContext,
+ PredInfo, ProcId, ModuleInfo0, ModuleInfo1),
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo0, PredicateTable,
+ { module_info_set_predicate_table(ModuleInfo1, PredicateTable,
ModuleInfo) },
{ PredProcId = PredId - ProcId }.
-:- pred module_do_add_mode(pred_info, arity, list(mode), maybe(determinism),
- prog_context, pred_info, proc_id, io__state, io__state).
-:- mode module_do_add_mode(in, in, in, in, in, out, out, di, uo) is det.
+:- pred module_do_add_mode(pred_info, list(mode), maybe(determinism),
+ prog_context, pred_info, proc_id, module_info, module_info,
+ io__state, io__state).
+:- mode module_do_add_mode(in, in, in, in, out, out, in, out,
+ di, uo) is det.
-module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext,
- PredInfo, ProcId) -->
+module_do_add_mode(PredInfo0, Modes0, MaybeDet, MContext,
+ PredInfo, ProcId, ModuleInfo0, ModuleInfo) -->
% check that the determinism was specified
+ { pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
+ { pred_info_name(PredInfo0, PredName) },
+ { pred_info_module(PredInfo0, PredModule) },
+ { pred_info_arity(PredInfo0, TotalArity) },
+ { pred_info_visual_arity(PredInfo0, VisualArity) },
+ { PredSymName = qualified(PredModule, PredName) },
(
{ MaybeDet = no }
->
{ pred_info_import_status(PredInfo0, ImportStatus) },
- { pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
- { pred_info_module(PredInfo0, PredModule) },
- { pred_info_name(PredInfo0, PredName) },
- { PredSymName = qualified(PredModule, PredName) },
( { status_is_exported(ImportStatus, yes) } ->
- unspecified_det_for_exported(PredSymName, Arity,
+ unspecified_det_for_exported(PredSymName, VisualArity,
PredOrFunc, MContext)
;
globals__io_lookup_bool_option(infer_det, InferDet),
(
{ InferDet = no }
->
- unspecified_det_for_local(PredSymName, Arity,
- PredOrFunc, MContext)
+ unspecified_det_for_local(PredSymName,
+ VisualArity, PredOrFunc, MContext)
;
[]
)
@@ -2772,10 +2862,15 @@
;
[]
),
-
+ { pred_info_hidden_args(PredInfo0, FormsAndNames) },
+ { edcg__get_hidden_pred_modes(ModuleInfo0, FormsAndNames, Modes1,
+ UndefFormsAndNames) },
+ { list__append(Modes0, Modes1, Modes) },
+ maybe_undef_hidden_modes(UndefFormsAndNames, ModuleInfo0, ModuleInfo,
+ PredSymName, VisualArity, PredOrFunc, MContext),
% add the mode declaration to the pred_info for this procedure.
{ ArgLives = no },
- { add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
+ { add_new_proc(PredInfo0, TotalArity, Modes, yes(Modes), ArgLives,
MaybeDet, MContext, address_is_not_taken, PredInfo, ProcId) }.
% Whenever there is a clause or mode declaration for an undeclared
@@ -2866,12 +2961,13 @@
:- pred module_add_pred_clause(module_info, prog_varset, sym_name,
list(prog_term), goal, import_status, prog_context,
- bool, module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_pred_clause(in, in, in, in, in, in, in, in, out,
+ bool, module_info, maybe_edcg, qual_info, qual_info, io__state,
+ io__state).
+:- mode module_add_pred_clause(in, in, in, in, in, in, in, in, out, in,
in, out, di, uo) is det.
module_add_pred_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, IsAssertion, ModuleInfo,
+ Status, Context, IsAssertion, ModuleInfo, MaybeEDCG,
Info0, Info) -->
% print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
@@ -2884,7 +2980,7 @@
[]
),
module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, predicate, IsAssertion, ModuleInfo,
+ Status, Context, predicate, IsAssertion, ModuleInfo, MaybeEDCG,
Info0, Info).
:- pred module_add_func_clause(module_info, prog_varset, sym_name,
@@ -2908,17 +3004,18 @@
),
{ list__append(Args0, [Result], Args) },
module_add_clause(ModuleInfo0, ClauseVarSet, FuncName, Args, Body,
- Status, Context, function, IsAssertion, ModuleInfo,
+ Status, Context, function, IsAssertion, ModuleInfo, no,
Info0, Info).
:- pred module_add_clause(module_info, prog_varset, sym_name, list(prog_term),
goal, import_status, prog_context, pred_or_func, bool,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
+ module_info, maybe_edcg, qual_info, qual_info, io__state,
+ io__state).
+:- mode module_add_clause(in, in, in, in, in, in, in, in, in, out,
+ in, in, out, di, uo) is det.
module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body, Status,
- Context, PredOrFunc, IsAssertion, ModuleInfo,
+ Context, PredOrFunc, IsAssertion, ModuleInfo, MaybeEDCG,
Info0, Info) -->
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error
@@ -3005,12 +3102,35 @@
{ maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
{ pred_info_procedures(PredInfo2, Procs) },
{ map__keys(Procs, ModeIds) },
+ { module_info_edcgs(ModuleInfo0, EDCGTable) },
+ { edcg_table_get_hidden_info(EDCGTable, HiddenInfo0) },
+ { pred_info_hidden_args(PredInfo2, FormAndNames0) },
+ (
+ % EDCG warning edcg clause without "-->>" functor.
+ { MaybeEDCG = no },
+ { Body \= true - _ }, % not a fact
+ { FormAndNames0 = [_|_] }
+ ->
+ % XXX: magic number 0 for indenting
+ { error_util__describe_one_pred_name(ModuleInfo0,
+ PredId, PredDescription) },
+ { error_util__list_to_pieces(["Warning:",
+ PredDescription,
+ "should have `-->>' as functor."], Formats) },
+ error_util__report_warning(Context, 0, Formats),
+ { FormAndNames = [] }
+ ;
+ { FormAndNames = FormAndNames0 }
+ ),
clauses_info_add_clause(Clauses0, PredId, ModeIds,
ClauseVarSet, TVarSet0, Args, Body, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet, Clauses, Warnings,
- ModuleInfo0, ModuleInfo1, Info0, Info),
- {
+ ModuleInfo0, ModuleInfo1, Info0, Info, FormAndNames,
+ PredicateTable1, HiddenInfo0, HiddenInfo),
+ edcg__maybe_hidden_error(HiddenInfo, Context,
+ PredOrFunc, PredName, Arity, ModuleInfo1, ModuleInfo2),
+ {
pred_info_set_clauses_info(PredInfo2, Clauses, PredInfo3),
(
IsAssertion = yes
@@ -3039,7 +3159,7 @@
map__det_update(Preds0, PredId, PredInfo, Preds),
predicate_table_set_preds(PredicateTable1, Preds,
PredicateTable),
- module_info_set_predicate_table(ModuleInfo1, PredicateTable,
+ module_info_set_predicate_table(ModuleInfo2, PredicateTable,
ModuleInfo)
},
( { Status \= opt_imported } ->
@@ -3223,8 +3343,6 @@
% lookup some information we need from the pred_info and proc_info
%
{ pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc) },
- { pred_info_module(PredInfo0, PredModule) },
- { pred_info_name(PredInfo0, PredName) },
{ pred_info_clauses_info(PredInfo0, Clauses0) },
{ pred_info_arg_types(PredInfo0, ArgTypes) },
{ pred_info_get_purity(PredInfo0, Purity) },
@@ -3266,8 +3384,7 @@
{ PragmaImpl = ordinary(C_Code, no) },
clauses_info_add_pragma_c_code(Clauses0, Purity, Attributes,
PredId, ProcId, VarSet, PragmaVars, ArgTypes, PragmaImpl,
- Context, PredOrFunc, qualified(PredModule, PredName),
- Arity, Clauses, Info0, Info),
+ Context, PredOrFunc, Arity, Clauses, Info0, Info),
%
% Store the clauses_info etc. back into the pred_info
@@ -3404,6 +3521,63 @@
%-----------------------------------------------------------------------------%
+:- pred module_add_htype_defn(module_info, sym_name, htype_defn, term__context,
+ module_info, io__state, io__state).
+:- mode module_add_htype_defn(in, in, in, in, out, di, uo) is det.
+
+module_add_htype_defn(Module0, HiddenName, HtypeDefn, Context, Module) -->
+ { edcg__det_sym_name_to_hidden_arg(HiddenName, HiddenArg) },
+ { module_info_edcgs(Module0, EDCGTable0) },
+ (
+ % Checks to see if declaration is duplicated.
+ { edcg_table_fetch_context(EDCGTable0, HiddenArg, hidden_type,
+ OriginalContext) }
+ ->
+ % Mutiple htype declarations.
+ { module_info_incr_errors(Module0, Module) },
+ multiply_defined_hidden_error(HiddenName, hidden_type, Context,
+ OriginalContext)
+ ;
+ { edcg_table_add_htype(EDCGTable0, HiddenArg, HtypeDefn,
+ Context, EDCGTable) },
+ { module_info_set_edcgs(Module0, EDCGTable, Module) }
+ ).
+
+:- pred module_add_hmode_defn(module_info, sym_name, hmode_defn, term__context,
+ module_info, io__state, io__state).
+:- mode module_add_hmode_defn(in, in, in, in, out, di, uo) is det.
+
+module_add_hmode_defn(Module0, HiddenName, HmodeDefn, Context, Module) -->
+ { edcg__det_sym_name_to_hidden_arg(HiddenName, HiddenArg) },
+ { module_info_edcgs(Module0, EDCGTable0) },
+ (
+ % Checks to see if declaration is duplicated.
+ { edcg_table_fetch_context(EDCGTable0, HiddenArg, hidden_mode,
+ OriginalContext) }
+ ->
+ % Mutiple hmode declarations.
+ { module_info_incr_errors(Module0, Module) },
+ multiply_defined_hidden_error(HiddenName, hidden_mode, Context,
+ OriginalContext)
+ ;
+ { edcg_table_add_hmode(EDCGTable0, HiddenArg, HmodeDefn,
+ Context, EDCGTable) },
+ { module_info_set_edcgs(Module0, EDCGTable, Module) }
+ ).
+
+:- pred multiply_defined_hidden_error(sym_name, htype_or_hmode,
+ term__context, term__context, io__state, io__state).
+:- mode multiply_defined_hidden_error(in, in, in, in, di, uo) is det.
+
+multiply_defined_hidden_error(HiddenName, HtypeOrHmode, Context,
+ OriginalContext) -->
+ { htype_or_hmode_to_string(HtypeOrHmode, DeclString) },
+ multiple_def_error(HiddenName, 0, DeclString, Context,
+ OriginalContext).
+
+
+%-----------------------------------------------------------------------------%
+
:- pred module_add_pragma_c_code(pragma_c_code_attributes, sym_name,
pred_or_func, list(pragma_var), prog_varset, pragma_c_code_impl,
import_status, prog_context, module_info, module_info,
@@ -3495,8 +3669,7 @@
clauses_info_add_pragma_c_code(Clauses0, Purity,
Attributes, PredId, ProcId, VarSet,
PVars, ArgTypes, PragmaImpl, Context,
- PredOrFunc, PredName, Arity,
- Clauses, Info0, Info),
+ PredOrFunc, Arity, Clauses, Info0, Info),
{ pred_info_set_clauses_info(PredInfo1, Clauses,
PredInfo2) },
{ pred_info_set_goal_type(PredInfo2, pragmas,
@@ -4446,12 +4619,15 @@
hlds_goal::out, prog_varset::out, tvarset::out,
clauses_info::out, list(quant_warning)::out,
module_info::in, module_info::out, qual_info::in,
- qual_info::out, io__state::di, io__state::uo) is det.
+ qual_info::out, list(hidden_form_and_name)::in,
+ predicate_table::in, hidden_info::in,
+ hidden_info::out, io__state::di, io__state::uo) is det.
clauses_info_add_clause(ClausesInfo0, PredId, ModeIds, CVarSet, TVarSet0,
Args, Body, Context, PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet0, ClausesInfo, Warnings, Module0, Module,
- Info0, Info) -->
+ Info0, Info, FormsAndNames, PredTable,
+ HiddenInfo0, HiddenInfo) -->
{ ClausesInfo0 = clauses_info(VarSet0, VarTypes0, VarTypes1,
HeadVars, ClauseList0,
TI_VarMap, TCI_VarMap) },
@@ -4459,7 +4635,8 @@
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, IsAssertion, Goal, VarSet, Warnings,
- Module0, Module, Info1, Info2),
+ Module0, Module, Info1, Info2, FormsAndNames,
+ PredTable, HiddenInfo0, HiddenInfo),
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
(
@@ -4489,94 +4666,48 @@
:- pred clauses_info_add_pragma_c_code(clauses_info, purity,
pragma_c_code_attributes, pred_id, proc_id, prog_varset,
list(pragma_var), list(type), pragma_c_code_impl, prog_context,
- pred_or_func, sym_name, arity, clauses_info, qual_info,
+ pred_or_func, arity, clauses_info, qual_info,
qual_info, io__state, io__state) is det.
:- mode clauses_info_add_pragma_c_code(in, in, in, in, in, in, in, in, in, in,
- in, in, in, out, in, out, di, uo) is det.
+ in, in, out, in, out, di, uo) is det.
clauses_info_add_pragma_c_code(ClausesInfo0, Purity, Attributes, PredId,
ModeId, PVarSet, PVars, OrigArgTypes, PragmaImpl, Context,
- PredOrFunc, PredName, Arity, ClausesInfo, Info0, Info) -->
+ PredOrFunc, Arity, ClausesInfo, Info0, Info) -->
{
ClausesInfo0 = clauses_info(VarSet0, VarTypes, VarTypes1,
HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
pragma_get_vars(PVars, Args0),
pragma_get_var_infos(PVars, ArgInfo),
- %
- % Check for arguments occurring multiple times.
- %
- bag__init(ArgBag0),
- bag__insert_list(ArgBag0, Args0, ArgBag),
- bag__to_assoc_list(ArgBag, ArgBagAL0),
- list__filter(
- (pred(Arg::in) is semidet :-
- Arg = _ - Occurrences,
- Occurrences > 1
- ), ArgBagAL0, ArgBagAL),
- assoc_list__keys(ArgBagAL, MultipleArgs)
- },
-
- ( { MultipleArgs = [_ | _] } ->
- { ClausesInfo = ClausesInfo0 },
- { Info = Info0 },
- prog_out__write_context(Context),
- io__write_string("In `:- pragma c_code' declaration for "),
- { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
- hlds_out__write_simple_call_id(
- PredOrFunc - PredName/OrigArity),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: "),
- (
- { MultipleArgs = [MultipleArg] },
- io__write_string("variable `"),
- mercury_output_var(MultipleArg, PVarSet, no),
- io__write_string("' occurs multiple times\n")
- ;
- { MultipleArgs = [_, _ | _] },
- io__write_string("variables `"),
- mercury_output_vars(MultipleArgs, PVarSet, no),
- io__write_string(
- "' occur multiple times\n")
- ),
- prog_out__write_context(Context),
- io__write_string(" in the argument list.\n"),
- io__set_exit_status(1)
- ;
% merge the varsets of the proc and the new pragma_c_code
- {
- varset__merge_subst(VarSet0, PVarSet, VarSet1, Subst),
- map__apply_to_list(Args0, Subst, TermArgs),
- term__term_list_to_var_list(TermArgs, Args),
+ varset__merge_subst(VarSet0, PVarSet, VarSet1, Subst),
+ map__apply_to_list(Args0, Subst, TermArgs),
+ term__term_list_to_var_list(TermArgs, Args),
- % build the pragma_c_code
- goal_info_init(GoalInfo0),
- goal_info_set_context(GoalInfo0, Context, GoalInfo1),
- % Put the purity in the goal_info in case
- % this c code is inlined
- add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
- HldsGoal0 = pragma_c_code(Attributes, PredId, ModeId, Args,
- ArgInfo, OrigArgTypes, PragmaImpl) - GoalInfo
- },
- % Apply unifications with the head args.
- % Since the set of head vars and the set vars in the
- % pragma C code are disjoint, the unifications can be
- % implemented as substitutions, and they will be.
- insert_arg_unifications(HeadVars, TermArgs, Context,
- head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
- HldsGoal1, VarSet2, Info0, Info),
- {
- map__init(Empty),
- implicitly_quantify_clause_body(HeadVars, HldsGoal1,
- VarSet2, Empty, HldsGoal, VarSet, _, _Warnings),
- NewClause = clause([ModeId], HldsGoal, Context),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
- HeadVars, [NewClause|ClauseList],
- TI_VarMap, TCI_VarMap)
- }
- ).
-
+ % build the pragma_c_code
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo1),
+ % Put the purity in the goal_info in case this c code is inlined
+ add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
+ HldsGoal0 = pragma_c_code(Attributes, PredId, ModeId, Args,
+ ArgInfo, OrigArgTypes, PragmaImpl) - GoalInfo
+ },
+ % Apply unifications with the head args.
+ % Since the set of head vars and the set vars in the
+ % pragma C code are disjoint, the unifications can be
+ % implemented as substitutions, and they will be.
+ insert_arg_unifications(HeadVars, TermArgs, Context,
+ head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
+ HldsGoal1, VarSet2, Info0, Info),
+ {
+ map__init(Empty),
+ implicitly_quantify_clause_body(HeadVars, HldsGoal1, VarSet2, Empty,
+ HldsGoal, VarSet, _, _Warnings),
+ NewClause = clause([ModeId], HldsGoal, Context),
+ ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1, HeadVars,
+ [NewClause|ClauseList], TI_VarMap, TCI_VarMap)
+ }.
:- pred allocate_vars_for_saved_vars(list(string), list(pair(prog_var, string)),
prog_varset, prog_varset).
@@ -4594,35 +4725,53 @@
prog_varset, prog_context, pred_or_func, arity, bool,
hlds_goal, prog_varset, list(quant_warning),
module_info, module_info, qual_info, qual_info,
+ list(hidden_form_and_name), predicate_table,
+ hidden_info, hidden_info,
io__state, io__state).
-:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out,
- in, out, in, out, di, uo) is det.
+:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out, in,
+ out, in, out, in, in, in, out, di, uo) is det.
transform(Subst, HeadVars, Args0, Body, VarSet0, Context, PredOrFunc,
Arity, IsAssertion, Goal, VarSet, Warnings,
- Module0, Module, Info0, Info) -->
- transform_goal(Body, VarSet0, Subst, Goal1, VarSet1, Info0, Info1),
- { term__apply_substitution_to_list(Args0, Subst, Args) },
+ Module0, Module, Info0, Info, FormAndNames, PredTable,
+ HiddenInfo0, HiddenInfo) -->
+
+ % If Body is a fact then an underscore needs to be prefixed
+ % onto passed and consumed hidden arguments.
+ { ( Body = true - _ ->
+ Fact = yes
+ ;
+ Fact = no
+ ) },
+ { hidden_info_initial_state(FormAndNames, VarSet0, VarSet1, Fact,
+ HiddenInfo0, HiddenInfo1) },
+ transform_goal(Body, VarSet1, Subst, Goal1, VarSet2, Info0, Info1,
+ PredTable, HiddenInfo1, HiddenInfo),
+ { edcg__get_hidden_head_args(FormAndNames, HiddenInfo1, HiddenInfo,
+ HiddenArgs) },
+ { list__append(Args0, HiddenArgs, Args1) },
+ { term__apply_substitution_to_list(Args1, Subst, Args) },
{ map__init(Empty) },
-
+
% The head variables of an assertion will always be
% variables, so it is unnecessary to insert unifications.
(
{ IsAssertion = yes }
->
{ Module = Module0 },
- { VarSet2 = VarSet1 },
+ { VarSet3 = VarSet2 },
{ Goal2 = Goal1 },
{ Info = Info0 }
;
{ Module = Module0 },
{ ArgContext = head(PredOrFunc, Arity) },
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- no, Goal1, VarSet1, Goal2, VarSet2, Info1, Info)
+ no, Goal1, VarSet2, Goal2, VarSet3, Info1, Info)
),
- { implicitly_quantify_clause_body(HeadVars, Goal2, VarSet2, Empty,
+ { implicitly_quantify_clause_body(HeadVars, Goal2, VarSet3, Empty,
Goal, VarSet, _, Warnings) }.
+
%-----------------------------------------------------------------------------%
% Convert goals from the prog_data `goal' structure into the
@@ -4639,186 +4788,383 @@
transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo1, VarSet,
Info0, Info) -->
+ { hidden_info_init(HiddenInfo) },
+ { predicate_table_init(PredTable) },
transform_goal_2(Goal0, Context, VarSet0, Subst, Goal1 - GoalInfo0,
- VarSet, Info0, Info),
+ VarSet, Info0, Info, PredTable, HiddenInfo, _),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo1) }.
+
+:- pred transform_goal(goal, prog_varset, prog_substitution, hlds_goal,
+ prog_varset, qual_info, qual_info, predicate_table,
+ hidden_info, hidden_info, io__state, io__state).
+:- mode transform_goal(in, in, in, out, out, in, out, in, in, out,
+ di, uo) is det.
-:- pred transform_goal_2(goal_expr, prog_context, prog_varset,
- prog_substitution, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
-:- mode transform_goal_2(in, in, in, in, out, out, in, out, di, uo) is det.
+transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo1, VarSet,
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo) -->
+ transform_goal_2(Goal0, Context, VarSet0, Subst, Goal1 - GoalInfo0,
+ VarSet, Info0, Info, PredTable, HiddenInfo0, HiddenInfo),
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) }.
+:- pred transform_goal_2(goal_expr, term__context, prog_varset,
+ prog_substitution, hlds_goal, prog_varset, qual_info, qual_info,
+ predicate_table, hidden_info, hidden_info, io__state,
+ io__state).
+:- mode transform_goal_2(in, in, in, in, out, out, in, out, in, in, out,
+ di, uo) is det.
+
transform_goal_2(fail, _, VarSet, _, disj([], Empty) - GoalInfo, VarSet,
- Info, Info) -->
+ Info, Info, _, HiddenInfo, HiddenInfo) -->
{ map__init(Empty) },
{ goal_info_init(GoalInfo) }.
transform_goal_2(true, _, VarSet, _, conj([]) - GoalInfo, VarSet,
- Info, Info) -->
+ Info, Info, _, HiddenInfo, HiddenInfo) -->
{ goal_info_init(GoalInfo) }.
% Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
transform_goal_2(all(Vars0, Goal0), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info) -->
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo) -->
{ TransformedGoal = not(some(Vars0, not(Goal0) - Context) - Context) },
transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
- Goal, VarSet, Info0, Info).
+ Goal, VarSet, Info0, Info, PredTable, HiddenInfo0, HiddenInfo).
transform_goal_2(some(Vars0, Goal0), _, VarSet0, Subst,
- some(Vars, can_remove, Goal) - GoalInfo,
- VarSet, Info0, Info) -->
+ some(Vars, can_remove, Goal) - GoalInfo, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
{ substitute_vars(Vars0, Subst, Vars) },
- transform_goal(Goal0, VarSet0, Subst, Goal, VarSet, Info0, Info),
+ transform_goal(Goal0, VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo),
{ goal_info_init(GoalInfo) }.
-
-transform_goal_2(if_then_else(Vars0, A0, B0, C0), _, VarSet0, Subst,
- if_then_else(Vars, A, B, C, Empty) - GoalInfo, VarSet, Info0, Info)
- -->
+transform_goal_2(if_then_else(Vars0, A0, B0, C0), Context, VarSet0, Subst,
+ if_then_else(Vars, A, B, C, Empty) - GoalInfo, VarSet,
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo) -->
{ substitute_vars(Vars0, Subst, Vars) },
- transform_goal(A0, VarSet0, Subst, A, VarSet1, Info0, Info1),
- transform_goal(B0, VarSet1, Subst, B, VarSet2, Info1, Info2),
- transform_goal(C0, VarSet2, Subst, C, VarSet, Info2, Info),
- { map__init(Empty) },
- { goal_info_init(GoalInfo) }.
+ transform_goal(A0, VarSet0, Subst, A, VarSet1, Info0, Info1,
+ PredTable, HiddenInfo0, HiddenInfo1),
+ transform_goal(B0, VarSet1, Subst, B1, VarSet2, Info1, Info2,
+ PredTable, HiddenInfo1, HiddenInfo2),
+ { edcg__update_var_names(HiddenInfo2, HiddenInfo0, HiddenInfo3) },
+ transform_goal(C0, VarSet2, Subst, C1, VarSet3, Info2, Info,
+ PredTable, HiddenInfo3, HiddenInfo4),
+ { edcg__hidden_info_combine_errors(HiddenInfo4, HiddenInfo2,
+ HiddenInfo5) }, { map__init(Empty) },
+ { goal_info_init(GoalInfo) },
+ { edcg__update_hidden_info(HiddenInfo5, HiddenInfo,
+ VarSet3, VarSet) },
+ { edcg__update_disj(B1, Context, HiddenInfo2, HiddenInfo,
+ GoalInfo, B) },
+ { edcg__update_disj(C1, Context, HiddenInfo5, HiddenInfo,
+ GoalInfo, C) }.
transform_goal_2(if_then(Vars0, A0, B0), Context, Subst, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
transform_goal_2(if_then_else(Vars0, A0, B0, true - Context),
- Context, Subst, VarSet0, Goal, VarSet, Info0, Info).
-
-transform_goal_2(not(A0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
- transform_goal(A0, VarSet0, Subst, A, VarSet, Info0, Info),
- { goal_info_init(GoalInfo) },
- { Goal = not(A) - GoalInfo }.
-
-transform_goal_2((A0,B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
- get_conj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1),
- get_conj(A0, Subst, L0, VarSet1, L, VarSet, Info1, Info),
- { goal_info_init(GoalInfo) },
- { conj_list_to_goal(L, GoalInfo, Goal) }.
-
-transform_goal_2((A0 & B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
- get_par_conj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1),
- get_par_conj(A0, Subst, L0, VarSet1, L, VarSet, Info1, Info),
- { goal_info_init(GoalInfo) },
- { par_conj_list_to_goal(L, GoalInfo, Goal) }.
+ Context, Subst, VarSet0, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo).
-transform_goal_2((A0;B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
- get_disj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1),
- get_disj(A0, Subst, L0, VarSet1, L, VarSet, Info1, Info),
+transform_goal_2(not(A0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
+ transform_goal(A0, VarSet0, Subst, A, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo),
+ % eliminate double negations
+ { A = not(Goal1) - _ ->
+ Goal = Goal1
+ ;
+ goal_info_init(GoalInfo),
+ Goal = not(A) - GoalInfo
+ }.
+
+transform_goal_2((A0,B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
+ get_conj(A0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1, PredTable,
+ HiddenInfo0, HiddenInfo1),
+ get_conj(B0, Subst, L0, VarSet1, L, VarSet, Info1, Info, PredTable,
+ HiddenInfo1, HiddenInfo),
+ { goal_info_init(GoalInfo) },
+ { conj_list_to_goal(L, GoalInfo, Goal) }.
+
+transform_goal_2((A0 & B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
+ get_par_conj(A0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1,
+ PredTable, HiddenInfo0, HiddenInfo1),
+ get_par_conj(B0, Subst, L0, VarSet1, L, VarSet, Info1, Info,
+ PredTable, HiddenInfo1, HiddenInfo),
+ { goal_info_init(GoalInfo) },
+ { par_conj_list_to_goal(L, GoalInfo, Goal) }.
+
+transform_goal_2((A0;B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
+ get_disj(A0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1,
+ PredTable, HiddenInfo0, HiddenInfo1),
+ { edcg__update_var_names(HiddenInfo1, HiddenInfo0, HiddenInfo2) },
+ get_disj(B0, Subst, L0, VarSet1, L1, VarSet2, Info1, Info,
+ PredTable, HiddenInfo2, HiddenInfo3),
{ goal_info_init(GoalInfo) },
+ { edcg__update_hidden_info(HiddenInfo3, HiddenInfo4,
+ VarSet2, VarSet) },
+ { edcg__update_disj_list(L1, HiddenInfo4, GoalInfo, L, HiddenInfo) },
{ disj_list_to_goal(L, GoalInfo, Goal) }.
transform_goal_2(implies(P, Q), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info) -->
- % `P => Q' is defined as `not (P, not Q)'
- { TransformedGoal = not( (P, not(Q) - Context) - Context ) },
- transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
- Goal, VarSet, Info0, Info).
-
-transform_goal_2(equivalent(P0, Q0), _Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info) -->
- %
- % `P <=> Q' is defined as `(P => Q), (Q => P)',
- % but that transformation must not be done until
- % after quantification analysis, lest the duplication of
- % the goals concerned affect the implicit quantification
- % of the variables inside them.
- %
- { goal_info_init(GoalInfo) },
- transform_goal(P0, VarSet0, Subst, P, VarSet1, Info0, Info1),
- transform_goal(Q0, VarSet1, Subst, Q, VarSet, Info1, Info),
- { Goal = bi_implication(P, Q) - GoalInfo }.
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo) -->
+ % `P => Q' is defined as `not (P, not Q)'
+ { TransformedGoal = not( (P, not(Q) - Context) - Context ) },
+ transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
+ Goal, VarSet, Info0, Info, PredTable, HiddenInfo0, HiddenInfo).
+
+transform_goal_2(equivalent(P, Q), Context, VarSet0, Subst, Goal, VarSet,
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo) -->
+ % `P <=> Q' is defined as `(P => Q), (Q => P)'
+ { TransformedGoal = (implies(P, Q) - Context,
+ implies(Q, P) - Context) },
+ transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
+ Goal, VarSet, Info0, Info, PredTable, HiddenInfo0, HiddenInfo).
+
+transform_goal_2(call(Name, VisualArgs0, HiddenArgs, Purity), Context,
+ VarSet0, Subst, Goal, VarSet, Info0, Info, PredTable,
+ HiddenInfo0, HiddenInfo) -->
+ (
+ { Name = unqualified("\\=") },
+ { VisualArgs0 = [LHS, RHS] },
+ { HiddenArgs = [] }
+ ->
+ % `LHS \= RHS' is defined as `not (RHS = RHS)'
+ transform_goal_2(not(unify(LHS, RHS) - Context), Context,
+ VarSet0, Subst, Goal, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo)
+ ;
+ % EDCG goal
+ { Name = unqualified("-->>") },
+ { VisualArgs0 = [HiddenTerms0, Body0] },
+ { HiddenTerms0 = term__functor(term__atom("edcg"), HiddenTerms,
+ _) },
+ { HiddenArgs = [] }
+ ->
+ process_edcg_goal(HiddenTerms, Body0, VarSet0, Context, Subst,
+ Goal, VarSet, Info0, Info, PredTable, HiddenInfo0,
+ HiddenInfo)
+ ;
+ { edcg__add_hidden_args(Name, VisualArgs0, HiddenArgs,
+ VisualArgs1, VarSet0, VarSet1, Context, HiddenInfo0,
+ HiddenInfo1, PredTable) },
+ { term__apply_substitution_to_list(VisualArgs1, Subst,
+ VisualArgs) },
+ { make_fresh_arg_vars(VisualArgs, VarSet1, HeadVars, VarSet2) },
+ { list__length(VisualArgs, Arity) },
+ (
+ % check for a higher-order call,
+ % i.e. a call to either call/N or ''/N.
+ { Name = unqualified("call")
+ ; Name = unqualified("")
+ },
+ { HeadVars = [PredVar | RealHeadVars] }
+ ->
+ { % initialize some fields to junk
+ Modes = [],
+ Det = erroneous,
+
+ GenericCall = higher_order(PredVar,
+ predicate, Arity),
+ Call = generic_call(GenericCall,
+ RealHeadVars, Modes, Det),
+
+ hlds_goal__generic_call_id(GenericCall, CallId),
+ Purity1 = pure
+ },
+ (
+ { Purity = pure }
+ ->
+ []
+ ;
+ prog_out__write_context(Context),
+ io__write_string("Warning: unnecessary `"),
+ write_purity(Purity),
+ io__write_string("' marker.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Higher-order goals are always pure.\n")
+ )
+ ;
+ % initialize some fields to junk
+ { invalid_pred_id(PredId),
+ invalid_proc_id(ModeId),
+
+ MaybeUnifyContext = no,
+ Call = call(PredId, ModeId, HeadVars, not_builtin,
+ MaybeUnifyContext, Name),
+ CallId = call(predicate - Name/Arity),
+ Purity1 = Purity
+ }
+ ),
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
+ { add_goal_info_purity_feature(GoalInfo1, Purity1, GoalInfo) },
+ { Goal0 = Call - GoalInfo },
+
+ insert_arg_unifications(HeadVars, VisualArgs,
+ Context, call(CallId), no,
+ Goal0, VarSet2, Goal, VarSet, Info0, Info,
+ HiddenInfo1, HiddenInfo)
+ ).
-transform_goal_2(call(Name, Args0, Purity), Context, VarSet0, Subst, Goal,
- VarSet, Info0, Info) -->
+transform_goal_2(unify(A0, B0), Context, VarSet0, Subst, Goal, VarSet,
+ Info0, Info, _, HiddenInfo0, HiddenInfo) -->
+ { term__apply_substitution(A0, Subst, A) },
+ { term__apply_substitution(B0, Subst, B) },
+ unravel_unification(A, B, Context, explicit, [],
+ VarSet0, Goal, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo).
+
+:- pred dummy_hlds_goal(hlds_goal, term__context, prog_varset, prog_varset).
+:- mode dummy_hlds_goal(out, in, in, out) is det.
+
+dummy_hlds_goal(HLDSGoal, Context, VarSet0, VarSet) :-
+ varset__new_var(VarSet0, Var1, VarSet1),
+ varset__new_var(VarSet1, Var2, VarSet),
+ create_atomic_unification(Var1, var(Var2), Context, explicit,
+ [], HLDSGoal).
+
+:- type edcg_operator
+ ---> access
+ ; change.
+
+ % process_edcg_goal(HiddenTerms, Body, VarSet0, Context, Subst,
+ % HldsGoal, VarSet, Info0, Info, PredTable, HiddenInfoIn,
+ % HiddenInfoOut)
+ %
+ % This predicates transforms an EDCG goal into an HLDS goal (HldsGoal).
+ % HiddenTerms is the list of hidden arguments and values in the head of
+ % the EDCG goal. Body is the body of the EDCG goal.
+:- pred process_edcg_goal(list(prog_term), prog_term, prog_varset,
+ term__context, prog_substitution, hlds_goal, prog_varset, qual_info,
+ qual_info, predicate_table, hidden_info, hidden_info, io__state,
+ io__state).
+:- mode process_edcg_goal(in, in, in, in, in, out, out, in, out, in,
+ in, out, di, uo) is det.
+
+process_edcg_goal(HiddenTerms, Body0, VarSet0, Context, Subst,
+ Goal, VarSet, Info0, Info, PredTable, HiddenInfo0,
+ HiddenInfo) -->
+ { edcg__sep_hidden_terms(HiddenTerms, VarSet0, Context,
+ HiddenInfo0, HiddenInfo1, FirstNames, FirstForms,
+ SecondNames, FirstArgs, SecondArgs) },
+ { make_fresh_arg_vars(FirstArgs, VarSet0, FirstVars, VarSet1) },
+ { make_fresh_arg_vars(SecondArgs, VarSet1, SecondVars, VarSet2) },
+ { true_goal(Goal0) },
+ { CallId = call(predicate - unqualified("edcg")/0) },
+ insert_arg_unifications(FirstVars, FirstArgs,
+ Context, call(CallId), no,
+ Goal0, VarSet2, Goal1, VarSet3, Info0, Info1,
+ HiddenInfo1, HiddenInfo2),
+ append_arg_unifications(SecondVars, SecondArgs,
+ Context, call(CallId), Goal1, VarSet3, Goal2, VarSet4,
+ Info1, Info2, HiddenInfo2, HiddenInfo3),
+ % Set the hidden_info to include the state of hidden variables
+ % local to the goal.
+ { edcg__hidden_info_convert(FirstNames, Context, FirstForms,
+ FirstVars, HiddenInfo3, HiddenInfo4) },
+ { term__coerce(Body0, Body1) },
+ { parse_goal(Body1, VarSet4, Body, VarSet5) },
+ transform_goal(Body, VarSet5, Subst, Goal3, VarSet6,
+ Info2, Info3, PredTable, HiddenInfo4, HiddenInfo5),
+ { edcg__hidden_info_vars(SecondNames, HiddenInfo5,
+ HiddenSecondVars) },
+ % Unset the states of the hidden variables local to the goal.
+ { edcg__hidden_info_revert(FirstNames, HiddenInfo3,
+ HiddenInfo5, HiddenInfo) },
+ { conjoin_goals(Goal2, Goal3, Goal4) },
+ { term__var_list_to_term_list(SecondVars, SecondTerms) },
+ append_arg_unifications(HiddenSecondVars, SecondTerms,
+ Context, call(CallId), Goal4, VarSet6, Goal, VarSet,
+ Info3, Info).
+
+
+ % process_edcg_operator(Operator, HiddenArg, Context, VarSet0, Var,
+ % VarSet, HiddenInfoIn, HiddenInfo)
+ %
+ % Operator is the type of EDCG operator, either access ($) or change
+ % ($=). Var is the current or next variable of HiddenArg if the operator
+ % is access or change respectively.
+:- pred process_edcg_operator(edcg_operator, prog_term,
+ term__context, prog_varset, prog_var,
+ prog_varset, hidden_info, hidden_info).
+:- mode process_edcg_operator(in, in, in, in, out, out,
+ in, out) is det.
+
+process_edcg_operator(EDCGOperator, HiddenArgTerm, Context,
+ VarSet0, Var, VarSet, HiddenInfo0, HiddenInfo) :-
+ edcg__hidden_arg_term_to_sym_name(HiddenArgTerm, MaybeName),
(
- { Name = unqualified("\\=") },
- { Args0 = [LHS, RHS] }
- ->
- % `LHS \= RHS' is defined as `not (RHS = RHS)'
- transform_goal_2(not(unify(LHS, RHS) - Context), Context,
- VarSet0, Subst, Goal, VarSet, Info0, Info)
- ;
- { Purity = pure },
- { Name = unqualified(Name1) },
- { Name1 = "aditi_insert"
- ; Name1 = "aditi_delete"
- ; Name1 = "aditi_bulk_insert"
- ; Name1 = "aditi_bulk_delete"
- ; Name1 = "aditi_modify"
- }
- ->
- { term__apply_substitution_to_list(Args0, Subst, Args1) },
- transform_aditi_builtin(Name1, Args1, Context, VarSet0,
- Goal, VarSet, Info0, Info)
+ MaybeName = error(Msg,Term),
+ hidden_info_error(syntax_error(Msg, Term, Context, VarSet),
+ HiddenInfo0, HiddenInfo),
+ varset__new_var(VarSet0, Var, VarSet)
;
- { term__apply_substitution_to_list(Args0, Subst, Args) },
- { make_fresh_arg_vars(Args, VarSet0, HeadVars, VarSet1) },
- { list__length(Args, Arity) },
+ MaybeName = ok(Name),
(
- % check for a higher-order call,
- % i.e. a call to either call/N or ''/N.
- { Name = unqualified("call")
- ; Name = unqualified("")
- },
- { HeadVars = [PredVar | RealHeadVars] }
+ hidden_info_get_hidden_arg(Name, Context, HiddenInfo0,
+ HiddenInfo1, HiddenArg)
->
- {
- % initialize some fields to junk
- Modes = [],
- Det = erroneous,
-
- GenericCall = higher_order(PredVar,
- predicate, Arity),
- Call = generic_call(GenericCall,
- RealHeadVars, Modes, Det),
-
- hlds_goal__generic_call_id(GenericCall, CallId),
- Purity1 = pure
- },
- (
- { Purity = pure }
- ->
- []
- ;
- prog_out__write_context(Context),
- io__write_string("Warning: unnecessary `"),
- write_purity(Purity),
- io__write_string("' marker.\n"),
- prog_out__write_context(Context),
- io__write_string(" Higher-order goals are always pure.\n")
- )
- ;
- {
- % initialize some fields to junk
- invalid_pred_id(PredId),
- invalid_proc_id(ModeId),
-
- MaybeUnifyContext = no,
- Call = call(PredId, ModeId, HeadVars, not_builtin,
- MaybeUnifyContext, Name),
- CallId = call(predicate - Name/Arity),
- Purity1 = Purity
- }
- ),
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
- { add_goal_info_purity_feature(GoalInfo1, Purity1, GoalInfo) },
- { Goal0 = Call - GoalInfo },
-
- insert_arg_unifications(HeadVars, Args,
- Context, call(CallId), no,
- Goal0, VarSet1, Goal, VarSet, Info0, Info)
+ process_edcg_operator_2(EDCGOperator, HiddenArg,
+ Context, VarSet0, Var,
+ VarSet, HiddenInfo1, HiddenInfo)
+ ;
+ hidden_info_error(undefined_error(Name,
+ Context), HiddenInfo0, HiddenInfo),
+ varset__new_var(VarSet0, Var, VarSet)
+ )
).
-transform_goal_2(unify(A0, B0), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info) -->
- { term__apply_substitution(A0, Subst, A) },
- { term__apply_substitution(B0, Subst, B) },
- unravel_unification(A, B, Context, explicit, [],
- VarSet0, Goal, VarSet, Info0, Info).
+:- pred process_edcg_operator_2(edcg_operator, hidden_arg,
+ term__context, prog_varset, prog_var,
+ prog_varset, hidden_info, hidden_info).
+:- mode process_edcg_operator_2(in, in, in, in, out, out,
+ in, out) is det.
+
+process_edcg_operator_2(access, HiddenArg, Context, VarSet0,
+ Var, VarSet, HiddenInfo0, HiddenInfo) :-
+ (
+ hidden_info_access(HiddenInfo0, HiddenArg, Var0)
+ ->
+ HiddenInfo = HiddenInfo0,
+ Var = Var0,
+ VarSet = VarSet0
+ ;
+ hidden_info_error(op_state_error("$", Context, "alive",
+ "dead", [HiddenArg]), HiddenInfo0, HiddenInfo1),
+ % Make it alive to avoid future errors
+ hidden_info_det_birth(HiddenArg, changed, VarSet0,
+ VarSet, no, HiddenInfo1, HiddenInfo),
+ hidden_info_get_var(HiddenArg, HiddenInfo, Var)
+ ).
+
+process_edcg_operator_2(change, HiddenArg, Context, VarSet0,
+ Var, VarSet, HiddenInfo0, HiddenInfo) :-
+ (
+ hidden_info_change(HiddenInfo0, HiddenArg, _, Var0,
+ StateForm, VarSet0, VarSet1, HiddenInfo1)
+ ->
+ Var0 = Var,
+ (
+ StateForm = changed,
+ HiddenInfo = HiddenInfo1
+ ;
+ StateForm = passed,
+ hidden_info_error(op_state_error("$=", Context,
+ "changed", "not changed", [HiddenArg]),
+ HiddenInfo1, HiddenInfo)
+ ),
+ VarSet = VarSet1
+ ;
+ hidden_info_error(op_state_error("$=", Context, "alive",
+ "dead", [HiddenArg]), HiddenInfo0, HiddenInfo1),
+ % Make it alive to avoid future errors
+ hidden_info_det_birth(HiddenArg, changed, VarSet0,
+ VarSet, no, HiddenInfo1, HiddenInfo),
+ hidden_info_get_var(HiddenArg, HiddenInfo, Var)
+ ).
:- inst aditi_update_str =
bound( "aditi_insert"
@@ -4836,6 +5182,9 @@
:- mode transform_aditi_builtin(in(aditi_update_str), in,
in, in, out, out, in, out, di, uo) is det.
+%-----------------------------------------------------------------------------
+ % Aditi Section.
+
transform_aditi_builtin("aditi_insert", Args0, Context, VarSet0,
Goal, VarSet, Info0, Info) -->
% Build an empty goal_info.
@@ -5303,16 +5652,33 @@
insert_arg_unifications(HeadVars, Args, Context, ArgContext, ForPragmaC,
Goal0, VarSet0, Goal, VarSet, Info0, Info) -->
+ { hidden_info_init(HiddenInfo0) },
+ insert_arg_unifications(HeadVars, Args, Context, ArgContext, ForPragmaC,
+ Goal0, VarSet0, Goal, VarSet, Info0, Info,
+ HiddenInfo0, _).
+
+:- pred insert_arg_unifications(list(prog_var), list(prog_term),
+ prog_context, arg_context, bool, hlds_goal, prog_varset,
+ hlds_goal, prog_varset, qual_info, qual_info,
+ hidden_info, hidden_info,
+ io__state, io__state).
+:- mode insert_arg_unifications(in, in, in, in, in, in, in, out,
+ out, in, out, in, out, di, uo) is det.
+
+insert_arg_unifications(HeadVars, Args, Context, ArgContext, ForPragmaC,
+ Goal0, VarSet0, Goal, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo) -->
( { HeadVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 }
+ { Info = Info0 },
+ { HiddenInfo = HiddenInfo0 }
;
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, List0) },
insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
ForPragmaC, 0, List0, VarSet0, List, VarSet,
- Info0, Info),
+ Info0, Info, HiddenInfo0, HiddenInfo),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(List, GoalInfo, Goal) }
).
@@ -5320,18 +5686,20 @@
:- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
prog_context, arg_context, bool, int, list(hlds_goal),
prog_varset, list(hlds_goal), prog_varset,
- qual_info, qual_info, io__state, io__state).
+ qual_info, qual_info, hidden_info, hidden_info,
+ io__state, io__state).
:- mode insert_arg_unifications_2(in, in, in, in, in, in, in, in,
- out, out, in, out, di, uo) is det.
+ out, out, in, out, in, out, di, uo) is det.
-insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
insert_arg_unifications_2([], [], _, _, _, _, List, VarSet, List, VarSet,
- Info, Info) --> [].
+ Info, Info, HiddenInfo, HiddenInfo) --> [].
insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
- ForPragmaC, N0, List0, VarSet0, List, VarSet, Info0, Info) -->
+ ForPragmaC, N0, List0, VarSet0, List, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo) -->
{ N1 is N0 + 1 },
(
{ Arg = term__variable(Var) }
@@ -5339,7 +5707,7 @@
% Skip unifications of the form `X = X'
insert_arg_unifications_2(Vars, Args, Context,
ArgContext, ForPragmaC, N1, List0, VarSet0, List,
- VarSet, Info0, Info)
+ VarSet, Info0, Info, HiddenInfo0, HiddenInfo)
;
{ Arg = term__variable(ArgVar) },
{ ForPragmaC = yes }
@@ -5357,18 +5725,19 @@
},
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
ForPragmaC, N1, List1, VarSet1, List, VarSet,
- Info0, Info)
+ Info0, Info, HiddenInfo0, HiddenInfo)
;
{ arg_context_to_unify_context(ArgContext, N1,
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet1, Info0, Info1),
+ VarSet0, Goal, VarSet1, Info0, Info1, HiddenInfo0,
+ HiddenInfo1),
{ goal_to_conj_list(Goal, ConjList) },
{ list__append(ConjList, List1, List) },
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
ForPragmaC, N1, List0, VarSet1, List1, VarSet,
- Info1, Info)
+ Info1, Info, HiddenInfo1, HiddenInfo)
).
% append_arg_unifications is the same as insert_arg_unifications,
@@ -5383,48 +5752,67 @@
append_arg_unifications(HeadVars, Args, Context, ArgContext, Goal0, VarSet0,
Goal, VarSet, Info0, Info) -->
+ { hidden_info_init(HiddenInfo0) },
+ append_arg_unifications(HeadVars, Args, Context, ArgContext, Goal0,
+ VarSet0, Goal, VarSet, Info0, Info, HiddenInfo0, _).
+
+:- pred append_arg_unifications(list(prog_var), list(prog_term),
+ prog_context, arg_context, hlds_goal, prog_varset, hlds_goal,
+ prog_varset, qual_info, qual_info,
+ hidden_info, hidden_info, io__state, io__state).
+:- mode append_arg_unifications(in, in, in, in, in, in,
+ out, out, in, out, in, out, di, uo) is det.
+
+append_arg_unifications(HeadVars, Args, Context, ArgContext, Goal0, VarSet0,
+ Goal, VarSet, Info0, Info, HiddenInfo0, HiddenInfo) -->
( { HeadVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 }
+ { Info = Info0 },
+ { HiddenInfo = HiddenInfo0 }
;
{ Goal0 = _ - GoalInfo },
{ goal_to_conj_list(Goal0, List0) },
append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, VarSet0, List, VarSet, Info0, Info),
+ 0, List0, VarSet0, List, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo),
{ conj_list_to_goal(List, GoalInfo, Goal) }
).
:- pred append_arg_unifications_2(list(prog_var), list(prog_term),
prog_context, arg_context, int, list(hlds_goal), prog_varset,
list(hlds_goal), prog_varset, qual_info, qual_info,
- io__state, io__state).
+ hidden_info, hidden_info, io__state, io__state).
:- mode append_arg_unifications_2(in, in, in, in, in, in, in,
- out, out, in, out, di, uo) is det.
+ out, out, in, out, in, out, di, uo) is det.
-append_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _) -->
+append_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _) -->
{ error("append_arg_unifications_2: length mismatch") }.
-append_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _) -->
+append_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _) -->
{ error("append_arg_unifications_2: length mismatch") }.
append_arg_unifications_2([], [], _, _, _, List, VarSet, List, VarSet,
- Info, Info) --> [].
+ Info, Info, HiddenInfo, HiddenInfo) --> [].
append_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext, N0,
- List0, VarSet0, List, VarSet, Info0, Info) -->
+ List0, VarSet0, List, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo) -->
{ N1 is N0 + 1 },
% skip unifications of the form `X = X'
( { Arg = term__variable(Var) } ->
append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- List0, VarSet0, List, VarSet, Info0, Info)
+ List0, VarSet0, List, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo)
;
{ arg_context_to_unify_context(ArgContext, N1,
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet1, Info0, Info1),
+ VarSet0, Goal, VarSet1, Info0, Info1,
+ HiddenInfo0, HiddenInfo1),
{ goal_to_conj_list(Goal, ConjList) },
{ list__append(List0, ConjList, List1) },
append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- List1, VarSet1, List, VarSet, Info1, Info)
+ List1, VarSet1, List, VarSet, Info1, Info,
+ HiddenInfo1, HiddenInfo)
).
:- pred arg_context_to_unify_context(arg_context, int,
@@ -5495,11 +5883,24 @@
:- mode unravel_unification(in, in, in, in, in, in, out, out,
in, out, di, uo) is det.
+unravel_unification(X, Y, Context, MainContext, SubContext, VarSet0, Goal,
+ VarSet, Info0, Info) -->
+ { hidden_info_init(HiddenInfo0) },
+ unravel_unification(X, Y, Context, MainContext, SubContext, VarSet0,
+ Goal, VarSet, Info0, Info, HiddenInfo0, _).
+
+:- pred unravel_unification(prog_term, prog_term, prog_context,
+ unify_main_context, unify_sub_contexts, prog_varset, hlds_goal,
+ prog_varset, qual_info, qual_info, hidden_info, hidden_info,
+ io__state, io__state).
+:- mode unravel_unification(in, in, in, in, in, in, out, out,
+ in, out, in, out, di, uo) is det.
+
% `X = Y' needs no unravelling.
unravel_unification(term__variable(X), term__variable(Y), Context,
- MainContext, SubContext, VarSet0, Goal, VarSet, Info, Info)
- -->
+ MainContext, SubContext, VarSet0, Goal, VarSet, Info, Info,
+ HiddenInfo, HiddenInfo) -->
{ create_atomic_unification(X, var(Y), Context, MainContext,
SubContext, Goal) },
{ VarSet0 = VarSet }.
@@ -5515,7 +5916,7 @@
unravel_unification(term__variable(X), RHS,
Context, MainContext, SubContext, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ Goal, VarSet, Info0, Info, HiddenInfo0, HiddenInfo) -->
{ RHS = term__functor(F, Args, FunctorContext) },
(
% Handle explicit type qualification.
@@ -5529,7 +5930,7 @@
Context, Info0, Info1),
unravel_unification(term__variable(X), RVal,
Context, MainContext, SubContext, VarSet0,
- Goal, VarSet, Info1, Info)
+ Goal, VarSet, Info1, Info, HiddenInfo0, HiddenInfo)
;
{
% handle lambda expressions
@@ -5573,7 +5974,8 @@
build_lambda_expression(X, PredOrFunc, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info)
+ Info1, Info),
+ { HiddenInfo0 = HiddenInfo }
;
{
% handle higher-order dcg pred expressions -
@@ -5599,7 +6001,8 @@
build_lambda_expression(X, predicate, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info)
+ Info1, Info),
+ { HiddenInfo0 = HiddenInfo }
;
% handle if-then-else expressions
{ F = term__atom("else"),
@@ -5622,10 +6025,10 @@
Info0, Info1),
unravel_unification(term__variable(X), ThenTerm,
Context, MainContext, SubContext, VarSet22, ThenGoal,
- VarSet33, Info1, Info2),
+ VarSet33, Info1, Info2, HiddenInfo0, HiddenInfo1),
unravel_unification(term__variable(X), ElseTerm,
Context, MainContext, SubContext, VarSet33, ElseGoal,
- VarSet, Info2, Info),
+ VarSet, Info2, Info, HiddenInfo1, HiddenInfo),
{ map__init(Empty) },
{ IfThenElse = if_then_else(Vars, IfGoal, ThenGoal, ElseGoal,
Empty) },
@@ -5634,6 +6037,24 @@
{ Goal = IfThenElse - GoalInfo }
;
{ parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
+ { MaybeFunctor = ok(unqualified("$"), [HiddenArg]) }
+ ->
+ { process_edcg_operator(access, HiddenArg, Context, VarSet0,
+ Var, VarSet, HiddenInfo0, HiddenInfo) },
+ { Info0 = Info },
+ { create_atomic_unification(X, var(Var), Context, MainContext,
+ SubContext, Goal) }
+ ;
+ { parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
+ { MaybeFunctor = ok(unqualified("$="), [HiddenArg]) }
+ ->
+ { process_edcg_operator(change, HiddenArg, Context, VarSet0,
+ Var, VarSet, HiddenInfo0, HiddenInfo) },
+ { Info0 = Info },
+ { create_atomic_unification(X, var(Var), Context, MainContext,
+ SubContext, Goal) }
+ ;
+ { parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
(
{ MaybeFunctor = ok(FunctorName, FunctorArgs) },
{ list__length(FunctorArgs, Arity) },
@@ -5650,7 +6071,8 @@
{ create_atomic_unification(X, functor(ConsId, []),
Context, MainContext, SubContext, Goal) },
{ VarSet = VarSet0 },
- { Info = Info0 }
+ { Info = Info0 },
+ { HiddenInfo = HiddenInfo0 }
;
{ make_fresh_arg_vars(FunctorArgs, VarSet0,
HeadVars, VarSet1) },
@@ -5664,17 +6086,20 @@
% with type-checking :-(
append_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal0,
- VarSet1, Goal, VarSet, Info0, Info)
+ VarSet1, Goal, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo)
)
).
% Handle `f(...) = X' in the same way as `X = f(...)'.
unravel_unification(term__functor(F, As, FC), term__variable(Y),
- C, MC, SC, VarSet0, Goal, VarSet, Info0, Info) -->
+ C, MC, SC, VarSet0, Goal, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo) -->
unravel_unification(term__variable(Y),
term__functor(F, As, FC),
- C, MC, SC, VarSet0, Goal, VarSet, Info0, Info).
+ C, MC, SC, VarSet0, Goal, VarSet, Info0, Info,
+ HiddenInfo0, HiddenInfo).
% If we find a unification of the form `f1(...) = f2(...)',
% then we replace it with `Tmp = f1(...), Tmp = f2(...)',
@@ -5685,18 +6110,20 @@
unravel_unification(term__functor(LeftF, LeftAs, LeftC),
term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ Goal, VarSet, Info0, Info, HiddenInfo0, HiddenInfo) -->
{ varset__new_var(VarSet0, TmpVar, VarSet1) },
unravel_unification(
term__variable(TmpVar),
- term__functor(LeftF, LeftAs, LeftC),
+ term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext,
- VarSet1, Goal0, VarSet2, Info0, Info1),
+ VarSet1, Goal1, VarSet2, Info0, Info1,
+ HiddenInfo0, HiddenInfo1),
unravel_unification(
term__variable(TmpVar),
- term__functor(RightF, RightAs, RightC),
+ term__functor(LeftF, LeftAs, LeftC),
Context, MainContext, SubContext,
- VarSet2, Goal1, VarSet, Info1, Info),
+ VarSet2, Goal0, VarSet, Info1, Info,
+ HiddenInfo1, HiddenInfo),
{ goal_info_init(GoalInfo) },
{ goal_to_conj_list(Goal0, ConjList0) },
{ goal_to_conj_list(Goal1, ConjList1) },
@@ -5931,26 +6358,29 @@
%-----------------------------------------------------------------------------%
% get_conj(Goal, Conj0, Subst, Conj) :
-% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
-% append Conj0, and return the result in Conj.
+% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
+% append Conj0, and return the result in Conj.
:- pred get_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
list(hlds_goal), prog_varset, qual_info, qual_info,
+ predicate_table, hidden_info, hidden_info,
io__state, io__state).
-:- mode get_conj(in, in, in, in, out, out, in, out, di, uo) is det.
+:- mode get_conj(in, in, in, in, out, out, in, out, in, in, out, di, uo) is det.
-get_conj(Goal, Subst, Conj0, VarSet0, Conj, VarSet, Info0, Info) -->
+get_conj(Goal, Subst, Conj0, VarSet0, Conj, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
(
{ Goal = (A,B) - _Context }
->
- get_conj(B, Subst, Conj0, VarSet0, Conj1, VarSet1,
- Info0, Info1),
- get_conj(A, Subst, Conj1, VarSet1, Conj, VarSet, Info1, Info)
- ;
+ get_conj(A, Subst, Conj0, VarSet0, Conj1, VarSet1,
+ Info0, Info1, PredTable, HiddenInfo0, HiddenInfo1),
+ get_conj(B, Subst, Conj1, VarSet1, Conj, VarSet, Info1, Info,
+ PredTable, HiddenInfo1, HiddenInfo)
+ ;
transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info),
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo),
{ goal_to_conj_list(Goal1, ConjList) },
- { list__append(ConjList, Conj0, Conj) }
+ { list__append(Conj0, ConjList, Conj) }
).
% get_par_conj(Goal, ParConj0, Subst, ParConj) :
@@ -5959,45 +6389,62 @@
:- pred get_par_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
list(hlds_goal), prog_varset, qual_info, qual_info,
+ predicate_table, hidden_info, hidden_info,
io__state, io__state).
-:- mode get_par_conj(in, in, in, in, out, out, in, out, di, uo) is det.
+:- mode get_par_conj(in, in, in, in, out, out, in, out, in, in, out,
+ di, uo) is det.
-get_par_conj(Goal, Subst, ParConj0, VarSet0, ParConj, VarSet, Info0, Info) -->
+get_par_conj(Goal, Subst, ParConj0, VarSet0, ParConj, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
(
{ Goal = (A & B) - _Context }
->
- get_par_conj(B, Subst, ParConj0, VarSet0, ParConj1, VarSet1,
- Info0, Info1),
- get_par_conj(A, Subst, ParConj1, VarSet1, ParConj, VarSet,
- Info1, Info)
+ get_par_conj(A, Subst, ParConj0, VarSet0, ParConj1, VarSet1,
+ Info0, Info1, PredTable, HiddenInfo0, HiddenInfo1),
+ { edcg__update_var_names(HiddenInfo1, HiddenInfo0,
+ HiddenInfo2) },
+ get_par_conj(B, Subst, ParConj1, VarSet1, ParConj, VarSet,
+ Info1, Info, PredTable, HiddenInfo2, HiddenInfo)
;
transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info),
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo),
{ goal_to_par_conj_list(Goal1, ParConjList) },
- { list__append(ParConjList, ParConj0, ParConj) }
+ { list__append(ParConj0, ParConjList, ParConj) }
).
% get_disj(Goal, Subst, Disj0, Disj) :
-% Goal is a tree of disjuncts. Flatten it into a list (applying Subst)
-% append Disj0, and return the result in Disj.
+% Goal is a tree of disjuncts. Flatten it into a list (applying Subst)
+% append Disj0, and return the result in Disj.
-:- pred get_disj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, qual_info, qual_info,
- io__state, io__state).
-:- mode get_disj(in, in, in, in, out, out, in, out, di, uo) is det.
+:- pred get_disj(goal, prog_substitution,
+ list(pair(pair(hlds_goal, term__context), hidden_info)),
+ prog_varset,
+ list(pair(pair(hlds_goal, term__context), hidden_info)),
+ prog_varset,
+ qual_info, qual_info,
+ predicate_table, hidden_info, hidden_info,
+ io__state, io__state).
+:- mode get_disj(in, in, in, in, out, out, in, out, in, in, out, di, uo) is det.
-get_disj(Goal, Subst, Disj0, VarSet0, Disj, VarSet, Info0, Info) -->
- (
- { Goal = (A;B) - _Context }
- ->
- get_disj(B, Subst, Disj0, VarSet0, Disj1, VarSet1,
- Info0, Info1),
- get_disj(A, Subst, Disj1, VarSet1, Disj, VarSet, Info1, Info)
- ;
- transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
- Info0, Info),
- { Disj = [Goal1 | Disj0] }
- ).
+get_disj(Goal, Subst, Disj0, VarSet0, Disj, VarSet, Info0, Info,
+ PredTable, HiddenInfo0, HiddenInfo) -->
+ (
+ { Goal = (A;B) - _Context }
+ ->
+ get_disj(A, Subst, Disj0, VarSet0, Disj1, VarSet1,
+ Info0, Info1, PredTable, HiddenInfo0, HiddenInfo1),
+ { edcg__update_var_names(HiddenInfo1, HiddenInfo0,
+ HiddenInfo2) },
+ get_disj(B, Subst, Disj1, VarSet1, Disj, VarSet,
+ Info1, Info, PredTable, HiddenInfo2, HiddenInfo)
+ ;
+ { Goal = _ - Context },
+ transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
+ Info0, Info, PredTable, HiddenInfo0, HiddenInfo),
+ { Disj1 = [(Goal1 - Context) - HiddenInfo] },
+ { list__append(Disj0, Disj1, Disj) }
+ % XXX: should be able to remove append
+ ).
%-----------------------------------------------------------------------------%
@@ -6097,11 +6544,38 @@
io__write_string(Descr),
io__write_string("' declaration.\n").
+:- pred list_multiple_def_error(predicate_table, string, string,
+ list(pair(pred_id)), io__state, io__state).
+:- mode list_multiple_def_error(in, in, in, in, di, uo) is det.
+
+list_multiple_def_error(_, _, _, []) --> [].
+list_multiple_def_error(PredTable, DefType, ArityType,
+ [PredId1 - PredId2 | Rest]) -->
+ { predicate_table_pred_info(PredTable, PredId1, PredInfo1) },
+ { predicate_table_pred_info(PredTable, PredId2, PredInfo2) },
+ { pred_info_module(PredInfo1, Module) },
+ { pred_info_name(PredInfo1, Name) },
+ { pred_info_arity(PredInfo1, Arity) },
+ { PredName = qualified(Module, Name) },
+ { pred_info_context(PredInfo1, Context1) },
+ { pred_info_context(PredInfo2, Context2) },
+ multiple_def_error(PredName, Arity, DefType, ArityType, Context1,
+ Context2),
+ list_multiple_def_error(PredTable, DefType, ArityType, Rest).
+
:- pred multiple_def_error(sym_name, int, string, prog_context, prog_context,
io__state, io__state).
:- mode multiple_def_error(in, in, in, in, in, di, uo) is det.
multiple_def_error(Name, Arity, DefType, Context, OrigContext) -->
+ multiple_def_error(Name, Arity, DefType, "visual",
+ Context, OrigContext).
+
+:- pred multiple_def_error(sym_name, int, string, string, term__context,
+ term__context, io__state, io__state).
+:- mode multiple_def_error(in, in, in, in, in, in, di, uo) is det.
+
+multiple_def_error(Name, Arity, DefType, ArityType, Context, OrigContext) -->
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string("Error: "),
@@ -6110,7 +6584,9 @@
prog_out__write_sym_name(Name),
io__write_string("/"),
io__write_int(Arity),
- io__write_string("' multiply defined.\n"),
+ io__write_string("' multiply defined for "),
+ io__write_string(ArityType),
+ io__write_string(" arity.\n"),
prog_out__write_context(OrigContext),
io__write_string(
" Here is the previous definition of "),
@@ -6153,6 +6629,35 @@
prog_out__write_sym_name_and_arity(Name/Arity),
io__write_string("' specifies non-existent mode.\n").
+:- pred maybe_undef_hidden_modes(list(hidden_form_and_name), module_info,
+ module_info, sym_name, arity, pred_or_func, term__context,
+ io__state, io__state).
+:- mode maybe_undef_hidden_modes(in, in, out, in, in, in, in, di, uo) is det.
+
+maybe_undef_hidden_modes([], ModuleInfo, ModuleInfo, _, _, _, _) --> [].
+maybe_undef_hidden_modes([FormAndName | Rest], ModuleInfo0, ModuleInfo,
+ Name, Arity, PredOrFunc, Context) -->
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ prog_out__write_context(Context),
+ io__write_string("Error: In "),
+ hlds_out__write_simple_call_id(PredOrFunc, Name/Arity),
+ io__write_string("\n"),
+ maybe_undef_hidden_modes_2([FormAndName | Rest], Context).
+
+:- pred maybe_undef_hidden_modes_2(list(hidden_form_and_name), term__context,
+ io__state, io__state).
+:- mode maybe_undef_hidden_modes_2(in, in, di, uo) is det.
+
+maybe_undef_hidden_modes_2([], _) --> [].
+maybe_undef_hidden_modes_2([FormAndName | Rest], Context) -->
+ prog_out__write_context(Context),
+ io__write_string(" No mode(s) declared for hidden argument "),
+ { edcg__name_and_form(HiddenArg, Form, FormAndName) },
+ mercury_output_bracketed_sym_name(HiddenArg),
+ { edcg__string_to_form(FormString, Form) },
+ io__write_strings([" for the form ", FormString, ".\n"]),
+ maybe_undef_hidden_modes_2(Rest, Context).
+
:- pred maybe_undefined_pred_error(sym_name, int, pred_or_func, prog_context,
string, io__state, io__state).
:- mode maybe_undefined_pred_error(in, in, in, in, in, di, uo) is det.
@@ -6447,5 +6952,3 @@
;
PragmaVars0 = []
).
-
-%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list