Permalink
Browse files

[cleanup] qmljsimp: removing some dead code (and slighly refactoring …

…on the way)
  • Loading branch information...
1 parent f2ce0c4 commit 750fba915133c1983e273de8adaf380389e06aa2 Valentin Gatien-Baron committed Jul 22, 2011
View
@@ -9,4 +9,4 @@ qmljsimp/Imp_SumCase
qmljsimp/Imp_Renaming
qmljsimp/Imp_CleanUp
qmljsimp/Imp_Inlining
-qmljsimp/jsPasses
+qmljsimp/Imp_SimpleRenaming
View
@@ -815,7 +815,7 @@ let rename_code_elt code_elt =
acc, J.Je_function (label,name,params,body)
| _ -> tra acc e)
false code_elt in
- if failed then JsPasses.local_alpha_stm code_elt else code_elt
+ if failed then Imp_SimpleRenaming.local_alpha_stm code_elt else code_elt
let rename code =
List.map rename_code_elt code
@@ -0,0 +1,226 @@
+(*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*)
+
+module J = JsAst
+module Cons = JsCons
+
+let (|>) = InfixOperator.(|>)
+
+module IdentMap = JsAst.IdentMap;;
+module IdentSet = JsAst.IdentSet;;
+
+module List = Base.List
+module String = Base.String
+
+type jsp = JsAst.code -> JsAst.code
+
+(*
+ If we need to have unicity of annotation,
+ we must replace rlabel by :
+ {[
+ let rlabel = Annot.refresh
+ ]}
+*)
+external rlabel : Annot.label -> Annot.label = "%identity"
+
+module Rename :
+sig
+ type env
+ val empty : env
+ val add : JsAst.ident -> env -> env
+ val new_binding : env -> JsAst.ident -> env * JsAst.ident
+ val resolve : env -> JsAst.ident -> JsAst.ident
+ val assert_resolve : env -> JsAst.ident -> JsAst.ident
+end =
+struct
+
+ (*
+ Generate a short JS identifier from an int.
+ In case the identifier returned is a js keyword,
+ skip it, and inspect the next generated one.
+
+ The function return the next int to use for generating
+ the next short ident.
+ *)
+ let rec name_of_int i =
+ let name = IdentGenerator.alphanum i in
+ if JsAst.is_keyword name then name_of_int (i+1) else JsCons.Ident.native name, (i+1)
+
+ type env = JsAst.ident IdentMap.t * int
+ let empty = (IdentMap.empty, 0)
+
+ let new_binding (map, number) ident =
+ let new_ident, number = name_of_int number in
+ let map = IdentMap.add ident new_ident map in
+ (map, number), new_ident
+
+ let add ident (map, number) =
+ let new_ident, number = name_of_int number in
+ let map = IdentMap.add ident new_ident map in
+ (map, number)
+
+ let resolve (map, _) ident =
+ match IdentMap.find_opt ident map with
+ | Some ident -> ident
+ | None -> ident
+
+ let assert_resolve (map, _) ident =
+ match IdentMap.find_opt ident map with
+ | Some ident -> ident
+ | None ->
+ assert false
+end
+
+(*
+ Collect vars and function local to a statement, without entering
+ internal function inside other functions.
+*)
+let stmt_collect_locals acc s =
+ JsWalk.OnlyStatement.traverse_fold (
+ fun tra acc -> function
+ | J.Js_var (_, ident, _) -> Rename.add ident acc
+ | J.Js_function (_, ident, _, _) -> Rename.add ident acc (* NOT traversing *)
+ | J.Js_trycatch (_,_,catches,_) ->
+ let acc = List.fold_left (fun acc (ident,_,_) -> Rename.add ident acc) acc catches in
+ tra acc s
+ | s ->
+ tra acc s
+ ) acc s
+
+(*
+ Cf the notice for the 3 following recursive functions.
+
+ {[
+ let rec rename_expr
+ and rename_function
+ and rename_statement
+ ]}
+*)
+
+let rec rename_expr (acc : Rename.env) e =
+ JsWalk.OnlyExpr.traverse_map (
+ fun tra e ->
+ match e with
+ | J.Je_function (label, ident, params, body) ->
+ let recons (ident, params, body) = J.Je_function (label, ident, params, body) in
+ recons (rename_function acc ident params body)
+
+ | J.Je_ident (label, ident) ->
+ let ident = Rename.resolve acc ident in
+ let e = J.Je_ident (label, ident) in
+ e
+
+ | e ->
+ tra e
+ ) e
+
+and rename_function acc ident params body =
+ let ident = Option.map (Rename.resolve acc) ident in
+ let acc, params = List.fold_left_map Rename.new_binding acc params in
+ let acc = List.fold_left stmt_collect_locals acc body in
+ let body = List.tail_map (rename_statement acc) body in
+ (ident, params, body)
+
+and rename_statement acc stmt =
+ JsWalk.TStatement.traverse_map (
+ fun traS _traE s ->
+ match s with
+ | J.Js_var (label, ident, expr) ->
+ let ident = Rename.resolve acc ident in
+ let expr = Option.map (rename_expr acc) expr in
+ J.Js_var (label, ident, expr)
+
+ | J.Js_function (label, ident, params, body) ->
+ let recons (ident, params, body) =
+ let ident = Option.get ident in
+ J.Js_function (label, ident, params, body) in
+ recons (rename_function acc (Some ident) params body)
+
+ | J.Js_trycatch (label, body, catches, finally) ->
+ let catches = List.map (fun (ident, e, s) -> (Rename.resolve acc ident, e, s)) catches in
+ let s = J.Js_trycatch (label, body, catches, finally) in
+ traS s
+
+ (*
+ the node with is not supported by the local renaming
+ *)
+ | J.Js_with _ -> assert false
+
+ | s -> traS s
+ )
+ (fun _traE _traS e -> rename_expr acc e)
+ stmt
+
+
+(*
+ Renaming function parameters, and local variables.
+ This renaming does not affect toplevel identifiers
+*)
+let local_alpha_stm stm =
+ let acc = Rename.empty in
+ rename_statement acc stm
+let local_alpha code =
+ let acc = Rename.empty in
+ List.tail_map (rename_statement acc) code
+
+(*
+ NOTICE:
+
+let rec rename_expr (acc : Rename.env) e =
+ let rec aux e =
+ ExprOnly.map_down
+ ou un traverse_map_down où on fait gaffe aux je_function
+ map_down utilisant acc
+ sauf dans le cas Je_function,
+ où on appelle une regle de renommage des fonctions
+ qui appelle rename_statement avec (acc + quelque chose)
+ in
+ aux_expr e
+
+and rename_function recons acc ident params body =
+ 1) on rename ident avec ce acc,
+
+ 2) collect les var et les function dans body sans rentrer dans les function
+ fold sur statement only, pas de tra sur Js_function
+ StatementOnly.traverse_fold
+
+ 3) ca en fait un acc2,
+ on met params dans acc2
+ on renomme le body avec acc2 (rename_statement)
+ et on recons
+
+and rename_statement acc s =
+
+ - si tombe sur Js_function, simplement appliquer rename_function
+ - si var : simplement appliquer le renommage
+
+ sinon : rename_expr avec le meme acc
+ et tra acc sur les statement
+ TStatement.traverse_map
+ avec rename_expr sur les expr
+ et tra sur les statement
+
+TStatement.traverse_map
+ (fun traS traE e -> rename_expr acc e)
+ (fun traS traE s ->
+ match s with
+ | Js_function -> rename_function
+ | JsVar -> lookup acc pour renommer
+ | s -> traS s)
+ s
+*)
@@ -0,0 +1,30 @@
+(*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*)
+
+(**
+ This function makes an alpha renaming on each local value:
+ - function parameters
+ - local function variables
+ - local letin
+ - identifiers bound by catch
+
+ using a short ident generator, using a reset for each toplevel declaration,
+ for keeping identifier short, even on a huge code.
+*)
+val local_alpha_stm : JsAst.statement -> JsAst.statement
+val local_alpha : JsAst.code -> JsAst.code
Oops, something went wrong.

0 comments on commit 750fba9

Please sign in to comment.