1 % (c) 2015-2022 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(b_ast_cleanup_rewrite_rules,[rewrite_rule_with_rename/7,normalization_rule_with_rename/7]).
6
7
8 :- use_module(probsrc(module_information),[module_info/2]).
9 :- module_info(group,typechecker).
10 :- module_info(description,'A rewriting engine for transformations/simplifications on the AST.').
11
12
13 :- use_module(probsrc(bsyntaxtree),[get_texpr_type/2, get_texpr_expr/2,
14 replace_id_by_expr/4, extract_pos_infos/2,syntaxtransformation/5,
15 safe_syntaxelement/5]).
16 :- use_module(probsrc(tools), [foldl/4]).
17 :- use_module(rewrite_rules_db, [rewrite_rule_mandatory/8, rewrite_rule_normalize/8]).
18 :- use_module(probsrc(btypechecker),[unify_types_strict/2]).
19 :- use_module(library(lists)).
20
21 % rename any quantified variables inside RHS of rules to avoid variable capture
22 % replace_id_by_expr/4 will perform replace
23
24 % TO DO: can we find a more elegant/efficient way to perform alpha-renaming/avoid name clashes?
25 % if we replace all quantified variables by variables like '_zzzz_unary' which cannot be used by the user: are we safe provided these identifiers cannot escape !?
26
27 :- meta_predicate apply_rewrite_rule_with_rename(8,-,-,-,-,-,-,-).
28 :- meta_predicate mycall(8,-,-,-,-,-,-,-,-).
29
30 rewrite_rule_with_rename(Expr,Type,Infos, FullNewExpr,NewType, FullNewInfos, Name) :-
31 ? apply_rewrite_rule_with_rename(rewrite_rule_mandatory,Expr,Type,Infos, FullNewExpr,NewType, FullNewInfos, Name).
32 normalization_rule_with_rename(Expr,Type,Infos, FullNewExpr,NewType, FullNewInfos, Name) :-
33 apply_rewrite_rule_with_rename(rewrite_rule_normalize,Expr,Type,Infos, FullNewExpr,NewType, FullNewInfos, Name).
34
35 apply_rewrite_rule_with_rename(RULEPRED,Expr,Type,Infos, FullNewExpr,NewType, FullNewInfos, Name) :-
36 % TO DO: check if Expr can match any rule according to RULEPRED, create_fresh_ids can be expensive
37 ? syntaxtransformation(Expr,Subs,_Names,NewSubs,ExprWithVars),
38 mycall(RULEPRED,ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name),
39 create_fresh_ids(Subs,1,NewSubs,Renamings), %debug:debug_nl_time(renamings(RULEPRED,Renamings,Expr)),
40 my_unify_types(Type,RuleType),
41 get_argument_types(Expr,ExprArgTypes),
42 %print(e(Name,Expr,ExprArgTypes)),nl,
43 maplist(my_unify_types,ArgTypes,ExprArgTypes),
44 (ground(RuleType) -> true ; print(unified(Type,RuleType)),nl),
45 ? foldl(perform_rename,Renamings,b(NewCopy,NewCType,NewCInfos),NewTExpr),
46 (extract_pos_infos(Infos,Pos)
47 ? -> update_pos(NewTExpr,Pos,b(FullNewExpr,NewType,FullNewInfos))
48 ; NewTExpr=b(FullNewExpr,NewType,FullNewInfos)
49 ).
50
51 mycall(b_ast_cleanup_rewrite_rules:rewrite_rule_mandatory,ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name) :- !,
52 rewrite_rule_mandatory(ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name).
53 mycall(b_ast_cleanup_rewrite_rules:rewrite_rule_normalize,ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name) :- !,
54 rewrite_rule_normalize(ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name).
55 mycall(RULEPRED,ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name) :-
56 print(call(RULEPRED)),nl,
57 call(RULEPRED,ExprWithVars,RuleType,Infos, ArgTypes,NewCopy,NewCType, NewCInfos, Name).
58
59 my_unify_types(T1,T2) :- (unify_types_strict(T1,T2) -> true ; format('*** Unify failed: ~w = ~w~n',[T1,T2]),fail).
60
61 get_argument_types(EXPR,ArgTypes) :- safe_syntaxelement(EXPR,Subs,_,_,_),
62 maplist(get_texpr_type,Subs,ArgTypes).
63
64 perform_rename(rename(ID,Arg),Expr,NewExpr) :-
65 ? replace_id_by_expr(Expr,ID,Arg,NewExpr).
66
67 create_fresh_ids([],_,[],[]).
68 create_fresh_ids([Arg|T],Nr,Args,RT) :-
69 is_ground_b_pattern(Arg),!, Args = [Arg|IT],
70 N1 is Nr+1,
71 create_fresh_ids(T,N1,IT,RT).
72 create_fresh_ids([Arg|T],Nr,[b(identifier(FRESHID),Type,[])|IT],[rename(FRESHID,Arg)|RT]) :-
73 get_texpr_type(Arg,Type), get_fresh_id(Nr,FRESHID),
74 N1 is Nr+1,
75 create_fresh_ids(T,N1,IT,RT).
76 :- use_module(probsrc(tools_strings), [string_concatenate/3]).
77 get_fresh_id(Nr,FRESHID) :- string_concatenate('___$FRESH$_',Nr,FRESHID).
78
79 % for those patterns we do not need to add fresh variables, i.e., not containing identifiers
80 is_ground_b_pattern(V) :- nonvar(V), get_texpr_expr(V,VE), nonvar(VE),is_ground_b_pattern_aux(VE).
81 is_ground_b_pattern_aux(boolean_false).
82 is_ground_b_pattern_aux(boolean_true).
83 is_ground_b_pattern_aux(bool_set).
84 is_ground_b_pattern_aux(empty_sequence).
85 is_ground_b_pattern_aux(empty_set).
86 is_ground_b_pattern_aux(integer(_)).
87 is_ground_b_pattern_aux(integer_set(_)).
88 is_ground_b_pattern_aux(max_int).
89 is_ground_b_pattern_aux(min_int).
90 is_ground_b_pattern_aux(float_set).
91 is_ground_b_pattern_aux(real_set).
92 is_ground_b_pattern_aux(string_set).
93 is_ground_b_pattern_aux(value(_)).
94 % TO DO: extend this
95
96 :- use_module(probsrc(bsyntaxtree),[transform_bexpr/3]).
97
98 :- public add_pos/3.
99 add_pos(Pos,b(E,T,I),b(E,T,NewInfo)) :-
100 (memberchk(nodeid(_),I) -> NewInfo=I ; append(Pos,I,NewInfo)).
101
102 % also the updating of the position info is a bit ad-hoc; can we do this more elegantly ?
103 update_pos(E,Pos,Res) :- !,
104 ? transform_bexpr(b_ast_cleanup_rewrite_rules:add_pos(Pos),E,Res).
105
106
107 % ----------------------------------
108 % stuff below should be put into seperate file
109