diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 897ca100d61..d5d858a17d3 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -259,6 +259,10 @@ jobs: env: PLATFORM: linux64 OPAMYES: 1 + strategy: + fail-fast: false + matrix: + ocaml: ["4.08.1", "5.0.0"] steps: - uses: actions/checkout@main with: @@ -269,7 +273,7 @@ jobs: uses: actions/cache@v3.0.11 with: path: ~/.opam/ - key: ${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-2 + key: ${{ runner.os }}-${{ matrix.ocaml }}-${{ hashFiles('./haxe.opam', './libs/') }} - name: Install Neko from S3 run: | @@ -303,6 +307,7 @@ jobs: set -ex opam init # --disable-sandboxing opam update + opam switch create ${{ matrix.ocaml }} opam pin add haxe . --no-action opam install haxe --deps-only --assume-depexts opam list @@ -343,11 +348,12 @@ jobs: - name: Upload artifact uses: actions/upload-artifact@v3 with: - name: linuxBinaries + name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }} path: out - name: Upload xmldoc artifact uses: actions/upload-artifact@v3 + if: matrix.ocaml == '4.08.1' with: name: xmldoc path: extra/doc @@ -363,6 +369,7 @@ jobs: strategy: fail-fast: false matrix: + ocaml: ["4.08.1", "5.0.0"] target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash, neko] include: - target: hl @@ -379,7 +386,7 @@ jobs: submodules: recursive - uses: actions/download-artifact@v3 with: - name: linuxBinaries + name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }} path: linuxBinaries - name: Install Neko from S3 @@ -586,7 +593,7 @@ jobs: uses: actions/cache@v3.0.11 with: path: ~/.opam/ - key: ${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-2 + key: ${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }} - name: Install Neko from S3 run: | diff --git a/Earthfile b/Earthfile index 8f399bb103a..dda473f6c60 100644 --- a/Earthfile +++ b/Earthfile @@ -93,6 +93,9 @@ devcontainer: # Install OCaml libraries COPY haxe.opam . RUN opam init --disable-sandboxing + RUN opam switch create 4.08.1 + RUN eval $(opam env) + RUN opam env RUN opam install . --yes --deps-only --no-depexts RUN opam list RUN ocamlopt -v diff --git a/extra/github-actions/cache-opam-windows.yml b/extra/github-actions/cache-opam-windows.yml deleted file mode 100644 index 5270fbf1fed..00000000000 --- a/extra/github-actions/cache-opam-windows.yml +++ /dev/null @@ -1,6 +0,0 @@ -- name: Cache opam - id: cache-opam - uses: actions/cache@v3.0.11 - with: - path: D:\.opam - key: ${{ runner.os }}${{ env.ARCH }}-${{ hashFiles('./haxe.opam', './libs/') }} diff --git a/extra/github-actions/cache-opam.yml b/extra/github-actions/cache-opam.yml deleted file mode 100644 index faaee00b723..00000000000 --- a/extra/github-actions/cache-opam.yml +++ /dev/null @@ -1,6 +0,0 @@ -- name: Cache opam - id: cache-opam - uses: actions/cache@v3.0.11 - with: - path: ~/.opam/ - key: ${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-2 diff --git a/extra/github-actions/workflows/main.yml b/extra/github-actions/workflows/main.yml index 629d1bd640c..5dbff676142 100644 --- a/extra/github-actions/workflows/main.yml +++ b/extra/github-actions/workflows/main.yml @@ -57,12 +57,22 @@ jobs: env: PLATFORM: linux64 OPAMYES: 1 + strategy: + fail-fast: false + matrix: + ocaml: ["4.08.1", "5.0.0"] steps: - uses: actions/checkout@main with: submodules: recursive - @import cache-opam.yml + - name: Cache opam + id: cache-opam + uses: actions/cache@v3.0.11 + with: + path: ~/.opam/ + key: ${{ runner.os }}-${{ matrix.ocaml }}-${{ hashFiles('./haxe.opam', './libs/') }} + @import install-neko-unix.yml - name: Install dependencies @@ -79,6 +89,7 @@ jobs: set -ex opam init # --disable-sandboxing opam update + opam switch create ${{ matrix.ocaml }} opam pin add haxe . --no-action opam install haxe --deps-only --assume-depexts opam list @@ -119,11 +130,12 @@ jobs: - name: Upload artifact uses: actions/upload-artifact@v3 with: - name: linuxBinaries + name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }} path: out - name: Upload xmldoc artifact uses: actions/upload-artifact@v3 + if: matrix.ocaml == '4.08.1' with: name: xmldoc path: extra/doc @@ -139,6 +151,7 @@ jobs: strategy: fail-fast: false matrix: + ocaml: ["4.08.1", "5.0.0"] target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash, neko] include: - target: hl @@ -155,7 +168,7 @@ jobs: submodules: recursive - uses: actions/download-artifact@v3 with: - name: linuxBinaries + name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }} path: linuxBinaries @import install-neko-unix.yml @@ -325,7 +338,13 @@ jobs: with: submodules: recursive - @import cache-opam.yml + - name: Cache opam + id: cache-opam + uses: actions/cache@v3.0.11 + with: + path: ~/.opam/ + key: ${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }} + @import install-neko-unix.yml @import build-mac.yml diff --git a/haxe.opam b/haxe.opam index 16b250972f2..9b3f38fe0c3 100644 --- a/haxe.opam +++ b/haxe.opam @@ -19,14 +19,15 @@ build: [ install: [make "install" "INSTALL_DIR=%{prefix}%"] remove: [make "uninstall" "INSTALL_DIR=%{prefix}%"] depends: [ - "ocaml" {>= "4.08"} + ("ocaml" {>= "5.0"} & ("camlp5" {build})) + | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00"})) "ocamlfind" {build} "dune" {>= "1.11"} - "camlp5" {build & = "8.00"} "sedlex" {>= "2.0"} "xml-light" "extlib" {>= "1.7.8"} "sha" + "camlp-streams" "conf-libpcre2-8" "conf-zlib" "conf-neko" diff --git a/libs/extc/extc_stubs.c b/libs/extc/extc_stubs.c index 30dc986d5c4..92faa58aa2a 100644 --- a/libs/extc/extc_stubs.c +++ b/libs/extc/extc_stubs.c @@ -92,7 +92,7 @@ int Zflush_val(value zflush_val) { case 4: return Z_FINISH; // TODO: support Z_BLOCK and Z_TREE // TODO: append the received value - default: failwith("Error in `Zflush_val` (extc_stubs.c): Unknown zflush value"); + default: caml_failwith("Error in `Zflush_val` (extc_stubs.c): Unknown zflush value"); } assert(0); } @@ -222,14 +222,14 @@ CAMLprim value zlib_deflate_init2(value level_val, value window_bits_val) { break; case Z_STREAM_ERROR: // TODO: use stream->msg to get _zlib_'s text message - failwith("Error in `zlib_deflate_init2` (extc_stubs.c): call to `deflateInit2` failed: Z_STREAM_ERROR"); + caml_failwith("Error in `zlib_deflate_init2` (extc_stubs.c): call to `deflateInit2` failed: Z_STREAM_ERROR"); break; case Z_VERSION_ERROR: // TODO: use stream->msg to get _zlib_'s text message - failwith("Error in `zlib_deflate_init2` (extc_stubs.c): call to `deflateInit2` failed: Z_VERSION_ERROR"); + caml_failwith("Error in `zlib_deflate_init2` (extc_stubs.c): call to `deflateInit2` failed: Z_VERSION_ERROR"); break; default: - failwith("Error in `zlib_deflate_init2` (extc_stubs.c): unknown return code from `deflateInit2`"); + caml_failwith("Error in `zlib_deflate_init2` (extc_stubs.c): unknown return code from `deflateInit2`"); } assert(0); } @@ -275,7 +275,7 @@ CAMLprim value zlib_deflate(value stream_val, value src, value spos, value slen, if (deflate_result == Z_OK || deflate_result == Z_STREAM_END) { stream->next_in = NULL; stream->next_out = NULL; - value zresult = alloc_small(3, 0); + value zresult = caml_alloc_small(3, 0); // z_finish Field(zresult, 0) = Val_bool(deflate_result == Z_STREAM_END); // z_read @@ -291,14 +291,14 @@ CAMLprim value zlib_deflate(value stream_val, value src, value spos, value slen, break; case Z_STREAM_ERROR: // TODO: use stream->msg to get _zlib_'s text message - failwith("Error in `zlib_deflate` (extc_stubs.c): call to `deflate` failed: Z_STREAM_ERROR"); + caml_failwith("Error in `zlib_deflate` (extc_stubs.c): call to `deflate` failed: Z_STREAM_ERROR"); break; case Z_BUF_ERROR: // TODO: use stream->msg to get _zlib_'s text message - failwith("Error in `zlib_deflate` (extc_stubs.c): call to `deflate` failed: Z_BUF_ERROR"); + caml_failwith("Error in `zlib_deflate` (extc_stubs.c): call to `deflate` failed: Z_BUF_ERROR"); break; default: - failwith("Error in `zlib_deflate` (extc_stubs.c): unknown return code from `deflate`"); + caml_failwith("Error in `zlib_deflate` (extc_stubs.c): unknown return code from `deflate`"); } assert(0); } @@ -309,14 +309,14 @@ CAMLprim value zlib_deflate_bytecode(value *arg, int nargs) { CAMLprim value zlib_deflate_end(value zv) { if( deflateEnd(ZStreamP_val(zv)) != 0 ) - failwith("zlib_deflate_end"); + caml_failwith("zlib_deflate_end"); return Val_unit; } CAMLprim value zlib_inflate_init(value wbits) { value z = zlib_new_stream(); if( inflateInit2(ZStreamP_val(z),Int_val(wbits)) != Z_OK ) - failwith("zlib_inflate_init"); + caml_failwith("zlib_inflate_init"); return z; } @@ -330,12 +330,12 @@ CAMLprim value zlib_inflate( value zv, value src, value spos, value slen, value z->avail_in = Int_val(slen); z->avail_out = Int_val(dlen); if( (r = inflate(z,Int_val(flush))) < 0 ) - failwith("zlib_inflate"); + caml_failwith("zlib_inflate"); z->next_in = NULL; z->next_out = NULL; - res = alloc_small(3, 0); + res = caml_alloc_small(3, 0); Field(res, 0) = Val_bool(r == Z_STREAM_END); Field(res, 1) = Val_int(Int_val(slen) - z->avail_in); Field(res, 2) = Val_int(Int_val(dlen) - z->avail_out); @@ -348,7 +348,7 @@ CAMLprim value zlib_inflate_bytecode(value * arg, int nargs) { CAMLprim value zlib_inflate_end(value zv) { if( inflateEnd(ZStreamP_val(zv)) != 0 ) - failwith("zlib_inflate_end"); + caml_failwith("zlib_inflate_end"); return Val_unit; } @@ -368,13 +368,13 @@ CAMLprim value executable_path(value u) { #ifdef _WIN32 char path[MAX_PATH]; if( GetModuleFileName(NULL,path,MAX_PATH) == 0 ) - failwith("executable_path"); + caml_failwith("executable_path"); return caml_copy_string(path); #elif __APPLE__ char path[MAXPATHLEN+1]; uint32_t path_len = MAXPATHLEN; if ( _NSGetExecutablePath(path, &path_len) ) - failwith("executable_path"); + caml_failwith("executable_path"); return caml_copy_string(path); #elif __FreeBSD__ char path[PATH_MAX]; @@ -387,7 +387,7 @@ CAMLprim value executable_path(value u) { len = sizeof(path); error = sysctl(name, 4, path, &len, NULL, 0); if( error < 0 ) - failwith("executable_path"); + caml_failwith("executable_path"); return caml_copy_string(path); #else char path[PATH_MAX]; @@ -397,7 +397,7 @@ CAMLprim value executable_path(value u) { if( p != NULL ) return caml_copy_string(p); else - failwith("executable_path"); + caml_failwith("executable_path"); } path[length] = '\0'; return caml_copy_string(path); @@ -408,12 +408,12 @@ CAMLprim value get_full_path( value f ) { #ifdef _WIN32 char path[MAX_PATH]; if( GetFullPathName(String_val(f),MAX_PATH,path,NULL) == 0 ) - failwith("get_full_path"); + caml_failwith("get_full_path"); return caml_copy_string(path); #else char path[4096]; if( realpath(String_val(f),path) == NULL ) - failwith("get_full_path"); + caml_failwith("get_full_path"); return caml_copy_string(path); #endif } @@ -428,7 +428,7 @@ CAMLprim value get_real_path( value path ) { // this will ensure the full class path with proper casing if( GetFullPathName(String_val(path),MAX_PATH,out,NULL) == 0 ) - failwith("get_real_path"); + caml_failwith("get_real_path"); len = strlen(out); i = 0; @@ -501,7 +501,7 @@ CAMLprim value sys_time() { ULARGE_INTEGER ui; GetSystemTime(&t); if( !SystemTimeToFileTime(&t,&ft) ) - failwith("sys_cpu_time"); + caml_failwith("sys_cpu_time"); ui.LowPart = ft.dwLowDateTime; ui.HighPart = ft.dwHighDateTime; return caml_copy_double( ((double)ui.QuadPart) / 10000000.0 - EPOCH_DIFF ); diff --git a/libs/extc/process_stubs.c b/libs/extc/process_stubs.c index c17c7a4f5bd..1f42c0fd1ad 100644 --- a/libs/extc/process_stubs.c +++ b/libs/extc/process_stubs.c @@ -67,10 +67,10 @@ #define val_null Val_int(0) #define val_some(v) Field(v,0) #define val_int(v) Int_val(v) -#define neko_error() failwith(__FUNCTION__) +#define neko_error() caml_failwith(__FUNCTION__) static value alloc_private( int size ) { - return alloc((size + sizeof(value) - 1) / sizeof(value), Abstract_tag); + return caml_alloc((size + sizeof(value) - 1) / sizeof(value), Abstract_tag); } // --- buffer api diff --git a/libs/extlib-leftovers/uTF8.ml b/libs/extlib-leftovers/uTF8.ml index ef61364deb0..ec25bd7aed9 100644 --- a/libs/extlib-leftovers/uTF8.ml +++ b/libs/extlib-leftovers/uTF8.ml @@ -177,7 +177,7 @@ let rec iter_aux proc s i = let iter proc s = iter_aux proc s 0 -let compare s1 s2 = Pervasives.compare s1 s2 +let compare s1 s2 = Stdlib.compare s1 s2 exception Malformed_code diff --git a/libs/ilib/peReader.ml b/libs/ilib/peReader.ml index fc79151e5b4..4d2e4aadb7a 100644 --- a/libs/ilib/peReader.ml +++ b/libs/ilib/peReader.ml @@ -25,7 +25,7 @@ open ExtList;; exception Error_message of string type reader_ctx = { - ch : Pervasives.in_channel; + ch : Stdlib.in_channel; i : IO.input; verbose : bool; } @@ -42,7 +42,7 @@ let seek r pos = seek_in r.ch pos let pos r = - Pervasives.pos_in r.ch + Stdlib.pos_in r.ch let info r msg = if r.verbose then diff --git a/libs/objsize/c_objsize.c b/libs/objsize/c_objsize.c index 5f222e0727c..4a316753177 100644 --- a/libs/objsize/c_objsize.c +++ b/libs/objsize/c_objsize.c @@ -12,6 +12,11 @@ #include "util.h" #include +#include + +#if OCAML_VERSION_MAJOR >= 5 +#include +#endif // FROM byterun/gc.h #define Caml_white (0 << 8) @@ -38,6 +43,7 @@ #define In_static_data 4 #define In_code_area 8 +#if OCAML_VERSION_MAJOR < 5 #ifdef ARCH_SIXTYFOUR // 64 bits: Represent page table as a sparse hash table @@ -63,6 +69,23 @@ CAMLextern unsigned char * caml_page_table[Pagetable1_size]; #define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young)) +void store_explicit(header_t hd, value v, int col) + { + Hd_val(v) = Coloredhd_hd(hd, col); + } + +#else + +void store_explicit(header_t hd, value v, int col) + { + atomic_store_explicit( + Hp_atomic_val(v), + Coloredhd_hd(hd, col), + memory_order_release); + } + +#endif + //-------------------------------------------------------- @@ -352,7 +375,7 @@ void c_rec_objsize(value v, size_t depth) DBG(printf("COL: w %08lx %i\n", v, col)); - Hd_val(v) = Coloredhd_hd(hd, Col_blue); + store_explicit(hd, v, Col_blue); if (Tag_val(v) < No_scan_tag) { @@ -378,7 +401,7 @@ void restore_colors(value v) col = readcolor(); DBG(printf("COL: r %08lx %i\n", v, col)); - Hd_val(v) = Coloredhd_hd(Hd_val(v), col); + store_explicit(Hd_val(v), v, col); if (Tag_val(v) < No_scan_tag) { @@ -417,7 +440,7 @@ int c_objsize(value v, value scan, value reach, size_t* headers, size_t* data, s head = Field(head,1); if( col == Col_blue ) continue; writecolor(col); - Hd_val(v) = Coloredhd_hd(hd, Col_blue); + store_explicit(hd, v, Col_blue); } acc_data = 0; @@ -444,7 +467,7 @@ int c_objsize(value v, value scan, value reach, size_t* headers, size_t* data, s head = Field(head,1); if( Colornum_hd(Hd_val(v)) != Col_blue ) continue; col = readcolor(); - Hd_val(v) = Coloredhd_hd(Hd_val(v), col); + store_explicit(Hd_val(v), v, col); } while( COND_BLOCK(reach) ) { diff --git a/libs/swflib/swfParser.ml b/libs/swflib/swfParser.ml index 2f647453261..8006c81ae52 100644 --- a/libs/swflib/swfParser.ml +++ b/libs/swflib/swfParser.ml @@ -444,7 +444,7 @@ and tag_length t = (* READ PRIMS *) let skip ch n = - seek_in ch ((Pervasives.pos_in ch) + n) + seek_in ch ((Stdlib.pos_in ch) + n) let read_rgba ch = let r = read_byte ch in diff --git a/libs/swflib/swfPic.ml b/libs/swflib/swfPic.ml index 7e69e28eb62..613260d189d 100644 --- a/libs/swflib/swfPic.ml +++ b/libs/swflib/swfPic.ml @@ -59,7 +59,7 @@ let load_picture file id = let len = String.length file in let p = (try String.rindex file '.' with Not_found -> len) in let ext = String.sub file (p + 1) (len - (p + 1)) in - match String.uppercase ext with + match ExtString.String.uppercase ext with | "PNG" -> let png , header, data = (try let p = Png.parse ch in diff --git a/libs/ttflib/tTFParser.ml b/libs/ttflib/tTFParser.ml index 68d1e26329a..9b3468ac7ee 100644 --- a/libs/ttflib/tTFParser.ml +++ b/libs/ttflib/tTFParser.ml @@ -24,7 +24,7 @@ open TTFData open IO type ctx = { - file : Pervasives.in_channel; + file : Stdlib.in_channel; ch : input; mutable entry : entry; } diff --git a/libs/ziplib/zip.ml b/libs/ziplib/zip.ml index 9245f0d00a2..0e5edc1eb52 100644 --- a/libs/ziplib/zip.ml +++ b/libs/ziplib/zip.ml @@ -62,7 +62,7 @@ type entry = type in_file = { if_filename: string; - if_channel: Pervasives.in_channel; + if_channel: Stdlib.in_channel; if_entries: entry list; if_directory: (string, entry) Hashtbl.t; if_comment: string } @@ -72,7 +72,7 @@ let comment ifile = ifile.if_comment type out_file = { of_filename: string; - of_channel: Pervasives.out_channel; + of_channel: Stdlib.out_channel; mutable of_entries: entry list; of_comment: string } @@ -217,7 +217,7 @@ let read_cd filename ic cd_entries cd_offset cd_bound = (* Open a ZIP file for reading *) let open_in filename = - let ic = Pervasives.open_in_bin filename in + let ic = Stdlib.open_in_bin filename in let (cd_entries, cd_size, cd_offset, cd_comment) = read_ecd filename ic in let entries = read_cd filename ic cd_entries cd_offset (Int32.add cd_offset cd_size) in @@ -232,7 +232,7 @@ let open_in filename = (* Close a ZIP file opened for reading *) let close_in ifile = - Pervasives.close_in ifile.if_channel + Stdlib.close_in ifile.if_channel (* Return the info associated with an entry *) @@ -369,7 +369,7 @@ let open_out ?(comment = "") filename = if String.length comment >= 0x10000 then raise(Error(filename, "", "comment too long")); { of_filename = filename; - of_channel = Pervasives.open_out_bin filename; + of_channel = Stdlib.open_out_bin filename; of_entries = []; of_comment = comment } @@ -416,7 +416,7 @@ let close_out ofile = write4_int oc start_cd; (* offset of central dir *) write2 oc (String.length ofile.of_comment); (* length of comment *) writestring oc ofile.of_comment; (* comment *) - Pervasives.close_out oc + Stdlib.close_out oc (* Write a local file header and return the corresponding entry *) @@ -552,9 +552,9 @@ let copy_file_to_entry infilename ofile ?(extra = "") ?(comment = "") with Unix.Unix_error(_,_,_) -> None in try copy_channel_to_entry ic ofile ~extra ~comment ~level ?mtime:mtime' name; - Pervasives.close_in ic + Stdlib.close_in ic with x -> - Pervasives.close_in ic; raise x + Stdlib.close_in ic; raise x (* Add an entry whose content will be produced by the caller *) diff --git a/src/codegen/dotnet.ml b/src/codegen/dotnet.ml index b0be29dec47..43fa7a58a8d 100644 --- a/src/codegen/dotnet.ml +++ b/src/codegen/dotnet.ml @@ -68,7 +68,7 @@ let cs_unops = let netname_to_hx name = let len = String.length name in let chr = String.get name 0 in - String.make 1 (Char.uppercase chr) ^ (String.sub name 1 (len-1)) + String.make 1 (Char.uppercase_ascii chr) ^ (String.sub name 1 (len-1)) (* -net-lib implementation *) @@ -105,7 +105,7 @@ let escape_chars = let netcl_to_hx cl = let cl = if String.length cl > 0 && String.get cl 0 >= 'a' && String.get cl 0 <= 'z' then - Char.escaped (Char.uppercase (String.get cl 0)) ^ (String.sub cl 1 (String.length cl - 1)) + Char.escaped (Char.uppercase_ascii (String.get cl 0)) ^ (String.sub cl 1 (String.length cl - 1)) else cl in diff --git a/src/codegen/java.ml b/src/codegen/java.ml index 5a6fcd9daa4..3a70f1d936f 100644 --- a/src/codegen/java.ml +++ b/src/codegen/java.ml @@ -46,7 +46,7 @@ let is_haxe_keyword = function let jname_to_hx name = let name = if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then - Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1) + Char.escaped (Char.uppercase_ascii (String.get name 0)) ^ String.sub name 1 (String.length name - 1) else name in diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index 95c0fe3ffe1..8ccbd709e9d 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -555,7 +555,7 @@ module PathConverter = struct let jname_to_hx name = let name = if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then - Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1) + Char.escaped (Char.uppercase_ascii (String.get name 0)) ^ String.sub name 1 (String.length name - 1) else name in diff --git a/src/codegen/swfLoader.ml b/src/codegen/swfLoader.ml index 18c324e83a9..2d2a25104f7 100644 --- a/src/codegen/swfLoader.ml +++ b/src/codegen/swfLoader.ml @@ -33,7 +33,7 @@ let lowercase_pack pack = let name = let fchar = String.get name 0 in if fchar >= 'A' && fchar <= 'Z' then - (String.make 1 (Char.lowercase fchar)) ^ String.sub name 1 (String.length name - 1) + (String.make 1 (Char.lowercase_ascii fchar)) ^ String.sub name 1 (String.length name - 1) else name in diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index a55dfadd5be..ebdf508b9f0 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -269,7 +269,7 @@ let maybe_load_display_file_before_typing tctx display_file_dot_path = match dis let handle_display_after_typing ctx tctx display_file_dot_path = let com = ctx.com in - if ctx.com.display.dms_kind = DMNone & ctx.has_error then raise Abort; + if ctx.com.display.dms_kind = DMNone && ctx.has_error then raise Abort; begin match ctx.com.display.dms_kind,!Parser.delayed_syntax_completion with | DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj | _ -> () diff --git a/src/context/display/displayException.ml b/src/context/display/displayException.ml index a731f9a1d98..661bb1bd17b 100644 --- a/src/context/display/displayException.ml +++ b/src/context/display/displayException.ml @@ -23,9 +23,9 @@ let max_completion_items = ref 0 let filter_somehow ctx items kind subj = let subject = match subj.s_name with | None -> "" - | Some name-> String.lowercase name + | Some name-> ExtString.String.lowercase name in - let subject_length = String.length subject in + let subject_length = ExtString.String.length subject in let determine_cost s = let get_initial_cost o = if o = 0 then @@ -33,7 +33,7 @@ let filter_somehow ctx items kind subj = else begin (* Consider `.` as anchors and determine distance from closest one. Penalize starting distance by factor 2. *) try - let last_anchor = String.rindex_from s o '.' in + let last_anchor = ExtString.String.rindex_from s o '.' in (o - (last_anchor + 1)) * 2 with Not_found -> o * 2 @@ -54,12 +54,12 @@ let filter_somehow ctx items kind subj = let o',new_cost = index_from o subject.[i] in loop (i + 1) o' (cost + new_cost) end else - cost + (if o = String.length s - 1 then 0 else 1) (* Slightly penalize for not-exact matches. *) + cost + (if o = ExtString.String.length s - 1 then 0 else 1) (* Slightly penalize for not-exact matches. *) in if subject_length = 0 then 0 else try - let o = String.index s subject.[0] in + let o = ExtString.String.index s subject.[0] in loop 1 o (get_initial_cost o); with Not_found | Invalid_argument _ -> -1 @@ -67,7 +67,7 @@ let filter_somehow ctx items kind subj = let rec loop acc items index = match items with | item :: items -> - let name = String.lowercase (get_filter_name item) in + let name = ExtString.String.lowercase (get_filter_name item) in let cost = determine_cost name in let acc = if cost >= 0 then (item,index,cost) :: acc @@ -102,8 +102,8 @@ let patch_completion_subject subj = match subj.s_name with | Some name -> let delta = p.pmax - p.pmin in - let name = if delta > 0 && delta < String.length name then - String.sub name 0 delta + let name = if delta > 0 && delta < ExtString.String.length name then + ExtString.String.sub name 0 delta else name in diff --git a/src/context/display/documentSymbols.ml b/src/context/display/documentSymbols.ml index 705c8be1dee..4d61a6ae4ef 100644 --- a/src/context/display/documentSymbols.ml +++ b/src/context/display/documentSymbols.ml @@ -56,7 +56,7 @@ let collect_module_symbols mname with_locals (pack,decls) = | FFun f -> add_field ( if fst cff_name = "new" then Constructor - else if ((parent_kind = EnumAbstract or parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff_meta) then Operator + else if ((parent_kind = EnumAbstract || parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff_meta) then Operator else Method ); if with_locals then func field_parent f diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 79fd8e6f5af..8760eafd96f 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -628,7 +628,7 @@ let merge_core_doc ctx mt = let field_to_type_path com e = let rec loop e pack name = match e with - | EField(e,f,_),p when Char.lowercase (String.get f 0) <> String.get f 0 -> (match name with + | EField(e,f,_),p when Char.lowercase_ascii (String.get f 0) <> String.get f 0 -> (match name with | [] | _ :: [] -> loop e pack (f :: name) | _ -> (* too many name paths *) @@ -640,7 +640,7 @@ let field_to_type_path com e = let pack, name, sub = match name with | [] -> let fchar = String.get f 0 in - if Char.uppercase fchar = fchar then + if Char.uppercase_ascii fchar = fchar then pack, f, None else begin display_error com "A class name must start with an uppercase letter" (snd e); @@ -690,12 +690,12 @@ let s_field_call_candidate fcc = let relative_path ctx file = let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in let fpath = slashes (Path.get_full_path file) in - let fpath_lower = String.lowercase fpath in + let fpath_lower = String.lowercase_ascii fpath in let flen = String.length fpath_lower in let rec loop = function | [] -> file | path :: l -> - let spath = String.lowercase (slashes path) in + let spath = String.lowercase_ascii (slashes path) in let slen = String.length spath in if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l in diff --git a/src/core/path.ml b/src/core/path.ml index c5bf6d74d08..119908524b8 100644 --- a/src/core/path.ml +++ b/src/core/path.ml @@ -223,7 +223,7 @@ end = struct let create = if Globals.is_windows then - (fun f -> String.lowercase (get_full_path f)) + (fun f -> ExtString.String.lowercase (get_full_path f)) else get_full_path @@ -378,7 +378,7 @@ let full_dot_path pack mname tname = let file_extension file = match List.rev (ExtString.String.nsplit file ".") with - | e :: _ -> String.lowercase e + | e :: _ -> ExtString.String.lowercase e | [] -> "" module FilePath = struct diff --git a/src/dune b/src/dune index 03cd1d84add..63d49be3ba2 100644 --- a/src/dune +++ b/src/dune @@ -17,7 +17,7 @@ (library (name haxe) (libraries - extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 swflib ttflib ziplib + extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 camlp-streams swflib ttflib ziplib json unix ipaddr str bigarray threads dynlink xml-light extlib sha diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index e417bbbb718..edd687642d7 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -7035,8 +7035,8 @@ let write_build_options common_ctx filename defines = | _ -> write_define name (escape_command value)) defines; let pin,pid = Process_helper.open_process_args_in_pid "haxelib" [|"haxelib"; "path"; "hxcpp"|] in set_binary_mode_in pin false; - write_define "hxcpp" (Pervasives.input_line pin); - Pervasives.ignore (Process_helper.close_process_in_pid (pin,pid)); + write_define "hxcpp" (Stdlib.input_line pin); + Stdlib.ignore (Process_helper.close_process_in_pid (pin,pid)); writer#close;; let create_member_types common_ctx = diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index dee561b888b..14b6618ee41 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -4096,7 +4096,7 @@ let add_types ctx types = | Method MethNormal when not (List.exists (fun (m,_,_) -> m = Meta.HlNative) f.cf_meta) -> (match f.cf_expr with | Some { eexpr = TFunction { tf_expr = { eexpr = TBlock ([] | [{ eexpr = TReturn (Some { eexpr = TConst _ })}]) } } } | None -> - let name = prefix ^ String.lowercase (Str.global_replace (Str.regexp "[A-Z]+") "_\\0" f.cf_name) in + let name = prefix ^ String.lowercase_ascii (Str.global_replace (Str.regexp "[A-Z]+") "_\\0" f.cf_name) in f.cf_meta <- (Meta.HlNative, [(EConst (String(lib,SDoubleQuotes)),p);(EConst (String(name,SDoubleQuotes)),p)], p) :: f.cf_meta; | _ -> ()) | _ -> () @@ -4186,7 +4186,7 @@ let generate com = in if Path.file_extension com.file = "c" then begin - let gnames = Array.create (Array.length code.globals) "" in + let gnames = Array.make (Array.length code.globals) "" in PMap.iter (fun n i -> gnames.(i) <- n) ctx.cglobals.map; if not (Common.defined com Define.SourceHeader) then begin let version_major = com.version / 1000 in diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml index 514acd4a3b3..288a9168cd3 100644 --- a/src/generators/genphp7.ml +++ b/src/generators/genphp7.ml @@ -15,8 +15,8 @@ open Sourcemaps *) let escape_bin s = let b = Buffer.create 0 in - for i = 0 to String.length s - 1 do - match Char.code (String.unsafe_get s i) with + for i = 0 to ExtString.String.length s - 1 do + match Char.code (ExtString.String.unsafe_get s i) with | c when c = Char.code('\\') || c = Char.code('"') || c = Char.code('$') -> Buffer.add_string b "\\"; Buffer.add_char b (Char.chr c) @@ -46,7 +46,7 @@ let write_resource dir name data = *) let copy_file src dst = let buffer_size = 8192 in - let buffer = String.create buffer_size in + let buffer = ExtString.String.create buffer_size in let fd_in = Unix.openfile src [O_RDONLY] 0 in let fd_out = Unix.openfile dst [O_WRONLY; O_CREAT; O_TRUNC] 0o644 in let rec copy_loop () = @@ -196,7 +196,7 @@ end (** Check if specified string is a reserved word in PHP *) -let is_keyword str = Hashtbl.mem php_keywords_tbl (String.lowercase str) +let is_keyword str = Hashtbl.mem php_keywords_tbl (ExtString.String.lowercase str) (** Check if specified type is php.NativeArray @@ -531,10 +531,10 @@ let get_full_type_name ?(escape=false) ?(omit_first_slash=false) (type_path:path else "" :: get_real_path module_path in - (String.concat "\\" parts) ^ "\\" ^ type_name + (ExtString.String.concat "\\" parts) ^ "\\" ^ type_name in if escape then - String.escaped name + ExtString.String.escaped name else name @@ -618,7 +618,7 @@ let fix_call_args callee_type exprs = Escapes all "$" chars and encloses `str` into double quotes *) let quote_string str = - "\"" ^ (Str.global_replace (Str.regexp "\\$") "\\$" (String.escaped str)) ^ "\"" + "\"" ^ (Str.global_replace (Str.regexp "\\$") "\\$" (ExtString.String.escaped str)) ^ "\"" (** Check if specified field is a var with non-constant expression @@ -1296,21 +1296,21 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = Decrease indentation by one level *) method indent_less = - indentation <- String.make ((String.length indentation) - 1) '\t'; + indentation <- ExtString.String.make ((ExtString.String.length indentation) - 1) '\t'; (** Set indentation level (starting from zero for no indentation) *) method indent level = - indentation <- String.make level '\t'; + indentation <- ExtString.String.make level '\t'; (** Get indentation level (starting from zero for no indentation) *) - method get_indentation = String.length indentation + method get_indentation = ExtString.String.length indentation (** Set indentation level (starting from zero for no indentation) *) method set_indentation level = - indentation <- String.make level '\t' + indentation <- ExtString.String.make level '\t' (** Specify local var name declared in current scope *) @@ -1326,7 +1326,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = else if get_type_name type_path = "" then match get_module_path type_path with | [] -> "\\" - | module_path -> "\\" ^ (String.concat "\\" (get_real_path module_path)) ^ "\\" + | module_path -> "\\" ^ (ExtString.String.concat "\\" (get_real_path module_path)) ^ "\\" else begin let orig_type_path = type_path in let type_path = match type_path with (pack, name) -> (pack, get_real_name name) in @@ -1942,7 +1942,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = set_sourcemap_pointer sourcemap sm_pointer_before_body; let locals = vars#pop_captured in if List.length locals > 0 then begin - self#write ("unset($" ^ (String.concat ", $" locals) ^ ");\n"); + self#write ("unset($" ^ (ExtString.String.concat ", $" locals) ^ ");\n"); self#write_indentation end; self#write_bypassing_sourcemap body; @@ -2999,7 +2999,7 @@ class virtual type_builder ctx (wrapper:type_wrapper) = Returns generated file contents *) method get_contents = - if (String.length contents) = 0 then begin + if (ExtString.String.length contents) = 0 then begin self#write_declaration; writer#write_line " {"; (** opening bracket for a class *) self#write_body; @@ -3016,7 +3016,7 @@ class virtual type_builder ctx (wrapper:type_wrapper) = writer#write_statement ("require_once __DIR__.'/" ^ polyfills_file ^ "'"); writer#write_statement (boot_class ^ "::__hx__init()") end; - let haxe_class = match wrapper#get_type_path with (path, name) -> String.concat "." (path @ [name]) in + let haxe_class = match wrapper#get_type_path with (path, name) -> ExtString.String.concat "." (path @ [name]) in writer#write_statement (boot_class ^ "::registerClass(" ^ (self#get_name) ^ "::class, '" ^ haxe_class ^ "')"); self#write_rtti_meta; self#write_pre_hx_init; @@ -3051,7 +3051,7 @@ class virtual type_builder ctx (wrapper:type_wrapper) = writer#write "\n"; let namespace = self#get_namespace in if List.length namespace > 0 then - writer#write_line ("namespace " ^ (String.concat "\\" namespace) ^ ";\n"); + writer#write_line ("namespace " ^ (ExtString.String.concat "\\" namespace) ^ ";\n"); writer#write_use (** Generates PHP docblock and attributes to output buffer. @@ -3082,11 +3082,11 @@ class virtual type_builder ctx (wrapper:type_wrapper) = Writes description section of docblocks *) method write_doc_description (doc:string) = - let lines = Str.split (Str.regexp "\n") (String.trim doc) + let lines = Str.split (Str.regexp "\n") (ExtString.String.trim doc) and write_line line = - let trimmed = String.trim line in - if String.length trimmed > 0 then ( - if String.get trimmed 0 = '*' then + let trimmed = ExtString.String.trim line in + if ExtString.String.length trimmed > 0 then ( + if ExtString.String.get trimmed 0 = '*' then writer#write_line (" " ^ trimmed) else writer#write_line (" * " ^ trimmed) @@ -3554,7 +3554,7 @@ class class_builder ctx (cls:tclass) = cls.cl_implements in let interfaces = List.map use_interface unique in - writer#write (String.concat ", " interfaces); + writer#write (ExtString.String.concat ", " interfaces); end; (** Returns either user-defined constructor or creates empty constructor if instance initialization is required. @@ -3667,7 +3667,7 @@ class class_builder ctx (cls:tclass) = List.iter (fun field -> if not !required then - required := (String.lowercase field.cf_name = String.lowercase self#get_name) + required := (ExtString.String.lowercase field.cf_name = ExtString.String.lowercase self#get_name) ) (cls.cl_ordered_statics @ cls.cl_ordered_fields); !required @@ -3676,10 +3676,10 @@ class class_builder ctx (cls:tclass) = Writes `-D php-prefix` value as class constant PHP_PREFIX *) method private write_php_prefix () = - let prefix = String.concat "\\" ctx.pgc_prefix in + let prefix = ExtString.String.concat "\\" ctx.pgc_prefix in let indentation = writer#get_indentation in writer#indent 1; - writer#write_statement ("const PHP_PREFIX = \"" ^ (String.escaped prefix) ^ "\""); + writer#write_statement ("const PHP_PREFIX = \"" ^ (ExtString.String.escaped prefix) ^ "\""); writer#indent indentation (** Writes expressions for `__hx__init` method @@ -3998,8 +3998,8 @@ class generator (ctx:php_generator_context) = if front_dirs <> [] then ignore(create_dir_recursive (root_dir :: front_dirs)); let lib_path = - (String.concat "" (List.fold_left (fun acc s -> if s <> "." then "../" :: acc else acc) [] front_dirs)) - ^ (String.concat "/" self#get_lib_path) + (ExtString.String.concat "" (List.fold_left (fun acc s -> if s <> "." then "../" :: acc else acc) [] front_dirs)) + ^ (ExtString.String.concat "/" self#get_lib_path) in let channel = open_out (root_dir ^ "/" ^ filename) in output_string channel " Array.set cases tag (pos - switch_pos)) !constructs; DynArray.set ctx.code switch_index (HSwitch (1,Array.to_list cases)); branch(); diff --git a/src/generators/hl2c.ml b/src/generators/hl2c.ml index d5b94f0ddff..42e1656326b 100644 --- a/src/generators/hl2c.ml +++ b/src/generators/hl2c.ml @@ -1143,7 +1143,7 @@ let make_types_idents htypes = try PMap.find vp (!types_descs) with Not_found -> - let arr = Array.create (Array.length vp.vfields) ("",DSimple HVoid) in + let arr = Array.make (Array.length vp.vfields) ("",DSimple HVoid) in let td = DVirtual arr in types_descs := PMap.add vp td (!types_descs); Array.iteri (fun i (f,_,t) -> arr.(i) <- (f,make_desc t)) vp.vfields; diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index e50714f7ee4..baba96be4d9 100644 --- a/src/generators/hlinterp.ml +++ b/src/generators/hlinterp.ml @@ -1111,7 +1111,7 @@ let interp ctx f args = (match rtype r with | HEnum e -> let _, _, fl = e.efields.(f) in - let vl = Array.create (Array.length fl) VUndef in + let vl = Array.make (Array.length fl) VUndef in set r (VEnum (e, f, vl)) | _ -> Globals.die "" __LOC__ ) @@ -1257,7 +1257,7 @@ let load_native ctx lib name t = | _ -> Globals.die "" __LOC__) | "alloc_array" -> (function - | [VType t;VInt i] -> VArray (Array.create (int i) (default t),t) + | [VType t;VInt i] -> VArray (Array.make (int i) (default t),t) | _ -> Globals.die "" __LOC__) | "alloc_obj" -> (function @@ -1347,7 +1347,7 @@ let load_native ctx lib name t = | "math_asin" -> (function [VFloat f] -> VFloat (asin f) | _ -> Globals.die "" __LOC__) | "math_atan" -> (function [VFloat f] -> VFloat (atan f) | _ -> Globals.die "" __LOC__) | "math_atan2" -> (function [VFloat a; VFloat b] -> VFloat (atan2 a b) | _ -> Globals.die "" __LOC__) - | "math_log" -> (function [VFloat f] -> VFloat (Pervasives.log f) | _ -> Globals.die "" __LOC__) + | "math_log" -> (function [VFloat f] -> VFloat (Stdlib.log f) | _ -> Globals.die "" __LOC__) | "math_exp" -> (function [VFloat f] -> VFloat (exp f) | _ -> Globals.die "" __LOC__) | "math_pow" -> (function [VFloat a; VFloat b] -> VFloat (a ** b) | _ -> Globals.die "" __LOC__) | "parse_int" -> @@ -1539,7 +1539,7 @@ let load_native ctx lib name t = | "Darwin" -> "Mac" | n -> n ) in - Pervasives.ignore (Process_helper.close_process_in_pid (ic, pid)); + Stdlib.ignore (Process_helper.close_process_in_pid (ic, pid)); cached_sys_name := Some uname; uname) | "Win32" | "Cygwin" -> "Windows" @@ -2147,7 +2147,7 @@ let add_code ctx code = ctx.t_globals <- globals; (* expand function table *) let nfunctions = Array.length code.functions + Array.length code.natives in - let functions = Array.create nfunctions (FNativeFun ("",(fun _ -> Globals.die "" __LOC__),HDyn)) in + let functions = Array.make nfunctions (FNativeFun ("",(fun _ -> Globals.die "" __LOC__),HDyn)) in Array.blit ctx.t_functions 0 functions 0 (Array.length ctx.t_functions); let rec loop i = if i = Array.length code.natives then () else @@ -2191,7 +2191,7 @@ let add_code ctx code = (* ------------------------------- CHECK ---------------------------------------------- *) let check code macros = - let ftypes = Array.create (Array.length code.natives + Array.length code.functions) HVoid in + let ftypes = Array.make (Array.length code.natives + Array.length code.functions) HVoid in let is_native_fun = Hashtbl.create 0 in let check_fun f = diff --git a/src/macro/eval/evalJit.ml b/src/macro/eval/evalJit.ml index c9e7d35c958..d2c21a539a1 100644 --- a/src/macro/eval/evalJit.ml +++ b/src/macro/eval/evalJit.ml @@ -230,7 +230,7 @@ and jit_expr jit return e = let hasret = jit_closure.has_nonfinal_return in let eci = get_env_creation jit_closure false tf.tf_expr.epos.pfile (EKLocalFunction jit.num_closures) in let captures = Hashtbl.fold (fun vid (i,declared) acc -> (i,vid,declared) :: acc) jit_closure.captures [] in - let captures = List.sort (fun (i1,_,_) (i2,_,_) -> Pervasives.compare i1 i2) captures in + let captures = List.sort (fun (i1,_,_) (i2,_,_) -> Stdlib.compare i1 i2) captures in (* Check if the out-of-scope var is in the outer scope because otherwise we have to promote outwards. *) List.iter (fun var -> ignore(get_capture_slot jit var)) jit_closure.captures_outside_scope; let captures = ExtList.List.filter_map (fun (i,vid,declared) -> diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index 90b3d157340..ae09bcbfef8 100644 --- a/src/macro/eval/evalStdLib.ml +++ b/src/macro/eval/evalStdLib.ml @@ -289,7 +289,7 @@ module StdBytes = struct let compare = vifun1 (fun vthis other -> let this = this vthis in let other = decode_bytes other in - vint (Pervasives.compare this other) + vint (Stdlib.compare this other) ) let fastGet = vfun2 (fun b pos -> @@ -1694,13 +1694,13 @@ module StdMath = struct let ceil = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (ceil (num v)))) let cos = vfun1 (fun v -> vfloat (cos (num v))) let exp = vfun1 (fun v -> vfloat (exp (num v))) - let fceil = vfun1 (fun v -> vfloat (Pervasives.ceil (num v))) - let ffloor = vfun1 (fun v -> vfloat (Pervasives.floor (num v))) + let fceil = vfun1 (fun v -> vfloat (Stdlib.ceil (num v))) + let ffloor = vfun1 (fun v -> vfloat (Stdlib.floor (num v))) let floor = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (floor (num v)))) - let fround = vfun1 (fun v -> vfloat (Pervasives.floor (num v +. 0.5))) + let fround = vfun1 (fun v -> vfloat (Stdlib.floor (num v +. 0.5))) let isFinite = vfun1 (fun v -> vbool (match v with VFloat f -> f <> infinity && f <> neg_infinity && f = f | _ -> true)) let isNaN = vfun1 (fun v -> vbool (match v with VFloat f -> f <> f | VInt32 _ -> false | _ -> true)) - let log = vfun1 (fun v -> vfloat (Pervasives.log (num v))) + let log = vfun1 (fun v -> vfloat (Stdlib.log (num v))) let max = vfun2 (fun a b -> let a = num a in @@ -1716,7 +1716,7 @@ module StdMath = struct let pow = vfun2 (fun a b -> vfloat ((num a) ** (num b))) let random = vfun0 (fun () -> vfloat (Random.State.float random 1.)) - let round = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (Pervasives.floor (num v +. 0.5)))) + let round = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (Stdlib.floor (num v +. 0.5)))) let sin = vfun1 (fun v -> vfloat (sin (num v))) let sqrt = vfun1 (fun v -> @@ -2690,7 +2690,7 @@ module StdSys = struct | "Darwin" -> "Mac" | n -> n ) in - Pervasives.ignore (Process_helper.close_process_in_pid (ic, pid)); + Stdlib.ignore (Process_helper.close_process_in_pid (ic, pid)); cached_sys_name := Some uname; uname) | "Win32" | "Cygwin" -> "Windows" @@ -2735,10 +2735,12 @@ module StdThread = struct vnull ) - let kill = vifun0 (fun vthis -> - Thread.kill (this vthis).tthread; - vnull - ) + (* Thread.kill has been marked deprecated (because unstable or even not working at all) for a while, and removed in ocaml 5 *) + (* See also https://github.com/HaxeFoundation/haxe/issues/5800 *) + (* let kill = vifun0 (fun vthis -> *) + (* Thread.kill (this vthis).tthread; *) + (* vnull *) + (* ) *) let self = vfun0 (fun () -> let eval = get_eval (get_ctx()) in @@ -3062,7 +3064,7 @@ module StdUtf8 = struct let compare = vfun2 (fun a b -> let a = decode_string a in let b = decode_string b in - vint (Pervasives.compare a b) + vint (Stdlib.compare a b) ) let decode = vfun1 (fun s -> @@ -3728,7 +3730,7 @@ let init_standard_library builtins = "id",StdThread.id; "get_events",StdThread.get_events; "set_events",StdThread.set_events; - "kill",StdThread.kill; + (* "kill",StdThread.kill; *) "sendMessage",StdThread.sendMessage; ]; init_fields builtins (["sys";"thread"],"Tls") [] [ diff --git a/src/optimization/inlineConstructors.ml b/src/optimization/inlineConstructors.ml index 63cc3f926f5..11fa081c4ab 100644 --- a/src/optimization/inlineConstructors.ml +++ b/src/optimization/inlineConstructors.ml @@ -495,7 +495,7 @@ let inline_constructors ctx original_e = | IOFInlineMethod(io,io_var,c,tl,cf,tf) -> let argvs, pl = analyze_call_args call_args in io.io_dependent_vars <- io.io_dependent_vars @ argvs; - io.io_has_untyped <- io.io_has_untyped or (Meta.has Meta.HasUntyped cf.cf_meta); + io.io_has_untyped <- io.io_has_untyped || (Meta.has Meta.HasUntyped cf.cf_meta); let e = Inline.type_inline ctx cf tf (mk (TLocal io_var.iv_var) (TInst (c,tl)) e.epos) pl e.etype None e.epos true in let e = mark_ctors e in io.io_inline_methods <- io.io_inline_methods @ [e]; diff --git a/src/typing/matcher/texprConverter.ml b/src/typing/matcher/texprConverter.ml index a6cb90092be..8b234e6f9bd 100644 --- a/src/typing/matcher/texprConverter.ml +++ b/src/typing/matcher/texprConverter.ml @@ -193,7 +193,7 @@ let report_not_exhaustive v_lookup e_subject unmatched = in let s = match unmatched with | [] -> "_" - | _ -> String.concat " | " (List.sort Pervasives.compare sl) + | _ -> String.concat " | " (List.sort Stdlib.compare sl) in raise_typing_error (Printf.sprintf "Unmatched patterns: %s" (s_subject v_lookup s e_subject)) e_subject.epos diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 618b8838766..3a6e41a3d24 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -319,7 +319,7 @@ let check_module_types ctx m p t = let t = t_infos t in try let path2 = ctx.com.type_to_module#find t.mt_path in - if m.m_path <> path2 && String.lowercase (s_type_path path2) = String.lowercase (s_type_path m.m_path) then raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p; + if m.m_path <> path2 && String.lowercase_ascii (s_type_path path2) = String.lowercase_ascii (s_type_path m.m_path) then raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p; let m2 = ctx.com.module_lut#find path2 in let hex1 = Digest.to_hex m.m_extra.m_sign in let hex2 = Digest.to_hex m2.m_extra.m_sign in diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index 86595e5edff..b947479ade4 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -102,7 +102,7 @@ let resolve_module_file com m remap p = with Not_found -> Common.find_file com (compose_path true) in - let file = (match String.lowercase (snd m) with + let file = (match ExtString.String.lowercase (snd m) with | "con" | "aux" | "prn" | "nul" | "com1" | "com2" | "com3" | "lpt1" | "lpt2" | "lpt3" when Sys.os_type = "Win32" -> (* these names are reserved by the OS - old DOS legacy, such files cannot be easily created but are reported as visible *) if (try (Unix.stat file).Unix.st_size with _ -> 0) > 0 then file else raise Not_found