diff --git a/.gitignore b/.gitignore index a7529f3946..e28d012e35 100644 --- a/.gitignore +++ b/.gitignore @@ -1,13 +1,6 @@ _build -src/unix/lwt_config.ml -src/unix/lwt_config.h -src/unix/lwt_unix_jobs_generated.ml -src/unix/jobs-unix/ -setup.data -setup.log -setup.exe -setup-dev.exe -_opam +src/unix/lwt_config +src/jbuild-ignore # Coverage analysis. bisect*.out @@ -15,3 +8,7 @@ _coverage/ # For local work, tests, etc. scratch/ + +# Autogenerated by jbuider +.merlin +*.install diff --git a/.jenkins.sh b/.jenkins.sh index 0e96b3f2de..ffa8fce56e 100644 --- a/.jenkins.sh +++ b/.jenkins.sh @@ -1,14 +1,17 @@ opam pin add --no-action lwt . opam install camlp4 opam install ssl lablgtk react conf-libev +opam install ocamlbuild uchar opam install --deps-only lwt opam install --verbose lwt do_build_doc () { - rm -rf _build/lwt-api.wikidocdir - ./setup-dev.exe -build lwt-api.wikidocdir/index.wiki + rm -rf doc/api + # generate wikidoc documentation + make doc-api-wiki + # copy manual pages and api documentation cp -Rf doc/*.wiki ${MANUAL_SRC_DIR} - cp -Rf _build/lwt-api.wikidocdir/*.wiki ${API_DIR} + cp -Rf doc/api/wiki/*.wiki ${API_DIR} } do_remove () { diff --git a/.merlin b/.merlin deleted file mode 100644 index eea11d3a18..0000000000 --- a/.merlin +++ /dev/null @@ -1,9 +0,0 @@ -S src/** - -B _build/** - -S tests/ -S doc/examples/ - -PKG result -PKG bytes diff --git a/.travis.yml b/.travis.yml index a6addab363..76b65b0bfa 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,8 +8,8 @@ matrix: env: COMPILER=4.03 - os: linux env: COMPILER=4.04 - - os: linux - env: COMPILER=4.05 + #- os: linux + # env: COMPILER=4.05 - os: linux env: COMPILER=4.04 FLAMBDA=yes - os: linux diff --git a/META.lwt.template b/META.lwt.template new file mode 100644 index 0000000000..f53e6d385e --- /dev/null +++ b/META.lwt.template @@ -0,0 +1,134 @@ +# +# This file has been copied from _build/default/META.lwt then +# modified to add exists_if clauses to support optional +# compilation and the camlp4 syntax extension packages have +# been given appropriate predicates. +# + +version = "dev" +description = "Monadic promises and concurrent I/O" +requires = "bytes result" +archive(byte) = "lwt.cma" +archive(native) = "lwt.cmxa" +plugin(byte) = "lwt.cma" +plugin(native) = "lwt.cmxs" +package "log" ( + directory = "log" + version = "dev" + description = "Logger for Lwt" + requires = "bytes lwt result" + archive(byte) = "lwt_log.cma" + archive(native) = "lwt_log.cmxa" + plugin(byte) = "lwt_log.cma" + plugin(native) = "lwt_log.cmxs" + exists_if = "lwt_log.cma" +) +package "ppx" ( + directory = "ppx" + version = "dev" + description = "Lwt PPX syntax extension" + requires(ppx_driver) = "compiler-libs + compiler-libs.common + ocaml-migrate-parsetree + ppx_tools_versioned" + archive(ppx_driver,byte) = "ppx_lwt.cma" + archive(ppx_driver,native) = "ppx_lwt.cmxa" + plugin(ppx_driver,byte) = "ppx_lwt.cma" + plugin(ppx_driver,native) = "ppx_lwt.cmxs" + exists_if = "ppx_lwt.cma" + # This is what jbuilder uses to find out the runtime dependencies of + # a preprocessor + ppx_runtime_deps = "bytes lwt result" + # This line makes things transparent for people mixing preprocessors + # and normal dependencies + requires(-ppx_driver) = "lwt.ppx.deprecated-ppx-method" + package "deprecated-ppx-method" ( + version = "dev" + description = "glue package for the deprecated method of using ppx" + requires = "bytes lwt result" + ppx(-ppx_driver,-custom_ppx) = "./ppx.exe --as-ppx" + exists_if = "ppx_lwt.cma" + ) +) +package "preemptive" ( + directory = "preemptive" + version = "dev" + description = "Preemptive thread support for Lwt" + requires = "bigarray + bytes + lwt + lwt.log + lwt.unix + result + threads + threads.posix + unix" + archive(byte) = "lwt_preemptive.cma" + archive(native) = "lwt_preemptive.cmxa" + plugin(byte) = "lwt_preemptive.cma" + plugin(native) = "lwt_preemptive.cmxs" + exists_if = "lwt_preemptive.cma" +) +package "simple-top" ( + directory = "simple-top" + version = "dev" + description = "Lwt-OCaml top level integration (deprecated; use utop)" + requires = "bigarray + bytes + compiler-libs + compiler-libs.common + lwt + lwt.log + lwt.unix + result + unix" + archive(byte) = "lwt_simple_top.cma" + archive(native) = "lwt_simple_top.cmxa" + plugin(byte) = "lwt_simple_top.cma" + plugin(native) = "lwt_simple_top.cmxs" + exists_if = "lwt_simple_top.cma" +) +package "syntax" ( + directory = "syntax" + version = "dev" + description = "Camlp4 syntax for Lwt (deprecated; use lwt.ppx)" + requires = "camlp4 lwt.syntax.options" + archive(syntax, preprocessor) = "lwt_syntax.cma" + archive(syntax, toploop) = "lwt_syntax.cma" + archive(syntax, preprocessor, native) = "lwt_syntax.cmxa" + archive(syntax, preprocessor, native, plugin) = "lwt_syntax.cmxs" + exists_if = "lwt_syntax.cma" + package "log" ( + directory = "log" + version = "dev" + description = "Camlp4 syntax for Lwt logging (deprecated; use lwt.ppx)" + requires = "camlp4 lwt.syntax.options" + archive(syntax, preprocessor) = "lwt_syntax_log.cma" + archive(syntax, toploop) = "lwt_syntax_log.cma" + archive(syntax, preprocessor, native) = "lwt_syntax_log.cmxa" + archive(syntax, preprocessor, native, plugin) = "lwt_syntax_log.cmxs" + exists_if = "lwt_syntax_log.cma" + ) + package "options" ( + directory = "options" + version = "dev" + description = "Options for Lwt Camlp4 syntax extension (deprecated; use lwt.ppx)" + requires = "camlp4" + archive(syntax, preprocessor) = "lwt_syntax_options.cma" + archive(syntax, toploop) = "lwt_syntax_options.cma" + archive(syntax, preprocessor, native) = "lwt_syntax_options.cmxa" + archive(syntax, preprocessor, native, plugin) = "lwt_syntax_options.cmxs" + exists_if = "lwt_syntax_options.cma" + ) +) +package "unix" ( + directory = "unix" + version = "dev" + description = "Unix support for Lwt" + requires = "bigarray bytes lwt lwt.log result unix" + archive(byte) = "lwt_unix.cma" + archive(native) = "lwt_unix.cmxa" + plugin(byte) = "lwt_unix.cma" + plugin(native) = "lwt_unix.cmxs" + exists_if = "lwt_unix.cma" +) diff --git a/Makefile b/Makefile index 0b1bb32e64..487dc7afdd 100644 --- a/Makefile +++ b/Makefile @@ -9,70 +9,68 @@ OCAMLFIND_IGNORE_DUPS_IN = $(shell ocamlfind query compiler-libs) export OCAMLFIND_IGNORE_DUPS_IN -# Set to setup.exe for the release -SETUP := setup-dev.exe - # Default rule default: build -# Setup for the development version -setup-dev.exe: _oasis setup.ml - grep -v '^#' setup.ml > setup_dev.ml - ocamlfind ocamlopt -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || \ - ocamlfind ocamlc -o $@ -linkpkg -package ocamlbuild,oasis.dynrun setup_dev.ml || true - rm -f setup_dev.* - -# Setup for the release -setup.exe: setup.ml - ocamlopt.opt -o $@ $< || ocamlopt -o $@ $< || ocamlc -o $@ $< - rm -f setup.cmx setup.cmi setup.o setup.obj setup.cmo +# build the usual development packages +build: check-config + jbuilder build \ + --only-packages lwt \ + @install -setup: $(SETUP) +# build everything +all: check-config + jbuilder build @install -build: $(SETUP) setup.data - ./$(SETUP) -build $(BUILDFLAGS) +# run all tests +test: check-config + jbuilder runtest -doc: $(SETUP) setup.data build - ./$(SETUP) -doc $(DOCFLAGS) +# configuration +check-config: + @[ -f src/jbuild-ignore ] && [ -f src/unix/lwt_config ] && echo "LWT configuration OK" || cat src/util/config-warn -doc-api: $(SETUP) setup.data build - ./$(SETUP) -build lwt-api.docdir/index.html +default-config: + ocaml src/util/configure.ml -use-libev false -use-camlp4 false -test: $(SETUP) setup.data build clean-coverage - ./$(SETUP) -test $(TESTFLAGS) +# Use jbuilder/odoc to generate static html documentation. +# Currenty requires ocaml 4.03.0 to install odoc. +doc: + jbuilder build @doc -all: $(SETUP) - ./$(SETUP) -all $(ALLFLAGS) +# Build HTML documentation with ocamldoc +doc-api-html: all + make -C doc api/html/index.html -install: $(SETUP) setup.data - ./$(SETUP) -install $(INSTALLFLAGS) +# Build wiki documentation with wikidoc +# requires ocaml 4.03.0 and pinning the repo +# https://github.com/ocsigen/wikidoc +doc-api-wiki: all + make -C doc api/wiki/index.wiki -uninstall: $(SETUP) setup.data - ./$(SETUP) -uninstall $(UNINSTALLFLAGS) +install: + jbuilder install -reinstall: $(SETUP) setup.data - ./$(SETUP) -reinstall $(REINSTALLFLAGS) +uninstall: + jbuilder uninstall -clean: $(SETUP) clean-coverage - ./$(SETUP) -clean $(CLEANFLAGS) +reinstall: + jbuilder uninstall + jbuilder install -distclean: $(SETUP) - ./$(SETUP) -distclean $(DISTCLEANFLAGS) - rm -rf setup*.exe +clean: + rm -fr _build + rm -f *.install + rm -fr doc/api + rm -f src/jbuild-ignore src/unix/lwt_config clean-coverage: rm -rf bisect*.out rm -rf _coverage/ -configure: $(SETUP) - ./$(SETUP) -configure $(CONFIGUREFLAGS) - -setup.data: $(SETUP) - ./$(SETUP) -configure $(CONFIGUREFLAGS) - coverage: test bisect-ppx-report -I _build/ -html _coverage/ bisect*.out bisect-ppx-report -text - -summary-only bisect*.out @echo See _coverage/index.html -.PHONY: default setup build doc test all install uninstall reinstall clean distclean configure coverage +.PHONY: default build doc test all install uninstall reinstall clean coverage diff --git a/_oasis b/_oasis deleted file mode 100644 index 74d7a90860..0000000000 --- a/_oasis +++ /dev/null @@ -1,440 +0,0 @@ -# +-------------------------------------------------------------------+ -# | Package parameters | -# +-------------------------------------------------------------------+ - -OASISFormat: 0.4 -OCamlVersion: >= 4.02 -Name: lwt -Version: 3.0.0 -LicenseFile: COPYING -License: LGPL-2.1 with OCaml linking exception -Authors: - Jérôme Vouillon, - Vincent Balat, - Nataliya Guts, - Pierre Clairambault, - Stéphane Glondu, - Jérémie Dimino, - Warren Harris, - Pierre Chambart, - Mauricio Fernandez, - Grégoire Henri, - Gabriel Radanne, - Peter Zotov, - Hugo Heuzard, - Vincent Bernardoff, - Romain Slootmaekers -Homepage: http://ocsigen.org/lwt/ -BuildTools: ocamlbuild -Plugins: DevFiles (0.4), META (0.4) -XDevFilesEnableMakefile: false -PostConfCommand: ocaml src/util/discover.ml -ext-obj $ext_obj -exec-name $default_executable_name -use-libev $libev -os-type $os_type -use-glib $glib -ccomp-type $ccomp_type -use-pthread $pthread -use-unix $unix -android-target $android_target -libev_default $libev_default -PostDistCleanCommand: $rm src/unix/lwt_config.h src/unix/lwt_config.ml src/unix/lwt_unix_jobs_generated.ml src/unix/jobs-unix/* - -AlphaFeatures: pure_interface, ocamlbuild_more_args -XOCamlbuildPluginTags: package(cppo_ocamlbuild) - -Synopsis: Monadic promises and concurrent I/O -Description: - A promise is a value that may become determined in the future. Lwt provides - typed, composable promises. Promises that are resolved by I/O are resolved by - Lwt in parallel. Meanwhile, OCaml code, including code creating and waiting on - promises, runs in a single thread by default. This reduces the need for locks - or other nchronization primitives. Code can be run in parallel on an opt-in - basis. - - -# +-------------------------------------------------------------------+ -# | Flags | -# +-------------------------------------------------------------------+ - -Flag android_target - Description: Compiles for Android - Default: false - -Flag all - Description: build and install everything - Default: false - -Flag camlp4 - Description: Build the syntax extension - Default$: flag(all) - -Flag ppx - Description: Build the ppx syntax extension - Default$: flag(all) - -Flag unix - Description: Unix support - Default: true - -Flag react - Description: React helpers - Default$: flag(all) - -Flag glib - Description: GLib integration - Default$: flag(all) - -Flag ssl - Description: SSL support - Default$: flag(all) - -Flag preemptive - Description: Preemptive threads support - Default$: flag(unix) && !flag(android_target) - -Flag libev - Description: Compile with libev support - Default$: !os_type(Win32) && !flag(android_target) - -Flag libev_default - Description: Use the libev backend by default - Default$: system(linux) || system(linux_elf) || system(linux_aout) || system(linux_eabi) || system(linux_eabihf) - -Flag pthread - Description: Use pthread - Default$: !os_type(Win32) - -Flag coverage - Description: Instrument for coverage analysis - Default: false - -# +-------------------------------------------------------------------+ -# | Libraries | -# +-------------------------------------------------------------------+ - -Library "lwt" - Path: src/core - Modules: - Lwt_condition, - Lwt_list, - Lwt, - Lwt_mutex, - Lwt_mvar, - Lwt_pool, - Lwt_result, - Lwt_sequence, - Lwt_stream, - Lwt_switch, - Lwt_pqueue - BuildDepends: bytes, result - XMETADescription: Lightweight thread library for OCaml (core library) - -Library "lwt-log" - FindlibName: log - FindlibParent: lwt - Path: src/logger - Modules: Lwt_log_core, Lwt_log_rules - BuildDepends: lwt - XMETADescription: Logger for Lwt - -Library "lwt-unix" - Build$: flag(unix) || flag(all) - Install$: flag(unix) || flag(all) - FindlibName: unix - FindlibParent: lwt - Path: src/unix - Modules: - Lwt_chan, - Lwt_daemon, - Lwt_gc, - Lwt_io, - Lwt_log, - Lwt_main, - Lwt_process, - Lwt_throttle, - Lwt_timeout, - Lwt_unix, - Lwt_sys, - Lwt_engine, - Lwt_bytes - InternalModules: - Lwt_unix_jobs_generated, - Lwt_config - BuildDepends: lwt, lwt.log, unix, bigarray - XMETADescription: Unix support for Lwt - CSources: - lwt_config.h, - lwt_unix.h, - lwt_unix_stubs.c, - lwt_libev_stubs.c, - lwt_process_stubs.c, - jobs-unix/lwt_unix_job_access.c, - jobs-unix/lwt_unix_job_chdir.c, - jobs-unix/lwt_unix_job_chmod.c, - jobs-unix/lwt_unix_job_chown.c, - jobs-unix/lwt_unix_job_chroot.c, - jobs-unix/lwt_unix_job_close.c, - jobs-unix/lwt_unix_job_fchmod.c, - jobs-unix/lwt_unix_job_fchown.c, - jobs-unix/lwt_unix_job_fdatasync.c, - jobs-unix/lwt_unix_job_fsync.c, - jobs-unix/lwt_unix_job_ftruncate.c, - jobs-unix/lwt_unix_job_link.c, - jobs-unix/lwt_unix_job_lseek.c, - jobs-unix/lwt_unix_job_mkdir.c, - jobs-unix/lwt_unix_job_mkfifo.c, - jobs-unix/lwt_unix_job_rename.c, - jobs-unix/lwt_unix_job_rmdir.c, - jobs-unix/lwt_unix_job_symlink.c, - jobs-unix/lwt_unix_job_tcdrain.c, - jobs-unix/lwt_unix_job_tcflow.c, - jobs-unix/lwt_unix_job_tcflush.c, - jobs-unix/lwt_unix_job_tcsendbreak.c, - jobs-unix/lwt_unix_job_truncate.c, - jobs-unix/lwt_unix_job_unlink.c - if os_type(Win32) && ccomp_type(msvc) - CCLib+: ws2_32.lib - else if os_type(Win32) - CCLib+: -lws2_32 - -Library "lwt-simple-top" - Build$: flag(unix) || flag(all) - Install$: flag(unix) || flag(all) - FindlibName: simple-top - FindlibParent: lwt - Path: src/simple_top - InternalModules: Lwt_simple_top - BuildDepends: lwt, lwt.unix, compiler-libs.common - XMETADescription: Lwt-OCaml top level integration (deprecated; use utop) - -# This library is built through this build system only in development. For the -# release build system, see src/react/_oasis. -Library "lwt-react" - Build$: flag(react) || flag(all) - Install$: flag(react) || flag(all) - FindlibName: react - FindlibParent: lwt - Path: src/react - Modules: Lwt_react - BuildDepends: lwt, react - XMETADescription: Reactive programming helpers for Lwt (deprecated; use package lwt_react) - -Library "lwt-preemptive" - Build$: flag(preemptive) || flag(all) - Install$: flag(preemptive) || flag(all) - FindlibName: preemptive - FindlibParent: lwt - Path: src/preemptive - Modules: Lwt_preemptive - BuildDepends: lwt, lwt.unix, threads - XMETADescription: Preemptive thread support for Lwt - -# This library is built through this build system only in development. For the -# release build system, see src/glib/_oasis. -Library "lwt-glib" - Build$: flag(glib) || flag(all) - Install$: flag(glib) || flag(all) - FindlibName: glib - FindlibParent: lwt - Path: src/glib - Modules: Lwt_glib - CSources: lwt_glib_stubs.c - BuildDepends: lwt, lwt.unix - XMETADescription: GLib integration for Lwt (deprecated; use package lwt_glib) - -# This library is built through this build system only in development. For the -# release build system, see src/ssl/_oasis. -Library "lwt-ssl" - Build$: flag(ssl) || flag(all) - Install$: flag(ssl) || flag(all) - FindlibName: ssl - FindlibParent: lwt - Path: src/ssl - Modules: Lwt_ssl - BuildDepends: ssl, lwt.unix - XMETADescription: SSL support for Lwt (deprecated; use package lwt_ssl) - -Library "lwt-syntax" - Build$: flag(camlp4) || flag(all) - Install$: flag(camlp4) || flag(all) - FindlibName: syntax - FindlibParent: lwt - Path: src/camlp4 - Modules: Pa_lwt - BuildDepends: camlp4, camlp4.quotations.o, camlp4.extend - XMETAType: syntax - XMETADescription: Camlp4 syntax for Lwt (deprecated; use lwt.ppx) - XMETARequires: camlp4, lwt.syntax.options - -Library "lwt-syntax-options" - Build$: flag(camlp4) || flag(all) - Install$: flag(camlp4) || flag(all) - FindlibName: options - FindlibParent: lwt-syntax - Path: src/camlp4 - InternalModules: Pa_lwt_options - BuildDepends: camlp4 - XMETAType: syntax - XMETADescription: Options for Lwt Camlp4 syntax extension (deprecated; use lwt.ppx) - XMETARequires: camlp4 - -Library "lwt-syntax-log" - Build$: flag(camlp4) || flag(all) - Install$: flag(camlp4) || flag(all) - FindlibName: log - FindlibParent: lwt-syntax - Path: src/camlp4 - Modules: Pa_lwt_log - BuildDepends: camlp4, camlp4.quotations.o - XMETAType: syntax - XMETADescription: Camlp4 syntax for Lwt logging (deprecated; use lwt.ppx) - XMETARequires: camlp4, lwt.syntax.options - -Library "ppx" - Build$: flag(ppx) || flag(all) - Install$: flag(ppx) || flag(all) - FindlibName: ppx - FindlibParent: lwt - Path: src/ppx - Modules: Ppx_lwt - XMETADescription: Lwt PPX syntax extension - XMETARequires: lwt - XMETAExtraLines: ppx = "ppx_lwt" - -Executable "ppx_lwt" - Build$: flag(ppx) || flag(all) - Install$: flag(ppx) || flag(all) - Path: src/ppx - MainIs: ppx_lwt_ex.ml - BuildDepends: compiler-libs.common, ppx_tools.metaquot - CompiledObject: best - -# +-------------------------------------------------------------------+ -# | Doc | -# +-------------------------------------------------------------------+ - -Document "lwt-api" - Title: API reference for Lwt - Type: ocamlbuild (0.3) - Install: true - InstallDir: $htmldir/api - DataFiles: src/util/style.css - BuildTools: ocamldoc - XOCamlbuildPath: ./ - XOCamlbuildLibraries: - lwt, - lwt.glib, - lwt.preemptive, - lwt.react, - lwt.ssl, - lwt.log, - lwt.unix, - lwt.syntax, - lwt.syntax.log, - lwt.ppx - -# +-------------------------------------------------------------------+ -# | Examples | -# +-------------------------------------------------------------------+ - -Executable logging - Path: doc/examples/unix - Build$: flag(unix) && flag(ppx) - Install: false - MainIs: logging.ml - BuildDepends: lwt.unix, lwt.ppx - CompiledObject: best - -Executable relay - Path: doc/examples/unix - Build$: flag(unix) && flag(ppx) - Install: false - MainIs: relay.ml - BuildDepends: lwt.unix, lwt.ppx - CompiledObject: best - -Executable parallelize - Path: doc/examples/unix - Build$: flag(unix) && flag(ppx) - Install: false - MainIs: parallelize.ml - BuildDepends: lwt.unix, lwt.ppx - CompiledObject: best - -# +-------------------------------------------------------------------+ -# | Tests | -# +-------------------------------------------------------------------+ - -Library test - Path: tests - Modules: Test - Install: false - Build$: flag(tests) && (flag(unix) || flag(all)) - BuildDepends: lwt, unix, lwt.unix - -Executable test_core - Path: tests/core - Build$: flag(tests) && (flag(unix) || flag(all)) - Install: false - CompiledObject: best - MainIs: main.ml - BuildDepends: test, lwt, unix, lwt.unix - -Executable test_unix - Path: tests/unix - Build$: flag(tests) && (flag(unix) || flag(all)) - Install: false - CompiledObject: best - MainIs: main.ml - BuildDepends: test, lwt, unix, lwt.unix - -Executable test_react - Path: tests/react - Build$: flag(tests) && ((flag(unix) && flag(react)) || flag(all)) - Install: false - CompiledObject: best - MainIs: main.ml - BuildDepends: test, lwt, unix, lwt.unix, react, lwt.react - -Executable test_preemptive - Path: tests/preemptive - Build$: flag(tests) && ((flag(preemptive) && flag(unix)) || flag(all)) - Install: false - CompiledObject: best - MainIs: main.ml - BuildDepends: test, lwt, unix, lwt.unix, lwt.preemptive, threads - -Executable test_ppx - Path: tests/ppx - Build$: flag(tests) && ((flag(ppx) && flag(unix)) || flag(all)) - Install: false - CompiledObject: best - MainIs: main.ml - BuildTools: ppx_lwt - BuildDepends: test, lwt, lwt.unix - -Test core - Command: $test_core - TestTools: test_core - Run$: flag(tests) && (flag(unix) || flag(all)) - -Test unix - Command: $test_unix - TestTools: test_unix - Run$: flag(tests) && (flag(unix) || flag(all)) - -Test react - Command: $test_react - TestTools: test_react - Run$: flag(tests) && ((flag(unix) && flag(react)) || flag(all)) - -Test preemptive - Command: $test_preemptive - TestTools: test_preemptive - Run$: flag(tests) && ((flag(preemptive) && flag(unix)) || flag(all)) - -Test ppx - Command: $test_ppx - TestTools: test_ppx - Run$: flag(tests) && ((flag(ppx) && flag(unix)) || flag(all)) - -# +-------------------------------------------------------------------+ -# | Misc | -# +-------------------------------------------------------------------+ - -SourceRepository head - Type: git - Location: git://github.com/ocsigen/lwt - Browser: https://github.com/ocsigen/lwt diff --git a/_tags b/_tags deleted file mode 100644 index 6f37a509a9..0000000000 --- a/_tags +++ /dev/null @@ -1,33 +0,0 @@ -# -*- conf -*- -not : safe_string - -# cppo pre-processing for OCaml (compiler/stdlib) compatibility workarounds -<**/*.ml>: cppo_V_OCAML -<**/*.mli>: cppo_V_OCAML - -# Warnings. The order is important. This is not fully legitimate as it appears -# to depend on how Ocamlbuild internally handles lists of warn() tags. - or : warn(-4) -: warn(-3) -<**/*>: warn(+A-29-58) - -# Syntax extension -: syntax(camlp4o) - -# Stubs -: use_C_libev, use_C_pthread -: use_C_glib -<**/*.c>: use_lwt_headers -<**/*.h>: use_lwt_headers - -# Ppx tests -: ppx_lwt - -# Examples -: ppx_lwt - -# Scratch directory -"scratch": -traverse - -# OASIS_START -# OASIS_STOP diff --git a/opam/descr b/descr similarity index 100% rename from opam/descr rename to descr diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000000..ec4ed687d6 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,50 @@ +BLD=../_build/default/src +SRC=../src + +PKGS=\ + -package bytes -package result \ + -package bigarray -package unix -package camlp4 \ + -package ocaml-migrate-parsetree -package ppx_tools_versioned \ + -package react -package ssl + +INCS=\ + -I ${BLD}/camlp4 \ + -I ${BLD}/core \ + -I ${BLD}/glib \ + -I ${BLD}/logger \ + -I ${BLD}/ppx \ + -I ${BLD}/preemptive \ + -I ${BLD}/react \ + -I ${BLD}/simple_top \ + -I ${BLD}/ssl \ + -I ${BLD}/unix + +MLIS=\ + $(wildcard ${SRC}/camlp4/*.mli) \ + $(wildcard ${SRC}/core/*.mli) \ + $(wildcard ${SRC}/glib/*.mli) \ + $(wildcard ${SRC}/logger/*.mli) \ + $(wildcard ${SRC}/ppx/*.mli) \ + $(wildcard ${SRC}/preemptive/*.mli) \ + $(wildcard ${SRC}/react/*.mli) \ + $(wildcard ${SRC}/simple_top/*.mli) \ + $(wildcard ${SRC}/ssl/*.mli) \ + $(filter-out ${BLD}/unix/lwt_unix.cppo.mli,$(wildcard ${BLD}/unix/*.mli)) + +DOCOPT := -colorize-code -short-functors -charset utf-8 + +.PHONY: doc wikidoc +doc: api/html/index.html +api/html/index.html: ${MLIS} apiref-intro + mkdir -p api/html + ocamlfind ocamldoc ${DOCOPT} -package ocamlbuild,uchar ${PKGS} ${INCS} -intro apiref-intro -html \ + -d api/html \ + ${MLIS} + +wikidoc: api/wiki/index.wiki +api/wiki/index.wiki: ${MLIS} apiref-intro + mkdir -p api/wiki + ocamlfind ocamldoc ${DOCOPT} -package ocamlbuild,uchar ${PKGS} ${INCS} -intro apiref-intro \ + -d api/wiki \ + -i $(shell ocamlfind query wikidoc) -g odoc_wiki.cma \ + ${MLIS} diff --git a/doc/examples/gtk/Makefile b/doc/examples/gtk/Makefile deleted file mode 100644 index bfc1eaf1e4..0000000000 --- a/doc/examples/gtk/Makefile +++ /dev/null @@ -1,2 +0,0 @@ -all: - ocamlbuild -use-ocamlfind -classic-display -package lwt.unix,lwt.glib,lwt.ppx,lablgtk2 connect.byte diff --git a/doc/examples/gtk/jbuild b/doc/examples/gtk/jbuild new file mode 100644 index 0000000000..3e41fb8b37 --- /dev/null +++ b/doc/examples/gtk/jbuild @@ -0,0 +1,6 @@ +(jbuild_version 1) + +(executable + ((name connect) + (libraries (lwt-unix lwt-glib threads lablgtk2)) + (preprocess (pps (lwt-ppx))))) diff --git a/doc/examples/unix/jbuild b/doc/examples/unix/jbuild new file mode 100644 index 0000000000..4c74b2bdf8 --- /dev/null +++ b/doc/examples/unix/jbuild @@ -0,0 +1,6 @@ +(jbuild_version 1) + +(executables + ((names (logging relay parallelize)) + (libraries (lwt-unix)) + (preprocess (pps (lwt-ppx))))) diff --git a/jbuild b/jbuild new file mode 100644 index 0000000000..e960b5250f --- /dev/null +++ b/jbuild @@ -0,0 +1,11 @@ +(jbuild_version 1) + +(alias + ((name unix-examples) + (deps (doc/examples/unix/logging.exe + doc/examples/unix/relay.exe + doc/examples/unix/parallelize.exe)))) + +(alias + ((name gtk-example) + (deps (doc/examples/gtk/connect.exe)))) diff --git a/jbuild-workspace.dev b/jbuild-workspace.dev new file mode 100644 index 0000000000..b004872c61 --- /dev/null +++ b/jbuild-workspace.dev @@ -0,0 +1,3 @@ +(context ((switch 4.02.3))) +(context ((switch 4.03.0))) +(context ((switch 4.04.1))) diff --git a/opam/opam b/lwt.opam similarity index 62% rename from opam/opam rename to lwt.opam index 26effc65d0..6af2df8ebc 100644 --- a/opam/opam +++ b/lwt.opam @@ -16,31 +16,17 @@ bug-reports: "https://github.com/ocsigen/lwt/issues" license: "LGPL with OpenSSL linking exception" dev-repo: "https://github.com/ocsigen/lwt.git" build: [ - [make "setup"] - ["ocaml" "setup.ml" "-configure" - "--prefix" prefix - "--%{conf-libev:enable}%-libev" - "--%{camlp4:enable}%-camlp4" - "--%{base-unix:enable}%-unix" - "--%{base-threads:enable}%-preemptive" - "--%{ppx_tools:enable}%-ppx"] - [make "build"] + [ "ocaml" "src/util/configure.ml" "-use-libev" "%{conf-libev:installed}%" + "-use-camlp4" "%{camlp4:installed}%" ] + [ "jbuilder" "build" "-p" name "-j" jobs ] ] -build-test: [ - ["ocaml" "setup.ml" "-configure" "--enable-tests"] - [make "test"] -] -install: [[make "install"]] -remove: [[ "ocamlfind" "remove" "lwt" ]] +build-test: [ [ "jbuilder" "runtest" "-p" name ] ] depends: [ "ocamlfind" {build & >= "1.5.0"} - "ocamlbuild" {build} + "jbuilder" { build & >= "1.0+beta9" } + "ppx_tools_versioned" + "cppo" { build } "result" - "cppo" {build} - # See https://github.com/ocsigen/lwt/issues/266 - ( "base-no-ppx" | "ppx_tools" {build} ) - ## OASIS is not required in released version - "oasis" {build & >= "0.4.8"} ] depopts: [ "base-threads" @@ -48,9 +34,8 @@ depopts: [ "conf-libev" "camlp4" ] -conflicts: [ - "ppx_tools" {< "1.0.0" } -] +# In practice, Lwt requires OCaml >= 4.02.3, as that is a constraint of the +# dependency jbuilder. available: [ocaml-version >= "4.02.0" & compiler != "4.02.1+BER"] messages: [ "For module Lwt_ssl, please install package lwt_ssl" diff --git a/src/glib/opam b/lwt_glib.opam similarity index 65% rename from src/glib/opam rename to lwt_glib.opam index bcae082a04..4ab92fe1f4 100644 --- a/src/glib/opam +++ b/lwt_glib.opam @@ -1,8 +1,10 @@ opam-version: "1.2" name: "lwt_glib" -version: "1.0.1" +version: "dev" maintainer: [ "Anton Bachin " + "Mauricio Fernandez " + "Simon Cruanes " ] authors: [ "Jérémie Dimino" @@ -12,17 +14,10 @@ doc: "https://ocsigen.org/lwt/manual/" dev-repo: "https://github.com/ocsigen/lwt.git" bug-reports: "https://github.com/ocsigen/lwt/issues" license: "LGPL with OpenSSL linking exception" -build: [ - [make "configure"] - [make "build"] -] -install: [ - [make "install"] -] -remove: [ - ["ocamlfind" "remove" "lwt_glib"] -] +build: [ [ "jbuilder" "build" "-p" name "-j" jobs ] ] +build-test: [ [ "jbuilder" "runtest" "-p" name ] ] depends: [ + "jbuilder" { build & >= "1.0+beta9" } "lwt" {>= "3.0.0"} "base-unix" "conf-pkg-config" {build} diff --git a/src/react/opam b/lwt_react.opam similarity index 62% rename from src/react/opam rename to lwt_react.opam index d88ae46f63..947748ad6b 100644 --- a/src/react/opam +++ b/lwt_react.opam @@ -1,8 +1,10 @@ opam-version: "1.2" name: "lwt_react" -version: "1.0.1" +version: "dev" maintainer: [ "Anton Bachin " + "Mauricio Fernandez " + "Simon Cruanes " ] authors: [ "Jérémie Dimino" @@ -12,17 +14,10 @@ doc: "https://ocsigen.org/lwt/manual/" dev-repo: "https://github.com/ocsigen/lwt.git" bug-reports: "https://github.com/ocsigen/lwt/issues" license: "LGPL with OpenSSL linking exception" -build: [ - [make "configure"] - [make "build"] -] -install: [ - [make "install"] -] -remove: [ - ["ocamlfind" "remove" "lwt_react"] -] +build: [ [ "jbuilder" "build" "-p" name "-j" jobs ] ] +build-test: [ [ "jbuilder" "runtest" "-p" name ] ] depends: [ + "jbuilder" { build & >= "1.0+beta9" } "lwt" {>= "3.0.0"} "react" {>= "1.0.0"} ] diff --git a/src/ssl/opam b/lwt_ssl.opam similarity index 64% rename from src/ssl/opam rename to lwt_ssl.opam index c6a5dbe675..a7956ee4ca 100644 --- a/src/ssl/opam +++ b/lwt_ssl.opam @@ -1,8 +1,10 @@ opam-version: "1.2" name: "lwt_ssl" -version: "1.0.1" +version: "dev" maintainer: [ "Anton Bachin " + "Mauricio Fernandez " + "Simon Cruanes " ] authors: [ "Jérôme Vouillon" @@ -13,17 +15,10 @@ doc: "https://ocsigen.org/lwt/manual/" dev-repo: "https://github.com/ocsigen/lwt.git" bug-reports: "https://github.com/ocsigen/lwt/issues" license: "LGPL with OpenSSL linking exception" -build: [ - [make "configure"] - [make "build"] -] -install: [ - [make "install"] -] -remove: [ - ["ocamlfind" "remove" "lwt_ssl"] -] +build: [ [ "jbuilder" "build" "-p" name "-j" jobs ] ] +build-test: [ [ "jbuilder" "runtest" "-p" name ] ] depends: [ + "jbuilder" { build & >= "1.0+beta9" } "lwt" {>= "3.0.0"} "ssl" {>= "0.5.0"} "base-unix" diff --git a/myocamlbuild.ml b/myocamlbuild.ml deleted file mode 100644 index 35dce3e88d..0000000000 --- a/myocamlbuild.ml +++ /dev/null @@ -1,179 +0,0 @@ -(* OCaml promise library - * http://www.ocsigen.org/lwt - * Copyright (C) 2010 Jérémie Dimino - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as - * published by the Free Software Foundation, with linking exceptions; - * either version 2.1 of the License, or (at your option) any later - * version. See COPYING file for details. - * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - * 02111-1307, USA. - *) - -(* OASIS_START *) -(* OASIS_STOP *) - -open Ocamlbuild_plugin - -let split str = - let rec skip_spaces i = - if i = String.length str then - [] - else - if str.[i] = ' ' then - skip_spaces (i + 1) - else - extract i (i + 1) - and extract i j = - if j = String.length str then - [String.sub str i (j - i)] - else - if str.[j] = ' ' then - String.sub str i (j - i) :: skip_spaces (j + 1) - else - extract i (j + 1) - in - skip_spaces 0 - -let c_library_tag name = Printf.sprintf "use_C_%s" name - -let define_c_library name env = - if BaseEnvLight.var_get name env = "true" then begin - let tag = c_library_tag name in - - let opt = - List.map - (fun x -> A x) - (split (BaseEnvLight.var_get (name ^ "_opt") env)) - and lib = - List.map - (fun x -> A x) - (split (BaseEnvLight.var_get (name ^ "_lib") env)) - in - - (* Add flags for linking with the C library: *) - flag ["ocamlmklib"; "c"; tag] & S lib; - - (* C stubs using the C library must be compiled with the library - specifics flags: *) - flag ["c"; "compile"; tag] & - S (List.map (fun arg -> S[A"-ccopt"; arg]) opt); - - (* OCaml libraries must depends on the C library: *) - flag ["link"; "ocaml"; tag] & - S (List.map (fun arg -> S[A"-cclib"; arg]) lib) - end - -let conditional_warnings_as_errors () = - match Sys.getenv "LWT_WARNINGS_AS_ERRORS" with - | "yes" -> - let flags = S [A "-warn-error"; A "+A"] in - flag ["ocaml"; "compile"] flags; - flag ["ocaml"; "link"] flags - | _ -> () - | exception Not_found -> () - -let () = dispatch begin fun hook -> - let env = - BaseEnvLight.load - ~allow_empty:true - ~filename:(Pathname.basename BaseEnvLight.default_filename) - () - in - - Ocamlbuild_cppo.dispatcher hook; - - dispatch_default hook; - - match hook with - | Before_options -> - Options.make_links := false - - | After_options -> - if BaseEnvLight.var_get "coverage" env = "true" then - Options.tag_lines := - [": package(bisect_ppx)"; - "<**/lwt_config.*>: -package(bisect_ppx)"; - " or : package(bisect_ppx)"; - ": package(bisect_ppx)"] - @ !Options.tag_lines - - | After_rules -> - (* Determine extension of CompiledObject: best *) - let native_suffix = - if BaseEnvLight.var_get "is_native" env = "true" - then "native" else "byte" - in - - flag ["ocaml"; "compile"; "ppx_lwt"] & - S [A "-ppx"; A ("src/ppx/ppx_lwt_ex." ^ native_suffix)]; - - (* Use an introduction page with categories *) - tag_file "lwt-api.docdir/index.html" ["apiref"]; - dep ["apiref"] ["doc/apiref-intro"]; - flag ["apiref"] & S[A "-intro"; P "doc/apiref-intro"; A"-colorize-code"]; - - (* Stubs: *) - dep ["file:src/unix/lwt_unix_stubs.c"] - ["src/unix/lwt_unix_unix.c"; "src/unix/lwt_unix_windows.c"]; - - let c_libraries = ["glib"; "libev"; "pthread"] in - - (* Check for "unix" because other variables are not present in the - setup.data file if lwt.unix is disabled. *) - if BaseEnvLight.var_get "unix" env = "true" then begin - List.iter (fun name -> define_c_library name env) c_libraries; - flag ["c"; "compile"; "use_lwt_headers"] & S [A"-ccopt"; A"-Isrc/unix"]; - end; - - List.iter (fun name -> - mark_tag_used (c_library_tag name)) c_libraries; - - conditional_warnings_as_errors (); - - | _ -> - () - end - -(* Compile the wiki version of the Ocamldoc. - - Thanks to Till Varoquaux on usenet: - http://www.digipedia.pl/usenet/thread/14273/231/ *) -let ocamldoc_wiki tags deps docout docdir = - let tags = tags -- "extension:html" in - Ocamlbuild_pack.Ocaml_tools.ocamldoc_l_dir tags deps docout docdir - -let () = - try - let wikidoc_dir = - let base = - Ocamlbuild_pack.My_unix.run_and_read - "ocamlfind query wikidoc 2> /dev/null" - in - String.sub base 0 (String.length base - 1) - in - - Ocamlbuild_pack.Rule.rule - "ocamldoc: document ocaml project odocl & *odoc -> wikidocdir" - ~insert:`top - ~prod:"%.wikidocdir/index.wiki" - ~stamp:"%.wikidocdir/wiki.stamp" - ~dep:"%.odocl" - (Ocamlbuild_pack.Ocaml_tools.document_ocaml_project - ~ocamldoc:ocamldoc_wiki - "%.odocl" "%.wikidocdir/index.wiki" "%.wikidocdir"); - - tag_file "lwt-api.wikidocdir/index.wiki" ["apiref";"wikidoc"]; - flag ["wikidoc"] & S[A"-i";A wikidoc_dir;A"-g";A"odoc_wiki.cma"] - - (* Silently fail if the package wikidoc isn't available *) - with Failure e -> () diff --git a/opam/files/lwt.install b/opam/files/lwt.install deleted file mode 100644 index d88814c3cd..0000000000 --- a/opam/files/lwt.install +++ /dev/null @@ -1,6 +0,0 @@ -lib: "opam/opam" { "opam" } -doc: [ - "README.md" - "CHANGES" - "doc/COPYING" { "LICENSE" } -] diff --git a/setup.ml b/setup.ml deleted file mode 100644 index 9438a7ce28..0000000000 --- a/setup.ml +++ /dev/null @@ -1,26 +0,0 @@ -(* - * setup.ml - * -------- - * Copyright : (c) 2011, Jérémie Dimino - * Licence : BSD3 - * - * This file is a part of lwt. - *) - -(* OASIS_START *) -#use "topfind";; -#require "oasis.dynrun";; -open OASISDynRun;; -(* OASIS_STOP *) - -let () = - InternalInstallPlugin.lib_hook := - fun (cs, bs, lib, dn) -> - match lib.OASISTypes.lib_findlib_name with - | Some "unix" -> - (cs, bs, lib, dn, ["src/unix/lwt_config.h"; "src/unix/lwt_unix.h"]) - | _ -> - (cs, bs, lib, dn, []) -;; - -let () = setup ();; diff --git a/src/camlp4/jbuild b/src/camlp4/jbuild new file mode 100644 index 0000000000..88b66a0653 --- /dev/null +++ b/src/camlp4/jbuild @@ -0,0 +1,10 @@ +(jbuild_version 1) + +(library + ((name lwt_syntax) + (public_name lwt.syntax) + (synopsis "Camlp4 syntax for Lwt (deprecated; use lwt.ppx)") + (optional) + (wrapped false) + (libraries (camlp4 lwt.syntax.options)) + (preprocess (action (run camlp4oof ${<}))))) diff --git a/src/camlp4/log/jbuild b/src/camlp4/log/jbuild new file mode 100644 index 0000000000..beda303cc1 --- /dev/null +++ b/src/camlp4/log/jbuild @@ -0,0 +1,10 @@ +(jbuild_version 1) + +(library + ((name lwt_syntax_log) + (public_name lwt.syntax.log) + (synopsis "Camlp4 syntax for Lwt logging (deprecated; use lwt.ppx)") + (optional) + (wrapped false) + (libraries (camlp4 lwt.syntax.options)) + (preprocess (action (run camlp4oof ${<}))))) diff --git a/src/camlp4/pa_lwt_log.ml b/src/camlp4/log/pa_lwt_log.ml similarity index 100% rename from src/camlp4/pa_lwt_log.ml rename to src/camlp4/log/pa_lwt_log.ml diff --git a/src/camlp4/pa_lwt_log.mli b/src/camlp4/log/pa_lwt_log.mli similarity index 100% rename from src/camlp4/pa_lwt_log.mli rename to src/camlp4/log/pa_lwt_log.mli diff --git a/src/camlp4/options/jbuild b/src/camlp4/options/jbuild new file mode 100644 index 0000000000..19696ba965 --- /dev/null +++ b/src/camlp4/options/jbuild @@ -0,0 +1,9 @@ +(jbuild_version 1) + +(library + ((name lwt_syntax_options) + (public_name lwt.syntax.options) + (synopsis "Options for Lwt Camlp4 syntax extension (deprecated; use lwt.ppx)") + (optional) + (wrapped false) + (libraries (camlp4)))) diff --git a/src/camlp4/pa_lwt_options.ml b/src/camlp4/options/pa_lwt_options.ml similarity index 100% rename from src/camlp4/pa_lwt_options.ml rename to src/camlp4/options/pa_lwt_options.ml diff --git a/src/core/jbuild b/src/core/jbuild new file mode 100644 index 0000000000..01e6696ef1 --- /dev/null +++ b/src/core/jbuild @@ -0,0 +1,8 @@ +(jbuild_version 1) + +(library + ((name lwt) + (public_name lwt) + (synopsis "Monadic promises and concurrent I/O") + (wrapped false) + (libraries (bytes result)))) diff --git a/src/glib/_oasis b/src/glib/_oasis deleted file mode 100644 index 3c3f3da57b..0000000000 --- a/src/glib/_oasis +++ /dev/null @@ -1,25 +0,0 @@ -# This is only for generating the release build system for this package. In -# development, the main Lwt build system is used. - -# To generate, run -# oasis setup -setup-update none - -OASISFormat: 0.4 -OCamlVersion: >= 4.02 -Name: lwt_glib -Version: 1.0.1 -Synopsis: GLib integration for Lwt -Authors: Jérémie Dimino -License: LGPL-2.1 -Plugins: DevFiles (0.4), META (0.4) - -AlphaFeatures: ocamlbuild_more_args -XOCamlbuildPluginTags: use_str - -Library lwt_glib - Path: . - BuildTools: ocamlbuild - Modules: Lwt_glib - CSources: lwt_glib_stubs.c - BuildDepends: lwt.unix - XMETADescription: GLib integration for Lwt diff --git a/src/glib/myocamlbuild.ml b/src/glib/config/discover.ml similarity index 53% rename from src/glib/myocamlbuild.ml rename to src/glib/config/discover.ml index 2e468f55be..3524289d33 100644 --- a/src/glib/myocamlbuild.ml +++ b/src/glib/config/discover.ml @@ -1,5 +1,3 @@ -(* OASIS_START *) -(* OASIS_STOP *) (* This is largely based on the Glib-related code in the main build system, though rewritten somewhat. *) @@ -46,38 +44,52 @@ let pkg_config arguments = Printf.eprintf "Command failed: %s" command; exit 1 -(* Loads values from setup.data. In particular, this build needs to check - whether ccomp_type, as detected by configure, is "msvc". *) -let env = - BaseEnvLight.load - ~allow_empty:true - ~filename:(Pathname.basename BaseEnvLight.default_filename) - () +(* read ocamlc -config file, if provided *) +let get_ocamlc_config name = + let f = open_in name in + let cfg line = + let idx = String.index line ':' in + String.sub line 0 idx, + String.sub line (idx + 2) (String.length line - idx - 2) + in + let input_line () = try Some(input_line f) with End_of_file -> None in + let rec lines () = + match input_line () with + | None -> [] + | Some(x) -> cfg x :: lines () + in + let cfg = lines () in + let () = close_in f in + cfg -let () = - dispatch begin fun hook -> - dispatch_default hook; +let ccomp_type = + try + let cfg = get_ocamlc_config Sys.argv.(1) in + List.assoc "ccomp_type" cfg + with _ -> + let () = Printf.eprintf "failed to read ccomp_type from ocamlc -config\n" in + exit 1 - match hook with - | After_rules -> - (* Get compiler and linker options using pkg-config. *) - let cflags = pkg_config "--cflags glib-2.0" in - let libs = - let ccomp_type = BaseEnvLight.var_get "ccomp_type" env in - if ccomp_type = "msvc" then - pkg_config "--libs-only-L glib-2.0" @ - pkg_config "--libs-only-l --msvc_syntax glib-2.0" - else - pkg_config "--libs glib-2.0" - in +let cflags = pkg_config "--cflags glib-2.0" +let libs = + if String.compare ccomp_type "msvc" = 0 then + pkg_config "--libs-only-L glib-2.0" @ + pkg_config "--libs-only-l --msvc_syntax glib-2.0" + else + pkg_config "--libs glib-2.0" - (* Forward compiler and linker options to Ocamlbuild. *) - flag ["ocamlmklib"; "c"] @@ - S (List.map (fun s -> A s) libs); - flag ["compile"; "c"] @@ - S (List.map (fun s -> S [A "-ccopt"; A s]) cflags); - flag ["link"; "ocaml"] @@ - S (List.map (fun s -> S [A "-cclib"; A s]) libs); +(* do sexps properly... +let () = + let write_sexp fn sexp = Out_channel.write_all fn ~data:(Sexp.to_string sexp) in + write_sexp "glib_c_flags.sexp" (sexp_of_list sexp_of_string cflags); + write_sexp "glib_c_library_flags.sexp" (sexp_of_list sexp_of_string libs) +*) - | _ -> () - end +let () = + let write_sexp n x = + let f = open_out n in + output_string f ("(" ^ String.concat " " x ^ ")"); + close_out f + in + write_sexp ("glib_c_flags.sexp") cflags; + write_sexp ("glib_c_library_flags.sexp") libs diff --git a/src/glib/config/jbuild b/src/glib/config/jbuild new file mode 100644 index 0000000000..4863fdeae3 --- /dev/null +++ b/src/glib/config/jbuild @@ -0,0 +1,5 @@ +(jbuild_version 1) + +(executables + ((names (discover)) + (libraries (unix str)))) diff --git a/src/glib/jbuild b/src/glib/jbuild new file mode 100644 index 0000000000..e142b9dff7 --- /dev/null +++ b/src/glib/jbuild @@ -0,0 +1,25 @@ +(jbuild_version 1) + +(library + ((name lwt_glib) + (public_name lwt_glib) + (synopsis "GLib integration for Lwt") + (wrapped false) + (libraries (lwt lwt.unix)) + (c_names (lwt_glib_stubs)) + (c_flags (:include glib_c_flags.sexp)) + (c_library_flags (:include glib_c_library_flags.sexp)))) + +;; implements pkg-config logic from glib/myocamlbuild + +(rule + ((targets (glib_c_flags.sexp + glib_c_library_flags.sexp)) + (deps (config/discover.exe ocamlc_config)) + (action (run ${<} ocamlc_config)))) + +;; create ocamlc -config file + +(rule + ((targets (ocamlc_config)) + (action (with-stdout-to ${@} (run ${OCAMLC} -config))))) diff --git a/src/logger/jbuild b/src/logger/jbuild new file mode 100644 index 0000000000..9921cbe3f7 --- /dev/null +++ b/src/logger/jbuild @@ -0,0 +1,11 @@ +(jbuild_version 1) + +(ocamllex (lwt_log_rules)) + +(library + ((name lwt_log) + (public_name lwt.log) + (synopsis "Logger for Lwt") + (optional) + (wrapped false) + (libraries (lwt)))) diff --git a/src/ppx/.merlin b/src/ppx/.merlin deleted file mode 100644 index 69dfe6fcae..0000000000 --- a/src/ppx/.merlin +++ /dev/null @@ -1,4 +0,0 @@ -PKG ppx_tools -PKG ppx_tools.metaquot - -REC \ No newline at end of file diff --git a/src/ppx/jbuild b/src/ppx/jbuild new file mode 100644 index 0000000000..8f1ee64e32 --- /dev/null +++ b/src/ppx/jbuild @@ -0,0 +1,13 @@ +(jbuild_version 1) + +(library + ((name ppx_lwt) + (public_name lwt.ppx) + (synopsis "Lwt PPX syntax extension") + (modules (ppx_lwt)) + (libraries (compiler-libs.common + ocaml-migrate-parsetree + ppx_tools_versioned)) + (ppx_runtime_libraries (lwt)) + (kind ppx_rewriter) + (preprocess (pps (ppx_tools_versioned.metaquot_404))))) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index 3fe087d259..886388712c 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -1 +1,379 @@ -(* Dummy ML file to workaround https://github.com/ocsigen/lwt/issues/91 *) +open Migrate_parsetree +open OCaml_404.Ast +open Ast_mapper +open Ast_helper +open Asttypes +open Parsetree + +open Ast_convenience_404 + +(** {2 Convenient stuff} *) + +let with_loc f {txt ; loc = _loc} = + (f txt) [@metaloc _loc] + +let def_loc txt = + { txt; loc = !default_loc } + +(** Test if a case is a catchall. *) +let is_catchall case = + let rec is_catchall_pat p = match p.ppat_desc with + | Ppat_any | Ppat_var _ -> true + | Ppat_alias (p, _) -> is_catchall_pat p + | _ -> false + in + case.pc_guard = None && is_catchall_pat case.pc_lhs + +(** Add a wildcard case in there is none. Useful for exception handlers. *) +let add_wildcard_case cases = + let has_wildcard = + List.exists is_catchall cases + in + if not has_wildcard + then cases @ [Exp.case [%pat? exn] [%expr Lwt.fail exn]] + else cases + +(** {3 Internal names} *) + +let lwt_prefix = "__ppx_lwt_" + +(** {2 Here we go!} *) + +let warn_let_lwt_rec loc attrs = + let attr = attribute_of_warning loc "\"let%lwt rec\" is not a recursive Lwt binding" in + attr :: attrs + +let debug = ref true +let log = ref false +let sequence = ref true +let strict_seq = ref true + +(** let%lwt related functions *) + +let gen_name i = lwt_prefix ^ string_of_int i + +(** [p = x] ≡ [__ppx_lwt_$i = x] *) +let gen_bindings l = + let aux i binding = + { binding with + pvb_pat = (pvar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] + } + in + List.mapi aux l + +(** [p = x] and e ≡ [Lwt.bind __ppx_lwt_$i (fun p -> e)] *) +let gen_binds e_loc l e = + let rec aux i bindings = + match bindings with + | [] -> e + | binding :: t -> + let name = (* __ppx_lwt_$i, at the position of $x$ *) + (evar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] + in + let fun_ = + [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] [@metaloc binding.pvb_loc] + in + let new_exp = + if !debug then + [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) + [%e name] [%e fun_]] [@metaloc e_loc] + else + [%expr Lwt.bind [%e name] [%e fun_]] [@metaloc e_loc] + in + { new_exp with pexp_attributes = binding.pvb_attributes } + in aux 0 l + +(** [p = x and p' = x' and ...] ≡ + [p, p', ... = Lwt_main.run ( + Lwt.bind x (fun __ppx_lwt_$i -> + Lwt.bind x' (fun __ppx_lwt_$i' -> + ... + Lwt.return (__ppx_lwt_$i, __ppx_lwt_$i', ...))))] *) + +let gen_top_binds vbs = + let gen_exp vbs i = + match vbs with + | {pvb_expr; _}::_rest -> + if !debug then + [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) + [%e pvb_expr] (fun [%p pvar (gen_name i)] -> gen_exp _rest (i + 1))] + else + [%expr Lwt.bind [%e pvb_expr] (fun [%p pvar (gen_name i)] -> gen_exp rest (i + 1))] + | [] -> + let rec names i = + if i >= 0 then evar (gen_name i) :: names (i - 1) else [] + in Exp.tuple (names i) + in + [Vb.mk (Pat.tuple (vbs |> List.map (fun { pvb_pat; _ } -> pvb_pat))) + [%expr Lwt_main.run [%e gen_exp vbs 0]]] + +(** For expressions only *) +(* We only expand the first level after a %lwt. + After that, we call the mapper to expand sub-expressions. *) +let lwt_expression mapper exp attributes = + default_loc := exp.pexp_loc; + let pexp_attributes = attributes @ exp.pexp_attributes in + match exp.pexp_desc with + + (* [let%lwt $p$ = $e$ in $e'$] ≡ [Lwt.bind $e$ (fun $p$ -> $e'$)] *) + | Pexp_let (Nonrecursive, vbl , e) -> + let new_exp = + Exp.let_ + Nonrecursive + (gen_bindings vbl) + (gen_binds exp.pexp_loc vbl e) + in mapper.expr mapper { new_exp with pexp_attributes } + + (* [match%lwt $e$ with $c$] ≡ [Lwt.bind $e$ (function $c$)] + [match%lwt $e$ with exception $x$ | $c$] ≡ + [Lwt.try_bind (fun () -> $e$) (function $c$) (function $x$)] *) + | Pexp_match (e, cases) -> + let exns, cases = + cases |> List.partition ( + function + | {pc_lhs = [%pat? exception [%p? _]]; _} -> true + | _ -> false) + in + let exns = + exns |> List.map ( + function + | {pc_lhs = [%pat? exception [%p? pat]]; _} as case -> + { case with pc_lhs = pat } + | _ -> assert false) + in + let exns = add_wildcard_case exns in + let new_exp = + match exns with + | [] -> [%expr Lwt.bind [%e e] [%e Exp.function_ cases]] + | _ -> [%expr Lwt.try_bind (fun () -> [%e e]) + [%e Exp.function_ cases] [%e Exp.function_ exns]] + in + mapper.expr mapper { new_exp with pexp_attributes } + + (* [assert%lwt $e$] ≡ + [try Lwt.return (assert $e$) with exn -> Lwt.fail exn] *) + | Pexp_assert e -> + let new_exp = + [%expr try Lwt.return (assert [%e e]) with exn -> Lwt.fail exn] + in mapper.expr mapper { new_exp with pexp_attributes } + + (* [while%lwt $cond$ do $body$ done] ≡ + [let rec __ppx_lwt_loop () = + if $cond$ then Lwt.bind $body$ __ppx_lwt_loop + else Lwt.return_unit + in __ppx_lwt_loop] + *) + | Pexp_while (cond, body) -> + let new_exp = + [%expr + let rec __ppx_lwt_loop () = + if [%e cond] then Lwt.bind [%e body] __ppx_lwt_loop + else Lwt.return_unit + in __ppx_lwt_loop () + ] + in mapper.expr mapper { new_exp with pexp_attributes } + + (* [for%lwt $p$ = $start$ (to|downto) $end$ do $body$ done] ≡ + [let __ppx_lwt_bound = $end$ in + let rec __ppx_lwt_loop $p$ = + if $p$ COMP __ppx_lwt_bound then Lwt.return_unit + else Lwt.bind $body$ (fun () -> __ppx_lwt_loop ($p$ OP 1)) + in __ppx_lwt_loop $start$] + *) + | Pexp_for ({ppat_desc = Ppat_var p_var; _} as p, start, bound, dir, body) -> + let comp, op = match dir with + | Upto -> evar ">", evar "+" + | Downto -> evar "<", evar "-" + in + let p' = with_loc (fun s -> evar s) p_var in + + let exp_bound = [%expr __ppx_lwt_bound] [@metaloc bound.pexp_loc] in + let pat_bound = [%pat? __ppx_lwt_bound] [@metaloc bound.pexp_loc] in + + let new_exp = + [%expr + let [%p pat_bound] : int = [%e bound] in + let rec __ppx_lwt_loop [%p p] = + if [%e comp] [%e p'] [%e exp_bound] then Lwt.return_unit + else Lwt.bind [%e body] (fun () -> __ppx_lwt_loop ([%e op] [%e p'] 1)) + in __ppx_lwt_loop [%e start] + ] + in mapper.expr mapper { new_exp with pexp_attributes } + + + (* [try%lwt $e$ with $c$] ≡ + [Lwt.catch (fun () -> $e$) (function $c$)] + *) + | Pexp_try (expr, cases) -> + let cases = add_wildcard_case cases in + let new_exp = + if !debug then + [%expr Lwt.backtrace_catch (fun exn -> try raise exn with exn -> exn) + (fun () -> [%e expr]) [%e Exp.function_ cases]] + else + [%expr Lwt.catch (fun () -> [%e expr]) [%e Exp.function_ cases]] + in + mapper.expr mapper { new_exp with pexp_attributes } + + (* [if%lwt $c$ then $e1$ else $e2$] ≡ + [match%lwt $c$ with true -> $e1$ | false -> $e2$] + [if%lwt $c$ then $e1$] ≡ + [match%lwt $c$ with true -> $e1$ | false -> Lwt.return_unit] + *) + | Pexp_ifthenelse (cond, e1, e2) -> + let e2 = match e2 with None -> [%expr Lwt.return_unit] | Some e -> e in + let cases = + [ + Exp.case [%pat? true] e1 ; + Exp.case [%pat? false] e2 ; + ] + in + let new_exp = [%expr Lwt.bind [%e cond] [%e Exp.function_ cases]] in + mapper.expr mapper { new_exp with pexp_attributes } + + (* [[%lwt $e$]] ≡ [Lwt.catch (fun () -> $e$) Lwt.fail] *) + | _ -> + let exp = + match exp with + | { pexp_loc; pexp_desc=Pexp_let (Recursive, _, _); pexp_attributes } -> + let attr = attribute_of_warning pexp_loc "\"let%lwt rec\" is not a recursive Lwt binding" in + { exp with pexp_attributes = attr :: pexp_attributes } + | _ -> exp + in + let new_exp = + if !debug then + [%expr Lwt.backtrace_catch (fun exn -> try raise exn with exn -> exn) + (fun () -> [%e exp]) Lwt.fail] + else + [%expr Lwt.catch (fun () -> [%e exp]) Lwt.fail] + in + mapper.expr mapper { new_exp with pexp_attributes } + +let make_loc {Location.loc_start; _} = + let (file, line, char) = Location.get_pos_info loc_start in + [%expr ([%e str file], [%e int line], [%e int char])] + +(** + [Lwt_log.error "message"] ≡ + [let __pa_log_section = Lwt_log.Section.main in + if Lwt_log.Error >= (Lwt_log.Section.level __pa_log_section) + then Lwt_log.error ~location:("foo.ml", 1, 0) ~section:__pa_log_section "message" + else Lwt.return_unit]; + [Lwt_log.error ~section "message"] ≡ + [let __pa_log_section = section in ...]. + Additionally, remove debug-level statements if -no-debug is given. **) +let lwt_log mapper fn args attrs loc = + let open Longident in + match fn with + | {pexp_desc = Pexp_ident {txt = Ldot (Lident "Lwt_log", func); _}; _} -> + let len = String.length func in + let fmt = len >= 2 && func.[len - 2] = '_' && func.[len - 1] = 'f' + and ign = len >= 4 && func.[0] = 'i' && func.[1] = 'g' && func.[2] = 'n' && func.[3] = '_' in + let level = + match fmt, ign with + | false, false -> func + | true, false -> String.sub func 0 (len - 2) + | false, true -> String.sub func 4 (len - 4) + | true, true -> String.sub func 4 (len - 6) + in + let level = (String.capitalize [@ocaml.warning "-3"]) level in + if level = "Debug" && (not !debug) then + let new_exp = if ign then [%expr ()] else [%expr Lwt.return_unit] in + mapper.expr mapper { new_exp with pexp_attributes = attrs } + else if List.mem level ["Fatal"; "Error"; "Warning"; "Notice"; "Info"; "Debug"] then + let args = List.map (fun (l,e) -> l, mapper.expr mapper e) args in + let new_exp = + let args = (Label.labelled "location", make_loc loc) :: + (Label.labelled "section", [%expr __pa_log_section]) :: + List.remove_assoc (Label.labelled "section") args in + [%expr + if [%e Exp.construct (def_loc (Ldot (Lident "Lwt_log", level))) None] >= + Lwt_log.Section.level __pa_log_section then + [%e Exp.apply (Exp.ident (def_loc (Ldot (Lident "Lwt_log", func)))) args] + else + [%e if ign then [%expr ()] else [%expr Lwt.return_unit]]] + in + try + let section = List.assoc (Label.labelled "section") args in + [%expr let __pa_log_section = [%e section] in [%e new_exp]] + with Not_found -> + [%expr let __pa_log_section = Lwt_log.Section.main in [%e new_exp]] + else default_mapper.expr mapper (Exp.apply ~attrs fn args) + | _ -> default_mapper.expr mapper (Exp.apply ~attrs fn args) + +let mapper = + { default_mapper with + expr = (fun mapper expr -> + match expr with + | [%expr [%lwt [%e? exp]]] -> + lwt_expression mapper exp expr.pexp_attributes + + + (* [($e$)[%finally $f$]] ≡ + [Lwt.finalize (fun () -> $e$) (fun () -> $f$)] *) + | [%expr [%e? exp ] [%finally [%e? finally]] ] + | [%expr [%e? exp ] [%lwt.finally [%e? finally]] ] -> + let new_exp = + if !debug then + [%expr Lwt.backtrace_finalize (fun exn -> try raise exn with exn -> exn) + (fun () -> [%e exp]) (fun () -> [%e finally])] + else + [%expr Lwt.finalize (fun () -> [%e exp]) (fun () -> [%e finally])] + in + mapper.expr mapper + { new_exp with + pexp_attributes = expr.pexp_attributes @ exp.pexp_attributes + } + + | [%expr [%finally [%e? _ ]]] + | [%expr [%lwt.finally [%e? _ ]]] -> + raise (Location.Error ( + Location.errorf + ~loc:expr.pexp_loc + "Lwt's finally should be used only with the syntax: \"()[%%finally ...]\"." + )) + + + | [%expr [%e? lhs] >> [%e? rhs]] -> + if !sequence then + let pat = if !strict_seq then [%pat? ()] else [%pat? _] in + let lhs, rhs = mapper.expr mapper lhs, mapper.expr mapper rhs in + if !debug then + [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) + [%e lhs] (fun [%p pat] -> [%e rhs])] + else + [%expr Lwt.bind [%e lhs] (fun [%p pat] -> [%e rhs])] + else + default_mapper.expr mapper expr + | { pexp_desc = Pexp_apply (fn, args); pexp_attributes; pexp_loc } when !log -> + default_loc := pexp_loc; + lwt_log mapper fn args pexp_attributes pexp_loc + | _ -> default_mapper.expr mapper expr); + structure_item = (fun mapper stri -> + default_loc := stri.pstr_loc; + match stri with + | [%stri let%lwt [%p? var] = [%e? exp]] -> + [%stri let [%p var] = Lwt_main.run [%e mapper.expr mapper exp]] + | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [ + {pstr_desc = Pstr_value (Recursive, _); _}]) as content, attrs); pstr_loc} -> + {stri with pstr_desc = + Pstr_extension (content, warn_let_lwt_rec pstr_loc attrs)} + | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [ + {pstr_desc = Pstr_value (Nonrecursive, vbs); _}]), _); _} -> + mapper.structure_item mapper (Str.value Nonrecursive (gen_top_binds vbs)) + | x -> default_mapper.structure_item mapper x); + } + + +let args = + Arg.([ + "-no-debug", Clear debug, "disable debug mode"; + "-log", Set log, "enable logging"; + "-no-log", Clear log, "disable logging"; + "-no-sequence", Clear sequence, "disable sequence operator"; + "-no-strict-sequence", Clear strict_seq, "allow non-unit sequence operations"; + ]) + +let () = + Driver.register ~name:"ppx_lwt" ~args Versions.ocaml_404 + (fun _config _cookies -> mapper) diff --git a/src/ppx/ppx_lwt.mli b/src/ppx/ppx_lwt.mli index 21ee9c9946..2dd976441d 100644 --- a/src/ppx/ppx_lwt.mli +++ b/src/ppx/ppx_lwt.mli @@ -238,3 +238,6 @@ else - Debug messages are removed if the option [-no-debug] is passed. *) + + +val mapper : Migrate_parsetree.OCaml_404.Ast.Ast_mapper.mapper diff --git a/src/ppx/ppx_lwt_ex.ml b/src/ppx/ppx_lwt_ex.ml deleted file mode 100644 index fc8132828d..0000000000 --- a/src/ppx/ppx_lwt_ex.ml +++ /dev/null @@ -1,373 +0,0 @@ -open Ast_mapper -open Ast_helper -open Asttypes -open Parsetree - -open Ast_convenience - -(** {2 Convenient stuff} *) - -let with_loc f {txt ; loc = _loc} = - (f txt) [@metaloc _loc] - -let def_loc txt = - { txt; loc = !default_loc } - -(** Test if a case is a catchall. *) -let is_catchall case = - let rec is_catchall_pat p = match p.ppat_desc with - | Ppat_any | Ppat_var _ -> true - | Ppat_alias (p, _) -> is_catchall_pat p - | _ -> false - in - case.pc_guard = None && is_catchall_pat case.pc_lhs - -(** Add a wildcard case in there is none. Useful for exception handlers. *) -let add_wildcard_case cases = - let has_wildcard = - List.exists is_catchall cases - in - if not has_wildcard - then cases @ [Exp.case [%pat? exn] [%expr Lwt.fail exn]] - else cases - -(** {3 Internal names} *) - -let lwt_prefix = "__ppx_lwt_" - -(** {2 Here we go!} *) - -let warn_let_lwt_rec loc attrs = - let attr = attribute_of_warning loc "\"let%lwt rec\" is not a recursive Lwt binding" in - attr :: attrs - -let debug = ref true -let log = ref false -let sequence = ref true -let strict_seq = ref true - -(** let%lwt related functions *) - -let gen_name i = lwt_prefix ^ string_of_int i - -(** [p = x] ≡ [__ppx_lwt_$i = x] *) -let gen_bindings l = - let aux i binding = - { binding with - pvb_pat = (pvar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] - } - in - List.mapi aux l - -(** [p = x] and e ≡ [Lwt.bind __ppx_lwt_$i (fun p -> e)] *) -let gen_binds e_loc l e = - let rec aux i bindings = - match bindings with - | [] -> e - | binding :: t -> - let name = (* __ppx_lwt_$i, at the position of $x$ *) - (evar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] - in - let fun_ = - [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] [@metaloc binding.pvb_loc] - in - let new_exp = - if !debug then - [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) - [%e name] [%e fun_]] [@metaloc e_loc] - else - [%expr Lwt.bind [%e name] [%e fun_]] [@metaloc e_loc] - in - { new_exp with pexp_attributes = binding.pvb_attributes } - in aux 0 l - -(** [p = x and p' = x' and ...] ≡ - [p, p', ... = Lwt_main.run ( - Lwt.bind x (fun __ppx_lwt_$i -> - Lwt.bind x' (fun __ppx_lwt_$i' -> - ... - Lwt.return (__ppx_lwt_$i, __ppx_lwt_$i', ...))))] *) - -let gen_top_binds vbs = - let gen_exp vbs i = - match vbs with - | {pvb_expr; _}::_rest -> - if !debug then - [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) - [%e pvb_expr] (fun [%p pvar (gen_name i)] -> gen_exp _rest (i + 1))] - else - [%expr Lwt.bind [%e pvb_expr] (fun [%p pvar (gen_name i)] -> gen_exp rest (i + 1))] - | [] -> - let rec names i = - if i >= 0 then evar (gen_name i) :: names (i - 1) else [] - in Exp.tuple (names i) - in - [Vb.mk (Pat.tuple (vbs |> List.map (fun { pvb_pat; _ } -> pvb_pat))) - [%expr Lwt_main.run [%e gen_exp vbs 0]]] - -(** For expressions only *) -(* We only expand the first level after a %lwt. - After that, we call the mapper to expand sub-expressions. *) -let lwt_expression mapper exp attributes = - default_loc := exp.pexp_loc; - let pexp_attributes = attributes @ exp.pexp_attributes in - match exp.pexp_desc with - - (* [let%lwt $p$ = $e$ in $e'$] ≡ [Lwt.bind $e$ (fun $p$ -> $e'$)] *) - | Pexp_let (Nonrecursive, vbl , e) -> - let new_exp = - Exp.let_ - Nonrecursive - (gen_bindings vbl) - (gen_binds exp.pexp_loc vbl e) - in mapper.expr mapper { new_exp with pexp_attributes } - - (* [match%lwt $e$ with $c$] ≡ [Lwt.bind $e$ (function $c$)] - [match%lwt $e$ with exception $x$ | $c$] ≡ - [Lwt.try_bind (fun () -> $e$) (function $c$) (function $x$)] *) - | Pexp_match (e, cases) -> - let exns, cases = - cases |> List.partition ( - function - | {pc_lhs = [%pat? exception [%p? _]]; _} -> true - | _ -> false) - in - let exns = - exns |> List.map ( - function - | {pc_lhs = [%pat? exception [%p? pat]]; _} as case -> - { case with pc_lhs = pat } - | _ -> assert false) - in - let exns = add_wildcard_case exns in - let new_exp = - match exns with - | [] -> [%expr Lwt.bind [%e e] [%e Exp.function_ cases]] - | _ -> [%expr Lwt.try_bind (fun () -> [%e e]) - [%e Exp.function_ cases] [%e Exp.function_ exns]] - in - mapper.expr mapper { new_exp with pexp_attributes } - - (* [assert%lwt $e$] ≡ - [try Lwt.return (assert $e$) with exn -> Lwt.fail exn] *) - | Pexp_assert e -> - let new_exp = - [%expr try Lwt.return (assert [%e e]) with exn -> Lwt.fail exn] - in mapper.expr mapper { new_exp with pexp_attributes } - - (* [while%lwt $cond$ do $body$ done] ≡ - [let rec __ppx_lwt_loop () = - if $cond$ then Lwt.bind $body$ __ppx_lwt_loop - else Lwt.return_unit - in __ppx_lwt_loop] - *) - | Pexp_while (cond, body) -> - let new_exp = - [%expr - let rec __ppx_lwt_loop () = - if [%e cond] then Lwt.bind [%e body] __ppx_lwt_loop - else Lwt.return_unit - in __ppx_lwt_loop () - ] - in mapper.expr mapper { new_exp with pexp_attributes } - - (* [for%lwt $p$ = $start$ (to|downto) $end$ do $body$ done] ≡ - [let __ppx_lwt_bound = $end$ in - let rec __ppx_lwt_loop $p$ = - if $p$ COMP __ppx_lwt_bound then Lwt.return_unit - else Lwt.bind $body$ (fun () -> __ppx_lwt_loop ($p$ OP 1)) - in __ppx_lwt_loop $start$] - *) - | Pexp_for ({ppat_desc = Ppat_var p_var; _} as p, start, bound, dir, body) -> - let comp, op = match dir with - | Upto -> evar ">", evar "+" - | Downto -> evar "<", evar "-" - in - let p' = with_loc (fun s -> evar s) p_var in - - let exp_bound = [%expr __ppx_lwt_bound] [@metaloc bound.pexp_loc] in - let pat_bound = [%pat? __ppx_lwt_bound] [@metaloc bound.pexp_loc] in - - let new_exp = - [%expr - let [%p pat_bound] : int = [%e bound] in - let rec __ppx_lwt_loop [%p p] = - if [%e comp] [%e p'] [%e exp_bound] then Lwt.return_unit - else Lwt.bind [%e body] (fun () -> __ppx_lwt_loop ([%e op] [%e p'] 1)) - in __ppx_lwt_loop [%e start] - ] - in mapper.expr mapper { new_exp with pexp_attributes } - - - (* [try%lwt $e$ with $c$] ≡ - [Lwt.catch (fun () -> $e$) (function $c$)] - *) - | Pexp_try (expr, cases) -> - let cases = add_wildcard_case cases in - let new_exp = - if !debug then - [%expr Lwt.backtrace_catch (fun exn -> try raise exn with exn -> exn) - (fun () -> [%e expr]) [%e Exp.function_ cases]] - else - [%expr Lwt.catch (fun () -> [%e expr]) [%e Exp.function_ cases]] - in - mapper.expr mapper { new_exp with pexp_attributes } - - (* [if%lwt $c$ then $e1$ else $e2$] ≡ - [match%lwt $c$ with true -> $e1$ | false -> $e2$] - [if%lwt $c$ then $e1$] ≡ - [match%lwt $c$ with true -> $e1$ | false -> Lwt.return_unit] - *) - | Pexp_ifthenelse (cond, e1, e2) -> - let e2 = match e2 with None -> [%expr Lwt.return_unit] | Some e -> e in - let cases = - [ - Exp.case [%pat? true] e1 ; - Exp.case [%pat? false] e2 ; - ] - in - let new_exp = [%expr Lwt.bind [%e cond] [%e Exp.function_ cases]] in - mapper.expr mapper { new_exp with pexp_attributes } - - (* [[%lwt $e$]] ≡ [Lwt.catch (fun () -> $e$) Lwt.fail] *) - | _ -> - let exp = - match exp with - | { pexp_loc; pexp_desc=Pexp_let (Recursive, _, _); pexp_attributes } -> - let attr = attribute_of_warning pexp_loc "\"let%lwt rec\" is not a recursive Lwt binding" in - { exp with pexp_attributes = attr :: pexp_attributes } - | _ -> exp - in - let new_exp = - if !debug then - [%expr Lwt.backtrace_catch (fun exn -> try raise exn with exn -> exn) - (fun () -> [%e exp]) Lwt.fail] - else - [%expr Lwt.catch (fun () -> [%e exp]) Lwt.fail] - in - mapper.expr mapper { new_exp with pexp_attributes } - -let make_loc {Location.loc_start; _} = - let (file, line, char) = Location.get_pos_info loc_start in - [%expr ([%e str file], [%e int line], [%e int char])] - -(** - [Lwt_log.error "message"] ≡ - [let __pa_log_section = Lwt_log.Section.main in - if Lwt_log.Error >= (Lwt_log.Section.level __pa_log_section) - then Lwt_log.error ~location:("foo.ml", 1, 0) ~section:__pa_log_section "message" - else Lwt.return_unit]; - [Lwt_log.error ~section "message"] ≡ - [let __pa_log_section = section in ...]. - Additionally, remove debug-level statements if -no-debug is given. **) -let lwt_log mapper fn args attrs loc = - let open Longident in - match fn with - | {pexp_desc = Pexp_ident {txt = Ldot (Lident "Lwt_log", func); _}; _} -> - let len = String.length func in - let fmt = len >= 2 && func.[len - 2] = '_' && func.[len - 1] = 'f' - and ign = len >= 4 && func.[0] = 'i' && func.[1] = 'g' && func.[2] = 'n' && func.[3] = '_' in - let level = - match fmt, ign with - | false, false -> func - | true, false -> String.sub func 0 (len - 2) - | false, true -> String.sub func 4 (len - 4) - | true, true -> String.sub func 4 (len - 6) - in - let level = (String.capitalize [@ocaml.warning "-3"]) level in - if level = "Debug" && (not !debug) then - let new_exp = if ign then [%expr ()] else [%expr Lwt.return_unit] in - mapper.expr mapper { new_exp with pexp_attributes = attrs } - else if List.mem level ["Fatal"; "Error"; "Warning"; "Notice"; "Info"; "Debug"] then - let args = List.map (fun (l,e) -> l, mapper.expr mapper e) args in - let new_exp = - let args = (Label.labelled "location", make_loc loc) :: - (Label.labelled "section", [%expr __pa_log_section]) :: - List.remove_assoc (Label.labelled "section") args in - [%expr - if [%e Exp.construct (def_loc (Ldot (Lident "Lwt_log", level))) None] >= - Lwt_log.Section.level __pa_log_section then - [%e Exp.apply (Exp.ident (def_loc (Ldot (Lident "Lwt_log", func)))) args] - else - [%e if ign then [%expr ()] else [%expr Lwt.return_unit]]] - in - try - let section = List.assoc (Label.labelled "section") args in - [%expr let __pa_log_section = [%e section] in [%e new_exp]] - with Not_found -> - [%expr let __pa_log_section = Lwt_log.Section.main in [%e new_exp]] - else default_mapper.expr mapper (Exp.apply ~attrs fn args) - | _ -> default_mapper.expr mapper (Exp.apply ~attrs fn args) - -let lwt_mapper args = - args |> List.iter (fun arg -> - match arg with - | "-no-debug" -> debug := false - | "-log" -> log := true - | "-no-log" -> log := false - | "-no-sequence" -> sequence := false - | "-no-strict-sequence" -> strict_seq := false - | _ -> raise (Location.Error (Location.errorf "Unknown lwt.ppx argument: %s" arg))); - { default_mapper with - expr = (fun mapper expr -> - match expr with - | [%expr [%lwt [%e? exp]]] -> - lwt_expression mapper exp expr.pexp_attributes - - - (* [($e$)[%finally $f$]] ≡ - [Lwt.finalize (fun () -> $e$) (fun () -> $f$)] *) - | [%expr [%e? exp ] [%finally [%e? finally]] ] - | [%expr [%e? exp ] [%lwt.finally [%e? finally]] ] -> - let new_exp = - if !debug then - [%expr Lwt.backtrace_finalize (fun exn -> try raise exn with exn -> exn) - (fun () -> [%e exp]) (fun () -> [%e finally])] - else - [%expr Lwt.finalize (fun () -> [%e exp]) (fun () -> [%e finally])] - in - mapper.expr mapper - { new_exp with - pexp_attributes = expr.pexp_attributes @ exp.pexp_attributes - } - - | [%expr [%finally [%e? _ ]]] - | [%expr [%lwt.finally [%e? _ ]]] -> - raise (Location.Error ( - Location.errorf - ~loc:expr.pexp_loc - "Lwt's finally should be used only with the syntax: \"()[%%finally ...]\"." - )) - - - | [%expr [%e? lhs] >> [%e? rhs]] -> - if !sequence then - let pat = if !strict_seq then [%pat? ()] else [%pat? _] in - let lhs, rhs = mapper.expr mapper lhs, mapper.expr mapper rhs in - if !debug then - [%expr Lwt.backtrace_bind (fun exn -> try raise exn with exn -> exn) - [%e lhs] (fun [%p pat] -> [%e rhs])] - else - [%expr Lwt.bind [%e lhs] (fun [%p pat] -> [%e rhs])] - else - default_mapper.expr mapper expr - | { pexp_desc = Pexp_apply (fn, args); pexp_attributes; pexp_loc } when !log -> - default_loc := pexp_loc; - lwt_log mapper fn args pexp_attributes pexp_loc - | _ -> default_mapper.expr mapper expr); - structure_item = (fun mapper stri -> - default_loc := stri.pstr_loc; - match stri with - | [%stri let%lwt [%p? var] = [%e? exp]] -> - [%stri let [%p var] = Lwt_main.run [%e mapper.expr mapper exp]] - | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [ - {pstr_desc = Pstr_value (Recursive, _); _}]) as content, attrs); pstr_loc} -> - {stri with pstr_desc = - Pstr_extension (content, warn_let_lwt_rec pstr_loc attrs)} - | {pstr_desc = Pstr_extension (({txt = "lwt"; _}, PStr [ - {pstr_desc = Pstr_value (Nonrecursive, vbs); _}]), _); _} -> - mapper.structure_item mapper (Str.value Nonrecursive (gen_top_binds vbs)) - | x -> default_mapper.structure_item mapper x); - } - -let () = run_main lwt_mapper diff --git a/src/preemptive/jbuild b/src/preemptive/jbuild new file mode 100644 index 0000000000..d5102eb1de --- /dev/null +++ b/src/preemptive/jbuild @@ -0,0 +1,8 @@ +(jbuild_version 1) + +(library + ((name lwt_preemptive) + (public_name lwt.preemptive) + (synopsis "Preemptive thread support for Lwt") + (wrapped false) + (libraries (lwt lwt.unix threads)))) diff --git a/src/react/_oasis b/src/react/_oasis deleted file mode 100644 index 4ac1217b08..0000000000 --- a/src/react/_oasis +++ /dev/null @@ -1,20 +0,0 @@ -# This is only for generating the release build system for this package. In -# development, the main Lwt build system is used. - -# To generate, run -# oasis setup -setup-update none - -OASISFormat: 0.4 -Name: lwt_react -Version: 1.0.1 -Synopsis: Helpers for using React with Lwt -Authors: Jérémie Dimino -License: LGPL-2.1 -Plugins: DevFiles (0.4), META (0.4) - -Library lwt_react - Path: . - BuildTools: ocamlbuild - Modules: Lwt_react - BuildDepends: lwt, react - XMETADescription: Helpers for using React with Lwt diff --git a/src/react/jbuild b/src/react/jbuild new file mode 100644 index 0000000000..80e21655fb --- /dev/null +++ b/src/react/jbuild @@ -0,0 +1,8 @@ +(jbuild_version 1) + +(library + ((name lwt_react) + (public_name lwt_react) + (synopsis "Reactive programming helpers for Lwt") + (wrapped false) + (libraries (lwt react)))) diff --git a/src/simple_top/jbuild b/src/simple_top/jbuild new file mode 100644 index 0000000000..f54fa846d2 --- /dev/null +++ b/src/simple_top/jbuild @@ -0,0 +1,9 @@ +(jbuild_version 1) + +(library + ((name lwt_simple_top) + (public_name lwt.simple-top) + (synopsis "Lwt-OCaml top level integration (deprecated; use utop)") + (optional) + (wrapped false) + (libraries (lwt lwt.unix compiler-libs.common)))) diff --git a/src/ssl/_oasis b/src/ssl/_oasis deleted file mode 100644 index fa393dedf2..0000000000 --- a/src/ssl/_oasis +++ /dev/null @@ -1,20 +0,0 @@ -# This is only for generating the release build system for this package. In -# development, the main Lwt build system is used. - -# To generate, run -# oasis setup -setup-update none - -OASISFormat: 0.4 -Name: lwt_ssl -Version: 1.0.1 -Synopsis: Lwt-friendly OpenSSL bindings -Authors: Jérémie Dimino -License: LGPL-2.1 -Plugins: DevFiles (0.4), META (0.4) - -Library lwt_ssl - Path: . - BuildTools: ocamlbuild - Modules: Lwt_ssl - BuildDepends: lwt.unix, ssl - XMETADescription: Lwt-friendly OpenSSL bindings diff --git a/src/ssl/jbuild b/src/ssl/jbuild new file mode 100644 index 0000000000..d983c270f8 --- /dev/null +++ b/src/ssl/jbuild @@ -0,0 +1,8 @@ +(jbuild_version 1) + +(library + ((name lwt_ssl) + (public_name lwt_ssl) + (synopsis "SSL support for Lwt") + (wrapped false) + (libraries (ssl lwt.unix)))) diff --git a/src/util/discover.ml b/src/unix/config/discover.ml similarity index 85% rename from src/util/discover.ml rename to src/unix/config/discover.ml index fcc8597752..69604bcf77 100644 --- a/src/util/discover.ml +++ b/src/unix/config/discover.ml @@ -308,6 +308,8 @@ CAMLprim value lwt_test() +-----------------------------------------------------------------+ *) let ocamlc = ref "ocamlfind ocamlc" +let ocamlc_config = ref "" +let lwt_config = ref "" let ext_obj = ref ".o" let exec_name = ref "a.out" let use_libev = ref true @@ -318,6 +320,7 @@ let os_type = ref "Unix" let android_target = ref false let ccomp_type = ref "cc" let libev_default = ref true +let system = ref "" let debug = ref (try Sys.getenv "DEBUG" = "y" with Not_found -> false) let dprintf fmt = @@ -396,8 +399,8 @@ let test_code args stub_code = cleanup (); raise exn -let config = open_out "src/unix/lwt_config.h" -let config_ml = open_out "src/unix/lwt_config.ml" +let config = open_out "lwt_config.h" +let config_ml = open_out "lwt_config.ml" let () = fprintf config "\ @@ -512,16 +515,8 @@ let arg_bool r = let () = let args = [ "-ocamlc", Arg.Set_string ocamlc, " ocamlc"; - "-ext-obj", Arg.Set_string ext_obj, " C object files extension"; - "-exec-name", Arg.Set_string exec_name, " name of the executable produced by ocamlc"; - "-use-libev", arg_bool use_libev, " whether to check for libev"; - "-use-glib", arg_bool use_glib, " whether to check for glib"; - "-use-pthread", arg_bool use_pthread, " whether to use pthread"; - "-use-unix", arg_bool use_unix, " whether to build lwt.unix"; - "-os-type", Arg.Set_string os_type, " type of the target os"; - "-android-target", arg_bool android_target, " compiles for Android"; - "-ccomp-type", Arg.Set_string ccomp_type, " C compiler type"; - "-libev_default", arg_bool libev_default, " whether to use the libev backend by default"; + "-ocamlc-config", Arg.Set_string ocamlc_config, " ocamlc config"; + "-lwt-config", Arg.Set_string lwt_config, " lwt config"; ] in Arg.parse args ignore "check for external C libraries and available features\noptions are:"; @@ -546,6 +541,68 @@ let () = safe_remove (Filename.chop_extension !caml_file ^ ".cmi"); safe_remove (Filename.chop_extension !caml_file ^ ".cmo")); + (* read ocamlc -config and lwt config files. + The former must exist, but we can apply defaults for the later. *) + let read_config config filename = + let f = open_in filename in + let cfg line = + let idx = String.index line ':' in + String.sub line 0 idx, + String.sub line (idx + 2) (String.length line - idx - 2) + in + let input_line () = try Some(input_line f) with End_of_file -> None in + let rec lines () = + match input_line () with + | None -> [] + | Some(x) -> cfg x :: lines () + in + let cfg = lines () in + let () = close_in f in + cfg + in + let () = if !ocamlc_config = "" then begin + printf "Configuration file for 'ocamlc -config' does not exist\n"; + exit 1; + end in + let ocamlc_config = read_config "ocamlc" !ocamlc_config in + let lwt_config = try read_config "lwt" !lwt_config with _ -> [] in + (* get params from configuration files *) + let () = + let get var name = + try + var := List.assoc name ocamlc_config; + printf "found config var %s: %s %s\n" name (String.make (29 - String.length name) '.') !var + with Not_found -> + printf "Couldn't find value '%s' in 'ocamlc -config'\n" name; + exit 1 + in + get ext_obj "ext_obj"; + get exec_name "default_executable_name"; + get ccomp_type "ccomp_type"; + get system "system"; + get os_type "os_type"; + let get var name default = + try + let () = + match List.assoc name lwt_config with + | "true" -> var := true + | "false" -> var := false + | _ -> raise Not_found + in + printf "found config var %s: %s %b\n" name (String.make (29 - String.length name) '.') !var + with Not_found -> + var := default + in + (* set up the defaults as per the original _oasis file *) + get android_target "android_target" false; + get use_pthread "use_pthread" (!os_type <> "Win32"); + get use_libev "use_libev" (!os_type <> "Win32" && !android_target = false); + get libev_default "libev_default" + (List.mem !system (* as per _oasis *) + ["linux"; "linux_elf"; "linux_aout"; "linux_eabi"; "linux_eabihf"]); + in + + let exit status = if status <> 0 then begin if !debug then printf " @@ -657,11 +714,11 @@ You may be missing core components (compiler, ncurses, etc) printf " Some required C libraries were not found. If a C library is installed in a non-standard location, set _CFLAGS and _LIBS accordingly. You may also -try 'ocaml setup.ml -configure --disable-' to avoid compiling support for +try 'ocaml src/utils/configure.ml -use- false' to avoid compiling support for it. For example, in the case of libev missing: export LIBEV_CFLAGS=-I/opt/local/include export LIBEV_LIBS='-L/opt/local/lib -lev' - (* or: *) ocaml setup.ml -configure --disable-libev + (* or: *) ocaml src/utils/configure.ml -use-libev false Missing C libraries: %s " (String.concat ", " !not_available); @@ -791,6 +848,38 @@ Lwt can use pthread or the win32 API. close_out config; close_out config_ml; - (* Generate stubs. *) - print_endline "Generating C stubs..."; - exit (Sys.command "ocaml src/unix/gen_stubs.ml") + + let get_flags lib = + (try List.assoc (lib ^ "_opt") !setup_data with _ -> []), + (try List.assoc (lib ^ "_lib") !setup_data with _ -> []) + in + let cflags_ev, libs_ev = get_flags "libev" in + let cflags_pt, libs_pt = get_flags "pthread" in + let cflags = cflags_ev @ cflags_pt in + let libs = libs_ev @ libs_pt in + + (* do sexps properly... + let open Base in + let open Stdio in + + let write_sexp fn sexp = Out_channel.write_all fn ~data:(Sexp.to_string sexp) in + write_sexp ("unix_c_flags.sexp") (sexp_of_list sexp_of_string ("-I."::cflags)); + write_sexp ("unix_c_library_flags.sexp") (sexp_of_list sexp_of_string (libs)) + *) + + (* add Win32 linker flags *) + let libs = + if !os_type = "Win32" then + if !ccomp_type = "msvc" then libs @ ["ws2_32.lib"] + else libs @ ["-lws2_32"] + else + libs + in + + let write_sexp n x = + let f = open_out n in + output_string f ("(" ^ String.concat " " x ^ ")"); + close_out f + in + write_sexp ("unix_c_flags.sexp") ("-I."::cflags); + write_sexp ("unix_c_library_flags.sexp") libs diff --git a/src/unix/config/jbuild b/src/unix/config/jbuild new file mode 100644 index 0000000000..fb28bc378a --- /dev/null +++ b/src/unix/config/jbuild @@ -0,0 +1,4 @@ +(jbuild_version 1) + +(executable + ((name discover))) diff --git a/src/unix/jbuild b/src/unix/jbuild new file mode 100644 index 0000000000..abdb3843c4 --- /dev/null +++ b/src/unix/jbuild @@ -0,0 +1,132 @@ +(jbuild_version 1) + +;; pre-processing cppo files + +(rule + ((targets (lwt_unix.ml)) + (deps (lwt_unix.cppo.ml)) + (action (run ${bin:cppo} -V OCAML:${ocaml_version} ${<} -o ${@})))) + +(rule + ((targets (lwt_unix.mli)) + (deps (lwt_unix.cppo.mli)) + (action (run ${bin:cppo} -V OCAML:${ocaml_version} ${<} -o ${@})))) + +;; lwt feature discovery +;; +;; we use 2 config files +;; +;; - ocamlc_config which is generated here from calling 'ocamlc -config' +;; - lwt_config which is optionally generated by src/utils/configure.ml +;; and contains configuration options for libev, pthread, android etc. +;; +;; The later configration file can be used for development and by opam +;; to enable features based on the system configuration. + +;; run ocamlc -config +(rule + ((targets (ocamlc_config)) + (action (with-stdout-to ${@} (run ${OCAMLC} -config))))) + +;; generate an empty lwt_config if it doesn't exist. +;; the discover script will generate defaults as appropriate. +(rule + ((targets (lwt_config)) + (action (with-stdout-to lwt_config (echo ""))))) + +;; note; the call to (and dependancy on) ocamlfind is avoided by adding: +;; -ocamlc ${OCAMLC} +;; however, this only works on ocaml >= 4.04 due to passing options to ocamlc as +;; "-cclib -o -cclib " +(rule + ((targets (unix_c_flags.sexp + unix_c_library_flags.sexp + lwt_config.h + lwt_config.ml)) + (deps (config/discover.exe ocamlc_config lwt_config)) + (action (run ${<} + -ocamlc-config ocamlc_config ;; generated above + -lwt-config lwt_config + )))) + +;; gen_stubs.ml + +(rule + ((targets ( + lwt_unix_job_access.c + lwt_unix_job_chdir.c + lwt_unix_job_chmod.c + lwt_unix_job_chown.c + lwt_unix_job_chroot.c + lwt_unix_job_close.c + lwt_unix_job_fchmod.c + lwt_unix_job_fchown.c + lwt_unix_job_fdatasync.c + lwt_unix_job_fsync.c + lwt_unix_job_ftruncate.c + lwt_unix_job_link.c + lwt_unix_job_lseek.c + lwt_unix_job_mkdir.c + lwt_unix_job_mkfifo.c + lwt_unix_job_rename.c + lwt_unix_job_rmdir.c + lwt_unix_job_symlink.c + lwt_unix_job_tcdrain.c + lwt_unix_job_tcflow.c + lwt_unix_job_tcflush.c + lwt_unix_job_tcsendbreak.c + lwt_unix_job_truncate.c + lwt_unix_job_unlink.c + lwt_unix_jobs_generated.ml + )) + (deps (stubs/gen_stubs.exe)) + (action (run ${<})))) + +;; main library +;; Lwt_unix_jobs_generated and Lwt_config should be hidden + +(library + ((name lwt_unix) + (public_name lwt.unix) + (synopsis "Unix support for Lwt") + (optional) + (wrapped false) + (libraries (lwt lwt.log unix bigarray)) + (c_names ( + lwt_unix_stubs + lwt_libev_stubs + lwt_process_stubs + lwt_unix_job_access + lwt_unix_job_chdir + lwt_unix_job_chmod + lwt_unix_job_chown + lwt_unix_job_chroot + lwt_unix_job_close + lwt_unix_job_fchmod + lwt_unix_job_fchown + lwt_unix_job_fdatasync + lwt_unix_job_fsync + lwt_unix_job_ftruncate + lwt_unix_job_link + lwt_unix_job_lseek + lwt_unix_job_mkdir + lwt_unix_job_mkfifo + lwt_unix_job_rename + lwt_unix_job_rmdir + lwt_unix_job_symlink + lwt_unix_job_tcdrain + lwt_unix_job_tcflow + lwt_unix_job_tcflush + lwt_unix_job_tcsendbreak + lwt_unix_job_truncate + lwt_unix_job_unlink + )) + (install_c_headers ( + lwt_config + lwt_unix + lwt_unix_unix + lwt_unix_windows + )) + (c_flags (:include unix_c_flags.sexp)) + (c_library_flags (:include unix_c_library_flags.sexp)) +)) diff --git a/src/unix/lwt_unix_stubs.c b/src/unix/lwt_unix_stubs.c index 83d82fd266..4674e4ecbc 100644 --- a/src/unix/lwt_unix_stubs.c +++ b/src/unix/lwt_unix_stubs.c @@ -88,9 +88,9 @@ +-----------------------------------------------------------------+ */ #if defined(LWT_ON_WINDOWS) -# include "lwt_unix_windows.c" +# include "lwt_unix_windows.h" #else -# include "lwt_unix_unix.c" +# include "lwt_unix_unix.h" #endif /* +-----------------------------------------------------------------+ diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.h similarity index 100% rename from src/unix/lwt_unix_unix.c rename to src/unix/lwt_unix_unix.h diff --git a/src/unix/lwt_unix_windows.c b/src/unix/lwt_unix_windows.h similarity index 100% rename from src/unix/lwt_unix_windows.c rename to src/unix/lwt_unix_windows.h diff --git a/src/unix/gen_stubs.ml b/src/unix/stubs/gen_stubs.ml similarity index 99% rename from src/unix/gen_stubs.ml rename to src/unix/stubs/gen_stubs.ml index d21c8771d6..4a251c149f 100644 --- a/src/unix/gen_stubs.ml +++ b/src/unix/stubs/gen_stubs.ml @@ -731,7 +731,7 @@ end let gen job = let fname = "lwt_unix_job_" ^ job.name ^ ".c" in - let oc = open_out ("src/unix/jobs-unix/" ^ fname) in + let oc = open_out fname in let job64 = { job with params = ( @@ -778,7 +778,7 @@ let () = match Sys.argv with | [|_|] -> let fname = "lwt_unix_jobs_generated.ml" in - ml_oc := open_out ("src/unix/" ^ fname); + ml_oc := open_out fname; let pr_header oc fname = fprintf oc "\ (* @@ -805,7 +805,7 @@ module Make(Job : Job) = struct output_string !ml_oc "end\n"; close_out !ml_oc | [|_; "list-job-files"|] -> - StringMap.iter (fun name job -> printf "src/unix/jobs-unix/lwt_unix_job_%s.c\n" name) jobs + StringMap.iter (fun name job -> printf "lwt_unix_job_%s.c\n" name) jobs | [|_; "list-job-names"|] -> StringMap.iter (fun name job -> printf "%s\n" name) jobs | _ -> diff --git a/src/unix/stubs/jbuild b/src/unix/stubs/jbuild new file mode 100644 index 0000000000..8a44740c4b --- /dev/null +++ b/src/unix/stubs/jbuild @@ -0,0 +1,4 @@ +(jbuild_version 1) + +(executable + ((name gen_stubs))) diff --git a/src/util/appveyor-build.sh b/src/util/appveyor-build.sh index 8553888e90..2b724812c1 100644 --- a/src/util/appveyor-build.sh +++ b/src/util/appveyor-build.sh @@ -1,16 +1,12 @@ set -e set -x +# install packages and run tests if [ "$SYSTEM" = cygwin ] then - PACKAGES="lwt lwt_react lwt_ssl" + opam install -y -t --verbose lwt lwt_react lwt_ssl else - PACKAGES="lwt lwt_react" + opam install -y -t --verbose lwt lwt_react fi -opam install -y --keep-build-dir --verbose $PACKAGES -cd `opam config var lib`/../build/lwt.* -ocaml setup.ml -configure --enable-tests -make test - ! opam list -i batteries diff --git a/src/util/appveyor-install.sh b/src/util/appveyor-install.sh index f02673278d..cd7c94a536 100644 --- a/src/util/appveyor-install.sh +++ b/src/util/appveyor-install.sh @@ -11,8 +11,7 @@ CACHE=$DIRECTORY/../opam-cache-$SYSTEM-$COMPILER-$LIBEV.tar pin_extra_package () { PACKAGE=$1 - ( cd src/$PACKAGE/ && oasis setup -setup-update none ) - opam pin add -y --no-action src/$PACKAGE/ + opam pin add -y --no-action lwt_$PACKAGE . } if [ ! -f $CACHE ] @@ -20,9 +19,8 @@ then opam init -y --auto-setup eval `opam config env` - # Pin Lwt and install its dependencies. This also installs OASIS, which is - # needed later to generate the build systems of extra packages.s - opam pin add -y --no-action . + # Pin Lwt and install its dependencies. + opam pin add -y --no-action lwt . opam install -y --deps-only lwt opam install -y camlp4 if [ "$LIBEV" = yes ] diff --git a/src/util/config-warn b/src/util/config-warn new file mode 100644 index 0000000000..50fa42b333 --- /dev/null +++ b/src/util/config-warn @@ -0,0 +1,20 @@ +=========================================================== + +LWT configuration is incomplete and compilation will +proceed with default values. + +Consider running 'ocaml src/util/configure.ml' or +'make default-config' to complete configuration. + +$ ocaml src/util/configure.ml -help +enable lwt.unix and camlp4 features +options are: + -use-libev {true|false} whether to check for libev + -use-pthread {true|false} whether to use pthread + -android-target {true|false} compile for Android + -libev-default {true|false} whether to use the libev backend by default + -use-camlp4 {true|false} when true enable camlp4 syntax extension + -help Display this list of options + --help Display this list of options + +=========================================================== diff --git a/src/util/configure.ml b/src/util/configure.ml new file mode 100644 index 0000000000..8da874accf --- /dev/null +++ b/src/util/configure.ml @@ -0,0 +1,47 @@ +(* top-level lwt feature configuration *) + +let use_libev = ref None +let use_pthread = ref None +let android_target = ref None +let libev_default = ref None +let use_camlp4 = ref None + +let arg_bool r = + Arg.Symbol (["true"; "false"], + function + | "true" -> r := Some true + | "false" -> r := Some false + | _ -> assert false) +let args = [ + "-use-libev", arg_bool use_libev, " whether to check for libev"; + "-use-pthread", arg_bool use_pthread, " whether to use pthread"; + "-android-target", arg_bool android_target, " compile for Android"; + "-libev-default", arg_bool libev_default, " whether to use the libev backend by default"; + "-use-camlp4", arg_bool use_camlp4, " when true enable camlp4 syntax extension"; +] + +let main () = + Arg.parse args ignore "enable lwt.unix and camlp4 features\noptions are:"; + let f = open_out "src/unix/lwt_config" in + let print name var = + match var with + | None -> () + | Some var -> Printf.fprintf f "%s: %b\n" name var + in + print"use_libev" !use_libev; + print"use_pthread" !use_pthread; + print"android_target" !android_target; + print"libev_default" !libev_default; + close_out f; + (* '-use-camlp4 false' (or none) will write a jbuild-ignore file directing jbuilder to ignore + * the camlp4 directory. + * '-use-camlp4 true' will write an empty file which does nothing + * + * This is a workaround required to overcome some weird camlp4 packaging behaviour + * where ocamlfind sometimes installs a dummy META file for it even though it's + * not actually installed. *) + let f = open_out "src/jbuild-ignore" in + (if !use_camlp4 = Some(true) then () else Printf.fprintf f "camlp4"); + close_out f + +let () = main () diff --git a/src/util/travis.sh b/src/util/travis.sh index 2814336209..45fcb6fb3b 100644 --- a/src/util/travis.sh +++ b/src/util/travis.sh @@ -117,7 +117,7 @@ fi # Pin Lwt, install dependencies, and then install Lwt. Lwt is installed # separately because we want to keep the build directory for running the tests. -opam pin add -y --no-action . +opam pin add -y --no-action lwt . opam install -y --deps-only lwt opam install -y camlp4 @@ -128,14 +128,12 @@ fi opam install --keep-build-dir --verbose lwt -# Pin additional packages, generate their build systems, and install them. There +# Pin additional packages and install them. There # aren't any specific tests for these packages. Installation itself is the only -# test. Build system generation requires OASIS; this should have been installed -# while installing dependencies of Lwt. +# test. install_extra_package () { PACKAGE=$1 - ( cd src/$PACKAGE/ && oasis setup -setup-update none ) - opam pin add -y --no-action src/$PACKAGE/ + opam pin add -y --no-action lwt_$PACKAGE . opam install -y --verbose lwt_$PACKAGE } @@ -146,7 +144,6 @@ install_extra_package glib # Build and run the tests. opam install -y ounit cd `opam config var lib`/../build/lwt.* -ocaml setup.ml -configure --enable-tests make test @@ -157,5 +154,5 @@ then ! opam list -i conf-libev fi -opam list -i ppx_tools +opam list -i ppx_tools_versioned ! opam list -i batteries diff --git a/tests/core/jbuild b/tests/core/jbuild new file mode 100644 index 0000000000..9f5f445764 --- /dev/null +++ b/tests/core/jbuild @@ -0,0 +1,10 @@ +(jbuild_version 1) + +(executable + ((name main) + (libraries (lwttester)))) + +(alias + ((name runtest) + (package lwt) + (action (run ${exe:main.exe})))) diff --git a/tests/jbuild b/tests/jbuild new file mode 100644 index 0000000000..53fc8b7b41 --- /dev/null +++ b/tests/jbuild @@ -0,0 +1,6 @@ +(jbuild_version 1) + +(library + ((name "lwttester") + (wrapped false) + (libraries (lwt unix lwt.unix)))) diff --git a/tests/ppx/jbuild b/tests/ppx/jbuild new file mode 100644 index 0000000000..a625d3ad15 --- /dev/null +++ b/tests/ppx/jbuild @@ -0,0 +1,11 @@ +(jbuild_version 1) + +(executable + ((name main) + (libraries (lwttester)) + (preprocess (pps (lwt.ppx))))) + +(alias + ((name runtest) + (package lwt) + (action (run ${exe:main.exe})))) diff --git a/tests/preemptive/jbuild b/tests/preemptive/jbuild new file mode 100644 index 0000000000..2c3c8ee332 --- /dev/null +++ b/tests/preemptive/jbuild @@ -0,0 +1,10 @@ +(jbuild_version 1) + +(executable + ((name main) + (libraries (lwt.preemptive lwttester)))) + +(alias + ((name runtest) + (package lwt) + (action (run ${exe:main.exe})))) diff --git a/tests/react/jbuild b/tests/react/jbuild new file mode 100644 index 0000000000..5b36992722 --- /dev/null +++ b/tests/react/jbuild @@ -0,0 +1,10 @@ +(jbuild_version 1) + +(executable + ((name main) + (libraries (lwt_react lwttester)))) + +(alias + ((name runtest) + (package lwt_react) + (action (run ${exe:main.exe})))) diff --git a/tests/test.ml b/tests/test.ml index c3a0f45afd..6ff0230090 100644 --- a/tests/test.ml +++ b/tests/test.ml @@ -51,9 +51,9 @@ let run name suites = match suites with | [] -> if failures = 0 then - Printf.printf "\r\027[JDone. %d test(s) skipped.\n%!" skipped + Printf.printf "Done. %d test(s) skipped.\n%!" skipped else begin - Printf.printf "\r\027[JDone. %d of %d tests failed.\n%!" failures total; + Printf.printf "Done. %d of %d tests failed.\n%!" failures total; exit 1 end | suite :: suites -> @@ -67,27 +67,27 @@ let run name suites = loop_suites failures skipped number suites | test :: tests -> if not (test.only_if ()) then begin - Printf.printf "\r\027[J(%d/%d) Skipping test %S from suite %S%!" + Printf.printf "(%d/%d) Skipping test %S from suite %S\b%!" number total test.name suite_name; loop_tests failures (skipped + 1) suite_name (number + 1) suites tests end else begin - Printf.printf "\r\027[J(%d/%d) Running test %S from suite %S%!" + Printf.printf "(%d/%d) Running test %S from suite %S\n%!" number total test.name suite_name; try if test.run () then loop_tests failures skipped suite_name (number + 1) suites tests else begin Printf.printf - "\r\027[J\027[31;1mTest %S from suite %S failed.\027[0m\n%!" + "Test %S from suite %S failed.\n%!" test.name suite_name; loop_tests (failures + 1) skipped suite_name (number + 1) suites tests end with exn -> Printf.printf - "\r\027[J\027[31;1mTest %S from suite %S failed. It raised: %S.\027[0m\n%!" + "Test %S from suite %S failed. It raised: %S.\n%!" test.name suite_name (Printexc.to_string exn); loop_tests (failures + 1) skipped suite_name (number + 1) suites tests @@ -99,10 +99,10 @@ let temp_name = let rng = Random.State.make_self_init () in fun () -> let number = Random.State.int rng 10000 in - Printf.sprintf "_build/lwt-testing-%04d" number + Printf.sprintf (*"_build/"*)"lwt-testing-%04d" number let temp_file () = - Filename.temp_file ~temp_dir:"_build" "lwt-testing-" "" + Filename.temp_file (*~temp_dir:"_build"*) "lwt-testing-" "" let temp_directory () = let rec attempt () = diff --git a/tests/unix/jbuild b/tests/unix/jbuild new file mode 100644 index 0000000000..0fce9092e0 --- /dev/null +++ b/tests/unix/jbuild @@ -0,0 +1,15 @@ +(jbuild_version 1) + +(rule + ((targets (test_lwt_unix.ml)) + (deps (test_lwt_unix.cppo.ml)) + (action (run ${bin:cppo} -V OCAML:${ocaml_version} ${<} -o ${@})))) + +(executable + ((name main) + (libraries (lwttester)))) + +(alias + ((name runtest) + (package lwt) + (action (run ${exe:main.exe}))))