%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2012 The University of Melbourne.
% Copyright (C) 2014-2019, 2022-2024 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%

:- module check_hlds.clause_to_proc.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.

:- import_module list.

%-----------------------------------------------------------------------------%

    % In the hlds, we initially record the clauses for a predicate in the
    % clauses_info data structure, which is part of the pred_info data
    % structure. But once the clauses have been type-checked, we want to have
    % a separate copy of each clause for each different mode of the predicate,
    % since we may end up reordering the clauses differently in different
    % modes. Here we copy the clauses from the clause_info data structure
    % into the proc_info data structure. Each clause is marked with a list
    % of the modes for which it applies, so that there can be different code
    % to implement different modes of a predicate (e.g. sort). For each mode
    % of the predicate, we select the clauses for that mode, disjoin them
    % together, and save this in the proc_info.
    %
:- pred copy_clauses_to_proc_for_all_valid_procs(
    module_info::in, module_info::out) is det.
:- pred copy_clauses_to_procs_for_pred_in_module_info(pred_id::in,
    module_info::in, module_info::out) is det.
:- pred copy_clauses_to_nonmethod_procs_for_preds_in_module_info(
    list(pred_id)::in, module_info::in, module_info::out) is det.

:- pred copy_clauses_to_proc_in_proc_info(pred_info::in, proc_id::in,
    proc_info::in, proc_info::out) is det.

:- pred should_copy_clauses_to_procs(pred_info::in) is semidet.

%-----------------------------------------------------------------------------%

:- implementation.

:- import_module hlds.hlds_args.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.pred_name.
:- import_module hlds.pred_table.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.

:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module term.

%-----------------------------------------------------------------------------%

copy_clauses_to_proc_for_all_valid_procs(!ModuleInfo) :-
    module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
    map.map_values(copy_clauses_to_procs_in_pred_info,
        PredIdTable0, PredIdTable),
    module_info_set_pred_id_table(PredIdTable, !ModuleInfo).

copy_clauses_to_procs_for_pred_in_module_info(PredId, !ModuleInfo) :-
    module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
    map.lookup(PredIdTable0, PredId, PredInfo0),
    copy_clauses_to_procs_in_pred_info(PredId, PredInfo0, PredInfo),
    map.det_update(PredId, PredInfo, PredIdTable0, PredIdTable),
    module_info_set_pred_id_table(PredIdTable, !ModuleInfo).

:- pred copy_clauses_to_procs_in_pred_info(pred_id::in,
    pred_info::in, pred_info::out) is det.

copy_clauses_to_procs_in_pred_info(PredId, !PredInfo) :-
    pred_info_get_clauses_info(!.PredInfo, ClausesInfo),
    pred_info_get_proc_table(!.PredInfo, ProcMap0),
    map.map_values(
        copy_clauses_to_maybe_imported_proc_in_proc_info(!.PredInfo,
            ClausesInfo, PredId),
        ProcMap0, ProcMap),
    pred_info_set_proc_table(ProcMap, !PredInfo).

:- pred copy_clauses_to_maybe_imported_proc_in_proc_info(pred_info::in,
    clauses_info::in, pred_id::in, proc_id::in,
    proc_info::in, proc_info::out) is det.

copy_clauses_to_maybe_imported_proc_in_proc_info(PredInfo, ClausesInfo,
        _PredId, ProcId, !ProcInfo) :-
    ( if
        (
            pred_info_is_imported(PredInfo)
        ;
            pred_info_is_pseudo_imported(PredInfo),
            hlds_pred.in_in_unification_proc_id(ProcId)
        )
    then
        % We need to set these fields in the proc_info here, because
        % some parts of the compiler (e.g. unused_args.m) depend on
        % these fields being valid even for imported procedures.

        % XXX ARGVEC - when the proc_info uses the proc_arg_vector,
        % just pass the headvar vector directly to the proc_info.
        clauses_info_get_headvars(ClausesInfo, HeadVars),
        HeadVarList = proc_arg_vector_to_list(HeadVars),
        clauses_info_get_var_table(ClausesInfo, VarTable),
        clauses_info_get_rtti_varmaps(ClausesInfo, RttiVarMaps),
        proc_info_set_headvars(HeadVarList, !ProcInfo),
        proc_info_set_var_table(VarTable, !ProcInfo),
        proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo)
    else
        copy_clauses_to_proc_in_proc_info(PredInfo, ProcId, !ProcInfo)
    ).

%-----------------------------------------------------------------------------%

copy_clauses_to_nonmethod_procs_for_preds_in_module_info(PredIds,
        !ModuleInfo) :-
    module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
    list.foldl(copy_pred_clauses_to_nonmethod_procs_in_pred_id_table, PredIds,
        PredIdTable0, PredIdTable),
    module_info_set_pred_id_table(PredIdTable, !ModuleInfo).

    % For each mode of the given predicate, copy the clauses relevant
    % to the mode and the current backend to the proc_info.
    %
:- pred copy_pred_clauses_to_nonmethod_procs_in_pred_id_table(pred_id::in,
    pred_id_table::in, pred_id_table::out) is det.

copy_pred_clauses_to_nonmethod_procs_in_pred_id_table(PredId, !PredIdTable) :-
    map.lookup(!.PredIdTable, PredId, PredInfo0),
    ( if should_copy_clauses_to_procs(PredInfo0) then
        copy_clauses_to_procs_in_pred_info(PredId, PredInfo0, PredInfo),
        map.det_update(PredId, PredInfo, !PredIdTable)
    else
        true
    ).

%-----------------------------------------------------------------------------%

copy_clauses_to_proc_in_proc_info(PredInfo, ProcId, !ProcInfo) :-
    pred_info_get_clauses_info(PredInfo, ClausesInfo),
    ClausesInfo = clauses_info(_, _, VarTable0, RttiVarMaps, _, HeadVars,
        ClausesRep0, _ItemNumbers, _HaveForeignClauses, _HadSyntaxError),
    % The "replacement" is the replacement of the pred_info's clauses_rep
    % with the goal in the proc_info; the clauses_rep won't be needed again.
    get_clause_list_for_replacement(ClausesRep0, Clauses),
    select_matching_clauses(PredInfo, ProcId, Clauses, MatchingClauses),
    get_clause_disjuncts_and_warnings(MatchingClauses, ClausesDisjuncts,
        StateVarWarnings),
    (
        StateVarWarnings = [_ | _],
        proc_info_set_statevar_warnings(StateVarWarnings, !ProcInfo)
    ;
        StateVarWarnings = []
        % Do not allocate a new proc_info if we do not need to.
    ),
    (
        ClausesDisjuncts = [SingleGoal],
        SingleGoal = hlds_goal(SingleExpr, _),
        (
            SingleExpr = call_foreign_proc(_, _, _, Args, ExtraArgs,
                MaybeTraceRuntimeCond, _),
            % Use the original variable names for the headvars of foreign_proc
            % clauses, not the introduced `HeadVar__n' names.
            list.foldl(set_arg_names, Args, VarTable0, VarTable),
            expect(unify(ExtraArgs, []), $pred, "extra_args"),
            expect(unify(MaybeTraceRuntimeCond, no), $pred,
                "trace runtime cond")
        ;
            ( SingleExpr = plain_call(_, _, _, _, _, _)
            ; SingleExpr = generic_call(_, _, _, _, _)
            ; SingleExpr = unify(_, _, _, _, _)
            ; SingleExpr = conj(_, _)
            ; SingleExpr = disj(_)
            ; SingleExpr = switch(_, _, _)
            ; SingleExpr = if_then_else(_,_,  _, _)
            ; SingleExpr = negation(_)
            ; SingleExpr = scope(_, _)
            ; SingleExpr = shorthand(_)
            ),
            VarTable = VarTable0
        ),
        Goal = SingleGoal
    ;
        % We use the context of the first clause, unless there were
        % no clauses at all, in which case we use the context of the
        % mode declaration.
        (
            ClausesDisjuncts = [FirstGoal, _ | _],
            FirstGoal = hlds_goal(_, FirstGoalInfo),
            Context = goal_info_get_context(FirstGoalInfo)
        ;
            ClausesDisjuncts = [],
            proc_info_get_context(!.ProcInfo, Context)
        ),

        VarTable = VarTable0,

        % Convert the list of clauses into a disjunction,
        % and construct a goal_info for the disjunction.

        % The nonlocal vars are just the head variables.
        NonLocalVars =
            set_of_var.list_to_set(proc_arg_vector_to_list(HeadVars)),

        % The disjunction is impure/semipure if any of the disjuncts
        % is impure/semipure.
        accumulate_disjunction_purity(ClausesDisjuncts,
            purity_pure, DisjunctionPurity),

        % The InstMapDelta and Detism are just placeholders; they will be
        % overridden by the actual computed values later.
        instmap_delta_init_unreachable(InstMapDelta),
        Detism = detism_erroneous,

        goal_info_init(NonLocalVars, InstMapDelta, Detism,
            DisjunctionPurity, Context, GoalInfo),
        Goal = hlds_goal(disj(ClausesDisjuncts), GoalInfo)
    ),
    % XXX ARGVEC - when the proc_info is converted to use proc_arg_vectors
    % we should just pass the headvar vector in directly.
    HeadVarList = proc_arg_vector_to_list(HeadVars),
    proc_info_set_body(VarTable, HeadVarList, Goal, RttiVarMaps, !ProcInfo).

%-----------------------------------------------------------------------------%

:- pred select_matching_clauses(pred_info::in, proc_id::in,
    list(clause)::in, list(clause)::out) is det.

select_matching_clauses(PredInfo, ProcId, Clauses, MatchingClauses) :-
    pred_info_get_origin(PredInfo, Origin),
    % To allow us to process even *very* long lists of clauses without
    % running out of stack, we have to keep select_matching_clauses_loop
    % tail recursive. We do this by making it add each matching clause
    % it processes to the *front* of the list of so-far-detected-to-be-matching
    % clauses, which computes the list of matching clauses in reverse.
    RevMatchingClauses0 = [],
    ( if
        Origin = origin_compiler(made_for_uci(spec_pred_unify, _TypeCtor))
    then
        ( if hlds_pred.in_in_unification_proc_id(ProcId) then
            MaybeInInMode = in_in_mode
        else
            MaybeInInMode = not_in_in_mode
        ),
        select_matching_unify_clauses_acc(MaybeInInMode, ProcId, Clauses,
            RevMatchingClauses0, RevMatchingClauses)
    else
        select_matching_nonunify_clauses_acc(ProcId, Clauses,
            RevMatchingClauses0, RevMatchingClauses)
    ),
    list.reverse(RevMatchingClauses, MatchingClauses).

:- type maybe_in_in_mode
    --->    not_in_in_mode
    ;       in_in_mode.

:- pred select_matching_unify_clauses_acc(maybe_in_in_mode::in, proc_id::in,
    list(clause)::in, list(clause)::in, list(clause)::out) is det.

select_matching_unify_clauses_acc(_, _, [], !RevMatchingClauses).
select_matching_unify_clauses_acc(MaybeInInMode, ProcId, [Clause | Clauses],
        !RevMatchingClauses) :-
    ApplicableProcIds = Clause ^ clause_applicable_procs,
    (
        ApplicableProcIds = all_modes,
        % A clause in a unification predicate may have all_modes as its
        % ApplicableProcIds.
        !:RevMatchingClauses = [Clause | !.RevMatchingClauses]
    ;
        ApplicableProcIds = selected_modes(_),
        unexpected($pred, "non unify mode")
    ;
        ApplicableProcIds = unify_in_in_modes,
        (
            MaybeInInMode = not_in_in_mode
        ;
            MaybeInInMode = in_in_mode,
            !:RevMatchingClauses = [Clause | !.RevMatchingClauses]
        )
    ;
        ApplicableProcIds = unify_non_in_in_modes,
        (
            MaybeInInMode = not_in_in_mode,
            !:RevMatchingClauses = [Clause | !.RevMatchingClauses]
        ;
            MaybeInInMode = in_in_mode
        )
    ),
    select_matching_unify_clauses_acc(MaybeInInMode, ProcId, Clauses,
        !RevMatchingClauses).

:- pred select_matching_nonunify_clauses_acc(proc_id::in, list(clause)::in,
    list(clause)::in, list(clause)::out) is det.

select_matching_nonunify_clauses_acc(_, [], !RevMatchingClauses).
select_matching_nonunify_clauses_acc(ProcId, [Clause | Clauses],
        !RevMatchingClauses) :-
    ApplicableProcIds = Clause ^ clause_applicable_procs,
    (
        ApplicableProcIds = all_modes,
        !:RevMatchingClauses = [Clause | !.RevMatchingClauses]
    ;
        ApplicableProcIds = selected_modes(ProcIds),
        ( if list.member(ProcId, ProcIds) then
            !:RevMatchingClauses = [Clause | !.RevMatchingClauses]
        else
            true
        )
    ;
        ( ApplicableProcIds = unify_in_in_modes
        ; ApplicableProcIds = unify_non_in_in_modes
        ),
        unexpected($pred, "unify mode")
    ),
    select_matching_nonunify_clauses_acc(ProcId, Clauses, !RevMatchingClauses).

%-----------------------------------------------------------------------------%

:- pred get_clause_disjuncts_and_warnings(list(clause)::in,
    list(hlds_goal)::out, list(error_spec)::out) is det.

get_clause_disjuncts_and_warnings([], [], []).
get_clause_disjuncts_and_warnings([Clause | Clauses], Disjuncts, Warnings) :-
    Goal = Clause ^ clause_body,
    goal_to_disj_list(Goal, FirstDisjuncts),
    FirstWarnings = Clause ^ clause_statevar_warnings,
    get_clause_disjuncts_and_warnings(Clauses, LaterDisjuncts, LaterWarnings),
    Disjuncts = FirstDisjuncts ++ LaterDisjuncts,
    Warnings = FirstWarnings ++ LaterWarnings.

%-----------------------------------------------------------------------------%

:- pred set_arg_names(foreign_arg::in, var_table::in, var_table::out)
    is det.

set_arg_names(Arg, !VarTable) :-
    Var = foreign_arg_var(Arg),
    MaybeNameMode = foreign_arg_maybe_name_mode(Arg),
    (
        MaybeNameMode = yes(foreign_arg_name_mode(Name, _)),
        update_var_name(Var, Name, !VarTable)
    ;
        MaybeNameMode = no
    ).

%-----------------------------------------------------------------------------%

:- pred accumulate_disjunction_purity(list(hlds_goal)::in,
    purity::in, purity::out) is det.

accumulate_disjunction_purity([], !Purity).
accumulate_disjunction_purity([Disjunct | Disjuncts], !Purity) :-
    DisjunctPurity = goal_get_purity(Disjunct),
    !:Purity = worst_purity(!.Purity, DisjunctPurity),
    accumulate_disjunction_purity(Disjuncts, !Purity).

%-----------------------------------------------------------------------------%

should_copy_clauses_to_procs(PredInfo) :-
    % Don't process typeclass methods, because their proc_infos
    % are generated already mode-correct.
    pred_info_get_markers(PredInfo, PredMarkers),
    not check_marker(PredMarkers, marker_class_method).

%-----------------------------------------------------------------------------%
:- end_module check_hlds.clause_to_proc.
%-----------------------------------------------------------------------------%
