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).
233
234