clean up statement handling

Author: bobzhang

jscomp/all.depend

@@ -509,7 +509,8 @@ core/lam_pass_deep_flatten.cmx : core/lam_util.cmx core/lam_group.cmx \
     core/lam.cmx core/js_number.cmx ext/ident_set.cmx ext/ext_list.cmx \
     core/lam_pass_deep_flatten.cmi
 core/js_stmt_make.cmx : core/lam_print.cmx core/lam.cmx core/js_exp_make.cmx \
-    core/js_closure.cmx core/js_analyzer.cmx core/j.cmx core/js_stmt_make.cmi
+    core/js_closure.cmx core/js_analyzer.cmx core/j.cmx ext/ext_list.cmx \
+    core/js_stmt_make.cmi
 core/js_pass_flatten.cmx : core/js_stmt_make.cmx core/js_map.cmx \
     core/js_exp_make.cmx core/js_analyzer.cmx core/j.cmx ext/ext_list.cmx \
     core/js_pass_flatten.cmi

jscomp/core/js_of_lam_variant.ml

@@ -41,7 +41,7 @@ let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t =
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) -> 
               {J.case = i ; 
-               body = [S.return (E.str r)],
+               body = [S.return_stmt (E.str r)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
 
@@ -60,7 +60,7 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) -> 
               {J.case = i ; 
-               body = [S.return (E.index (E.var event) 0l)],
+               body = [S.return_stmt (E.index (E.var event) 0l)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
       , (* TODO: improve, one dispatch later, 
@@ -71,7 +71,7 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) =
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) -> 
               {J.case = i ; 
-               body = [S.return (E.index (E.var event) 1l)],
+               body = [S.return_stmt (E.index (E.var event) 1l)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
       )
@@ -87,7 +87,7 @@ let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) : E.t  =
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) -> 
               {J.case = i ; 
-               body = [S.return (E.int (Int32.of_int  r))],
+               body = [S.return_stmt (E.int (Int32.of_int  r))],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
 

jscomp/core/js_output.ml

@@ -67,7 +67,7 @@ let handle_name_tail
       then dummy
       else {block = []; value  = Some exp ; finished = False}
   | EffectCall, ReturnTrue _ ->
-      make [S.return  exp] ~finished:True
+      make [S.return_stmt  exp] ~finished:True
   | Declare (kind, n), ReturnFalse -> 
       make [ S.define ~kind n  exp]
   | Assign n ,ReturnFalse -> 
@@ -87,13 +87,14 @@ let handle_block_return
   | Assign n, ReturnFalse -> make (block @ [S.assign n exp])
   | (Declare _ | Assign _), ReturnTrue _ -> make [S.unknown_lambda lam] ~finished:True
   | EffectCall, ReturnFalse -> make block ~value:exp
-  | EffectCall, ReturnTrue _ -> make (block @ [S.return exp]) ~finished:True
+  | EffectCall, ReturnTrue _ -> make (block @ [S.return_stmt exp]) ~finished:True
   | NeedValue, _ ->  make block ~value:exp
 
 let statement_of_opt_expr (x : J.expression option) : J.statement =
   match x with 
-  | None -> S.empty ()
-  | Some x when Js_analyzer.no_side_effect_expression x -> S.empty ()
+  | None -> S.empty_stmt
+  | Some x when Js_analyzer.no_side_effect_expression x -> 
+    S.empty_stmt 
         (* TODO, pure analysis in lambda instead *)
   | Some x -> S.exp x 
 

jscomp/core/js_pass_flatten.ml

@@ -64,16 +64,16 @@ let flatten_map =
           end
       | Return ( {return_value = {expression_desc = Cond (a,b,c);  comment}}) 
         -> 
-          { statement_desc = If (a, [self#statement (S.return b)],  
-                                 Some [ self#statement (S.return c)]); comment}
+          { statement_desc = If (a, [self#statement (S.return_stmt b)],  
+                                 Some [ self#statement (S.return_stmt c)]); comment}
 
       | Return ({return_value = {expression_desc = Seq _; _} as v}) ->
           let block = Js_analyzer.rev_flatten_seq v  in
           begin match block with
           | {statement_desc = Exp last_one ; _} :: rest_rev
             ->  
               super#statement 
-                (S.block (Ext_list.rev_map_append (self#statement) rest_rev [S.return last_one]))
+                (S.block (Ext_list.rev_map_append (self#statement) rest_rev [S.return_stmt last_one]))
           | _ -> assert false
           end
       | Block [x]

jscomp/core/js_stmt_make.ml

@@ -31,28 +31,25 @@ module E = Js_exp_make
 
 type t = J.statement 
 
-let return ?comment e : t = 
+let return_stmt ?comment e : t = 
   {statement_desc = Return {return_value = e; } ; comment}
 
-let return_unit ?comment () : t =              
-  return ?comment  E.unit 
+let return_unit  : t list =              
+    [{ statement_desc = Return {return_value = E.unit; } ; 
+      comment = None}]
+  
+let empty_stmt  : t = 
+  { statement_desc = Block []; comment = None}
 
-let break ?comment () : t = 
-  {comment ; statement_desc = Break }
-
-let mk ?comment  statement_desc : t = 
-  {statement_desc; comment}
-
-let empty ?comment  () : t = { statement_desc = Block []; comment}
-
-let throw ?comment v : t = { statement_desc = J.Throw v; comment}
+let throw_stmt ?comment v : t = 
+  { statement_desc = J.Throw v; comment}
 
 (* avoid nested block *)
 let  rec block ?comment  (b : J.block)   : t =  
   match b with 
   | [{statement_desc = Block bs }  ] -> block bs
   | [b] -> b
-  | [] -> empty ?comment ()
+  | [] -> empty_stmt 
   | _ -> {statement_desc = Block b  ; comment}
 
 (* It's a statement, we can discard some values *)       
@@ -92,10 +89,12 @@ let int_switch ?comment   ?declaration ?default (e : J.expression)  clauses : t
   match e.expression_desc with 
   | Number (Int {i; _}) -> 
     let continuation =  
-      begin match List.find (fun (x : _ J.case_clause) -> x.case = (Int32.to_int i)) clauses
+      begin match Ext_list.find_opt 
+        (fun (x : _ J.case_clause) ->
+         if x.case = (Int32.to_int i) then Some (fst x.body) else None ) clauses
         with 
-        | case -> fst case.body
-        | exception Not_found -> 
+        | Some case -> case 
+        | None -> 
           begin match default with
             | Some x ->  x 
             | None -> assert false
@@ -124,11 +123,15 @@ let string_switch ?comment ?declaration  ?default (e : J.expression)  clauses :
   match e.expression_desc with 
   | Str (_,s) -> 
     let continuation = 
-      begin match List.find 
-                    (fun  (x : string J.case_clause) -> x.case = s) clauses
+      begin match Ext_list.find_opt 
+                    (fun  (x : string J.case_clause) ->
+                      if x.case = s then 
+                        Some (fst x.body)
+                      else None  
+                      ) clauses
         with 
-        | case ->  (fst case.body)
-        | exception Not_found -> 
+        | Some case ->  case
+        | None -> 
           begin match default with 
             | Some x -> x 
             | None -> assert false 
@@ -177,7 +180,7 @@ let rec if_ ?comment  ?declaration ?else_ (e : J.expression) (then_ : J.block)
     | _, [ {statement_desc = Return {return_value = b; _}; _}], 
       [ {statement_desc = Return {return_value = a; _}; _}]
       ->
-      return (E.econd e b a ) :: acc 
+      return_stmt (E.econd e b a ) :: acc 
     | _,  [ {statement_desc = 
                Exp {expression_desc = Bin(Eq, ({expression_desc = Var (Id id0); _} as l0), a0); _}; _}], 
       [ {statement_desc = 
@@ -345,7 +348,7 @@ let unknown_lambda ?(comment="unknown")  (lam : Lam.t ) : t =
 (* TODO: 
     actually, only loops can be labelled
 *)    
-let continue  ?comment   ?(label="") unit  : t = 
+let continue_stmt  ?comment   ?(label="") unit  : t = 
   { 
     statement_desc = J.Continue  label;
     comment;

jscomp/core/js_stmt_make.mli

@@ -34,11 +34,15 @@
 
 type t = J.statement 
 
-val mk :  ?comment:string  -> J.statement_desc -> t
 
-val empty : ?comment:string  ->  unit -> t
+(** empty statement, block of length 0 *)  
+val empty_stmt :  
+  t
 
-val throw : ?comment:string  -> J.expression -> t
+val throw_stmt :
+  ?comment:string  ->
+  J.expression ->
+  t
 
 val if_ : 
   ?comment:string  ->
@@ -51,59 +55,132 @@ val if_ :
   J.block -> 
   t
 
-val block : ?comment:string  -> J.block -> t
+(**   
+  turn a block into  a single statement,
+  avoid nested block
+*)  
+val block : 
+  ?comment:string  -> 
+  J.block ->
+  t
 
+(** [int_switch ~declaration e clauses]
+
+  The [declaration] is attached to peepwhole 
+  such pattern 
+
+  {[
+    var x ;
+    x = yy
+  ]}
+  
+  into
+  {[
+    var x = yy;
+  ]}
+*)  
 val int_switch :
-  ?comment:string -> ?declaration:Lam.let_kind * Ident.t -> 
-  ?default:J.block -> J.expression -> int J.case_clause list -> t 
+  ?comment:string -> 
+  ?declaration:Lam.let_kind * Ident.t -> 
+  ?default:J.block -> 
+  J.expression -> 
+  int J.case_clause list -> 
+  t 
 
-val string_switch : ?comment:string -> ?declaration:Lam.let_kind * Ident.t -> 
-  ?default:J.block -> J.expression -> string J.case_clause list -> t
+val string_switch : 
+  ?comment:string -> 
+  ?declaration:Lam.let_kind * Ident.t -> 
+  ?default:J.block ->
+  J.expression -> 
+  string J.case_clause list ->
+  t
 
-val declare_variable : ?comment:string ->
-  ?ident_info:J.ident_info 
-  -> kind:Lam.let_kind -> Ident.t -> t
+val declare_variable : 
+  ?comment:string ->
+  ?ident_info:J.ident_info ->
+  kind:Lam.let_kind -> 
+  Ident.t ->
+  t
 
 val define : 
   ?comment:string ->
   ?ident_info:J.ident_info ->
-  kind:Lam.let_kind -> Ident.t -> J.expression  -> t
+  kind:Lam.let_kind -> 
+  Ident.t ->
+  J.expression ->
+  t
 
 val alias_variable :
-  ?comment:string -> ?exp:J.expression -> Ident.t -> t
-val assign : ?comment:string  -> J.ident -> J.expression -> t
+  ?comment:string ->
+  ?exp:J.expression ->
+  Ident.t ->
+  t
 
-val assign_unit : ?comment:string  -> J.ident -> t
+val assign :
+  ?comment:string  ->
+  J.ident ->
+  J.expression ->
+  t
+
+val assign_unit :
+  ?comment:string  ->
+  J.ident ->
+  t
 
-val declare_unit : ?comment:string  -> J.ident -> t
+val declare_unit :
+  ?comment:string  ->
+  J.ident ->
+  t
 
-val while_ : ?comment:string ->
-  ?label:J.label -> ?env:Js_closure.t -> J.expression -> J.block -> t
+val while_ :
+  ?comment:string ->
+  ?label:J.label ->
+  ?env:Js_closure.t ->
+  J.expression ->
+  J.block ->
+  t
 
 val for_ : 
   ?comment:string ->
   ?env:Js_closure.t ->
   J.for_ident_expression option ->
   J.finish_ident_expression ->
-  J.for_ident  -> J.for_direction -> J.block -> t
+  J.for_ident  ->
+  J.for_direction ->
+  J.block ->
+  t
 
 val try_ :
   ?comment:string  ->
-  ?with_:J.ident * J.block -> ?finally:J.block -> J.block -> t
+  ?with_:J.ident * J.block ->
+  ?finally:J.block ->
+  J.block ->
+  t
 
-val exp : ?comment:string  -> J.expression -> t
+val exp :
+  ?comment:string  ->
+  J.expression ->
+  t
 
-val return : ?comment:string  -> J.expression -> t
+val return_stmt :
+  ?comment:string  ->
+  J.expression ->
+  t
 
-val unknown_lambda : ?comment:string  -> Lam.t -> t
+val unknown_lambda :
+  ?comment:string  ->
+  Lam.t ->
+  t
 
-val return_unit : ?comment:string -> unit -> t
+val return_unit : t list
 (** for ocaml function which returns unit 
     it will be compiled into [return 0] in js *)
 
-val break : ?comment:string  -> unit -> t
-
 (** if [label] is not set, it will default to empty *)  
-val continue : ?comment:string  -> ?label:J.label -> unit  -> t
+val continue_stmt :
+  ?comment:string  ->
+  ?label:J.label ->
+  unit  ->
+  t
 
 val debugger :  t