2323 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424
2525type ident = Ident .t
26-
2726type apply_status = App_na | App_infer_full | App_uncurry
2827
2928type ap_info = {
@@ -414,13 +413,12 @@ let switch lam (lam_switch : lambda_switch) : t =
414413
415414let stringswitch (lam : t ) cases default : t =
416415 match lam with
417- | Lconst (Const_string a ) -> Ext_list. assoc_by_string cases a default
416+ | Lconst (Const_string { s; unicode = false } ) ->
417+ Ext_list. assoc_by_string cases s default
418418 | _ -> Lstringswitch (lam, cases, default)
419419
420420let true_ : t = Lconst Const_js_true
421-
422421let false_ : t = Lconst Const_js_false
423-
424422let unit : t = Lconst Const_js_undefined
425423
426424let rec seq (a : t ) b : t =
@@ -436,28 +434,19 @@ let rec seq (a : t) b : t =
436434 | _ -> Lsequence (a, b)
437435
438436let var id : t = Lvar id
439-
440437let global_module id = Lglobal_module id
441-
442438let const ct : t = Lconst ct
443439
444440let function_ ~attr ~arity ~params ~body : t =
445441 Lfunction { arity; params; body; attr }
446442
447443let let_ kind id e body : t = Llet (kind, id, e, body)
448-
449444let letrec bindings body : t = Lletrec (bindings, body)
450-
451445let while_ a b : t = Lwhile (a, b)
452-
453446let try_ body id handler : t = Ltrywith (body, id, handler)
454-
455447let for_ v e1 e2 dir e3 : t = Lfor (v, e1, e2, dir, e3)
456-
457448let assign v l : t = Lassign (v, l)
458-
459449let staticcatch a b c : t = Lstaticcatch (a, b, c)
460-
461450let staticraise a b : t = Lstaticraise (a, b)
462451
463452module Lift = struct
@@ -478,9 +467,7 @@ module Lift = struct
478467 Lconst ((Const_nativeint b)) *)
479468
480469 let int64 b : t = Lconst (Const_int64 b)
481-
482- let string b : t = Lconst (Const_string b)
483-
470+ let string s : t = Lconst (Const_string { s; unicode = false })
484471 let char b : t = Lconst (Const_char b)
485472end
486473
@@ -496,8 +483,8 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
496483 Lift. int (Int32. of_float (float_of_string a))
497484 (* | Pnegfloat -> Lift.float (-. a) *)
498485 (* | Pabsfloat -> Lift.float (abs_float a) *)
499- | Pstringlength , Const_string a ->
500- Lift. int (Int32. of_int (String. length a ))
486+ | Pstringlength , Const_string { s; unicode = false } ->
487+ Lift. int (Int32. of_int (String. length s ))
501488 (* | Pnegbint Pnativeint, ( (Const_nativeint i)) *)
502489 (* -> *)
503490 (* Lift.nativeint (Nativeint.neg i) *)
@@ -568,8 +555,13 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
568555 | Psequor , Const_js_true , (Const_js_true | Const_js_false ) -> true_
569556 | Psequor , Const_js_false , Const_js_true -> true_
570557 | Psequor , Const_js_false , Const_js_false -> false_
571- | Pstringadd , Const_string a , Const_string b -> Lift. string (a ^ b)
572- | (Pstringrefs | Pstringrefu ), Const_string a , Const_int { i = b } -> (
558+ | ( Pstringadd ,
559+ Const_string { s = a; unicode = false },
560+ Const_string { s = b; unicode = false } ) ->
561+ Lift. string (a ^ b)
562+ | ( (Pstringrefs | Pstringrefu ),
563+ Const_string { s = a; unicode = false },
564+ Const_int { i = b } ) -> (
573565 try Lift. char (String. get a (Int32. to_int b)) with _ -> default () )
574566 | _ -> default () )
575567 | _ -> (
0 commit comments