فهرست منبع

Added depth analysis file (should have been in previous commit)

Taddeus Kroes 12 سال پیش
والد
کامیت
2aeb8c53aa
1فایلهای تغییر یافته به همراه52 افزوده شده و 0 حذف شده
  1. 52 0
      phases/depth_analysis.ml

+ 52 - 0
phases/depth_analysis.ml

@@ -0,0 +1,52 @@
+open Types
+open Util
+
+let tag_index program =
+    let nglobs = ref 0 in
+    let consts = Hashtbl.create 32 in
+    let rec trav stacklen node = match node with
+        | GlobalDef _ ->
+            let index = !nglobs in
+            nglobs := !nglobs + 1;
+            annotate (Index index) (transform_children (trav stacklen) node)
+
+        | FunDef _ ->
+            let stacklen = ref 0 in
+            let node = transform_children (trav stacklen) node in
+            annotate (Index !stacklen) node
+
+        | VarDec _ | Dim _ ->
+            let index = !stacklen in
+            stacklen := !stacklen + 1;
+            annotate (Index index) (transform_children (trav stacklen) node)
+
+        | Const (value, _) ->
+            let index = if Hashtbl.mem consts value then (
+                Hashtbl.find consts value
+            ) else (
+                let index = Hashtbl.length consts in
+                Hashtbl.add consts value index;
+                index
+            ) in
+            annotate (Index index) node
+
+        | _ -> transform_children (trav stacklen) node
+    in trav (ref 0) program
+
+let rec strip = function
+    | VarUse (dec, dims, ann) ->
+        Var (nameof dec, optmap strip dims, ann)
+
+    | VarLet (dec, dims, value, ann) ->
+        Assign (nameof dec, optmap strip dims, strip value, ann)
+
+    | FunUse (dec, args, ann) ->
+        FunCall (nameof dec, List.map strip args, ann)
+
+    | node -> transform_children strip node
+
+let rec phase input =
+    log_line 2 "- Depth analysis";
+    match input with
+    | Ast node -> Ast (Context_analysis.analyse_context (tag_index (strip node)))
+    | _ -> raise (InvalidInput "depth analysis")