mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 06:14:59 +00:00
Estimated hours taken: 60
Branches: main
A rewrite of the state variable transformation from the ground up.
The initial aim was to avoid situations (encountered in the g12 project)
in which the old state variable transformation generated code that
did not satisfy the mode checker, due to unnecessary unifications.
The new system tries hard to minimize the number of unifications added to the
program. It does this by relying extensively on the idea that in a branched
structure such as an disjunction, if two branches both update the same state
variable, and the variables representing the last state of the state variable
in the two branches are (say) X and Y, and we pick X to represent the current
state after the disjunction, then we don't have to put the assignment X := Y
into the second branch; instead, we can RENAME Y to X in that branch.
To avoid renaming a goal several times (for itself, for its parent, for its
grandparent etc), we delay all renamings until the end, when we do it all
in one traversal.
The old state var system was opaque and hard to understand, partly because
its basic operations did different things in different contexts. The new system
is a much more direct expression of the intuitive meaning of state variables;
it keeps track of their state much as the programmer writing the original code
would. It should therefore be significantly easier to understand and to modify
in the future.
The new system can also detect more kinds of errors in the use of state
variables. For example it can discover that some branches of a disjunction or
if-then-else set the initial value of a state variable and some do not.
This is ok if the non-setting-branch cannot succeed; if it can, then it is
a bug. We therefore generate messages about such branches, but print them
only if mode analysis finds a bug in the procedure, since in that case,
the lack of initialization may be the cause of the bug.
doc/reference_manual.texi:
Replaced an old example that didn't know what it was talking about,
and thoroughly confused the issue of what is legal use of state
variables and what is not.
compiler/state_var.m:
Rewrite this module along the lines mentioned above.
compiler/options.m:
Add two new options. One, warn-state-var-shadowing, controls whether
we generate warnings for one state var shadowing another (which
G12 has lots of). The other, --allow-defn-for-builtins, is for
developers only; it is needed to bootstrap changes that add new
builtins. I needed this for a form of the state variable transformation
that used calls to a new builtin predicate to copy the values of state
variables in branches that did not modify them, even though other
branches did. I ultimately used unifications to do this copying,
for reasons documented in state_var.m.
compiler/add_clause.m:
compiler/add_pragma.m:
Respect the new --allow-defn-for-builtins option.
(Previously, we changed the code that now looks up the value of the
option.)
doc/user_guide.texi:
Document the --warn-state-var-shadowing option.
Fix some old documentation about dump options.
compiler/simplify.m:
Fix an old oversight: list the predicates in table_builtin.m that may
have calls introduced to them by table_gen.m.
compiler/superhomogeneous.m:
compiler/field_access.m:
compiler/add_clause.m:
compiler/goal_expr_to_goal.m:
Together with state_var.m, these modules contain the transformation
from the parse tree to the HLDS. Since the change to state_var.m
involves significant changes in its interface (such as separating out
the persistent and location-dependent aspects of the information needed
by the state variable transformation), and needing callbacks at
different points than the old transformation, these modules had to
change extensively as well to conform.
goal_expr_to_goal.m is a new module carved out of add_clause.m.
It deserves a module of its own because its code has a significantly
different purpose than add_clause.m. The two separate modules each
have much better cohesion than the old conjoined module did.
In superhomogeneous.m, replace two predicates that did the same thing
with one predicate.
compiler/make_hlds.m:
compiler/notes/compiler_design.html.m:
Mention the new module.
compiler/hlds_goal.m:
Add a mechanism to do the kind of incremental renaming that the state
variable transformation needs.
Add some utility predicates needed by the new code in other modules.
compiler/hlds_clause.m:
compiler/hlds_pred.m:
Add an extra piece of information to clauses and proc_infos:
a list of informational messages generated by the state variable
transformation about some branches of branched goals not giving initial
values to some state variables, while other branches do.
The state variable transformation fills in this field in clauses
where relevant.
compiler/clause_to_proc.m:
Copy this list of messages from clauses to proc_infos.
compiler/modes.m:
When generating an error message for a procedure, include this list
of messages from the state var transformation in the output.
compiler/handle_options.m:
Add a dump alias for debugging the state var transformation.
compiler/hlds_out_goal.m:
Add a predicate that is useful in trace messages when debugging
the compiler.
compiler/hlds_out_pred.m:
Print goal path and goal id information in clauses as well as
proc_infos, since the state var transformation now uses goal ids.
compiler/prog_item.m:
In lists of quantified vars in scope headers, separate out the vars
introduced as !S from those introduced as !.S and !:S. This makes it
easier for the state var transformation to handle them.
Document that we expect lists of quantified variables and state
variables to contain no duplicates. The state var transformation
is slightly simpler if we impose this requirement, and quantifying
a variable twice in the same scope does not make sense, and is
therefore almost certainly an error.
compiler/prog_io_util.m:
Generate error messages when a variable or state variable IS
listed twice in the same quantification list.
Factor out some code used to generate error messages.
compiler/typecheck.m:
Conform to the changes above.
Break a very large predicate into two smaller pieces.
compiler/add_class.m:
compiler/add_pragma.m:
compiler/add_pred.m:
compiler/assertion.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/goal_path.m:
compiler/goal_util.m:
compiler/headvar_names.m:
compiler/hhf.m:
compiler/hlds_out_module.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/mercury_to_mercury.m:
compiler/module_imports.m:
compiler/module_qual.m:
compiler/post_typecheck.m:
compiler/prog_io_goal.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
Conform to the changes above.
compiler/mode_constraints.m:
compiler/modules.m:
compiler/structure_reuse.analysis.m:
Avoid the warnings we now generate about one state variable shadowing
another.
browser/declarative_user.m:
compiler/hlds_out_util.m:
compiler/ordering_mode_constraints.m:
compiler/table_gen.m:
deep_profiler/read_profile.m:
Improve programming style.
library/require.m:
Add expect_not, a negated version of expect.
library/varset.m:
Return lists of new variables in order, not reverse order.
mdbcomp/mdbcomp.goal_path.m:
compiler/prog_mode.m:
Add a utility predicate.
tests/debugger/tailrec1.exp:
tests/invalid/any_passed_as_ground.err_exp:
tests/invalid/bad_sv_unify_msg.err_exp:
tests/invalid/state_vars_test1.err_exp:
tests/invalid/state_vars_test4.err_exp:
tests/invalid/try_bad_params.err_exp:
tests/invalid/try_detism.err_exp:
tests/invalid/purity/impure_pred_t1_fixed.err_exp:
tests/invalid/purity/impure_pred_t2.err_exp:
Update the expected outputs of these test cases to account for
incidental changes in variable numbers and goal paths after this
change.
tests/general/state_vars_tests.{m,exp}:
Remove the code that expected the state var transformation to do
something that was actually AGAINST the reference manual: treating
the step from the condition to the then part of an if-then-else
expression (not a goal) as a sequence point.
tests/general/state_vars_trace.m:
Add a test case that is not enabled yet, since we don't pass it.
tests/hard_coded/bit_buffer_test.m:
Fix a bug in the test itself: the introduction of a state var twice
in the same scope.
tests/hard_coded/try_syntax_6.m:
Avoid a warning about state var shadowing.
tests/hard_coded/if_then_else_expr_state_var.{m,exp}:
A new test to check the proper handling of state vars in if-then-else
expressions.
tests/hard_coded/Mmakefile:
Enable the new test.
1225 lines
46 KiB
Mathematica
1225 lines
46 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2011 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: prog_io_util.m.
|
|
% Main author: fjh.
|
|
%
|
|
% This module defines the types used by prog_io and its subcontractors
|
|
% to return the results of parsing, and some utility predicates needed
|
|
% by several of prog_io's submodules.
|
|
%
|
|
% Most parsing predicates must check for errors. They return either the
|
|
% item(s) they were looking for, or an error indication.
|
|
%
|
|
% Most of the parsing predicates return a `maybe1(T)' or a `maybe2(T1, T2)',
|
|
% which will either be the `ok(ParseTree)' (or `ok(ParseTree1, ParseTree2)'),
|
|
% if the parse is successful, or `error(Message, Term)' if it is not.
|
|
% The `Term' there should be the term which is syntactically incorrect.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_io_util.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type maybe1(T1)
|
|
---> error1(list(error_spec))
|
|
; ok1(T1).
|
|
|
|
:- type maybe2(T1, T2)
|
|
---> error2(list(error_spec))
|
|
; ok2(T1, T2).
|
|
|
|
:- type maybe3(T1, T2, T3)
|
|
---> error3(list(error_spec))
|
|
; ok3(T1, T2, T3).
|
|
|
|
:- type maybe4(T1, T2, T3, T4)
|
|
---> error4(list(error_spec))
|
|
; ok4(T1, T2, T3, T4).
|
|
|
|
:- func get_any_errors1(maybe1(T1)) = list(error_spec).
|
|
:- func get_any_errors2(maybe2(T1, T2)) = list(error_spec).
|
|
:- func get_any_errors3(maybe3(T1, T2, T3)) = list(error_spec).
|
|
:- func get_any_errors4(maybe4(T1, T2, T3, T4)) = list(error_spec).
|
|
|
|
:- type maybe_functor == maybe_functor(generic).
|
|
:- type maybe_functor(T) == maybe2(sym_name, list(term(T))).
|
|
|
|
% ok(SymName, Args - MaybeFuncRetArg) ; error(Msg, Term).
|
|
:- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))).
|
|
|
|
:- type var2tvar == map(var, tvar).
|
|
|
|
:- type var2pvar == map(var, prog_var).
|
|
|
|
:- type parser(T) == pred(term, maybe1(T)).
|
|
:- mode parser == (pred(in, out) is det).
|
|
|
|
% Various predicates to parse small bits of syntax.
|
|
% These predicates simply fail if they encounter a syntax error.
|
|
|
|
:- pred parse_list_of_vars(term(T)::in, list(var(T))::out) is semidet.
|
|
|
|
% Parse a list of quantified variables.
|
|
% The other input argument is a prefix for any error messages.
|
|
%
|
|
:- pred parse_vars(term(T)::in, varset(T)::in, list(format_component)::in,
|
|
maybe1(list(var(T)))::out) is det.
|
|
|
|
% Parse a list of quantified variables, splitting it into
|
|
% ordinary logic variables and state variables respectively.
|
|
% The other input argument is a prefix for any error messages.
|
|
%
|
|
:- pred parse_quantifier_vars(term(T)::in, varset(T)::in,
|
|
list(format_component)::in, maybe2(list(var(T)), list(var(T)))::out)
|
|
is det.
|
|
|
|
% Similar to parse_vars, but also allow state variables to appear
|
|
% in the list. The outputs separate the parsed variables into ordinary
|
|
% variables, state variables listed as !.X, and state variables
|
|
% listed as !:X.
|
|
%
|
|
:- pred parse_vars_and_state_vars(term(T)::in, varset(T)::in,
|
|
list(format_component)::in,
|
|
maybe4(list(var(T)), list(var(T)), list(var(T)), list(var(T)))::out)
|
|
is det.
|
|
|
|
:- pred parse_name_and_arity(module_name::in, term(T)::in,
|
|
sym_name::out, arity::out) is semidet.
|
|
|
|
:- pred parse_name_and_arity(term(T)::in, sym_name::out, arity::out)
|
|
is semidet.
|
|
|
|
:- pred parse_pred_or_func_name_and_arity(term(T)::in,
|
|
pred_or_func::out, sym_name::out, arity::out) is semidet.
|
|
|
|
:- pred parse_pred_or_func_and_args(term(_T)::in,
|
|
pred_or_func::out, sym_name::out, list(term(_T))::out) is semidet.
|
|
|
|
:- pred parse_pred_or_func_and_args_general(maybe(module_name)::in,
|
|
term(_T)::in, varset(_T)::in, list(format_component)::in,
|
|
maybe_pred_or_func(term(_T))::out) is det.
|
|
|
|
:- pred maybe_parse_type(term::in, mer_type::out) is semidet.
|
|
|
|
:- pred parse_type(term::in, varset::in, list(format_component)::in,
|
|
maybe1(mer_type)::out) is det.
|
|
|
|
:- pred maybe_parse_types(list(term)::in, list(mer_type)::out) is semidet.
|
|
|
|
:- pred parse_types(list(term)::in, varset::in, list(format_component)::in,
|
|
maybe1(list(mer_type))::out) is det.
|
|
|
|
:- pred unparse_type(mer_type::in, term::out) is det.
|
|
|
|
:- pred parse_purity_annotation(term(T)::in, purity::out, term(T)::out) is det.
|
|
|
|
:- type allow_constrained_inst_var
|
|
---> allow_constrained_inst_var
|
|
; no_allow_constrained_inst_var.
|
|
|
|
:- pred convert_mode_list(allow_constrained_inst_var::in, list(term)::in,
|
|
list(mer_mode)::out) is semidet.
|
|
|
|
:- pred convert_mode(allow_constrained_inst_var::in, term::in, mer_mode::out)
|
|
is semidet.
|
|
|
|
:- pred convert_inst_list(allow_constrained_inst_var::in, list(term)::in,
|
|
list(mer_inst)::out) is semidet.
|
|
|
|
:- pred convert_inst(allow_constrained_inst_var::in, term::in, mer_inst::out)
|
|
is semidet.
|
|
|
|
:- pred standard_det(string::in, determinism::out) is semidet.
|
|
|
|
% Convert a "disjunction" (bunch of terms separated by ';'s) to a list.
|
|
%
|
|
:- pred disjunction_to_list(term(T)::in, list(term(T))::out) is det.
|
|
|
|
% Convert a "conjunction" (bunch of terms separated by ','s) to a list.
|
|
%
|
|
:- pred conjunction_to_list(term(T)::in, list(term(T))::out) is det.
|
|
|
|
% list_to_conjunction(Context, First, Rest, Term):
|
|
% Convert a list to a "conjunction" (bunch of terms separated by ','s).
|
|
%
|
|
:- pred list_to_conjunction(prog_context::in, term(T)::in, list(term(T))::in,
|
|
term(T)::out) is det.
|
|
|
|
% Convert a "sum" (bunch of terms separated by '+' operators) to a list.
|
|
%
|
|
:- pred sum_to_list(term(T)::in, list(term(T))::out) is det.
|
|
|
|
% Parse a comma-separated list (misleading described as a "conjunction")
|
|
% of things.
|
|
%
|
|
:- pred parse_list(parser(T)::parser, term::in, maybe1(list(T))::out) is det.
|
|
|
|
:- pred map_parser(parser(T)::parser, list(term)::in, maybe1(list(T))::out)
|
|
is det.
|
|
|
|
:- pred list_term_to_term_list(term::in, list(term)::out) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type decl_attribute
|
|
---> decl_attr_purity(purity)
|
|
; decl_attr_quantifier(quantifier_type, list(var))
|
|
; decl_attr_constraints(quantifier_type, term)
|
|
% the term here is the (not yet parsed) list of constraints
|
|
; decl_attr_solver_type.
|
|
|
|
:- type quantifier_type
|
|
---> quant_type_exist
|
|
; quant_type_univ.
|
|
|
|
% The term associated with each decl_attribute is the term containing
|
|
% both the attribute and the declaration that that attribute modifies;
|
|
% this term is used when printing out error messages for cases when
|
|
% attributes are used on declarations where they are not allowed.
|
|
:- type decl_attrs == assoc_list(decl_attribute, term.context).
|
|
|
|
:- pred parse_decl_attribute(string::in, list(term)::in, decl_attribute::out,
|
|
term::out) is semidet.
|
|
|
|
:- pred check_no_attributes(maybe1(T)::in, decl_attrs::in, maybe1(T)::out)
|
|
is det.
|
|
|
|
:- func attribute_description(decl_attribute) = string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% parse_condition_suffix(Term, BeforeCondTerm, Condition):
|
|
%
|
|
% Bind Condition to a representation of the 'where' condition of Term,
|
|
% if any, and bind BeforeCondTerm to the other part of Term. If Term
|
|
% does not contain a condition, then set Condition to true.
|
|
%
|
|
% NU-Prolog supported type declarations of the form
|
|
% :- pred p(T) where p(X) : sorted(X).
|
|
% or
|
|
% :- type sorted_list(T) = list(T) where X : sorted(X).
|
|
% :- pred p(sorted_list(T)).
|
|
% There is some code here to support that sort of thing, but
|
|
% probably we would now need to use a different syntax, since
|
|
% Mercury now uses `where' for different purposes (e.g. specifying
|
|
% user-defined equality predicates, and also for type classes ...)
|
|
%
|
|
:- pred parse_condition_suffix(term::in, term::out, condition::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.prog_io_sym_name.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
get_any_errors1(ok1(_)) = [].
|
|
get_any_errors1(error1(Specs)) = Specs.
|
|
|
|
get_any_errors2(ok2(_, _)) = [].
|
|
get_any_errors2(error2(Specs)) = Specs.
|
|
|
|
get_any_errors3(ok3(_, _, _)) = [].
|
|
get_any_errors3(error3(Specs)) = Specs.
|
|
|
|
get_any_errors4(ok4(_, _, _, _)) = [].
|
|
get_any_errors4(error4(Specs)) = Specs.
|
|
|
|
parse_name_and_arity(ModuleName, PredAndArityTerm, SymName, Arity) :-
|
|
PredAndArityTerm = term.functor(term.atom("/"),
|
|
[PredNameTerm, ArityTerm], _),
|
|
try_parse_implicitly_qualified_sym_name_and_no_args(ModuleName,
|
|
PredNameTerm, SymName),
|
|
ArityTerm = term.functor(term.integer(Arity), [], _).
|
|
|
|
parse_name_and_arity(PredAndArityTerm, SymName, Arity) :-
|
|
parse_name_and_arity(unqualified(""),
|
|
PredAndArityTerm, SymName, Arity).
|
|
|
|
parse_pred_or_func_name_and_arity(PorFPredAndArityTerm,
|
|
PredOrFunc, SymName, Arity) :-
|
|
PorFPredAndArityTerm = term.functor(term.atom(PredOrFuncStr), Args, _),
|
|
( PredOrFuncStr = "pred", PredOrFunc = pf_predicate
|
|
; PredOrFuncStr = "func", PredOrFunc = pf_function
|
|
),
|
|
Args = [Arg],
|
|
ModuleName = unqualified(""),
|
|
parse_name_and_arity(ModuleName, Arg, SymName, Arity).
|
|
|
|
parse_pred_or_func_and_args(PredAndArgsTerm, PredOrFunc, SymName, ArgTerms) :-
|
|
(
|
|
PredAndArgsTerm = term.functor(term.atom("="),
|
|
[FuncAndArgsTerm, FuncResultTerm], _)
|
|
->
|
|
try_parse_sym_name_and_args(FuncAndArgsTerm, SymName, ArgTerms0),
|
|
PredOrFunc = pf_function,
|
|
ArgTerms = ArgTerms0 ++ [FuncResultTerm]
|
|
;
|
|
try_parse_sym_name_and_args(PredAndArgsTerm, SymName, ArgTerms),
|
|
PredOrFunc = pf_predicate
|
|
).
|
|
|
|
parse_pred_or_func_and_args_general(MaybeModuleName, PredAndArgsTerm,
|
|
VarSet, ContextPieces, PredAndArgsResult) :-
|
|
(
|
|
PredAndArgsTerm = term.functor(term.atom("="),
|
|
[FuncAndArgsTerm, FuncResultTerm], _)
|
|
->
|
|
FunctorTerm = FuncAndArgsTerm,
|
|
MaybeFuncResult = yes(FuncResultTerm)
|
|
;
|
|
FunctorTerm = PredAndArgsTerm,
|
|
MaybeFuncResult = no
|
|
),
|
|
varset.coerce(VarSet, GenericVarSet),
|
|
(
|
|
MaybeModuleName = yes(ModuleName),
|
|
parse_implicitly_qualified_sym_name_and_args(ModuleName, FunctorTerm,
|
|
GenericVarSet, ContextPieces, Result)
|
|
;
|
|
MaybeModuleName = no,
|
|
parse_sym_name_and_args(FunctorTerm, GenericVarSet, ContextPieces,
|
|
Result)
|
|
),
|
|
(
|
|
Result = ok2(SymName, Args),
|
|
PredAndArgsResult = ok2(SymName, Args - MaybeFuncResult)
|
|
;
|
|
Result = error2(Specs),
|
|
PredAndArgsResult = error2(Specs)
|
|
).
|
|
|
|
maybe_parse_type(Term, Type) :-
|
|
% The values of VarSet and ContextPieces do not matter since we succeed
|
|
% only if they aren't used.
|
|
VarSet = varset.init,
|
|
ContextPieces = [],
|
|
parse_type(Term, VarSet, ContextPieces, ok1(Type)).
|
|
|
|
parse_type(Term, VarSet, ContextPieces, Result) :-
|
|
% XXX kind inference: We currently give all types kind `star'.
|
|
% This will be different when we have a kind system.
|
|
|
|
(
|
|
Term = term.variable(Var0, _)
|
|
->
|
|
term.coerce_var(Var0, Var),
|
|
Result = ok1(type_variable(Var, kind_star))
|
|
;
|
|
parse_builtin_type(Term, BuiltinType)
|
|
->
|
|
Result = ok1(builtin_type(BuiltinType))
|
|
;
|
|
parse_higher_order_type(Term, HOArgs, MaybeRet, Purity, EvalMethod)
|
|
->
|
|
Result = ok1(higher_order_type(HOArgs, MaybeRet, Purity, EvalMethod))
|
|
;
|
|
Term = term.functor(term.atom("{}"), Args, _)
|
|
->
|
|
parse_types(Args, VarSet, ContextPieces, ArgsResult),
|
|
(
|
|
ArgsResult = ok1(ArgTypes),
|
|
Result = ok1(tuple_type(ArgTypes, kind_star))
|
|
;
|
|
ArgsResult = error1(Specs),
|
|
Result = error1(Specs)
|
|
)
|
|
;
|
|
% We don't support apply/N types yet, so we just detect them
|
|
% and report an error message.
|
|
Term = term.functor(term.atom(""), _, Context)
|
|
->
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
|
|
words("Error: ill-formed type"), words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(Pieces)])]),
|
|
Result = error1([Spec])
|
|
;
|
|
% We don't support kind annotations yet, and we don't report
|
|
% an error either. Perhaps we should?
|
|
parse_sym_name_and_args(Term, VarSet, ContextPieces, NameResult),
|
|
(
|
|
NameResult = ok2(SymName, ArgTerms),
|
|
parse_types(ArgTerms, VarSet, ContextPieces, ArgsResult),
|
|
(
|
|
ArgsResult = ok1(ArgTypes),
|
|
Result = ok1(defined_type(SymName, ArgTypes, kind_star))
|
|
;
|
|
ArgsResult = error1(Specs),
|
|
Result = error1(Specs)
|
|
)
|
|
;
|
|
NameResult = error2(Specs),
|
|
Result = error1(Specs)
|
|
)
|
|
).
|
|
|
|
maybe_parse_types(Term, Types) :-
|
|
% The values of VarSet and ContextPieces do not matter since we succeed
|
|
% only if they aren't used.
|
|
VarSet = varset.init,
|
|
ContextPieces = [],
|
|
parse_types(Term, VarSet, ContextPieces, ok1(Types)).
|
|
|
|
parse_types(Terms, VarSet, ContextPieces, Result) :-
|
|
parse_types_2(Terms, VarSet, ContextPieces, [], Result).
|
|
|
|
:- pred parse_types_2(list(term)::in, varset::in, list(format_component)::in,
|
|
list(mer_type)::in, maybe1(list(mer_type))::out) is det.
|
|
|
|
parse_types_2([], _, _, RevTypes, ok1(Types)) :-
|
|
list.reverse(RevTypes, Types).
|
|
parse_types_2([Term | Terms], VarSet, ContextPieces, RevTypes, Result) :-
|
|
parse_type(Term, VarSet, ContextPieces, Result0),
|
|
(
|
|
Result0 = ok1(Type),
|
|
parse_types_2(Terms, VarSet, ContextPieces, [Type | RevTypes], Result)
|
|
;
|
|
Result0 = error1(Specs),
|
|
Result = error1(Specs)
|
|
).
|
|
|
|
:- pred parse_builtin_type(term::in, builtin_type::out) is semidet.
|
|
|
|
parse_builtin_type(Term, BuiltinType) :-
|
|
Term = term.functor(term.atom(Name), [], _),
|
|
builtin_type_to_string(BuiltinType, Name).
|
|
|
|
% If there are any ill-formed types in the argument then we just fail.
|
|
% The predicate parse_type will then try to parse the term as an ordinary
|
|
% defined type and will produce the required error message.
|
|
%
|
|
:- pred parse_higher_order_type(term::in, list(mer_type)::out,
|
|
maybe(mer_type)::out, purity::out, lambda_eval_method::out) is semidet.
|
|
|
|
parse_higher_order_type(Term0, ArgTypes, MaybeRet, Purity, lambda_normal) :-
|
|
parse_purity_annotation(Term0, Purity, Term1),
|
|
( Term1 = term.functor(term.atom("="), [FuncAndArgs, Ret], _) ->
|
|
FuncAndArgs = term.functor(term.atom("func"), Args, _),
|
|
maybe_parse_type(Ret, RetType),
|
|
MaybeRet = yes(RetType)
|
|
;
|
|
Term1 = term.functor(term.atom("pred"), Args, _),
|
|
MaybeRet = no
|
|
),
|
|
maybe_parse_types(Args, ArgTypes).
|
|
|
|
parse_purity_annotation(Term0, Purity, Term) :-
|
|
(
|
|
Term0 = term.functor(term.atom(PurityName), [Term1], _),
|
|
purity_name(Purity0, PurityName)
|
|
->
|
|
Purity = Purity0,
|
|
Term = Term1
|
|
;
|
|
Purity = purity_pure,
|
|
Term = Term0
|
|
).
|
|
|
|
unparse_type(type_variable(TVar, _), term.variable(Var, context_init)) :-
|
|
Var = term.coerce_var(TVar).
|
|
unparse_type(defined_type(SymName, Args, _), Term) :-
|
|
unparse_type_list(Args, ArgTerms),
|
|
unparse_qualified_term(SymName, ArgTerms, Term).
|
|
unparse_type(builtin_type(BuiltinType), Term) :-
|
|
Context = term.context_init,
|
|
builtin_type_to_string(BuiltinType, Name),
|
|
Term = term.functor(term.atom(Name), [], Context).
|
|
unparse_type(higher_order_type(Args, MaybeRet, Purity, EvalMethod), Term) :-
|
|
Context = term.context_init,
|
|
unparse_type_list(Args, ArgTerms),
|
|
(
|
|
MaybeRet = yes(Ret),
|
|
Term0 = term.functor(term.atom("func"), ArgTerms, Context),
|
|
maybe_add_lambda_eval_method(EvalMethod, Term0, Term1),
|
|
unparse_type(Ret, RetTerm),
|
|
Term2 = term.functor(term.atom("="), [Term1, RetTerm], Context)
|
|
;
|
|
MaybeRet = no,
|
|
Term0 = term.functor(term.atom("pred"), ArgTerms, Context),
|
|
maybe_add_lambda_eval_method(EvalMethod, Term0, Term2)
|
|
),
|
|
maybe_add_purity_annotation(Purity, Term2, Term).
|
|
unparse_type(tuple_type(Args, _), Term) :-
|
|
Context = term.context_init,
|
|
unparse_type_list(Args, ArgTerms),
|
|
Term = term.functor(term.atom("{}"), ArgTerms, Context).
|
|
unparse_type(apply_n_type(TVar, Args, _), Term) :-
|
|
Context = term.context_init,
|
|
Var = term.coerce_var(TVar),
|
|
unparse_type_list(Args, ArgTerms),
|
|
Term = term.functor(term.atom(""), [term.variable(Var, Context) | ArgTerms],
|
|
Context).
|
|
unparse_type(kinded_type(_, _), _) :-
|
|
unexpected(this_file, "prog_io_util: kind annotation").
|
|
|
|
:- pred unparse_type_list(list(mer_type)::in, list(term)::out) is det.
|
|
|
|
unparse_type_list(Types, Terms) :-
|
|
list.map(unparse_type, Types, Terms).
|
|
|
|
:- pred unparse_qualified_term(sym_name::in, list(term)::in, term::out) is det.
|
|
|
|
unparse_qualified_term(unqualified(Name), Args, Term) :-
|
|
Context = term.context_init,
|
|
Term = term.functor(term.atom(Name), Args, Context).
|
|
unparse_qualified_term(qualified(Qualifier, Name), Args, Term) :-
|
|
Context = term.context_init,
|
|
unparse_qualified_term(Qualifier, [], QualTerm),
|
|
Term0 = term.functor(term.atom(Name), Args, Context),
|
|
Term = term.functor(term.atom("."), [QualTerm, Term0], Context).
|
|
|
|
:- pred maybe_add_lambda_eval_method(lambda_eval_method::in, term::in,
|
|
term::out) is det.
|
|
|
|
maybe_add_lambda_eval_method(lambda_normal, Term, Term).
|
|
|
|
:- pred maybe_add_purity_annotation(purity::in, term::in, term::out) is det.
|
|
|
|
maybe_add_purity_annotation(purity_pure, Term, Term).
|
|
maybe_add_purity_annotation(purity_semipure, Term0, Term) :-
|
|
Context = term.context_init,
|
|
Term = term.functor(term.atom("semipure"), [Term0], Context).
|
|
maybe_add_purity_annotation(purity_impure, Term0, Term) :-
|
|
Context = term.context_init,
|
|
Term = term.functor(term.atom("impure"), [Term0], Context).
|
|
|
|
convert_mode_list(_, [], []).
|
|
convert_mode_list(AllowConstrainedInstVar, [H0 | T0], [H | T]) :-
|
|
convert_mode(AllowConstrainedInstVar, H0, H),
|
|
convert_mode_list(AllowConstrainedInstVar, T0, T).
|
|
|
|
convert_mode(AllowConstrainedInstVar, Term, Mode) :-
|
|
(
|
|
Term = term.functor(term.atom(">>"), [InstTermA, InstTermB], _)
|
|
->
|
|
convert_inst(AllowConstrainedInstVar, InstTermA, InstA),
|
|
convert_inst(AllowConstrainedInstVar, InstTermB, InstB),
|
|
Mode = (InstA -> InstB)
|
|
;
|
|
% Handle higher-order predicate modes:
|
|
% a mode of the form
|
|
% pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% is an abbreviation for the inst mapping
|
|
% ( pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% -> pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% )
|
|
|
|
Term = term.functor(term.atom("is"), [PredTerm, DetTerm], _),
|
|
PredTerm = term.functor(term.atom("pred"), ArgModesTerms, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes),
|
|
PredInstInfo = pred_inst_info(pf_predicate, ArgModes, Detism),
|
|
Inst = ground(shared, higher_order(PredInstInfo)),
|
|
Mode = (Inst -> Inst)
|
|
;
|
|
% Handle higher-order function modes:
|
|
% a mode of the form
|
|
% func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% is an abbreviation for the inst mapping
|
|
% ( func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% -> func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% )
|
|
|
|
Term = term.functor(term.atom("is"), [EqTerm, DetTerm], _),
|
|
EqTerm = term.functor(term.atom("="), [FuncTerm, RetModeTerm], _),
|
|
FuncTerm = term.functor(term.atom("func"), ArgModesTerms, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes0),
|
|
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
|
|
list.append(ArgModes0, [RetMode], ArgModes),
|
|
FuncInstInfo = pred_inst_info(pf_function, ArgModes, Detism),
|
|
Inst = ground(shared, higher_order(FuncInstInfo)),
|
|
Mode = (Inst -> Inst)
|
|
;
|
|
% Handle higher-order predicate modes:
|
|
% a mode of the form
|
|
% any_pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% is an abbreviation for the inst mapping
|
|
% ( any_pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% -> any_pred(<Mode1>, <Mode2>, ...) is <Det>
|
|
% )
|
|
|
|
Term = term.functor(term.atom("is"), [PredTerm, DetTerm], _),
|
|
PredTerm = term.functor(term.atom("any_pred"), ArgModesTerms, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes),
|
|
PredInstInfo = pred_inst_info(pf_predicate, ArgModes, Detism),
|
|
Inst = any(shared, higher_order(PredInstInfo)),
|
|
Mode = (Inst -> Inst)
|
|
;
|
|
% Handle higher-order function modes:
|
|
% a mode of the form
|
|
% any_func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% is an abbreviation for the inst mapping
|
|
% ( any_func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% -> any_func(<Mode1>, <Mode2>, ...) = <RetMode> is <Det>
|
|
% )
|
|
|
|
Term = term.functor(term.atom("is"), [EqTerm, DetTerm], _),
|
|
EqTerm = term.functor(term.atom("="), [FuncTerm, RetModeTerm], _),
|
|
FuncTerm = term.functor(term.atom("any_func"), ArgModesTerms, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes0),
|
|
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
|
|
list.append(ArgModes0, [RetMode], ArgModes),
|
|
FuncInstInfo = pred_inst_info(pf_function, ArgModes, Detism),
|
|
Inst = any(shared, higher_order(FuncInstInfo)),
|
|
Mode = (Inst -> Inst)
|
|
;
|
|
% If the sym_name_and_args fails, we should report the error
|
|
% (we would need to call parse_qualified_term instead).
|
|
try_parse_sym_name_and_args(Term, Name, Args),
|
|
convert_inst_list(AllowConstrainedInstVar, Args, ConvertedArgs),
|
|
Mode = user_defined_mode(Name, ConvertedArgs)
|
|
).
|
|
|
|
convert_inst_list(_, [], []).
|
|
convert_inst_list(AllowConstrainedInstVar, [H0 | T0], [H | T]) :-
|
|
convert_inst(AllowConstrainedInstVar, H0, H),
|
|
convert_inst_list(AllowConstrainedInstVar, T0, T).
|
|
|
|
convert_inst(_, term.variable(V0, _), inst_var(V)) :-
|
|
term.coerce_var(V0, V).
|
|
convert_inst(AllowConstrainedInstVar, Term, Result) :-
|
|
Term = term.functor(term.atom(Name), Args0, _Context),
|
|
(
|
|
convert_simple_builtin_inst(Name, Args0, Result0)
|
|
->
|
|
Result = Result0
|
|
;
|
|
% The syntax for a ground higher-order pred inst is
|
|
%
|
|
% pred(<Mode1>, <Mode2>, ...) is <Detism>
|
|
%
|
|
% where <Mode1>, <Mode2>, ... are a list of modes,
|
|
% and <Detism> is a determinism.
|
|
|
|
Name = "is", Args0 = [PredTerm, DetTerm],
|
|
PredTerm = term.functor(term.atom("pred"), ArgModesTerm, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes),
|
|
PredInst = pred_inst_info(pf_predicate, ArgModes, Detism),
|
|
Result = ground(shared, higher_order(PredInst))
|
|
;
|
|
% The syntax for a ground higher-order func inst is
|
|
%
|
|
% func(<Mode1>, <Mode2>, ...) = <RetMode> is <Detism>
|
|
%
|
|
% where <Mode1>, <Mode2>, ... are a list of modes,
|
|
% <RetMode> is a mode, and <Detism> is a determinism.
|
|
|
|
Name = "is", Args0 = [EqTerm, DetTerm],
|
|
EqTerm = term.functor(term.atom("="), [FuncTerm, RetModeTerm], _),
|
|
FuncTerm = term.functor(term.atom("func"), ArgModesTerm, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes0),
|
|
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
|
|
list.append(ArgModes0, [RetMode], ArgModes),
|
|
FuncInst = pred_inst_info(pf_function, ArgModes, Detism),
|
|
Result = ground(shared, higher_order(FuncInst))
|
|
;
|
|
% The syntax for an `any' higher-order pred inst is
|
|
%
|
|
% any_pred(<Mode1>, <Mode2>, ...) is <Detism>
|
|
%
|
|
% where <Mode1>, <Mode2>, ... are a list of modes,
|
|
% and <Detism> is a determinism.
|
|
|
|
Name = "is", Args0 = [PredTerm, DetTerm],
|
|
PredTerm = term.functor(term.atom("any_pred"), ArgModesTerm, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes),
|
|
PredInst = pred_inst_info(pf_predicate, ArgModes, Detism),
|
|
Result = any(shared, higher_order(PredInst))
|
|
;
|
|
% The syntax for an `any' higher-order func inst is
|
|
%
|
|
% any_func(<Mode1>, <Mode2>, ...) = <RetMode> is <Detism>
|
|
%
|
|
% where <Mode1>, <Mode2>, ... are a list of modes,
|
|
% <RetMode> is a mode, and <Detism> is a determinism.
|
|
|
|
Name = "is", Args0 = [EqTerm, DetTerm],
|
|
EqTerm = term.functor(term.atom("="), [FuncTerm, RetModeTerm], _),
|
|
FuncTerm = term.functor(term.atom("any_func"), ArgModesTerm, _)
|
|
->
|
|
DetTerm = term.functor(term.atom(DetString), [], _),
|
|
standard_det(DetString, Detism),
|
|
convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes0),
|
|
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
|
|
list.append(ArgModes0, [RetMode], ArgModes),
|
|
FuncInst = pred_inst_info(pf_function, ArgModes, Detism),
|
|
Result = any(shared, higher_order(FuncInst))
|
|
|
|
; Name = "bound", Args0 = [Disj] ->
|
|
% `bound' insts
|
|
parse_bound_inst_list(AllowConstrainedInstVar, Disj, shared, Result)
|
|
; Name = "bound_unique", Args0 = [Disj] ->
|
|
% `bound_unique' is for backwards compatibility - use `unique' instead.
|
|
parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result)
|
|
; Name = "unique", Args0 = [Disj] ->
|
|
parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result)
|
|
; Name = "mostly_unique", Args0 = [Disj] ->
|
|
parse_bound_inst_list(AllowConstrainedInstVar, Disj, mostly_unique,
|
|
Result)
|
|
; Name = "=<", Args0 = [VarTerm, InstTerm] ->
|
|
AllowConstrainedInstVar = allow_constrained_inst_var,
|
|
VarTerm = term.variable(Var, _),
|
|
% Do not allow nested constrained_inst_vars.
|
|
convert_inst(no_allow_constrained_inst_var, InstTerm, Inst),
|
|
Result = constrained_inst_vars(set.make_singleton_set(
|
|
term.coerce_var(Var)), Inst)
|
|
;
|
|
% Anything else must be a user-defined inst.
|
|
try_parse_sym_name_and_args(Term, QualifiedName, Args1),
|
|
(
|
|
BuiltinModule = mercury_public_builtin_module,
|
|
sym_name_get_module_name_default(QualifiedName, unqualified(""),
|
|
BuiltinModule),
|
|
% If the term is qualified with the `builtin' module
|
|
% then it may be one of the simple builtin insts.
|
|
% We call convert_inst recursively to check for this.
|
|
UnqualifiedName = unqualify_name(QualifiedName),
|
|
convert_simple_builtin_inst(UnqualifiedName, Args1, Result0),
|
|
|
|
% However, if the inst is a user_inst defined inside
|
|
% the `builtin' module then we need to make sure it is
|
|
% properly module-qualified.
|
|
Result0 \= defined_inst(user_inst(_, _))
|
|
->
|
|
Result = Result0
|
|
;
|
|
convert_inst_list(AllowConstrainedInstVar, Args1, Args),
|
|
Result = defined_inst(user_inst(QualifiedName, Args))
|
|
)
|
|
).
|
|
|
|
% A "simple" builtin inst is one that has no arguments and no special
|
|
% syntax.
|
|
%
|
|
:- pred convert_simple_builtin_inst(string::in, list(term)::in, mer_inst::out)
|
|
is semidet.
|
|
|
|
convert_simple_builtin_inst(Name, [], Inst) :-
|
|
convert_simple_builtin_inst_2(Name, Inst).
|
|
|
|
:- pred convert_simple_builtin_inst_2(string::in, mer_inst::out) is semidet.
|
|
|
|
% `free' insts
|
|
convert_simple_builtin_inst_2("free", free).
|
|
|
|
% `any' insts
|
|
convert_simple_builtin_inst_2("any", any(shared, none)).
|
|
convert_simple_builtin_inst_2("unique_any", any(unique, none)).
|
|
convert_simple_builtin_inst_2("mostly_unique_any", any(mostly_unique, none)).
|
|
convert_simple_builtin_inst_2("clobbered_any", any(clobbered, none)).
|
|
convert_simple_builtin_inst_2("mostly_clobbered_any",
|
|
any(mostly_clobbered, none)).
|
|
|
|
% `ground' insts
|
|
convert_simple_builtin_inst_2("ground", ground(shared, none)).
|
|
convert_simple_builtin_inst_2("unique", ground(unique, none)).
|
|
convert_simple_builtin_inst_2("mostly_unique", ground(mostly_unique, none)).
|
|
convert_simple_builtin_inst_2("clobbered", ground(clobbered, none)).
|
|
convert_simple_builtin_inst_2("mostly_clobbered",
|
|
ground(mostly_clobbered, none)).
|
|
|
|
% `not_reached' inst
|
|
convert_simple_builtin_inst_2("not_reached", not_reached).
|
|
|
|
standard_det("det", detism_det).
|
|
standard_det("cc_nondet", detism_cc_non).
|
|
standard_det("cc_multi", detism_cc_multi).
|
|
standard_det("nondet", detism_non).
|
|
standard_det("multi", detism_multi).
|
|
standard_det("multidet", detism_multi).
|
|
standard_det("semidet", detism_semi).
|
|
standard_det("erroneous", detism_erroneous).
|
|
standard_det("failure", detism_failure).
|
|
|
|
:- pred parse_bound_inst_list(allow_constrained_inst_var::in, term::in,
|
|
uniqueness::in, mer_inst::out) is semidet.
|
|
|
|
parse_bound_inst_list(AllowConstrainedInstVar, Disj, Uniqueness,
|
|
bound(Uniqueness, Functors)) :-
|
|
disjunction_to_list(Disj, List),
|
|
convert_bound_inst_list(AllowConstrainedInstVar, List, Functors0),
|
|
list.sort(Functors0, Functors),
|
|
% Check that the list doesn't specify the same functor twice.
|
|
\+ (
|
|
list.append(_, SubList, Functors),
|
|
SubList = [F1, F2 | _],
|
|
F1 = bound_functor(ConsId, _),
|
|
F2 = bound_functor(ConsId, _)
|
|
).
|
|
|
|
:- pred convert_bound_inst_list(allow_constrained_inst_var::in, list(term)::in,
|
|
list(bound_inst)::out) is semidet.
|
|
|
|
convert_bound_inst_list(_, [], []).
|
|
convert_bound_inst_list(AllowConstrainedInstVar, [H0 | T0], [H | T]) :-
|
|
convert_bound_inst(AllowConstrainedInstVar, H0, H),
|
|
convert_bound_inst_list(AllowConstrainedInstVar, T0, T).
|
|
|
|
:- pred convert_bound_inst(allow_constrained_inst_var::in, term::in,
|
|
bound_inst::out) is semidet.
|
|
|
|
convert_bound_inst(AllowConstrainedInstVar, InstTerm, BoundInst) :-
|
|
InstTerm = term.functor(Functor, Args0, _),
|
|
(
|
|
Functor = term.atom(_),
|
|
try_parse_sym_name_and_args(InstTerm, SymName, Args1),
|
|
list.length(Args1, Arity),
|
|
ConsId = cons(SymName, Arity, cons_id_dummy_type_ctor)
|
|
;
|
|
Functor = term.implementation_defined(_),
|
|
% Implementation-defined literals should not appear in inst
|
|
% definitions.
|
|
fail
|
|
;
|
|
( Functor = term.integer(_)
|
|
; Functor = term.float(_)
|
|
; Functor = term.string(_)
|
|
),
|
|
Args1 = Args0,
|
|
list.length(Args1, Arity),
|
|
ConsId = make_functor_cons_id(Functor, Arity)
|
|
),
|
|
convert_inst_list(AllowConstrainedInstVar, Args1, Args),
|
|
BoundInst = bound_functor(ConsId, Args).
|
|
|
|
disjunction_to_list(Term, List) :-
|
|
binop_term_to_list(";", Term, List).
|
|
|
|
conjunction_to_list(Term, List) :-
|
|
binop_term_to_list(",", Term, List).
|
|
|
|
list_to_conjunction(_, Term, [], Term).
|
|
list_to_conjunction(Context, First, [Second | Rest], Term) :-
|
|
list_to_conjunction(Context, Second, Rest, Tail),
|
|
Term = term.functor(term.atom(","), [First, Tail], Context).
|
|
|
|
sum_to_list(Term, List) :-
|
|
binop_term_to_list("+", Term, List).
|
|
|
|
% General predicate to convert terms separated by any specified operator
|
|
% into a list.
|
|
%
|
|
:- pred binop_term_to_list(string::in, term(T)::in, list(term(T))::out) is det.
|
|
|
|
binop_term_to_list(Op, Term, List) :-
|
|
binop_term_to_list_2(Op, Term, [], List).
|
|
|
|
:- pred binop_term_to_list_2(string::in, term(T)::in, list(term(T))::in,
|
|
list(term(T))::out) is det.
|
|
|
|
binop_term_to_list_2(Op, Term, !List) :-
|
|
( Term = term.functor(term.atom(Op), [L, R], _Context) ->
|
|
binop_term_to_list_2(Op, R, !List),
|
|
binop_term_to_list_2(Op, L, !List)
|
|
;
|
|
!:List = [Term | !.List]
|
|
).
|
|
|
|
parse_list(Parser, Term, Result) :-
|
|
conjunction_to_list(Term, List),
|
|
map_parser(Parser, List, Result).
|
|
|
|
map_parser(_, [], ok1([])).
|
|
map_parser(Parser, [X | Xs], Result) :-
|
|
call(Parser, X, X_Result),
|
|
map_parser(Parser, Xs, Xs_Result),
|
|
combine_list_results(X_Result, Xs_Result, Result).
|
|
|
|
% If several items in a list contain errors, then we report them all.
|
|
%
|
|
:- pred combine_list_results(maybe1(T)::in, maybe1(list(T))::in,
|
|
maybe1(list(T))::out) is det.
|
|
|
|
combine_list_results(error1(HeadSpecs), error1(TailSpecs),
|
|
error1(HeadSpecs ++ TailSpecs)).
|
|
combine_list_results(error1(Specs), ok1(_), error1(Specs)).
|
|
combine_list_results(ok1(_), error1(Specs), error1(Specs)).
|
|
combine_list_results(ok1(X), ok1(Xs), ok1([X | Xs])).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_list_of_vars(term.functor(term.atom("[]"), [], _), []).
|
|
parse_list_of_vars(term.functor(term.atom("[|]"), [Head, Tail], _),
|
|
[Var | Vars]) :-
|
|
Head = term.variable(Var, _),
|
|
parse_list_of_vars(Tail, Vars).
|
|
|
|
parse_vars(Term, VarSet, ContextPieces, MaybeVars) :-
|
|
( Term = functor(atom("[]"), [], _) ->
|
|
MaybeVars = ok1([])
|
|
; Term = functor(atom("[|]"), [HeadTerm, TailTerm], _) ->
|
|
(
|
|
HeadTerm = variable(HeadVar, _),
|
|
parse_vars(TailTerm, VarSet, ContextPieces, MaybeVarsTail),
|
|
(
|
|
MaybeVarsTail = ok1(TailVars),
|
|
( list.member(HeadVar, TailVars) ->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error1([Spec])
|
|
;
|
|
Vars = [HeadVar | TailVars],
|
|
MaybeVars = ok1(Vars)
|
|
)
|
|
;
|
|
MaybeVarsTail = error1(_),
|
|
MaybeVars = MaybeVarsTail
|
|
)
|
|
;
|
|
HeadTerm = functor(_, _, _),
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"variable", HeadTerm, Spec),
|
|
MaybeVars = error1([Spec])
|
|
)
|
|
;
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"list of variables", Term, Spec),
|
|
MaybeVars = error1([Spec])
|
|
).
|
|
|
|
:- type ordinary_state_var(T)
|
|
---> os_ordinary_var(var(T))
|
|
; os_state_var(var(T)).
|
|
|
|
parse_quantifier_vars(Term, VarSet, ContextPieces, MaybeVars) :-
|
|
( Term = functor(atom("[]"), [], _) ->
|
|
MaybeVars = ok2([], [])
|
|
; Term = functor(atom("[|]"), [HeadTerm, TailTerm], _) ->
|
|
(
|
|
(
|
|
HeadTerm = variable(V0, _),
|
|
VarKind = os_ordinary_var(V0)
|
|
;
|
|
HeadTerm = functor(atom("!"), [variable(SV0, _)], _),
|
|
VarKind = os_state_var(SV0)
|
|
)
|
|
->
|
|
parse_quantifier_vars(TailTerm, VarSet, ContextPieces,
|
|
MaybeVarsTail),
|
|
(
|
|
MaybeVarsTail = ok2(TailVars, TailStateVars),
|
|
(
|
|
VarKind = os_ordinary_var(V),
|
|
( list.member(V, TailVars) ->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error2([Spec])
|
|
;
|
|
Vars = [V | TailVars],
|
|
MaybeVars = ok2(Vars, TailStateVars)
|
|
)
|
|
;
|
|
VarKind = os_state_var(SV),
|
|
( list.member(SV, TailStateVars) ->
|
|
generate_repeated_state_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error2([Spec])
|
|
;
|
|
StateVars = [SV | TailStateVars],
|
|
MaybeVars = ok2(TailVars, StateVars)
|
|
)
|
|
)
|
|
;
|
|
MaybeVarsTail = error2(_),
|
|
MaybeVars = MaybeVarsTail
|
|
)
|
|
;
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"variable or state variable", HeadTerm, Spec),
|
|
MaybeVars = error2([Spec])
|
|
)
|
|
;
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"list of variables and/or state variables", Term, Spec),
|
|
MaybeVars = error2([Spec])
|
|
).
|
|
|
|
:- type ordinary_state_dot_colon_var(T)
|
|
---> osdc_ordinary_var(var(T))
|
|
; osdc_state_var(var(T))
|
|
; osdc_dot_var(var(T))
|
|
; osdc_colon_var(var(T)).
|
|
|
|
parse_vars_and_state_vars(Term, VarSet, ContextPieces, MaybeVars) :-
|
|
( Term = functor(atom("[]"), [], _) ->
|
|
MaybeVars = ok4([], [], [], [])
|
|
; Term = functor(atom("[|]"), [HeadTerm, Tail], _) ->
|
|
(
|
|
(
|
|
HeadTerm = variable(V0, _),
|
|
VarKind = osdc_ordinary_var(V0)
|
|
;
|
|
HeadTerm = functor(atom("!"), [variable(SV0, _)], _),
|
|
VarKind = osdc_state_var(SV0)
|
|
;
|
|
HeadTerm = functor(atom("!."), [variable(SV0, _)], _),
|
|
VarKind = osdc_dot_var(SV0)
|
|
;
|
|
HeadTerm = functor(atom("!:"), [variable(SV0, _)], _),
|
|
VarKind = osdc_colon_var(SV0)
|
|
)
|
|
->
|
|
parse_vars_and_state_vars(Tail, VarSet, ContextPieces,
|
|
MaybeVarsTail),
|
|
(
|
|
MaybeVarsTail = ok4(TailVars, TailStateVars,
|
|
TailDotVars, TailColonVars),
|
|
(
|
|
VarKind = osdc_ordinary_var(V),
|
|
( list.member(V, TailVars) ->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error4([Spec])
|
|
;
|
|
Vars = [V | TailVars],
|
|
MaybeVars = ok4(Vars, TailStateVars,
|
|
TailDotVars, TailColonVars)
|
|
)
|
|
;
|
|
VarKind = osdc_state_var(SV),
|
|
(
|
|
( list.member(SV, TailStateVars )
|
|
; list.member(SV, TailDotVars )
|
|
; list.member(SV, TailColonVars )
|
|
)
|
|
->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error4([Spec])
|
|
;
|
|
StateVars = [SV | TailStateVars],
|
|
MaybeVars = ok4(TailVars, StateVars,
|
|
TailDotVars, TailColonVars)
|
|
)
|
|
;
|
|
VarKind = osdc_dot_var(SV),
|
|
(
|
|
( list.member(SV, TailStateVars )
|
|
; list.member(SV, TailDotVars )
|
|
; list.member(SV, TailColonVars )
|
|
)
|
|
->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error4([Spec])
|
|
;
|
|
DotVars = [SV | TailDotVars],
|
|
MaybeVars = ok4(TailVars, TailStateVars,
|
|
DotVars, TailColonVars)
|
|
)
|
|
;
|
|
VarKind = osdc_colon_var(SV),
|
|
(
|
|
( list.member(SV, TailStateVars )
|
|
; list.member(SV, TailDotVars )
|
|
; list.member(SV, TailColonVars )
|
|
)
|
|
->
|
|
generate_repeated_var_msg(ContextPieces, VarSet,
|
|
HeadTerm, Spec),
|
|
MaybeVars = error4([Spec])
|
|
;
|
|
ColonVars = [SV | TailColonVars],
|
|
MaybeVars = ok4(TailVars, TailStateVars,
|
|
TailDotVars, ColonVars)
|
|
)
|
|
)
|
|
;
|
|
MaybeVarsTail = error4(_),
|
|
MaybeVars = MaybeVarsTail
|
|
)
|
|
;
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"variable or state variable", HeadTerm, Spec),
|
|
MaybeVars = error4([Spec])
|
|
)
|
|
;
|
|
generate_unexpected_term_message(ContextPieces, VarSet,
|
|
"list of variables and/or state variables", Term, Spec),
|
|
MaybeVars = error4([Spec])
|
|
).
|
|
|
|
:- pred generate_repeated_var_msg(list(format_component)::in,
|
|
varset(T)::in, term(T)::in, error_spec::out) is det.
|
|
|
|
generate_repeated_var_msg(ContextPieces, VarSet, Term, Spec) :-
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
|
|
words("Repeated variable"), words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]).
|
|
|
|
:- pred generate_repeated_state_var_msg(list(format_component)::in,
|
|
varset(T)::in, term(T)::in, error_spec::out) is det.
|
|
|
|
generate_repeated_state_var_msg(ContextPieces, VarSet, Term, Spec) :-
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
|
|
words("Repeated state variable"), words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]).
|
|
|
|
:- pred generate_unexpected_term_message(list(format_component)::in,
|
|
varset(T)::in, string::in, term(T)::in, error_spec::out) is det.
|
|
|
|
generate_unexpected_term_message(ContextPieces, VarSet, Expected, Term,
|
|
Spec) :-
|
|
TermStr = describe_error_term(VarSet, Term),
|
|
Pieces = ContextPieces ++ [lower_case_next_if_not_first,
|
|
words("Expected"), words(Expected), suffix(","),
|
|
words("not"), words(TermStr), suffix("."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(get_term_context(Term), [always(Pieces)])]).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
list_term_to_term_list(Term, Terms) :-
|
|
(
|
|
Term = term.functor(term.atom("[|]"), [HeadTerm, TailTerm], _),
|
|
list_term_to_term_list(TailTerm, TailTerms),
|
|
Terms = [HeadTerm | TailTerms]
|
|
;
|
|
Term = term.functor(term.atom("[]"), [], _),
|
|
Terms = []
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_decl_attribute(Functor, ArgTerms, Attribute, SubTerm) :-
|
|
(
|
|
Functor = "impure",
|
|
ArgTerms = [SubTerm],
|
|
Attribute = decl_attr_purity(purity_impure)
|
|
;
|
|
Functor = "semipure",
|
|
ArgTerms = [SubTerm],
|
|
Attribute = decl_attr_purity(purity_semipure)
|
|
;
|
|
Functor = "<=",
|
|
ArgTerms = [SubTerm, ConstraintsTerm],
|
|
Attribute = decl_attr_constraints(quant_type_univ, ConstraintsTerm)
|
|
;
|
|
Functor = "=>",
|
|
ArgTerms = [SubTerm, ConstraintsTerm],
|
|
Attribute = decl_attr_constraints(quant_type_exist, ConstraintsTerm)
|
|
;
|
|
Functor = "some",
|
|
ArgTerms = [TVarsTerm, SubTerm],
|
|
parse_list_of_vars(TVarsTerm, TVars),
|
|
Attribute = decl_attr_quantifier(quant_type_exist, TVars)
|
|
;
|
|
Functor = "all",
|
|
ArgTerms = [TVarsTerm, SubTerm],
|
|
parse_list_of_vars(TVarsTerm, TVars),
|
|
Attribute = decl_attr_quantifier(quant_type_univ, TVars)
|
|
;
|
|
Functor = "solver",
|
|
ArgTerms = [SubTerm],
|
|
Attribute = decl_attr_solver_type
|
|
).
|
|
|
|
check_no_attributes(Result0, Attributes, Result) :-
|
|
(
|
|
Result0 = ok1(_),
|
|
Attributes = [Attr - Context | _]
|
|
->
|
|
% XXX Shouldn't we mention EVERY element of Attributes?
|
|
Pieces = [words("Error:"), words(attribute_description(Attr)),
|
|
words("not allowed here."), nl],
|
|
Spec = error_spec(severity_error, phase_term_to_parse_tree,
|
|
[simple_msg(Context, [always(Pieces)])]),
|
|
Result = error1([Spec])
|
|
;
|
|
Result = Result0
|
|
).
|
|
|
|
attribute_description(decl_attr_purity(_)) = "purity specifier".
|
|
attribute_description(decl_attr_quantifier(quant_type_univ, _)) =
|
|
"universal quantifier (`all')".
|
|
attribute_description(decl_attr_quantifier(quant_type_exist, _)) =
|
|
"existential quantifier (`some')".
|
|
attribute_description(decl_attr_constraints(quant_type_univ, _)) =
|
|
"type class constraint (`<=')".
|
|
attribute_description(decl_attr_constraints(quant_type_exist, _)) =
|
|
"existentially quantified type class constraint (`=>')".
|
|
attribute_description(decl_attr_solver_type) = "solver type specifier".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_condition_suffix(Term, Term, cond_true).
|
|
|
|
% parse_condition_suffix(B, Body, Condition) :-
|
|
% (
|
|
% B = term.functor(term.atom("where"), [Body1, Condition1],
|
|
% _Context)
|
|
% ->
|
|
% Body = Body1,
|
|
% Condition = where(Condition1)
|
|
% ;
|
|
% Body = B,
|
|
% Condition = true
|
|
% ).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "prog_io_util.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module parse_tree.prog_io_util.
|
|
%-----------------------------------------------------------------------------%
|