1		% (c) 2009-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(eval_let_store,[stored_let_value/3,
6		add_stored_let_value/3,
7		set_stored_let_value/3,
8		retract_stored_let_value/3,
9		reset_let_values/0,
10		extend_state_with_stored_lets/2, extend_state_with_probids_and_lets/2,
11		get_stored_let_typing_scope/1,
12		extend_typing_scope_for_stored_lets/2]).
13
14		:- use_module(error_manager).
15		:- use_module(debug).
16
17		:- dynamic stored_let_value/3.
18
19		add_stored_let_value(ID,_,_) :- retract(stored_let_value(ID,_,_)),
20		add_warning(eval_let_store,'Erasing old stored value for: ',ID),
21		fail.
22		add_stored_let_value(ID,Type,Val) :-
23		assertz(stored_let_value(ID,Type,Val)).
24		% TODO: invalidate parse_expr_cache
25
26		% add or update:
27		set_stored_let_value(ID,_,_) :- retract(stored_let_value(ID,_,_)),
28		fail.
29		set_stored_let_value(ID,Type,Val) :-
30		format(user_output,'Storing ~w (type :~w)~n',[ID,Type]),
31		debug_println(9,value(Val)),
32		assertz(stored_let_value(ID,Type,Val)).
33
34		retract_stored_let_value(ID,Type,Val) :-
35		retract(stored_let_value(ID,Type,Val)).
36
37
38		% just delete lets if necessary because they clash or the typing is invalid
39		reset_let_values :-
40		stored_let_value(ID,Type,Value),
41		(contains_invalid_user_set(Type) -> true
42		; is_a_machine_identifier(ID)), % the ID now clashes
43		retract_stored_let_value(ID,Type,Value),
44		print(removing_let(ID)),nl,
45		fail.
46		reset_let_values.
47
48		% to do: write a proper predicate in bmachine and also collect other ids like freetypes ?!
49		is_a_machine_identifier(ID) :- bmachine:b_is_constant(ID).
50		is_a_machine_identifier(ID) :- bmachine:b_is_variable(ID).
51		is_a_machine_identifier(ID) :- b_global_sets:b_global_set(ID).
52		is_a_machine_identifier(ID) :- b_global_sets:lookup_global_constant(ID,_).
53
54		% check if a type contains a user defined set which is no longer available in new machine or re-loaded machine
55		contains_invalid_user_set(global(G)) :- \+ b_global_sets:b_global_set(G).
56		contains_invalid_user_set(set(T)) :- contains_invalid_user_set(T).
57		contains_invalid_user_set(seq(T)) :- contains_invalid_user_set(T).
58		contains_invalid_user_set(couple(A,B)) :-
59		(contains_invalid_user_set(A) -> true ; contains_invalid_user_set(B)).
60		contains_invalid_user_set(freetype(_)). % TO DO: check
61		contains_invalid_user_set(record(Fields)) :- member(field(_,T),Fields), contains_invalid_user_set(T).
62
63		% extend a state with values of the stored lets
64		extend_state_with_stored_lets(State,ExtendedState) :-
65		findall(bind(ID,Val),stored_let_value(ID,_,Val),ExtendedState,State).
66
67
68		:- use_module(b_global_sets,[add_prob_deferred_set_elements_to_store/3]).
69		extend_state_with_probids_and_lets(BState,BState2) :-
70		add_prob_deferred_set_elements_to_store(BState,BState1,visible),
71		extend_state_with_stored_lets(BState1,BState2).
72
73		% for the typechecker you need a identifier(Ids) scope entry with
74		get_stored_let_typing_scope(identifier(Ids)) :-
75		findall(b(identifier(ID),Type,[]),stored_let_value(ID,Type,_),Ids),
76		Ids \= [].
77
78		extend_typing_scope_for_stored_lets(Scope,[S1|Scope]) :- get_stored_let_typing_scope(Scope1),!,S1=Scope1.
79		extend_typing_scope_for_stored_lets(Scope,Scope).
80