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