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-2025, 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    do_expand_vars(Bindings, Query, Expanded, NewBindings).
   94expand_vars(Bindings, Query, Query, Bindings).
   95
   96do_expand_vars(Bindings, Query, Expanded, NewBindings) :-
   97    acyclic_term(Bindings),
   98    !,
   99    phrase(expand_vars(Bindings, Query, Expanded), NewBindings).
  100do_expand_vars(Bindings, Query, Expanded, NewBindings) :-
  101    '$factorize_term'(Query, Skel, Assignments),
  102    !,
  103    phrase(expand_vars(Bindings, Skel+Assignments, Expanded+EAssignments),
  104           NewBindings),
  105    rebind(EAssignments).
  106
  107expand_vars(_, Var, Var) -->
  108    { var(Var) },
  109    !.
  110expand_vars(_, Atomic, Atomic) -->
  111    { atomic(Atomic) },
  112    !.
  113expand_vars(Bindings, $(Var), Value) -->
  114    { name_var(Var, Bindings, Name),
  115      (   toplevel_var(Name, Value)
  116      ->  !
  117      ;   throw(error(existence_error(answer_variable, Name), _))
  118      )
  119    },
  120    [ Name = Value ].
  121expand_vars(Bindings, Term, Expanded) -->
  122    { compound_name_arity(Term, Name, Arity),
  123      !,
  124      compound_name_arity(Expanded, Name, Arity),
  125      End is Arity + 1
  126    },
  127    expand_args(1, End, Bindings, Term, Expanded).
  128
  129expand_args(End, End, _, _, _) --> !.
  130expand_args(Arg0, End, Bindings, T0, T) -->
  131    { arg(Arg0, T0, V0),
  132      arg(Arg0, T, V1),
  133      Arg1 is Arg0 + 1
  134    },
  135    expand_vars(Bindings, V0, V1),
  136    expand_args(Arg1, End, Bindings, T0, T).
  137
  138name_var(Var, [VarName = TheVar|_], VarName) :-
  139    Var == TheVar,
  140    !.
  141name_var(Var, [_|T], Name) :-
  142    name_var(Var, T, Name).
  143
  144
  145delete_bound_vars([], _, []).
  146delete_bound_vars([H|T0], Free, [H|T1]) :-
  147    H = (_Name = Value),
  148    v_member(Value, Free),
  149    !,
  150    delete_bound_vars(T0, Free, T1).
  151delete_bound_vars([_|T0], Free, T1) :-
  152    delete_bound_vars(T0, Free, T1).
  153
  154v_member(V, [H|T]) :-
  155    (   V == H
  156    ;   v_member(V, T)
  157    ).
  158
  159rebind([]).
  160rebind([Var=Value|T]) :-
  161    Var = Value,
  162    rebind(T).
  163
  164%!  '$save_toplevel_vars'(+Bindings) is det.
  165%
  166%   Save toplevel variable bindings.
  167
  168'$save_toplevel_vars'(Bindings) :-
  169    (   current_prolog_flag(toplevel_var_size, Count),
  170        Count > 0
  171    ->  assert_bindings(Bindings)
  172    ;   true
  173    ).
  174
  175assert_bindings([]).
  176assert_bindings([Var = Value|Tail]) :-
  177    assert_binding(Var, Value),
  178    assert_bindings(Tail).
  179
  180assert_binding(Var, Value) :-
  181    (   ( nonvar(Value) ; attvar(Value))
  182    ->  update_var(Var, Value)
  183    ;   true
  184    ).
  185
  186update_var(Name, Value) :-
  187    current_prolog_flag(toplevel_mode, recursive),
  188    !,
  189    (   nb_current('$topvar', Bindings),
  190        Bindings \== []
  191    ->  true
  192    ;   Bindings = '$topvar'{}
  193    ),
  194    put_dict(Name, Bindings, Value, NewBindings),
  195    b_setval('$topvar', NewBindings).
  196update_var(Name, Value) :-
  197    delete_var(Name),
  198    set_var(Name, Value).
  199
  200delete_var(Name) :-
  201    forall(recorded('$topvar', Name = _, Ref), erase(Ref)).
  202
  203set_var(Name, Value) :-
  204    current_prolog_flag(toplevel_var_size, Count),
  205    !,
  206    (   '$term_size'(Value, Count, _)
  207    ->  recorda('$topvar', Name = Value, _)
  208    ;   true
  209    ).
  210set_var(Name, Value) :-
  211    recorda('$topvar', Name = Value, _).
  212
  213toplevel_var(Var, Binding) :-
  214    current_prolog_flag(toplevel_mode, recursive),
  215    !,
  216    nb_current('$topvar', Bindings),
  217    Bindings \== [],
  218    get_dict(Var, Bindings, Binding).
  219toplevel_var(Var, Binding) :-
  220    recorded('$topvar', Var=Binding).
  221
  222%!  '$switch_toplevel_mode'(+Mode) is det.
  223%
  224%   Migrate the variable database when switching   to a new toplevel
  225%   mode. Alternatively we may decide to wipe it as the semantics of
  226%   the variables may be slightly different.
  227
  228'$switch_toplevel_mode'(recursive) :-
  229    findall(Name-Value, retract_topvar(Name, Value), Pairs),
  230    dict_pairs(Bindings, '$topvar', Pairs),
  231    b_setval('$topvar', Bindings).
  232'$switch_toplevel_mode'(backtracking) :-
  233    (   nb_current('$topvar', Dict),
  234        Dict \== []
  235    ->  forall(get_dict(Name, Dict, Value),
  236               recorda('$topvar', Name = Value, _))
  237    ),
  238    nb_delete('$topvar').
  239
  240retract_topvar(Name, Value) :-
  241    recorded('$topvar', Name=Value, Ref),
  242    erase(Ref).
  243
  244%!  print_toplevel_variables
  245%
  246%   Print known bindings for toplevel ($Var) variables.
  247
  248print_toplevel_variables :-
  249    (   toplevel_var(Name, Value)
  250    *-> format('$~w =~t~12|~p~n', [Name, Value]),
  251        fail
  252    ;   format('No defined toplevel variables~n')
  253    ).
  254
  255verbose_expansion(on) :-
  256    !,
  257    retractall(verbose),
  258    asserta(verbose).
  259verbose_expansion(off) :-
  260    retractall(verbose)