@@ -95120,14 +95120,14 @@ let rec eliminate_ref id (lam : Lam.t) =
9512095120 Lam.prim ~primitive ~args:(List.map (eliminate_ref id) args) loc
9512195121 | Lswitch(e, sw) ->
9512295122 Lam.switch(eliminate_ref id e)
95123- {sw_numconsts = sw.sw_numconsts;
95124- sw_consts =
95125- List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_consts;
95126- sw_numblocks = sw.sw_numblocks;
95127- sw_blocks =
95128- List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
95129- sw_failaction =
95130- Misc.may_map (eliminate_ref id) sw.sw_failaction; }
95123+ {sw_numconsts = sw.sw_numconsts;
95124+ sw_consts =
95125+ List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_consts;
95126+ sw_numblocks = sw.sw_numblocks;
95127+ sw_blocks =
95128+ List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
95129+ sw_failaction =
95130+ Misc.may_map (eliminate_ref id) sw.sw_failaction; }
9513195131 | Lstringswitch(e, sw, default) ->
9513295132 Lam.stringswitch
9513395133 (eliminate_ref id e)
@@ -95163,7 +95163,8 @@ let rec eliminate_ref id (lam : Lam.t) =
9516395163
9516495164
9516595165let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
95166- let subst : Lam.t Ident_hashtbl.t = Ident_hashtbl.create 31 in
95166+ let subst : Lam.t Ident_hashtbl.t = Ident_hashtbl.create 32 in
95167+ let string_table : string Ident_hashtbl.t = Ident_hashtbl.create 32 in
9516795168 let used v = (count_var v ).times > 0 in
9516895169 let rec simplif (lam : Lam.t) =
9516995170 match lam with
@@ -95204,15 +95205,20 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9520495205 | Const_pointer _ ) (* could be poly-variant [`A] -> [65a]*)
9520595206 | Lprim {primitive = Pfield (_);
9520695207 args = [Lprim {primitive = Pgetglobal _; _}]}
95207- )
95208+ )
9520895209 (* Const_int64 is no longer primitive
9520995210 Note for some constant which is not
9521095211 inlined, we can still record it and
9521195212 do constant folding independently
9521295213 *)
9521395214 ->
9521495215 Ident_hashtbl.add subst v (simplif l1); simplif l2
95216+ | _, Lconst (Const_base (Const_string (s,_)) ) ->
95217+ Ident_hashtbl.add string_table v s;
95218+ Lam.let_ Alias v l1 (simplif l2)
95219+ (* we need move [simplif l2] later, since adding Hashtbl does have side effect *)
9521595220 | _ -> Lam.let_ Alias v (simplif l1) (simplif l2)
95221+ (* for Alias, in most cases [l1] is already simplified *)
9521695222 end
9521795223 | Llet(StrictOpt as kind, v, l1, l2) ->
9521895224 (** can not be inlined since [l1] depend on the store
@@ -95224,7 +95230,16 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9522495230 *)
9522595231 if not @@ used v
9522695232 then simplif l2
95227- else Lam_util.refine_let ~kind v (simplif l1 ) (simplif l2)
95233+ else
95234+ let l1 = simplif l1 in
95235+ begin match l1 with
95236+ | Lconst(Const_base(Const_string(s,_))) ->
95237+ Ident_hashtbl.add string_table v s;
95238+ (* we need move [simplif l2] later, since adding Hashtbl does have side effect *)
95239+ Lam.let_ Alias v l1 (simplif l2)
95240+ | _ ->
95241+ Lam_util.refine_let ~kind v l1 (simplif l2)
95242+ end
9522895243 (* TODO: check if it is correct rollback to [StrictOpt]? *)
9522995244
9523095245 | Llet((Strict | Variable as kind), v, l1, l2) ->
@@ -95235,8 +95250,17 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9523595250 if Lam_analysis.no_side_effects l1
9523695251 then l2
9523795252 else Lam.seq l1 l2
95238- else Lam_util.refine_let ~kind v (simplif l1) (simplif l2)
95239-
95253+ else
95254+ let l1 = (simplif l1) in
95255+
95256+ begin match kind, l1 with
95257+ | Strict, Lconst(Const_base(Const_string(s,_)))
95258+ ->
95259+ Ident_hashtbl.add string_table v s;
95260+ Lam.let_ Alias v l1 (simplif l2)
95261+ | _ ->
95262+ Lam_util.refine_let ~kind v l1 (simplif l2)
95263+ end
9524095264 | Lifused(v, l) ->
9524195265 if used v then
9524295266 simplif l
@@ -95251,7 +95275,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9525195275 when Ext_list.same_length params args ->
9525295276 simplif (Lam_beta_reduce.beta_reduce params body args)
9525395277 | Lapply{ fn = Lfunction{kind = Tupled; params; body};
95254- args = [Lprim {primitive = Pmakeblock _; args; _}]; _}
95278+ args = [Lprim {primitive = Pmakeblock _; args; _}]; _}
9525595279 (** TODO: keep track of this parameter in ocaml trunk,
9525695280 can we switch to the tupled backend?
9525795281 *)
@@ -95267,6 +95291,53 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9526795291 Lam.letrec
9526895292 (List.map (fun (v, l) -> (v, simplif l)) bindings)
9526995293 (simplif body)
95294+ | Lprim {primitive=Pstringadd; args = [l;r]; loc } ->
95295+ begin
95296+ let l' = simplif l in
95297+ let r' = simplif r in
95298+ let opt_l =
95299+ match l' with
95300+ | Lconst(Const_base(Const_string(ls,_))) -> Some ls
95301+ | Lvar i -> Ident_hashtbl.find_opt string_table i
95302+ | _ -> None in
95303+ match opt_l with
95304+ | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
95305+ | Some l_s ->
95306+ let opt_r =
95307+ match r' with
95308+ | Lconst (Const_base (Const_string(rs,_))) -> Some rs
95309+ | Lvar i -> Ident_hashtbl.find_opt string_table i
95310+ | _ -> None in
95311+ begin match opt_r with
95312+ | None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
95313+ | Some r_s ->
95314+ Lam.const ((Const_base(Const_string(l_s^r_s, None))))
95315+ end
95316+ end
95317+
95318+ | Lprim {primitive = (Pstringrefu|Pstringrefs) as primitive ;
95319+ args = [l;r] ; loc
95320+ } -> (* TODO: introudce new constant *)
95321+ let l' = simplif l in
95322+ let r' = simplif r in
95323+ let opt_l =
95324+ match l' with
95325+ | Lconst (Const_base(Const_string(ls,_))) ->
95326+ Some ls
95327+ | Lvar i -> Ident_hashtbl.find_opt string_table i
95328+ | _ -> None in
95329+ begin match opt_l with
95330+ | None -> Lam.prim ~primitive ~args:[l';r'] loc
95331+ | Some l_s ->
95332+ match r with
95333+ |Lconst(Const_base(Const_int i)) ->
95334+ if i < String.length l_s && i >=0 then
95335+ Lam.const (Const_base (Const_char l_s.[i]))
95336+ else
95337+ Lam.prim ~primitive ~args:[l';r'] loc
95338+ | _ ->
95339+ Lam.prim ~primitive ~args:[l';r'] loc
95340+ end
9527095341 | Lprim {primitive; args; loc}
9527195342 -> Lam.prim ~primitive ~args:(List.map simplif args) loc
9527295343 | Lswitch(l, sw) ->
@@ -95281,7 +95352,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam =
9528195352 | Lstringswitch (l,sw,d) ->
9528295353 Lam.stringswitch
9528395354 (simplif l) (List.map (fun (s,l) -> s,simplif l) sw)
95284- (Misc.may_map simplif d)
95355+ (Misc.may_map simplif d)
9528595356 | Lstaticraise (i,ls) ->
9528695357 Lam.staticraise i (List.map simplif ls)
9528795358 | Lstaticcatch(l1, (i,args), l2) ->
0 commit comments