File Fix-usage-of-mutable-strings-for-OCaml-4.02.patch of Package cppmem
From 56042bcda0010b1f90fa8c1b31ea73b806cd9e0f Mon Sep 17 00:00:00 2001
From: Aaron Puchert <aaron.puchert@sap.com>
Date: Tue, 10 Jun 2025 22:56:53 +0200
Subject: [PATCH 3/3] Fix usage of mutable strings for OCaml >4.02
There were lots of errors and warnings about this:
+ /usr/bin/ocamlc.opt -c -g -I ../lem-ocaml-lib-for-cmm/_build/ -g -I cil-parser -o pp.cmo pp.ml
File "pp.ml", line 1181, characters 12-25:
1181 | let r = String.create l in
^^^^^^^^^^^^^
Alert deprecated: Stdlib.String.create
Use Bytes.create/BytesLabels.create instead.
File "pp.ml", line 1182, characters 26-43:
1182 | for i = 0 to l - 1 do String.unsafe_set r i (f(String.unsafe_get s i)) done;
^^^^^^^^^^^^^^^^^
Alert deprecated: Stdlib.String.unsafe_set
File "pp.ml", line 1183, characters 4-5:
1183 | r
^
Error: This expression has type bytes but an expression was expected of type
string
Similar in other files. The reason is that since OCaml 4.02, strings are
no longer mutable. So for all mutations, we switch to a sequence of
bytes instead, and convert back to a string at the end.
---
cil-parser/errormsg.ml | 18 +++++++++---------
cil-parser/pretty.ml | 18 +++++++++---------
js_of_ocaml-1.2/compiler/code.ml | 21 +++++++++++----------
js_of_ocaml-1.2/compiler/parse.ml | 14 +++++++-------
js_of_ocaml-1.2/compiler/pretty_print.ml | 2 +-
js_of_ocaml-1.2/compiler/util.ml | 4 ++--
pp.ml | 6 +++---
7 files changed, 42 insertions(+), 41 deletions(-)
diff --git a/cil-parser/errormsg.ml b/cil-parser/errormsg.ml
index 7501f72..6b93619 100755
--- a/cil-parser/errormsg.ml
+++ b/cil-parser/errormsg.ml
@@ -214,20 +214,20 @@ let rem_quotes str = String.sub str 1 ((String.length str) - 2)
(* Change \ into / in file names. To avoid complications with escapes *)
let cleanFileName str =
- let str1 =
- if str <> "" && String.get str 0 = '"' (* '"' ( *)
- then rem_quotes str else str in
- let l = String.length str1 in
+ let str1 = Bytes.of_string
+ (if str <> "" && String.get str 0 = '"' (* '"' ( *)
+ then rem_quotes str else str) in
+ let l = Bytes.length str1 in
let rec loop (copyto: int) (i: int) =
if i >= l then
- String.sub str1 0 copyto
+ Bytes.to_string (Bytes.sub str1 0 copyto)
else
- let c = String.get str1 i in
+ let c = Bytes.get str1 i in
if c <> '\\' then begin
- String.set str1 copyto c; loop (copyto + 1) (i + 1)
+ Bytes.set str1 copyto c; loop (copyto + 1) (i + 1)
end else begin
- String.set str1 copyto '/';
- if i < l - 2 && String.get str1 (i + 1) = '\\' then
+ Bytes.set str1 copyto '/';
+ if i < l - 2 && Bytes.get str1 (i + 1) = '\\' then
loop (copyto + 1) (i + 2)
else
loop (copyto + 1) (i + 1)
diff --git a/cil-parser/pretty.ml b/cil-parser/pretty.ml
index 2e406c1..566378e 100755
--- a/cil-parser/pretty.ml
+++ b/cil-parser/pretty.ml
@@ -726,31 +726,31 @@ let gprintf (finish : doc -> 'b)
invalid_arg ("dprintf: unimplemented format "
^ (String.sub format i (j-i+1)));
let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ let format_spec = Bytes.of_string "% " in
+ Bytes.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
Obj.magic(fun n ->
collect (dctext1 acc
- (Int64.format format_spec n))
+ (Int64.format (Bytes.to_string format_spec) n))
(succ j'))
| 'l' ->
if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
^ (String.sub format i (j-i+1)));
let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ let format_spec = Bytes.of_string "% " in
+ Bytes.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
Obj.magic(fun n ->
collect (dctext1 acc
- (Int32.format format_spec n))
+ (Int32.format (Bytes.to_string format_spec) n))
(succ j'))
| 'n' ->
if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
^ (String.sub format i (j-i+1)));
let j' = succ j in (* eat the d,i,x etc. *)
- let format_spec = "% " in
- String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ let format_spec = Bytes.of_string "% " in
+ Bytes.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
Obj.magic(fun n ->
collect (dctext1 acc
- (Nativeint.format format_spec n))
+ (Nativeint.format (Bytes.to_string format_spec) n))
(succ j'))
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(fun f ->
diff --git a/js_of_ocaml-1.2/compiler/code.ml b/js_of_ocaml-1.2/compiler/code.ml
index 4dc2912..4b17d9b 100644
--- a/js_of_ocaml-1.2/compiler/code.ml
+++ b/js_of_ocaml-1.2/compiler/code.ml
@@ -24,20 +24,21 @@ module VarPrinter = struct
let name v nm = Hashtbl.add names v nm
let propagate_name v v' =
try name v' (Hashtbl.find names v) with Not_found -> ()
- let name v nm =
+ let name v nms =
+ let nm = Bytes.of_string nms in
let is_alpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') in
let is_num c = (c >= '0' && c <= '9') in
- if String.length nm > 0 then begin
- let nm = String.copy nm in
- if not (is_alpha nm.[0]) then nm.[0] <- '_';
- for i = 1 to String.length nm - 1 do
- if not (is_alpha nm.[i] || is_num nm.[i]) then nm.[i] <- '_';
+ if Bytes.length nm > 0 then begin
+ let nm = Bytes.copy nm in
+ if not (is_alpha (Bytes.get nm 0)) then nm.[0] <- '_';
+ for i = 1 to Bytes.length nm - 1 do
+ if not (is_alpha (Bytes.get nm i) || is_num (Bytes.get nm i)) then nm.[i] <- '_';
done;
let c = ref 0 in
- for i = 0 to String.length nm - 1 do
- if nm.[i] = '_' then incr c
+ for i = 0 to Bytes.length nm - 1 do
+ if Bytes.get nm i = '_' then incr c
done;
- if !c < String.length nm then name v nm
+ if !c < Bytes.length nm then name v nm
end
let reserved = Hashtbl.create 107
@@ -73,7 +74,7 @@ module VarPrinter = struct
if !pretty then begin
try
let nm = Hashtbl.find names i in
- Format.sprintf "%s_%s_" nm s
+ Format.sprintf "%s_%s_" (Bytes.to_string nm) s
with Not_found ->
Format.sprintf "_%s_" s
end else
diff --git a/js_of_ocaml-1.2/compiler/parse.ml b/js_of_ocaml-1.2/compiler/parse.ml
index 0b03368..a20e97c 100644
--- a/js_of_ocaml-1.2/compiler/parse.ml
+++ b/js_of_ocaml-1.2/compiler/parse.ml
@@ -1668,27 +1668,27 @@ let read_toc ic =
let pos_trailer = in_channel_length ic - 16 in
seek_in ic pos_trailer;
let num_sections = input_binary_int ic in
- let header = String.create(String.length exec_magic_number) in
+ let header = Bytes.create(String.length exec_magic_number) in
really_input ic header 0 (String.length exec_magic_number);
- if header <> exec_magic_number then raise Bad_magic_number;
+ if header <> Bytes.of_string exec_magic_number then raise Bad_magic_number;
seek_in ic (pos_trailer - 8 * num_sections);
let section_table = ref [] in
for i = 1 to num_sections do
let name = String.create 4 in
really_input ic name 0 4;
let len = input_binary_int ic in
- section_table := (name, len) :: !section_table
+ section_table := (Bytes.to_string name, len) :: !section_table
done;
!section_table
let read_primitive_table toc ic =
let len = seek_section toc ic "PRIM" in
- let p = String.create len in
+ let p = Bytes.create len in
really_input ic p 0 len;
let rec split beg cur =
if cur >= len then []
- else if p.[cur] = '\000' then
- String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+ else if Bytes.get p cur = '\000' then
+ Bytes.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
else
split beg (cur + 1) in
Array.of_list(split 0 0)
@@ -1715,7 +1715,7 @@ let fixed_code =
let fix_min_max_int code =
begin try
let i = Str.search_forward orig_code code 0 in
- String.blit fixed_code 0 code (i + 16) (String.length fixed_code)
+ String.blit fixed_code 0 (Bytes.of_string code) (i + 16) (String.length fixed_code)
with Not_found ->
Format.eprintf
"Warning: could not fix min_int/max_int definition \
diff --git a/js_of_ocaml-1.2/compiler/pretty_print.ml b/js_of_ocaml-1.2/compiler/pretty_print.ml
index 1f205e2..3223b24 100644
--- a/js_of_ocaml-1.2/compiler/pretty_print.ml
+++ b/js_of_ocaml-1.2/compiler/pretty_print.ml
@@ -153,7 +153,7 @@ let newline st =
let to_out_channel ch =
{ indent = 0; box_indent = 0; prev_indents = [];
limit = 78; cur = 0; l = []; n = 0; w = 0;
- compact = false; output = fun s i l -> output ch s i l }
+ compact = false; output = fun s i l -> output ch (Bytes.of_string s) i l }
let to_buffer b =
{ indent = 0; box_indent = 0; prev_indents = [];
diff --git a/js_of_ocaml-1.2/compiler/util.ml b/js_of_ocaml-1.2/compiler/util.ml
index 6b69acd..84e2428 100644
--- a/js_of_ocaml-1.2/compiler/util.ml
+++ b/js_of_ocaml-1.2/compiler/util.ml
@@ -43,10 +43,10 @@ let rec find_in_paths paths name =
let read_file f =
let ch = open_in_bin f in
let b = Buffer.create 4096 in
- let s = String.create 4096 in
+ let s = Bytes.create 4096 in
while
let n = input ch s 0 4096 in
- Buffer.add_substring b s 0 n;
+ Buffer.add_subbytes b s 0 n;
n <> 0
do () done;
close_in ch;
diff --git a/pp.ml b/pp.ml
index cd18842..162f856 100644
--- a/pp.ml
+++ b/pp.ml
@@ -1178,9 +1178,9 @@ let pp_isa () (m,testname,(exod,exedo,exddo)) =
let string_map f s =
let l = String.length s in
if l = 0 then s else begin
- let r = String.create l in
- for i = 0 to l - 1 do String.unsafe_set r i (f(String.unsafe_get s i)) done;
- r
+ let r = Bytes.create l in
+ for i = 0 to l - 1 do Bytes.set r i (f(String.unsafe_get s i)) done;
+ Bytes.to_string r
end
let pp_tex () (m,testname,(exod,exedo,exddo)) =
--
2.43.0