This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
15
unikernel/duniverse/cppo/.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
15
unikernel/duniverse/cppo/.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
<!-- Thank you for your contribution.
|
||||
Make sure you read the contributing guide and fill this template. -->
|
||||
|
||||
|
||||
<!-- If this is a bug fix, make sure the bug was reported beforehand. -->
|
||||
Fixes / closes #????
|
||||
|
||||
|
||||
<!-- Remove anything that doesn't apply in the following checklist. -->
|
||||
|
||||
<!-- If there is a user-visible change and testing is not prohibitively expensive: -->
|
||||
- [ ] Added / updated [**test-suite**](test).
|
||||
|
||||
<!-- If this is a feature pull request / breaks compatibility: -->
|
||||
- [ ] Added [**changelog**](Changes.md).
|
||||
6
unikernel/duniverse/cppo/.github/dependabot.yml
vendored
Normal file
6
unikernel/duniverse/cppo/.github/dependabot.yml
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
version: 2
|
||||
updates:
|
||||
- package-ecosystem: github-actions
|
||||
directory: /
|
||||
schedule:
|
||||
interval: weekly
|
||||
198
unikernel/duniverse/cppo/.github/workflows/build.yml
vendored
Normal file
198
unikernel/duniverse/cppo/.github/workflows/build.yml
vendored
Normal file
|
|
@ -0,0 +1,198 @@
|
|||
---
|
||||
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
|
||||
6
unikernel/duniverse/cppo/.gitignore
vendored
Normal file
6
unikernel/duniverse/cppo/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*~
|
||||
_build
|
||||
.merlin
|
||||
*.install
|
||||
.*.swp
|
||||
*.opam
|
||||
22
unikernel/duniverse/cppo/.ocp-indent
Normal file
22
unikernel/duniverse/cppo/.ocp-indent
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
# See https://github.com/OCamlPro/ocp-indent/blob/master/.ocp-indent for more
|
||||
|
||||
# Indent for clauses inside a pattern-match (after the arrow):
|
||||
# match foo with
|
||||
# | _ ->
|
||||
# ^^^^bar
|
||||
# the default is 2, which aligns the pattern and the expression
|
||||
match_clause = 4
|
||||
|
||||
# When nesting expressions on the same line, their indentation are in
|
||||
# some cases stacked, so that it remains correct if you close them one
|
||||
# at a line. This may lead to large indents in complex code though, so
|
||||
# this parameter can be used to set a maximum value. Note that it only
|
||||
# affects indentation after function arrows and opening parens at end
|
||||
# of line.
|
||||
#
|
||||
# for example (left: `none`; right: `4`)
|
||||
# let f = g (h (i (fun x -> # let f = g (h (i (fun x ->
|
||||
# x) # x)
|
||||
# ) # )
|
||||
# ) # )
|
||||
max_indent = 2
|
||||
16
unikernel/duniverse/cppo/.travis.yml
Normal file
16
unikernel/duniverse/cppo/.travis.yml
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
language: c
|
||||
sudo: required
|
||||
install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
|
||||
script: bash -ex .travis-opam.sh
|
||||
env:
|
||||
global:
|
||||
- PACKAGE=cppo
|
||||
matrix:
|
||||
- OCAML_VERSION=4.03
|
||||
- OCAML_VERSION=4.04
|
||||
- OCAML_VERSION=4.05
|
||||
- OCAML_VERSION=4.06
|
||||
- OCAML_VERSION=4.07
|
||||
os:
|
||||
- linux
|
||||
- osx
|
||||
10
unikernel/duniverse/cppo/CODEOWNERS
Normal file
10
unikernel/duniverse/cppo/CODEOWNERS
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
# 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
|
||||
105
unikernel/duniverse/cppo/Changes.md
Normal file
105
unikernel/duniverse/cppo/Changes.md
Normal file
|
|
@ -0,0 +1,105 @@
|
|||
## 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
|
||||
17
unikernel/duniverse/cppo/INSTALL.md
Normal file
17
unikernel/duniverse/cppo/INSTALL.md
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
Installation instructions for cppo
|
||||
==================================
|
||||
|
||||
Building cppo requires GNU Make and a standard OCaml
|
||||
installation. It can be installed with opam or manually as follows:
|
||||
|
||||
Build:
|
||||
|
||||
```
|
||||
make
|
||||
```
|
||||
|
||||
Install:
|
||||
|
||||
```
|
||||
make DESTDIR=/some/path install
|
||||
```
|
||||
24
unikernel/duniverse/cppo/LICENSE.md
Normal file
24
unikernel/duniverse/cppo/LICENSE.md
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
Copyright (c) 2009-2011 Martin Jambon
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. 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.
|
||||
67
unikernel/duniverse/cppo/Makefile
Normal file
67
unikernel/duniverse/cppo/Makefile
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
.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
|
||||
736
unikernel/duniverse/cppo/README.md
Normal file
736
unikernel/duniverse/cppo/README.md
Normal file
|
|
@ -0,0 +1,736 @@
|
|||
[](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 "<stdin>"
|
||||
(* 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
|
||||
14
unikernel/duniverse/cppo/appveyor.yml
Normal file
14
unikernel/duniverse/cppo/appveyor.yml
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
|
||||
environment:
|
||||
matrix:
|
||||
- OCAML_BRANCH: 4.05
|
||||
- OCAML_BRANCH: 4.06
|
||||
|
||||
install:
|
||||
- appveyor DownloadFile "https://raw.githubusercontent.com/Chris00/ocaml-appveyor/master/install_ocaml.cmd" -FileName "C:\install_ocaml.cmd"
|
||||
- C:\install_ocaml.cmd
|
||||
|
||||
build_script:
|
||||
- cd "%APPVEYOR_BUILD_FOLDER%"
|
||||
- dune subst
|
||||
- dune build -p cppo
|
||||
45
unikernel/duniverse/cppo/dune-project
Normal file
45
unikernel/duniverse/cppo/dune-project
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
(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 <martin@mjambon.com>"
|
||||
"Yishuai Li <yishuai@upenn.edu>")
|
||||
(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).
|
||||
"))
|
||||
8
unikernel/duniverse/cppo/examples/Makefile
Normal file
8
unikernel/duniverse/cppo/examples/Makefile
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
.PHONY: all clean
|
||||
all:
|
||||
../cppo debug.ml > debug.out
|
||||
../cppo french.ml > french.out
|
||||
ocamllex lexer.mll
|
||||
../cppo lexer.ml > lexer.out
|
||||
clean:
|
||||
rm -f *.out lexer.ml
|
||||
7
unikernel/duniverse/cppo/examples/debug.ml
Normal file
7
unikernel/duniverse/cppo/examples/debug.ml
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#ifdef DEBUG
|
||||
#define debug(s) Printf.eprintf "[%S %i] %s\n%!" __FILE__ __LINE__ s
|
||||
#else
|
||||
#define debug(s) ()
|
||||
#endif
|
||||
|
||||
debug("test")
|
||||
32
unikernel/duniverse/cppo/examples/dune
Normal file
32
unikernel/duniverse/cppo/examples/dune
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
(ocamllex lexer)
|
||||
|
||||
(rule
|
||||
(deps
|
||||
(:< debug.ml))
|
||||
(targets debug.out)
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{targets}
|
||||
(run %{bin:cppo} %{<}))))
|
||||
|
||||
(rule
|
||||
(deps
|
||||
(:< french.ml))
|
||||
(targets french.out)
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{targets}
|
||||
(run %{bin:cppo} %{<}))))
|
||||
|
||||
(rule
|
||||
(deps
|
||||
(:< lexer.ml))
|
||||
(targets lexer.out)
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{targets}
|
||||
(run %{bin:cppo} %{<}))))
|
||||
|
||||
(alias
|
||||
(name DEFAULT)
|
||||
(deps debug.out french.out lexer.out))
|
||||
34
unikernel/duniverse/cppo/examples/french.ml
Normal file
34
unikernel/duniverse/cppo/examples/french.ml
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
#define soit let
|
||||
#define fonction function
|
||||
#define fon fun
|
||||
#define dans in
|
||||
#define si if
|
||||
#define alors then
|
||||
#define sinon else
|
||||
|
||||
#define Liste List
|
||||
#define Affichef Printf
|
||||
#define affichef printf
|
||||
|
||||
#define separation split
|
||||
#define tri sort
|
||||
|
||||
soit rec separation x = fonction
|
||||
y :: l ->
|
||||
soit l1, l2 = separation x l dans
|
||||
si y < x alors (y :: l1), l2
|
||||
sinon l1, (y :: l2)
|
||||
| [] ->
|
||||
[], []
|
||||
|
||||
soit rec tri = fonction
|
||||
x :: l ->
|
||||
soit l1, l2 = separation x l dans
|
||||
tri l1 @ [x] @ tri l2
|
||||
| [] ->
|
||||
[]
|
||||
|
||||
soit () =
|
||||
soit l = tri [ 5; 3; 7; 1; 7; 4; 99; 22 ] dans
|
||||
Liste.iter (fon i -> Affichef.affichef "%i " i) l;
|
||||
Affichef.affichef "\n"
|
||||
9
unikernel/duniverse/cppo/examples/lexer.mll
Normal file
9
unikernel/duniverse/cppo/examples/lexer.mll
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
(* Warning: ocamllex doesn't accept cppo directives
|
||||
within the rules section. *)
|
||||
rule token = parse
|
||||
['a'-'z']+ { `String (Lexing.lexeme lexbuf) }
|
||||
{
|
||||
#ifndef NOFOO
|
||||
let foo () = ()
|
||||
#endif
|
||||
}
|
||||
1
unikernel/duniverse/cppo/ocamlbuild_plugin/_tags
Normal file
1
unikernel/duniverse/cppo/ocamlbuild_plugin/_tags
Normal file
|
|
@ -0,0 +1 @@
|
|||
true: package(ocamlbuild)
|
||||
6
unikernel/duniverse/cppo/ocamlbuild_plugin/dune
Normal file
6
unikernel/duniverse/cppo/ocamlbuild_plugin/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name cppo_ocamlbuild)
|
||||
(public_name cppo_ocamlbuild)
|
||||
(wrapped false)
|
||||
(synopsis "Cppo ocamlbuild plugin")
|
||||
(libraries ocamlbuild))
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
open Ocamlbuild_plugin
|
||||
|
||||
let cppo_rules ext =
|
||||
let dep = "%(name).cppo"-.-ext
|
||||
and prod1 = "%(name: <*> and not <*.cppo>)"-.-ext
|
||||
and prod2 = "%(name: <**/*> and not <**/*.cppo>)"-.-ext in
|
||||
let cppo_rule prod env _build =
|
||||
let dep = env dep in
|
||||
let prod = env prod in
|
||||
let tags = tags_of_pathname prod ++ "cppo" in
|
||||
Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ])
|
||||
in
|
||||
rule ("cppo: *.cppo."-.-ext^" -> *."-.-ext) ~dep ~prod:prod1 (cppo_rule prod1);
|
||||
rule ("cppo: **/*.cppo."-.-ext^" -> **/*."-.-ext) ~dep ~prod:prod2 (cppo_rule prod2)
|
||||
|
||||
let dispatcher = function
|
||||
| After_rules -> begin
|
||||
List.iter cppo_rules ["ml"; "mli"; "mlpack"];
|
||||
pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ;
|
||||
pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ;
|
||||
pflag ["cppo"] "cppo_I" (fun s ->
|
||||
if Pathname.is_directory s then S [A "-I"; P s]
|
||||
else S [A "-I"; P (Pathname.dirname s)]
|
||||
) ;
|
||||
pdep ["cppo"] "cppo_I" (fun s ->
|
||||
if Pathname.is_directory s then [] else [s]) ;
|
||||
flag ["cppo"; "cppo_q"] (A "-q") ;
|
||||
flag ["cppo"; "cppo_s"] (A "-s") ;
|
||||
flag ["cppo"; "cppo_n"] (A "-n") ;
|
||||
pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]);
|
||||
pflag ["cppo"] "cppo_V" (fun s -> S [A "-V"; A s]);
|
||||
flag ["cppo"; "cppo_V_OCAML"] & S [A "-V"; A ("OCAML:" ^ Sys.ocaml_version)]
|
||||
end
|
||||
| _ -> ()
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
|
||||
(** [cppo_rules extension] will add rules to Ocamlbuild so that
|
||||
cppo is applied to files ending in "cppo.[extension]".
|
||||
|
||||
By default rules are inserted for files ending with "ml", "mli" and
|
||||
"mlpack". *)
|
||||
val cppo_rules : string -> unit
|
||||
|
||||
val dispatcher : Ocamlbuild_plugin.hook -> unit
|
||||
7
unikernel/duniverse/cppo/src/compat.ml
Normal file
7
unikernel/duniverse/cppo/src/compat.ml
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
if 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"
|
||||
63
unikernel/duniverse/cppo/src/cppo_command.ml
Normal file
63
unikernel/duniverse/cppo/src/cppo_command.ml
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
open Printf
|
||||
|
||||
type command_token =
|
||||
[ `Text of string
|
||||
| `Loc_file
|
||||
| `Loc_first_line
|
||||
| `Loc_last_line ]
|
||||
|
||||
type command_template = command_token list
|
||||
|
||||
let parse s : command_template =
|
||||
let rec loop acc buf s len i =
|
||||
if i >= len then
|
||||
let s = Buffer.contents buf in
|
||||
if s = "" then acc
|
||||
else `Text s :: acc
|
||||
else if i = len - 1 then (
|
||||
Buffer.add_char buf s.[i];
|
||||
`Text (Buffer.contents buf) :: acc
|
||||
)
|
||||
else
|
||||
let c = s.[i] in
|
||||
if c = '%' then
|
||||
let acc =
|
||||
let s = Buffer.contents buf in
|
||||
Buffer.clear buf;
|
||||
if s = "" then acc
|
||||
else
|
||||
`Text s :: acc
|
||||
in
|
||||
let x =
|
||||
match s.[i+1] with
|
||||
'F' -> `Loc_file
|
||||
| 'B' -> `Loc_first_line
|
||||
| 'E' -> `Loc_last_line
|
||||
| '%' -> `Text "%"
|
||||
| _ ->
|
||||
failwith (
|
||||
sprintf "Invalid escape sequence in command template %S. \
|
||||
Use %%%% for a %% sign." s
|
||||
)
|
||||
in
|
||||
loop (x :: acc) buf s len (i + 2)
|
||||
else (
|
||||
Buffer.add_char buf c;
|
||||
loop acc buf s len (i + 1)
|
||||
)
|
||||
in
|
||||
let len = String.length s in
|
||||
List.rev (loop [] (Buffer.create len) s len 0)
|
||||
|
||||
|
||||
let subst (cmd : command_template) file first last =
|
||||
let l =
|
||||
List.map (
|
||||
function
|
||||
`Text s -> s
|
||||
| `Loc_file -> file
|
||||
| `Loc_first_line -> string_of_int first
|
||||
| `Loc_last_line -> string_of_int last
|
||||
) cmd
|
||||
in
|
||||
String.concat "" l
|
||||
11
unikernel/duniverse/cppo/src/cppo_command.mli
Normal file
11
unikernel/duniverse/cppo/src/cppo_command.mli
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
type command_token =
|
||||
[ `Text of string
|
||||
| `Loc_file
|
||||
| `Loc_first_line
|
||||
| `Loc_last_line ]
|
||||
|
||||
type command_template = command_token list
|
||||
|
||||
val subst : command_template -> string -> int -> int -> string
|
||||
|
||||
val parse : string -> command_template
|
||||
781
unikernel/duniverse/cppo/src/cppo_eval.ml
Normal file
781
unikernel/duniverse/cppo/src/cppo_eval.ml
Normal file
|
|
@ -0,0 +1,781 @@
|
|||
open 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
|
||||
20
unikernel/duniverse/cppo/src/cppo_eval.mli
Normal file
20
unikernel/duniverse/cppo/src/cppo_eval.mli
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
(** 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
|
||||
851
unikernel/duniverse/cppo/src/cppo_lexer.mll
Normal file
851
unikernel/duniverse/cppo/src/cppo_lexer.mll
Normal file
|
|
@ -0,0 +1,851 @@
|
|||
{
|
||||
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 <name> 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 <name> 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
|
||||
}
|
||||
230
unikernel/duniverse/cppo/src/cppo_main.ml
Normal file
230
unikernel/duniverse/cppo/src/cppo_main.ml
Normal file
|
|
@ -0,0 +1,230 @@
|
|||
open Printf
|
||||
|
||||
let add_extension tbl s =
|
||||
let i =
|
||||
try String.index s ':'
|
||||
with Not_found ->
|
||||
failwith "Invalid -x argument"
|
||||
in
|
||||
let id = String.sub s 0 i in
|
||||
let raw_tpl = String.sub s (i+1) (String.length s - i - 1) in
|
||||
let cmd_tpl = Cppo_command.parse raw_tpl in
|
||||
if Hashtbl.mem tbl id then
|
||||
failwith ("Multiple definitions for extension " ^ id)
|
||||
else
|
||||
Hashtbl.add tbl id cmd_tpl
|
||||
|
||||
let semver_re = Str.regexp "\
|
||||
\\([0-9]+\\)\
|
||||
\\.\\([0-9]+\\)\
|
||||
\\(\\.\\([0-9]+\\)\\)?\
|
||||
\\([~-]\\([^+]*\\)\\)?\
|
||||
\\(\\+\\(.*\\)\\)?\
|
||||
\r?$"
|
||||
|
||||
let parse_semver s =
|
||||
if not (Str.string_match semver_re s 0) then
|
||||
None
|
||||
else
|
||||
let major = Str.matched_group 1 s in
|
||||
let minor = Str.matched_group 2 s in
|
||||
let patch = 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 (),
|
||||
"<command line>",
|
||||
(fun () -> Lexing.from_string s),
|
||||
(fun () -> ()) ]
|
||||
in
|
||||
let main =
|
||||
match List.rev !files with
|
||||
[] -> [ Sys.getcwd (),
|
||||
"<stdin>",
|
||||
(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
|
||||
275
unikernel/duniverse/cppo/src/cppo_parser.mly
Normal file
275
unikernel/duniverse/cppo/src/cppo_parser.mly
Normal file
|
|
@ -0,0 +1,275 @@
|
|||
%{
|
||||
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] }
|
||||
;
|
||||
204
unikernel/duniverse/cppo/src/cppo_types.ml
Normal file
204
unikernel/duniverse/cppo/src/cppo_types.ml
Normal file
|
|
@ -0,0 +1,204 @@
|
|||
open 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)
|
||||
128
unikernel/duniverse/cppo/src/cppo_types.mli
Normal file
128
unikernel/duniverse/cppo/src/cppo_types.mli
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
type 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
|
||||
1
unikernel/duniverse/cppo/src/cppo_version.mli
Normal file
1
unikernel/duniverse/cppo/src/cppo_version.mli
Normal file
|
|
@ -0,0 +1 @@
|
|||
val cppo_version : string
|
||||
21
unikernel/duniverse/cppo/src/dune
Normal file
21
unikernel/duniverse/cppo/src/dune
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
(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))
|
||||
3
unikernel/duniverse/cppo/test/already_defined.cppo
Normal file
3
unikernel/duniverse/cppo/test/already_defined.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(* A macro is defined twice. *)
|
||||
#define FOO "oh"
|
||||
#define FOO "no"
|
||||
2
unikernel/duniverse/cppo/test/already_defined.ref
Normal file
2
unikernel/duniverse/cppo/test/already_defined.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "already_defined.cppo", line 3, characters 0-17
|
||||
Error: "FOO" is already defined
|
||||
3
unikernel/duniverse/cppo/test/applied_to_none.cppo
Normal file
3
unikernel/duniverse/cppo/test/applied_to_none.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(* A parameterized macro is applied to no arguments. *)
|
||||
#define FOO(x) x
|
||||
FOO + 1
|
||||
2
unikernel/duniverse/cppo/test/applied_to_none.ref
Normal file
2
unikernel/duniverse/cppo/test/applied_to_none.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "applied_to_none.cppo", line 3, characters 0-3
|
||||
Error: "FOO" expects 1 argument but is applied to 0 argument.
|
||||
3
unikernel/duniverse/cppo/test/arity_mismatch.cppo
Normal file
3
unikernel/duniverse/cppo/test/arity_mismatch.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(* This test shows an arity mismatch error. *)
|
||||
#define INCR(x) x+1
|
||||
INCR(x, y)
|
||||
2
unikernel/duniverse/cppo/test/arity_mismatch.ref
Normal file
2
unikernel/duniverse/cppo/test/arity_mismatch.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "arity_mismatch.cppo", line 3, characters 0-10
|
||||
Error: "INCR" expects 1 argument but is applied to 2 arguments.
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
#define ID(X) X
|
||||
#define APPLY(F : [.], X) F (* intentionally forgetting to apply F *)
|
||||
APPLY(ID, 42)
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "arity_mismatch_indirect.cppo", line 2, characters 26-27
|
||||
Error: "F" expects 1 argument but is applied to 0 argument.
|
||||
2
unikernel/duniverse/cppo/test/at_least_one_arg.cppo
Normal file
2
unikernel/duniverse/cppo/test/at_least_one_arg.cppo
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(* A parameterized macro cannot have zero arguments. *)
|
||||
#define FOO() "not ok"
|
||||
2
unikernel/duniverse/cppo/test/at_least_one_arg.ref
Normal file
2
unikernel/duniverse/cppo/test/at_least_one_arg.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "at_least_one_arg.cppo", line 2, characters 12-13
|
||||
Error: A macro must have at least one formal parameter
|
||||
6
unikernel/duniverse/cppo/test/capital.cppo
Normal file
6
unikernel/duniverse/cppo/test/capital.cppo
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
|
||||
#define EVENT(n,ty) external CONCAT(on,CAPITALIZE(n)) : ty = STRINGIFY(n) [@@bs.val]
|
||||
|
||||
|
||||
EVENT(exit, unit -> unit)
|
||||
6
unikernel/duniverse/cppo/test/capital.ref
Normal file
6
unikernel/duniverse/cppo/test/capital.ref
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
|
||||
|
||||
|
||||
# 6 "capital.cppo"
|
||||
external onExit : unit -> unit = "exit" [@@bs.val]
|
||||
2
unikernel/duniverse/cppo/test/comment_in_formals.cppo
Normal file
2
unikernel/duniverse/cppo/test/comment_in_formals.cppo
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
#define FOO(x, (* a comment *) y) x+y
|
||||
FOO(42, 23)
|
||||
2
unikernel/duniverse/cppo/test/comment_in_formals.ref
Normal file
2
unikernel/duniverse/cppo/test/comment_in_formals.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "comment_in_formals.cppo", line 1, characters 15-16
|
||||
Error: Invalid formal parameter: expected an identifier
|
||||
7
unikernel/duniverse/cppo/test/comments.cppo
Normal file
7
unikernel/duniverse/cppo/test/comments.cppo
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(* '"' *)
|
||||
|
||||
#define BE_GONE
|
||||
|
||||
(* "*)"
|
||||
#define DONT_TOUCH_THIS
|
||||
*)
|
||||
8
unikernel/duniverse/cppo/test/comments.ref
Normal file
8
unikernel/duniverse/cppo/test/comments.ref
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
# 1 "comments.cppo"
|
||||
(* '"' *)
|
||||
|
||||
|
||||
# 5 "comments.cppo"
|
||||
(* "*)"
|
||||
#define DONT_TOUCH_THIS
|
||||
*)
|
||||
47
unikernel/duniverse/cppo/test/cond.cppo
Normal file
47
unikernel/duniverse/cppo/test/cond.cppo
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
#if 1 = 1
|
||||
#else
|
||||
#error "ignored #else (?)"
|
||||
#endif
|
||||
|
||||
#if true
|
||||
banana
|
||||
#elif false
|
||||
apple
|
||||
#error "ignored #elif (?)"
|
||||
#endif
|
||||
|
||||
#if false
|
||||
earthworm
|
||||
#error ""
|
||||
#elif true
|
||||
apricot
|
||||
#endif
|
||||
|
||||
#if false
|
||||
cuckoo
|
||||
#error ""
|
||||
#else
|
||||
#if false
|
||||
egg
|
||||
#error ""
|
||||
#else
|
||||
nest
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#define X 3
|
||||
|
||||
#if false
|
||||
helicopter
|
||||
#error ""
|
||||
#elif false
|
||||
ocean
|
||||
#error ""
|
||||
#else
|
||||
#if X = 12
|
||||
sand
|
||||
#error ""
|
||||
#elif 4 * X = 12
|
||||
sea urchin
|
||||
#endif
|
||||
#endif
|
||||
17
unikernel/duniverse/cppo/test/cond.ref
Normal file
17
unikernel/duniverse/cppo/test/cond.ref
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
|
||||
|
||||
# 7 "cond.cppo"
|
||||
banana
|
||||
|
||||
|
||||
# 17 "cond.cppo"
|
||||
apricot
|
||||
|
||||
|
||||
# 28 "cond.cppo"
|
||||
nest
|
||||
|
||||
|
||||
|
||||
# 45 "cond.cppo"
|
||||
sea urchin
|
||||
88
unikernel/duniverse/cppo/test/def.cppo
Normal file
88
unikernel/duniverse/cppo/test/def.cppo
Normal file
|
|
@ -0,0 +1,88 @@
|
|||
(* 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
|
||||
152
unikernel/duniverse/cppo/test/def.ref
Normal file
152
unikernel/duniverse/cppo/test/def.ref
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
# 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. *)
|
||||
2
unikernel/duniverse/cppo/test/define_on_last_line.cppo
Normal file
2
unikernel/duniverse/cppo/test/define_on_last_line.cppo
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(* This #define is NOT ended by a new line, but is nevertheless accepted. *)
|
||||
#define TWICE(e) e + e
|
||||
292
unikernel/duniverse/cppo/test/dune
Normal file
292
unikernel/duniverse/cppo/test/dune
Normal file
|
|
@ -0,0 +1,292 @@
|
|||
;; ---------------------------------------------------------------------------
|
||||
;; 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)))
|
||||
6
unikernel/duniverse/cppo/test/expect_ident.cppo
Normal file
6
unikernel/duniverse/cppo/test/expect_ident.cppo
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
let 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. *)
|
||||
2
unikernel/duniverse/cppo/test/expect_ident.ref
Normal file
2
unikernel/duniverse/cppo/test/expect_ident.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "expect_ident.cppo", line 4, characters 6-12
|
||||
Error: The name of a macro is expected in this position
|
||||
6
unikernel/duniverse/cppo/test/expect_ident_empty.cppo
Normal file
6
unikernel/duniverse/cppo/test/expect_ident_empty.cppo
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
let 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. *)
|
||||
2
unikernel/duniverse/cppo/test/expect_ident_empty.ref
Normal file
2
unikernel/duniverse/cppo/test/expect_ident_empty.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "expect_ident_empty.cppo", line 4, characters 6-6
|
||||
Error: The name of a macro is expected in this position
|
||||
3
unikernel/duniverse/cppo/test/expects_no_args.cppo
Normal file
3
unikernel/duniverse/cppo/test/expects_no_args.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(* A non-parameterized macro is given actual arguments. *)
|
||||
#define FOO "foo"
|
||||
1 + FOO(42)
|
||||
2
unikernel/duniverse/cppo/test/expects_no_args.ref
Normal file
2
unikernel/duniverse/cppo/test/expects_no_args.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "expects_no_args.cppo", line 3, characters 4-11
|
||||
Error: "FOO" expects 0 argument but is applied to 1 argument.
|
||||
10
unikernel/duniverse/cppo/test/ext.cppo
Normal file
10
unikernel/duniverse/cppo/test/ext.cppo
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
hello
|
||||
#ext rot13
|
||||
abc
|
||||
\#endext
|
||||
def
|
||||
#endext
|
||||
goodbye
|
||||
|
||||
#ext source
|
||||
#endext
|
||||
28
unikernel/duniverse/cppo/test/ext.ref
Normal file
28
unikernel/duniverse/cppo/test/ext.ref
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
# 1 "ext.cppo"
|
||||
hello
|
||||
nop
|
||||
#raqrkg
|
||||
qrs
|
||||
# 7 "ext.cppo"
|
||||
goodbye
|
||||
|
||||
# 9
|
||||
(*
|
||||
hello
|
||||
#ext rot13
|
||||
abc
|
||||
\#endext
|
||||
def
|
||||
#endext
|
||||
goodbye
|
||||
|
||||
#ext source
|
||||
#endext
|
||||
*)
|
||||
(*
|
||||
Environment variables:
|
||||
CPPO_FILE=ext.cppo
|
||||
CPPO_FIRST_LINE=9
|
||||
CPPO_LAST_LINE=11
|
||||
*)
|
||||
# 11
|
||||
4
unikernel/duniverse/cppo/test/extraneous_enddef.cppo
Normal file
4
unikernel/duniverse/cppo/test/extraneous_enddef.cppo
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#define FOO \
|
||||
42
|
||||
(* The following #enddef is extraneous; it should not be there. *)
|
||||
#enddef
|
||||
2
unikernel/duniverse/cppo/test/extraneous_enddef.ref
Normal file
2
unikernel/duniverse/cppo/test/extraneous_enddef.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "extraneous_enddef.cppo", line 4, characters 0-8
|
||||
Error: syntax error
|
||||
69
unikernel/duniverse/cppo/test/higher_order_macros.cppo
Normal file
69
unikernel/duniverse/cppo/test/higher_order_macros.cppo
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
(* 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)
|
||||
100
unikernel/duniverse/cppo/test/higher_order_macros.ref
Normal file
100
unikernel/duniverse/cppo/test/higher_order_macros.ref
Normal file
|
|
@ -0,0 +1,100 @@
|
|||
# 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
|
||||
)
|
||||
3
unikernel/duniverse/cppo/test/incl.cppo
Normal file
3
unikernel/duniverse/cppo/test/incl.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
included
|
||||
|
||||
#include "incl2.cppo"
|
||||
1
unikernel/duniverse/cppo/test/incl2.cppo
Normal file
1
unikernel/duniverse/cppo/test/incl2.cppo
Normal file
|
|
@ -0,0 +1 @@
|
|||
ok
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
#include "define_on_last_line.cppo"
|
||||
(* Check that the definition of TWICE has been accepted: *)
|
||||
let f x = TWICE(x)
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
# 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
|
||||
4
unikernel/duniverse/cppo/test/int_expansion_error.cppo
Normal file
4
unikernel/duniverse/cppo/test/int_expansion_error.cppo
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#define FOO 3+3
|
||||
#if FOO = 0
|
||||
let x = "Hello"
|
||||
#endif
|
||||
4
unikernel/duniverse/cppo/test/int_expansion_error.ref
Normal file
4
unikernel/duniverse/cppo/test/int_expansion_error.ref
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
Error: 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.
|
||||
27
unikernel/duniverse/cppo/test/lexical.cppo
Normal file
27
unikernel/duniverse/cppo/test/lexical.cppo
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
(* 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()
|
||||
36
unikernel/duniverse/cppo/test/lexical.ref
Normal file
36
unikernel/duniverse/cppo/test/lexical.ref
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
# 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()
|
||||
8
unikernel/duniverse/cppo/test/loc.cppo
Normal file
8
unikernel/duniverse/cppo/test/loc.cppo
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#define loc __FILE__ __LINE__
|
||||
loc
|
||||
X(loc)
|
||||
X(loc)
|
||||
X(Y(loc))
|
||||
|
||||
#define F(x) loc
|
||||
F()
|
||||
21
unikernel/duniverse/cppo/test/loc.ref
Normal file
21
unikernel/duniverse/cppo/test/loc.ref
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
# 2 "loc.cppo"
|
||||
"loc.cppo" 2
|
||||
# 3 "loc.cppo"
|
||||
X(
|
||||
# 3 "loc.cppo"
|
||||
"loc.cppo" 3
|
||||
# 3 "loc.cppo"
|
||||
)
|
||||
X(
|
||||
# 4 "loc.cppo"
|
||||
"loc.cppo" 4
|
||||
# 4 "loc.cppo"
|
||||
)
|
||||
X(Y(
|
||||
# 5 "loc.cppo"
|
||||
"loc.cppo" 5
|
||||
# 5 "loc.cppo"
|
||||
))
|
||||
|
||||
# 8 "loc.cppo"
|
||||
"loc.cppo" 8
|
||||
12
unikernel/duniverse/cppo/test/missing_enddef.cppo
Normal file
12
unikernel/duniverse/cppo/test/missing_enddef.cppo
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(* 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. *)
|
||||
2
unikernel/duniverse/cppo/test/missing_enddef.ref
Normal file
2
unikernel/duniverse/cppo/test/missing_enddef.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "missing_enddef.cppo", line 3, characters 0-13
|
||||
Error: This #def is never closed: perhaps #enddef is missing
|
||||
14
unikernel/duniverse/cppo/test/missing_endscope.cppo
Normal file
14
unikernel/duniverse/cppo/test/missing_endscope.cppo
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(* 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. *)
|
||||
2
unikernel/duniverse/cppo/test/missing_endscope.ref
Normal file
2
unikernel/duniverse/cppo/test/missing_endscope.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "missing_endscope.cppo", line 3, characters 0-6
|
||||
Error: This #scope is never closed: perhaps #endscope is missing
|
||||
3
unikernel/duniverse/cppo/test/paren_arg.cppo
Normal file
3
unikernel/duniverse/cppo/test/paren_arg.cppo
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
#define F(x, y) <x> <y>
|
||||
F((1, (2)), 34)
|
||||
F((1\,\(2\)), 34)
|
||||
4
unikernel/duniverse/cppo/test/paren_arg.ref
Normal file
4
unikernel/duniverse/cppo/test/paren_arg.ref
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
# 2 "paren_arg.cppo"
|
||||
<(1, (2))> < 34>
|
||||
# 3 "paren_arg.cppo"
|
||||
<(1 , (2 ))> < 34>
|
||||
85
unikernel/duniverse/cppo/test/scope.cppo
Normal file
85
unikernel/duniverse/cppo/test/scope.cppo
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
(* 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
|
||||
131
unikernel/duniverse/cppo/test/scope.ref
Normal file
131
unikernel/duniverse/cppo/test/scope.ref
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
# 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"
|
||||
5
unikernel/duniverse/cppo/test/shape_mismatch.cppo
Normal file
5
unikernel/duniverse/cppo/test/shape_mismatch.cppo
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#define FOO 24
|
||||
#define APPLY(F : [.], X) F(X)
|
||||
APPLY(FOO, 42)
|
||||
(* invalid because APPLY expects a macro of type [.]
|
||||
but FOO has type . *)
|
||||
3
unikernel/duniverse/cppo/test/shape_mismatch.ref
Normal file
3
unikernel/duniverse/cppo/test/shape_mismatch.ref
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
Error: File "shape_mismatch.cppo", line 3, characters 6-9
|
||||
Error: A macro of type [.] was expected, but
|
||||
a macro of type . was provided
|
||||
13
unikernel/duniverse/cppo/test/source.sh
Executable file
13
unikernel/duniverse/cppo/test/source.sh
Executable file
|
|
@ -0,0 +1,13 @@
|
|||
#! /bin/sh -e
|
||||
|
||||
echo "# $2"
|
||||
echo "(*"
|
||||
cat "$1"
|
||||
echo "*)"
|
||||
echo "(*"
|
||||
echo " Environment variables:"
|
||||
echo " CPPO_FILE=$CPPO_FILE"
|
||||
echo " CPPO_FIRST_LINE=$CPPO_FIRST_LINE"
|
||||
echo " CPPO_LAST_LINE=$CPPO_LAST_LINE"
|
||||
echo "*)"
|
||||
echo "# $3"
|
||||
146
unikernel/duniverse/cppo/test/test.cppo
Normal file
146
unikernel/duniverse/cppo/test/test.cppo
Normal file
|
|
@ -0,0 +1,146 @@
|
|||
(* 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
|
||||
142
unikernel/duniverse/cppo/test/test.ref
Normal file
142
unikernel/duniverse/cppo/test/test.ref
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
# 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
|
||||
38
unikernel/duniverse/cppo/test/tuple.cppo
Normal file
38
unikernel/duniverse/cppo/test/tuple.cppo
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
#if (2 + 2, 5) < (4, 5)
|
||||
mountain
|
||||
#error ""
|
||||
#else
|
||||
pistachios
|
||||
#endif
|
||||
|
||||
#if (3 * 3) = 10 - 1
|
||||
trees
|
||||
#else
|
||||
rocks
|
||||
#error ""
|
||||
#endif
|
||||
|
||||
#if (1) = (1)
|
||||
waves
|
||||
#else
|
||||
sharks
|
||||
#error ""
|
||||
#endif
|
||||
|
||||
|
||||
#define x 11
|
||||
#if (x, 2) <> (x, 4/2)
|
||||
honey
|
||||
#error ""
|
||||
#else
|
||||
bees
|
||||
#endif
|
||||
|
||||
#define tuple (0, -5, 3)
|
||||
#define tuple2 tuple
|
||||
#if (0, -5, x) > tuple2
|
||||
steamboat
|
||||
#else
|
||||
koalas
|
||||
#error ""
|
||||
#endif
|
||||
20
unikernel/duniverse/cppo/test/tuple.ref
Normal file
20
unikernel/duniverse/cppo/test/tuple.ref
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
|
||||
# 5 "tuple.cppo"
|
||||
pistachios
|
||||
|
||||
|
||||
# 9 "tuple.cppo"
|
||||
trees
|
||||
|
||||
|
||||
# 16 "tuple.cppo"
|
||||
waves
|
||||
|
||||
|
||||
|
||||
# 28 "tuple.cppo"
|
||||
bees
|
||||
|
||||
|
||||
# 34 "tuple.cppo"
|
||||
steamboat
|
||||
4
unikernel/duniverse/cppo/test/undefined.cppo
Normal file
4
unikernel/duniverse/cppo/test/undefined.cppo
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#define APPLY(F : [.], X) F(X)
|
||||
APPLY(FOO, 42)
|
||||
(* invalid because APPLY expects a macro as an argument:
|
||||
but FOO is not defined. *)
|
||||
2
unikernel/duniverse/cppo/test/undefined.ref
Normal file
2
unikernel/duniverse/cppo/test/undefined.ref
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
Error: File "undefined.cppo", line 2, characters 6-9
|
||||
Error: The macro 'FOO' is not defined
|
||||
14
unikernel/duniverse/cppo/test/unmatched.cppo
Normal file
14
unikernel/duniverse/cppo/test/unmatched.cppo
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
#ifdef whatever
|
||||
(
|
||||
#else
|
||||
let a = 1 in
|
||||
let b = 2 in
|
||||
(a ||
|
||||
#endif
|
||||
|
||||
b)
|
||||
|
||||
#define F(x, y) (x + y)
|
||||
F(1,(2+3))
|
||||
)
|
||||
(
|
||||
15
unikernel/duniverse/cppo/test/unmatched.ref
Normal file
15
unikernel/duniverse/cppo/test/unmatched.ref
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
# 4 "unmatched.cppo"
|
||||
let a = 1 in
|
||||
let b = 2 in
|
||||
(a ||
|
||||
|
||||
|
||||
# 9 "unmatched.cppo"
|
||||
b)
|
||||
|
||||
# 12 "unmatched.cppo"
|
||||
(1 + (2+3))
|
||||
# 13 "unmatched.cppo"
|
||||
)
|
||||
(
|
||||
34
unikernel/duniverse/cppo/test/version.cppo
Normal file
34
unikernel/duniverse/cppo/test/version.cppo
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
#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
|
||||
42
unikernel/duniverse/cppo/test/version.ref
Normal file
42
unikernel/duniverse/cppo/test/version.ref
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
|
||||
# 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue