Source file jg_ast_optimize.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
open Jg_types
open Jg_ast_mapper
(** [dead_code_elimination ast] perform a dead code elimination on [ast].
It is able to remove from ast:
- macro and function definitions not being actually used in ast
*)
let dead_code_elimination stmts =
let used = Hashtbl.create 512 in
let local_variables : (string * string list) list ref = ref [("", [])] in
let push_block name = local_variables := (name, []) :: !local_variables in
let pop_block () = local_variables := List.tl !local_variables in
let set_local x =
let fst, snd = List.hd !local_variables in
local_variables := (fst, x :: snd ) :: (List.tl !local_variables) in
let is_local (x : string) = List.exists (fun (_, l) -> List.mem x l) !local_variables in
let scope () =
let rec loop = function
| [] -> ""
| ("", _) :: tl -> loop tl
| (s, _) :: _ -> s in
loop !local_variables in
let rec maybe_set = function
| SetExpr set -> List.iter maybe_set set
| IdentExpr id -> set_local id
| _ -> () in
let statement self = function
| SetStatement (id, _) as s ->
maybe_set id ;
default_mapper.statement self s
| SetBlockStatement (id, _) as s ->
set_local id;
push_block id;
let s = default_mapper.statement self s in
pop_block () ;
s
| ForStatement (ids, _, _) as s ->
push_block "" ;
List.iter set_local ids ;
let s = default_mapper.statement self s in
pop_block () ;
s
| FunctionStatement (id, args, _)
| MacroStatement (id, args, _) as s ->
push_block id ;
set_local id ;
List.iter (fun (i, _) -> set_local i) args ;
let s = default_mapper.statement self s in
pop_block () ;
s
| CallStatement(id, args, _, _) as s ->
Hashtbl.add used id (scope ()) ;
push_block "" ;
List.iter (fun (i, _) -> set_local i) args ;
let s = default_mapper.statement self s in
pop_block () ;
s
| TextStatement (_)
| ExpandStatement (_)
| IfStatement (_)
| SwitchStatement (_, _)
| IncludeStatement (_, _)
| RawIncludeStatement _
| ExtendsStatement _
| ImportStatement (_, _)
| FromImportStatement (_, _)
| BlockStatement (_, _)
| FilterStatement (_, _)
| WithStatement (_, _)
| AutoEscapeStatement (_, _)
| NamespaceStatement (_, _)
| Statements (_)
as s -> default_mapper.statement self s
in
let expression self = function
| IdentExpr name as x when not (is_local name) ->
Hashtbl.add used name (scope ()) ; x
| e -> default_mapper.expression self e in
let mapper = { default_mapper with expression ; statement } in
let _ = mapper.ast mapper stmts in
let statement self = function
| MacroStatement (id, _, _)
| FunctionStatement (id, _, _) as s ->
let rec loop lists =
match lists with
| [] -> Statements []
| [[]] -> Statements []
| list :: _ when List.mem "" list -> default_mapper.statement self s
| list :: _ ->
let list' =
list
|> List.map (Hashtbl.find_all used)
|> List.flatten
|> List.sort_uniq compare in
if List.mem list' lists then Statements []
else loop (list' :: lists)
in
loop [ List.sort_uniq compare @@ Hashtbl.find_all used id ]
| s -> default_mapper.statement self s
in
let mapper = { default_mapper with statement } in
mapper.ast mapper stmts
(** [inline_include env ast]
Inline the templates included in [ast] so it won't be necessary to
open and parse theses parts when execution [ast].
*)
let inline_include env stmts =
let open Jg_ast_mapper in
let statement self = function
| IncludeStatement (LiteralExpr (Tstr file), true) ->
Statements (self.ast self @@ Jg_interp.ast_from_file ~env file)
| RawIncludeStatement (LiteralExpr (Tstr file)) ->
Statements (self.ast self @@ Jg_interp.ast_from_file ~env file)
| e -> default_mapper.statement self e in
let mapper = { default_mapper with statement } in
mapper.ast mapper stmts