1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  1985-2024, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(toplevel_variables,
   38          [ print_toplevel_variables/0,
   39            verbose_expansion/1,
   40            '$replace_toplevel_vars'/4,
   41            '$save_toplevel_vars'/1,            % +Bindings
   42            '$switch_toplevel_mode'/1           % +Mode
   43          ]).   44
   45:- dynamic
   46    verbose/0.   47
   48% define the operator globally
   49:- op(1, fx, user:($)).   50
   51%!  '$replace_toplevel_vars'(+Query0, -Query, +Bindings0, -Bindings) is det.
   52%
   53%   These predicates realise reuse of   toplevel variables using the
   54%   $Var notation. These hooks are   normally called by toplevel.pl.
   55%   If the user defines rules for these   hooks  in the user module,
   56%   these implementations may be  called  (or   not)  to  define the
   57%   interaction with the user hooks.
   58
   59'$replace_toplevel_vars'(Query, Expanded, Bindings, ExpandedBindings) :-
   60    expand_vars(Bindings, Query, Expanded, NewBindings),
   61    term_variables(Expanded, Free),
   62    delete_bound_vars(Bindings, Free, ExpandedBindings0),
   63    '$append'(ExpandedBindings0, NewBindings, ExpandedBindings),
   64    (   verbose,
   65        Query \=@= Expanded
   66    ->  print_query(Expanded, ExpandedBindings)
   67    ;   true
   68    ).
   69
   70print_query(Query, Bindings) :-
   71    bind_vars(Bindings),
   72    writeq(Query), write('.'), nl,
   73    fail.                           % undo bind_vars/2.
   74print_query(_, _).
   75
   76bind_vars([]).
   77bind_vars([Name=Value|Rest]) :-
   78    Name = Value,
   79    bind_vars(Rest).
   80
   81%!  expand_vars(+Bindings, +Query, -Expanded, -NewBindings) is det.
   82%
   83%   Replace $Var terms inside Query by   the  toplevel variable term
   84%   and unify the result with  Expanded. NewBindings gets Name=Value
   85%   terms for toplevel variables that are bound to non-ground terms.
   86%
   87%   @error existence_error(answer_variable, Name)
   88
   89expand_vars(Bindings, Query, Expanded, NewBindings) :-
   90    current_prolog_flag(toplevel_var_size, Count),
   91    Count > 0,
   92    !,
   93    phrase(expand_vars(Bindings, Query, Expanded), NewBindings).
   94expand_vars(Bindings, Query, Query, Bindings).
   95
   96expand_vars(_, Var, Var) -->
   97    { var(Var) },
   98    !.
   99expand_vars(_, Atomic, Atomic) -->
  100    { atomic(Atomic) },
  101    !.
  102expand_vars(Bindings, $(Var), Value) -->
  103    { name_var(Var, Bindings, Name),
  104      (   toplevel_var(Name, Value)
  105      ->  !
  106      ;   throw(error(existence_error(answer_variable, Name), _))
  107      )
  108    },
  109    [ Name = Value ].
  110expand_vars(Bindings, Term, Expanded) -->
  111    { compound_name_arity(Term, Name, Arity),
  112      !,
  113      compound_name_arity(Expanded, Name, Arity),
  114      End is Arity + 1
  115    },
  116    expand_args(1, End, Bindings, Term, Expanded).
  117
  118expand_args(End, End, _, _, _) --> !.
  119expand_args(Arg0, End, Bindings, T0, T) -->
  120    { arg(Arg0, T0, V0),
  121      arg(Arg0, T, V1),
  122      Arg1 is Arg0 + 1
  123    },
  124    expand_vars(Bindings, V0, V1),
  125    expand_args(Arg1, End, Bindings, T0, T).
  126
  127name_var(Var, [VarName = TheVar|_], VarName) :-
  128    Var == TheVar,
  129    !.
  130name_var(Var, [_|T], Name) :-
  131    name_var(Var, T, Name).
  132
  133
  134delete_bound_vars([], _, []).
  135delete_bound_vars([H|T0], Free, [H|T1]) :-
  136    H = (_Name = Value),
  137    v_member(Value, Free),
  138    !,
  139    delete_bound_vars(T0, Free, T1).
  140delete_bound_vars([_|T0], Free, T1) :-
  141    delete_bound_vars(T0, Free, T1).
  142
  143v_member(V, [H|T]) :-
  144    (   V == H
  145    ;   v_member(V, T)
  146    ).
  147
  148%!  '$save_toplevel_vars'(+Bindings) is det.
  149%
  150%   Save toplevel variable bindings.
  151
  152'$save_toplevel_vars'(Bindings) :-
  153    (   current_prolog_flag(toplevel_var_size, Count),
  154        Count > 0
  155    ->  assert_bindings(Bindings)
  156    ;   true
  157    ).
  158
  159assert_bindings([]).
  160assert_bindings([Var = Value|Tail]) :-
  161    assert_binding(Var, Value),
  162    assert_bindings(Tail).
  163
  164assert_binding(Var, Value) :-
  165    (   ( nonvar(Value) ; attvar(Value))
  166    ->  update_var(Var, Value)
  167    ;   true
  168    ).
  169
  170update_var(Name, Value) :-
  171    current_prolog_flag(toplevel_mode, recursive),
  172    !,
  173    (   nb_current('$topvar', Bindings),
  174        Bindings \== []
  175    ->  true
  176    ;   Bindings = '$topvar'{}
  177    ),
  178    put_dict(Name, Bindings, Value, NewBindings),
  179    b_setval('$topvar', NewBindings).
  180update_var(Name, Value) :-
  181    delete_var(Name),
  182    set_var(Name, Value).
  183
  184delete_var(Name) :-
  185    forall(recorded('$topvar', Name = _, Ref), erase(Ref)).
  186
  187set_var(Name, Value) :-
  188    current_prolog_flag(toplevel_var_size, Count),
  189    !,
  190    (   '$term_size'(Value, Count, _)
  191    ->  recorda('$topvar', Name = Value, _)
  192    ;   true
  193    ).
  194set_var(Name, Value) :-
  195    recorda('$topvar', Name = Value, _).
  196
  197toplevel_var(Var, Binding) :-
  198    current_prolog_flag(toplevel_mode, recursive),
  199    !,
  200    nb_current('$topvar', Bindings),
  201    Bindings \== [],
  202    get_dict(Var, Bindings, Binding).
  203toplevel_var(Var, Binding) :-
  204    recorded('$topvar', Var=Binding).
  205
  206%!  '$switch_toplevel_mode'(+Mode) is det.
  207%
  208%   Migrate the variable database when switching   to a new toplevel
  209%   mode. Alternatively we may decide to wipe it as the semantics of
  210%   the variables may be slightly different.
  211
  212'$switch_toplevel_mode'(recursive) :-
  213    findall(Name-Value, retract_topvar(Name, Value), Pairs),
  214    dict_pairs(Bindings, '$topvar', Pairs),
  215    b_setval('$topvar', Bindings).
  216'$switch_toplevel_mode'(backtracking) :-
  217    (   nb_current('$topvar', Dict),
  218        Dict \== []
  219    ->  forall(get_dict(Name, Dict, Value),
  220               recorda('$topvar', Name = Value, _))
  221    ),
  222    nb_delete('$topvar').
  223
  224retract_topvar(Name, Value) :-
  225    recorded('$topvar', Name=Value, Ref),
  226    erase(Ref).
  227
  228%!  print_toplevel_variables
  229%
  230%   Print known bindings for toplevel ($Var) variables.
  231
  232print_toplevel_variables :-
  233    (   toplevel_var(Name, Value)
  234    *-> format('$~w =~t~12|~p~n', [Name, Value]),
  235        fail
  236    ;   format('No defined toplevel variables~n')
  237    ).
  238
  239verbose_expansion(on) :-
  240    !,
  241    retractall(verbose),
  242    asserta(verbose).
  243verbose_expansion(off) :-
  244    retractall(verbose)