diff --git a/Changes b/Changes index 67bda55deee7..7a4dc171ff3f 100644 --- a/Changes +++ b/Changes @@ -44,6 +44,10 @@ Working version Thread.wait_write, Thread.wait_read, the whole ThreadUnix module. (Nicolás Ojeda Bär, review by Damien Doligez) +* #10896: Remove Stream, Genlex and Pervasives. Also remove legacy standalone + bigarray library (the Bigarray module is now part of the standard library). + (Nicolás Ojeda Bär, review by Kate Deplaix and Anil Madhavapeddy) + ### Other libraries: ### Tools: diff --git a/HACKING.adoc b/HACKING.adoc index e9f6473696dc..220e066c6254 100644 --- a/HACKING.adoc +++ b/HACKING.adoc @@ -133,7 +133,7 @@ link:stdlib/[]:: The standard library. Each file is largely independent and should not need further knowledge. link:otherlibs/[]:: External libraries such as `unix`, `threads`, -`dynlink`, `str` and `bigarray`. +`dynlink` and `str`. Instructions for building the full reference manual are provided in link:manual/README.md[]. However, if you only modify the documentation diff --git a/Makefile b/Makefile index 1682a61bf631..5c1f23c9977d 100644 --- a/Makefile +++ b/Makefile @@ -805,7 +805,7 @@ clean:: $(MAKE) -C runtime clean rm -f stdlib/libcamlrun.a stdlib/libcamlrun.lib -otherlibs_all := bigarray dynlink \ +otherlibs_all := dynlink \ str systhreads unix win32unix subdirs := debugger lex ocamldoc ocamltest stdlib tools \ $(addprefix otherlibs/, $(otherlibs_all)) \ diff --git a/Makefile.config.in b/Makefile.config.in index 63bdc810a4dc..e4e22de4dd13 100644 --- a/Makefile.config.in +++ b/Makefile.config.in @@ -168,9 +168,6 @@ INSTALL_BYTECODE_PROGRAMS=@install_bytecode_programs@ ### Which libraries to compile and install # Currently available: -# bigarray Large, multidimensional numerical arrays -# (legacy support: this library is now part of the -# Standard Library) # dynlink Dynamic linking (bytecode and native) # (win32)unix Unix system calls # str Regular expressions and high-level string processing diff --git a/README.win32.adoc b/README.win32.adoc index 374a155e2e4a..5c4041ac2243 100644 --- a/README.win32.adoc +++ b/README.win32.adoc @@ -225,7 +225,7 @@ your `~/.bashrc` file. the performance of bytecode programs is about 2/3 of that obtained under Unix/GCC, Cygwin or Mingw-w64 on similar hardware. -* Libraries available in this port: `bigarray`, `dynlink`, `num`, +* Libraries available in this port: `dynlink`, `num`, `str`, `threads`, and large parts of `unix`. * The replay debugger is partially supported (no reverse execution). @@ -279,7 +279,7 @@ After installing, you will need to ensure that `ocamlopt` (or `ocamlc -custom`) can access the C compiler. You can do this either by using OCaml from Cygwin's bash or by adding Cygwin's bin directory (e.g. `C:\cygwin\bin`) to your `PATH`. -* Libraries available in this port: `bigarray`, `dynlink`, `num`, +* Libraries available in this port: `dynlink`, `num`, `str`, `threads`, and large parts of `unix`. * The replay debugger is partially supported (no reverse execution). diff --git a/api_docgen/Makefile.docfiles b/api_docgen/Makefile.docfiles index d35f69ab6337..d85ccfb1a293 100644 --- a/api_docgen/Makefile.docfiles +++ b/api_docgen/Makefile.docfiles @@ -37,9 +37,9 @@ dynlink_MLIS := dynlink.mli thread_MLIS := \ thread.mli event.mli -STDLIB=$(filter-out stdlib__Pervasives, $(STDLIB_MODULES)) +STDLIB=$(STDLIB_MODULES) -stdlib_UNPREFIXED=$(filter-out pervasives, $(STDLIB_MODULE_BASENAMES)) +stdlib_UNPREFIXED=$(STDLIB_MODULE_BASENAMES) otherlibref := $(dynlink_MLIS:%.mli=%) @@ -55,9 +55,8 @@ ifneq "$(filter systhreads,$(OTHERLIBRARIES))" "" otherlibref += $(thread_MLIS:%.mli=%) endif -libref_EXTRA=stdlib__pervasives libref_TEXT=Ocaml_operators Format_tutorial -libref_C=$(call capitalize,$(libref) $(libref_EXTRA)) +libref_C=$(call capitalize,$(libref)) PARSING_MLIS := $(call sort, \ $(notdir $(wildcard $(ROOTDIR)/parsing/*.mli))\ diff --git a/configure b/configure index 24a8604d3075..325eb5855096 100755 --- a/configure +++ b/configure @@ -1570,7 +1570,6 @@ Optional Features: --disable-systhreads disable the Win32/POSIX threads library --disable-str-lib do not build the str library --disable-unix-lib do not build the unix library - --disable-bigarray-lib do not build the legacy separate bigarray library --disable-ocamldoc do not build the ocamldoc documentation system --disable-ocamltest do not build the ocamltest driver --enable-native-toplevel @@ -3204,7 +3203,8 @@ fi # Check whether --enable-bigarray-lib was given. if test "${enable_bigarray_lib+set}" = set; then : - enableval=$enable_bigarray_lib; + enableval=$enable_bigarray_lib; as_fn_error $? "The bigarray-lib option was deleted in OCaml 5.00, \ +as the Bigarray module is now part of the standard library." "$LINENO" 5 fi @@ -3414,9 +3414,6 @@ if test x"$enable_unix_lib" = "xno"; then : as_fn_error $? "replay debugger requires the unix library" "$LINENO" 5 else enable_debugger="no" -fi - if test x"$enable_bigarray_lib" = "xyes"; then : - as_fn_error $? "legacy bigarray library requires the unix library" "$LINENO" 5 fi fi @@ -12677,11 +12674,7 @@ esac otherlibraries="dynlink" if test x"$enable_unix_lib" != "xno"; then : enable_unix_lib=yes - if test x"$enable_bigarray_lib" != "xno"; then : - otherlibraries="$otherlibraries $unixlib bigarray" -else - otherlibraries="$otherlibraries $unixlib" -fi + otherlibraries="$otherlibraries $unixlib" fi if test x"$enable_str_lib" != "xno"; then : otherlibraries="$otherlibraries str" diff --git a/configure.ac b/configure.ac index bc1d1b493f7a..67831f74b933 100644 --- a/configure.ac +++ b/configure.ac @@ -273,9 +273,10 @@ AC_ARG_ENABLE([unix-lib], [AS_HELP_STRING([--disable-unix-lib], [do not build the unix library])]) -AC_ARG_ENABLE([bigarray-lib], - [AS_HELP_STRING([--disable-bigarray-lib], - [do not build the legacy separate bigarray library])]) +AC_ARG_ENABLE([bigarray-lib], [], + [AC_MSG_ERROR([The bigarray-lib option was deleted in OCaml 5.00, \ +as the Bigarray module is now part of the standard library.])], + []) AC_ARG_ENABLE([ocamldoc], [AS_HELP_STRING([--disable-ocamldoc], @@ -425,9 +426,7 @@ AC_ARG_WITH([flexdll], AS_IF([test x"$enable_unix_lib" = "xno"], [AS_IF([test x"$enable_debugger" = "xyes"], [AC_MSG_ERROR([replay debugger requires the unix library])], - [enable_debugger="no"]) - AS_IF([test x"$enable_bigarray_lib" = "xyes"], - [AC_MSG_ERROR([legacy bigarray library requires the unix library])])]) + [enable_debugger="no"])]) AS_IF([test x"$enable_unix_lib" = "xno" -o x"$enable_str_lib" = "xno"], [AS_IF([test x"$enable_ocamldoc" = "xyes"], @@ -547,9 +546,7 @@ AS_CASE([$host], otherlibraries="dynlink" AS_IF([test x"$enable_unix_lib" != "xno"], [enable_unix_lib=yes - AS_IF([test x"$enable_bigarray_lib" != "xno"], - [otherlibraries="$otherlibraries $unixlib bigarray"], - [otherlibraries="$otherlibraries $unixlib"])]) + otherlibraries="$otherlibraries $unixlib"]) AS_IF([test x"$enable_str_lib" != "xno"], [otherlibraries="$otherlibraries str"]) diff --git a/manual/src/library/core.etex b/manual/src/library/core.etex index eb823f015e0f..0cc59eeb0087 100644 --- a/manual/src/library/core.etex +++ b/manual/src/library/core.etex @@ -30,7 +30,4 @@ indexed at the end of this report. \fi \begin{linklist} \libdocitem{Stdlib}{the initially opened module} -\ifouthtml% -\item Module \texttt{Pervasives}: deprecated alias for Stdlib -\fi% \end{linklist} diff --git a/manual/src/library/stdlib-blurb.etex b/manual/src/library/stdlib-blurb.etex index c9b60d1c7276..4535ec7edf2f 100644 --- a/manual/src/library/stdlib-blurb.etex +++ b/manual/src/library/stdlib-blurb.etex @@ -88,10 +88,8 @@ indentation and line breaking \\ \end{tabular} \subsubsection*{sss:stdlib-parsing}{Parsing:} \begin{tabular}{lll} -"Genlex" & p.~\stdpageref{Genlex} & a generic lexer over streams \\ "Lexing" & p.~\stdpageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\ "Parsing" & p.~\stdpageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\ -"Stream" & p.~\stdpageref{Stream} & basic functions over streams \\ \end{tabular} \subsubsection*{sss:stdlib-system}{System interface:} \begin{tabular}{lll} @@ -141,7 +139,6 @@ be called from C \\ \stddocitem{Format}{pretty printing} \stddocitem{Fun}{function values} \stddocitem{Gc}{memory management control and statistics; finalized values} -\stddocitem{Genlex}{a generic lexical analyzer} \stddocitem{Hashtbl}{hash tables and hash functions} \stddocitem{In_channel}{input channels} \stddocitem{Int}{integers} @@ -171,7 +168,6 @@ be called from C \\ \stddocitem{Semaphore}{semaphores, another thread synchronization mechanism} \stddocitem{Stack}{last-in first-out stacks} \stddocitem{StdLabels}{include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels} -\stddocitem{Stream}{streams and parsers} \stddocitem{String}{string operations} \stddocitem{StringLabels}{string operations (with labels)} \stddocitem{Sys}{system interface} diff --git a/manual/tests/check-stdlib-modules b/manual/tests/check-stdlib-modules index ed17a5e35a36..fa3fc40c5fac 100755 --- a/manual/tests/check-stdlib-modules +++ b/manual/tests/check-stdlib-modules @@ -10,7 +10,7 @@ cut -c 2- $TMPDIR/stdlib-$$-files \ exitcode=0 for i in `cat $TMPDIR/stdlib-$$-modules`; do case $i in - Stdlib | Camlinternal* | *Labels | Obj | Pervasives | In_channel | Out_channel) continue;; + Stdlib | Camlinternal* | *Labels | Obj | In_channel | Out_channel) continue;; esac grep -q -e '"'$i'" & p\.~\\stdpageref{'$i'} &' $1/manual/src/library/stdlib-blurb.etex || { echo "Module $i is missing from the module description in library/stdlib-blurb.etex." >&2 diff --git a/otherlibs/Makefile b/otherlibs/Makefile index bd7b88361419..7f1a7edfa26e 100644 --- a/otherlibs/Makefile +++ b/otherlibs/Makefile @@ -16,7 +16,7 @@ ROOTDIR=.. include $(ROOTDIR)/Makefile.common -OTHERLIBRARIES ?= bigarray dynlink str systhreads \ +OTHERLIBRARIES ?= dynlink str systhreads \ unix win32unix # $1: target name to dispatch to all otherlibs/*/Makefile diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend deleted file mode 100644 index 24e7963ace3d..000000000000 --- a/otherlibs/bigarray/.depend +++ /dev/null @@ -1,5 +0,0 @@ -bigarray.cmo : \ - bigarray.cmi -bigarray.cmx : \ - bigarray.cmi -bigarray.cmi : diff --git a/otherlibs/bigarray/Makefile b/otherlibs/bigarray/Makefile deleted file mode 100644 index 02130dfd6f4c..000000000000 --- a/otherlibs/bigarray/Makefile +++ /dev/null @@ -1,26 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -#* * -#* Copyright 1999 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -LIBNAME=bigarray -CAMLOBJS=bigarray.cmo - -include ../Makefile.otherlibs.common - -.PHONY: depend - -depend: - $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend - -include .depend diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml deleted file mode 100644 index d7c9354eeb04..000000000000 --- a/otherlibs/bigarray/bigarray.ml +++ /dev/null @@ -1,15 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jeremie Dimino, Jane Street Europe *) -(* *) -(* Copyright 2018 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -include Stdlib.Bigarray diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli deleted file mode 100644 index 9dcaed9600d1..000000000000 --- a/otherlibs/bigarray/bigarray.mli +++ /dev/null @@ -1,15 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jeremie Dimino, Jane Street Europe *) -(* *) -(* Copyright 2018 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -include module type of struct include Stdlib.Bigarray end diff --git a/otherlibs/bigarray/empty.c b/otherlibs/bigarray/empty.c deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/stdlib/.depend b/stdlib/.depend index 67e92f953be3..c0e1ddb92e94 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -362,24 +362,6 @@ stdlib__Gc.cmx : gc.ml \ stdlib__Gc.cmi stdlib__Gc.cmi : gc.mli \ stdlib__Printexc.cmi -stdlib__Genlex.cmo : genlex.ml \ - stdlib__String.cmi \ - stdlib__Stream.cmi \ - stdlib__List.cmi \ - stdlib__Hashtbl.cmi \ - stdlib__Char.cmi \ - stdlib__Bytes.cmi \ - stdlib__Genlex.cmi -stdlib__Genlex.cmx : genlex.ml \ - stdlib__String.cmx \ - stdlib__Stream.cmx \ - stdlib__List.cmx \ - stdlib__Hashtbl.cmx \ - stdlib__Char.cmx \ - stdlib__Bytes.cmx \ - stdlib__Genlex.cmi -stdlib__Genlex.cmi : genlex.mli \ - stdlib__Stream.cmi stdlib__Hashtbl.cmo : hashtbl.ml \ stdlib__Sys.cmi \ stdlib__String.cmi \ @@ -581,10 +563,6 @@ stdlib__Parsing.cmx : parsing.ml \ stdlib__Parsing.cmi : parsing.mli \ stdlib__Obj.cmi \ stdlib__Lexing.cmi -stdlib__Pervasives.cmo : pervasives.ml \ - camlinternalFormatBasics.cmi -stdlib__Pervasives.cmx : pervasives.ml \ - camlinternalFormatBasics.cmx stdlib__Printexc.cmo : printexc.ml \ stdlib.cmi \ stdlib__Printf.cmi \ @@ -738,19 +716,6 @@ stdlib__StdLabels.cmi : stdLabels.mli \ stdlib__ArrayLabels.cmi std_exit.cmo : std_exit.cmx : -stdlib__Stream.cmo : stream.ml \ - stdlib__String.cmi \ - stdlib__List.cmi \ - stdlib__Lazy.cmi \ - stdlib__Bytes.cmi \ - stdlib__Stream.cmi -stdlib__Stream.cmx : stream.ml \ - stdlib__String.cmx \ - stdlib__List.cmx \ - stdlib__Lazy.cmx \ - stdlib__Bytes.cmx \ - stdlib__Stream.cmi -stdlib__Stream.cmi : stream.mli stdlib__String.cmo : string.ml \ stdlib.cmi \ stdlib__Bytes.cmi \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index e837270d2b48..084499581f41 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -35,15 +35,15 @@ # with lowercase first letters). These must be listed in dependency order. STDLIB_MODULE_BASENAMES = \ camlinternalFormatBasics camlinternalAtomic \ - stdlib pervasives either \ + stdlib either \ sys obj camlinternalLazy lazy \ seq option result bool char uchar \ list int bytes string unit marshal array float int32 int64 nativeint \ - lexing parsing set map stack queue stream buffer \ + lexing parsing set map stack queue buffer \ atomic mutex condition semaphore domain \ camlinternalFormat printf arg \ printexc fun gc digest bigarray random hashtbl weak \ - format scanf callback camlinternalOO oo camlinternalMod genlex ephemeron \ + format scanf callback camlinternalOO oo camlinternalMod ephemeron \ filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \ stdLabels in_channel out_channel effect diff --git a/stdlib/genlex.ml b/stdlib/genlex.ml deleted file mode 100644 index fad49d55d7ab..000000000000 --- a/stdlib/genlex.ml +++ /dev/null @@ -1,203 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -[@@@ocaml.warning "-3"] (* ignore deprecation warning about module Stream *) - -type token = - Kwd of string - | Ident of string - | Int of int - | Float of float - | String of string - | Char of char - -(* The string buffering machinery *) - -let initial_buffer = Bytes.create 32 - -let buffer = ref initial_buffer -let bufpos = ref 0 - -let reset_buffer () = buffer := initial_buffer; bufpos := 0 - -let store c = - if !bufpos >= Bytes.length !buffer then begin - let newbuffer = Bytes.create (2 * !bufpos) in - Bytes.blit !buffer 0 newbuffer 0 !bufpos; - buffer := newbuffer - end; - Bytes.set !buffer !bufpos c; - incr bufpos - -let get_string () = - let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s - -(* The lexer *) - -let make_lexer keywords = - let kwd_table = Hashtbl.create 17 in - List.iter (fun s -> Hashtbl.add kwd_table s (Kwd s)) keywords; - let ident_or_keyword id = - try Hashtbl.find kwd_table id with - Not_found -> Ident id - and keyword_or_error c = - let s = String.make 1 c in - try Hashtbl.find kwd_table s with - Not_found -> raise (Stream.Error ("Illegal character " ^ s)) - in - let rec next_token (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> - Stream.junk strm__; next_token strm__ - | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; ident s - | Some - ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' | - '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; ident2 s - | Some ('0'..'9' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; number s - | Some '\'' -> - Stream.junk strm__; - let c = - try char strm__ with - Stream.Failure -> raise (Stream.Error "") - in - begin match Stream.peek strm__ with - Some '\'' -> Stream.junk strm__; Some (Char c) - | _ -> raise (Stream.Error "") - end - | Some '\"' -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); Some (String (string s)) - | Some '-' -> Stream.junk strm__; neg_number strm__ - | Some '(' -> Stream.junk strm__; maybe_comment strm__ - | Some c -> Stream.junk strm__; Some (keyword_or_error c) - | _ -> None - and ident (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some - ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) -> - Stream.junk strm__; let s = strm__ in store c; ident s - | _ -> Some (ident_or_keyword (get_string ())) - and ident2 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some - ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' | - '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> - Stream.junk strm__; let s = strm__ in store c; ident2 s - | _ -> Some (ident_or_keyword (get_string ())) - and neg_number (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store '-'; store c; number s - | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s - and number (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; number s - | Some '.' -> - Stream.junk strm__; let s = strm__ in store '.'; decimal_part s - | Some ('e' | 'E') -> - Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s - | _ -> Some (Int (int_of_string (get_string ()))) - and decimal_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; decimal_part s - | Some ('e' | 'E') -> - Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s - | _ -> Some (Float (float_of_string (get_string ()))) - and exponent_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('+' | '-' as c) -> - Stream.junk strm__; let s = strm__ in store c; end_exponent_part s - | _ -> end_exponent_part strm__ - and end_exponent_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; end_exponent_part s - | _ -> Some (Float (float_of_string (get_string ()))) - and string (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\"' -> Stream.junk strm__; get_string () - | Some '\\' -> - Stream.junk strm__; - let c = - try escape strm__ with - Stream.Failure -> raise (Stream.Error "") - in - let s = strm__ in store c; string s - | Some c -> Stream.junk strm__; let s = strm__ in store c; string s - | _ -> raise Stream.Failure - and char (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\\' -> - Stream.junk strm__; - begin try escape strm__ with - Stream.Failure -> raise (Stream.Error "") - end - | Some c -> Stream.junk strm__; c - | _ -> raise Stream.Failure - and escape (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some 'n' -> Stream.junk strm__; '\n' - | Some 'r' -> Stream.junk strm__; '\r' - | Some 't' -> Stream.junk strm__; '\t' - | Some ('0'..'9' as c1) -> - Stream.junk strm__; - begin match Stream.peek strm__ with - Some ('0'..'9' as c2) -> - Stream.junk strm__; - begin match Stream.peek strm__ with - Some ('0'..'9' as c3) -> - Stream.junk strm__; - Char.chr - ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 + - (Char.code c3 - 48)) - | _ -> raise (Stream.Error "") - end - | _ -> raise (Stream.Error "") - end - | Some c -> Stream.junk strm__; c - | _ -> raise Stream.Failure - and maybe_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '*' -> - Stream.junk strm__; let s = strm__ in comment s; next_token s - | _ -> Some (keyword_or_error '(') - and comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '(' -> Stream.junk strm__; maybe_nested_comment strm__ - | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - and maybe_nested_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - and maybe_end_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ')' -> Stream.junk strm__; () - | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - in - fun input -> Stream.from (fun _count -> next_token input) diff --git a/stdlib/genlex.mli b/stdlib/genlex.mli deleted file mode 100644 index d48076587223..000000000000 --- a/stdlib/genlex.mli +++ /dev/null @@ -1,75 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** A generic lexical analyzer. - - - This module implements a simple 'standard' lexical analyzer, presented - as a function from character streams to token streams. It implements - roughly the lexical conventions of OCaml, but is parameterized by the - set of keywords of your language. - - - Example: a lexer suitable for a desk calculator is obtained by -{[ let lexer = make_lexer ["+"; "-"; "*"; "/"; "let"; "="; "("; ")"]]} - - The associated parser would be a function from [token stream] - to, for instance, [int], and would have rules such as: - - {[ - let rec parse_expr = parser - | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2 - and parse_atom = parser - | [< 'Int n >] -> n - | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n - and parse_remainder n1 = parser - | [< 'Kwd "+"; n2 = parse_expr >] -> n1 + n2 - | [< >] -> n1 - ]} - - One should notice that the use of the [parser] keyword and associated - notation for streams are only available through camlp4 extensions. This - means that one has to preprocess its sources {i e. g.} by using the - ["-pp"] command-line switch of the compilers. -*) - -[@@@ocaml.warning "-3"] (* ignore deprecation warning about module Stream *) - -(** The type of tokens. The lexical classes are: [Int] and [Float] - for integer and floating-point numbers; [String] for - string literals, enclosed in double quotes; [Char] for - character literals, enclosed in single quotes; [Ident] for - identifiers (either sequences of letters, digits, underscores - and quotes, or sequences of 'operator characters' such as - [+], [*], etc); and [Kwd] for keywords (either identifiers or - single 'special characters' such as [(], [}], etc). *) -type token = - Kwd of string - | Ident of string - | Int of int - | Float of float - | String of string - | Char of char - -val make_lexer : string list -> char Stream.t -> token Stream.t -(** Construct the lexer function. The first argument is the list of - keywords. An identifier [s] is returned as [Kwd s] if [s] - belongs to this list, and as [Ident s] otherwise. - A special character [s] is returned as [Kwd s] if [s] - belongs to this list, and cause a lexical error (exception - {!Stream.Error} with the offending lexeme as its parameter) otherwise. - Blanks and newlines are skipped. Comments delimited by [(*] and [*)] - are skipped as well, and can be nested. A {!Stream.Failure} exception - is raised if end of stream is unexpectedly reached.*) diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml deleted file mode 100644 index e9b2e5cdee10..000000000000 --- a/stdlib/pervasives.ml +++ /dev/null @@ -1,244 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Jeremie Dimino, Jane Street Europe *) -(* *) -(* Copyright 2017 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** @deprecated Use {!Stdlib} *) - -external raise : exn -> 'a = "%raise" -external raise_notrace : exn -> 'a = "%raise_notrace" -let invalid_arg = invalid_arg -let failwith = failwith -exception Exit -external ( = ) : 'a -> 'a -> bool = "%equal" -external ( <> ) : 'a -> 'a -> bool = "%notequal" -external ( < ) : 'a -> 'a -> bool = "%lessthan" -external ( > ) : 'a -> 'a -> bool = "%greaterthan" -external ( <= ) : 'a -> 'a -> bool = "%lessequal" -external ( >= ) : 'a -> 'a -> bool = "%greaterequal" -external compare : 'a -> 'a -> int = "%compare" -let min = min -let max = max -external ( == ) : 'a -> 'a -> bool = "%eq" -external ( != ) : 'a -> 'a -> bool = "%noteq" -external not : bool -> bool = "%boolnot" -external ( && ) : bool -> bool -> bool = "%sequand" -external ( & ) : bool -> bool -> bool = "%sequand" - [@@ocaml.deprecated "Use (&&) instead."] -external ( || ) : bool -> bool -> bool = "%sequor" -external ( or ) : bool -> bool -> bool = "%sequor" - [@@ocaml.deprecated "Use (||) instead."] -external __LOC__ : string = "%loc_LOC" -external __FILE__ : string = "%loc_FILE" -external __LINE__ : int = "%loc_LINE" -external __MODULE__ : string = "%loc_MODULE" -external __POS__ : string * int * int * int = "%loc_POS" -external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC" -external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE" -external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS" -external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply" -external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply" -external ( ~- ) : int -> int = "%negint" -external ( ~+ ) : int -> int = "%identity" -external succ : int -> int = "%succint" -external pred : int -> int = "%predint" -external ( + ) : int -> int -> int = "%addint" -external ( - ) : int -> int -> int = "%subint" -external ( * ) : int -> int -> int = "%mulint" -external ( / ) : int -> int -> int = "%divint" -external ( mod ) : int -> int -> int = "%modint" -let abs = abs -let max_int = max_int -let min_int = min_int -external ( land ) : int -> int -> int = "%andint" -external ( lor ) : int -> int -> int = "%orint" -external ( lxor ) : int -> int -> int = "%xorint" -let lnot = lnot -external ( lsl ) : int -> int -> int = "%lslint" -external ( lsr ) : int -> int -> int = "%lsrint" -external ( asr ) : int -> int -> int = "%asrint" -external ( ~-. ) : float -> float = "%negfloat" -external ( ~+. ) : float -> float = "%identity" -external ( +. ) : float -> float -> float = "%addfloat" -external ( -. ) : float -> float -> float = "%subfloat" -external ( *. ) : float -> float -> float = "%mulfloat" -external ( /. ) : float -> float -> float = "%divfloat" -external ( ** ) : float -> float -> float = "caml_power_float" "pow" - [@@unboxed] [@@noalloc] -external sqrt : float -> float = "caml_sqrt_float" "sqrt" - [@@unboxed] [@@noalloc] -external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] -external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] -external log10 : float -> float = "caml_log10_float" "log10" - [@@unboxed] [@@noalloc] -external expm1 : float -> float = "caml_expm1_float" "caml_expm1" - [@@unboxed] [@@noalloc] -external log1p : float -> float = "caml_log1p_float" "caml_log1p" - [@@unboxed] [@@noalloc] -external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc] -external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc] -external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc] -external acos : float -> float = "caml_acos_float" "acos" - [@@unboxed] [@@noalloc] -external asin : float -> float = "caml_asin_float" "asin" - [@@unboxed] [@@noalloc] -external atan : float -> float = "caml_atan_float" "atan" - [@@unboxed] [@@noalloc] -external atan2 : float -> float -> float = "caml_atan2_float" "atan2" - [@@unboxed] [@@noalloc] -external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" - [@@unboxed] [@@noalloc] -external cosh : float -> float = "caml_cosh_float" "cosh" - [@@unboxed] [@@noalloc] -external sinh : float -> float = "caml_sinh_float" "sinh" - [@@unboxed] [@@noalloc] -external tanh : float -> float = "caml_tanh_float" "tanh" - [@@unboxed] [@@noalloc] -external ceil : float -> float = "caml_ceil_float" "ceil" - [@@unboxed] [@@noalloc] -external floor : float -> float = "caml_floor_float" "floor" - [@@unboxed] [@@noalloc] -external abs_float : float -> float = "%absfloat" -external copysign : float -> float -> float - = "caml_copysign_float" "caml_copysign" - [@@unboxed] [@@noalloc] -external mod_float : float -> float -> float = "caml_fmod_float" "fmod" - [@@unboxed] [@@noalloc] -external frexp : float -> float * int = "caml_frexp_float" -external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) = - "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc] -external modf : float -> float * float = "caml_modf_float" -external float : int -> float = "%floatofint" -external float_of_int : int -> float = "%floatofint" -external truncate : float -> int = "%intoffloat" -external int_of_float : float -> int = "%intoffloat" -let infinity = infinity -let neg_infinity = neg_infinity -let nan = nan -let max_float = max_float -let min_float = min_float -let epsilon_float = epsilon_float -type nonrec fpclass = fpclass = - FP_normal - | FP_subnormal - | FP_zero - | FP_infinite - | FP_nan -external classify_float : (float [@unboxed]) -> fpclass = - "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc] -let ( ^ ) = ( ^ ) -external int_of_char : char -> int = "%identity" -let char_of_int = char_of_int -external ignore : 'a -> unit = "%ignore" -let string_of_bool = string_of_bool -let bool_of_string = bool_of_string -let bool_of_string_opt = bool_of_string_opt -let string_of_int = string_of_int -external int_of_string : string -> int = "caml_int_of_string" -let int_of_string_opt = int_of_string_opt -let string_of_float = string_of_float -external float_of_string : string -> float = "caml_float_of_string" -let float_of_string_opt = float_of_string_opt -external fst : 'a * 'b -> 'a = "%field0" -external snd : 'a * 'b -> 'b = "%field1" -let ( @ ) = ( @ ) -type nonrec in_channel = in_channel -type nonrec out_channel = out_channel -let stdin = stdin -let stdout = stdout -let stderr = stderr -let print_char = print_char -let print_string = print_string -let print_bytes = print_bytes -let print_int = print_int -let print_float = print_float -let print_endline = print_endline -let print_newline = print_newline -let prerr_char = prerr_char -let prerr_string = prerr_string -let prerr_bytes = prerr_bytes -let prerr_int = prerr_int -let prerr_float = prerr_float -let prerr_endline = prerr_endline -let prerr_newline = prerr_newline -let read_line = read_line -let read_int = read_int -let read_int_opt = read_int_opt -let read_float = read_float -let read_float_opt = read_float_opt -type nonrec open_flag = open_flag = - Open_rdonly - | Open_wronly - | Open_append - | Open_creat - | Open_trunc - | Open_excl - | Open_binary - | Open_text - | Open_nonblock -let open_out = open_out -let open_out_bin = open_out_bin -let open_out_gen = open_out_gen -let flush = flush -let flush_all = flush_all -let output_char = output_char -let output_string = output_string -let output_bytes = output_bytes -let output = output -let output_substring = output_substring -let output_byte = output_byte -let output_binary_int = output_binary_int -let output_value = output_value -let seek_out = seek_out -let pos_out = pos_out -let out_channel_length = out_channel_length -let close_out = close_out -let close_out_noerr = close_out_noerr -let set_binary_mode_out = set_binary_mode_out -let open_in = open_in -let open_in_bin = open_in_bin -let open_in_gen = open_in_gen -let input_char = input_char -let input_line = input_line -let input = input -let really_input = really_input -let really_input_string = really_input_string -let input_byte = input_byte -let input_binary_int = input_binary_int -let input_value = input_value -let seek_in = seek_in -let pos_in = pos_in -let in_channel_length = in_channel_length -let close_in = close_in -let close_in_noerr = close_in_noerr -let set_binary_mode_in = set_binary_mode_in -module LargeFile = LargeFile -type nonrec 'a ref = 'a ref = { mutable contents : 'a } -external ref : 'a -> 'a ref = "%makemutable" -external ( ! ) : 'a ref -> 'a = "%field0" -external ( := ) : 'a ref -> 'a -> unit = "%setfield0" -external incr : int ref -> unit = "%incr" -external decr : int ref -> unit = "%decr" -type nonrec ('a,'b) result = ('a,'b) result = Ok of 'a | Error of 'b -type ('a, 'b, 'c, 'd, 'e, 'f) format6 = - ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 -type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6 -type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4 -let string_of_format = string_of_format -external format_of_string : - ('a, 'b, 'c, 'd, 'e, 'f) format6 -> - ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity" -let ( ^^ ) = ( ^^ ) -let exit = exit -let at_exit = at_exit -let valid_float_lexem = valid_float_lexem -let do_at_exit = do_at_exit diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index f7e8afe8e3ef..f81ee7848b45 100644 --- a/stdlib/stdlib.ml +++ b/stdlib/stdlib.ml @@ -593,7 +593,6 @@ module Float = Float module Format = Format module Fun = Fun module Gc = Gc -module Genlex = Genlex module Hashtbl = Hashtbl module In_channel = In_channel module Int = Int @@ -613,7 +612,6 @@ module Oo = Oo module Option = Option module Out_channel = Out_channel module Parsing = Parsing -module Pervasives = Pervasives module Printexc = Printexc module Printf = Printf module Queue = Queue @@ -625,7 +623,6 @@ module Seq = Seq module Set = Set module Stack = Stack module StdLabels = StdLabels -module Stream = Stream module String = String module StringLabels = StringLabels module Sys = Sys diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index 63d4aad3082a..4ee05c02969e 100644 --- a/stdlib/stdlib.mli +++ b/stdlib/stdlib.mli @@ -1387,8 +1387,6 @@ module Float = Float module Format = Format module Fun = Fun module Gc = Gc -module Genlex = Genlex -[@@deprecated "Use the camlp-streams library instead."] module Hashtbl = Hashtbl module In_channel = In_channel module Int = Int @@ -1408,11 +1406,6 @@ module Oo = Oo module Option = Option module Out_channel = Out_channel module Parsing = Parsing -module Pervasives = Pervasives -[@@deprecated "Use Stdlib instead.\n\ -\n\ -If you need to stay compatible with OCaml < 4.07, you can use the \n\ -stdlib-shims library: https://github.com/ocaml/stdlib-shims"] module Printexc = Printexc module Printf = Printf module Queue = Queue @@ -1424,8 +1417,6 @@ module Seq = Seq module Set = Set module Stack = Stack module StdLabels = StdLabels -module Stream = Stream -[@@deprecated "Use the camlp-streams library instead."] module String = String module StringLabels = StringLabels module Sys = Sys diff --git a/stdlib/stream.ml b/stdlib/stream.ml deleted file mode 100644 index 2bfef709ddc2..000000000000 --- a/stdlib/stream.ml +++ /dev/null @@ -1,236 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -type 'a t = 'a cell option -and 'a cell = { mutable count : int; mutable data : 'a data } -and 'a data = - Sempty - | Scons of 'a * 'a data - | Sapp of 'a data * 'a data - | Slazy of 'a data Lazy.t - | Sgen of 'a gen - | Sbuffio : buffio -> char data -and 'a gen = { mutable curr : 'a option option; func : int -> 'a option } -and buffio = - { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int } - -exception Failure -exception Error of string - -let count = function - | None -> 0 - | Some { count } -> count -let data = function - | None -> Sempty - | Some { data } -> data - -let fill_buff b = - b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0 - - -let rec get_data : type v. int -> v data -> v data = fun count d -> match d with - (* Returns either Sempty or Scons(a, _) even when d is a generator - or a buffer. In those cases, the item a is seen as extracted from - the generator/buffer. - The count parameter is used for calling `Sgen-functions'. *) - Sempty | Scons (_, _) -> d - | Sapp (d1, d2) -> - begin match get_data count d1 with - Scons (a, d11) -> Scons (a, Sapp (d11, d2)) - | Sempty -> get_data count d2 - | _ -> assert false - end - | Sgen {curr = Some None} -> Sempty - | Sgen ({curr = Some(Some a)} as g) -> - g.curr <- None; Scons(a, d) - | Sgen g -> - begin match g.func count with - None -> g.curr <- Some(None); Sempty - | Some a -> Scons(a, d) - (* Warning: anyone using g thinks that an item has been read *) - end - | Sbuffio b -> - if b.ind >= b.len then fill_buff b; - if b.len == 0 then Sempty else - let r = Bytes.unsafe_get b.buff b.ind in - (* Warning: anyone using g thinks that an item has been read *) - b.ind <- succ b.ind; Scons(r, d) - | Slazy f -> get_data count (Lazy.force f) - - -let rec peek_data : type v. v cell -> v option = fun s -> - (* consult the first item of s *) - match s.data with - Sempty -> None - | Scons (a, _) -> Some a - | Sapp (_, _) -> - begin match get_data s.count s.data with - Scons(a, _) as d -> s.data <- d; Some a - | Sempty -> None - | _ -> assert false - end - | Slazy f -> s.data <- (Lazy.force f); peek_data s - | Sgen {curr = Some a} -> a - | Sgen g -> let x = g.func s.count in g.curr <- Some x; x - | Sbuffio b -> - if b.ind >= b.len then fill_buff b; - if b.len == 0 then begin s.data <- Sempty; None end - else Some (Bytes.unsafe_get b.buff b.ind) - - -let peek = function - | None -> None - | Some s -> peek_data s - - -let rec junk_data : type v. v cell -> unit = fun s -> - match s.data with - Scons (_, d) -> s.count <- (succ s.count); s.data <- d - | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None - | Sbuffio b -> - if b.ind >= b.len then fill_buff b; - if b.len == 0 then s.data <- Sempty - else (s.count <- (succ s.count); b.ind <- succ b.ind) - | _ -> - match peek_data s with - None -> () - | Some _ -> junk_data s - - -let junk = function - | None -> () - | Some data -> junk_data data - -let rec nget_data n s = - if n <= 0 then [], s.data, 0 - else - match peek_data s with - Some a -> - junk_data s; - let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k - | None -> [], s.data, 0 - - -let npeek_data n s = - let (al, d, len) = nget_data n s in - s.count <- (s.count - len); - s.data <- d; - al - - -let npeek n = function - | None -> [] - | Some d -> npeek_data n d - -let next s = - match peek s with - Some a -> junk s; a - | None -> raise Failure - - -let empty s = - match peek s with - Some _ -> raise Failure - | None -> () - - -let iter f strm = - let rec do_rec () = - match peek strm with - Some a -> junk strm; ignore(f a); do_rec () - | None -> () - in - do_rec () - - -(* Stream building functions *) - -let from f = Some {count = 0; data = Sgen {curr = None; func = f}} - -let of_list l = - Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty} - - -let of_string s = - let count = ref 0 in - from (fun _ -> - (* We cannot use the index passed by the [from] function directly - because it returns the current stream count, with absolutely no - guarantee that it will start from 0. For example, in the case - of [Stream.icons 'c' (Stream.from_string "ab")], the first - access to the string will be made with count [1] already. - *) - let c = !count in - if c < String.length s - then (incr count; Some s.[c]) - else None) - - -let of_bytes s = - let count = ref 0 in - from (fun _ -> - let c = !count in - if c < Bytes.length s - then (incr count; Some (Bytes.get s c)) - else None) - - -let of_channel ic = - Some {count = 0; - data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}} - - -(* Stream expressions builders *) - -let iapp i s = Some {count = 0; data = Sapp (data i, data s)} -let icons i s = Some {count = 0; data = Scons (i, data s)} -let ising i = Some {count = 0; data = Scons (i, Sempty)} - -let lapp f s = - Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))} - -let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))} -let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))} - -let sempty = None -let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))} - -(* For debugging use *) - -let rec dump : type v. (v -> unit) -> v t -> unit = fun f s -> - print_string "{count = "; - print_int (count s); - print_string "; data = "; - dump_data f (data s); - print_string "}"; - print_newline () -and dump_data : type v. (v -> unit) -> v data -> unit = fun f -> - function - Sempty -> print_string "Sempty" - | Scons (a, d) -> - print_string "Scons ("; - f a; - print_string ", "; - dump_data f d; - print_string ")" - | Sapp (d1, d2) -> - print_string "Sapp ("; - dump_data f d1; - print_string ", "; - dump_data f d2; - print_string ")" - | Slazy _ -> print_string "Slazy" - | Sgen _ -> print_string "Sgen" - | Sbuffio _ -> print_string "Sbuffio" diff --git a/stdlib/stream.mli b/stdlib/stream.mli deleted file mode 100644 index ea7d293a139b..000000000000 --- a/stdlib/stream.mli +++ /dev/null @@ -1,111 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Streams and parsers. *) - -type !'a t -(** The type of streams holding values of type ['a]. *) - -exception Failure -(** Raised by parsers when none of the first components of the stream - patterns is accepted. *) - -exception Error of string -(** Raised by parsers when the first component of a stream pattern is - accepted, but one of the following components is rejected. *) - - -(** {1 Stream builders} *) - -val from : (int -> 'a option) -> 'a t -(** [Stream.from f] returns a stream built from the function [f]. - To create a new stream element, the function [f] is called with - the current stream count. The user function [f] must return either - [Some ] for a value or [None] to specify the end of the - stream. - - Do note that the indices passed to [f] may not start at [0] in the - general case. For example, [[< '0; '1; Stream.from f >]] would call - [f] the first time with count [2]. -*) - -val of_list : 'a list -> 'a t -(** Return the stream holding the elements of the list in the same - order. *) - -val of_string : string -> char t -(** Return the stream of the characters of the string parameter. *) - -val of_bytes : bytes -> char t -(** Return the stream of the characters of the bytes parameter. - @since 4.02.0 *) - -val of_channel : in_channel -> char t -(** Return the stream of the characters read from the input channel. *) - - -(** {1 Stream iterator} *) - -val iter : ('a -> unit) -> 'a t -> unit -(** [Stream.iter f s] scans the whole stream s, applying function [f] - in turn to each stream element encountered. *) - - -(** {1 Predefined parsers} *) - -val next : 'a t -> 'a -(** Return the first element of the stream and remove it from the - stream. - @raise Stream.Failure if the stream is empty. *) - -val empty : 'a t -> unit -(** Return [()] if the stream is empty, else raise {!Stream.Failure}. *) - - -(** {1 Useful functions} *) - -val peek : 'a t -> 'a option -(** Return [Some] of "the first element" of the stream, or [None] if - the stream is empty. *) - -val junk : 'a t -> unit -(** Remove the first element of the stream, possibly unfreezing - it before. *) - -val count : 'a t -> int -(** Return the current count of the stream elements, i.e. the number - of the stream elements discarded. *) - -val npeek : int -> 'a t -> 'a list -(** [npeek n] returns the list of the [n] first elements of - the stream, or all its remaining elements if less than [n] - elements are available. *) - -(**/**) - -(* The following is for system use only. Do not call directly. *) - -val iapp : 'a t -> 'a t -> 'a t -val icons : 'a -> 'a t -> 'a t -val ising : 'a -> 'a t - -val lapp : (unit -> 'a t) -> 'a t -> 'a t -val lcons : (unit -> 'a) -> 'a t -> 'a t -val lsing : (unit -> 'a) -> 'a t - -val sempty : 'a t -val slazy : (unit -> 'a t) -> 'a t - -val dump : ('a -> unit) -> 'a t -> unit diff --git a/testsuite/tests/basic/patmatch_for_multiple.ml b/testsuite/tests/basic/patmatch_for_multiple.ml index e14525620b4a..6433f3d9a448 100644 --- a/testsuite/tests/basic/patmatch_for_multiple.ml +++ b/testsuite/tests/basic/patmatch_for_multiple.ml @@ -26,15 +26,15 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1) +(let (*match*/274 = 3 *match*/275 = 2 *match*/276 = 1) (catch (catch - (catch (if (!= *match*/278 3) (exit 3) (exit 1)) with (3) - (if (!= *match*/277 1) (exit 2) (exit 1))) + (catch (if (!= *match*/275 3) (exit 3) (exit 1)) with (3) + (if (!= *match*/274 1) (exit 2) (exit 1))) with (2) 0) with (1) 1)) -(let (*match*/277 = 3 *match*/278 = 2 *match*/279 = 1) - (catch (if (!= *match*/278 3) (if (!= *match*/277 1) 0 (exit 1)) (exit 1)) +(let (*match*/274 = 3 *match*/275 = 2 *match*/276 = 1) + (catch (if (!= *match*/275 3) (if (!= *match*/274 1) 0 (exit 1)) (exit 1)) with (1) 1)) - : bool = false |}];; @@ -47,26 +47,26 @@ match (3, 2, 1) with | _ -> false ;; [%%expect{| -(let (*match*/282 = 3 *match*/283 = 2 *match*/284 = 1) +(let (*match*/279 = 3 *match*/280 = 2 *match*/281 = 1) (catch (catch (catch - (if (!= *match*/283 3) (exit 6) - (let (x/286 =a (makeblock 0 *match*/282 *match*/283 *match*/284)) - (exit 4 x/286))) + (if (!= *match*/280 3) (exit 6) + (let (x/283 =a (makeblock 0 *match*/279 *match*/280 *match*/281)) + (exit 4 x/283))) with (6) - (if (!= *match*/282 1) (exit 5) - (let (x/285 =a (makeblock 0 *match*/282 *match*/283 *match*/284)) - (exit 4 x/285)))) + (if (!= *match*/279 1) (exit 5) + (let (x/282 =a (makeblock 0 *match*/279 *match*/280 *match*/281)) + (exit 4 x/282)))) with (5) 0) - with (4 x/280) (seq (ignore x/280) 1))) -(let (*match*/282 = 3 *match*/283 = 2 *match*/284 = 1) + with (4 x/277) (seq (ignore x/277) 1))) +(let (*match*/279 = 3 *match*/280 = 2 *match*/281 = 1) (catch - (if (!= *match*/283 3) - (if (!= *match*/282 1) 0 - (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284))) - (exit 4 (makeblock 0 *match*/282 *match*/283 *match*/284))) - with (4 x/280) (seq (ignore x/280) 1))) + (if (!= *match*/280 3) + (if (!= *match*/279 1) 0 + (exit 4 (makeblock 0 *match*/279 *match*/280 *match*/281))) + (exit 4 (makeblock 0 *match*/279 *match*/280 *match*/281))) + with (4 x/277) (seq (ignore x/277) 1))) - : bool = false |}];; @@ -76,8 +76,8 @@ let _ = fun a b -> | ((true, _) as _g) | ((false, _) as _g) -> () [%%expect{| -(function a/287[int] b/288 : int 0) -(function a/287[int] b/288 : int 0) +(function a/284[int] b/285 : int 0) +(function a/284[int] b/285 : int 0) - : bool -> 'a -> unit = |}];; @@ -96,8 +96,8 @@ let _ = fun a b -> match a, b with | (false, _) as p -> p (* outside, trivial *) [%%expect {| -(function a/291[int] b/292 (let (p/293 =a (makeblock 0 a/291 b/292)) p/293)) -(function a/291[int] b/292 (makeblock 0 a/291 b/292)) +(function a/288[int] b/289 (let (p/290 =a (makeblock 0 a/288 b/289)) p/290)) +(function a/288[int] b/289 (makeblock 0 a/288 b/289)) - : bool -> 'a -> bool * 'a = |}] @@ -106,8 +106,8 @@ let _ = fun a b -> match a, b with | ((false, _) as p) -> p (* inside, trivial *) [%%expect{| -(function a/295[int] b/296 (let (p/297 =a (makeblock 0 a/295 b/296)) p/297)) -(function a/295[int] b/296 (makeblock 0 a/295 b/296)) +(function a/292[int] b/293 (let (p/294 =a (makeblock 0 a/292 b/293)) p/294)) +(function a/292[int] b/293 (makeblock 0 a/292 b/293)) - : bool -> 'a -> bool * 'a = |}];; @@ -116,11 +116,11 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, simple *) [%%expect {| -(function a/301[int] b/302 - (let (x/303 =a[int] a/301 p/304 =a (makeblock 0 a/301 b/302)) - (makeblock 0 (int,*) x/303 p/304))) -(function a/301[int] b/302 - (makeblock 0 (int,*) a/301 (makeblock 0 a/301 b/302))) +(function a/298[int] b/299 + (let (x/300 =a[int] a/298 p/301 =a (makeblock 0 a/298 b/299)) + (makeblock 0 (int,*) x/300 p/301))) +(function a/298[int] b/299 + (makeblock 0 (int,*) a/298 (makeblock 0 a/298 b/299))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -129,11 +129,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, simple *) [%%expect {| -(function a/307[int] b/308 - (let (x/309 =a[int] a/307 p/310 =a (makeblock 0 a/307 b/308)) - (makeblock 0 (int,*) x/309 p/310))) -(function a/307[int] b/308 - (makeblock 0 (int,*) a/307 (makeblock 0 a/307 b/308))) +(function a/304[int] b/305 + (let (x/306 =a[int] a/304 p/307 =a (makeblock 0 a/304 b/305)) + (makeblock 0 (int,*) x/306 p/307))) +(function a/304[int] b/305 + (makeblock 0 (int,*) a/304 (makeblock 0 a/304 b/305))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -142,15 +142,15 @@ let _ = fun a b -> match a, b with | (false, x) as p -> x, p (* outside, complex *) [%%expect{| -(function a/317[int] b/318[int] - (if a/317 - (let (x/319 =a[int] a/317 p/320 =a (makeblock 0 a/317 b/318)) - (makeblock 0 (int,*) x/319 p/320)) - (let (x/321 =a b/318 p/322 =a (makeblock 0 a/317 b/318)) - (makeblock 0 (int,*) x/321 p/322)))) -(function a/317[int] b/318[int] - (if a/317 (makeblock 0 (int,*) a/317 (makeblock 0 a/317 b/318)) - (makeblock 0 (int,*) b/318 (makeblock 0 a/317 b/318)))) +(function a/314[int] b/315[int] + (if a/314 + (let (x/316 =a[int] a/314 p/317 =a (makeblock 0 a/314 b/315)) + (makeblock 0 (int,*) x/316 p/317)) + (let (x/318 =a b/315 p/319 =a (makeblock 0 a/314 b/315)) + (makeblock 0 (int,*) x/318 p/319)))) +(function a/314[int] b/315[int] + (if a/314 (makeblock 0 (int,*) a/314 (makeblock 0 a/314 b/315)) + (makeblock 0 (int,*) b/315 (makeblock 0 a/314 b/315)))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -160,19 +160,19 @@ let _ = fun a b -> match a, b with -> x, p (* inside, complex *) [%%expect{| -(function a/323[int] b/324[int] +(function a/320[int] b/321[int] (catch - (if a/323 - (let (x/331 =a[int] a/323 p/332 =a (makeblock 0 a/323 b/324)) - (exit 10 x/331 p/332)) - (let (x/329 =a b/324 p/330 =a (makeblock 0 a/323 b/324)) - (exit 10 x/329 p/330))) - with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326))) -(function a/323[int] b/324[int] + (if a/320 + (let (x/328 =a[int] a/320 p/329 =a (makeblock 0 a/320 b/321)) + (exit 10 x/328 p/329)) + (let (x/326 =a b/321 p/327 =a (makeblock 0 a/320 b/321)) + (exit 10 x/326 p/327))) + with (10 x/322[int] p/323) (makeblock 0 (int,*) x/322 p/323))) +(function a/320[int] b/321[int] (catch - (if a/323 (exit 10 a/323 (makeblock 0 a/323 b/324)) - (exit 10 b/324 (makeblock 0 a/323 b/324))) - with (10 x/325[int] p/326) (makeblock 0 (int,*) x/325 p/326))) + (if a/320 (exit 10 a/320 (makeblock 0 a/320 b/321)) + (exit 10 b/321 (makeblock 0 a/320 b/321))) + with (10 x/322[int] p/323) (makeblock 0 (int,*) x/322 p/323))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -185,15 +185,15 @@ let _ = fun a b -> match a, b with | (false as x, _) as p -> x, p (* outside, onecase *) [%%expect {| -(function a/333[int] b/334[int] - (if a/333 - (let (x/335 =a[int] a/333 _p/336 =a (makeblock 0 a/333 b/334)) - (makeblock 0 (int,*) x/335 [0: 1 1])) - (let (x/337 =a[int] a/333 p/338 =a (makeblock 0 a/333 b/334)) - (makeblock 0 (int,*) x/337 p/338)))) -(function a/333[int] b/334[int] - (if a/333 (makeblock 0 (int,*) a/333 [0: 1 1]) - (makeblock 0 (int,*) a/333 (makeblock 0 a/333 b/334)))) +(function a/330[int] b/331[int] + (if a/330 + (let (x/332 =a[int] a/330 _p/333 =a (makeblock 0 a/330 b/331)) + (makeblock 0 (int,*) x/332 [0: 1 1])) + (let (x/334 =a[int] a/330 p/335 =a (makeblock 0 a/330 b/331)) + (makeblock 0 (int,*) x/334 p/335)))) +(function a/330[int] b/331[int] + (if a/330 (makeblock 0 (int,*) a/330 [0: 1 1]) + (makeblock 0 (int,*) a/330 (makeblock 0 a/330 b/331)))) - : bool -> bool -> bool * (bool * bool) = |}] @@ -202,11 +202,11 @@ let _ = fun a b -> match a, b with | ((false as x, _) as p) -> x, p (* inside, onecase *) [%%expect{| -(function a/339[int] b/340 - (let (x/341 =a[int] a/339 p/342 =a (makeblock 0 a/339 b/340)) - (makeblock 0 (int,*) x/341 p/342))) -(function a/339[int] b/340 - (makeblock 0 (int,*) a/339 (makeblock 0 a/339 b/340))) +(function a/336[int] b/337 + (let (x/338 =a[int] a/336 p/339 =a (makeblock 0 a/336 b/337)) + (makeblock 0 (int,*) x/338 p/339))) +(function a/336[int] b/337 + (makeblock 0 (int,*) a/336 (makeblock 0 a/336 b/337))) - : bool -> 'a -> bool * (bool * 'a) = |}] @@ -223,14 +223,14 @@ let _ =fun a b -> match a, b with | (_, _) as p -> p (* outside, tuplist *) [%%expect {| -(function a/352[int] b/353 +(function a/349[int] b/350 (catch - (if a/352 (if b/353 (let (p/354 =a (field_imm 0 b/353)) p/354) (exit 12)) + (if a/349 (if b/350 (let (p/351 =a (field_imm 0 b/350)) p/351) (exit 12)) (exit 12)) - with (12) (let (p/355 =a (makeblock 0 a/352 b/353)) p/355))) -(function a/352[int] b/353 - (catch (if a/352 (if b/353 (field_imm 0 b/353) (exit 12)) (exit 12)) - with (12) (makeblock 0 a/352 b/353))) + with (12) (let (p/352 =a (makeblock 0 a/349 b/350)) p/352))) +(function a/349[int] b/350 + (catch (if a/349 (if b/350 (field_imm 0 b/350) (exit 12)) (exit 12)) + with (12) (makeblock 0 a/349 b/350))) - : bool -> bool tuplist -> bool * bool tuplist = |}] @@ -239,20 +239,20 @@ let _ = fun a b -> match a, b with | ((_, _) as p) -> p (* inside, tuplist *) [%%expect{| -(function a/356[int] b/357 +(function a/353[int] b/354 (catch (catch - (if a/356 - (if b/357 (let (p/361 =a (field_imm 0 b/357)) (exit 13 p/361)) + (if a/353 + (if b/354 (let (p/358 =a (field_imm 0 b/354)) (exit 13 p/358)) (exit 14)) (exit 14)) - with (14) (let (p/360 =a (makeblock 0 a/356 b/357)) (exit 13 p/360))) - with (13 p/358) p/358)) -(function a/356[int] b/357 + with (14) (let (p/357 =a (makeblock 0 a/353 b/354)) (exit 13 p/357))) + with (13 p/355) p/355)) +(function a/353[int] b/354 (catch (catch - (if a/356 (if b/357 (exit 13 (field_imm 0 b/357)) (exit 14)) (exit 14)) - with (14) (exit 13 (makeblock 0 a/356 b/357))) - with (13 p/358) p/358)) + (if a/353 (if b/354 (exit 13 (field_imm 0 b/354)) (exit 14)) (exit 14)) + with (14) (exit 13 (makeblock 0 a/353 b/354))) + with (13 p/355) p/355)) - : bool -> bool tuplist -> bool * bool tuplist = |}] diff --git a/testsuite/tests/generalized-open/gpr1506.ml b/testsuite/tests/generalized-open/gpr1506.ml index bb1eea1e724f..bd72ed302fb6 100644 --- a/testsuite/tests/generalized-open/gpr1506.ml +++ b/testsuite/tests/generalized-open/gpr1506.ml @@ -103,9 +103,9 @@ include struct open struct type t = T end let x = T end Line 1, characters 15-41: 1 | include struct open struct type t = T end let x = T end ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The type t/340 introduced by this open appears in the signature +Error: The type t/337 introduced by this open appears in the signature Line 1, characters 46-47: - The value x has no valid type if t/340 is hidden + The value x has no valid type if t/337 is hidden |}];; module A = struct @@ -123,9 +123,9 @@ Lines 3-6, characters 4-7: 4 | type t = T 5 | let x = T 6 | end -Error: The type t/345 introduced by this open appears in the signature +Error: The type t/342 introduced by this open appears in the signature Line 7, characters 8-9: - The value y has no valid type if t/345 is hidden + The value y has no valid type if t/342 is hidden |}];; module A = struct @@ -142,9 +142,9 @@ Lines 3-5, characters 4-7: 3 | ....open struct 4 | type t = T 5 | end -Error: The type t/350 introduced by this open appears in the signature +Error: The type t/347 introduced by this open appears in the signature Line 6, characters 8-9: - The value y has no valid type if t/350 is hidden + The value y has no valid type if t/347 is hidden |}] (* It was decided to not allow this anymore. *) diff --git a/testsuite/tests/lib-stdlib/pervasives_deprecated.ml b/testsuite/tests/lib-stdlib/pervasives_deprecated.ml deleted file mode 100644 index 86df55428eb9..000000000000 --- a/testsuite/tests/lib-stdlib/pervasives_deprecated.ml +++ /dev/null @@ -1,41 +0,0 @@ -(* TEST - * expect -*) - -[@@@warning "@A"];; - -Pervasives.(+) 1 1;; -[%%expect{| -Line 3, characters 0-14: -3 | Pervasives.(+) 1 1;; - ^^^^^^^^^^^^^^ -Error (alert deprecated): module Stdlib.Pervasives -Use Stdlib instead. - -If you need to stay compatible with OCaml < 4.07, you can use the -stdlib-shims library: https://github.com/ocaml/stdlib-shims -|}] - -module X = Pervasives;; -[%%expect{| -Line 1, characters 11-21: -1 | module X = Pervasives;; - ^^^^^^^^^^ -Error (alert deprecated): module Stdlib.Pervasives -Use Stdlib instead. - -If you need to stay compatible with OCaml < 4.07, you can use the -stdlib-shims library: https://github.com/ocaml/stdlib-shims -|}] - -open Pervasives;; -[%%expect{| -Line 1, characters 5-15: -1 | open Pervasives;; - ^^^^^^^^^^ -Error (alert deprecated): module Stdlib.Pervasives -Use Stdlib instead. - -If you need to stay compatible with OCaml < 4.07, you can use the -stdlib-shims library: https://github.com/ocaml/stdlib-shims -|}] diff --git a/testsuite/tests/lib-stream/count_concat_bug.ml b/testsuite/tests/lib-stream/count_concat_bug.ml deleted file mode 100644 index b8605b8bdfb2..000000000000 --- a/testsuite/tests/lib-stream/count_concat_bug.ml +++ /dev/null @@ -1,62 +0,0 @@ -(* TEST - flags = "-w -3" - include testing -*) - -let is_empty s = - try Stream.empty s; true with Stream.Failure -> false - -let test_icons = - let s = Stream.of_string "ab" in - let s = Stream.icons 'c' s in - Testing.test (Stream.next s = 'c'); - Testing.test (Stream.next s = 'a'); - Testing.test (Stream.next s = 'b'); - Testing.test (is_empty s); - () - -let test_lcons = - let s = Stream.of_string "ab" in - let s = Stream.lcons (fun () -> 'c') s in - Testing.test (Stream.next s = 'c'); - Testing.test (Stream.next s = 'a'); - Testing.test (Stream.next s = 'b'); - Testing.test (is_empty s); - () - -let test_iapp = - let s = Stream.of_string "ab" in - let s = Stream.iapp (Stream.of_list ['c']) s in - Testing.test (Stream.next s = 'c'); - Testing.test (Stream.next s = 'a'); - Testing.test (Stream.next s = 'b'); - Testing.test (is_empty s); - () - -let test_lapp_right = - let s1 = Stream.of_list ['c'] in - let s2 = Stream.of_string "ab" in - let s = Stream.lapp (fun () -> s1) s2 in - Testing.test (Stream.next s = 'c'); - Testing.test (Stream.next s = 'a'); - Testing.test (Stream.next s = 'b'); - Testing.test (is_empty s); - () - -let test_lapp_left = - let s1 = Stream.of_string "bc" in - let s2 = Stream.of_list ['a'] in - Testing.test (Stream.next s1 = 'b'); - let s = Stream.lapp (fun () -> s1) s2 in - Testing.test (Stream.next s = 'c'); - Testing.test (Stream.next s = 'a'); - Testing.test (is_empty s); - () - -let test_slazy = - let s = Stream.of_string "ab" in - Testing.test (Stream.next s = 'a'); - let s = Stream.slazy (fun () -> s) in - Testing.test (Stream.next s = 'b'); - Testing.test (is_empty s); - () diff --git a/testsuite/tests/lib-stream/count_concat_bug.reference b/testsuite/tests/lib-stream/count_concat_bug.reference deleted file mode 100644 index 52e367eabc8e..000000000000 --- a/testsuite/tests/lib-stream/count_concat_bug.reference +++ /dev/null @@ -1,2 +0,0 @@ - 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 -All tests succeeded. diff --git a/testsuite/tests/lib-stream/mpr7769.ml b/testsuite/tests/lib-stream/mpr7769.ml deleted file mode 100644 index 9bace0c2b092..000000000000 --- a/testsuite/tests/lib-stream/mpr7769.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* TEST - flags = "-w -3" - readonly_files = "mpr7769.txt" -*) - -let () = - let s = Stream.of_channel (open_in "mpr7769.txt") in - Stream.junk s; - print_char (Stream.next s); - print_newline () diff --git a/testsuite/tests/lib-stream/mpr7769.reference b/testsuite/tests/lib-stream/mpr7769.reference deleted file mode 100644 index 61780798228d..000000000000 --- a/testsuite/tests/lib-stream/mpr7769.reference +++ /dev/null @@ -1 +0,0 @@ -b diff --git a/testsuite/tests/lib-stream/mpr7769.txt b/testsuite/tests/lib-stream/mpr7769.txt deleted file mode 100644 index 81bf39695611..000000000000 --- a/testsuite/tests/lib-stream/mpr7769.txt +++ /dev/null @@ -1 +0,0 @@ -ab diff --git a/testsuite/tests/shapes/comp_units.ml b/testsuite/tests/shapes/comp_units.ml index ea64f67af5eb..1de07d7fcdf5 100644 --- a/testsuite/tests/shapes/comp_units.ml +++ b/testsuite/tests/shapes/comp_units.ml @@ -25,7 +25,7 @@ module Mproj = Unit module F (X : sig type t end) = X [%%expect{| { - "F"[module] -> Abs<.4>(X/280, X/280<.3>); + "F"[module] -> Abs<.4>(X/277, X/277<.3>); } module F : functor (X : sig type t end) -> sig type t = X.t end |}] diff --git a/testsuite/tests/shapes/functors.ml b/testsuite/tests/shapes/functors.ml index aa4fe0d0f011..a909d53ebbcc 100644 --- a/testsuite/tests/shapes/functors.ml +++ b/testsuite/tests/shapes/functors.ml @@ -17,7 +17,7 @@ module type S = sig type t val x : t end module Falias (X : S) = X [%%expect{| { - "Falias"[module] -> Abs<.4>(X/282, X/282<.3>); + "Falias"[module] -> Abs<.4>(X/279, X/279<.3>); } module Falias : functor (X : S) -> sig type t = X.t val x : t end |}] @@ -29,10 +29,10 @@ end { "Finclude"[module] -> Abs<.6> - (X/286, + (X/283, { - "t"[type] -> X/286<.5> . "t"[type]; - "x"[value] -> X/286<.5> . "x"[value]; + "t"[type] -> X/283<.5> . "t"[type]; + "x"[value] -> X/283<.5> . "x"[value]; }); } module Finclude : functor (X : S) -> sig type t = X.t val x : t end @@ -45,7 +45,7 @@ end [%%expect{| { "Fredef"[module] -> - Abs<.10>(X/293, { + Abs<.10>(X/290, { "t"[type] -> <.8>; "x"[value] -> <.9>; }); @@ -223,8 +223,8 @@ module Big_to_small1 : B2S = functor (X : Big) -> X [%%expect{| { "Big_to_small1"[module] -> - Abs<.40>(X/388, {<.39> - "t"[type] -> X/388<.39> . "t"[type]; + Abs<.40>(X/385, {<.39> + "t"[type] -> X/385<.39> . "t"[type]; }); } module Big_to_small1 : B2S @@ -234,8 +234,8 @@ module Big_to_small2 : B2S = functor (X : Big) -> struct include X end [%%expect{| { "Big_to_small2"[module] -> - Abs<.42>(X/391, { - "t"[type] -> X/391<.41> . "t"[type]; + Abs<.42>(X/388, { + "t"[type] -> X/388<.41> . "t"[type]; }); } module Big_to_small2 : B2S diff --git a/testsuite/tests/shapes/open_arg.ml b/testsuite/tests/shapes/open_arg.ml index 9dd8cbe05a67..e0c502523497 100644 --- a/testsuite/tests/shapes/open_arg.ml +++ b/testsuite/tests/shapes/open_arg.ml @@ -22,7 +22,7 @@ end = struct end [%%expect{| { - "Make"[module] -> Abs<.3>(I/282, { + "Make"[module] -> Abs<.3>(I/279, { }); } module Make : functor (I : sig end) -> sig end diff --git a/testsuite/tests/shapes/recmodules.ml b/testsuite/tests/shapes/recmodules.ml index 2f31951dc478..1911efd4fc6a 100644 --- a/testsuite/tests/shapes/recmodules.ml +++ b/testsuite/tests/shapes/recmodules.ml @@ -43,8 +43,8 @@ and B : sig end = B [%%expect{| { - "A"[module] -> A/305<.11>; - "B"[module] -> B/306<.12>; + "A"[module] -> A/302<.11>; + "B"[module] -> B/303<.12>; } module rec A : sig type t = Leaf of B.t end and B : sig type t = int end @@ -82,13 +82,13 @@ end = Set.Make(A) "ASet"[module] -> { "compare"[value] -> - CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . + CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) . "compare"[value]; "elt"[type] -> - CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . + CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) . "elt"[type]; "t"[type] -> - CU Stdlib . "Set"[module] . "Make"[module](A/327<.19>) . "t"[type]; + CU Stdlib . "Set"[module] . "Make"[module](A/324<.19>) . "t"[type]; }; } module rec A : diff --git a/testsuite/tests/shapes/rotor_example.ml b/testsuite/tests/shapes/rotor_example.ml index d0d4632bb3c0..e8f96a6c39be 100644 --- a/testsuite/tests/shapes/rotor_example.ml +++ b/testsuite/tests/shapes/rotor_example.ml @@ -26,7 +26,7 @@ end { "Pair"[module] -> Abs<.9> - (X/282, Abs(Y/283, { + (X/279, Abs(Y/280, { "t"[type] -> <.5>; "to_string"[value] -> <.6>; })); diff --git a/testsuite/tests/tool-ocaml/t240-c_call2.ml b/testsuite/tests/tool-ocaml/t240-c_call2.ml index 6a0c055858ae..35d3916e822f 100644 --- a/testsuite/tests/tool-ocaml/t240-c_call2.ml +++ b/testsuite/tests/tool-ocaml/t240-c_call2.ml @@ -7,7 +7,7 @@ ocaml_script_as_argument = "true" *) open Lib;; -if Pervasives.compare 1 2 <> -1 then raise Not_found;; +if Stdlib.compare 1 2 <> -1 then raise Not_found;; (** 0 CONSTINT 42 diff --git a/testsuite/tests/tool-ocaml/t330-compact-2.ml b/testsuite/tests/tool-ocaml/t330-compact-2.ml index c61ec42bf36e..d466b1a246c1 100644 --- a/testsuite/tests/tool-ocaml/t330-compact-2.ml +++ b/testsuite/tests/tool-ocaml/t330-compact-2.ml @@ -8,7 +8,7 @@ ocaml_script_as_argument = "true" open Lib;; Gc.compact ();; -let _ = Pervasives.do_at_exit();; +let _ = Stdlib.do_at_exit();; (** 0 CONSTINT 42 diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index c09643864ea0..5636e9abe258 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/testsuite/tests/typing-sigsubst/sigsubst.ml @@ -24,11 +24,11 @@ end Line 3, characters 2-36: 3 | include Comparable with type t = t ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Illegal shadowing of included type t/287 by t/292 +Error: Illegal shadowing of included type t/284 by t/289 Line 2, characters 2-19: - Type t/287 came from this include + Type t/284 came from this include Line 3, characters 2-23: - The value print has no valid type if t/287 is shadowed + The value print has no valid type if t/284 is shadowed |}] module type Sunderscore = sig diff --git a/toplevel/dune b/toplevel/dune index cb4ff13ef342..a541ed7f30ee 100644 --- a/toplevel/dune +++ b/toplevel/dune @@ -61,7 +61,6 @@ stdlib__Float stdlib__Format stdlib__Gc - stdlib__Genlex stdlib__Hashtbl stdlib__Int32 stdlib__Int64 @@ -77,7 +76,6 @@ stdlib__Oo stdlib__Option stdlib__Parsing - stdlib__Pervasives stdlib__Printexc stdlib__Printf stdlib__Queue @@ -89,7 +87,6 @@ stdlib__Stack ; stdlib__StdLabels stdlib - stdlib__Stream stdlib__String ; stdlib__StringLabels stdlib__Sys