Sketch-out a dummy escape-finding module

which nothing but traversal of AST at the moment

diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml
index a6e4af6..25eb2ce 100644 (file)
--- a/compiler/src/lib/tiger/tiger_semant.ml
+++ b/compiler/src/lib/tiger/tiger_semant.ml
@@ -4,6 +4,7 @@ module A         = Tiger_absyn
 module Dag       = Tiger_dag
 module Env       = Tiger_env
 module E         = Tiger_error
+module Escape    = Tiger_semant_escape
 module Pos       = Tiger_position
 module Sym       = Tiger_symbol
 module Translate = Tiger_translate
@@ -403,5 +404,6 @@ end
 open Semant
 
 let transProg absyn =
+  Escape.find absyn;
   let {exp = _; ty = _} = transExp absyn ~env:Env.base in
   ()

diff --git a/compiler/src/lib/tiger/tiger_semant_escape.ml b/compiler/src/lib/tiger/tiger_semant_escape.ml
new file mode 100644 (file)
index 0000000..499bc95
--- /dev/null
+++ b/compiler/src/lib/tiger/tiger_semant_escape.ml
@@ -0,0 +1,92 @@
+module List = ListLabels
+
+module A   = Tiger_absyn
+module Opt = Tiger_opt
+module Map = Tiger_map
+module Sym = Tiger_symbol
+
+type info =
+  { depth   : int
+  ; escapes : bool ref
+  }
+
+type env =
+  (Sym.t, info) Map.t
+
+let rec traverseExp ~(env : env) ~depth (exp : A.exp) =
+  (match exp with
+  | A.NilExp
+  | A.IntExp _
+  | A.StringExp _ ->
+      ()
+  | A.CallExp {func=_; args; pos=_} ->
+      List.iter args ~f:(traverseExp ~env ~depth)
+  | A.OpExp {oper=_; left; right; pos=_} ->
+      traverseExp ~env ~depth left;
+      traverseExp ~env ~depth right
+  | A.RecordExp {fields=field_exps; typ=_; pos=_} ->
+      List.iter field_exps ~f:(fun (_, exp, _) -> traverseExp ~env ~depth exp)
+  | A.SeqExp exps ->
+      List.iter exps ~f:(fun (exp, _) -> traverseExp ~env ~depth exp)
+  | A.AssignExp {var; exp; pos=_} ->
+      traverseVar ~env ~depth var;
+      traverseExp ~env ~depth exp
+  | A.IfExp {test; then'; else'; pos=_} ->
+      traverseExp ~env ~depth test;
+      traverseExp ~env ~depth then';
+      Opt.iter else' ~f:(fun e -> traverseExp ~env ~depth e)
+  | A.WhileExp {test; body; pos=_} ->
+      traverseExp ~env ~depth test;
+      traverseExp ~env ~depth body
+  | A.ForExp {var=_; lo; hi; body; pos=_; escape=_} ->
+      traverseExp ~env ~depth lo;
+      traverseExp ~env ~depth hi;
+      traverseExp ~env ~depth body
+  | A.BreakExp _ ->
+      ()
+  | A.LetExp {decs; body; pos=_} ->
+      traverseDecs ~env ~depth decs;
+      traverseExp ~env ~depth body
+  | A.ArrayExp {typ=_; size; init; pos=_} ->
+      traverseExp ~env ~depth size;
+      traverseExp ~env ~depth init
+  | A.VarExp var ->
+      traverseVar ~env ~depth var
+  )
+and traverseVar ~env ~depth (var : A.var) =
+  (match var with
+  | A.SimpleVar _ ->
+      ()
+  | A.FieldVar {var; symbol=_; pos=_} ->
+      traverseVar ~env ~depth var
+  | A.SubscriptVar {var; exp; pos=_} ->
+      traverseVar ~env ~depth var;
+      traverseExp ~env ~depth exp
+  )
+and traverseDecs ~env ~depth (decs : A.dec list) =
+  List.iter decs ~f:(traverseDec ~env ~depth)
+and traverseDec ~env ~depth (dec : A.dec) =
+  (match dec with
+  | A.FunDecs fundecs ->
+      List.iter fundecs ~f:(
+        fun (A.FunDec {name=_; params; result=_; body; pos=_}) ->
+          traverseFields ~env ~depth params;
+          traverseExp ~env ~depth body
+      )
+  | A.VarDec {name=_; escape=_; typ=_; init; pos=_} ->
+      traverseExp ~env ~depth init
+  | A.TypeDecs typedecs ->
+      List.iter typedecs ~f:(fun (A.TypeDec {name=_; ty; pos=_}) ->
+        match ty with
+        | A.NameTy _
+        | A.ArrayTy _ ->
+            ()
+        | A.RecordTy fields ->
+            traverseFields ~env ~depth fields
+      )
+  )
+and traverseFields ~env:_ ~depth:_ fields =
+  List.iter fields ~f:(fun (A.Field {name=_; escape=_; typ=_; pos=_}) -> ())
+
+let find ~prog =
+  traverseExp ~env:Map.empty ~depth:0 prog

diff --git a/compiler/src/lib/tiger/tiger_semant_escape.mli b/compiler/src/lib/tiger/tiger_semant_escape.mli
new file mode 100644 (file)
index 0000000..21b3d07
--- /dev/null
+++ b/compiler/src/lib/tiger/tiger_semant_escape.mli
@@ -0,0 +1 @@
+val find : prog:Tiger_absyn.t -> unit