[m-dev.] for review: EDCGs - diff part 1 (again)
Peter Nicholas MALKIN
pnmalk at students.cs.mu.oz.au
Fri Feb 4 00:32:48 AEDT 2000
Hi,
Please disregard the last diff email. I have posted the first part again
because the previous diff was not created with the -u option.
Estimated Hours Taken: >100
Implementation of the EDCG syntax. The transformation from code with EDCGs to
code without, is done when items are placed into the HLDS.
EDCGs are as their name implies are similar to DCGs, except more variation is
allowed in the usage of implicit arguments (referred to here as hidden
arguments). Like DCGs, EDCGs do not change the semantics of the language. They
are similar to DCGs, in that the compiler performs a source to source
transformation of the EDCG code.
EDCGs are a way of implicitly using variables (through hidden variables) that
can be used within the body of a clause without explicitly listing the variable
in the head argument list or in any predicate call argument list within the body
of the clause. A hidden variable represents a single variable at a time, but not
necessarily always the same variable. Each hidden variable has associated with
it a name (hidden variables are module qualified) that must be distinct from all
other hidden variable names. A hidden variable can be only be used in specific
places where it is in scope.
The transformation is based around the hidden_info type, which contains
state_info for each hidden variable at any particular part of the program.
The state_info can be in one of three main states: dead, used or changed. If a
hidden variable is dead it is out of scope. If a hidden variable is used it
is in scope and represents a variable. If a hidden variable is changed then it
is in scope and represents a variable and also represents a next variable (the
next variable is accessed with the operator '$=', the current variable is
accessed using the '$' operator).
Detailed Desciption:
compiler/edcg.m:
New file. Contains predicates to manipulate the hidden_info, and
state_info data structures (the main EDCG data structures).
Also contains some predicates to parse EDCG syntax.
compiler/prog_data.m:
Added and changed types to deal with hidden declarations.
compiler/prog_io.m:
Added code to parse EDCG `htype' and `hmode' declarations and also code
to parse EDCG clauses.
compiler/prog_io_dcg.m:
Trivial changes.
compiler/prog_io_goal.m:
Added code the parse the additional hidden part to predicate calls.
compiler/prog_io_typeclass.m:
Trivial changes.
compiler/prog_util.m:
Trivial changes.
Index: compiler/edcg.m
===================================================================
RCS file: edcg.m
diff -N edcg.m
--- /dev/null Wed May 28 10:49:58 1997
+++ edcg.m Wed Feb 2 18:49:37 2000
@@ -0,0 +1,1899 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1999-2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+
+% File: edcg.m.
+% Main author: pnmalk.
+
+% This file provides predicates to transform code with EDCG notation into code
+% without. The transformation takes place when items are placed into the HLDS.
+
+%---------------------------------------------------------------------------%
+
+:- module edcg.
+
+:- interface.
+
+:- import_module assoc_list, list, term, bool.
+:- import_module hlds_pred, hlds_module, hlds_goal.
+:- import_module prog_data.
+:- import_module std_util.
+
+%---------------------------------------------------------------------------%
+ % Predicates to manipulate the edcg_table data structure
+
+:- type edcg_table.
+
+:- type htype_or_hmode
+ ---> hidden_type
+ ; hidden_mode.
+
+:- pred edcg_table_init(edcg_table::out) is det.
+
+ % Assumes that htype declaration does not already exist.
+:- pred edcg_table_add_htype(edcg_table, hidden_arg, htype_defn, term__context,
+ edcg_table).
+:- mode edcg_table_add_htype(in, in, in, in, out) is det.
+
+ % Assumes that hmode declaration does not already exist.
+:- pred edcg_table_add_hmode(edcg_table, hidden_arg, hmode_defn, term__context,
+ edcg_table).
+:- mode edcg_table_add_hmode(in, in, in, in, out) is det.
+
+:- pred edcg_table_fetch_hidden_type(hidden_arg, edcg_table, type).
+:- mode edcg_table_fetch_hidden_type(in, in, out) is semidet.
+
+:- pred edcg_table_fetch_hidden_mode(hidden_arg, form, edcg_table,
+ list(mode)).
+:- mode edcg_table_fetch_hidden_mode(in, in, in, out) is semidet.
+
+:- pred edcg_table_fetch_context(edcg_table, hidden_arg, htype_or_hmode,
+ term__context).
+:- mode edcg_table_fetch_context(in, in, in, out) is semidet.
+
+:- pred edcg_table_get_hidden_info(edcg_table, hidden_info).
+:- mode edcg_table_get_hidden_info(in, out) is det.
+
+:- pred htype_or_hmode_to_string(htype_or_hmode::in, string::out) is det.
+
+%-----------------------------------------------------------------------------%
+ % Predicates to expand EDCG clauses. Only used by make_hlds.m, and
+ % hlds_module.m.
+
+:- type hidden_info.
+
+:- type edcg_operator
+ ---> access
+ ; change.
+
+:- type hidden_disj_info
+ == assoc_list(pair(hlds_goal, term__context), hidden_info).
+
+ % Returns a list types that are to be appended onto the end of the
+ % head type list of a particular predicate.
+:- pred get_hidden_pred_types(module_info, hidden_forms, list(type)).
+:- mode get_hidden_pred_types(in, in, out) is det.
+
+ % Returns a list of modes that are to be appended onto the end of the
+ % head mode list of a particular predicate.
+:- pred get_hidden_pred_modes(hidden_forms, list(mode),
+ pred_id, term__context, module_info, module_info,
+ io__state, io__state).
+:- mode get_hidden_pred_modes(in, out, in, in, in, out, di, uo) is det.
+
+ % sep_hidden_terms(HiddenTerms, VarSet0, Context, HiddenInfoIn,
+ % HiddenInfoOut, HiddenForms, FirstHiddenNames,
+ % SecondHiddenNames, FirstArgs, SecondArgs)
+ %
+ % The purpose of this predicate is basically to parse the head of an
+ % EDCG goal. HiddenTerms is a list of hidden variables as functors with
+ % one or two arguments, as listed for an EDCG goal. HiddenForms is a
+ % list of all the hidden variables listed in the goal head and their
+ % repspective forms. FirstHiddenNames is a list of all hidden variables
+ % in the list, of form passed or changed. SecondHiddenNames is a list
+ % of the with form changed or produced. FirstArgs is a list of all the
+ % terms which the hidden variables in FirstHiddenNames will be unified
+ % with before the goal. SecondArgs is a list of all the terms which the
+ % hidden variables in SecondHiddenNames will be unified with after the
+ % goal. HiddenInfoIn is HiddenInfoOut unless an error was found.
+:- pred sep_hidden_terms(prog_term, term__context,
+ hidden_info, hidden_info, hidden_forms,
+ list(hidden_arg), list(hidden_arg),
+ list(prog_term), list(prog_term)).
+:- mode sep_hidden_terms(in, in, in, out, out, out, out,
+ out, out) is det.
+
+ % add_hidden_head_args(FormsAndNamesList, HiddenInfoIn,
+ % HiddenInfoOut, VisualArgs):
+ %
+ % Given a list of FormsAndNames declared for a particular predicate,
+ % the pre state (HiddenInfoIn) and post state of a clause for that
+ % predicate, VisualAndHiddenArgs is a list hidden arguments for that
+ % clause head.
+:- pred get_hidden_head_args(hidden_forms,
+ hidden_info, hidden_info, list(prog_term)).
+:- mode get_hidden_head_args(in, in, in, out) is det.
+
+ % add_hidden_args(PredName, VisualArgs, HiddenArgs, AllArgs,
+ % VarSet0, VarSet, Context, HiddenInfoIn, HiddenInfoOut, PredTable):
+ %
+ % PredName is looked up in the PredTable to obtain the list of forms
+ % and names of hidden arguments it uses. The appropriate list of
+ % hidden arguments is appended onto the VisualArgs list to give
+ % AllArgs. This is used for predicate calls.
+:- pred add_hidden_args(sym_name, list(prog_term), list(prog_term),
+ list(prog_term), prog_varset, prog_varset, term__context,
+ hidden_info, hidden_info, predicate_table).
+:- mode add_hidden_args(in, in, in, out, in, out, in, in, out, in) is det.
+
+ % maybe_hidden_error/8 :
+ % prints out error messages corresponding to error states returned
+ % from processing the Body of a clause.
+:- pred maybe_hidden_error(hidden_info, pred_id,
+ module_info, module_info, io__state, io__state).
+:- mode maybe_hidden_error(in, in, in, out, di, uo) is det.
+
+ % update_disj_list(DisjunctAndHiddenInfoList, HiddenInfoIn,
+ % GoalInfo, HLDSGoalList, HiddenInfoOut):
+ %
+ % Given a list of disjuncts it calls update_disjunct/8 on every
+ % disjunct. HLDSGoalList is the final list of HLDSGoals with
+ % the appropriate unifications appended such that all hidden
+ % variables in scope at the end of the disjunction represent
+ % consistent variables accross disjunctions. HiddenInfoOut is the
+ % consistent post state of the disjunctions.
+:- pred update_disj_list(hidden_disj_info, hlds_goal_info,
+ prog_varset, prog_varset,
+ list(hlds_goal), hidden_info).
+:- mode update_disj_list(in, in, in, out, out, out) is det.
+
+ % update_if_then_else(ThenGoal, ElseGoal, Context, ThenHiddenInfoIn,
+ % GoalInfo, HLDSGoalList, HiddenInfoOut):
+ %
+ % If-then-elses are treated similarly to disjuncts hence
+ % update_if_then_else calls update_disjunct_list/6.
+:- pred update_if_then_else(hlds_goal, hlds_goal, term__context,
+ hlds_goal_info, prog_varset, prog_varset,
+ hidden_info, hidden_info, hidden_info,
+ hlds_goal, hlds_goal).
+:- mode update_if_then_else(in, in, in, in, in, out, in, in, out, out, out)
+ is det.
+
+ % check_for_dups(ListFormsAndNames, PredId, Context, ModuleInfoIn,
+ % ModuleInfoOut):
+ %
+ % Checks for any duplicate hidden variables in the list of forms and
+ % names.
+:- pred check_for_dups(hidden_forms, pred_id, term__context,
+ module_info, module_info, io__state, io__state).
+:- mode check_for_dups(in, in, in, in, out, di, uo) is det.
+
+ % 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.
+
+ % check_hidden_states(HiddenForms, Context, HiddenInfoIn,
+ % HiddenInfoOut):
+ %
+ % HiddenInfoIn is the post state of a clause. This predicates check
+ % the post state against the declared forms of the hidden
+ % variables in HiddenForms.
+:- pred check_hidden_states(hidden_forms, term__context,
+ hidden_info, hidden_info).
+:- mode check_hidden_states(in, in, in, out) is det.
+
+%---------------------------------------------------------------------------%
+ % Hidden info utility predicates
+
+:- pred hidden_info_init(hidden_info::out) is det.
+
+ % Adds a hidden argument to the current hidden information.
+:- pred hidden_info_add_hidden_arg(hidden_info, hidden_arg, hidden_info).
+:- mode hidden_info_add_hidden_arg(in, in, out) is det.
+
+ % hidden_info_initial_state(FormsAndNames, VarSet0, VarSet, IsFact,
+ % HiddenInfoIn, HiddenInfoOut):
+ %
+ % HiddenInfoOut is HiddenInfoIn with all the hidden arguments
+ % in FormsAndNames having appropriate information added, such
+ % that HiddenInfoOut is the pre state of a predicate with
+ % the FormsAndNames declaration.
+ % IsFact is yes if the Clause with FormsAndNames is a fact.
+ % It is needed to flag whether an underscore needs to be
+ % prefixed to the NameBase, to prevent unused variable warnings.
+:- pred hidden_info_initial_state(hidden_forms, prog_varset,
+ prog_varset, bool, hidden_info, hidden_info).
+:- mode hidden_info_initial_state(in, in, out, in, in, out) is det.
+
+ % hidden_info_update(HiddenInfoIn, HiddenInfOut)
+ %
+ % HiddenInfoOut is HiddenInfoIn with all hidden variables, that were
+ % changed (used with the operator `$=') in the last goal, now
+ % representing their next variable.
+:- pred hidden_info_update(hidden_info, hidden_info).
+:- mode hidden_info_update(in, out) is det.
+
+ % hidden_info_convert(HiddenArgs, Context, Forms, Vars,
+ % VarSet0, VarSet, HiddenInfoIn, HiddenInfoOut)
+ %
+ % This predicate is used to set the initial hidden_info for an EDCG
+ % goal. HiddenArgs is a list of hidden variables with a scope local to
+ % the EDCG goal. Every hidden variable in HiddenArgs has its state
+ % changed within HiddenInfoIn. The new state is `alive' with a fresh
+ % variable as listed in Vars. The form of the new state is the
+ % corresponding form from Forms. HiddenInfoOut is HiddenInfoIn with the
+ % new states of the HiddenArgs.
+:- pred hidden_info_convert(hidden_forms, term__context,
+ prog_varset, prog_varset, hidden_info, hidden_info).
+:- mode hidden_info_convert(in, in, in, out, in, out) is det.
+
+ % hidden_info_revert(HiddenArgs, HiddenInfoInitial, HiddenInfoFinal,
+ % HiddenInfoOut)
+ %
+ % HiddenInfoOut is HiddenInfoFinal except that the hidden variables in
+ % HiddenArgs have their state set to what it is in HiddenInfoInitial.
+ % This predicate is used after processing EDCG goals. HiddenInfoIntial
+ % is the hidden_info before the goal and HiddenInfoFinal is the state at
+ % the end of the goal. HiddenArgs is a list of hidden variables with a
+ % scope local to the EDCG goal. This predicate undoes
+ % hidden_info_convert/6.
+:- pred hidden_info_revert(list(hidden_arg), hidden_info,
+ hidden_info, hidden_info).
+:- mode hidden_info_revert(in, in, in, out) is det.
+
+ % hidden_info_vars(HiddenArgs, HiddenInfo, Vars)
+ %
+ % Vars is the list of variables of that the list of hidden variables
+ % HiddenArgs currently represent in HiddenInfo.
+:- pred hidden_info_vars(list(hidden_arg), hidden_info, prog_vars).
+:- mode hidden_info_vars(in, in, out) is det.
+
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module prog_util, prog_out, prog_io, prog_io_util, prog_io_goal.
+:- import_module io, map, string, set, int, assoc_list, require, varset.
+:- import_module hlds_data, make_hlds, error_util.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type edcg_table
+ ---> edcg_table(htype_table, hmode_table, hidden_info).
+
+:- type htype_table == map(hidden_arg, htype_info).
+:- type hmode_table == map(hidden_arg, hmode_info).
+
+:- type htype_info == pair(htype_defn, term__context).
+:- type hmode_info == pair(hmode_defn, term__context).
+
+edcg_table_init(edcg_table(HtypeTable, HmodeTable, HiddenInfo)) :-
+ map__init(HtypeTable),
+ map__init(HmodeTable),
+ hidden_info_init(HiddenInfo).
+
+edcg_table_add_htype(EDCGTable0, HiddenArg, HtypeDefn, Context,
+ EDCGTable) :-
+ edcg_table_get_htype_table(EDCGTable0, HtypeTable0),
+ map__set(HtypeTable0, HiddenArg, HtypeDefn - Context, HtypeTable),
+ edcg_table_set_htype_table(EDCGTable0, HtypeTable, EDCGTable1),
+ edcg_table_get_hidden_info(EDCGTable1, HiddenInfo0),
+ hidden_info_add_hidden_arg(HiddenInfo0, HiddenArg, HiddenInfo),
+ edcg_table_set_hidden_info(EDCGTable1, HiddenInfo, EDCGTable).
+
+edcg_table_add_hmode(EDCGTable0, HiddenArg, HmodeDefn, Context,
+ EDCGTable) :-
+ edcg_table_get_hmode_table(EDCGTable0, HmodeTable0),
+ map__set(HmodeTable0, HiddenArg, HmodeDefn - Context, HmodeTable),
+ edcg_table_set_hmode_table(EDCGTable0, HmodeTable, EDCGTable).
+
+edcg_table_fetch_hidden_type(HiddenArg, EDCGTable, Type) :-
+ edcg_table_get_htype_table(EDCGTable, HtypeTable),
+ map__search(HtypeTable, HiddenArg, htype_defn(Type) - _).
+
+edcg_table_fetch_hidden_mode(HiddenArg, Form, EDCGTable,
+ ModeList) :-
+ edcg_table_get_hmode_table(EDCGTable, HmodeTable),
+ map__search(HmodeTable, HiddenArg, HmodeDefn - _),
+ get_hidden_modes(Form, HmodeDefn, ModeList).
+
+edcg_table_fetch_context(EDCGTable, HiddenArg, hidden_mode,
+ Context) :-
+ edcg_table_get_hmode_table(EDCGTable, HmodeTable),
+ map__search(HmodeTable, HiddenArg, _ - Context).
+edcg_table_fetch_context(EDCGTable, HiddenArg, hidden_type,
+ Context) :-
+ edcg_table_get_htype_table(EDCGTable, HtypeTable),
+ map__search(HtypeTable, HiddenArg, _ - Context).
+
+edcg_table_get_hidden_info(edcg_table(_,_,HiddenInfo), HiddenInfo).
+
+htype_or_hmode_to_string(hidden_type, "htype").
+htype_or_hmode_to_string(hidden_mode, "hmode").
+
+:- pred edcg_table_get_htype_table(edcg_table, htype_table).
+:- mode edcg_table_get_htype_table(in, out) is det.
+
+edcg_table_get_htype_table(edcg_table(HtypeTable,_,_), HtypeTable).
+
+:- pred edcg_table_get_hmode_table(edcg_table, hmode_table).
+:- mode edcg_table_get_hmode_table(in, out) is det.
+
+edcg_table_get_hmode_table(edcg_table(_,HmodeTable,_), HmodeTable).
+
+:- pred edcg_table_set_htype_table(edcg_table, htype_table, edcg_table).
+:- mode edcg_table_set_htype_table(in, in, out) is det.
+
+edcg_table_set_htype_table(edcg_table(_,B,C), HtypeTable,
+ edcg_table(HtypeTable,B,C)).
+
+:- pred edcg_table_set_hmode_table(edcg_table, hmode_table, edcg_table).
+:- mode edcg_table_set_hmode_table(in, in, out) is det.
+
+edcg_table_set_hmode_table(edcg_table(A,_,C), HmodeTable,
+ edcg_table(A,HmodeTable,C)).
+
+:- pred edcg_table_set_hidden_info(edcg_table, hidden_info, edcg_table).
+:- mode edcg_table_set_hidden_info(in, in, out) is det.
+
+edcg_table_set_hidden_info(edcg_table(A,B,_), HiddenInfo,
+ edcg_table(A,B,HiddenInfo)).
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+get_hidden_pred_types(_, [], []).
+get_hidden_pred_types(ModuleInfo, [HiddenArg - Form|Rest],
+ TypeList) :-
+ module_info_edcgs(ModuleInfo, EDCGTable),
+ (
+ edcg_table_fetch_hidden_type(HiddenArg, EDCGTable, Type)
+ ->
+ (
+ Form = changed
+ ->
+ TypeList = [Type,Type|TypeList0],
+ get_hidden_pred_types(ModuleInfo, Rest, TypeList0)
+ ;
+ TypeList = [Type|TypeList0],
+ get_hidden_pred_types(ModuleInfo, Rest, TypeList0)
+ )
+ ;
+ % The hidden argument's exisistence has already been
+ % checked.
+ error("Missing value from hidden type table.")
+ ).
+
+get_hidden_pred_modes(FormsAndNames, Modes, PredId, Context,
+ ModuleInfo0, ModuleInfo) -->
+ { get_hidden_pred_modes_2(ModuleInfo0, FormsAndNames, Modes,
+ UndefFormsAndNames) },
+ maybe_undef_hidden_modes(UndefFormsAndNames, PredId, Context,
+ ModuleInfo0, ModuleInfo).
+
+:- pred get_hidden_pred_modes_2(module_info, hidden_forms,
+ list(mode), hidden_forms).
+:- mode get_hidden_pred_modes_2(in, in, out, out) is det.
+
+get_hidden_pred_modes_2(_, [], [], []).
+get_hidden_pred_modes_2(ModuleInfo, [HiddenArg - Form|Rest], ModeList,
+ UndefFormsAndNames) :-
+ module_info_edcgs(ModuleInfo, EDCGTable),
+ (
+ edcg_table_fetch_hidden_mode(HiddenArg, Form, EDCGTable, Modes)
+ ->
+ list__append(Modes, ModeList0, ModeList),
+ get_hidden_pred_modes_2(ModuleInfo, Rest, ModeList0,
+ UndefFormsAndNames)
+ ;
+ UndefFormsAndNames = [HiddenArg - Form | UndefFormsAndNames0],
+ get_hidden_pred_modes_2(ModuleInfo, Rest, ModeList,
+ UndefFormsAndNames0)
+ ).
+
+:- pred maybe_undef_hidden_modes(hidden_forms,
+ pred_id, term__context, module_info, module_info,
+ io__state, io__state).
+:- mode maybe_undef_hidden_modes(in, in, in, in, out, di, uo) is det.
+
+maybe_undef_hidden_modes([], _, _, ModuleInfo, ModuleInfo) --> [].
+maybe_undef_hidden_modes([FormAndName | Rest], PredId, Context,
+ ModuleInfo0, ModuleInfo) -->
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { error_util__describe_one_pred_name(ModuleInfo, PredId,
+ PredDes) },
+ { maybe_undef_hidden_modes_2([FormAndName | Rest], ErrorDes) },
+ { list__append([words("Error: In"), fixed(PredDes)], ErrorDes,
+ ErrorMsg) },
+ error_util__write_error_pieces(Context, 0, ErrorMsg).
+
+:- pred maybe_undef_hidden_modes_2(hidden_forms, list(format_component)).
+:- mode maybe_undef_hidden_modes_2(in, out) is det.
+
+maybe_undef_hidden_modes_2([], []).
+maybe_undef_hidden_modes_2([HiddenArg - Form | Rest], Msg) :-
+ sym_name_to_string(HiddenArg, HiddenString),
+ form_to_string(Form, FormString),
+ maybe_undef_hidden_modes_2(Rest, Msg0),
+ list__append([words("No mode(s) declared for hidden argument"),
+ words(HiddenString), words("for the form"), words(FormString),
+ nl], Msg0, Msg).
+
+sep_hidden_terms(Term0, Context, HiddenInfo0, HiddenInfo, NameAndForms,
+ FirstNames, SecondNames, FirstArgs, SecondArgs) :-
+ sep_hidden_terms_2(Term0, Context, HiddenInfo0, HiddenInfo,
+ [], NameAndForms, [], FirstNames, [], SecondNames,
+ [], FirstArgs, [], SecondArgs).
+
+:- pred sep_hidden_terms_2(prog_term, term__context,
+ hidden_info, hidden_info,
+ hidden_forms, hidden_forms,
+ list(hidden_arg), list(hidden_arg),
+ list(hidden_arg), list(hidden_arg),
+ list(prog_term), list(prog_term),
+ list(prog_term), list(prog_term)).
+:- mode sep_hidden_terms_2(in, in, in, out, in, out, in, out, in, out,
+ in, out, in, out) is det.
+
+sep_hidden_terms_2(Term0, Context, HiddenInfo0, HiddenInfo,
+ NameAndForms0, NameAndForms, FirstNames0, FirstNames,
+ SecondNames0, SecondNames, FirstArgs0, FirstArgs,
+ SecondArgs0, SecondArgs) :-
+ (
+ Term0 = term__functor(term__atom(","), [Term1, Term2],
+ _Context)
+ ->
+ sep_hidden_terms_2(Term1, Context, HiddenInfo0, HiddenInfo1,
+ NameAndForms0, NameAndForms1, FirstNames0, FirstNames1,
+ SecondNames0, SecondNames1, FirstArgs0, FirstArgs1,
+ SecondArgs0, SecondArgs1),
+ sep_hidden_terms_2(Term2, Context, HiddenInfo1, HiddenInfo,
+ NameAndForms1, NameAndForms, FirstNames1, FirstNames,
+ SecondNames1, SecondNames, FirstArgs1, FirstArgs,
+ SecondArgs1, SecondArgs)
+ ;
+ Term0 = term__functor(term__atom("is"), [Term1, Term2],
+ _Context),
+ sym_name_and_args(Term1, Name0, []),
+ hidden_info_get_hidden_arg(Name0, Context, HiddenInfo0,
+ HiddenInfo1, Name)
+ ->
+ (
+ Term2 = term__functor(term__atom("changed"),
+ [FirstArg, SecondArg], _)
+ ->
+ NameAndForms = [Name - changed | NameAndForms0],
+ FirstNames = [Name | FirstNames0],
+ SecondNames = [Name | SecondNames0],
+ FirstArgs = [FirstArg | FirstArgs0],
+ SecondArgs = [SecondArg | SecondArgs0],
+ HiddenInfo = HiddenInfo1
+ ;
+ Term2 = term__functor(term__atom("passed"),
+ [FirstArg], _)
+ ->
+ NameAndForms = [Name - changed | NameAndForms0],
+ FirstNames = [Name | FirstNames0],
+ SecondNames = SecondNames0,
+ FirstArgs = [FirstArg | FirstArgs0],
+ SecondArgs = SecondArgs0,
+ HiddenInfo = HiddenInfo1
+ ;
+ Term2 = term__functor(term__atom("produced"),
+ [SecondArg], _)
+ ->
+ NameAndForms = [Name - changed | NameAndForms0],
+ FirstNames = FirstNames0,
+ SecondNames = [Name | SecondNames0],
+ FirstArgs = FirstArgs0,
+ SecondArgs = [SecondArg | SecondArgs0],
+ HiddenInfo = HiddenInfo1
+ ;
+ NameAndForms = NameAndForms0,
+ FirstNames = FirstNames0,
+ SecondNames = SecondNames0,
+ FirstArgs = FirstArgs0,
+ SecondArgs = SecondArgs0,
+ hidden_info_error(
+ syntax_error("Unrecognised edcg form.",
+ Context), HiddenInfo1,
+ HiddenInfo)
+ )
+ ;
+ NameAndForms = NameAndForms0,
+ FirstNames = FirstNames0,
+ SecondNames = SecondNames0,
+ FirstArgs = FirstArgs0,
+ SecondArgs = SecondArgs0,
+ hidden_info_error(syntax_error("Unrecognised edcg goal head.",
+ Context), HiddenInfo0, HiddenInfo)
+ ).
+
+get_hidden_head_args([], _, _, []).
+get_hidden_head_args([HiddenArg - Form | Rest], HiddenInfo0, HiddenInfo1,
+ Terms) :-
+ (
+ Form = changed,
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0,
+ StateInfo1),
+ state_info_get_var(StateInfo1, Var1),
+ hidden_info_get_state_info(HiddenArg, HiddenInfo1,
+ StateInfo2),
+ state_info_get_var(StateInfo2, Var2),
+ Terms = [term__variable(Var1) , term__variable(Var2) | Terms0]
+ ;
+ Form = passed,
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0,
+ StateInfo),
+ state_info_get_var(StateInfo, Var),
+ Terms = [term__variable(Var) | Terms0]
+ ;
+ Form = produced,
+ hidden_info_get_state_info(HiddenArg, HiddenInfo1,
+ StateInfo),
+ state_info_get_var(StateInfo, Var),
+ Terms = [term__variable(Var) | Terms0]
+ ),
+ get_hidden_head_args(Rest, HiddenInfo0, HiddenInfo1, Terms0).
+
+add_hidden_args(Name, VisualArgs0, HiddenArgs, TotalArgs, VarSet0, VarSet,
+ Context, HiddenInfo0, HiddenInfo, PredTable) :-
+ list__length(VisualArgs0, VisualArity),
+ (
+ predicate_table_search_sym_arity(PredTable, Name, VisualArity,
+ PredIds)
+ ->
+ (
+ PredIds = [PredId]
+ ->
+ predicate_table_pred_info(PredTable, PredId, PredInfo),
+ pred_info_arity(PredInfo, TotalArity),
+ (
+ VisualArity = TotalArity
+ ->
+ TotalArgs = VisualArgs0,
+ VarSet = VarSet0,
+ (
+ HiddenArgs = []
+ ->
+ HiddenInfo = HiddenInfo0
+ ;
+ hidden_info_error(
+ pred_call_ambiguity_error(
+ Context, [PredId]),
+ HiddenInfo0, HiddenInfo)
+ )
+ ;
+ pred_info_hidden_args(PredInfo, FormsAndNames),
+ check_hidden_terms(HiddenArgs, Context,
+ FormsAndNames, HiddenTerms,
+ HiddenInfo0, HiddenInfo1),
+ add_hidden_args_2(FormsAndNames,
+ HiddenTerms, Context, VarSet0,
+ HiddenInfo1, Args, VarSet,
+ ErrorList, HiddenInfo2),
+ list__append(VisualArgs0, Args, TotalArgs),
+ (
+ ErrorList = []
+ ->
+ HiddenInfo = HiddenInfo2
+ ;
+ hidden_info_error(
+ pred_call_error(PredId,
+ Context, ErrorList),
+ HiddenInfo2, HiddenInfo)
+ )
+ )
+ ;
+ % If no predicates contain hidden arguments then
+ % it is left for typecheck.m to resolve.
+ no_hidden_args(PredIds, PredTable)
+ ->
+ HiddenInfo = HiddenInfo0,
+ VarSet = VarSet0,
+ TotalArgs = VisualArgs0
+ ;
+ hidden_info_error(pred_call_ambiguity_error(Context,
+ PredIds), HiddenInfo0, HiddenInfo),
+ VarSet = VarSet0,
+ TotalArgs = VisualArgs0
+ )
+ ;
+ % Maybe a higher order call.
+ HiddenInfo = HiddenInfo0,
+ VarSet = VarSet0,
+ TotalArgs = VisualArgs0
+ ).
+
+:- pred add_hidden_args_2(hidden_forms,
+ assoc_list(sym_name, list(prog_term)), term__context,
+ prog_varset, hidden_info, list(prog_term), prog_varset,
+ list(hidden_arg), hidden_info).
+:- mode add_hidden_args_2(in, in, in, in, in, out, out, out, out) is det.
+
+ % ErrorList1 is a list of hidden arguments that were found to be
+ % dead but were required to be alive. ErrorList2 is a list of hidden
+ % arguments that were alive instead of dead.
+add_hidden_args_2([], [], _, VarSet, HiddenInfo, [], VarSet, [], HiddenInfo).
+add_hidden_args_2([], [_|_], _, VarSet, HiddenInfo, [], VarSet,
+ [], HiddenInfo) :-
+ error("List length match error.").
+add_hidden_args_2([HiddenArg - Form | Rest], HiddenTerms0, Context, VarSet0,
+ HiddenInfo0, ArgList, VarSet, ErrorList, HiddenInfo) :-
+ (
+ get_hidden_args(HiddenArg, Context, HiddenTerms0,
+ HiddenTerms1, HiddenInfo0, HiddenInfo1, ArgList0)
+ ->
+ add_hidden_args_2(Rest, HiddenTerms1, Context, VarSet0,
+ HiddenInfo1, ArgList1, VarSet, ErrorList,
+ HiddenInfo),
+ list__append(ArgList0, ArgList1, ArgList)
+ ;
+ (
+ Form = passed,
+ (
+ hidden_info_pass(HiddenArg, HiddenInfo0,
+ HiddenInfo1, Var)
+ ->
+ ArgList = [term__variable(Var) | ArgList0],
+ add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet0, HiddenInfo1, ArgList0,
+ VarSet, ErrorList, HiddenInfo)
+ ;
+ ErrorList = [HiddenArg | ErrorList0],
+ hidden_info_birth(HiddenArg, VarSet0, VarSet1,
+ no, HiddenInfo0, HiddenInfo1),
+ add_hidden_args_2([HiddenArg - Form| Rest],
+ HiddenTerms0, Context, VarSet1,
+ HiddenInfo1, ArgList, VarSet,
+ ErrorList0, HiddenInfo)
+ )
+ ;
+ Form = changed,
+ (
+ hidden_info_change(HiddenArg, VarSet0, VarSet1,
+ Var1, Var2, HiddenInfo0, HiddenInfo1)
+ ->
+ ArgList = [term__variable(Var1),
+ term__variable(Var2) | ArgList0],
+ add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet1, HiddenInfo1, ArgList0,
+ VarSet, ErrorList, HiddenInfo)
+ ;
+ ErrorList = [HiddenArg | ErrorList0],
+ hidden_info_birth(HiddenArg, VarSet0, VarSet1,
+ no, HiddenInfo0, HiddenInfo1),
+ add_hidden_args_2([HiddenArg - Form | Rest],
+ HiddenTerms0, Context, VarSet1,
+ HiddenInfo1, ArgList, VarSet,
+ ErrorList0, HiddenInfo)
+ )
+ ;
+ Form = produced,
+ (
+ hidden_info_produce(HiddenArg, VarSet0, VarSet1,
+ Var, HiddenInfo0, HiddenInfo1)
+ ->
+ ArgList = [term__variable(Var) | ArgList0],
+ add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet1, HiddenInfo1, ArgList0,
+ VarSet, ErrorList,
+ HiddenInfo)
+ ;
+ ErrorList = [HiddenArg | ErrorList0],
+ hidden_info_birth(HiddenArg, VarSet0, VarSet1,
+ no, HiddenInfo0, HiddenInfo1),
+ add_hidden_args_2([HiddenArg - Form | Rest],
+ HiddenTerms0, Context, VarSet1,
+ HiddenInfo1, ArgList, VarSet,
+ ErrorList0, HiddenInfo)
+ )
+ )
+ ).
+
+:- pred check_hidden_terms(list(prog_term), term__context,
+ hidden_forms, assoc_list(sym_name, list(prog_term)),
+ hidden_info, hidden_info).
+:- mode check_hidden_terms(in, in, in, out, in, out) is det.
+
+check_hidden_terms([], _, _, [], HiddenInfo, HiddenInfo).
+check_hidden_terms([HiddenTerm | HiddenTerms], Context,
+ FormAndNames, HiddenArgVars, HiddenInfo0, HiddenInfo) :-
+ (
+ sym_name_and_args(HiddenTerm, HiddenName, Args)
+ ->
+ get_hidden_names(HiddenName, Args, FormAndNames,
+ HiddenNames),
+ (
+ HiddenNames = [Name]
+ ->
+ check_hidden_terms(HiddenTerms, Context,
+ FormAndNames, HiddenArgVars0, HiddenInfo0,
+ HiddenInfo),
+ HiddenArgVars = [Name - Args | HiddenArgVars0]
+ ;
+ HiddenNames = []
+ ->
+ hidden_info_error(undefined_error(HiddenName, Context),
+ HiddenInfo0, HiddenInfo),
+ HiddenArgVars = []
+ ;
+ hidden_info_error(hidden_arg_ambiguity_error(Context,
+ HiddenNames), HiddenInfo0, HiddenInfo),
+ HiddenArgVars = []
+ )
+ ;
+ hidden_info_error(syntax_error("Unrecognised hidden variable.",
+ Context), HiddenInfo0, HiddenInfo),
+ HiddenArgVars = []
+ ).
+
+:- pred get_hidden_names(sym_name, list(prog_term),
+ hidden_forms, list(sym_name)).
+:- mode get_hidden_names(in, in, in, out) is det.
+
+get_hidden_names(_, _, [], []).
+get_hidden_names(HiddenName, Args, [Name - Form | FormAndNames0], Names) :-
+ get_hidden_names(HiddenName, Args, FormAndNames0,
+ Names0),
+ (
+ match_sym_name(HiddenName, Name),
+ (
+ Form = changed
+ ->
+ Args = [_|_]
+ ;
+ Args = [_]
+ )
+ ->
+ Names = [Name | Names0]
+ ;
+ Names = Names0
+ ).
+
+:- pred get_hidden_args(hidden_arg, term__context,
+ assoc_list(sym_name, list(prog_term)),
+ assoc_list(sym_name, list(prog_term)),
+ hidden_info, hidden_info, list(prog_term)).
+:- mode get_hidden_args(in, in, in, out, in, out, out) is semidet.
+
+get_hidden_args(HiddenArg, Context, HiddenTerms0, HiddenTerms,
+ HiddenInfo0, HiddenInfo, ArgList) :-
+ get_hidden_arg_terms(HiddenArg, HiddenTerms0, HiddenTerms,
+ HiddenTermMatches),
+ (
+ HiddenTermMatches = [],
+ fail
+ ;
+ HiddenTermMatches = [_HiddenName - Args],
+ ArgList = Args,
+ HiddenInfo = HiddenInfo0
+ ;
+ HiddenTermMatches = _._._,
+ list__map(fst, HiddenTermMatches, HiddenNames),
+ ArgList = [],
+ hidden_info_error(hidden_arg_ambiguity_error(Context,
+ HiddenNames), HiddenInfo0, HiddenInfo)
+ ).
+
+:- pred get_hidden_arg_terms(hidden_arg,
+ assoc_list(sym_name, list(prog_term)),
+ assoc_list(sym_name, list(prog_term)),
+ assoc_list(sym_name, list(prog_term))).
+:- mode get_hidden_arg_terms(in, in, out, out) is det.
+
+get_hidden_arg_terms(_, [], [], []).
+get_hidden_arg_terms(HiddenArg, [HiddenName - Args | HiddenTerms0],
+ HiddenTerms, HiddenTermMatches) :-
+ (
+ HiddenArg = HiddenName
+ ->
+ get_hidden_arg_terms(HiddenArg, HiddenTerms0,
+ HiddenTerms1, HiddenTermsMatches0),
+ HiddenTermMatches = [HiddenName - Args | HiddenTermsMatches0],
+ HiddenTerms = HiddenTerms1
+ ;
+ get_hidden_arg_terms(HiddenArg, HiddenTerms0,
+ HiddenTerms1, HiddenTermMatches),
+ HiddenTerms = [HiddenName - Args | HiddenTerms1]
+ ).
+
+ % True if all the preds do not have any hidden arguments.
+:- pred no_hidden_args(list(pred_id), predicate_table).
+:- mode no_hidden_args(in, in) is semidet.
+
+no_hidden_args([], _).
+no_hidden_args([PredId | PredIdList], PredTable) :-
+ predicate_table_pred_info(PredTable, PredId, PredInfo),
+ pred_info_hidden_args(PredInfo, FormsAndNames),
+ FormsAndNames = [],
+ no_hidden_args(PredIdList, PredTable).
+
+maybe_hidden_error(HiddenInfo, PredId, ModuleInfo0, ModuleInfo) -->
+ { hidden_info_get_errors(HiddenInfo, Errors0) },
+ { list__reverse(Errors0, Errors) },
+ { error_util__describe_one_pred_name(ModuleInfo0, PredId,
+ PredString) },
+ { PredFormat = [words("In clause for"), fixed(PredString), nl] },
+ maybe_hidden_error_2(Errors, PredFormat, ModuleInfo0, ModuleInfo).
+
+:- pred maybe_hidden_error_2(list(hidden_error), list(format_component),
+ module_info, module_info, io__state, io__state).
+:- mode maybe_hidden_error_2(in, in, in, out, di, uo) is det.
+
+maybe_hidden_error_2([], _, ModuleInfo, ModuleInfo) --> [].
+maybe_hidden_error_2([Error|Rest], PredFormat, ModuleInfo0, ModuleInfo) -->
+ maybe_hidden_error_3(Error, PredFormat, ModuleInfo0, ModuleInfo1),
+ maybe_hidden_error_2(Rest, PredFormat, ModuleInfo1, ModuleInfo).
+
+:- pred maybe_hidden_error_3(hidden_error, list(format_component),
+ module_info, module_info,
+ io__state, io__state).
+:- mode maybe_hidden_error_3(in, in, in, out, di, uo) is det.
+
+maybe_hidden_error_3(form_error(Context, HiddenArg, Form, Use),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { form_to_string(Form, FormString) },
+ { use_to_string(Use, UseString) },
+ { sym_name_to_string(HiddenArg, HiddenArgString) },
+ { string__append_list(["EDCG variable ", HiddenArgString,
+ " form error: ", " declared ", FormString, " but inferred ",
+ UseString, "."], Message) },
+ { list__append(PredFormat, [words(Message)], FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(pred_call_error(PredId, Context,
+ HiddenArgList), PredFormat, ModuleInfo0, ModuleInfo) -->
+ { error_util__describe_one_pred_name(ModuleInfo0, PredId, PredString) },
+ { list__append(PredFormat,
+ [words("EDCG scope error: At call to"),
+ words(PredString), nl], FormatComps0) },
+ { scope_error(HiddenArgList, Context, MessageString) },
+ { error_util__list_to_pieces(MessageString, MessageFormat) },
+ { list__append(FormatComps0, MessageFormat, FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(scope_error(Op, Context, HiddenArg),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { list__append(PredFormat, [words("EDCG scope error: At operator"),
+ words(Op), nl], FormatComps0) },
+ { scope_error([HiddenArg], Context, MessageString) },
+ { error_util__list_to_pieces(MessageString, MessageFormat) },
+ { list__append(FormatComps0, MessageFormat, FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(hidden_arg_ambiguity_error(Context, HiddenArgs),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { list__append(PredFormat, [words("Ambiguous hidden argument use."), nl,
+ words("Possible matches are:")], FormatComps0) },
+ { hidden_arg_list_to_string(HiddenArgs, HiddenStrings) },
+ { error_util__list_to_pieces(HiddenStrings, HiddenFormats) },
+ { list__append(FormatComps0, HiddenFormats, FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(pred_call_ambiguity_error(Context, PredIds),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { list__append(PredFormat, [words("Ambiguous call to predicate."), nl,
+ words("Possible matches are:")], FormatComps0) },
+ { error_util__describe_several_pred_names(ModuleInfo0, PredIds,
+ FormatComps1) },
+ { list__append(FormatComps0, FormatComps1, FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(undefined_error(HiddenArg, Context),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { sym_name_to_string(HiddenArg, HiddenArgString) },
+ { list__append(PredFormat,
+ [words("Undefined hidden argument:"), words(HiddenArgString)],
+ FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(change_error(HiddenArg, Context),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { sym_name_to_string(HiddenArg, HiddenArgString) },
+ { list__append(PredFormat,
+ [words("EDCG operator error: $= used twice within goal"),
+ words("with hidden argument:"), words(HiddenArgString)],
+ FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+maybe_hidden_error_3(syntax_error(Message, Context),
+ PredFormat, ModuleInfo0, ModuleInfo) -->
+ { list__append(PredFormat, [words("EDCG syntax error:"),
+ words(Message)], FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }.
+
+:- pred scope_error(list(hidden_arg), term__context, list(string)).
+:- mode scope_error(in, in, out) is det.
+
+scope_error([], _, []).
+scope_error([HiddenArg|Rest], Context, String.Strings) :-
+ sym_name_to_string(HiddenArg, HiddenArgString),
+ string__append(HiddenArgString, " is not in scope", String),
+ scope_error(Rest, Context, Strings).
+
+update_if_then_else(ThenGoal0, ElseGoal0, Context, GoalInfo,
+ VarSet0, VarSet, ThenHiddenInfo, ElseHiddenInfo, HiddenInfo,
+ ThenGoal, ElseGoal) :-
+ update_disj_list([(ThenGoal0 - Context) - ThenHiddenInfo,
+ (ElseGoal0 - Context) - ElseHiddenInfo], GoalInfo,
+ VarSet0, VarSet, Goals, HiddenInfo),
+ (
+ Goals = [ThenGoal1, ElseGoal1]
+ ->
+ ThenGoal = ThenGoal1,
+ ElseGoal = ElseGoal1
+ ;
+ error("Length mismatch in lists.")
+ ).
+
+update_disj_list(Goals0, GoalInfo, VarSet0, VarSet, Goals, HiddenInfo) :-
+ hidden_info_combine(Goals0, HiddenInfo0),
+ hidden_info_new(VarSet0, VarSet, HiddenInfo0, HiddenInfo1),
+ update_disj_list_2(Goals0, HiddenInfo1, GoalInfo, Goals,
+ HiddenInfo).
+
+:- pred update_disj_list_2(hidden_disj_info, hidden_info, hlds_goal_info,
+ list(hlds_goal), hidden_info).
+:- mode update_disj_list_2(in, in, in, out, out) is det.
+
+update_disj_list_2([], HiddenInfo, _, [], HiddenInfo).
+update_disj_list_2([(HldsGoal0 - Context) - HiddenInfo0 | Rest],
+ HiddenInfo1, GoalInfo, [HldsGoal | GoalList], HiddenInfo) :-
+ update_disj(HldsGoal0, Context, GoalInfo,
+ HiddenInfo0, HiddenInfo1, HldsGoal),
+ hidden_info_combine_errors(HiddenInfo1, HiddenInfo0, HiddenInfo3),
+ update_disj_list_2(Rest, HiddenInfo3, GoalInfo, GoalList,
+ HiddenInfo).
+
+
+ % update_disj(HLDSGoalIn, Context, HiddenInfoIn,
+ %
+ % HiddenInfoFinal, HLDSGoalInfo, HLDSGoalOut):
+ % HLDSGoalOut is HLDSIn with a list of unifications appended onto it.
+ % The unifications are to match variables across disjunctions or
+ % the THEN and ELSE parts of if-then-elses. All hidden argument
+ % variables in HiddenInfoIn, that do not match their corresponding
+ % hidden argument variable in HiddenInfoFinal are unified with it.
+:- pred update_disj(hlds_goal, term__context, hlds_goal_info,
+ hidden_info, hidden_info, hlds_goal).
+:- mode update_disj(in, in, in, in, in, out) is det.
+
+update_disj(HldsGoal0, Context, GoalInfo, HiddenInfo0, HiddenInfo1,
+ HldsGoal) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ hidden_info_get_state_info_table(HiddenInfo1, StateTable1),
+ map__keys(StateTable0, HiddenArgs),
+ update_disj_2(HiddenArgs, Context, StateTable0, StateTable1,
+ HldsGoals),
+ goal_to_conj_list(HldsGoal0, ConjList),
+ list__append(ConjList, HldsGoals, HldsGoalList),
+ conj_list_to_goal(HldsGoalList, GoalInfo, HldsGoal).
+
+:- pred update_disj_2(list(hidden_arg), term__context,
+ state_info_table, state_info_table, list(hlds_goal)).
+:- mode update_disj_2(in, in, in, in, out) is det.
+
+update_disj_2([], _, _, _, []).
+update_disj_2([HiddenArg|HiddenArgList], Context,
+ StateTable0, StateTable1, HldsGoals) :-
+ map__lookup(StateTable0, HiddenArg, StateInfo0),
+ map__lookup(StateTable1, HiddenArg, StateInfo1),
+ (
+ state_info_is_alive(StateInfo0),
+ state_info_is_alive(StateInfo1)
+ ->
+ state_info_get_var(StateInfo0, Var0),
+ state_info_get_var(StateInfo1, Var1),
+ create_atomic_unification(Var0, var(Var1), Context,
+ explicit, [], Goal),
+ HldsGoals = [Goal | HldsGoals0],
+ update_disj_2(HiddenArgList, Context,
+ StateTable0, StateTable1, HldsGoals0)
+ ;
+ state_info_is_alive(StateInfo0)
+ ->
+ error("Hidden variable mismatch across disjuction.")
+ ;
+ state_info_is_alive(StateInfo1)
+ ->
+ error("Hidden variable mismatch across disjuction.")
+ ;
+ update_disj_2(HiddenArgList, Context,
+ StateTable0, StateTable1, HldsGoals)
+ ).
+
+
+check_for_dups(FormAndNameList, PredId, Context, ModuleInfo0, ModuleInfo) -->
+ { check_for_dups_2(FormAndNameList, HiddenNames) },
+ (
+ { HiddenNames = [] }
+ ->
+ { ModuleInfo = ModuleInfo0 }
+ ;
+ dup_error(HiddenNames, PredId, Context, ModuleInfo0),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }
+ ).
+
+:- pred check_for_dups_2(hidden_forms, list(hidden_arg)).
+:- mode check_for_dups_2(in, out) is det.
+
+check_for_dups_2([], []).
+check_for_dups_2([Name - _Form | FormAndNameList], HiddenNames) :-
+ (
+ assoc_list__search(FormAndNameList, Name, _)
+ ->
+ assoc_list__remove_all(FormAndNameList, Name,
+ FormAndNameList0),
+ HiddenNames = [Name | HiddenNames0],
+ check_for_dups_2(FormAndNameList0, HiddenNames0)
+ ;
+ check_for_dups_2(FormAndNameList, HiddenNames)
+ ).
+
+ % Outputs error message resulting from multiple listings of hidden
+ % arguments in pred declarations.
+:- pred dup_error(list(sym_name), pred_id, term__context, module_info,
+ io__state, io__state).
+:- mode dup_error(in, in, in, in, di, uo) is det.
+
+dup_error(HiddenNames, PredId, Context, ModuleInfo) -->
+ { error_util__describe_one_pred_name(ModuleInfo, PredId,
+ PredString) },
+ { hidden_arg_list_to_string(HiddenNames, HiddenStrings) },
+ { error_util__list_to_pieces(HiddenStrings, HiddenFormats) },
+ { list__append([words("In pred declaration for "), fixed(PredString),
+ nl, words("Multiple inclusions of"),
+ words("the following hidden arguments:")], HiddenFormats,
+ FormatComps) },
+ error_util__write_error_pieces(Context, 0, FormatComps).
+
+process_edcg_operator(EDCGOperator, HiddenArgTerm, Context,
+ VarSet0, Var, VarSet, HiddenInfo0, HiddenInfo) :-
+ hidden_arg_term_to_sym_name(HiddenArgTerm, MaybeName),
+ (
+ MaybeName = error(Msg,_),
+ hidden_info_error(syntax_error(Msg, Context),
+ HiddenInfo0, HiddenInfo),
+ varset__new_var(VarSet0, Var, VarSet)
+ ;
+ MaybeName = ok(Name),
+ (
+ hidden_info_get_hidden_arg(Name, Context, HiddenInfo0,
+ HiddenInfo1, HiddenArg)
+ ->
+ 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)
+ )
+ ).
+
+:- 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_current(HiddenArg, Var0, HiddenInfo0, HiddenInfo1)
+ ->
+ HiddenInfo = HiddenInfo1,
+ Var = Var0,
+ VarSet = VarSet0
+ ;
+ hidden_info_error(scope_error("$", Context, HiddenArg),
+ HiddenInfo0, HiddenInfo1),
+ % Make it alive to avoid future errors
+ hidden_info_birth(HiddenArg, 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_next(HiddenArg, Context, VarSet0, VarSet1, Var0,
+ HiddenInfo0, HiddenInfo1)
+ ->
+ Var0 = Var,
+ hidden_info_add_next(HiddenArg, HiddenInfo1, HiddenInfo),
+ VarSet = VarSet1
+ ;
+ hidden_info_error(scope_error("$=", Context, HiddenArg),
+ HiddenInfo0, HiddenInfo1),
+ % Make it alive to avoid future errors
+ hidden_info_birth(HiddenArg, VarSet0,
+ VarSet, no, HiddenInfo1, HiddenInfo),
+ hidden_info_get_var(HiddenArg, HiddenInfo, Var)
+ ).
+
+
+check_hidden_states([], _, HiddenInfo, HiddenInfo).
+check_hidden_states([HiddenArg - Form | Rest], Context,
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo),
+ state_info_get_use(StateInfo, Use),
+ (
+ match_form_and_use(Form, Use)
+ ->
+ HiddenInfo1 = HiddenInfo0
+ ;
+ hidden_info_error(form_error(Context, HiddenArg, Form,
+ Use), HiddenInfo0, HiddenInfo1)
+ ),
+ check_hidden_states(Rest, Context, HiddenInfo1, HiddenInfo).
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+ % hidden_info is a data structure containing all the states of the
+ % hidden arguments defined in the module.
+:- type hidden_info
+ ---> hidden_info(
+ state_info_table,
+ name_table,
+ list(hidden_arg),
+ list(hidden_error)
+ ).
+
+ % The hidden error structure stores all information relating to any
+ % errors caused by hidden arguments.
+:- type hidden_error
+ ---> pred_call_error(pred_id, term__context, list(hidden_arg))
+ ; scope_error(string, term__context, hidden_arg)
+ ; form_error(term__context, hidden_arg, form, use)
+ ; hidden_arg_ambiguity_error(term__context, list(hidden_arg))
+ ; pred_call_ambiguity_error(term__context, list(pred_id))
+ ; undefined_error(hidden_arg, term__context)
+ ; change_error(hidden_arg, term__context)
+ ; syntax_error(string, term__context).
+
+:- type state_info_table == map(hidden_arg, state_info).
+
+ % name_table is a map from all unqualified hidden argument names
+ % to qualified names.
+:- type name_table == map(string, list(hidden_arg)).
+
+hidden_info_init(HiddenInfo) :-
+ map__init(StateTable),
+ map__init(NameTable),
+ HiddenInfo = hidden_info(StateTable, NameTable, [], []).
+
+hidden_info_add_hidden_arg(
+ hidden_info(StateTable0, NameTable0, HiddenArgs, Errors),
+ HiddenArg,
+ hidden_info(StateTable, NameTable, HiddenArgs, Errors)) :-
+ state_info_init(HiddenArg, StateInfo),
+ unqualify_name(HiddenArg, Name),
+ map__det_insert(StateTable0, HiddenArg, StateInfo, StateTable),
+ (
+ map__search(NameTable0, Name, HiddenArgList)
+ ->
+ map__set(NameTable0, Name, [HiddenArg|HiddenArgList],
+ NameTable)
+ ;
+ map__det_insert(NameTable0, Name, [HiddenArg],
+ NameTable)
+ ).
+
+hidden_info_initial_state([], VarSet, VarSet, _, HiddenInfo, HiddenInfo).
+hidden_info_initial_state([HiddenArg - _|Rest], VarSet0, VarSet, IsFact,
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_birth(HiddenArg, VarSet0, VarSet1, IsFact,
+ HiddenInfo0, HiddenInfo1),
+ hidden_info_initial_state(Rest, VarSet1, VarSet, IsFact,
+ HiddenInfo1, HiddenInfo).
+
+hidden_info_update(hidden_info(StateTable0, B, HiddenArgs, D),
+ hidden_info(StateTable, B, [], D)) :-
+ hidden_info_update_hidden_args(HiddenArgs, StateTable0, StateTable).
+
+hidden_info_convert(Names0, Context, VarSet0 , VarSet,
+ HiddenInfo0, HiddenInfo) :-
+ (
+ Names0 = [Name - _Form | Names]
+ ->
+ (
+ hidden_info_get_hidden_arg(Name, Context, HiddenInfo0,
+ HiddenInfo1, HiddenArg)
+ ->
+ hidden_info_get_state_info(HiddenArg, HiddenInfo1,
+ StateInfo0),
+ state_info_new(VarSet0, VarSet1, StateInfo0, StateInfo),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo1,
+ StateInfo, HiddenInfo2)
+ ;
+ hidden_info_error(undefined_error(Name, Context),
+ HiddenInfo0, HiddenInfo2),
+ VarSet1 = VarSet0
+ ),
+ hidden_info_convert(Names, Context, VarSet1, VarSet,
+ HiddenInfo2, HiddenInfo)
+ ;
+ Names0 = []
+ ->
+ HiddenInfo = HiddenInfo0,
+ VarSet0 = VarSet
+ ;
+ error("List length mismatch.")
+ ).
+
+
+hidden_info_revert([], _, HiddenInfo, HiddenInfo).
+hidden_info_revert([HiddenArg | HiddenArgs], HiddenInfo0, HiddenInfo1,
+ HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo1, StateInfo,
+ HiddenInfo2),
+ hidden_info_revert(HiddenArgs, HiddenInfo0, HiddenInfo2,
+ HiddenInfo).
+
+hidden_info_vars([], _, []).
+hidden_info_vars([HiddenArg | HiddenArgs], HiddenInfo, Vars) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo, StateInfo),
+ state_info_get_var(StateInfo, Var),
+ hidden_info_vars(HiddenArgs, HiddenInfo, Vars0),
+ Vars = [Var | Vars0].
+
+%---------------------------------------------------------------------------%
+ % HiddenInfo Utility predicates.
+
+:- implementation.
+
+ % hidden_info_get_hidden_arg(Name, Context, HiddenInfoIn, HiddenInfoOut,
+ % HiddenArg)
+ % HiddenInfoOut is HiddenInfoIn unless there is an ambiguity error
+ % in which case the first found hidden argument is returned
+ % and an error is listed in HiddenInfoOut. It fails if no hidden
+ % argument is found.
+:- pred hidden_info_get_hidden_arg(sym_name, term__context, hidden_info,
+ hidden_info, hidden_arg).
+:- mode hidden_info_get_hidden_arg(in, in, in, out, out) is semidet.
+
+hidden_info_get_hidden_arg(SymName, Context, HiddenInfo0, HiddenInfo,
+ HiddenArg) :-
+ (
+ SymName = unqualified(Name),
+ hidden_info_get_name_table(HiddenInfo0, NameTable),
+ map__search(NameTable, Name, HiddenArgs),
+ (
+ HiddenArgs = [HiddenArg0]
+ ->
+ HiddenArg = HiddenArg0,
+ HiddenInfo = HiddenInfo0
+ ;
+ HiddenArgs = [HiddenArg0 | _]
+ ->
+ hidden_info_error(hidden_arg_ambiguity_error(Context,
+ HiddenArgs), HiddenInfo0, HiddenInfo),
+ HiddenArg = HiddenArg0
+ ;
+ error("Map search returned nothing.")
+ )
+ ;
+ SymName = qualified(_, _),
+ HiddenArg = SymName,
+ hidden_info_get_state_info_table(HiddenInfo, StateTable),
+ map__contains(StateTable, HiddenArg),
+ HiddenInfo = HiddenInfo0
+ ).
+
+ % hidden_info_combine(HiddenInfoIn, HiddenInfoOld, HiddenInfoOut):
+ %
+ % This predicate is called inbetween processing disjuncts or THEN and
+ % ELSE parts. HiddenInfoOld is the hidden pre state of all the
+ % disjuncts or THEN and ELSE parts to be processed. HiddenInfoIn is
+ % the post state of the last processed disjuct or THEN part.
+ % HiddenInfoOut is HiddenInfoOld with the variable suffixes updated
+ % to correspond to the ones in HiddenInfoIn. This predicate ensures
+ % the unique naming of all hidden variables created.
+:- pred hidden_info_combine(hidden_disj_info, hidden_info).
+:- mode hidden_info_combine(in, out) is det.
+
+hidden_info_combine([], _) :-
+ error("No disjunctions given to update var_names").
+hidden_info_combine([(_Goal - _Context) - HiddenInfo0 | Rest], HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable),
+ map__keys(StateTable, HiddenArgs),
+ hidden_info_combine_2(HiddenArgs, Rest, HiddenInfo0, HiddenInfo).
+
+:- pred hidden_info_combine_2(list(hidden_arg), hidden_disj_info, hidden_info,
+ hidden_info).
+:- mode hidden_info_combine_2(in, in, in, out) is det.
+
+hidden_info_combine_2(_, [], HiddenInfo, HiddenInfo).
+hidden_info_combine_2(HiddenArgs, [(_Goal - _Context) - HiddenInfoIn | Rest],
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_combine_errors(HiddenInfo0, HiddenInfoIn, HiddenInfo1),
+ hidden_info_combine_3(HiddenArgs, HiddenInfoIn, HiddenInfo1,
+ HiddenInfo2),
+ hidden_info_combine_2(HiddenArgs, Rest, HiddenInfo2, HiddenInfo).
+
+:- pred hidden_info_combine_3(list(hidden_arg), hidden_info, hidden_info,
+ hidden_info).
+:- mode hidden_info_combine_3(in, in, in, out) is det.
+
+hidden_info_combine_3([], _, HiddenInfo, HiddenInfo).
+hidden_info_combine_3(HiddenArg.HiddenArgs, HiddenInfo0, HiddenInfo1,
+ HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ hidden_info_get_state_info(HiddenArg, HiddenInfo1, StateInfo1),
+ state_info_get_suffix(StateInfo0, Suffix0),
+ state_info_get_suffix(StateInfo1, Suffix1),
+ (
+ Suffix0 > Suffix1
+ ->
+ StateInfo2 = StateInfo0
+ ;
+ StateInfo2 = StateInfo1
+ ),
+ (
+ state_info_is_alive(StateInfo0),
+ state_info_is_alive(StateInfo1)
+ ->
+ state_info_get_use(StateInfo0, Use0),
+ state_info_get_use(StateInfo1, Use1),
+ combine_use(Use0, Use1, Use),
+ state_info_set_use(StateInfo2, Use, StateInfo)
+ ;
+ StateInfo = StateInfo2
+ ),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo1, StateInfo,
+ HiddenInfo2),
+ hidden_info_combine_3(HiddenArgs, HiddenInfo0, HiddenInfo2, HiddenInfo).
+
+ % hidden_info_new(HiddenInfoIn, HiddenInfoOut).
+ %
+ % This predicate is called before update_disj/8 or
+ % update_disj/5. HiddenInfoOut is HiddenInfoIn with all alive
+ % hidden arguments assigned to new variables. This ensures
+ % that variables match across disjunctions and if-then-elses and that
+ % hidden argument's scopes are never restricted to the `if' part
+ % of an if-then-else.
+:- pred hidden_info_new(prog_varset, prog_varset, hidden_info, hidden_info).
+:- mode hidden_info_new(in, out, in, out) is det.
+
+hidden_info_new(VarSet0, VarSet, HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ map__keys(StateTable0, HiddenArgs),
+ hidden_info_new_2(HiddenArgs, VarSet0, VarSet, HiddenInfo0, HiddenInfo).
+
+:- pred hidden_info_new_2(list(hidden_arg), prog_varset, prog_varset,
+ hidden_info, hidden_info).
+:- mode hidden_info_new_2(in, in, out, in, out) is det.
+
+hidden_info_new_2([], VarSet, VarSet, HiddenInfo, HiddenInfo).
+hidden_info_new_2([HiddenArg | Rest], VarSet0, VarSet,
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_new_var(VarSet0, VarSet1, StateInfo0, StateInfo),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0, StateInfo,
+ HiddenInfo1),
+ hidden_info_new_2(Rest, VarSet1, VarSet, HiddenInfo1, HiddenInfo).
+
+ % Updates the state_info of any hidden variables that were changed
+ % during a goal such that the next variable is now the current variable
+ % (this cannot be done during a goal because the edcg operators have
+ % atomic goal scope).
+:- pred hidden_info_update_hidden_args(list(hidden_arg), state_info_table,
+ state_info_table).
+:- mode hidden_info_update_hidden_args(in, in, out) is det.
+
+hidden_info_update_hidden_args([], StateTable, StateTable).
+hidden_info_update_hidden_args([HiddenArg | Rest], StateTable0, StateTable) :-
+ map__lookup(StateTable0, HiddenArg, StateInfo0),
+ state_info_update(StateInfo0, StateInfo),
+ map__det_update(StateTable0, HiddenArg, StateInfo, StateTable1),
+ hidden_info_update_hidden_args(Rest, StateTable1, StateTable).
+
+ % Start the scope of a hidden variable.
+ % Will produce a software error if the hidden variable is already in
+ % scope.
+:- pred hidden_info_birth(hidden_arg, prog_varset,
+ prog_varset, bool, hidden_info, hidden_info).
+:- mode hidden_info_birth(in, in, out, in, in, out) is det.
+
+hidden_info_birth(HiddenArg, VarSet0, VarSet,
+ IsFactVar, HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_birth(IsFactVar, VarSet0, VarSet,
+ StateInfo0, StateInfo),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0,
+ StateInfo, HiddenInfo).
+
+ % Returns the variable that the hidden variable currently represents.
+ % Used for the operator `$'.
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_current(hidden_arg, prog_var, hidden_info, hidden_info).
+:- mode hidden_info_current(in, out, in, out) is semidet.
+
+hidden_info_current(HiddenArg, Var, HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_current(StateInfo0, StateInfo, Var),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0, StateInfo,
+ HiddenInfo).
+
+ % Returns the next variable that the hidden variable will represent.
+ % Used for the operator `$='.
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_next(hidden_arg, term__context, prog_varset, prog_varset,
+ prog_var, hidden_info, hidden_info).
+:- mode hidden_info_next(in, in, in, out, out, in, out) is semidet.
+
+hidden_info_next(HiddenArg, Context, VarSet0, VarSet, Var, HiddenInfo0,
+ HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ (
+ state_info_is_changed(StateInfo0)
+ ->
+ hidden_info_error(change_error(HiddenArg, Context),
+ HiddenInfo0, HiddenInfo1)
+ ;
+ HiddenInfo1 = HiddenInfo0
+ ),
+ state_info_next(VarSet0, VarSet, StateInfo0, StateInfo, Var),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo1, StateInfo,
+ HiddenInfo).
+
+ % Returns the variable that the hidden variable currently represents.
+ % Used for predicate calls where the form of the hidden variable for the
+ % predicate is passed.
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_pass(hidden_arg, hidden_info, hidden_info, prog_var).
+:- mode hidden_info_pass(in, in, out, out) is semidet.
+
+hidden_info_pass(HiddenArg, HiddenInfo0, HiddenInfo, Var) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_current(StateInfo0, StateInfo, Var),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0, StateInfo,
+ HiddenInfo).
+
+ % Returns the variable that the hidden variable currently represents.
+ % Used for predicate calls where the form of the hidden variable for the
+ % predicate is produced.
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_produce(hidden_arg, prog_varset, prog_varset,
+ prog_var, hidden_info, hidden_info).
+:- mode hidden_info_produce(in, in, out, out, in, out) is semidet.
+
+hidden_info_produce(HiddenArg, VarSet0, VarSet, Var,
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_produce(VarSet0, VarSet, StateInfo0, StateInfo, Var),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0,
+ StateInfo, HiddenInfo).
+
+ % Returns the variable that the hidden variable currently represents.
+ % Used for predicate calls where the form of the hidden variable for the
+ % predicate is changed.
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_change(hidden_arg, prog_varset, prog_varset,
+ prog_var, prog_var, hidden_info, hidden_info).
+:- mode hidden_info_change(in, in, out, out, out, in, out) is semidet.
+
+hidden_info_change(HiddenArg, VarSet0, VarSet, Var1, Var2,
+ HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ state_info_change(VarSet0, VarSet, StateInfo0, StateInfo, Var1, Var2),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0,
+ StateInfo, HiddenInfo).
+
+ % Adds a hidden variable to the list of hidden variables that have
+ % been used in the current goal with the operator `$='.
+ % hidden_info_update uses this information to update the hidden_info at
+ % the conclusion of the goal.
+:- pred hidden_info_add_next(hidden_arg, hidden_info, hidden_info).
+:- mode hidden_info_add_next(in, in, out) is det.
+
+hidden_info_add_next(HiddenArg, hidden_info(A, B, HiddenArgs, D),
+ hidden_info(A, B, HiddenArg.HiddenArgs, D)).
+
+ % hidden_info_error(HiddenError, HiddenInfoIn, HiddenInfoOut)
+ %
+ % HiddenInfoOut is HiddenInfoIn with HiddenError appended onto
+ % its list of errors.
+:- pred hidden_info_error(hidden_error, hidden_info, hidden_info).
+:- mode hidden_info_error(in, in, out) is det.
+
+hidden_info_error(Error, HiddenInfo0, HiddenInfo) :-
+ HiddenInfo0 = hidden_info(StateTable, NameTable, HArgs, Errors),
+ HiddenInfo = hidden_info(StateTable, NameTable, HArgs, Error.Errors).
+
+ % hidden_info_combine_errors(HiddenInfo0, HiddenInfo1, HiddenInfo)
+ % HiddenInfo is HiddenInfo0 with the errors in HiddenInfo1 added.
+:- pred hidden_info_combine_errors(hidden_info, hidden_info, hidden_info).
+:- mode hidden_info_combine_errors(in, in, out) is det.
+
+hidden_info_combine_errors(HiddenInfo0, HiddenInfo1, HiddenInfo) :-
+ hidden_info_get_errors(HiddenInfo0, Errors0),
+ hidden_info_get_errors(HiddenInfo1, Errors1),
+ list__append(Errors0, Errors1, Errors),
+ hidden_info_set_errors(Errors, HiddenInfo0, HiddenInfo).
+
+%---------------------------------------------------------------------------%
+ % HiddenInfo Get and Set predicates
+
+:- implementation.
+
+:- pred hidden_info_get_state_info_table(hidden_info, state_info_table).
+:- mode hidden_info_get_state_info_table(in, out) is det.
+
+hidden_info_get_state_info_table(hidden_info(StateTable, _, _, _), StateTable).
+
+:- pred hidden_info_get_name_table(hidden_info, name_table).
+:- mode hidden_info_get_name_table(in, out) is det.
+
+hidden_info_get_name_table(hidden_info(_, NameTable, _, _), NameTable).
+
+:- pred hidden_info_set_state_info_table(hidden_info, state_info_table,
+ hidden_info).
+:- mode hidden_info_set_state_info_table(in, in, out) is det.
+
+hidden_info_set_state_info_table(hidden_info(_, B, C, D), StateTable,
+ hidden_info(StateTable, B, C, D)).
+
+:- pred hidden_info_set_name_table(hidden_info, name_table, hidden_info).
+:- mode hidden_info_set_name_table(in, in, out) is det.
+
+hidden_info_set_name_table(hidden_info(A, _, C, D), NameTable,
+ hidden_info(A, NameTable, C, D)).
+
+:- pred hidden_info_get_state_info(hidden_arg, hidden_info, state_info).
+:- mode hidden_info_get_state_info(in, in, out) is det.
+
+hidden_info_get_state_info(HiddenArg, HiddenInfo, StateInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo, StateTable),
+ map__lookup(StateTable, HiddenArg, StateInfo).
+
+ % Overwrite any existing state information for the hidden id.
+:- pred hidden_info_set_state_info(hidden_arg, hidden_info, state_info,
+ hidden_info).
+:- mode hidden_info_set_state_info(in, in, in, out) is det.
+
+hidden_info_set_state_info(HiddenArg, HiddenInfo0, StateInfo, HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ map__set(StateTable0, HiddenArg, StateInfo, StateTable),
+ hidden_info_set_state_info_table(HiddenInfo0, StateTable, HiddenInfo).
+
+:- pred hidden_info_get_errors(hidden_info, list(hidden_error)).
+:- mode hidden_info_get_errors(in, out) is det.
+
+hidden_info_get_errors(hidden_info(_, _, _, Errors), Errors).
+
+:- pred hidden_info_set_errors(list(hidden_error), hidden_info, hidden_info).
+:- mode hidden_info_set_errors(in, in, out) is det.
+
+hidden_info_set_errors(Errors, hidden_info(A, B, C, _),
+ hidden_info(A, B, C, Errors)).
+
+ % hidden_info_get_vars(HiddenArg, HiddenInfo, Var)
+ %
+ % Var is the variable that HiddenArg currently represents in HiddenInfo.
+:- pred hidden_info_get_var(hidden_arg, hidden_info, prog_var).
+:- mode hidden_info_get_var(in, in, out) is det.
+
+hidden_info_get_var(HiddenArg, HiddenInfo, Var) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo, StateInfo),
+ state_info_get_var(StateInfo, Var).
+
+%---------------------------------------------------------------------------%
+
+ % StateInfo Utility predicates.
+
+:- implementation.
+
+ % Note that var_suffix is the next available suffix and not the
+ % actual suffix of var.
+:- type state_info
+ ---> used(name_base, var_suffix, use, prog_var)
+ ; changed(name_base, var_suffix, use, prog_var, prog_var)
+ ; dead(name_base, var_suffix).
+
+:- type name_base == string.
+:- type var_suffix == int.
+:- type use == pair(bool). % is_used - is_changed
+
+
+:- pred state_info_init(hidden_arg, state_info).
+:- mode state_info_init(in, out) is det.
+
+state_info_init(HiddenArg, StateInfo) :-
+ create_var_name(HiddenArg, NameBase),
+ init_var_suffix(Suffix),
+ StateInfo = dead(NameBase, Suffix).
+
+:- pred state_info_birth(bool, prog_varset, prog_varset,
+ state_info, state_info).
+:- mode state_info_birth(in, in, out, in, out) is det.
+
+state_info_birth(IsFact, VarSet0, VarSet, dead(NameBase, Suffix0),
+ StateInfo) :-
+ new_var(VarSet0, NameBase, Suffix0, IsFact, VarSet, Suffix, Var),
+ StateInfo = used(NameBase, Suffix, no - no, Var).
+state_info_birth(_,_,_,used(_,_,_,_), _) :-
+ error("Hidden argument assumed dead when alive.\n").
+state_info_birth(_,_,_,changed(_,_,_,_,_), _) :-
+ error("Hidden argument assumed dead when alive.\n").
+
+ % Used for edcg goals,
+:- pred state_info_new(prog_varset, prog_varset,
+ state_info, state_info).
+:- mode state_info_new(in, out, in, out) is det.
+
+state_info_new(VarSet0, VarSet, StateInfo0, StateInfo) :-
+ state_info_get_name_base(StateInfo0, NameBase),
+ state_info_get_suffix(StateInfo0, Suffix0),
+ new_var(VarSet0, NameBase, Suffix0, no, VarSet, Suffix, Var),
+ StateInfo = used(NameBase, Suffix, no - no, Var).
+
+:- pred state_info_new_var(prog_varset, prog_varset, state_info, state_info).
+:- mode state_info_new_var(in, out, in, out) is det.
+
+state_info_new_var(VarSet, VarSet, dead(A,B), dead(A,B)).
+state_info_new_var(VarSet0, VarSet, used(NameBase,Suffix0,C,_),
+ used(NameBase,Suffix,C,Var)) :-
+ new_var(VarSet0, NameBase, Suffix0, no, VarSet, Suffix, Var).
+state_info_new_var(_,_,changed(_,_,_,_,_),_) :-
+ error("Hidden variables in incorrect state, changed instead of used.").
+
+ % Used with the operator '$='
+:- pred state_info_next(prog_varset, prog_varset, state_info, state_info,
+ prog_var).
+:- mode state_info_next(in, out, in, out, out) is semidet.
+
+state_info_next(VarSet0, VarSet, used(NameBase, Suffix0, IsUsed - _, D),
+ changed(NameBase, Suffix, IsUsed - yes, D, Var),Var) :-
+ new_var(VarSet0, NameBase, Suffix0, no, VarSet, Suffix, Var).
+state_info_next(VarSet, VarSet, changed(A, B, IsUsed - _, D, Var),
+ changed(A, B, IsUsed - yes, D, Var),Var).
+
+ % Used with the '$' operator and for a predicate call with a form of
+ % passed for the hidden variable
+:- pred state_info_current(state_info, state_info, prog_var).
+:- mode state_info_current(in, out, out) is semidet.
+
+state_info_current(used(A, B, _ - no, Var),
+ used(A, B, yes - no, Var),Var).
+state_info_current(used(A, B, IsUsed - yes, Var),
+ used(A, B, IsUsed - yes, Var),Var).
+state_info_current(changed(A, B, _ - no, Var, E),
+ changed(A, B, yes - no, Var, E),Var).
+state_info_current(changed(A, B, IsUsed - yes, Var, E),
+ changed(A, B, IsUsed - yes, Var, E),Var).
+
+ % Used for a predicate call with a form of produced for the hidden
+ % variable.
+:- pred state_info_produce(prog_varset, prog_varset, state_info, state_info,
+ prog_var).
+:- mode state_info_produce(in, out, in, out, out) is semidet.
+
+state_info_produce(VarSet0, VarSet,
+ used(NameBase, Suffix0, IsUsed - _, _),
+ used(NameBase, Suffix, IsUsed - yes, Var), Var) :-
+ new_var(VarSet0, NameBase, Suffix0, no, VarSet, Suffix, Var).
+state_info_produce(_,_,changed(_,_,_,_,_),_,_) :-
+ error("Hidden variable in incorrect state, changed instead of used.").
+
+ % Used for a predicate call with a form of changed for the hidden
+ % variable.
+:- pred state_info_change(prog_varset, prog_varset, state_info, state_info,
+ prog_var, prog_var).
+:- mode state_info_change(in, out, in, out, out, out) is semidet.
+
+state_info_change(VarSet0, VarSet,
+ used(NameBase, Suffix0, IsUsed0 - IsChanged, Var1),
+ used(NameBase, Suffix, IsUsed - yes, Var2),
+ Var1, Var2) :-
+ new_var(VarSet0, NameBase, Suffix0, no, VarSet, Suffix, Var2),
+ (
+ IsChanged = yes
+ ->
+ IsUsed = IsUsed0
+ ;
+ IsUsed = yes
+ ).
+state_info_change(_,_,changed(_,_,_,_,_),_,_,_) :-
+ error("Hidden variable in incorrect state, changed instead of used.").
+
+ % Used at the conclusion of a goal.
+:- pred state_info_update(state_info, state_info).
+:- mode state_info_update(in, out) is det.
+
+state_info_update(dead(A, B), dead(A, B)).
+state_info_update(used(A,B,C,D), used(A,B,C,D)).
+state_info_update(changed(A,B,C,_,Var), used(A,B,C,Var)).
+
+:- pred state_info_is_alive(state_info::in) is semidet.
+
+state_info_is_alive(used(_,_,_,_)).
+state_info_is_alive(changed(_,_,_,_,_)).
+
+:- pred state_info_is_changed(state_info).
+:- mode state_info_is_changed(in) is semidet.
+
+state_info_is_changed(changed(_,_,_,_,_)).
+
+%---------------------------------------------------------------------------%
+ % StateInfo Get and Set predicates
+
+:- implementation.
+
+:- pred state_info_get_var(state_info, prog_var).
+:- mode state_info_get_var(in, out) is det.
+
+state_info_get_var(used(_,_,_,Var), Var).
+state_info_get_var(changed(_,_,_,Var,_), Var).
+state_info_get_var(dead(_,_), _) :-
+ error("Hidden argument incorrectly assumed dead.\n").
+
+:- pred state_info_get_name_base(state_info, name_base).
+:- mode state_info_get_name_base(in, out) is det.
+
+state_info_get_name_base(used(NameBase,_,_,_), NameBase).
+state_info_get_name_base(changed(NameBase,_,_,_,_), NameBase).
+state_info_get_name_base(dead(NameBase,_), NameBase).
+
+:- pred state_info_get_suffix(state_info, var_suffix).
+:- mode state_info_get_suffix(in, out) is det.
+
+state_info_get_suffix(used(_,Suffix,_,_), Suffix).
+state_info_get_suffix(changed(_,Suffix,_,_,_), Suffix).
+state_info_get_suffix(dead(_,Suffix), Suffix).
+
+:- pred state_info_set_name_base(state_info, name_base, state_info).
+:- mode state_info_set_name_base(in, in, out) is det.
+
+state_info_set_name_base(used(_,B,C,D), NameBase,
+ used(NameBase,B,C,D)).
+state_info_set_name_base(changed(_,B,C,D,E), NameBase,
+ changed(NameBase,B,C,D,E)).
+state_info_set_name_base(dead(_,B), NameBase,
+ dead(NameBase,B)).
+
+:- pred state_info_set_suffix(state_info, var_suffix, state_info).
+:- mode state_info_set_suffix(in, in, out) is det.
+
+state_info_set_suffix(used(A,_,C,D), Suffix, used(A,Suffix,C,D)).
+state_info_set_suffix(changed(A,_,C,D,E), Suffix, changed(A,Suffix,C,D,E)).
+state_info_set_suffix(dead(A,_), Suffix, dead(A,Suffix)).
+
+:- pred state_info_get_use(state_info, use).
+:- mode state_info_get_use(in, out) is det.
+
+state_info_get_use(used(_,_,Use,_), Use).
+state_info_get_use(changed(_,_,Use,_,_), Use).
+state_info_get_use(dead(_,_), _) :-
+ error("Hidden variable assumed alive when dead.").
+
+:- pred state_info_set_use(state_info, use, state_info).
+:- mode state_info_set_use(in, in, out) is det.
+
+state_info_set_use(used(A,B,_,D), Use, used(A,B,Use,D)).
+state_info_set_use(changed(A,B,_,D,E), Use, changed(A,B,Use,D,E)).
+state_info_set_use(dead(_,_), _, _) :-
+ error("Hidden variable assumed alive when dead.").
+
+%---------------------------------------------------------------------------%
+ % General Utility predicates.
+
+:- implementation.
+
+ % Returns an error if the hidden argument term is badly formatted
+ % or involves arguments.
+:- pred hidden_arg_term_to_sym_name(prog_term,
+ maybe1(sym_name, prog_var_type)).
+:- mode hidden_arg_term_to_sym_name(in, out) is det.
+
+hidden_arg_term_to_sym_name(HiddenTerm, SymName) :-
+ ( sym_name_and_args(HiddenTerm, HiddenName, Args) ->
+ (
+ Args = []
+ ->
+ SymName = ok(HiddenName)
+ ;
+ SymName = error("Hidden arguments take no arguments.\n",
+ HiddenTerm)
+ )
+ ;
+ SymName = error("Badly formatted hidden argument name.\n",
+ HiddenTerm)
+ ).
+
+ % new_var(VarSetIn, NameBase, SuffixOld, IsFact, VarSetOut, SuffixNew,
+ % Var):
+ % VarSetOut is VarSetIn with the Var added with NameBase and SuffixOld,
+ % SuffixNew is the next available suffix to use.
+:- pred new_var(prog_varset, name_base, var_suffix, bool, prog_varset,
+ var_suffix, prog_var).
+:- mode new_var(in, in, in, in, out, out, out) is det.
+
+new_var(VarSet0, NameBase0, Suffix0, IsFactVar, VarSet, Suffix, Var) :-
+ string__int_to_string(Suffix0, SuffixString),
+ (
+ IsFactVar = yes,
+ string__append("_", NameBase0, NameBase)
+ ;
+ IsFactVar = no,
+ NameBase = NameBase0
+ ),
+ string__append(NameBase, SuffixString, VarName),
+ varset__new_named_var(VarSet0, VarName, Var, VarSet),
+ next_var_suffix(Suffix0, Suffix).
+
+ % Creates a string to be used as the base for the variable names.
+:- pred create_var_name(hidden_arg::in, name_base::out) is det.
+
+create_var_name(HiddenArg, VarName) :-
+ unqualify_name(HiddenArg, Name),
+ sym_name_get_module_name(HiddenArg, unqualified(""), ModuleName0),
+ unqualify_name(ModuleName0, ModuleName),
+ string__append_list(["EDCG_", ModuleName, "_", Name], VarName).
+
+:- pred init_var_suffix(var_suffix::out) is det.
+
+init_var_suffix(0).
+
+:- pred next_var_suffix(var_suffix::in, var_suffix::out) is det.
+
+next_var_suffix(Suffix, NewSuffix) :-
+ NewSuffix is Suffix + 1.
+
+:- pred combine_use(use, use, use).
+:- mode combine_use(in, in, out) is det.
+
+combine_use(IsUsed0 - IsChanged0, IsUsed1 - IsChanged1, IsUsed - IsChanged) :-
+ bool__or(IsUsed0, IsUsed1, IsUsed),
+ bool__or(IsChanged0, IsChanged1, IsChanged).
+
+:- pred use_to_string(use, string).
+:- mode use_to_string(in, out) is det.
+
+use_to_string(no - no, "not used and not changed").
+use_to_string(yes - no, "used and not changed").
+use_to_string(no - yes, "not used and changed").
+use_to_string(yes - yes, "used and changed").
+
+:- pred hidden_arg_list_to_string(list(hidden_arg), list(string)).
+:- mode hidden_arg_list_to_string(in, out) is det.
+
+hidden_arg_list_to_string([], []).
+hidden_arg_list_to_string([HiddenArg | RestHiddenArg], [String | RestString]) :-
+ sym_name_to_string(HiddenArg, String),
+ hidden_arg_list_to_string(RestHiddenArg, RestString).
+
+:- pred match_form_and_use(form, use).
+:- mode match_form_and_use(in, in) is semidet.
+
+match_form_and_use(changed, _).
+match_form_and_use(produced, no - _).
+match_form_and_use(passed, _ - no).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.52
diff -u -r1.52 prog_data.m
--- compiler/prog_data.m 2000/01/24 17:47:15 1.52
+++ compiler/prog_data.m 2000/01/31 02:50:42
@@ -44,8 +44,9 @@
:- type item_and_context == pair(item, prog_context).
:- type item
- ---> pred_clause(prog_varset, sym_name, list(prog_term), goal)
- % VarNames, PredName, HeadArgs, ClauseBody
+ ---> pred_clause(prog_varset, sym_name, list(prog_term), goal,
+ maybe_edcg)
+ % VarNames, PredName, HeadArgs, ClauseBody, IsEDCG
; func_clause(prog_varset, sym_name, list(prog_term),
prog_term, goal)
@@ -56,12 +57,17 @@
; mode_defn(inst_varset, mode_defn, condition)
; module_defn(prog_varset, module_defn)
+ ; htype_defn(tvarset, sym_name, htype_defn)
+ ; hmode_defn(inst_varset, sym_name, hmode_defn)
+
; pred(tvarset, inst_varset, existq_tvars, sym_name,
- list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints)
+ list(type_and_mode), hidden_forms,
+ maybe(determinism), condition, purity,
+ class_constraints)
% TypeVarNames, InstVarNames,
% ExistentiallyQuantifiedTypeVars, PredName, ArgTypes,
- % Deterministicness, Cond, Purity, TypeClassContext
+ % HiddenNamesAndForms, Deterministicness, Cond, Purity,
+ % TypeClassContext
; func(tvarset, inst_varset, existq_tvars, sym_name,
list(type_and_mode), type_and_mode, maybe(determinism),
@@ -73,8 +79,8 @@
; pred_mode(inst_varset, sym_name, list(mode), maybe(determinism),
condition)
- % VarNames, PredName, ArgModes, Deterministicness,
- % Cond
+ % VarNames, PredName, ArgModes, HiddenArgmodes,
+ % Deterministicness, Cond
; func_mode(inst_varset, sym_name, list(mode), mode,
maybe(determinism), condition)
@@ -104,6 +110,17 @@
---> type_only(type)
; type_and_mode(type, mode).
+:- type hidden_arg == sym_name.
+
+:- type hidden_forms == assoc_list(hidden_arg, form).
+
+:- type form
+ ---> changed
+ ; passed
+ ; produced.
+
+:- type maybe_edcg == bool.
+
:- type pred_or_func
---> predicate
; function.
@@ -562,7 +579,7 @@
; if_then_else(prog_vars, goal, goal, goal)
% atomic goals
- ; call(sym_name, list(prog_term), purity)
+ ; call(sym_name, list(prog_term), list(prog_term), purity)
; unify(prog_term, prog_term).
:- type goals == list(goal).
@@ -766,6 +783,21 @@
; user_defined_mode(sym_name, list(inst)).
% mode/4 defined above
+
+ % Data constructors may need to be added later.
+:- type htype_defn
+ ---> htype_defn(type).
+
+:- type hmode_defn
+ ---> hmode_defn(
+ changed_modes,
+ passed_mode,
+ produced_mode
+ ).
+
+:- type changed_modes == maybe(pair(mode, mode)).
+:- type passed_mode == maybe(mode).
+:- type produced_mode == maybe(mode).
%-----------------------------------------------------------------------------%
%
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.186
diff -u -r1.186 prog_io.m
--- compiler/prog_io.m 2000/01/13 06:16:49 1.186
+++ compiler/prog_io.m 2000/02/01 03:09:12
@@ -693,6 +693,7 @@
convert_item(ok(Item, Context), ok(Item, Context)).
convert_item(error(M, T), error(M, T)).
+
parse_item(ModuleName, VarSet, Term, Result) :-
( %%% some [Decl, DeclContext]
Term = term__functor(term__atom(":-"), [Decl], _DeclContext)
@@ -707,54 +708,80 @@
parse_dcg_clause(ModuleName, VarSet, DCG_H, DCG_B,
DCG_Context, Result)
;
- % It's either a fact or a rule
- ( %%% some [H, B, TermContext]
- Term = term__functor(term__atom(":-"), [H, B],
- TermContext)
- ->
- % it's a rule
- Head = H,
- Body = B,
- TheContext = TermContext
- ;
- % it's a fact
- Head = Term,
- (
- Head = term__functor(_Functor, _Args,
- HeadContext)
- ->
- TheContext = HeadContext
- ;
- % term consists of just a single
- % variable - the context has been lost
- term__context_init(TheContext)
- ),
- Body = term__functor(term__atom("true"), [], TheContext)
- ),
+ Term = term__functor(term__atom("-->>"), [EDCG_H, EDCG_B],
+ EDCG_Context)
+ ->
+ parse_edcg_clause(ModuleName, VarSet, Term, EDCG_H, EDCG_B,
+ EDCG_Context, Result)
+ ;
+ parse_clause(ModuleName, VarSet, Term, Result)
+ ).
+
+:- pred parse_edcg_clause(module_name, varset, term, term, term, prog_context,
+ maybe_item_and_context).
+:- mode parse_edcg_clause(in, in, in, in, in, in, out) is det.
+parse_edcg_clause(ModuleName, VarSet, Term, Head, Body, TheContext, Result):-
+ (
+ Head = term__functor(term__atom("="), [_Head, _Result], _)
+ ->
+ Result = error("EDCGs cannot be used with functions.", Term)
+ ;
varset__coerce(VarSet, ProgVarSet),
parse_goal(Body, ProgVarSet, Body2, ProgVarSet2),
+ parse_implicitly_qualified_term(ModuleName, Head, Term,
+ "clause head", R2),
+ process_pred_clause(R2, ProgVarSet2, Body2, yes, R3),
+ add_context(R3, TheContext, Result)
+ ).
+
+:- pred parse_clause(module_name, varset, term, maybe_item_and_context).
+:- mode parse_clause(in, in, in, out) is det.
+parse_clause(ModuleName, VarSet, Term, Result):-
+ % It's either a fact or a rule
+ ( %%% some [H, B, TermContext]
+ Term = term__functor(term__atom(":-"), [H, B], TermContext)
+ ->
+ % it's a rule
+ Head = H,
+ Body = B,
+ TheContext = TermContext
+ ;
+ % it's a fact
+ Head = Term,
(
- Head = term__functor(term__atom("="),
- [FuncHead, FuncResult], _)
+ Head = term__functor(_Functor, _Args, HeadContext)
->
- parse_implicitly_qualified_term(ModuleName,
- FuncHead, Head, "equation head", R2),
- process_func_clause(R2, FuncResult, ProgVarSet2, Body2,
- R3)
+ TheContext = HeadContext
;
- parse_implicitly_qualified_term(ModuleName,
- Head, Term, "clause head", R2),
- process_pred_clause(R2, ProgVarSet2, Body2, R3)
+ % term consists of just a single
+ % variable - the context has been lost
+ term__context_init(TheContext)
),
- add_context(R3, TheContext, Result)
- ).
+ Body = term__functor(term__atom("true"), [], TheContext)
+ ),
+ varset__coerce(VarSet, ProgVarSet),
+ parse_goal(Body, ProgVarSet, Body2, ProgVarSet2),
+ (
+ Head = term__functor(term__atom("="), [FuncHead, FuncResult], _)
+ ->
+ parse_implicitly_qualified_term(ModuleName,
+ FuncHead, Head, "equation head", R2),
+ process_func_clause(R2, FuncResult, ProgVarSet2, Body2, R3)
+ ;
+ parse_implicitly_qualified_term(ModuleName, Head, Term,
+ "clause head", R2),
+ process_pred_clause(R2, ProgVarSet2, Body2, no, R3)
+ ),
+ add_context(R3, TheContext, Result).
-:- pred process_pred_clause(maybe_functor, prog_varset, goal, maybe1(item)).
-:- mode process_pred_clause(in, in, in, out) is det.
-process_pred_clause(ok(Name, Args0), VarSet, Body,
- ok(pred_clause(VarSet, Name, Args, Body))) :-
+:- pred process_pred_clause(maybe_functor, prog_varset, goal, maybe_edcg,
+ maybe1(item)).
+:- mode process_pred_clause(in, in, in, in, out) is det.
+process_pred_clause(ok(Name, Args0), VarSet, Body, MaybeEDCG,
+ ok(pred_clause(VarSet, Name, Args, Body, MaybeEDCG))) :-
list__map(term__coerce, Args0, Args).
-process_pred_clause(error(ErrMessage, Term0), _, _, error(ErrMessage, Term)) :-
+process_pred_clause(error(ErrMessage, Term0), _, _, _,
+ error(ErrMessage, Term)) :-
term__coerce(Term0, Term).
:- pred process_func_clause(maybe_functor, term, prog_varset, goal,
@@ -841,6 +868,14 @@
process_decl(ModuleName, VarSet, "func", [FuncDecl], Attributes, Result) :-
parse_type_decl_func(ModuleName, VarSet, FuncDecl, Attributes, Result).
+process_decl(ModuleName, VarSet, "htype", TypeDecl, Attributes, Result) :-
+ parse_edcg_type_decl(ModuleName, VarSet, TypeDecl, Result0),
+ check_no_attributes(Result0, Attributes, Result).
+
+process_decl(ModuleName, VarSet, "hmode", ModeDecl, Attributes, Result) :-
+ parse_edcg_mode_decl(ModuleName, VarSet, ModeDecl, Result0),
+ check_no_attributes(Result0, Attributes, Result).
+
process_decl(ModuleName, VarSet, "mode", [ModeDecl], Attributes, Result) :-
parse_mode_decl(ModuleName, VarSet, ModeDecl, Result0),
check_no_attributes(Result0, Attributes, Result).
@@ -1097,8 +1132,6 @@
attribute_description(constraints(exist, _),
"existentially quantified type class constraint (`=>')").
-%-----------------------------------------------------------------------------%
-
% parse the assertion declaration.
:- pred parse_assertion(module_name, varset, list(term), maybe1(item)).
:- mode parse_assertion(in, in, in, out) is semidet.
@@ -1629,31 +1662,55 @@
get_class_context(ModuleName, Attributes0, Attributes, MaybeContext),
(
MaybeContext = ok(ExistQVars, Constraints),
- parse_implicitly_qualified_term(ModuleName,
- PredType, PredType, "`:- pred' declaration",
- R),
- process_pred_2(R, PredType, VarSet, MaybeDet, Cond,
- ExistQVars, Constraints, Attributes, Result)
+ (
+ % Does the predicate declaration have hidden
+ % arguments
+ PredType = term__functor(term__atom("+"),
+ [VisualDecl, HiddenDecl], _Context)
+ ->
+ VisualPredType = VisualDecl,
+ process_hidden_decl(HiddenDecl, PredType, MaybeHiddenFN)
+ ;
+ VisualPredType = PredType,
+ MaybeHiddenFN = ok([])
+ ),
+ process_pred_2(ModuleName, VisualPredType, PredType, VarSet,
+ MaybeDet, Cond, ExistQVars, Constraints, Attributes,
+ MaybeHiddenFN, Result)
;
MaybeContext = error(String, Term),
Result = error(String, Term)
).
-:- pred process_pred_2(maybe_functor, term, varset, maybe(determinism),
+:- pred process_pred_2(module_name, term, term, varset, maybe(determinism),
condition, existq_tvars, class_constraints, decl_attrs,
- maybe1(item)).
-:- mode process_pred_2(in, in, in, in, in, in, in, in, out) is det.
+ maybe1(hidden_forms), maybe1(item)).
+:- mode process_pred_2(in, in, in, in, in, in, in, in, in, in, out) is det.
+
+process_pred_2(ModuleName, VisualPredType, PredType, VarSet0, MaybeDet, Cond,
+ ExistQVars, ClassContext, Attributes0, ok(HiddenFN), Result) :-
+ parse_implicitly_qualified_term(ModuleName, VisualPredType, PredType,
+ "`:- pred' declaration", R),
+ process_pred_3(R, PredType, VarSet0, MaybeDet, Cond,
+ ExistQVars, ClassContext, Attributes0, HiddenFN, Result).
+process_pred_2(_, _, _, _, _, _, _, _, _, error(M, T), error(M, T)).
-process_pred_2(ok(F, As0), PredType, VarSet0, MaybeDet, Cond, ExistQVars,
- ClassContext, Attributes0, Result) :-
+:- pred process_pred_3(maybe_functor, term, varset, maybe(determinism),
+ condition, existq_tvars, class_constraints, decl_attrs,
+ hidden_forms, maybe1(item)).
+:- mode process_pred_3(in, in, in, in, in, in, in, in, in, out) is det.
+
+process_pred_3(ok(F, As0), PredType, VarSet0, MaybeDet, Cond,
+ ExistQVars, ClassContext, Attributes0, HiddenFN, Result) :-
( convert_type_and_mode_list(As0, As) ->
( verify_type_and_mode_list(As) ->
get_purity(Attributes0, Purity, Attributes),
varset__coerce(VarSet0, TVarSet),
varset__coerce(VarSet0, IVarSet),
- Result0 = ok(pred(TVarSet, IVarSet, ExistQVars, F,
- As, MaybeDet, Cond, Purity, ClassContext)),
- check_no_attributes(Result0, Attributes, Result)
+ Result1 = ok(pred(TVarSet, IVarSet, ExistQVars,
+ F, As, HiddenFN, MaybeDet, Cond, Purity,
+ ClassContext)),
+ check_no_attributes(Result1, Attributes, Result)
;
Result = error("some but not all arguments have modes",
PredType)
@@ -1662,7 +1719,7 @@
Result = error("syntax error in `:- pred' declaration",
PredType)
).
-process_pred_2(error(M, T), _, _, _, _, _, _, _, error(M, T)).
+process_pred_3(error(M, T), _, _, _, _, _, _, _, _, error(M, T)).
:- pred get_purity(decl_attrs, purity, decl_attrs).
:- mode get_purity(in, out, out) is det.
@@ -1676,6 +1733,44 @@
Attributes = Attributes0
).
+:- pred process_hidden_decl(term, term, maybe1(hidden_forms)).
+:- mode process_hidden_decl(in, in, out) is det.
+
+process_hidden_decl(Term, PredType, Result):-
+ (
+ Term = term__functor(term__atom("hidden"), Args, _),
+ convert_to_hidden_forms(Args, HiddenArgs)
+ ->
+ Result = HiddenArgs
+ ;
+ Result = error("syntax error in `:- pred' declaration",
+ PredType)
+ ).
+
+:- pred convert_to_hidden_forms(list(term), maybe1(hidden_forms)).
+:- mode convert_to_hidden_forms(in, out) is semidet.
+
+convert_to_hidden_forms([], ok([])).
+convert_to_hidden_forms([Term|Others0], Result) :-
+ Term = term__functor(term__atom(FormString), [NameTerm], _),
+ parse_qualified_term(NameTerm, Term, "pred declaration", R),
+ ( R = error(Msg, T) ->
+ Result = error(Msg, T)
+ ; R = ok(SymName, []) ->
+ ( form_to_string(Form, FormString) ->
+ convert_to_hidden_forms(Others0, Others),
+ ( Others = ok(FormAndNameList) ->
+ Result = ok([SymName - Form|FormAndNameList])
+ ;
+ Result = Others
+ )
+ ;
+ Result = error("Unrecognised hidden form.", Term)
+ )
+ ;
+ Result = error("Hidden arguments take no arguments.", Term)
+ ).
+
%-----------------------------------------------------------------------------%
% We could perhaps get rid of some code duplication between here and
@@ -2259,8 +2354,111 @@
make_mode_defn(VarSet0, Cond, ModeDefn, mode_defn(VarSet, ModeDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
-%-----------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- pred parse_edcg_type_decl(module_name, varset, list(term), maybe1(item)).
+:- mode parse_edcg_type_decl(in, in, in, out)is semidet.
+
+parse_edcg_type_decl(ModuleName, VarSet0, [NameTerm, Type0], Item):-
+ parse_implicitly_qualified_term(ModuleName, NameTerm, NameTerm,
+ "`:- htype' declaration", Result),
+ ( Result = ok(Name, []) ->
+ ( term__is_ground(Type0) ->
+ convert_type(Type0, Type),
+ varset__coerce(VarSet0, VarSet),
+ Item = ok(htype_defn(VarSet, Name, htype_defn(Type)))
+ ;
+ Item = error("Hidden arguments are not polymorphic",
+ NameTerm)
+ )
+ ; Result = ok(_, [_|_]) ->
+ Item = error("Hidden arguments take no arguments", NameTerm)
+ ;
+ Result = error(M, T),
+ Item = error(M, T)
+ ).
+
+%---------------------------------------------------------------------------%
+:- pred parse_edcg_mode_decl(module_name, varset, list(term), maybe1(item)).
+:- mode parse_edcg_mode_decl(in, in, in, out) is det.
+
+parse_edcg_mode_decl(_, _, [], Item) :-
+ dummy_term(DummyTerm),
+ Item = error("hmode declarations take arguments.", DummyTerm).
+parse_edcg_mode_decl(ModuleName, VarSet0, [NameTerm|FormAndModeTerms], Item):-
+ parse_implicitly_qualified_term(ModuleName, NameTerm, NameTerm,
+ "`:- hmode' declaration", Result),
+ (
+ Result = ok(_, [_|_])
+ ->
+ Item = error("Hidden arguments take no arguments", NameTerm)
+ ;
+ Result = error(M, T)
+ ->
+ Item = error(M, T)
+ ;
+ Result = ok(Name, []),
+ init_hmode_defn(HmodeDefn0),
+ convert_to_form_and_mode(FormAndModeTerms, HmodeDefn0,
+ HmodeDefn)
+ ->
+ (
+ HmodeDefn = error(M, T),
+ Item = error(M, T)
+ ;
+ HmodeDefn = ok(FormAndModes),
+ varset__coerce(VarSet0, VarSet),
+ Item = ok(hmode_defn(VarSet, Name, FormAndModes))
+ )
+ ;
+ Item = error("Multiple mode declarations for the same EDCG form for hidden",
+ NameTerm)
+ ).
+
+ % Fails if there are multiple mode declarations for the same form.
+:- pred convert_to_form_and_mode(list(term), hmode_defn, maybe1(hmode_defn)).
+:- mode convert_to_form_and_mode(in, in, out) is semidet.
+
+convert_to_form_and_mode([], HmodeDefn, ok(HmodeDefn)).
+convert_to_form_and_mode([Term|OtherTerms], HmodeDefn0, HmodeDefn) :-
+ Term = term__functor(term__atom(FormString), ModeList0, _),
+ ( form_to_string(Form, FormString) ->
+ ( check_number_of_modes(Form, ModeList0) ->
+ ( prog_io_util__convert_mode_list(ModeList0, ModeList) ->
+ init_hidden_modes(Form, HmodeDefn0, ModeList, HmodeDefn1),
+ convert_to_form_and_mode(OtherTerms, HmodeDefn1, HmodeDefn)
+ ;
+ HmodeDefn = error("Invalid mode(s)", Term)
+ )
+ ;
+ HmodeDefn = error("Wrong number of modes for EDCG form", Term)
+ )
+ ;
+ HmodeDefn = error("Unrecognized EDCG form", Term)
+ ).
+
+:- pred init_hmode_defn(hmode_defn::out) is det.
+
+init_hmode_defn(hmode_defn(no, no, no)).
+
+ % Fails if the modes are already defined.
+:- pred init_hidden_modes(form, hmode_defn, list(mode), hmode_defn).
+:- mode init_hidden_modes(in, in, in, out) is semidet.
+
+init_hidden_modes(changed, hmode_defn(no,B,C), [Mode1, Mode2],
+ hmode_defn(yes(Mode1 - Mode2),B,C)).
+init_hidden_modes(passed, hmode_defn(A,no,C), [Mode],
+ hmode_defn(A,yes(Mode),C)).
+init_hidden_modes(produced, hmode_defn(A,B,no), [Mode],
+ hmode_defn(A,B,yes(Mode))).
+
+:- pred check_number_of_modes(form::in, list(term)::in) is semidet.
+check_number_of_modes(changed, [_,_]).
+check_number_of_modes(passed, [_]).
+check_number_of_modes(produced, [_]).
+
+%-----------------------------------------------------------------------------%
:- type parser(T) == pred(term, maybe1(T)).
:- mode parser :: pred(in, out) is det.
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.14
diff -u -r1.14 prog_io_dcg.m
--- compiler/prog_io_dcg.m 2000/01/13 06:16:56 1.14
+++ compiler/prog_io_dcg.m 2000/01/17 05:36:16
@@ -34,7 +34,7 @@
:- implementation.
:- import_module prog_io, prog_io_goal, prog_util, purity.
-:- import_module int, map, string, std_util, list.
+:- import_module int, map, string, std_util, list, bool.
%-----------------------------------------------------------------------------%
@@ -112,7 +112,7 @@
list__append(Args0,
[term__variable(Var0),
term__variable(Var)], Args),
- Goal = call(SymName, Args, pure) - Context
+ Goal = call(SymName, Args, [], pure) - Context
)
;
% A call to a free variable, or to a number or string.
@@ -121,7 +121,7 @@
new_dcg_var(VarSet0, N0, VarSet, N, Var),
term__coerce(Term, ProgTerm),
Goal = call(unqualified("call"), [ProgTerm,
- term__variable(Var0), term__variable(Var)],
+ term__variable(Var0), term__variable(Var)], [],
pure) - Context
).
@@ -306,8 +306,8 @@
parse_dcg_goal_with_purity(G, VarSet0, N0, Var0, Purity, Goal, VarSet,
N, Var) :-
parse_dcg_goal(G, VarSet0, N0, Var0, Goal1, VarSet, N, Var),
- ( Goal1 = call(Pred, Args, pure) - Context ->
- Goal = call(Pred, Args, Purity) - Context
+ ( Goal1 = call(Pred, Args, HArgs, pure) - Context ->
+ Goal = call(Pred, Args, HArgs, Purity) - Context
;
% Inappropriate placement of an impurity marker, so we treat
% it like a predicate call. typecheck.m prints out something
@@ -315,7 +315,7 @@
Goal1 = _ - Context,
purity_name(Purity, PurityString),
term__coerce(G, G1),
- Goal = call(unqualified(PurityString), [G1], pure) - Context
+ Goal = call(unqualified(PurityString), [G1], [], pure) - Context
).
:- pred append_to_disjunct(goal, goal_expr, prog_context, goal).
@@ -452,7 +452,7 @@
:- mode process_dcg_clause(in, in, in, in, in, out) is det.
process_dcg_clause(ok(Name, Args0), VarSet, Var0, Var, Body,
- ok(pred_clause(VarSet, Name, Args, Body))) :-
+ ok(pred_clause(VarSet, Name, Args, Body, no))) :-
list__map(term__coerce, Args0, Args1),
list__append(Args1, [term__variable(Var0),
term__variable(Var)], Args).
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.17
diff -u -r1.17 prog_io_goal.m
--- compiler/prog_io_goal.m 1999/07/13 08:53:24 1.17
+++ compiler/prog_io_goal.m 1999/12/16 05:04:56
@@ -116,16 +116,26 @@
% it's not a builtin
term__coerce(Term, ArgsTerm),
(
+ ArgsTerm = term__functor(term__atom("+"),
+ [VisualTerm, HiddenTerm], _Context),
+ sym_name_and_args(VisualTerm, SymName, VisualArgs),
+ sym_name_and_args(HiddenTerm, unqualified("hidden"),
+ HiddenArgs)
+ ->
+ VarSet = VarSet0,
+ Goal = call(SymName, VisualArgs, HiddenArgs, pure)
+ - Context
+ ;
% check for predicate calls
- sym_name_and_args(ArgsTerm, SymName, Args)
+ sym_name_and_args(ArgsTerm, SymName, VisualArgs)
->
VarSet = VarSet0,
- Goal = call(SymName, Args, pure) - Context
+ Goal = call(SymName, VisualArgs, [], pure) - Context
;
% A call to a free variable, or to a number or string.
% Just translate it into a call to call/1 - the typechecker
% will catch calls to numbers and strings.
- Goal = call(unqualified("call"), [ArgsTerm], pure)
+ Goal = call(unqualified("call"), [ArgsTerm], [], pure)
- Context,
VarSet = VarSet0
)
@@ -232,15 +242,15 @@
parse_goal_with_purity(A0, V0, Purity, A, V) :-
parse_goal(A0, V0, A1, V),
- ( A1 = call(Pred, Args, pure) - _ ->
- A = call(Pred, Args, Purity)
+ ( A1 = call(Pred, VArgs, HArgs, pure) - _ ->
+ A = call(Pred, VArgs, HArgs, Purity)
;
% Inappropriate placement of an impurity marker, so we treat
% it like a predicate call. typecheck.m prints out something
% descriptive for these errors.
purity_name(Purity, PurityString),
term__coerce(A0, A2),
- A = call(unqualified(PurityString), [A2], pure)
+ A = call(unqualified(PurityString), [A2], [], pure)
).
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.12
diff -u -r1.12 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 1999/10/30 09:22:50 1.12
+++ compiler/prog_io_typeclass.m 1999/12/10 04:03:07
@@ -199,9 +199,9 @@
item_to_class_method(ok(Item, Context), Term, Result) :-
(
% XXX Purity is ignored
- Item = pred(A, B, C, D, E, F, G, _, I)
+ Item = pred(A, B, C, D, E, _, G, H, _, I)
->
- Result = ok(pred(A, B, C, D, E, F, G, I, Context))
+ Result = ok(pred(A, B, C, D, E, G, H, I, Context))
;
% XXX Purity is ignored
Item = func(A, B, C, D, E, F, G, H, _, J)
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.48
diff -u -r1.48 prog_util.m
--- compiler/prog_util.m 2000/01/13 06:17:01 1.48
+++ compiler/prog_util.m 2000/02/01 04:38:50
@@ -104,6 +104,20 @@
:- pred construct_qualified_term(sym_name, list(term(T)), prog_context, term(T)).
:- mode construct_qualified_term(in, in, in, out) is det.
+ % extract the hidden modes for a particular hidden form from an
+ % hmode_defn
+:- pred get_hidden_modes(form, hmode_defn, list(mode)).
+:- mode get_hidden_modes(in, in, out) is semidet.
+
+ % set the hidden modes for a particular hidden form from an
+ % hmode_defn
+:- pred set_hidden_modes(form, hmode_defn, list(mode), hmode_defn).
+:- mode set_hidden_modes(in, in, in, out) is semidet.
+
+:- pred form_to_string(form, string).
+:- mode form_to_string(in, out) is det.
+:- mode form_to_string(out, in) is semidet.
+
%-----------------------------------------------------------------------------%
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
@@ -281,10 +295,12 @@
prog_util__rename_in_goal(Cond0, OldVar, NewVar, Cond),
prog_util__rename_in_goal(Then0, OldVar, NewVar, Then),
prog_util__rename_in_goal(Else0, OldVar, NewVar, Else).
-prog_util__rename_in_goal_expr(call(SymName, Terms0, Purity), OldVar, NewVar,
- call(SymName, Terms, Purity)) :-
+prog_util__rename_in_goal_expr(call(SymName, Terms0, HTerms0, Purity), OldVar,
+ NewVar, call(SymName, Terms, HTerms, Purity)) :-
term__substitute_list(Terms0, OldVar, term__variable(NewVar),
- Terms).
+ Terms),
+ term__substitute_list(HTerms0, OldVar, term__variable(NewVar),
+ HTerms).
prog_util__rename_in_goal_expr(unify(TermA0, TermB0), OldVar, NewVar,
unify(TermA, TermB)) :-
term__substitute(TermA0, OldVar, term__variable(NewVar),
@@ -366,6 +382,24 @@
add_sym_name_suffix(unqualified(Name0), Suffix, unqualified(Name)) :-
string__append(Name0, Suffix, Name).
+%-----------------------------------------------------------------------------%
+
+get_hidden_modes(changed, hmode_defn(yes(Mode1 - Mode2),_,_),
+ [Mode1, Mode2]).
+get_hidden_modes(passed, hmode_defn(_,yes(Mode),_), [Mode]).
+get_hidden_modes(produced, hmode_defn(_,_,yes(Mode)), [Mode]).
+
+set_hidden_modes(changed, hmode_defn(_,B,C), [Mode1, Mode2],
+ hmode_defn(yes(Mode1 - Mode2),B,C)).
+set_hidden_modes(passed, hmode_defn(A,_,C), [Mode],
+ hmode_defn(A,yes(Mode),C)).
+set_hidden_modes(produced, hmode_defn(A,B,_), [Mode],
+ hmode_defn(A,B,yes(Mode))).
+
+form_to_string(passed, "passed").
+form_to_string(changed, "changed").
+form_to_string(produced, "produced").
+
%-----------------------------------------------------------------------------%
make_pred_name_with_context(ModuleName, Prefix,
--------------------------------------------------------------------------
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