root
8 years ago
parent
a320ead9c0
commit
bab2f19597
@ -1 +1,2 @@
|
||||
DIST tripwire-2.4.2.2-src.tar.bz2 716616 SHA256 e09a7bdca9302e704cc62067399e0b584488f825b0e58c82ad6d54cd2e899fad SHA512 be39757aac7b74d4deac6c5048d0964d839a32f8f2a0d1878c4246888c4d59e35a503413595178c7af3a0da80725d0b36c21026dc734e1f760c9affda017bbbb WHIRLPOOL beb99e1ae055947a4b94a45f51492bcc453def5a41188f853ff3285a85ef8e2921274b86b095b77dbcdc8f549358f6216996a75ba391247e17bf7a29c78849c5
|
||||
DIST tripwire-2.4.3.1.tar.gz 932665 SHA256 9744af4de7ecb1d643442eb22f08c819556494bb6f56f5879e22c3438f2db896 SHA512 fb5f0ad353da826a0e8381e534e0da1ac9335851e108a23053e378afd3aec6e66931446addbf0ba8d55eaa8d3148c471056e26095aeff7696ed9b6d3633cdf90 WHIRLPOOL b87447869d845be840399389a3e3ed5f9c961f6777c1b463755994876b191e08cca359273826466d34f2f32a26b597f23d130f6cb689224ed3ff58810efceed1
|
||||
|
||||
@ -0,0 +1,79 @@
|
||||
# Copyright 1999-2016 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
|
||||
inherit autotools eutils flag-o-matic
|
||||
|
||||
DESCRIPTION="Open Source File Integrity Checker and IDS"
|
||||
HOMEPAGE="http://www.tripwire.org/"
|
||||
SRC_URI="https://github.com/Tripwire/tripwire-open-source/archive/${PV}.tar.gz -> ${PF}.tar.gz"
|
||||
|
||||
LICENSE="GPL-2"
|
||||
SLOT="0"
|
||||
KEYWORDS="~amd64 ~ppc ~x86 ~x86-fbsd"
|
||||
IUSE="libressl ssl static +tools"
|
||||
|
||||
DEPEND="sys-devel/automake
|
||||
sys-devel/autoconf
|
||||
ssl? (
|
||||
!libressl? ( dev-libs/openssl:0= )
|
||||
libressl? ( dev-libs/libressl:0= )
|
||||
)"
|
||||
RDEPEND="virtual/cron
|
||||
virtual/mta
|
||||
ssl? ( dev-libs/openssl )"
|
||||
PDEPEND="tools? ( app-admin/mktwpol )"
|
||||
|
||||
S="${WORKDIR}/tripwire-open-source-${PV}"
|
||||
|
||||
src_prepare() {
|
||||
mv configure.in configure.ac || die
|
||||
eautoreconf
|
||||
}
|
||||
|
||||
src_configure() {
|
||||
# tripwire can be sensitive to compiler optimisation.
|
||||
# see #32613, #45823, and others.
|
||||
# -taviso@gentoo.org
|
||||
strip-flags
|
||||
append-cppflags -DCONFIG_DIR='"\"/etc/tripwire\""' -fno-strict-aliasing
|
||||
econf $(use_enable ssl openssl) $(use_enable static)
|
||||
}
|
||||
|
||||
src_install() {
|
||||
dosbin "${S}"/bin/{siggen,tripwire,twadmin,twprint}
|
||||
doman "${S}"/man/man{4/*.4,5/*.5,8/*.8}
|
||||
dodir /etc/tripwire /var/lib/tripwire{,/report}
|
||||
keepdir /var/lib/tripwire{,/report}
|
||||
|
||||
exeinto /etc/cron.daily
|
||||
doexe "${FILESDIR}"/tripwire
|
||||
|
||||
dodoc ChangeLog policy/policyguide.txt TRADEMARK \
|
||||
"${FILESDIR}"/tripwire.txt
|
||||
|
||||
insinto /etc/tripwire
|
||||
doins "${FILESDIR}"/twcfg.txt policy/twpol-GENERIC.txt
|
||||
|
||||
fperms 750 /etc/cron.daily/tripwire
|
||||
}
|
||||
|
||||
pkg_postinst() {
|
||||
if [[ -z ${REPLACING_VERSIONS} ]] ; then
|
||||
elog "Tripwire needs to be configured before its first run. You can"
|
||||
elog "do this by manually editing the twpol-GENERIC.txt file shipped with"
|
||||
elog "the package to suit your needs. A quickstart guide is provided"
|
||||
elog "in tripwire.txt file to help you with this."
|
||||
elog "To configure tripwire automatically, you can use the twsetup.sh"
|
||||
elog "script provided by the app-admin/mktwpol package. This package is"
|
||||
elog "installed for you by the \"tools\" USE flag (which is enabled by"
|
||||
elog "default."
|
||||
else
|
||||
elog "Maintenance of tripwire policy files as packages are added"
|
||||
elog "and deleted from your system can be automated by the mktwpol.sh"
|
||||
elog "script provided by the app-admin/mktwpol package. This package"
|
||||
elog "is installed for you if you append \"tools\" to your USE flags"
|
||||
fi
|
||||
}
|
||||
@ -1,3 +1,4 @@
|
||||
DIST scite355.tgz 2302137 SHA256 20515597ac986f1727c97bda2c27d88487ddb79cfe330b0b890b5e25330b7d9f SHA512 cdd9d3aa621f5d31632cfb9f71524255a4b47b70a654bf4bc8a25a76f8a2dbe098a48e0cd4587ced8ca8455be7e809973e212fcbcde5b62087aa0f9528f7f40d WHIRLPOOL c901804481042b859be68f44ab728544e97975d61219a4bb576ba3da00bd663c8877e9b23b981a0295d759cae3e9afd037d981923086c6850ff29f01c43ec9f6
|
||||
DIST scite362.tgz 2368491 SHA256 6530d0d86c72485b815663e3b2c2987d59779340a71632ed8bb97a43530737a3 SHA512 cb9618e962a16db7484e16a494b3da39f210250277e9772b112af5e16649b38f27ead0ec61664b1211c9263880cb7f3c34b5b32d94a4e70087fb1503805740c1 WHIRLPOOL 52a31f0e1518a9d8f6107aa22eead7da89e1d1ea6523a2aae57fbd7a3a8ecbd192c124c3d2550acea6383457763d6e501b14791ec6490a54379c5d13356e42da
|
||||
DIST scite364.tgz 2386959 SHA256 6a27a1062b838e0fe914fb045f265935e5d39e34d69ae894b55f971437192baa SHA512 eaba353edac23902a8f446fb8877f3e5dd43221e5289bc38941d76068a3f7c87602e9eb5828e6caafec56657d05b5268aad2a1bb36356a14154de3c22602c76d WHIRLPOOL f1b4c64eb4a5c6d6e73ffb3f457a5b5ddf8d31cf5f5778b204c05a093bcfb8e78e7a8cab634cf369ce29f200c11b933492f01c30afb268f581d465ed31157c88
|
||||
DIST scite365.tgz 2391190 SHA256 dde62ebebbd4c36afd81ab0e745ff04839f4cfc911496f2d0463aade1374b9d1 SHA512 193dcb1f8787a7c7d520ce62462e5c95e7b6bcaf79f4ab23f9885474fb0444dbc5a69a0d45eafc592e5fff2a2e746a9aba599799e847e3c74d3436eed26580a9 WHIRLPOOL e79a2f05444c16f40f6c84fd252d3b71247a48f6af27f912d3f51de99b968c93ec505bc903aa4df407d1ff503f3ce35052004c46e3f7fe8502d0d0ef4939610e
|
||||
|
||||
@ -0,0 +1,90 @@
|
||||
# Copyright 1999-2016 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI="6"
|
||||
|
||||
inherit toolchain-funcs eutils
|
||||
|
||||
MY_PV=${PV//./}
|
||||
DESCRIPTION="A very powerful editor for programmers"
|
||||
HOMEPAGE="http://www.scintilla.org/SciTE.html"
|
||||
SRC_URI="mirror://sourceforge/scintilla/${PN}${MY_PV}.tgz"
|
||||
|
||||
LICENSE="HPND lua? ( MIT )"
|
||||
SLOT="0"
|
||||
KEYWORDS="~amd64 ~ppc ~x86 ~x86-fbsd ~x86-freebsd ~amd64-linux ~arm-linux ~x86-linux"
|
||||
IUSE="lua"
|
||||
|
||||
RDEPEND="dev-libs/glib:=
|
||||
x11-libs/cairo:*
|
||||
x11-libs/gtk+:2
|
||||
x11-libs/gdk-pixbuf:*
|
||||
x11-libs/pango:*
|
||||
lua? ( >=dev-lang/lua-5:= )"
|
||||
DEPEND="${RDEPEND}
|
||||
virtual/pkgconfig
|
||||
>=sys-apps/sed-4"
|
||||
|
||||
S="${WORKDIR}/${PN}/gtk"
|
||||
|
||||
src_prepare() {
|
||||
sed -i "${WORKDIR}/scintilla/gtk/makefile" \
|
||||
-e "s#^CXXFLAGS=#CXXFLAGS=${CXXFLAGS} #" \
|
||||
-e "s#^\(CXXFLAGS=.*\)-Os#\1#" \
|
||||
-e "s#^CC =\(.*\)#CC = $(tc-getCXX)#" \
|
||||
-e "s#^CCOMP =\(.*\)#CCOMP = $(tc-getCC)#" \
|
||||
-e "s#-Os##" \
|
||||
|| die "error patching /scintilla/gtk/makefile"
|
||||
|
||||
sed -i "${WORKDIR}/scite/gtk/makefile" \
|
||||
-e "s#-rdynamic#-rdynamic ${LDFLAGS}#" \
|
||||
|| die "error patching /scite/gtk/makefile"
|
||||
|
||||
# repair and enhance the .desktop file
|
||||
sed -i "${WORKDIR}/scite/gtk/SciTE.desktop" \
|
||||
-e "s/^Encoding/#Encoding/" \
|
||||
-e "s#text/plain#text/\*;application/xhtml+xml#" \
|
||||
-e "s#^Categories=\(.*\)#Categories=Development;#" \
|
||||
|| die "error patching /scite/gtk/SciTe.desktop"
|
||||
|
||||
sed -i "${S}/makefile" \
|
||||
-e 's#usr/local#usr#g' \
|
||||
-e 's#/gnome/apps/Applications#/applications#' \
|
||||
-e "s#^CXXFLAGS=#CXXFLAGS=${CXXFLAGS} #" \
|
||||
-e "s#^\(CXXFLAGS=.*\)-Os#\1#" \
|
||||
-e "s#^CC =\(.*\)#CC = $(tc-getCXX)#" \
|
||||
-e "s#^CCOMP =\(.*\)#CCOMP = $(tc-getCC)#" \
|
||||
-e 's#${D}##' \
|
||||
-e 's#-g root#-g 0#' \
|
||||
-e "s#-Os##" \
|
||||
|| die "error patching gtk/makefile"
|
||||
|
||||
eapply_user
|
||||
}
|
||||
|
||||
src_compile() {
|
||||
emake CC="$(tc-getCC)" LD="$(tc-getLD)" \
|
||||
LDFLAGS="$(raw-ldflags)" AR="$(tc-getAR)" \
|
||||
-C "${WORKDIR}/scintilla/gtk"
|
||||
|
||||
if use lua; then
|
||||
emake
|
||||
else
|
||||
emake NO_LUA=1
|
||||
fi
|
||||
}
|
||||
|
||||
src_install() {
|
||||
dodir /usr/bin
|
||||
dodir /usr/share/{pixmaps,applications}
|
||||
|
||||
emake DESTDIR="${ED}" install
|
||||
|
||||
# we have to keep this because otherwise it'll break upgrading
|
||||
mv "${ED}/usr/bin/SciTE" "${ED}/usr/bin/scite" || die
|
||||
dosym /usr/bin/scite /usr/bin/SciTE
|
||||
|
||||
doman ../doc/scite.1
|
||||
dodoc ../README
|
||||
}
|
||||
@ -1,3 +1,3 @@
|
||||
DIST openssl-0.9.8zh.tar.gz 3818524 SHA256 f1d9f3ed1b85a82ecf80d0e2d389e1fda3fca9a4dba0bf07adbf231e1a5e2fd6 SHA512 b97fa2468211f86c0719c68ad1781eff84f772c479ed5193d6da14bac086b4ca706e7d851209d9df3f0962943b5e5333ab0def00110fb2e517caa73c0c6674c6 WHIRLPOOL 8ed3362e6aed89cd6ae02438bc3fb58ff3a91afb8a2d401d1d66c1ee4fd96f4befb50558131dd03a60fc15b588172fc1ede5d56bb1f68e184453bfe3b34f9abf
|
||||
DIST openssl-1.0.2f.tar.gz 5258384 SHA256 932b4ee4def2b434f85435d9e3e19ca8ba99ce9a065a61524b429a9d5e9b2e9c SHA512 50abf6dc94cafd06e7fd20770808bdc675c88daa369e4f752bd584ab17f72a57357c1ca1eca3c83e6745b5a3c9c73c99dce70adaa904d73f6df4c75bc7138351 WHIRLPOOL 179e1b5ad38c50a4c8110024aa7b33c53634c39690917e3bf5c2099548430beef96132ae9f9588ff0cedd6e08bb216a8d36835baaaa04e506fb3fbaed37d31c9
|
||||
DIST openssl-1.0.2g.tar.gz 5266102 SHA256 b784b1b3907ce39abf4098702dade6365522a253ad1552e267a9a0e89594aa33 SHA512 4d96b6c8a232203483d6e8bee81da01ba10977bfbac92f25304a36dec9ea584b7ef917bc45e097cc7dbe681d71a4570d649c22244c178393ae91fab48323f735 WHIRLPOOL aedbd82af0a550e8329a84312fae492f3bb3cb04af763fc9ef532099b2b2e61a55e4a7cfb06085f045740e2b692bbdb3ecb8bf5ca82f46325c3caf22d2317ffb
|
||||
DIST openssl-1.0.2h.tar.gz 5274412 SHA256 1d4007e53aad94a5b2002fe045ee7bb0b3d98f1a47f8b2bc851dcd1c74332919 SHA512 780601f6f3f32f42b6d7bbc4c593db39a3575f9db80294a10a68b2b0bb79448d9bd529ca700b9977354cbdfc65887c76af0aa7b90d3ee421f74ab53e6f15c303 WHIRLPOOL 41b6cf0c08b547f1432dc8167a4c7835da0b6907f8932969e0a352fab8bdbb4d8f612a5bf431e415d93ff1c8238652b2ee3ce0bd935cc2f59e8ea4f40fe6b5d6
|
||||
|
||||
@ -1,314 +0,0 @@
|
||||
--- openssl-1.0.2e/crypto/Makefile
|
||||
+++ openssl-1.0.2e/crypto/Makefile
|
||||
@@ -85,11 +85,11 @@
|
||||
@if [ -z "$(THIS)" ]; then $(MAKE) -f $(TOP)/Makefile reflect THIS=$@; fi
|
||||
|
||||
subdirs:
|
||||
- @target=all; $(RECURSIVE_MAKE)
|
||||
+ +@target=all; $(RECURSIVE_MAKE)
|
||||
|
||||
files:
|
||||
$(PERL) $(TOP)/util/files.pl "CPUID_OBJ=$(CPUID_OBJ)" Makefile >> $(TOP)/MINFO
|
||||
- @target=files; $(RECURSIVE_MAKE)
|
||||
+ +@target=files; $(RECURSIVE_MAKE)
|
||||
|
||||
links:
|
||||
@$(PERL) $(TOP)/util/mklink.pl ../include/openssl $(EXHEADER)
|
||||
@@ -100,7 +100,7 @@
|
||||
# lib: $(LIB): are splitted to avoid end-less loop
|
||||
lib: $(LIB)
|
||||
@touch lib
|
||||
-$(LIB): $(LIBOBJ)
|
||||
+$(LIB): $(LIBOBJ) | subdirs
|
||||
$(AR) $(LIB) $(LIBOBJ)
|
||||
test -z "$(FIPSLIBDIR)" || $(AR) $(LIB) $(FIPSLIBDIR)fipscanister.o
|
||||
$(RANLIB) $(LIB) || echo Never mind.
|
||||
@@ -111,7 +111,7 @@
|
||||
fi
|
||||
|
||||
libs:
|
||||
- @target=lib; $(RECURSIVE_MAKE)
|
||||
+ +@target=lib; $(RECURSIVE_MAKE)
|
||||
|
||||
install:
|
||||
@[ -n "$(INSTALLTOP)" ] # should be set by top Makefile...
|
||||
@@ -120,7 +120,7 @@
|
||||
(cp $$i $(INSTALL_PREFIX)$(INSTALLTOP)/include/openssl/$$i; \
|
||||
chmod 644 $(INSTALL_PREFIX)$(INSTALLTOP)/include/openssl/$$i ); \
|
||||
done;
|
||||
- @target=install; $(RECURSIVE_MAKE)
|
||||
+ +@target=install; $(RECURSIVE_MAKE)
|
||||
|
||||
lint:
|
||||
@target=lint; $(RECURSIVE_MAKE)
|
||||
--- openssl-1.0.2e/engines/Makefile
|
||||
+++ openssl-1.0.2e/engines/Makefile
|
||||
@@ -72,7 +72,7 @@
|
||||
|
||||
all: lib subdirs
|
||||
|
||||
-lib: $(LIBOBJ)
|
||||
+lib: $(LIBOBJ) | subdirs
|
||||
@if [ -n "$(SHARED_LIBS)" ]; then \
|
||||
set -e; \
|
||||
for l in $(LIBNAMES); do \
|
||||
@@ -89,7 +89,7 @@
|
||||
|
||||
subdirs:
|
||||
echo $(EDIRS)
|
||||
- @target=all; $(RECURSIVE_MAKE)
|
||||
+ +@target=all; $(RECURSIVE_MAKE)
|
||||
|
||||
files:
|
||||
$(PERL) $(TOP)/util/files.pl Makefile >> $(TOP)/MINFO
|
||||
@@ -128,7 +128,7 @@
|
||||
mv -f $(INSTALL_PREFIX)$(INSTALLTOP)/$(LIBDIR)/engines/$$pfx$$l$$sfx.new $(INSTALL_PREFIX)$(INSTALLTOP)/$(LIBDIR)/engines/$$pfx$$l$$sfx ); \
|
||||
done; \
|
||||
fi
|
||||
- @target=install; $(RECURSIVE_MAKE)
|
||||
+ +@target=install; $(RECURSIVE_MAKE)
|
||||
|
||||
tags:
|
||||
ctags $(SRC)
|
||||
--- openssl-1.0.2e/Makefile.org
|
||||
+++ openssl-1.0.2e/Makefile.org
|
||||
@@ -280,17 +280,17 @@
|
||||
build_libssl: build_ssl libssl.pc
|
||||
|
||||
build_crypto:
|
||||
- @dir=crypto; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=crypto; target=all; $(BUILD_ONE_CMD)
|
||||
build_ssl: build_crypto
|
||||
- @dir=ssl; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=ssl; target=all; $(BUILD_ONE_CMD)
|
||||
build_engines: build_crypto
|
||||
- @dir=engines; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=engines; target=all; $(BUILD_ONE_CMD)
|
||||
build_apps: build_libs
|
||||
- @dir=apps; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=apps; target=all; $(BUILD_ONE_CMD)
|
||||
build_tests: build_libs
|
||||
- @dir=test; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=test; target=all; $(BUILD_ONE_CMD)
|
||||
build_tools: build_libs
|
||||
- @dir=tools; target=all; $(BUILD_ONE_CMD)
|
||||
+ +@dir=tools; target=all; $(BUILD_ONE_CMD)
|
||||
|
||||
all_testapps: build_libs build_testapps
|
||||
build_testapps:
|
||||
@@ -548,7 +548,7 @@
|
||||
(cp $$i $(INSTALL_PREFIX)$(INSTALLTOP)/include/openssl/$$i; \
|
||||
chmod 644 $(INSTALL_PREFIX)$(INSTALLTOP)/include/openssl/$$i ); \
|
||||
done;
|
||||
- @set -e; target=install; $(RECURSIVE_BUILD_CMD)
|
||||
+ +@set -e; target=install; $(RECURSIVE_BUILD_CMD)
|
||||
@set -e; liblist="$(LIBS)"; for i in $$liblist ;\
|
||||
do \
|
||||
if [ -f "$$i" ]; then \
|
||||
--- openssl-1.0.2e/Makefile.shared
|
||||
+++ openssl-1.0.2e/Makefile.shared
|
||||
@@ -105,6 +105,7 @@
|
||||
SHAREDFLAGS="$${SHAREDFLAGS:-$(CFLAGS) $(SHARED_LDFLAGS)}"; \
|
||||
LIBPATH=`for x in $$LIBDEPS; do echo $$x; done | sed -e 's/^ *-L//;t' -e d | uniq`; \
|
||||
LIBPATH=`echo $$LIBPATH | sed -e 's/ /:/g'`; \
|
||||
+ [ -e $$SHLIB$$SHLIB_SOVER$$SHLIB_SUFFIX ] && exit 0; \
|
||||
LD_LIBRARY_PATH=$$LIBPATH:$$LD_LIBRARY_PATH \
|
||||
$${SHAREDCMD} $${SHAREDFLAGS} \
|
||||
-o $$SHLIB$$SHLIB_SOVER$$SHLIB_SUFFIX \
|
||||
@@ -122,6 +123,7 @@
|
||||
done; \
|
||||
fi; \
|
||||
if [ -n "$$SHLIB_SOVER" ]; then \
|
||||
+ [ -e "$$SHLIB$$SHLIB_SUFFIX" ] || \
|
||||
( $(SET_X); rm -f $$SHLIB$$SHLIB_SUFFIX; \
|
||||
ln -s $$prev $$SHLIB$$SHLIB_SUFFIX ); \
|
||||
fi; \
|
||||
--- openssl-1.0.2e/test/Makefile
|
||||
+++ openssl-1.0.2e/test/Makefile
|
||||
@@ -138,7 +138,7 @@
|
||||
tags:
|
||||
ctags $(SRC)
|
||||
|
||||
-tests: exe apps $(TESTS)
|
||||
+tests: exe $(TESTS)
|
||||
|
||||
apps:
|
||||
@(cd ..; $(MAKE) DIRS=apps all)
|
||||
@@ -416,127 +416,127 @@
|
||||
link_app.$${shlib_target}
|
||||
|
||||
$(RSATEST)$(EXE_EXT): $(RSATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RSATEST); $(BUILD_CMD)
|
||||
+ +@target=$(RSATEST); $(BUILD_CMD)
|
||||
|
||||
$(BNTEST)$(EXE_EXT): $(BNTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(BNTEST); $(BUILD_CMD)
|
||||
+ +@target=$(BNTEST); $(BUILD_CMD)
|
||||
|
||||
$(ECTEST)$(EXE_EXT): $(ECTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(ECTEST); $(BUILD_CMD)
|
||||
+ +@target=$(ECTEST); $(BUILD_CMD)
|
||||
|
||||
$(EXPTEST)$(EXE_EXT): $(EXPTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(EXPTEST); $(BUILD_CMD)
|
||||
+ +@target=$(EXPTEST); $(BUILD_CMD)
|
||||
|
||||
$(IDEATEST)$(EXE_EXT): $(IDEATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(IDEATEST); $(BUILD_CMD)
|
||||
+ +@target=$(IDEATEST); $(BUILD_CMD)
|
||||
|
||||
$(MD2TEST)$(EXE_EXT): $(MD2TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(MD2TEST); $(BUILD_CMD)
|
||||
+ +@target=$(MD2TEST); $(BUILD_CMD)
|
||||
|
||||
$(SHATEST)$(EXE_EXT): $(SHATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(SHATEST); $(BUILD_CMD)
|
||||
+ +@target=$(SHATEST); $(BUILD_CMD)
|
||||
|
||||
$(SHA1TEST)$(EXE_EXT): $(SHA1TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(SHA1TEST); $(BUILD_CMD)
|
||||
+ +@target=$(SHA1TEST); $(BUILD_CMD)
|
||||
|
||||
$(SHA256TEST)$(EXE_EXT): $(SHA256TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(SHA256TEST); $(BUILD_CMD)
|
||||
+ +@target=$(SHA256TEST); $(BUILD_CMD)
|
||||
|
||||
$(SHA512TEST)$(EXE_EXT): $(SHA512TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(SHA512TEST); $(BUILD_CMD)
|
||||
+ +@target=$(SHA512TEST); $(BUILD_CMD)
|
||||
|
||||
$(RMDTEST)$(EXE_EXT): $(RMDTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RMDTEST); $(BUILD_CMD)
|
||||
+ +@target=$(RMDTEST); $(BUILD_CMD)
|
||||
|
||||
$(MDC2TEST)$(EXE_EXT): $(MDC2TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(MDC2TEST); $(BUILD_CMD)
|
||||
+ +@target=$(MDC2TEST); $(BUILD_CMD)
|
||||
|
||||
$(MD4TEST)$(EXE_EXT): $(MD4TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(MD4TEST); $(BUILD_CMD)
|
||||
+ +@target=$(MD4TEST); $(BUILD_CMD)
|
||||
|
||||
$(MD5TEST)$(EXE_EXT): $(MD5TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(MD5TEST); $(BUILD_CMD)
|
||||
+ +@target=$(MD5TEST); $(BUILD_CMD)
|
||||
|
||||
$(HMACTEST)$(EXE_EXT): $(HMACTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(HMACTEST); $(BUILD_CMD)
|
||||
+ +@target=$(HMACTEST); $(BUILD_CMD)
|
||||
|
||||
$(WPTEST)$(EXE_EXT): $(WPTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(WPTEST); $(BUILD_CMD)
|
||||
+ +@target=$(WPTEST); $(BUILD_CMD)
|
||||
|
||||
$(RC2TEST)$(EXE_EXT): $(RC2TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RC2TEST); $(BUILD_CMD)
|
||||
+ +@target=$(RC2TEST); $(BUILD_CMD)
|
||||
|
||||
$(BFTEST)$(EXE_EXT): $(BFTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(BFTEST); $(BUILD_CMD)
|
||||
+ +@target=$(BFTEST); $(BUILD_CMD)
|
||||
|
||||
$(CASTTEST)$(EXE_EXT): $(CASTTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(CASTTEST); $(BUILD_CMD)
|
||||
+ +@target=$(CASTTEST); $(BUILD_CMD)
|
||||
|
||||
$(RC4TEST)$(EXE_EXT): $(RC4TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RC4TEST); $(BUILD_CMD)
|
||||
+ +@target=$(RC4TEST); $(BUILD_CMD)
|
||||
|
||||
$(RC5TEST)$(EXE_EXT): $(RC5TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RC5TEST); $(BUILD_CMD)
|
||||
+ +@target=$(RC5TEST); $(BUILD_CMD)
|
||||
|
||||
$(DESTEST)$(EXE_EXT): $(DESTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(DESTEST); $(BUILD_CMD)
|
||||
+ +@target=$(DESTEST); $(BUILD_CMD)
|
||||
|
||||
$(RANDTEST)$(EXE_EXT): $(RANDTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(RANDTEST); $(BUILD_CMD)
|
||||
+ +@target=$(RANDTEST); $(BUILD_CMD)
|
||||
|
||||
$(DHTEST)$(EXE_EXT): $(DHTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(DHTEST); $(BUILD_CMD)
|
||||
+ +@target=$(DHTEST); $(BUILD_CMD)
|
||||
|
||||
$(DSATEST)$(EXE_EXT): $(DSATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(DSATEST); $(BUILD_CMD)
|
||||
+ +@target=$(DSATEST); $(BUILD_CMD)
|
||||
|
||||
$(METHTEST)$(EXE_EXT): $(METHTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(METHTEST); $(BUILD_CMD)
|
||||
+ +@target=$(METHTEST); $(BUILD_CMD)
|
||||
|
||||
$(SSLTEST)$(EXE_EXT): $(SSLTEST).o $(DLIBSSL) $(DLIBCRYPTO)
|
||||
- @target=$(SSLTEST); $(FIPS_BUILD_CMD)
|
||||
+ +@target=$(SSLTEST); $(FIPS_BUILD_CMD)
|
||||
|
||||
$(ENGINETEST)$(EXE_EXT): $(ENGINETEST).o $(DLIBCRYPTO)
|
||||
- @target=$(ENGINETEST); $(BUILD_CMD)
|
||||
+ +@target=$(ENGINETEST); $(BUILD_CMD)
|
||||
|
||||
$(EVPTEST)$(EXE_EXT): $(EVPTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(EVPTEST); $(BUILD_CMD)
|
||||
+ +@target=$(EVPTEST); $(BUILD_CMD)
|
||||
|
||||
$(EVPEXTRATEST)$(EXE_EXT): $(EVPEXTRATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(EVPEXTRATEST); $(BUILD_CMD)
|
||||
+ +@target=$(EVPEXTRATEST); $(BUILD_CMD)
|
||||
|
||||
$(ECDSATEST)$(EXE_EXT): $(ECDSATEST).o $(DLIBCRYPTO)
|
||||
- @target=$(ECDSATEST); $(BUILD_CMD)
|
||||
+ +@target=$(ECDSATEST); $(BUILD_CMD)
|
||||
|
||||
$(ECDHTEST)$(EXE_EXT): $(ECDHTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(ECDHTEST); $(BUILD_CMD)
|
||||
+ +@target=$(ECDHTEST); $(BUILD_CMD)
|
||||
|
||||
$(IGETEST)$(EXE_EXT): $(IGETEST).o $(DLIBCRYPTO)
|
||||
- @target=$(IGETEST); $(BUILD_CMD)
|
||||
+ +@target=$(IGETEST); $(BUILD_CMD)
|
||||
|
||||
$(JPAKETEST)$(EXE_EXT): $(JPAKETEST).o $(DLIBCRYPTO)
|
||||
- @target=$(JPAKETEST); $(BUILD_CMD)
|
||||
+ +@target=$(JPAKETEST); $(BUILD_CMD)
|
||||
|
||||
$(ASN1TEST)$(EXE_EXT): $(ASN1TEST).o $(DLIBCRYPTO)
|
||||
- @target=$(ASN1TEST); $(BUILD_CMD)
|
||||
+ +@target=$(ASN1TEST); $(BUILD_CMD)
|
||||
|
||||
$(SRPTEST)$(EXE_EXT): $(SRPTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(SRPTEST); $(BUILD_CMD)
|
||||
+ +@target=$(SRPTEST); $(BUILD_CMD)
|
||||
|
||||
$(V3NAMETEST)$(EXE_EXT): $(V3NAMETEST).o $(DLIBCRYPTO)
|
||||
- @target=$(V3NAMETEST); $(BUILD_CMD)
|
||||
+ +@target=$(V3NAMETEST); $(BUILD_CMD)
|
||||
|
||||
$(HEARTBEATTEST)$(EXE_EXT): $(HEARTBEATTEST).o $(DLIBCRYPTO)
|
||||
- @target=$(HEARTBEATTEST); $(BUILD_CMD_STATIC)
|
||||
+ +@target=$(HEARTBEATTEST); $(BUILD_CMD_STATIC)
|
||||
|
||||
$(CONSTTIMETEST)$(EXE_EXT): $(CONSTTIMETEST).o
|
||||
- @target=$(CONSTTIMETEST) $(BUILD_CMD)
|
||||
+ +@target=$(CONSTTIMETEST) $(BUILD_CMD)
|
||||
|
||||
$(VERIFYEXTRATEST)$(EXE_EXT): $(VERIFYEXTRATEST).o
|
||||
- @target=$(VERIFYEXTRATEST) $(BUILD_CMD)
|
||||
+ +@target=$(VERIFYEXTRATEST) $(BUILD_CMD)
|
||||
|
||||
$(CLIENTHELLOTEST)$(EXE_EXT): $(CLIENTHELLOTEST).o
|
||||
- @target=$(CLIENTHELLOTEST) $(BUILD_CMD)
|
||||
+ +@target=$(CLIENTHELLOTEST) $(BUILD_CMD)
|
||||
|
||||
#$(AESTEST).o: $(AESTEST).c
|
||||
# $(CC) -c $(CFLAGS) -DINTERMEDIATE_VALUE_KAT -DTRACE_KAT_MCT $(AESTEST).c
|
||||
@@ -549,7 +549,7 @@
|
||||
# fi
|
||||
|
||||
dummytest$(EXE_EXT): dummytest.o $(DLIBCRYPTO)
|
||||
- @target=dummytest; $(BUILD_CMD)
|
||||
+ +@target=dummytest; $(BUILD_CMD)
|
||||
|
||||
# DO NOT DELETE THIS LINE -- make depend depends on it.
|
||||
|
||||
@ -0,0 +1,87 @@
|
||||
diff -uNr async_unix-113.33.00/_oasis async_unix-113.33.00+4.03/_oasis
|
||||
--- async_unix-113.33.00/_oasis 2016-03-09 16:44:52.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/_oasis 2016-03-22 15:13:48.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: async_unix
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Monadic concurrency library
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2008-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr async_unix-113.33.00/opam async_unix-113.33.00+4.03/opam
|
||||
--- async_unix-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/opam 2016-03-22 17:51:33.000000000 +0100
|
||||
@@ -26,4 +26,4 @@
|
||||
"typerep"
|
||||
"variantslib"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr async_unix-113.33.00/src/raw_scheduler.ml async_unix-113.33.00+4.03/src/raw_scheduler.ml
|
||||
--- async_unix-113.33.00/src/raw_scheduler.ml 2016-03-09 16:44:52.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/src/raw_scheduler.ml 2016-03-22 15:13:48.000000000 +0100
|
||||
@@ -587,7 +587,7 @@
|
||||
|
||||
let sync_changed_fds_to_file_descr_watcher t =
|
||||
let module F = (val t.file_descr_watcher : File_descr_watcher.S) in
|
||||
- let make_file_descr_watcher_agree_with (fd : Fd.t) =
|
||||
+ let make_file_descr_watcher_agree_with = (fun (fd : Fd.t) ->
|
||||
fd.watching_has_changed <- false;
|
||||
let desired =
|
||||
Read_write.mapi fd.watching ~f:(fun read_or_write watching ->
|
||||
@@ -607,7 +607,7 @@
|
||||
with exn ->
|
||||
failwiths "sync_changed_fds_to_file_descr_watcher unable to set fd"
|
||||
(desired, fd, exn, t) [%sexp_of: bool Read_write.t * Fd.t * exn * t]
|
||||
- in
|
||||
+ ) [@inline always] in
|
||||
let changed = t.fds_whose_watching_has_changed in
|
||||
t.fds_whose_watching_has_changed <- [];
|
||||
List.iter changed ~f:make_file_descr_watcher_agree_with;
|
||||
diff -uNr async_unix-113.33.00/src/std.ml async_unix-113.33.00+4.03/src/std.ml
|
||||
--- async_unix-113.33.00/src/std.ml 2016-03-09 16:44:52.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/src/std.ml 2016-03-22 15:13:48.000000000 +0100
|
||||
@@ -60,10 +60,9 @@
|
||||
|
||||
module Overwrite_ = struct
|
||||
let overwrite1 (`This_is_async__Think_about_blocking as x) = x
|
||||
- let wrap f `This_is_async__Think_about_blocking = f
|
||||
- let overwrite2 = wrap overwrite1
|
||||
- let overwrite3 = wrap overwrite2
|
||||
- let overwrite4 = wrap overwrite3
|
||||
+ let overwrite2 `This_is_async__Think_about_blocking = overwrite1
|
||||
+ let overwrite3 `This_is_async__Think_about_blocking = overwrite2
|
||||
+ let overwrite4 `This_is_async__Think_about_blocking = overwrite3
|
||||
let overwritef f = ksprintf (fun _ -> `This_is_async__Think_about_blocking) f
|
||||
end
|
||||
open Overwrite_
|
||||
diff -uNr async_unix-113.33.00/src/unix_syscalls.ml async_unix-113.33.00+4.03/src/unix_syscalls.ml
|
||||
--- async_unix-113.33.00/src/unix_syscalls.ml 2016-03-09 16:44:52.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/src/unix_syscalls.ml 2016-03-22 15:13:48.000000000 +0100
|
||||
@@ -365,8 +365,8 @@
|
||||
;;
|
||||
|
||||
(* symlinks *)
|
||||
-let symlink ~src ~dst =
|
||||
- In_thread.syscall_exn ~name:"symlink" (fun () -> Unix.symlink ~src ~dst)
|
||||
+let symlink ?to_dir ~src ~dst =
|
||||
+ In_thread.syscall_exn ~name:"symlink" (fun () -> Unix.symlink ?to_dir ~src ~dst)
|
||||
;;
|
||||
|
||||
let readlink filename =
|
||||
diff -uNr async_unix-113.33.00/src/unix_syscalls.mli async_unix-113.33.00+4.03/src/unix_syscalls.mli
|
||||
--- async_unix-113.33.00/src/unix_syscalls.mli 2016-03-09 16:44:52.000000000 +0100
|
||||
+++ async_unix-113.33.00+4.03/src/unix_syscalls.mli 2016-03-22 15:13:48.000000000 +0100
|
||||
@@ -223,7 +223,7 @@
|
||||
-> string
|
||||
-> unit Deferred.t
|
||||
|
||||
-val symlink : src:string -> dst:string -> unit Deferred.t
|
||||
+val symlink : ?to_dir:bool -> src:string -> dst:string -> unit Deferred.t
|
||||
|
||||
val readlink : string -> string Deferred.t
|
||||
|
||||
@ -0,0 +1,762 @@
|
||||
commit 45bcb681e4218586b66f3a0d83d7f5a51f5548e0
|
||||
Author: KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
|
||||
Date: Wed Mar 23 09:42:33 2016 +0000
|
||||
|
||||
Upgrading to 4.03
|
||||
|
||||
diff --git a/src/batArray.mliv b/src/batArray.mliv
|
||||
index 51b4e28..025887f 100644
|
||||
--- a/src/batArray.mliv
|
||||
+++ b/src/batArray.mliv
|
||||
@@ -82,8 +82,7 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
|
||||
If the value of [x] is a floating-point number, then the maximum
|
||||
size is only [Sys.max_array_length / 2].*)
|
||||
|
||||
-##V<4.2##val make_float : int -> float array
|
||||
-##V>=4.2##external make_float : int -> float array = "caml_make_float_vect"
|
||||
+val make_float : int -> float array
|
||||
(** [Array.make_float n] returns a fresh float array of length [n],
|
||||
with uninitialized data.
|
||||
|
||||
diff --git a/src/batCharParser.mli b/src/batCharParser.mli
|
||||
index 52c00d8..80ff8a8 100644
|
||||
--- a/src/batCharParser.mli
|
||||
+++ b/src/batCharParser.mli
|
||||
@@ -52,7 +52,7 @@ val source_of_string : string -> (char, position) Source.t
|
||||
val source_of_enum : char BatEnum.t -> (char, position) Source.t
|
||||
(** Create a source from a latin-1 character.*)
|
||||
|
||||
-val parse : (char, 'a, position) t -> string -> ('a, position report) BatPervasives.result
|
||||
+val parse : (char, 'a, position) t -> string -> ('a, position report) result
|
||||
(**Apply a parser to a string.*)
|
||||
|
||||
(**{6 Utilities}*)
|
||||
diff --git a/src/batGc.mli b/src/batGc.mli
|
||||
index f3e6f54..ecffb79 100644
|
||||
--- a/src/batGc.mli
|
||||
+++ b/src/batGc.mli
|
||||
@@ -34,18 +34,18 @@
|
||||
type stat = Gc.stat =
|
||||
{ minor_words : float;
|
||||
(** Number of words allocated in the minor heap since
|
||||
- the program was started. This number is accurate in
|
||||
- byte-code programs, but only an approximation in programs
|
||||
- compiled to native code. *)
|
||||
+ the program was started. This number is accurate in
|
||||
+ byte-code programs, but only an approximation in programs
|
||||
+ compiled to native code. *)
|
||||
|
||||
promoted_words : float;
|
||||
(** Number of words allocated in the minor heap that
|
||||
- survived a minor collection and were moved to the major heap
|
||||
- since the program was started. *)
|
||||
+ survived a minor collection and were moved to the major heap
|
||||
+ since the program was started. *)
|
||||
|
||||
major_words : float;
|
||||
(** Number of words allocated in the major heap, including
|
||||
- the promoted words, since the program was started. *)
|
||||
+ the promoted words, since the program was started. *)
|
||||
|
||||
minor_collections : int;
|
||||
(** Number of minor collections since the program was started. *)
|
||||
@@ -62,7 +62,7 @@ type stat = Gc.stat =
|
||||
|
||||
live_words : int;
|
||||
(** Number of words of live data in the major heap, including the header
|
||||
- words. *)
|
||||
+ words. *)
|
||||
|
||||
live_blocks : int;
|
||||
(** Number of live blocks in the major heap. *)
|
||||
@@ -78,8 +78,8 @@ type stat = Gc.stat =
|
||||
|
||||
fragments : int;
|
||||
(** Number of wasted words due to fragmentation. These are
|
||||
- 1-words free blocks placed between two live blocks. They
|
||||
- are not available for allocation. *)
|
||||
+ 1-words free blocks placed between two live blocks. They
|
||||
+ are not available for allocation. *)
|
||||
|
||||
compactions : int;
|
||||
(** Number of heap compactions since the program was started. *)
|
||||
@@ -89,62 +89,68 @@ type stat = Gc.stat =
|
||||
|
||||
stack_size: int;
|
||||
(** Current size of the stack, in words. @since 3.12.0 *)
|
||||
- }
|
||||
+}
|
||||
(** The memory management counters are returned in a [stat] record.
|
||||
|
||||
- The total amount of memory allocated by the program since it was started
|
||||
- is (in words) [minor_words + major_words - promoted_words]. Multiply by
|
||||
- the word size (4 on a 32-bit machine, 8 on a 64-bit machine) to get
|
||||
- the number of bytes.
|
||||
+ The total amount of memory allocated by the program since it was started
|
||||
+ is (in words) [minor_words + major_words - promoted_words]. Multiply by
|
||||
+ the word size (4 on a 32-bit machine, 8 on a 64-bit machine) to get
|
||||
+ the number of bytes.
|
||||
*)
|
||||
|
||||
type control = Gc.control =
|
||||
{ mutable minor_heap_size : int;
|
||||
(** The size (in words) of the minor heap. Changing
|
||||
- this parameter will trigger a minor collection. Default: 32k. *)
|
||||
+ this parameter will trigger a minor collection. Default: 256k. *)
|
||||
|
||||
mutable major_heap_increment : int;
|
||||
- (** The minimum number of words to add to the
|
||||
- major heap when increasing it. Default: 124k. *)
|
||||
+ (** How much to add to the major heap when increasing it. If this
|
||||
+ number is less than or equal to 1000, it is a percentage of
|
||||
+ the current heap size (i.e. setting it to 100 will double the heap
|
||||
+ size at each increase). If it is more than 1000, it is a fixed
|
||||
+ number of words that will be added to the heap. Default: 15. *)
|
||||
|
||||
mutable space_overhead : int;
|
||||
(** The major GC speed is computed from this parameter.
|
||||
- This is the memory that will be "wasted" because the GC does not
|
||||
- immediatly collect unreachable blocks. It is expressed as a
|
||||
- percentage of the memory used for live data.
|
||||
- The GC will work more (use more CPU time and collect
|
||||
- blocks more eagerly) if [space_overhead] is smaller.
|
||||
- Default: 80. *)
|
||||
+ This is the memory that will be "wasted" because the GC does not
|
||||
+ immediatly collect unreachable blocks. It is expressed as a
|
||||
+ percentage of the memory used for live data.
|
||||
+ The GC will work more (use more CPU time and collect
|
||||
+ blocks more eagerly) if [space_overhead] is smaller.
|
||||
+ Default: 80. *)
|
||||
|
||||
mutable verbose : int;
|
||||
(** This value controls the GC messages on standard error output.
|
||||
- It is a sum of some of the following flags, to print messages
|
||||
- on the corresponding events:
|
||||
- - [0x001] Start of major GC cycle.
|
||||
- - [0x002] Minor collection and major GC slice.
|
||||
- - [0x004] Growing and shrinking of the heap.
|
||||
- - [0x008] Resizing of stacks and memory manager tables.
|
||||
- - [0x010] Heap compaction.
|
||||
- - [0x020] Change of GC parameters.
|
||||
- - [0x040] Computation of major GC slice size.
|
||||
- - [0x080] Calling of finalisation functions.
|
||||
- - [0x100] Bytecode executable search at start-up.
|
||||
- - [0x200] Computation of compaction triggering condition.
|
||||
- Default: 0. *)
|
||||
+ It is a sum of some of the following flags, to print messages
|
||||
+ on the corresponding events:
|
||||
+ - [0x001] Start of major GC cycle.
|
||||
+ - [0x002] Minor collection and major GC slice.
|
||||
+ - [0x004] Growing and shrinking of the heap.
|
||||
+ - [0x008] Resizing of stacks and memory manager tables.
|
||||
+ - [0x010] Heap compaction.
|
||||
+ - [0x020] Change of GC parameters.
|
||||
+ - [0x040] Computation of major GC slice size.
|
||||
+ - [0x080] Calling of finalisation functions.
|
||||
+ - [0x100] Bytecode executable and shared library search at start-up.
|
||||
+ - [0x200] Computation of compaction-triggering condition.
|
||||
+ - [0x400] Output GC statistics at program exit.
|
||||
+ Default: 0. *)
|
||||
|
||||
mutable max_overhead : int;
|
||||
(** Heap compaction is triggered when the estimated amount
|
||||
- of "wasted" memory is more than [max_overhead] percent of the
|
||||
- amount of live data. If [max_overhead] is set to 0, heap
|
||||
- compaction is triggered at the end of each major GC cycle
|
||||
- (this setting is intended for testing purposes only).
|
||||
- If [max_overhead >= 1000000], compaction is never triggered.
|
||||
- Default: 500. *)
|
||||
+ of "wasted" memory is more than [max_overhead] percent of the
|
||||
+ amount of live data. If [max_overhead] is set to 0, heap
|
||||
+ compaction is triggered at the end of each major GC cycle
|
||||
+ (this setting is intended for testing purposes only).
|
||||
+ If [max_overhead >= 1000000], compaction is never triggered.
|
||||
+ If compaction is permanently disabled, it is strongly suggested
|
||||
+ to set [allocation_policy] to 1.
|
||||
+ Default: 500. *)
|
||||
|
||||
mutable stack_limit : int;
|
||||
(** The maximum size of the stack (in words). This is only
|
||||
- relevant to the byte-code runtime, as the native code runtime
|
||||
- uses the operating system's stack. Default: 256k. *)
|
||||
+ relevant to the byte-code runtime, as the native code runtime
|
||||
+ uses the operating system's stack. Default: 1024k. *)
|
||||
|
||||
mutable allocation_policy : int;
|
||||
(** The policy used for allocating in the heap. Possible
|
||||
@@ -153,16 +159,22 @@ type control = Gc.control =
|
||||
first-fit policy, which can be slower in some cases but
|
||||
can be better for programs with fragmentation problems.
|
||||
Default: 0. @since 3.11.0 *)
|
||||
- }
|
||||
+
|
||||
+ window_size : int;
|
||||
+ (** The size of the window used by the major GC for smoothing
|
||||
+ out variations in its workload. This is an integer between
|
||||
+ 1 and 50.
|
||||
+ Default: 1. @since 4.03.0 *)
|
||||
+}
|
||||
(** The GC parameters are given as a [control] record. Note that
|
||||
these parameters can also be initialised by setting the
|
||||
OCAMLRUNPARAM environment variable. See the documentation of
|
||||
- ocamlrun. *)
|
||||
+ [ocamlrun]. *)
|
||||
|
||||
external stat : unit -> stat = "caml_gc_stat"
|
||||
(** Return the current values of the memory management counters in a
|
||||
- [stat] record. This function examines every heap block to get the
|
||||
- statistics. *)
|
||||
+ [stat] record. This function examines every heap block to get the
|
||||
+ statistics. *)
|
||||
|
||||
external quick_stat : unit -> stat = "caml_gc_quick_stat"
|
||||
(** Same as [stat] except that [live_words], [live_blocks], [free_words],
|
||||
@@ -172,117 +184,144 @@ external quick_stat : unit -> stat = "caml_gc_quick_stat"
|
||||
|
||||
external counters : unit -> float * float * float = "caml_gc_counters"
|
||||
(** Return [(minor_words, promoted_words, major_words)]. This function
|
||||
- is as fast at [quick_stat]. *)
|
||||
+ is as fast as [quick_stat]. *)
|
||||
|
||||
external get : unit -> control = "caml_gc_get"
|
||||
(** Return the current values of the GC parameters in a [control] record. *)
|
||||
|
||||
external set : control -> unit = "caml_gc_set"
|
||||
(** [set r] changes the GC parameters according to the [control] record [r].
|
||||
- The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
|
||||
+ The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
|
||||
|
||||
external minor : unit -> unit = "caml_gc_minor"
|
||||
(** Trigger a minor collection. *)
|
||||
|
||||
-external major_slice : int -> int = "caml_gc_major_slice";;
|
||||
-(** Do a minor collection and a slice of major collection. The argument
|
||||
- is the size of the slice, 0 to use the automatically-computed
|
||||
- slice size. In all cases, the result is the computed slice size. *)
|
||||
+external major_slice : int -> int = "caml_gc_major_slice"
|
||||
+(** [major_slice n]
|
||||
+ Do a minor collection and a slice of major collection. [n] is the
|
||||
+ size of the slice: the GC will do enough work to free (on average)
|
||||
+ [n] words of memory. If [n] = 0, the GC will try to do enough work
|
||||
+ to ensure that the next slice has no work to do.
|
||||
+ Return an approximation of the work that the next slice will have
|
||||
+ to do. *)
|
||||
|
||||
external major : unit -> unit = "caml_gc_major"
|
||||
(** Do a minor collection and finish the current major collection cycle. *)
|
||||
|
||||
external full_major : unit -> unit = "caml_gc_full_major"
|
||||
(** Do a minor collection, finish the current major collection cycle,
|
||||
- and perform a complete new cycle. This will collect all currently
|
||||
- unreachable blocks. *)
|
||||
+ and perform a complete new cycle. This will collect all currently
|
||||
+ unreachable blocks. *)
|
||||
|
||||
external compact : unit -> unit = "caml_gc_compaction"
|
||||
(** Perform a full major collection and compact the heap. Note that heap
|
||||
- compaction is a lengthy operation. *)
|
||||
+ compaction is a lengthy operation. *)
|
||||
|
||||
val print_stat : _ BatInnerIO.output -> unit
|
||||
(** Print the current values of the memory management counters (in
|
||||
- human-readable form) into the channel argument. *)
|
||||
+ human-readable form) into the channel argument. *)
|
||||
|
||||
val allocated_bytes : unit -> float
|
||||
(** Return the total number of bytes allocated since the program was
|
||||
- started. It is returned as a [float] to avoid overflow problems
|
||||
- with [int] on 32-bit machines. *)
|
||||
+ started. It is returned as a [float] to avoid overflow problems
|
||||
+ with [int] on 32-bit machines. *)
|
||||
+
|
||||
+external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc]
|
||||
+(** Return the current size of the free space inside the minor heap. *)
|
||||
+
|
||||
+external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
|
||||
+(** [get_bucket n] returns the current size of the [n]-th future bucket
|
||||
+ of the GC smoothing system. The unit is one millionth of a full GC.
|
||||
+ Raise [Invalid_argument] if [n] is negative, return 0 if n is larger
|
||||
+ than the smoothing window. *)
|
||||
+
|
||||
+external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
|
||||
+(** [get_credit ()] returns the current size of the "work done in advance"
|
||||
+ counter of the GC smoothing system. The unit is one millionth of a
|
||||
+ full GC. *)
|
||||
+
|
||||
+external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
|
||||
+(** Return the number of times we tried to map huge pages and had to fall
|
||||
+ back to small pages. This is always 0 if [OCAMLRUNPARAM] contains [H=1].
|
||||
+ @since 4.03.0 *)
|
||||
|
||||
val finalise : ('a -> unit) -> 'a -> unit
|
||||
(** [finalise f v] registers [f] as a finalisation function for [v].
|
||||
- [v] must be heap-allocated. [f] will be called with [v] as
|
||||
- argument at some point between the first time [v] becomes unreachable
|
||||
- and the time [v] is collected by the GC. Several functions can
|
||||
- be registered for the same value, or even several instances of the
|
||||
- same function. Each instance will be called once (or never,
|
||||
- if the program terminates before [v] becomes unreachable).
|
||||
-
|
||||
- The GC will call the finalisation functions in the order of
|
||||
- deallocation. When several values become unreachable at the
|
||||
- same time (i.e. during the same GC cycle), the finalisation
|
||||
- functions will be called in the reverse order of the corresponding
|
||||
- calls to [finalise]. If [finalise] is called in the same order
|
||||
- as the values are allocated, that means each value is finalised
|
||||
- before the values it depends upon. Of course, this becomes
|
||||
- false if additional dependencies are introduced by assignments.
|
||||
-
|
||||
- Anything reachable from the closure of finalisation functions
|
||||
- is considered reachable, so the following code will not work
|
||||
- as expected:
|
||||
- - [ let v = ... in Gc.finalise (fun x -> ...) v ]
|
||||
-
|
||||
- Instead you should write:
|
||||
- - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
|
||||
-
|
||||
-
|
||||
- The [f] function can use all features of OCaml, including
|
||||
- assignments that make the value reachable again. It can also
|
||||
- loop forever (in this case, the other
|
||||
- finalisation functions will not be called during the execution of f,
|
||||
- unless it calls [finalise_release]).
|
||||
- It can call [finalise] on [v] or other values to register other
|
||||
- functions or even itself. It can raise an exception; in this case
|
||||
- the exception will interrupt whatever the program was doing when
|
||||
- the function was called.
|
||||
-
|
||||
-
|
||||
- [finalise] will raise [Invalid_argument] if [v] is not
|
||||
- heap-allocated. Some examples of values that are not
|
||||
- heap-allocated are integers, constant constructors, booleans,
|
||||
- the empty array, the empty list, the unit value. The exact list
|
||||
- of what is heap-allocated or not is implementation-dependent.
|
||||
- Some constant values can be heap-allocated but never deallocated
|
||||
- during the lifetime of the program, for example a list of integer
|
||||
- constants; this is also implementation-dependent.
|
||||
- You should also be aware that compiler optimisations may duplicate
|
||||
- some immutable values, for example floating-point numbers when
|
||||
- stored into arrays, so they can be finalised and collected while
|
||||
- another copy is still in use by the program.
|
||||
-
|
||||
-
|
||||
- The results of calling {!String.make}, {!String.create},
|
||||
- {!Array.make}, and {!Pervasives.ref} are guaranteed to be
|
||||
- heap-allocated and non-constant except when the length argument is [0].
|
||||
+ [v] must be heap-allocated. [f] will be called with [v] as
|
||||
+ argument at some point between the first time [v] becomes unreachable
|
||||
+ (including through weak pointers) and the time [v] is collected by
|
||||
+ the GC. Several functions can
|
||||
+ be registered for the same value, or even several instances of the
|
||||
+ same function. Each instance will be called once (or never,
|
||||
+ if the program terminates before [v] becomes unreachable).
|
||||
+
|
||||
+ The GC will call the finalisation functions in the order of
|
||||
+ deallocation. When several values become unreachable at the
|
||||
+ same time (i.e. during the same GC cycle), the finalisation
|
||||
+ functions will be called in the reverse order of the corresponding
|
||||
+ calls to [finalise]. If [finalise] is called in the same order
|
||||
+ as the values are allocated, that means each value is finalised
|
||||
+ before the values it depends upon. Of course, this becomes
|
||||
+ false if additional dependencies are introduced by assignments.
|
||||
+
|
||||
+ In the presence of multiple OCaml threads it should be assumed that
|
||||
+ any particular finaliser may be executed in any of the threads.
|
||||
+
|
||||
+ Anything reachable from the closure of finalisation functions
|
||||
+ is considered reachable, so the following code will not work
|
||||
+ as expected:
|
||||
+ - [ let v = ... in Gc.finalise (fun _ -> ...v...) v ]
|
||||
+
|
||||
+ Instead you should make sure that [v] is not in the closure of
|
||||
+ the finalisation function by writing:
|
||||
+ - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
|
||||
+
|
||||
+
|
||||
+ The [f] function can use all features of OCaml, including
|
||||
+ assignments that make the value reachable again. It can also
|
||||
+ loop forever (in this case, the other
|
||||
+ finalisation functions will not be called during the execution of f,
|
||||
+ unless it calls [finalise_release]).
|
||||
+ It can call [finalise] on [v] or other values to register other
|
||||
+ functions or even itself. It can raise an exception; in this case
|
||||
+ the exception will interrupt whatever the program was doing when
|
||||
+ the function was called.
|
||||
+
|
||||
+
|
||||
+ [finalise] will raise [Invalid_argument] if [v] is not
|
||||
+ guaranteed to be heap-allocated. Some examples of values that are not
|
||||
+ heap-allocated are integers, constant constructors, booleans,
|
||||
+ the empty array, the empty list, the unit value. The exact list
|
||||
+ of what is heap-allocated or not is implementation-dependent.
|
||||
+ Some constant values can be heap-allocated but never deallocated
|
||||
+ during the lifetime of the program, for example a list of integer
|
||||
+ constants; this is also implementation-dependent.
|
||||
+ Note that values of types [float] and ['a lazy] (for any ['a]) are
|
||||
+ sometimes allocated and sometimes not, so finalising them is unsafe,
|
||||
+ and [finalise] will also raise [Invalid_argument] for them.
|
||||
+
|
||||
+
|
||||
+ The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
|
||||
+ {!Array.make}, and {!Pervasives.ref} are guaranteed to be
|
||||
+ heap-allocated and non-constant except when the length argument is [0].
|
||||
*)
|
||||
|
||||
-val finalise_release : unit -> unit;;
|
||||
+val finalise_release : unit -> unit
|
||||
(** A finalisation function may call [finalise_release] to tell the
|
||||
GC that it can launch the next finalisation function without waiting
|
||||
for the current one to return. *)
|
||||
|
||||
type alarm = Gc.alarm
|
||||
(** An alarm is a piece of data that calls a user function at the end of
|
||||
- each major GC cycle. The following functions are provided to create
|
||||
- and delete alarms. *)
|
||||
+ each major GC cycle. The following functions are provided to create
|
||||
+ and delete alarms. *)
|
||||
|
||||
val create_alarm : (unit -> unit) -> alarm
|
||||
(** [create_alarm f] will arrange for [f] to be called at the end of each
|
||||
- major GC cycle, starting with the current cycle or the next one.
|
||||
- A value of type [alarm] is returned that you can
|
||||
- use to call [delete_alarm]. *)
|
||||
+ major GC cycle, starting with the current cycle or the next one.
|
||||
+ A value of type [alarm] is returned that you can
|
||||
+ use to call [delete_alarm]. *)
|
||||
|
||||
val delete_alarm : alarm -> unit
|
||||
- (** [delete_alarm a] will stop the calls to the function associated
|
||||
- to [a]. Calling [delete_alarm a] again has no effect. *)
|
||||
+(** [delete_alarm a] will stop the calls to the function associated
|
||||
+ to [a]. Calling [delete_alarm a] again has no effect. *)
|
||||
diff --git a/src/batHashtbl.mli b/src/batHashtbl.mli
|
||||
index d3a9118..dd95c0c 100644
|
||||
--- a/src/batHashtbl.mli
|
||||
+++ b/src/batHashtbl.mli
|
||||
@@ -276,7 +276,7 @@ val print : ?first:string -> ?last:string -> ?sep:string -> ?kvsep:string ->
|
||||
module Exceptionless :
|
||||
sig
|
||||
val find : ('a, 'b) t -> 'a -> 'b option
|
||||
- val modify : 'a -> ('b -> 'b) -> ('a, 'b) t -> (unit, exn) BatPervasives.result
|
||||
+ val modify : 'a -> ('b -> 'b) -> ('a, 'b) t -> (unit, exn) result
|
||||
end
|
||||
|
||||
(** Infix operators over a {!BatHashtbl} *)
|
||||
@@ -402,7 +402,7 @@ sig
|
||||
module Exceptionless :
|
||||
sig
|
||||
val find : 'a t -> key -> 'a option
|
||||
- val modify : key -> ('a -> 'a) -> 'a t -> (unit, exn) BatPervasives.result
|
||||
+ val modify : key -> ('a -> 'a) -> 'a t -> (unit, exn) result
|
||||
end
|
||||
|
||||
(** Infix operators over a {!BatHashtbl} *)
|
||||
@@ -562,7 +562,7 @@ sig
|
||||
module Exceptionless :
|
||||
sig
|
||||
val find : ('a, 'b, [>`Read]) t -> 'a -> 'b option
|
||||
- val modify : 'a -> ('b -> 'b) -> ('a, 'b, [>`Read]) t -> (unit, exn) BatPervasives.result
|
||||
+ val modify : 'a -> ('b -> 'b) -> ('a, 'b, [>`Read]) t -> (unit, exn) result
|
||||
end
|
||||
|
||||
(** Operations on {!BatHashtbl.Cap} with labels.*)
|
||||
diff --git a/src/batHashtbl.mlv b/src/batHashtbl.mlv
|
||||
index 6a79a33..ef7a030 100644
|
||||
--- a/src/batHashtbl.mlv
|
||||
+++ b/src/batHashtbl.mlv
|
||||
@@ -413,7 +413,7 @@ sig
|
||||
module Exceptionless :
|
||||
sig
|
||||
val find : 'a t -> key -> 'a option
|
||||
- val modify : key -> ('a -> 'a) -> 'a t -> (unit, exn) BatPervasives.result
|
||||
+ val modify : key -> ('a -> 'a) -> 'a t -> (unit, exn) result
|
||||
end
|
||||
|
||||
(** Infix operators over a {!BatHashtbl} *)
|
||||
@@ -571,7 +571,7 @@ struct
|
||||
let map_inplace (f:key -> 'a -> 'b) h = map_inplace f (to_hash h)
|
||||
let filteri_inplace f h = filteri_inplace f (to_hash h)
|
||||
let filter_inplace f h = filter_inplace f (to_hash h)
|
||||
- let filter_map_inplace f h = filter_map_inplace f (to_hash h)
|
||||
+ let filter_map_inplace f h = filter_map_inplace f h
|
||||
|
||||
|
||||
let find_option h key =
|
||||
diff --git a/src/batInnerPervasives.mlv b/src/batInnerPervasives.mlv
|
||||
index c86f1f7..c81cba4 100644
|
||||
--- a/src/batInnerPervasives.mlv
|
||||
+++ b/src/batInnerPervasives.mlv
|
||||
@@ -43,20 +43,16 @@ let unique () =
|
||||
Q.unit (fun () -> unique () <> unique ())
|
||||
*)
|
||||
|
||||
-type ('a, 'b) result =
|
||||
- | Ok of 'a
|
||||
- | Bad of 'b
|
||||
-
|
||||
(* Ideas taken from Nicholas Pouillard's my_std.ml in ocamlbuild/ *)
|
||||
let ignore_ok = function
|
||||
Ok _ -> ()
|
||||
- | Bad ex -> raise ex
|
||||
+ | Error ex -> raise ex
|
||||
|
||||
let ok = function
|
||||
Ok v -> v
|
||||
- | Bad ex -> raise ex
|
||||
+ | Error ex -> raise ex
|
||||
|
||||
-let wrap f x = try Ok (f x) with ex -> Bad ex
|
||||
+let wrap f x = try Ok (f x) with ex -> Error ex
|
||||
|
||||
let forever f x = ignore (while true do f x done)
|
||||
|
||||
diff --git a/src/batInnerWeaktbl.ml b/src/batInnerWeaktbl.ml
|
||||
index 64bb15f..c525f62 100644
|
||||
--- a/src/batInnerWeaktbl.ml
|
||||
+++ b/src/batInnerWeaktbl.ml
|
||||
@@ -120,6 +120,7 @@ module Make (H: Hashtbl.HashedType) : Hashtbl.S with type key = H.t = struct
|
||||
W.iter (fun cls -> W.add tbl' (Stack.copy cls)) tbl; tbl'
|
||||
let stats _ = assert false
|
||||
let reset _ = assert false
|
||||
+ let filter_map_inplace _ = assert false
|
||||
end
|
||||
|
||||
module StdHash = Make
|
||||
diff --git a/src/batParserCo.ml b/src/batParserCo.ml
|
||||
index cac4701..75ac6fb 100644
|
||||
--- a/src/batParserCo.ml
|
||||
+++ b/src/batParserCo.ml
|
||||
@@ -274,10 +274,10 @@ let lookahead p e = match apply p e with
|
||||
| Failure _ as result -> result
|
||||
|
||||
let interpret_result = function
|
||||
- | Setback f | Failure f -> BatInnerPervasives.Bad f
|
||||
- | Success (r, _) | Backtrack (r, _, _) -> BatInnerPervasives.Ok r
|
||||
+ | Setback f | Failure f -> Error f
|
||||
+ | Success (r, _) | Backtrack (r, _, _) -> Ok r
|
||||
|
||||
-let suspend : ('a, 'b, 'c) t -> ('a, (unit -> ('b, 'c report) BatInnerPervasives.result), 'c) t = fun s e ->
|
||||
+let suspend : ('a, 'b, 'c) t -> ('a, (unit -> ('b, 'c report) Pervasives.result), 'c) t = fun s e ->
|
||||
let resume () = interpret_result (s e) in
|
||||
Success (resume, e)
|
||||
|
||||
diff --git a/src/batParserCo.mli b/src/batParserCo.mli
|
||||
index 1fbe15a..40c5cf7 100644
|
||||
--- a/src/batParserCo.mli
|
||||
+++ b/src/batParserCo.mli
|
||||
@@ -141,15 +141,15 @@ val filter: ('b -> bool) -> ('a, 'b, 'c) t -> ('a, 'b, 'c) t
|
||||
(**[filter f p] is only accepts values [x] such that [p]
|
||||
accepts [x] and [f (p x)] is [true]*)
|
||||
|
||||
-val suspend : ('a, 'b, 'c) t -> ('a, (unit -> ('b, 'c report) BatPervasives.result), 'c) t
|
||||
+val suspend : ('a, 'b, 'c) t -> ('a, (unit -> ('b, 'c report) result), 'c) t
|
||||
(**[suspend s] returns the state of the parser in a form that can be
|
||||
resumed by calling the returned function. evaluation will resume
|
||||
from parser s *)
|
||||
|
||||
-val run: ('a, 'b, 'c) t -> ('a, 'c) Source.t -> ('b, 'c report) BatPervasives.result
|
||||
+val run: ('a, 'b, 'c) t -> ('a, 'c) Source.t -> ('b, 'c report) result
|
||||
(**[run p s] executes parser [p] on source [s]. In case of
|
||||
success, returns [Ok v], where [v] is the return value of [p].
|
||||
- In case of failure, returns [Bad f], with [f] containing
|
||||
+ In case of failure, returns [Error f], with [f] containing
|
||||
details on the parsing error.*)
|
||||
|
||||
|
||||
diff --git a/src/batPathGen.ml b/src/batPathGen.ml
|
||||
index 46a97ba..71d1084 100644
|
||||
--- a/src/batPathGen.ml
|
||||
+++ b/src/batPathGen.ml
|
||||
@@ -512,7 +512,7 @@ module Make = functor (S : StringType) -> struct
|
||||
let full_match pars ss =
|
||||
let parser_final = BatParserCo.( >>> ) pars BatParserCo.eof in
|
||||
match BatParserCo.run parser_final (S.Parse.source ss) with
|
||||
- | BatPervasives.Ok _ -> true
|
||||
+ | Ok _ -> true
|
||||
| _ -> false
|
||||
|
||||
(* let full_match_none_of raw_excluded ss =
|
||||
diff --git a/src/batPervasives.mliv b/src/batPervasives.mliv
|
||||
index 6353214..c74b913 100644
|
||||
--- a/src/batPervasives.mliv
|
||||
+++ b/src/batPervasives.mliv
|
||||
@@ -842,20 +842,14 @@ val print : ?first:string -> ?last:string -> ?sep:string -> ('a BatInnerIO.outp
|
||||
|
||||
For more functions related to this type, see the {!BatResult} module.
|
||||
*)
|
||||
-type ('a, 'b) result = ('a, 'b) BatInnerPervasives.result =
|
||||
- | Ok of 'a
|
||||
- | Bad of 'b
|
||||
- (** The result of a computation - either an [Ok] with the normal
|
||||
- result or a [Bad] with some value (often an exception) containing
|
||||
- failure information*)
|
||||
|
||||
val ignore_ok : ('a, exn) result -> unit
|
||||
(** [ignore_ok (f x)] ignores the result of [f x] if it's ok, but
|
||||
- throws the exception contained if [Bad] is returned. *)
|
||||
+ throws the exception contained if [Error] is returned. *)
|
||||
|
||||
val ok : ('a, exn) result -> 'a
|
||||
(** [f x |> ok] unwraps the [Ok] result of [f x] and returns it, or
|
||||
- throws the exception contained if [Bad] is returned. *)
|
||||
+ throws the exception contained if [Error] is returned. *)
|
||||
|
||||
val wrap : ('a -> 'b) -> 'a -> ('b, exn) result
|
||||
(** [wrap f x] wraps a function that would normally throw an exception
|
||||
diff --git a/src/batResult.ml b/src/batResult.ml
|
||||
index 1d98663..f90b4d9 100644
|
||||
--- a/src/batResult.ml
|
||||
+++ b/src/batResult.ml
|
||||
@@ -1,45 +1,45 @@
|
||||
|
||||
-type ('a, 'b) t = ('a, 'b) BatPervasives.result =
|
||||
+type ('a, 'b) t = ('a, 'b) result =
|
||||
| Ok of 'a
|
||||
- | Bad of 'b
|
||||
+ | Error of 'b
|
||||
|
||||
-let catch f x = try Ok (f x) with e -> Bad e
|
||||
-let catch2 f x y = try Ok (f x y) with e -> Bad e
|
||||
-let catch3 f x y z = try Ok (f x y z) with e -> Bad e
|
||||
+let catch f x = try Ok (f x) with e -> Error e
|
||||
+let catch2 f x y = try Ok (f x y) with e -> Error e
|
||||
+let catch3 f x y z = try Ok (f x y z) with e -> Error e
|
||||
|
||||
let of_option = function
|
||||
| Some x -> Ok x
|
||||
- | None -> Bad ()
|
||||
+ | None -> Error ()
|
||||
|
||||
let to_option = function
|
||||
| Ok x -> Some x
|
||||
- | Bad _-> None
|
||||
+ | Error _-> None
|
||||
|
||||
let default def = function
|
||||
| Ok x -> x
|
||||
- | Bad _ -> def
|
||||
+ | Error _ -> def
|
||||
|
||||
let map_default def f = function
|
||||
| Ok x -> f x
|
||||
- | Bad _ -> def
|
||||
+ | Error _ -> def
|
||||
|
||||
-let is_ok = function Ok _ -> true | Bad _ -> false
|
||||
+let is_ok = function Ok _ -> true | Error _ -> false
|
||||
|
||||
-let is_bad = function Bad _ -> true | Ok _ -> false
|
||||
+let is_bad = function Error _ -> true | Ok _ -> false
|
||||
|
||||
-let is_exn e = function Bad exn -> exn = e | Ok _ -> false
|
||||
+let is_exn e = function Error exn -> exn = e | Ok _ -> false
|
||||
|
||||
-let get = function Ok x -> x | Bad e -> raise e
|
||||
+let get = function Ok x -> x | Error e -> raise e
|
||||
|
||||
let print print_val oc = function
|
||||
| Ok x -> BatPrintf.fprintf oc "Ok(%a)" print_val x
|
||||
- | Bad e -> BatPrintf.fprintf oc "Bad(%a)" BatPrintexc.print e
|
||||
+ | Error e -> BatPrintf.fprintf oc "Error(%a)" BatPrintexc.print e
|
||||
|
||||
|
||||
module Monad = struct
|
||||
let bind m k = match m with
|
||||
| Ok x -> k x
|
||||
- | Bad _ as e -> e
|
||||
+ | Error _ as e -> e
|
||||
|
||||
let return x = Ok x
|
||||
|
||||
diff --git a/src/batResult.mli b/src/batResult.mli
|
||||
index a295c64..203c125 100644
|
||||
--- a/src/batResult.mli
|
||||
+++ b/src/batResult.mli
|
||||
@@ -1,12 +1,12 @@
|
||||
(** Monadic results of computations that can raise exceptions *)
|
||||
|
||||
(** The type of a result. A result is either [Ok x] carrying the
|
||||
- normal return value [x] or is [Bad e] carrying some indication of an
|
||||
+ normal return value [x] or is [Error e] carrying some indication of an
|
||||
error. The value associated with a bad result is usually an exception
|
||||
([exn]) that can be raised.
|
||||
@since 1.0
|
||||
*)
|
||||
-type ('a, 'b) t = ('a, 'b) BatPervasives.result = Ok of 'a | Bad of 'b
|
||||
+type ('a, 'b) t = ('a, 'b) result = Ok of 'a | Error of 'b
|
||||
|
||||
(** Execute a function and catch any exception as a result. This
|
||||
function encapsulates code that could throw an exception and returns
|
||||
@@ -26,19 +26,19 @@ val catch2: ('a -> 'b -> 'c) -> 'a -> 'b -> ('c, exn) t
|
||||
val catch3: ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t
|
||||
|
||||
|
||||
-(** [get (Ok x)] returns [x], and [get (Bad e)] raises [e]. This
|
||||
+(** [get (Ok x)] returns [x], and [get (Error e)] raises [e]. This
|
||||
function is, in a way, the opposite of the [catch] function
|
||||
@since 2.0
|
||||
*)
|
||||
val get : ('a, exn) t -> 'a
|
||||
|
||||
-(** [default d r] evaluates to [d] if [r] is [Bad] else [x] when [r] is
|
||||
+(** [default d r] evaluates to [d] if [r] is [Error] else [x] when [r] is
|
||||
[Ok x]
|
||||
@since 2.0
|
||||
*)
|
||||
val default: 'a -> ('a, _) t -> 'a
|
||||
|
||||
-(** [map_default d f r] evaluates to [d] if [r] is [Bad] else [f x]
|
||||
+(** [map_default d f r] evaluates to [d] if [r] is [Error] else [f x]
|
||||
when [r] is [Ok x]
|
||||
@since 2.0
|
||||
*)
|
||||
@@ -49,12 +49,12 @@ val map_default : 'b -> ('a -> 'b) -> ('a, _) t -> 'b
|
||||
*)
|
||||
val is_ok : ('a, 'b) t -> bool
|
||||
|
||||
-(** [is_bad (Bad _)] is [true], otherwise [false]
|
||||
+(** [is_bad (Error _)] is [true], otherwise [false]
|
||||
@since 2.0
|
||||
*)
|
||||
val is_bad : ('a, 'b) t -> bool
|
||||
|
||||
-(** [is_exn e1 r] is [true] iff [r] is [Bad e2] with [e1=e2] *)
|
||||
+(** [is_exn e1 r] is [true] iff [r] is [Error e2] with [e1=e2] *)
|
||||
val is_exn : exn -> ('a, exn) t -> bool
|
||||
|
||||
(** Convert an [option] to a [result]
|
||||
@@ -96,5 +96,5 @@ module Infix : sig
|
||||
val ( >>= ): ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t
|
||||
end
|
||||
|
||||
-(** Print a result as Ok(x) or Bad(exn) *)
|
||||
+(** Print a result as Ok(x) or Error(exn) *)
|
||||
val print : ('b BatInnerIO.output -> 'a -> unit) -> 'b BatInnerIO.output -> ('a, exn) t -> unit
|
||||
diff --git a/src/batSys.mliv b/src/batSys.mliv
|
||||
index 510a661..add0b33 100644
|
||||
--- a/src/batSys.mliv
|
||||
+++ b/src/batSys.mliv
|
||||
@@ -65,7 +65,8 @@ external getenv : string -> string = "caml_sys_getenv"
|
||||
external command : string -> int = "caml_sys_system_command"
|
||||
(** Execute the given shell command and return its exit code. *)
|
||||
|
||||
-external time : unit -> float = "caml_sys_time"
|
||||
+##V<4.3## external time : unit -> float = "caml_sys_time"
|
||||
+##V>=4.3## external time : unit -> (float [@unboxed]) = "caml_sys_time" "caml_sys_time_unboxed" [@@noalloc]
|
||||
(** Return the processor time, in seconds, used by the program
|
||||
since the beginning of execution. *)
|
||||
|
||||
diff --git a/src/batUnix.mliv b/src/batUnix.mliv
|
||||
index 60a6ec4..069d63a 100644
|
||||
--- a/src/batUnix.mliv
|
||||
+++ b/src/batUnix.mliv
|
||||
@@ -766,7 +766,8 @@ val create_process_env :
|
||||
(** {6 Symbolic links} *)
|
||||
|
||||
|
||||
-val symlink : string -> string -> unit
|
||||
+##V>=4.3##val symlink : ?to_dir:bool -> string -> string -> unit
|
||||
+##V<4.3##val symlink : string -> string -> unit
|
||||
(** [symlink source dest] creates the file [dest] as a symbolic link
|
||||
to the file [source]. *)
|
||||
|
||||
@ -0,0 +1,344 @@
|
||||
commit 905cbb6a3ebf1edc11745737feeedd36708149a7
|
||||
Author: KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
|
||||
Date: Wed Mar 23 10:11:46 2016 +0000
|
||||
|
||||
Spacing edits
|
||||
|
||||
diff --git a/src/batGc.mli b/src/batGc.mli
|
||||
index ecffb79..494b9b1 100644
|
||||
--- a/src/batGc.mli
|
||||
+++ b/src/batGc.mli
|
||||
@@ -34,18 +34,18 @@
|
||||
type stat = Gc.stat =
|
||||
{ minor_words : float;
|
||||
(** Number of words allocated in the minor heap since
|
||||
- the program was started. This number is accurate in
|
||||
- byte-code programs, but only an approximation in programs
|
||||
- compiled to native code. *)
|
||||
+ the program was started. This number is accurate in
|
||||
+ byte-code programs, but only an approximation in programs
|
||||
+ compiled to native code. *)
|
||||
|
||||
promoted_words : float;
|
||||
(** Number of words allocated in the minor heap that
|
||||
- survived a minor collection and were moved to the major heap
|
||||
- since the program was started. *)
|
||||
+ survived a minor collection and were moved to the major heap
|
||||
+ since the program was started. *)
|
||||
|
||||
major_words : float;
|
||||
(** Number of words allocated in the major heap, including
|
||||
- the promoted words, since the program was started. *)
|
||||
+ the promoted words, since the program was started. *)
|
||||
|
||||
minor_collections : int;
|
||||
(** Number of minor collections since the program was started. *)
|
||||
@@ -62,7 +62,7 @@ type stat = Gc.stat =
|
||||
|
||||
live_words : int;
|
||||
(** Number of words of live data in the major heap, including the header
|
||||
- words. *)
|
||||
+ words. *)
|
||||
|
||||
live_blocks : int;
|
||||
(** Number of live blocks in the major heap. *)
|
||||
@@ -78,8 +78,8 @@ type stat = Gc.stat =
|
||||
|
||||
fragments : int;
|
||||
(** Number of wasted words due to fragmentation. These are
|
||||
- 1-words free blocks placed between two live blocks. They
|
||||
- are not available for allocation. *)
|
||||
+ 1-words free blocks placed between two live blocks. They
|
||||
+ are not available for allocation. *)
|
||||
|
||||
compactions : int;
|
||||
(** Number of heap compactions since the program was started. *)
|
||||
@@ -92,16 +92,16 @@ type stat = Gc.stat =
|
||||
}
|
||||
(** The memory management counters are returned in a [stat] record.
|
||||
|
||||
- The total amount of memory allocated by the program since it was started
|
||||
- is (in words) [minor_words + major_words - promoted_words]. Multiply by
|
||||
- the word size (4 on a 32-bit machine, 8 on a 64-bit machine) to get
|
||||
- the number of bytes.
|
||||
+ The total amount of memory allocated by the program since it was started
|
||||
+ is (in words) [minor_words + major_words - promoted_words]. Multiply by
|
||||
+ the word size (4 on a 32-bit machine, 8 on a 64-bit machine) to get
|
||||
+ the number of bytes.
|
||||
*)
|
||||
|
||||
type control = Gc.control =
|
||||
{ mutable minor_heap_size : int;
|
||||
(** The size (in words) of the minor heap. Changing
|
||||
- this parameter will trigger a minor collection. Default: 256k. *)
|
||||
+ this parameter will trigger a minor collection. Default: 256k. *)
|
||||
|
||||
mutable major_heap_increment : int;
|
||||
(** How much to add to the major heap when increasing it. If this
|
||||
@@ -112,45 +112,45 @@ type control = Gc.control =
|
||||
|
||||
mutable space_overhead : int;
|
||||
(** The major GC speed is computed from this parameter.
|
||||
- This is the memory that will be "wasted" because the GC does not
|
||||
- immediatly collect unreachable blocks. It is expressed as a
|
||||
- percentage of the memory used for live data.
|
||||
- The GC will work more (use more CPU time and collect
|
||||
- blocks more eagerly) if [space_overhead] is smaller.
|
||||
- Default: 80. *)
|
||||
+ This is the memory that will be "wasted" because the GC does not
|
||||
+ immediatly collect unreachable blocks. It is expressed as a
|
||||
+ percentage of the memory used for live data.
|
||||
+ The GC will work more (use more CPU time and collect
|
||||
+ blocks more eagerly) if [space_overhead] is smaller.
|
||||
+ Default: 80. *)
|
||||
|
||||
mutable verbose : int;
|
||||
(** This value controls the GC messages on standard error output.
|
||||
- It is a sum of some of the following flags, to print messages
|
||||
- on the corresponding events:
|
||||
- - [0x001] Start of major GC cycle.
|
||||
- - [0x002] Minor collection and major GC slice.
|
||||
- - [0x004] Growing and shrinking of the heap.
|
||||
- - [0x008] Resizing of stacks and memory manager tables.
|
||||
- - [0x010] Heap compaction.
|
||||
- - [0x020] Change of GC parameters.
|
||||
- - [0x040] Computation of major GC slice size.
|
||||
- - [0x080] Calling of finalisation functions.
|
||||
- - [0x100] Bytecode executable and shared library search at start-up.
|
||||
- - [0x200] Computation of compaction-triggering condition.
|
||||
- - [0x400] Output GC statistics at program exit.
|
||||
- Default: 0. *)
|
||||
+ It is a sum of some of the following flags, to print messages
|
||||
+ on the corresponding events:
|
||||
+ - [0x001] Start of major GC cycle.
|
||||
+ - [0x002] Minor collection and major GC slice.
|
||||
+ - [0x004] Growing and shrinking of the heap.
|
||||
+ - [0x008] Resizing of stacks and memory manager tables.
|
||||
+ - [0x010] Heap compaction.
|
||||
+ - [0x020] Change of GC parameters.
|
||||
+ - [0x040] Computation of major GC slice size.
|
||||
+ - [0x080] Calling of finalisation functions.
|
||||
+ - [0x100] Bytecode executable and shared library search at start-up.
|
||||
+ - [0x200] Computation of compaction-triggering condition.
|
||||
+ - [0x400] Output GC statistics at program exit.
|
||||
+ Default: 0. *)
|
||||
|
||||
mutable max_overhead : int;
|
||||
(** Heap compaction is triggered when the estimated amount
|
||||
- of "wasted" memory is more than [max_overhead] percent of the
|
||||
- amount of live data. If [max_overhead] is set to 0, heap
|
||||
- compaction is triggered at the end of each major GC cycle
|
||||
- (this setting is intended for testing purposes only).
|
||||
- If [max_overhead >= 1000000], compaction is never triggered.
|
||||
- If compaction is permanently disabled, it is strongly suggested
|
||||
- to set [allocation_policy] to 1.
|
||||
- Default: 500. *)
|
||||
+ of "wasted" memory is more than [max_overhead] percent of the
|
||||
+ amount of live data. If [max_overhead] is set to 0, heap
|
||||
+ compaction is triggered at the end of each major GC cycle
|
||||
+ (this setting is intended for testing purposes only).
|
||||
+ If [max_overhead >= 1000000], compaction is never triggered.
|
||||
+ If compaction is permanently disabled, it is strongly suggested
|
||||
+ to set [allocation_policy] to 1.
|
||||
+ Default: 500. *)
|
||||
|
||||
mutable stack_limit : int;
|
||||
(** The maximum size of the stack (in words). This is only
|
||||
- relevant to the byte-code runtime, as the native code runtime
|
||||
- uses the operating system's stack. Default: 1024k. *)
|
||||
+ relevant to the byte-code runtime, as the native code runtime
|
||||
+ uses the operating system's stack. Default: 1024k. *)
|
||||
|
||||
mutable allocation_policy : int;
|
||||
(** The policy used for allocating in the heap. Possible
|
||||
@@ -173,8 +173,8 @@ type control = Gc.control =
|
||||
|
||||
external stat : unit -> stat = "caml_gc_stat"
|
||||
(** Return the current values of the memory management counters in a
|
||||
- [stat] record. This function examines every heap block to get the
|
||||
- statistics. *)
|
||||
+ [stat] record. This function examines every heap block to get the
|
||||
+ statistics. *)
|
||||
|
||||
external quick_stat : unit -> stat = "caml_gc_quick_stat"
|
||||
(** Same as [stat] except that [live_words], [live_blocks], [free_words],
|
||||
@@ -191,7 +191,7 @@ external get : unit -> control = "caml_gc_get"
|
||||
|
||||
external set : control -> unit = "caml_gc_set"
|
||||
(** [set r] changes the GC parameters according to the [control] record [r].
|
||||
- The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
|
||||
+ The normal usage is: [Gc.set { (Gc.get()) with Gc.verbose = 0x00d }] *)
|
||||
|
||||
external minor : unit -> unit = "caml_gc_minor"
|
||||
(** Trigger a minor collection. *)
|
||||
@@ -210,21 +210,21 @@ external major : unit -> unit = "caml_gc_major"
|
||||
|
||||
external full_major : unit -> unit = "caml_gc_full_major"
|
||||
(** Do a minor collection, finish the current major collection cycle,
|
||||
- and perform a complete new cycle. This will collect all currently
|
||||
- unreachable blocks. *)
|
||||
+ and perform a complete new cycle. This will collect all currently
|
||||
+ unreachable blocks. *)
|
||||
|
||||
external compact : unit -> unit = "caml_gc_compaction"
|
||||
(** Perform a full major collection and compact the heap. Note that heap
|
||||
- compaction is a lengthy operation. *)
|
||||
+ compaction is a lengthy operation. *)
|
||||
|
||||
val print_stat : _ BatInnerIO.output -> unit
|
||||
(** Print the current values of the memory management counters (in
|
||||
- human-readable form) into the channel argument. *)
|
||||
+ human-readable form) into the channel argument. *)
|
||||
|
||||
val allocated_bytes : unit -> float
|
||||
(** Return the total number of bytes allocated since the program was
|
||||
- started. It is returned as a [float] to avoid overflow problems
|
||||
- with [int] on 32-bit machines. *)
|
||||
+ started. It is returned as a [float] to avoid overflow problems
|
||||
+ with [int] on 32-bit machines. *)
|
||||
|
||||
external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc]
|
||||
(** Return the current size of the free space inside the minor heap. *)
|
||||
@@ -247,63 +247,63 @@ external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
|
||||
|
||||
val finalise : ('a -> unit) -> 'a -> unit
|
||||
(** [finalise f v] registers [f] as a finalisation function for [v].
|
||||
- [v] must be heap-allocated. [f] will be called with [v] as
|
||||
- argument at some point between the first time [v] becomes unreachable
|
||||
- (including through weak pointers) and the time [v] is collected by
|
||||
- the GC. Several functions can
|
||||
- be registered for the same value, or even several instances of the
|
||||
- same function. Each instance will be called once (or never,
|
||||
- if the program terminates before [v] becomes unreachable).
|
||||
-
|
||||
- The GC will call the finalisation functions in the order of
|
||||
- deallocation. When several values become unreachable at the
|
||||
- same time (i.e. during the same GC cycle), the finalisation
|
||||
- functions will be called in the reverse order of the corresponding
|
||||
- calls to [finalise]. If [finalise] is called in the same order
|
||||
- as the values are allocated, that means each value is finalised
|
||||
- before the values it depends upon. Of course, this becomes
|
||||
- false if additional dependencies are introduced by assignments.
|
||||
-
|
||||
- In the presence of multiple OCaml threads it should be assumed that
|
||||
- any particular finaliser may be executed in any of the threads.
|
||||
-
|
||||
- Anything reachable from the closure of finalisation functions
|
||||
- is considered reachable, so the following code will not work
|
||||
- as expected:
|
||||
- - [ let v = ... in Gc.finalise (fun _ -> ...v...) v ]
|
||||
-
|
||||
- Instead you should make sure that [v] is not in the closure of
|
||||
- the finalisation function by writing:
|
||||
- - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
|
||||
-
|
||||
-
|
||||
- The [f] function can use all features of OCaml, including
|
||||
- assignments that make the value reachable again. It can also
|
||||
- loop forever (in this case, the other
|
||||
- finalisation functions will not be called during the execution of f,
|
||||
- unless it calls [finalise_release]).
|
||||
- It can call [finalise] on [v] or other values to register other
|
||||
- functions or even itself. It can raise an exception; in this case
|
||||
- the exception will interrupt whatever the program was doing when
|
||||
- the function was called.
|
||||
-
|
||||
-
|
||||
- [finalise] will raise [Invalid_argument] if [v] is not
|
||||
- guaranteed to be heap-allocated. Some examples of values that are not
|
||||
- heap-allocated are integers, constant constructors, booleans,
|
||||
- the empty array, the empty list, the unit value. The exact list
|
||||
- of what is heap-allocated or not is implementation-dependent.
|
||||
- Some constant values can be heap-allocated but never deallocated
|
||||
- during the lifetime of the program, for example a list of integer
|
||||
- constants; this is also implementation-dependent.
|
||||
- Note that values of types [float] and ['a lazy] (for any ['a]) are
|
||||
- sometimes allocated and sometimes not, so finalising them is unsafe,
|
||||
- and [finalise] will also raise [Invalid_argument] for them.
|
||||
-
|
||||
-
|
||||
- The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
|
||||
- {!Array.make}, and {!Pervasives.ref} are guaranteed to be
|
||||
- heap-allocated and non-constant except when the length argument is [0].
|
||||
+ [v] must be heap-allocated. [f] will be called with [v] as
|
||||
+ argument at some point between the first time [v] becomes unreachable
|
||||
+ (including through weak pointers) and the time [v] is collected by
|
||||
+ the GC. Several functions can
|
||||
+ be registered for the same value, or even several instances of the
|
||||
+ same function. Each instance will be called once (or never,
|
||||
+ if the program terminates before [v] becomes unreachable).
|
||||
+
|
||||
+ The GC will call the finalisation functions in the order of
|
||||
+ deallocation. When several values become unreachable at the
|
||||
+ same time (i.e. during the same GC cycle), the finalisation
|
||||
+ functions will be called in the reverse order of the corresponding
|
||||
+ calls to [finalise]. If [finalise] is called in the same order
|
||||
+ as the values are allocated, that means each value is finalised
|
||||
+ before the values it depends upon. Of course, this becomes
|
||||
+ false if additional dependencies are introduced by assignments.
|
||||
+
|
||||
+ In the presence of multiple OCaml threads it should be assumed that
|
||||
+ any particular finaliser may be executed in any of the threads.
|
||||
+
|
||||
+ Anything reachable from the closure of finalisation functions
|
||||
+ is considered reachable, so the following code will not work
|
||||
+ as expected:
|
||||
+ - [ let v = ... in Gc.finalise (fun _ -> ...v...) v ]
|
||||
+
|
||||
+ Instead you should make sure that [v] is not in the closure of
|
||||
+ the finalisation function by writing:
|
||||
+ - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ]
|
||||
+
|
||||
+
|
||||
+ The [f] function can use all features of OCaml, including
|
||||
+ assignments that make the value reachable again. It can also
|
||||
+ loop forever (in this case, the other
|
||||
+ finalisation functions will not be called during the execution of f,
|
||||
+ unless it calls [finalise_release]).
|
||||
+ It can call [finalise] on [v] or other values to register other
|
||||
+ functions or even itself. It can raise an exception; in this case
|
||||
+ the exception will interrupt whatever the program was doing when
|
||||
+ the function was called.
|
||||
+
|
||||
+
|
||||
+ [finalise] will raise [Invalid_argument] if [v] is not
|
||||
+ guaranteed to be heap-allocated. Some examples of values that are not
|
||||
+ heap-allocated are integers, constant constructors, booleans,
|
||||
+ the empty array, the empty list, the unit value. The exact list
|
||||
+ of what is heap-allocated or not is implementation-dependent.
|
||||
+ Some constant values can be heap-allocated but never deallocated
|
||||
+ during the lifetime of the program, for example a list of integer
|
||||
+ constants; this is also implementation-dependent.
|
||||
+ Note that values of types [float] and ['a lazy] (for any ['a]) are
|
||||
+ sometimes allocated and sometimes not, so finalising them is unsafe,
|
||||
+ and [finalise] will also raise [Invalid_argument] for them.
|
||||
+
|
||||
+
|
||||
+ The results of calling {!String.make}, {!Bytes.make}, {!Bytes.create},
|
||||
+ {!Array.make}, and {!Pervasives.ref} are guaranteed to be
|
||||
+ heap-allocated and non-constant except when the length argument is [0].
|
||||
*)
|
||||
|
||||
val finalise_release : unit -> unit
|
||||
@@ -313,15 +313,15 @@ val finalise_release : unit -> unit
|
||||
|
||||
type alarm = Gc.alarm
|
||||
(** An alarm is a piece of data that calls a user function at the end of
|
||||
- each major GC cycle. The following functions are provided to create
|
||||
- and delete alarms. *)
|
||||
+ each major GC cycle. The following functions are provided to create
|
||||
+ and delete alarms. *)
|
||||
|
||||
val create_alarm : (unit -> unit) -> alarm
|
||||
(** [create_alarm f] will arrange for [f] to be called at the end of each
|
||||
- major GC cycle, starting with the current cycle or the next one.
|
||||
- A value of type [alarm] is returned that you can
|
||||
- use to call [delete_alarm]. *)
|
||||
+ major GC cycle, starting with the current cycle or the next one.
|
||||
+ A value of type [alarm] is returned that you can
|
||||
+ use to call [delete_alarm]. *)
|
||||
|
||||
val delete_alarm : alarm -> unit
|
||||
(** [delete_alarm a] will stop the calls to the function associated
|
||||
- to [a]. Calling [delete_alarm a] again has no effect. *)
|
||||
+ to [a]. Calling [delete_alarm a] again has no effect. *)
|
||||
@ -0,0 +1,21 @@
|
||||
commit 39393f8fc2d7c60dc093e9ea836077598dfbe955
|
||||
Author: KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
|
||||
Date: Wed Mar 23 11:23:26 2016 +0000
|
||||
|
||||
Fix make_float versioning
|
||||
|
||||
diff --git a/src/batArray.mliv b/src/batArray.mliv
|
||||
index 025887f..c6bfd02 100644
|
||||
--- a/src/batArray.mliv
|
||||
+++ b/src/batArray.mliv
|
||||
@@ -82,7 +82,9 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
|
||||
If the value of [x] is a floating-point number, then the maximum
|
||||
size is only [Sys.max_array_length / 2].*)
|
||||
|
||||
-val make_float : int -> float array
|
||||
+##V>=4.3##val make_float : int -> float array
|
||||
+##V=4.2##external make_float : int -> float array = "caml_make_float_vect"
|
||||
+##V<4.2##val make_float : int -> float array
|
||||
(** [Array.make_float n] returns a fresh float array of length [n],
|
||||
with uninitialized data.
|
||||
|
||||
@ -0,0 +1,58 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI="5"
|
||||
|
||||
OASIS_BUILD_DOCS=1
|
||||
OASIS_BUILD_TESTS=1
|
||||
|
||||
inherit eutils oasis
|
||||
|
||||
MY_P=${P/_/\~}
|
||||
DESCRIPTION="Jane Street's alternative to the standard library"
|
||||
HOMEPAGE="http://www.janestreet.com/ocaml"
|
||||
SRC_URI="http://ocaml.janestreet.com/ocaml-core/${PV%.*}/files/${P}.tar.gz"
|
||||
|
||||
LICENSE="LGPL-2.1-with-linking-exception"
|
||||
SLOT="0/${PV}"
|
||||
KEYWORDS="~amd64"
|
||||
IUSE=""
|
||||
|
||||
RDEPEND="
|
||||
>=dev-ml/bin-prot-113.24.00:=
|
||||
>=dev-ml/core_kernel-113.24.00:=
|
||||
>=dev-ml/fieldslib-113.24.00:=
|
||||
dev-ml/ppx_assert:=
|
||||
dev-ml/ppx_bench:=
|
||||
dev-ml/ppx_driver:=
|
||||
dev-ml/ppx_expect:=
|
||||
dev-ml/ppx_inline_test:=
|
||||
dev-ml/ppx_jane:=
|
||||
>=dev-ml/sexplib-113.24.00:=
|
||||
dev-ml/typerep:=
|
||||
dev-ml/variantslib:=
|
||||
"
|
||||
DEPEND="${RDEPEND}"
|
||||
|
||||
src_prepare() {
|
||||
has_version '>=dev-lang/ocaml-4.03' && epatch "${FILESDIR}/oc43.patch"
|
||||
}
|
||||
|
||||
src_configure() {
|
||||
emake setup.exe
|
||||
OASIS_SETUP_COMMAND="./setup.exe" oasis_src_configure
|
||||
}
|
||||
|
||||
src_compile() {
|
||||
emake
|
||||
}
|
||||
|
||||
src_install() {
|
||||
opam-installer -i \
|
||||
--prefix="${ED}/usr" \
|
||||
--libdir="${D}/$(ocamlc -where)" \
|
||||
--docdir="${ED}/usr/share/doc/${PF}" \
|
||||
${PN}.install || die
|
||||
dodoc CHANGES.md README.md
|
||||
}
|
||||
@ -0,0 +1,279 @@
|
||||
diff -uNr core-113.33.02/_oasis core-113.33.02+4.03/_oasis
|
||||
--- core-113.33.02/_oasis 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/_oasis 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: core
|
||||
-Version: 113.33.02
|
||||
+Version: 113.33.02+4.03
|
||||
Synopsis: Industrial strength alternative to OCaml's standard library
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2008-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr core-113.33.02/opam core-113.33.02+4.03/opam
|
||||
--- core-113.33.02/opam 2016-04-06 11:12:24.000000000 +0200
|
||||
+++ core-113.33.02+4.03/opam 2016-04-06 12:54:27.000000000 +0200
|
||||
@@ -26,4 +26,4 @@
|
||||
"typerep"
|
||||
"variantslib"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr core-113.33.02/src/bigstring.ml core-113.33.02+4.03/src/bigstring.ml
|
||||
--- core-113.33.02/src/bigstring.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/bigstring.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -29,7 +29,7 @@
|
||||
|
||||
let length = Array1.dim
|
||||
|
||||
-external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" "noalloc"
|
||||
+external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" [@@noalloc]
|
||||
|
||||
let init n ~f =
|
||||
let t = create n in
|
||||
@@ -168,7 +168,7 @@
|
||||
|
||||
external unsafe_send_nonblocking_no_sigpipe
|
||||
: file_descr -> pos : int -> len : int -> t -> Syscall_result.Int.t
|
||||
- = "bigstring_send_nonblocking_no_sigpipe_stub" "noalloc"
|
||||
+ = "bigstring_send_nonblocking_no_sigpipe_stub" [@@noalloc]
|
||||
|
||||
let send_nonblocking_no_sigpipe fd ?(pos = 0) ?len bstr =
|
||||
let len = get_opt_len bstr ~pos len in
|
||||
diff -uNr core-113.33.02/src/core_sys.ml core-113.33.02+4.03/src/core_sys.ml
|
||||
--- core-113.33.02/src/core_sys.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/core_sys.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -83,7 +83,7 @@
|
||||
*)
|
||||
external executing_bytecode
|
||||
: unit -> unit -> unit -> unit -> unit -> unit -> bool
|
||||
- = "executing_bytecode" "not_executing_bytecode" "noalloc"
|
||||
+ = "executing_bytecode" "not_executing_bytecode" [@@noalloc]
|
||||
|
||||
let execution_mode () =
|
||||
if executing_bytecode () () () () () () then `Bytecode else `Native
|
||||
@@ -95,7 +95,7 @@
|
||||
|
||||
|
||||
(* returns size, in bits, of an [int] type in C *)
|
||||
-external c_int_size : unit -> int = "c_int_size" "noalloc"
|
||||
+external c_int_size : unit -> int = "c_int_size" [@@noalloc]
|
||||
|
||||
let%test _ = let size = c_int_size () in size >= 16 && size <= Sys.word_size
|
||||
|
||||
diff -uNr core-113.33.02/src/core_sys.mli core-113.33.02+4.03/src/core_sys.mli
|
||||
--- core-113.33.02/src/core_sys.mli 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/core_sys.mli 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -134,7 +134,7 @@
|
||||
(** [c_int_size] returns the number of bits in a C [int]. Note that this can be
|
||||
different from [word_size]. For example, Linux x86-64 should have
|
||||
[word_size = 64], but [c_int_size () = 32] *)
|
||||
-external c_int_size : unit -> int = "c_int_size" "noalloc"
|
||||
+external c_int_size : unit -> int = "c_int_size" [@@noalloc]
|
||||
|
||||
(** Return the home directory, using the [HOME] environment variable if that is defined,
|
||||
and if not, using the effective user's information in the Unix password database. *)
|
||||
diff -uNr core-113.33.02/src/core_unix.ml core-113.33.02+4.03/src/core_unix.ml
|
||||
--- core-113.33.02/src/core_unix.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/core_unix.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -393,7 +393,7 @@
|
||||
|
||||
(* Signal handling *)
|
||||
|
||||
-external abort : unit -> 'a = "unix_abort" "noalloc"
|
||||
+external abort : unit -> 'a = "unix_abort" [@@noalloc]
|
||||
|
||||
(* User id, group id management *)
|
||||
|
||||
@@ -1160,6 +1160,11 @@
|
||||
(fun () -> [("src", atom src); ("dst", atom dst)])
|
||||
;;
|
||||
|
||||
+let src_dst' f ?to_dir ~src ~dst =
|
||||
+ improve (fun () -> f ?to_dir ~src ~dst)
|
||||
+ (fun () -> [("src", atom src); ("dst", atom dst)])
|
||||
+;;
|
||||
+
|
||||
let unlink = unary_filename Unix.unlink
|
||||
|
||||
let rename = src_dst Unix.rename
|
||||
@@ -1554,7 +1559,7 @@
|
||||
Exit_or_signal.of_unix (Unix.close_process_full (c.C.stdout, c.C.stdin, c.C.stderr))
|
||||
;;
|
||||
|
||||
-let symlink = src_dst Unix.symlink
|
||||
+let symlink = src_dst' Unix.symlink
|
||||
let readlink = unary_filename Unix.readlink
|
||||
|
||||
module Select_fds = struct
|
||||
diff -uNr core-113.33.02/src/core_unix.mli core-113.33.02+4.03/src/core_unix.mli
|
||||
--- core-113.33.02/src/core_unix.mli 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/core_unix.mli 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -910,7 +910,7 @@
|
||||
|
||||
(** [symlink source dest] creates the file [dest] as a symbolic link
|
||||
to the file [source]. *)
|
||||
-val symlink : src:string -> dst:string -> unit
|
||||
+val symlink : ?to_dir:bool -> src:string -> dst:string -> unit
|
||||
|
||||
(** Read the contents of a link. *)
|
||||
val readlink : string -> string
|
||||
@@ -2007,7 +2007,7 @@
|
||||
caught and the signal handler does not return. If the SIGABRT signal is
|
||||
blocked or ignored, the abort() function will still override it.
|
||||
*)
|
||||
-external abort : unit -> _ = "unix_abort" "noalloc"
|
||||
+external abort : unit -> _ = "unix_abort" [@@noalloc]
|
||||
|
||||
(** {2 User id, group id} *)
|
||||
|
||||
diff -uNr core-113.33.02/src/iobuf.ml core-113.33.02+4.03/src/iobuf.ml
|
||||
--- core-113.33.02/src/iobuf.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/iobuf.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -1094,7 +1094,7 @@
|
||||
-> (read_write, seek) t array
|
||||
-> Recvmmsg_context.ctx
|
||||
-> Unix.Syscall_result.Int.t
|
||||
- = "iobuf_recvmmsg_assume_fd_is_nonblocking_stub" "noalloc"
|
||||
+ = "iobuf_recvmmsg_assume_fd_is_nonblocking_stub" [@@noalloc]
|
||||
|
||||
let recvmmsg_assume_fd_is_nonblocking fd { Recvmmsg_context. iobufs; ctx; _ } =
|
||||
unsafe_recvmmsg_assume_fd_is_nonblocking fd iobufs ctx
|
||||
diff -uNr core-113.33.02/src/linux_ext.ml core-113.33.02+4.03/src/linux_ext.ml
|
||||
--- core-113.33.02/src/linux_ext.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/linux_ext.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -320,7 +320,7 @@
|
||||
-> initial : Int63.t
|
||||
-> interval : Int63.t
|
||||
-> Syscall_result.Unit.t
|
||||
- = "linux_timerfd_settime" "noalloc"
|
||||
+ = "linux_timerfd_settime" [@@noalloc]
|
||||
|
||||
let%test_unit "unsafe_timerfd_settime returning errno" =
|
||||
let result =
|
||||
@@ -683,13 +683,13 @@
|
||||
type ready_events = Bigstring.t
|
||||
|
||||
external epoll_sizeof_epoll_event
|
||||
- : unit -> int = "linux_epoll_sizeof_epoll_event" "noalloc"
|
||||
+ : unit -> int = "linux_epoll_sizeof_epoll_event" [@@noalloc]
|
||||
|
||||
external epoll_offsetof_readyfd
|
||||
- : unit -> int = "linux_epoll_offsetof_readyfd" "noalloc"
|
||||
+ : unit -> int = "linux_epoll_offsetof_readyfd" [@@noalloc]
|
||||
|
||||
external epoll_offsetof_readyflags
|
||||
- : unit -> int = "linux_epoll_offsetof_readyflags" "noalloc"
|
||||
+ : unit -> int = "linux_epoll_offsetof_readyflags" [@@noalloc]
|
||||
|
||||
let sizeof_epoll_event = epoll_sizeof_epoll_event ()
|
||||
let offsetof_readyfd = epoll_offsetof_readyfd ()
|
||||
diff -uNr core-113.33.02/src/syslog.ml core-113.33.02+4.03/src/syslog.ml
|
||||
--- core-113.33.02/src/syslog.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/syslog.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -57,8 +57,8 @@
|
||||
|
||||
external core_syslog_openlog : string option -> int -> int -> unit = "core_syslog_openlog"
|
||||
external core_syslog_syslog : int -> string -> unit = "core_syslog_syslog"
|
||||
-external core_syslog_closelog : unit -> unit = "core_syslog_closelog" "noalloc"
|
||||
-external core_syslog_setlogmask : int -> unit = "core_syslog_setlogmask" "noalloc"
|
||||
+external core_syslog_closelog : unit -> unit = "core_syslog_closelog" [@@noalloc]
|
||||
+external core_syslog_setlogmask : int -> unit = "core_syslog_setlogmask" [@@noalloc]
|
||||
|
||||
let openlog ?id ?(options = []) ?(facility = Facility.USER) () =
|
||||
core_syslog_openlog id (Open_option.mask options) (Facility.to_int facility)
|
||||
diff -uNr core-113.33.02/src/time_stamp_counter.ml core-113.33.02+4.03/src/time_stamp_counter.ml
|
||||
--- core-113.33.02/src/time_stamp_counter.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/time_stamp_counter.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -93,7 +93,7 @@
|
||||
#if JSC_ARCH_SIXTYFOUR
|
||||
|
||||
(* noalloc on x86_64 only *)
|
||||
-external now : unit -> tsc = "tsc_get" "noalloc"
|
||||
+external now : unit -> tsc = "tsc_get" [@@noalloc]
|
||||
|
||||
module Calibrator = struct
|
||||
|
||||
diff -uNr core-113.33.02/src/time_stamp_counter.mli core-113.33.02+4.03/src/time_stamp_counter.mli
|
||||
--- core-113.33.02/src/time_stamp_counter.mli 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/time_stamp_counter.mli 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -102,7 +102,7 @@
|
||||
end
|
||||
|
||||
#if JSC_ARCH_SIXTYFOUR
|
||||
-external now : unit -> t = "tsc_get" "noalloc"
|
||||
+external now : unit -> t = "tsc_get" [@@noalloc]
|
||||
#else
|
||||
external now : unit -> t = "tsc_get"
|
||||
#endif
|
||||
diff -uNr core-113.33.02/src/unix_stubs.c core-113.33.02+4.03/src/unix_stubs.c
|
||||
--- core-113.33.02/src/unix_stubs.c 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/src/unix_stubs.c 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -213,7 +213,7 @@
|
||||
of strings and fill it will strings contained in the string array
|
||||
[arg]. Pointers stored in the result points directly inside the
|
||||
OCaml heap. */
|
||||
-extern char **cstringvect(value arg);
|
||||
+extern char **cstringvect(value arg, char* cmdname);
|
||||
|
||||
/* Given v_prog, an O'Caml string value specifying a program name,
|
||||
v_args, an O'Caml array specifying program arguments (not
|
||||
@@ -378,7 +378,7 @@
|
||||
|
||||
/* We don't bother saving/restoring the environment or freeing the
|
||||
new one since we exit the process in case of error. */
|
||||
- environ = cstringvect(v_env);
|
||||
+ environ = cstringvect(v_env, "ml_create_process");
|
||||
|
||||
if (Is_block(v_working_dir))
|
||||
working_dir = String_val(Field(v_working_dir, 0));
|
||||
diff -uNr core-113.33.02/test/bigstring_test.ml core-113.33.02+4.03/test/bigstring_test.ml
|
||||
--- core-113.33.02/test/bigstring_test.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/test/bigstring_test.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -169,7 +169,7 @@
|
||||
simple_conversion_test ~n:"single" "1";
|
||||
repeat 50 (simple_conversion_test ~n:"random") sg;
|
||||
);
|
||||
-
|
||||
+(*
|
||||
"input" >::
|
||||
(fun () ->
|
||||
fd_test really_read_test ~n:"single" (bs_of_s "X");
|
||||
@@ -178,6 +178,7 @@
|
||||
repeat 100 (fd_test really_read_test ~n:"random big")
|
||||
(bsg ~size:(fun () -> 100 * png ()));
|
||||
);
|
||||
+*)
|
||||
|
||||
"destruction" >::
|
||||
(fun () ->
|
||||
@@ -209,6 +210,7 @@
|
||||
blit_test ~n:"random" ~src_pos ~dst_pos ~len (s1,s2))
|
||||
(fun () -> (sg (), sg(),nng (), nng (), nng ()))
|
||||
);
|
||||
+(*
|
||||
"really write/read pipe" >::
|
||||
(fun () ->
|
||||
let write_read_test = write_read_test Unix.pipe in
|
||||
@@ -239,6 +241,7 @@
|
||||
repeat 500 (output_input_test ~n:"random big")
|
||||
(bsg ~size:(fun () -> 100 * png ()));
|
||||
);
|
||||
+*)
|
||||
|
||||
"sub" >::
|
||||
(fun () ->
|
||||
diff -uNr core-113.33.02/test/hashtbl/table_new_intf.ml core-113.33.02+4.03/test/hashtbl/table_new_intf.ml
|
||||
--- core-113.33.02/test/hashtbl/table_new_intf.ml 2016-04-06 11:06:40.000000000 +0200
|
||||
+++ core-113.33.02+4.03/test/hashtbl/table_new_intf.ml 2016-04-06 12:42:48.000000000 +0200
|
||||
@@ -7,7 +7,7 @@
|
||||
compare: 'k -> 'k -> int;
|
||||
}
|
||||
|
||||
-external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
|
||||
+external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc]
|
||||
|
||||
let poly = {
|
||||
hash = (fun z -> hash_param 10 100 z);
|
||||
@ -0,0 +1,581 @@
|
||||
diff -uNr core_kernel-113.33.01/check_caml_modify/caml_modify.ml core_kernel-113.33.01+4.03/check_caml_modify/caml_modify.ml
|
||||
--- core_kernel-113.33.01/check_caml_modify/caml_modify.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/check_caml_modify/caml_modify.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -1,5 +1,5 @@
|
||||
-external count : unit -> int = "check_caml_modify_count" "noalloc"
|
||||
-external reset : unit -> unit = "check_caml_modify_reset" "noalloc"
|
||||
+external count : unit -> int = "check_caml_modify_count" [@@noalloc]
|
||||
+external reset : unit -> unit = "check_caml_modify_reset" [@@noalloc]
|
||||
|
||||
let%test_unit _ =
|
||||
let x = Array.make (32 * 1024) [Random.int 10] in
|
||||
diff -uNr core_kernel-113.33.01/check_caml_modify/caml_modify.mli core_kernel-113.33.01+4.03/check_caml_modify/caml_modify.mli
|
||||
--- core_kernel-113.33.01/check_caml_modify/caml_modify.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/check_caml_modify/caml_modify.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -6,7 +6,7 @@
|
||||
|
||||
(** [count ()] returns the number of times [caml_modify] has been called since the last
|
||||
call to {!reset}. *)
|
||||
-external count : unit -> int = "check_caml_modify_count" "noalloc"
|
||||
+external count : unit -> int = "check_caml_modify_count" [@@noalloc]
|
||||
|
||||
(** [reset ()] reset the counter to [0]. *)
|
||||
-external reset : unit -> unit = "check_caml_modify_reset" "noalloc"
|
||||
+external reset : unit -> unit = "check_caml_modify_reset" [@@noalloc]
|
||||
diff -uNr core_kernel-113.33.01/_oasis core_kernel-113.33.01+4.03/_oasis
|
||||
--- core_kernel-113.33.01/_oasis 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/_oasis 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: core_kernel
|
||||
-Version: 113.33.01
|
||||
+Version: 113.33.01+4.03
|
||||
Synopsis: Industrial strength alternative to OCaml's standard library
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2008-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr core_kernel-113.33.01/opam core_kernel-113.33.01+4.03/opam
|
||||
--- core_kernel-113.33.01/opam 2016-03-22 11:43:53.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/opam 2016-03-22 17:51:34.000000000 +0100
|
||||
@@ -25,4 +25,4 @@
|
||||
"typerep"
|
||||
"variantslib"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr core_kernel-113.33.01/src/bigstring.ml core_kernel-113.33.01+4.03/src/bigstring.ml
|
||||
--- core_kernel-113.33.01/src/bigstring.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/bigstring.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -16,6 +16,8 @@
|
||||
|
||||
external aux_create: max_mem_waiting_gc:int -> size:int -> t = "bigstring_alloc"
|
||||
|
||||
+external test_allocation : unit -> 'a = "core_bigstring_test_allocation"
|
||||
+
|
||||
let create ?max_mem_waiting_gc size =
|
||||
let max_mem_waiting_gc =
|
||||
match max_mem_waiting_gc with
|
||||
@@ -35,6 +37,7 @@
|
||||
let max_mem_waiting_gc = Byte_units.create mem_units 256. in
|
||||
for _ = 0 to large_int do
|
||||
let (_ : t) = create ~max_mem_waiting_gc large_int in
|
||||
+ ignore (test_allocation ()); (* ensure we allocate something *)
|
||||
()
|
||||
done;
|
||||
Alarm.delete alarm;
|
||||
@@ -48,7 +51,7 @@
|
||||
|
||||
let length = Array1.dim
|
||||
|
||||
-external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" "noalloc"
|
||||
+external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" [@@noalloc]
|
||||
|
||||
let init n ~f =
|
||||
let t = create n in
|
||||
@@ -119,7 +122,7 @@
|
||||
(struct
|
||||
external unsafe_blit
|
||||
: src : string -> src_pos : int -> dst : t -> dst_pos : int -> len : int -> unit
|
||||
- = "bigstring_blit_string_bigstring_stub" "noalloc"
|
||||
+ = "bigstring_blit_string_bigstring_stub" [@@noalloc]
|
||||
include Bigstring_sequence
|
||||
end)
|
||||
;;
|
||||
@@ -131,7 +134,7 @@
|
||||
(struct
|
||||
external unsafe_blit
|
||||
: src : t -> src_pos : int -> dst : string -> dst_pos : int -> len : int -> unit
|
||||
- = "bigstring_blit_bigstring_string_stub" "noalloc"
|
||||
+ = "bigstring_blit_bigstring_string_stub" [@@noalloc]
|
||||
include String_sequence
|
||||
end)
|
||||
;;
|
||||
@@ -200,7 +203,7 @@
|
||||
|
||||
external unsafe_memcmp
|
||||
: t1 : t -> t1_pos : int -> t2 : t -> t2_pos : int -> len : int -> int
|
||||
- = "bigstring_memcmp_stub" "noalloc"
|
||||
+ = "bigstring_memcmp_stub" [@@noalloc]
|
||||
|
||||
let compare t1 t2 =
|
||||
if phys_equal t1 t2 then 0 else
|
||||
@@ -395,7 +398,7 @@
|
||||
|
||||
(* Search *)
|
||||
|
||||
-external unsafe_find : t -> char -> pos:int -> len:int -> int = "bigstring_find" "noalloc"
|
||||
+external unsafe_find : t -> char -> pos:int -> len:int -> int = "bigstring_find" [@@noalloc]
|
||||
|
||||
let find ?(pos = 0) ?len chr bstr =
|
||||
let len = get_opt_len bstr ~pos len in
|
||||
diff -uNr core_kernel-113.33.01/src/bigstring.mli core_kernel-113.33.01+4.03/src/bigstring.mli
|
||||
--- core_kernel-113.33.01/src/bigstring.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/bigstring.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -83,7 +83,7 @@
|
||||
(** [set t pos] sets the character at [pos] *)
|
||||
external set : t -> int -> char -> unit = "%caml_ba_set_1"
|
||||
|
||||
-external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" "noalloc"
|
||||
+external is_mmapped : t -> bool = "bigstring_is_mmapped_stub" [@@noalloc]
|
||||
(** [is_mmapped bstr] @return whether the bigstring [bstr] is
|
||||
memory-mapped. *)
|
||||
|
||||
@@ -159,7 +159,7 @@
|
||||
|
||||
(** Same as [find], but does no bounds checking, and returns a negative value instead of
|
||||
[None] if [char] is not found. *)
|
||||
-external unsafe_find : t -> char -> pos:int -> len:int -> int = "bigstring_find" "noalloc"
|
||||
+external unsafe_find : t -> char -> pos:int -> len:int -> int = "bigstring_find" [@@noalloc]
|
||||
|
||||
|
||||
(** {6 Destruction} *)
|
||||
diff -uNr core_kernel-113.33.01/src/bigstring_stubs.c core_kernel-113.33.01+4.03/src/bigstring_stubs.c
|
||||
--- core_kernel-113.33.01/src/bigstring_stubs.c 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/bigstring_stubs.c 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -202,3 +202,14 @@
|
||||
core_bigstring_destroy(Caml_ba_array_val(v_bstr), 0);
|
||||
return Val_unit;
|
||||
}
|
||||
+
|
||||
+CAMLprim value core_bigstring_test_allocation(value v_unit)
|
||||
+{
|
||||
+ int i;
|
||||
+ value v;
|
||||
+ v_unit = v_unit;
|
||||
+ for (i = 0; i < 20; i++) {
|
||||
+ v = caml_alloc_small(100, 0);
|
||||
+ }
|
||||
+ return v;
|
||||
+}
|
||||
diff -uNr core_kernel-113.33.01/src/core_array.ml core_kernel-113.33.01+4.03/src/core_array.ml
|
||||
--- core_kernel-113.33.01/src/core_array.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_array.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -937,7 +937,7 @@
|
||||
module Unsafe_blit = struct
|
||||
external unsafe_blit
|
||||
: src:t_ -> src_pos:int -> dst:t_ -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_int_blit" "noalloc"
|
||||
+ = "core_array_unsafe_int_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
include
|
||||
@@ -966,7 +966,7 @@
|
||||
module Unsafe_blit = struct
|
||||
external unsafe_blit
|
||||
: src:t_ -> src_pos:int -> dst:t_ -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_float_blit" "noalloc"
|
||||
+ = "core_array_unsafe_float_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
include
|
||||
@@ -1131,7 +1131,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:[> read] t -> src_pos:int -> dst:[> write] t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_int_blit" "noalloc"
|
||||
+ = "core_array_unsafe_int_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
module Float : sig
|
||||
@@ -1141,7 +1141,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:[> read] t -> src_pos:int -> dst:[> write] t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_float_blit" "noalloc"
|
||||
+ = "core_array_unsafe_float_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
val of_array_id : 'a array -> ('a, [< read_write]) t
|
||||
diff -uNr core_kernel-113.33.01/src/core_array.mli core_kernel-113.33.01+4.03/src/core_array.mli
|
||||
--- core_kernel-113.33.01/src/core_array.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_array.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -97,7 +97,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:t -> src_pos:int -> dst:t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_int_blit" "noalloc"
|
||||
+ = "core_array_unsafe_int_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
module Float : sig
|
||||
@@ -107,7 +107,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:t -> src_pos:int -> dst:t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_float_blit" "noalloc"
|
||||
+ = "core_array_unsafe_float_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
(** [Array.of_list l] returns a fresh array containing the elements of [l]. *)
|
||||
@@ -332,7 +332,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:[> read] t -> src_pos:int -> dst:[> write] t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_int_blit" "noalloc"
|
||||
+ = "core_array_unsafe_int_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
module Float : sig
|
||||
@@ -342,7 +342,7 @@
|
||||
|
||||
external unsafe_blit
|
||||
: src:[> read] t -> src_pos:int -> dst:[> write] t -> dst_pos:int -> len:int -> unit
|
||||
- = "core_array_unsafe_float_blit" "noalloc"
|
||||
+ = "core_array_unsafe_float_blit" [@@noalloc]
|
||||
end
|
||||
|
||||
(** [of_array_id] and [to_array_id] return the same underlying array. On the other
|
||||
diff -uNr core_kernel-113.33.01/src/core_gc.ml core_kernel-113.33.01+4.03/src/core_gc.ml
|
||||
--- core_kernel-113.33.01/src/core_gc.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_gc.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -83,6 +83,7 @@
|
||||
the first-fit policy, which can be slower in some cases but can be better for
|
||||
programs with fragmentation problems. Default: 0. *)
|
||||
mutable allocation_policy : int;
|
||||
+ window_size : int;
|
||||
} [@@deriving compare, bin_io, sexp, fields]
|
||||
end
|
||||
|
||||
@@ -91,7 +92,8 @@
|
||||
end
|
||||
|
||||
let tune ?logger ?minor_heap_size ?major_heap_increment ?space_overhead
|
||||
- ?verbose ?max_overhead ?stack_limit ?allocation_policy () =
|
||||
+ ?verbose ?max_overhead ?stack_limit ?allocation_policy
|
||||
+ ?window_size () =
|
||||
let module Field = Fieldslib.Field in
|
||||
let old_control_params = get () in
|
||||
let f opt to_string field =
|
||||
@@ -113,6 +115,7 @@
|
||||
~max_overhead: (f max_overhead string_of_int)
|
||||
~stack_limit: (f stack_limit string_of_int)
|
||||
~allocation_policy: (f allocation_policy string_of_int)
|
||||
+ ~window_size: (f window_size string_of_int)
|
||||
in
|
||||
set new_control_params
|
||||
;;
|
||||
@@ -141,14 +144,14 @@
|
||||
;;
|
||||
|
||||
external minor_words : unit -> int = "core_kernel_gc_minor_words"
|
||||
-external major_words : unit -> int = "core_kernel_gc_major_words" "noalloc"
|
||||
-external promoted_words : unit -> int = "core_kernel_gc_promoted_words" "noalloc"
|
||||
-external minor_collections : unit -> int = "core_kernel_gc_minor_collections" "noalloc"
|
||||
-external major_collections : unit -> int = "core_kernel_gc_major_collections" "noalloc"
|
||||
-external heap_words : unit -> int = "core_kernel_gc_heap_words" "noalloc"
|
||||
-external heap_chunks : unit -> int = "core_kernel_gc_heap_chunks" "noalloc"
|
||||
-external compactions : unit -> int = "core_kernel_gc_compactions" "noalloc"
|
||||
-external top_heap_words : unit -> int = "core_kernel_gc_top_heap_words" "noalloc"
|
||||
+external major_words : unit -> int = "core_kernel_gc_major_words" [@@noalloc]
|
||||
+external promoted_words : unit -> int = "core_kernel_gc_promoted_words" [@@noalloc]
|
||||
+external minor_collections : unit -> int = "core_kernel_gc_minor_collections" [@@noalloc]
|
||||
+external major_collections : unit -> int = "core_kernel_gc_major_collections" [@@noalloc]
|
||||
+external heap_words : unit -> int = "core_kernel_gc_heap_words" [@@noalloc]
|
||||
+external heap_chunks : unit -> int = "core_kernel_gc_heap_chunks" [@@noalloc]
|
||||
+external compactions : unit -> int = "core_kernel_gc_compactions" [@@noalloc]
|
||||
+external top_heap_words : unit -> int = "core_kernel_gc_top_heap_words" [@@noalloc]
|
||||
|
||||
external major_plus_minor_words : unit -> int = "core_kernel_gc_major_plus_minor_words"
|
||||
|
||||
diff -uNr core_kernel-113.33.01/src/core_gc.mli core_kernel-113.33.01+4.03/src/core_gc.mli
|
||||
--- core_kernel-113.33.01/src/core_gc.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_gc.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -148,6 +148,7 @@
|
||||
first-fit policy, which can be slower in some cases but
|
||||
can be better for programs with fragmentation problems.
|
||||
Default: 0. *)
|
||||
+ window_size : int;
|
||||
}
|
||||
[@@deriving bin_io, sexp, fields]
|
||||
|
||||
@@ -185,21 +186,21 @@
|
||||
(%r15 on x86-64) to the global variable [caml_young_ptr] before the C stub tries to
|
||||
read its value. *)
|
||||
external minor_words : unit -> int = "core_kernel_gc_minor_words"
|
||||
-external major_words : unit -> int = "core_kernel_gc_major_words" "noalloc"
|
||||
-external promoted_words : unit -> int = "core_kernel_gc_promoted_words" "noalloc"
|
||||
-external minor_collections : unit -> int = "core_kernel_gc_minor_collections" "noalloc"
|
||||
-external major_collections : unit -> int = "core_kernel_gc_major_collections" "noalloc"
|
||||
-external heap_words : unit -> int = "core_kernel_gc_heap_words" "noalloc"
|
||||
-external heap_chunks : unit -> int = "core_kernel_gc_heap_chunks" "noalloc"
|
||||
-external compactions : unit -> int = "core_kernel_gc_compactions" "noalloc"
|
||||
-external top_heap_words : unit -> int = "core_kernel_gc_top_heap_words" "noalloc"
|
||||
+external major_words : unit -> int = "core_kernel_gc_major_words" [@@noalloc]
|
||||
+external promoted_words : unit -> int = "core_kernel_gc_promoted_words" [@@noalloc]
|
||||
+external minor_collections : unit -> int = "core_kernel_gc_minor_collections" [@@noalloc]
|
||||
+external major_collections : unit -> int = "core_kernel_gc_major_collections" [@@noalloc]
|
||||
+external heap_words : unit -> int = "core_kernel_gc_heap_words" [@@noalloc]
|
||||
+external heap_chunks : unit -> int = "core_kernel_gc_heap_chunks" [@@noalloc]
|
||||
+external compactions : unit -> int = "core_kernel_gc_compactions" [@@noalloc]
|
||||
+external top_heap_words : unit -> int = "core_kernel_gc_top_heap_words" [@@noalloc]
|
||||
|
||||
(** This function returns [major_words () + minor_words ()]. It exists purely for speed
|
||||
(one call into C rather than two). Like [major_words] and [minor_words],
|
||||
[major_plus_minor_words] avoids allocating a [stat] record or a float, and may
|
||||
overflow on 32-bit machines.
|
||||
|
||||
- This function is not marked ["noalloc"] to ensure that the allocation pointer is
|
||||
+ This function is not marked [[@@noalloc]] to ensure that the allocation pointer is
|
||||
up-to-date when the minor-heap measurement is made.
|
||||
*)
|
||||
external major_plus_minor_words : unit -> int = "core_kernel_gc_major_plus_minor_words"
|
||||
@@ -256,6 +257,7 @@
|
||||
-> ?max_overhead : int
|
||||
-> ?stack_limit : int
|
||||
-> ?allocation_policy : int
|
||||
+ -> ?window_size : int
|
||||
-> unit
|
||||
-> unit
|
||||
|
||||
diff -uNr core_kernel-113.33.01/src/core_gc_stubs.c core_kernel-113.33.01+4.03/src/core_gc_stubs.c
|
||||
--- core_kernel-113.33.01/src/core_gc_stubs.c 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_gc_stubs.c 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -11,8 +11,8 @@
|
||||
|
||||
extern intnat caml_stat_minor_collections;
|
||||
extern intnat caml_stat_major_collections;
|
||||
-extern intnat caml_stat_heap_size;
|
||||
-extern intnat caml_stat_top_heap_size;
|
||||
+extern intnat caml_stat_heap_wsz;
|
||||
+extern intnat caml_stat_top_heap_wsz;
|
||||
extern intnat caml_stat_compactions;
|
||||
extern intnat caml_stat_heap_chunks;
|
||||
|
||||
@@ -54,7 +54,7 @@
|
||||
|
||||
CAMLprim value core_kernel_gc_heap_words(value unit __attribute__((unused)))
|
||||
{
|
||||
- return Val_long(caml_stat_heap_size / sizeof (value));
|
||||
+ return Val_long(caml_stat_heap_wsz);
|
||||
}
|
||||
|
||||
CAMLprim value core_kernel_gc_heap_chunks(value unit __attribute__((unused)))
|
||||
@@ -69,7 +69,7 @@
|
||||
|
||||
CAMLprim value core_kernel_gc_top_heap_words(value unit __attribute__((unused)))
|
||||
{
|
||||
- return Val_long(caml_stat_top_heap_size / sizeof (value));
|
||||
+ return Val_long(caml_stat_top_heap_wsz);
|
||||
}
|
||||
|
||||
CAMLprim value core_kernel_gc_major_plus_minor_words(value unit __attribute__((unused)))
|
||||
diff -uNr core_kernel-113.33.01/src/core_pervasives.mli core_kernel-113.33.01+4.03/src/core_pervasives.mli
|
||||
--- core_kernel-113.33.01/src/core_pervasives.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_pervasives.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -417,8 +417,8 @@
|
||||
zero. When [f] is non-zero, they are defined by
|
||||
[f = x *. 2 ** n] and [0.5 <= x < 1.0]. *)
|
||||
|
||||
-external ldexp : float -> int -> float = "caml_ldexp_float"
|
||||
- [@@deprecated "[since 2014-10] Use [Float]"]
|
||||
+external ldexp : (float [@unboxed]) -> (int [@untagged]) -> (float [@unboxed]) =
|
||||
+ "caml_ldexp_float" "caml_ldexp_float_unboxed" [@@noalloc]
|
||||
(** [ldexp x n] returns [x *. 2 ** n]. *)
|
||||
|
||||
external modf : float -> float * float = "caml_modf_float"
|
||||
@@ -480,7 +480,8 @@
|
||||
(** The five classes of floating-point numbers, as determined by
|
||||
the {!Pervasives.classify_float} function. *)
|
||||
|
||||
-external classify_float : float -> fpclass = "caml_classify_float"
|
||||
+external classify_float : (float [@unboxed]) -> fpclass =
|
||||
+ "caml_classify_float" "caml_classify_float_unboxed" [@@noalloc]
|
||||
[@@deprecated "[since 2014-10] Use [Float]"]
|
||||
(** Return the class of the given floating-point number:
|
||||
normal, subnormal, zero, infinite, or not a number. *)
|
||||
@@ -953,6 +954,10 @@
|
||||
Equivalent to [fun r -> r := pred !r]. *)
|
||||
|
||||
|
||||
+(* Result type *)
|
||||
+
|
||||
+type ('a,'b) result = ('a, 'b) Pervasives.result = Ok of 'a | Error of 'b
|
||||
+
|
||||
(** {6 Operations on format strings} *)
|
||||
|
||||
(** Format strings are character strings with special lexical conventions
|
||||
@@ -1054,7 +1059,6 @@
|
||||
[f1], then results from [f2].
|
||||
*)
|
||||
|
||||
-
|
||||
(** {6 Program termination} *)
|
||||
|
||||
val exit : int -> 'a
|
||||
diff -uNr core_kernel-113.33.01/src/core_string.ml core_kernel-113.33.01+4.03/src/core_string.ml
|
||||
--- core_kernel-113.33.01/src/core_string.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_string.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -949,7 +949,7 @@
|
||||
divergence is to expose the macro redefined in hash_stubs.c in the hash.h header of
|
||||
the OCaml compiler.) *)
|
||||
module Hash = struct
|
||||
- external hash : string -> int = "caml_hash_string" "noalloc"
|
||||
+ external hash : string -> int = "caml_hash_string" [@@noalloc]
|
||||
|
||||
let%test_unit _ =
|
||||
List.iter ~f:(fun string -> assert (hash string = Caml.Hashtbl.hash string))
|
||||
diff -uNr core_kernel-113.33.01/src/core_string.mli core_kernel-113.33.01+4.03/src/core_string.mli
|
||||
--- core_kernel-113.33.01/src/core_string.mli 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/core_string.mli 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -269,7 +269,7 @@
|
||||
val concat_array : ?sep : t -> t array -> t
|
||||
|
||||
(** slightly faster hash function on strings *)
|
||||
-external hash : t -> int = "caml_hash_string" "noalloc"
|
||||
+external hash : t -> int = "caml_hash_string" [@@noalloc]
|
||||
|
||||
(** fast equality function on strings, doesn't use compare_val *)
|
||||
val equal : t -> t -> bool
|
||||
diff -uNr core_kernel-113.33.01/src/exn.ml core_kernel-113.33.01+4.03/src/exn.ml
|
||||
--- core_kernel-113.33.01/src/exn.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/exn.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -112,7 +112,8 @@
|
||||
try func () with
|
||||
| exn -> raise (Reraised (str, exn))
|
||||
|
||||
-external clear_backtrace : unit -> unit = "clear_caml_backtrace_pos" "noalloc"
|
||||
+external clear_backtrace : unit -> unit = "clear_caml_backtrace_pos" [@@noalloc]
|
||||
+
|
||||
let raise_without_backtrace e =
|
||||
(* We clear the backtrace to reduce confusion, so that people don't think whatever
|
||||
is stored corresponds to this raise. *)
|
||||
diff -uNr core_kernel-113.33.01/src/float.ml core_kernel-113.33.01+4.03/src/float.ml
|
||||
--- core_kernel-113.33.01/src/float.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/float.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -15,7 +15,7 @@
|
||||
type t = float [@@deriving sexp, bin_io, typerep]
|
||||
let compare (x : t) y = compare x y
|
||||
let equal (x : t) y = x = y
|
||||
- external hash : float -> int = "caml_hash_double" "noalloc"
|
||||
+ external hash : float -> int = "caml_hash_double" [@@noalloc]
|
||||
|
||||
let%test_unit _ =
|
||||
List.iter ~f:(fun float -> assert (hash float = Caml.Hashtbl.hash float))
|
||||
@@ -381,6 +381,7 @@
|
||||
else
|
||||
invalid_argf "Float.iround_up_exn: argument (%f) is too small or NaN" (box t) ()
|
||||
end
|
||||
+[@@ocaml.inline always]
|
||||
|
||||
let iround_down t =
|
||||
if t >= 0.0 then begin
|
||||
@@ -409,6 +410,7 @@
|
||||
else
|
||||
invalid_argf "Float.iround_down_exn: argument (%f) is too small or NaN" (box t) ()
|
||||
end
|
||||
+[@@ocaml.inline always]
|
||||
|
||||
let iround_towards_zero t =
|
||||
if t >= iround_lbound && t <= iround_ubound then
|
||||
@@ -481,6 +483,7 @@
|
||||
else
|
||||
invalid_argf "Float.iround_nearest_exn: argument (%f) is too small or NaN" (box t)
|
||||
()
|
||||
+[@@ocaml.inline always]
|
||||
|
||||
(* The following [iround_exn] and [iround] functions are slower than the ones above.
|
||||
Their equivalence to those functions is tested in the unit tests below. *)
|
||||
diff -uNr core_kernel-113.33.01/src/heap_block.ml core_kernel-113.33.01+4.03/src/heap_block.ml
|
||||
--- core_kernel-113.33.01/src/heap_block.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/heap_block.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -1,6 +1,6 @@
|
||||
type 'a t = 'a [@@deriving sexp_of]
|
||||
|
||||
-external is_heap_block : Obj.t -> bool = "core_heap_block_is_heap_block" "noalloc"
|
||||
+external is_heap_block : Obj.t -> bool = "core_heap_block_is_heap_block" [@@noalloc]
|
||||
|
||||
let is_ok v = is_heap_block (Obj.repr v)
|
||||
|
||||
diff -uNr core_kernel-113.33.01/src/int_math.ml core_kernel-113.33.01+4.03/src/int_math.ml
|
||||
--- core_kernel-113.33.01/src/int_math.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/int_math.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -8,7 +8,7 @@
|
||||
Core_printf.invalid_argf "integer overflow in pow" ()
|
||||
|
||||
(* To implement [int64_pow], we use C code rather than OCaml to eliminate allocation. *)
|
||||
-external int_math_int_pow : int -> int -> int = "int_math_int_pow_stub" "noalloc"
|
||||
+external int_math_int_pow : int -> int -> int = "int_math_int_pow_stub" [@@noalloc]
|
||||
external int_math_int64_pow : int64 -> int64 -> int64 = "int_math_int64_pow_stub"
|
||||
|
||||
let int_pow base exponent =
|
||||
diff -uNr core_kernel-113.33.01/src/META core_kernel-113.33.01+4.03/src/META
|
||||
--- core_kernel-113.33.01/src/META 2016-03-22 11:43:53.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/META 2016-03-22 17:51:34.000000000 +0100
|
||||
@@ -1,6 +1,6 @@
|
||||
# OASIS_START
|
||||
-# DO NOT EDIT (digest: decb3f50ccea06803a171b5aba7b36dd)
|
||||
-version = "113.33.01"
|
||||
+# DO NOT EDIT (digest: f5e86cbda47f50180165621f5cbe2d8d)
|
||||
+version = "113.33.01+4.03"
|
||||
description = "Industrial strength alternative to OCaml's standard library"
|
||||
requires =
|
||||
"bin_prot fieldslib num ppx_assert.runtime-lib ppx_bench.runtime-lib ppx_expect.collector ppx_inline_test.runtime-lib result sexplib typerep variantslib"
|
||||
diff -uNr core_kernel-113.33.01/src/obj_array.ml core_kernel-113.33.01+4.03/src/obj_array.ml
|
||||
--- core_kernel-113.33.01/src/obj_array.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/obj_array.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -33,16 +33,22 @@
|
||||
|
||||
let empty = [||]
|
||||
|
||||
+type not_a_float = Not_a_float_0 | Not_a_float_1 of int
|
||||
+let _not_a_float_0 = Not_a_float_0
|
||||
+let _not_a_float_1 = Not_a_float_1 42
|
||||
+
|
||||
let get t i =
|
||||
- (* Make the compiler believe [a] is an integer array so it does not check if [a] is
|
||||
- tagged with [Double_array_tag]. *)
|
||||
- Obj.repr (Array.get (Obj.magic (t : t) : int array) i : int)
|
||||
+ (* Make the compiler believe [a] is an array not containing floats so it does not
|
||||
+ check if [a] is tagged with [Double_array_tag]. It is NOT ok to use "int array"
|
||||
+ since (if this function is inlined and the array contains in-heap boxed values)
|
||||
+ wrong register typing may result, leading to a failure to register necessary
|
||||
+ GC roots. *)
|
||||
+ Obj.repr (Array.get (Obj.magic (t : t) : not_a_float array) i : not_a_float)
|
||||
;;
|
||||
|
||||
let unsafe_get t i =
|
||||
- (* Make the compiler believe [a] is an integer array so it does not check if [a] is
|
||||
- tagged with [Double_array_tag]. *)
|
||||
- Obj.repr (Array.unsafe_get (Obj.magic (t : t) : int array) i : int)
|
||||
+ (* See comment on [get]. *)
|
||||
+ Obj.repr (Array.unsafe_get (Obj.magic (t : t) : not_a_float array) i : not_a_float)
|
||||
;;
|
||||
|
||||
(* For [set] and [unsafe_set], if a pointer is involved, we first do a physical-equality
|
||||
diff -uNr core_kernel-113.33.01/src/time_ns.ml core_kernel-113.33.01+4.03/src/time_ns.ml
|
||||
--- core_kernel-113.33.01/src/time_ns.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/time_ns.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -419,7 +419,7 @@
|
||||
|
||||
#if JSC_ARCH_SIXTYFOUR
|
||||
external since_unix_epoch_or_zero : unit -> t
|
||||
- = "core_kernel_time_ns_gettime_or_zero" "noalloc"
|
||||
+ = "core_kernel_time_ns_gettime_or_zero" [@@noalloc]
|
||||
#else
|
||||
external since_unix_epoch_or_zero : unit -> t
|
||||
= "core_kernel_time_ns_gettime_or_zero"
|
||||
diff -uNr core_kernel-113.33.01/src/type_equal.ml core_kernel-113.33.01+4.03/src/type_equal.ml
|
||||
--- core_kernel-113.33.01/src/type_equal.ml 2016-03-22 11:37:07.000000000 +0100
|
||||
+++ core_kernel-113.33.01+4.03/src/type_equal.ml 2016-03-22 15:15:54.000000000 +0100
|
||||
@@ -64,7 +64,8 @@
|
||||
type _ t = ..
|
||||
|
||||
let sexp_of_t _sexp_of_a t =
|
||||
- (`type_witness (Obj.extension_id t)) |> [%sexp_of: [ `type_witness of int ]]
|
||||
+ (`type_witness (Obj.extension_id (Obj.extension_constructor t)))
|
||||
+ |> [%sexp_of: [ `type_witness of int ]]
|
||||
;;
|
||||
end
|
||||
|
||||
@@ -87,7 +88,8 @@
|
||||
(module M : S with type t = t)
|
||||
;;
|
||||
|
||||
- let uid (type a) (module M : S with type t = a) = Obj.extension_id M.Key
|
||||
+ let uid (type a) (module M : S with type t = a) =
|
||||
+ Obj.extension_id (Obj.extension_constructor M.Key)
|
||||
|
||||
(* We want a constant allocated once that [same] can return whenever it gets the same
|
||||
witnesses. If we write the constant inside the body of [same], the native-code
|
||||
@ -0,0 +1,24 @@
|
||||
commit 926305bb6fc95494064e75ceafc6443b62d3773b
|
||||
Author: Vasilis Papavasileiou <git@vasilis.airpost.net>
|
||||
Date: Tue Mar 29 15:42:38 2016 +0200
|
||||
|
||||
Fix DELETE_RULE for 4.03 (nonrec flag)
|
||||
|
||||
diff --git a/syntax/std/pa_deriving_std.ml b/syntax/std/pa_deriving_std.ml
|
||||
index 1ec000c..dde8d9e 100644
|
||||
--- a/syntax/std/pa_deriving_std.ml
|
||||
+++ b/syntax/std/pa_deriving_std.ml
|
||||
@@ -18,8 +18,13 @@ struct
|
||||
open Camlp4.PreCast
|
||||
include Syntax
|
||||
|
||||
+#if ocaml_version >= (4, 03)
|
||||
+ DELETE_RULE Gram str_item: "type"; opt_nonrec; type_declaration END
|
||||
+ DELETE_RULE Gram sig_item: "type"; opt_nonrec; type_declaration END
|
||||
+#else
|
||||
DELETE_RULE Gram str_item: "type"; type_declaration END
|
||||
DELETE_RULE Gram sig_item: "type"; type_declaration END
|
||||
+#endif
|
||||
|
||||
open Ast
|
||||
|
||||
@ -0,0 +1 @@
|
||||
DIST js-build-tools-113.33.03.tar.gz 52884 SHA256 eb3e7a444bde32c20d910be4da774200f12dd01b157533de903409c3d0cb013a SHA512 4c5c6a7d98977900e130607fc2ce2aee683a0f73f2bc559078aaf0df35815d670be55bb429892238ba3d10f655d300d031b3b1d20a0717426c15292e5aeebf66 WHIRLPOOL f8e8e0d053d36681f69a587a6dfc011c7c559069a8b73eec7567777e10c1f41b8c98102f991ea74799e27340b8f72b8ac9c25ed3488c40ca2953517a8e10e5aa
|
||||
@ -0,0 +1,40 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
|
||||
OASIS_BUILD_DOCS=1
|
||||
OASIS_BUILD_TESTS=1
|
||||
|
||||
inherit oasis
|
||||
|
||||
DESCRIPTION="Collection of tools to help building Jane Street Packages"
|
||||
HOMEPAGE="https://github.com/janestreet/js-build-tools"
|
||||
SRC_URI="http://ocaml.janestreet.com/ocaml-core/${PV%.*}/files/${P}.tar.gz"
|
||||
|
||||
LICENSE="Apache-2.0"
|
||||
SLOT="0/${PV}"
|
||||
KEYWORDS="~amd64"
|
||||
IUSE=""
|
||||
|
||||
RDEPEND=""
|
||||
DEPEND="${RDEPEND} dev-ml/opam"
|
||||
|
||||
src_configure() {
|
||||
emake setup.exe
|
||||
OASIS_SETUP_COMMAND="./setup.exe" oasis_src_configure
|
||||
}
|
||||
|
||||
src_compile() {
|
||||
emake
|
||||
}
|
||||
|
||||
src_install() {
|
||||
opam-installer -i \
|
||||
--prefix="${ED}/usr" \
|
||||
--libdir="${D}/$(ocamlc -where)" \
|
||||
--docdir="${ED}/usr/share/doc/${PF}" \
|
||||
${PN}.install || die
|
||||
dodoc README.md
|
||||
}
|
||||
@ -0,0 +1,11 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE pkgmetadata SYSTEM "http://www.gentoo.org/dtd/metadata.dtd">
|
||||
<pkgmetadata>
|
||||
<maintainer type="project">
|
||||
<email>ml@gentoo.org</email>
|
||||
<name>Gentoo ML Project</name>
|
||||
</maintainer>
|
||||
<upstream>
|
||||
<remote-id type="bitbucket">yminsky/ocaml-core</remote-id>
|
||||
</upstream>
|
||||
</pkgmetadata>
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,2 +1,3 @@
|
||||
DIST lwt-2.4.3.tar.gz 504000 SHA256 efee23937750290d6dee96eed6c0bbdb19817d5be6eefcba61ac5031fac10107 SHA512 725d50a096a43294d49ae2322fdc985c301ce6a8ff5c956925225d7977e787ccb446e36a9db5fdbb50f284b9f1a3a12a52d1aa44d4400feecb59f6f938ed00ad WHIRLPOOL c5999e950008902600b43bf39f174ed0bc2cb3f6dce983d885416969a3bb98170ec8b74c8f5829459c3c96d160e5b4c8491b7057e7efeac035a46c9846ff7764
|
||||
DIST lwt-2.5.1.tar.gz 1272834 SHA256 351ea57e30cdeeebb02ae3b12906ed391f947fd35d57148905828ee121ec29ec SHA512 648f08e13a5b13072ed44ec380cce226bbf2ac480ca6adcd170e5bfa789bf6a4e832af0748bb1bff0e45611fd8d1b14592ece4211fb78be5b03cbcd7c3cb3b7d WHIRLPOOL c89ff1cd278ca194e1edf11ee447466dfd90f1bae4c79967e296c73cecf6684f017f8873a9f8cd6c367e83d1acfbd65ccc021edc1a7efc01432207e171f8e9dd
|
||||
DIST lwt-2.5.2.tar.gz 268168 SHA256 b319514cf51656780a8f609a63ead08d3052a442546b218530ce146d37bf6331 SHA512 83c7a9d9798fe12e0bdd618e7f69ac357065a9b26e2abb644240c420cb1d507a3b558549b2f82ecc9c3fbc9ca5952e8d7cb32b6832713bfb6fffcb58975d5449 WHIRLPOOL f0482836988a248b691c332ef7acbeb5121226582cb8ef1e0b301719d35e25fd5d08e6b7b9e9ab02081b4d734ddc399251a31b66a26859542a4484342e517257
|
||||
|
||||
@ -0,0 +1,42 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
|
||||
OASIS_BUILD_TESTS=1
|
||||
# fails to build
|
||||
#OASIS_BUILD_DOCS=1
|
||||
|
||||
inherit oasis
|
||||
|
||||
DESCRIPTION="Cooperative light-weight thread library for OCaml"
|
||||
SRC_URI="https://github.com/ocsigen/lwt/archive/${PV}.tar.gz -> ${P}.tar.gz"
|
||||
HOMEPAGE="http://ocsigen.org/lwt"
|
||||
|
||||
IUSE="gtk +ppx +react +ssl"
|
||||
|
||||
DEPEND="react? ( >=dev-ml/react-1.2:= )
|
||||
dev-libs/libev
|
||||
ssl? ( >=dev-ml/ocaml-ssl-0.4.0:= )
|
||||
gtk? ( dev-ml/lablgtk:= dev-libs/glib:2 )
|
||||
ppx? ( dev-ml/ppx_tools:= )
|
||||
|| ( dev-ml/camlp4:= <dev-lang/ocaml-4.02.0 )"
|
||||
|
||||
RDEPEND="${DEPEND}
|
||||
!<www-servers/ocsigen-1.1"
|
||||
|
||||
SLOT="0/${PV}"
|
||||
LICENSE="LGPL-2.1-with-linking-exception"
|
||||
KEYWORDS="~amd64 ~x86-fbsd"
|
||||
|
||||
DOCS=( "CHANGES" "README.md" )
|
||||
|
||||
src_configure() {
|
||||
oasis_configure_opts="$(use_enable gtk glib)
|
||||
$(use_enable react)
|
||||
$(use_enable ssl)
|
||||
--enable-camlp4
|
||||
$(use_enable ppx)" \
|
||||
oasis_src_configure
|
||||
}
|
||||
@ -1,3 +1,4 @@
|
||||
DIST ocaml-cstruct-1.7.1.tar.gz 245894 SHA256 7869d096fe7c6231bbceefe3b2205417b28b6c10f4174b7e2cfdfa46956eaaa5 SHA512 67dd276ab2f895ef80cc7ba5b48d51bcfcf52ac49aa29cd4b17aa00be109198347a50229b81fbe506d831ace753d72f3b4bb80f19e8e57fa29d9ba65da472f19 WHIRLPOOL 8145930a1dcadbcf48c1da0dcba10a45f3d52c8ae2565aee7e609bd3eeb5eead9cee9ef423332a580ab77ceabb2f301917226d1a73e1b7f6efc7a3096c4112d6
|
||||
DIST ocaml-cstruct-1.8.0.tar.gz 250696 SHA256 e1635072283ae5db7889966ce92e916749bcd192012a0c46285827beba1263d7 SHA512 38ea6301b48603f8b63c73a7aa42312d25bbd16fb8524e1de2b69a54e45e9e1c1326201e19fcf2953d2719607139c903d76296a32fb7058998c079ac112adc9c WHIRLPOOL 6fdabfc1143331662757826de11c62c3947fb59155ba68e866a2f9939963deacd52d5832417997833deff9a9ff902675d266a98b41e0d2cf9f29c4d4c628601e
|
||||
DIST ocaml-cstruct-1.9.0.tar.gz 254162 SHA256 2d175bf1e2cdc5ca43cb30bd3fa507beee2f18b2cbecae801ab6ffaecde16c9c SHA512 fad3788c0888599a3171d4062b9d9f4c539c0cbb1d8b6d4f6be2f3456ffe235444def4e619a94ca75336cf555b5133e6e60edc07a03dc0abdd772acf9371b666 WHIRLPOOL 99984c32625d9dbf452a7191f4103228bedbd7eee23bfb1eee7834022a023dee1582fca9704fcbe09ed37424ca7d684c482426d3b30b5f1dc66cc55b78769532
|
||||
DIST ocaml-cstruct-2.0.0.tar.gz 250245 SHA256 285341c6b5bdfc456f2b63c072210771aeb7110d777bbdaec5087234a505acf5 SHA512 4fc1f09824bf943c45a2afe8908d80fb3d9857f5e9f426479520713c92c04eac588a38fbf036352a17e787165476a7a5647f34df9c89f6c93a195f80ae11c3dd WHIRLPOOL ef8c3770ed73323c292152b5b29b8b0737158b84f0f738ac0841257e07d787edf5e0c7c55c0d5630c7f44fcd878d00585e320b12d9ece22a98a906cc7e86c08c
|
||||
|
||||
@ -0,0 +1,43 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
OASIS_BUILD_DOCS=1
|
||||
OASIS_BUILD_TESTS=1
|
||||
|
||||
inherit oasis
|
||||
|
||||
DESCRIPTION="Map OCaml arrays onto C-like structs"
|
||||
HOMEPAGE="https://github.com/mirage/ocaml-cstruct https://mirage.io"
|
||||
SRC_URI="https://github.com/mirage/${PN}/archive/v${PV}.tar.gz -> ${P}.tar.gz"
|
||||
|
||||
LICENSE="ISC"
|
||||
SLOT="0/${PV}"
|
||||
KEYWORDS="~amd64"
|
||||
IUSE="async +lwt +ppx"
|
||||
|
||||
RDEPEND="
|
||||
async? ( dev-ml/async:= )
|
||||
lwt? ( dev-ml/lwt:= )
|
||||
ppx? ( dev-ml/ppx_tools:= )
|
||||
>=dev-lang/ocaml-4.01:=
|
||||
dev-ml/ocplib-endian:=
|
||||
dev-ml/sexplib:=
|
||||
dev-ml/type-conv:=
|
||||
"
|
||||
DEPEND="
|
||||
test? ( dev-ml/ounit )
|
||||
${RDEPEND}
|
||||
"
|
||||
|
||||
src_configure() {
|
||||
oasis_configure_opts="
|
||||
$(use_enable lwt)
|
||||
$(use_enable async)
|
||||
$(use_enable ppx)
|
||||
--enable-unix
|
||||
" oasis_src_configure
|
||||
}
|
||||
|
||||
DOCS=( CHANGES README.md TODO.md )
|
||||
@ -1,3 +1,4 @@
|
||||
DIST ocaml-ctypes-0.4.1.tar.gz 162601 SHA256 74564e049de5d3c0e76ea284c225cb658ac1a2b483345be1efb9be4b3c1702f5 SHA512 8155ffe16a58d5714ceb602afa5531c93526defca39a16047328ac06d2c7c7f52b768b18170391f467e1f6919c69275734faf85d27315e11b8bbefcb1bc8afa9 WHIRLPOOL d8d0ef24e0b6c40f50fddf38fed7238cf95573909d2809cc2ab5c1b9b3dab333210e1ce99cf805804576a79d08d819e2ecdee7b4a6a9e13efb13e7b9f88ad802
|
||||
DIST ocaml-ctypes-0.4.2.tar.gz 162968 SHA256 704efcbf3b99c180855ad4faed0dd7cec4f2384f9b8963b572329697be8cbae4 SHA512 78e51a4ea35efd6d854b81c65d3e224175927a3c87b9b665d173cefeb3f424e1ed8fc8dfbbb4ce33b4bc43163ecf647ba9b502e69c82eb05ddcde66b8d6c99e4 WHIRLPOOL 124c6f91ae1ae980994f8cca483a2090c60b62864abe8d4b9aac725b2131f331d385a6a1e5b7685e4f61ac4e3e53cb22ac0cad9b32ebefa444d2ef00e15f7caa
|
||||
DIST ocaml-ctypes-0.5.0.tar.gz 168414 SHA256 d15df8a065b5b9850400727c0e5cb4eb8ad567c3504278b03065cc766b57bf3e SHA512 0d59b6aec0421e7eb79792bfd02a8f77311bca1787f7b17af0eca4fdaa82a55d27de24bc2c6fa937e3c2b86585cd496d929a7490165e27c49da360e6efd3d67d WHIRLPOOL a84b3d14437cf8a47d09d15a3af67b48ed57a147e09d12f93711102879b2962fbe7b4ea1c327e92da262334bed40d8175c9dd18902f8bc4a19f552b97406fd15
|
||||
DIST ocaml-ctypes-0.5.1.tar.gz 168540 SHA256 51da7276abccb274fd09fda9d024a3469b819d534492afe9c8d549dd953114ec SHA512 03a67c6b995b87c229b04577d2f38a8d699223d5c44c4597e6ac5ff1d74bc22474aea248e9b54d913b83a99ac7ccc61c7c67ca288e4f41b71a63da683b085331 WHIRLPOOL 0eed3a97a7c0fdf568d97b07718171f140aed34d440fa55bb8d21380dddba2f52fa2c3bf61d044da24cd30479c0bdea23bd23b86997adbc14a99bd630fc1ee17
|
||||
|
||||
@ -0,0 +1,36 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
|
||||
inherit findlib
|
||||
|
||||
DESCRIPTION="Library for binding to C libraries using pure OCaml"
|
||||
HOMEPAGE="https://github.com/ocamllabs/ocaml-ctypes"
|
||||
SRC_URI="https://github.com/ocamllabs/ocaml-ctypes/archive/${PV}.tar.gz -> ${P}.tar.gz"
|
||||
|
||||
LICENSE="MIT"
|
||||
SLOT="0/${PV}"
|
||||
KEYWORDS="~amd64 ~arm ~x86"
|
||||
IUSE="test"
|
||||
|
||||
RDEPEND="
|
||||
>=dev-lang/ocaml-4.02:=[ocamlopt]
|
||||
virtual/libffi
|
||||
"
|
||||
DEPEND="${RDEPEND}
|
||||
test? ( dev-ml/ounit )"
|
||||
|
||||
src_compile() {
|
||||
emake -j1
|
||||
}
|
||||
|
||||
src_test() {
|
||||
emake -j1 test
|
||||
}
|
||||
|
||||
src_install() {
|
||||
findlib_src_install
|
||||
dodoc CHANGES.md README.md
|
||||
}
|
||||
@ -0,0 +1,12 @@
|
||||
Index: ocaml-gettext-0.3.5/ocaml-gettext/Makefile
|
||||
===================================================================
|
||||
--- ocaml-gettext-0.3.5.orig/ocaml-gettext/Makefile
|
||||
+++ ocaml-gettext-0.3.5/ocaml-gettext/Makefile
|
||||
@@ -64,7 +64,6 @@ uninstall: ocaml-xgettext-uninstall
|
||||
ocaml-xgettext: $(BUILDBIN)
|
||||
$(OCAMLC) \
|
||||
-I +camlp4 dynlink.cma camlp4lib.cma \
|
||||
- unix.cma \
|
||||
`$(OCAMLFIND) query -r -predicates byte gettext.extract -i-format` \
|
||||
`$(OCAMLFIND) query -r -predicates byte gettext.extract -a-format` \
|
||||
`$(OCAMLFIND) query -r -predicates byte gettext.extract -o-format` \
|
||||
@ -0,0 +1,37 @@
|
||||
Index: ocaml-mysql-1.2.0/mysql_stubs.c
|
||||
===================================================================
|
||||
--- ocaml-mysql-1.2.0.orig/mysql_stubs.c
|
||||
+++ ocaml-mysql-1.2.0/mysql_stubs.c
|
||||
@@ -508,14 +508,14 @@ db_fetch (value result)
|
||||
|
||||
EXTERNAL value
|
||||
db_to_row(value result, value offset) {
|
||||
- int64 off = Int64_val(offset);
|
||||
+ int64_t off = Int64_val(offset);
|
||||
MYSQL_RES *res;
|
||||
|
||||
res = RESval(result);
|
||||
if (!res)
|
||||
mysqlfailwith("Mysql.to_row: result did not return fetchable data");
|
||||
|
||||
- if (off < 0 || off > (int64)mysql_num_rows(res)-1)
|
||||
+ if (off < 0 || off > (int64_t)mysql_num_rows(res)-1)
|
||||
invalid_argument("Mysql.to_row: offset out of range");
|
||||
|
||||
mysql_data_seek(res, off);
|
||||
@@ -640,13 +640,13 @@ db_size(value result)
|
||||
{
|
||||
CAMLparam1(result);
|
||||
MYSQL_RES *res;
|
||||
- int64 size;
|
||||
+ int64_t size;
|
||||
|
||||
res = RESval(result);
|
||||
if (!res)
|
||||
size = 0;
|
||||
else
|
||||
- size = (int64)(mysql_num_rows(res));
|
||||
+ size = (int64_t)(mysql_num_rows(res));
|
||||
|
||||
CAMLreturn(copy_int64(size));
|
||||
}
|
||||
@ -1 +1,2 @@
|
||||
DIST ocaml-pcap-0.3.3.tar.gz 45752 SHA256 9419a1701310b2d9130be3d305a6e2cb0cb2c8da0348a6c9fc49bbe2a5d6ae76 SHA512 732f895c08b114aef34ea3b776c69d67696e290f2a2952405b75097ce0253fcc8a754dd223ac4ce98b134786f46c328cc2510f7313c4c8c4042d242a1a4de8a1 WHIRLPOOL 0a39017e791e1031b0f1500e3f9eb055db66dda3c35c0ba027f579f4a3066c824bb066733cce9ab07e37e679694bc909ef0b3c812b71570a1563e5a28121b00d
|
||||
DIST ocaml-pcap-0.4.0.tar.gz 52694 SHA256 abf4cd0da26ae70de26c7b395d53b1983ab4c9ab7f81322a1df56c039a373e6a SHA512 cbcd33d7a557f1a05e5f12013e8dbe226a81a64822689452614dffedeecf8641ce2498e9c9322f80066977ef56a4130ee016816911b6871609d11a988cfcad0e WHIRLPOOL 0b87ede6a7740dec323f8a5592e69f55af0dcd825cdfed4d9834a3d0059f7d5c90c6036e84e23d375f282454e4901dd2b0dbda2e4c854711a6999604ccb80a27
|
||||
|
||||
@ -0,0 +1,34 @@
|
||||
# Copyright 1999-2015 Gentoo Foundation
|
||||
# Distributed under the terms of the GNU General Public License v2
|
||||
# $Id$
|
||||
|
||||
EAPI=5
|
||||
OASIS_BUILD_DOCS=1
|
||||
OASIS_BUILD_TESTS=1
|
||||
|
||||
inherit oasis
|
||||
|
||||
DESCRIPTION="Read and write pcap-formatted network packet traces."
|
||||
HOMEPAGE="https://github.com/mirage/ocaml-pcap https://mirage.io"
|
||||
SRC_URI="https://github.com/mirage/${PN}/archive/v${PV}.tar.gz -> ${P}.tar.gz"
|
||||
|
||||
LICENSE="ISC"
|
||||
SLOT="0/${PV}"
|
||||
KEYWORDS="~amd64"
|
||||
IUSE=""
|
||||
|
||||
# Blockers taken from opam file and only relevant
|
||||
# if MirageOS should enter portage.
|
||||
RDEPEND="
|
||||
dev-ml/ocaml-ipaddr:=
|
||||
!dev-ml/mirage-net-socket
|
||||
!<dev-ml/mirage-0.9.2
|
||||
>=dev-ml/ocaml-cstruct-0.6.0:=[ppx(-)]
|
||||
"
|
||||
DEPEND="
|
||||
test? ( dev-ml/ounit
|
||||
>=dev-ml/lwt-2.4.0 )
|
||||
${RDEPEND}
|
||||
"
|
||||
|
||||
DOCS=( CHANGES MAINTAINERS README.md )
|
||||
@ -1 +1 @@
|
||||
DIST ocamlbuild-0.9.1.tar.gz 160896 SHA256 7a31fde2d863768372851665e3ce64064c35e38d2b2f3cbd060a6df426f16ee8 SHA512 07da313f896fd31fab42881515f33544a587f831aa0928540af2351bf8d59b14115a144b17d156cb2599ce5d568684192a922f9f85f86ddd7299b8e194fd85c6 WHIRLPOOL f28e3ce19371dc26d6992035e47a72cb82adde2869dd5188a8ea0ed6aee481633e0ada4ec28428a2f58e51582f60c3a486066d0f7e09dda4e8c374f977f420a8
|
||||
DIST ocamlbuild-0.9.2.tar.gz 163014 SHA256 257a3961da1aa47deb3de8da238ebe1daf13a73efef2228f97a064a90f91c6bc SHA512 6f6fa2ca0030256b61a9f93275f26327a032594a1ddd288e1eb9f4c41dfc139e4cdb6cd66ae8e383dd2f8aabb435181abfbf6b4aa0892ef6fa420c29e33b391a WHIRLPOOL 4b1285a3177787c9d4d1e4581dec4079a1144568512c8871b2ed9436bea941c9447130af616c418d7c18157f0818de26f6344635c7e63e4ec13acaa5229cf77a
|
||||
|
||||
@ -1,13 +0,0 @@
|
||||
Index: ocamlbuild-0.9.1/Makefile
|
||||
===================================================================
|
||||
--- ocamlbuild-0.9.1.orig/Makefile
|
||||
+++ ocamlbuild-0.9.1/Makefile
|
||||
@@ -202,7 +202,7 @@ beforedepend:: src/ocamlbuild_config.ml
|
||||
install-bin-byte:
|
||||
mkdir -p $(INSTALL_BINDIR)
|
||||
$(CP) ocamlbuild.byte $(INSTALL_BINDIR)/ocamlbuild.byte$(EXE)
|
||||
-ifeq ($(OCAML_NATIVE), true)
|
||||
+ifneq ($(OCAML_NATIVE), true)
|
||||
$(CP) ocamlbuild.byte $(INSTALL_BINDIR)/ocamlbuild$(EXE)
|
||||
endif
|
||||
|
||||
@ -0,0 +1,84 @@
|
||||
commit 0893920618cec4885b1633fd2f81de84e7a8be72
|
||||
Author: Gerd Stolpmann <gerd@gerd-stolpmann.de>
|
||||
Date: Sun May 1 13:24:22 2016 +0200
|
||||
|
||||
Fixes for building against OCaml-4.03
|
||||
|
||||
diff --git a/code/src/equeue/uq_engines_compat.ml b/code/src/equeue/uq_engines_compat.ml
|
||||
index 512811a..e779410 100644
|
||||
--- a/code/src/equeue/uq_engines_compat.ml
|
||||
+++ b/code/src/equeue/uq_engines_compat.ml
|
||||
@@ -7,7 +7,8 @@ class type server_socket_acceptor = server_endpoint_acceptor
|
||||
class type client_socket_connector = client_endpoint_connector
|
||||
|
||||
|
||||
-exception Mem_not_supported = Uq_multiplex.Mem_not_supported
|
||||
+(* exception Mem_not_supported = Uq_multiplex.Mem_not_supported *)
|
||||
+(* already included from Uq_engines *)
|
||||
|
||||
let create_multiplex_controller_for_connected_socket =
|
||||
Uq_multiplex.create_multiplex_controller_for_connected_socket
|
||||
diff --git a/code/src/netstring/netasn1.ml b/code/src/netstring/netasn1.ml
|
||||
index 05d5d3a..4cada35 100644
|
||||
--- a/code/src/netstring/netasn1.ml
|
||||
+++ b/code/src/netstring/netasn1.ml
|
||||
@@ -437,7 +437,7 @@ module Value = struct
|
||||
let hour = int_of_string (Netstring_str.matched_group m 4 s) in
|
||||
let minute = int_of_string (Netstring_str.matched_group m 5 s) in
|
||||
let second = int_of_string (Netstring_str.matched_group m 6 s) in
|
||||
- let zonestr = Netstring_str.matched_group m 8s in
|
||||
+ let zonestr = Netstring_str.matched_group m 8 s in
|
||||
let zone = get_zone zonestr in
|
||||
if month = 0 || month > 12 || day = 0 || day > 31 ||
|
||||
hour > 23 || minute > 59 || second > 59
|
||||
diff --git a/code/src/netsys/netlog.ml b/code/src/netsys/netlog.ml
|
||||
index 4d87c0e..4633655 100644
|
||||
--- a/code/src/netsys/netlog.ml
|
||||
+++ b/code/src/netsys/netlog.ml
|
||||
@@ -8,6 +8,18 @@ type level =
|
||||
type logger =
|
||||
level -> string -> unit
|
||||
|
||||
+type timespec = float * int
|
||||
+type clock_id
|
||||
+type clock =
|
||||
+ (* originally from Netsys_posix *)
|
||||
+ | CLOCK_REALTIME
|
||||
+ | CLOCK_MONOTONIC
|
||||
+ | CLOCK_ID of clock_id
|
||||
+
|
||||
+external clock_gettime : clock -> timespec = "netsys_clock_gettime"
|
||||
+(* originally from Netsys_posix *)
|
||||
+
|
||||
+
|
||||
let level_weight =
|
||||
function
|
||||
| `Emerg -> 0
|
||||
@@ -95,7 +107,7 @@ let current_formatter =
|
||||
let channel_logger ch max_lev lev msg =
|
||||
if level_weight lev <= level_weight max_lev then (
|
||||
let (sec,ns) =
|
||||
- try Netsys_posix.clock_gettime Netsys_posix.CLOCK_REALTIME
|
||||
+ try clock_gettime CLOCK_REALTIME
|
||||
with Invalid_argument _ ->
|
||||
(Unix.gettimeofday(), 0) in
|
||||
let s = (* Netdate is unavailable here *)
|
||||
diff --git a/code/src/netsys/netsys_posix.ml b/code/src/netsys/netsys_posix.ml
|
||||
index 1062a6c..602ceae 100644
|
||||
--- a/code/src/netsys/netsys_posix.ml
|
||||
+++ b/code/src/netsys/netsys_posix.ml
|
||||
@@ -771,12 +771,14 @@ external readlinkat : Unix.file_descr -> string -> string
|
||||
type timespec = float * int
|
||||
type clock_id
|
||||
type clock =
|
||||
+ (* also in Netlog *)
|
||||
| CLOCK_REALTIME
|
||||
| CLOCK_MONOTONIC
|
||||
| CLOCK_ID of clock_id
|
||||
|
||||
external nanosleep : timespec -> timespec ref -> unit = "netsys_nanosleep"
|
||||
external clock_gettime : clock -> timespec = "netsys_clock_gettime"
|
||||
+ (* also in Netlog *)
|
||||
external clock_settime : clock -> timespec -> unit = "netsys_clock_settime"
|
||||
external clock_getres : clock -> timespec = "netsys_clock_getres"
|
||||
external clock_getcpuclockid : int -> clock_id = "netsys_clock_getcpuclockid"
|
||||
@ -0,0 +1,35 @@
|
||||
diff -uNr ppx_bench-113.33.00/_oasis ppx_bench-113.33.00+4.03/_oasis
|
||||
--- ppx_bench-113.33.00/_oasis 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_bench-113.33.00+4.03/_oasis 2016-03-22 15:13:49.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_bench
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Syntax extension for writing in-line benchmarks in ocaml code
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_bench-113.33.00/opam ppx_bench-113.33.00+4.03/opam
|
||||
--- ppx_bench-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_bench-113.33.00+4.03/opam 2016-03-22 17:51:35.000000000 +0100
|
||||
@@ -17,4 +17,4 @@
|
||||
"ppx_inline_test"
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_bench-113.33.00/src/ppx_bench.ml ppx_bench-113.33.00+4.03/src/ppx_bench.ml
|
||||
--- ppx_bench-113.33.00/src/ppx_bench.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_bench-113.33.00+4.03/src/ppx_bench.ml 2016-03-22 15:13:49.000000000 +0100
|
||||
@@ -113,7 +113,7 @@
|
||||
assert_enabled loc;
|
||||
apply_to_descr_bench
|
||||
path "add_bench_module" loc ~inner_loc:m.pmod_loc None ?name_suffix name
|
||||
- (pexp_fun ~loc "" None (punit ~loc)
|
||||
+ (pexp_fun ~loc Nolabel None (punit ~loc)
|
||||
(pexp_letmodule ~loc (Located.mk ~loc "M")
|
||||
m
|
||||
(eunit ~loc)))
|
||||
@ -0,0 +1,113 @@
|
||||
diff -uNr ppx_bin_prot-113.33.00/_oasis ppx_bin_prot-113.33.00+4.03/_oasis
|
||||
--- ppx_bin_prot-113.33.00/_oasis 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_bin_prot-113.33.00+4.03/_oasis 2016-03-22 15:13:49.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_bin_prot
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Generation of bin_prot readers and writers from types
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_bin_prot-113.33.00/opam ppx_bin_prot-113.33.00+4.03/opam
|
||||
--- ppx_bin_prot-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_bin_prot-113.33.00+4.03/opam 2016-03-22 17:51:35.000000000 +0100
|
||||
@@ -17,4 +17,4 @@
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
"ppx_type_conv"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_bin_prot-113.33.00/src/ppx_bin_prot.ml ppx_bin_prot-113.33.00+4.03/src/ppx_bin_prot.ml
|
||||
--- ppx_bin_prot-113.33.00/src/ppx_bin_prot.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_bin_prot-113.33.00+4.03/src/ppx_bin_prot.ml 2016-03-22 15:13:49.000000000 +0100
|
||||
@@ -37,7 +37,7 @@
|
||||
~init:result_type
|
||||
~f:(fun (tp, _variance) acc ->
|
||||
let loc = tp.ptyp_loc in
|
||||
- ptyp_arrow ~loc "" (wrap_type ~loc tp) acc)
|
||||
+ ptyp_arrow ~loc Nolabel (wrap_type ~loc tp) acc)
|
||||
in
|
||||
psig_value ~loc (value_description ~loc ~name ~type_:typ ~prim:[])
|
||||
|
||||
@@ -72,7 +72,12 @@
|
||||
| Rinherit _ -> false)
|
||||
;;
|
||||
|
||||
-let atoms_in_variant cds = List.exists cds ~f:(fun cds -> cds.pcd_args = [])
|
||||
+let atoms_in_variant cds =
|
||||
+ List.exists cds ~f:(fun cds ->
|
||||
+ match cds.pcd_args with
|
||||
+ | Pcstr_tuple [] -> true
|
||||
+ | Pcstr_tuple _ -> false
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported")
|
||||
|
||||
let let_ins loc bindings expr =
|
||||
List.fold_right bindings ~init:expr ~f:(fun binding expr ->
|
||||
@@ -327,8 +332,8 @@
|
||||
Location.raise_errorf ~loc:ty.ptyp_loc
|
||||
"bin_size_sum: GADTs are not supported by bin_prot");
|
||||
match cd.pcd_args with
|
||||
- | [] -> acc
|
||||
- | args ->
|
||||
+ | Pcstr_tuple [] -> acc
|
||||
+ | Pcstr_tuple args ->
|
||||
let get_tp tp = tp in
|
||||
let mk_patt loc v_name _ = pvar ~loc v_name in
|
||||
let patts, size_args =
|
||||
@@ -344,7 +349,8 @@
|
||||
let size = [%e size_tag] in
|
||||
[%e size_args]
|
||||
]
|
||||
- :: acc)
|
||||
+ :: acc
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported")
|
||||
in
|
||||
let matchings =
|
||||
if atoms_in_variant alts then
|
||||
@@ -585,13 +591,13 @@
|
||||
Location.raise_errorf ~loc:ty.ptyp_loc
|
||||
"bin_write_sum: GADTs are not supported by bin_prot");
|
||||
match cd.pcd_args with
|
||||
- | [] ->
|
||||
+ | Pcstr_tuple [] ->
|
||||
let loc = cd.pcd_loc in
|
||||
case
|
||||
~lhs:(pconstruct cd None)
|
||||
~guard:None
|
||||
~rhs:(eapply ~loc write_tag [eint ~loc i])
|
||||
- | args ->
|
||||
+ | Pcstr_tuple args ->
|
||||
let get_tp tp = tp in
|
||||
let mk_patt loc v_name _ = pvar ~loc v_name in
|
||||
let patts, write_args =
|
||||
@@ -606,7 +612,8 @@
|
||||
~rhs:[%expr
|
||||
let pos = [%e write_tag] [%e eint ~loc i] in
|
||||
[%e write_args]
|
||||
- ])
|
||||
+ ]
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported")
|
||||
in
|
||||
`Match matchings
|
||||
|
||||
@@ -934,13 +941,14 @@
|
||||
Location.raise_errorf ~loc:cd.pcd_loc
|
||||
"bin_read_sum: GADTs are not supported by bin_prot");
|
||||
match cd.pcd_args with
|
||||
- | [] ->
|
||||
+ | Pcstr_tuple [] ->
|
||||
let loc = cd.pcd_loc in
|
||||
case ~lhs:(pint ~loc mi) ~guard:None ~rhs:(econstruct cd None)
|
||||
- | args ->
|
||||
+ | Pcstr_tuple args ->
|
||||
let bindings, args_expr = handle_arg_tp loc full_type_name args in
|
||||
let rhs = let_ins loc bindings (econstruct cd (Some args_expr)) in
|
||||
case ~lhs:(pint ~loc mi) ~guard:None ~rhs
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported"
|
||||
in
|
||||
let mcs = List.mapi alts ~f:map in
|
||||
let n_alts = List.length alts in
|
||||
@ -0,0 +1,126 @@
|
||||
diff -uNr ppx_compare-113.33.00/expander/ppx_compare_expander.ml ppx_compare-113.33.00+4.03/expander/ppx_compare_expander.ml
|
||||
--- ppx_compare-113.33.00/expander/ppx_compare_expander.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_compare-113.33.00+4.03/expander/ppx_compare_expander.ml 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -219,53 +219,56 @@
|
||||
if cd.pcd_res <> None then
|
||||
Location.raise_errorf ~loc "GADTs are not supported by comparelib";
|
||||
match cd.pcd_args with
|
||||
- | [] ->
|
||||
- let pcnstr = pconstruct cd None in
|
||||
- let pany = ppat_any ~loc in
|
||||
- let case l r n =
|
||||
- case ~guard:None ~lhs:(ppat_tuple ~loc [l; r]) ~rhs:(eint ~loc n)
|
||||
- in
|
||||
- if rightmost then
|
||||
- [ case pcnstr pcnstr 0 ]
|
||||
- else
|
||||
- [ case pcnstr pcnstr 0
|
||||
- ; case pcnstr pany (-1)
|
||||
- ; case pany pcnstr 1
|
||||
- ]
|
||||
- | tps ->
|
||||
- let ids_ty =
|
||||
- List.map tps
|
||||
- ~f:(fun ty ->
|
||||
- (gen_symbol ~prefix:"_a" (),
|
||||
- gen_symbol ~prefix:"_b" (),
|
||||
- ty))
|
||||
- in
|
||||
- let lpatt = List.map ids_ty ~f:(fun (l,_r,_ty) -> pvar ~loc l) |> ppat_tuple ~loc
|
||||
- and rpatt = List.map ids_ty ~f:(fun (_l,r,_ty) -> pvar ~loc r) |> ppat_tuple ~loc
|
||||
- and body =
|
||||
- List.map ids_ty ~f:(fun (l,r,ty) ->
|
||||
- compare_of_ty ty (evar ~loc l) (evar ~loc r))
|
||||
- |> chain_if
|
||||
- in
|
||||
- let res =
|
||||
- case ~guard:None
|
||||
- ~lhs:(ppat_tuple ~loc [ pconstruct cd (Some lpatt)
|
||||
- ; pconstruct cd (Some rpatt)
|
||||
- ])
|
||||
- ~rhs:body
|
||||
- in
|
||||
- if rightmost then
|
||||
- [ res ]
|
||||
- else
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported"
|
||||
+ | Pcstr_tuple pcd_args ->
|
||||
+ match pcd_args with
|
||||
+ | [] ->
|
||||
+ let pcnstr = pconstruct cd None in
|
||||
let pany = ppat_any ~loc in
|
||||
- let pcnstr = pconstruct cd (Some pany) in
|
||||
let case l r n =
|
||||
case ~guard:None ~lhs:(ppat_tuple ~loc [l; r]) ~rhs:(eint ~loc n)
|
||||
in
|
||||
- [ res
|
||||
- ; case pcnstr pany (-1)
|
||||
- ; case pany pcnstr 1
|
||||
- ])
|
||||
+ if rightmost then
|
||||
+ [ case pcnstr pcnstr 0 ]
|
||||
+ else
|
||||
+ [ case pcnstr pcnstr 0
|
||||
+ ; case pcnstr pany (-1)
|
||||
+ ; case pany pcnstr 1
|
||||
+ ]
|
||||
+ | tps ->
|
||||
+ let ids_ty =
|
||||
+ List.map tps
|
||||
+ ~f:(fun ty ->
|
||||
+ (gen_symbol ~prefix:"_a" (),
|
||||
+ gen_symbol ~prefix:"_b" (),
|
||||
+ ty))
|
||||
+ in
|
||||
+ let lpatt = List.map ids_ty ~f:(fun (l,_r,_ty) -> pvar ~loc l) |> ppat_tuple ~loc
|
||||
+ and rpatt = List.map ids_ty ~f:(fun (_l,r,_ty) -> pvar ~loc r) |> ppat_tuple ~loc
|
||||
+ and body =
|
||||
+ List.map ids_ty ~f:(fun (l,r,ty) ->
|
||||
+ compare_of_ty ty (evar ~loc l) (evar ~loc r))
|
||||
+ |> chain_if
|
||||
+ in
|
||||
+ let res =
|
||||
+ case ~guard:None
|
||||
+ ~lhs:(ppat_tuple ~loc [ pconstruct cd (Some lpatt)
|
||||
+ ; pconstruct cd (Some rpatt)
|
||||
+ ])
|
||||
+ ~rhs:body
|
||||
+ in
|
||||
+ if rightmost then
|
||||
+ [ res ]
|
||||
+ else
|
||||
+ let pany = ppat_any ~loc in
|
||||
+ let pcnstr = pconstruct cd (Some pany) in
|
||||
+ let case l r n =
|
||||
+ case ~guard:None ~lhs:(ppat_tuple ~loc [l; r]) ~rhs:(eint ~loc n)
|
||||
+ in
|
||||
+ [ res
|
||||
+ ; case pcnstr pany (-1)
|
||||
+ ; case pany pcnstr 1
|
||||
+ ])
|
||||
|> List.map ~f:List.rev
|
||||
|> List.concat
|
||||
|> List.rev
|
||||
diff -uNr ppx_compare-113.33.00/_oasis ppx_compare-113.33.00+4.03/_oasis
|
||||
--- ppx_compare-113.33.00/_oasis 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_compare-113.33.00+4.03/_oasis 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_compare
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Generation of comparison functions from types
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_compare-113.33.00/opam ppx_compare-113.33.00+4.03/opam
|
||||
--- ppx_compare-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_compare-113.33.00+4.03/opam 2016-03-22 17:51:35.000000000 +0100
|
||||
@@ -17,4 +17,4 @@
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
"ppx_type_conv"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
@ -0,0 +1,788 @@
|
||||
diff -uNr ppx_core-113.33.00/js-utils/gen_install.ml ppx_core-113.33.01+4.03/js-utils/gen_install.ml
|
||||
--- ppx_core-113.33.00/js-utils/gen_install.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/js-utils/gen_install.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -31,7 +31,7 @@
|
||||
|> List.map (fun line -> Scanf.sscanf line "%[^=]=%S" (fun k v -> (k, v)))
|
||||
|
||||
let remove_cwd =
|
||||
- let prefix = Sys.getcwd () ^ "/" in
|
||||
+ let prefix = Sys.getcwd () ^ Filename.dir_sep in
|
||||
let len_prefix = String.length prefix in
|
||||
fun fn ->
|
||||
let len = String.length fn in
|
||||
diff -uNr ppx_core-113.33.00/_oasis ppx_core-113.33.01+4.03/_oasis
|
||||
--- ppx_core-113.33.00/_oasis 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/_oasis 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_core
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.01+4.03
|
||||
Synopsis: Standard library for ppx rewriters
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_core-113.33.00/opam ppx_core-113.33.01+4.03/opam
|
||||
--- ppx_core-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/opam 2016-04-18 12:27:13.000000000 +0200
|
||||
@@ -14,4 +14,4 @@
|
||||
"ocamlfind" {build & >= "1.3.2"}
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_core-113.33.00/src/ast_builder_intf.ml ppx_core-113.33.01+4.03/src/ast_builder_intf.ml
|
||||
--- ppx_core-113.33.00/src/ast_builder_intf.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/ast_builder_intf.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -44,6 +44,11 @@
|
||||
val elist : (expression list -> expression) with_loc
|
||||
val plist : (pattern list -> pattern ) with_loc
|
||||
|
||||
+ val pstr_value_list :
|
||||
+ loc:Location.t -> Asttypes.rec_flag -> value_binding list -> structure_item list
|
||||
+ (** [pstr_value_list ~loc rf vbs] = [pstr_value ~loc rf vbs] if [vbs <> []], [[]]
|
||||
+ otherwise. *)
|
||||
+
|
||||
val nonrec_type_declaration :
|
||||
(name:string Location.loc
|
||||
-> params:(core_type * Asttypes.variance) list
|
||||
diff -uNr ppx_core-113.33.00/src/ast_builder.ml ppx_core-113.33.01+4.03/src/ast_builder.ml
|
||||
--- ppx_core-113.33.00/src/ast_builder.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/ast_builder.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -22,27 +22,31 @@
|
||||
|
||||
include Ast_builder_generated.M
|
||||
|
||||
+ let pstr_value_list ~loc rec_flag = function
|
||||
+ | [] -> []
|
||||
+ | vbs -> [pstr_value ~loc rec_flag vbs]
|
||||
+
|
||||
let nonrec_type_declaration ~loc ~name ~params ~cstrs ~kind ~private_ ~manifest =
|
||||
let td = type_declaration ~loc ~name ~params ~cstrs ~kind ~private_ ~manifest in
|
||||
{ td with ptype_attributes =
|
||||
({ txt = "nonrec"; loc }, PStr []) :: td.ptype_attributes }
|
||||
;;
|
||||
|
||||
- let eint ~loc t = pexp_constant ~loc (Const_int t)
|
||||
- let echar ~loc t = pexp_constant ~loc (Const_char t)
|
||||
- let estring ~loc t = pexp_constant ~loc (Const_string (t, None))
|
||||
- let efloat ~loc t = pexp_constant ~loc (Const_float t)
|
||||
- let eint32 ~loc t = pexp_constant ~loc (Const_int32 t)
|
||||
- let eint64 ~loc t = pexp_constant ~loc (Const_int64 t)
|
||||
- let enativeint ~loc t = pexp_constant ~loc (Const_nativeint t)
|
||||
-
|
||||
- let pint ~loc t = ppat_constant ~loc (Const_int t)
|
||||
- let pchar ~loc t = ppat_constant ~loc (Const_char t)
|
||||
- let pstring ~loc t = ppat_constant ~loc (Const_string (t, None))
|
||||
- let pfloat ~loc t = ppat_constant ~loc (Const_float t)
|
||||
- let pint32 ~loc t = ppat_constant ~loc (Const_int32 t)
|
||||
- let pint64 ~loc t = ppat_constant ~loc (Const_int64 t)
|
||||
- let pnativeint ~loc t = ppat_constant ~loc (Const_nativeint t)
|
||||
+ let eint ~loc t = pexp_constant ~loc (Pconst_integer (string_of_int t, None))
|
||||
+ let echar ~loc t = pexp_constant ~loc (Pconst_char t)
|
||||
+ let estring ~loc t = pexp_constant ~loc (Pconst_string (t, None))
|
||||
+ let efloat ~loc t = pexp_constant ~loc (Pconst_float (t, None))
|
||||
+ let eint32 ~loc t = pexp_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
|
||||
+ let eint64 ~loc t = pexp_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))
|
||||
+ let enativeint ~loc t = pexp_constant ~loc (Pconst_integer (Nativeint.to_string t, Some 'n'))
|
||||
+
|
||||
+ let pint ~loc t = ppat_constant ~loc (Pconst_integer (string_of_int t, None))
|
||||
+ let pchar ~loc t = ppat_constant ~loc (Pconst_char t)
|
||||
+ let pstring ~loc t = ppat_constant ~loc (Pconst_string (t, None))
|
||||
+ let pfloat ~loc t = ppat_constant ~loc (Pconst_float (t, None))
|
||||
+ let pint32 ~loc t = ppat_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
|
||||
+ let pint64 ~loc t = ppat_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))
|
||||
+ let pnativeint ~loc t = ppat_constant ~loc (Pconst_integer (Nativeint.to_string t, Some 'n'))
|
||||
|
||||
let ebool ~loc t = pexp_construct ~loc (Located.lident ~loc (string_of_bool t)) None
|
||||
let pbool ~loc t = ppat_construct ~loc (Located.lident ~loc (string_of_bool t)) None
|
||||
@@ -77,10 +81,11 @@
|
||||
| _ -> pexp_apply ~loc e el
|
||||
;;
|
||||
|
||||
- let eapply ~loc e el = pexp_apply ~loc e (List.map el ~f:(fun e -> ("", e)))
|
||||
+ let eapply ~loc e el =
|
||||
+ pexp_apply ~loc e (List.map el ~f:(fun e -> (Asttypes.Nolabel, e)))
|
||||
|
||||
let eabstract ~loc ps e =
|
||||
- List.fold_right ps ~init:e ~f:(fun p e -> pexp_fun ~loc "" None p e)
|
||||
+ List.fold_right ps ~init:e ~f:(fun p e -> pexp_fun ~loc Asttypes.Nolabel None p e)
|
||||
;;
|
||||
|
||||
let pconstruct cd arg = ppat_construct ~loc:cd.pcd_loc (Located.map_lident cd.pcd_name) arg
|
||||
@@ -111,6 +116,8 @@
|
||||
module Make(Loc : sig val loc : Location.t end) : S = struct
|
||||
include Ast_builder_generated.Make(Loc)
|
||||
|
||||
+ let pstr_value_list = Default.pstr_value_list
|
||||
+
|
||||
let nonrec_type_declaration ~name ~params ~cstrs ~kind ~private_ ~manifest =
|
||||
Default.nonrec_type_declaration ~loc ~name ~params ~cstrs ~kind ~private_ ~manifest
|
||||
;;
|
||||
diff -uNr ppx_core-113.33.00/src/ast_pattern.ml ppx_core-113.33.01+4.03/src/ast_pattern.ml
|
||||
--- ppx_core-113.33.00/src/ast_pattern.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/ast_pattern.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -80,6 +80,13 @@
|
||||
|
||||
let ( >>| ) t f = map t ~f
|
||||
|
||||
+let map0 (T func) ~f = T (fun ctx loc x k -> func ctx loc x ( k f ))
|
||||
+let map1 (T func) ~f = T (fun ctx loc x k -> func ctx loc x (fun a -> k (f a )))
|
||||
+let map2 (T func) ~f = T (fun ctx loc x k -> func ctx loc x (fun a b -> k (f a b)))
|
||||
+
|
||||
+let alt_option some none =
|
||||
+ alt (map1 some ~f:(fun x -> Some x)) (map0 none ~f:None)
|
||||
+
|
||||
let many (T f) = T (fun ctx loc l k ->
|
||||
k (List.map l ~f:(fun x -> f ctx loc x (fun x -> x))))
|
||||
;;
|
||||
@@ -96,25 +103,37 @@
|
||||
|
||||
let ( ^:: ) = cons
|
||||
|
||||
-let eint t = pexp_constant (const_int t)
|
||||
-let echar t = pexp_constant (const_char t)
|
||||
-let estring t = pexp_constant (const_string t drop)
|
||||
-let efloat t = pexp_constant (const_float t)
|
||||
-let eint32 t = pexp_constant (const_int32 t)
|
||||
-let eint64 t = pexp_constant (const_int64 t)
|
||||
+let echar t = pexp_constant (pconst_char t )
|
||||
+let estring t = pexp_constant (pconst_string t drop)
|
||||
+let efloat t = pexp_constant (pconst_float t drop)
|
||||
+
|
||||
+let pchar t = ppat_constant (pconst_char t )
|
||||
+let pstring t = ppat_constant (pconst_string t drop)
|
||||
+let pfloat t = ppat_constant (pconst_float t drop)
|
||||
+
|
||||
+let int' (T f) = T (fun ctx loc x k -> f ctx loc (int_of_string x) k)
|
||||
+let int32' (T f) = T (fun ctx loc x k -> f ctx loc (Int32.of_string x) k)
|
||||
+let int64' (T f) = T (fun ctx loc x k -> f ctx loc (Int64.of_string x) k)
|
||||
+let nativeint' (T f) = T (fun ctx loc x k -> f ctx loc (Nativeint.of_string x) k)
|
||||
+
|
||||
+let const_int t = pconst_integer (int' t) none
|
||||
+let const_int32 t = pconst_integer (int32' t) (some (char 'l'))
|
||||
+let const_int64 t = pconst_integer (int64' t) (some (char 'L'))
|
||||
+let const_nativeint t = pconst_integer (nativeint' t) (some (char 'n'))
|
||||
+
|
||||
+let eint t = pexp_constant (const_int t)
|
||||
+let eint32 t = pexp_constant (const_int32 t)
|
||||
+let eint64 t = pexp_constant (const_int64 t)
|
||||
let enativeint t = pexp_constant (const_nativeint t)
|
||||
|
||||
-let pint t = ppat_constant (const_int t)
|
||||
-let pchar t = ppat_constant (const_char t)
|
||||
-let pstring t = ppat_constant (const_string t drop)
|
||||
-let pfloat t = ppat_constant (const_float t)
|
||||
-let pint32 t = ppat_constant (const_int32 t)
|
||||
-let pint64 t = ppat_constant (const_int64 t)
|
||||
+let pint t = ppat_constant (const_int t)
|
||||
+let pint32 t = ppat_constant (const_int32 t)
|
||||
+let pint64 t = ppat_constant (const_int64 t)
|
||||
let pnativeint t = ppat_constant (const_nativeint t)
|
||||
|
||||
let single_expr_payload t = pstr (pstr_eval t nil ^:: nil)
|
||||
|
||||
-let no_label t = string "" ** t
|
||||
+let no_label t = (cst Asttypes.Nolabel ~to_string:(fun _ -> "Nolabel")) ** t
|
||||
|
||||
let attribute (T f1) (T f2) = T (fun ctx loc ((name : _ Location.loc), payload) k ->
|
||||
let k = f1 ctx name.loc name.txt k in
|
||||
diff -uNr ppx_core-113.33.00/src/ast_pattern.mli ppx_core-113.33.01+4.03/src/ast_pattern.mli
|
||||
--- ppx_core-113.33.00/src/ast_pattern.mli 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/ast_pattern.mli 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -115,6 +115,10 @@
|
||||
one. *)
|
||||
val alt : ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> ('a, 'b, 'c) t
|
||||
|
||||
+(** Same as [alt], for the common case where the left-hand-side captures a value but not
|
||||
+ the right-hand-side. *)
|
||||
+val alt_option : ('a, 'v -> 'b, 'c) t -> ('a, 'b, 'c) t -> ('a, 'v option -> 'b, 'c) t
|
||||
+
|
||||
(** Same as [alt] *)
|
||||
val ( ||| ) : ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> ('a, 'b, 'c) t
|
||||
|
||||
@@ -125,6 +129,10 @@
|
||||
(** Same as [map] *)
|
||||
val ( >>| ) : ('a, 'b, 'c) t -> ('d -> 'b) -> ('a, 'd, 'c) t
|
||||
|
||||
+val map0 : ('a, 'b, 'c) t -> f: 'v -> ('a, 'v -> 'b, 'c) t
|
||||
+val map1 : ('a, 'v1 -> 'b, 'c) t -> f:('v1 -> 'v) -> ('a, 'v -> 'b, 'c) t
|
||||
+val map2 : ('a, 'v1 -> 'v2 -> 'b, 'c) t -> f:('v1 -> 'v2 -> 'v) -> ('a, 'v -> 'b, 'c) t
|
||||
+
|
||||
val ( ^:: ) : ('a, 'b, 'c) t -> ('a list, 'c, 'd) t -> ('a list, 'b, 'd) t
|
||||
val many : ('a, 'b -> 'b, 'c) t -> ('a list, 'c list -> 'd, 'd) t
|
||||
|
||||
@@ -194,7 +202,7 @@
|
||||
|
||||
val single_expr_payload : (expression, 'a, 'b) t -> (payload, 'a, 'b) t
|
||||
|
||||
-val no_label : (expression, 'a, 'b) t -> (string * expression, 'a, 'b) t
|
||||
+val no_label : (expression, 'a, 'b) t -> (Asttypes.arg_label * expression, 'a, 'b) t
|
||||
|
||||
val attribute : (string, 'a, 'b) t -> (payload, 'b, 'c) t -> (attribute, 'a, 'c) t
|
||||
val extension : (string, 'a, 'b) t -> (payload, 'b, 'c) t -> (attribute, 'a, 'c) t
|
||||
diff -uNr ppx_core-113.33.00/src/attribute.ml ppx_core-113.33.01+4.03/src/attribute.ml
|
||||
--- ppx_core-113.33.00/src/attribute.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/attribute.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -15,6 +15,10 @@
|
||||
; "ocaml.doc"
|
||||
; "ocaml.text"
|
||||
; "nonrec"
|
||||
+ ; "ocaml.noalloc"
|
||||
+ ; "ocaml.unboxed"
|
||||
+ ; "ocaml.untagged"
|
||||
+ ; "ocaml.inline"
|
||||
]
|
||||
;;
|
||||
|
||||
@@ -74,6 +78,7 @@
|
||||
| Pstr_eval : structure_item t
|
||||
| Pstr_extension : structure_item t
|
||||
| Psig_extension : signature_item t
|
||||
+ | Row_field : row_field t
|
||||
|
||||
let label_declaration = Label_declaration
|
||||
let constructor_declaration = Constructor_declaration
|
||||
@@ -100,6 +105,7 @@
|
||||
let pstr_eval = Pstr_eval
|
||||
let pstr_extension = Pstr_extension
|
||||
let psig_extension = Psig_extension
|
||||
+ let row_field = Row_field
|
||||
|
||||
let get_pstr_eval st =
|
||||
match st.pstr_desc with
|
||||
@@ -116,6 +122,17 @@
|
||||
| Psig_extension (e, l) -> (e, l)
|
||||
| _ -> failwith "Attribute.Context.get_psig_extension"
|
||||
|
||||
+ module Row_field = struct
|
||||
+ let get_attrs = function
|
||||
+ | Rinherit _ -> []
|
||||
+ | Rtag (_, attrs, _, _) -> attrs
|
||||
+
|
||||
+ let set_attrs attrs = function
|
||||
+ | Rinherit _ -> invalid_arg "Row_field.set_attrs"
|
||||
+ | Rtag (lbl, _, can_be_constant, params_opts) ->
|
||||
+ Rtag (lbl, attrs, can_be_constant, params_opts)
|
||||
+ end
|
||||
+
|
||||
let get_attributes : type a. a t -> a -> attributes = fun t x ->
|
||||
match t with
|
||||
| Label_declaration -> x.pld_attributes
|
||||
@@ -143,6 +160,7 @@
|
||||
| Pstr_eval -> snd (get_pstr_eval x)
|
||||
| Pstr_extension -> snd (get_pstr_extension x)
|
||||
| Psig_extension -> snd (get_psig_extension x)
|
||||
+ | Row_field -> Row_field.get_attrs x
|
||||
|
||||
let set_attributes : type a. a t -> a -> attributes -> a = fun t x attrs ->
|
||||
match t with
|
||||
@@ -174,6 +192,7 @@
|
||||
{ x with pstr_desc = Pstr_extension (get_pstr_extension x |> fst, attrs) }
|
||||
| Psig_extension ->
|
||||
{ x with psig_desc = Psig_extension (get_psig_extension x |> fst, attrs) }
|
||||
+ | Row_field -> Row_field.set_attrs attrs x
|
||||
|
||||
let desc : type a. a t -> string = function
|
||||
| Label_declaration -> "label declaration"
|
||||
@@ -201,6 +220,7 @@
|
||||
| Pstr_eval -> "toplevel expression"
|
||||
| Pstr_extension -> "toplevel extension"
|
||||
| Psig_extension -> "toplevel signature extension"
|
||||
+ | Row_field -> "row field"
|
||||
|
||||
(*
|
||||
let pattern : type a b c d. a t
|
||||
@@ -480,6 +500,7 @@
|
||||
method! module_expr x = super#module_expr (self#check_node Context.Module_expr x)
|
||||
method! value_binding x = super#value_binding (self#check_node Context.Value_binding x)
|
||||
method! module_binding x = super#module_binding (self#check_node Context.Module_binding x)
|
||||
+ method! row_field x = super#row_field (self#check_node Context.Row_field x)
|
||||
|
||||
method! class_field x =
|
||||
let x = self#check_node Context.Class_field x in
|
||||
diff -uNr ppx_core-113.33.00/src/attribute.mli ppx_core-113.33.01+4.03/src/attribute.mli
|
||||
--- ppx_core-113.33.00/src/attribute.mli 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/attribute.mli 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -42,6 +42,7 @@
|
||||
val pstr_eval : structure_item t
|
||||
val pstr_extension : structure_item t
|
||||
val psig_extension : signature_item t
|
||||
+ val row_field : row_field t
|
||||
end
|
||||
|
||||
(** [declare fully_qualified_name context payload_pattern k] declares an attribute. [k] is
|
||||
diff -uNr ppx_core-113.33.00/src/common.ml ppx_core-113.33.01+4.03/src/common.ml
|
||||
--- ppx_core-113.33.00/src/common.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/common.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -16,7 +16,7 @@
|
||||
List.fold_right
|
||||
(fun (tp, _variance) acc ->
|
||||
let loc = tp.ptyp_loc in
|
||||
- ptyp_arrow ~loc "" (f ~loc tp) acc)
|
||||
+ ptyp_arrow ~loc Nolabel (f ~loc tp) acc)
|
||||
td.ptype_params
|
||||
result_type
|
||||
;;
|
||||
@@ -74,7 +74,9 @@
|
||||
|
||||
method! constructor_declaration cd =
|
||||
(* Don't recurse through cd.pcd_res *)
|
||||
- List.iter (fun ty -> self#core_type ty) cd.pcd_args
|
||||
+ match cd.pcd_args with
|
||||
+ | Pcstr_tuple args -> List.iter (fun ty -> self#core_type ty) args
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported"
|
||||
end
|
||||
|
||||
let types_are_recursive ?(stop_on_functions = true) ?(short_circuit = fun _ -> None)
|
||||
@@ -110,6 +112,7 @@
|
||||
match payload with
|
||||
| PStr [] -> name.loc
|
||||
| PStr (x :: l) -> { x.pstr_loc with loc_end = (last x l).pstr_loc.loc_end }
|
||||
+ | PSig _ -> failwith "Not yet implemented"
|
||||
| PTyp t -> t.ptyp_loc
|
||||
| PPat (x, None) -> x.ppat_loc
|
||||
| PPat (x, Some e) -> { x.ppat_loc with loc_end = e.pexp_loc.loc_end }
|
||||
diff -uNr ppx_core-113.33.00/src/gen/common.ml ppx_core-113.33.01+4.03/src/gen/common.ml
|
||||
--- ppx_core-113.33.00/src/gen/common.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/gen/common.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -70,8 +70,13 @@
|
||||
| Type_variant cds ->
|
||||
List.fold_left cds ~init:acc
|
||||
~f:(fun acc (cd : Types.constructor_declaration) ->
|
||||
- List.fold_left cd.cd_args ~init:acc
|
||||
- ~f:(add_type_expr_dependencies env))
|
||||
+ match cd.cd_args with
|
||||
+ | Cstr_tuple typ_exprs ->
|
||||
+ List.fold_left typ_exprs ~init:acc ~f:(add_type_expr_dependencies env)
|
||||
+ | Cstr_record label_decls ->
|
||||
+ List.fold_left label_decls ~init:acc
|
||||
+ ~f:(fun acc (label_decl : Types.label_declaration) ->
|
||||
+ add_type_expr_dependencies env acc label_decl.ld_type))
|
||||
| Type_abstract ->
|
||||
match td.type_manifest with
|
||||
| None -> acc
|
||||
diff -uNr ppx_core-113.33.00/src/gen/gen_ast_builder.ml ppx_core-113.33.01+4.03/src/gen/gen_ast_builder.ml
|
||||
--- ppx_core-113.33.00/src/gen/gen_ast_builder.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/gen/gen_ast_builder.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -121,57 +121,60 @@
|
||||
open M
|
||||
|
||||
let gen_combinator_for_constructor ~wrapper:(wpath, wprefix, has_attrs) path ~prefix cd =
|
||||
- let args =
|
||||
- List.mapi cd.cd_args ~f:(fun i _ -> sprintf "x%d" i)
|
||||
- in
|
||||
- let exp =
|
||||
- Exp.construct (Loc.mk (fqn_longident path cd.cd_id))
|
||||
- (match args with
|
||||
- | [] -> None
|
||||
- | [x] -> Some (evar x)
|
||||
- | _ -> Some (Exp.tuple (List.map args ~f:evar)))
|
||||
- in
|
||||
- let body =
|
||||
- let fields =
|
||||
- [ ( Loc.mk (fqn_longident' wpath (wprefix ^ "loc"))
|
||||
- , evar "loc"
|
||||
- )
|
||||
- ; ( Loc.mk (fqn_longident' wpath (wprefix ^ "desc"))
|
||||
- , exp
|
||||
- )
|
||||
- ]
|
||||
+ match cd.cd_args with
|
||||
+ | Cstr_record _ -> failwith "Cstr_record not supported"
|
||||
+ | Cstr_tuple cd_args ->
|
||||
+ let args =
|
||||
+ List.mapi cd_args ~f:(fun i _ -> sprintf "x%d" i)
|
||||
+ in
|
||||
+ let exp =
|
||||
+ Exp.construct (Loc.mk (fqn_longident path cd.cd_id))
|
||||
+ (match args with
|
||||
+ | [] -> None
|
||||
+ | [x] -> Some (evar x)
|
||||
+ | _ -> Some (Exp.tuple (List.map args ~f:evar)))
|
||||
in
|
||||
- let fields =
|
||||
- if has_attrs then
|
||||
- ( Loc.mk (fqn_longident' wpath (wprefix ^ "attributes"))
|
||||
- , [%expr []]
|
||||
- )
|
||||
- :: fields
|
||||
+ let body =
|
||||
+ let fields =
|
||||
+ [ ( Loc.mk (fqn_longident' wpath (wprefix ^ "loc"))
|
||||
+ , evar "loc"
|
||||
+ )
|
||||
+ ; ( Loc.mk (fqn_longident' wpath (wprefix ^ "desc"))
|
||||
+ , exp
|
||||
+ )
|
||||
+ ]
|
||||
+ in
|
||||
+ let fields =
|
||||
+ if has_attrs then
|
||||
+ ( Loc.mk (fqn_longident' wpath (wprefix ^ "attributes"))
|
||||
+ , [%expr []]
|
||||
+ )
|
||||
+ :: fields
|
||||
+ else
|
||||
+ fields
|
||||
+ in
|
||||
+ Exp.record fields None
|
||||
+ in
|
||||
+ let body =
|
||||
+ (* match args with
|
||||
+ | [] -> [%expr fun () -> [%e body]]
|
||||
+ | _ ->*)
|
||||
+ List.fold_right args ~init:body ~f:(fun arg acc ->
|
||||
+ [%expr fun [%p pvar arg] -> [%e acc]])
|
||||
+ in
|
||||
+ (* let body =
|
||||
+ if not has_attrs then
|
||||
+ body
|
||||
+ else
|
||||
+ [%expr fun ?(attrs=[]) -> [%e body]]
|
||||
+ in*)
|
||||
+ let body =
|
||||
+ if fixed_loc then
|
||||
+ body
|
||||
else
|
||||
- fields
|
||||
+ [%expr fun ~loc -> [%e body]]
|
||||
in
|
||||
- Exp.record fields None
|
||||
- in
|
||||
- let body =
|
||||
-(* match args with
|
||||
- | [] -> [%expr fun () -> [%e body]]
|
||||
- | _ ->*)
|
||||
- List.fold_right args ~init:body ~f:(fun arg acc ->
|
||||
- [%expr fun [%p pvar arg] -> [%e acc]])
|
||||
- in
|
||||
-(* let body =
|
||||
- if not has_attrs then
|
||||
- body
|
||||
- else
|
||||
- [%expr fun ?(attrs=[]) -> [%e body]]
|
||||
- in*)
|
||||
- let body =
|
||||
- if fixed_loc then
|
||||
- body
|
||||
- else
|
||||
- [%expr fun ~loc -> [%e body]]
|
||||
- in
|
||||
- [%stri let [%p pvar (function_name_of_id ~prefix cd.cd_id)] = [%e body]]
|
||||
+ [%stri let [%p pvar (function_name_of_id ~prefix cd.cd_id)] = [%e body]]
|
||||
;;
|
||||
|
||||
let gen_combinator_for_record path ~prefix lds =
|
||||
@@ -189,10 +192,10 @@
|
||||
let body =
|
||||
let l = List.filter funcs ~f:(fun f -> f <> "loc" && f <> "attributes") in
|
||||
match l with
|
||||
- | [x] -> Exp.fun_ "" None (pvar x) body
|
||||
+ | [x] -> Exp.fun_ Nolabel None (pvar x) body
|
||||
| _ ->
|
||||
List.fold_right l ~init:body ~f:(fun func acc ->
|
||||
- Exp.fun_ func None (pvar func) acc
|
||||
+ Exp.fun_ (Labelled func) None (pvar func) acc
|
||||
)
|
||||
in
|
||||
(* let body =
|
||||
diff -uNr ppx_core-113.33.00/src/gen/gen_ast_pattern.ml ppx_core-113.33.01+4.03/src/gen/gen_ast_pattern.ml
|
||||
--- ppx_core-113.33.00/src/gen/gen_ast_pattern.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/gen/gen_ast_pattern.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -157,66 +157,69 @@
|
||||
]
|
||||
|
||||
let gen_combinator_for_constructor ?wrapper path ~prefix cd =
|
||||
- let args =
|
||||
- List.mapi cd.cd_args ~f:(fun i _ -> sprintf "x%d" i)
|
||||
- in
|
||||
- let funcs =
|
||||
- List.mapi cd.cd_args ~f:(fun i _ -> sprintf "f%d" i)
|
||||
- in
|
||||
- let pat =
|
||||
- Pat.construct (Loc.mk (fqn_longident path cd.cd_id))
|
||||
- (match args with
|
||||
- | [] -> None
|
||||
- | [x] -> Some (pvar x)
|
||||
- | _ -> Some (Pat.tuple (List.map args ~f:pvar)))
|
||||
- in
|
||||
- let exp =
|
||||
- apply_parsers funcs (List.map args ~f:evar) cd.cd_args
|
||||
- in
|
||||
- let expected = without_prefix ~prefix (Ident.name cd.cd_id) in
|
||||
- let body =
|
||||
- [%expr
|
||||
- match x with
|
||||
- | [%p pat] -> ctx.matched <- ctx.matched + 1; [%e exp]
|
||||
- | _ -> fail loc [%e Exp.constant (Const_string (expected, None))]
|
||||
- ]
|
||||
- in
|
||||
- let body =
|
||||
- match wrapper with
|
||||
- | None -> body
|
||||
- | Some (path, prefix, has_attrs) ->
|
||||
- let body =
|
||||
- [%expr
|
||||
- let loc = [%e Exp.field (evar "x")
|
||||
- (Loc.mk @@ fqn_longident' path (prefix ^ "loc"))]
|
||||
- in
|
||||
- let x = [%e Exp.field (evar "x")
|
||||
- (Loc.mk @@ fqn_longident' path (prefix ^ "desc"))]
|
||||
- in
|
||||
- [%e body]
|
||||
- ]
|
||||
- in
|
||||
- if has_attrs then
|
||||
- [%expr
|
||||
- [%e assert_no_attributes ~path ~prefix];
|
||||
- [%e body]
|
||||
- ]
|
||||
- else
|
||||
- body
|
||||
- in
|
||||
- let body =
|
||||
- let loc =
|
||||
+ match cd.cd_args with
|
||||
+ | Cstr_record _ -> failwith "Cstr_record not supported"
|
||||
+ | Cstr_tuple cd_args ->
|
||||
+ let args =
|
||||
+ List.mapi cd_args ~f:(fun i _ -> sprintf "x%d" i)
|
||||
+ in
|
||||
+ let funcs =
|
||||
+ List.mapi cd_args ~f:(fun i _ -> sprintf "f%d" i)
|
||||
+ in
|
||||
+ let pat =
|
||||
+ Pat.construct (Loc.mk (fqn_longident path cd.cd_id))
|
||||
+ (match args with
|
||||
+ | [] -> None
|
||||
+ | [x] -> Some (pvar x)
|
||||
+ | _ -> Some (Pat.tuple (List.map args ~f:pvar)))
|
||||
+ in
|
||||
+ let exp =
|
||||
+ apply_parsers funcs (List.map args ~f:evar) cd_args
|
||||
+ in
|
||||
+ let expected = without_prefix ~prefix (Ident.name cd.cd_id) in
|
||||
+ let body =
|
||||
+ [%expr
|
||||
+ match x with
|
||||
+ | [%p pat] -> ctx.matched <- ctx.matched + 1; [%e exp]
|
||||
+ | _ -> fail loc [%e Exp.constant (Pconst_string (expected, None))]
|
||||
+ ]
|
||||
+ in
|
||||
+ let body =
|
||||
match wrapper with
|
||||
- | None -> [%pat? loc]
|
||||
- | Some _ -> [%pat? _loc]
|
||||
+ | None -> body
|
||||
+ | Some (path, prefix, has_attrs) ->
|
||||
+ let body =
|
||||
+ [%expr
|
||||
+ let loc = [%e Exp.field (evar "x")
|
||||
+ (Loc.mk @@ fqn_longident' path (prefix ^ "loc"))]
|
||||
+ in
|
||||
+ let x = [%e Exp.field (evar "x")
|
||||
+ (Loc.mk @@ fqn_longident' path (prefix ^ "desc"))]
|
||||
+ in
|
||||
+ [%e body]
|
||||
+ ]
|
||||
+ in
|
||||
+ if has_attrs then
|
||||
+ [%expr
|
||||
+ [%e assert_no_attributes ~path ~prefix];
|
||||
+ [%e body]
|
||||
+ ]
|
||||
+ else
|
||||
+ body
|
||||
in
|
||||
- [%expr T (fun ctx [%p loc] x k -> [%e body])]
|
||||
- in
|
||||
- let body =
|
||||
- List.fold_right funcs ~init:body ~f:(fun func acc ->
|
||||
- [%expr fun (T [%p pvar func]) -> [%e acc]])
|
||||
- in
|
||||
- [%stri let [%p pvar (function_name_of_id ~prefix cd.cd_id)] = [%e body]]
|
||||
+ let body =
|
||||
+ let loc =
|
||||
+ match wrapper with
|
||||
+ | None -> [%pat? loc]
|
||||
+ | Some _ -> [%pat? _loc]
|
||||
+ in
|
||||
+ [%expr T (fun ctx [%p loc] x k -> [%e body])]
|
||||
+ in
|
||||
+ let body =
|
||||
+ List.fold_right funcs ~init:body ~f:(fun func acc ->
|
||||
+ [%expr fun (T [%p pvar func]) -> [%e acc]])
|
||||
+ in
|
||||
+ [%stri let [%p pvar (function_name_of_id ~prefix cd.cd_id)] = [%e body]]
|
||||
;;
|
||||
|
||||
let gen_combinator_for_record path ~prefix ~has_attrs lds =
|
||||
@@ -241,7 +244,7 @@
|
||||
let body = [%expr T (fun ctx loc x k -> [%e body])] in
|
||||
let body =
|
||||
List.fold_right funcs ~init:body ~f:(fun func acc ->
|
||||
- Exp.fun_ func None [%pat? T [%p pvar func]] acc)
|
||||
+ Exp.fun_ (Labelled func) None [%pat? T [%p pvar func]] acc)
|
||||
in
|
||||
[%stri let [%p pvar (Common.function_name_of_path path)] = [%e body]]
|
||||
;;
|
||||
diff -uNr ppx_core-113.33.00/src/gen/gen.ml ppx_core-113.33.01+4.03/src/gen/gen.ml
|
||||
--- ppx_core-113.33.00/src/gen/gen.ml 2016-03-09 16:44:53.000000000 +0100
|
||||
+++ ppx_core-113.33.01+4.03/src/gen/gen.ml 2016-04-18 12:14:21.000000000 +0200
|
||||
@@ -23,7 +23,7 @@
|
||||
|
||||
method apply
|
||||
: Parsetree.expression
|
||||
- -> (string * Parsetree.expression) list
|
||||
+ -> (Asttypes.arg_label * Parsetree.expression) list
|
||||
-> Parsetree.expression
|
||||
|
||||
method abstract
|
||||
@@ -49,9 +49,9 @@
|
||||
method class_params = []
|
||||
|
||||
method apply expr args = Exp.apply expr args
|
||||
- method abstract patt expr = Exp.fun_ "" None patt expr
|
||||
+ method abstract patt expr = Exp.fun_ Nolabel None patt expr
|
||||
|
||||
- method typ ty = Typ.arrow "" ty ty
|
||||
+ method typ ty = Typ.arrow Nolabel ty ty
|
||||
|
||||
method array = [%expr Array.map]
|
||||
method any = [%expr fun x -> x]
|
||||
@@ -68,7 +68,7 @@
|
||||
method class_params = []
|
||||
|
||||
method apply expr args = Exp.apply expr args
|
||||
- method abstract patt expr = Exp.fun_ "" None patt expr
|
||||
+ method abstract patt expr = Exp.fun_ Nolabel None patt expr
|
||||
|
||||
method typ ty = [%type: [%t ty] -> unit]
|
||||
method array = [%expr Array.iter]
|
||||
@@ -88,8 +88,9 @@
|
||||
|
||||
method class_params = [(Typ.var "acc", Asttypes.Invariant)]
|
||||
|
||||
- method apply expr args = Exp.apply expr (args @ [("", evar "acc")])
|
||||
- method abstract patt expr = Exp.fun_ "" None patt (Exp.fun_ "" None (pvar "acc") expr)
|
||||
+ method apply expr args = Exp.apply expr (args @ [(Asttypes.Nolabel, evar "acc")])
|
||||
+ method abstract patt expr =
|
||||
+ Exp.fun_ Nolabel None patt (Exp.fun_ Nolabel None (pvar "acc") expr)
|
||||
|
||||
method typ ty = [%type: [%t ty] -> 'acc -> 'acc]
|
||||
method array =
|
||||
@@ -121,8 +122,9 @@
|
||||
|
||||
method class_params = [(Typ.var "acc", Asttypes.Invariant)]
|
||||
|
||||
- method apply expr args = Exp.apply expr (args @ [("", evar "acc")])
|
||||
- method abstract patt expr = Exp.fun_ "" None patt (Exp.fun_ "" None (pvar "acc") expr)
|
||||
+ method apply expr args = Exp.apply expr (args @ [(Asttypes.Nolabel, evar "acc")])
|
||||
+ method abstract patt expr =
|
||||
+ Exp.fun_ Nolabel None patt (Exp.fun_ Nolabel None (pvar "acc") expr)
|
||||
|
||||
method typ ty = [%type: [%t ty] -> 'acc -> [%t ty] * 'acc]
|
||||
method array =
|
||||
@@ -180,12 +182,12 @@
|
||||
|
||||
method class_params = [(Typ.var "ctx", Asttypes.Invariant)]
|
||||
|
||||
- method apply expr args = Exp.apply expr (("", evar "ctx") :: args)
|
||||
+ method apply expr args = Exp.apply expr ((Asttypes.Nolabel, evar "ctx") :: args)
|
||||
method abstract patt expr =
|
||||
if uses_ctx expr then
|
||||
- Exp.fun_ "" None (pvar "ctx") (Exp.fun_ "" None patt expr)
|
||||
+ Exp.fun_ Nolabel None (pvar "ctx") (Exp.fun_ Nolabel None patt expr)
|
||||
else
|
||||
- Exp.fun_ "" None (pvar "_ctx") (Exp.fun_ "" None patt expr)
|
||||
+ Exp.fun_ Nolabel None (pvar "_ctx") (Exp.fun_ Nolabel None patt expr)
|
||||
|
||||
method typ ty = [%type: 'ctx -> [%t ty] -> [%t ty]]
|
||||
method array = [%expr fun ctx a -> Array.map (f ctx) a]
|
||||
@@ -219,7 +221,7 @@
|
||||
let ty = Typ.constr (Loc.mk ~loc (longident_of_path path)) params in
|
||||
let ty =
|
||||
List.fold_right
|
||||
- (fun param ty -> Typ.arrow "" (what#typ param) ty)
|
||||
+ (fun param ty -> Typ.arrow Nolabel (what#typ param) ty)
|
||||
params (what#typ ty)
|
||||
in
|
||||
Typ.poly vars ty
|
||||
@@ -244,7 +246,8 @@
|
||||
| _ ->
|
||||
Exp.apply map
|
||||
(List.map
|
||||
- (fun te -> ("", type_expr_mapper ~what ~all_types ~var_mappers te))
|
||||
+ (fun te ->
|
||||
+ (Asttypes.Nolabel, type_expr_mapper ~what ~all_types ~var_mappers te))
|
||||
params)
|
||||
else
|
||||
what#any
|
||||
@@ -263,7 +266,8 @@
|
||||
List.map2
|
||||
(fun te var ->
|
||||
(var,
|
||||
- what#apply (type_expr_mapper ~what ~all_types ~var_mappers te) [("", evar var)]))
|
||||
+ what#apply (type_expr_mapper ~what ~all_types ~var_mappers te)
|
||||
+ [(Asttypes.Nolabel, evar var)]))
|
||||
tes vars
|
||||
;;
|
||||
|
||||
@@ -290,24 +294,27 @@
|
||||
let cases =
|
||||
List.map
|
||||
(fun cd ->
|
||||
- let vars = vars_of_list cd.cd_args in
|
||||
- let cstr = Loc.mk ~loc (lident (Ident.name cd.cd_id)) in
|
||||
- let deconstruct =
|
||||
- Pat.construct cstr
|
||||
- (match vars with
|
||||
- | [] -> None
|
||||
- | _ -> Some (Pat.tuple (List.map pvar vars)))
|
||||
- in
|
||||
- let reconstruct =
|
||||
- Exp.construct cstr
|
||||
- (match vars with
|
||||
- | [] -> None
|
||||
- | _ -> Some (Exp.tuple (List.map evar vars)))
|
||||
- in
|
||||
- let mappers =
|
||||
- map_variables ~what ~all_types ~var_mappers vars cd.cd_args
|
||||
- in
|
||||
- Exp.case deconstruct (what#combine mappers ~reconstruct))
|
||||
+ match cd.cd_args with
|
||||
+ | Cstr_tuple args ->
|
||||
+ let vars = vars_of_list args in
|
||||
+ let cstr = Loc.mk ~loc (lident (Ident.name cd.cd_id)) in
|
||||
+ let deconstruct =
|
||||
+ Pat.construct cstr
|
||||
+ (match vars with
|
||||
+ | [] -> None
|
||||
+ | _ -> Some (Pat.tuple (List.map pvar vars)))
|
||||
+ in
|
||||
+ let reconstruct =
|
||||
+ Exp.construct cstr
|
||||
+ (match vars with
|
||||
+ | [] -> None
|
||||
+ | _ -> Some (Exp.tuple (List.map evar vars)))
|
||||
+ in
|
||||
+ let mappers =
|
||||
+ map_variables ~what ~all_types ~var_mappers vars args
|
||||
+ in
|
||||
+ Exp.case deconstruct (what#combine mappers ~reconstruct)
|
||||
+ | Cstr_record _ -> failwith "Cstr_record not supported")
|
||||
cds
|
||||
in
|
||||
what#abstract (pvar "x") (Exp.match_ (evar "x") cases)
|
||||
@@ -333,7 +340,7 @@
|
||||
| Some te -> type_expr_mapper ~what ~all_types ~var_mappers te
|
||||
in
|
||||
List.fold_right
|
||||
- (fun (_, v) acc -> Exp.fun_ "" None (pvar v) acc)
|
||||
+ (fun (_, v) acc -> Exp.fun_ Nolabel None (pvar v) acc)
|
||||
var_mappers body
|
||||
end
|
||||
;;
|
||||
@ -0,0 +1,145 @@
|
||||
diff -uNr ppx_custom_printf-113.33.00/CHANGES.md ppx_custom_printf-113.33.00+4.03/CHANGES.md
|
||||
--- ppx_custom_printf-113.33.00/CHANGES.md 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/CHANGES.md 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,3 +1,7 @@
|
||||
+## 113.33.00+4.03
|
||||
+
|
||||
+Various updates to work with OCaml 4.03.0
|
||||
+
|
||||
## 113.24.00
|
||||
|
||||
- OCaml makes no distinctions between "foo" and
|
||||
diff -uNr ppx_custom_printf-113.33.00/format-lifter/META ppx_custom_printf-113.33.00+4.03/format-lifter/META
|
||||
--- ppx_custom_printf-113.33.00/format-lifter/META 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/format-lifter/META 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -1,6 +1,6 @@
|
||||
# OASIS_START
|
||||
-# DO NOT EDIT (digest: 30e281114bcfdcf7ccf231691613c2e6)
|
||||
-version = "113.33.00"
|
||||
+# DO NOT EDIT (digest: 2c66a1ad37be0774b6cf2393020b734d)
|
||||
+version = "113.33.00+4.03"
|
||||
description =
|
||||
"Printf-style format-strings for user-defined string conversion"
|
||||
archive(byte) = "ppx_format_lifter.cma"
|
||||
diff -uNr ppx_custom_printf-113.33.00/INSTALL.txt ppx_custom_printf-113.33.00+4.03/INSTALL.txt
|
||||
--- ppx_custom_printf-113.33.00/INSTALL.txt 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/INSTALL.txt 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -1,5 +1,5 @@
|
||||
(* OASIS_START *)
|
||||
-(* DO NOT EDIT (digest: aa3e5a8a416bfdc4bbbd15b0bcdbfede) *)
|
||||
+(* DO NOT EDIT (digest: d41a009725728d3aa9236f47b80b9b12) *)
|
||||
|
||||
This is the INSTALL file for the ppx_custom_printf distribution.
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
|
||||
In order to compile this package, you will need:
|
||||
|
||||
-* ocaml (>= 4.02.3)
|
||||
+* ocaml (>= 4.03.0)
|
||||
* findlib (>= 1.3.2)
|
||||
* ppx_core for library ppx_custom_printf
|
||||
* ppx_driver for library ppx_custom_printf, executable ppx
|
||||
diff -uNr ppx_custom_printf-113.33.00/_oasis ppx_custom_printf-113.33.00+4.03/_oasis
|
||||
--- ppx_custom_printf-113.33.00/_oasis 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/_oasis 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_custom_printf
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Printf-style format-strings for user-defined string conversion
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_custom_printf-113.33.00/opam ppx_custom_printf-113.33.00+4.03/opam
|
||||
--- ppx_custom_printf-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/opam 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -17,4 +17,4 @@
|
||||
"ppx_sexp_conv"
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_custom_printf-113.33.00/setup.ml ppx_custom_printf-113.33.00+4.03/setup.ml
|
||||
--- ppx_custom_printf-113.33.00/setup.ml 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/setup.ml 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -1,5 +1,5 @@
|
||||
(* OASIS_START *)
|
||||
-(* DO NOT EDIT (digest: c9a6b21baa91c0680f8cba2e849204cf) *)
|
||||
+(* DO NOT EDIT (digest: 924f534c954af21abd6099b21f46beee) *)
|
||||
(*
|
||||
Regenerated by OASIS v0.4.5
|
||||
Visit http://oasis.forge.ocamlcore.org for more information and
|
||||
@@ -6666,12 +6666,12 @@
|
||||
package =
|
||||
{
|
||||
oasis_version = "0.4";
|
||||
- ocaml_version = Some (OASISVersion.VGreaterEqual "4.02.3");
|
||||
+ ocaml_version = Some (OASISVersion.VGreaterEqual "4.03.0");
|
||||
findlib_version = Some (OASISVersion.VGreaterEqual "1.3.2");
|
||||
alpha_features = [];
|
||||
beta_features = [];
|
||||
name = "ppx_custom_printf";
|
||||
- version = "113.33.00";
|
||||
+ version = "113.33.00+4.03";
|
||||
license =
|
||||
OASISLicense.DEP5License
|
||||
(OASISLicense.DEP5Unit
|
||||
@@ -6841,7 +6841,7 @@
|
||||
};
|
||||
oasis_fn = Some "_oasis";
|
||||
oasis_version = "0.4.5";
|
||||
- oasis_digest = Some "Hd\2128>@-\017\228\178\138\253\228l<\r";
|
||||
+ oasis_digest = Some "UJ\215>\004\182B+\173\217\151\0165\212\011,";
|
||||
oasis_exec = None;
|
||||
oasis_setup_args = [];
|
||||
setup_update = false
|
||||
diff -uNr ppx_custom_printf-113.33.00/src/META ppx_custom_printf-113.33.00+4.03/src/META
|
||||
--- ppx_custom_printf-113.33.00/src/META 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/src/META 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -1,6 +1,6 @@
|
||||
# OASIS_START
|
||||
-# DO NOT EDIT (digest: 2dabcf3bd944c3b9b0a168e17d64eb20)
|
||||
-version = "113.33.00"
|
||||
+# DO NOT EDIT (digest: 148f0da22163c9e0ef38850349ca8160)
|
||||
+version = "113.33.00+4.03"
|
||||
description =
|
||||
"Printf-style format-strings for user-defined string conversion"
|
||||
requires =
|
||||
diff -uNr ppx_custom_printf-113.33.00/src/ppx_custom_printf.ml ppx_custom_printf-113.33.00+4.03/src/ppx_custom_printf.ml
|
||||
--- ppx_custom_printf-113.33.00/src/ppx_custom_printf.ml 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_custom_printf-113.33.00+4.03/src/ppx_custom_printf.ml 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -182,7 +182,7 @@
|
||||
let ty = Parse.core_type lexbuf in
|
||||
let e = Ppx_sexp_conv_expander.Sexp_of.core_type ty in
|
||||
let arg = gen_symbol () in
|
||||
- pexp_fun ~loc "" None (pvar ~loc arg)
|
||||
+ pexp_fun ~loc Nolabel None (pvar ~loc arg)
|
||||
(eapply ~loc sexp_converter [eapply ~loc e [evar ~loc arg]])
|
||||
| None ->
|
||||
let fail loc =
|
||||
@@ -214,7 +214,7 @@
|
||||
let func = pexp_ident ~loc (Located.mk ~loc to_string_id) in
|
||||
(* Eta-expand as the to_string function might take optional arguments *)
|
||||
let arg = gen_symbol () in
|
||||
- pexp_fun ~loc "" None (pvar ~loc arg) (eapply ~loc func [evar ~loc arg])
|
||||
+ pexp_fun ~loc Nolabel None (pvar ~loc arg) (eapply ~loc func [evar ~loc arg])
|
||||
|
||||
class lifter ~loc ~custom_specs = object(self)
|
||||
inherit [expression] Ppx_format_lifter.lifter as super
|
||||
@@ -296,9 +296,9 @@
|
||||
match e.pexp_desc with
|
||||
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "!"; _ }
|
||||
; pexp_attributes = ident_attrs; _ },
|
||||
- [ ("", { pexp_desc = Pexp_constant (Const_string (str, _))
|
||||
- ; pexp_loc = loc
|
||||
- ; pexp_attributes = str_attrs }) ]) ->
|
||||
+ [ (Nolabel, { pexp_desc = Pexp_constant (Pconst_string (str, _))
|
||||
+ ; pexp_loc = loc
|
||||
+ ; pexp_attributes = str_attrs }) ]) ->
|
||||
assert_no_attributes ident_attrs;
|
||||
assert_no_attributes str_attrs;
|
||||
let e' = expand_format_string ~loc str in
|
||||
@ -0,0 +1,67 @@
|
||||
diff -uNr ppx_driver-113.33.00/_oasis ppx_driver-113.33.00+4.03/_oasis
|
||||
--- ppx_driver-113.33.00/_oasis 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_driver-113.33.00+4.03/_oasis 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_driver
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Feature-full driver for OCaml AST transformers
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_driver-113.33.00/opam ppx_driver-113.33.00+4.03/opam
|
||||
--- ppx_driver-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_driver-113.33.00+4.03/opam 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -16,4 +16,4 @@
|
||||
"ppx_core"
|
||||
"ppx_optcomp"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_driver-113.33.00/src/ppx_driver.ml ppx_driver-113.33.00+4.03/src/ppx_driver.ml
|
||||
--- ppx_driver-113.33.00/src/ppx_driver.ml 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_driver-113.33.00+4.03/src/ppx_driver.ml 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -111,6 +111,24 @@
|
||||
|> fst
|
||||
;;
|
||||
|
||||
+let remove_empty_lets = object
|
||||
+ inherit Ast_traverse.map as super
|
||||
+
|
||||
+ method! structure_item st =
|
||||
+ let st = super#structure_item st in
|
||||
+ match st.pstr_desc with
|
||||
+ | Pstr_value (_, []) ->
|
||||
+ let (module B) = Ast_builder.make st.pstr_loc in
|
||||
+ B.pstr_value Nonrecursive [B.value_binding ~pat:B.punit ~expr:B.eunit]
|
||||
+ | _ -> st
|
||||
+
|
||||
+ method! expression e =
|
||||
+ let e = super#expression e in
|
||||
+ match e.pexp_desc with
|
||||
+ | Pexp_let (_, [], e) -> e
|
||||
+ | _ -> e
|
||||
+end
|
||||
+
|
||||
let map_structure st =
|
||||
let st =
|
||||
if !perform_checks then begin
|
||||
@@ -123,6 +141,7 @@
|
||||
apply_transforms st ~field:(fun (ct : Transform.t) -> ct.impl)
|
||||
~dropped_so_far:Attribute.dropped_so_far_structure
|
||||
in
|
||||
+ let st = remove_empty_lets#structure st in
|
||||
if !perform_checks then begin
|
||||
Attribute.check_unused#structure st;
|
||||
Extension.check_unused#structure st;
|
||||
@@ -143,6 +162,7 @@
|
||||
apply_transforms sg ~field:(fun ct -> ct.intf)
|
||||
~dropped_so_far:Attribute.dropped_so_far_signature
|
||||
in
|
||||
+ let sg = remove_empty_lets#signature sg in
|
||||
if !perform_checks then begin
|
||||
Attribute.check_unused#signature sg;
|
||||
Extension.check_unused#signature sg;
|
||||
@ -0,0 +1,40 @@
|
||||
diff -uNr ppx_enumerate-113.33.00/_oasis ppx_enumerate-113.33.00+4.03/_oasis
|
||||
--- ppx_enumerate-113.33.00/_oasis 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_enumerate-113.33.00+4.03/_oasis 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_enumerate
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Generate a list containing all values of a finite type
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_enumerate-113.33.00/opam ppx_enumerate-113.33.00+4.03/opam
|
||||
--- ppx_enumerate-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_enumerate-113.33.00+4.03/opam 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -16,4 +16,4 @@
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
"ppx_type_conv"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_enumerate-113.33.00/src/ppx_enumerate.ml ppx_enumerate-113.33.00+4.03/src/ppx_enumerate.ml
|
||||
--- ppx_enumerate-113.33.00/src/ppx_enumerate.ml 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_enumerate-113.33.00+4.03/src/ppx_enumerate.ml 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -226,10 +226,11 @@
|
||||
|
||||
and constructor_case loc cd =
|
||||
match cd.pcd_args with
|
||||
- | [] -> [%expr [ [%e econstruct cd None ] ] ]
|
||||
- | tps ->
|
||||
+ | Pcstr_tuple [] -> [%expr [ [%e econstruct cd None ] ] ]
|
||||
+ | Pcstr_tuple tps ->
|
||||
product loc tps (fun x ->
|
||||
econstruct cd (Some (pexp_tuple ~loc x)))
|
||||
+ | Pcstr_record _ -> failwith "Pcstr_record not supported"
|
||||
|
||||
and product loc tps f =
|
||||
let all = List.map tps ~f:(fun tp -> enum ~main_type:tp tp) in
|
||||
@ -0,0 +1,49 @@
|
||||
diff -uNr ppx_expect-113.33.01/expect_payload/ppx_expect_payload.ml ppx_expect-113.33.01+4.03/expect_payload/ppx_expect_payload.ml
|
||||
--- ppx_expect-113.33.01/expect_payload/ppx_expect_payload.ml 2016-03-22 17:09:17.000000000 +0100
|
||||
+++ ppx_expect-113.33.01+4.03/expect_payload/ppx_expect_payload.ml 2016-04-06 12:35:50.000000000 +0200
|
||||
@@ -63,7 +63,7 @@
|
||||
|
||||
let pattern () =
|
||||
Ast_pattern.(
|
||||
- map (single_expr_payload (pexp_loc __ (pexp_constant (const_string __ __))))
|
||||
+ map (single_expr_payload (pexp_loc __ (pexp_constant (pconst_string __ __))))
|
||||
~f:(fun f loc s tag -> f (Some (loc, s, tag)))
|
||||
|||
|
||||
map (pstr nil)
|
||||
diff -uNr ppx_expect-113.33.01/_oasis ppx_expect-113.33.01+4.03/_oasis
|
||||
--- ppx_expect-113.33.01/_oasis 2016-03-22 17:09:17.000000000 +0100
|
||||
+++ ppx_expect-113.33.01+4.03/_oasis 2016-04-06 12:35:50.000000000 +0200
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_expect
|
||||
-Version: 113.33.01
|
||||
+Version: 113.33.01+4.03
|
||||
Synopsis: Cram like framework for OCaml
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_expect-113.33.01/opam ppx_expect-113.33.01+4.03/opam
|
||||
--- ppx_expect-113.33.01/opam 2016-03-22 18:31:21.000000000 +0100
|
||||
+++ ppx_expect-113.33.01+4.03/opam 2016-04-06 12:54:27.000000000 +0200
|
||||
@@ -27,4 +27,4 @@
|
||||
"sexplib"
|
||||
"variantslib"
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_expect-113.33.01/src/expect_extension.ml ppx_expect-113.33.01+4.03/src/expect_extension.ml
|
||||
--- ppx_expect-113.33.01/src/expect_extension.ml 2016-03-22 17:09:17.000000000 +0100
|
||||
+++ ppx_expect-113.33.01+4.03/src/expect_extension.ml 2016-04-06 12:35:50.000000000 +0200
|
||||
@@ -24,9 +24,8 @@
|
||||
pstr ((
|
||||
pstr_value nonrecursive (
|
||||
value_binding
|
||||
- ~pat:(map (pstring __) ~f:(fun f x -> f (Some x)))
|
||||
+ ~pat:(alt_option (pstring __) ppat_any)
|
||||
~expr ^:: nil)
|
||||
- ||| map (pstr_eval expr nil) ~f:(fun f -> f None)
|
||||
) ^:: nil)
|
||||
|
||||
let expect_test =
|
||||
@ -0,0 +1,35 @@
|
||||
diff -uNr ppx_fail-113.33.00/_oasis ppx_fail-113.33.00+4.03/_oasis
|
||||
--- ppx_fail-113.33.00/_oasis 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_fail-113.33.00+4.03/_oasis 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -1,8 +1,8 @@
|
||||
OASISFormat: 0.4
|
||||
-OCamlVersion: >= 4.02.3
|
||||
+OCamlVersion: >= 4.03.0
|
||||
FindlibVersion: >= 1.3.2
|
||||
Name: ppx_fail
|
||||
-Version: 113.33.00
|
||||
+Version: 113.33.00+4.03
|
||||
Synopsis: Add location to calls to failwiths
|
||||
Authors: Jane Street Group, LLC <opensource@janestreet.com>
|
||||
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
|
||||
diff -uNr ppx_fail-113.33.00/opam ppx_fail-113.33.00+4.03/opam
|
||||
--- ppx_fail-113.33.00/opam 2016-03-18 12:08:01.000000000 +0100
|
||||
+++ ppx_fail-113.33.00+4.03/opam 2016-03-22 17:51:36.000000000 +0100
|
||||
@@ -17,4 +17,4 @@
|
||||
"ppx_here"
|
||||
"ppx_tools" {>= "0.99.3"}
|
||||
]
|
||||
-available: [ ocaml-version >= "4.02.3" ]
|
||||
+available: [ ocaml-version >= "4.03.0" ]
|
||||
diff -uNr ppx_fail-113.33.00/src/ppx_fail.ml ppx_fail-113.33.00+4.03/src/ppx_fail.ml
|
||||
--- ppx_fail-113.33.00/src/ppx_fail.ml 2016-03-09 16:44:54.000000000 +0100
|
||||
+++ ppx_fail-113.33.00+4.03/src/ppx_fail.ml 2016-03-22 15:13:50.000000000 +0100
|
||||
@@ -12,7 +12,7 @@
|
||||
match e.pexp_desc with
|
||||
| Pexp_ident { txt = Lident "failwiths"; _ } ->
|
||||
let loc = e.pexp_loc in
|
||||
- pexp_apply e ~loc [("here", Ppx_here_expander.lift_position ~loc)]
|
||||
+ pexp_apply e ~loc [(Labelled "here", Ppx_here_expander.lift_position ~loc)]
|
||||
| _ -> super#expression e
|
||||
end
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in new issue