/tryocaml/js_of_ocaml-patched/compiler/pure_fun.ml

http://github.com/cago/tryocaml · OCaml · 82 lines · 53 code · 8 blank · 21 comment · 6 complexity · 02d22ddeb445d6097b3c7ba515cdb74f MD5 · raw file

  1. (* Js_of_ocaml compiler
  2. * http://www.ocsigen.org/js_of_ocaml/
  3. * Copyright (C) 2010 Jérôme Vouillon
  4. * Laboratoire PPS - CNRS Université Paris Diderot
  5. *
  6. * This program is free software; you can redistribute it and/or modify
  7. * it under the terms of the GNU Lesser General Public License as published by
  8. * the Free Software Foundation, with linking exception;
  9. * either version 2.1 of the License, or (at your option) any later version.
  10. *
  11. * This program is distributed in the hope that it will be useful,
  12. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. * GNU Lesser General Public License for more details.
  15. *
  16. * You should have received a copy of the GNU Lesser General Public License
  17. * along with this program; if not, write to the Free Software
  18. * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19. *)
  20. open Code
  21. (****)
  22. let pure_expr pure_funs e =
  23. match e with
  24. Const _ | Block _ | Field _ | Closure _ | Constant _ ->
  25. true
  26. | Apply (f, l, n) ->
  27. begin match n with
  28. Some n -> let m = List.length l in
  29. m < n || (m = n && VarSet.mem f pure_funs)
  30. | None -> false
  31. end
  32. | Prim (p, l) ->
  33. match p with
  34. Extern f -> Primitive.is_pure f
  35. | _ -> true
  36. let pure_instr pure_funs i =
  37. match i with
  38. Let (_, e) ->
  39. pure_expr pure_funs e
  40. | Set_field _ | Offset_ref _ | Array_set _ ->
  41. false
  42. (****)
  43. let rec traverse blocks pc visited funs =
  44. try
  45. (AddrMap.find pc visited, visited, funs)
  46. with Not_found ->
  47. let visited = AddrMap.add pc false visited in
  48. let (pure, visited, funs) =
  49. fold_children blocks pc
  50. (fun pc (pure, visited, funs) ->
  51. let (pure', visited, funs) = traverse blocks pc visited funs in
  52. (pure && pure', visited, funs))
  53. (true, visited, funs)
  54. in
  55. let (pure, visited, funs) = block blocks pc pure visited funs in
  56. (pure, AddrMap.add pc pure visited, funs)
  57. and block blocks pc pure visited funs =
  58. let b = AddrMap.find pc blocks in
  59. let pure = match b.branch with Raise _ -> false | _ -> pure in
  60. List.fold_left
  61. (fun (pure, visited, funs) i ->
  62. let (visited, funs) =
  63. match i with
  64. Let (x, Closure (_, (pc, _))) ->
  65. let (pure, visited, funs) = traverse blocks pc visited funs in
  66. (visited, if pure then VarSet.add x funs else funs)
  67. | _ ->
  68. (visited, funs)
  69. in
  70. (pure && pure_instr funs i, visited, funs))
  71. (pure, visited, funs) b.body
  72. let f (pc, blocks, _) =
  73. let (_, _, funs) = traverse blocks pc AddrMap.empty VarSet.empty in
  74. funs