Skip to content

Commit 16f2327

Browse files
authored
Merge pull request #445 from bloomberg/bs_lambda
clean up, improve lam_iter, and free variables
2 parents 4bcdad6 + a7a5484 commit 16f2327

17 files changed

+228
-212
lines changed

jscomp/core.mllib

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ config_util
88

99

1010
lam
11+
lam_iter
1112
lam_print
1213
lam_compile_env
1314
lam_dispatch_primitive

jscomp/lam.ml

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -119,8 +119,8 @@ let const ct : t = Lconst ct
119119
let apply fn args loc status : t =
120120
Lapply { fn; args; loc ;
121121
status }
122-
let function_ arity kind ids body : t =
123-
Lfunction { arity; kind; params = ids; body}
122+
let function_ ~arity ~kind ~params ~body : t =
123+
Lfunction { arity; kind; params ; body}
124124

125125
let let_ kind id e body : t
126126
= Llet (kind,id,e,body)
@@ -241,7 +241,7 @@ let lift_int32 b : t =
241241
let lift_int64 b : t =
242242
Lconst (Const_base (Const_int64 b))
243243

244-
let prim (prim : Prim.t) (ll : t list) : t =
244+
let prim ~primitive:(prim : Prim.t) ~args:(ll : t list) : t =
245245
let default () : t = Lprim { primitive = prim ;args = ll } in
246246
match ll with
247247
| [Lconst a] ->
@@ -395,8 +395,10 @@ let rec convert (lam : Lambda.lambda) : t =
395395
| Lapply (fn,args,info)
396396
-> apply (convert fn) (List.map convert args)
397397
info.apply_loc info.apply_status
398-
| Lfunction (kind, ids,body)
399-
-> function_ (List.length ids) kind ids (convert body)
398+
| Lfunction (kind, params,body)
399+
-> function_
400+
~arity:(List.length params) ~kind ~params
401+
~body:(convert body)
400402
| Llet (kind,id,e,body)
401403
-> Llet(kind,id,convert e, convert body)
402404
| Lletrec (bindings,body)

jscomp/lam.mli

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,10 @@ val var : Ident.t -> t
8989
val const : Lambda.structured_constant -> t
9090

9191
val apply : t -> t list -> Location.t -> Lambda.apply_status -> t
92-
val function_ : int -> Lambda.function_kind -> Ident.t list -> t -> t
92+
val function_ :
93+
arity:int ->
94+
kind:Lambda.function_kind -> params:Ident.t list -> body:t -> t
95+
9396
val let_ : Lambda.let_kind -> Ident.t -> t -> t -> t
9497
val letrec : (Ident.t * t) list -> t -> t
9598
val if_ : triop
@@ -115,7 +118,7 @@ val send :
115118
t -> t -> t list ->
116119
Location.t -> t
117120

118-
val prim : Lambda.primitive -> t list -> t
121+
val prim : primitive:Lambda.primitive -> args:t list -> t
119122

120123
val staticcatch :
121124
t -> int * Ident.t list -> t -> t

jscomp/lam_beta_reduce.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ let rewrite (map : (Ident.t, _) Hashtbl.t)
102102
| Lfunction{arity; kind; params; body} ->
103103
let params = List.map rebind params in
104104
let body = aux body in
105-
Lam.function_ arity kind params body
105+
Lam.function_ ~arity ~kind ~params ~body
106106
| Lstaticcatch(l1, (i,xs), l2) ->
107107
let l1 = aux l1 in
108108
let xs = List.map rebind xs in
@@ -117,7 +117,7 @@ let rewrite (map : (Ident.t, _) Hashtbl.t)
117117
| Lconst _ -> lam
118118
| Lprim {primitive; args } ->
119119
(* here it makes sure that global vars are not rebound *)
120-
Lam.prim primitive (List.map aux args)
120+
Lam.prim ~primitive ~args:(List.map aux args)
121121
| Lapply {fn; args; loc; status } ->
122122
let fn = aux fn in
123123
let args = List.map aux args in

jscomp/lam_beta_reduce_util.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -75,12 +75,12 @@ let simple_beta_reduce params body args =
7575
List.iter2 (fun p a -> Hashtbl.add param_hash p {lambda = a; used = false }) params args
7676
in
7777
begin match aux [] args' with
78-
| us ->
78+
| args ->
7979
let result =
8080
Hashtbl.fold (fun _param {lambda; used} code ->
8181
if not used then
8282
Lam.seq lambda code
83-
else code) param_hash (Lam.prim primitive us ) in
83+
else code) param_hash (Lam.prim ~primitive ~args) in
8484
Hashtbl.clear param_hash;
8585
Some result
8686
| exception _ ->

jscomp/lam_compile.ml

Lines changed: 21 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -911,15 +911,22 @@ and
911911
begin
912912
match fn with
913913
| Lfunction {params = [_]; body}
914-
-> compile_lambda cxt (Lam.function_ 0 Curried [] body)
914+
->
915+
compile_lambda cxt
916+
(Lam.function_
917+
~arity:0
918+
~kind:Curried
919+
~params:[]
920+
~body)
915921
| _ ->
916922
compile_lambda cxt
917-
(Lam.function_ 0 Curried []
918-
@@
919-
Lam.apply fn
920-
[Lam.unit]
921-
Location.none App_na
922-
)
923+
(Lam.function_ ~arity:0
924+
~kind:Curried ~params:[]
925+
~body:(
926+
Lam.apply fn
927+
[Lam.unit]
928+
Location.none App_na
929+
))
923930
end
924931
else
925932
begin match fn with
@@ -928,10 +935,14 @@ and
928935
if len = arity then
929936
compile_lambda cxt fn
930937
else if len > arity then
931-
let first, rest = Ext_list.take arity args in
938+
let params, rest = Ext_list.take arity args in
932939
compile_lambda cxt
933-
(Lam.function_ arity
934-
kind first (Lam.function_ (len - arity) kind rest body))
940+
(Lam.function_
941+
~arity
942+
~kind ~params
943+
~body:(Lam.function_ ~arity:(len - arity)
944+
~kind ~params:rest ~body)
945+
)
935946
else
936947
compile_lambda cxt
937948
(Lam_util.eta_conversion arity

jscomp/lam_compile_global.ml

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -44,13 +44,19 @@ let query_lambda id env =
4444
Lam_compile_env.query_and_add_if_not_exist (Lam_module_ident.of_ml id)
4545
(Has_env env)
4646
~not_found:(fun id -> assert false)
47-
~found:(fun {signature = sigs; _} ->
48-
Lam.prim (Pmakeblock(0, Blk_module None, Immutable))
49-
(List.mapi (fun i _ ->
50-
Lam.prim (Pfield (i, Lambda.Fld_na))
51-
[Lam.prim (Pgetglobal id) [] ] )
52-
sigs)
53-
)
47+
~found:(fun {signature = sigs; _}
48+
->
49+
Lam.prim
50+
~primitive:(Pmakeblock(0, Blk_module None, Immutable))
51+
~args:(
52+
List.mapi (fun i _ ->
53+
Lam.prim
54+
~primitive:(Pfield (i, Lambda.Fld_na))
55+
~args:[
56+
Lam.prim
57+
~primitive:(Pgetglobal id)
58+
~args:[]])
59+
sigs))
5460

5561

5662
(* Given an module name and position, find its corresponding name *)

jscomp/lam_group.ml

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -140,7 +140,10 @@ let deep_flatten
140140
let id' = Ident.rename id in
141141
flatten acc
142142
(Lam.let_ str id' arg
143-
(Lam.let_ Alias id (Lam.prim (Pccall p) [Lam.var id'])
143+
(Lam.let_ Alias id
144+
(Lam.prim
145+
~primitive:(Pccall p)
146+
~args: [Lam.var id'])
144147
body)
145148
)
146149
| Llet (str,id,arg,body) ->
@@ -302,11 +305,11 @@ let deep_flatten
302305
(* TODO: note when int is too big, [caml_int64_to_float] is unsafe *)
303306
Lam.const
304307
(Const_base (Const_float (Js_number.to_string (Int64.to_float i) )))
305-
| Lprim {primitive = p; args = ll}
308+
| Lprim {primitive ; args }
306309
->
307310
begin
308-
let ll = List.map aux ll in
309-
match p, ll with
311+
let args = List.map aux args in
312+
match primitive, args with
310313
(* Simplify %revapply, for n-ary functions with n > 1 *)
311314
| Prevapply loc, [x; Lapply {fn = f; args; _}]
312315
| Prevapply loc, [x; Levent (Lapply {fn = f; args; _},_)] ->
@@ -319,10 +322,10 @@ let deep_flatten
319322
Lam.apply f (args@[x]) loc App_na
320323
| Pdirapply loc, [f; x] ->
321324
Lam.apply f [x] loc App_na
322-
| _ -> Lam.prim p ll
325+
| _ -> Lam.prim ~primitive ~args
323326
end
324327
| Lfunction{arity; kind; params; body = l} ->
325-
Lam.function_ arity kind params (aux l)
328+
Lam.function_ ~arity ~kind ~params ~body:(aux l)
326329
| Lswitch(l, {sw_failaction;
327330
sw_consts;
328331
sw_blocks;

jscomp/lam_inline_util.ml

Lines changed: 7 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -28,41 +28,18 @@
2828

2929

3030

31+
(* TODO: add a context, like
32+
[args]
33+
[Lfunction(params,body)]
34+
*)
3135

3236

3337
let maybe_functor (name : string) =
3438
name.[0] >= 'A' && name.[0] <= 'Z'
3539

3640

37-
let should_be_functor (name : string) lam =
38-
maybe_functor name &&
39-
(function | Lam.Lfunction _ -> true | _ -> false) lam
41+
let should_be_functor (name : string) (lam : Lam.t) =
42+
maybe_functor name &&
43+
(match lam with Lfunction _ -> true | _ -> false)
4044

41-
(* TODO: add a context, like
42-
[args]
43-
[Lfunction(params,body)]
44-
*)
4545

46-
(* HONGBO .. doe snot look like this function is used (not in .mli) *)
47-
(* let app_definitely_inlined (body : Lam.t) = *)
48-
(* match body with *)
49-
(* | Lvar _ *)
50-
(* | Lconst _ *)
51-
(* | Lprim _ *)
52-
(* | Lapply _ -> true *)
53-
(* | Llet _ *)
54-
(* | Lletrec _ *)
55-
(* | Lstringswitch _ *)
56-
(* | Lswitch _ *)
57-
(* | Lstaticraise _ *)
58-
(* | Lfunction _ *)
59-
(* | Lstaticcatch _ *)
60-
(* | Ltrywith _ *)
61-
(* | Lifthenelse _ *)
62-
(* | Lsequence _ *)
63-
(* | Lwhile _ *)
64-
(* | Lfor _ *)
65-
(* | Lassign _ *)
66-
(* | Lsend _ *)
67-
(* | Levent _ *)
68-
(* | Lifused _ -> false *)

jscomp/lam_iter.ml

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
26+
let inner_iter f l =
27+
match (l : Lam.t) with
28+
Lvar _
29+
| Lconst _ -> ()
30+
| Lapply{fn; args; _} ->
31+
f fn; List.iter f args
32+
| Lfunction{body;_} ->
33+
f body
34+
| Llet(str, id, arg, body) ->
35+
f arg; f body
36+
| Lletrec(decl, body) ->
37+
f body;
38+
List.iter (fun (id, exp) -> f exp) decl
39+
| Lprim {args; _} ->
40+
List.iter f args
41+
| Lswitch(arg, sw) ->
42+
f arg;
43+
List.iter (fun (key, case) -> f case) sw.sw_consts;
44+
List.iter (fun (key, case) -> f case) sw.sw_blocks;
45+
begin match sw.sw_failaction with
46+
| None -> ()
47+
| Some a -> f a
48+
end
49+
| Lstringswitch (arg,cases,default) ->
50+
f arg ;
51+
List.iter (fun (_,act) -> f act) cases ;
52+
begin match default with
53+
| None -> ()
54+
| Some a -> f a
55+
end
56+
| Lstaticraise (_,args) ->
57+
List.iter f args
58+
| Lstaticcatch(e1, (_,vars), e2) ->
59+
f e1; f e2
60+
| Ltrywith(e1, exn, e2) ->
61+
f e1; f e2
62+
| Lifthenelse(e1, e2, e3) ->
63+
f e1; f e2; f e3
64+
| Lsequence(e1, e2) ->
65+
f e1; f e2
66+
| Lwhile(e1, e2) ->
67+
f e1; f e2
68+
| Lfor(v, e1, e2, dir, e3) ->
69+
f e1; f e2; f e3
70+
| Lassign(id, e) ->
71+
f e
72+
| Lsend (k, met, obj, args, _) ->
73+
List.iter f (met::obj::args)
74+
| Levent (lam, evt) ->
75+
f lam
76+
| Lifused (v, e) ->
77+
f e
78+

jscomp/lam_iter.mli

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
val inner_iter : (Lam.t -> unit) -> Lam.t -> unit

jscomp/lam_pass_alpha_conversion.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,10 +73,10 @@ let alpha_conversion (meta : Lam_stats.meta) (lam : Lam.t) : Lam.t =
7373
let bindings = List.map (fun (k,l) -> (k, simpl l)) bindings in
7474
Lam.letrec bindings (simpl body)
7575
| Lprim {primitive; args } ->
76-
Lam.prim primitive (List.map simpl args)
76+
Lam.prim ~primitive ~args:(List.map simpl args)
7777
| Lfunction {arity; kind; params; body = l} ->
7878
(* Lam_mk.lfunction kind params (simpl l) *)
79-
Lam.function_ arity kind params (simpl l)
79+
Lam.function_ ~arity ~kind ~params ~body:(simpl l)
8080
| Lswitch (l, {sw_failaction;
8181
sw_consts;
8282
sw_blocks;

0 commit comments

Comments
 (0)