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