From 47b393c883ab794bf1457ba60ef7d3c48df614fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Glondu?= Date: Mon, 5 Aug 2019 03:45:09 +0200 Subject: Import cppo_1.6.6-1.debian.tar.xz [dgit import tarball cppo 1.6.6-1 cppo_1.6.6-1.debian.tar.xz] --- changelog | 153 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ clean | 1 + compat | 1 + control | 26 ++++++++++ copyright | 51 ++++++++++++++++++++ cppo.1 | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++ cppo.dirs | 1 + cppo.docs | 1 + cppo.examples | 1 + cppo.install | 2 + cppo.manpages | 1 + cppo.mkd | 53 ++++++++++++++++++++ gbp.conf | 2 + not-installed | 2 + rules | 25 ++++++++++ source/format | 1 + watch | 2 + 17 files changed, 457 insertions(+) create mode 100644 changelog create mode 100644 clean create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 cppo.1 create mode 100644 cppo.dirs create mode 100644 cppo.docs create mode 100644 cppo.examples create mode 100644 cppo.install create mode 100644 cppo.manpages create mode 100644 cppo.mkd create mode 100644 gbp.conf create mode 100644 not-installed create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..bbe68a1 --- /dev/null +++ b/changelog @@ -0,0 +1,153 @@ +cppo (1.6.6-1) unstable; urgency=medium + + * Team upload + * New upstream release + * Remove Hendrik from Uploaders + * Bump Standards-Version to 4.4.0 + * Bump debhelper compat level to 12 + + -- Stéphane Glondu Mon, 05 Aug 2019 03:45:09 +0200 + +cppo (1.6.4-3) unstable; urgency=medium + + * Stop relying on opam during build to avoid a build-dep loop + + -- Mehdi Dogguy Tue, 16 Oct 2018 08:52:55 +0200 + +cppo (1.6.4-2) unstable; urgency=medium + + * Team upload. + * Fix issue on arm{el,hf} and ppc64el (Closes: #907431) + - add patch 0001-Fix-typo-in-cppo-s-parser.patch from upstream + + -- Mehdi Dogguy Fri, 14 Sep 2018 07:26:53 +0200 + +cppo (1.6.4-1) unstable; urgency=medium + + * Team upload. + * New upstream release (2018-02-26) + * Provides distinct cppo and cppo_ocamlbuild packages + This is a breaking change. + * Provides compatibility with OCaml 4.07 + * Remove obsolete Debian patches + * Use the jbuilder build system. + The dependency on `opam` is due to opam-installer + + * Move the packaging repository to salsa.debian.org + * debian/copyright: Update Source URI + * Bump Standards-Version to 4.1.5 + + debian/copyright: Use an HTTPS Format URI + * Switch to debhelper 11 + * Detect files that failed to install with dh_missing + + -- Nicolas Braud-Santoni Sat, 04 Aug 2018 17:00:20 +0800 + +cppo (1.5.0-2) unstable; urgency=medium + + * Team upload + * Fix FTBFS on bytecode architectures + + -- Stéphane Glondu Wed, 19 Jul 2017 09:30:38 +0200 + +cppo (1.5.0-1) unstable; urgency=medium + + [ Stéphane Glondu ] + * Team upload + * New upstream release + * Add ocamlbuild to Build-Depends + + [ Hendrik Tews ] + * use githup page as homepage + + -- Stéphane Glondu Fri, 14 Jul 2017 14:02:40 +0200 + +cppo (1.3.2-1) unstable; urgency=medium + + * Team upload + * New upstream release + * Bump Standards-Version to 3.9.8 + * Fix Vcs-Git + + -- Stéphane Glondu Wed, 01 Jun 2016 11:35:07 +0200 + +cppo (1.3.1-2) unstable; urgency=medium + + * Team upload + * Install native libraries where available (Closes: #813885) + + -- Hilko Bengen Fri, 12 Feb 2016 00:34:00 +0100 + +cppo (1.3.1-1) unstable; urgency=medium + + * Team upload + * New upstream release + * Update Vcs-* + + -- Stéphane Glondu Tue, 26 Jan 2016 15:54:38 +0100 + +cppo (1.1.2-2) unstable; urgency=medium + + * Team upload + * Fix compilation on bytecode architectures + + -- Stéphane Glondu Thu, 03 Sep 2015 17:35:12 +0200 + +cppo (1.1.2-1) unstable; urgency=medium + + * Team upload + * New upstream release + * Bump Standards-Version to 3.9.6 + + -- Stéphane Glondu Thu, 03 Sep 2015 14:34:44 +0200 + +cppo (0.9.3-3) unstable; urgency=low + + * Team upload + * Upload to unstable + + -- Stéphane Glondu Tue, 03 Dec 2013 08:08:21 +0100 + +cppo (0.9.3-2) experimental; urgency=low + + * Team upload + * Compile with OCaml >= 4 + + -- Stéphane Glondu Thu, 25 Jul 2013 08:54:16 +0200 + +cppo (0.9.3-1) unstable; urgency=low + + [ Sylvain Le Gall] + * Remove Sylvain Le Gall from uploaders + + [ Hendrik Tews ] + * update watch file (thanks to Bart Martens) + * bump standards version and debhelper compat level + * update homepage + * update Vcs fields + * change to architecture any (Closes: 664200) + * update dependencies + * fix copyright + * add myself as uploader + * update man page + + -- Hendrik Tews Sun, 02 Jun 2013 23:12:27 +0200 + +cppo (0.9.2-1) unstable; urgency=low + + * Team upload + * New upstream release + + -- Stéphane Glondu Wed, 02 Nov 2011 07:09:56 +0100 + +cppo (0.9.0-2) unstable; urgency=low + + * Team upload + * Rebuild with OCaml 3.12.0 (no changes) + + -- Stéphane Glondu Mon, 18 Apr 2011 09:00:19 +0200 + +cppo (0.9.0-1) unstable; urgency=low + + * Initial release. (Closes: #605677) + + -- Sylvain Le Gall Sat, 04 Dec 2010 23:03:03 +0100 diff --git a/clean b/clean new file mode 100644 index 0000000..e032546 --- /dev/null +++ b/clean @@ -0,0 +1 @@ +testdata/ext.out diff --git a/compat b/compat new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +12 diff --git a/control b/control new file mode 100644 index 0000000..c84c59a --- /dev/null +++ b/control @@ -0,0 +1,26 @@ +Source: cppo +Section: ocaml +Priority: optional +Maintainer: Debian OCaml Maintainers +Build-Depends: + ocaml-nox (>= 4), + ocaml-findlib (>= 1.4), + dh-ocaml (>= 0.9~), + debhelper (>= 12), + dune, + ocamlbuild +Standards-Version: 4.4.0 +Homepage: https://github.com/mjambon/cppo +Vcs-Git: https://salsa.debian.org/ocaml-team/cppo.git +Vcs-Browser: https://salsa.debian.org/ocaml-team/cppo + +Package: cppo +Architecture: any +Depends: + ${ocaml:Depends}, + ${shlibs:Depends}, + ${misc:Depends} +Description: cpp for OCaml + Cppo is an OCaml-friendly implementation of cpp, the C preprocessor. + It can replace camlp4 for preprocessing OCaml files, using cpp style and + syntax. It allows defining simple macros and file inclusion. diff --git a/copyright b/copyright new file mode 100644 index 0000000..db2d107 --- /dev/null +++ b/copyright @@ -0,0 +1,51 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: Cppo +Upstream-Contact: Martin Jambon +Source: https://github.com/mjambon/cppo + +Files: * +Copyright: Copyright (c) 2009-2011 Martin Jambon +License: BSD-3-clause + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + . + THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +Files: debian/* +Copyright: 2010 Sylvain Le Gall + 2013 Hendrik Tews +License: GPL-3+ + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + . + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + . + You should have received a copy of the GNU General Public License + along with this program. If not, see . + . + On Debian systems, the full text of the GNU General Public + License version 3 can be found in the file + `/usr/share/common-licenses/GPL-3'. diff --git a/cppo.1 b/cppo.1 new file mode 100644 index 0000000..48eaf48 --- /dev/null +++ b/cppo.1 @@ -0,0 +1,134 @@ +.\" groff -man -Tascii cppo.1 +.\" ========================================================================== +.\" ============= Synopsis =================================================== +.\" ========================================================================== +.TH CPPO 1 "June 2013" CPPO "User Manuals" +.SH NAME +cppo \- lightweight cpp-like preprocessor for OCaml +.SH SYNOPSIS +.B cppo \fR[\fIOptions...\fR] \fIfiles\fR... +.\" ========================================================================== +.\" ============= Description ================================================ +.\" ========================================================================== +.SH DESCRIPTION +.B cppo +is the equivalent of the C preprocessor for OCaml. It permits the +definition and expansion of simple (in comparison with +.B camlp4\fR) +macros and file inclusion. +.B cppo +supports functional macros, conditionals, boolean and arithmetic +expressions, stringification, and calling different, external +preprocessors. For a precise description of the features, see +.I /usr/share/doc/cppo/README.gz\fR. +.\" +.\" ========================================================================== +.\" ================ Options ================================================= +.\" ========================================================================== +.\" +.SH OPTIONS +.\" ===================== -D DEF ============================================= +.TP +.B "-D IDENT" +define +.I IDENT +.\" ===================== -U IDENT =========================================== +.TP +.B "-U IDENT" +undefine +.I IDENT +.\" ===================== -I DIR ============================================= +.TP +.B "-I DIR" +add +.I DIR +to the search path for included files +.\" ===================== -o FILE ============================================ +.TP +.B "-o FILE" +write output to +.I FILE +.\" ===================== -q ================================================ +.TP +.B "-q" +Identify and preserve camlp4 quotations +.\" ===================== -s ================================================ +.TP +.B "-s" +Output line directives pointing to the exact source location of +each token, including those coming from the body of macro +definitions. This behavior is off by default. +.\" ===================== -n ================================================ +.TP +.B "-n" +Do not output any line directive other than those found in the +input (overrides +.B -s\fR). +.\" ===================== -version ========================================== +.TP +.B "-version " +print version and exit +.\" ===================== -x NAME:CMD_TEMPLATE =============================== +.TP +.B "-x NAME:CMD_TEMPLATE" +.RS +Define a custom preprocessor target section starting with: +.P +.RS +#ext "NAME" +.RE +.P +and ending with: +.P +.RS +#endext +.RE +.P +.I NAME +must be a lowercase identifier of the form [a-z][A-Za-z0-9_]* +.P +.I CMD_TEMPLATE +is a command template supporting the following special sequences: +.RS +.HP +%F file name (unescaped; beware of potential scripting attacks) +.HP +%B number of the first line +.HP +%E number of the last line +.HP +%% a single percent sign +.RE +.P +The filename, the first line number and the last line number are +available to the external preprocessor via the environment +variables +.I CPPO_FILE\fR, \fICPPO_FIRST_LINE\fR, \fICPPO_LAST_LINE\fR. +.P +The command is expected to read from stdin and to write to +stdout. +.RE +.\" ===================== -help ================================================= +.TP +.B "-help | --help" +Display options and exit +.\" +.\" ========================================================================== +.\" ================ SEE ALSO ================================================ +.\" ========================================================================== +.\" +.SH SEE ALSO +.TP +the \fBcppo\fR web page, \fIhttp://mjambon.com/cppo.html\fR +.TP +the text manual in \fI/usr/share/doc/cppo/README.gz +.\" +.\" ========================================================================== +.\" ================ Author ================================================== +.\" ========================================================================== +.\" +.SH AUTHOR +This manual page was written by Sylvain Le Gall + and Hendrik Tews , +specifically for the Debian project (and may be used by others). + diff --git a/cppo.dirs b/cppo.dirs new file mode 100644 index 0000000..415f082 --- /dev/null +++ b/cppo.dirs @@ -0,0 +1 @@ +/usr/bin diff --git a/cppo.docs b/cppo.docs new file mode 100644 index 0000000..a7a328f --- /dev/null +++ b/cppo.docs @@ -0,0 +1 @@ +usr/doc/*/* diff --git a/cppo.examples b/cppo.examples new file mode 100644 index 0000000..e39721e --- /dev/null +++ b/cppo.examples @@ -0,0 +1 @@ +examples/* diff --git a/cppo.install b/cppo.install new file mode 100644 index 0000000..89b5c8e --- /dev/null +++ b/cppo.install @@ -0,0 +1,2 @@ +usr/bin/cppo +usr/lib/ocaml/cpp* diff --git a/cppo.manpages b/cppo.manpages new file mode 100644 index 0000000..e0a5c7b --- /dev/null +++ b/cppo.manpages @@ -0,0 +1 @@ +debian/cppo.1 diff --git a/cppo.mkd b/cppo.mkd new file mode 100644 index 0000000..a7e33dc --- /dev/null +++ b/cppo.mkd @@ -0,0 +1,53 @@ +% this is the old source for the man page +% process with pandoc -s -w man $^ -o $@ +% CPPO(1) cppo User Manual +% Sylvain Le Gall +% December 4, 2010 + +# NAME + +cppo - cpp for OCaml. + +# SYNOPSIS + +cppo [options] file\* + +# DESCRIPTION + +Cppo is an OCaml-friendly implementation of cpp, the C preprocessor. +It can replace camlp4 for preprocessing OCaml files, using cpp style and +syntax. It allows defining simple macros and file inclusion. + +# OPTIONS + +-D *DEF* +: Equivalent of interpreting '#define DEF' before processing the + input + +-U *IDENT* +: Equivalent of interpreting '#undef IDENT' before processing the + input + +-I `DIR` +: Add directory DIR to the search path for included files + +-o `FILE` +: Output file + +-q +: Identify and preserve camlp4 quotations + +-s +: Output line directives pointing to the exact source location of + each token, including those coming from the body of macro + definitions. This behavior is off by default. + +-n +: Do not output any line directive other than those found in the + input (overrides -s). + +-version +: Print the version of the program and exit. + +-help|\--help +: Display this list of options diff --git a/gbp.conf b/gbp.conf new file mode 100644 index 0000000..cec628c --- /dev/null +++ b/gbp.conf @@ -0,0 +1,2 @@ +[DEFAULT] +pristine-tar = True diff --git a/not-installed b/not-installed new file mode 100644 index 0000000..907f853 --- /dev/null +++ b/not-installed @@ -0,0 +1,2 @@ +usr/share/doc/cppo/LICENSE.md +usr/share/doc/cppo_ocamlbuild/* diff --git a/rules b/rules new file mode 100755 index 0000000..55a960f --- /dev/null +++ b/rules @@ -0,0 +1,25 @@ +#!/usr/bin/make -f +# -*- makefile -*- + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 +#export DH_OPTIONS=-v + +include /usr/share/ocaml/ocamlvars.mk + +DESTDIR := $(CURDIR)/debian/tmp +export OCAMLFIND_DESTDIR=$(DESTDIR)/$(OCAML_STDLIB_DIR)/cppo_ocamlbuild +BUILD_PATH=_build/install/default/lib/cppo_ocamlbuild + +%: + dh $@ --with ocaml + +.PHONY: override_dh_auto_install +override_dh_auto_install: + dune install --destdir=$(DESTDIR) --prefix=/usr --libdir=..$(OCAML_STDLIB_DIR) + rm -f $(DESTDIR)/usr/doc/*/LICENSE.md + +override_dh_missing: + dh_missing --fail-missing + +override_dh_dwz: diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..f157673 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=3 +https://github.com/mjambon/cppo/tags .*/v(.*)\.tar\.gz -- cgit v1.2.3 From 72cebfed0e398ed5d47ff5a3c37297c3db63bab3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Glondu?= Date: Mon, 5 Aug 2019 03:45:09 +0200 Subject: Import cppo_1.6.6.orig.tar.gz [dgit import orig cppo_1.6.6.orig.tar.gz] --- .gitignore | 5 + .ocp-indent | 22 ++ .travis.yml | 16 + CODEOWNERS | 8 + Changes | 80 ++++ INSTALL.md | 23 ++ LICENSE.md | 24 ++ Makefile | 18 + README.md | 521 ++++++++++++++++++++++++ VERSION | 1 + appveyor.yml | 14 + cppo.opam | 30 ++ cppo_ocamlbuild.opam | 25 ++ dune-project | 2 + examples/Makefile | 8 + examples/debug.ml | 7 + examples/dune | 32 ++ examples/french.ml | 34 ++ examples/lexer.mll | 9 + ocamlbuild_plugin/_tags | 1 + ocamlbuild_plugin/dune | 6 + ocamlbuild_plugin/ocamlbuild_cppo.ml | 35 ++ ocamlbuild_plugin/ocamlbuild_cppo.mli | 9 + src/cppo_command.ml | 63 +++ src/cppo_command.mli | 11 + src/cppo_eval.ml | 697 ++++++++++++++++++++++++++++++++ src/cppo_eval.mli | 29 ++ src/cppo_lexer.mll | 721 ++++++++++++++++++++++++++++++++++ src/cppo_main.ml | 226 +++++++++++ src/cppo_parser.mly | 266 +++++++++++++ src/cppo_types.ml | 98 +++++ src/cppo_types.mli | 70 ++++ src/cppo_version.mli | 1 + src/dune | 16 + test/capital.cppo | 6 + test/capital.ref | 6 + test/comments.cppo | 7 + test/comments.ref | 8 + test/cond.cppo | 47 +++ test/cond.ref | 17 + test/dune | 130 ++++++ test/ext.cppo | 10 + test/ext.ref | 28 ++ test/incl.cppo | 3 + test/incl2.cppo | 1 + test/loc.cppo | 8 + test/loc.ref | 21 + test/paren_arg.cppo | 3 + test/paren_arg.ref | 4 + test/source.sh | 13 + test/test.cppo | 144 +++++++ test/tuple.cppo | 38 ++ test/tuple.ref | 20 + test/unmatched.cppo | 14 + test/unmatched.ref | 15 + test/version.cppo | 30 ++ 56 files changed, 3701 insertions(+) create mode 100644 .gitignore create mode 100644 .ocp-indent create mode 100644 .travis.yml create mode 100644 CODEOWNERS create mode 100644 Changes create mode 100644 INSTALL.md create mode 100644 LICENSE.md create mode 100644 Makefile create mode 100644 README.md create mode 100644 VERSION create mode 100644 appveyor.yml create mode 100644 cppo.opam create mode 100644 cppo_ocamlbuild.opam create mode 100644 dune-project create mode 100644 examples/Makefile create mode 100644 examples/debug.ml create mode 100644 examples/dune create mode 100644 examples/french.ml create mode 100644 examples/lexer.mll create mode 100644 ocamlbuild_plugin/_tags create mode 100644 ocamlbuild_plugin/dune create mode 100644 ocamlbuild_plugin/ocamlbuild_cppo.ml create mode 100644 ocamlbuild_plugin/ocamlbuild_cppo.mli create mode 100644 src/cppo_command.ml create mode 100644 src/cppo_command.mli create mode 100644 src/cppo_eval.ml create mode 100644 src/cppo_eval.mli create mode 100644 src/cppo_lexer.mll create mode 100644 src/cppo_main.ml create mode 100644 src/cppo_parser.mly create mode 100644 src/cppo_types.ml create mode 100644 src/cppo_types.mli create mode 100644 src/cppo_version.mli create mode 100644 src/dune create mode 100644 test/capital.cppo create mode 100644 test/capital.ref create mode 100644 test/comments.cppo create mode 100644 test/comments.ref create mode 100644 test/cond.cppo create mode 100644 test/cond.ref create mode 100644 test/dune create mode 100644 test/ext.cppo create mode 100644 test/ext.ref create mode 100644 test/incl.cppo create mode 100644 test/incl2.cppo create mode 100644 test/loc.cppo create mode 100644 test/loc.ref create mode 100644 test/paren_arg.cppo create mode 100644 test/paren_arg.ref create mode 100755 test/source.sh create mode 100644 test/test.cppo create mode 100644 test/tuple.cppo create mode 100644 test/tuple.ref create mode 100644 test/unmatched.cppo create mode 100644 test/unmatched.ref create mode 100644 test/version.cppo diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1d0dd35 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*~ +_build +.merlin +*.install +.*.swp diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 0000000..fb580a5 --- /dev/null +++ b/.ocp-indent @@ -0,0 +1,22 @@ +# See https://github.com/OCamlPro/ocp-indent/blob/master/.ocp-indent for more + +# Indent for clauses inside a pattern-match (after the arrow): +# match foo with +# | _ -> +# ^^^^bar +# the default is 2, which aligns the pattern and the expression +match_clause = 4 + +# When nesting expressions on the same line, their indentation are in +# some cases stacked, so that it remains correct if you close them one +# at a line. This may lead to large indents in complex code though, so +# this parameter can be used to set a maximum value. Note that it only +# affects indentation after function arrows and opening parens at end +# of line. +# +# for example (left: `none`; right: `4`) +# let f = g (h (i (fun x -> # let f = g (h (i (fun x -> +# x) # x) +# ) # ) +# ) # ) +max_indent = 2 diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..1f17d11 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,16 @@ +language: c +sudo: required +install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh +script: bash -ex .travis-opam.sh +env: + global: + - PACKAGE=cppo + matrix: + - OCAML_VERSION=4.03 + - OCAML_VERSION=4.04 + - OCAML_VERSION=4.05 + - OCAML_VERSION=4.06 + - OCAML_VERSION=4.07 +os: + - linux + - osx diff --git a/CODEOWNERS b/CODEOWNERS new file mode 100644 index 0000000..2a7c825 --- /dev/null +++ b/CODEOWNERS @@ -0,0 +1,8 @@ +# We're looking for one or more volunteers to take the lead of cppo, +# with the help of ocaml-community. +# +# Call for volunteers: https://github.com/ocaml-community/meta/issues/27 +# About ocaml-community: https://github.com/ocaml-community/meta +# +# Interim maintainers who won't be very responsive :-( +* @mjambon @pmetzger diff --git a/Changes b/Changes new file mode 100644 index 0000000..2201c10 --- /dev/null +++ b/Changes @@ -0,0 +1,80 @@ +## v1.6.6 (2019-05-27) +- [pkg] port build system to dune from jbuilder. +- [pkg] upgrade opam metadata to 2.0 format. +- [pkg] remove topkg and use dune-release. +- [compat] Use `String.capitalize_ascii` to remove warning. + +## v1.6.5 (2018-09-12) +- [bug] Fix 'asr' operator (#61) + +## v1.6.4 (2018-02-26) +- [compat] Tests should now work with older versions of jbuilder. + +## v1.6.3 (2018-02-21) +- [compat] Fix tests. + +## v1.6.1 (2018-01-25) +- [compat] Emit line directives always containing the file name, + as mandated starting with ocaml 4.07. + +## v1.6.0 (2017-08-07) +- [pkg] BREAKING: cppo and cppo_ocamlbuild are now two distinct opam + packages. + +## v1.5.0 (2017-04-24) +- [+ui] Added the `CAPITALIZE()` function. + +## v1.4.0 (2016-08-19) +- [compat] Cppo is now safe-string ready. + +## v1.3.2 (2016-04-20) +- [pkg] Cppo can now be built on MSVC. + +## v1.3.1 (2015-09-20) +- [bug] Possible to have #endif between two matching parenthesis. + +## v1.3.0 (2015-09-13) +- [+ui] Removed the need for escaping commas and parenthesis in macros. +- [+ui] Blanks is now allowed in argument list in macro definitions. +- [+ui] #directive with wrong arguments is now giving a proper error. +- [bug] Fixed expansion of __FILE__ and __LINE__. + +## v1.1.2 (2014-11-10) +- [+ui] Ocamlbuild_cppo: added the ocamlbuild flag `cppo_V(NAME:VERSION)`, + equivalent to `-V NAME:VERSION` (for _tags file). + +## v1.1.1 (2014-11-10) +- [+ui] Ocamlbuild_cppo: added the ocamlbuild flag `cppo_V_OCAML`, + equivalent to `-V OCAML:VERSION` (for _tags file). + +## v1.1.0 (2014-11-04) +- [+ui] Added the `-V NAME:VERSION` option. +- [+ui] Support for tuples in comparisons: tuples can be constructed + and compared, e.g. `#if (2 + 2, 5) < (4, 5)`. + +## v1.0.1 (2014-10-20) +- [+ui] `#elif` and `#else` can now be used in the same #if-#else statement. +- [bug] Fixed the Ocamlbuild flag `cppo_n`. + +## v1.0.0 (2014-09-06) +- [bug] OCaml comments are now better parsed. For example, (* '"' *) works. + +## v0.9.4 (2014-06-10) +- [+ui] Added the ocamlbuild_cppo plugin for Ocamlbuild. To use it: + `-plugin(cppo_ocamlbuild)`. + +## v0.9.3 (2012-02-03) +- [pkg] New way of building the tar.gz archive. + +## v0.9.2 (2011-08-12) +- [+ui] Added two predefined macros STRINGIFY and CONCAT for making + string literals and for building identifiers respectively. + +## v0.9.1 (2011-07-20) +- [+ui] Added support for processing sections of files using external programs + (#ext/#endext, -x option) +- [doc] Moved and extended documentation into the README file. + +## v0.9.0 (2009-11-17) + +- initial public release diff --git a/INSTALL.md b/INSTALL.md new file mode 100644 index 0000000..9888ee2 --- /dev/null +++ b/INSTALL.md @@ -0,0 +1,23 @@ +Installation instructions for cppo +================================== + +Building cppo requires GNU Make and a standard OCaml +installation. It can be installed with opam or manually as follows: + +Build: + +``` +make +``` + +Install: + +``` +make PREFIX=/some/path install +``` + +or + +``` +make BINDIR=/some/path/bin install +``` diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..f1725ba --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,24 @@ +Copyright (c) 2009-2011 Martin Jambon +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..c69d27e --- /dev/null +++ b/Makefile @@ -0,0 +1,18 @@ +all: + @dune build + +test: + @dune runtest + +install: + @dune install + +uninstall: + @dune uninstall + +check: test + +.PHONY: clean all check test install uninstall + +clean: + dune clean diff --git a/README.md b/README.md new file mode 100644 index 0000000..8d5093a --- /dev/null +++ b/README.md @@ -0,0 +1,521 @@ +[![Build status](https://ci.appveyor.com/api/projects/status/ft3167hf8yr2n5d3?svg=true)](https://ci.appveyor.com/project/Chris00/cppo-pnjtx) + +Cppo: cpp for OCaml +=================== + +Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain + +User guide +---------- + +Cppo is a preprocessor for programming languages that follow lexical rules +compatible with OCaml including OCaml-style comments `(* ... *)`. These include Ocamllex, Ocamlyacc, Menhir, and extensions of OCaml based on Camlp4, Camlp5, or ppx. Cppo should work with Bucklescript as well. It won't work so well with Reason code because Reason uses C-style comment delimiters `/*` and `*/`. + +Cppo supports a number of directives. A directive is a `#` sign placed +at the beginning of a line, possibly preceded by some whitespace, and followed +by a valid directive name or by a number: + +```ocaml +BLANK* "#" BLANK* ("define"|"undef" + |"if"|"ifdef"|"ifndef"|"else"|"elif"|"endif" + |"include" + |"warning"|"error" + |"ext"|"endext") ... +``` + +Directives can be split into multiple lines by placing a backslash `\` at +the end of the line to be continued. In general, any special character +can used as a normal character by preceding it with backslash. + + +File inclusion +-------------- + +```ocaml +#include "hello.ml" +``` + +This is how a source file `hello.ml` can be included. +Relative paths are searched first in the directory of the current file +and then in the search paths added on the command line using `-I`, if any. + + +Macros +------ + +This is a simple macro that doesn't take an argument ("object-like +macro" in the cpp jargon): + +```ocaml +#define Ms Mississippi + +match state with + Ms -> true + | _ -> false +``` + +After preprocessing by cppo, the code above becomes: + +```ocaml +match state with + Mississippi -> true + | _ -> false +``` + +If needed, defined macros can be undefined. This is required prior to +redefining a macro: + +```ocaml +#undef X +``` + +An important distinction with cpp is that only previously-defined +macros are accessible. Defining, undefining or redefining a macro has +no effect on how previous macros will expand. + +Macros can take arguments ("function-like macro" in the cpp +jargon). Both in the definition (`#define`) and in macro application the +opening parenthesis must stick to the macro's identifier: + +```ocaml +#define debug(args) if !debugging then Printf.eprintf args else () + +debug("Testing %i" (1 + 1)) +``` + +is expanded into: + +```ocaml +if !debugging then Printf.eprintf "Testing %i" (1 + 1) else () +``` + +Here is a multiline macro definition. Newlines occurring between +tokens must be protected by a backslash: + +```ocaml +#define repeat_until(action,condition) \ + action; \ + while not (condition) do \ + action \ + done +``` + +All user-definable macros are constant. There are however two +predefined variable macros: `__FILE__` and `__LINE__` which take the value +of the position in the source file where the macro is being expanded. + +```ocaml +#define loc (Printf.sprintf "File %S, line %i" __FILE__ __LINE__) +``` + +Macros can be defined on the command line as follows: + +```ocaml +# preprocessing only +cppo -D 'VERSION 1.0' example.ml + +# preprocessing and compiling +ocamlopt -c -pp "cppo -D 'VERSION 1.0'" example.ml +``` + +Conditionals +------------ + +Here is a quick reference on conditionals available in cppo. If you +are not familiar with `#ifdef`, `#ifndef`, `#if`, `#else` and `#elif`, please +refer to the corresponding section in the cpp manual. + +```ocaml +#ifndef VERSION +#warning "VERSION is undefined" +#define VERSION "n/a" +#endif +#ifndef VERSION +#error "VERSION is undefined" +#endif +#if OCAML_MAJOR >= 3 && OCAML_MINOR >= 10 +... +#endif +#ifdef X +... +#elif defined Y +... +#else +... +#endif +``` + +The boolean expressions following `#if` and `#elif` may perform arithmetic +operations and tests over 64-bit ints. + +Boolean expressions: + +* `defined` ... followed by an identifier, returns true if such a macro exists +* `true` +* `false` +* `(` ... `)` +* ... `&&` ... +* ... `||` ... +* `not` ... + +Arithmetic comparisons used in boolean expressions: + +* ... `=` ... +* ... `<` ... +* ... `>` ... +* ... `<>` ... +* ... `<=` ... +* ... `>=` ... + +Arithmetic operators over signed 64-bit ints: + +* `(` ... `)` +* ... `+` ... +* ... `-` ... +* ... `*` ... +* ... `/` ... +* ... `mod` ... +* ... `lsl` ... +* ... `lsr` ... +* ... `asr` ... +* ... `land` ... +* ... `lor` ... +* ... `lxor` ... +* `lnot` ... + +Macro identifiers can be used in place of ints as long as they expand +to an int literal or a tuple of int literals, e.g.: + +```ocaml +#define one 1 + +#if one + one <> 2 +#error "Something's wrong." +#endif + +#define VERSION (1, 0, 5) +#if VERSION <= (1, 0, 2) +#error "Version 1.0.2 or greater is required." +#endif +``` + +Version strings (http://semver.org/) can also be passed to cppo on the +command line. This results in multiple variables being defined, all +sharing the same prefix. See the output of `cppo -help` (copied at the +bottom of this page). + +``` +$ cppo -V OCAML:`ocamlc -version` +#if OCAML_VERSION >= (4, 0, 0) +(* All is well. *) +#else + #error "This version of OCaml is not supported." +#endif +``` + +Output: +``` +# 2 "" +(* All is well. *) +``` + +Source file location +-------------------- + +Location directives are the same as in OCaml and are echoed in the +output. They consist of a line number optionally followed by a file name: + +```ocaml +# 123 +# 456 "source" +``` + +Messages +-------- + +Warnings and error messages can be produced by the preprocessor: + +```ocaml +#ifndef X + #warning "Assuming default value for X" + #define X 1 +#elif X = 0 + #error "X may not be null" +#endif +``` + +Calling an external processor +----------------------------- + +Cppo provides a mechanism for converting sections of a file using +and external program. Such a section must be placed between `#ext` and +`#endext` directives. + +```bash +$ cat foo +ABC +#ext lowercase +DEF +#endext +GHI +#ext lowercase +KLM +NOP +#endext +QRS + +$ cppo -x lowercase:'tr "[A-Z]" "[a-z]"' foo +# 1 "foo" +ABC +def +# 5 "foo" +GHI +klm +nop +# 10 "foo" +QRS +``` + +In the example above, `lowercase` is the name given on the +command-line to external command `'tr "[A-Z]" "[a-z]"'` that reads +input from stdin and writes its output to stdout. + + +Escaping +-------- + +The following characters can be escaped by a backslash when needed: + +```ocaml +( +) +, +# +``` + +In OCaml `#` is used for method calls. It is usually not a problem +because in order to be interpreted as a preprocessor directive, it +must be the first non-blank character of a line and be a known +directive. If an object has a define method and you want `#` to appear +first on a line, you would have to use `\#` instead: + +```ocaml +obj + \#define +``` + +Line directives in the usual format supported by OCaml are correctly +interpreted by cppo. + +Comments and string literals constitute single tokens even when they +span across multiple lines. Therefore newlines within string literals +and comments should remain as-is (no preceding backslash) even in a +macro body: + +```ocaml +#define welcome \ +"********** +*Welcome!* +********** +" +``` + +Concatenation +------------- + +`CONCAT()` is a predefined macro that takes two arguments, removes any +whitespace between and around them and fuses them into a single identifier. +The result of the concatenation must be a valid identifier of the +form [A-Za-z_][A-Za-z0-9_]+ or [A-Za-z], or empty. + +For example, + +```ocaml +#define x 123 +CONCAT(z, x) +``` + +expands into: + +```ocaml +z123 +``` + +However the following is illegal: + +```ocaml +#define x 123 +CONCAT(x, z) +``` + +because 123z does not form a valid identifier. + +`CONCAT(a,b)` is roughly equivalent to `a##b` in cpp syntax. + +CAPITALIZE +--------------- + +`CAPITALIZE()` is a predefined macro that takes one argument, +removes any leading and trailing whitespace, reduces each internal +whitespace sequence to a single space character and produces +a valid OCaml identifer with first character. + +For example, +```ocaml +#define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val] +EVENT(exit, unit -> unit) +``` +is expanded into: + +```ocaml +external onExit : unit -> unit = "exit" [@@bs.val] +``` + +Stringification +--------------- + +`STRINGIFY()` is a predefined macro that takes one argument, +removes any leading and trailing whitespace, reduces each internal +whitespace sequence to a single space character and produces +a valid OCaml string literal. + +For example, + +```ocaml +#define TRACE(f) Printf.printf ">>> %s\n" STRINGIFY(f); f +TRACE(print_endline) "Hello" +``` + +is expanded into: + +```ocaml +Printf.printf ">>> %s\n" "print_endline"; print_endline "Hello" +``` + +`STRINGIFY(x)` is the equivalent of `#x` in cpp syntax. + + +Ocamlbuild plugin +------------------ + +An ocamlbuild plugin is available. To use it, you can call ocamlbuild +with the argument `-plugin-tag package(cppo_ocamlbuild)` (only since +ocaml 4.01 and cppo >= 0.9.4). + +Starting from **cppo >= 1.6.0**, the `cppo_ocamlbuild` plugin is in a +separate OPAM package (`opam install cppo_ocamlbuild`). + +With Oasis : +``` +OCamlVersion: >= 4.01 +AlphaFeatures: ocamlbuild_more_args +XOCamlbuildPluginTags: package(cppo_ocamlbuild) +``` + +After that, you need to add in your `myocamlbuild.ml` : +```ocaml +let () = + Ocamlbuild_plugin.dispatch + (fun hook -> + Ocamlbuild_cppo.dispatcher hook ; + ) +``` + +By default the plugin will apply cppo on all files ending in `.cppo.ml` +`cppo.mli`, and `cppo.mlpack`, in order to produce `.ml`, `.mli`, +and`.mlpack` files. The following tags are available: +* `cppo_D(X)` ≡ `-D X` +* `cppo_U(X)` ≡ `-U X` +* `cppo_q` ≡ `-q` +* `cppo_s` ≡ `-s` +* `cppo_n` ≡ `-n` +* `cppo_x(NAME:CMD_TEMPLATE)` ≡ `-x NAME:CMD_TEMPLATE` +* The tag `cppo_I(foo)` can behave in two way: + * If `foo` is a directory, it's equivalent to `-I foo`. + * If `foo` is a file, it adds `foo` as a dependency and apply `-I + parent(foo)`. +* `cppo_V(NAME:VERSION)` ≡ `-V NAME:VERSION` +* `cppo_V_OCAML` ≡ `-V OCAML:VERSION`, where `VERSION` + is the version of OCaml that ocamlbuild uses. + +Detailed command-line usage and options +--------------------------------------- + +``` +Usage: ./cppo [OPTIONS] [FILE1 [FILE2 ...]] +Options: + -D DEF + Equivalent of interpreting '#define DEF' before processing the + input + -U IDENT + Equivalent of interpreting '#undef IDENT' before processing the + input + -I DIR + Add directory DIR to the search path for included files + -V VAR:MAJOR.MINOR.PATCH-OPTPRERELEASE+OPTBUILD + Define the following variables extracted from a version string + (following the Semantic Versioning syntax http://semver.org/): + + VAR_MAJOR must be a non-negative int + VAR_MINOR must be a non-negative int + VAR_PATCH must be a non-negative int + VAR_PRERELEASE if the OPTPRERELEASE part exists + VAR_BUILD if the OPTBUILD part exists + VAR_VERSION is the tuple (MAJOR, MINOR, PATCH) + VAR_VERSION_STRING is the string MAJOR.MINOR.PATCH + VAR_VERSION_FULL is the original string + + Example: cppo -V OCAML:4.02.1 + + -o FILE + Output file + -q + Identify and preserve camlp4 quotations + -s + Output line directives pointing to the exact source location of + each token, including those coming from the body of macro + definitions. This behavior is off by default. + -n + Do not output any line directive other than those found in the + input (overrides -s). + -version + Print the version of the program and exit. + -x NAME:CMD_TEMPLATE + Define a custom preprocessor target section starting with: + #ext "NAME" + and ending with: + #endext + + NAME must be a lowercase identifier of the form [a-z][A-Za-z0-9_]* + + CMD_TEMPLATE is a command template supporting the following + special sequences: + %F file name (unescaped; beware of potential scripting attacks) + %B number of the first line + %E number of the last line + %% a single percent sign + + Filename, first line number and last line number are also + available from the following environment variables: + CPPO_FILE, CPPO_FIRST_LINE, CPPO_LAST_LINE. + + The command produced is expected to read the data lines from stdin + and to write its output to stdout. + -help Display this list of options + --help Display this list of options +``` + + +Contributing +------------ + +See our contribution guidelines at +https://github.com/mjambon/documents/blob/master/how-to-contribute.md diff --git a/VERSION b/VERSION new file mode 100644 index 0000000..ec70f75 --- /dev/null +++ b/VERSION @@ -0,0 +1 @@ +1.6.6 diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..456a4cc --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,14 @@ + +environment: + matrix: + - OCAML_BRANCH: 4.05 + - OCAML_BRANCH: 4.06 + +install: + - appveyor DownloadFile "https://raw.githubusercontent.com/Chris00/ocaml-appveyor/master/install_ocaml.cmd" -FileName "C:\install_ocaml.cmd" + - C:\install_ocaml.cmd + +build_script: + - cd "%APPVEYOR_BUILD_FOLDER%" + - dune subst + - dune build -p cppo diff --git a/cppo.opam b/cppo.opam new file mode 100644 index 0000000..5a6b2f7 --- /dev/null +++ b/cppo.opam @@ -0,0 +1,30 @@ +opam-version: "2.0" +maintainer: "martin@mjambon.com" +authors: "Martin Jambon" +license: "BSD-3-Clause" +homepage: "http://mjambon.com/cppo.html" +doc: "https://ocaml-community.github.io/cppo/" +bug-reports: "https://github.com/ocaml-community/cppo/issues" +depends: [ + "ocaml" {>= "4.03"} + "dune" {build & >= "1.0"} + "base-unix" +] +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +dev-repo: "git+https://github.com/ocaml-community/cppo.git" +synopsis: "Code preprocessor like cpp for OCaml" +description: """ +Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain +""" diff --git a/cppo_ocamlbuild.opam b/cppo_ocamlbuild.opam new file mode 100644 index 0000000..a81a6a8 --- /dev/null +++ b/cppo_ocamlbuild.opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "martin@mjambon.com" +authors: "Martin Jambon" +license: "BSD-3-Clause" +homepage: "http://mjambon.com/cppo.html" +doc: "https://ocaml-community.github.io/cppo/" +bug-reports: "https://github.com/ocaml-community/cppo/issues" +depends: [ + "ocaml" + "dune" {build & >= "1.0"} + "ocamlbuild" +] +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +dev-repo: "git+https://github.com/ocaml-community/cppo.git" +synopsis: "Plugin to use cppo with ocamlbuild" +description: """ +This ocamlbuild plugin lets you use cppo in ocamlbuild projects. + +To use it, you can call ocamlbuild with the argument `-plugin-tag +package(cppo_ocamlbuild)` (only since ocaml 4.01 and cppo >= 0.9.4). +""" diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..902539e --- /dev/null +++ b/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.0) +(name cppo) diff --git a/examples/Makefile b/examples/Makefile new file mode 100644 index 0000000..f9dd33f --- /dev/null +++ b/examples/Makefile @@ -0,0 +1,8 @@ +.PHONY: all clean +all: + ../cppo debug.ml > debug.out + ../cppo french.ml > french.out + ocamllex lexer.mll + ../cppo lexer.ml > lexer.out +clean: + rm -f *.out lexer.ml diff --git a/examples/debug.ml b/examples/debug.ml new file mode 100644 index 0000000..d47b512 --- /dev/null +++ b/examples/debug.ml @@ -0,0 +1,7 @@ +#ifdef DEBUG +#define debug(s) Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s +#else +#define debug(s) () +#endif + +debug("test") diff --git a/examples/dune b/examples/dune new file mode 100644 index 0000000..f4d9de7 --- /dev/null +++ b/examples/dune @@ -0,0 +1,32 @@ +(ocamllex lexer) + +(rule + (deps + (:< debug.ml)) + (targets debug.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (deps + (:< french.ml)) + (targets french.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (deps + (:< lexer.ml)) + (targets lexer.out) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(alias + (name DEFAULT) + (deps debug.out french.out lexer.out)) diff --git a/examples/french.ml b/examples/french.ml new file mode 100644 index 0000000..e173a1f --- /dev/null +++ b/examples/french.ml @@ -0,0 +1,34 @@ +#define soit let +#define fonction function +#define fon fun +#define dans in +#define si if +#define alors then +#define sinon else + +#define Liste List +#define Affichef Printf +#define affichef printf + +#define separation split +#define tri sort + +soit rec separation x = fonction + y :: l -> + soit l1, l2 = separation x l dans + si y < x alors (y :: l1), l2 + sinon l1, (y :: l2) + | [] -> + [], [] + +soit rec tri = fonction + x :: l -> + soit l1, l2 = separation x l dans + tri l1 @ [x] @ tri l2 + | [] -> + [] + +soit () = + soit l = tri [ 5; 3; 7; 1; 7; 4; 99; 22 ] dans + Liste.iter (fon i -> Affichef.affichef "%i " i) l; + Affichef.affichef "\n" diff --git a/examples/lexer.mll b/examples/lexer.mll new file mode 100644 index 0000000..446e8ee --- /dev/null +++ b/examples/lexer.mll @@ -0,0 +1,9 @@ +(* Warning: ocamllex doesn't accept cppo directives + within the rules section. *) +rule token = parse + ['a'-'z']+ { `String (Lexing.lexeme lexbuf) } +{ +#ifndef NOFOO + let foo () = () +#endif +} diff --git a/ocamlbuild_plugin/_tags b/ocamlbuild_plugin/_tags new file mode 100644 index 0000000..dc946a1 --- /dev/null +++ b/ocamlbuild_plugin/_tags @@ -0,0 +1 @@ +true: package(ocamlbuild) diff --git a/ocamlbuild_plugin/dune b/ocamlbuild_plugin/dune new file mode 100644 index 0000000..b512a12 --- /dev/null +++ b/ocamlbuild_plugin/dune @@ -0,0 +1,6 @@ +(library + (name cppo_ocamlbuild) + (public_name cppo_ocamlbuild) + (wrapped false) + (synopsis "Cppo ocamlbuild plugin") + (libraries ocamlbuild)) diff --git a/ocamlbuild_plugin/ocamlbuild_cppo.ml b/ocamlbuild_plugin/ocamlbuild_cppo.ml new file mode 100644 index 0000000..f301c36 --- /dev/null +++ b/ocamlbuild_plugin/ocamlbuild_cppo.ml @@ -0,0 +1,35 @@ + +open Ocamlbuild_plugin + +let cppo_rules ext = + let dep = "%(name).cppo"-.-ext + and prod1 = "%(name: <*> and not <*.cppo>)"-.-ext + and prod2 = "%(name: <**/*> and not <**/*.cppo>)"-.-ext in + let cppo_rule prod env _build = + let dep = env dep in + let prod = env prod in + let tags = tags_of_pathname prod ++ "cppo" in + Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ]) + in + rule ("cppo: *.cppo."-.-ext^" -> *."-.-ext) ~dep ~prod:prod1 (cppo_rule prod1); + rule ("cppo: **/*.cppo."-.-ext^" -> **/*."-.-ext) ~dep ~prod:prod2 (cppo_rule prod2) + +let dispatcher = function + | After_rules -> begin + List.iter cppo_rules ["ml"; "mli"; "mlpack"]; + pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ; + pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ; + pflag ["cppo"] "cppo_I" (fun s -> + if Pathname.is_directory s then S [A "-I"; P s] + else S [A "-I"; P (Pathname.dirname s)] + ) ; + pdep ["cppo"] "cppo_I" (fun s -> + if Pathname.is_directory s then [] else [s]) ; + flag ["cppo"; "cppo_q"] (A "-q") ; + flag ["cppo"; "cppo_s"] (A "-s") ; + flag ["cppo"; "cppo_n"] (A "-n") ; + pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]); + pflag ["cppo"] "cppo_V" (fun s -> S [A "-V"; A s]); + flag ["cppo"; "cppo_V_OCAML"] & S [A "-V"; A ("OCAML:" ^ Sys.ocaml_version)] + end + | _ -> () diff --git a/ocamlbuild_plugin/ocamlbuild_cppo.mli b/ocamlbuild_plugin/ocamlbuild_cppo.mli new file mode 100644 index 0000000..2124358 --- /dev/null +++ b/ocamlbuild_plugin/ocamlbuild_cppo.mli @@ -0,0 +1,9 @@ + +(** [cppo_rules extension] will add rules to Ocamlbuild so that + cppo is applied to files ending in "cppo.[extension]". + + By default rules are inserted for files ending with "ml", "mli" and + "mlpack". *) +val cppo_rules : string -> unit + +val dispatcher : Ocamlbuild_plugin.hook -> unit diff --git a/src/cppo_command.ml b/src/cppo_command.ml new file mode 100644 index 0000000..5c61028 --- /dev/null +++ b/src/cppo_command.ml @@ -0,0 +1,63 @@ +open Printf + +type command_token = + [ `Text of string + | `Loc_file + | `Loc_first_line + | `Loc_last_line ] + +type command_template = command_token list + +let parse s : command_template = + let rec loop acc buf s len i = + if i >= len then + let s = Buffer.contents buf in + if s = "" then acc + else `Text s :: acc + else if i = len - 1 then ( + Buffer.add_char buf s.[i]; + `Text (Buffer.contents buf) :: acc + ) + else + let c = s.[i] in + if c = '%' then + let acc = + let s = Buffer.contents buf in + Buffer.clear buf; + if s = "" then acc + else + `Text s :: acc + in + let x = + match s.[i+1] with + 'F' -> `Loc_file + | 'B' -> `Loc_first_line + | 'E' -> `Loc_last_line + | '%' -> `Text "%" + | _ -> + failwith ( + sprintf "Invalid escape sequence in command template %S. \ + Use %%%% for a %% sign." s + ) + in + loop (x :: acc) buf s len (i + 2) + else ( + Buffer.add_char buf c; + loop acc buf s len (i + 1) + ) + in + let len = String.length s in + List.rev (loop [] (Buffer.create len) s len 0) + + +let subst (cmd : command_template) file first last = + let l = + List.map ( + function + `Text s -> s + | `Loc_file -> file + | `Loc_first_line -> string_of_int first + | `Loc_last_line -> string_of_int last + ) cmd + in + String.concat "" l diff --git a/src/cppo_command.mli b/src/cppo_command.mli new file mode 100644 index 0000000..af57d8c --- /dev/null +++ b/src/cppo_command.mli @@ -0,0 +1,11 @@ +type command_token = + [ `Text of string + | `Loc_file + | `Loc_first_line + | `Loc_last_line ] + +type command_template = command_token list + +val subst : command_template -> string -> int -> int -> string + +val parse : string -> command_template diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml new file mode 100644 index 0000000..fb3f9de --- /dev/null +++ b/src/cppo_eval.ml @@ -0,0 +1,697 @@ +open Printf + +open Cppo_types + +module S = Set.Make (String) +module M = Map.Make (String) + +let builtins = [ + "__FILE__", (fun _env -> `Special); + "__LINE__", (fun _env -> `Special); + "STRINGIFY", (fun env -> + `Defun (dummy_loc, "STRINGIFY", + ["x"], + [`Stringify (`Ident (dummy_loc, "x", None))], + env) + ); + "CONCAT", (fun env -> + `Defun (dummy_loc, "CONCAT", + ["x";"y"], + [`Concat (`Ident (dummy_loc, "x", None), + `Ident (dummy_loc, "y", None))], + env) + ); + "CAPITALIZE", (fun env -> + `Defun (dummy_loc, "CAPITALIZE", + ["x"], + [`Capitalize (`Ident (dummy_loc, "x", None))], + env) + ); + +] + +let is_reserved s = + List.exists (fun (s', _) -> s = s') builtins + +let builtin_env = + List.fold_left (fun env (s, f) -> M.add s (f env) env) M.empty builtins + +let line_directive buf pos = + let len = Buffer.length buf in + if len > 0 && Buffer.nth buf (len - 1) <> '\n' then + Buffer.add_char buf '\n'; + bprintf buf "# %i %S\n" + pos.Lexing.pos_lnum + pos.Lexing.pos_fname; + bprintf buf "%s" (String.make (pos.Lexing.pos_cnum - pos.Lexing.pos_bol) ' ') + +let rec add_sep sep last = function + [] -> [ last ] + | [x] -> [ x; last ] + | x :: l -> x :: sep :: add_sep sep last l + + +let remove_space l = + List.filter (function `Text (_, true, _) -> false | _ -> true) l + +let trim_and_compact buf s = + let started = ref false in + let need_space = ref false in + for i = 0 to String.length s - 1 do + match s.[i] with + ' ' | '\t' | '\n' | '\r' -> + if !started then + need_space := true + | c -> + if !need_space then + Buffer.add_char buf ' '; + (match c with + '\"' -> Buffer.add_string buf "\\\"" + | '\\' -> Buffer.add_string buf "\\\\" + | c -> Buffer.add_char buf c); + started := true; + need_space := false + done + +let stringify buf s = + Buffer.add_char buf '\"'; + trim_and_compact buf s; + Buffer.add_char buf '\"' + +let trim_and_compact_string s = + let buf = Buffer.create (String.length s) in + trim_and_compact buf s; + Buffer.contents buf + +let trim_compact_and_capitalize_string s = + let buf = Buffer.create (String.length s) in + trim_and_compact buf s; + String.capitalize_ascii (Buffer.contents buf) + +let is_ident s = + let len = String.length s in + len > 0 + && + (match s.[0] with + 'A'..'Z' | 'a'..'z' -> true + | '_' when len > 1 -> true + | _ -> false) + && + (try + for i = 1 to len - 1 do + match s.[i] with + 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> () + | _ -> raise Exit + done; + true + with Exit -> + false) + +let concat loc x y = + let s = trim_and_compact_string x ^ trim_and_compact_string y in + if not (s = "" || is_ident s) then + error loc + (sprintf "CONCAT() does not expand into a valid identifier nor \ + into whitespace:\n%S" s) + else + if s = "" then " " + else " " ^ s ^ " " + +(* + Expand the contents of a variable used in a boolean expression. + + Ideally, we should first completely expand the contents bound + to the variable, and then parse the result as an int or an int tuple. + This is a bit complicated to do well, and we don't want to implement + a full programming language here either. + + Instead we only accept int literals, int tuple literals, and variables that + themselves expand into one those. + + In particular: + - We do not support arithmetic operations + - We do not support tuples containing variables such as (x, y) + + Example of contents that we support: + - 123 + - (1, 2, 3) + - x, where x expands into 123. +*) +let rec eval_ident env loc name = + let l = + try + match M.find name env with + | `Def (_, _, l, _) -> l + | `Defun _ -> + error loc (sprintf "%S expects arguments" name) + | `Special -> assert false + with Not_found -> error loc (sprintf "Undefined identifier %S" name) + in + let expansion_error () = + error loc + (sprintf "\ +Variable %s found in cppo boolean expression must expand +into an int literal, into a tuple of int literals, +or into a variable with the same properties." + name) + in + (try + match remove_space l with + [ `Ident (loc, name, None) ] -> + (* single identifier that we expand recursively *) + eval_ident env loc name + | _ -> + (* int literal or int tuple literal; variables not allowed *) + let text = + List.map ( + function + `Text (_, _is_space, s) -> s + | _ -> + expansion_error () + ) (Cppo_types.flatten_nodes l) + in + let s = String.concat "" text in + (match Cppo_lexer.int_tuple_of_string s with + Some [i] -> `Int i + | Some l -> `Tuple (loc, List.map (fun i -> `Int i) l) + | None -> + expansion_error () + ) + with Cppo_error _ -> + expansion_error () + ) + +let rec replace_idents env (x : arith_expr) : arith_expr = + match x with + | `Ident (loc, name) -> eval_ident env loc name + + | `Int x -> `Int x + | `Neg x -> `Neg (replace_idents env x) + | `Add (a, b) -> `Add (replace_idents env a, replace_idents env b) + | `Sub (a, b) -> `Sub (replace_idents env a, replace_idents env b) + | `Mul (a, b) -> `Mul (replace_idents env a, replace_idents env b) + | `Div (loc, a, b) -> `Div (loc, replace_idents env a, replace_idents env b) + | `Mod (loc, a, b) -> `Mod (loc, replace_idents env a, replace_idents env b) + | `Lnot a -> `Lnot (replace_idents env a) + | `Lsl (a, b) -> `Lsl (replace_idents env a, replace_idents env b) + | `Lsr (a, b) -> `Lsr (replace_idents env a, replace_idents env b) + | `Asr (a, b) -> `Asr (replace_idents env a, replace_idents env b) + | `Land (a, b) -> `Land (replace_idents env a, replace_idents env b) + | `Lor (a, b) -> `Lor (replace_idents env a, replace_idents env b) + | `Lxor (a, b) -> `Lxor (replace_idents env a, replace_idents env b) + | `Tuple (loc, l) -> `Tuple (loc, List.map (replace_idents env) l) + +let rec eval_int env (x : arith_expr) : int64 = + match x with + | `Ident (loc, name) -> eval_int env (eval_ident env loc name) + + | `Int x -> x + | `Neg x -> Int64.neg (eval_int env x) + | `Add (a, b) -> Int64.add (eval_int env a) (eval_int env b) + | `Sub (a, b) -> Int64.sub (eval_int env a) (eval_int env b) + | `Mul (a, b) -> Int64.mul (eval_int env a) (eval_int env b) + | `Div (loc, a, b) -> + (try Int64.div (eval_int env a) (eval_int env b) + with Division_by_zero -> + error loc "Division by zero") + + | `Mod (loc, a, b) -> + (try Int64.rem (eval_int env a) (eval_int env b) + with Division_by_zero -> + error loc "Division by zero") + + | `Lnot a -> Int64.lognot (eval_int env a) + + | `Lsl (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_left n (Int64.to_int shift) + + | `Lsr (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_right_logical n (Int64.to_int shift) + + | `Asr (a, b) -> + let n = eval_int env a in + let shift = eval_int env b in + let shift = + if shift >= 64L then 64L + else if shift <= -64L then -64L + else shift + in + Int64.shift_right n (Int64.to_int shift) + + | `Land (a, b) -> Int64.logand (eval_int env a) (eval_int env b) + | `Lor (a, b) -> Int64.logor (eval_int env a) (eval_int env b) + | `Lxor (a, b) -> Int64.logxor (eval_int env a) (eval_int env b) + | `Tuple (loc, l) -> + assert (List.length l <> 1); + error loc "Operation not supported on tuples" + +let rec compare_lists al bl = + match al, bl with + | a :: al, b :: bl -> + let c = Int64.compare a b in + if c <> 0 then c + else compare_lists al bl + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + +let compare_tuples env (a : arith_expr) (b : arith_expr) = + (* We replace the identifiers first to get a better error message + on such input: + + #define x (1, 2) + #if x >= (1, 2) + + since variables must represent a single int, not a tuple. + *) + let a = replace_idents env a in + let b = replace_idents env b in + match a, b with + | `Tuple (_, al), `Tuple (_, bl) when List.length al = List.length bl -> + let eval_list l = List.map (eval_int env) l in + compare_lists (eval_list al) (eval_list bl) + + | `Tuple (_loc1, al), `Tuple (loc2, bl) -> + error loc2 + (sprintf "Tuple of length %i cannot be compared to a tuple of length %i" + (List.length bl) (List.length al) + ) + + | `Tuple (loc, _), _ + | _, `Tuple (loc, _) -> + error loc "Tuple cannot be compared to an int" + + | a, b -> + Int64.compare (eval_int env a) (eval_int env b) + +let rec eval_bool env (x : bool_expr) = + match x with + `True -> true + | `False -> false + | `Defined s -> M.mem s env + | `Not x -> not (eval_bool env x) + | `And (a, b) -> eval_bool env a && eval_bool env b + | `Or (a, b) -> eval_bool env a || eval_bool env b + | `Eq (a, b) -> compare_tuples env a b = 0 + | `Lt (a, b) -> compare_tuples env a b < 0 + | `Gt (a, b) -> compare_tuples env a b > 0 + + +type globals = { + call_loc : Cppo_types.loc; + (* location used to set the value of + __FILE__ and __LINE__ global variables *) + + mutable buf : Buffer.t; + (* buffer where the output is written *) + + included : S.t; + (* set of already-included files *) + + require_location : bool ref; + (* whether a line directive should be printed before outputting the next + token *) + + show_exact_locations : bool; + (* whether line directives should be printed even for expanded macro + bodies *) + + enable_loc : bool ref; + (* whether line directives should be printed *) + + g_preserve_quotations : bool; + (* identify and preserve camlp4 quotations *) + + incdirs : string list; + (* directories for finding included files *) + + current_directory : string; + (* directory containing the current file *) + + extensions : (string, Cppo_command.command_template) Hashtbl.t; + (* mapping from extension ID to pipeline command *) +} + + + +let parse ~preserve_quotations file lexbuf = + let lexer_env = Cppo_lexer.init ~preserve_quotations file lexbuf in + try + Cppo_parser.main (Cppo_lexer.line lexer_env) lexbuf + with + Parsing.Parse_error -> + error (Cppo_lexer.loc lexbuf) "syntax error" + | Cppo_types.Cppo_error _ as e -> + raise e + | e -> + error (Cppo_lexer.loc lexbuf) (Printexc.to_string e) + +let plural n = + if abs n <= 1 then "" + else "s" + + +let maybe_print_location g pos = + if !(g.enable_loc) then + if !(g.require_location) then ( + line_directive g.buf pos + ) + +let expand_ext g loc id data = + let cmd_tpl = + try Hashtbl.find g.extensions id + with Not_found -> + error loc (sprintf "Undefined extension %s" id) + in + let p1, p2 = loc in + let file = p1.Lexing.pos_fname in + let first = p1.Lexing.pos_lnum in + let last = p2.Lexing.pos_lnum in + let cmd = Cppo_command.subst cmd_tpl file first last in + Unix.putenv "CPPO_FILE" file; + Unix.putenv "CPPO_FIRST_LINE" (string_of_int first); + Unix.putenv "CPPO_LAST_LINE" (string_of_int last); + let (ic, oc) as p = Unix.open_process cmd in + output_string oc data; + close_out oc; + (try + while true do + bprintf g.buf "%s\n" (input_line ic) + done + with End_of_file -> () + ); + match Unix.close_process p with + Unix.WEXITED 0 -> () + | Unix.WEXITED n -> + failwith (sprintf "Command %S exited with status %i" cmd n) + | _ -> + failwith (sprintf "Command %S failed" cmd) + +let rec include_file g loc rel_file env = + let file = + if not (Filename.is_relative rel_file) then + if Sys.file_exists rel_file then + rel_file + else + error loc (sprintf "Included file %S does not exist" rel_file) + else + try + let dir = + List.find ( + fun dir -> + let file = Filename.concat dir rel_file in + Sys.file_exists file + ) (g.current_directory :: g.incdirs) + in + if dir = Filename.current_dir_name then + rel_file + else + Filename.concat dir rel_file + with Not_found -> + error loc (sprintf "Cannot find included file %S" rel_file) + in + if S.mem file g.included then + failwith (sprintf "Cyclic inclusion of file %S" file) + else + let ic = open_in file in + let lexbuf = Lexing.from_channel ic in + let l = parse ~preserve_quotations:g.g_preserve_quotations file lexbuf in + close_in ic; + expand_list { g with + included = S.add file g.included; + current_directory = Filename.dirname file + } env l + +and expand_list ?(top = false) g env l = + List.fold_left (expand_node ~top g) env l + +and expand_node ?(top = false) g env0 (x : node) = + match x with + `Ident (loc, name, opt_args) -> + + let def = + try Some (M.find name env0) + with Not_found -> None + in + let g = + if top && def <> None || g.call_loc == dummy_loc then + { g with call_loc = loc } + else g + in + + let enable_loc0 = !(g.enable_loc) in + + if def <> None then ( + g.require_location := true; + + if not g.show_exact_locations then ( + (* error reports will point more or less to the point + where the code is included rather than the source location + of the macro definition *) + maybe_print_location g (fst loc); + g.enable_loc := false + ) + ); + + let env = + match def, opt_args with + None, None -> + expand_node g env0 (`Text (loc, false, name)) + | None, Some args -> + let with_sep = + add_sep + [`Text (loc, false, ",")] + [`Text (loc, false, ")")] + args in + let l = + `Text (loc, false, name ^ "(") :: List.flatten with_sep in + expand_list g env0 l + + | Some (`Defun (_, _, arg_names, _, _)), None -> + error loc + (sprintf "%S expects %i arguments but is applied to none." + name (List.length arg_names)) + + | Some (`Def _), Some _ -> + error loc + (sprintf "%S expects no arguments" name) + + | Some (`Def (_, _, l, env)), None -> + ignore (expand_list g env l); + env0 + + | Some (`Defun (_, _, arg_names, l, env)), Some args -> + let argc = List.length arg_names in + let n = List.length args in + let args = + (* it's ok to pass an empty arg if one arg + is expected *) + if n = 0 && argc = 1 then [[]] + else args + in + if argc <> n then + error loc + (sprintf "%S expects %i argument%s but is applied to \ + %i argument%s." + name argc (plural argc) n (plural n)) + else + let app_env = + List.fold_left2 ( + fun env name l -> + M.add name (`Def (loc, name, l, env0)) env + ) env arg_names args + in + ignore (expand_list g app_env l); + env0 + + | Some `Special, _ -> assert false + in + + if def = None then + g.require_location := false + else + g.require_location := true; + + (* restore initial setting *) + g.enable_loc := enable_loc0; + + env + + + | `Def (loc, name, body)-> + g.require_location := true; + if M.mem name env0 then + error loc (sprintf "%S is already defined" name) + else + M.add name (`Def (loc, name, body, env0)) env0 + + | `Defun (loc, name, arg_names, body) -> + g.require_location := true; + if M.mem name env0 then + error loc (sprintf "%S is already defined" name) + else + M.add name (`Defun (loc, name, arg_names, body, env0)) env0 + + | `Undef (loc, name) -> + g.require_location := true; + if is_reserved name then + error loc + (sprintf "%S is a built-in variable that cannot be undefined" name) + else + M.remove name env0 + + | `Include (loc, file) -> + g.require_location := true; + let env = include_file g loc file env0 in + g.require_location := true; + env + + | `Ext (loc, id, data) -> + g.require_location := true; + expand_ext g loc id data; + g.require_location := true; + env0 + + | `Cond (_loc, test, if_true, if_false) -> + let l = + if eval_bool env0 test then if_true + else if_false + in + g.require_location := true; + let env = expand_list g env0 l in + g.require_location := true; + env + + | `Error (loc, msg) -> + error loc msg + + | `Warning (loc, msg) -> + warning loc msg; + env0 + + | `Text (loc, is_space, s) -> + if not is_space then ( + maybe_print_location g (fst loc); + g.require_location := false + ); + Buffer.add_string g.buf s; + env0 + + | `Seq l -> + expand_list g env0 l + + | `Stringify x -> + let enable_loc0 = !(g.enable_loc) in + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + stringify buf0 (Buffer.contents local_buf); + g.buf <- buf0; + g.enable_loc := enable_loc0; + env0 + + | `Capitalize (x : node) -> + let enable_loc0 = !(g.enable_loc) in + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + let xs = Buffer.contents local_buf in + let s = trim_compact_and_capitalize_string xs in + (* stringify buf0 (Buffer.contents local_buf); *) + Buffer.add_string buf0 s ; + g.buf <- buf0; + g.enable_loc := enable_loc0; + env0 + | `Concat (x, y) -> + let enable_loc0 = !(g.enable_loc) in + g.enable_loc := false; + let buf0 = g.buf in + let local_buf = Buffer.create 100 in + g.buf <- local_buf; + ignore (expand_node g env0 x); + let xs = Buffer.contents local_buf in + Buffer.clear local_buf; + ignore (expand_node g env0 y); + let ys = Buffer.contents local_buf in + let s = concat g.call_loc xs ys in + Buffer.add_string buf0 s; + g.buf <- buf0; + g.enable_loc := enable_loc0; + env0 + + | `Line (loc, opt_file, n) -> + (* printing a line directive is not strictly needed *) + (match opt_file with + None -> + maybe_print_location g (fst loc); + bprintf g.buf "\n# %i\n" n + | Some file -> + bprintf g.buf "\n# %i %S\n" n file + ); + (* printing the location next time is needed because it just changed *) + g.require_location := true; + env0 + + | `Current_line loc -> + maybe_print_location g (fst loc); + g.require_location := true; + let pos, _ = g.call_loc in + bprintf g.buf " %i " pos.Lexing.pos_lnum; + env0 + + | `Current_file loc -> + maybe_print_location g (fst loc); + g.require_location := true; + let pos, _ = g.call_loc in + bprintf g.buf " %S " pos.Lexing.pos_fname; + env0 + + + + +let include_inputs + ~extensions + ~preserve_quotations + ~incdirs + ~show_exact_locations + ~show_no_locations + buf env l = + + let enable_loc = not show_no_locations in + List.fold_left ( + fun env (dir, file, open_, close) -> + let l = parse ~preserve_quotations file (open_ ()) in + close (); + let g = { + call_loc = dummy_loc; + buf = buf; + included = S.empty; + require_location = ref true; + show_exact_locations = show_exact_locations; + enable_loc = ref enable_loc; + g_preserve_quotations = preserve_quotations; + incdirs = incdirs; + current_directory = dir; + extensions = extensions; + } + in + expand_list ~top:true { g with included = S.add file g.included } env l + ) env l diff --git a/src/cppo_eval.mli b/src/cppo_eval.mli new file mode 100644 index 0000000..d4302f0 --- /dev/null +++ b/src/cppo_eval.mli @@ -0,0 +1,29 @@ +(** The type signatures in this module are not yet for public consumption. + + Please don't rely on them in any way.*) + +module S : Set.S with type elt = string +module M : Map.S with type key = string + +val builtin_env + : [> `Defun of + Cppo_types.loc * string * string list * + [> `Capitalize of Cppo_types.node + | `Concat of (Cppo_types.node * Cppo_types.node) + | `Stringify of Cppo_types.node ] list * 'a + | `Special ] M.t as 'a + +val include_inputs + : extensions:(string, Cppo_command.command_template) Hashtbl.t + -> preserve_quotations:bool + -> incdirs:string list + -> show_exact_locations:bool + -> show_no_locations:bool + -> Buffer.t + -> (([< `Def of Cppo_types.loc * string * Cppo_types.node list * 'a + | `Defun of Cppo_types.loc * string * string list * Cppo_types.node list * 'a + | `Special + > `Def `Defun ] + as 'b) + M.t as 'a) + -> (string * string * (unit -> Lexing.lexbuf) * (unit -> unit)) list -> 'a diff --git a/src/cppo_lexer.mll b/src/cppo_lexer.mll new file mode 100644 index 0000000..93ae901 --- /dev/null +++ b/src/cppo_lexer.mll @@ -0,0 +1,721 @@ +{ +open Printf +open Lexing + +open Cppo_types +open Cppo_parser + +let pos1 lexbuf = lexbuf.lex_start_p +let pos2 lexbuf = lexbuf.lex_curr_p +let loc lexbuf = (pos1 lexbuf, pos2 lexbuf) + +let lexer_error lexbuf descr = + error (loc lexbuf) descr + +let new_file lb name = + lb.lex_curr_p <- { lb.lex_curr_p with pos_fname = name } + +let lex_new_lines lb = + let n = ref 0 in + let s = lb.lex_buffer in + for i = lb.lex_start_pos to lb.lex_curr_pos do + if Bytes.get s i = '\n' then + incr n + done; + let p = lb.lex_curr_p in + lb.lex_curr_p <- + { p with + pos_lnum = p.pos_lnum + !n; + pos_bol = p.pos_cnum + } + +let count_new_lines lb n = + let p = lb.lex_curr_p in + lb.lex_curr_p <- + { p with + pos_lnum = p.pos_lnum + n; + pos_bol = p.pos_cnum + } + +(* must start a new line *) +let update_pos lb p added_chars added_breaks = + let cnum = p.pos_cnum + added_chars in + lb.lex_curr_p <- + { pos_fname = p.pos_fname; + pos_lnum = p.pos_lnum + added_breaks; + pos_bol = cnum; + pos_cnum = cnum } + +let set_lnum lb opt_file lnum = + let p = lb.lex_curr_p in + let cnum = p.pos_cnum in + let fname = + match opt_file with + None -> p.pos_fname + | Some file -> file + in + lb.lex_curr_p <- + { pos_fname = fname; + pos_bol = cnum; + pos_cnum = cnum; + pos_lnum = lnum } + +let shift lb n = + let p = lb.lex_curr_p in + lb.lex_curr_p <- { p with pos_cnum = p.pos_cnum + n } + +let read_hexdigit c = + match c with + '0'..'9' -> Char.code c - 48 + | 'A'..'F' -> Char.code c - 55 + | 'a'..'z' -> Char.code c - 87 + | _ -> invalid_arg "read_hexdigit" + +let read_hex2 c1 c2 = + Char.chr (read_hexdigit c1 * 16 + read_hexdigit c2) + +type env = { + preserve_quotations : bool; + mutable lexer : [ `Ocaml | `Test ]; + mutable line_start : bool; + mutable in_directive : bool; (* true while processing a directive, until the + final newline *) + buf : Buffer.t; + mutable token_start : Lexing.position; + lexbuf : Lexing.lexbuf; +} + +let new_line env = + env.line_start <- true; + count_new_lines env.lexbuf 1 + +let clear env = Buffer.clear env.buf + +let add env s = + env.line_start <- false; + Buffer.add_string env.buf s + +let add_char env c = + env.line_start <- false; + Buffer.add_char env.buf c + +let get env = Buffer.contents env.buf + +let long_loc e = (e.token_start, pos2 e.lexbuf) + +let cppo_directives = [ + "define"; + "elif"; + "else"; + "endif"; + "error"; + "if"; + "ifdef"; + "ifndef"; + "include"; + "undef"; + "warning"; +] + +let is_reserved_directive = + let tbl = Hashtbl.create 20 in + List.iter (fun s -> Hashtbl.add tbl s ()) cppo_directives; + fun s -> Hashtbl.mem tbl s + +} + +(* standard character classes used for macro identifiers *) +let upper = ['A'-'Z'] +let lower = ['a'-'z'] +let digit = ['0'-'9'] + +let identchar = upper | lower | digit | [ '_' '\'' ] + + +(* iso-8859-1 upper and lower characters used for ocaml identifiers *) +let oc_upper = ['A'-'Z' '\192'-'\214' '\216'-'\222'] +let oc_lower = ['a'-'z' '\223'-'\246' '\248'-'\255'] +let oc_identchar = oc_upper | oc_lower | digit | ['_' '\''] + +(* + Identifiers: ident is used for macro names and is a subset of oc_ident +*) +let ident = (lower | '_' identchar | upper) identchar* +let oc_ident = (oc_lower | '_' oc_identchar | oc_upper) oc_identchar* + + + +let hex = ['0'-'9' 'a'-'f' 'A'-'F'] +let oct = ['0'-'7'] +let bin = ['0'-'1'] + +let operator_char = + [ '!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let infix_symbol = + ['=' '<' '>' '@' '^' '|' '&' '+' '-' '*' '/' '$' '%'] operator_char* +let prefix_symbol = ['!' '?' '~'] operator_char* + +let blank = [ ' ' '\t' ] +let space = [ ' ' '\t' '\r' '\n' ] + +let line = ( [^'\n'] | '\\' ('\r'? '\n') )* ('\n' | eof) + +let dblank0 = (blank | '\\' '\r'? '\n')* +let dblank1 = blank (blank | '\\' '\r'? '\n')* + +rule token e = parse + "" + { + (* + We use two different lexers for boolean expressions in #if directives + and for regular OCaml tokens. + *) + match e.lexer with + `Ocaml -> ocaml_token e lexbuf + | `Test -> test_token e lexbuf + } + +and line e = parse + blank* "#" as s + { + match e.lexer with + `Test -> lexer_error lexbuf "Syntax error in boolean expression" + | `Ocaml -> + if e.line_start then ( + e.in_directive <- true; + clear e; + add e s; + e.token_start <- pos1 lexbuf; + e.line_start <- false; + directive e lexbuf + ) + else ( + e.line_start <- false; + clear e; + TEXT (loc lexbuf, false, s) + ) + } + + | "" { clear e; + token e lexbuf } + +and directive e = parse + blank* "define" dblank1 (ident as id) "(" + { DEFUN (long_loc e, id) } + + | blank* "define" dblank1 (ident as id) + { assert e.in_directive; + DEF (long_loc e, id) } + + | blank* "undef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + UNDEF (long_loc e, id) } + + | blank* "if" dblank1 { e.lexer <- `Test; + IF (long_loc e) } + | blank* "elif" dblank1 { e.lexer <- `Test; + ELIF (long_loc e) } + + | blank* "ifdef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + IFDEF (long_loc e, `Defined id) } + + | blank* "ifndef" dblank1 (ident as id) + { blank_until_eol e lexbuf; + IFDEF (long_loc e, `Not (`Defined id)) } + + | blank* "ext" dblank1 (ident as id) + { blank_until_eol e lexbuf; + clear e; + let s = read_ext e lexbuf in + EXT (long_loc e, id, s) } + + | blank* "define" dblank1 oc_ident + | blank* "undef" dblank1 oc_ident + | blank* "ifdef" dblank1 oc_ident + | blank* "ifndef" dblank1 oc_ident + | blank* "ext" dblank1 oc_ident + { error (loc lexbuf) + "Identifiers containing non-ASCII characters \ + may not be used as macro identifiers" } + + | blank* "else" + { blank_until_eol e lexbuf; + ELSE (long_loc e) } + + | blank* "endif" + { blank_until_eol e lexbuf; + ENDIF (long_loc e) } + + | blank* "include" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + INCLUDE (long_loc e, get e) } + + | blank* "error" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + ERROR (long_loc e, get e) } + + | blank* "warning" dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + WARNING (long_loc e, get e) } + + | blank* (['0'-'9']+ as lnum) dblank0 '\r'? '\n' + { e.in_directive <- false; + new_line e; + let here = long_loc e in + let fname = None in + let lnum = int_of_string lnum in + (* Apply line directive regardless of possible #if condition. *) + set_lnum lexbuf fname lnum; + LINE (here, None, lnum) } + + | blank* (['0'-'9']+ as lnum) dblank0 '"' + { clear e; + eval_string e lexbuf; + blank_until_eol e lexbuf; + let here = long_loc e in + let fname = Some (get e) in + let lnum = int_of_string lnum in + (* Apply line directive regardless of possible #if condition. *) + set_lnum lexbuf fname lnum; + LINE (here, fname, lnum) } + + | blank* + { e.in_directive <- false; + add e (lexeme lexbuf); + TEXT (long_loc e, true, get e) } + + | blank* (['a'-'z']+ as s) + { if is_reserved_directive s then + error (loc lexbuf) "cppo directive with missing or wrong arguments"; + e.in_directive <- false; + add e (lexeme lexbuf); + TEXT (long_loc e, false, get e) } + + +and blank_until_eol e = parse + blank* eof + | blank* '\r'? '\n' { new_line e; + e.in_directive <- false } + | "" { lexer_error lexbuf "syntax error in directive" } + +and read_ext e = parse + blank* "#" blank* "endext" blank* ('\r'? '\n' | eof) + { let s = get e in + clear e; + new_line e; + e.in_directive <- false; + s } + + | (blank* as a) "\\" ("#" blank* "endext" blank* '\r'? '\n' as b) + { add e a; + add e b; + new_line e; + read_ext e lexbuf } + + | [^'\n']* '\n' as x + { add e x; + new_line e; + read_ext e lexbuf } + + | eof + { lexer_error lexbuf "End of file within #ext ... #endext" } + +and ocaml_token e = parse + "__LINE__" + { e.line_start <- false; + CURRENT_LINE (loc lexbuf) } + + | "__FILE__" + { e.line_start <- false; + CURRENT_FILE (loc lexbuf) } + + | ident as s + { e.line_start <- false; + IDENT (loc lexbuf, s) } + + | oc_ident as s + { e.line_start <- false; + TEXT (loc lexbuf, false, s) } + + | ident as s "(" + { e.line_start <- false; + FUNIDENT (loc lexbuf, s) } + + | "'\n'" + | "'\r\n'" + { new_line e; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | "(" { e.line_start <- false; OP_PAREN (loc lexbuf) } + | ")" { e.line_start <- false; CL_PAREN (loc lexbuf) } + | "," { e.line_start <- false; COMMA (loc lexbuf) } + + | "\\)" { e.line_start <- false; TEXT (loc lexbuf, false, " )") } + | "\\," { e.line_start <- false; TEXT (loc lexbuf, false, " ,") } + | "\\(" { e.line_start <- false; TEXT (loc lexbuf, false, " (") } + | "\\#" { e.line_start <- false; TEXT (loc lexbuf, false, " #") } + + | '`' + | "!=" | "#" | "&" | "&&" | "(" | "*" | "+" | "-" + | "-." | "->" | "." | ".. :" | "::" | ":=" | ":>" | ";" | ";;" | "<" + | "<-" | "=" | ">" | ">]" | ">}" | "?" | "??" | "[" | "[<" | "[>" | "[|" + | "]" | "_" | "`" | "{" | "{<" | "|" | "|]" | "}" | "~" + | ">>" + | prefix_symbol + | infix_symbol + | "'" ([^ '\'' '\\'] + | '\\' (_ | digit digit digit | 'x' hex hex)) "'" + + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | blank+ + { TEXT (loc lexbuf, true, lexeme lexbuf) } + + | '\\' ('\r'? '\n' as nl) + + { + new_line e; + if e.in_directive then + TEXT (loc lexbuf, true, nl) + else + TEXT (loc lexbuf, false, lexeme lexbuf) + } + + | '\r'? '\n' + { + new_line e; + if e.in_directive then ( + e.in_directive <- false; + ENDEF (loc lexbuf) + ) + else + TEXT (loc lexbuf, true, lexeme lexbuf) + } + + | "(*" + { clear e; + add e "(*"; + e.token_start <- pos1 lexbuf; + comment (loc lexbuf) e 1 lexbuf } + + | '"' + { clear e; + add e "\""; + e.token_start <- pos1 lexbuf; + string e lexbuf; + e.line_start <- false; + TEXT (long_loc e, false, get e) } + + | "<:" + | "<<" + { if e.preserve_quotations then ( + clear e; + add e (lexeme lexbuf); + e.token_start <- pos1 lexbuf; + quotation e lexbuf; + e.line_start <- false; + TEXT (long_loc e, false, get e) + ) + else ( + e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) + ) + } + + + | '-'? ( digit (digit | '_')* + | ("0x"| "0X") hex (hex | '_')* + | ("0o"| "0O") oct (oct | '_')* + | ("0b"| "0B") bin (bin | '_')* ) + + | '-'? digit (digit | '_')* ('.' (digit | '_')* )? + (['e' 'E'] ['+' '-']? digit (digit | '_')* )? + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | blank+ + { TEXT (loc lexbuf, true, lexeme lexbuf) } + + | _ + { e.line_start <- false; + TEXT (loc lexbuf, false, lexeme lexbuf) } + + | eof + { EOF } + + +and comment startloc e depth = parse + "(*" + { add e "(*"; + comment startloc e (depth + 1) lexbuf } + + | "*)" + { let depth = depth - 1 in + add e "*)"; + if depth > 0 then + comment startloc e depth lexbuf + else ( + e.line_start <- false; + TEXT (long_loc e, false, get e) + ) + } + | '"' + { add_char e '"'; + string e lexbuf; + comment startloc e depth lexbuf } + + | "'\n'" + | "'\r\n'" + { new_line e; + add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | "'" ([^ '\'' '\\'] + | '\\' (_ | digit digit digit | 'x' hex hex)) "'" + { add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | '\r'? '\n' + { + new_line e; + add e (lexeme lexbuf); + comment startloc e depth lexbuf + } + + | [^'(' '*' '"' '\'' '\r' '\n']+ + { + add e (lexeme lexbuf); + comment startloc e depth lexbuf + } + + | _ + { add e (lexeme lexbuf); + comment startloc e depth lexbuf } + + | eof + { error startloc "Unterminated comment reaching the end of file" } + + +and string e = parse + '"' + { add_char e '"' } + + | "\\\\" + | '\\' '"' + { add e (lexeme lexbuf); + string e lexbuf } + + | '\\' '\r'? '\n' + { + add e (lexeme lexbuf); + new_line e; + string e lexbuf + } + + | '\r'? '\n' + { + if e.in_directive then + lexer_error lexbuf "Unterminated string literal" + else ( + add e (lexeme lexbuf); + new_line e; + string e lexbuf + ) + } + + | _ as c + { add_char e c; + string e lexbuf } + + | eof + { } + + +and eval_string e = parse + '"' + { } + + | '\\' (['\'' '\"' '\\'] as c) + { add_char e c; + eval_string e lexbuf } + + | '\\' '\r'? '\n' + { assert e.in_directive; + eval_string e lexbuf } + + | '\r'? '\n' + { assert e.in_directive; + lexer_error lexbuf "Unterminated string literal" } + + | '\\' (digit digit digit as s) + { add_char e (Char.chr (int_of_string s)); + eval_string e lexbuf } + + | '\\' 'x' (hex as c1) (hex as c2) + { add_char e (read_hex2 c1 c2); + eval_string e lexbuf } + + | '\\' 'b' + { add_char e '\b'; + eval_string e lexbuf } + + | '\\' 'n' + { add_char e '\n'; + eval_string e lexbuf } + + | '\\' 'r' + { add_char e '\r'; + eval_string e lexbuf } + + | '\\' 't' + { add_char e '\t'; + eval_string e lexbuf } + + | [^ '\"' '\\']+ + { add e (lexeme lexbuf); + eval_string e lexbuf } + + | eof + { lexer_error lexbuf "Unterminated string literal" } + + +and quotation e = parse + ">>" + { add e ">>" } + + | "\\>>" + { add e "\\>>"; + quotation e lexbuf } + + | '\\' '\r'? '\n' + { + if e.in_directive then ( + new_line e; + quotation e lexbuf + ) + else ( + add e (lexeme lexbuf); + new_line e; + quotation e lexbuf + ) + } + + | '\r'? '\n' + { + if e.in_directive then + lexer_error lexbuf "Unterminated quotation" + else ( + add e (lexeme lexbuf); + new_line e; + quotation e lexbuf + ) + } + + | [^'>' '\\' '\r' '\n']+ + { add e (lexeme lexbuf); + quotation e lexbuf } + + | eof + { lexer_error lexbuf "Unterminated quotation" } + +and test_token e = parse + "true" { TRUE } + | "false" { FALSE } + | "defined" { DEFINED } + | "(" { OP_PAREN (loc lexbuf) } + | ")" { CL_PAREN (loc lexbuf) } + | "&&" { AND } + | "||" { OR } + | "not" { NOT } + | "=" { EQ } + | "<" { LT } + | ">" { GT } + | "<>" { NE } + | "<=" { LE } + | ">=" { GE } + + | '-'? ( digit (digit | '_')* + | ("0x"| "0X") hex (hex | '_')* + | ("0o"| "0O") oct (oct | '_')* + | ("0b"| "0B") bin (bin | '_')* ) + { let s = Lexing.lexeme lexbuf in + try INT (Int64.of_string s) + with _ -> + error (loc lexbuf) + (sprintf "Integer constant %s is out the valid range for int64" s) + } + + | "+" { PLUS } + | "-" { MINUS } + | "*" { STAR } + | "/" { SLASH (loc lexbuf) } + | "mod" { MOD (loc lexbuf) } + | "lsl" { LSL } + | "lsr" { LSR } + | "asr" { ASR } + | "land" { LAND } + | "lor" { LOR } + | "lxor" { LXOR } + | "lnot" { LNOT } + + | "," { COMMA (loc lexbuf) } + + | ident + { IDENT (loc lexbuf, lexeme lexbuf) } + + | blank+ { test_token e lexbuf } + | '\\' '\r'? '\n' { new_line e; + test_token e lexbuf } + | '\r'? '\n' + | eof { assert e.in_directive; + e.in_directive <- false; + new_line e; + e.lexer <- `Ocaml; + ENDTEST (loc lexbuf) } + | _ { error (loc lexbuf) + (sprintf "Invalid token %s" (Lexing.lexeme lexbuf)) } + + +(* Parse just an int or a tuple of ints *) +and int_tuple = parse + | space* (([^'(']#space)+ as s) space* eof + { [Int64.of_string s] } + + | space* "(" { int_tuple_content lexbuf } + + | eof | _ { failwith "Not an int nor a tuple" } + +and int_tuple_content = parse + | space* (([^',' ')']#space)+ as s) space* "," + { let x = Int64.of_string s in + x :: int_tuple_content lexbuf } + + | space* (([^',' ')']#space)+ as s) space* ")" space* eof + { [Int64.of_string s] } + + +{ + let init ~preserve_quotations file lexbuf = + new_file lexbuf file; + { + preserve_quotations = preserve_quotations; + lexer = `Ocaml; + line_start = true; + in_directive = false; + buf = Buffer.create 200; + token_start = Lexing.dummy_pos; + lexbuf = lexbuf; + } + + let int_tuple_of_string s = + try Some (int_tuple (Lexing.from_string s)) + with _ -> None +} diff --git a/src/cppo_main.ml b/src/cppo_main.ml new file mode 100644 index 0000000..22792b3 --- /dev/null +++ b/src/cppo_main.ml @@ -0,0 +1,226 @@ +open Printf + +let add_extension tbl s = + let i = + try String.index s ':' + with Not_found -> + failwith "Invalid -x argument" + in + let id = String.sub s 0 i in + let raw_tpl = String.sub s (i+1) (String.length s - i - 1) in + let cmd_tpl = Cppo_command.parse raw_tpl in + if Hashtbl.mem tbl id then + failwith ("Multiple definitions for extension " ^ id) + else + Hashtbl.add tbl id cmd_tpl + +let semver_re = Str.regexp "\ +\\([0-9]+\\)\ +\\.\\([0-9]+\\)\ +\\.\\([0-9]+\\)\ +\\(-\\([^+]*\\)\\)?\ +\\(\\+\\(.*\\)\\)?\ +\r?$" + +let parse_semver s = + if not (Str.string_match semver_re s 0) then + None + else + let major = Str.matched_group 1 s in + let minor = Str.matched_group 2 s in + let patch = Str.matched_group 3 s in + let prerelease = try Some (Str.matched_group 5 s) with Not_found -> None in + let build = try Some (Str.matched_group 7 s) with Not_found -> None in + Some (major, minor, patch, prerelease, build) + +let define var s = + [sprintf "#define %s %s\n" var s] + +let opt_define var o = + match o with + | None -> [] + | Some s -> define var s + +let parse_version_spec s = + let error () = + failwith (sprintf "Invalid version specification: %S" s) + in + let prefix, version_full = + try + let len = String.index s ':' in + String.sub s 0 len, String.sub s (len+1) (String.length s - (len+1)) + with Not_found -> + error () + in + match parse_semver version_full with + | None -> + error () + | Some (major, minor, patch, opt_prerelease, opt_build) -> + let version = sprintf "(%s, %s, %s)" major minor patch in + let version_string = sprintf "%s.%s.%s" major minor patch in + List.flatten [ + define (prefix ^ "_MAJOR") major; + define (prefix ^ "_MINOR") minor; + define (prefix ^ "_PATCH") patch; + opt_define (prefix ^ "_PRERELEASE") opt_prerelease; + opt_define (prefix ^ "_BUILD") opt_build; + define (prefix ^ "_VERSION") version; + define (prefix ^ "_VERSION_STRING") version_string; + define (prefix ^ "_VERSION_FULL") s; + ] + +let main () = + let extensions = Hashtbl.create 10 in + let files = ref [] in + let header = ref [] in + let incdirs = ref [] in + let out_file = ref None in + let preserve_quotations = ref false in + let show_exact_locations = ref false in + let show_no_locations = ref false in + let options = [ + "-D", Arg.String (fun s -> header := ("#define " ^ s ^ "\n") :: !header), + "DEF + Equivalent of interpreting '#define DEF' before processing the + input, e.g. `cppo -D 'VERSION \"1.2.3\"'` (no equal sign)"; + + "-U", Arg.String (fun s -> header := ("#undef " ^ s ^ "\n") :: !header), + "IDENT + Equivalent of interpreting '#undef IDENT' before processing the + input"; + + "-I", Arg.String (fun s -> incdirs := s :: !incdirs), + "DIR + Add directory DIR to the search path for included files"; + + "-V", Arg.String (fun s -> header := parse_version_spec s @ !header), + "VAR:MAJOR.MINOR.PATCH-OPTPRERELEASE+OPTBUILD + Define the following variables extracted from a version string + (following the Semantic Versioning syntax http://semver.org/): + + VAR_MAJOR must be a non-negative int + VAR_MINOR must be a non-negative int + VAR_PATCH must be a non-negative int + VAR_PRERELEASE if the OPTPRERELEASE part exists + VAR_BUILD if the OPTBUILD part exists + VAR_VERSION is the tuple (MAJOR, MINOR, PATCH) + VAR_VERSION_STRING is the string MAJOR.MINOR.PATCH + VAR_VERSION_FULL is the original string + + Example: cppo -V OCAML:4.02.1 +"; + + "-o", Arg.String (fun s -> out_file := Some s), + "FILE + Output file"; + + "-q", Arg.Set preserve_quotations, + " + Identify and preserve camlp4 quotations"; + + "-s", Arg.Set show_exact_locations, + " + Output line directives pointing to the exact source location of + each token, including those coming from the body of macro + definitions. This behavior is off by default."; + + "-n", Arg.Set show_no_locations, + " + Do not output any line directive other than those found in the + input (overrides -s)."; + + "-version", Arg.Unit (fun () -> + print_endline Cppo_version.cppo_version; + exit 0), + " + Print the version of the program and exit."; + + "-x", Arg.String (fun s -> add_extension extensions s), + "NAME:CMD_TEMPLATE + Define a custom preprocessor target section starting with: + #ext \"NAME\" + and ending with: + #endext + + NAME must be a lowercase identifier of the form [a-z][A-Za-z0-9_]* + + CMD_TEMPLATE is a command template supporting the following + special sequences: + %F file name (unescaped; beware of potential scripting attacks) + %B number of the first line + %E number of the last line + %% a single percent sign + + Filename, first line number and last line number are also + available from the following environment variables: + CPPO_FILE, CPPO_FIRST_LINE, CPPO_LAST_LINE. + + The command produced is expected to read the data lines from stdin + and to write its output to stdout." + ] + in + let msg = sprintf "\ +Usage: %s [OPTIONS] [FILE1 [FILE2 ...]] +Options:" Sys.argv.(0) in + let add_file s = files := s :: !files in + Arg.parse options add_file msg; + + let inputs = + let preliminaries = + match List.rev !header with + [] -> [] + | l -> + let s = String.concat "" l in + [ Sys.getcwd (), + "", + (fun () -> Lexing.from_string s), + (fun () -> ()) ] + in + let main = + match List.rev !files with + [] -> [ Sys.getcwd (), + "", + (fun () -> Lexing.from_channel stdin), + (fun () -> ()) ] + | l -> + List.map ( + fun file -> + let ic = lazy (open_in file) in + Filename.dirname file, + file, + (fun () -> Lexing.from_channel (Lazy.force ic)), + (fun () -> close_in (Lazy.force ic)) + ) l + in + preliminaries @ main + in + + let env = Cppo_eval.builtin_env in + let buf = Buffer.create 10_000 in + let _env = + Cppo_eval.include_inputs + ~extensions + ~preserve_quotations: !preserve_quotations + ~incdirs: (List.rev !incdirs) + ~show_exact_locations: !show_exact_locations + ~show_no_locations: !show_no_locations + buf env inputs + in + match !out_file with + None -> + print_string (Buffer.contents buf); + flush stdout + | Some file -> + let oc = open_out file in + output_string oc (Buffer.contents buf); + close_out oc + +let () = + if not !Sys.interactive then + try + main () + with + | Cppo_types.Cppo_error msg + | Failure msg -> + eprintf "Error: %s\n%!" msg; + exit 1 diff --git a/src/cppo_parser.mly b/src/cppo_parser.mly new file mode 100644 index 0000000..21d2cdd --- /dev/null +++ b/src/cppo_parser.mly @@ -0,0 +1,266 @@ +%{ + open Cppo_types +%} + +/* Directives */ +%token < Cppo_types.loc * string > DEF DEFUN UNDEF INCLUDE WARNING ERROR +%token < Cppo_types.loc * string option * int > LINE +%token < Cppo_types.loc * Cppo_types.bool_expr > IFDEF +%token < Cppo_types.loc * string * string > EXT +%token < Cppo_types.loc > ENDEF IF ELIF ELSE ENDIF ENDTEST + +/* Boolean expressions in #if/#elif directives */ +%token TRUE FALSE DEFINED NOT AND OR EQ LT GT NE LE GE + PLUS MINUS STAR LNOT LSL LSR ASR LAND LOR LXOR +%token < Cppo_types.loc > OP_PAREN SLASH MOD +%token < int64 > INT + + +/* Regular program and shared terminals */ +%token < Cppo_types.loc > CL_PAREN COMMA CURRENT_LINE CURRENT_FILE +%token < Cppo_types.loc * string > IDENT FUNIDENT +%token < Cppo_types.loc * bool * string > TEXT /* bool means "is space" */ +%token EOF + +/* Priorities for boolean expressions */ +%left OR +%left AND + +/* Priorities for arithmetics */ +%left PLUS MINUS +%left STAR SLASH +%left MOD LSL LSR ASR LAND LOR LXOR +%nonassoc NOT +%nonassoc LNOT +%nonassoc UMINUS + +%start main +%type < Cppo_types.node list > main +%% + +main: +| unode main { $1 :: $2 } +| EOF { [] } +; + +unode_list0: +| unode unode_list0 { $1 :: $2 } +| { [] } +; + +pnode_list0: +| pnode pnode_list0 { $1 :: $2 } +| { [] } +; + +/* node in which opening and closing parentheses don't need to match */ +unode: +| node { $1 } +| OP_PAREN { `Text ($1, false, "(") } +| CL_PAREN { `Text ($1, false, ")") } +| COMMA { `Text ($1, false, ",") } +; + +/* node in which parentheses must be closed */ +pnode: +| node { $1 } +| OP_PAREN pnode_or_comma_list0 CL_PAREN + { `Seq [`Text ($1, false, "("); + `Seq $2; + `Text ($3, false, ")")] } +; + +/* node without parentheses handling (need to use unode or pnode) */ +node: +| TEXT { `Text $1 } + +| IDENT { let loc, name = $1 in + `Ident (loc, name, None) } + +| FUNIDENT args1 CL_PAREN + { + (* macro application that receives at least one argument, + possibly empty. We cannot distinguish syntactically between + zero argument and one empty argument. + *) + let (pos1, _), name = $1 in + let _, pos2 = $3 in + `Ident ((pos1, pos2), name, Some $2) } +| FUNIDENT error + { error (fst $1) "Invalid macro application" } + +| CURRENT_LINE { `Current_line $1 } +| CURRENT_FILE { `Current_file $1 } + +| DEF unode_list0 ENDEF + { let (pos1, _), name = $1 in + + (* Additional spacing is needed for cases like '+foo+' + expanding into '++' instead of '+ +'. *) + let safe_space = `Text ($3, true, " ") in + + let body = $2 @ [safe_space] in + let _, pos2 = $3 in + `Def ((pos1, pos2), name, body) } + +| DEFUN def_args1 CL_PAREN unode_list0 ENDEF + { let (pos1, _), name = $1 in + let args = $2 in + + (* Additional spacing is needed for cases like 'foo()bar' + where 'foo()' expands into 'abc', giving 'abcbar' + instead of 'abc bar'; + Also needed for '+foo()+' expanding into '++' instead + of '+ +'. *) + let safe_space = `Text ($5, true, " ") in + + let body = $4 @ [safe_space] in + let _, pos2 = $5 in + `Defun ((pos1, pos2), name, args, body) } + +| DEFUN CL_PAREN + { error (fst (fst $1), snd $2) + "At least one argument is required" } + +| UNDEF + { `Undef $1 } +| WARNING + { `Warning $1 } +| ERROR + { `Error $1 } + +| INCLUDE + { `Include $1 } + +| EXT + { `Ext $1 } + +| IF test unode_list0 elif_list ENDIF + { let pos1, _ = $1 in + let _, pos2 = $5 in + let loc = (pos1, pos2) in + let test = $2 in + let if_true = $3 in + let if_false = + List.fold_right ( + fun (loc, test, if_true) if_false -> + [`Cond (loc, test, if_true, if_false) ] + ) $4 [] + in + `Cond (loc, test, if_true, if_false) + } + +| IF test unode_list0 elif_list error + { (* BUG? ocamlyacc fails to reduce that rule but not menhir *) + error $1 "missing #endif" } + +| IFDEF unode_list0 elif_list ENDIF + { let (pos1, _), test = $1 in + let _, pos2 = $4 in + let loc = (pos1, pos2) in + let if_true = $2 in + let if_false = + List.fold_right ( + fun (loc, test, if_true) if_false -> + [`Cond (loc, test, if_true, if_false) ] + ) $3 [] + in + `Cond (loc, test, if_true, if_false) + } + +| IFDEF unode_list0 elif_list error + { error (fst $1) "missing #endif" } + +| LINE { `Line $1 } +; + + +elif_list: + ELIF test unode_list0 elif_list + { let pos1, _ = $1 in + let pos2 = Parsing.rhs_end_pos 4 in + ((pos1, pos2), $2, $3) :: $4 } +| ELSE unode_list0 + { let pos1, _ = $1 in + let pos2 = Parsing.rhs_end_pos 2 in + [ ((pos1, pos2), `True, $2) ] } +| { [] } +; + +args1: + pnode_list0 COMMA args1 { $1 :: $3 } +| pnode_list0 { [ $1 ] } +; + +pnode_or_comma_list0: +| pnode pnode_or_comma_list0 { $1 :: $2 } +| COMMA pnode_or_comma_list0 { `Text ($1, false, ",") :: $2 } +| { [] } +; + +def_args1: +| arg_blank IDENT COMMA def_args1 + { (snd $2) :: $4 } +| arg_blank IDENT { [ snd $2 ] } +; + +arg_blank: +| TEXT arg_blank { let loc, is_space, _s = $1 in + if not is_space then + error loc "Invalid argument list" + } +| { () } +; + +test: + bexpr ENDTEST { $1 } +; + +/* Boolean expressions after #if or #elif */ +bexpr: + | TRUE { `True } + | FALSE { `False } + | DEFINED IDENT { `Defined (snd $2) } + | OP_PAREN bexpr CL_PAREN { $2 } + | NOT bexpr { `Not $2 } + | bexpr AND bexpr { `And ($1, $3) } + | bexpr OR bexpr { `Or ($1, $3) } + | aexpr EQ aexpr { `Eq ($1, $3) } + | aexpr LT aexpr { `Lt ($1, $3) } + | aexpr GT aexpr { `Gt ($1, $3) } + | aexpr NE aexpr { `Not (`Eq ($1, $3)) } + | aexpr LE aexpr { `Not (`Gt ($1, $3)) } + | aexpr GE aexpr { `Not (`Lt ($1, $3)) } +; + +/* Arithmetic expressions within boolean expressions */ +aexpr: + | INT { `Int $1 } + | IDENT { `Ident $1 } + | OP_PAREN aexpr_list CL_PAREN + { match $2 with + | [x] -> x + | l -> + let pos1, _ = $1 in + let _, pos2 = $3 in + `Tuple ((pos1, pos2), l) + } + | aexpr PLUS aexpr { `Add ($1, $3) } + | aexpr MINUS aexpr { `Sub ($1, $3) } + | aexpr STAR aexpr { `Mul ($1, $3) } + | aexpr SLASH aexpr { `Div ($2, $1, $3) } + | aexpr MOD aexpr { `Mod ($2, $1, $3) } + | aexpr LSL aexpr { `Lsl ($1, $3) } + | aexpr LSR aexpr { `Lsr ($1, $3) } + | aexpr ASR aexpr { `Asr ($1, $3) } + | aexpr LAND aexpr { `Land ($1, $3) } + | aexpr LOR aexpr { `Lor ($1, $3) } + | aexpr LXOR aexpr { `Lxor ($1, $3) } + | LNOT aexpr { `Lnot $2 } + | MINUS aexpr %prec UMINUS { `Neg $2 } +; + +aexpr_list: + | aexpr COMMA aexpr_list { $1 :: $3 } + | aexpr { [$1] } +; diff --git a/src/cppo_types.ml b/src/cppo_types.ml new file mode 100644 index 0000000..d6428d8 --- /dev/null +++ b/src/cppo_types.ml @@ -0,0 +1,98 @@ +open Printf +open Lexing + +module String_set = Set.Make (String) +module String_map = Map.Make (String) + +type loc = position * position + +type bool_expr = + [ `True + | `False + | `Defined of string + | `Not of bool_expr (* not *) + | `And of (bool_expr * bool_expr) (* && *) + | `Or of (bool_expr * bool_expr) (* || *) + | `Eq of (arith_expr * arith_expr) (* = *) + | `Lt of (arith_expr * arith_expr) (* < *) + | `Gt of (arith_expr * arith_expr) (* > *) + (* syntax for additional operators: <>, <=, >= *) + ] + +and arith_expr = (* signed int64 *) + [ `Int of int64 + | `Ident of (loc * string) + (* must be bound to a valid int literal. + Expansion of macro functions is not supported. *) + + | `Tuple of (loc * arith_expr list) + (* tuple of 2 or more elements guaranteed by the syntax *) + + | `Neg of arith_expr (* - *) + | `Add of (arith_expr * arith_expr) (* + *) + | `Sub of (arith_expr * arith_expr) (* - *) + | `Mul of (arith_expr * arith_expr) (* * *) + | `Div of (loc * arith_expr * arith_expr) (* / *) + | `Mod of (loc * arith_expr * arith_expr) (* mod *) + + (* Bitwise operations on 64 bits *) + | `Lnot of arith_expr (* lnot *) + | `Lsl of (arith_expr * arith_expr) (* lsl *) + | `Lsr of (arith_expr * arith_expr) (* lsr *) + | `Asr of (arith_expr * arith_expr) (* asr *) + | `Land of (arith_expr * arith_expr) (* land *) + | `Lor of (arith_expr * arith_expr) (* lor *) + | `Lxor of (arith_expr * arith_expr) (* lxor *) + ] + +and node = + [ `Ident of (loc * string * node list list option) + | `Def of (loc * string * node list) + | `Defun of (loc * string * string list * node list) + | `Undef of (loc * string) + | `Include of (loc * string) + | `Ext of (loc * string * string) + | `Cond of (loc * bool_expr * node list * node list) + | `Error of (loc * string) + | `Warning of (loc * string) + | `Text of (loc * bool * string) (* bool is true for space tokens *) + | `Seq of node list + | `Stringify of node + | `Capitalize of node + | `Concat of (node * node) + | `Line of (loc * string option * int) + | `Current_line of loc + | `Current_file of loc ] + + + +let string_of_loc (pos1, pos2) = + let line1 = pos1.pos_lnum + and start1 = pos1.pos_bol in + Printf.sprintf "File %S, line %i, characters %i-%i" + pos1.pos_fname line1 + (pos1.pos_cnum - start1) + (pos2.pos_cnum - start1) + + +exception Cppo_error of string + +let error loc s = + let msg = + sprintf "%s\nError: %s" (string_of_loc loc) s in + raise (Cppo_error msg) + +let warning loc s = + let msg = + sprintf "%s\nWarning: %s" (string_of_loc loc) s in + eprintf "%s\n%!" msg + +let dummy_loc = (Lexing.dummy_pos, Lexing.dummy_pos) + +let rec flatten_nodes (l: node list): node list = + List.flatten (List.map flatten_node l) + +and flatten_node (node: node): node list = + match node with + | `Seq l -> flatten_nodes l + | x -> [x] diff --git a/src/cppo_types.mli b/src/cppo_types.mli new file mode 100644 index 0000000..f3b5423 --- /dev/null +++ b/src/cppo_types.mli @@ -0,0 +1,70 @@ +type loc = Lexing.position * Lexing.position + +exception Cppo_error of string + +type bool_expr = + [ `True + | `False + | `Defined of string + | `Not of bool_expr (* not *) + | `And of (bool_expr * bool_expr) (* && *) + | `Or of (bool_expr * bool_expr) (* || *) + | `Eq of (arith_expr * arith_expr) (* = *) + | `Lt of (arith_expr * arith_expr) (* < *) + | `Gt of (arith_expr * arith_expr) (* > *) + (* syntax for additional operators: <>, <=, >= *) + ] + +and arith_expr = (* signed int64 *) + [ `Int of int64 + | `Ident of (loc * string) + (* must be bound to a valid int literal. + Expansion of macro functions is not supported. *) + + | `Tuple of (loc * arith_expr list) + (* tuple of 2 or more elements guaranteed by the syntax *) + + | `Neg of arith_expr (* - *) + | `Add of (arith_expr * arith_expr) (* + *) + | `Sub of (arith_expr * arith_expr) (* - *) + | `Mul of (arith_expr * arith_expr) (* * *) + | `Div of (loc * arith_expr * arith_expr) (* / *) + | `Mod of (loc * arith_expr * arith_expr) (* mod *) + + (* Bitwise operations on 64 bits *) + | `Lnot of arith_expr (* lnot *) + | `Lsl of (arith_expr * arith_expr) (* lsl *) + | `Lsr of (arith_expr * arith_expr) (* lsr *) + | `Asr of (arith_expr * arith_expr) (* asr *) + | `Land of (arith_expr * arith_expr) (* land *) + | `Lor of (arith_expr * arith_expr) (* lor *) + | `Lxor of (arith_expr * arith_expr) (* lxor *) + ] + +and node = + [ `Ident of (loc * string * node list list option) + | `Def of (loc * string * node list) + | `Defun of (loc * string * string list * node list) + | `Undef of (loc * string) + | `Include of (loc * string) + | `Ext of (loc * string * string) + | `Cond of (loc * bool_expr * node list * node list) + | `Error of (loc * string) + | `Warning of (loc * string) + | `Text of (loc * bool * string) (* bool is true for space tokens *) + | `Seq of node list + | `Stringify of node + | `Capitalize of node + | `Concat of (node * node) + | `Line of (loc * string option * int) + | `Current_line of loc + | `Current_file of loc ] + +val dummy_loc : loc + +val error : loc -> string -> _ + +val warning : loc -> string -> unit + +val flatten_nodes : node list -> node list + diff --git a/src/cppo_version.mli b/src/cppo_version.mli new file mode 100644 index 0000000..7d20f68 --- /dev/null +++ b/src/cppo_version.mli @@ -0,0 +1 @@ +val cppo_version : string diff --git a/src/dune b/src/dune new file mode 100644 index 0000000..38f1809 --- /dev/null +++ b/src/dune @@ -0,0 +1,16 @@ +(ocamllex cppo_lexer) + +(ocamlyacc cppo_parser) + +(rule + (targets cppo_version.ml) + (action + (with-stdout-to + %{targets} + (echo "let cppo_version = \"%{version:cppo}\"")))) + +(executable + (name cppo_main) + (package cppo) + (public_name cppo) + (libraries unix str)) diff --git a/test/capital.cppo b/test/capital.cppo new file mode 100644 index 0000000..fa85caa --- /dev/null +++ b/test/capital.cppo @@ -0,0 +1,6 @@ + + +#define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val] + + +EVENT(exit, unit -> unit) \ No newline at end of file diff --git a/test/capital.ref b/test/capital.ref new file mode 100644 index 0000000..adcc26e --- /dev/null +++ b/test/capital.ref @@ -0,0 +1,6 @@ + + + + +# 6 "capital.cppo" + external onExit : unit -> unit = "exit" [@@bs.val] \ No newline at end of file diff --git a/test/comments.cppo b/test/comments.cppo new file mode 100644 index 0000000..5e335f1 --- /dev/null +++ b/test/comments.cppo @@ -0,0 +1,7 @@ +(* '"' *) + +#define BE_GONE + +(* "*)" +#define DONT_TOUCH_THIS +*) diff --git a/test/comments.ref b/test/comments.ref new file mode 100644 index 0000000..1d0dd1d --- /dev/null +++ b/test/comments.ref @@ -0,0 +1,8 @@ +# 1 "comments.cppo" +(* '"' *) + + +# 5 "comments.cppo" +(* "*)" +#define DONT_TOUCH_THIS +*) diff --git a/test/cond.cppo b/test/cond.cppo new file mode 100644 index 0000000..b5f0c49 --- /dev/null +++ b/test/cond.cppo @@ -0,0 +1,47 @@ +#if 1 = 1 +#else +#error "ignored #else (?)" +#endif + +#if true + banana +#elif false + apple + #error "ignored #elif (?)" +#endif + +#if false + earthworm + #error "" +#elif true + apricot +#endif + +#if false + cuckoo + #error "" +#else + #if false + egg + #error "" + #else + nest + #endif +#endif + +#define X 3 + +#if false + helicopter + #error "" +#elif false + ocean + #error "" +#else + #if X = 12 + sand + #error "" + #elif 4 * X = 12 + sea urchin + #endif +#endif diff --git a/test/cond.ref b/test/cond.ref new file mode 100644 index 0000000..a21ea21 --- /dev/null +++ b/test/cond.ref @@ -0,0 +1,17 @@ + + +# 7 "cond.cppo" + banana + + +# 17 "cond.cppo" + apricot + + +# 28 "cond.cppo" + nest + + + +# 45 "cond.cppo" + sea urchin diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..a7fab7b --- /dev/null +++ b/test/dune @@ -0,0 +1,130 @@ +(rule + (targets ext.out) + (deps + (:< ext.cppo) + source.sh) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} -x "rot13:tr '[a-z]' '[n-za-m]'" -x + "source:sh source.sh '%F' %B %E" %{<})))) + +(rule + (targets comments.out) + (deps + (:< comments.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets cond.out) + (deps + (:< cond.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets tuple.out) + (deps + (:< tuple.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets loc.out) + (deps + (:< loc.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets paren_arg.out) + (deps + (:< paren_arg.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets unmatched.out) + (deps + (:< unmatched.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} %{<})))) + +(rule + (targets version.out) + (deps + (:< version.cppo)) + (action + (with-stdout-to + %{targets} + (run %{bin:cppo} -V X:123.05.2-alpha.1+foo-2.1 %{<})))) + +(alias + (name runtest) + (package cppo) + (action + (diff ext.ref ext.out))) + +(alias + (name runtest) + (package cppo) + (action + (diff comments.ref comments.out))) + +(alias + (name runtest) + (package cppo) + (action + (diff cond.ref cond.out))) + +(alias + (name runtest) + (package cppo) + (action + (diff tuple.ref tuple.out))) + +(alias + (name runtest) + (package cppo) + (action + (diff loc.ref loc.out))) + +(alias + (name runtest) + (package cppo) + (action + (diff paren_arg.ref paren_arg.out))) + +(alias + (name runtest) + (package cppo) + (deps version.out)) + +(alias + (name runtest) + (package cppo) + (action + (diff unmatched.ref unmatched.out))) + +(alias + (name runtest) + (package cppo) + (deps + (:< test.cppo) + incl.cppo + incl2.cppo) + (action + (ignore-stdout (run %{bin:cppo} %{<})))) diff --git a/test/ext.cppo b/test/ext.cppo new file mode 100644 index 0000000..cb32573 --- /dev/null +++ b/test/ext.cppo @@ -0,0 +1,10 @@ +hello +#ext rot13 +abc +\#endext +def +#endext +goodbye + +#ext source +#endext diff --git a/test/ext.ref b/test/ext.ref new file mode 100644 index 0000000..4626b21 --- /dev/null +++ b/test/ext.ref @@ -0,0 +1,28 @@ +# 1 "ext.cppo" +hello +nop +#raqrkg +qrs +# 7 "ext.cppo" +goodbye + +# 9 +(* +hello +#ext rot13 +abc +\#endext +def +#endext +goodbye + +#ext source +#endext +*) +(* + Environment variables: + CPPO_FILE=ext.cppo + CPPO_FIRST_LINE=9 + CPPO_LAST_LINE=11 +*) +# 11 diff --git a/test/incl.cppo b/test/incl.cppo new file mode 100644 index 0000000..a2ce8db --- /dev/null +++ b/test/incl.cppo @@ -0,0 +1,3 @@ +included + +#include "incl2.cppo" diff --git a/test/incl2.cppo b/test/incl2.cppo new file mode 100644 index 0000000..9766475 --- /dev/null +++ b/test/incl2.cppo @@ -0,0 +1 @@ +ok diff --git a/test/loc.cppo b/test/loc.cppo new file mode 100644 index 0000000..d7c2c52 --- /dev/null +++ b/test/loc.cppo @@ -0,0 +1,8 @@ +#define loc __FILE__ __LINE__ +loc +X(loc) +X(loc) +X(Y(loc)) + +#define F(x) loc +F() diff --git a/test/loc.ref b/test/loc.ref new file mode 100644 index 0000000..78bbfb7 --- /dev/null +++ b/test/loc.ref @@ -0,0 +1,21 @@ +# 2 "loc.cppo" + "loc.cppo" 2 +# 3 "loc.cppo" +X( +# 3 "loc.cppo" + "loc.cppo" 3 +# 3 "loc.cppo" +) +X( +# 4 "loc.cppo" + "loc.cppo" 4 +# 4 "loc.cppo" +) +X(Y( +# 5 "loc.cppo" + "loc.cppo" 5 +# 5 "loc.cppo" + )) + +# 8 "loc.cppo" + "loc.cppo" 8 diff --git a/test/paren_arg.cppo b/test/paren_arg.cppo new file mode 100644 index 0000000..f4c4803 --- /dev/null +++ b/test/paren_arg.cppo @@ -0,0 +1,3 @@ +#define F(x, y) +F((1, (2)), 34) +F((1\,\(2\)), 34) diff --git a/test/paren_arg.ref b/test/paren_arg.ref new file mode 100644 index 0000000..6555ca0 --- /dev/null +++ b/test/paren_arg.ref @@ -0,0 +1,4 @@ +# 2 "paren_arg.cppo" + <(1, (2))> < 34> +# 3 "paren_arg.cppo" + <(1 , (2 ))> < 34> diff --git a/test/source.sh b/test/source.sh new file mode 100755 index 0000000..660d161 --- /dev/null +++ b/test/source.sh @@ -0,0 +1,13 @@ +#! /bin/sh -e + +echo "# $2" +echo "(*" +cat "$1" +echo "*)" +echo "(*" +echo " Environment variables:" +echo " CPPO_FILE=$CPPO_FILE" +echo " CPPO_FIRST_LINE=$CPPO_FIRST_LINE" +echo " CPPO_LAST_LINE=$CPPO_LAST_LINE" +echo "*)" +echo "# $3" diff --git a/test/test.cppo b/test/test.cppo new file mode 100644 index 0000000..89756f7 --- /dev/null +++ b/test/test.cppo @@ -0,0 +1,144 @@ +(* comment *) + +#define pi 3.14 +f(1) +#define f(x) x+pi +f(2) +#undef pi +f(3) + +#ifdef g +"g" is defined +#else +"g" is not defined +#endif + +#define a(x) b() +#define b(x) a() +a() + +debug("a") +debug("b") + +#define z 123 +#define y z +#define x y + +#if x lsl 1 = 2*123 + +#if 1 = 2 +#error "test" +#endif + +success +#else +failure +#endif + +#define test_multiline \ +"abc\ + def" \ +(* 123 \ + 456 *) +test_multiline + +#define test_args(x, y) x y +test_args("a","b") + +#define test_argc(x) x y +test_argc(aa\,bb) + +#define test_esc(x) x +test_esc(\,\)\() + +blah #define xyz +#ifdef xyz +#error "xyz should not have been defined" +#endif + +#define sticky1(x) _ +#define sticky2(x) sticky1()_ (* the 2 underscores should be space-separated *) +sticky2() + +#define empty1 +#define empty2 +empty1+ (* there should be some space between the pluses *) +empty2 + +(* (* nested comment with single single quote: ' *) "*)" *) + +#define arg +obj + \# define arg + +' (* lone single quote *) + +#define one 1 +one is not 1 + +#undef x +#define x # +x is # + +#undef one +#define one 1 +#if (one+one = 100 + \ + 64 lsr 3 / 4 - lnot lnot 100) && \ + 1 + 3 * 5 = 16 && \ + 22 mod 7 = 1 && \ + lnot 0 = 0xffffffffffffffff && \ + -1 asr 100 = -1 && \ + -1 land (1 lsl 1 lsr 1) = 1 && \ + -1 lor 1 = -1 && \ + -2 lxor 1 = -1 && \ + lnot -1 = 0 && \ + true && not false && defined one && \ + (true || true && false) +good maths +#else +#error "math error" +#endif + + +#undef f +#undef g +#undef x +#undef y + +#define trace(f) \ +let f x = \ + printf "call %s\n%!" STRINGIFY(f); \ + let y = f x in \ + printf "return %s\n%!" STRINGIFY(f); \ + y \ +;; + +trace(g) + +#define field(name,type) \ + val mutable name : type option \ + method CONCAT(get_, name) = name \ + method CONCAT(set_, name) x = name <- Some x + +class foo () = +object + field(field_1, int) + field(field_2, string) +end + +#define DEBUG(x) \ + (if !debug then \ + eprintf "[debug] %s %i: " __FILE__ __LINE__; \ + eprintf x; \ + eprintf "\n") +DEBUG("test1 %i %i" x y) +DEBUG("test2 %i" x) + +#include "incl.cppo" +# 123456 + +#789 "test" +#include "incl.cppo" + +#define debug(s) Printf.eprintf "%S %i: %s\n%!" __FILE__ __LINE__ s + +end diff --git a/test/tuple.cppo b/test/tuple.cppo new file mode 100644 index 0000000..57423b8 --- /dev/null +++ b/test/tuple.cppo @@ -0,0 +1,38 @@ +#if (2 + 2, 5) < (4, 5) + mountain + #error "" +#else + pistachios +#endif + +#if (3 * 3) = 10 - 1 + trees +#else + rocks + #error "" +#endif + +#if (1) = (1) + waves +#else + sharks + #error "" +#endif + + +#define x 11 +#if (x, 2) <> (x, 4/2) + honey + #error "" +#else + bees +#endif + +#define tuple (0, -5, 3) +#define tuple2 tuple +#if (0, -5, x) > tuple2 + steamboat +#else + koalas + #error "" +#endif diff --git a/test/tuple.ref b/test/tuple.ref new file mode 100644 index 0000000..58df976 --- /dev/null +++ b/test/tuple.ref @@ -0,0 +1,20 @@ + +# 5 "tuple.cppo" + pistachios + + +# 9 "tuple.cppo" + trees + + +# 16 "tuple.cppo" + waves + + + +# 28 "tuple.cppo" + bees + + +# 34 "tuple.cppo" + steamboat diff --git a/test/unmatched.cppo b/test/unmatched.cppo new file mode 100644 index 0000000..470cbd4 --- /dev/null +++ b/test/unmatched.cppo @@ -0,0 +1,14 @@ +#ifdef whatever + ( +#else + let a = 1 in + let b = 2 in + (a || +#endif + + b) + +#define F(x, y) (x + y) +F(1,(2+3)) +) +( diff --git a/test/unmatched.ref b/test/unmatched.ref new file mode 100644 index 0000000..ff2356a --- /dev/null +++ b/test/unmatched.ref @@ -0,0 +1,15 @@ + +# 4 "unmatched.cppo" + let a = 1 in + let b = 2 in + (a || + + +# 9 "unmatched.cppo" + b) + +# 12 "unmatched.cppo" + (1 + (2+3)) +# 13 "unmatched.cppo" +) +( diff --git a/test/version.cppo b/test/version.cppo new file mode 100644 index 0000000..ee4e429 --- /dev/null +++ b/test/version.cppo @@ -0,0 +1,30 @@ +#if X_VERSION < (123, 0, 0) + alligators + #error "" +#else + Cape buffalos +#endif + +#define v X_VERSION +#if v = (X_MAJOR, X_MINOR, X_PATCH) + onion rings +#else + gazpacho + #error "" +#endif + +major: X_MAJOR +minor: X_MINOR +patch: X_PATCH + +#ifdef X_PRERELEASE + prerelease: X_PRERELEASE +#else + #error "" +#endif + +#ifdef X_BUILD + build: X_BUILD +#else + #error "" +#endif -- cgit v1.2.3