Commit | Line | Data |
---|---|---|
21d0f050 SK |
1 | module List = ListLabels |
2 | ||
3 | module A = Tiger_absyn | |
4 | module Opt = Tiger_opt | |
5 | module Map = Tiger_map | |
6 | module Sym = Tiger_symbol | |
7 | ||
8 | type info = | |
9 | { depth : int | |
10 | ; escapes : bool ref | |
11 | } | |
12 | ||
13 | type env = | |
14 | (Sym.t, info) Map.t | |
15 | ||
16 | let rec traverseExp ~(env : env) ~depth (exp : A.exp) = | |
17 | (match exp with | |
18 | | A.NilExp | |
19 | | A.IntExp _ | |
20 | | A.StringExp _ -> | |
21 | () | |
22 | | A.CallExp {func=_; args; pos=_} -> | |
23 | List.iter args ~f:(traverseExp ~env ~depth) | |
24 | | A.OpExp {oper=_; left; right; pos=_} -> | |
25 | traverseExp ~env ~depth left; | |
26 | traverseExp ~env ~depth right | |
27 | | A.RecordExp {fields=field_exps; typ=_; pos=_} -> | |
28 | List.iter field_exps ~f:(fun (_, exp, _) -> traverseExp ~env ~depth exp) | |
29 | | A.SeqExp exps -> | |
30 | List.iter exps ~f:(fun (exp, _) -> traverseExp ~env ~depth exp) | |
31 | | A.AssignExp {var; exp; pos=_} -> | |
32 | traverseVar ~env ~depth var; | |
33 | traverseExp ~env ~depth exp | |
34 | | A.IfExp {test; then'; else'; pos=_} -> | |
35 | traverseExp ~env ~depth test; | |
36 | traverseExp ~env ~depth then'; | |
37 | Opt.iter else' ~f:(fun e -> traverseExp ~env ~depth e) | |
38 | | A.WhileExp {test; body; pos=_} -> | |
39 | traverseExp ~env ~depth test; | |
40 | traverseExp ~env ~depth body | |
41 | | A.ForExp {var=_; lo; hi; body; pos=_; escape=_} -> | |
42 | traverseExp ~env ~depth lo; | |
43 | traverseExp ~env ~depth hi; | |
44 | traverseExp ~env ~depth body | |
45 | | A.BreakExp _ -> | |
46 | () | |
47 | | A.LetExp {decs; body; pos=_} -> | |
48 | traverseDecs ~env ~depth decs; | |
49 | traverseExp ~env ~depth body | |
50 | | A.ArrayExp {typ=_; size; init; pos=_} -> | |
51 | traverseExp ~env ~depth size; | |
52 | traverseExp ~env ~depth init | |
53 | | A.VarExp var -> | |
54 | traverseVar ~env ~depth var | |
55 | ) | |
56 | and traverseVar ~env ~depth (var : A.var) = | |
57 | (match var with | |
58 | | A.SimpleVar _ -> | |
59 | () | |
60 | | A.FieldVar {var; symbol=_; pos=_} -> | |
61 | traverseVar ~env ~depth var | |
62 | | A.SubscriptVar {var; exp; pos=_} -> | |
63 | traverseVar ~env ~depth var; | |
64 | traverseExp ~env ~depth exp | |
65 | ) | |
66 | and traverseDecs ~env ~depth (decs : A.dec list) = | |
67 | List.iter decs ~f:(traverseDec ~env ~depth) | |
68 | and traverseDec ~env ~depth (dec : A.dec) = | |
69 | (match dec with | |
70 | | A.FunDecs fundecs -> | |
71 | List.iter fundecs ~f:( | |
72 | fun (A.FunDec {name=_; params; result=_; body; pos=_}) -> | |
73 | traverseFields ~env ~depth params; | |
74 | traverseExp ~env ~depth body | |
75 | ) | |
76 | | A.VarDec {name=_; escape=_; typ=_; init; pos=_} -> | |
77 | traverseExp ~env ~depth init | |
78 | | A.TypeDecs typedecs -> | |
79 | List.iter typedecs ~f:(fun (A.TypeDec {name=_; ty; pos=_}) -> | |
80 | match ty with | |
81 | | A.NameTy _ | |
82 | | A.ArrayTy _ -> | |
83 | () | |
84 | | A.RecordTy fields -> | |
85 | traverseFields ~env ~depth fields | |
86 | ) | |
87 | ) | |
88 | and traverseFields ~env:_ ~depth:_ fields = | |
89 | List.iter fields ~f:(fun (A.Field {name=_; escape=_; typ=_; pos=_}) -> ()) | |
90 | ||
91 | let find ~prog = | |
92 | traverseExp ~env:Map.empty ~depth:0 prog |