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 |