/tryocaml/js_of_ocaml-patched/compiler/pure_fun.ml
OCaml | 82 lines | 53 code | 8 blank | 21 comment | 6 complexity | 02d22ddeb445d6097b3c7ba515cdb74f MD5 | raw file
Possible License(s): GPL-2.0
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 21open Code 22 23(****) 24 25let pure_expr pure_funs e = 26 match e with 27 Const _ | Block _ | Field _ | Closure _ | Constant _ -> 28 true 29 | Apply (f, l, n) -> 30 begin match n with 31 Some n -> let m = List.length l in 32 m < n || (m = n && VarSet.mem f pure_funs) 33 | None -> false 34 end 35 | Prim (p, l) -> 36 match p with 37 Extern f -> Primitive.is_pure f 38 | _ -> true 39 40let pure_instr pure_funs i = 41 match i with 42 Let (_, e) -> 43 pure_expr pure_funs e 44 | Set_field _ | Offset_ref _ | Array_set _ -> 45 false 46 47(****) 48 49let rec traverse blocks pc visited funs = 50 try 51 (AddrMap.find pc visited, visited, funs) 52 with Not_found -> 53 let visited = AddrMap.add pc false visited in 54 let (pure, visited, funs) = 55 fold_children blocks pc 56 (fun pc (pure, visited, funs) -> 57 let (pure', visited, funs) = traverse blocks pc visited funs in 58 (pure && pure', visited, funs)) 59 (true, visited, funs) 60 in 61 let (pure, visited, funs) = block blocks pc pure visited funs in 62 (pure, AddrMap.add pc pure visited, funs) 63 64and block blocks pc pure visited funs = 65 let b = AddrMap.find pc blocks in 66 let pure = match b.branch with Raise _ -> false | _ -> pure in 67 List.fold_left 68 (fun (pure, visited, funs) i -> 69 let (visited, funs) = 70 match i with 71 Let (x, Closure (_, (pc, _))) -> 72 let (pure, visited, funs) = traverse blocks pc visited funs in 73 (visited, if pure then VarSet.add x funs else funs) 74 | _ -> 75 (visited, funs) 76 in 77 (pure && pure_instr funs i, visited, funs)) 78 (pure, visited, funs) b.body 79 80let f (pc, blocks, _) = 81 let (_, _, funs) = traverse blocks pc AddrMap.empty VarSet.empty in 82 funs