depth_analysis.ml 1.6 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. open Types
  2. open Util
  3. let tag_index program =
  4. let nglobs = ref 0 in
  5. let consts = Hashtbl.create 32 in
  6. let rec trav stacklen node = match node with
  7. | GlobalDef _ ->
  8. let index = !nglobs in
  9. nglobs := !nglobs + 1;
  10. annotate (Index index) (transform_children (trav stacklen) node)
  11. | FunDef _ ->
  12. let stacklen = ref 0 in
  13. let node = transform_children (trav stacklen) node in
  14. annotate (Index !stacklen) node
  15. | VarDec _ | Dim _ ->
  16. let index = !stacklen in
  17. stacklen := !stacklen + 1;
  18. annotate (Index index) (transform_children (trav stacklen) node)
  19. | Const (value, _) ->
  20. let index = if Hashtbl.mem consts value then (
  21. Hashtbl.find consts value
  22. ) else (
  23. let index = Hashtbl.length consts in
  24. Hashtbl.add consts value index;
  25. index
  26. ) in
  27. annotate (Index index) node
  28. | _ -> transform_children (trav stacklen) node
  29. in trav (ref 0) program
  30. let rec strip = function
  31. | VarUse (dec, dims, ann) ->
  32. Var (nameof dec, optmap strip dims, ann)
  33. | VarLet (dec, dims, value, ann) ->
  34. Assign (nameof dec, optmap strip dims, strip value, ann)
  35. | FunUse (dec, args, ann) ->
  36. FunCall (nameof dec, List.map strip args, ann)
  37. | node -> transform_children strip node
  38. let rec phase input =
  39. log_line 2 "- Depth analysis";
  40. match input with
  41. | Ast node -> Ast (Context_analysis.analyse_context (tag_index (strip node)))
  42. | _ -> raise (InvalidInput "depth analysis")