%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2007, 2011 The University of Melbourne.
% Copyright (C) 2014-2015, 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: declarative_oracle.m
% Author: Mark Brown
%
% This module implements the oracle for a Mercury declarative debugger.
% It is called by the front end of the declarative debugger to provide
% information about the intended interpretation of the program being debugged.
%
% The module has a knowledge base as a sub-component. This is a cache for
% all the assumptions that the oracle is currently making. When the oracle
% is queried, it first checks the KB to see if an answer is available there.
%
% If no answer is available in the KB, then the oracle uses the UI (in
% browser/declarative_user.m) to get the required answer from the user.
% If any new knowledge is obtained, it is added to the KB so the user
% will not be asked the same question twice.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- module mdb.declarative_oracle.
:- interface.

:- import_module mdb.browser_info.
:- import_module mdb.declarative_debugger.
:- import_module mdb.declarative_user.
:- import_module mdb.help.
:- import_module mdbcomp.
:- import_module mdbcomp.rtti_access.
:- import_module mdbcomp.sym_name.

:- import_module bool.
:- import_module io.

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

    % A response that the oracle gives to a query about the truth
    % of an EDT node.
    %
:- type oracle_response(T)
    --->    oracle_response_answer(decl_answer(T))
    ;       oracle_response_show_info(io.output_stream)
    ;       oracle_response_change_search(user_search_mode)
    ;       oracle_response_undo

            % Ask the diagnoser to revert to the
            % last question it asked.

    ;       oracle_response_exit_diagnosis(T)
    ;       oracle_response_abort_diagnosis.

:- pred oracle_response_undoable(oracle_response(T)::in) is semidet.

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

    % The oracle state. This is threaded around the declarative debugger.
    %
:- type oracle_state.

    % Produce a new oracle state.
    %
:- pred oracle_state_init(io.input_stream::in, io.output_stream::in,
    browser_info.browser_persistent_state::in, help_system::in,
    oracle_state::out) is det.

    % Trust all the modules in the Mercury standard library.
    %
:- pred trust_standard_library(oracle_state::in, oracle_state::out) is det.

    % Add a module to the set of modules trusted by the oracle.
    %
:- pred add_trusted_module(module_name::in,
    oracle_state::in, oracle_state::out) is det.

    % Add a predicate/function to the set of predicates/functions trusted
    % by the oracle.
    %
:- pred add_trusted_pred_or_func(proc_layout::in,
    oracle_state::in, oracle_state::out) is det.

    % remove_trusted(Id, !Oracle):
    %
    % Removes the trusted object with the given Id from the set of trusted
    % objects.
    %
:- pred remove_trusted(int::in, oracle_state::in, oracle_state::out)
    is semidet.

    % get_trusted_list(Oracle, MDBCommandFormat, String):
    %
    % Return a string listing the trusted objects.
    %
    % If MDBCommandFormat is true, then return the list in the form of
    % a series of mdb `trust' commands, which can be executed.
    %
    % If MDBCommandFormat is false, then return the list in a format
    % that is suitable for display to the user.
    %
:- pred get_trusted_list(oracle_state::in, bool::in, string::out) is det.

    % query_oracle(Question, Response, AnswerFromUser, !Oracle, !IO):
    %
    % Query the oracle about the program being debugged. Question is a node
    % in the evaluation tree, Response is the oracle's response. The oracle
    % state is threaded through so its contents can be updated after user
    % responses. If the response came directly from the user, then
    % AnswerFromUser will be yes, otherwise it will be no.
    %
:- pred query_oracle(decl_question(T)::in, oracle_response(T)::out, bool::out,
    oracle_state::in, oracle_state::out, io::di, io::uo) is cc_multi.

    % True if the answer to the question is in the knowledge base, or
    % the predicate is trusted.
    %
:- pred answer_known(oracle_state::in, decl_question(T)::in,
    decl_answer(T)::out(known_answer)) is semidet.

    % Confirm that the node found is indeed an e_bug or an i_bug. If the bug
    % is overruled, force the oracle to forget everything it knows about
    % the evidence that led to that bug.
    %
:- pred oracle_confirm_bug(decl_bug::in, decl_evidence(T)::in,
    decl_confirmation::out, oracle_state::in, oracle_state::out,
    io::di, io::uo) is cc_multi.

    % Revise a question in the oracle's knowledge base so that the oracle
    % will get an answer to the question from the user.
    %
:- pred revise_oracle(decl_question(T)::in,
    oracle_state::in, oracle_state::out) is det.

    % update_revised_knowledge_base(Oracle1, Oracle2, Oracle3):
    %
    % Update the revised knowledge base in Oracle1 with the current knowledge
    % base from Oracle2 and return the resulting oracle in Oracle3.
    %
:- pred update_revised_knowledge_base(oracle_state::in, oracle_state::in,
    oracle_state::out) is det.

    % Returns the state of the term browser.
    %
:- func get_oracle_browser_state(oracle_state)
    = browser_info.browser_persistent_state.

    % Return the output stream used for interacting with the user.
    %
:- func get_oracle_user_output_stream(oracle_state) = io.output_stream.

    % Return the input stream used for interacting with the user.
    %
:- func get_oracle_user_input_stream(oracle_state) = io.input_stream.

    % Sets the state of the term browser.
    %
:- pred set_oracle_browser_state(browser_info.browser_persistent_state::in,
    oracle_state::in, oracle_state::out) is det.

    % Set the testing flag of the user_state in the given oracle.
    %
:- pred set_oracle_testing_flag(are_we_testing::in,
    oracle_state::in, oracle_state::out) is det.

    % Reset the oracle's knowledge base.
    %
:- pred reset_oracle_knowledge_base(oracle_state::in, oracle_state::out)
    is det.

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

:- implementation.

:- import_module mdb.declarative_execution.
:- import_module mdbcomp.prim_data.

:- import_module bimap.
:- import_module counter.
:- import_module int.
:- import_module library.
:- import_module list.
:- import_module map.
:- import_module pair.
:- import_module set.
:- import_module solutions.
:- import_module string.

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

oracle_response_undoable(oracle_response_answer(_)).
oracle_response_undoable(oracle_response_change_search(_)).

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

:- type oracle_state
    --->    oracle(
                % Current information about the intended interpretation.
                % These answers have been given, but have not since been
                % revised.
                kb_current          :: oracle_kb,

                % Old information about the intended interpretation.
                % These answers were given and subsequently revised,
                % but new answers to the questions have not yet been given.
                kb_revised          :: oracle_kb,

                % User interface.
                user_state          :: user_state,

                % The set of trusted "objects" (the Mercury standard library,
                % modules, predicates, and/or functions) trusted by the oracle.
                % We map each to an integer as an id, and vice versa, in order
                % to allow the user to untrust an object by giving its id,
                % instead of having to give e.g. a module name again.
                %
                % This field is only used to implement the user interface,
                % i.e. the command to add, list and delete trusted objects.
                % The actual test whether a procedure is trusted is done
                % using the module_trust_map field below, which is optimized
                % for that task.
                trusted_object_map  :: bimap(trusted_object, int),

                % Counter to allocate ids to trusted objects.
                trusted_id_counter  :: counter,

                % Maps each module to an indication whether
                %
                % - the entirety of the module is trusted, and if so,
                %   whether this trust came about
                %
                %   - because this module is part of the Mercury standard
                %     library, and the user trusted the standard library, or
                %   - because the user trusted this module explicitly, and
                %
                % - which predicates and functions in the module were
                %   trusted individually by the user.
                %
                % This field must be kept in sync with the trusted object map.
                module_trust_map    :: module_trust_map
            ).

:- type trusted_object
    --->    trusted_standard_library

    ;       trusted_module(module_name)
            % Trust all predicates/functions in the named module.

    ;       trusted_predicate(
                module_name,
                string,     % pred name
                int         % arity
            )

    ;       trusted_function(
                module_name,
                string,     % function name
                int         % arity including return value
            ).

:- type module_trust_map == map(module_name, module_trust_info).

:- type is_trusted
    --->    is_not_trusted
    ;       is_trusted.

:- type module_trust_info
    --->    module_trust_info(
                is_trusted_stdlib   :: is_trusted,
                is_trusted_module   :: is_trusted,
                trusted_preds       :: map(string, set(int)),
                trusted_funcs       :: map(string, set(int))
            ).

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

oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle) :-
    oracle_kb_init(Current),
    oracle_kb_init(Old),
    user_state_init(InStr, OutStr, Browser, HelpSystem, User),
    counter.init(0, Counter0),
    Oracle0 = oracle(Current, Old, User, bimap.init, Counter0, map.init),
    % Trust the standard library by default.
    trust_standard_library(Oracle0, Oracle).

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

trust_standard_library(!Oracle) :-
    Counter0 = !.Oracle ^ trusted_id_counter,
    counter.allocate(Id, Counter0, Counter),
    Trusted0 = !.Oracle ^ trusted_object_map,
    ( if bimap.insert(trusted_standard_library, Id, Trusted0, Trusted) then
        !Oracle ^ trusted_object_map := Trusted,
        !Oracle ^ trusted_id_counter := Counter,

        ModuleTrustMap0 = !.Oracle ^ module_trust_map,
        list.foldl(add_to_module_trust_map(trust_module_as_stdlib),
            stdlib_modules, ModuleTrustMap0, ModuleTrustMap),
        !Oracle ^ module_trust_map := ModuleTrustMap
    else
        true
    ).

add_trusted_module(ModuleName, !Oracle) :-
    Counter0 = !.Oracle ^ trusted_id_counter,
    counter.allocate(Id, Counter0, Counter),
    Trusted0 = !.Oracle ^ trusted_object_map,
    ( if bimap.insert(trusted_module(ModuleName), Id, Trusted0, Trusted) then
        !Oracle ^ trusted_object_map := Trusted,
        !Oracle ^ trusted_id_counter := Counter,

        ModuleTrustMap0 = !.Oracle ^ module_trust_map,
        add_to_module_trust_map(trust_module_on_its_own, ModuleName,
            ModuleTrustMap0, ModuleTrustMap),
        !Oracle ^ module_trust_map := ModuleTrustMap
    else
        true
    ).

add_trusted_pred_or_func(ProcLayout, !Oracle) :-
    Counter0 = !.Oracle ^ trusted_id_counter,
    counter.allocate(Id, Counter0, Counter),
    ProcLabel = get_proc_label_from_layout(ProcLayout),
    (
        ProcLabel = ordinary_proc_label(ModuleName, PredOrFunc, _,
            Name, Arity, _)
    ;
        ProcLabel = special_proc_label(ModuleName, _, _, Name, Arity, _),
        PredOrFunc = pf_predicate
    ),
    Trusted0 = !.Oracle ^ trusted_object_map,
    ( if
        (
            PredOrFunc = pf_predicate,
            TrustedObject = trusted_predicate(ModuleName, Name, Arity)
        ;
            PredOrFunc = pf_function,
            TrustedObject = trusted_function(ModuleName, Name, Arity)
        ),
        bimap.insert(TrustedObject, Id, Trusted0, Trusted)
    then
        !Oracle ^ trusted_object_map := Trusted,
        !Oracle ^ trusted_id_counter := Counter,

        ModuleTrustMap0 = !.Oracle ^ module_trust_map,
        ( if map.search(ModuleTrustMap0, ModuleName, ModuleTrustInfo0) then
            ModuleTrustInfo1 = ModuleTrustInfo0
        else
            ModuleTrustInfo1 = module_trust_info(is_not_trusted, is_not_trusted,
                map.init, map.init)
        ),
        (
            PredOrFunc = pf_predicate,
            PredMap1 = ModuleTrustInfo1 ^ trusted_preds,
            add_trusted_arity(Name, Arity, PredMap1, PredMap),
            ModuleTrustInfo = ModuleTrustInfo1 ^ trusted_preds := PredMap
        ;
            PredOrFunc = pf_function,
            FuncMap1 = ModuleTrustInfo1 ^ trusted_funcs,
            add_trusted_arity(Name, Arity, FuncMap1, FuncMap),
            ModuleTrustInfo = ModuleTrustInfo1 ^ trusted_funcs := FuncMap
        ),
        map.set(ModuleName, ModuleTrustInfo,
            ModuleTrustMap0, ModuleTrustMap),
        !Oracle ^ module_trust_map := ModuleTrustMap
    else
        true
    ).

remove_trusted(Id, !Oracle) :-
    Trusted0 = !.Oracle ^ trusted_object_map,
    bimap.search(Trusted0, OldTrustedObject, Id),
    bimap.delete_value(Id, Trusted0, Trusted),
    !Oracle ^ trusted_object_map := Trusted,

    ModuleTrustMap0 = !.Oracle ^ module_trust_map,
    (
        OldTrustedObject = trusted_standard_library,
        list.foldl(remove_from_module_trust_map(trust_module_as_stdlib),
            stdlib_modules, ModuleTrustMap0, ModuleTrustMap)
    ;
        OldTrustedObject = trusted_module(ModuleName),
        remove_from_module_trust_map(trust_module_on_its_own, ModuleName,
            ModuleTrustMap0, ModuleTrustMap)
    ;
        ( OldTrustedObject = trusted_predicate(ModuleName, Name, Arity)
        ; OldTrustedObject = trusted_function(ModuleName, Name, Arity)
        ),
        map.lookup(ModuleTrustMap0, ModuleName, ModuleTrustInfo0),
        ModuleTrustInfo0 = module_trust_info(TrustedStdLib0, TrustedOnItsOwn0,
            PredMap0, FuncMap0),
        (
            OldTrustedObject = trusted_predicate(_, _, _),
            remove_trusted_arity(Name, Arity, PredMap0, PredMap),
            FuncMap = FuncMap0
        ;
            OldTrustedObject = trusted_function(_, _, _),
            remove_trusted_arity(Name, Arity, FuncMap0, FuncMap),
            PredMap = PredMap0
        ),
        ModuleTrustInfo = module_trust_info(TrustedStdLib0, TrustedOnItsOwn0,
            PredMap, FuncMap),
        ( if
            TrustedStdLib0 = is_not_trusted,
            TrustedOnItsOwn0 = is_not_trusted,
            map.is_empty(PredMap),
            map.is_empty(FuncMap)
        then
            map.delete(ModuleName, ModuleTrustMap0, ModuleTrustMap)
        else
            map.det_update(ModuleName, ModuleTrustInfo,
                ModuleTrustMap0, ModuleTrustMap)
        )
    ),
    !Oracle ^ module_trust_map := ModuleTrustMap.

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

:- type trust_module_as
    --->    trust_module_as_stdlib
    ;       trust_module_on_its_own.

:- pred add_to_module_trust_map(trust_module_as::in, module_name::in,
    module_trust_map::in, module_trust_map::out) is det.

add_to_module_trust_map(TrustModuleAs, ModuleName, !ModuleTrustMap) :-
    ( if map.search(!.ModuleTrustMap, ModuleName, ModuleTrustInfo0) then
        (
            TrustModuleAs = trust_module_as_stdlib,
            ModuleTrustInfo = ModuleTrustInfo0 ^ is_trusted_stdlib :=
                is_trusted
        ;
            TrustModuleAs = trust_module_on_its_own,
            ModuleTrustInfo = ModuleTrustInfo0 ^ is_trusted_module :=
                is_trusted
        ),
        map.det_update(ModuleName, ModuleTrustInfo, !ModuleTrustMap)
    else
        (
            TrustModuleAs = trust_module_as_stdlib,
            TrustStdLib = is_trusted,
            TrustOnItsOwn = is_not_trusted
        ;
            TrustModuleAs = trust_module_on_its_own,
            TrustStdLib = is_not_trusted,
            TrustOnItsOwn = is_trusted
        ),
        ModuleTrustInfo = module_trust_info(TrustStdLib, TrustOnItsOwn,
            map.init, map.init),
        map.det_insert(ModuleName, ModuleTrustInfo, !ModuleTrustMap)
    ).

:- pred remove_from_module_trust_map(trust_module_as::in, module_name::in,
    module_trust_map::in, module_trust_map::out) is det.

remove_from_module_trust_map(TrustModuleAs, ModuleName, !ModuleTrustMap) :-
    map.lookup(!.ModuleTrustMap, ModuleName, ModuleTrustInfo0),
    (
        TrustModuleAs = trust_module_as_stdlib,
        ModuleTrustInfo = ModuleTrustInfo0 ^ is_trusted_stdlib :=
            is_not_trusted
    ;
        TrustModuleAs = trust_module_on_its_own,
        ModuleTrustInfo = ModuleTrustInfo0 ^ is_trusted_module :=
            is_not_trusted
    ),
    ModuleTrustInfo = module_trust_info(TrustedStdLib, TrustedOnItsOwn,
        PredMap, FuncMap),
    ( if
        TrustedStdLib = is_not_trusted,
        TrustedOnItsOwn = is_not_trusted,
        map.is_empty(PredMap),
        map.is_empty(FuncMap)
    then
        map.delete(ModuleName, !ModuleTrustMap)
    else
        map.det_update(ModuleName, ModuleTrustInfo, !ModuleTrustMap)
    ).

:- pred add_trusted_arity(string::in, int::in,
    map(string, set(int))::in, map(string, set(int))::out) is det.

add_trusted_arity(Name, Arity, !TrustedArityMap) :-
    ( if map.search(!.TrustedArityMap, Name, TrustedArities0) then
        set.insert(Arity, TrustedArities0, TrustedArities),
        map.det_update(Name, TrustedArities, !TrustedArityMap)
    else
        set.singleton_set(Arity, TrustedArities),
        map.det_insert(Name, TrustedArities, !TrustedArityMap)
    ).

:- pred remove_trusted_arity(string::in, int::in,
    map(string, set(int))::in, map(string, set(int))::out) is det.

remove_trusted_arity(Name, Arity, !TrustedArityMap) :-
    map.lookup(!.TrustedArityMap, Name, TrustedArities0),
    set.det_remove(Arity, TrustedArities0, TrustedArities),
    ( if set.is_empty(TrustedArities) then
        map.delete(Name, !TrustedArityMap)
    else
        map.det_update(Name, TrustedArities, !TrustedArityMap)
    ).

:- func stdlib_modules = list(module_name).

stdlib_modules = StdLibModuleNames :-
    GetStdLibModuleNames =
        ( pred(ModuleName::out) is multi :-
            stdlib_module_doc_undoc(ModuleNameStr, _),
            ModuleName = string_to_sym_name(ModuleNameStr)
        ),
    solutions.solutions(GetStdLibModuleNames, StdLibModuleNames).

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

get_trusted_list(Oracle, MDBCommandFormat, Str) :-
    IdToObjectMap = bimap.reverse_map(Oracle ^ trusted_object_map),
    IdObjectPairs = map.to_assoc_list(IdToObjectMap),
    (
        MDBCommandFormat = yes,
        TrustCmdStrs = list.map(format_trust_command, IdObjectPairs),
        Str = string.append_list(TrustCmdStrs)
    ;
        MDBCommandFormat = no,
        DisplayStrs = list.map(format_trust_display, IdObjectPairs),
        (
            DisplayStrs = [],
            Str = "There are no trusted modules, predicates or functions.\n"
        ;
            DisplayStrs = [_ | _],
            Str = string.append_list(["Trusted objects:\n" | DisplayStrs])
        )
    ).

:- func format_trust_command(pair(int, trusted_object)) = string.

format_trust_command(_Id - TrustedObject) = CmdStr :-
    (
        TrustedObject = trusted_standard_library,
        CmdStr = "trust std lib\n"
    ;
        TrustedObject = trusted_module(ModuleName),
        ModuleNameStr = sym_name_to_string(ModuleName),
        string.format("trust %s\n", [s(ModuleNameStr)], CmdStr)
    ;
        TrustedObject = trusted_predicate(ModuleName, Name, Arity),
        ModuleNameStr = sym_name_to_string(ModuleName),
        string.format("trust pred*%s.%s/%d\n",
            [s(ModuleNameStr), s(Name), i(Arity)], CmdStr)
    ;
        TrustedObject = trusted_function(ModuleName, Name, Arity),
        ModuleNameStr = sym_name_to_string(ModuleName),
        string.format("trust func*%s.%s/%d\n",
            [s(ModuleNameStr), s(Name), i(Arity - 1)], CmdStr)
    ).

:- func format_trust_display(pair(int, trusted_object)) = string.

format_trust_display(Id - TrustedObject) = Display :-
    (
        TrustedObject = trusted_standard_library,
        CmdDisplay = "the Mercury standard library"
    ;
        TrustedObject = trusted_module(ModuleName),
        ModuleNameStr = sym_name_to_string(ModuleName),
        CmdDisplay = "module " ++ ModuleNameStr
    ;
        TrustedObject = trusted_predicate(ModuleName, Name, Arity),
        ModuleNameStr = sym_name_to_string(ModuleName),
        CmdDisplay = "predicate " ++ ModuleNameStr ++ "."
            ++ Name ++ "/" ++ int_to_string(Arity)
    ;
        TrustedObject = trusted_function(ModuleName, Name, Arity),
        ModuleNameStr = sym_name_to_string(ModuleName),
        CmdDisplay = "function " ++ ModuleNameStr ++ "."
            ++ Name ++ "/" ++ int_to_string(Arity - 1)
    ),
    string.format("%d: %s\n", [i(Id), s(CmdDisplay)], Display).

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

query_oracle(Question, Response, FromUser, !Oracle, !IO) :-
    ( if answer_known(!.Oracle, Question, Answer) then
        Response = oracle_response_answer(Answer),
        FromUser = no
    else
        make_user_question(!.Oracle ^ kb_revised, Question, UserQuestion),
        query_oracle_user(UserQuestion, Response, !Oracle, !IO),
        FromUser = yes
    ).

:- pred make_user_question(oracle_kb::in, decl_question(T)::in,
    user_question(T)::out) is det.

make_user_question(Revised, DeclQuestion, UserQuestion) :-
    ( if
        query_oracle_kb(Revised, DeclQuestion, Answer),
        Answer = truth_value(_, DeclTruth)
    then
        UserQuestion = question_with_default(DeclQuestion, DeclTruth)
    else
        UserQuestion = plain_question(DeclQuestion)
    ).

:- pred query_oracle_user(user_question(T)::in, oracle_response(T)::out,
    oracle_state::in, oracle_state::out, io::di, io::uo) is cc_multi.

query_oracle_user(UserQuestion, OracleResponse, !Oracle, !IO) :-
    User0 = !.Oracle ^ user_state,
    query_user(UserQuestion, UserResponse, User0, User, !IO),
    (
        UserResponse = user_response_answer(Question, Answer),
        OracleResponse = oracle_response_answer(Answer),
        Current0 = !.Oracle ^ kb_current,
        Revised0 = !.Oracle ^ kb_revised,
        retract_oracle_kb(Question, Revised0, Revised),
        assert_oracle_kb(Question, Answer, Current0, Current),
        !Oracle ^ kb_current := Current,
        !Oracle ^ kb_revised := Revised
    ;
        UserResponse = user_response_trust_predicate(Question),
        Atom = get_decl_question_atom(Question),
        add_trusted_pred_or_func(Atom ^ proc_layout, !Oracle),
        OracleResponse = oracle_response_answer(
            ignore(get_decl_question_node(Question)))
    ;
        UserResponse = user_response_trust_module(Question),
        Atom = get_decl_question_atom(Question),
        ProcLabel = get_proc_label_from_layout(Atom ^ proc_layout),
        get_pred_attributes(ProcLabel, Module, _, _, _),
        add_trusted_module(Module, !Oracle),
        OracleResponse = oracle_response_answer(
            ignore(get_decl_question_node(Question)))
    ;
        UserResponse = user_response_show_info(OutStream),
        OracleResponse = oracle_response_show_info(OutStream)
    ;
        UserResponse = user_response_change_search(Mode),
        OracleResponse = oracle_response_change_search(Mode)
    ;
        UserResponse = user_response_exit_diagnosis(Node),
        OracleResponse = oracle_response_exit_diagnosis(Node)
    ;
        UserResponse = user_response_abort_diagnosis,
        OracleResponse = oracle_response_abort_diagnosis
    ;
        UserResponse = user_response_undo,
        OracleResponse = oracle_response_undo
    ),
    !Oracle ^ user_state := User.

answer_known(Oracle, Question, Answer) :-
    Atom = get_decl_question_atom(Question),
    ( if proc_is_trusted(Oracle, Atom ^ proc_layout) then
        % We tell the analyser that this node does not contain a bug,
        % however its children may still contain bugs, since trusted procs
        % may call untrusted procs. One example is when an untrusted closure
        % is passed to a trusted predicate.
        Answer = ignore(get_decl_question_node(Question))
    else
        query_oracle_kb(Oracle ^ kb_current, Question, Answer)
    ).

:- pred proc_is_trusted(oracle_state::in, proc_layout::in) is semidet.

proc_is_trusted(Oracle, ProcLayout) :-
    ModuleTrustMap = Oracle ^ module_trust_map,
    ProcLabel = get_proc_label_from_layout(ProcLayout),
    (
        ProcLabel = ordinary_proc_label(Module, PredOrFunc, _, Name, Arity, _),
        % If the search fails, the procedure is not trusted.
        map.search(ModuleTrustMap, Module, ModuleTrustInfo),
        ModuleTrustInfo = module_trust_info(TrustedAsStdLib, TrustedAsModule,
            PredMap, FuncMap),
        (
            TrustedAsStdLib = is_trusted
        ;
            TrustedAsModule = is_trusted
        ;
            (
                PredOrFunc = pf_predicate,
                map.search(PredMap, Name, TrustedArities)
            ;
                PredOrFunc = pf_function,
                map.search(FuncMap, Name, TrustedArities)
            ),
            set.contains(TrustedArities, Arity)
        )
    ;
        ProcLabel = special_proc_label(_, _, _, _, _, _)
    ).

oracle_confirm_bug(Bug, Evidence, Confirmation, Oracle0, Oracle, !IO) :-
    User0 = Oracle0 ^ user_state,
    user_confirm_bug(Bug, Confirmation, User0, User, !IO),
    Oracle1 = Oracle0 ^ user_state := User,
    (
        Confirmation = overrule_bug,
        list.foldl(revise_oracle, Evidence, Oracle1, Oracle)
    ;
        ( Confirmation = confirm_bug
        ; Confirmation = abort_diagnosis
        ),
        Oracle = Oracle1
    ).

revise_oracle(Question, !Oracle) :-
    Current0 = !.Oracle ^ kb_current,
    ( if query_oracle_kb(Current0, Question, Answer) then
        retract_oracle_kb(Question, Current0, Current),
        Revised0 = !.Oracle ^ kb_revised,
        assert_oracle_kb(Question, Answer, Revised0, Revised),
        !Oracle ^ kb_revised := Revised,
        !Oracle ^ kb_current := Current
    else
        true
    ).

update_revised_knowledge_base(Oracle1, Oracle2, Oracle3) :-
    Oracle3 = Oracle1 ^ kb_revised := Oracle2 ^ kb_current.

%---------------------------------------------------------------------------%
%
% This section implements the oracle knowledge base, which stores anything
% that the debugger knows about the intended interpretation. This can be used
% to check the correctness of an EDT node.
%

    % The type of the knowledge base. Other fields may be added in
    % the future, such as for assertions made on-the-fly by the user,
    % or assertions in the program text.
    %
:- type oracle_kb
    ---> oracle_kb(
            % For ground atoms, the knowledge is represented directly with
            % a map. This is used, for example, in the common case that
            % the user supplies a truth value for a "wrong answer" node.
            kb_ground_map :: map(final_decl_atom, decl_truth),

            % This map stores knowledge about the completeness of the set
            % of solutions generated by calling the given initial atom.
            % This is used, for example, in the common case that the user
            % supplies a truth value for a "missing answer" node.
            kb_complete_map :: map(init_decl_atom, decl_truth),

            % Mapping from call atoms to information about which
            % exceptions are possible or impossible.
            kb_exceptions_map :: map(init_decl_atom, known_exceptions)
        ).

:- type known_exceptions
    --->    known_excp(
                % Possible exceptions.
                possible        :: set(decl_exception),

                % Impossible exceptions.
                impossible      :: set(decl_exception),

                % Exceptions from inadmissible calls.
                inadmissible    :: set(decl_exception)
            ).

:- pred oracle_kb_init(oracle_kb::out) is det.

oracle_kb_init(oracle_kb(G, C, X)) :-
    map.init(G),
    map.init(C),
    map.init(X).

:- pred get_kb_ground_map(oracle_kb::in,
    map(final_decl_atom, decl_truth)::out) is det.
:- pred get_kb_complete_map(oracle_kb::in,
    map(init_decl_atom, decl_truth)::out) is det.
:- pred get_kb_exceptions_map(oracle_kb::in,
    map(init_decl_atom, known_exceptions)::out) is det.

get_kb_ground_map(KB, X) :-
    X = KB ^ kb_ground_map.
get_kb_complete_map(KB, X) :-
    X = KB ^ kb_complete_map.
get_kb_exceptions_map(KB, X) :-
    X = KB ^ kb_exceptions_map.

:- pred set_kb_ground_map(map(final_decl_atom, decl_truth)::in,
    oracle_kb::in, oracle_kb::out) is det.
:- pred set_kb_complete_map(map(init_decl_atom, decl_truth)::in,
    oracle_kb::in, oracle_kb::out) is det.
:- pred set_kb_exceptions_map(map(init_decl_atom, known_exceptions)::in,
    oracle_kb::in, oracle_kb::out) is det.

set_kb_ground_map(M, !KB) :-
    !KB ^ kb_ground_map := M.
set_kb_complete_map(M, !KB) :-
    !KB ^ kb_complete_map := M.
set_kb_exceptions_map(M, !KB) :-
    !KB ^ kb_exceptions_map := M.

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

:- pred query_oracle_kb(oracle_kb::in, decl_question(T)::in,
    decl_answer(T)::out(known_answer)) is semidet.

query_oracle_kb(KB, Question, Answer) :-
    (
        Question = wrong_answer(Node, _, Atom),
        get_kb_ground_map(KB, Map),
        map.search(Map, Atom, Truth),
        Answer = truth_value(Node, Truth)
    ;
        Question = missing_answer(Node, Call, _Solns),
        get_kb_complete_map(KB, CMap),
        map.search(CMap, Call, Truth),
        Answer = truth_value(Node, Truth)
    ;
        Question = unexpected_exception(Node, Call, Exception),
        get_kb_exceptions_map(KB, XMap),
        map.search(XMap, Call, X),
        X = known_excp(Possible, Impossible, Inadmissible),
        ( if set.member(Exception, Possible) then
            Answer = truth_value(Node, truth_correct)
        else if set.member(Exception, Impossible) then
            Answer = truth_value(Node, truth_erroneous)
        else
            set.member(Exception, Inadmissible),
            Answer = truth_value(Node, truth_inadmissible)
        )
    ).

    % assert_oracle_kb/3 assumes that the asserted fact is consistent
    % with the current knowledge base. This will generally be the case,
    % since the user will never be asked questions which the knowledge base
    % knows anything about.
    %
:- pred assert_oracle_kb(decl_question(T)::in, decl_answer(T)::in,
    oracle_kb::in, oracle_kb::out) is det.

assert_oracle_kb(Question, Answer, !KB) :-
    (
        ( Answer = suspicious_subterm(_, _, _, _, _)
        ; Answer = ignore(_)
        ; Answer = skip(_)
        )
    ;
        Answer = truth_value(_, Truth),
        (
            Question = wrong_answer(_, _, Atom),
            get_kb_ground_map(!.KB, Map0),
            ProcLayout = Atom ^ final_atom ^ proc_layout,

            % Insert all modes for the atom if the atom is correct,
            % and just the one mode if it is not correct. In general,
            % we cannot insert all modes for erroneous or inadmissible atoms,
            % since the atom might be erroneous with respect to one mode,
            % but inadmissible with respect to another mode.

            (
                Truth = truth_correct,
                foldl(add_atom_to_ground_map(Truth, Atom),
                    get_all_modes_for_layout(ProcLayout), Map0, Map)
            ;
                ( Truth = truth_erroneous
                ; Truth = truth_inadmissible
                ),
                add_atom_to_ground_map(Truth, Atom, ProcLayout, Map0, Map)
            ),
            set_kb_ground_map(Map, !KB)
        ;
            Question = missing_answer(_, Call, _),
            get_kb_complete_map(!.KB, Map0),
            map.set(Call, Truth, Map0, Map),
            set_kb_complete_map(Map, !KB)
        ;
            Question = unexpected_exception(_, Call, Exception),
            get_kb_exceptions_map(!.KB, Map0),
            ( if map.search(Map0, Call, OldKnownExceptions) then
                KnownExceptions0 = OldKnownExceptions
            else
                set.init(EmptyPossible0),
                set.init(EmptyImpossible0),
                set.init(EmptyInadmissible0),
                KnownExceptions0 = known_excp(EmptyPossible0, EmptyImpossible0,
                    EmptyInadmissible0)
            ),
            (
                Truth = truth_correct,
                Possible0 = KnownExceptions0 ^ possible,
                set.insert(Exception, Possible0, Possible),
                KnownExceptions = KnownExceptions0 ^ possible := Possible
            ;
                Truth = truth_erroneous,
                Impossible0 = KnownExceptions0 ^ impossible,
                set.insert(Exception, Impossible0, Impossible),
                KnownExceptions = KnownExceptions0 ^ impossible := Impossible
            ;
                Truth = truth_inadmissible,
                Inadmissible0 = KnownExceptions0 ^ inadmissible,
                set.insert(Exception, Inadmissible0, Inadmissible),
                KnownExceptions =
                    KnownExceptions0 ^ inadmissible := Inadmissible
            ),
            map.set(Call, KnownExceptions, Map0, Map),
            set_kb_exceptions_map(Map, !KB)
        )
    ).

:- pred retract_oracle_kb(decl_question(T)::in, oracle_kb::in, oracle_kb::out)
    is det.

retract_oracle_kb(Question, !KB) :-
    (
        Question = wrong_answer(_, _, Atom),
        GroundMap0 = !.KB ^ kb_ground_map,
        % Delete all modes of the predicate/function.
        list.foldl(remove_atom_from_ground_map(Atom),
            get_all_modes_for_layout(Atom ^ final_atom ^ proc_layout),
            GroundMap0, GroundMap),
        !KB ^ kb_ground_map := GroundMap
    ;
        Question = missing_answer(_, InitAtom, _),
        CompleteMap0 = !.KB ^ kb_complete_map,
        map.delete(InitAtom, CompleteMap0, CompleteMap),
        !KB ^ kb_complete_map := CompleteMap
    ;
        Question = unexpected_exception(_, InitAtom, Exception),
        ExceptionsMap0 = !.KB ^ kb_exceptions_map,
        ( if
            map.search(ExceptionsMap0, InitAtom, KnownExceptions0),
            KnownExceptions0 =
                known_excp(Possible0, Impossible0, Inadmissible0)
        then
            set.delete(Exception, Possible0, Possible),
            set.delete(Exception, Impossible0, Impossible),
            set.delete(Exception, Inadmissible0, Inadmissible),
            KnownExceptions = known_excp(Possible, Impossible, Inadmissible),
            map.set(InitAtom, KnownExceptions, ExceptionsMap0, ExceptionsMap)
        else
            ExceptionsMap = ExceptionsMap0
        ),
        !KB ^ kb_exceptions_map := ExceptionsMap
    ).

:- pred add_atom_to_ground_map(decl_truth::in, final_decl_atom::in,
    proc_layout::in,
    map(final_decl_atom, decl_truth)::in,
    map(final_decl_atom, decl_truth)::out) is det.

add_atom_to_ground_map(Truth, FinalAtom, ProcLayout, !Map) :-
    map.set(final_decl_atom(
        atom(ProcLayout, FinalAtom ^ final_atom ^ atom_args),
        FinalAtom ^ final_io_actions), Truth, !Map).

:- pred remove_atom_from_ground_map(final_decl_atom::in, proc_layout::in,
    map(final_decl_atom, decl_truth)::in,
    map(final_decl_atom, decl_truth)::out) is det.

remove_atom_from_ground_map(FinalAtom, ProcLayout, !Map) :-
    FinalDeclAtom = final_decl_atom(
        atom(ProcLayout, FinalAtom ^ final_atom ^ atom_args),
        FinalAtom ^ final_io_actions),
    map.delete(FinalDeclAtom, !Map).

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

get_oracle_browser_state(Oracle) =
    mdb.declarative_user.get_user_browser_state(Oracle ^ user_state).

get_oracle_user_output_stream(Oracle) =
    declarative_user.get_user_output_stream(Oracle ^ user_state).

get_oracle_user_input_stream(Oracle) =
    declarative_user.get_user_input_stream(Oracle ^ user_state).

set_oracle_browser_state(Browser, !Oracle) :-
    User0 = !.Oracle ^ user_state,
    declarative_user.set_user_browser_state(Browser, User0, User),
    !Oracle ^ user_state := User.

set_oracle_testing_flag(Testing, !Oracle) :-
    User0 = !.Oracle ^ user_state,
    set_user_testing_flag(Testing, User0, User),
    !Oracle ^ user_state := User.

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

reset_oracle_knowledge_base(!Oracle) :-
    oracle_kb_init(EmptyKB),
    !Oracle ^ kb_revised := !.Oracle ^ kb_current,
    !Oracle ^ kb_current := EmptyKB.

%---------------------------------------------------------------------------%
:- end_module mdb.declarative_oracle.
%---------------------------------------------------------------------------%
