[m-dev.] for review: EDCGs - diff part 1
Peter Nicholas MALKIN
pnmalk at cat.cs.mu.OZ.AU
Fri Dec 24 14:10:25 AEDT 1999
Detailed Desciption of Change:
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 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 Thu Dec 23 16:35:05 1999
@@ -0,0 +1,1470 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1993-1999 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 string, list, term, bool.
+:- import_module hlds_module, hlds_pred, hlds_goal.
+:- import_module prog_data, prog_io_util.
+:- import_module std_util.
+
+:- implementation.
+:- import_module prog_util, prog_out, prog_io, prog_io_goal, mercury_to_mercury.
+:- import_module io, map, set, int, assoc_list, require, varset.
+:- import_module hlds_data, hlds_out, make_hlds, error_util.
+
+%---------------------------------------------------------------------------%
+
+ % Predicates to handle EDCG declarations.
+
+:- interface.
+
+:- type hidden_arg == sym_name.
+:- type hidden_arg_and_vars == list(pair(hidden_arg, prog_vars)).
+
+:- pred edcg__name_and_form(sym_name, form, hidden_form_and_name).
+:- mode edcg__name_and_form(in, in, out) is det.
+:- mode edcg__name_and_form(out, out, in) is det.
+
+ % Returns an error if the hidden argument term is badly formatted
+ % or involves arguments.
+:- pred edcg__hidden_arg_term_to_sym_name(prog_term,
+ maybe1(sym_name, prog_var_type)).
+:- mode edcg__hidden_arg_term_to_sym_name(in, out) is det.
+
+:- pred edcg__output_hidden_arg_list(list(hidden_arg), io__state, io__state).
+:- mode edcg__output_hidden_arg_list(in, di, uo) is det.
+
+:- pred edcg__output_hidden_arg(hidden_arg, io__state, io__state).
+:- mode edcg__output_hidden_arg(in, di, uo) is det.
+
+ % Returns a list types that are to be appended onto the end of the
+ % head type list of a particular predicate.
+ % Fails if one or more of the hidden arguments for the pred are not
+ % module qualified as they should have been in module_qual.m but
+ % not because of ambiguity.
+:- pred edcg__get_hidden_pred_types(module_info,
+ list(hidden_form_and_name), list(type)).
+:- mode edcg__get_hidden_pred_types(in, in, out) is semidet.
+
+ % Returns a list of modes that are to be appended onto the end of the
+ % head mode list of a particular predicate.
+:- pred edcg__get_hidden_pred_modes(module_info, list(hidden_form_and_name),
+ list(mode), list(hidden_form_and_name)).
+:- mode edcg__get_hidden_pred_modes(in, in, out, out) is det.
+
+:- pred edcg__get_hidden_modes(form, hmode_defn, list(mode)).
+:- mode edcg__get_hidden_modes(in, in, out) is semidet.
+
+:- pred edcg__set_hidden_modes(form, hmode_defn, list(mode), hmode_defn).
+:- mode edcg__set_hidden_modes(in, in, in, out) is semidet.
+
+:- pred edcg__string_to_form(string, form).
+:- mode edcg__string_to_form(in, out) is semidet.
+:- mode edcg__string_to_form(out, in) is det.
+
+ % Fails if sym_name is not module qualified.
+:- pred edcg__sym_name_to_hidden_arg(sym_name, hidden_arg).
+:- mode edcg__sym_name_to_hidden_arg(in, out) is semidet.
+
+ % Gives a fatal software error if sym_name is not module
+ % qualified.
+:- pred edcg__det_sym_name_to_hidden_arg(sym_name, hidden_arg).
+:- mode edcg__det_sym_name_to_hidden_arg(in, out) is det.
+
+ % edcg__sep_hidden_terms(HiddenTerms, VarSet0, Context, HiddenInfoIn,
+ % HiddenInfoOut, FirstHiddenNames, Forms,
+ % SecondHiddenNames, FirstArgs, SecondArgs)
+ %
+ % The purpose of this predicate is basically to pass 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. FirstHiddenNames is a
+ % list of all hidden variables in the list, Forms is a list of the forms
+ % of the hidden variables. SecondHiddenNames is a list of the hidden
+ % variables in the list with two arguments listed. FirstArgs is a list
+ % of all the first arguments to the hidden variables and SecondArgs is a
+ % list of all the second arguments to the hidden variables.
+ % HiddenInfoIn is HiddenInfoOut unless an error was found, such as an
+ % undefined hidden variable or an incorrect number of arguments.
+:- pred edcg__sep_hidden_terms(list(prog_term), prog_varset, term__context,
+ hidden_info, hidden_info,
+ list(sym_name), list(state_info_form), list(sym_name),
+ list(prog_term), list(prog_term)).
+:- mode edcg__sep_hidden_terms(in, in, in, in, out, out, out, out,
+ out, out) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+edcg__name_and_form(HiddenName, passed, HiddenName - passed).
+edcg__name_and_form(HiddenName, changed, HiddenName - changed).
+
+edcg__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)
+ ).
+
+edcg__get_hidden_pred_types(_, [], []).
+edcg__get_hidden_pred_types(ModuleInfo, [HiddenFormAndName|Rest],
+ TypeList) :-
+ module_info_edcgs(ModuleInfo, EDCGTable),
+ edcg__name_and_form(SymName, Form, HiddenFormAndName),
+ edcg__sym_name_to_hidden_arg(SymName, HiddenArg),
+ (
+ edcg_table_fetch_hidden_type(HiddenArg, EDCGTable, Type)
+ ->
+ (
+ Form = changed
+ ->
+ TypeList = [Type,Type|TypeList0],
+ edcg__get_hidden_pred_types(ModuleInfo, Rest, TypeList0)
+ ;
+ TypeList = [Type|TypeList0],
+ edcg__get_hidden_pred_types(ModuleInfo, Rest, TypeList0)
+ )
+ ;
+ % The hidden argument's exisistence has already been
+ % checked.
+ error("Missing value from hidden type table.")
+ ).
+
+edcg__get_hidden_pred_modes(_, [], [], []).
+edcg__get_hidden_pred_modes(ModuleInfo, [HiddenFormAndName|Rest], ModeList,
+ UndefFormsAndNames) :-
+ module_info_edcgs(ModuleInfo, EDCGTable),
+ edcg__name_and_form(SymName, Form, HiddenFormAndName),
+ edcg__det_sym_name_to_hidden_arg(SymName, HiddenArg),
+ (
+ edcg_table_fetch_hidden_mode(HiddenArg, Form, EDCGTable, Modes)
+ ->
+ list__append(Modes, ModeList0, ModeList),
+ edcg__get_hidden_pred_modes(ModuleInfo, Rest, ModeList0,
+ UndefFormsAndNames)
+ ;
+ UndefFormsAndNames = [HiddenFormAndName | UndefFormsAndNames0],
+ edcg__get_hidden_pred_modes(ModuleInfo, Rest, ModeList,
+ UndefFormsAndNames0)
+ ).
+
+edcg__get_hidden_modes(changed, hmode_defn(yes(Mode1 - Mode2),_),
+ [Mode1, Mode2]).
+edcg__get_hidden_modes(passed, hmode_defn(_,yes(Mode)), [Mode]).
+edcg__set_hidden_modes(changed, hmode_defn(_,B), [Mode1, Mode2],
+ hmode_defn(yes(Mode1 - Mode2),B)).
+edcg__set_hidden_modes(passed, hmode_defn(A,_), [Mode],
+ hmode_defn(A,yes(Mode))).
+
+edcg__string_to_form("passed", passed).
+edcg__string_to_form("changed", changed).
+
+edcg__sym_name_to_hidden_arg(SymName, SymName):-
+ SymName = qualified(_, _).
+
+edcg__det_sym_name_to_hidden_arg(SymName, HiddenArg):-
+ (
+ SymName = qualified(_, _),
+ HiddenArg = SymName
+ ;
+ % All hidden arguments should be qualified in
+ % module_qual.m.
+ SymName = unqualified(_),
+ error("Unqualified hidden argument.\n")
+ ).
+
+edcg__output_hidden_arg_list([]) --> [].
+edcg__output_hidden_arg_list([HiddenArg | Rest]) -->
+ io__write_string(" "),
+ edcg__output_hidden_arg(HiddenArg),
+ edcg__output_hidden_arg_list(Rest).
+
+edcg__output_hidden_arg(HiddenArg) -->
+ mercury_output_bracketed_sym_name(HiddenArg).
+
+edcg__sep_hidden_terms([], _, _, HiddenInfo, HiddenInfo, [], [], [], [], []).
+edcg__sep_hidden_terms([HiddenTerm | HiddenTerms], VarSet, Context, HiddenInfo0,
+ HiddenInfo, FirstNames, FirstForms, SecondNames, FirstArgs,
+ SecondArgs) :-
+ edcg__sep_hidden_terms(HiddenTerms, VarSet, Context, HiddenInfo0,
+ HiddenInfo1, FirstNames0, FirstForms0, SecondNames0, FirstArgs0,
+ SecondArgs0),
+ (
+ sym_name_and_args(HiddenTerm, Name0, Args),
+ hidden_info_get_hidden_arg(Name0, Context, HiddenInfo1,
+ HiddenInfo2, Name)
+ ->
+ (
+ Args = [FirstArg, SecondArg]
+ ->
+ FirstNames = [Name | FirstNames0],
+ FirstForms = [changed | FirstForms0],
+ SecondNames = [Name | SecondNames0],
+ FirstArgs = [FirstArg | FirstArgs0],
+ SecondArgs = [SecondArg | SecondArgs0],
+ HiddenInfo = HiddenInfo2
+ ;
+ Args = [FirstArg]
+ ->
+ FirstNames = [Name | FirstNames0],
+ FirstForms = [passed | FirstForms0],
+ SecondNames = SecondNames0,
+ FirstArgs = [FirstArg | FirstArgs0],
+ SecondArgs = SecondArgs0,
+ HiddenInfo = HiddenInfo2
+ ;
+ FirstNames = FirstNames0,
+ FirstForms = FirstForms0,
+ SecondNames = SecondNames0,
+ FirstArgs = FirstArgs0,
+ SecondArgs = SecondArgs0,
+ hidden_info_error(
+ syntax_error("Incorrect number of arguments to hidden variable, should be one or two.",
+ HiddenTerm, Context, VarSet), HiddenInfo2,
+ HiddenInfo)
+ )
+ ;
+ FirstNames = FirstNames0,
+ FirstForms = FirstForms0,
+ SecondNames = SecondNames0,
+ FirstArgs = FirstArgs0,
+ SecondArgs = SecondArgs0,
+ hidden_info_error(syntax_error("Unrecoginsed hidden variable.",
+ HiddenTerm, Context, VarSet), HiddenInfo1, HiddenInfo)
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % Predicates to expand EDCG clauses.
+
+:- interface.
+
+:- type hidden_info.
+
+ % The hidden error structure stores all information relating to any
+ % errors caused by hidden arguments.
+ % A state error in general is when hidden arguments are either dead
+ % where they should be alive, or vice versa.
+:- type hidden_error
+ ---> call_state_error(sym_name, arity, term__context,
+ list(hidden_arg), list(hidden_arg))
+ ; op_state_error(string, term__context, string, string,
+ list(hidden_arg))
+ ; head_state_error(term__context, list(hidden_arg),
+ list(hidden_arg))
+ ; head_functor_error(term__context)
+ ; hidden_arg_ambiguity_error(term__context, list(hidden_arg))
+ ; pred_call_ambiguity_error(term__context, list(pred_id),
+ predicate_table)
+ ; undefined_error(hidden_arg, term__context)
+ ; syntax_error(string, prog_term, term__context, prog_varset).
+
+:- type state_info_form
+ ---> changed
+ ; passed.
+
+ % edcg__add_hidden_head_args(FormsAndNamesList, HiddenInfoIn,
+ % HiddenInfoOut, VisualArgs, VisualAndHiddenArgs):
+ % Given a list of FormsAndNames declared for a particular predicate,
+ % the pre state and post state of a clause for that predicate,
+ % VisualAndHiddenArgs is a list hidden arguement terms appended onto
+ % the end of VisualArgs. The post state of the clause should have
+ % already have been checked for consistency with the pred
+ % declaration.
+:- pred edcg__get_hidden_head_args(list(hidden_form_and_name),
+ hidden_info, hidden_info, list(prog_term)).
+:- mode edcg__get_hidden_head_args(in, in, in, out) is det.
+
+ % edcg__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.
+ % An error state is returned if the list of forms and names cannot
+ % match the current HiddenInfoIn.
+:- pred edcg__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 edcg__add_hidden_args(in, in, in, out, in, out, in, in, out, in) is det.
+
+ % edcg__maybe_hidden_error/8 :
+ % prints out error messages corresponding to error states returned
+ % from processing the Body of a clause.
+:- pred edcg__maybe_hidden_error(hidden_info, term__context,
+ pred_or_func, sym_name, arity, module_info, module_info,
+ io__state, io__state).
+:- mode edcg__maybe_hidden_error(in, in, in, in, in, in, out, di, uo) is det.
+
+ % edcg__update_disj_list(DisjunctAndHiddenInfoList, HiddenInfoIn,
+ % GoalInfo, HLDSGoalList, HiddenInfoOut):
+ % Given a list of disjuncts it calls edcg__update_disjunct/8 on every
+ % disjunct. HiddenInfoIn is the HiddenInfo returned by processing the
+ % last disjunct. HLDSGoalList is the final list of HLDSGoals with
+ % the appropriate unifications appended. HiddenInfoOut is
+ % HiddenInfoIn unless an error is encountered.
+:- pred edcg__update_disj_list(list(pair(pair(hlds_goal, term__context),
+ hidden_info)),
+ hidden_info, hlds_goal_info, list(hlds_goal),
+ hidden_info).
+:- mode edcg__update_disj_list(in, in, in, out, out) is det.
+
+ % edcg__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 edcg__update_disj(hlds_goal, term__context, hidden_info,
+ hidden_info, hlds_goal_info, hlds_goal).
+:- mode edcg__update_disj(in, in, in, in, in, out) is det.
+
+ % edcg__update_hidden_info(HiddenInfoIn, HiddenInfoOut, VarSetIn,
+ % VarSetOut):
+ % This predicate is called before edcg__update_disj/8 or
+ % edcg__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
+ % if an if-then-else.
+:- pred edcg__update_hidden_info(hidden_info, hidden_info,
+ prog_varset, prog_varset).
+:- mode edcg__update_hidden_info(in, out, in, out) is det.
+
+ % edcg__update_var_names(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. The compiler
+ % would work fine without it.
+:- pred edcg__update_var_names(hidden_info, hidden_info,
+ hidden_info).
+:- mode edcg__update_var_names(in, in, out) is det.
+
+ % edcg__check_for_dups(ListFormsAndNames, ListHiddenNames):
+ % Is true if ListHiddenNames is the list of all duplicate hidden
+ % arguments appearing in ListFormAndNames.
+:- pred edcg__check_for_dups(list(hidden_form_and_name), list(sym_name)).
+:- mode edcg__check_for_dups(in, out) is det.
+
+ % Outputs error message resulting from multiple listings of hidden
+ % arguments in pred declarations.
+:- pred edcg__dup_error(list(sym_name), sym_name, arity,
+ term__context, io__state, io__state).
+:- mode edcg__dup_error(in, in, in, in, di, uo) is det.
+
+%---------------------------------------------------------------------------%
+
+:- 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_error)).
+
+:- 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)).
+
+ % Note that var_suffix is the next available suffix and not the
+ % actual suffix of var.
+:- type state_info
+ ---> alive(prog_var, state_info_form, name_base, var_suffix)
+ ; dead(name_base, var_suffix).
+
+:- type name_base == string.
+:- type var_suffix == int.
+
+edcg__get_hidden_head_args([], _, _, []).
+edcg__get_hidden_head_args([FormAndName|Rest], HiddenInfo0, HiddenInfo1,
+ Terms) :-
+ edcg__name_and_form(SymName, Form, FormAndName),
+ edcg__det_sym_name_to_hidden_arg(SymName, HiddenArg),
+ (
+ 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]
+ ),
+ edcg__get_hidden_head_args(Rest, HiddenInfo0, HiddenInfo1, Terms0).
+
+edcg__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], PredTable),
+ HiddenInfo0, HiddenInfo)
+ )
+ ;
+ pred_info_hidden_args(PredInfo, FormsAndNames),
+ edcg__check_hidden_terms(HiddenArgs, Context,
+ VarSet0, FormsAndNames, HiddenTerms,
+ HiddenInfo0, HiddenInfo1),
+ edcg__add_hidden_args_2(FormsAndNames,
+ HiddenTerms, Context, VarSet0,
+ HiddenInfo1, Args, VarSet,
+ ErrorList1, ErrorList2, HiddenInfo2),
+ list__append(VisualArgs0, Args, TotalArgs),
+ (
+ ErrorList1 = [],
+ ErrorList2 = []
+ ->
+ HiddenInfo = HiddenInfo2
+ ;
+ hidden_info_error(
+ call_state_error(Name,
+ VisualArity, Context,
+ ErrorList1, ErrorList2),
+ 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, PredTable), HiddenInfo0, HiddenInfo),
+ VarSet = VarSet0,
+ TotalArgs = VisualArgs0
+ )
+ ;
+ % Maybe a higher order call.
+ HiddenInfo = HiddenInfo0,
+ VarSet = VarSet0,
+ TotalArgs = VisualArgs0
+ ).
+
+:- pred edcg__add_hidden_args_2(list(hidden_form_and_name),
+ list(pair(sym_name, list(prog_term))), term__context,
+ prog_varset, hidden_info, list(prog_term), prog_varset,
+ list(hidden_arg), list(hidden_arg), hidden_info).
+:- mode edcg__add_hidden_args_2(in, in, in, in, in, out, 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.
+edcg__add_hidden_args_2([], [], _, VarSet, HiddenInfo, [], VarSet, [],
+ [], HiddenInfo).
+edcg__add_hidden_args_2([], [_|_], _, VarSet, HiddenInfo, [], VarSet, [],
+ [], HiddenInfo) :-
+ error("List length match error.").
+edcg__add_hidden_args_2([FormAndName|Rest], HiddenTerms0, Context, VarSet0,
+ HiddenInfo0, ArgList, VarSet, ErrorList1, ErrorList2,
+ HiddenInfo) :-
+ edcg__name_and_form(SymName, Form, FormAndName),
+ edcg__det_sym_name_to_hidden_arg(SymName, HiddenArg),
+ (
+ edcg__get_hidden_args(HiddenArg, Context, HiddenTerms0,
+ HiddenTerms1, HiddenInfo0, HiddenInfo1, ArgList0)
+ ->
+ edcg__add_hidden_args_2(Rest, HiddenTerms1, Context, VarSet0,
+ HiddenInfo1, ArgList1, VarSet, ErrorList1, ErrorList2,
+ HiddenInfo),
+ list__append(ArgList0, ArgList1, ArgList)
+ ;
+ (
+ Form = passed,
+ (
+ hidden_info_access(HiddenInfo0, HiddenArg, Var)
+ ->
+ ArgList = [term__variable(Var) | ArgList0],
+ edcg__add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet0, HiddenInfo0, ArgList0,
+ VarSet, ErrorList1, ErrorList2,
+ HiddenInfo)
+ ;
+ ErrorList1 = [HiddenArg | ErrorList10],
+ edcg__add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet0, HiddenInfo0, ArgList,
+ VarSet, ErrorList10, ErrorList2,
+ HiddenInfo)
+ )
+ ;
+ Form = changed,
+ (
+ hidden_info_change(HiddenInfo0, HiddenArg, Var1,
+ Var2, _, VarSet0, VarSet1, HiddenInfo1)
+ ->
+ ArgList = [term__variable(Var1),
+ term__variable(Var2) | ArgList0],
+ edcg__add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet1, HiddenInfo1, ArgList0,
+ VarSet, ErrorList1, ErrorList2,
+ HiddenInfo)
+ ;
+ ErrorList1 = [HiddenArg | ErrorList10],
+ edcg__add_hidden_args_2(Rest, HiddenTerms0,
+ Context, VarSet0, HiddenInfo0, ArgList,
+ VarSet, ErrorList10, ErrorList2,
+ HiddenInfo)
+ )
+ )
+ ).
+
+:- pred edcg__check_hidden_terms(list(prog_term), term__context, prog_varset,
+ list(hidden_form_and_name), list(pair(sym_name, list(prog_term))),
+ hidden_info, hidden_info).
+:- mode edcg__check_hidden_terms(in, in, in, in, out, in, out) is det.
+edcg__check_hidden_terms([], _, _, _, [], HiddenInfo, HiddenInfo).
+edcg__check_hidden_terms([HiddenTerm | HiddenTerms], Context, VarSet,
+ FormAndNames, HiddenArgVars, HiddenInfo0, HiddenInfo) :-
+ (
+ sym_name_and_args(HiddenTerm, HiddenName, Args)
+ ->
+ edcg__get_hidden_names(HiddenName, Args, FormAndNames,
+ HiddenNames),
+ (
+ HiddenNames = [Name]
+ ->
+ edcg__check_hidden_terms(HiddenTerms, Context, VarSet,
+ 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.",
+ HiddenTerm, Context, VarSet), HiddenInfo0, HiddenInfo),
+ HiddenArgVars = []
+ ).
+
+:- pred edcg__get_hidden_names(sym_name, list(prog_term),
+ list(hidden_form_and_name), list(sym_name)).
+:- mode edcg__get_hidden_names(in, in, in, out) is det.
+edcg__get_hidden_names(_, _, [], []).
+edcg__get_hidden_names(HiddenName, Args, [FormAndName |
+ FormAndNames0], Names) :-
+ edcg__get_hidden_names(HiddenName, Args, FormAndNames0,
+ Names0),
+ edcg__name_and_form(Name, Form, FormAndName),
+ (
+ match_sym_name(HiddenName, Name),
+ (
+ Form = changed
+ ->
+ Args = [_|_]
+ ;
+ Args = [_]
+ )
+ ->
+ Names = [Name | Names0]
+ ;
+ Names = Names0
+ ).
+
+:- pred edcg__get_hidden_args(hidden_arg, term__context,
+ list(pair(sym_name, list(prog_term))),
+ list(pair(sym_name, list(prog_term))),
+ hidden_info, hidden_info, list(prog_term)).
+:- mode edcg__get_hidden_args(in, in, in, out, in, out, out) is semidet.
+
+edcg__get_hidden_args(HiddenArg, Context, HiddenTerms0, HiddenTerms,
+ HiddenInfo0, HiddenInfo, ArgList) :-
+ edcg__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 edcg__get_hidden_arg_terms(hidden_arg,
+ list(pair(sym_name, list(prog_term))),
+ list(pair(sym_name, list(prog_term))),
+ list(pair(sym_name, list(prog_term)))).
+:- mode edcg__get_hidden_arg_terms(in, in, out, out) is det.
+edcg__get_hidden_arg_terms(_, [], [], []).
+edcg__get_hidden_arg_terms(HiddenArg, [HiddenName - Args | HiddenTerms0],
+ HiddenTerms, HiddenTermMatches) :-
+ (
+ HiddenArg = HiddenName
+ ->
+ edcg__get_hidden_arg_terms(HiddenArg, HiddenTerms0,
+ HiddenTerms1, HiddenTermsMatches0),
+ HiddenTermMatches = [HiddenName - Args | HiddenTermsMatches0],
+ HiddenTerms = HiddenTerms1
+ ;
+ edcg__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).
+
+edcg__maybe_hidden_error(HiddenInfo, Context, PredOrFunc, PredName, Arity,
+ ModuleInfo0, ModuleInfo) -->
+ { hidden_info_get_errors(HiddenInfo, Errors) },
+ (
+ { Errors = [] }
+ ->
+ { ModuleInfo = ModuleInfo0 }
+ ;
+ prog_out__write_context(Context),
+ io__write_string("In clause for "),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
+ io__write_string("\n"),
+ edcg__maybe_hidden_error_2(Errors),
+ { module_info_incr_errors(ModuleInfo0, ModuleInfo) }
+ ).
+
+:- pred edcg__maybe_hidden_error_2(list(hidden_error), io__state, io__state).
+:- mode edcg__maybe_hidden_error_2(in, di, uo) is det.
+
+edcg__maybe_hidden_error_2([]) --> [].
+edcg__maybe_hidden_error_2([Error|Rest]) -->
+ edcg__maybe_hidden_error_3(Error),
+ edcg__maybe_hidden_error_2(Rest).
+
+:- pred edcg__maybe_hidden_error_3(hidden_error, io__state, io__state).
+:- mode edcg__maybe_hidden_error_3(in, di, uo) is det.
+
+edcg__maybe_hidden_error_3(head_functor_error(Context)) -->
+ prog_out__write_context(Context),
+ io__write_string(" functor `:-' used instead of `-->>'.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Predicate has hidden arguments declared\n"),
+ prog_out__write_context(Context),
+ io__write_string(" so all its clauses involve EDCGs.\n").
+
+edcg__maybe_hidden_error_3(head_state_error(Context, DeadList, LiveList)) -->
+ prog_out__write_context(Context),
+ io__write_string(" EDCG state error: At end of clause:\n"),
+ state_error("alive", "dead", DeadList, Context),
+ state_error("dead", "alive", LiveList, Context).
+
+edcg__maybe_hidden_error_3(call_state_error(PredName, Arity, Context,
+ DeadList, LiveList)) -->
+ prog_out__write_context(Context),
+ io__write_string(" EDCG state error: At call to "),
+ hlds_out__write_simple_call_id(predicate, PredName/Arity),
+ io__write_string(":\n"),
+ state_error("alive", "dead", DeadList, Context),
+ state_error("dead", "alive", LiveList, Context).
+
+edcg__maybe_hidden_error_3(op_state_error(Op, Context, Required,
+ Currently, HiddenArgList)) -->
+ prog_out__write_context(Context),
+ io__write_strings([" EDCG state error: At operator `", Op, "':\n"]),
+ state_error(Required, Currently, HiddenArgList, Context).
+
+edcg__maybe_hidden_error_3(hidden_arg_ambiguity_error(Context, HiddenArgs)) -->
+ prog_out__write_context(Context),
+ io__write_string(" Ambiguous hidden argument use.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Possible matches are: "),
+ edcg__output_hidden_arg_list(HiddenArgs),
+ io__nl,
+ prog_out__write_context(Context),
+ io__write_string(" Module qualify hidden argument.\n").
+
+edcg__maybe_hidden_error_3(pred_call_ambiguity_error(Context, PredIds,
+ PredTable)) -->
+ prog_out__write_context(Context),
+ io__write_string(" Ambiguous call to predicate.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Possible matches are: "),
+ output_pred_list(PredIds, PredTable),
+ io__nl.
+
+:- pred output_pred_list(list(pred_id), predicate_table, io__state, io__state).
+:- mode output_pred_list(in, in, di, uo) is det.
+
+output_pred_list([], _) --> [].
+output_pred_list([PredId | Rest], PredTable) -->
+ { predicate_table_pred_info(PredTable, PredId, PredInfo) },
+ { pred_info_module(PredInfo, Module) },
+ { pred_info_name(PredInfo, Name) },
+ { pred_info_arity(PredInfo, Arity) },
+ { PredName = qualified(Module, Name) },
+ io__write_string(" "),
+ hlds_out__write_simple_call_id(pair(predicate,PredName/Arity)),
+ output_pred_list(Rest, PredTable).
+
+edcg__maybe_hidden_error_3(undefined_error(HiddenArg, Context)) -->
+ prog_out__write_context(Context),
+ io__write_string(" Undefined hidden argument: "),
+ mercury_output_bracketed_sym_name(HiddenArg),
+ io__write_string(".\n").
+
+edcg__maybe_hidden_error_3(syntax_error(Message, Term, Context, VarSet)) -->
+ prog_out__write_context(Context),
+ io__write_string(" EDCG syntax error in "),
+ mercury_output_term(Term, VarSet, no),
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ io__write_string(Message).
+
+:- pred state_error(string, string, list(hidden_arg), term__context,
+ io__state, io__state).
+:- mode state_error(in, in, in, in, di, uo) is det.
+
+state_error(_, _, [], _) --> [].
+state_error(Required, Currently, [HiddenArg|Rest], Context) -->
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ edcg__output_hidden_arg(HiddenArg),
+ io__write_strings([" is required to be ", Required]),
+ io__write_strings([" but is currently ", Currently]),
+ io__write_string(".\n"),
+ state_error(Required, Currently, Rest, Context).
+
+edcg__update_disj_list(Goals0, HiddenInfo0, GoalInfo, Goals, HiddenInfo) :-
+ % Prevents the last disjunction's errors being included twice
+ edcg__hidden_info_set_errors([], HiddenInfo0, HiddenInfo1),
+ edcg__update_disj_list_2(Goals0, HiddenInfo1, GoalInfo, Goals,
+ HiddenInfo).
+
+:- pred edcg__update_disj_list_2(list(pair(pair(hlds_goal, term__context),
+ hidden_info)),
+ hidden_info, hlds_goal_info, list(hlds_goal),
+ hidden_info).
+:- mode edcg__update_disj_list_2(in, in, in, out, out) is det.
+
+edcg__update_disj_list_2([], HiddenInfo, _, [], HiddenInfo).
+edcg__update_disj_list_2([(HldsGoal0 - Context) - HiddenInfo0 | Rest],
+ HiddenInfo1, GoalInfo, [HldsGoal | GoalList], HiddenInfo) :-
+ edcg__update_disj(HldsGoal0, Context,
+ HiddenInfo0, HiddenInfo1, GoalInfo, HldsGoal),
+ hidden_info_combine_errors(HiddenInfo1, HiddenInfo0, HiddenInfo3),
+ edcg__update_disj_list_2(Rest, HiddenInfo3, GoalInfo, GoalList,
+ HiddenInfo).
+
+edcg__update_disj(HldsGoal0, Context, HiddenInfo0, HiddenInfo1, GoalInfo,
+ HldsGoal) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ hidden_info_get_state_info_table(HiddenInfo1, StateTable1),
+ map__keys(StateTable0, HiddenArgs),
+ edcg__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 edcg__update_disj_2(list(hidden_arg), term__context,
+ state_info_table, state_info_table, list(hlds_goal)).
+:- mode edcg__update_disj_2(in, in, in, in, out) is det.
+
+edcg__update_disj_2([], _, _, _, []).
+edcg__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],
+ edcg__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.")
+ ;
+ edcg__update_disj_2(HiddenArgList, Context,
+ StateTable0, StateTable1, HldsGoals)
+ ).
+
+edcg__update_hidden_info(HiddenInfo0, HiddenInfo, VarSet0, VarSet) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable),
+ map__keys(StateTable, HiddenArgs),
+ edcg__update_hidden_info_2(HiddenArgs, HiddenInfo0, HiddenInfo,
+ VarSet0, VarSet).
+
+:- pred edcg__update_hidden_info_2(list(hidden_arg), hidden_info, hidden_info,
+ prog_varset, prog_varset).
+:- mode edcg__update_hidden_info_2(in, in, out, in, out) is det.
+
+edcg__update_hidden_info_2([], HiddenInfo, HiddenInfo, VarSet, VarSet).
+edcg__update_hidden_info_2([HiddenArg | Rest], HiddenInfo0, HiddenInfo,
+ VarSet0, VarSet) :-
+ (
+ hidden_info_change(HiddenInfo0, HiddenArg, _, _, _,
+ VarSet0, VarSet1, HiddenInfo1)
+ ->
+ VarSet2 = VarSet1,
+ HiddenInfo2 = HiddenInfo1
+ ;
+ VarSet2 = VarSet0,
+ HiddenInfo2 = HiddenInfo0
+ ),
+ edcg__update_hidden_info_2(Rest, HiddenInfo2, HiddenInfo,
+ VarSet2, VarSet).
+
+edcg__update_var_names(HiddenInfoNew, HiddenInfoOld, HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfoNew, StateTableNew),
+ hidden_info_get_state_info_table(HiddenInfoOld, StateTableOld),
+ map__keys(StateTableOld, Keys),
+ edcg__update_var_names_2(Keys, StateTableNew, StateTableOld,
+ StateTable),
+ hidden_info_set_state_info_table(HiddenInfoOld, StateTable,
+ HiddenInfo).
+
+:- pred edcg__update_var_names_2(list(hidden_arg), state_info_table,
+ state_info_table, state_info_table).
+:- mode edcg__update_var_names_2(in, in, in, out) is det.
+
+edcg__update_var_names_2([], _, StateTable, StateTable).
+edcg__update_var_names_2([HiddenArg | Rest], StateTableNew,
+ StateTableOld0, StateTable) :-
+ map__lookup(StateTableNew, HiddenArg, StateInfoNew),
+ map__lookup(StateTableOld0, HiddenArg, StateInfoOld0),
+ state_info_get_suffix(StateInfoNew, SuffixNew),
+ state_info_get_suffix(StateInfoOld0, SuffixOld),
+ (
+ SuffixNew > SuffixOld
+ ->
+ state_info_set_suffix(StateInfoOld0, SuffixNew, StateInfoOld),
+ map__set(StateTableOld0, HiddenArg, StateInfoOld,
+ StateTableOld)
+ ;
+ StateTableOld = StateTableOld0
+ ),
+ edcg__update_var_names_2(Rest, StateTableNew, StateTableOld,
+ StateTable).
+
+edcg__check_for_dups([], []).
+edcg__check_for_dups([FormAndName | FormAndNameList], HiddenNames) :-
+ edcg__name_and_form(Name, _Form, FormAndName),
+ (
+ assoc_list__search(FormAndNameList, Name, _)
+ ->
+ assoc_list__remove_all(FormAndNameList, Name,
+ FormAndNameList0),
+ HiddenNames = [Name | HiddenNames0],
+ check_for_dups(FormAndNameList0, HiddenNames0)
+ ;
+ check_for_dups(FormAndNameList, HiddenNames)
+ ).
+
+edcg__dup_error(HiddenNames, PredName, Arity, Context) -->
+ prog_out__write_context(Context),
+ io__write_string("In pred declaration for "),
+ hlds_out__write_simple_call_id(predicate, PredName/Arity),
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Multiple inclusions of the following hidden arguments:\n"),
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ edcg__output_hidden_names(HiddenNames),
+ io__nl.
+
+:- pred output_hidden_names(list(sym_name), io__state, io__state) is det.
+:- mode output_hidden_names(in, di, uo) is det.
+output_hidden_names([]) --> [].
+output_hidden_names([HiddenName | Rest]) -->
+ mercury_output_bracketed_sym_name(HiddenName),
+ io__write_string(" "),
+ edcg__output_hidden_names(Rest).
+
+
+%---------------------------------------------------------------------------%
+
+ % HiddenInfo predicates.
+
+:- interface.
+
+:- 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(list(hidden_form_and_name), prog_varset,
+ prog_varset, bool, hidden_info, hidden_info).
+:- mode hidden_info_initial_state(in, in, out, in, in, out) is det.
+
+ % hidden_info_final_state(FormsAndNames, HiddenArgList):
+ % HiddenArgList is the hidden arguments that should be alive
+ % at the end of a predicate with a FormsAndNames declaration.
+:- pred hidden_info_final_state(list(hidden_form_and_name), list(hidden_arg)).
+:- mode hidden_info_final_state(in, out) is det.
+
+ % Does not fail if the hidden argument is already alive,
+ % instead it gives a software error message.
+:- pred hidden_info_det_birth(hidden_arg, state_info_form, prog_varset,
+ prog_varset, bool, hidden_info, hidden_info).
+:- mode hidden_info_det_birth(in, in, in, out, in, in, out) is det.
+
+ % Fails if hidden argument is already alive.
+:- pred hidden_info_birth(hidden_info, hidden_arg,
+ prog_var, prog_varset, prog_varset, hidden_info).
+:- mode hidden_info_birth(in, in, out, in, out, out) is semidet.
+
+ % Fails if hidden argument is already dead.
+:- pred hidden_info_death(hidden_info, hidden_arg, prog_var, state_info_form,
+ hidden_info).
+:- mode hidden_info_death(in, in, out, out, out) is semidet.
+
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_access(hidden_info, hidden_arg, prog_var).
+:- mode hidden_info_access(in, in, out) is semidet.
+
+ % Fails if the hidden argument is dead.
+:- pred hidden_info_change(hidden_info, hidden_arg, prog_var, prog_var,
+ state_info_form, prog_varset, prog_varset, hidden_info).
+:- mode hidden_info_change(in, in, out, out, out, in, out, out) is semidet.
+
+ % 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.
+:- 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_convert(HiddenArgs, Context, Forms, Vars, 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(list(hidden_arg), term__context,
+ list(state_info_form), list(prog_var), hidden_info, hidden_info).
+:- mode hidden_info_convert(in, in, in, in, 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 for 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_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_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_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.
+
+ % 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.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+hidden_info_init(HiddenInfo) :-
+ map__init(StateTable),
+ map__init(NameTable),
+ HiddenInfo = hidden_info(StateTable, NameTable, []).
+
+hidden_info_add_hidden_arg(hidden_info(StateTable0, NameTable0, Errors),
+ HiddenArg, hidden_info(StateTable, NameTable, Errors)) :-
+ create_var_name(HiddenArg, VarNameBase),
+ init_var_suffix(VarSuffix),
+ unqualify_name(HiddenArg, Name),
+ StateInfo = dead(VarNameBase, VarSuffix),
+ 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([FormAndName|Rest], VarSet0, VarSet, IsFact,
+ HiddenInfo0, HiddenInfo) :-
+ edcg__name_and_form(HiddenName, Form, FormAndName),
+ edcg__det_sym_name_to_hidden_arg(HiddenName, HiddenArg),
+ (
+ Form = changed,
+ hidden_info_det_birth(HiddenArg, changed,
+ VarSet0, VarSet1, no, HiddenInfo0, HiddenInfo1),
+ hidden_info_initial_state(Rest, VarSet1, VarSet, IsFact,
+ HiddenInfo1, HiddenInfo)
+ ;
+ Form = passed,
+ hidden_info_det_birth(HiddenArg, passed,
+ VarSet0, VarSet1, IsFact, HiddenInfo0, HiddenInfo1),
+ hidden_info_initial_state(Rest, VarSet1, VarSet, IsFact,
+ HiddenInfo1, HiddenInfo)
+ ).
+
+hidden_info_final_state([], []).
+hidden_info_final_state([FormAndName|Rest], HiddenArgList) :-
+ edcg__name_and_form(HiddenName, Form, FormAndName),
+ edcg__det_sym_name_to_hidden_arg(HiddenName, HiddenArg),
+ (
+ Form = changed,
+ HiddenArgList = [HiddenArg|HiddenArgList0],
+ hidden_info_final_state(Rest, HiddenArgList0)
+ ;
+ Form = passed,
+ HiddenArgList = [HiddenArg|HiddenArgList0],
+ hidden_info_final_state(Rest, HiddenArgList0)
+ ).
+
+hidden_info_det_birth(HiddenArg, StateForm, VarSet0, VarSet,
+ IsFactVar, HiddenInfo0, HiddenInfo) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo0, StateInfo0),
+ ( StateInfo0 = dead(NameBase, Suffix) ->
+ new_var(VarSet0, NameBase, Suffix, IsFactVar, VarSet,
+ NewSuffix, Var),
+ StateInfo = alive(Var, StateForm, NameBase, NewSuffix),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo0,
+ StateInfo, HiddenInfo)
+ ;
+ error("Hidden argument assumed dead when alive.\n")
+ ).
+
+hidden_info_birth(HiddenInfo0, HiddenArg, Var, VarSet0, VarSet, HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ map__lookup(StateTable0, HiddenArg, StateInfo0),
+ StateInfo0 = dead(NameBase, Suffix),
+ new_var(VarSet0, NameBase, Suffix, no, VarSet,
+ NewSuffix, Var),
+ StateInfo = alive(Var, passed, NameBase, NewSuffix),
+ map__set(StateTable0, HiddenArg, StateInfo, StateTable),
+ hidden_info_set_state_info_table(HiddenInfo0, StateTable, HiddenInfo).
+
+hidden_info_death(HiddenInfo0, HiddenArg, Var, StateForm,
+ HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ map__lookup(StateTable0, HiddenArg, StateInfo0),
+ StateInfo0 = alive(Var,StateForm,NameBase,Suffix),
+ StateInfo = dead(NameBase, Suffix),
+ map__set(StateTable0, HiddenArg, StateInfo, StateTable),
+ hidden_info_set_state_info_table(HiddenInfo0, StateTable, HiddenInfo).
+
+hidden_info_change(HiddenInfo0, HiddenArg, Var1, Var2, StateForm,
+ VarSet0, VarSet, HiddenInfo) :-
+ hidden_info_get_state_info_table(HiddenInfo0, StateTable0),
+ map__lookup(StateTable0, HiddenArg, StateInfo0),
+ StateInfo0 = alive(Var1, StateForm, NameBase, Suffix),
+ new_var(VarSet0, NameBase, Suffix, no, VarSet, NewSuffix, Var2),
+ StateInfo = alive(Var2, StateForm, NameBase, NewSuffix),
+ map__set(StateTable0, HiddenArg, StateInfo, StateTable),
+ hidden_info_set_state_info_table(HiddenInfo0, StateTable, HiddenInfo).
+
+hidden_info_access(HiddenInfo, HiddenArg, Var) :-
+ hidden_info_get_state_info_table(HiddenInfo, StateTable),
+ map__lookup(StateTable, HiddenArg, StateInfo),
+ StateInfo = alive(Var, _, _, _).
+
+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(_, _),
+ edcg__det_sym_name_to_hidden_arg(SymName, HiddenArg),
+ hidden_info_get_state_info_table(HiddenInfo, StateTable),
+ map__contains(StateTable, HiddenArg),
+ HiddenInfo = HiddenInfo0
+ ).
+
+hidden_info_convert(Names0, Context, Forms0, Vars0, HiddenInfo0,
+ HiddenInfo) :-
+ (
+ Names0 = [Name | Names],
+ Forms0 = [Form | Forms],
+ Vars0 = [Var | Vars]
+ ->
+ (
+ hidden_info_get_hidden_arg(Name, Context, HiddenInfo0,
+ HiddenInfo1, HiddenArg)
+ ->
+ hidden_info_get_state_info(HiddenArg, HiddenInfo1,
+ StateInfo0),
+ state_info_get_name_base(StateInfo0, NameBase),
+ state_info_get_suffix(StateInfo0, Suffix),
+ StateInfo = alive(Var, Form, NameBase, Suffix),
+ hidden_info_set_state_info(HiddenArg, HiddenInfo1,
+ StateInfo, HiddenInfo2)
+ ;
+ hidden_info_error(undefined_error(Name, Context),
+ HiddenInfo0, HiddenInfo2)
+ ),
+ hidden_info_convert(Names, Context, Forms, Vars, HiddenInfo2,
+ HiddenInfo)
+ ;
+ Names0 = [],
+ Forms0 = [],
+ Vars0 = []
+ ->
+ HiddenInfo = HiddenInfo0
+ ;
+ 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].
+
+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).
+
+hidden_info_get_var(HiddenArg, HiddenInfo, Var) :-
+ hidden_info_get_state_info(HiddenArg, HiddenInfo, StateInfo),
+ state_info_get_var(StateInfo, Var).
+
+
+%---------------------------------------------------------------------------%
+
+ % HiddenInfo Utility 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), StateTable,
+ hidden_info(StateTable,B, C)).
+
+:- 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), NameTable,
+ hidden_info(A, NameTable, C)).
+
+:- 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, _), hidden_info(A, B, Errors)).
+
+:- pred hidden_info_live_args(hidden_info, list(hidden_arg)).
+:- mode hidden_info_live_args(in, out) is det.
+
+hidden_info_live_args(HiddenInfo, HiddenArgs) :-
+ hidden_info_get_state_info_table(HiddenInfo, StateTable),
+ map__to_assoc_list(StateTable, StateTableList),
+ hidden_info_live_args_2(StateTableList, HiddenArgs).
+
+:- pred hidden_info_live_args_2(assoc_list(hidden_arg, state_info),
+ list(hidden_arg)).
+:- mode hidden_info_live_args_2(in, out) is det.
+
+hidden_info_live_args_2([], []).
+hidden_info_live_args_2([HiddenArg - StateInfo | Rest], HiddenArgs) :-
+ (
+ state_info_is_alive(StateInfo)
+ ->
+ HiddenArgs = [HiddenArg | HiddenArgs0]
+ ;
+ HiddenArgs = HiddenArgs0
+ ),
+ hidden_info_live_args_2(Rest, HiddenArgs0).
+
+hidden_info_error(Error, HiddenInfo0, HiddenInfo) :-
+ HiddenInfo0 = hidden_info(StateTable, NameTable, Errors),
+ HiddenInfo = hidden_info(StateTable, NameTable, Error.Errors).
+
+%---------------------------------------------------------------------------%
+
+ % StateInfo Utility predicates.
+
+:- implementation.
+
+:- pred state_info_get_var(state_info, prog_var).
+:- mode state_info_get_var(in, out) is det.
+state_info_get_var(StateInfo, Var) :-
+ (
+ StateInfo = alive(Var, _, _, _)
+ ;
+ StateInfo = dead(_,_),
+ error("Hidden argument incorrectly assumed dead.\n")
+ ).
+
+:- pred state_info_get_suffix(state_info, var_suffix).
+:- mode state_info_get_suffix(in, out) is det.
+state_info_get_suffix(StateInfo, Suffix) :-
+ (
+ StateInfo = alive(_, _, _, Suffix)
+ ;
+ StateInfo = dead(_, Suffix)
+ ).
+
+ % This predicate is currently not used.
+:- 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(StateInfo, NameBase) :-
+ (
+ StateInfo = alive(_, _, NameBase, _)
+ ;
+ StateInfo = dead(NameBase, _)
+ ).
+
+:- pred state_info_set_var(state_info, prog_var, state_info).
+:- mode state_info_set_var(in, in, out) is semidet.
+state_info_set_var(StateInfo, Var, alive(Var, B, C, D)) :-
+ (
+ StateInfo = alive(Var, B, C, D)
+ ;
+ StateInfo = dead(_,_),
+ error("Hidden argument incorrectly assumed dead.\n")
+ ).
+
+:- 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(StateInfo0, Suffix, StateInfo) :-
+ (
+ StateInfo0 = alive(A, B, C, _),
+ StateInfo = alive(A, B, C, Suffix)
+ ;
+ StateInfo0 = dead(A,_),
+ StateInfo = dead(A,Suffix)
+ ).
+
+ % This predicate is currently not used.
+:- 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(StateInfo0, NameBase, StateInfo) :-
+ (
+ StateInfo0 = alive(A, B, _, D),
+ StateInfo = alive(A, B, NameBase, D)
+ ;
+ StateInfo0 = dead(_,B),
+ StateInfo = dead(NameBase,B)
+ ).
+
+:- pred state_info_is_alive(state_info::in) is semidet.
+state_info_is_alive(alive(_,_,_,_)).
+
+%---------------------------------------------------------------------------%
+
+ % General Utility predicates.
+ % 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.
+
+%---------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.50
diff -u -r1.50 prog_data.m
--- compiler/prog_data.m 1999/11/11 23:12:09 1.50
+++ compiler/prog_data.m 1999/12/20 08:03:26
@@ -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), list(hidden_form_and_name),
+ 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,14 @@
---> type_only(type)
; type_and_mode(type, mode).
+:- type form
+ ---> changed
+ ; passed.
+
+:- type hidden_form_and_name == pair(sym_name, form).
+
+:- type maybe_edcg == bool.
+
:- type pred_or_func
---> predicate
; function.
@@ -562,7 +576,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).
@@ -760,6 +774,19 @@
; 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
+ ).
+
+:- type changed_modes == maybe(pair(mode, mode)).
+:- type passed_mode == maybe(mode).
%-----------------------------------------------------------------------------%
%
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.185
diff -u -r1.185 prog_io.m
--- compiler/prog_io.m 1999/11/16 07:51:14 1.185
+++ compiler/prog_io.m 1999/12/21 02:14:44
@@ -183,7 +183,7 @@
:- implementation.
:- import_module prog_io_goal, prog_io_dcg, prog_io_pragma, prog_io_util.
-:- import_module prog_io_typeclass.
+:- import_module prog_io_typeclass, edcg.
:- import_module hlds_data, hlds_pred, prog_util, prog_out.
:- import_module globals, options, (inst).
@@ -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)
- ;
- parse_implicitly_qualified_term(ModuleName,
- Head, Term, "clause head", R2),
- process_pred_clause(R2, ProgVarSet2, Body2, R3)
+ TheContext = HeadContext
+ ;
+ % 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(list(hidden_form_and_name)), maybe1(item)).
+:- mode process_pred_2(in, in, in, in, in, in, in, in, in, in, out) is det.
-process_pred_2(ok(F, As0), PredType, VarSet0, MaybeDet, Cond, ExistQVars,
- ClassContext, Attributes0, Result) :-
+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)).
+
+:- pred process_pred_3(maybe_functor, term, varset, maybe(determinism),
+ condition, existq_tvars, class_constraints, decl_attrs,
+ list(hidden_form_and_name), 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,46 @@
Attributes = Attributes0
).
+:- pred process_hidden_decl(term, term, maybe1(list(hidden_form_and_name))).
+:- mode process_hidden_decl(in, in, out) is det.
+
+process_hidden_decl(Term, PredType, Result):-
+ (
+ Term = term__functor(term__atom("hidden"), Args, _),
+ convert_to_form_and_name(Args, HiddenArgs)
+ ->
+ Result = HiddenArgs
+ ;
+ Result = error("syntax error in `:- pred' declaration",
+ PredType)
+ ).
+
+:- pred convert_to_form_and_name(list(term),
+ maybe1(list(hidden_form_and_name))).
+:- mode convert_to_form_and_name(in, out) is semidet.
+
+convert_to_form_and_name([], ok([])).
+convert_to_form_and_name([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, []) ->
+ ( edcg__string_to_form(FormString, Form) ->
+ edcg__name_and_form(SymName, Form, FormAndName),
+ convert_to_form_and_name(Others0, Others),
+ ( Others = ok(FormAndNameList) ->
+ Result = ok([FormAndName|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 +2356,108 @@
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, _),
+ ( edcg__string_to_form(FormString, Form) ->
+ ( 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)).
+
+ % 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), [Mode1, Mode2],
+ hmode_defn(yes(Mode1 - Mode2),B)).
+init_hidden_modes(passed, hmode_defn(A,no), [Mode],
+ hmode_defn(A,yes(Mode))).
+
+:- pred check_number_of_modes(form::in, list(term)::in) is semidet.
+check_number_of_modes(changed, [_,_]).
+check_number_of_modes(passed, [_]).
+
+%-----------------------------------------------------------------------------%
:- 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.13
diff -u -r1.13 prog_io_dcg.m
--- compiler/prog_io_dcg.m 1998/11/20 04:08:57 1.13
+++ compiler/prog_io_dcg.m 1999/12/16 06:53:38
@@ -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
).
@@ -299,8 +299,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
@@ -308,7 +308,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).
@@ -445,7 +445,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.47
diff -u -r1.47 prog_util.m
--- compiler/prog_util.m 1999/07/14 14:56:14 1.47
+++ compiler/prog_util.m 1999/12/16 09:35:43
@@ -254,10 +254,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),
--------------------------------------------------------------------------
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