pax_global_header00006660000000000000000000000064147235433210014516gustar00rootroot0000000000000052 comment=a3e90caf8fe416000f8aff8e1b1e7ee3b309d589 cppo-1.8.0/000077500000000000000000000000001472354332100124655ustar00rootroot00000000000000cppo-1.8.0/.github/000077500000000000000000000000001472354332100140255ustar00rootroot00000000000000cppo-1.8.0/.github/PULL_REQUEST_TEMPLATE.md000066400000000000000000000010171472354332100176250ustar00rootroot00000000000000 Fixes / closes #???? - [ ] Added / updated [**test-suite**](test). - [ ] Added [**changelog**](Changes.md). cppo-1.8.0/.github/dependabot.yml000066400000000000000000000001601472354332100166520ustar00rootroot00000000000000version: 2 updates: - package-ecosystem: github-actions directory: / schedule: interval: weekly cppo-1.8.0/.github/workflows/000077500000000000000000000000001472354332100160625ustar00rootroot00000000000000cppo-1.8.0/.github/workflows/build.yml000066400000000000000000000125271472354332100177130ustar00rootroot00000000000000--- name: Build on: push: branches: - master # forall push/merge in master pull_request: branches: - "**" # forall submitted Pull Requests jobs: build: strategy: fail-fast: false matrix: setup-version: - v2 - v3 os: - macos-13 - macos-latest - ubuntu-latest - windows-latest ocaml-version: - 4.02.x - 4.03.x - 4.04.x - 4.05.x - 4.06.x - 4.07.x - 4.08.x - 4.09.x - 4.10.x - 4.11.x - 4.12.x - 4.13.x - 4.14.x - 5.0.x - 5.1.x - 5.2.x exclude: - os: macos-13 setup-version: v3 # opam uninstall fails - os: macos-latest setup-version: v2 - os: macos-latest ocaml-version: 4.02.x - os: macos-latest ocaml-version: 4.03.x - os: macos-latest ocaml-version: 4.04.x - os: macos-latest ocaml-version: 4.05.x - os: macos-latest ocaml-version: 4.06.x - os: macos-latest ocaml-version: 4.07.x - os: macos-latest ocaml-version: 4.08.x - os: macos-latest ocaml-version: 4.09.x - os: macos-latest ocaml-version: 4.11.x - os: windows-latest setup-version: v3 ocaml-version: 4.02.x - os: windows-latest setup-version: v3 ocaml-version: 4.03.x - os: windows-latest setup-version: v3 ocaml-version: 4.04.x - os: windows-latest setup-version: v3 ocaml-version: 4.05.x - os: windows-latest setup-version: v3 ocaml-version: 4.06.x - os: windows-latest setup-version: v3 ocaml-version: 4.07.x - os: windows-latest setup-version: v3 ocaml-version: 4.08.x - os: windows-latest setup-version: v3 ocaml-version: 4.09.x - os: windows-latest setup-version: v3 ocaml-version: 4.10.x - os: windows-latest setup-version: v3 ocaml-version: 4.11.x - os: windows-latest setup-version: v3 ocaml-version: 4.12.x - os: windows-latest setup-version: v2 ocaml-version: 5.0.x - os: windows-latest setup-version: v2 ocaml-version: 5.1.x - os: windows-latest setup-version: v2 ocaml-version: 5.2.x runs-on: ${{ matrix.os }} env: SKIP_BUILD: | dose lilis rotor camlimages freetds frenetic genprint hdf5 ocp-index-top pa_ppx pla ppx_deriving_rpc reed-solomon-erasure setr stdcompat uwt OPAMAUTOREMOVE: true SKIP_TEST: | 0install bisect_ppx cconv-ppx decompress extlib-compat General steps: - name: Prepare git run: | git config --global core.autocrlf false git config --global init.defaultBranch master - name: Checkout code uses: actions/checkout@v4 - name: Setup OCaml ${{ matrix.ocaml-version }} with v2 if: matrix.setup-version == 'v2' uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-version }} - name: Setup OCaml ${{ matrix.ocaml-version }} with v3 if: matrix.setup-version == 'v3' uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-version }} - name: Install dependencies run: opam install --deps-only . - name: List installed packages run: opam list - name: Build locally run: opam exec -- make - name: Upload the build artifact uses: actions/upload-artifact@v4 with: name: ${{ matrix.os }}-${{ matrix.ocaml-version }}-cppo.exe path: _build/default/src/cppo_main.exe overwrite: true - name: Build, test, and install package run: opam install -t . - name: Test dependants if: > (matrix.ocaml-version >= '4.05') && (matrix.os != 'windows-latest') run: | PACKAGES=`opam list -s --color=never --installable --depends-on cppo,cppo_ocamlbuild` echo "Dependants:" $PACKAGES for PACKAGE in $PACKAGES do echo $SKIP_BUILD | tr ' ' '\n' | grep ^$PACKAGE$ > /dev/null && echo Skip $PACKAGE && continue OPAMWITHTEST=true echo $SKIP_TEST | tr ' ' '\n' | grep ^$PACKAGE$ > /dev/null && OPAMWITHTEST=false ([ $OPAMWITHTEST == false ] && echo ::group::Build $PACKAGE) || echo ::group::Build and test $PACKAGE DEPS_FAILED=false (opam depext $PACKAGE && opam install --deps-only $PACKAGE) || DEPS_FAILED=true [ $DEPS_FAILED == false ] && opam install $PACKAGE echo ::endgroup:: [ $DEPS_FAILED == false ] || echo Dependencies broken done cppo-1.8.0/.gitignore000066400000000000000000000000521472354332100144520ustar00rootroot00000000000000*~ _build .merlin *.install .*.swp *.opam cppo-1.8.0/.ocp-indent000066400000000000000000000015721472354332100145330ustar00rootroot00000000000000# 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 cppo-1.8.0/.travis.yml000066400000000000000000000005151472354332100145770ustar00rootroot00000000000000language: 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 cppo-1.8.0/CODEOWNERS000066400000000000000000000005631472354332100140640ustar00rootroot00000000000000# 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 *.opam @liyishuai .github/workflows/ @liyishuai cppo-1.8.0/Changes.md000066400000000000000000000067521472354332100143710ustar00rootroot00000000000000## v1.8.0 (2024-12-03) - [+ui] A scope, delimited by `#scope ... #endscope`, limits the effect of `#define`, `#def ... #enddef`, and `#undef`. - [bug] Fix `cppo -version`, which used to print a blank line (#92). ## v1.7.0 (2024-08-22) - [+ui] Multi-line macros, without line terminators `\`, can now be defined using `#def` and `#enddef`. These macro definitions can be nested. - [+ui] Higher-order macros: a macro can now take a parameterized macro as a parameter. - [compat] Better locations for some syntax error messages. ## v1.6.9 (2022-05-19) - [bug] Fix multiline string support (#81) ## v1.6.8 (2021-09-17) - [compat] Allow version strings without patch numbers, _e.g._ `8.13+beta1` The patch number will be set to 0 upon empty, _i.e._ `(8, 13, 0)` ## v1.6.7 (2020-12-21) - [compat] Treat ~ and - the same in semver in order to parse OCaml 4.12.0 pre-release versions. - [compat] Restore 4.02.3 compatibility. ## 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 cppo-1.8.0/INSTALL.md000066400000000000000000000004111472354332100141110ustar00rootroot00000000000000Installation 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 DESTDIR=/some/path install ``` cppo-1.8.0/LICENSE.md000066400000000000000000000027331472354332100140760ustar00rootroot00000000000000Copyright (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. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``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 COPYRIGHT HOLDER OR CONTRIBUTORS 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. cppo-1.8.0/Makefile000066400000000000000000000035041472354332100141270ustar00rootroot00000000000000.PHONY: all clean test check install uninstall release all: @dune build clean: @git clean -fX test: @dune runtest check: test install: @dune install uninstall: @dune uninstall # To make a release: # + check that [make test] succeeds # + check that everything has been committed and pushed # + check that the CI has succeeded # + make sure that the package is not pinned: [opam pin remove cppo] # + run [make release VERSION=X.Y.Z] release: # Check if this is the master branch. @ if [ "$$(git symbolic-ref --short HEAD)" != "master" ] ; then \ echo "Error: this is not the master branch." ; \ git branch ; \ exit 1 ; \ fi # Check if everything has been committed. @ if [ -n "$$(git status --porcelain)" ] ; then \ echo "Error: there remain uncommitted changes." ; \ git status ; \ exit 1 ; \ fi # Make sure the current version can be compiled. @ make clean @ make test # Check the current package description. @ opam lint # Make sure $(VERSION) is nonempty. @ if [ -z "$(VERSION)" ] ; then \ echo "Error: please use: make release VERSION=X.Y.Z" ; \ exit 1 ; \ fi # Make sure a CHANGES entry with the current version seems to exist. @ if ! grep "## v$(VERSION)" Changes.md >/dev/null ; then \ echo "Error: Changes.md has no entry for version $(VERSION)." ; \ exit 1 ; \ fi # Make sure the current version is mentioned in dune-project. @ if ! grep "(version $(VERSION))" dune-project >/dev/null ; then \ echo "Error: dune-project does not mention version $(VERSION)." ; \ grep "(version" dune-project ; \ exit 1 ; \ fi # Create a git tag. @ git tag v$(VERSION) # Upload. (This automatically makes a .tar.gz archive available on github.) @ git push @ git push --tags # Publish an opam description. @ opam publish --tag=v$(VERSION) -v $(VERSION) ocaml-community/cppo cppo-1.8.0/README.md000066400000000000000000000467641472354332100137650ustar00rootroot00000000000000[![Build status](https://github.com/ocaml-community/cppo/actions/workflows/build.yml/badge.svg)](https://github.com/ocaml-community/cppo/actions/workflows/build.yml) 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 Meta ---- * Author: Martin Jambon * OCaml-community maintainers: - Martin Jambon ([**@mjambon**](https://github.com/mjambon)) - Yishuai Li ([**@liyishuai**](https://github.com/liyishuai)) * License: [BSD 3-Clause "New" or "Revised" License](LICENSE.md) * Compatible OCaml versions: 4.02.3 or later * Additional dependencies: - [Dune](https://dune.build) 1.10 or later - [OCamlbuild](https://github.com/ocaml/ocamlbuild) and [Findlib](http://projects.camlcity.org/projects/findlib.html), for Ocamlbuild plugin Building and installation instructions -------------------------------------- The easiest way to install the latest released version of cppo is via [OPAM](https://opam.ocaml.org/doc/Install.html): ```shell opam install cppo ``` To instead build and install manually, do: ``` shell git clone https://github.com/ocaml-community/cppo.git cd cppo make make install ``` 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* ("def"|"enddef"|"define"|"undef" |"scope"|"endscope" |"if"|"ifdef"|"ifndef"|"else"|"elif"|"endif" |"include" |"warning"|"error" |"ext"|"endext") ... ``` A macro definition that is delimited by `#def` and `#enddef` can span several lines. There is no need for protecting line endings with backslash characters `\`. A directive (other than `#def ... #enddef`) can be split into multiple lines by placing a backslash character `\` at the end of the line to be continued. In general, any special character can be 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. That is, a macro can be parameterized; this is known as a "function-like macro" in `cpp` jargon. When a parameterized macro is defined and when it is applied, the opening parenthesis must stick to the macro's identifier: that is, there must be no space in between. For example, this text: ```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 () ``` An ordinary macro, which takes no arguments, can be viewed as a parameterized macro that takes zero arguments. However, the syntax differs: when there is no argument, no parentheses are used; when there is at least one argument, parentheses must be used. Here is a summary of the valid syntaxes: ```ocaml #define FOO 42 (* Definition of an ordinary macro *) FOO (* A use of an ordinary macro *) #define BAR() 42 (* Invalid! When parentheses are used, there must be at least one parameter *) #define BAR(x) 42+x (* Definition of a parameterized macro *) BAR(0) (* A use of this parameterized macro *) BAR() (* Another valid use -- the argument is empty *) ``` 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 ``` Multi-line macros and nested macros ----------------------------------- A macro definition that begins with `#define` can span several lines. In that case, the end of each line must be protected with a backslash character, as in this example: ```ocaml #define repeat_until(action,condition) \ action; \ while not (condition) do \ action \ done ``` In other words, at the first line ending that is *not* preceded by a `\` character, an `#enddefine` token is implicitly generated, and the definition ends. This convention, which is inherited from C, causes two problems. First, protecting every line ending with a `\` character is painful. Second, more seriously, this convention does not allow macro definitions to be nested. Indeed, if one attempts to nest two definitions that begin with `#define`, then only one `#enddefine` token is generated; it is generated at the first unprotected line ending. So, the beginnings and ends of definitions cannot be correctly balanced. These problems are avoided by using an alternative syntax where the beginning and end of a macro definition are explicitly marked by `#def` and `#enddef`. Here is an example: ```ocaml #def repeat_until(action,condition) action; while not (condition) do action done #enddef ``` With this syntax, a macro can span several lines: there is no need to protect line endings with `\` characters. Furthermore, this syntax allows macro definitions to be nested: inside a macro definition that is delimited by `#def` and `#enddef`, both `#def` and `#define` can be used. Higher-order macros ------------------- A parameterized macro can take a parameterized macro as a parameter: this is known as a higher-order macro. To enable this feature, some annotations are required: when a macro parameter is itself a parameterized macro, it must be annotated with its type. A macro takes *n* arguments (where *n* can be zero) and returns a piece of text. So, to describe the type of a macro, it suffices to describe the types of its *n* arguments. Thus, the syntax of types is `τ ::= [τ ... τ]`. That is, a type is a sequence of *n* types, without separators, surrounded with square brackets. An ordinary macro, which takes zero parameters, has type `[]`. This is the base type: in other words, it is the type of text. For greater readability, this type can also be written in the form of a single period, `.`. Here are a few examples of types: ```ocaml . (* An ordinary unparameterized macro: in other words, text *) [] (* Same as above. *) [.] (* A parameterized macro that expects one piece of text *) [..] (* A parameterized macro that expects two pieces of text *) [[.].] (* A parameterized macro whose first parameter is a parameterized macro of type [.] and whose second parameter is a piece of text *) ``` In the definition of a parameterized macro `M`, each parameter `X` can be annotated with a type by writing `X : τ`. This is optional: if no annotation is provided, the base type `.` is assumed. If a parameter `X` is annotated with a type `τ` other than the base type, then, when the parameterized macro `M` is applied, the actual argument `Y` that is supplied as an instance for `X` must be the name of a macro of type `τ`. This is more easily explained via an example. In the following code, ```ocaml #define TWICE(e) (e + e) #define APPLY(F : [.], e) (let x = (e) in F(x)) let forty_two = APPLY(TWICE,1+2+3+4+5+6) ``` `TWICE` is a parameterized macro of type `[.]`, and `APPLY` is a higher-order macro, whose type is `[[.].]`. Thus, the application `APPLY(TWICE, ...)` is valid. This code is expanded into: ```ocaml let forty_two = (let x = (1+2+3+4+5+6) in (x + x)) ``` Scopes ------ When a block of text is delimited by `#scope ... #endscope`, all macro definitions (`#define`, `#def ... #enddef`) and undefinitions (`#undef`) become local: they take effect only within this block. ```ocaml (* Here, assume that the macro FOO is not defined. *) #scope #define FOO "FOO is now defined" let x = FOO (* FOO expands to "FOO is now defined" *) #endscope (* Here, the macro FOO is again not defined. *) #define FOO 42 let y = FOO (* FOO expands to 42 *) ``` Scopes can be nested, as illustrated by this example: ```ocaml #scope #define HELLO "Hello, " #scope #define MAN "man" let message1 = HELLO ^ MAN #endscope (* Here, MAN is no longer defined, but HELLO still is. *) let message2 = HELLO ^ "world" #endscope ``` 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. Balancing delimiters -------------------- All delimiters, including scope delimiters (`#scope` and `#endscope`), delimiters of macro definitions (`#def` and `#enddef`), and delimiters of conditional constructs (`#if`, `#endif`, etc.), must be used in a well-balanced manner. This requirement does *not* apply separately to each category of delimiters. instead, it applies to all categories of delimiters at once. This is a stricter requirement. Thus, for example, `#scope` cannot be followed with `#endif`, and `#if` cannot be followed with `#endscope`. In other words, a scope cannot contain a fragment of a conditional construct, and a conditional construct cannot contain a fragment of a macro definition. 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 cppo-1.8.0/appveyor.yml000066400000000000000000000005221472354332100150540ustar00rootroot00000000000000 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 cppo-1.8.0/dune-project000066400000000000000000000021101472354332100150010ustar00rootroot00000000000000(lang dune 2.0) (name cppo) (version 1.8.0) (generate_opam_files true) (source (github ocaml-community/cppo)) (license BSD-3-Clause) (authors "Martin Jambon") (maintainers "Martin Jambon " "Yishuai Li ") (documentation "https://ocaml-community.github.io/cppo") (package (name cppo) (depends (ocaml (>= 4.02.3)) (dune (>= 2.0)) base-unix) (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 ")) (package (name cppo_ocamlbuild) (depends ocaml (dune (>= 2.0)) ocamlbuild ocamlfind) (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). ")) cppo-1.8.0/examples/000077500000000000000000000000001472354332100143035ustar00rootroot00000000000000cppo-1.8.0/examples/Makefile000066400000000000000000000002441472354332100157430ustar00rootroot00000000000000.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 cppo-1.8.0/examples/debug.ml000066400000000000000000000002021472354332100157150ustar00rootroot00000000000000#ifdef DEBUG #define debug(s) Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s #else #define debug(s) () #endif debug("test") cppo-1.8.0/examples/dune000066400000000000000000000007011472354332100151570ustar00rootroot00000000000000(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)) cppo-1.8.0/examples/french.ml000066400000000000000000000012421472354332100161010ustar00rootroot00000000000000#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" cppo-1.8.0/examples/lexer.mll000066400000000000000000000003161472354332100161300ustar00rootroot00000000000000(* 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 } cppo-1.8.0/ocamlbuild_plugin/000077500000000000000000000000001472354332100161565ustar00rootroot00000000000000cppo-1.8.0/ocamlbuild_plugin/_tags000066400000000000000000000000321472354332100171710ustar00rootroot00000000000000true: package(ocamlbuild) cppo-1.8.0/ocamlbuild_plugin/dune000066400000000000000000000002171472354332100170340ustar00rootroot00000000000000(library (name cppo_ocamlbuild) (public_name cppo_ocamlbuild) (wrapped false) (synopsis "Cppo ocamlbuild plugin") (libraries ocamlbuild)) cppo-1.8.0/ocamlbuild_plugin/ocamlbuild_cppo.ml000066400000000000000000000025401472354332100216450ustar00rootroot00000000000000 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 | _ -> () cppo-1.8.0/ocamlbuild_plugin/ocamlbuild_cppo.mli000066400000000000000000000004471472354332100220220ustar00rootroot00000000000000 (** [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 cppo-1.8.0/src/000077500000000000000000000000001472354332100132545ustar00rootroot00000000000000cppo-1.8.0/src/compat.ml000066400000000000000000000003401472354332100150660ustar00rootroot00000000000000if Filename.check_suffix Sys.argv.(1) ".ml" && Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> (a, b)) < (4, 03) then print_endline "\ module String = struct include String let capitalize_ascii = capitalize end" cppo-1.8.0/src/cppo_command.ml000066400000000000000000000030171472354332100162460ustar00rootroot00000000000000open 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 cppo-1.8.0/src/cppo_command.mli000066400000000000000000000003641472354332100164210ustar00rootroot00000000000000type 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 cppo-1.8.0/src/cppo_eval.ml000066400000000000000000000571341472354332100155700ustar00rootroot00000000000000open Printf open Cppo_types module S = Set.Make (String) module M = Map.Make (String) let find_opt name env = try Some (M.find name env) with Not_found -> None (* An environment entry. *) (* In a macro definition [EDef (loc, formals, body, env)], + [loc] is the location of the macro definition, + [formals] is the list of formal parameters, + [body] and [env] represent the closed body of the macro definition. *) type entry = | EDef of loc * formals * body * env (* An environment is a map of (macro) names to environment entries. *) and env = entry M.t let basic x : formal = (x, base) let ident x = `Ident (dummy_loc, x, []) let dummy_defun formals body env = EDef (dummy_loc, List.map basic formals, body, env) let builtins : (string * (env -> entry)) list = [ "STRINGIFY", dummy_defun ["x"] (`Stringify (ident "x")) ; "CONCAT", dummy_defun ["x";"y"] (`Concat (ident "x", ident "y")) ; "CAPITALIZE", dummy_defun ["x"] (`Capitalize (ident "x")) ; ] let is_reserved s = s = "__FILE__" || s = "__LINE__" || List.exists (fun (s', _) -> s = s') builtins let builtin_env : 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 (* Transform a list of actual macro arguments back into ordinary text, after discovering that they are not macro arguments after all. *) let text loc name (actuals : actuals) : node list = match actuals with | [] -> [`Text (loc, false, name)] | _ :: _ -> `Text (loc, false, name ^ "(") :: add_sep (`Text (loc, false, ",")) (`Text (loc, false, ")")) actuals 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 ^ " " let int_expansion_error loc name = 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) let rec int_expansion loc name (node : node) : string = match node with | `Text (_loc, _is_space, s) -> s | `Seq (_loc, nodes) -> List.map (int_expansion loc name) nodes |> String.concat "" | _ -> int_expansion_error loc name (* 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 body = match find_opt name env with | Some (EDef (_loc, [], body, _env)) -> body | Some (EDef _) -> error loc (sprintf "%S expects arguments" name) | None -> error loc (sprintf "Undefined identifier %S" name) in (try match node_is_ident body with | Some (loc, name) -> (* single identifier that we expand recursively *) eval_ident env loc name | None -> (* int literal or int tuple literal; variables not allowed *) let s = int_expansion loc name body 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 -> int_expansion_error loc name ) with Cppo_error _ -> int_expansion_error loc name ) 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; also used in the expansion of CONCAT *) 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 *) } (* [preserving_enable_loc g action] saves [g.enable_loc], runs [action()], then restores [g.enable_loc]. The result of [action()] is returned. *) let preserving_enable_loc g action = let enable_loc0 = !(g.enable_loc) in let result = action() in g.enable_loc := enable_loc0; result 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.long_loc lexer_env) "syntax error" | Cppo_types.Cppo_error _ as e -> raise e | e -> error (Cppo_lexer.long_loc lexer_env) (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 check_arity loc name (formals : _ list) (actuals : _ list) = let formals = List.length formals and actuals = List.length actuals in if formals <> actuals then sprintf "%S expects %i argument%s but is applied to %i argument%s." name formals (plural formals) actuals (plural actuals) |> error loc (* [macro_of_node node] checks that [node] is a single identifier, possibly surrounded with whitespace, and returns this identifier as well as its location. *) let macro_of_node (node : node) : loc * macro = match node_is_ident node with | Some (loc, x) -> loc, x | None -> sprintf "The name of a macro is expected in this position" |> error (node_loc node) (* [fetch loc x env] checks that the macro [x] exists in [env] and fetches its definition. *) let fetch loc (x : macro) env : entry = match find_opt x env with | None -> sprintf "The macro '%s' is not defined" x |> error loc | Some def -> def (* [entry_shape def] returns the shape of the macro that is defined by the environment entry [def]. *) let entry_shape (entry : entry) : shape = let EDef (_loc, formals, _body, _env) = entry in Shape (List.map snd formals) (* [check_shape loc expected provided] checks that the shapes [expected] and [provided] are equal. *) let check_shape loc expected provided = if not (same_shape expected provided) then sprintf "A macro of type %s was expected, but\n \ a macro of type %s was provided" (print_shape expected) (print_shape provided) |> error loc (* [bind_one formal (loc, actual, env) accu] binds one formal parameter to one actual argument, extending the environment [accu]. *) let bind_one (formal : formal) (loc, actual, env) accu = let (x : macro), (expected : shape) = formal in (* Analyze the shape of this formal parameter. *) match expected with | Shape [] -> (* This formal parameter has the base shape: it is an ordinary parameter. It becomes an ordinary (unparameterized) macro: the name [x] becomes bound to the closure [actual, env]. *) M.add x (EDef (loc, [], actual, env)) accu | _ -> (* This formal parameter has a shape other than the base shape: it is itself a parameterized macro. In that case, we expect the actual parameter to be just a name [y]. *) let loc, y = macro_of_node actual in (* Check that the macro [y] exists, and fetch its definition. *) let def = fetch loc y env in (* Compute its shape. *) let provided = entry_shape def in (* Check that the shapes match. *) check_shape loc expected provided; (* Now bind [x] to the definition of [y]. *) (* This is analogous to [let x = y] in OCaml. *) M.add x def accu (* [bind_many formals (loc, actuals, env) accu] binds a tuple of formal parameters to a tuple of actual arguments, extending the environment [accu]. *) let bind_many formals (loc, actuals, env) accu = List.fold_left2 (fun accu formal actual -> bind_one formal (loc, actual, env) accu ) accu formals actuals 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 (* [expand_ident] is the special case of [expand_node] where the node is an identifier [`Ident (loc, name, actuals)]. *) and expand_ident ~top g env0 loc name (actuals : actuals) = (* Test whether there exists a definition for the macro [name]. *) let def = find_opt name env0 in match def with | None -> (* There is no definition for the macro [name], so this is not a macro application after all. Transform it back into text, and process it. *) expand_list g env0 (text loc name actuals) | Some def -> expand_macro_application ~top g env0 loc name actuals def (* [expand_macro_application] is the special case of [expand_ident] where it turns out that the identifier [name] is a macro. *) and expand_macro_application ~top g env0 loc name actuals def = let g = if top || g.call_loc == dummy_loc then { g with call_loc = loc } else g in preserving_enable_loc g @@ fun () -> 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 EDef (_loc, formals, body, env) = def in (* Check that this macro is applied to a correct number of arguments. *) check_arity loc name formals actuals; (* Extend the macro's captured environment [env] with bindings of formals to actuals. Each actual captures the environment [env0] that exists here, at the macro application site. *) let env = bind_many formals (loc, actuals, env0) env in (* Process the macro's body in this extended environment. *) let (_ : env) = expand_node g env body in g.require_location := true; (* Continue with our original environment. *) env0 and expand_node ?(top = false) g env0 (x : node) = match x with | `Ident (loc, name, actuals) -> expand_ident ~top g env0 loc name actuals | `Def (loc, name, formals, body)-> g.require_location := true; if M.mem name env0 then error loc (sprintf "%S is already defined" name) else M.add name (EDef (loc, formals, body, env0)) env0 | `Scope body -> (* A [body] is just a [node]. We expand this node, and drop the resulting environment; instead, we return the current environment. *) let env = expand_node ~top g env0 body in ignore env; 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 (_loc, l) -> expand_list g env0 l | `Stringify x -> preserving_enable_loc g @@ fun () -> 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; env0 | `Capitalize (x : node) -> preserving_enable_loc g @@ fun () -> 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; env0 | `Concat (x, y) -> preserving_enable_loc g @@ fun () -> 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; 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 cppo-1.8.0/src/cppo_eval.mli000066400000000000000000000010261472354332100157260ustar00rootroot00000000000000(** 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 type env val builtin_env : env 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 -> env -> (string * string * (unit -> Lexing.lexbuf) * (unit -> unit)) list -> env cppo-1.8.0/src/cppo_lexer.mll000066400000000000000000000531771472354332100161370ustar00rootroot00000000000000{ 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 = [ "def"; "define"; "elif"; "else"; "enddef"; "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 let assert_ocaml_lexer e lexbuf = match e.lexer with | `Test -> lexer_error lexbuf "Syntax error in boolean expression" | `Ocaml -> () } (* 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')* (* We use two different lexers: [ocaml_token] is used for ordinary OCaml tokens; [test_token] is used inside the Boolean expression that follows an #if directive. The field [e.lexer] indicates which lexer is currently active. *) rule line e = parse (* A directive begins with a # symbol, which must appear at the beginning of a line. *) | blank* "#" as s { assert_ocaml_lexer e lexbuf; clear e; (* We systematically set [e.token_start], so that [long_loc e] will correctly produce the location of the last token. *) e.token_start <- pos1 lexbuf; if e.line_start then ( e.in_directive <- true; add e s; e.line_start <- false; directive e lexbuf ) else TEXT (loc lexbuf, false, s) } | "" { clear e; (* We systematically set [e.token_start], so that [long_loc e] will correctly produce the location of the last token. *) e.token_start <- pos1 lexbuf; match e.lexer with | `Ocaml -> ocaml_token e lexbuf | `Test -> test_token e lexbuf } and directive e = parse (* If #define is immediately followed with an opening parenthesis (without any blank space) then this is interpreted as a parameterized macro definition. The formal parameters are parsed by the lexer. *) | blank* "define" dblank1 (ident as id) "(" { let xs = formals1 lexbuf in assert (xs <> []); DEF (long_loc e, id, xs) } (* If #define is not followed with an opening parenthesis then this is interpreted as an ordinary (non-parameterized) macro definition. *) | blank* "define" dblank1 (ident as id) { let xs = [] in DEF (long_loc e, id, xs) } (* #def is identical to #define, except it does not set [e.in_directive], so backslashes and newlines do not receive special treatment. The end of the macro definition must be explicitly signaled by #enddef. *) | blank* "def" dblank1 (ident as id) "(" { e.in_directive <- false; let xs = formals1 lexbuf in assert (xs <> []); DEF (long_loc e, id, xs) } | blank* "def" dblank1 (ident as id) { e.in_directive <- false; let xs = [] in DEF (long_loc e, id, xs) } (* #enddef ends a definition, which (we expect) has been opened by #def. Because we use the same pair of tokens, namely [DEF] and [ENDEF], for both kinds of definitions (#define and #def), it is in fact possible to begin a definition with #define and end it with #enddef. We do not document this fact, and users should not rely on it. *) | blank* "enddef" { blank_until_eol e lexbuf; ENDEF (long_loc e) } | blank* "undef" dblank1 (ident as id) { blank_until_eol e lexbuf; UNDEF (long_loc e, id) } (* #scope opens a block, which we expect will be ended by #endscope. It does not set [e.in_directive], so backslashes and newlines do not receive special treatment. *) | blank* "scope" dblank0 { e.in_directive <- false; SCOPE (long_loc e) } (* #endscope ends a block. *) | blank* "endscope" { blank_until_eol e lexbuf; ENDSCOPE (long_loc e) } | 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) } (* At the end of the file, the lexer normally produces EOF. However, if we are currently inside a definition (opened by #define) then the lexer produces ENDEF followed by EOF. *) | eof { if e.in_directive then (e.in_directive <- false; ENDEF (loc lexbuf)) else 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' { 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] } (* -------------------------------------------------------------------------- *) (* Lists of formal macro parameters. *) (* [formals1] recognizes a nonempty comma-separated list of formal macro parameters, ended with a closing parenthesis. *) and formals1 = parse | blank+ { formals1 lexbuf } | ")" { lexer_error lexbuf "A macro must have at least one formal parameter" } | "" { let x = formal lexbuf in formals0 [x] lexbuf } (* [formals0 xs] recognizes a possibly empty list of comma-preceded formal macro parameters, ended with a closing parenthesis. [xs] is the accumulator. *) and formals0 xs = parse | blank+ { formals0 xs lexbuf } | ")" { List.rev xs } | "," { let x = formal lexbuf in formals0 (x :: xs) lexbuf } | _ | eof { lexer_error lexbuf "Invalid formal parameter list: expected ',' or ')'" } (* [formal] recognizes one formal macro parameter. It is either an identifier [x] or an identifier annotated with a shape [x : sh]. *) and formal = parse | blank+ { formal lexbuf } | (ident as x) blank* ":" { (x, shape lexbuf) } | ident as x { (x, base) } | _ | eof { lexer_error lexbuf "Invalid formal parameter: expected an identifier" } (* [shape] recognizes a shape. *) and shape = parse | blank+ { shape lexbuf } | "." (* The base shape can be written [] but we also allow . as a more readable alternative. *) { base } | "[" { Shape (shapes [] lexbuf) } | _ | eof { lexer_error lexbuf "Invalid shape: expected '.' or '[' or ']'" } (* A closing square bracket is valid if an opening square bracket has been entered. We could keep track of this via an additional parameter, but that seems overkill. *) (* [shapes shs] recognizes a possibly empty list of shapes, ended with a closing square bracket. There is no separator between shapes. [shs] is the accumulator. *) and shapes shs = parse | blank+ { shapes shs lexbuf } | "]" { List.rev shs } | "" { let sh = shape lexbuf in shapes (sh :: shs) lexbuf } (* -------------------------------------------------------------------------- *) (* Initialization. *) { 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 } cppo-1.8.0/src/cppo_main.ml000066400000000000000000000163761472354332100155700ustar00rootroot00000000000000open 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 = try (Str.matched_group 4 s) with Not_found -> "0" in let prerelease = try Some (Str.matched_group 6 s) with Not_found -> None in let build = try Some (Str.matched_group 8 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 Note that cppo recognises both '-' and '~' preceding the pre-release meaning -V OCAML:4.11.0+alpha1 sets OCAML_BUILD to alpha1 but -V OCAML:4.12.0~alpha1 sets OCAML_PRERELEASE to alpha1. "; "-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 cppo-1.8.0/src/cppo_parser.mly000066400000000000000000000210771472354332100163230ustar00rootroot00000000000000%{ open Cppo_types %} /* Directives */ %token < Cppo_types.loc * string > UNDEF INCLUDE WARNING ERROR %token < Cppo_types.loc * string * (string * Cppo_types.shape) list > DEF %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 SCOPE ENDSCOPE 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 } | { [] } ; body: | unode_list0 { let pos1 = Parsing.symbol_start_pos() and pos2 = Parsing.symbol_end_pos() in let loc = (pos1, pos2) in (loc, $1) } pnode_list0: | pnode pnode_list0 { $1 :: $2 } | { [] } ; actual: | pnode_list0 { let pos1 = Parsing.symbol_start_pos() and pos2 = Parsing.symbol_end_pos() in let loc = (pos1, pos2) in `Seq (loc, $1) } ; /* 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 { let nodes = `Text ($1, false, "(") :: $2 @ `Text ($3, false, ")") :: [] in let pos1, _ = $1 and _, pos2 = $3 in let loc = (pos1, pos2) in `Seq (loc, nodes) } ; /* node without parentheses handling (need to use unode or pnode) */ node: | TEXT { `Text $1 } | IDENT { let loc, name = $1 in `Ident (loc, name, []) } | FUNIDENT actuals1 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 assert ($2 <> []); `Ident ((pos1, pos2), name, $2) } | FUNIDENT error { error (fst $1) "Invalid macro application" } | CURRENT_LINE { `Current_line $1 } | CURRENT_FILE { `Current_file $1 } | DEF body ENDEF { let (pos1, _), name, formals = $1 in let loc, body = $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 ($3, true, " ") in let body = body @ [safe_space] in let body = `Seq (loc, body) in let _, pos2 = $3 in `Def ((pos1, pos2), name, formals, body) } | DEF body EOF { let loc, _name, _formals = $1 in error loc "This #def is never closed: perhaps #enddef is missing" } /* We include this rule in order to produce a good error message when a #def has no matching #enddef. */ | SCOPE body ENDSCOPE { let body = `Seq $2 in `Scope body } | SCOPE body EOF { let loc = $1 in error loc "This #scope is never closed: perhaps #endscope is missing" } /* We include this rule in order to produce a good error message when a #scope has no matching #endscope. */ | 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) ] } | { [] } ; actuals1: actual COMMA actuals1 { $1 :: $3 } | actual { [ $1 ] } ; pnode_or_comma_list0: | pnode pnode_or_comma_list0 { $1 :: $2 } | COMMA pnode_or_comma_list0 { `Text ($1, false, ",") :: $2 } | { [] } ; 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] } ; cppo-1.8.0/src/cppo_types.ml000066400000000000000000000126171472354332100160020ustar00rootroot00000000000000open Printf open Lexing module String_set = Set.Make (String) module String_map = Map.Make (String) type loc = position * position (* The name of a macro. *) type macro = string (* The shape of a macro. The abstract syntax of shapes is τ ::= [τ, ..., τ]. That is, a macro takes a tuple of parameters, each of which has a shape. The length of of this tuple can be zero: this is the base case. *) type shape = | Shape of shape list (* Printing a shape. This code must be consistent with the shape parser in [Cppo_lexer]. *) let rec print_shape (Shape shs) = match shs with | [] -> (* As a special case, the base shape is ".". *) "." | _ -> "[" ^ String.concat "" (List.map print_shape shs) ^ "]" (* Testing two shapes for equality. *) let same_shape : shape -> shape -> bool = (=) (* The base shape. This is the shape of a basic macro, which takes no parameters, and produces text. *) let base = Shape [] type bool_expr = [ `True | `False | `Defined of macro | `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 *) ] type node = [ `Ident of (loc * string * actuals) (* the list [actuals] is empty if and only if no parentheses are used at this macro invocation site. *) | `Def of (loc * macro * formals * body) (* the list [formals] is empty if and only if no parentheses are used at this macro definition site. *) | `Scope of body | `Undef of (loc * macro) | `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 (loc * 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 ] (* A formal macro parameter consists of an identifier (the name of this parameter) and a shape (the shape of this parameter). In the concrete syntax, if the shape is omitted, then the base shape is assumed. *) and formal = string * shape (* A tuple of formal macro parameters. *) and formals = formal list (* One actual macro argument. *) and actual = node (* A tuple of actual macro arguments. *) and actuals = actual list (* The body of a macro definition. *) and body = node 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 node_loc (node : node) : loc = match node with | `Ident (loc, _, _) | `Def (loc, _, _, _) | `Undef (loc, _) | `Include (loc, _) | `Ext (loc, _, _) | `Cond (loc, _, _, _) | `Error (loc, _) | `Warning (loc, _) | `Text (loc, _, _) | `Seq (loc, _) | `Line (loc, _, _) | `Current_line loc | `Current_file loc -> loc | `Scope node -> node_loc node | `Stringify _ | `Capitalize _ | `Concat (_, _) -> dummy_loc (* These cases are never produced by the parser. *) let rec is_whitespace_node node = match node with | `Text (_, is_whitespace, _) -> is_whitespace | `Seq (_loc, nodes) -> is_whitespace_nodes nodes | _ -> false and is_whitespace_nodes nodes = List.for_all is_whitespace_node nodes let is_not_whitespace_node node = not (is_whitespace_node node) let dissolve (node : node) : node list = match node with | `Seq (_loc, nodes) -> nodes | _ -> [node] let nodes_are_ident (nodes : node list) : (loc * string) option = match List.filter is_not_whitespace_node nodes with | [`Ident (loc, x, [])] -> Some (loc, x) | _ -> None let node_is_ident (node : node) : (loc * string) option = nodes_are_ident (dissolve node) cppo-1.8.0/src/cppo_types.mli000066400000000000000000000076131472354332100161530ustar00rootroot00000000000000type loc = Lexing.position * Lexing.position exception Cppo_error of string (* The name of a macro. *) type macro = string (* The shape of a macro. The abstract syntax of shapes is τ ::= [τ, ..., τ]. That is, a macro takes a tuple of parameters, each of which has a shape. The length of of this tuple can be zero: this is the base case. *) type shape = | Shape of shape list (* The base shape. This is the shape of a basic macro, which takes no parameters, and produces text. *) val base : shape (* Printing a shape. *) val print_shape : shape -> string (* Testing two shapes for equality. *) val same_shape : shape -> shape -> bool type bool_expr = [ `True | `False | `Defined of macro | `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 *) ] type node = [ `Ident of (loc * string * actuals) (* the list [actuals] is empty if and only if no parentheses are used at this macro invocation site. *) | `Def of (loc * macro * formals * body) (* the list [formals] is empty if and only if no parentheses are used at this macro definition site. *) | `Scope of body | `Undef of (loc * macro) | `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 (loc * 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 ] (* A formal macro parameter consists of an identifier (the name of this parameter) and a shape (the shape of this parameter). In the concrete syntax, if the shape is omitted, then the base shape is assumed. *) and formal = string * shape (* A tuple of formal macro parameters. *) and formals = formal list (* One actual macro argument. *) and actual = node (* A tuple of actual macro arguments. *) and actuals = actual list (* The body of a macro definition. *) and body = node val dummy_loc : loc val error : loc -> string -> _ val warning : loc -> string -> unit (* [node_loc] extracts the location of a node. *) val node_loc : node -> loc (* [is_whitespace_node] determines whether a node is just whitespace. *) val is_whitespace_node : node -> bool val is_whitespace_nodes : node list -> bool (* [node_is_ident node] tests whether [node] is a single identifier, possibly surrounded with whitespace, and (if successful) returns this identifier as well as its location. *) val node_is_ident : node -> (loc * string) option cppo-1.8.0/src/cppo_version.mli000066400000000000000000000000321472354332100164600ustar00rootroot00000000000000val cppo_version : string cppo-1.8.0/src/dune000066400000000000000000000006511472354332100141340ustar00rootroot00000000000000(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) (modules :standard \ compat) (preprocess (per_module ((action (progn (run ocaml %{dep:compat.ml} %{input-file}) (cat %{input-file}))) cppo_eval))) (libraries unix str)) cppo-1.8.0/test/000077500000000000000000000000001472354332100134445ustar00rootroot00000000000000cppo-1.8.0/test/already_defined.cppo000066400000000000000000000001021472354332100174170ustar00rootroot00000000000000(* A macro is defined twice. *) #define FOO "oh" #define FOO "no" cppo-1.8.0/test/already_defined.ref000066400000000000000000000001341472354332100172370ustar00rootroot00000000000000Error: File "already_defined.cppo", line 3, characters 0-17 Error: "FOO" is already defined cppo-1.8.0/test/applied_to_none.cppo000066400000000000000000000001211472354332100174600ustar00rootroot00000000000000(* A parameterized macro is applied to no arguments. *) #define FOO(x) x FOO + 1 cppo-1.8.0/test/applied_to_none.ref000066400000000000000000000001711472354332100173000ustar00rootroot00000000000000Error: File "applied_to_none.cppo", line 3, characters 0-3 Error: "FOO" expects 1 argument but is applied to 0 argument. cppo-1.8.0/test/arity_mismatch.cppo000066400000000000000000000001161472354332100173420ustar00rootroot00000000000000(* This test shows an arity mismatch error. *) #define INCR(x) x+1 INCR(x, y) cppo-1.8.0/test/arity_mismatch.ref000066400000000000000000000001731472354332100171600ustar00rootroot00000000000000Error: File "arity_mismatch.cppo", line 3, characters 0-10 Error: "INCR" expects 1 argument but is applied to 2 arguments. cppo-1.8.0/test/arity_mismatch_indirect.cppo000066400000000000000000000001441472354332100212240ustar00rootroot00000000000000#define ID(X) X #define APPLY(F : [.], X) F (* intentionally forgetting to apply F *) APPLY(ID, 42) cppo-1.8.0/test/arity_mismatch_indirect.ref000066400000000000000000000002011472354332100210310ustar00rootroot00000000000000Error: File "arity_mismatch_indirect.cppo", line 2, characters 26-27 Error: "F" expects 1 argument but is applied to 0 argument. cppo-1.8.0/test/at_least_one_arg.cppo000066400000000000000000000001171472354332100176140ustar00rootroot00000000000000(* A parameterized macro cannot have zero arguments. *) #define FOO() "not ok" cppo-1.8.0/test/at_least_one_arg.ref000066400000000000000000000001651472354332100174320ustar00rootroot00000000000000Error: File "at_least_one_arg.cppo", line 2, characters 12-13 Error: A macro must have at least one formal parameter cppo-1.8.0/test/capital.cppo000066400000000000000000000001631472354332100157440ustar00rootroot00000000000000 #define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val] EVENT(exit, unit -> unit)cppo-1.8.0/test/capital.ref000066400000000000000000000001171472354332100155560ustar00rootroot00000000000000 # 6 "capital.cppo" external onExit : unit -> unit = "exit" [@@bs.val] cppo-1.8.0/test/comment_in_formals.cppo000066400000000000000000000000621472354332100202000ustar00rootroot00000000000000#define FOO(x, (* a comment *) y) x+y FOO(42, 23) cppo-1.8.0/test/comment_in_formals.ref000066400000000000000000000001701472354332100200130ustar00rootroot00000000000000Error: File "comment_in_formals.cppo", line 1, characters 15-16 Error: Invalid formal parameter: expected an identifier cppo-1.8.0/test/comments.cppo000066400000000000000000000000771472354332100161600ustar00rootroot00000000000000(* '"' *) #define BE_GONE (* "*)" #define DONT_TOUCH_THIS *) cppo-1.8.0/test/comments.ref000066400000000000000000000001271472354332100157670ustar00rootroot00000000000000# 1 "comments.cppo" (* '"' *) # 5 "comments.cppo" (* "*)" #define DONT_TOUCH_THIS *) cppo-1.8.0/test/cond.cppo000066400000000000000000000007221472354332100152530ustar00rootroot00000000000000#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 cppo-1.8.0/test/cond.ref000066400000000000000000000002031472354332100150600ustar00rootroot00000000000000 # 7 "cond.cppo" banana # 17 "cond.cppo" apricot # 28 "cond.cppo" nest # 45 "cond.cppo" sea urchin cppo-1.8.0/test/def.cppo000066400000000000000000000042501472354332100150660ustar00rootroot00000000000000(* This macro application combinator provides call-by-value semantics: the actual argument is evaluated up front and its value is bound to a variable, which is passed as an argument to the macro [F]. *) #def APPLY(F : [.], X : .) (let __x = (X) in F(__x)) (* Multiple lines permitted; no backslash required. *) #enddef (* Some trivial tests. *) #define ID(X) X #define C 42 let forty_one = APPLY(ID, 41) let forty_two = APPLY(ID, C ) (* A [for]-loop macro. *) #def LOOP(start, finish, body : [.]) ( for __index = start to finish-1 do body(__index) done ) #enddef (* A [for]-loop macro that performs unrolling. *) #def UNROLLED_LOOP(start, finish, body : [.]) ( (* #define can be nested inside #def. *) #define BODY(i) APPLY(body, i) (* #def can be nested inside #def. *) #def INCREMENT(i, k) i := !i + k #enddef let __finish = (finish) in let __index = ref (start) in while !__index + 2 <= __finish do BODY(!__index); BODY(!__index + 1); INCREMENT(__index, 2) done; while !__index < __finish do BODY(!__index); INCREMENT(__index, 1) done ) #enddef (* In the examples that follow, #scope ... #endscope is used to avoid the need to #undefine local macros such as BODY and F. *) (* Iteration over an array, with a normal loop. *) let iter f a = #scope #define BODY(i) (f a.(i)) LOOP(0, Array.length a, BODY) #endscope (* Iteration over an array, with an unrolled loop. *) let unrolled_iter f a = #scope #define BODY(i) (f a.(i)) UNROLLED_LOOP(0, Array.length a, BODY) #endscope (* Printing an array, with a normal loop. *) let print_int_array a = #scope #define F(i) Printf.printf "%d" a.(i) LOOP(0, Array.length a, F) #endscope (* A higher-order macro that produces a definition of [iter], and accepts an arbitrary definition of the macro [LOOP]. *) #def DEFINE_ITER(iter, LOOP : [..[.]]) #scope #define BODY(i) (f a.(i)) let iter f a = LOOP(0, Array.length a, BODY) #endscope #enddef (* Some noise, which does not affect the above definitions. *) #define BODY(i) "noise" DEFINE_ITER(iter, LOOP) DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) (* Just because we can, undefine BODY. *) #undef BODY cppo-1.8.0/test/def.ref000066400000000000000000000060111472354332100146760ustar00rootroot00000000000000# 1 "def.cppo" (* This macro application combinator provides call-by-value semantics: the actual argument is evaluated up front and its value is bound to a variable, which is passed as an argument to the macro [F]. *) # 10 "def.cppo" (* Some trivial tests. *) # 13 "def.cppo" let forty_one = # 13 "def.cppo" (let __x = ( 41) in __x ) (* Multiple lines permitted; no backslash required. *) # 14 "def.cppo" let forty_two = # 14 "def.cppo" (let __x = ( 42 ) in __x ) (* Multiple lines permitted; no backslash required. *) # 16 "def.cppo" (* A [for]-loop macro. *) # 25 "def.cppo" (* A [for]-loop macro that performs unrolling. *) # 47 "def.cppo" (* In the examples that follow, #scope ... #endscope is used to avoid the need to #undefine local macros such as BODY and F. *) (* Iteration over an array, with a normal loop. *) let iter f a = # 54 "def.cppo" ( for __index = 0 to Array.length a-1 do (f a.(__index)) done ) # 57 "def.cppo" (* Iteration over an array, with an unrolled loop. *) let unrolled_iter f a = # 61 "def.cppo" ( (* #define can be nested inside #def. *) (* #def can be nested inside #def. *) let __finish = ( Array.length a) in let __index = ref (0) in while !__index + 2 <= __finish do (let __x = ( !__index) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; (let __x = ( !__index + 1) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; __index := !__index + 2 done; while !__index < __finish do (let __x = ( !__index) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; __index := !__index + 1 done ) # 64 "def.cppo" (* Printing an array, with a normal loop. *) let print_int_array a = # 68 "def.cppo" ( for __index = 0 to Array.length a-1 do Printf.printf "%d" a.(__index) done ) # 71 "def.cppo" (* A higher-order macro that produces a definition of [iter], and accepts an arbitrary definition of the macro [LOOP]. *) # 81 "def.cppo" (* Some noise, which does not affect the above definitions. *) # 84 "def.cppo" let iter f a = ( for __index = 0 to Array.length a-1 do (f a.(__index)) done ) # 85 "def.cppo" let unrolled_iter f a = ( (* #define can be nested inside #def. *) (* #def can be nested inside #def. *) let __finish = ( Array.length a) in let __index = ref (0) in while !__index + 2 <= __finish do (let __x = ( !__index) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; (let __x = ( !__index + 1) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; __index := !__index + 2 done; while !__index < __finish do (let __x = ( !__index) in (f a.(__x)) ) (* Multiple lines permitted; no backslash required. *) ; __index := !__index + 1 done ) # 87 "def.cppo" (* Just because we can, undefine BODY. *) cppo-1.8.0/test/define_on_last_line.cppo000066400000000000000000000001431472354332100203050ustar00rootroot00000000000000(* This #define is NOT ended by a new line, but is nevertheless accepted. *) #define TWICE(e) e + ecppo-1.8.0/test/dune000066400000000000000000000165531472354332100143340ustar00rootroot00000000000000;; --------------------------------------------------------------------------- ;; Positive tests. (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 -V COQ:8.13+beta1 -V OCAML:4.12.0~alpha1 %{<})))) (rule (targets test.out) (deps (:< test.cppo) incl.cppo incl2.cppo) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (targets lexical.out) (deps (:< lexical.cppo)) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (targets scope.out) (deps (:< scope.cppo)) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (targets higher_order_macros.out) (deps (:< higher_order_macros.cppo)) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (targets include_define_on_last_line.out) (deps (:< include_define_on_last_line.cppo) define_on_last_line.cppo) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (targets def.out) (deps (:< def.cppo)) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) (rule (alias runtest) (package cppo) (action (diff ext.ref ext.out))) (rule (alias runtest) (package cppo) (action (diff comments.ref comments.out))) (rule (alias runtest) (package cppo) (action (diff cond.ref cond.out))) (rule (alias runtest) (package cppo) (action (diff tuple.ref tuple.out))) (rule (alias runtest) (package cppo) (action (diff loc.ref loc.out))) (rule (alias runtest) (package cppo) (action (diff paren_arg.ref paren_arg.out))) (rule (alias runtest) (package cppo) (action (diff version.ref version.out))) (rule (alias runtest) (package cppo) (action (diff unmatched.ref unmatched.out))) (rule (alias runtest) (package cppo) (action (diff test.ref test.out))) (rule (alias runtest) (package cppo) (action (diff lexical.ref lexical.out))) (rule (alias runtest) (package cppo) (action (diff scope.ref scope.out))) (rule (alias runtest) (package cppo) (action (diff higher_order_macros.ref higher_order_macros.out))) (rule (alias runtest) (package cppo) (action (diff include_define_on_last_line.ref include_define_on_last_line.out))) (rule (alias runtest) (package cppo) (action (diff def.ref def.out))) ;; --------------------------------------------------------------------------- ;; Negative tests. (rule (targets arity_mismatch.err) (deps (:< arity_mismatch.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff arity_mismatch.ref arity_mismatch.err))) (rule (targets applied_to_none.err) (deps (:< applied_to_none.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff applied_to_none.ref applied_to_none.err))) (rule (targets expects_no_args.err) (deps (:< expects_no_args.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff expects_no_args.ref expects_no_args.err))) (rule (targets already_defined.err) (deps (:< already_defined.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff already_defined.ref already_defined.err))) (rule (targets at_least_one_arg.err) (deps (:< at_least_one_arg.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff at_least_one_arg.ref at_least_one_arg.err))) (rule (targets comment_in_formals.err) (deps (:< comment_in_formals.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff comment_in_formals.ref comment_in_formals.err))) (rule (targets arity_mismatch_indirect.err) (deps (:< arity_mismatch_indirect.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff arity_mismatch_indirect.ref arity_mismatch_indirect.err))) (rule (targets expect_ident.err) (deps (:< expect_ident.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff expect_ident.ref expect_ident.err))) (rule (targets expect_ident_empty.err) (deps (:< expect_ident_empty.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff expect_ident_empty.ref expect_ident_empty.err))) (rule (targets undefined.err) (deps (:< undefined.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff undefined.ref undefined.err))) (rule (targets shape_mismatch.err) (deps (:< shape_mismatch.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff shape_mismatch.ref shape_mismatch.err))) (rule (targets int_expansion_error.err) (deps (:< int_expansion_error.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff int_expansion_error.ref int_expansion_error.err))) (rule (targets extraneous_enddef.err) (deps (:< extraneous_enddef.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff extraneous_enddef.ref extraneous_enddef.err))) (rule (targets missing_enddef.err) (deps (:< missing_enddef.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff missing_enddef.ref missing_enddef.err))) (rule (targets missing_endscope.err) (deps (:< missing_endscope.cppo)) (action (with-stderr-to %{targets} (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) (rule (alias runtest) (package cppo) (action (diff missing_endscope.ref missing_endscope.err))) cppo-1.8.0/test/expect_ident.cppo000066400000000000000000000002761472354332100170070ustar00rootroot00000000000000let id x = x #define ID(X) X #define APPLY(F : [.], X) F(X) APPLY(ID(id), 42) (* invalid because APPLY expects a macro as an argument: ID would be a valid argument; ID(id) is not. *) cppo-1.8.0/test/expect_ident.ref000066400000000000000000000001611472354332100166130ustar00rootroot00000000000000Error: File "expect_ident.cppo", line 4, characters 6-12 Error: The name of a macro is expected in this position cppo-1.8.0/test/expect_ident_empty.cppo000066400000000000000000000002551472354332100202220ustar00rootroot00000000000000let id x = x #define ID(X) X #define APPLY(F : [.], X) F(X) APPLY(, 42) (* invalid because APPLY expects a macro as an argument: an empty argument is not allowed. *) cppo-1.8.0/test/expect_ident_empty.ref000066400000000000000000000001661472354332100200360ustar00rootroot00000000000000Error: File "expect_ident_empty.cppo", line 4, characters 6-6 Error: The name of a macro is expected in this position cppo-1.8.0/test/expects_no_args.cppo000066400000000000000000000001311472354332100175050ustar00rootroot00000000000000(* A non-parameterized macro is given actual arguments. *) #define FOO "foo" 1 + FOO(42) cppo-1.8.0/test/expects_no_args.ref000066400000000000000000000001721472354332100173250ustar00rootroot00000000000000Error: File "expects_no_args.cppo", line 3, characters 4-11 Error: "FOO" expects 0 argument but is applied to 1 argument. cppo-1.8.0/test/ext.cppo000066400000000000000000000001071472354332100151250ustar00rootroot00000000000000hello #ext rot13 abc \#endext def #endext goodbye #ext source #endext cppo-1.8.0/test/ext.ref000066400000000000000000000003711472354332100147430ustar00rootroot00000000000000# 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 cppo-1.8.0/test/extraneous_enddef.cppo000066400000000000000000000001361472354332100200310ustar00rootroot00000000000000#define FOO \ 42 (* The following #enddef is extraneous; it should not be there. *) #enddef cppo-1.8.0/test/extraneous_enddef.ref000066400000000000000000000001211472354332100176360ustar00rootroot00000000000000Error: File "extraneous_enddef.cppo", line 4, characters 0-8 Error: syntax error cppo-1.8.0/test/higher_order_macros.cppo000066400000000000000000000036151472354332100203410ustar00rootroot00000000000000(* This macro application combinator provides call-by-value semantics: the actual argument is evaluated up front and its value is bound to a variable, which is passed as an argument to the macro [F]. *) #define APPLY(F : [.], X : .)(let __x = (X) in F(__x)) (* Some trivial tests. *) #define ID(X) X #define C 42 let forty_one = APPLY(ID, 41) let forty_two = APPLY(ID, C ) (* A [for]-loop macro. *) #define LOOP(start, finish, body : [.]) (\ for __index = start to finish-1 do\ body(__index)\ done\ ) (* A [for]-loop macro that performs unrolling. *) #define UNROLLED_LOOP(start, finish, body : [.]) (\ let __finish = (finish) in\ let __index = ref (start) in\ while !__index + 2 <= __finish do\ APPLY(body, !__index);\ APPLY(body, !__index + 1);\ __index := !__index + 2\ done;\ while !__index < __finish do\ APPLY(body, !__index);\ __index := !__index + 1\ done\ ) (* In some of the examples that follow, #scope ... #endscope is used to avoid the need to #undefine local macros such as BODY and F. *) (* Iteration over an array, with a normal loop. *) let iter f a = #scope #define BODY(i) (f a.(i)) LOOP(0, Array.length a, BODY) #endscope (* Iteration over an array, with an unrolled loop. *) let unrolled_iter f a = #scope #define BODY(i) (f a.(i)) UNROLLED_LOOP(0, Array.length a, BODY) #endscope (* Printing an array, with a normal loop. *) let print_int_array a = #define F(i) Printf.printf "%d" a.(i) LOOP(0, Array.length a, F) (* A higher-order macro that produces a definition of [iter], and accepts an arbitrary definition of the macro [LOOP]. *) #define BODY(i) (f a.(i)) #define DEFINE_ITER(iter, LOOP : [..[.]]) \ let iter f a = \ LOOP(0, Array.length a, BODY) #undef BODY (* Some noise, which does not affect the above definitions. *) #define BODY(i) "noise" DEFINE_ITER(iter, LOOP) DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) cppo-1.8.0/test/higher_order_macros.ref000066400000000000000000000050411472354332100201470ustar00rootroot00000000000000# 1 "higher_order_macros.cppo" (* This macro application combinator provides call-by-value semantics: the actual argument is evaluated up front and its value is bound to a variable, which is passed as an argument to the macro [F]. *) # 7 "higher_order_macros.cppo" (* Some trivial tests. *) # 10 "higher_order_macros.cppo" let forty_one = # 10 "higher_order_macros.cppo" (let __x = ( 41) in __x ) # 11 "higher_order_macros.cppo" let forty_two = # 11 "higher_order_macros.cppo" (let __x = ( 42 ) in __x ) # 13 "higher_order_macros.cppo" (* A [for]-loop macro. *) # 20 "higher_order_macros.cppo" (* A [for]-loop macro that performs unrolling. *) # 35 "higher_order_macros.cppo" (* In some of the examples that follow, #scope ... #endscope is used to avoid the need to #undefine local macros such as BODY and F. *) (* Iteration over an array, with a normal loop. *) let iter f a = # 42 "higher_order_macros.cppo" ( for __index = 0 to Array.length a-1 do (f a.(__index)) done ) # 45 "higher_order_macros.cppo" (* Iteration over an array, with an unrolled loop. *) let unrolled_iter f a = # 49 "higher_order_macros.cppo" ( let __finish = ( Array.length a) in let __index = ref (0) in while !__index + 2 <= __finish do (let __x = ( !__index) in (f a.(__x)) ) ; (let __x = ( !__index + 1) in (f a.(__x)) ) ; __index := !__index + 2 done; while !__index < __finish do (let __x = ( !__index) in (f a.(__x)) ) ; __index := !__index + 1 done ) # 52 "higher_order_macros.cppo" (* Printing an array, with a normal loop. *) let print_int_array a = # 55 "higher_order_macros.cppo" ( for __index = 0 to Array.length a-1 do Printf.printf "%d" a.(__index) done ) # 57 "higher_order_macros.cppo" (* A higher-order macro that produces a definition of [iter], and accepts an arbitrary definition of the macro [LOOP]. *) # 65 "higher_order_macros.cppo" (* Some noise, which does not affect the above definitions. *) # 68 "higher_order_macros.cppo" let iter f a = ( for __index = 0 to Array.length a-1 do (f a.(__index)) done ) # 69 "higher_order_macros.cppo" let unrolled_iter f a = ( let __finish = ( Array.length a) in let __index = ref (0) in while !__index + 2 <= __finish do (let __x = ( !__index) in (f a.(__x)) ) ; (let __x = ( !__index + 1) in (f a.(__x)) ) ; __index := !__index + 2 done; while !__index < __finish do (let __x = ( !__index) in (f a.(__x)) ) ; __index := !__index + 1 done ) cppo-1.8.0/test/incl.cppo000066400000000000000000000000401472354332100152460ustar00rootroot00000000000000included #include "incl2.cppo" cppo-1.8.0/test/incl2.cppo000066400000000000000000000000031472354332100153270ustar00rootroot00000000000000ok cppo-1.8.0/test/include_define_on_last_line.cppo000066400000000000000000000001631472354332100220120ustar00rootroot00000000000000#include "define_on_last_line.cppo" (* Check that the definition of TWICE has been accepted: *) let f x = TWICE(x) cppo-1.8.0/test/include_define_on_last_line.ref000066400000000000000000000004231472354332100216240ustar00rootroot00000000000000# 1 "define_on_last_line.cppo" (* This #define is NOT ended by a new line, but is nevertheless accepted. *) # 2 "include_define_on_last_line.cppo" (* Check that the definition of TWICE has been accepted: *) let f x = # 3 "include_define_on_last_line.cppo" x + x cppo-1.8.0/test/int_expansion_error.cppo000066400000000000000000000000651472354332100204170ustar00rootroot00000000000000#define FOO 3+3 #if FOO = 0 let x = "Hello" #endif cppo-1.8.0/test/int_expansion_error.ref000066400000000000000000000003401472354332100202260ustar00rootroot00000000000000Error: File "int_expansion_error.cppo", line 2, characters 4-7 Error: Variable FOO 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. cppo-1.8.0/test/lexical.cppo000066400000000000000000000015521472354332100157530ustar00rootroot00000000000000(* This test shows that the definition of BAR captures the original definition of FOO, so even if FOO is redefined, the expansion of BAR does not change. *) #define FOO "original definition" #define BAR FOO #undef FOO #define FOO "new definition" FOO (* expands to "new definition" *) BAR (* expands to "original definition" *) (* This test shows that a formal parameter can shadow a previously defined macro. *) #define F(FOO) FOO F(42) (* expands to 42 *) (* This test shows that two formal parameters can have the same name. In that case, the second parameter shadows the first one. *) #define G(X, X) X+X G(42,23) (* expands to 23+23 *) (* This test shows that it is OK to pass an empty argument to a macro that expects one parameter. This is interpreted as passing one empty argument. *) #define expect(x) show(x) expect(42) expect("23") expect() cppo-1.8.0/test/lexical.ref000066400000000000000000000017671472354332100155760ustar00rootroot00000000000000# 1 "lexical.cppo" (* This test shows that the definition of BAR captures the original definition of FOO, so even if FOO is redefined, the expansion of BAR does not change. *) # 8 "lexical.cppo" "new definition" # 8 "lexical.cppo" (* expands to "new definition" *) # 9 "lexical.cppo" "original definition" # 9 "lexical.cppo" (* expands to "original definition" *) (* This test shows that a formal parameter can shadow a previously defined macro. *) # 14 "lexical.cppo" 42 # 14 "lexical.cppo" (* expands to 42 *) (* This test shows that two formal parameters can have the same name. In that case, the second parameter shadows the first one. *) # 19 "lexical.cppo" 23+23 # 19 "lexical.cppo" (* expands to 23+23 *) (* This test shows that it is OK to pass an empty argument to a macro that expects one parameter. This is interpreted as passing one empty argument. *) # 25 "lexical.cppo" show(42) # 26 "lexical.cppo" show("23") # 27 "lexical.cppo" show() cppo-1.8.0/test/loc.cppo000066400000000000000000000001201472354332100150750ustar00rootroot00000000000000#define loc __FILE__ __LINE__ loc X(loc) X(loc) X(Y(loc)) #define F(x) loc F() cppo-1.8.0/test/loc.ref000066400000000000000000000004051472354332100147160ustar00rootroot00000000000000# 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 cppo-1.8.0/test/missing_enddef.cppo000066400000000000000000000003721472354332100173070ustar00rootroot00000000000000(* A common problem: *) #def TWICE(e) e + e (* missing #enddef here *) let f x = TWICE(x) (* The error is detected by the parser at the end of the file, but we are able to report the location of the #def as the source of the problem. *) cppo-1.8.0/test/missing_enddef.ref000066400000000000000000000001701472354332100171160ustar00rootroot00000000000000Error: File "missing_enddef.cppo", line 3, characters 0-13 Error: This #def is never closed: perhaps #enddef is missing cppo-1.8.0/test/missing_endscope.cppo000066400000000000000000000004151472354332100176600ustar00rootroot00000000000000(* A common problem: *) #scope #def TWICE(e) e + e #enddef (* missing #endscope here *) let f x = TWICE(x) (* The error is detected by the parser at the end of the file, but we are able to report the location of the #scope as the source of the problem. *) cppo-1.8.0/test/missing_endscope.ref000066400000000000000000000001751472354332100174760ustar00rootroot00000000000000Error: File "missing_endscope.cppo", line 3, characters 0-6 Error: This #scope is never closed: perhaps #endscope is missing cppo-1.8.0/test/paren_arg.cppo000066400000000000000000000000721472354332100162640ustar00rootroot00000000000000#define F(x, y) F((1, (2)), 34) F((1\,\(2\)), 34) cppo-1.8.0/test/paren_arg.ref000066400000000000000000000001221472354332100160730ustar00rootroot00000000000000# 2 "paren_arg.cppo" <(1, (2))> < 34> # 3 "paren_arg.cppo" <(1 , (2 ))> < 34> cppo-1.8.0/test/scope.cppo000066400000000000000000000043241472354332100154430ustar00rootroot00000000000000(* This example shows that the definition of FOO that is nested inside the (multi-line) definition of BAR affects only the body of the definition of BAR. It does not affect the text that follows a call to BAR. So, a multi-line macro definition acts as a scope delimiter. *) #def BAR #define FOO "definition of FOO inside BAR" FOO (* expands to "definition of FOO inside BAR" *) #enddef #define FOO "definition of FOO at the top level" FOO (* expands to "definition of FOO at the top level" *) BAR FOO (* expands to "definition of FOO at the top level" *) (* If one wishes to delimit a scope, without actually defining a macro, one can use #scope ... #endscope. *) #scope #define HELLO "first definition of HELLO" HELLO (* expands to "first definition of HELLO" *) #endscope #scope #define HELLO "second definition of HELLO" HELLO (* expands to "second definition of HELLO" *) #endscope HELLO (* this does not expand *) (* The effect of #scope ... #endscope can be simulated by writing #def DUMMY ... #enddef DUMMY #undef DUMMY but this is a bit unnatural. *) #def DUMMY #define HELLO "definition of HELLO inside the scope" HELLO (* expands to "definition of HELLO inside the scope" *) #enddef DUMMY #undef DUMMY HELLO (* this does not expand *) (* Another simple example. *) #scope #define HI "I am defined" let x = HI (* expands to "I am defined" *) #endscope #define HI 42 let y = HI (* expands to 42 *) (* Check that the effect of #undef is also local. This example relies on the above definition of HI. *) #scope #undef HI let qwd = HI (* HI is not recognized as a macro and expands to itself *) #endscope let z = HI (* expands to 42 *) (* Scopes can be nested. *) #define LEVEL 0 let x = LEVEL (* expands to 0 *) #scope #undef LEVEL #define LEVEL 1 let y = LEVEL (* expands to 1 *) #scope #undef LEVEL #define LEVEL 2 let z = LEVEL (* expands to 2 *) #endscope let _ = LEVEL (* expands to 1 *) #endscope let _ = LEVEL (* expands to 0 *) (* Another example of nesting. *) #scope #define HELLO "Hello, " #scope #define MAN "man" let message1 = HELLO ^ MAN #endscope (* Here, MAN is no longer defined, but HELLO still is. *) let message2 = HELLO ^ "world" #endscope cppo-1.8.0/test/scope.ref000066400000000000000000000056161472354332100152630ustar00rootroot00000000000000# 1 "scope.cppo" (* This example shows that the definition of FOO that is nested inside the (multi-line) definition of BAR affects only the body of the definition of BAR. It does not affect the text that follows a call to BAR. So, a multi-line macro definition acts as a scope delimiter. *) # 11 "scope.cppo" "definition of FOO at the top level" # 11 "scope.cppo" (* expands to "definition of FOO at the top level" *) # 12 "scope.cppo" "definition of FOO inside BAR" (* expands to "definition of FOO inside BAR" *) # 13 "scope.cppo" "definition of FOO at the top level" # 13 "scope.cppo" (* expands to "definition of FOO at the top level" *) (* If one wishes to delimit a scope, without actually defining a macro, one can use #scope ... #endscope. *) # 20 "scope.cppo" "first definition of HELLO" # 20 "scope.cppo" (* expands to "first definition of HELLO" *) # 24 "scope.cppo" "second definition of HELLO" # 24 "scope.cppo" (* expands to "second definition of HELLO" *) HELLO (* this does not expand *) (* The effect of #scope ... #endscope can be simulated by writing #def DUMMY ... #enddef DUMMY #undef DUMMY but this is a bit unnatural. *) # 36 "scope.cppo" "definition of HELLO inside the scope" (* expands to "definition of HELLO inside the scope" *) # 38 "scope.cppo" HELLO (* this does not expand *) (* Another simple example. *) # 44 "scope.cppo" let x = # 44 "scope.cppo" "I am defined" # 44 "scope.cppo" (* expands to "I am defined" *) # 47 "scope.cppo" let y = # 47 "scope.cppo" 42 # 47 "scope.cppo" (* expands to 42 *) (* Check that the effect of #undef is also local. This example relies on the above definition of HI. *) # 54 "scope.cppo" let qwd = HI (* HI is not recognized as a macro and expands to itself *) let z = # 56 "scope.cppo" 42 # 56 "scope.cppo" (* expands to 42 *) (* Scopes can be nested. *) # 61 "scope.cppo" let x = # 61 "scope.cppo" 0 # 61 "scope.cppo" (* expands to 0 *) # 65 "scope.cppo" let y = # 65 "scope.cppo" 1 # 65 "scope.cppo" (* expands to 1 *) # 69 "scope.cppo" let z = # 69 "scope.cppo" 2 # 69 "scope.cppo" (* expands to 2 *) let _ = # 71 "scope.cppo" 1 # 71 "scope.cppo" (* expands to 1 *) let _ = # 73 "scope.cppo" 0 # 73 "scope.cppo" (* expands to 0 *) (* Another example of nesting. *) # 81 "scope.cppo" let message1 = # 81 "scope.cppo" "Hello, " # 81 "scope.cppo" ^ # 81 "scope.cppo" "man" # 83 "scope.cppo" (* Here, MAN is no longer defined, but HELLO still is. *) let message2 = # 84 "scope.cppo" "Hello, " # 84 "scope.cppo" ^ "world" cppo-1.8.0/test/shape_mismatch.cppo000066400000000000000000000002171472354332100173140ustar00rootroot00000000000000#define FOO 24 #define APPLY(F : [.], X) F(X) APPLY(FOO, 42) (* invalid because APPLY expects a macro of type [.] but FOO has type . *) cppo-1.8.0/test/shape_mismatch.ref000066400000000000000000000002151472354332100171250ustar00rootroot00000000000000Error: File "shape_mismatch.cppo", line 3, characters 6-9 Error: A macro of type [.] was expected, but a macro of type . was provided cppo-1.8.0/test/source.sh000077500000000000000000000003621472354332100153040ustar00rootroot00000000000000#! /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" cppo-1.8.0/test/test.cppo000066400000000000000000000041351472354332100153110ustar00rootroot00000000000000(* 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\ xyz def" \ (* 123 \ 789 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 = 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 cppo-1.8.0/test/test.ref000066400000000000000000000034061472354332100151240ustar00rootroot00000000000000# 1 "test.cppo" (* comment *) # 4 "test.cppo" f(1) # 6 "test.cppo" 2+ 3.14 # 8 "test.cppo" 3+ 3.14 # 13 "test.cppo" "g" is not defined # 18 "test.cppo" b() # 20 "test.cppo" debug("a") debug("b") # 33 "test.cppo" success # 45 "test.cppo" "abc\ xyz def" (* 123 \ 789 456 *) # 48 "test.cppo" "a" "b" # 51 "test.cppo" aa ,bb 123 # 54 "test.cppo" , ) ( # 56 "test.cppo" blah #define xyz # 63 "test.cppo" _ _ (* the 2 underscores should be space-separated *) # 67 "test.cppo" + + (* there should be some space between the pluses *) # 69 "test.cppo" (* (* nested comment with single single quote: ' *) "*)" *) # 72 "test.cppo" obj # define # 73 "test.cppo" # 75 "test.cppo" ' (* lone single quote *) # 78 "test.cppo" 1 # 78 "test.cppo" = 1 # 82 "test.cppo" # # 82 "test.cppo" is # # 98 "test.cppo" good maths # 117 "test.cppo" let g x = printf "call %s\n%!" "g"; let y = g x in printf "return %s\n%!" "g"; y ;; # 124 "test.cppo" class foo () = object # 126 "test.cppo" val mutable field_1 : int option method get_field_1 = field_1 method set_field_1 x = field_1 <- Some x # 127 "test.cppo" val mutable field_2 : string option method get_field_2 = field_2 method set_field_2 x = field_2 <- Some x # 128 "test.cppo" end # 135 "test.cppo" (if !debug then eprintf "[debug] %s %i: " "test.cppo" 135 ; eprintf "test1 %i %i" x y; eprintf "\n") # 136 "test.cppo" (if !debug then eprintf "[debug] %s %i: " "test.cppo" 136 ; eprintf "test2 %i" x; eprintf "\n") # 1 "incl.cppo" included # 1 "incl2.cppo" ok # 139 "test.cppo" # 123456 # 789 "test" # 1 "incl.cppo" included # 1 "incl2.cppo" ok # 793 "test" end cppo-1.8.0/test/tuple.cppo000066400000000000000000000006041472354332100154600ustar00rootroot00000000000000#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 cppo-1.8.0/test/tuple.ref000066400000000000000000000002341472354332100152720ustar00rootroot00000000000000 # 5 "tuple.cppo" pistachios # 9 "tuple.cppo" trees # 16 "tuple.cppo" waves # 28 "tuple.cppo" bees # 34 "tuple.cppo" steamboat cppo-1.8.0/test/undefined.cppo000066400000000000000000000002111472354332100162620ustar00rootroot00000000000000#define APPLY(F : [.], X) F(X) APPLY(FOO, 42) (* invalid because APPLY expects a macro as an argument: but FOO is not defined. *) cppo-1.8.0/test/undefined.ref000066400000000000000000000001331472354332100161000ustar00rootroot00000000000000Error: File "undefined.cppo", line 2, characters 6-9 Error: The macro 'FOO' is not defined cppo-1.8.0/test/unmatched.cppo000066400000000000000000000001651472354332100163010ustar00rootroot00000000000000#ifdef whatever ( #else let a = 1 in let b = 2 in (a || #endif b) #define F(x, y) (x + y) F(1,(2+3)) ) ( cppo-1.8.0/test/unmatched.ref000066400000000000000000000002331472354332100161100ustar00rootroot00000000000000 # 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" ) ( cppo-1.8.0/test/version.cppo000066400000000000000000000006461472354332100160220ustar00rootroot00000000000000#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 Coq: COQ_VERSION OCaml pre-release: OCAML_PRERELEASE cppo-1.8.0/test/version.ref000066400000000000000000000010711472354332100156260ustar00rootroot00000000000000 # 5 "version.cppo" Cape buffalos # 10 "version.cppo" onion rings # 16 "version.cppo" major: # 16 "version.cppo" 123 # 17 "version.cppo" minor: # 17 "version.cppo" 05 # 18 "version.cppo" patch: # 18 "version.cppo" 2 # 21 "version.cppo" prerelease: # 21 "version.cppo" alpha.1 # 27 "version.cppo" build: # 27 "version.cppo" foo-2.1 # 32 "version.cppo" Coq: # 32 "version.cppo" (8, 13, 0) # 34 "version.cppo" OCaml pre-release: # 34 "version.cppo" alpha1