[m-rev.] for review: fix mantis bug #559, step 2

[Julien Fischer]

On Fri, 6 May 2022, Zoltan Somogyi wrote:

> Parse disjunctions using tail recursive code ...
> 
> to allow even very long disjunctions to be parsed in constant stack space.
> This fixes Mantis bug #559.
> 
> compiler/prog_item.m:
>     We used to represent a disjunction like ( GoalA ; GoalB ; GoalC ; GoalD )
>     in the parse tree as
>
>         disj_expr(ContextA, GoalA,
>             disj_expr(ContextB, GoalB,
>                 disj_expr(ContextC, GoalC,
>                     GoalD)))
>
>     To enable the changes in parse_goal.m and parse_dcg_goal.m, switch over
>     to representing them as
>
>         disj_expr(ContextA, GoalA, GoalB, [GoalC, GoalD])
>
>     The type of this term enforces the invariant that a disjunction
>     must have at least two disjuncts.
>
>     The fact that this throws away ContextB and ContextC is not a problem;
>     they were never used, being thrown away when converting the parse tree
>     to the HLDS.

...

> diff --git a/compiler/parse_dcg_goal.m b/compiler/parse_dcg_goal.m
> index 9d13c5d33..e12f2ad14 100644
> --- a/compiler/parse_dcg_goal.m
> +++ b/compiler/parse_dcg_goal.m

> @@ -552,6 +549,132 @@ parse_dcg_goal_semicolon(ArgTerms, Context, ContextPieces,

...

> +    % maybe_record_non_initial_dcg_var(DCGVar0, DCGVarEndBranch,
> +    %   !MaybeFirstDiffDCGVar):
> +    %
> +    % If the current branch updated the dcg variable from DCGVar0 to
> +    % DCGVarEndBranch, *and* if it is the first branch to have done som

s/som/so/

> +    % then record DCGVarEndBranch as !:MaybeFirstDiffDCGVar.
> +    %
> +:- pred maybe_record_non_initial_dcg_var(prog_var::in, prog_var::in,
> +    maybe(prog_var)::in, maybe(prog_var)::out) is det.
> +
> +maybe_record_non_initial_dcg_var(DCGVar0, DCGVarEndBranch,
> +        !MaybeFirstDiffDCGVar) :-
> +    ( if DCGVar0 = DCGVarEndBranch then
> +        true
> +    else
> +        (
> +            !.MaybeFirstDiffDCGVar = yes(_)
> +        ;
> +            !.MaybeFirstDiffDCGVar = no,
> +            !:MaybeFirstDiffDCGVar = yes(DCGVarEndBranch)
> +        )
> +    ).
> +
> +:- pred append_disjunct_dcg_var_to_cord(prog_var::in, goal::in,
> +    cord(pair(goal, prog_var))::in, cord(pair(goal, prog_var))::out) is det.
> +
> +append_disjunct_dcg_var_to_cord(DCGVar, Goal, !DisjunctsDCGVarsCord) :-
> +    % We flatten disjunctions, for reasons explained in the comment
> +    % at the top of tests/hard_coded/flatten_disjunctions.m.
> +    ( if Goal = disj_expr(_Ctxt, Disjunct1, Disjunct2, Disjuncts3plus) then
> +        append_disjunct_dcg_var_to_cord(DCGVar, Disjunct1,
> +            !DisjunctsDCGVarsCord),
> +        append_disjunct_dcg_var_to_cord(DCGVar, Disjunct2,
> +            !DisjunctsDCGVarsCord),
> +        list.foldl(append_disjunct_dcg_var_to_cord(DCGVar), Disjuncts3plus,
> +            !DisjunctsDCGVarsCord)
> +    else
> +        cord.snoc(Goal - DCGVar, !DisjunctsDCGVarsCord)
> +    ).
> +
> +    % Given a disjunction in which the initial and final values of the
> +    % DCG variable ate InitDCGVar and FinalDCGVar respectively,

s/ate/are/

> +    % ensure that all disjuncts end up with FinalDCGVar, whatever
> +    % the updates (if any) were within each disjunct.
> +    %
> +:- pred bring_disjuncts_up_to(prog_var::in, prog_var::in, prog_context::in,
> +    assoc_list(goal, prog_var)::in, list(goal)::in, list(goal)::out) is det.
> +
> +bring_disjuncts_up_to(_InitDCGVar, _FinalDCGVar, _Context, [], !Disjuncts).
> +bring_disjuncts_up_to(InitDCGVar, FinalDCGVar, Context,
> +        [RevDisjunctDCGVar | RevDisjunctsDCGVars], !Disjuncts) :-
> +    bring_disjunct_up_to(InitDCGVar, FinalDCGVar, Context,
> +        RevDisjunctDCGVar, !Disjuncts),
> +    bring_disjuncts_up_to(InitDCGVar, FinalDCGVar, Context,
> +        RevDisjunctsDCGVars, !Disjuncts).

...

> diff --git a/tests/hard_coded/flatten_disjunctions.m b/tests/hard_coded/flatten_disjunctions.m
> index e69de29bb..f373ca002 100644
> --- a/tests/hard_coded/flatten_disjunctions.m
> +++ b/tests/hard_coded/flatten_disjunctions.m
> @@ -0,0 +1,131 @@
> +%---------------------------------------------------------------------------%
> +% vim: ft=mercury ts=4 sw=4 et
> +%---------------------------------------------------------------------------%
> +%
> +% This test case tests whether the parser flattens nested disjunctions,
> +% both in normal clauses (predicate p), and in DCG clauses (predicate dcg_p).
> +%
> +% The main bodies of those predicates are disjunctions that are effectively
> +% switches on the value of A. Switch detection looks for unifications
> +% that could allow it to turn a disjunction into a switch in disjuncts
> +% of that disjunction, and in disjuncts inside those disjuncts; it does NOT
> +% look for them in disjuncts inside disjuncts inside disjuncts. In other
> +% words, it looks at a unifications at a maximum depth of two levels.
> +%
> +% In the written form of these predicates, the unifications in the innermost
> +% disjunction "( A = 4 ; A = 5 )" are at a depth of three. Switch detection
> +% can nevertheless turn both predicate bodies into switches, because parsing
> +% has traditionally flattened disjunctions, which means that if a disjunct
> +% consists entirely of another disjunction, then it replaced that outer
> +% disjunct with the arms of the inner disjunction. In this case, this
> +% flattening brings the A = 4 and A = 5 unifications that used to be
> +% at depth three to depth two, where switch detection can see them.
> +%
> +% This test case tests that the parser (parse_goal.m and parse_dcg_goal.m)

s/parser/parsers/

The rest looks fine -- thanks for looking into this so promptly.

Julien.