mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 14:25:56 +00:00
b56885be93
Estimated hours taken: 12 Branches: main Fix a bug that caused bootchecks with --optimize-constructor-last-call to fail. The problem was not in lco.m, but in follow_code.m. In some cases, (specifically, the LCMC version of insert_2 in sparse_bitset.m), follow_code.m moved an impure goal (store_at_ref) into the arms of an if-then-else without marking those arms, or the if-then-else, as impure. The next pass, simplify, then deleted the entire if-then-else, since it had no outputs. (The store_at_ref that originally appeared after the if-then-else was the only consumer of its only output.) The fix is to get follow_code.m to make branched control structures such as if-then-elses, as well as their arms, semipure or impure if a goal being moved into them is semipure or impure, or if they came from an semipure or impure conjunction. Improve the optimization of the LCMC version of sparse_bitset.insert_2, which had a foreign_proc invocation of bits_per_int in it: replace such invocations with a unification of the bits_per_int constant if not cross compiling. Add a new option, --optimize-constructor-last-call-null. When set, LCMC will assign NULLs to the fields not yet filled in, to avoid any junk happens to be there from being followed by the garbage collector's mark phase. This diff also makes several other changes that helped me to track down the bug above. compiler/follow_code.m: Make the fix described above. Delete all the provisions for --prev-code; it won't be implemented. Don't export a predicate that is not now used anywhere else. compiler/simplify.m: Make the optimization described above. compiler/lco.m: Make sure that the LCMC specialized procedure is a predicate, not a function: having a function with the mode LCMC_insert_2(in, in) = in looks wrong. To avoid name collisions when a function and a predicate with the same name and arity have LCMC applied to them, include the predicate vs function status of the original procedure included in the name of the new procedure. Update the sym_name of calls to LCMC variants, not just the pred_id, because without that, the HLDS dump looks misleading. compiler/pred_table.m: Don't have optimizations like LCMC insert new predicates at the front of the list of predicates. Maintain the list of predicates in the module as a two part list, to allow efficient addition of new pred_ids at the (logical) end without using O(N^2) algorithms. Having predicates in chronological order makes it easier to look at HLDS dumps and .c files. compiler/hlds_module.m: Make module_info_predids return a module_info that is physically updated though logically unchanged. compiler/options.m: Add --optimize-constructor-last-call-null. Make the options --dump-hlds-pred-id, --debug-opt-pred-id and --debug-opt-pred-name into accumulating options, to allow the user to specify more than one predicate to be dumped (e.g. insert_2 and its LCMC variant). Delete --prev-code. doc/user_guide.texi: Document the changes in options.m. compiler/code_info.m: Record the value of --optimize-constructor-last-call-null in the code_info, to avoid lookup at every cell construction. compiler/unify_gen.m: compiler/var_locn.m: When deciding whether a cell can be static or not, make sure that we never make static a cell that has some fields initialized with dummy zeros, to be filled in for real later. compiler/hlds_out.m: For goals that are semipure or impure, note this fact. This info was lost when I changed the representation of impurity from markers to a field. mdbcomp/prim_data.m: Rename some ambiguous function symbols. compiler/intermod.m: compiler/trans_opt.m: Rename the main predicates (and some function symbols) of these modules to avoid ambiguity and to make them more expressive. compiler/llds.m: Don't print line numbers for foreign_code fragments if the user has specified --no-line-numbers. compiler/make.dependencies.m: compiler/mercury_to_mercury.m: compiler/recompilation.usage.m: Don't use io.write to write out information to files we may need to parse again, because this is vulnerable to changes to the names of function symbols (e.g. the one to mdbcomp/prim_data.m). The compiler still contains some uses of io.write, but they are for debugging. I added an item to the todo list of the one exception, ilasm.m. compiler/recompilation.m: Rename a misleading function symbol name. compiler/parse_tree.m: Don't import recompilation.m here. It is not needed (all the components of parse_tree that need recompilation.m already import it themselves), and deleting the import avoids recompiling almost everything when recompilation.m changes. compiler/*.m: Conform to the changes above. compiler/*.m: browser/*.m: slice/*.m: Conform to the change to mdbcomp. library/sparse_bitset.m: Use some better variable names.
690 lines
26 KiB
Mathematica
690 lines
26 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2001, 2003-2007 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_dcg.m.
|
|
% Main authors: fjh, zs.
|
|
%
|
|
% This module handles the parsing of clauses in Definite Clause Grammar
|
|
% notation.
|
|
%
|
|
% XXX This module performs no error checking.
|
|
% XXX It may be an idea to recode this as a state variable transformation:
|
|
% roughly Head --> G1, G2, {G3}, G4.
|
|
% becomes Head(!DCG) :- G1(!DCG), G2(!DCG), G3, G4(!DCG).
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_io_dcg.
|
|
:- interface.
|
|
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_item.
|
|
:- import_module parse_tree.prog_io_util.
|
|
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred parse_dcg_clause(module_name::in, varset::in, term::in, term::in,
|
|
prog_context::in, maybe_item_and_context::out) is det.
|
|
|
|
% parse_dcg_pred_goal(GoalTerm, MaybeGoal, DCGVarInitial, DCGVarFinal,
|
|
% !Varset):
|
|
%
|
|
% Parses `GoalTerm' and expands it as a DCG goal.
|
|
% `DCGVarInitial' is the first DCG variable,
|
|
% and `DCGVarFinal' is the final DCG variable.
|
|
%
|
|
:- pred parse_dcg_pred_goal(term::in, maybe1(goal)::out,
|
|
prog_var::out, prog_var::out, prog_varset::in, prog_varset::out) is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.prog_io.
|
|
:- import_module parse_tree.prog_io_goal.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module parse_tree.prog_out.
|
|
|
|
:- import_module counter.
|
|
:- import_module list.
|
|
:- import_module pair.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_dcg_clause(ModuleName, VarSet0, DCG_Head, DCG_Body, DCG_Context,
|
|
Result) :-
|
|
varset.coerce(VarSet0, ProgVarSet0),
|
|
new_dcg_var(ProgVarSet0, ProgVarSet1, counter.init(0), Counter0,
|
|
DCG_0_Var),
|
|
parse_dcg_goal(DCG_Body, MaybeBody, ProgVarSet1, ProgVarSet,
|
|
Counter0, _Counter, DCG_0_Var, DCG_Var),
|
|
(
|
|
MaybeBody = ok1(Body),
|
|
parse_implicitly_qualified_term(ModuleName, DCG_Head, DCG_Body,
|
|
"DCG clause head", HeadResult),
|
|
process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var, Body,
|
|
DCG_Context, ProcessResult),
|
|
add_context(ProcessResult, DCG_Context, Result)
|
|
;
|
|
MaybeBody = error1(Errors),
|
|
Result = error2(Errors)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
parse_dcg_pred_goal(GoalTerm, MaybeGoal, DCGVar0, DCGVar, !VarSet) :-
|
|
new_dcg_var(!VarSet, counter.init(0), Counter0, DCGVar0),
|
|
parse_dcg_goal(GoalTerm, MaybeGoal, !VarSet, Counter0, _Counter,
|
|
DCGVar0, DCGVar).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Used to allocate fresh variables needed for the DCG expansion.
|
|
%
|
|
:- pred new_dcg_var(prog_varset::in, prog_varset::out,
|
|
counter::in, counter::out, prog_var::out) is det.
|
|
|
|
new_dcg_var(!VarSet, !Counter, DCG_0_Var) :-
|
|
counter.allocate(N, !Counter),
|
|
string.int_to_string(N, StringN),
|
|
string.append("DCG_", StringN, VarName),
|
|
varset.new_var(!.VarSet, DCG_0_Var, !:VarSet),
|
|
varset.name_var(!.VarSet, DCG_0_Var, VarName, !:VarSet).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Expand a DCG goal.
|
|
%
|
|
:- pred parse_dcg_goal(term::in, maybe1(goal)::out,
|
|
prog_varset::in, prog_varset::out, counter::in, counter::out,
|
|
prog_var::in, prog_var::out) is det.
|
|
|
|
parse_dcg_goal(Term, MaybeGoal, !VarSet, !Counter, !Var) :-
|
|
% First, figure out the context for the goal.
|
|
(
|
|
Term = term.functor(_, _, Context)
|
|
;
|
|
Term = term.variable(_, Context)
|
|
),
|
|
% Next, parse it.
|
|
(
|
|
term.coerce(Term, ProgTerm),
|
|
sym_name_and_args(ProgTerm, SymName, Args0)
|
|
->
|
|
% First check for the special cases:
|
|
(
|
|
SymName = unqualified(Functor),
|
|
list.map(term.coerce, Args0, Args1),
|
|
parse_dcg_goal_2(Functor, Args1, Context, MaybeGoalPrime,
|
|
!VarSet, !Counter, !Var)
|
|
->
|
|
MaybeGoal = MaybeGoalPrime
|
|
;
|
|
% It's the ordinary case of non-terminal. Create a fresh var
|
|
% as the DCG output var from this goal, and append the DCG argument
|
|
% pair to the non-terminal's argument list.
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
Args = Args0 ++
|
|
[term.variable(!.Var, Context), term.variable(Var, Context)],
|
|
Goal = call_expr(SymName, Args, purity_pure) - Context,
|
|
MaybeGoal = ok1(Goal),
|
|
!:Var = Var
|
|
)
|
|
;
|
|
% A call to a free variable, or to a number or string.
|
|
% Just translate it into a call to call/3 - the typechecker
|
|
% will catch calls to numbers and strings.
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
term.coerce(Term, ProgTerm),
|
|
Goal = call_expr(unqualified("call"),
|
|
[ProgTerm, variable(!.Var, Context), variable(Var, Context)],
|
|
purity_pure) - Context,
|
|
MaybeGoal = ok1(Goal),
|
|
!:Var = Var
|
|
).
|
|
|
|
% parse_dcg_goal_2(Functor, Args, Context, Goal, !VarSet, !Counter, !Var):
|
|
%
|
|
% We use !VarSet to allocate fresh DCG variables; We use !Counter
|
|
% to keep track of the number to give to the next DCG variable
|
|
% (so that we can give it a semi-meaningful name "DCG_<N>" for use
|
|
% in error messages, debugging, etc.). We use !Var to keep track of
|
|
% the current DCG variable.
|
|
%
|
|
% Since (A -> B) has different semantics in standard Prolog
|
|
% (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
|
|
% for the moment we'll just disallow it.
|
|
%
|
|
:- pred parse_dcg_goal_2(string::in, list(term)::in, prog_context::in,
|
|
maybe1(goal)::out, prog_varset::in, prog_varset::out,
|
|
counter::in, counter::out, prog_var::in, prog_var::out) is semidet.
|
|
|
|
parse_dcg_goal_2("{}", [G0 | Gs], Context, MaybeGoal, !VarSet, !Counter,
|
|
!Var) :-
|
|
% Ordinary goal inside { curly braces }.
|
|
% The parser treats '{}/N' terms as tuples, so we need
|
|
% to undo the parsing of the argument conjunction here.
|
|
list_to_conjunction(Context, G0, Gs, G),
|
|
parse_goal(G, MaybeGoal, !VarSet).
|
|
parse_dcg_goal_2("impure", [G], _, MaybeGoal, !VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal_with_purity(G, purity_impure, MaybeGoal, !VarSet,
|
|
!Counter, !Var).
|
|
parse_dcg_goal_2("semipure", [G], _, MaybeGoal, !VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal_with_purity(G, purity_semipure, MaybeGoal, !VarSet,
|
|
!Counter, !Var).
|
|
parse_dcg_goal_2("promise_pure", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(dont_make_implicit_promises, purity_pure,
|
|
Goal0) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("promise_semipure", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(dont_make_implicit_promises, purity_semipure,
|
|
Goal0) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("promise_impure", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(dont_make_implicit_promises, purity_impure,
|
|
Goal0) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("promise_pure_implicit", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(make_implicit_promises, purity_pure, Goal0)
|
|
- Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("promise_semipure_implicit", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(make_implicit_promises, purity_semipure,
|
|
Goal0) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("promise_impure_implicit", [G], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal0, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal0 = ok1(Goal0),
|
|
Goal = promise_purity_expr(make_implicit_promises, purity_impure,
|
|
Goal0) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal0 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("[]", [], Context, MaybeGoal, !VarSet, !Counter, Var0, Var) :-
|
|
% Empty list - just unify the input and output DCG args.
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
Goal = unify_expr(
|
|
term.variable(Var0, Context), term.variable(Var, Context), purity_pure)
|
|
- Context,
|
|
MaybeGoal = ok1(Goal).
|
|
parse_dcg_goal_2("[|]", [X, Xs], Context, MaybeGoal, !VarSet, !Counter,
|
|
Var0, Var) :-
|
|
% Non-empty list of terminals. Append the DCG output arg as the new tail
|
|
% of the list, and unify the result with the DCG input arg.
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
ConsTerm0 = term.functor(term.atom("[|]"), [X, Xs], Context),
|
|
term.coerce(ConsTerm0, ConsTerm),
|
|
term_list_append_term(ConsTerm, term.variable(Var, Context), Term),
|
|
Goal = unify_expr(variable(Var0, Context), Term, purity_pure) - Context,
|
|
MaybeGoal = ok1(Goal).
|
|
parse_dcg_goal_2("=", [A0], Context, MaybeGoal, !VarSet, !Counter, Var, Var) :-
|
|
% Call to '='/1 - unify argument with DCG input arg.
|
|
term.coerce(A0, A),
|
|
Goal = unify_expr(A, variable(Var, Context), purity_pure) - Context,
|
|
MaybeGoal = ok1(Goal).
|
|
parse_dcg_goal_2(":=", [A0], Context, MaybeGoal, !VarSet, !Counter,
|
|
_Var0, Var) :-
|
|
% Call to ':='/1 - unify argument with DCG output arg.
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
term.coerce(A0, A),
|
|
Goal = unify_expr(A, variable(Var, Context), purity_pure) - Context,
|
|
MaybeGoal = ok1(Goal).
|
|
parse_dcg_goal_2("if",
|
|
[term.functor(term.atom("then"), [CondTerm, ThenTerm], _)],
|
|
Context, MaybeGoal, !VarSet, !Counter, Var0, Var) :-
|
|
% If-then (NU-Prolog syntax).
|
|
parse_dcg_if_then(CondTerm, ThenTerm, Context, MaybeVarsCond, MaybeThen,
|
|
!VarSet, !Counter, Var0, Var),
|
|
(
|
|
MaybeVarsCond = ok3(Vars, StateVars, Cond),
|
|
MaybeThen = ok1(Then)
|
|
->
|
|
( Var = Var0 ->
|
|
Else = true_expr - Context
|
|
;
|
|
Unify = unify_expr(variable(Var, Context), variable(Var0, Context),
|
|
purity_pure),
|
|
Else = Unify - Context
|
|
),
|
|
Goal = if_then_else_expr(Vars, StateVars, Cond, Then, Else) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
CondErrors = get_any_errors3(MaybeVarsCond),
|
|
ThenErrors = get_any_errors1(MaybeThen),
|
|
MaybeGoal = error1(CondErrors ++ ThenErrors)
|
|
).
|
|
parse_dcg_goal_2(",", [ATerm, BTerm], Context, MaybeGoal, !VarSet, !Counter,
|
|
!Var) :-
|
|
% Conjunction.
|
|
parse_dcg_goal(ATerm, MaybeAGoal, !VarSet, !Counter, !Var),
|
|
parse_dcg_goal(BTerm, MaybeBGoal, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeAGoal = ok1(AGoal),
|
|
MaybeBGoal = ok1(BGoal)
|
|
->
|
|
Goal = conj_expr(AGoal, BGoal) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
AErrors = get_any_errors1(MaybeAGoal),
|
|
BErrors = get_any_errors1(MaybeBGoal),
|
|
MaybeGoal = error1(AErrors ++ BErrors)
|
|
).
|
|
parse_dcg_goal_2("&", [ATerm, BTerm], Context, MaybeGoal, !VarSet, !Counter,
|
|
!Var) :-
|
|
parse_dcg_goal(ATerm, MaybeAGoal, !VarSet, !Counter, !Var),
|
|
parse_dcg_goal(BTerm, MaybeBGoal, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeAGoal = ok1(AGoal),
|
|
MaybeBGoal = ok1(BGoal)
|
|
->
|
|
Goal = par_conj_expr(AGoal, BGoal) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
AErrors = get_any_errors1(MaybeAGoal),
|
|
BErrors = get_any_errors1(MaybeBGoal),
|
|
MaybeGoal = error1(AErrors ++ BErrors)
|
|
).
|
|
parse_dcg_goal_2(";", [ATerm, BTerm], Context, MaybeGoal, !VarSet, !Counter,
|
|
Var0, Var) :-
|
|
% Disjunction or if-then-else (Prolog syntax).
|
|
( ATerm = term.functor(term.atom("->"), [CondTerm, ThenTerm], _Context) ->
|
|
parse_dcg_if_then_else(CondTerm, ThenTerm, BTerm, Context, MaybeGoal,
|
|
!VarSet, !Counter, Var0, Var)
|
|
;
|
|
parse_dcg_goal(ATerm, MaybeAGoal0, !VarSet, !Counter, Var0, VarA),
|
|
parse_dcg_goal(BTerm, MaybeBGoal0, !VarSet, !Counter, Var0, VarB),
|
|
(
|
|
MaybeAGoal0 = ok1(AGoal0),
|
|
MaybeBGoal0 = ok1(BGoal0)
|
|
->
|
|
( VarA = Var0, VarB = Var0 ->
|
|
Var = Var0,
|
|
Goal = disj_expr(AGoal0, BGoal0) - Context
|
|
; VarA = Var0 ->
|
|
Var = VarB,
|
|
Unify = unify_expr(
|
|
term.variable(Var, Context), term.variable(VarA, Context),
|
|
purity_pure),
|
|
append_to_disjunct(AGoal0, Unify, Context, AGoal),
|
|
Goal = disj_expr(AGoal, BGoal0) - Context
|
|
; VarB = Var0 ->
|
|
Var = VarA,
|
|
Unify = unify_expr(
|
|
term.variable(Var, Context), term.variable(VarB, Context),
|
|
purity_pure),
|
|
append_to_disjunct(BGoal0, Unify, Context, BGoal),
|
|
Goal = disj_expr(AGoal0, BGoal) - Context
|
|
;
|
|
Var = VarB,
|
|
prog_util.rename_in_goal(VarA, VarB, AGoal0, AGoal),
|
|
Goal = disj_expr(AGoal, BGoal0) - Context
|
|
),
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
Var = VarA, % Dummy; the value shouldn't matter.
|
|
AErrors = get_any_errors1(MaybeAGoal0),
|
|
BErrors = get_any_errors1(MaybeBGoal0),
|
|
MaybeGoal = error1(AErrors ++ BErrors)
|
|
)
|
|
).
|
|
parse_dcg_goal_2("else", [IfTerm, ElseTerm], _, MaybeGoal, !VarSet, !Counter,
|
|
!Var) :-
|
|
% If-then-else (NU-Prolog syntax).
|
|
IfTerm = term.functor(term.atom("if"),
|
|
[term.functor(term.atom("then"), [CondTerm, ThenTerm], _)], Context),
|
|
parse_dcg_if_then_else(CondTerm, ThenTerm, ElseTerm, Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var).
|
|
parse_dcg_goal_2("not", [ATerm], Context, MaybeGoal, !VarSet, !Counter,
|
|
Var0, Var0) :-
|
|
% Negation (NU-Prolog syntax).
|
|
parse_dcg_goal(ATerm, MaybeAGoal, !VarSet, !Counter, Var0, _),
|
|
(
|
|
MaybeAGoal = ok1(AGoal),
|
|
Goal = not_expr(AGoal) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeAGoal = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("\\+", [ATerm], Context, MaybeGoal, !VarSet, !Counter,
|
|
Var0, Var0) :-
|
|
% Negation (Prolog syntax).
|
|
parse_dcg_goal(ATerm, MaybeAGoal, !VarSet, !Counter, Var0, _),
|
|
(
|
|
MaybeAGoal = ok1(AGoal),
|
|
Goal = not_expr(AGoal) - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeAGoal = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
parse_dcg_goal_2("all", [QVarsTerm, SubTerm], Context, MaybeGoal, !VarSet,
|
|
!Counter, !Var) :-
|
|
% Universal quantification.
|
|
% Extract any state variables in the quantifier.
|
|
parse_quantifier_vars(QVarsTerm, MaybeStateVarsAndVars),
|
|
parse_dcg_goal(SubTerm, MaybeSubGoal, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeStateVarsAndVars = ok2(Vars0, StateVars0),
|
|
MaybeSubGoal = ok1(SubGoal)
|
|
->
|
|
list.map(term.coerce_var, StateVars0, StateVars),
|
|
list.map(term.coerce_var, Vars0, Vars),
|
|
SubGoal = SubGoalExpr - SubContext,
|
|
(
|
|
Vars = [],
|
|
StateVars = [],
|
|
GoalExpr = SubGoalExpr
|
|
;
|
|
Vars = [],
|
|
StateVars = [_ | _],
|
|
GoalExpr = all_state_vars_expr(StateVars, SubGoal)
|
|
;
|
|
Vars = [_ | _],
|
|
StateVars = [],
|
|
GoalExpr = all_expr(Vars, SubGoal)
|
|
;
|
|
Vars = [_ | _],
|
|
StateVars = [_ | _],
|
|
GoalExpr = all_expr(Vars, all_state_vars_expr(StateVars, SubGoal)
|
|
- SubContext)
|
|
),
|
|
Goal = GoalExpr - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
VarsErrors = get_any_errors2(MaybeStateVarsAndVars),
|
|
SubGoalErrors = get_any_errors1(MaybeSubGoal),
|
|
MaybeGoal = error1(VarsErrors ++ SubGoalErrors)
|
|
).
|
|
parse_dcg_goal_2("some", [QVarsTerm, SubTerm], Context, MaybeGoal,
|
|
!VarSet, !Counter, !Var) :-
|
|
% Existential quantification.
|
|
% Extract any state variables in the quantifier.
|
|
parse_quantifier_vars(QVarsTerm, MaybeStateVarsAndVars),
|
|
parse_dcg_goal(SubTerm, MaybeSubGoal, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeStateVarsAndVars = ok2(Vars0, StateVars0),
|
|
MaybeSubGoal = ok1(SubGoal)
|
|
->
|
|
list.map(term.coerce_var, StateVars0, StateVars),
|
|
list.map(term.coerce_var, Vars0, Vars),
|
|
SubGoal = SubGoalExpr - SubContext,
|
|
(
|
|
Vars = [],
|
|
StateVars = [],
|
|
SubGoalExpr = GoalExpr
|
|
;
|
|
Vars = [],
|
|
StateVars = [_ | _],
|
|
GoalExpr = some_state_vars_expr(StateVars, SubGoal)
|
|
;
|
|
Vars = [_ | _],
|
|
StateVars = [],
|
|
GoalExpr = some_expr(Vars, SubGoal)
|
|
;
|
|
Vars = [_ | _],
|
|
StateVars = [_ | _],
|
|
GoalExpr = some_expr(Vars, some_state_vars_expr(StateVars, SubGoal)
|
|
- SubContext)
|
|
),
|
|
Goal = GoalExpr - Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
VarsErrors = get_any_errors2(MaybeStateVarsAndVars),
|
|
SubGoalErrors = get_any_errors1(MaybeSubGoal),
|
|
MaybeGoal = error1(VarsErrors ++ SubGoalErrors)
|
|
).
|
|
|
|
:- pred parse_dcg_goal_with_purity(term::in, purity::in, maybe1(goal)::out,
|
|
prog_varset::in, prog_varset::out, counter::in, counter::out,
|
|
prog_var::in, prog_var::out) is det.
|
|
|
|
parse_dcg_goal_with_purity(G, Purity, MaybeGoal, !VarSet, !Counter, !Var) :-
|
|
parse_dcg_goal(G, MaybeGoal1, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeGoal1 = ok1(Goal1),
|
|
( Goal1 = call_expr(Pred, Args, purity_pure) - Context ->
|
|
Goal = call_expr(Pred, Args, Purity) - Context
|
|
; Goal1 = unify_expr(ProgTerm1, ProgTerm2, purity_pure) - Context ->
|
|
Goal = unify_expr(ProgTerm1, ProgTerm2, Purity) - Context
|
|
;
|
|
% Inappropriate placement of an impurity marker, so we treat
|
|
% it like a predicate call. typecheck.m prints out something
|
|
% descriptive for these errors.
|
|
Goal1 = _ - Context,
|
|
purity_name(Purity, PurityString),
|
|
term.coerce(G, G1),
|
|
Goal = call_expr(unqualified(PurityString), [G1], purity_pure)
|
|
- Context
|
|
),
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
MaybeGoal1 = error1(Errors),
|
|
MaybeGoal = error1(Errors)
|
|
).
|
|
|
|
:- pred append_to_disjunct(goal::in, goal_expr::in, prog_context::in,
|
|
goal::out) is det.
|
|
|
|
append_to_disjunct(Disjunct0, Goal, Context, Disjunct) :-
|
|
( Disjunct0 = disj_expr(A0, B0) - Context2 ->
|
|
append_to_disjunct(A0, Goal, Context, A),
|
|
append_to_disjunct(B0, Goal, Context, B),
|
|
Disjunct = disj_expr(A, B) - Context2
|
|
;
|
|
Disjunct = conj_expr(Disjunct0, Goal - Context) - Context
|
|
).
|
|
|
|
:- pred parse_some_vars_dcg_goal(term::in,
|
|
maybe3(list(prog_var), list(prog_var), goal)::out,
|
|
prog_varset::in, prog_varset::out, counter::in, counter::out,
|
|
prog_var::in, prog_var::out) is det.
|
|
|
|
parse_some_vars_dcg_goal(Term, MaybeVarsGoal, !VarSet, !Counter, !Var) :-
|
|
( Term = term.functor(term.atom("some"), [VarsTerm, SubTerm], _Context) ->
|
|
parse_quantifier_vars(VarsTerm, MaybeVars),
|
|
GoalTerm = SubTerm
|
|
;
|
|
MaybeVars = ok2([], []),
|
|
GoalTerm = Term
|
|
),
|
|
parse_dcg_goal(GoalTerm, MaybeGoal, !VarSet, !Counter, !Var),
|
|
(
|
|
MaybeVars = ok2(Vars0, StateVars0),
|
|
MaybeGoal = ok1(Goal)
|
|
->
|
|
list.map(term.coerce_var, Vars0, Vars),
|
|
list.map(term.coerce_var, StateVars0, StateVars),
|
|
MaybeVarsGoal = ok3(Vars, StateVars, Goal)
|
|
;
|
|
VarsErrors = get_any_errors2(MaybeVars),
|
|
GoalErrors = get_any_errors1(MaybeGoal),
|
|
MaybeVarsGoal = error3(VarsErrors ++ GoalErrors)
|
|
).
|
|
|
|
% Parse the "if" and the "then" part of an if-then or an if-then-else.
|
|
% If the condition is a DCG goal, but then "then" part is not,
|
|
% then we need to translate
|
|
% ( a -> { b } ; c )
|
|
% as
|
|
% ( a(DCG_1, DCG_2) ->
|
|
% b,
|
|
% DCG_3 = DCG_2
|
|
% ;
|
|
% c(DCG_1, DCG_3)
|
|
% )
|
|
% rather than
|
|
% ( a(DCG_1, DCG_2) ->
|
|
% b
|
|
% ;
|
|
% c(DCG_1, DCG_2)
|
|
% )
|
|
% so that the implicit quantification of DCG_2 is correct.
|
|
%
|
|
:- pred parse_dcg_if_then(term::in, term::in, prog_context::in,
|
|
maybe3(list(prog_var), list(prog_var), goal)::out,
|
|
maybe1(goal)::out, prog_varset::in, prog_varset::out,
|
|
counter::in, counter::out, prog_var::in, prog_var::out) is det.
|
|
|
|
parse_dcg_if_then(CondTerm, ThenTerm, Context, MaybeVarsCond, MaybeThen,
|
|
!VarSet, !Counter, Var0, Var) :-
|
|
parse_some_vars_dcg_goal(CondTerm, MaybeVarsCond, !VarSet, !Counter,
|
|
Var0, Var1),
|
|
parse_dcg_goal(ThenTerm, MaybeThen1, !VarSet, !Counter, Var1, Var2),
|
|
(
|
|
Var0 \= Var1,
|
|
Var1 = Var2
|
|
->
|
|
(
|
|
MaybeThen1 = ok1(Then1),
|
|
new_dcg_var(!VarSet, !Counter, Var),
|
|
Unify = unify_expr(
|
|
term.variable(Var, Context), term.variable(Var2, Context),
|
|
purity_pure),
|
|
Then = conj_expr(Then1, Unify - Context) - Context,
|
|
MaybeThen = ok1(Then)
|
|
;
|
|
MaybeThen1 = error1(_),
|
|
MaybeThen = MaybeThen1,
|
|
Var = Var2 % Dummy; the value shouldn't matter.
|
|
)
|
|
;
|
|
MaybeThen = MaybeThen1,
|
|
Var = Var2
|
|
).
|
|
|
|
:- pred parse_dcg_if_then_else(term::in, term::in, term::in, prog_context::in,
|
|
maybe1(goal)::out, prog_varset::in, prog_varset::out,
|
|
counter::in, counter::out, prog_var::in, prog_var::out) is det.
|
|
|
|
parse_dcg_if_then_else(CondTerm, ThenTerm, ElseTerm, Context, MaybeGoal,
|
|
!VarSet, !Counter, Var0, Var) :-
|
|
parse_dcg_if_then(CondTerm, ThenTerm, Context, MaybeVarsCond, MaybeThen1,
|
|
!VarSet, !Counter, Var0, VarThen),
|
|
parse_dcg_goal(ElseTerm, MaybeElse1, !VarSet, !Counter, Var0, VarElse),
|
|
(
|
|
MaybeVarsCond = ok3(Vars, StateVars, Cond),
|
|
MaybeThen1 = ok1(Then1),
|
|
MaybeElse1 = ok1(Else1)
|
|
->
|
|
( VarThen = Var0, VarElse = Var0 ->
|
|
Var = Var0,
|
|
Then = Then1,
|
|
Else = Else1
|
|
; VarThen = Var0 ->
|
|
Var = VarElse,
|
|
Unify = unify_expr(
|
|
term.variable(Var, Context), term.variable(VarThen, Context),
|
|
purity_pure),
|
|
Then = conj_expr(Then1, Unify - Context) - Context,
|
|
Else = Else1
|
|
; VarElse = Var0 ->
|
|
Var = VarThen,
|
|
Then = Then1,
|
|
Unify = unify_expr(
|
|
term.variable(Var, Context), term.variable(VarElse, Context),
|
|
purity_pure),
|
|
Else = conj_expr(Else1, Unify - Context) - Context
|
|
;
|
|
% We prefer to substitute the then part since it is likely to be
|
|
% smaller than the else part, since the else part may have a deeply
|
|
% nested chain of if-then-elses.
|
|
|
|
% parse_dcg_if_then guarantees that if VarThen \= Var0, then the
|
|
% then part introduces a new DCG variable (i.e. VarThen does not
|
|
% appear in the condition). We therefore don't need to do the
|
|
% substitution in the condition.
|
|
|
|
Var = VarElse,
|
|
prog_util.rename_in_goal(VarThen, VarElse, Then1, Then),
|
|
Else = Else1
|
|
),
|
|
Goal = if_then_else_expr(Vars, StateVars, Cond, Then, Else)
|
|
- Context,
|
|
MaybeGoal = ok1(Goal)
|
|
;
|
|
CondErrors = get_any_errors3(MaybeVarsCond),
|
|
ThenErrors = get_any_errors1(MaybeThen1),
|
|
ElseErrors = get_any_errors1(MaybeElse1),
|
|
MaybeGoal = error1(CondErrors ++ ThenErrors ++ ElseErrors),
|
|
Var = Var0 % Dummy; the value shouldn't matter.
|
|
).
|
|
|
|
% term_list_append_term(ListTerm, Term, Result):
|
|
%
|
|
% If ListTerm is a term representing a proper list, this predicate
|
|
% will append the term Term onto the end of the list.
|
|
%
|
|
:- pred term_list_append_term(term(T)::in, term(T)::in, term(T)::out)
|
|
is semidet.
|
|
|
|
term_list_append_term(List0, Term, List) :-
|
|
( List0 = term.functor(term.atom("[]"), [], _Context) ->
|
|
List = Term
|
|
;
|
|
List0 = term.functor(term.atom("[|]"), [Head, Tail0], Context2),
|
|
List = term.functor(term.atom("[|]"), [Head, Tail], Context2),
|
|
term_list_append_term(Tail0, Term, Tail)
|
|
).
|
|
|
|
:- pred process_dcg_clause(maybe_functor::in, prog_varset::in, prog_var::in,
|
|
prog_var::in, goal::in, prog_context::in, maybe1(item)::out) is det.
|
|
|
|
process_dcg_clause(ok2(Name, Args0), VarSet, Var0, Var, Body, Context,
|
|
ok1(item_clause(user, VarSet, pf_predicate, Name, Args, Body))) :-
|
|
list.map(term.coerce, Args0, Args1),
|
|
Args = Args1 ++ [variable(Var0, Context), variable(Var, Context)].
|
|
process_dcg_clause(error2(Errors), _, _, _, _, _, error1(Errors)).
|