From 5ce8f6e957f041bdf0fecef331e6cd6263861eb7 Mon Sep 17 00:00:00 2001 From: Romain Beauxis Date: Fri, 27 Mar 2020 20:49:21 -0500 Subject: [PATCH] Switch to dune. --- .gitignore | 29 +- .gitmodules | 3 - .ocamlformat | 9 + CHANGES | 4 +- Makefile.in | 31 - bootstrap | 1 - configure.ac | 67 -- dune-project | 17 + duppy.opam | 32 +- examples/Makefile | 12 - examples/Makefile.http.in | 10 - examples/Makefile.telnet.in | 10 - examples/OCamlMakefile | 1154 ------------------------- examples/dune | 9 + examples/http.ml | 342 ++++---- examples/telnet.ml | 93 +- m4/base_checks.m4 | 175 ---- m4/bootstrap | 17 - m4/cpp_check_class.m4 | 24 - m4/detect_binding.m4 | 139 --- m4/ocaml.m4 | 329 ------- m4/ocaml_compilers.m4 | 76 -- m4/pkg_config.m4 | 76 -- m4/strict_check_tool.m4 | 7 - src/META.in | 10 - src/Makefile.in | 68 -- src/OCamlMakefile | 1139 ------------------------ src/dune | 8 + src/duppy.ml | 1475 +++++++++++++++----------------- src/duppy.mli | 228 ++--- src/duppy_secure_transport.ml | 19 - src/duppy_secure_transport.mli | 6 - src/duppy_ssl.ml | 13 - src/duppy_ssl.mli | 2 - 34 files changed, 1136 insertions(+), 4498 deletions(-) delete mode 100644 .gitmodules create mode 100644 .ocamlformat delete mode 100644 Makefile.in delete mode 120000 bootstrap delete mode 100644 configure.ac create mode 100644 dune-project delete mode 100644 examples/Makefile delete mode 100644 examples/Makefile.http.in delete mode 100644 examples/Makefile.telnet.in delete mode 100644 examples/OCamlMakefile create mode 100644 examples/dune delete mode 100644 m4/base_checks.m4 delete mode 100755 m4/bootstrap delete mode 100644 m4/cpp_check_class.m4 delete mode 100644 m4/detect_binding.m4 delete mode 100644 m4/ocaml.m4 delete mode 100644 m4/ocaml_compilers.m4 delete mode 100644 m4/pkg_config.m4 delete mode 100644 m4/strict_check_tool.m4 delete mode 100644 src/META.in delete mode 100644 src/Makefile.in delete mode 100644 src/OCamlMakefile create mode 100644 src/dune delete mode 100644 src/duppy_secure_transport.ml delete mode 100644 src/duppy_secure_transport.mli delete mode 100644 src/duppy_ssl.ml delete mode 100644 src/duppy_ssl.mli diff --git a/.gitignore b/.gitignore index 2f7df78..6fadc6f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,22 +1,7 @@ -Makefile -aclocal.m4 -autom4te.cache/ -config.guess -config.log -config.status -config.sub -configure -install-sh -src/META -src/Makefile -._bcdi -._d -._ncdi -src/*.a -src/*.cm* -src/*.o -src/*.so -src/*.annot -examples/Makefile.http -examples/Makefile.telnet -*.sw* +*~ +_build +*.byte +*.native +_tests +.merlin +*.install diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index 83f76ee..0000000 --- a/.gitmodules +++ /dev/null @@ -1,3 +0,0 @@ -[submodule "m4"] - path = m4 - url = git://github.com/savonet/m4.git diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..533d804 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,9 @@ +profile = conventional +break-separators = after +space-around-lists = false +doc-comments = before +match-indent = 2 +match-indent-nested = always +parens-ite +exp-grouping = preserve +module-item-spacing = compact diff --git a/CHANGES b/CHANGES index 963414e..a500bcd 100644 --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,8 @@ -0.8.1 (unreleased) +0.9.0 (unreleased) ===== * Add offset/length to writing functions. +* Convert to dune. +* Drop unused SSL and SecureTransport optional libs. 0.8.0 (12-11-2018) ===== diff --git a/Makefile.in b/Makefile.in deleted file mode 100644 index 9672296..0000000 --- a/Makefile.in +++ /dev/null @@ -1,31 +0,0 @@ -# $Id: Makefile.in 2660 2006-07-18 17:23:31Z dbaelde $ - -PROGNAME := ocaml-duppy -DISTFILES := @AUTOCONF_INSTALL_FILES@ CHANGES COPYING Makefile.in README \ - bootstrap configure configure.ac \ - src/*.ml src/*.mli src/*.c src/Makefile.in src/META.in \ - src/OCamlMakefile examples/*.ml examples/Makefile \ - examples/Makefile.*.in examples/OCamlMakefile -VERSION = @VERSION@ - -all clean install uninstall: - $(MAKE) -C src $@ - -distclean: clean - $(MAKE) -C examples clean - -doc: - $(MAKE) -C src htdoc - mkdir -p doc - rm -rf doc/html - mv src/doc/duppy/html doc - rm -rf src/doc - -dist: - rm -rf $(PROGNAME)-$(VERSION) - mkdir $(PROGNAME)-$(VERSION) - cp -R -L --parents $(DISTFILES) $(PROGNAME)-$(VERSION) - tar zcvf ../$(PROGNAME)-$(VERSION).tar.gz $(PROGNAME)-$(VERSION) - rm -rf $(PROGNAME)-$(VERSION) - -.PHONY: dist doc diff --git a/bootstrap b/bootstrap deleted file mode 120000 index b78754e..0000000 --- a/bootstrap +++ /dev/null @@ -1 +0,0 @@ -m4/bootstrap \ No newline at end of file diff --git a/configure.ac b/configure.ac deleted file mode 100644 index d848abf..0000000 --- a/configure.ac +++ /dev/null @@ -1,67 +0,0 @@ -AC_INIT([ocaml-duppy], - m4_esyscmd([cat duppy.opam | grep ^version | sed 's/version: "\([^"]*\)"/\1/' | tr -d '\r\n']), - [savonet-users@lists.sourceforge.net]) - -VERSION=$PACKAGE_VERSION -AC_SUBST(VERSION) -AC_MSG_RESULT([configuring $PACKAGE_STRING]) - -AC_BASE_CHECKS() - -AC_CHECK_OCAML_BINDING([pcre],[],[],[1]) -INC="$INC `$OCAMLFIND query pcre`" - -AC_CHECK_OCAML_BINDING([bytes],[],[],[1]) -INC="$INC `$OCAMLFIND query bytes`" - -AC_CHECK_OCAML_BINDING([ssl]) - -if test "$w_SSL" == "yes"; then - INC="$INC `$OCAMLFIND query ssl`" - DUPPY_SSL="duppy_ssl" - DUPPY_SSL_META="package \"ssl\" ( - description = \"OCaml advanced scheduler (SSL module)\" - requires = \"duppy ssl\" - version=\"${VERSION}\" - archive(byte) = \"duppy_ssl.cma\" - archive(native) = \"duppy_ssl.cmxa\" -)" -fi -AC_SUBST(DUPPY_SSL) -AC_SUBST(DUPPY_SSL_META) - -AC_CHECK_OCAML_BINDING([osx-secure-transport]) - -if test "$w_OSX_SECURE_TRANSPORT" == "yes"; then - INC="$INC `$OCAMLFIND query osx-secure-transport`" - DUPPY_SECURE_TRANSPORT="duppy_secure_transport" - DUPPY_SECURE_TRANSPORT_META="package \"secure_transport\" ( - description = \"OCaml advanced scheduler (SecureTransport module)\" - requires = \"duppy secure_transport\" - version=\"${VERSION}\" - archive(byte) = \"duppy_secure_transport.cma\" - archive(native) = \"duppy_secure_transport.cmxa\" -)" -fi -AC_SUBST(DUPPY_SECURE_TRANSPORT) -AC_SUBST(DUPPY_SECURE_TRANSPORT_META) - -# substitutions to perform -requires="unix threads pcre bigarray" -AC_SUBST(VERSION) -ALL_INC="`ocamlfind query -r -separator " " $requires` $_INC" -INC="$INC $_INC" -AC_SUBST(INC) -AC_SUBST(ALL_INC) -all_requires="`ocamlfind query -r -separator " " -format "%p" $requires` $_requires" -requires="$requires $_requires" -AC_SUBST(requires) -AC_SUBST(all_requires) - -# Finally create the Makefile and samples -AC_CONFIG_FILES([Makefile],[chmod a-w Makefile]) -AC_CONFIG_FILES([src/META]) -AC_CONFIG_FILES([src/Makefile]) -AC_CONFIG_FILES([examples/Makefile.telnet]) -AC_CONFIG_FILES([examples/Makefile.http]) -AC_OUTPUT diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..c23d560 --- /dev/null +++ b/dune-project @@ -0,0 +1,17 @@ +(lang dune 2.0) +(version 0.6.5) +(name duppy) +(source (github savonet/ocaml-duppy)) +(license GPL-2.0) +(authors "Romain Beauxis ") +(maintainers "The Savonet Team ") + +(generate_opam_files true) + +(package + (name duppy) + (synopsis "Library providing monadic threads") + (depends + (dune (> 2.0)) + pcre) +) diff --git a/duppy.opam b/duppy.opam index 2dd5336..058772f 100644 --- a/duppy.opam +++ b/duppy.opam @@ -1,22 +1,28 @@ +# This file is generated by dune, edit dune-project instead opam-version: "2.0" -name: "duppy" -version: "0.8.1" -maintainer: "Romain Beauxis " -authors: "The Savonet Team " +version: "0.6.5" +synopsis: "Library providing monadic threads" +maintainer: ["The Savonet Team "] +authors: ["Romain Beauxis "] +license: "GPL-2.0" homepage: "https://github.com/savonet/ocaml-duppy" bug-reports: "https://github.com/savonet/ocaml-duppy/issues" depends: [ - "ocaml" - "ocamlfind" {build} + "dune" {> "2.0"} "pcre" ] -depopts: ["ssl" "osx-secure-transport"] build: [ - ["./bootstrap"] {dev} - ["./configure" "--prefix" prefix] - [make "clean"] {dev} - [make] + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] ] -install: [make "install"] dev-repo: "git+https://github.com/savonet/ocaml-duppy.git" -synopsis: "Library providing monadic threads" diff --git a/examples/Makefile b/examples/Makefile deleted file mode 100644 index 2b9d33d..0000000 --- a/examples/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# OCaml-Lastfm examples. -# -# Copyright 2007 by the Savonet team. -# -# $Id: Makefile 4694 2007-10-23 23:33:11Z smimram $ - -all clean: - $(MAKE) -f Makefile.telnet $@ - $(MAKE) -f Makefile.http $@ - -distclean: clean - rm -rf autom4te.cache config.log config.status autom4te.cache diff --git a/examples/Makefile.http.in b/examples/Makefile.http.in deleted file mode 100644 index b920d89..0000000 --- a/examples/Makefile.http.in +++ /dev/null @@ -1,10 +0,0 @@ -SOURCES = http.ml -RESULT = http -INCDIRS = ../src @ALL_INC@ -OCAMLC = @OCAMLC@ -thread -OCAMLOPT = @OCAMLOPT@ -thread -LIBS = @all_requires@ duppy - -all: nc - --include OCamlMakefile diff --git a/examples/Makefile.telnet.in b/examples/Makefile.telnet.in deleted file mode 100644 index 5b6dee4..0000000 --- a/examples/Makefile.telnet.in +++ /dev/null @@ -1,10 +0,0 @@ -SOURCES = telnet.ml -RESULT = telnet -INCDIRS = ../src @ALL_INC@ -OCAMLC = @OCAMLC@ -thread -OCAMLOPT = @OCAMLOPT@ -thread -LIBS = @all_requires@ duppy - -all: nc - --include OCamlMakefile diff --git a/examples/OCamlMakefile b/examples/OCamlMakefile deleted file mode 100644 index 6f62c91..0000000 --- a/examples/OCamlMakefile +++ /dev/null @@ -1,1154 +0,0 @@ -########################################################################### -# OCamlMakefile -# Copyright (C) 1999-2004 Markus Mottl -# -# For updates see: -# http://www.ocaml.info/home/ocaml_sources.html -# -# $Id: OCamlMakefile,v 1.72 2005/12/09 15:30:50 mottl Exp $ -# -########################################################################### - -# Modified by damien for .glade.ml compilation - -# Set these variables to the names of the sources to be processed and -# the result variable. Order matters during linkage! - -ifndef SOURCES - SOURCES := foo.ml -endif -export SOURCES - -ifndef RES_CLIB_SUF - RES_CLIB_SUF := _stubs -endif -export RES_CLIB_SUF - -ifndef RESULT - RESULT := foo -endif -export RESULT - -export LIB_PACK_NAME - -ifndef DOC_FILES - DOC_FILES := $(filter %.mli, $(SOURCES)) -endif -export DOC_FILES - -export BCSUFFIX -export NCSUFFIX - -ifndef TOPSUFFIX - TOPSUFFIX := .top -endif -export TOPSUFFIX - -# Eventually set include- and library-paths, libraries to link, -# additional compilation-, link- and ocamlyacc-flags -# Path- and library information needs not be written with "-I" and such... -# Define THREADS if you need it, otherwise leave it unset (same for -# USE_CAMLP4)! - -export THREADS -export VMTHREADS -export ANNOTATE -export USE_CAMLP4 - -export INCDIRS -export LIBDIRS -export EXTLIBDIRS -export RESULTDEPS -export OCAML_DEFAULT_DIRS - -export LIBS -export CLIBS - -export OCAMLFLAGS -export OCAMLNCFLAGS -export OCAMLBCFLAGS - -export OCAMLLDFLAGS -export OCAMLNLDFLAGS -export OCAMLBLDFLAGS - -ifndef OCAMLCPFLAGS - OCAMLCPFLAGS := a -endif - -export OCAMLCPFLAGS - -export PPFLAGS - -export YFLAGS -export IDLFLAGS - -export OCAMLDOCFLAGS - -export OCAMLFIND_INSTFLAGS - -export DVIPSFLAGS - -export STATIC - -# Add a list of optional trash files that should be deleted by "make clean" -export TRASH - -#################### variables depending on your OCaml-installation - -ifdef MINGW - export MINGW - WIN32 := 1 - CFLAGS_WIN32 := -mno-cygwin -endif -ifdef MSVC - export MSVC - WIN32 := 1 - ifndef STATIC - CPPFLAGS_WIN32 := -DCAML_DLL - endif - CFLAGS_WIN32 += -nologo - EXT_OBJ := obj - EXT_LIB := lib - ifeq ($(CC),gcc) - # work around GNU Make default value - ifdef THREADS - CC := cl -MT - else - CC := cl - endif - endif - ifeq ($(CXX),g++) - # work around GNU Make default value - CXX := $(CC) - endif - CFLAG_O := -Fo -endif -ifdef WIN32 - EXT_CXX := cpp - EXE := .exe -endif - -ifndef EXT_OBJ - EXT_OBJ := o -endif -ifndef EXT_LIB - EXT_LIB := a -endif -ifndef EXT_CXX - EXT_CXX := cc -endif -ifndef EXE - EXE := # empty -endif -ifndef CFLAG_O - CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! -endif - -export CC -export CXX -export CFLAGS -export CXXFLAGS -export LDFLAGS -export CPPFLAGS - -ifndef RPATH_FLAG - RPATH_FLAG := -R -endif -export RPATH_FLAG - -ifndef MSVC -ifndef PIC_CFLAGS - PIC_CFLAGS := -fPIC -endif -ifndef PIC_CPPFLAGS - PIC_CPPFLAGS := -DPIC -endif -endif - -export PIC_CFLAGS -export PIC_CPPFLAGS - -BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) -NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) -TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) - -ifndef OCAMLFIND - OCAMLFIND := ocamlfind -endif -export OCAMLFIND - -ifndef OCAMLC - OCAMLC := ocamlc -endif -export OCAMLC - -ifndef OCAMLOPT - OCAMLOPT := ocamlopt -endif -export OCAMLOPT - -ifndef OCAMLMKTOP - OCAMLMKTOP := ocamlmktop -endif -export OCAMLMKTOP - -ifndef OCAMLCP - OCAMLCP := ocamlcp -endif -export OCAMLCP - -ifndef OCAMLDEP - OCAMLDEP := ocamldep -endif -export OCAMLDEP - -ifndef OCAMLLEX - OCAMLLEX := ocamllex -endif -export OCAMLLEX - -ifndef OCAMLYACC - OCAMLYACC := ocamlyacc -endif -export OCAMLYACC - -ifndef OCAMLMKLIB - OCAMLMKLIB := ocamlmklib -endif -export OCAMLMKLIB - -ifndef OCAML_GLADECC - OCAML_GLADECC := lablgladecc2 -endif -export OCAML_GLADECC - -ifndef OCAML_GLADECC_FLAGS - OCAML_GLADECC_FLAGS := -endif -export OCAML_GLADECC_FLAGS - -ifndef CAMELEON_REPORT - CAMELEON_REPORT := report -endif -export CAMELEON_REPORT - -ifndef CAMELEON_REPORT_FLAGS - CAMELEON_REPORT_FLAGS := -endif -export CAMELEON_REPORT_FLAGS - -ifndef CAMELEON_ZOGGY - CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo -endif -export CAMELEON_ZOGGY - -ifndef CAMELEON_ZOGGY_FLAGS - CAMELEON_ZOGGY_FLAGS := -endif -export CAMELEON_ZOGGY_FLAGS - -ifndef OXRIDL - OXRIDL := oxridl -endif -export OXRIDL - -ifndef CAMLIDL - CAMLIDL := camlidl -endif -export CAMLIDL - -ifndef CAMLIDLDLL - CAMLIDLDLL := camlidldll -endif -export CAMLIDLDLL - -ifndef NOIDLHEADER - MAYBE_IDL_HEADER := -header -endif -export NOIDLHEADER - -export NO_CUSTOM - -ifndef CAMLP4 - CAMLP4 := camlp4 -endif -export CAMLP4 - -ifndef REAL_OCAMLFIND - ifdef PACKS - ifndef CREATE_LIB - ifdef THREADS - PACKS += threads - endif - endif - empty := - space := $(empty) $(empty) - comma := , - ifdef PREDS - PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) - PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) - OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) - # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) - OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) - OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) - else - OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) - OCAML_DEP_PACKAGES := - endif - OCAML_FIND_LINKPKG := -linkpkg - REAL_OCAMLFIND := $(OCAMLFIND) - endif -endif - -export OCAML_FIND_PACKAGES -export OCAML_DEP_PACKAGES -export OCAML_FIND_LINKPKG -export REAL_OCAMLFIND - -ifndef OCAMLDOC - OCAMLDOC := ocamldoc -endif -export OCAMLDOC - -ifndef LATEX - LATEX := latex -endif -export LATEX - -ifndef DVIPS - DVIPS := dvips -endif -export DVIPS - -ifndef PS2PDF - PS2PDF := ps2pdf -endif -export PS2PDF - -ifndef OCAMLMAKEFILE - OCAMLMAKEFILE := OCamlMakefile -endif -export OCAMLMAKEFILE - -ifndef OCAMLLIBPATH - OCAMLLIBPATH := \ - $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/lib/ocaml) -endif -export OCAMLLIBPATH - -ifndef OCAML_LIB_INSTALL - OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib -endif -export OCAML_LIB_INSTALL - -########################################################################### - -#################### change following sections only if -#################### you know what you are doing! - -# delete target files when a build command fails -.PHONY: .DELETE_ON_ERROR -.DELETE_ON_ERROR: - -# for pedants using "--warn-undefined-variables" -export MAYBE_IDL -export REAL_RESULT -export CAMLIDLFLAGS -export THREAD_FLAG -export RES_CLIB -export MAKEDLL -export ANNOT_FLAG -export C_OXRIDL -export SUBPROJS -export CFLAGS_WIN32 -export CPPFLAGS_WIN32 - -INCFLAGS := - -SHELL := /bin/sh - -MLDEPDIR := ._d -BCDIDIR := ._bcdi -NCDIDIR := ._ncdi - -FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade - -FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) -SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) - -FILTERED_REP := $(filter %.rep, $(FILTERED)) -DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) -AUTO_REP := $(FILTERED_REP:.rep=.ml) - -FILTERED_ZOG := $(filter %.zog, $(FILTERED)) -DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) -AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) - -FILTERED_GLADE := $(filter %.glade, $(FILTERED)) -DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) -AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) - -FILTERED_ML := $(filter %.ml, $(FILTERED)) -DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) - -FILTERED_MLI := $(filter %.mli, $(FILTERED)) -DEP_MLI := $(FILTERED_MLI:.mli=.di) - -FILTERED_MLL := $(filter %.mll, $(FILTERED)) -DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) -AUTO_MLL := $(FILTERED_MLL:.mll=.ml) - -FILTERED_MLY := $(filter %.mly, $(FILTERED)) -DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) -AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) - -FILTERED_IDL := $(filter %.idl, $(FILTERED)) -DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) -C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) -ifndef NOIDLHEADER - C_IDL += $(FILTERED_IDL:.idl=.h) -endif -OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) -AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) - -FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) -DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) -AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) - -FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) -OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) -OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) - -PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) - -ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) - -MLDEPS := $(filter %.d, $(ALL_DEPS)) -MLIDEPS := $(filter %.di, $(ALL_DEPS)) -BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) -NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) - -ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) - -IMPLO_INTF := $(ALLML:%.mli=%.mli.__) -IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ - $(basename $(file)).cmi $(basename $(file)).cmo) -IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) -IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) - -IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) - -INTF := $(filter %.cmi, $(IMPLO_INTF)) -IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) -IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) -IMPL_ASM := $(IMPL_CMO:.cmo=.asm) -IMPL_S := $(IMPL_CMO:.cmo=.s) - -OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) -OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) - -EXECS := $(addsuffix $(EXE), \ - $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) -ifdef WIN32 - EXECS += $(BCRESULT).dll $(NCRESULT).dll -endif - -CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) -ifneq ($(strip $(OBJ_LINK)),) - RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) -endif - -ifdef WIN32 -DLLSONAME := $(CLIB_BASE).dll -else -DLLSONAME := dll$(CLIB_BASE).so -endif - -NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ - $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ - $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ - $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ - $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ - $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o - -ifndef STATIC - NONEXECS += $(DLLSONAME) -endif - -ifndef LIBINSTALL_FILES - LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ - $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) - ifndef STATIC - ifneq ($(strip $(OBJ_LINK)),) - LIBINSTALL_FILES += $(DLLSONAME) - endif - endif -endif - -export LIBINSTALL_FILES - -ifdef WIN32 - # some extra stuff is created while linking DLLs - NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib -endif - -TARGETS := $(EXECS) $(NONEXECS) - -# If there are IDL-files -ifneq ($(strip $(FILTERED_IDL)),) - MAYBE_IDL := -cclib -lcamlidl -endif - -ifdef USE_CAMLP4 - CAMLP4PATH := \ - $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/lib/camlp4) - INCFLAGS := -I $(CAMLP4PATH) - CINCFLAGS := -I$(CAMLP4PATH) -endif - -DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) -INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %) -CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) - -ifndef MSVC -CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ - $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \ - $(OCAML_DEFAULT_DIRS:%=-L%) -endif - -ifndef PROFILING - INTF_OCAMLC := $(OCAMLC) -else - ifndef THREADS - INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) - else - # OCaml does not support profiling byte code - # with threads (yet), therefore we force an error. - ifndef REAL_OCAMLC - $(error Profiling of multithreaded byte code not yet supported by OCaml) - endif - INTF_OCAMLC := $(OCAMLC) - endif -endif - -ifndef MSVC -COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ - $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ - $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \ - $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) -else -COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ - $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ - $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " -endif - -CLIBS_OPTS := $(CLIBS:%=-cclib -l%) -ifdef MSVC - ifndef STATIC - # MSVC libraries do not have 'lib' prefix - CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) - endif -endif - -ifneq ($(strip $(OBJ_LINK)),) - ifdef CREATE_LIB - OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) - else - OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) - endif -else - OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) -endif - -# If we have to make byte-code -ifndef REAL_OCAMLC - BYTE_OCAML := y - - # EXTRADEPS is added dependencies we have to insert for all - # executable files we generate. Ideally it should be all of the - # libraries we use, but it's hard to find the ones that get searched on - # the path since I don't know the paths built into the compiler, so - # just include the ones with slashes in their names. - EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) - - REAL_OCAMLC := $(INTF_OCAMLC) - - REAL_IMPL := $(IMPL_CMO) - REAL_IMPL_INTF := $(IMPLO_INTF) - IMPL_SUF := .cmo - - DEPFLAGS := - MAKE_DEPS := $(MLDEPS) $(BCDEPIS) - - ifdef CREATE_LIB - override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) - override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) - ifndef STATIC - ifneq ($(strip $(OBJ_LINK)),) - MAKEDLL := $(DLLSONAME) - ALL_LDFLAGS := -dllib $(DLLSONAME) - endif - endif - endif - - ifndef NO_CUSTOM - ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" - ALL_LDFLAGS += -custom - endif - endif - - ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ - $(COMMON_LDFLAGS) $(LIBS:%=%.cma) - CAMLIDLDLLFLAGS := - - ifdef THREADS - ifdef VMTHREADS - THREAD_FLAG := -vmthread - else - THREAD_FLAG := -thread - endif - ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) - ifndef CREATE_LIB - ifndef REAL_OCAMLFIND - ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) - endif - endif - endif - -# we have to make native-code -else - EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - ifndef PROFILING - SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) - PLDFLAGS := - else - SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) - PLDFLAGS := -p - endif - - REAL_IMPL := $(IMPL_CMX) - REAL_IMPL_INTF := $(IMPLX_INTF) - IMPL_SUF := .cmx - - override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) - - DEPFLAGS := -native - MAKE_DEPS := $(MLDEPS) $(NCDEPIS) - - ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ - $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) - CAMLIDLDLLFLAGS := -opt - - ifndef CREATE_LIB - ALL_LDFLAGS += $(LIBS:%=%.cmxa) - else - override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) - override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) - endif - - ifdef THREADS - THREAD_FLAG := -thread - ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) - ifndef CREATE_LIB - ifndef REAL_OCAMLFIND - ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) - endif - endif - endif -endif - -export MAKE_DEPS - -ifdef ANNOTATE - ANNOT_FLAG := -dtypes -else -endif - -ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ - $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) - -ifdef make_deps - -include $(MAKE_DEPS) - PRE_TARGETS := -endif - -########################################################################### -# USER RULES - -# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. -QUIET=@ - -# generates byte-code (default) -byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bc: byte-code - -byte-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bcnl: byte-code-nolink - -top: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes - -# generates native-code - -native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -nc: native-code - -native-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncnl: native-code-nolink - -# generates byte-code libraries -byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" \ - CREATE_LIB=yes \ - make_deps=yes -bcl: byte-code-library - -# generates native-code libraries -native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -ncl: native-code-library - -ifdef WIN32 -# generates byte-code dll -byte-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).dll \ - REAL_RESULT="$(BCRESULT)" \ - make_deps=yes -bcd: byte-code-dll - -# generates native-code dll -native-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).dll \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncd: native-code-dll -endif - -# generates byte-code with debugging information -debug-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dc: debug-code - -debug-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dcnl: debug-code-nolink - -# generates byte-code libraries with debugging information -debug-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - CREATE_LIB=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dcl: debug-code-library - -# generates byte-code for profiling -profiling-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - make_deps=yes -pbc: profiling-byte-code - -# generates native-code - -profiling-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PROFILING="y" \ - make_deps=yes -pnc: profiling-native-code - -# generates byte-code libraries -profiling-byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - CREATE_LIB=yes \ - make_deps=yes -pbcl: profiling-byte-code-library - -# generates native-code libraries -profiling-native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" PROFILING="y" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -pncl: profiling-native-code-library - -# packs byte-code objects -pack-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ - REAL_RESULT="$(BCRESULT)" \ - PACK_LIB=yes make_deps=yes -pabc: pack-byte-code - -# packs native-code objects -pack-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(NCRESULT).cmx $(NCRESULT).o \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PACK_LIB=yes make_deps=yes -panc: pack-native-code - -# generates HTML-documentation -htdoc: doc/$(RESULT)/html - -# generates Latex-documentation -ladoc: doc/$(RESULT)/latex - -# generates PostScript-documentation -psdoc: doc/$(RESULT)/latex/doc.ps - -# generates PDF-documentation -pdfdoc: doc/$(RESULT)/latex/doc.pdf - -# generates all supported forms of documentation -doc: htdoc ladoc psdoc pdfdoc - -########################################################################### -# LOW LEVEL RULES - -$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ - $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ - $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) - -nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) - -ifdef WIN32 -$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) - $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ - -o $@ $(REAL_IMPL) -endif - -%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ - $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ - $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) - -.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ - .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \ - .rep .zog .glade - -ifndef STATIC -ifdef MINGW -$(DLLSONAME): $(OBJ_LINK) - $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ - -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ - $(OCAMLLIBPATH)/ocamlrun.a \ - -Wl,--export-all-symbols \ - -Wl,--no-whole-archive -else -ifdef MSVC -$(DLLSONAME): $(OBJ_LINK) - link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ - $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ - $(OCAMLLIBPATH)/ocamlrun.lib - -else -$(DLLSONAME): $(OBJ_LINK) - $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ - -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ - $(OCAMLMKLIB_FLAGS) -endif -endif -endif - -ifndef LIB_PACK_NAME -$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) - -$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ - $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) -else -ifdef BYTE_OCAML -$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL) -else -$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL) -endif - -$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo - -$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ - $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx -endif - -$(RES_CLIB): $(OBJ_LINK) -ifndef MSVC - ifneq ($(strip $(OBJ_LINK)),) - $(AR) rcs $@ $(OBJ_LINK) - endif -else - ifneq ($(strip $(OBJ_LINK)),) - lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) - endif -endif - -.mli.cmi: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - else \ - echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - fi - -.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(ALL_OCAMLCFLAGS) $<; \ - else \ - echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ - fi - -ifdef PACK_LIB -$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(REAL_IMPL) -endif - -.PRECIOUS: %.ml -%.ml: %.mll - $(OCAMLLEX) $< - -.PRECIOUS: %.ml %.mli -%.ml %.mli: %.mly - $(OCAMLYACC) $(YFLAGS) $< - $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ - if [ ! -z "$$pp" ]; then \ - mv $*.ml $*.ml.temporary; \ - echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ - cat $*.ml.temporary >> $*.ml; \ - rm $*.ml.temporary; \ - mv $*.mli $*.mli.temporary; \ - echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ - cat $*.mli.temporary >> $*.mli; \ - rm $*.mli.temporary; \ - fi - - -.PRECIOUS: %.ml -%.ml: %.rep - $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< - -.PRECIOUS: %.ml -%.ml: %.zog - $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ - -.PRECIOUS: %.ml -%.ml: %.glade - $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ - -.PRECIOUS: %.ml %.mli -%.ml %.mli: %.oxridl - $(OXRIDL) $< - -.PRECIOUS: %.ml %.mli %_stubs.c %.h -%.ml %.mli %_stubs.c %.h: %.idl - $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ - $(CAMLIDLFLAGS) $< - $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi - -.c.$(EXT_OBJ): - $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ - $(CPPFLAGS) $(CPPFLAGS_WIN32) \ - $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< - -.$(EXT_CXX).$(EXT_OBJ): - $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ - -I'$(OCAMLLIBPATH)' \ - $< $(CFLAG_O)$@ - -$(MLDEPDIR)/%.d: %.ml - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - $(DINCFLAGS) $< \> $@; \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - $(DINCFLAGS) $< > $@; \ - else \ - echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ - fi - -$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< \> $@; \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ - else \ - echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ - -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ - -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ - fi - -doc/$(RESULT)/html: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ - $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ - else \ - echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES); \ - $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES); \ - fi - -doc/$(RESULT)/latex: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \ - $(DOC_FILES) -o $@/doc.tex; \ - $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \ - -o $@/doc.tex; \ - else \ - echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ - $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ - fi - -doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex - cd doc/$(RESULT)/latex && \ - $(LATEX) doc.tex && \ - $(LATEX) doc.tex && \ - $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) - -doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps - cd doc/$(RESULT)/latex && $(PS2PDF) $( 1 then ( - Printf.eprintf "Error: too many arguments\n" ; + Printf.eprintf "Error: too many arguments\n"; exit 1 ) else files_path := s in Arg.parse - [ ( "--non_blocking_queues" - , Arg.Int (fun i -> non_blocking_queues := i) - , Printf.sprintf "Number of non-blocking queues. (default: %d)" - !non_blocking_queues ) - ; ( "--maybe_blocking_queues" - , Arg.Int (fun i -> maybe_blocking_queues := i) - , Printf.sprintf "Number of maybe-blocking queues. (default: %d)" - !maybe_blocking_queues ) - ; ( "--port" - , Arg.Int (fun i -> port := i) - , Printf.sprintf "Port used to bind the server. (default: %d)" !port ) ] - arg usage ; - if !files_path = "" then ( Printf.printf "%s\n" usage ; exit 1 ) else () + [ + ( "--non_blocking_queues", + Arg.Int (fun i -> non_blocking_queues := i), + Printf.sprintf "Number of non-blocking queues. (default: %d)" + !non_blocking_queues ); + ( "--maybe_blocking_queues", + Arg.Int (fun i -> maybe_blocking_queues := i), + Printf.sprintf "Number of maybe-blocking queues. (default: %d)" + !maybe_blocking_queues ); + ( "--port", + Arg.Int (fun i -> port := i), + Printf.sprintf "Port used to bind the server. (default: %d)" !port ); + ] + arg usage; + if !files_path = "" then ( + Printf.printf "%s\n" usage; + exit 1 ) + else () type priority = Maybe_blocking | Non_blocking let scheduler = Duppy.create () type http_method = Post | Get - type http_protocol = Http_11 | Http_10 let string_of_protocol = function @@ -58,26 +58,29 @@ let method_of_string = function type data = None | String of string | File of Unix.file_descr -type request = - { request_protocol: http_protocol - ; request_method: http_method - ; request_uri: string - ; request_headers: (string * string) list - ; request_data: data } - -type reply = - { reply_protocol: http_protocol - ; reply_status: int * string - ; reply_headers: (string * string) list - ; reply_data: data } +type request = { + request_protocol : http_protocol; + request_method : http_method; + request_uri : string; + request_headers : (string * string) list; + request_data : data; +} + +type reply = { + reply_protocol : http_protocol; + reply_status : int * string; + reply_headers : (string * string) list; + reply_data : data; +} exception Assoc of string let assoc_uppercase x y = try List.iter - (fun (l, v) -> if String.uppercase_ascii l = x then raise (Assoc v) else ()) - y ; + (fun (l, v) -> + if String.uppercase_ascii l = x then raise (Assoc v) else ()) + y; raise Not_found with Assoc s -> s @@ -91,36 +94,39 @@ let html_template = %s" let server_error status protocol = - let code, explanation = status in + let _, explanation = status in let data = String (html_template (Printf.sprintf "%s\r\n%s !" explanation explanation)) in - { reply_protocol= protocol - ; reply_status= status - ; reply_headers= - [("Content-Type", "text/html; charset=UTF-8"); ("Server", server)] - ; reply_data= data } + { + reply_protocol = protocol; + reply_status = status; + reply_headers = + [("Content-Type", "text/html; charset=UTF-8"); ("Server", server)]; + reply_data = data; + } let error_404 = server_error (404, "File Not Found") - let error_500 = server_error (500, "Bad Request") Http_10 - let error_403 = server_error (403, "Forbidden") let http_302 protocol uri = - { reply_protocol= protocol - ; reply_status= (302, "Found") - ; reply_headers= [("Location", uri)] - ; reply_data= String "" } + { + reply_protocol = protocol; + reply_status = (302, "Found"); + reply_headers = [("Location", uri)]; + reply_data = String ""; + } type socket_status = Keep | Close let send_reply h reply = let write s = - Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h (Bytes.unsafe_of_string s) + Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h + (Bytes.unsafe_of_string s) in let code, status = reply.reply_status in let http_header = @@ -134,21 +140,25 @@ let send_reply h reply = in Duppy.Monad.bind (write http_header) (fun () -> match reply.reply_data with - | String s -> write s - | File fd -> - let stats = Unix.fstat fd in - let ba = Unix.map_file fd Bigarray.char Bigarray.c_layout false [|stats.Unix.st_size|] in - let ba = Bigarray.array1_of_genarray ba in - let close () = try Unix.close fd with _ -> () in - let on_error e = - close () ; - h.Duppy.Monad.Io.on_error e - in - let h = {h with Duppy.Monad.Io.on_error} in - Duppy.Monad.bind - (Duppy.Monad.Io.write_bigarray ?timeout:None ~priority:Non_blocking - h ba) (fun () -> Duppy.Monad.return (close ()) ) - | None -> Duppy.Monad.return () ) + | String s -> write s + | File fd -> + let stats = Unix.fstat fd in + let ba = + Unix.map_file fd Bigarray.char Bigarray.c_layout false + [| stats.Unix.st_size |] + in + let ba = Bigarray.array1_of_genarray ba in + let close () = try Unix.close fd with _ -> () in + let on_error e = + close (); + h.Duppy.Monad.Io.on_error e + in + let h = { h with Duppy.Monad.Io.on_error } in + Duppy.Monad.bind + (Duppy.Monad.Io.write_bigarray ?timeout:None + ~priority:Non_blocking h ba) (fun () -> + Duppy.Monad.return (close ())) + | None -> Duppy.Monad.return ()) let parse_headers headers = let split_header l h = @@ -172,11 +182,11 @@ let index_uri path index protocol uri = if Sys.is_directory (Printf.sprintf "%s%s" path uri) then if uri.[String.length uri - 1] <> '/' then Duppy.Monad.raise (http_302 protocol (Printf.sprintf "%s/" uri)) - else + else ( let index = Printf.sprintf "%s/%s" uri index in if Sys.file_exists (Printf.sprintf "%s/%s" path index) then Duppy.Monad.return index - else Duppy.Monad.return uri + else Duppy.Monad.return uri ) else Duppy.Monad.return uri with _ -> Duppy.Monad.return uri @@ -189,18 +199,18 @@ let file_request path _ request = ret.(1) with Not_found -> request.request_uri in - let __pa_duppy_0 = - index_uri path "index.html" request.request_protocol uri - in + let __pa_duppy_0 = index_uri path "index.html" request.request_protocol uri in Duppy.Monad.bind __pa_duppy_0 (fun uri -> let fname = Printf.sprintf "%s%s" path uri in - if Sys.file_exists fname then + if Sys.file_exists fname then ( try let fd = Unix.openfile fname [Unix.O_RDONLY] 0o640 in let stats = Unix.fstat fd in let headers = - [ ("Server", server) - ; ("Content-Length", string_of_int stats.Unix.st_size) ] + [ + ("Server", server); + ("Content-Length", string_of_int stats.Unix.st_size); + ] in let headers = if Pcre.pmatch ~rex:(Pcre.regexp "\\.html$") fname then @@ -210,15 +220,16 @@ let file_request path _ request = else headers in Duppy.Monad.raise - { reply_protocol= request.request_protocol - ; reply_status= (200, "OK") - ; reply_headers= headers - ; reply_data= File fd } - with _ -> Duppy.Monad.raise (error_403 request.request_protocol) - else Duppy.Monad.raise (error_404 request.request_protocol) ) + { + reply_protocol = request.request_protocol; + reply_status = (200, "OK"); + reply_headers = headers; + reply_data = File fd; + } + with _ -> Duppy.Monad.raise (error_403 request.request_protocol) ) + else Duppy.Monad.raise (error_404 request.request_protocol)) -let file_handler = - ((fun _ -> Duppy.Monad.return true), file_request !files_path) +let file_handler = ((fun _ -> Duppy.Monad.return true), file_request !files_path) let cgi_handler process path h request = let uri, args, suffix = @@ -263,7 +274,9 @@ let cgi_handler process path h request = Printf.sprintf "%s; export PATH_TRANSLATED=%s; export PATH_INFO=%s" env (Filename.quote tr_suffix) (Filename.quote suffix) in - let sanitize s = Pcre.replace ~pat:"-" ~templ:"_" (String.uppercase_ascii s) in + let sanitize s = + Pcre.replace ~pat:"-" ~templ:"_" (String.uppercase_ascii s) + in let headers = List.map (fun (x, y) -> (sanitize x, y)) request.request_headers in @@ -276,7 +289,7 @@ let cgi_handler process path h request = let env = append env "CONTENT_TYPE" in let env = append env "CONTENT_LENGTH" in let __pa_duppy_0 = - if List.mem_assoc "AUTHORIZATION" headers then + if List.mem_assoc "AUTHORIZATION" headers then ( let ret = Pcre.extract ~rex:(Pcre.regexp "(^[^\\s]*\\s.*)$") @@ -285,7 +298,7 @@ let cgi_handler process path h request = if Array.length ret > 0 then Duppy.Monad.return (Printf.sprintf "%s; extract AUTH_TYPE=%s" env ret.(1)) - else Duppy.Monad.raise error_500 + else Duppy.Monad.raise error_500 ) else Duppy.Monad.return env in Duppy.Monad.bind __pa_duppy_0 (fun env -> @@ -295,21 +308,22 @@ let cgi_handler process path h request = let env = List.fold_left f env headers in let data = match request.request_data with - | None -> "" - | String s -> s - | _ -> assert false + | None -> "" + | String s -> s + | _ -> assert false in (* not implemented *) let process = Printf.sprintf "%s; %s 2>/dev/null" env process in let in_c, out_c = Unix.open_process process in let out_s = Unix.descr_of_out_channel out_c in - let h = {h with Duppy.Monad.Io.socket= out_s; data= ""} in + let h = { h with Duppy.Monad.Io.socket = out_s; data = "" } in let __pa_duppy_0 = - Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h (Bytes.unsafe_of_string data) + Duppy.Monad.Io.write ?timeout:None ~priority:Non_blocking h + (Bytes.unsafe_of_string data) in Duppy.Monad.bind __pa_duppy_0 (fun () -> let in_s = Unix.descr_of_in_channel in_c in - let h = {h with Duppy.Monad.Io.socket= in_s; data= ""} in + let h = { h with Duppy.Monad.Io.socket = in_s; data = "" } in let __pa_duppy_0 = Duppy.Monad.Io.read ?timeout:None ~priority:Non_blocking ~marker:(Duppy.Io.Split "[\r]?\n[\r]?\n") h @@ -319,20 +333,20 @@ let cgi_handler process path h request = Duppy.Monad.catch (Duppy.Monad.Io.read_all ?timeout:None ~priority:Non_blocking h.Duppy.Monad.Io.scheduler in_s) - (fun (s, _) -> Duppy.Monad.return s ) + (fun (s, _) -> Duppy.Monad.return s) in Duppy.Monad.bind __pa_duppy_0 (fun data -> let data = Printf.sprintf "%s%s" h.Duppy.Monad.Io.data data in - ignore (Unix.close_process (in_c, out_c)) ; + ignore (Unix.close_process (in_c, out_c)); let __pa_duppy_0 = let headers = Pcre.split ~pat:"\r\n" headers in parse_headers headers in Duppy.Monad.bind __pa_duppy_0 (fun headers -> let __pa_duppy_0 = - if List.mem_assoc "Status" headers then + if List.mem_assoc "Status" headers then ( try let ans = Pcre.extract @@ -340,25 +354,27 @@ let cgi_handler process path h request = (List.assoc "Status" headers) in Duppy.Monad.return - ( (int_of_string ans.(1), ans.(2)) - , List.filter - (fun (x, y) -> x <> "Status") + ( (int_of_string ans.(1), ans.(2)), + List.filter + (fun (x, _) -> x <> "Status") headers ) - with _ -> Duppy.Monad.raise error_500 + with _ -> Duppy.Monad.raise error_500 ) else Duppy.Monad.return ((200, "OK"), headers) in Duppy.Monad.bind __pa_duppy_0 (fun (status, headers) -> let headers = - ( "Content-length" - , string_of_int (String.length data) ) + ( "Content-length", + string_of_int (String.length data) ) :: headers in Duppy.Monad.raise - { reply_protocol= request.request_protocol - ; reply_status= status - ; reply_headers= headers - ; reply_data= String data } ) ) ) ) ) ) ) + { + reply_protocol = request.request_protocol; + reply_status = status; + reply_headers = headers; + reply_data = String data; + }))))))) let php_handler = ( (fun request -> @@ -367,9 +383,8 @@ let php_handler = request.request_uri in Duppy.Monad.bind __pa_duppy_0 (fun uri -> - Duppy.Monad.return (Pcre.pmatch ~rex:(Pcre.regexp "\\.php$") uri) ) - ) - , cgi_handler "php-cgi" !files_path ) + Duppy.Monad.return (Pcre.pmatch ~rex:(Pcre.regexp "\\.php$") uri))), + cgi_handler "php-cgi" !files_path ) let handlers = [php_handler; file_handler] @@ -377,11 +392,11 @@ let handle_request h request = let f (check, handler) = let __pa_duppy_0 = check request in Duppy.Monad.bind __pa_duppy_0 (fun check -> - if check then handler h request else Duppy.Monad.return () ) + if check then handler h request else Duppy.Monad.return ()) in Duppy.Monad.catch (Duppy.Monad.bind (Duppy.Monad.iter f handlers) (fun () -> - Duppy.Monad.return (error_404 request.request_protocol) )) + Duppy.Monad.return (error_404 request.request_protocol))) (fun reply -> Duppy.Monad.return reply) let parse_request h r = @@ -389,11 +404,11 @@ let parse_request h r = let headers = Pcre.split ~pat:"\r\n" r in let __pa_duppy_0 = match headers with - | e :: l -> - let __pa_duppy_0 = parse_headers l in - Duppy.Monad.bind __pa_duppy_0 (fun headers -> - Duppy.Monad.return (e, headers) ) - | _ -> Duppy.Monad.raise error_500 + | e :: l -> + let __pa_duppy_0 = parse_headers l in + Duppy.Monad.bind __pa_duppy_0 (fun headers -> + Duppy.Monad.return (e, headers)) + | _ -> Duppy.Monad.raise error_500 in Duppy.Monad.bind __pa_duppy_0 (fun (request, headers) -> let rex = Pcre.regexp "([\\w]+)\\s([^\\s]+)\\s(HTTP/1.[01])" in @@ -401,9 +416,9 @@ let parse_request h r = try let sub = Pcre.exec ~rex request in let http_method, uri, protocol = - ( Pcre.get_substring sub 1 - , Pcre.get_substring sub 2 - , Pcre.get_substring sub 3 ) + ( Pcre.get_substring sub 1, + Pcre.get_substring sub 2, + Pcre.get_substring sub 3 ) in Duppy.Monad.return (method_of_string http_method, uri, protocol_of_string protocol) @@ -412,41 +427,43 @@ let parse_request h r = Duppy.Monad.bind __pa_duppy_0 (fun (http_method, uri, protocol) -> let __pa_duppy_0 = match http_method with - | Get -> Duppy.Monad.return None - | Post -> - let __pa_duppy_0 = - try - let length = assoc_uppercase "CONTENT-LENGTH" headers in - Duppy.Monad.return (int_of_string length) - with - | Not_found -> Duppy.Monad.return 0 - | _ -> Duppy.Monad.raise error_500 - in - Duppy.Monad.bind __pa_duppy_0 (fun len -> - match len with - | 0 -> Duppy.Monad.return None - | d -> - let __pa_duppy_0 = - Duppy.Monad.Io.read ?timeout:None - ~priority:Non_blocking - ~marker:(Duppy.Io.Length d) h - in - Duppy.Monad.bind __pa_duppy_0 (fun data -> - Duppy.Monad.return (String data) ) ) + | Get -> Duppy.Monad.return None + | Post -> + let __pa_duppy_0 = + try + let length = assoc_uppercase "CONTENT-LENGTH" headers in + Duppy.Monad.return (int_of_string length) + with + | Not_found -> Duppy.Monad.return 0 + | _ -> Duppy.Monad.raise error_500 + in + Duppy.Monad.bind __pa_duppy_0 (fun len -> + match len with + | 0 -> Duppy.Monad.return None + | d -> + let __pa_duppy_0 = + Duppy.Monad.Io.read ?timeout:None + ~priority:Non_blocking + ~marker:(Duppy.Io.Length d) h + in + Duppy.Monad.bind __pa_duppy_0 (fun data -> + Duppy.Monad.return (String data))) in Duppy.Monad.bind __pa_duppy_0 (fun data -> Duppy.Monad.return - { request_method= http_method - ; request_protocol= protocol - ; request_uri= uri - ; request_headers= headers - ; request_data= data } ) ) ) + { + request_method = http_method; + request_protocol = protocol; + request_uri = uri; + request_headers = headers; + request_data = data; + }))) with _ -> Duppy.Monad.raise error_500 let handle_client socket = (* Read and process lines *) - let on_error e = error_500 in - let h = {Duppy.Monad.Io.scheduler; socket; data= ""; on_error} in + let on_error _ = error_500 in + let h = { Duppy.Monad.Io.scheduler; socket; data = ""; on_error } in let rec exec () = let __pa_duppy_0 = Duppy.Monad.catch @@ -471,12 +488,12 @@ let handle_client socket = then Close else Keep in - Duppy.Monad.return (keep, reply) ) ) )) + Duppy.Monad.return (keep, reply))))) (fun reply -> Duppy.Monad.return (Close, reply)) in Duppy.Monad.bind __pa_duppy_0 (fun (keep, reply) -> Duppy.Monad.bind (send_reply h reply) (fun () -> - if keep = Keep then exec () else Duppy.Monad.return () ) ) + if keep = Keep then exec () else Duppy.Monad.return ())) in let finish _ = try Unix.close socket with _ -> () in Duppy.Monad.run ~return:finish ~raise:finish (exec ()) @@ -487,47 +504,52 @@ let new_queue ~priority ~name () = Thread.create queue () let bind_addr_inet = Unix.inet_addr_of_string "0.0.0.0" - let bind_addr = Unix.ADDR_INET (bind_addr_inet, !port) - let max_conn = 100 - let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 let () = (* See http://caml.inria.fr/mantis/print_bug_page.php?bug_id=4640 * for this: we want Unix EPIPE error and not SIGPIPE, which * crashes the program.. *) - Sys.set_signal Sys.sigpipe Sys.Signal_ignore ; - ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe]) ; - Unix.setsockopt sock Unix.SO_REUSEADDR true ; + Sys.set_signal Sys.sigpipe Sys.Signal_ignore; + ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe]); + Unix.setsockopt sock Unix.SO_REUSEADDR true; let rec incoming _ = ( try - let s, caller = Unix.accept sock in + let s, _ = Unix.accept sock in handle_client s with e -> - Printf.printf "Failed to accept new client: %S\n" - (Printexc.to_string e) ) ; - [ { Duppy.Task.priority= Non_blocking - ; events= [`Read sock] - ; handler= incoming } ] + Printf.printf "Failed to accept new client: %S\n" (Printexc.to_string e) + ); + [ + { + Duppy.Task.priority = Non_blocking; + events = [`Read sock]; + handler = incoming; + }; + ] in ( try Unix.bind sock bind_addr with Unix.Unix_error (Unix.EADDRINUSE, "bind", "") -> - failwith (Printf.sprintf "port %d already taken" !port) ) ; - Unix.listen sock max_conn ; + failwith (Printf.sprintf "port %d already taken" !port) ); + Unix.listen sock max_conn; Duppy.Task.add scheduler - {Duppy.Task.priority= Non_blocking; events= [`Read sock]; handler= incoming} ; + { + Duppy.Task.priority = Non_blocking; + events = [`Read sock]; + handler = incoming; + }; for i = 1 to !non_blocking_queues do ignore (new_queue ~priority:Non_blocking ~name:(Printf.sprintf "Non blocking queue #%d" i) ()) - done ; + done; for i = 1 to !maybe_blocking_queues do ignore (new_queue ~priority:Maybe_blocking ~name:(Printf.sprintf "Maybe blocking queue #%d" i) ()) - done ; + done; Duppy.queue scheduler ~log:(fun _ -> ()) "root" diff --git a/examples/telnet.ml b/examples/telnet.ml index f3c00e9..1511e33 100644 --- a/examples/telnet.ml +++ b/examples/telnet.ml @@ -16,53 +16,53 @@ let new_queue ~priority ~name () = Thread.create queue () let th = - ignore (new_queue ~priority:Non_blocking ~name:"Non blocking queue" ()) ; - ignore - (new_queue ~priority:Maybe_blocking ~name:"Maybe blocking queue #1" ()) ; + ignore (new_queue ~priority:Non_blocking ~name:"Non blocking queue" ()); + ignore (new_queue ~priority:Maybe_blocking ~name:"Maybe blocking queue #1" ()); new_queue ~priority:Maybe_blocking ~name:"Maybe blocking queue #2" () let exec_command s () = let chan = Unix.open_process_in s in let rec aux () = match try Some (input_line chan) with End_of_file -> None with - | None -> [] - | Some s -> s :: aux () + | None -> [] + | Some s -> s :: aux () in let l = aux () in - ignore (Unix.close_process_in chan) ; + ignore (Unix.close_process_in chan); Duppy.Monad.return (String.concat "\r\n" l) let commands = Hashtbl.create 10 let () = - Hashtbl.add commands "hello" (false, fun () -> Duppy.Monad.return "world") ; - Hashtbl.add commands "foo" (false, fun () -> Duppy.Monad.return "bar") ; - Hashtbl.add commands "uptime" (true, exec_command "uptime") ; - Hashtbl.add commands "date" (true, exec_command "date") ; - Hashtbl.add commands "whoami" (true, exec_command "whoami") ; - Hashtbl.add commands "sleep" (true, exec_command "sleep 15") ; + Hashtbl.add commands "hello" (false, fun () -> Duppy.Monad.return "world"); + Hashtbl.add commands "foo" (false, fun () -> Duppy.Monad.return "bar"); + Hashtbl.add commands "uptime" (true, exec_command "uptime"); + Hashtbl.add commands "date" (true, exec_command "date"); + Hashtbl.add commands "whoami" (true, exec_command "whoami"); + Hashtbl.add commands "sleep" (true, exec_command "sleep 15"); Hashtbl.add commands "exit" (true, fun () -> Duppy.Monad.raise ()) (* Add commands here *) let help = Buffer.create 10 let () = - Buffer.add_string help "List of commands:" ; + Buffer.add_string help "List of commands:"; Hashtbl.iter (fun x _ -> Buffer.add_string help (Printf.sprintf "\r\n%s" x)) - commands ; + commands; Hashtbl.add commands "help" (false, fun () -> Duppy.Monad.return (Buffer.contents help)) let handle_client socket = let on_error e = match e with - | Duppy.Io.Io_error -> Printf.printf "Client disconnected" - | Duppy.Io.Unix (c, p, m) -> Printf.printf "%s" (Printexc.to_string (Unix.Unix_error (c, p, m))) - | Duppy.Io.Unknown e -> Printf.printf "%s" (Printexc.to_string e) - | Duppy.Io.Timeout -> Printf.printf "Timeout" + | Duppy.Io.Io_error -> Printf.printf "Client disconnected" + | Duppy.Io.Unix (c, p, m) -> + Printf.printf "%s" (Printexc.to_string (Unix.Unix_error (c, p, m))) + | Duppy.Io.Unknown e -> Printf.printf "%s" (Printexc.to_string e) + | Duppy.Io.Timeout -> Printf.printf "Timeout" in - let h = {Duppy.Monad.Io.scheduler; socket; data= ""; on_error} in + let h = { Duppy.Monad.Io.scheduler; socket; data = ""; on_error } in (* Read and process lines *) let rec exec () = let __pa_duppy_0 = @@ -83,36 +83,39 @@ let handle_client socket = Duppy.Monad.bind (Duppy.Monad.bind (Duppy.Monad.Io.write ?timeout:None ~priority:io_priority h - (Bytes.unsafe_of_string "BEGIN\r\n")) (fun () -> + (Bytes.unsafe_of_string "BEGIN\r\n")) + (fun () -> Duppy.Monad.bind - (Duppy.Monad.Io.write ?timeout:None ~priority:io_priority - h (Bytes.unsafe_of_string ans)) (fun () -> + (Duppy.Monad.Io.write ?timeout:None ~priority:io_priority h + (Bytes.unsafe_of_string ans)) + (fun () -> Duppy.Monad.Io.write ?timeout:None ~priority:io_priority - h (Bytes.unsafe_of_string "\r\nEND\r\n")) )) - (fun () -> exec ()) ) ) + h + (Bytes.unsafe_of_string "\r\nEND\r\n")))) + (fun () -> exec ()))) in let close () = try Unix.close socket with _ -> () in let return () = - let on_error e = on_error e ; close () in + let on_error e = + on_error e; + close () + in Duppy.Io.write ~priority:io_priority ~on_error ~exec:close scheduler - ~string:(Bytes.unsafe_of_string "Bye!\r\n") socket + ~string:(Bytes.unsafe_of_string "Bye!\r\n") + socket in Duppy.Monad.run ~return ~raise:close (exec ()) open Unix let port = 4123 - let bind_addr_inet = inet_addr_of_string "0.0.0.0" - let bind_addr = ADDR_INET (bind_addr_inet, port) - let max_conn = 10 - let sock = socket PF_INET SOCK_STREAM 0 let () = - setsockopt sock SO_REUSEADDR true ; + setsockopt sock SO_REUSEADDR true; let rec incoming _ = ( try let s, caller = accept sock in @@ -122,21 +125,27 @@ let () = in try (gethostbyaddr a).h_name with Not_found -> string_of_inet_addr a in - Printf.printf "New client: %s\n" ip ; + Printf.printf "New client: %s\n" ip; handle_client s with e -> - Printf.printf "Failed to accept new client: %S\n" - (Printexc.to_string e) ) ; - [ { Duppy.Task.priority= io_priority - ; Duppy.Task.events= [`Read sock] - ; Duppy.Task.handler= incoming } ] + Printf.printf "Failed to accept new client: %S\n" (Printexc.to_string e) + ); + [ + { + Duppy.Task.priority = io_priority; + Duppy.Task.events = [`Read sock]; + Duppy.Task.handler = incoming; + }; + ] in ( try bind sock bind_addr with Unix.Unix_error (Unix.EADDRINUSE, "bind", "") -> - failwith (Printf.sprintf "port %d already taken" port) ) ; - listen sock max_conn ; + failwith (Printf.sprintf "port %d already taken" port) ); + listen sock max_conn; Duppy.Task.add scheduler - { Duppy.Task.priority= io_priority - ; Duppy.Task.events= [`Read sock] - ; Duppy.Task.handler= incoming } ; + { + Duppy.Task.priority = io_priority; + Duppy.Task.events = [`Read sock]; + Duppy.Task.handler = incoming; + }; Thread.join th diff --git a/m4/base_checks.m4 b/m4/base_checks.m4 deleted file mode 100644 index bfd98a2..0000000 --- a/m4/base_checks.m4 +++ /dev/null @@ -1,175 +0,0 @@ -AC_DEFUN([AC_BASE_CHECKS], -[AC_REQUIRE([AC_PROG_CC]) - -dnl check for base compilers -AC_CANONICAL_HOST() - -dnl Detect the target toolchain -AC_MSG_CHECKING([target toolchain]) -case "${host_os}" in - linux*) - TARGET_TOOLCHAIN="linux" - ;; - mingw*) - TARGET_TOOLCHAIN="mingw" - ;; - cygwin*) - TARGET_TOOLCHAIN="cygwin" - ;; - darwin*) - TARGET_TOOLCHAIN="darwin" - ;; - *) - TARGET_TOOLCHAIN="other" - ;; -esac -AC_MSG_RESULT([$TARGET_TOOLCHAIN]) -AC_SUBST(TARGET_TOOLCHAIN) - -# AC_CANONICAL_HOST needs those files -AUTOCONF_INSTALL_FILES="config.guess config.sub install-sh m4/*.m4" -AC_SUBST(AUTOCONF_INSTALL_FILES) - -AC_PROG_CC() -AC_PROG_INSTALL() -AC_CHECK_TOOL([AR],[ar],no) -AC_SUBST(AR) -AC_CHECK_OCAML_COMPILERS() - -dnl add some flags -AC_DETECT_PIC_FLAGS() - -CXXFLAGS="$CXXFLAGS $PIC_FLAGS" -CPPFLAGS="$CPPFLAGS $PIC_FLAGS" - -# Add prefix to compilation variables -# if passed -if test "x$prefix" != "xNONE"; then - CFLAGS="$CFLAGS -I$prefix/include" - LDFLAGS="$LDFLAGS -L$prefix/lib" - CPPFLAGS="$CPPFLAGS -I$prefix/include" - CXXFLAGS="$CXXFLAGS -I$prefix/include" -fi -]) - -dnl Check for basic stuff -dnl The following was stolen from mesa.. -dnl A few convenience macros for Mesa, mostly to keep all the platform -dnl specifics out of configure.ac. - -dnl AC_DETECT_PIC_FLAGS() -dnl -dnl Find out whether to build PIC code using the option --enable-pic and -dnl the configure enable_static/enable_shared settings. If PIC is needed, -dnl figure out the necessary flags for the platform and compiler. -dnl -dnl The platform checks have been shamelessly taken from libtool and -dnl stripped down to just what's needed for Mesa. See _LT_COMPILER_PIC in -dnl /usr/share/aclocal/libtool.m4 or -dnl http://git.savannah.gnu.org/gitweb/?p=libtool.git;a=blob;f=libltdl/m4/libtool.m4;hb=HEAD -dnl -AC_DEFUN([AC_DETECT_PIC_FLAGS], -[AC_ARG_VAR([PIC_FLAGS], [compiler flags for PIC code]) -AC_ARG_ENABLE([pic], - [AS_HELP_STRING([--disable-pic], - [compile PIC objects @<:@default=enabled for shared builds - on supported platforms@:>@])], - [enable_pic="$enableval" - test "x$enable_pic" = x && enable_pic=auto], - [enable_pic=auto]) -dnl disable PIC by default for static builds -if test "$enable_pic" = auto && test "$enable_static" = yes; then - enable_pic=no -fi -dnl if PIC hasn't been explicitly disabled, try to figure out the flags -if test "$enable_pic" != no; then - AC_MSG_CHECKING([for $CC option to produce PIC]) - dnl allow the user's flags to override - if test "x$PIC_FLAGS" = "x"; then - dnl see if we're using GCC - if test "x$GCC" = "xyes"; then - case "$host_os" in - aix*|beos*|cygwin*|irix5*|irix6*|osf3*|osf4*|osf5*) - dnl PIC is the default for these OSes. - ;; - mingw*|os2*|pw32*) - dnl This hack is so that the source file can tell whether - dnl it is being built for inclusion in a dll (and should - dnl export symbols for example). - PIC_FLAGS="-DDLL_EXPORT" - ;; - darwin*|rhapsody*) - dnl PIC is the default on this platform - dnl Common symbols not allowed in MH_DYLIB files - PIC_FLAGS="-fno-common" - ;; - hpux*) - dnl PIC is the default for IA64 HP-UX and 64-bit HP-UX, - dnl but not for PA HP-UX. - case $host_cpu in - hppa*64*|ia64*) - ;; - *) - PIC_FLAGS="-fPIC" - ;; - esac - ;; - *) - dnl Everyone else on GCC uses -fPIC - PIC_FLAGS="-fPIC" - ;; - esac - else dnl !GCC - case "$host_os" in - hpux9*|hpux10*|hpux11*) - dnl PIC is the default for IA64 HP-UX and 64-bit HP-UX, - dnl but not for PA HP-UX. - case "$host_cpu" in - hppa*64*|ia64*) - dnl +Z the default - ;; - *) - PIC_FLAGS="+Z" - ;; - esac - ;; - linux*|k*bsd*-gnu) - case `basename "$CC"` in - icc*|ecc*|ifort*) - PIC_FLAGS="-KPIC" - ;; - pgcc*|pgf77*|pgf90*|pgf95*) - dnl Portland Group compilers (*not* the Pentium gcc - dnl compiler, which looks to be a dead project) - PIC_FLAGS="-fpic" - ;; - ccc*) - dnl All Alpha code is PIC. - ;; - xl*) - dnl IBM XL C 8.0/Fortran 10.1 on PPC - PIC_FLAGS="-qpic" - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*|*Sun\ F*) - dnl Sun C 5.9 or Sun Fortran - PIC_FLAGS="-KPIC" - ;; - esac - esac - ;; - solaris*) - PIC_FLAGS="-KPIC" - ;; - sunos4*) - PIC_FLAGS="-PIC" - ;; - esac - fi - fi - AC_MSG_RESULT([$PIC_FLAGS]) -fi -AC_SUBST([PIC_FLAGS]) -])dnl PIC_FLAGS - diff --git a/m4/bootstrap b/m4/bootstrap deleted file mode 100755 index 151564b..0000000 --- a/m4/bootstrap +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh -e - -if [ -d m4 ]; then - OPTIONS="-I m4" - aclocal -I m4 -fi -autoreconf -f -i $OPTIONS $1 -# autoconf maintainers have not yet implemented -# a function to install missing files from autoconf -# itself, so we need to fake a call to automake here.. -automake -a -c -f 2>/dev/null || true -if [ -d examples ]; then - if [ -f examples/configure.ac ]; then - cd examples - autoreconf -f -i - fi -fi diff --git a/m4/cpp_check_class.m4 b/m4/cpp_check_class.m4 deleted file mode 100644 index fb3d299..0000000 --- a/m4/cpp_check_class.m4 +++ /dev/null @@ -1,24 +0,0 @@ -dnl $1: linker lib name -dnl $2: included file -dnl $3: tested class -dnl $4: emitted variable -AC_DEFUN([AC_CPP_CHECK_CLASS], -[AC_LANG_PUSH([C++]) - SAVED_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS -l$1" - AC_MSG_CHECKING([for class $3 in $1 library]) - AC_LINK_IFELSE( - [AC_LANG_PROGRAM([#include <$2>], - [$3 *x = NULL])], - [TEST_LIBS="$TEST_LIBS -l$1"] [RESULT=1], - [RESULT=]) - if test -z $RESULT; then - AC_MSG_RESULT([not found]) - else - AC_DEFINE([$4], [1], [Defined if class $3 has been found in $1 library]) - AC_MSG_RESULT([ok]) - fi - $4=$RESULT - AC_SUBST([$4]) - LDFLAGS=$SAVED_LDFLAGS - AC_LANG_POP([C++])]) diff --git a/m4/detect_binding.m4 b/m4/detect_binding.m4 deleted file mode 100644 index 1c1204b..0000000 --- a/m4/detect_binding.m4 +++ /dev/null @@ -1,139 +0,0 @@ -dnl =========================================================================== -dnl Helper macro to detect an optional binding - -m4_defun([AC_OCAML_COMPARE_VERSION], - [if test -z "$2" ; then - VERSION_OK=yes - else - AS_VERSION_COMPARE([$1],[$2], - [VERSION_OK=], - [VERSION_OK=yes], - [VERSION_OK=yes]) -fi]) - -m4_defun([AC_OCAML_CHECK_DEPS], - [dnl -m4_define([deps],[m4_translit([$1],['a-z'],['A-Z'])]) -DEPS_CHECK=yes -for i in deps(); do - eval "dep_check=\$W_$i" - if test -z "${dep_check}"; then - DEPS_CHECK= - break - fi -done]) - -m4_defun([AC_MSG_RESULT_NOT], - [ifelse([$1],[],[AC_MSG_RESULT($2)],[AC_MSG_ERROR($2)])]) - -AC_DEFUN([AC_CHECK_OCAML_BINDING],[dnl - -m4_define([BINDING],[m4_translit([$1],['a-z.-'],['A-Z__'])]) -m4_define([binding],[m4_translit([$1],['A-Z.-'],['a-z__'])]) - -dnl $1 = PKG_NAME -dnl $2 = PKG_VERSION -dnl $3 = PKG_DEPS -dnl $4 = PKG_MANDATORY -dnl $5 = PKG_USED (for instance sdl.mixer au lieu of sdl. Should only be used for bindings not provided by us..) -dnl $6 = PKG_CMA (used for duppy.syntax and flac.ogg when locally compiled..) - -if test -n "$5"; then - BINDING_PKGS="$5" -else - BINDING_PKGS="$1" -fi - -AC_ARG_WITH([binding()-dir], - AC_HELP_STRING( - [--with-binding()-dir=path], - [look for ocaml-binding() library in "path" (autodetected by default)])) - -dnl Version stuff -m4_define([VERSION_CHECK],[ifelse([$2],[],[],[ >= $2])]) - -AC_MSG_CHECKING([for ocaml $1 module[]VERSION_CHECK()]) - -OCAML_CHECK="${OCAMLFIND} query $1" - -dnl This (horrible) macro does the following: -dnl Detect optional binding -dnl If provided by ocamlfind, -dnl fills liquidsoap_ocamlcflags with "-package deps" for -dnl each dependency -dnl If provided by us, fills -dnl liquidsoap_ocamlcflags with "-I /path/to/ocaml-foo/src" -dnl and liquidsoap_ocamllfflags with "foo.cmxa" - -AC_OCAML_CHECK_DEPS([$3]) -if test -z $DEPS_CHECK; then - AC_MSG_RESULT([[]binding() needs $3]) -else - if test -z "${with_[]binding()_dir}" ; then - if ! ${OCAML_CHECK} > /dev/null 2>&1 ; then - AC_MSG_RESULT_NOT([$4],[Not found.]) - else - BINDING()_version="`${OCAMLFIND} query -format "%v" $1 2>/dev/null`" - AC_OCAML_COMPARE_VERSION([${[]BINDING()_version}],[$2]) - if test -z "${VERSION_OK}"; then - AC_MSG_RESULT_NOT([$4],[requires version >= $2 found ${[]BINDING()_version}.]) - else - BINDING()_PACKAGES="`${OCAMLFIND} query -separator " " -format "-package %p" $BINDING_PKGS 2>/dev/null`" - liquidsoap_ocamlcflags="${liquidsoap_ocamlcflags} ${[]BINDING()_PACKAGES}" - W_[]BINDING()=yes - LIBS_VERSIONS="${LIBS_VERSIONS} $1=$[]BINDING()_version" - AC_MSG_RESULT(ok) - fi - fi - else - BINDING()_STOP_CHECK= - BINDING()_version=changequote({,})"[unknown version]"changequote([,]) - BINDING()_requires= - if test -r ${with_[]binding()_dir}/META >/dev/null 2>&1; then - # Grab version - BINDING()_version=`cat "${with_[]binding()_dir}/META" | grep version | cut -d'=' -f 2 | tr -d ' ' | tr -d '"' | head -n 1` - AC_OCAML_COMPARE_VERSION([${[]BINDING()_version}],[$2]) - if test -z "${VERSION_OK}"; then - AC_MSG_RESULT_NOT([$4],[requires version >= $2 found ${[]BINDING()_version}.]) - BINDING()_STOP_CHECK=yes - fi - BINDING()_requires=`cat "${with_[]binding()_dir}/META" | grep 'requires' | cut -d '=' -f 2 | tr -d '"'` - BINDING()_path="${with_[]binding()_dir}" - else - BINDING()_path=`${OCAMLFIND} -query $1 2>/dev/null` - if ! test -z "$2"; then - AC_MSG_RESULT_NOT([$4],[cannot find version from META file.]) - BINDING()_STOP_CHECK=yes - fi - fi - if test -z "${BINDING()_STOP_CHECK}"; then - BINDING()_PACKAGES="`${OCAMLFIND} query -separator " " -format "-package %p" $BINGING_PKGS 2>/dev/null`" - echo ${with_[]binding()_dir} | grep ^/ > /dev/null 2>&1 \ - || with_[]binding()_dir=${PWD}/${with_[]binding()_dir} - liquidsoap_ocamlcflags="${liquidsoap_ocamlcflags} -I ${with_[]binding()_dir} ${[]BINDING()_PACKAGES}" - # We need to recurse here because - # some package may not be registered using ocamlfind - if test -n "$6"; then - BINDING()_CMA=$6.${cma} - else - BINDING()_CMA=$1.${cma} - fi - for i in ${[]BINDING()_requires}; do - BINDING()_PACKAGES="${[]BINDING()_PACKAGES} `${OCAMLFIND} query -separator " " -format "-package %p" $i 2>/dev/null`" - done - liquidsoap_ocamllflags="${liquidsoap_ocamllflags} ${[]BINDING()_PACKAGES} ${[]BINDING()_CMA}" - W_[]BINDING()=yes - LIBS_VERSIONS="${LIBS_VERSIONS} $1=$[]BINDING()_version" - AC_MSG_RESULT(ok) - fi - fi -fi - -AC_SUBST(W_[]BINDING()) -if test -z "${W_[]BINDING()}" ; then - w_[]BINDING()="no (requires $1)" -else - w_[]BINDING()=yes -fi]) - - diff --git a/m4/ocaml.m4 b/m4/ocaml.m4 deleted file mode 100644 index 28d1350..0000000 --- a/m4/ocaml.m4 +++ /dev/null @@ -1,329 +0,0 @@ -dnl autoconf macros for OCaml -dnl -dnl Copyright © 2009 Richard W.M. Jones -dnl Copyright © 2009 Stefano Zacchiroli -dnl Copyright © 2000-2005 Olivier Andrieu -dnl Copyright © 2000-2005 Jean-Christophe Filliâtre -dnl Copyright © 2000-2005 Georges Mariano -dnl -dnl For documentation, please read the ocaml.m4 man page. - -AC_DEFUN([AC_PROG_OCAML], -[dnl - # checking for ocamlc - AC_CHECK_TOOL([OCAMLC],[ocamlc],[no]) - - if test "$OCAMLC" = "no"; then - AC_MSG_ERROR(Cannot find ocamlc.) - fi - - AC_SUBST([OCAMLC]) - - OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` - AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) - # Check if version is >= 3.12.0 - AC_MSG_CHECKING([if ocaml compiler supports first-class modules]) - AS_VERSION_COMPARE([$OCAMLVERSION],[3.12.0],[],[OCAML_HAS_FIRST_CLASS_MODULES="yes"],[OCAML_HAS_FIRST_CLASS_MODULES="yes"]) - if test -n "${OCAML_HAS_FIRST_CLASS_MODULES}"; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - fi - AC_SUBST(OCAML_HAS_FIRST_CLASS_MODULES) - - # If OCAMLLIB is set, use it - if test "$OCAMLLIB" = ""; then - OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` - else - AC_MSG_RESULT([OCAMLLIB previously set; preserving it.]) - fi - AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) - - AC_SUBST([OCAMLVERSION]) - AC_SUBST([OCAMLLIB]) - - # checking for ocamlopt - AC_CHECK_TOOL_STRICT([OCAMLOPT],[ocamlopt],[no]) - OCAMLBEST=byte - OCAML_DYNLINK=byte-dyn - if test "$OCAMLOPT" = "no"; then - AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) - else - TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` - if test "$TMPVERSION" != "$OCAMLVERSION" ; then - AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) - OCAMLOPT=no - else - OCAMLBEST="byte opt" - OCAML_DYNLINK="byte-dyn opt-dyn" - fi - fi - - AC_SUBST([OCAMLBEST]) - AC_SUBST([OCAML_DYNLINK]) - - # checking for ocamlc.opt - AC_CHECK_TOOL_STRICT([OCAMLCDOTOPT],[ocamlc.opt],[no]) - if test "$OCAMLCDOTOPT" != "no"; then - TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` - if test "$TMPVERSION" != "$OCAMLVERSION" ; then - AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) - else - OCAMLC=$OCAMLCDOTOPT - fi - fi - - # checking for ocamlopt.opt - if test "$OCAMLOPT" != "no" ; then - AC_CHECK_TOOL_STRICT([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) - if test "$OCAMLOPTDOTOPT" != "no"; then - TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` - if test "$TMPVERSION" != "$OCAMLVERSION" ; then - AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) - else - OCAMLOPT=$OCAMLOPTDOTOPT - fi - fi - fi - - AC_SUBST([OCAMLOPT]) - - # checking for ocaml toplevel - AC_CHECK_TOOL_STRICT([OCAML],[ocaml],[no]) - - AC_SUBST([OCAML]) - - # checking for ocamldep - AC_CHECK_TOOL_STRICT([OCAMLDEP],[ocamldep],[no]) - if test "$OCAMLDEP" = "no"; then - AC_MSG_ERROR(Cannot find ocamlmklib.) - else - AC_CHECK_TOOL_STRICT([OCAMLDEPOPT],[ocamldep.opt],[no]) - if test "$OCAMLDEPOPT" != "no"; then - OCAMLDEP=$OCAMLDEPOPT - fi - fi - - AC_SUBST([OCAMLDEP]) - - # checking for ocamlmktop - AC_CHECK_TOOL_STRICT([OCAMLMKTOP],[ocamlmktop],[no]) - - AC_SUBST([OCAMLMKTOP]) - - # checking for ocamlmklib - AC_CHECK_TOOL_STRICT([OCAMLMKLIB],[ocamlmklib],[no]) - if test "$OCAMLMKLIB" = "no"; then - AC_MSG_ERROR(Cannot find ocamlmklib.) - fi - - AC_SUBST([OCAMLMKLIB]) - - # checking for ocamldoc - AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no]) - if test "$OCAMLDOC" != "no"; then - AC_CHECK_TOOL([OCAMLDOCOPT],[ocamldoc.opt],[no]) - if test "$OCAMLDOCOPT" != "no"; then - OCAMLDOC=$OCAMLDOCOPT - fi - fi - - AC_SUBST([OCAMLDOC]) - - # checking for ocamlbuild - AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no]) - - AC_SUBST([OCAMLBUILD]) -]) - - -AC_DEFUN([AC_PROG_OCAMLLEX], -[dnl - # checking for ocamllex - AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no]) - if test "$OCAMLLEX" != "no"; then - AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) - if test "$OCAMLLEXDOTOPT" != "no"; then - OCAMLLEX=$OCAMLLEXDOTOPT - fi - fi - AC_SUBST([OCAMLLEX]) -]) - -AC_DEFUN([AC_PROG_OCAMLYACC], -[dnl - AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no]) - AC_SUBST([OCAMLYACC]) -]) - - -AC_DEFUN([AC_PROG_CAMLP4], -[dnl - AC_REQUIRE([AC_PROG_OCAML])dnl - - - AC_ARG_ENABLE([camlp4], - AC_HELP_STRING([--disable-camlp4], - [disable camlp4 auto-detection.])) - - # checking for camlp4 - if test "x$enable_camlp4" != "xno"; then - AC_CHECK_TOOL_STRICT([CAMLP4],[camlp4],[no]) - if test "$CAMLP4" != "no"; then - TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p' | tr -d '\r'` - if test "$TMPVERSION" != "$OCAMLVERSION" ; then - AC_MSG_RESULT([versions differs from ocamlc]) - CAMLP4=no - fi - fi - AC_SUBST([CAMLP4]) - - # checking for companion tools - AC_CHECK_TOOL_STRICT([CAMLP4BOOT],[camlp4boot],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4O],[camlp4o],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4OF],[camlp4of],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4OOF],[camlp4oof],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4ORF],[camlp4orf],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4PROF],[camlp4prof],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4R],[camlp4r],[no]) - AC_CHECK_TOOL_STRICT([CAMLP4RF],[camlp4rf],[no]) - else - CAMLP4=no - CAMLP4BOOT=no - CAMLP4O=no - CAMLP4OF=no - CAMLP4OOF=no - CAMLP4ORF=no - CAMLP4PROF=no - CAMLP4R=no - CAMLP4RF=no - fi - - AC_SUBST([CAMLP4BOOT]) - AC_SUBST([CAMLP4O]) - AC_SUBST([CAMLP4OF]) - AC_SUBST([CAMLP4OOF]) - AC_SUBST([CAMLP4ORF]) - AC_SUBST([CAMLP4PROF]) - AC_SUBST([CAMLP4R]) - AC_SUBST([CAMLP4RF]) -]) - -AC_DEFUN([AC_PROG_CAMLIDL], -[dnl - AC_CHECK_TOOL(CAMLIDL,camlidl,no) - AC_SUBST(CAMLIDL) -]) - -AC_DEFUN([AC_PROG_FINDLIB], -[dnl - AC_REQUIRE([AC_PROG_OCAML])dnl - - # checking for ocamlfind - AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no]) - AC_SUBST([OCAMLFIND]) -]) - -AC_DEFUN([AC_CHECK_OCAML_STDLIB], -[dnl - AC_REQUIRE([AC_PROG_FINDLIB])dnl - - AC_MSG_CHECKING([for ocaml standard library path]) - OCAML_STDLIB=`$OCAMLFIND printconf stdlib` - AC_SUBST(OCAML_STDLIB) - AC_MSG_RESULT([$OCAML_STDLIB]) -]) - -dnl Thanks to Jim Meyering for working this next bit out for us. -dnl XXX We should define AS_TR_SH if it's not defined already -dnl (eg. for old autoconf). -AC_DEFUN([AC_CHECK_OCAML_PKG], -[dnl - AC_REQUIRE([AC_PROG_FINDLIB])dnl - - AC_ARG_WITH([$1-dir],AC_HELP_STRING([--with-$1-dir=path], - [use "path" as the location of ocaml-$1 (autodetected by default)])) - AC_MSG_CHECKING([for OCaml library $1]) - - unset found - unset pkg - found=no - if test -z "$with_$1_dir"; then - for pkg in $1 $2 ; do - if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then - AC_MSG_RESULT([found]) - AS_TR_SH([OCAML_PKG_$1])=$pkg - AS_TR_SH([OCAML_DIR_$1])=`$OCAMLFIND query $1` - found=yes - break - fi - done - else - echo $with_$1_dir | grep ^/ > /dev/null 2>&1 || with_$1_dir=$PWD/$with_$1_dir - AS_TR_SH([OCAML_PKG_$1])=no - OCAML_DIR_$1="$with_$1_dir" - found=yes - fi - if test "$found" = "no" ; then - AC_MSG_RESULT([not found]) - AS_TR_SH([OCAML_HAS_$1])=no - AS_TR_SH([OCAML_PKG_$1])=no - else - AS_TR_SH([OCAML_HAS_$1])=yes - fi - - AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) -]) - - -AC_DEFUN([AC_CHECK_OCAML_MODULE], -[dnl - AC_MSG_CHECKING([for OCaml module $2]) - - cat > conftest.ml <&5 2>&5 ; then - found=yes - break - fi - done - - if test "$found" ; then - AC_MSG_RESULT([$$1]) - else - AC_MSG_RESULT([not found]) - $1=no - fi - AC_SUBST([$1]) -]) - - -dnl XXX Cross-compiling -AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], -[dnl - AC_REQUIRE([AC_PROG_OCAML])dnl - AC_MSG_CHECKING([for OCaml compiler word size]) - cat > conftest.ml < conftest.ml <]) -CFLAGS=${old_CFLAGS} - -AC_ARG_ENABLE([debugging], - AC_HELP_STRING( - [--disable-debugging], - [disable debugging information (backtrace printing in particular)])) - -if test "$enable_debugging" \!= "no" ; then - OCAMLFLAGS="$OCAMLFLAGS -g" -fi - -AC_ARG_WITH([ocaml-warnings], - AC_HELP_STRING( - [--with-ocaml-warnings=WARNINGS], - [Enable specific list of ocaml compiler warnings.])) - -if test -n "${with_ocaml_warnings}" ; then - OCAMLFLAGS="$OCAMLFLAGS -w +${with_ocaml_warnings}" -else - OCAMLFLAGS="$OCAMLFLAGS -w +A-4@5-7@8-9@11@12@20-35-44-45-50" -fi - -AC_ARG_ENABLE([profiling], - AC_HELP_STRING( - [--enable-profiling], - [compile to generate profiling infomation])) -if test "x$enable_profiling" = "xyes" ; then - OCAMLNCFLAGS="$OCAMLNCFLAGS -p" -fi -AC_SUBST(OCAMLNCFLAGS) - -AC_ARG_ENABLE([nativecode], - AC_HELP_STRING( - [--disable-nativecode], - [compile in bytecode])) - -AC_ARG_ENABLE([custom], - AC_HELP_STRING( - [--disable-custom], - [disable custom mode for bytecode compilation (use if you know what you are doing)])) - -CAMLLIBPATH=$OCAMLLIB -AC_SUBST(CAMLLIBPATH) - -AC_SUBST(CAMLIDL) -AC_SUBST(OCAMLFLAGS) -]) diff --git a/m4/pkg_config.m4 b/m4/pkg_config.m4 deleted file mode 100644 index f940dff..0000000 --- a/m4/pkg_config.m4 +++ /dev/null @@ -1,76 +0,0 @@ -dnl Taken an modified from: -dnl pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- -dnl -dnl Copyright © 2004 Scott James Remnant . -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; either version 2 of the License, or -dnl (at your option) any later version. -dnl -dnl This program is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -dnl General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -dnl -dnl As a special exception to the GNU General Public License, if you -dnl distribute this file as part of a program that contains a -dnl configuration script generated by Autoconf, you may include it under -dnl the same distribution terms that you use for the rest of that program. - -dnl PKG_PROG_PKG_CONFIG([MIN-VERSION]) -dnl ---------------------------------- -AC_DEFUN([PKG_PROG_PKG_CONFIG], -[m4_pattern_forbid([^_?PKG_[A-Z_]+$]) -m4_pattern_allow([^PKG_CONFIG(_PATH)?$]) -AC_ARG_VAR([PKG_CONFIG], [path to pkg-config utility])dnl -if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then - AC_PATH_TOOL([PKG_CONFIG], [pkg-config]) -fi -if test -n "$PKG_CONFIG"; then - _pkg_min_version=m4_default([$1], [0.9.0]) - AC_MSG_CHECKING([pkg-config is at least version $_pkg_min_version]) - if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then - AC_MSG_RESULT([yes]) - else - AC_MSG_ERROR([no]) - PKG_CONFIG="" - fi - -fi[]dnl -])dnl PKG_PROG_PKG_CONFIG - -AC_ARG_VAR([PKG_CONFIG_OPTIONS], [Additional options passed when invoking pkg-config]) - -dnl PKG_CONFIG_CHECK_MODULE([name],[min-version]) -dnl min-version is optional -AC_DEFUN([PKG_CONFIG_CHECK_MODULE], -[if test -n "$2"; then - PKGCONFIG_CHECK_VERSION=" >= $2" -else - PKGCONFIG_CHECK_VERSION="" -fi -AC_MSG_CHECKING([whether pkg-config knows about $1${PKGCONFIG_CHECK_VERSION}]) -if ! $PKG_CONFIG $PKG_CONFIG_OPTIONS --exists $1; then - AC_MSG_ERROR([$1.pc not found.. Do you need to set PKG_CONFIG_PATH?]) -else - if test -n "$2"; then - if ! $PKG_CONFIG $PKG_CONFIG_OPTIONS --atleast-version=$2 $1; then - $1_VERSION="`$PKG_CONFIG $PKG_CONFIG_OPTIONS --modversion $1`" - AC_MSG_ERROR([requires version >= $2, found ${$1_VERSION}]) - else - AC_MSG_RESULT([ok]) - fi - else - AC_MSG_RESULT([ok]) - fi -fi -CFLAGS="$CFLAGS `$PKG_CONFIG $PKG_CONFIG_OPTIONS --cflags $1`" -CPPFLAGS="$CPPFLAGS `$PKG_CONFIG $PKG_CONFIG_OPTIONS --cflags $1`" -LIBS="$LIBS `$PKG_CONFIG $PKG_CONFIG_OPTIONS --libs-only-l $1`" -LDFLAGS="$LDFLAGS `$PKG_CONFIG $PKG_CONFIG_OPTIONS --libs-only-L $1`" -]) diff --git a/m4/strict_check_tool.m4 b/m4/strict_check_tool.m4 deleted file mode 100644 index 6a52090..0000000 --- a/m4/strict_check_tool.m4 +++ /dev/null @@ -1,7 +0,0 @@ -AC_DEFUN([AC_CHECK_TOOL_STRICT], -[AC_CHECK_PROG([$1], [${ac_tool_prefix}$2], [${ac_tool_prefix}$2], [$3], [$4])]) - -AC_DEFUN([AC_PATH_TOOL_STRICT], -[AC_PATH_PROG([$1], [${ac_tool_prefix}$2], [$3])]) - - diff --git a/src/META.in b/src/META.in deleted file mode 100644 index 9480812..0000000 --- a/src/META.in +++ /dev/null @@ -1,10 +0,0 @@ -name="duppy" -version="@VERSION@" -description="OCaml advanced scheduler" -requires="@requires@" -archive(byte)="duppy.cma" -archive(native)="duppy.cmxa" - -@DUPPY_SSL_META@ - -@DUPPY_SECURE_TRANSPORT_META@ diff --git a/src/Makefile.in b/src/Makefile.in deleted file mode 100644 index 2fb5511..0000000 --- a/src/Makefile.in +++ /dev/null @@ -1,68 +0,0 @@ -# Copyright (C) 2005-2006 Savonet team -# lastfm bindings for OCaml. -# -# by Samuel Mimram and Romain Beauxis - -# $Id: Makefile.in 2383 2006-04-09 16:21:04Z smimram $ - -OCAMLMAKEFILE = OCamlMakefile - -OCAMLFIND = @OCAMLFIND@ -OCAMLFIND_LDCONF = @OCAMLFIND_LDCONF@ -OCAMLC = @OCAMLC@ -thread -OCAMLOPT = @OCAMLOPT@ -thread -OCAMLBEST = @OCAMLBEST@ -OCAMLMKTOP = @OCAMLMKTOP@ -OCAMLMKLIB = @OCAMLMKLIB@ -OCAMLCP = @OCAMLCP@ -OCAMLDEP = @OCAMLDEP@ -OCAMLLEX = @OCAMLLEX@ -OCAMLYACC = @OCAMLYACC@ -OCAMLDOC = @OCAMLDOC@ -LATEX = @LATEX@ -DVIPS = @DVIPS@ -PS2PDF = @PS2PDF@ -OCAMLLIBPATH = @CAMLLIBPATH@ - -SOURCES = duppy_stubs.c duppy.ml duppy.mli -RESULT = duppy -OCAMLDOCFLAGS = -stars -DOC_FILES = $(filter %.mli, $(SOURCES)) -LIBINSTALL_FILES = $(DOC_FILES) $(wildcard *.cmi *.cma *.cmxa *.cmx *.a *.so) -ACLIBS = @LIBS@ -LDFLAGS = @LDFLAGS@ -CLIBS = $(ACLIBS:-l%=%) -CC = @CC@ -AR = @AR@ -CFLAGS = @CFLAGS@ -Wall -DCAML_NAME_SPACE -CPPFLAGS = @CPPFLAGS@ -INCDIRS = @INC@ -NO_CUSTOM = yes -OCAMLFLAGS = @OCAMLFLAGS@ -ANNOTATE = true - -all: $(OCAMLBEST) @DUPPY_SSL@ @DUPPY_SECURE_TRANSPORT@ - -duppy_ssl: - $(MAKE) SOURCES="duppy_ssl.mli duppy_ssl.ml" RESULT="duppy_ssl" $(OCAMLBEST) - -duppy_secure_transport: - $(MAKE) SOURCES="duppy_secure_transport.mli duppy_secure_transport.ml" RESULT="duppy_secure_transport" $(OCAMLBEST) - -byte: byte-code-library - -opt: native-code-library - -native-code-library: byte-code-library - -htdoc: - mkdir -p doc/html - ocamldoc -html -d doc/html - -install: libinstall - -uninstall: libuninstall - -update: uninstall install - --include $(OCAMLMAKEFILE) diff --git a/src/OCamlMakefile b/src/OCamlMakefile deleted file mode 100644 index d9ab23c..0000000 --- a/src/OCamlMakefile +++ /dev/null @@ -1,1139 +0,0 @@ -########################################################################### -# OCamlMakefile -# Copyright (C) 1999-2004 Markus Mottl -# -# For updates see: -# http://www.oefai.at/~markus/ocaml_sources -# -# $Id: OCamlMakefile 4512 2007-09-05 14:17:36Z sgimenez $ -# -########################################################################### - -# Modified by damien for .glade.ml compilation - -# Set these variables to the names of the sources to be processed and -# the result variable. Order matters during linkage! - -ifndef SOURCES - SOURCES := foo.ml -endif -export SOURCES - -ifndef RES_CLIB_SUF - RES_CLIB_SUF := _stubs -endif -export RES_CLIB_SUF - -ifndef RESULT - RESULT := foo -endif -export RESULT - -export LIB_PACK_NAME - -ifndef DOC_FILES - DOC_FILES := $(filter %.mli, $(SOURCES)) -endif -export DOC_FILES - -export BCSUFFIX -export NCSUFFIX - -ifndef TOPSUFFIX - TOPSUFFIX := .top -endif -export TOPSUFFIX - -# Eventually set include- and library-paths, libraries to link, -# additional compilation-, link- and ocamlyacc-flags -# Path- and library information needs not be written with "-I" and such... -# Define THREADS if you need it, otherwise leave it unset (same for -# USE_CAMLP4)! - -export THREADS -export VMTHREADS -export ANNOTATE -export USE_CAMLP4 - -export INCDIRS -export LIBDIRS -export EXTLIBDIRS -export RESULTDEPS -export OCAML_DEFAULT_DIRS - -export LIBS -export CLIBS - -export OCAMLFLAGS -export OCAMLNCFLAGS -export OCAMLBCFLAGS - -export OCAMLLDFLAGS -export OCAMLNLDFLAGS -export OCAMLBLDFLAGS - -ifndef OCAMLCPFLAGS - OCAMLCPFLAGS := a -endif - -export OCAMLCPFLAGS - -export PPFLAGS - -export YFLAGS -export IDLFLAGS - -export OCAMLDOCFLAGS - -export OCAMLFIND_INSTFLAGS - -export DVIPSFLAGS - -export STATIC - -# Add a list of optional trash files that should be deleted by "make clean" -export TRASH - -#################### variables depending on your OCaml-installation - -ifdef MINGW - export MINGW - WIN32 := 1 - CFLAGS_WIN32 := -mno-cygwin -endif -ifdef MSVC - export MSVC - WIN32 := 1 - ifndef STATIC - CPPFLAGS_WIN32 := -DCAML_DLL - endif - CFLAGS_WIN32 += -nologo - EXT_OBJ := obj - EXT_LIB := lib - ifeq ($(CC),gcc) - # work around GNU Make default value - ifdef THREADS - CC := cl -MT - else - CC := cl - endif - endif - ifeq ($(CXX),g++) - # work around GNU Make default value - CXX := $(CC) - endif - CFLAG_O := -Fo -endif -ifdef WIN32 - EXT_CXX := cpp - EXE := .exe -endif - -ifndef EXT_OBJ - EXT_OBJ := o -endif -ifndef EXT_LIB - EXT_LIB := a -endif -ifndef EXT_CXX - EXT_CXX := cc -endif -ifndef EXE - EXE := # empty -endif -ifndef CFLAG_O - CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! -endif - -export CC -export CXX -export CFLAGS -export CXXFLAGS -export LDFLAGS -export CPPFLAGS -export AR - -ifndef RPATH_FLAG - RPATH_FLAG := -R -endif -export RPATH_FLAG - -ifndef MSVC -ifndef PIC_CFLAGS - PIC_CFLAGS := -fPIC -endif -ifndef PIC_CPPFLAGS - PIC_CPPFLAGS := -DPIC -endif -endif - -export PIC_CFLAGS -export PIC_CPPFLAGS - -BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) -NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) -TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) - -ifndef OCAMLFIND - OCAMLFIND := ocamlfind -endif -export OCAMLFIND - -ifndef OCAMLC - OCAMLC := ocamlc -endif -export OCAMLC - -ifndef OCAMLOPT - OCAMLOPT := ocamlopt -endif -export OCAMLOPT - -ifndef OCAMLMKTOP - OCAMLMKTOP := ocamlmktop -endif -export OCAMLMKTOP - -ifndef OCAMLCP - OCAMLCP := ocamlcp -endif -export OCAMLCP - -ifndef OCAMLDEP - OCAMLDEP := ocamldep -endif -export OCAMLDEP - -ifndef OCAMLLEX - OCAMLLEX := ocamllex -endif -export OCAMLLEX - -ifndef OCAMLYACC - OCAMLYACC := ocamlyacc -endif -export OCAMLYACC - -ifndef OCAMLMKLIB - OCAMLMKLIB := ocamlmklib -endif -export OCAMLMKLIB - -ifndef OCAML_GLADECC - OCAML_GLADECC := lablgladecc2 -endif -export OCAML_GLADECC - -ifndef OCAML_GLADECC_FLAGS - OCAML_GLADECC_FLAGS := -endif -export OCAML_GLADECC_FLAGS - -ifndef CAMELEON_REPORT - CAMELEON_REPORT := report -endif -export CAMELEON_REPORT - -ifndef CAMELEON_REPORT_FLAGS - CAMELEON_REPORT_FLAGS := -endif -export CAMELEON_REPORT_FLAGS - -ifndef CAMELEON_ZOGGY - CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo -endif -export CAMELEON_ZOGGY - -ifndef CAMELEON_ZOGGY_FLAGS - CAMELEON_ZOGGY_FLAGS := -endif -export CAMELEON_ZOGGY_FLAGS - -ifndef OXRIDL - OXRIDL := oxridl -endif -export OXRIDL - -ifndef CAMLIDL - CAMLIDL := camlidl -endif -export CAMLIDL - -ifndef CAMLIDLDLL - CAMLIDLDLL := camlidldll -endif -export CAMLIDLDLL - -ifndef NOIDLHEADER - MAYBE_IDL_HEADER := -header -endif -export NOIDLHEADER - -export NO_CUSTOM - -ifndef CAMLP4 - CAMLP4 := camlp4 -endif -export CAMLP4 - -ifndef REAL_OCAMLFIND - ifdef PACKS - ifndef CREATE_LIB - ifdef THREADS - PACKS += threads - endif - endif - empty := - space := $(empty) $(empty) - comma := , - ifdef PREDS - PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) - PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) - OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) - # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) - OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) - OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) - else - OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) - OCAML_DEP_PACKAGES := - endif - OCAML_FIND_LINKPKG := -linkpkg - REAL_OCAMLFIND := $(OCAMLFIND) - endif -endif - -export OCAML_FIND_PACKAGES -export OCAML_DEP_PACKAGES -export OCAML_FIND_LINKPKG -export REAL_OCAMLFIND - -ifndef OCAMLDOC - OCAMLDOC := ocamldoc -endif -export OCAMLDOC - -ifndef LATEX - LATEX := latex -endif -export LATEX - -ifndef DVIPS - DVIPS := dvips -endif -export DVIPS - -ifndef PS2PDF - PS2PDF := ps2pdf -endif -export PS2PDF - -ifndef OCAMLMAKEFILE - OCAMLMAKEFILE := OCamlMakefile -endif -export OCAMLMAKEFILE - -ifndef OCAMLLIBPATH - OCAMLLIBPATH := \ - $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/lib/ocaml) -endif -export OCAMLLIBPATH - -ifndef OCAML_LIB_INSTALL - OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib -endif -export OCAML_LIB_INSTALL - -########################################################################### - -#################### change following sections only if -#################### you know what you are doing! - -# delete target files when a build command fails -.PHONY: .DELETE_ON_ERROR -.DELETE_ON_ERROR: - -# for pedants using "--warn-undefined-variables" -export MAYBE_IDL -export REAL_RESULT -export CAMLIDLFLAGS -export THREAD_FLAG -export RES_CLIB -export MAKEDLL -export ANNOT_FLAG -export C_OXRIDL -export SUBPROJS -export CFLAGS_WIN32 -export CPPFLAGS_WIN32 - -INCFLAGS := - -SHELL := /bin/sh - -MLDEPDIR := ._d -BCDIDIR := ._bcdi -NCDIDIR := ._ncdi - -FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade - -FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) -SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) - -FILTERED_REP := $(filter %.rep, $(FILTERED)) -DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) -AUTO_REP := $(FILTERED_REP:.rep=.ml) - -FILTERED_ZOG := $(filter %.zog, $(FILTERED)) -DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) -AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) - -FILTERED_GLADE := $(filter %.glade, $(FILTERED)) -DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) -AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) - -FILTERED_ML := $(filter %.ml, $(FILTERED)) -DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) - -FILTERED_MLI := $(filter %.mli, $(FILTERED)) -DEP_MLI := $(FILTERED_MLI:.mli=.di) - -FILTERED_MLL := $(filter %.mll, $(FILTERED)) -DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) -AUTO_MLL := $(FILTERED_MLL:.mll=.ml) - -FILTERED_MLY := $(filter %.mly, $(FILTERED)) -DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) -AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) - -FILTERED_IDL := $(filter %.idl, $(FILTERED)) -DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) -C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) -ifndef NOIDLHEADER - C_IDL += $(FILTERED_IDL:.idl=.h) -endif -OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) -AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) - -FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) -DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) -AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) - -FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) -OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) -OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) - -PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) - -ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) - -MLDEPS := $(filter %.d, $(ALL_DEPS)) -MLIDEPS := $(filter %.di, $(ALL_DEPS)) -BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) -NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) - -ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) - -IMPLO_INTF := $(ALLML:%.mli=%.mli.__) -IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ - $(basename $(file)).cmi $(basename $(file)).cmo) -IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) -IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) - -IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) - -INTF := $(filter %.cmi, $(IMPLO_INTF)) -IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) -IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) -IMPL_ASM := $(IMPL_CMO:.cmo=.asm) -IMPL_S := $(IMPL_CMO:.cmo=.s) - -OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) -OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) - -EXECS := $(addsuffix $(EXE), \ - $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) -ifdef WIN32 - EXECS += $(BCRESULT).dll $(NCRESULT).dll -endif - -CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) -ifneq ($(strip $(OBJ_LINK)),) - RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) -endif - -ifdef WIN32 -DLLSONAME := $(CLIB_BASE).dll -else -DLLSONAME := dll$(CLIB_BASE).so -endif - -NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ - $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ - $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ - $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ - $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ - $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o - -ifndef STATIC - NONEXECS += $(DLLSONAME) -endif - -ifndef LIBINSTALL_FILES - LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ - $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) - ifndef STATIC - ifneq ($(strip $(OBJ_LINK)),) - LIBINSTALL_FILES += $(DLLSONAME) - endif - endif -endif - -export LIBINSTALL_FILES - -ifdef WIN32 - # some extra stuff is created while linking DLLs - NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib -endif - -TARGETS := $(EXECS) $(NONEXECS) - -# If there are IDL-files -ifneq ($(strip $(FILTERED_IDL)),) - MAYBE_IDL := -cclib -lcamlidl -endif - -ifdef USE_CAMLP4 - CAMLP4PATH := \ - $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/lib/camlp4) - INCFLAGS := -I $(CAMLP4PATH) - CINCFLAGS := -I$(CAMLP4PATH) -endif - -DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) -INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %) -CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) - -ifndef MSVC -CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ - $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \ - $(OCAML_DEFAULT_DIRS:%=-L%) -endif - -ifndef PROFILING - INTF_OCAMLC := $(OCAMLC) -else - ifndef THREADS - INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) - else - # OCaml does not support profiling byte code - # with threads (yet), therefore we force an error. - ifndef REAL_OCAMLC - $(error Profiling of multithreaded byte code not yet supported by OCaml) - endif - INTF_OCAMLC := $(OCAMLC) - endif -endif - -ifndef MSVC -COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ - $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ - $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \ - $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) -else -COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ - $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ - $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " -endif - -CLIBS_OPTS := $(CLIBS:%=-cclib -l%) -ifdef MSVC - ifndef STATIC - # MSVC libraries do not have 'lib' prefix - CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) - endif -endif - -ifneq ($(strip $(OBJ_LINK)),) - ifdef CREATE_LIB - OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) - else - OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) - endif -else - OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) -endif - -# If we have to make byte-code -ifndef REAL_OCAMLC - BYTE_OCAML := y - - # EXTRADEPS is added dependencies we have to insert for all - # executable files we generate. Ideally it should be all of the - # libraries we use, but it's hard to find the ones that get searched on - # the path since I don't know the paths built into the compiler, so - # just include the ones with slashes in their names. - EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) - - REAL_OCAMLC := $(INTF_OCAMLC) - - REAL_IMPL := $(IMPL_CMO) - REAL_IMPL_INTF := $(IMPLO_INTF) - IMPL_SUF := .cmo - - DEPFLAGS := - MAKE_DEPS := $(MLDEPS) $(BCDEPIS) - - ifdef CREATE_LIB - CFLAGS := $(PIC_CFLAGS) $(CFLAGS) - CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) - ifndef STATIC - ifneq ($(strip $(OBJ_LINK)),) - MAKEDLL := $(DLLSONAME) - ALL_LDFLAGS := -dllib $(DLLSONAME) - endif - endif - endif - - ifndef NO_CUSTOM - ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" - ALL_LDFLAGS += -custom - endif - endif - - ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ - $(COMMON_LDFLAGS) $(LIBS:%=%.cma) - CAMLIDLDLLFLAGS := - - ifdef THREADS - ifdef VMTHREADS - THREAD_FLAG := -vmthread - else - THREAD_FLAG := -thread - endif - ifndef CREATE_LIB - ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) - ifndef REAL_OCAMLFIND - ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) - endif - endif - endif - -# we have to make native-code -else - EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) - ifndef PROFILING - SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) - PLDFLAGS := - else - SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) - PLDFLAGS := -p - endif - - REAL_IMPL := $(IMPL_CMX) - REAL_IMPL_INTF := $(IMPLX_INTF) - IMPL_SUF := .cmx - - CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) - - DEPFLAGS := -native - MAKE_DEPS := $(MLDEPS) $(NCDEPIS) - - ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ - $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) - CAMLIDLDLLFLAGS := -opt - - ifndef CREATE_LIB - ALL_LDFLAGS += $(LIBS:%=%.cmxa) - else - CFLAGS := $(PIC_CFLAGS) $(CFLAGS) - CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) - endif - - ifdef THREADS - THREAD_FLAG := -thread - ifndef CREATE_LIB - ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) - ifndef REAL_OCAMLFIND - ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) - endif - endif - endif -endif - -export MAKE_DEPS - -ifdef ANNOTATE - ANNOT_FLAG := -dtypes -else -endif - -ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ - $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) - -ifdef make_deps - -include $(MAKE_DEPS) - PRE_TARGETS := -endif - -########################################################################### -# USER RULES - -# Call "OCamlMakefile QUIET=" to get rid of all of the @'s. -QUIET=@ - -# generates byte-code (default) -byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bc: byte-code - -byte-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(BCRESULT)" make_deps=yes -bcnl: byte-code-nolink - -top: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes - -# generates native-code - -native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -nc: native-code - -native-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncnl: native-code-nolink - -# generates byte-code libraries -byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" \ - CREATE_LIB=yes \ - make_deps=yes -bcl: byte-code-library - -# generates native-code libraries -native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -ncl: native-code-library - -ifdef WIN32 -# generates byte-code dll -byte-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).dll \ - REAL_RESULT="$(BCRESULT)" \ - make_deps=yes -bcd: byte-code-dll - -# generates native-code dll -native-code-dll: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).dll \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - make_deps=yes -ncd: native-code-dll -endif - -# generates byte-code with debugging information -debug-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dc: debug-code - -debug-code-nolink: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dcnl: debug-code-nolink - -# generates byte-code libraries with debugging information -debug-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" make_deps=yes \ - CREATE_LIB=yes \ - OCAMLFLAGS="-g $(OCAMLFLAGS)" \ - OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" -dcl: debug-code-library - -# generates byte-code for profiling -profiling-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - make_deps=yes -pbc: profiling-byte-code - -# generates native-code - -profiling-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PROFILING="y" \ - make_deps=yes -pnc: profiling-native-code - -# generates byte-code libraries -profiling-byte-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(BCRESULT).cma \ - REAL_RESULT="$(BCRESULT)" PROFILING="y" \ - CREATE_LIB=yes \ - make_deps=yes -pbcl: profiling-byte-code-library - -# generates native-code libraries -profiling-native-code-library: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(RES_CLIB) $(NCRESULT).cmxa \ - REAL_RESULT="$(NCRESULT)" PROFILING="y" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - CREATE_LIB=yes \ - make_deps=yes -pncl: profiling-native-code-library - -# packs byte-code objects -pack-byte-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ - REAL_RESULT="$(BCRESULT)" \ - PACK_LIB=yes make_deps=yes -pabc: pack-byte-code - -# packs native-code objects -pack-native-code: $(PRE_TARGETS) - $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ - $(NCRESULT).cmx $(NCRESULT).o \ - REAL_RESULT="$(NCRESULT)" \ - REAL_OCAMLC="$(OCAMLOPT)" \ - PACK_LIB=yes make_deps=yes -panc: pack-native-code - -# generates HTML-documentation -htdoc: doc/$(RESULT)/html - -# generates Latex-documentation -ladoc: doc/$(RESULT)/latex - -# generates PostScript-documentation -psdoc: doc/$(RESULT)/latex/doc.ps - -# generates PDF-documentation -pdfdoc: doc/$(RESULT)/latex/doc.pdf - -# generates all supported forms of documentation -doc: htdoc ladoc psdoc pdfdoc - -########################################################################### -# LOW LEVEL RULES - -$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ - $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ - $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) - -nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) - -ifdef WIN32 -$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) - $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ - -o $@ $(REAL_IMPL) -endif - -%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ - $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ - $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ - $(REAL_IMPL) - -.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ - .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \ - .rep .zog .glade - -ifndef STATIC -ifdef MINGW -$(DLLSONAME): $(OBJ_LINK) - $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ - -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ - $(OCAMLLIBPATH)/ocamlrun.a \ - -Wl,--export-all-symbols \ - -Wl,--no-whole-archive -else -ifdef MSVC -$(DLLSONAME): $(OBJ_LINK) - link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ - $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ - $(OCAMLLIBPATH)/ocamlrun.lib - -else -$(DLLSONAME): $(OBJ_LINK) - $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ - -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ - $(OCAMLMKLIB_FLAGS) -endif -endif -endif - -ifndef LIB_PACK_NAME -$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) - -$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ - $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) -else -ifdef BYTE_OCAML -$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL) -else -$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL) -endif - -$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo - -$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) - $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ - $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx -endif - -$(RES_CLIB): $(OBJ_LINK) -ifndef MSVC - ifneq ($(strip $(OBJ_LINK)),) - $(AR) rcs $@ $(OBJ_LINK) - endif -else - ifneq ($(strip $(OBJ_LINK)),) - lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) - endif -endif - -.mli.cmi: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - else \ - echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ - $(OCAMLFLAGS) $(INCFLAGS) $<; \ - fi - -.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c $(ALL_OCAMLCFLAGS) $<; \ - else \ - echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ - $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ - -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ - fi - -ifdef PACK_LIB -$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) - $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \ - $(OBJS_LIBS) -o $@ $(REAL_IMPL) -endif - -.PRECIOUS: %.ml -%.ml: %.mll - $(OCAMLLEX) $< - -.PRECIOUS: %.ml %.mli -%.ml %.mli: %.mly - $(OCAMLYACC) $(YFLAGS) $< - -.PRECIOUS: %.ml -%.ml: %.rep - $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< - -.PRECIOUS: %.ml -%.ml: %.zog - $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ - -.PRECIOUS: %.ml -%.ml: %.glade - $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ - -.PRECIOUS: %.ml %.mli -%.ml %.mli: %.oxridl - $(OXRIDL) $< - -.PRECIOUS: %.ml %.mli %_stubs.c %.h -%.ml %.mli %_stubs.c %.h: %.idl - $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ - $(CAMLIDLFLAGS) $< - $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi - -.c.$(EXT_OBJ): - $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ - $(CPPFLAGS) $(CPPFLAGS_WIN32) \ - $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< - -.$(EXT_CXX).$(EXT_OBJ): - $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ - -I'$(OCAMLLIBPATH)' \ - $< $(CFLAG_O)$@ - -$(MLDEPDIR)/%.d: %.ml - $(QUIET)echo making $@ from $< - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - $(DINCFLAGS) $< > $@; \ - else \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ - -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ - fi - -$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli - $(QUIET)echo making $@ from $< - $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ - else \ - $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ - -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ - fi - -doc/$(RESULT)/html: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ - $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ - else \ - echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES); \ - $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES); \ - fi - -doc/$(RESULT)/latex: $(DOC_FILES) - rm -rf $@ - mkdir -p $@ - $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ - if [ -z "$$pp" ]; then \ - echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \ - $(DOC_FILES) -o $@/doc.tex; \ - $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \ - -o $@/doc.tex; \ - else \ - echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ - $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \ - $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ - fi - -doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex - cd doc/$(RESULT)/latex && \ - $(LATEX) doc.tex && \ - $(LATEX) doc.tex && \ - $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) - -doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps - cd doc/$(RESULT)/latex && $(PS2PDF) $( Unix.file_descr array -> Unix.file_descr array -> float -> (Unix.file_descr array * Unix.file_descr array * Unix.file_descr array) = "caml_poll" +external poll : + Unix.file_descr array -> + Unix.file_descr array -> + Unix.file_descr array -> + float -> + Unix.file_descr array * Unix.file_descr array * Unix.file_descr array + = "caml_poll" let poll r w e timeout = let r = Array.of_list r in let w = Array.of_list w in let e = Array.of_list e in - let (r, w, e) = - poll r w e timeout - in - (Array.to_list r, - Array.to_list w, - Array.to_list e) + let r, w, e = poll r w e timeout in + (Array.to_list r, Array.to_list w, Array.to_list e) let select, select_fname = match Sys.os_type with - | "Unix" -> poll, "poll" - | _ -> Unix.select, "select" + | "Unix" -> (poll, "poll") + | _ -> (Unix.select, "select") (** [remove f l] is like [List.find f l] but also returns the result of removing * the found element from the original list. *) let remove f l = let rec aux acc = function | [] -> raise Not_found - | x::l -> if f x then x, List.rev_append acc l else aux (x::acc) l + | x :: l -> if f x then (x, List.rev_append acc l) else aux (x :: acc) l in - aux [] l + aux [] l (** Events and tasks from the implementation point-of-view: * we have to hide the 'a parameter. *) -type e = { - r : fd list ; - w : fd list ; - x : fd list ; - t : float -} +type e = { r : fd list; w : fd list; x : fd list; t : float } type 'a t = { - timestamp : float ; - prio : 'a ; - enrich : e -> e ; - is_ready : e -> (unit -> 'a t list) option + timestamp : float; + prio : 'a; + enrich : e -> e; + is_ready : e -> (unit -> 'a t list) option; } -type 'a scheduler = -{ +type 'a scheduler = { out_pipe : Unix.file_descr; in_pipe : Unix.file_descr; compare : 'a -> 'a -> int; @@ -79,20 +75,20 @@ type 'a scheduler = mutable queues : Condition.t list; queues_m : Mutex.t; mutable stop : bool; - stop_m : Mutex.t + stop_m : Mutex.t; } -let clear_tasks s = - Mutex.lock s.tasks_m ; - s.tasks <- [] ; - Mutex.unlock s.tasks_m +let clear_tasks s = + Mutex.lock s.tasks_m; + s.tasks <- []; + Mutex.unlock s.tasks_m -let create ?(compare=compare) () = - let out_pipe,in_pipe = Unix.pipe () in +let create ?(compare = compare) () = + let out_pipe, in_pipe = Unix.pipe () in { - out_pipe = out_pipe; - in_pipe = in_pipe; - compare = compare; + out_pipe; + in_pipe; + compare; select_m = Mutex.create (); tasks = []; tasks_m = Mutex.create (); @@ -101,77 +97,76 @@ let create ?(compare=compare) () = queues = []; queues_m = Mutex.create (); stop = false; - stop_m = Mutex.create () + stop_m = Mutex.create (); } let wake_up s = ignore (Unix.write s.in_pipe (Bytes.of_string "x") 0 1) -module Task = -struct +module Task = struct (** Events and tasks from the user's point-of-view. *) - - type event = [ - | `Delay of float - | `Write of fd - | `Read of fd - | `Exception of fd - ] - - type ('a,'b) task = { - priority : 'a ; - events : 'b list ; - handler : 'b list -> ('a,'b) task list + + type event = + [ `Delay of float | `Write of fd | `Read of fd | `Exception of fd ] + + type ('a, 'b) task = { + priority : 'a; + events : 'b list; + handler : 'b list -> ('a, 'b) task list; } + let time () = Unix.gettimeofday () - - let rec t_of_task (task:('a,[ - List.fold_left - (fun e -> function - | `Delay s -> { e with t = min e.t (t0+.s) } - | `Read s -> { e with r = s::e.r } - | `Write s -> { e with w = s::e.w } - | `Exception s -> { e with x = s::e.x }) - e task.events) ; - is_ready = (fun e -> - let l = - List.filter - (fun evt -> - match (evt :> event) with - | `Delay s when time () > t0+.s -> true - | `Read s when List.mem s e.r -> true - | `Write s when List.mem s e.w -> true - | `Exception s when List.mem s e.x -> true - | _ -> false) - task.events - in - if l = [] then None else - Some (fun () -> List.map t_of_task (task.handler l))) - } - + { + timestamp = t0; + prio = task.priority; + enrich = + (fun e -> + List.fold_left + (fun e -> function `Delay s -> { e with t = min e.t (t0 +. s) } + | `Read s -> { e with r = s :: e.r } + | `Write s -> { e with w = s :: e.w } + | `Exception s -> { e with x = s :: e.x }) + e task.events); + is_ready = + (fun e -> + let l = + List.filter + (fun evt -> + match (evt :> event) with + | `Delay s when time () > t0 +. s -> true + | `Read s when List.mem s e.r -> true + | `Write s when List.mem s e.w -> true + | `Exception s when List.mem s e.x -> true + | _ -> false) + task.events + in + if l = [] then None + else Some (fun () -> List.map t_of_task (task.handler l))); + } + let add_t s items = - let f item = - match item.is_ready {r=[];w=[];x=[];t=0.} with - | Some f -> - Mutex.lock s.ready_m ; - s.ready <- (item.prio,f) :: s.ready ; + let f item = + match item.is_ready { r = []; w = []; x = []; t = 0. } with + | Some f -> + Mutex.lock s.ready_m; + s.ready <- (item.prio, f) :: s.ready; Mutex.unlock s.ready_m | None -> - Mutex.lock s.tasks_m ; - s.tasks <- item :: s.tasks ; - Mutex.unlock s.tasks_m ; + Mutex.lock s.tasks_m; + s.tasks <- item :: s.tasks; + Mutex.unlock s.tasks_m in - List.iter f items ; + List.iter f items; wake_up s - - let add s t = add_t s [t_of_task t] + + let add s t = add_t s [t_of_task t] end open Task -let stop s = +let stop s = clear_tasks s; Mutex.lock s.stop_m; s.stop <- true; @@ -186,43 +181,43 @@ let tmp = Bytes.create 1024 (** There should be only one call of #process at a time. * Process waits for tasks to become ready, and moves ready tasks * to the ready queue. *) -let process s log = +let process s log = (* Compute the union of all events. *) let e = List.fold_left (fun e t -> t.enrich e) - { r = [s.out_pipe] ; w = [] ; x = [] ; t = infinity } + { r = [s.out_pipe]; w = []; x = []; t = infinity } s.tasks in (* Poll for an event. *) - let r,w,x = - let rec f () = + let r, w, x = + let rec f () = try - let timeout = - if e.t = infinity then -1. else max 0. (e.t -. (time ())) - in - log (Printf.sprintf "Enter %s at %f, timeout %f (%d/%d/%d)." - select_fname (time ()) timeout - (List.length e.r) (List.length e.w) (List.length e.x)) ; - let r,w,x = select e.r e.w e.x timeout in - log (Printf.sprintf "Left %s at %f (%d/%d/%d)." select_fname (time ()) - (List.length r) (List.length w) (List.length x)) ; - r,w,x + let timeout = if e.t = infinity then -1. else max 0. (e.t -. time ()) in + log + (Printf.sprintf "Enter %s at %f, timeout %f (%d/%d/%d)." select_fname + (time ()) timeout (List.length e.r) (List.length e.w) + (List.length e.x)); + let r, w, x = select e.r e.w e.x timeout in + log + (Printf.sprintf "Left %s at %f (%d/%d/%d)." select_fname (time ()) + (List.length r) (List.length w) (List.length x)); + (r, w, x) with - | Unix.Unix_error (Unix.EINTR,_,_) -> - (* [EINTR] means that select was interrupted by - * a signal before any of the selected events - * occurred and before the timeout interval expired. - * We catch it and restart.. *) - log (Printf.sprintf "Select interrupted at %f." (time ())) ; - f () - | e -> - (* Uncaught exception: - * 1) Discards all tasks currently in the loop (we do not know which - * socket caused an error). - * 2) Re-Raise e *) - clear_tasks s ; - raise e + | Unix.Unix_error (Unix.EINTR, _, _) -> + (* [EINTR] means that select was interrupted by + * a signal before any of the selected events + * occurred and before the timeout interval expired. + * We catch it and restart.. *) + log (Printf.sprintf "Select interrupted at %f." (time ())); + f () + | e -> + (* Uncaught exception: + * 1) Discards all tasks currently in the loop (we do not know which + * socket caused an error). + * 2) Re-Raise e *) + clear_tasks s; + raise e in f () in @@ -233,70 +228,62 @@ let process s log = * one write. This avoids bad situation * when exceesive wake_up may fill up the * pipe's write buffer, causing a wake_up - * to become blocking.. *) + * to become blocking.. *) ignore (Unix.read s.out_pipe tmp 0 1024) in (* Move ready tasks to the ready list. *) - let e = { r=r ; w=w ; x=x ; t=0. } in - Mutex.lock s.tasks_m ; - (* Split [tasks] into [r]eady and still [w]aiting. *) - let r,w = - List.fold_left - (fun (r,w) t -> - match t.is_ready e with - | Some f -> (t.prio,f)::r, w - | None -> r, t::w) - ([],[]) - s.tasks - in - s.tasks <- w ; - Mutex.unlock s.tasks_m ; - Mutex.lock s.ready_m ; - s.ready <- List.stable_sort (fun (p,_) (p',_) -> s.compare p p') (s.ready @ r) ; - Mutex.unlock s.ready_m + let e = { r; w; x; t = 0. } in + Mutex.lock s.tasks_m; + (* Split [tasks] into [r]eady and still [w]aiting. *) + let r, w = + List.fold_left + (fun (r, w) t -> + match t.is_ready e with + | Some f -> ((t.prio, f) :: r, w) + | None -> (r, t :: w)) + ([], []) s.tasks + in + s.tasks <- w; + Mutex.unlock s.tasks_m; + Mutex.lock s.ready_m; + s.ready <- + List.stable_sort (fun (p, _) (p', _) -> s.compare p p') (s.ready @ r); + Mutex.unlock s.ready_m (** Code for a queue to process ready tasks. * Returns true a task was found (and hence processed). * * s.ready_m *must* be locked before calling * this function, and is freed *only* - * if some task was processed. *) -let exec s (priorities:'a->bool) = + * if some task was processed. *) +let exec s (priorities : 'a -> bool) = (* This assertion does not work on * win32 because a thread can double-lock * the same mutex.. *) - if Sys.os_type <> "Win32" then - assert(not (Mutex.try_lock s.ready_m)) ; + if Sys.os_type <> "Win32" then assert (not (Mutex.try_lock s.ready_m)); try - let (_,task),remaining = - remove - (fun (p,_) -> - priorities p) - s.ready - in - s.ready <- remaining ; - Mutex.unlock s.ready_m ; - add_t s (task ()) ; - true + let (_, task), remaining = remove (fun (p, _) -> priorities p) s.ready in + s.ready <- remaining; + Mutex.unlock s.ready_m; + add_t s (task ()); + true with Not_found -> false exception Queue_stopped exception Queue_processed - (** Main loop for queues. *) -let queue ?log ?(priorities=fun _ -> true) s name = - let log = - match log with - | Some e -> e - | None -> Printf.printf "queue %s: %s\n" name +(** Main loop for queues. *) +let queue ?log ?(priorities = fun _ -> true) s name = + let log = + match log with Some e -> e | None -> Printf.printf "queue %s: %s\n" name in let c = let c = Condition.create () in - Mutex.lock s.queues_m ; - s.queues <- c::s.queues ; - Mutex.unlock s.queues_m ; - log (Printf.sprintf "Queue #%d starting..." (List.length s.queues)) ; - c + Mutex.lock s.queues_m; + s.queues <- c :: s.queues; + Mutex.unlock s.queues_m; + log (Printf.sprintf "Queue #%d starting..." (List.length s.queues)); + c in (* Try to process ready tasks, otherwise try to become the master, * or be a slave and wait for the master to get some more ready tasks. *) @@ -308,453 +295,428 @@ let queue ?log ?(priorities=fun _ -> true) s name = (* Lock the ready tasks until the queue has a task to proceed, * *or* is really ready to restart on its condition, see the * Condition.wait call below for the atomic unlock and wait. *) - Mutex.lock s.ready_m ; - log (Printf.sprintf "There are %d ready tasks." (List.length s.ready)) ; + Mutex.lock s.ready_m; + log (Printf.sprintf "There are %d ready tasks." (List.length s.ready)); if exec s priorities then raise Queue_processed; - let wake () = + let wake () = (* Wake up other queues if there are remaining tasks *) - if s.ready <> [] then - begin - Mutex.lock s.queues_m ; - List.iter (fun x -> if x <> c then Condition.signal x) - s.queues ; - Mutex.unlock s.queues_m - end ; + if s.ready <> [] then begin + Mutex.lock s.queues_m; + List.iter (fun x -> if x <> c then Condition.signal x) s.queues; + Mutex.unlock s.queues_m + end in if Mutex.try_lock s.select_m then begin (* Processing finished for me * I can unlock ready_m now.. *) - Mutex.unlock s.ready_m ; - process s log ; - Mutex.unlock s.select_m ; - Mutex.lock s.ready_m ; - wake () ; + Mutex.unlock s.ready_m; + process s log; + Mutex.unlock s.select_m; + Mutex.lock s.ready_m; + wake (); Mutex.unlock s.ready_m - end else begin - (* We use s.ready_m mutex here. - * Hence, we avoid race conditions - * with any other queue being processing - * a task that would create a new task: - * without this mutex, the new task may not be - * notified to this queue if it is going to sleep - * in concurrency.. - * It also avoid race conditions when restarting - * queues since s.ready_m is locked until all - * queues have been signaled. *) - Condition.wait c s.ready_m; - Mutex.unlock s.ready_m end - in - let rec f () = + else begin + (* We use s.ready_m mutex here. + * Hence, we avoid race conditions + * with any other queue being processing + * a task that would create a new task: + * without this mutex, the new task may not be + * notified to this queue if it is going to sleep + * in concurrency.. + * It also avoid race conditions when restarting + * queues since s.ready_m is locked until all + * queues have been signaled. *) + Condition.wait c s.ready_m; + Mutex.unlock s.ready_m + end + in + let rec f () = begin - try run () with - | Queue_processed -> () + try run () with Queue_processed -> () end; (f [@tailcall]) () - in - try - f () - with Queue_stopped -> () + in + try f () with Queue_stopped -> () -module Async = -struct +module Async = struct (* m is used to make sure that * calls to [wake_up] and [stop] * are thread-safe. *) - type t = - { - stop : bool ref; - mutable fd : fd option; - m : Mutex.t - } + type t = { stop : bool ref; mutable fd : fd option; m : Mutex.t } exception Stopped - let add ~priority (scheduler:'a scheduler) f = - (* A pipe to wake up the task *) - let out_pipe,in_pipe = Unix.pipe () in - let stop = ref false in - let tmp = Bytes.create 1024 in - let rec task l = - if List.exists ((=) (`Read out_pipe)) l then + let add ~priority (scheduler : 'a scheduler) f = + (* A pipe to wake up the task *) + let out_pipe, in_pipe = Unix.pipe () in + let stop = ref false in + let tmp = Bytes.create 1024 in + let rec task l = + if List.exists (( = ) (`Read out_pipe)) l then (* Consume data from the pipe *) - ignore (Unix.read out_pipe tmp 0 1024) ; + ignore (Unix.read out_pipe tmp 0 1024); if !stop then begin - begin + begin try (* This interface is purely asynchronous * so we close both sides of the pipe here. *) - Unix.close in_pipe ; - Unix.close out_pipe + Unix.close in_pipe; + Unix.close out_pipe with _ -> () - end ; - [] + end; + [] end else begin let delay = f () in - let event = - if delay >= 0. then - [`Delay delay ] - else - [] - in - [{ priority = priority ; - events = `Read out_pipe :: event ; - handler = task }] + let event = if delay >= 0. then [`Delay delay] else [] in + [{ priority; events = `Read out_pipe :: event; handler = task }] end - in - let task = - { - priority = priority ; - events = [`Read out_pipe] ; - handler = task - } - in - add scheduler task ; - { stop = stop ; fd = Some in_pipe ; - m = Mutex.create () } + in + let task = { priority; events = [`Read out_pipe]; handler = task } in + add scheduler task; + { stop; fd = Some in_pipe; m = Mutex.create () } let wake_up t = - Mutex.lock t.m ; + Mutex.lock t.m; try - begin - match t.fd with - | Some t -> ignore (Unix.write t (Bytes.of_string " ") 0 1) - | None -> raise Stopped - end ; - Mutex.unlock t.m - with - | e -> Mutex.unlock t.m; raise e - - - let stop t = + begin + match t.fd with + | Some t -> ignore (Unix.write t (Bytes.of_string " ") 0 1) + | None -> raise Stopped + end; + Mutex.unlock t.m + with e -> + Mutex.unlock t.m; + raise e + + let stop t = Mutex.lock t.m; - try + try begin - match t.fd with - | Some c -> - t.stop := true ; - ignore (Unix.write c (Bytes.of_string " ") 0 1) - | None -> raise Stopped - end ; - t.fd <- None ; + match t.fd with + | Some c -> + t.stop := true; + ignore (Unix.write c (Bytes.of_string " ") 0 1) + | None -> raise Stopped + end; + t.fd <- None; Mutex.unlock t.m - with - | e -> Mutex.unlock t.m; raise e + with e -> + Mutex.unlock t.m; + raise e end -module type Transport_t = -sig +module type Transport_t = sig type t - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t - val sock : t -> Unix.file_descr - val read : t -> Bytes.t -> int -> int -> int - val write : t -> Bytes.t -> int -> int -> int + + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + val sock : t -> Unix.file_descr + val read : t -> Bytes.t -> int -> int -> int + val write : t -> Bytes.t -> int -> int -> int val ba_write : t -> bigarray -> int -> int -> int end -module Unix_transport : Transport_t with type t = Unix.file_descr = -struct +module Unix_transport : Transport_t with type t = Unix.file_descr = struct type t = Unix.file_descr - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + let sock s = s let read = Unix.read let write = Unix.write - external ba_write : t -> bigarray -> int -> int -> int = "ocaml_duppy_write_ba" + + external ba_write : t -> bigarray -> int -> int -> int + = "ocaml_duppy_write_ba" end -module type Io_t = -sig +module type Io_t = sig type socket type marker = Length of int | Split of string - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + type failure = | Io_error - | Unix of Unix.error*string*string + | Unix of Unix.error * string * string | Unknown of exn | Timeout + val read : - ?recursive:bool -> ?init:string -> ?on_error:(string*failure -> unit) -> - ?timeout:float -> priority:'a -> 'a scheduler -> socket -> - marker -> (string*(string option) -> unit) -> unit + ?recursive:bool -> + ?init:string -> + ?on_error:(string * failure -> unit) -> + ?timeout:float -> + priority:'a -> + 'a scheduler -> + socket -> + marker -> + (string * string option -> unit) -> + unit + val write : - ?exec:(unit -> unit) -> ?on_error:(failure -> unit) -> - ?bigarray:bigarray -> ?offset:int -> ?length:int -> ?string:Bytes.t -> ?timeout:float -> priority:'a -> - 'a scheduler -> socket -> unit + ?exec:(unit -> unit) -> + ?on_error:(failure -> unit) -> + ?bigarray:bigarray -> + ?offset:int -> + ?length:int -> + ?string:Bytes.t -> + ?timeout:float -> + priority:'a -> + 'a scheduler -> + socket -> + unit end -module MakeIo(Transport:Transport_t) : Io_t with type socket = Transport.t = +module MakeIo (Transport : Transport_t) : Io_t with type socket = Transport.t = struct type socket = Transport.t type marker = Length of int | Split of string - type failure = - | Io_error - | Unix of Unix.error*string*string + + type failure = + | Io_error + | Unix of Unix.error * string * string | Unknown of exn | Timeout exception Io exception Timeout_exc - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t - let read ?(recursive=false) ?(init="") ?(on_error=fun _ -> ()) - ?timeout ~priority (scheduler:'a scheduler) - socket marker exec = + let read ?(recursive = false) ?(init = "") ?(on_error = fun _ -> ()) ?timeout + ~priority (scheduler : 'a scheduler) socket marker exec = let length = 1024 in let b = Buffer.create length in let buf = Bytes.make length ' ' in - Buffer.add_string b init ; + Buffer.add_string b init; let unix_socket = Transport.sock socket in - let events,check_timeout = + let events, check_timeout = match timeout with - | None -> [`Read unix_socket], fun _ -> false - | Some f -> [`Read unix_socket; `Delay f], - (List.mem (`Delay f)) + | None -> ([`Read unix_socket], fun _ -> false) + | Some f -> ([`Read unix_socket; `Delay f], List.mem (`Delay f)) in let rec f l = - if check_timeout l then - raise Timeout_exc ; - if (List.mem (`Read unix_socket) l) then - begin + if check_timeout l then raise Timeout_exc; + if List.mem (`Read unix_socket) l then begin let input = Transport.read socket buf 0 length in - if input<=0 then raise Io ; + if input <= 0 then raise Io; Buffer.add_subbytes b buf 0 input - end ; - let ret = + end; + let ret = match marker with | Split r -> - let rex = Pcre.regexp r in - let acc = Buffer.contents b in - let ret = Pcre.full_split ~max:2 ~rex acc in - let rec p l = - match l with - | Pcre.Text x :: Pcre.Delim _ :: l -> - let f b x = - match x with - | Pcre.Text s - | Pcre.Delim s -> Buffer.add_string b s - | _ -> () - in - if recursive then - begin - Buffer.reset b; - List.iter (f b) l ; - Some (x,None) - end - else - begin - let b = Buffer.create 10 in - List.iter (f b) l ; - Some (x, Some (Buffer.contents b)) - end - | _ :: l' -> p l' - | [] -> None - in - p ret - | Length n when n <= Buffer.length b -> + let rex = Pcre.regexp r in + let acc = Buffer.contents b in + let ret = Pcre.full_split ~max:2 ~rex acc in + let rec p l = + match l with + | Pcre.Text x :: Pcre.Delim _ :: l -> + let f b x = + match x with + | Pcre.Text s | Pcre.Delim s -> Buffer.add_string b s + | _ -> () + in + if recursive then begin + Buffer.reset b; + List.iter (f b) l; + Some (x, None) + end + else begin + let b = Buffer.create 10 in + List.iter (f b) l; + Some (x, Some (Buffer.contents b)) + end + | _ :: l' -> p l' + | [] -> None + in + p ret + | Length n when n <= Buffer.length b -> let s = Buffer.sub b 0 n in let rem = Buffer.sub b n (Buffer.length b - n) in - if recursive then - begin - Buffer.reset b ; - Buffer.add_string b rem ; + if recursive then begin + Buffer.reset b; + Buffer.add_string b rem; Some (s, None) - end - else - Some (s, Some rem) + end + else Some (s, Some rem) | _ -> None in (* Catch all exceptions.. *) let f x = - try - f x - with - | Io -> on_error (Buffer.contents b,Io_error); [] - | Timeout_exc -> on_error (Buffer.contents b,Timeout); [] - | Unix.Unix_error(x,y,z) -> - on_error (Buffer.contents b,Unix(x,y,z)); [] - | e -> on_error (Buffer.contents b,Unknown e); [] + try f x with + | Io -> + on_error (Buffer.contents b, Io_error); + [] + | Timeout_exc -> + on_error (Buffer.contents b, Timeout); + [] + | Unix.Unix_error (x, y, z) -> + on_error (Buffer.contents b, Unix (x, y, z)); + [] + | e -> + on_error (Buffer.contents b, Unknown e); + [] in match ret with - | Some x -> - begin - match x with - | s,Some _ when recursive -> - exec (s,None) ; - [{ priority = priority ; - events = events ; - handler = f }] - | _ -> exec x; [] - end - | None -> - [{ priority = priority ; - events = events ; - handler = f }] + | Some x -> ( + match x with + | s, Some _ when recursive -> + exec (s, None); + [{ priority; events; handler = f }] + | _ -> + exec x; + [] ) + | None -> [{ priority; events; handler = f }] in (* Catch all exceptions.. *) - let f x = - try - f x - with - | Io -> on_error (Buffer.contents b,Io_error); [] - | Timeout_exc -> on_error (Buffer.contents b,Timeout); [] - | Unix.Unix_error(x,y,z) -> - on_error (Buffer.contents b,Unix(x,y,z)); [] - | e -> on_error (Buffer.contents b,Unknown e); [] + let f x = + try f x with + | Io -> + on_error (Buffer.contents b, Io_error); + [] + | Timeout_exc -> + on_error (Buffer.contents b, Timeout); + [] + | Unix.Unix_error (x, y, z) -> + on_error (Buffer.contents b, Unix (x, y, z)); + [] + | e -> + on_error (Buffer.contents b, Unknown e); + [] + in + (* First one is without read, + * in case init contains the wanted match. + * Unless the user sets timeout to 0., this + * should not interfer with user-defined timeout.. *) + let task = + { priority; events = [`Delay 0.; `Read unix_socket]; handler = f } in - (* First one is without read, - * in case init contains the wanted match. - * Unless the user sets timeout to 0., this - * should not interfer with user-defined timeout.. *) - let task = - { - priority = priority ; - events = [`Delay 0.; `Read unix_socket] ; - handler = f - } - in - add scheduler task - - let write ?(exec=fun () -> ()) ?(on_error=fun _ -> ()) - ?bigarray ?(offset=0) ?length ?string ?timeout ~priority - (scheduler:'a scheduler) socket = - let length,write = - match string,bigarray with - | Some s,_ -> - let length = match length with Some length -> length | None -> Bytes.length s in - length, - Transport.write socket s - | None,Some b -> - let length = match length with Some length -> length | None -> Bigarray.Array1.dim b in - length, - Transport.ba_write socket b - | _ -> - 0,fun _ _ -> 0 + add scheduler task + + let write ?(exec = fun () -> ()) ?(on_error = fun _ -> ()) ?bigarray + ?(offset = 0) ?length ?string ?timeout ~priority + (scheduler : 'a scheduler) socket = + let length, write = + match (string, bigarray) with + | Some s, _ -> + let length = + match length with Some length -> length | None -> Bytes.length s + in + (length, Transport.write socket s) + | None, Some b -> + let length = + match length with + | Some length -> length + | None -> Bigarray.Array1.dim b + in + (length, Transport.ba_write socket b) + | _ -> (0, fun _ _ -> 0) in - let unix_socket = Transport.sock (socket:Transport.t) in + let unix_socket = Transport.sock (socket : Transport.t) in let exec () = - if Sys.os_type = "Win32" then - Unix.clear_nonblock unix_socket; + if Sys.os_type = "Win32" then Unix.clear_nonblock unix_socket; exec () in - let events,check_timeout = + let events, check_timeout = match timeout with - | None -> [`Write unix_socket], fun _ -> false - | Some f -> [`Write unix_socket; `Delay f], - (List.mem (`Delay f)) + | None -> ([`Write unix_socket], fun _ -> false) + | Some f -> ([`Write unix_socket; `Delay f], List.mem (`Delay f)) in let rec f pos l = - try - if check_timeout l then - raise Timeout_exc ; - assert (List.exists ((=) (`Write unix_socket)) l) ; - let len = length - pos in - let n = write pos len in - if n<=0 then (on_error Io_error ; []) - else - begin - if n < len then - [{ priority = priority ; events = [`Write unix_socket] ; - handler = f (pos+n) }] - else - (exec () ; []) - end - with - | Unix.Unix_error(Unix.EWOULDBLOCK, _, _) when Sys.os_type = "Win32" -> - [{ priority = priority ; events = [`Write unix_socket] ; - handler = f pos }] - | Timeout_exc -> on_error Timeout; [] - | Unix.Unix_error(x,y,z) -> on_error (Unix(x,y,z)); [] - | e -> on_error (Unknown e); [] + try + if check_timeout l then raise Timeout_exc; + assert (List.exists (( = ) (`Write unix_socket)) l); + let len = length - pos in + let n = write pos len in + if n <= 0 then ( + on_error Io_error; + [] ) + else if n < len then + [{ priority; events = [`Write unix_socket]; handler = f (pos + n) }] + else ( + exec (); + [] ) + with + | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) when Sys.os_type = "Win32" -> + [{ priority; events = [`Write unix_socket]; handler = f pos }] + | Timeout_exc -> + on_error Timeout; + [] + | Unix.Unix_error (x, y, z) -> + on_error (Unix (x, y, z)); + [] + | e -> + on_error (Unknown e); + [] in - let task = { - priority = priority ; - events = events ; - handler = (f offset) - } in + let task = { priority; events; handler = f offset } in if length > 0 then (* Win32 is particularly bad with writting on sockets. It is nearly impossible * to write proper non-blocking code. send will block on blocking sockets if * there isn't enough data available instead of returning a partial buffer * and WSAEventSelect will not return if the socket still has available space. * Thus, setting the socket to non-blocking and writting as much as we can. *) - if Sys.os_type = "Win32" then - begin - Unix.set_nonblock unix_socket ; + if Sys.os_type = "Win32" then begin + Unix.set_nonblock unix_socket; List.iter (add scheduler) (f offset [`Write unix_socket]) - end - else - add scheduler task - else - exec () + end + else add scheduler task + else exec () end -module Io : Io_t with type socket = Unix.file_descr = MakeIo(Unix_transport) +module Io : Io_t with type socket = Unix.file_descr = MakeIo (Unix_transport) (** A monad for implicit continuations or responses *) -module Monad = -struct - type ('a,'b) handler = - { return: 'a -> unit ; - raise: 'b -> unit } - type ('a,'b) t = ('a,'b) handler -> unit - - let return x = - fun h -> h.return x - - let raise x = - fun h -> h.raise x - - let bind f g = - fun h -> - let ret x = - let process = g x in - process h - in - f { return = ret ; - raise = h.raise } +module Monad = struct + type ('a, 'b) handler = { return : 'a -> unit; raise : 'b -> unit } + type ('a, 'b) t = ('a, 'b) handler -> unit - let (>>=) = bind + let return x h = h.return x + let raise x h = h.raise x - let run ~return:ret ~raise:raise f = - f { return = ret ; - raise = raise } + let bind f g h = + let ret x = + let process = g x in + process h + in + f { return = ret; raise = h.raise } - let catch f g = - fun h -> - let raise x = - let process = g x in - process h - in - f { return = h.return ; - raise = raise } + let ( >>= ) = bind + let run ~return:ret ~raise f = f { return = ret; raise } - let (=<<) = fun x y -> catch y x + let catch f g h = + let raise x = + let process = g x in + process h + in + f { return = h.return; raise } - let rec fold_left f a = - function - | [] -> a - | b :: l -> - fold_left f (bind a (fun a -> f a b)) l + let ( =<< ) x y = catch y x - let fold_left f a l = fold_left f (return a) l + let rec fold_left f a = function + | [] -> a + | b :: l -> fold_left f (bind a (fun a -> f a b)) l + let fold_left f a l = fold_left f (return a) l let iter f l = fold_left (fun () b -> f b) () l module Mutex_o = Mutex - module Mutex = - struct - module type Mutex_control = - sig + module Mutex = struct + module type Mutex_control = sig type priority + val scheduler : priority scheduler - val priority : priority + val priority : priority end - module type Mutex_t = - sig + module type Mutex_t = sig (** Type for a mutex. *) type mutex @@ -770,353 +732,324 @@ struct (** A computation that locks a mutex * and returns [unit] afterwards. Computation * will be blocked until the mutex is sucessfuly locked. *) - val lock : mutex -> (unit,'a) t + val lock : mutex -> (unit, 'a) t (** A computation that tries to lock a mutex. * Returns immediatly [true] if the mutex was sucesfully locked * or [false] otherwise. *) - val try_lock : mutex -> (bool,'a) t + val try_lock : mutex -> (bool, 'a) t (** A computation that unlocks a mutex. * Should return immediatly. *) - val unlock : mutex -> (unit,'a) t + val unlock : mutex -> (unit, 'a) t end - module Factory(Control:Mutex_control) = - struct + module Factory (Control : Mutex_control) = struct (* A mutex is either locked or not * and has a list of tasks waiting to get * it. *) - type mutex = - { mutable locked : bool ; - mutable tasks : ((unit->unit) list) } + type mutex = { + mutable locked : bool; + mutable tasks : (unit -> unit) list; + } module Control = Control let tmp = Bytes.create 1024 - - let (x,y) = Unix.pipe () - + let x, y = Unix.pipe () let stop = ref false - - let wake_up () = ignore(Unix.write y (Bytes.of_string " ") 0 1) - + let wake_up () = ignore (Unix.write y (Bytes.of_string " ") 0 1) let ctl_m = Mutex_o.create () - - let finalise _ = - stop := true ; + + let finalise _ = + stop := true; wake_up () - - let mutexes = Queue.create () + let mutexes = Queue.create () let () = Gc.finalise finalise mutexes - - let register () = - let m = - { locked = false ; - tasks = [] } - in + + let register () = + let m = { locked = false; tasks = [] } in Queue.push m mutexes; m let cleanup m = - Mutex_o.lock ctl_m ; + Mutex_o.lock ctl_m; let q = Queue.create () in - Queue.iter (fun m' -> if m <> m' then Queue.push m q) mutexes ; - Queue.clear mutexes ; - Queue.transfer q mutexes ; + Queue.iter (fun m' -> if m <> m' then Queue.push m q) mutexes; + Queue.clear mutexes; + Queue.transfer q mutexes; Mutex_o.unlock ctl_m - + let task f = - { Task. - priority = Control.priority ; - events = [`Delay 0.]; - handler = (fun _ -> f (); [])} - + { + Task.priority = Control.priority; + events = [`Delay 0.]; + handler = + (fun _ -> + f (); + []); + } + (* This should only be called when [ctl_m] is locked. *) let process_mutex tasks m = - if not m.locked then + if not m.locked then ( (* I don't think shuffling tasks * matters here.. *) - match m.tasks with + match m.tasks with | x :: l -> - m.tasks <- l ; - m.locked <- true ; - task x :: tasks - | _ -> tasks + m.tasks <- l; + m.locked <- true; + task x :: tasks + | _ -> tasks ) else tasks - - let rec handler _ = - Mutex_o.lock ctl_m ; - if not !stop then - begin - let tasks = - Queue.fold process_mutex [] mutexes - in - Mutex_o.unlock ctl_m ; - ignore(Unix.read x tmp 0 1024) ; - { Task. - priority = Control.priority ; - events = [`Read x]; - handler = handler } :: tasks - end - else - begin - Mutex_o.unlock ctl_m ; - try - Unix.close x; - Unix.close y; - [] - with - | _ -> - [] - end - - let () = + + let rec handler _ = + Mutex_o.lock ctl_m; + if not !stop then begin + let tasks = Queue.fold process_mutex [] mutexes in + Mutex_o.unlock ctl_m; + ignore (Unix.read x tmp 0 1024); + { Task.priority = Control.priority; events = [`Read x]; handler } + :: tasks + end + else begin + Mutex_o.unlock ctl_m; + try + Unix.close x; + Unix.close y; + [] + with _ -> [] + end + + let () = Task.add Control.scheduler - { Task. - priority = Control.priority; - events = [`Read x]; - handler = handler } - - let create () = - Mutex_o.lock ctl_m ; + { Task.priority = Control.priority; events = [`Read x]; handler } + + let create () = + Mutex_o.lock ctl_m; let ret = register () in - Mutex_o.unlock ctl_m ; - Gc.finalise cleanup ret ; + Mutex_o.unlock ctl_m; + Gc.finalise cleanup ret; ret - - let lock m = - (fun h' -> - Mutex_o.lock ctl_m ; - if not m.locked then - begin - m.locked <- true ; - Mutex_o.unlock ctl_m ; - h'.return () - end - else - begin - m.tasks <- h'.return :: m.tasks ; - Mutex_o.unlock ctl_m - end) - - let try_lock m = - (fun h' -> - Mutex_o.lock ctl_m ; - if not m.locked then - begin - m.locked <- true ; - Mutex_o.unlock ctl_m ; - h'.return true ; - end - else - begin - Mutex_o.unlock ctl_m ; - h'.return false - end) - - let unlock m = - (fun h' -> - Mutex_o.lock ctl_m ; - (* Here we allow inter-thread - * and double unlock.. Double unlock - * is not necessarily a problem and - * inter-thread unlock well.. what is - * a thread here ?? :-) *) - m.locked <- false ; - let wake = m.tasks <> [] in - Mutex_o.unlock ctl_m ; - if wake then wake_up (); - h'.return ()) + + let lock m h' = + Mutex_o.lock ctl_m; + if not m.locked then begin + m.locked <- true; + Mutex_o.unlock ctl_m; + h'.return () + end + else begin + m.tasks <- h'.return :: m.tasks; + Mutex_o.unlock ctl_m + end + + let try_lock m h' = + Mutex_o.lock ctl_m; + if not m.locked then begin + m.locked <- true; + Mutex_o.unlock ctl_m; + h'.return true + end + else begin + Mutex_o.unlock ctl_m; + h'.return false + end + + let unlock m h' = + Mutex_o.lock ctl_m; + (* Here we allow inter-thread + * and double unlock.. Double unlock + * is not necessarily a problem and + * inter-thread unlock well.. what is + * a thread here ?? :-) *) + m.locked <- false; + let wake = m.tasks <> [] in + Mutex_o.unlock ctl_m; + if wake then wake_up (); + h'.return () end end - module Condition = - struct - module Factory(Mutex : Mutex.Mutex_t) = - struct - type condition = - { condition_m : Mutex_o.t ; - waiting : (unit -> unit) Queue.t } + + module Condition = struct + module Factory (Mutex : Mutex.Mutex_t) = struct + type condition = { + condition_m : Mutex_o.t; + waiting : (unit -> unit) Queue.t; + } module Control = Mutex.Control - let create () = - { condition_m = Mutex_o.create (); - waiting = Queue.create () } + let create () = + { condition_m = Mutex_o.create (); waiting = Queue.create () } (* Mutex.unlock m needs to happen _after_ * the task has been registered. *) - let wait c m = - (fun h -> - let proc = - fun () -> Mutex.lock m h - in - Mutex_o.lock c.condition_m ; - Queue.push proc c.waiting; - Mutex_o.unlock c.condition_m ; - (* Mutex.unlock does not raise exceptions (for now..) *) - let h' = { return = (fun () -> ()); - raise = (fun _ -> assert false) } - in - Mutex.unlock m h') - - let wake_up h = - let handler _ = h (); [] in + let wait c m h = + let proc () = Mutex.lock m h in + Mutex_o.lock c.condition_m; + Queue.push proc c.waiting; + Mutex_o.unlock c.condition_m; + (* Mutex.unlock does not raise exceptions (for now..) *) + let h' = { return = (fun () -> ()); raise = (fun _ -> assert false) } in + Mutex.unlock m h' + + let wake_up h = + let handler _ = + h (); + [] + in Task.add Control.scheduler - { Task. - priority = Control.priority; - events = [`Delay 0.]; - handler = handler } - - let signal c = - (fun h -> - Mutex_o.lock c.condition_m; - let h' = Queue.pop c.waiting in - Mutex_o.unlock c.condition_m; - wake_up h'; - h.return ()) - - let broadcast c = - (fun h -> - let q = Queue.create () in - Mutex_o.lock c.condition_m; - Queue.transfer c.waiting q; - Mutex_o.unlock c.condition_m; - Queue.iter wake_up q; - h.return ()) + { Task.priority = Control.priority; events = [`Delay 0.]; handler } + + let signal c h = + Mutex_o.lock c.condition_m; + let h' = Queue.pop c.waiting in + Mutex_o.unlock c.condition_m; + wake_up h'; + h.return () + + let broadcast c h = + let q = Queue.create () in + Mutex_o.lock c.condition_m; + Queue.transfer c.waiting q; + Mutex_o.unlock c.condition_m; + Queue.iter wake_up q; + h.return () end end - module type Monad_io_t = - sig + module type Monad_io_t = sig type socket + module Io : Io_t with type socket = socket - type ('a,'b) handler = - { scheduler : 'a scheduler ; - socket : Io.socket ; - mutable data : string ; - on_error : Io.failure -> 'b } - val exec : ?delay:float -> priority:'a -> ('a,'b) handler -> - ('c,'b) t -> ('c,'b) t - val delay : priority:'a -> ('a,'b) handler -> float -> (unit,'b) t - val read : ?timeout:float -> priority:'a -> - marker:Io.marker -> ('a,'b) handler -> - (string,'b) t - val read_all : ?timeout:float -> - priority:'a -> - 'a scheduler -> - Io.socket -> (string,(string*Io.failure)) t - val write : ?timeout:float -> priority:'a -> ('a,'b) handler -> - ?offset:int -> ?length:int -> Bytes.t -> (unit,'b) t - val write_bigarray : ?timeout:float -> priority:'a -> ('a,'b) handler -> - Io.bigarray -> (unit,'b) t + + type ('a, 'b) handler = { + scheduler : 'a scheduler; + socket : Io.socket; + mutable data : string; + on_error : Io.failure -> 'b; + } + + val exec : + ?delay:float -> + priority:'a -> + ('a, 'b) handler -> + ('c, 'b) t -> + ('c, 'b) t + + val delay : priority:'a -> ('a, 'b) handler -> float -> (unit, 'b) t + + val read : + ?timeout:float -> + priority:'a -> + marker:Io.marker -> + ('a, 'b) handler -> + (string, 'b) t + + val read_all : + ?timeout:float -> + priority:'a -> + 'a scheduler -> + Io.socket -> + (string, string * Io.failure) t + + val write : + ?timeout:float -> + priority:'a -> + ('a, 'b) handler -> + ?offset:int -> + ?length:int -> + Bytes.t -> + (unit, 'b) t + + val write_bigarray : + ?timeout:float -> + priority:'a -> + ('a, 'b) handler -> + Io.bigarray -> + (unit, 'b) t end - module MakeIo(Io:Io_t) = - struct + module MakeIo (Io : Io_t) = struct type socket = Io.socket + module Io = Io - type ('a,'b) handler = - { scheduler : 'a scheduler ; - socket : Io.socket ; - mutable data : string ; - on_error : Io.failure -> 'b } - - let exec ?(delay=0.) ~priority h f = - (fun h' -> - let handler _ = - begin - try - f h' - with - | e -> h'.raise (h.on_error (Io.Unknown e)) - end ; - [] + + type ('a, 'b) handler = { + scheduler : 'a scheduler; + socket : Io.socket; + mutable data : string; + on_error : Io.failure -> 'b; + } + + let exec ?(delay = 0.) ~priority h f h' = + let handler _ = + begin + try f h' with e -> h'.raise (h.on_error (Io.Unknown e)) + end; + [] + in + Task.add h.scheduler { Task.priority; events = [`Delay delay]; handler } + + let delay ~priority h delay = exec ~delay ~priority h (return ()) + + let read ?timeout ~priority ~marker h h' = + let process x = + let s = + match x with + | s, None -> + h.data <- ""; + s + | s, Some s' -> + h.data <- s'; + s in - Task.add h.scheduler - { Task. - priority = priority ; - events = [`Delay delay]; - handler = handler }) - - let delay ~priority h delay = - exec ~delay ~priority h (return ()) - - let read ?timeout ~priority ~marker h = - (fun h' -> - let process x = - let s = - match x with - | s, None -> - h.data <- "" ; - s - | s, Some s' -> - h.data <- s' ; - s - in - h'.return s - in - let init = h.data in - h.data <- "" ; - let on_error (s,x) = - h.data <- s ; - h'.raise (h.on_error x) - in - Io.read ?timeout ~priority ~init ~recursive:false - ~on_error h.scheduler h.socket - marker process) - - let read_all ?timeout ~priority s sock = - let handler = - { scheduler = s ; - socket = sock ; - data = "" ; - on_error = (fun e -> e) } - in - let buf = Buffer.create 1024 in - let rec f () = - let data = - read ?timeout ~priority - ~marker:(Io.Length 1024) - handler - in - let process data = - Buffer.add_string buf data ; - f () + h'.return s + in + let init = h.data in + h.data <- ""; + let on_error (s, x) = + h.data <- s; + h'.raise (h.on_error x) + in + Io.read ?timeout ~priority ~init ~recursive:false ~on_error h.scheduler + h.socket marker process + + let read_all ?timeout ~priority s sock = + let handler = + { scheduler = s; socket = sock; data = ""; on_error = (fun e -> e) } + in + let buf = Buffer.create 1024 in + let rec f () = + let data = read ?timeout ~priority ~marker:(Io.Length 1024) handler in + let process data = + Buffer.add_string buf data; + f () in data >>= process - in - let catch_ret e = - Buffer.add_string buf handler.data ; - match e with - | Io.Io_error -> return (Buffer.contents buf) - | e -> raise (Buffer.contents buf,e) - in - catch (f ()) catch_ret - - let write ?timeout ~priority h ?offset ?length s = - (fun h' -> - let on_error x = - h'.raise (h.on_error x) - in - let exec () = - h'.return () - in - Io.write ?timeout ~priority ~on_error ~exec ?offset ?length ~string:s h.scheduler h.socket) - - let write_bigarray ?timeout ~priority h ba = - (fun h' -> - let on_error x = - h'.raise (h.on_error x) - in - let exec () = - h'.return () - in - Io.write ?timeout ~priority ~on_error ~exec - ~bigarray:ba h.scheduler h.socket) + in + let catch_ret e = + Buffer.add_string buf handler.data; + match e with + | Io.Io_error -> return (Buffer.contents buf) + | e -> raise (Buffer.contents buf, e) + in + catch (f ()) catch_ret + + let write ?timeout ~priority h ?offset ?length s h' = + let on_error x = h'.raise (h.on_error x) in + let exec () = h'.return () in + Io.write ?timeout ~priority ~on_error ~exec ?offset ?length ~string:s + h.scheduler h.socket + + let write_bigarray ?timeout ~priority h ba h' = + let on_error x = h'.raise (h.on_error x) in + let exec () = h'.return () in + Io.write ?timeout ~priority ~on_error ~exec ~bigarray:ba h.scheduler + h.socket end - module Io = MakeIo(Io) + module Io = MakeIo (Io) end - diff --git a/src/duppy.mli b/src/duppy.mli index c8266d1..0c1cf0e 100644 --- a/src/duppy.mli +++ b/src/duppy.mli @@ -20,9 +20,9 @@ *****************************************************************************) - (** Advanced scheduler and monad for server-oriented programming. *) +(** Advanced scheduler and monad for server-oriented programming. *) - (** +(** * {R {i {v * The bars could not hold me; * Force could not control me now. @@ -61,7 +61,7 @@ type 'a scheduler (** Initiate a new scheduler * @param compare the comparison function used to sort tasks according to priorities. * Works as in [List.sort] *) -val create : ?compare:('a -> 'a -> int) -> unit -> 'a scheduler +val create : ?compare:('a -> 'a -> int) -> unit -> 'a scheduler (** [queue ~log ~priorities s name] * starts a queue, on the scheduler [s] only processing priorities [p] @@ -77,8 +77,11 @@ val create : ?compare:('a -> 'a -> int) -> unit -> 'a scheduler * restart Duppy's queues after it is raised but it should only be used to terminate * the process diligently!! *) val queue : - ?log:(string -> unit) -> ?priorities:('a -> bool) -> - 'a scheduler -> string -> unit + ?log:(string -> unit) -> + ?priorities:('a -> bool) -> + 'a scheduler -> + string -> + unit (** Stop all queues running on that scheduler, causing them to return. *) val stop : 'a scheduler -> unit @@ -89,43 +92,37 @@ val stop : 'a scheduler -> unit * execute when one of the events is trigered. * * The executed function may then return a list of new tasks to schedule. *) -module Task : -sig - +module Task : sig (** A task is a list of events awaited, * and a function to process events that have occured. * * The ['a] parameter is the type of priorities, ['b] will be a subset of possible * events. *) - type ('a,'b) task = { - priority : 'a ; - events : 'b list ; - handler : 'b list -> ('a,'b) task list + type ('a, 'b) task = { + priority : 'a; + events : 'b list; + handler : 'b list -> ('a, 'b) task list; } (** Type for possible events. * * Please not that currently, under win32, all socket used in ocaml-duppy * are expected to be in blocking mode only! *) - type event = [ - | `Delay of float + type event = + [ `Delay of float | `Write of Unix.file_descr | `Read of Unix.file_descr - | `Exception of Unix.file_descr - ] - + | `Exception of Unix.file_descr ] + (** Schedule a task. *) - val add : - 'a scheduler -> ('a,[< event ]) task -> unit + val add : 'a scheduler -> ('a, [< event ]) task -> unit end (** Asynchronous task module * * This module implements an asychronous API to {!Duppy.scheduler} * It allows to create a task that will run and then go to sleep. *) -module Async : -sig - +module Async : sig type t (** Exception raised when trying to wake_up a task @@ -154,13 +151,15 @@ sig end (** Module type for Io functor. *) -module type Transport_t = -sig +module type Transport_t = sig type t - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t - val sock : t -> Unix.file_descr - val read : t -> Bytes.t -> int -> int -> int - val write : t -> Bytes.t -> int -> int -> int + + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + val sock : t -> Unix.file_descr + val read : t -> Bytes.t -> int -> int -> int + val write : t -> Bytes.t -> int -> int -> int val ba_write : t -> bigarray -> int -> int -> int end @@ -172,9 +171,7 @@ end * * With {!Duppy.Io.write}, the schdeduler will try to write recursively to the file descriptor * the given string. *) -module type Io_t = -sig - +module type Io_t = sig type socket (** Type for markers. @@ -184,16 +181,17 @@ sig type marker = Length of int | Split of string (** Type of [Bigarray] used here. *) - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + type bigarray = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t (** Different types of failure. * * [Io_error] is raised when reading or writing * returned 0. This usually means that the socket * was closed. *) - type failure = - | Io_error - | Unix of Unix.error*string*string + type failure = + | Io_error + | Unix of Unix.error * string * string | Unknown of exn | Timeout @@ -221,9 +219,16 @@ sig * and the socket was not close while waiting. Default: wait * forever. *) val read : - ?recursive:bool -> ?init:string -> ?on_error:(string*failure -> unit) -> - ?timeout:float -> priority:'a -> 'a scheduler -> socket -> - marker -> (string*(string option) -> unit) -> unit + ?recursive:bool -> + ?init:string -> + ?on_error:(string * failure -> unit) -> + ?timeout:float -> + priority:'a -> + 'a scheduler -> + socket -> + marker -> + (string * string option -> unit) -> + unit (** Similar to [read] but less complex. * [write ?exec ?on_error ?string ?bigarray ~priority scheduler socket] @@ -244,13 +249,20 @@ sig * and the socket was not close while waiting. Default: wait * forever. *) val write : - ?exec:(unit -> unit) -> ?on_error:(failure -> unit) -> - ?bigarray:bigarray -> ?offset:int -> ?length:int -> ?string:Bytes.t -> ?timeout:float -> priority:'a -> - 'a scheduler -> socket -> unit + ?exec:(unit -> unit) -> + ?on_error:(failure -> unit) -> + ?bigarray:bigarray -> + ?offset:int -> + ?length:int -> + ?string:Bytes.t -> + ?timeout:float -> + priority:'a -> + 'a scheduler -> + socket -> + unit end -module MakeIo : functor (Transport : Transport_t) -> Io_t with type socket = Transport.t - +module MakeIo (Transport : Transport_t) : Io_t with type socket = Transport.t module Io : Io_t with type socket = Unix.file_descr (** Monadic interface to {!Duppy.Io}. @@ -280,73 +292,69 @@ module Io : Io_t with type socket = Unix.file_descr * computations which can either return * a new value or raise a value that is used * to terminate. *) -module Monad : -sig - +module Monad : sig (** Type representing a computation * which returns a value of type ['a] - * or raises a value of type ['b] *) - type ('a,'b) t + * or raises a value of type ['b] *) + type ('a, 'b) t (** [return x] create a computation that * returns value [x]. *) - val return : 'a -> ('a,'b) t + val return : 'a -> ('a, 'b) t (** [raise x] create a computation that raises * value [x]. *) - val raise : 'b -> ('a,'b) t + val raise : 'b -> ('a, 'b) t (** Compose two computations. * [bind f g] is equivalent to: * [let x = f in g x] where [x] * has f's return type. *) - val bind : ('a,'b) t -> ('a -> ('c,'b) t) -> ('c,'b) t + val bind : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t (** [>>=] is an alternative notation * for [bind] *) - val (>>=) : ('a,'b) t -> ('a -> ('c,'b) t) -> ('c,'b) t + val ( >>= ) : ('a, 'b) t -> ('a -> ('c, 'b) t) -> ('c, 'b) t (** [run f ~return ~raise ()] executes [f] and process * returned values with [return] or raised values * with [raise]. *) - val run : return:('a -> unit) -> raise:('b -> unit) -> ('a,'b) t -> unit + val run : return:('a -> unit) -> raise:('b -> unit) -> ('a, 'b) t -> unit (** [catch f g] redirects values [x] raised during * [f]'s execution to [g]. The name suggests the * usual [try .. with ..] exception catching. *) - val catch : ('a,'b) t -> ('b -> ('a,'c) t) -> ('a,'c) t + val catch : ('a, 'b) t -> ('b -> ('a, 'c) t) -> ('a, 'c) t (** [=<<] is an alternative notation for catch. *) - val (=<<) : ('b -> ('a,'c) t) -> ('a,'b) t -> ('a,'c) t + val ( =<< ) : ('b -> ('a, 'c) t) -> ('a, 'b) t -> ('a, 'c) t (** [fold_left f a [b1; b2; ..]] returns computation - * [ (f a b1) >>= (fun a -> f a b2) >>= ...] *) - val fold_left : ('a -> 'b -> ('a,'c) t) -> 'a -> 'b list -> ('a,'c) t + * [ (f a b1) >>= (fun a -> f a b2) >>= ...] *) + val fold_left : ('a -> 'b -> ('a, 'c) t) -> 'a -> 'b list -> ('a, 'c) t (** [iter f [x1; x2; ..]] returns computation * [f x1 >>= (fun () -> f x2) >>= ...] *) - val iter : ('a -> (unit,'b) t) -> 'a list -> (unit,'b) t + val iter : ('a -> (unit, 'b) t) -> 'a list -> (unit, 'b) t (** This module implements monadic * mutex computations. They can be used * to write blocking code that is compatible * with duppy's tasks, i.e. [Mutex.lock m] blocks * the calling computation and not the calling thread. *) - module Mutex : - sig + module Mutex : sig (** Information used to initialize a Mutex module. * [priority] and [scheduler] are used to initialize a task * which treat mutexes as well as conditions from the below * [Condition] module. *) - module type Mutex_control = - sig + module type Mutex_control = sig type priority + val scheduler : priority scheduler val priority : priority end - module type Mutex_t = - sig + module type Mutex_t = sig (** Type for a mutex. *) type mutex @@ -358,19 +366,19 @@ sig (** A computation that locks a mutex * and returns [unit] afterwards. Computation * will be blocked until the mutex is sucessfuly locked. *) - val lock : mutex -> (unit,'a) t + val lock : mutex -> (unit, 'a) t (** A computation that tries to lock a mutex. * Returns immediatly [true] if the mutex was sucesfully locked * or [false] otherwise. *) - val try_lock : mutex -> (bool,'a) t + val try_lock : mutex -> (bool, 'a) t (** A computation that unlocks a mutex. * Should return immediatly. *) - val unlock : mutex -> (unit,'a) t + val unlock : mutex -> (unit, 'a) t end - module Factory(Control : Mutex_control) : Mutex_t + module Factory (Control : Mutex_control) : Mutex_t end (** This module implements monadic @@ -380,10 +388,8 @@ sig * the calling computation and not the calling thread * until [Condition.signal c] or [Condition.broadcast c] has * been called. *) - module Condition : - sig - module Factory(Mutex : Mutex.Mutex_t) : - sig + module Condition : sig + module Factory (Mutex : Mutex.Mutex_t) : sig (** Type of a condition, used in [wait] and [broadcast] *) type condition @@ -401,17 +407,17 @@ sig has been called} * {- Locks mutex [m]} * {- Returns [unit]}} *) - val wait : condition -> Mutex.mutex -> (unit,'a) t - + val wait : condition -> Mutex.mutex -> (unit, 'a) t + (** [broadcast c] is a computation that * resumes all computations waiting on [c]. It should * return immediately. *) - val broadcast : condition -> (unit,'a) t - + val broadcast : condition -> (unit, 'a) t + (** [signal c] is a computation that resumes one * computation waiting on [c]. It should return * immediately. *) - val signal : condition -> (unit,'a) t + val signal : condition -> (unit, 'a) t end end @@ -420,8 +426,7 @@ sig * computations that read or write from a socket, * and also to redirect a computation in a different * queue with a new priority. *) - module type Monad_io_t = - sig + module type Monad_io_t = sig type socket module Io : Io_t with type socket = socket @@ -439,12 +444,13 @@ sig * remaining data that was received when * using [read]. If an error occured, * [data] contain data read before the - * error. *) - type ('a,'b) handler = - { scheduler : 'a scheduler ; - socket : Io.socket ; - mutable data : string ; - on_error : Io.failure -> 'b } + * error. *) + type ('a, 'b) handler = { + scheduler : 'a scheduler; + socket : Io.socket; + mutable data : string; + on_error : Io.failure -> 'b; + } (** {2 Execution flow } *) @@ -460,12 +466,16 @@ sig * by a computation that can be blocking, then one may * use [exec] to redirect this computation into an * appropriate queue. *) - val exec : ?delay:float -> priority:'a -> ('a,'b) handler -> - ('c,'b) t -> ('c,'b) t + val exec : + ?delay:float -> + priority:'a -> + ('a, 'b) handler -> + ('c, 'b) t -> + ('c, 'b) t (** [delay ~priority h d] creates a computation that returns * [unit] after delay [d] in seconds. *) - val delay : priority:'a -> ('a,'b) handler -> float -> (unit,'b) t + val delay : priority:'a -> ('a, 'b) handler -> float -> (unit, 'b) t (** {2 Read/write } *) @@ -478,18 +488,23 @@ sig * forces the computation to return an error if * nothing has been read for more than [timeout] * seconds. Default: wait forever. *) - val read : ?timeout:float -> priority:'a -> - marker:Io.marker -> ('a,'b) handler -> - (string,'b) t + val read : + ?timeout:float -> + priority:'a -> + marker:Io.marker -> + ('a, 'b) handler -> + (string, 'b) t (** [read_all ?timeout ~priority s sock] creates a * computation that reads all data from [sock] * and returns it. Raised value contains data * read before an error occured. *) - val read_all : ?timeout:float -> - priority:'a -> - 'a scheduler -> - Io.socket -> (string,(string*Io.failure)) t + val read_all : + ?timeout:float -> + priority:'a -> + 'a scheduler -> + Io.socket -> + (string, string * Io.failure) t (** [write ?timeout ~priority h s] creates a computation * that writes string [s] to [h.socket]. This @@ -498,22 +513,33 @@ sig * forces the computation to return an error if * nothing has been written for more than [timeout] * seconds. Default: wait forever. *) - val write : ?timeout:float -> priority:'a -> ('a,'b) handler -> - ?offset:int -> ?length:int -> Bytes.t -> (unit,'b) t + val write : + ?timeout:float -> + priority:'a -> + ('a, 'b) handler -> + ?offset:int -> + ?length:int -> + Bytes.t -> + (unit, 'b) t (** [write_bigarray ?timeout ~priority h ba] creates a computation * that writes data from [ba] to [h.socket]. This function * can to create a computation that writes data to a socket. *) - val write_bigarray : ?timeout:float -> priority:'a -> ('a,'b) handler -> - Io.bigarray -> (unit,'b) t + val write_bigarray : + ?timeout:float -> + priority:'a -> + ('a, 'b) handler -> + Io.bigarray -> + (unit, 'b) t end - module MakeIo : functor (Io:Io_t) -> Monad_io_t with type socket = Io.socket and module Io = Io + module MakeIo (Io : Io_t) : + Monad_io_t with type socket = Io.socket and module Io = Io module Io : Monad_io_t with type socket = Unix.file_descr and module Io = Io end - (** {2 Some culture..} +(** {2 Some culture..} * {e Duppy is a Caribbean patois word of West African origin meaning ghost or spirit. * Much of Caribbean folklore revolves around duppies. * Duppies are generally regarded as malevolent spirits. diff --git a/src/duppy_secure_transport.ml b/src/duppy_secure_transport.ml deleted file mode 100644 index 273d30c..0000000 --- a/src/duppy_secure_transport.ml +++ /dev/null @@ -1,19 +0,0 @@ -type secure_transport_socket = { - ctx: SecureTransport.t; - sock: Unix.file_descr -} -module Ssl_transport : Duppy.Transport_t with type t = secure_transport_socket = -struct - type t = secure_transport_socket - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t - let sock {sock} = sock - let read {ctx} buf ofs len = - SecureTransport.read ctx buf ofs len - let write {ctx} buf ofs len = - SecureTransport.write ctx buf ofs len - let ba_write _ _ _ _ = - failwith "Not implemented!" -end - -module Io = Duppy.MakeIo(Ssl_transport) -module Monad_io = Duppy.Monad.MakeIo(Io) diff --git a/src/duppy_secure_transport.mli b/src/duppy_secure_transport.mli deleted file mode 100644 index e176117..0000000 --- a/src/duppy_secure_transport.mli +++ /dev/null @@ -1,6 +0,0 @@ -type secure_transport_socket = { - ctx: SecureTransport.t; - sock: Unix.file_descr -} -module Io : Duppy.Io_t with type socket = secure_transport_socket -module Monad_io : Duppy.Monad.Monad_io_t with type socket = secure_transport_socket diff --git a/src/duppy_ssl.ml b/src/duppy_ssl.ml deleted file mode 100644 index d087677..0000000 --- a/src/duppy_ssl.ml +++ /dev/null @@ -1,13 +0,0 @@ -module Ssl_transport : Duppy.Transport_t with type t = Ssl.socket = -struct - type t = Ssl.socket - type bigarray = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t - let sock = Ssl.file_descr_of_socket - let read = Ssl.read - let write = Ssl.write - let ba_write _ _ _ _ = - failwith "Not implemented!" -end - -module Io = Duppy.MakeIo(Ssl_transport) -module Monad_io = Duppy.Monad.MakeIo(Io) diff --git a/src/duppy_ssl.mli b/src/duppy_ssl.mli deleted file mode 100644 index b417a0e..0000000 --- a/src/duppy_ssl.mli +++ /dev/null @@ -1,2 +0,0 @@ -module Io : Duppy.Io_t with type socket = Ssl.socket -module Monad_io : Duppy.Monad.Monad_io_t with type socket = Ssl.socket