mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Compare commits
8 Commits
concrete-n
...
sense-disa
| Author | SHA1 | Date | |
|---|---|---|---|
|
8406a1e381 | ||
|
|
438e18c78f | ||
|
|
b0cf72f0ec | ||
|
|
fd2aa96e65 | ||
|
|
7239a45ac5 | ||
|
|
7f84cc22e9 | ||
|
|
0db213f993 | ||
|
|
bf5abe2948 |
95
.github/workflows/build-all-versions.yml
vendored
95
.github/workflows/build-all-versions.yml
vendored
@@ -1,95 +0,0 @@
|
||||
# Based on the template here: https://kodimensional.dev/github-actions
|
||||
name: Build with stack and cabal
|
||||
|
||||
# Trigger the workflow on push or pull request, but only for the master branch
|
||||
on:
|
||||
pull_request:
|
||||
push:
|
||||
branches: [master]
|
||||
|
||||
jobs:
|
||||
cabal:
|
||||
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ubuntu-latest, macos-latest, windows-latest]
|
||||
cabal: ["3.2"]
|
||||
ghc:
|
||||
- "8.6.5"
|
||||
- "8.8.3"
|
||||
- "8.10.1"
|
||||
exclude:
|
||||
- os: macos-latest
|
||||
ghc: 8.8.3
|
||||
- os: macos-latest
|
||||
ghc: 8.6.5
|
||||
- os: windows-latest
|
||||
ghc: 8.8.3
|
||||
- os: windows-latest
|
||||
ghc: 8.6.5
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
|
||||
|
||||
- uses: actions/setup-haskell@v1.1.4
|
||||
id: setup-haskell-cabal
|
||||
name: Setup Haskell
|
||||
with:
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
cabal-version: ${{ matrix.cabal }}
|
||||
|
||||
- name: Freeze
|
||||
run: |
|
||||
cabal freeze
|
||||
|
||||
- uses: actions/cache@v1
|
||||
name: Cache ~/.cabal/store
|
||||
with:
|
||||
path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}
|
||||
# key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
|
||||
|
||||
- name: Build
|
||||
run: |
|
||||
cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
|
||||
cabal build all
|
||||
|
||||
# - name: Test
|
||||
# run: |
|
||||
# cabal test all
|
||||
|
||||
stack:
|
||||
name: stack / ghc ${{ matrix.ghc }}
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
matrix:
|
||||
stack: ["2.3.3"]
|
||||
ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4"]
|
||||
# ghc: ["8.8.3"]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
|
||||
|
||||
- uses: actions/setup-haskell@v1.1.4
|
||||
name: Setup Haskell Stack
|
||||
with:
|
||||
# ghc-version: ${{ matrix.ghc }}
|
||||
stack-version: ${{ matrix.stack }}
|
||||
|
||||
- uses: actions/cache@v1
|
||||
name: Cache ~/.stack
|
||||
with:
|
||||
path: ~/.stack
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-stack
|
||||
|
||||
- name: Build
|
||||
run: |
|
||||
stack build --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
|
||||
# stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
|
||||
|
||||
- name: Test
|
||||
run: |
|
||||
stack test --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
|
||||
185
.github/workflows/build-binary-packages.yml
vendored
185
.github/workflows/build-binary-packages.yml
vendored
@@ -1,185 +0,0 @@
|
||||
name: Build Binary Packages
|
||||
|
||||
on:
|
||||
workflow_dispatch:
|
||||
release:
|
||||
|
||||
jobs:
|
||||
|
||||
# ---
|
||||
|
||||
ubuntu:
|
||||
name: Build Ubuntu package
|
||||
runs-on: ubuntu-18.04
|
||||
# strategy:
|
||||
# matrix:
|
||||
# ghc: ["8.6.5"]
|
||||
# cabal: ["2.4"]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
# Note: `haskell-platform` is listed as requirement in debian/control,
|
||||
# which is why it's installed using apt instead of the Setup Haskell action.
|
||||
|
||||
# - name: Setup Haskell
|
||||
# uses: actions/setup-haskell@v1
|
||||
# id: setup-haskell-cabal
|
||||
# with:
|
||||
# ghc-version: ${{ matrix.ghc }}
|
||||
# cabal-version: ${{ matrix.cabal }}
|
||||
|
||||
- name: Install build tools
|
||||
run: |
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y \
|
||||
make \
|
||||
dpkg-dev \
|
||||
debhelper \
|
||||
haskell-platform \
|
||||
libghc-json-dev \
|
||||
python-dev \
|
||||
default-jdk \
|
||||
libtool-bin
|
||||
|
||||
- name: Build package
|
||||
run: |
|
||||
make deb
|
||||
|
||||
- name: Copy package
|
||||
run: |
|
||||
cp ../gf_*.deb dist/
|
||||
|
||||
- name: Upload artifact
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: gf-${{ github.sha }}-ubuntu
|
||||
path: dist/gf_*.deb
|
||||
if-no-files-found: error
|
||||
|
||||
# ---
|
||||
|
||||
macos:
|
||||
name: Build macOS package
|
||||
runs-on: macos-10.15
|
||||
strategy:
|
||||
matrix:
|
||||
ghc: ["8.6.5"]
|
||||
cabal: ["2.4"]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- name: Setup Haskell
|
||||
uses: actions/setup-haskell@v1
|
||||
id: setup-haskell-cabal
|
||||
with:
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
cabal-version: ${{ matrix.cabal }}
|
||||
|
||||
- name: Install build tools
|
||||
run: |
|
||||
brew install \
|
||||
automake
|
||||
cabal v1-install alex happy
|
||||
|
||||
- name: Build package
|
||||
run: |
|
||||
sudo mkdir -p /Library/Java/Home
|
||||
sudo ln -s /usr/local/opt/openjdk/include /Library/Java/Home/include
|
||||
make pkg
|
||||
|
||||
- name: Upload artifact
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: gf-${{ github.sha }}-macos
|
||||
path: dist/gf-*.pkg
|
||||
if-no-files-found: error
|
||||
|
||||
# ---
|
||||
|
||||
windows:
|
||||
name: Build Windows package
|
||||
runs-on: windows-2019
|
||||
strategy:
|
||||
matrix:
|
||||
ghc: ["8.6.5"]
|
||||
cabal: ["2.4"]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- name: Setup MSYS2
|
||||
uses: msys2/setup-msys2@v2
|
||||
with:
|
||||
install: >-
|
||||
base-devel
|
||||
gcc
|
||||
python-devel
|
||||
|
||||
- name: Prepare dist folder
|
||||
shell: msys2 {0}
|
||||
run: |
|
||||
mkdir /c/tmp-dist
|
||||
mkdir /c/tmp-dist/c
|
||||
mkdir /c/tmp-dist/java
|
||||
mkdir /c/tmp-dist/python
|
||||
|
||||
- name: Build C runtime
|
||||
shell: msys2 {0}
|
||||
run: |
|
||||
cd src/runtime/c
|
||||
autoreconf -i
|
||||
./configure
|
||||
make
|
||||
make install
|
||||
cp /mingw64/bin/libpgf-0.dll /c/tmp-dist/c
|
||||
cp /mingw64/bin/libgu-0.dll /c/tmp-dist/c
|
||||
|
||||
- name: Build Java bindings
|
||||
shell: msys2 {0}
|
||||
run: |
|
||||
export PATH="${PATH}:/c/Program Files/Java/jdk8u275-b01/bin"
|
||||
cd src/runtime/java
|
||||
make \
|
||||
JNI_INCLUDES="-I \"/c/Program Files/Java/jdk8u275-b01/include\" -I \"/c/Program Files/Java/jdk8u275-b01/include/win32\" -I \"/mingw64/include\" -D__int64=int64_t" \
|
||||
WINDOWS_LDFLAGS="-L\"/mingw64/lib\" -no-undefined"
|
||||
make install
|
||||
cp .libs//msys-jpgf-0.dll /c/tmp-dist/java/jpgf.dll
|
||||
cp jpgf.jar /c/tmp-dist/java
|
||||
|
||||
- name: Build Python bindings
|
||||
shell: msys2 {0}
|
||||
env:
|
||||
EXTRA_INCLUDE_DIRS: /mingw64/include
|
||||
EXTRA_LIB_DIRS: /mingw64/lib
|
||||
run: |
|
||||
cd src/runtime/python
|
||||
python setup.py build
|
||||
python setup.py install
|
||||
cp /usr/lib/python3.8/site-packages/pgf* /c/tmp-dist/python
|
||||
|
||||
- name: Setup Haskell
|
||||
uses: actions/setup-haskell@v1
|
||||
id: setup-haskell-cabal
|
||||
with:
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
cabal-version: ${{ matrix.cabal }}
|
||||
|
||||
- name: Install Haskell build tools
|
||||
run: |
|
||||
cabal install alex happy
|
||||
|
||||
- name: Build GF
|
||||
run: |
|
||||
cabal install --only-dependencies -fserver
|
||||
cabal configure -fserver
|
||||
cabal build
|
||||
copy dist\build\gf\gf.exe C:\tmp-dist
|
||||
|
||||
- name: Upload artifact
|
||||
uses: actions/upload-artifact@v2
|
||||
with:
|
||||
name: gf-${{ github.sha }}-windows
|
||||
path: C:\tmp-dist\*
|
||||
if-no-files-found: error
|
||||
98
.github/workflows/build-python-package.yml
vendored
98
.github/workflows/build-python-package.yml
vendored
@@ -1,98 +0,0 @@
|
||||
name: Build & Publish Python Package
|
||||
|
||||
# Trigger the workflow on push or pull request, but only for the master branch
|
||||
on:
|
||||
pull_request:
|
||||
push:
|
||||
branches: [master]
|
||||
|
||||
jobs:
|
||||
build_wheels:
|
||||
name: Build wheel on ${{ matrix.os }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: true
|
||||
matrix:
|
||||
os: [ubuntu-18.04, macos-10.15]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v1
|
||||
|
||||
- uses: actions/setup-python@v1
|
||||
name: Install Python
|
||||
with:
|
||||
python-version: '3.7'
|
||||
|
||||
- name: Install cibuildwheel
|
||||
run: |
|
||||
python -m pip install git+https://github.com/joerick/cibuildwheel.git@main
|
||||
|
||||
- name: Install build tools for OSX
|
||||
if: startsWith(matrix.os, 'macos')
|
||||
run: |
|
||||
brew install automake
|
||||
|
||||
- name: Build wheels on Linux
|
||||
if: startsWith(matrix.os, 'macos') != true
|
||||
env:
|
||||
CIBW_BEFORE_BUILD: cd src/runtime/c && autoreconf -i && ./configure && make && make install
|
||||
run: |
|
||||
python -m cibuildwheel src/runtime/python --output-dir wheelhouse
|
||||
|
||||
- name: Build wheels on OSX
|
||||
if: startsWith(matrix.os, 'macos')
|
||||
env:
|
||||
CIBW_BEFORE_BUILD: cd src/runtime/c && glibtoolize && autoreconf -i && ./configure && make && make install
|
||||
run: |
|
||||
python -m cibuildwheel src/runtime/python --output-dir wheelhouse
|
||||
|
||||
- uses: actions/upload-artifact@v2
|
||||
with:
|
||||
path: ./wheelhouse
|
||||
|
||||
build_sdist:
|
||||
name: Build source distribution
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- uses: actions/setup-python@v2
|
||||
name: Install Python
|
||||
with:
|
||||
python-version: '3.7'
|
||||
|
||||
- name: Build sdist
|
||||
run: cd src/runtime/python && python setup.py sdist
|
||||
|
||||
- uses: actions/upload-artifact@v2
|
||||
with:
|
||||
path: ./src/runtime/python/dist/*.tar.gz
|
||||
|
||||
upload_pypi:
|
||||
name: Upload to PyPI
|
||||
needs: [build_wheels, build_sdist]
|
||||
runs-on: ubuntu-latest
|
||||
if: github.ref == 'refs/heads/master' && github.event_name == 'push'
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- name: Set up Python
|
||||
uses: actions/setup-python@v2
|
||||
with:
|
||||
python-version: '3.x'
|
||||
|
||||
- name: Install twine
|
||||
run: pip install twine
|
||||
|
||||
- uses: actions/download-artifact@v2
|
||||
with:
|
||||
name: artifact
|
||||
path: ./dist
|
||||
|
||||
- name: Publish
|
||||
env:
|
||||
TWINE_USERNAME: __token__
|
||||
TWINE_PASSWORD: ${{ secrets.pypi_password }}
|
||||
run: |
|
||||
(cd ./src/runtime/python && curl -I --fail https://pypi.org/project/$(python setup.py --name)/$(python setup.py --version)/) || twine upload dist/*
|
||||
33
.gitignore
vendored
33
.gitignore
vendored
@@ -5,14 +5,7 @@
|
||||
*.jar
|
||||
*.gfo
|
||||
*.pgf
|
||||
debian/.debhelper
|
||||
debian/debhelper-build-stamp
|
||||
debian/gf
|
||||
debian/gf.debhelper.log
|
||||
debian/gf.substvars
|
||||
debian/files
|
||||
dist/
|
||||
dist-newstyle/
|
||||
src/runtime/c/.libs/
|
||||
src/runtime/c/Makefile
|
||||
src/runtime/c/Makefile.in
|
||||
@@ -46,30 +39,8 @@ src/runtime/c/sg/.dirstamp
|
||||
src/runtime/c/stamp-h1
|
||||
src/runtime/java/.libs/
|
||||
src/runtime/python/build/
|
||||
src/ui/android/libs/
|
||||
src/ui/android/obj/
|
||||
.cabal-sandbox
|
||||
cabal.sandbox.config
|
||||
.stack-work
|
||||
DATA_DIR
|
||||
|
||||
stack*.yaml.lock
|
||||
|
||||
# Output files for test suite
|
||||
*.out
|
||||
gf-tests.html
|
||||
|
||||
# Generated documentation (not exhaustive)
|
||||
demos/index-numbers.html
|
||||
demos/resourcegrammars.html
|
||||
demos/translation.html
|
||||
doc/tutorial/gf-tutorial.html
|
||||
doc/index.html
|
||||
doc/gf-bibliography.html
|
||||
doc/gf-developers.html
|
||||
doc/gf-editor-modes.html
|
||||
doc/gf-people.html
|
||||
doc/gf-refman.html
|
||||
doc/gf-shell-reference.html
|
||||
doc/icfp-2012.html
|
||||
download/*.html
|
||||
gf-book/index.html
|
||||
src/www/gf-web-api.html
|
||||
|
||||
19
LICENSE
19
LICENSE
@@ -8,9 +8,24 @@ other. For this reason the different components have different licenses.
|
||||
In summary:
|
||||
|
||||
- the GF compiler in the folder src/compiler and the PGF Web service in src/server
|
||||
are under the GNU GENERAL PUBLIC LICENSE.
|
||||
are under the GNU GENERAL PUBLIC LICENSE.
|
||||
|
||||
- the GF runtime in src/runtime is under dual GNU LESSER GENERAL PUBLIC LICENSE and BSD LICENSE
|
||||
- the GF runtime in src/runtime is under dual GNU LESSER GENERAL PUBLIC LICENSE
|
||||
and BSD LICENSE
|
||||
|
||||
- the resource grammar library in lib/src is under GNU LESSER GENERAL PUBLIC LICENSE.
|
||||
However the user have the right to choose any license for any application grammar
|
||||
derived from the resource grammar by using the grammar API.
|
||||
|
||||
- the resource grammar library also includes large coverage lexicons for some languages.
|
||||
Since these lexicons are derived from external sources they might be under different licenses.
|
||||
Look at the source file for every lexicon for details. The lexicons that we currently have
|
||||
are:
|
||||
|
||||
lib/src/bulgarian/ DictBul.gf DictBulAbs.gf for Bulgarian
|
||||
lib/src/english/ DictEng.gf DictEngAbs.gf for English
|
||||
lib/src/turkish/ DictTur.gf DictTurAbs.gf for Turkish
|
||||
lib/src/swedish/ DictSwe.gf DictSweAbs.gf for Swedish
|
||||
|
||||
The rest of this document contains copies of the GPL, LGPL and BSD licenses
|
||||
which are applicable to the different components of Grammatical Framework
|
||||
|
||||
3
Makefile
3
Makefile
@@ -20,7 +20,6 @@ doc:
|
||||
|
||||
clean:
|
||||
cabal clean
|
||||
bash bin/clean_html
|
||||
|
||||
gf:
|
||||
cabal build rgl-none
|
||||
@@ -33,7 +32,7 @@ html::
|
||||
# number to the top of debian/changelog.
|
||||
# (Tested on Ubuntu 15.04. You need to install dpkg-dev & debhelper.)
|
||||
deb:
|
||||
dpkg-buildpackage -b -uc
|
||||
dpkg-buildpackage -b
|
||||
|
||||
# Make an OS X Installer package
|
||||
pkg:
|
||||
|
||||
14
README.md
14
README.md
@@ -2,6 +2,8 @@
|
||||
|
||||
# Grammatical Framework (GF)
|
||||
|
||||
[](https://travis-ci.org/GrammaticalFramework/gf-core)
|
||||
|
||||
The Grammatical Framework is a grammar formalism based on type theory.
|
||||
It consists of:
|
||||
|
||||
@@ -30,16 +32,20 @@ GF particularly addresses four aspects of grammars:
|
||||
|
||||
## Compilation and installation
|
||||
|
||||
The simplest way of installing GF from source is with the command:
|
||||
The simplest way of installing GF is with the command:
|
||||
```
|
||||
cabal install
|
||||
```
|
||||
or:
|
||||
|
||||
This can be broken down into the usual sub-steps:
|
||||
```
|
||||
stack install
|
||||
cabal configure
|
||||
cabal build
|
||||
cabal copy
|
||||
```
|
||||
|
||||
For more information, including links to precompiled binaries, see the [download page](http://www.grammaticalframework.org/download/index.html).
|
||||
For more details, see the [download page](http://www.grammaticalframework.org/download/index.html)
|
||||
and [developers manual](http://www.grammaticalframework.org/doc/gf-developers.html).
|
||||
|
||||
## About this repository
|
||||
|
||||
|
||||
66
RELEASE.md
66
RELEASE.md
@@ -1,66 +0,0 @@
|
||||
# GF Core releases
|
||||
|
||||
**Note:**
|
||||
The RGL is now released completely separately from GF Core.
|
||||
See the [RGL's RELEASE.md](https://github.com/GrammaticalFramework/gf-rgl/blob/master/RELEASE.md).
|
||||
|
||||
## Creating a new release
|
||||
|
||||
### 1. Prepare the repository
|
||||
|
||||
**Web pages**
|
||||
|
||||
1. Create `download/index-X.Y.md` with installation instructions.
|
||||
2. Create `download/release-X.Y.md` with changelog information.
|
||||
3. Update `download/index.html` to redirect to the new version.
|
||||
4. Add announcement in news section in `index.html`.
|
||||
|
||||
**Version numbers**
|
||||
|
||||
1. Update version number in `gf.cabal` (ommitting `-git` suffix).
|
||||
2. Add a new line in `debian/changelog`.
|
||||
|
||||
### 2. Create GitHub release
|
||||
|
||||
1. When the above changes are committed to the `master` branch in the repository
|
||||
and pushed, check that all CI workflows are successful (fixing as necessary):
|
||||
- <https://github.com/GrammaticalFramework/gf-core/actions>
|
||||
- <https://travis-ci.org/github/GrammaticalFramework/gf-core>
|
||||
2. Create a GitHub release [here](https://github.com/GrammaticalFramework/gf-core/releases/new):
|
||||
- Tag version format `RELEASE-X.Y`
|
||||
- Title: "GF X.Y"
|
||||
- Description: mention major changes since last release
|
||||
3. Publish the release to trigger the building of the binary packages (below).
|
||||
|
||||
### 3. Binary packages
|
||||
|
||||
The binaries will be built automatically by GitHub Actions when the release is created,
|
||||
but the generated _artifacts_ must be manually attached to the release as _assets_.
|
||||
|
||||
1. Go to the [actions page](https://github.com/GrammaticalFramework/gf-core/actions) and click "Build Binary Packages" under _Workflows_.
|
||||
2. Choose the workflow run corresponding to the newly created release.
|
||||
3. Download the artifacts locally. Extract the Ubuntu and macOS ones to get the `.deb` and `.pkg` files.
|
||||
4. Go back to the [releases page](https://github.com/GrammaticalFramework/gf-core/releases) and click to edit the release information.
|
||||
5. Add the downloaded artifacts as release assets, giving them names with format `gf-X.Y-PLATFORM.EXT` (e.g. `gf-3.11-macos.pkg`).
|
||||
|
||||
### 4. Upload to Hackage
|
||||
|
||||
In order to do this you will need to be added the [GF maintainers](https://hackage.haskell.org/package/gf/maintainers/) on Hackage.
|
||||
|
||||
1. Run `make sdist`
|
||||
2. Upload the package, either:
|
||||
1. **Manually**: visit <https://hackage.haskell.org/upload> and upload the file `dist/gf-X.Y.tar.gz`
|
||||
2. **via Cabal (≥2.4)**: `cabal upload dist/gf-X.Y.tar.gz`
|
||||
3. If the documentation-building fails on the Hackage server, do:
|
||||
```
|
||||
cabal v2-haddock --builddir=dist/docs --haddock-for-hackage --enable-doc
|
||||
cabal upload --documentation dist/docs/*-docs.tar.gz
|
||||
```
|
||||
|
||||
## Miscellaneous
|
||||
|
||||
### What is the tag `GF-3.10`?
|
||||
|
||||
For GF 3.10, the Core and RGL repositories had already been separated, however
|
||||
the binary packages still included the RGL. `GF-3.10` is a tag that was created
|
||||
in both repositories ([gf-core](https://github.com/GrammaticalFramework/gf-core/releases/tag/GF-3.10) and [gf-rgl](https://github.com/GrammaticalFramework/gf-rgl/releases/tag/GF-3.10)) to indicate which versions of each went into the binaries.
|
||||
12
Setup.hs
12
Setup.hs
@@ -1,4 +1,3 @@
|
||||
import Distribution.System(Platform(..),OS(..))
|
||||
import Distribution.Simple(defaultMainWithHooks,UserHooks(..),simpleUserHooks)
|
||||
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs,datadir)
|
||||
import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..))
|
||||
@@ -19,6 +18,7 @@ main = defaultMainWithHooks simpleUserHooks
|
||||
, preInst = gfPreInst
|
||||
, postInst = gfPostInst
|
||||
, postCopy = gfPostCopy
|
||||
, sDistHook = gfSDist
|
||||
}
|
||||
where
|
||||
gfPreBuild args = gfPre args . buildDistPref
|
||||
@@ -28,17 +28,17 @@ main = defaultMainWithHooks simpleUserHooks
|
||||
return emptyHookedBuildInfo
|
||||
|
||||
gfPostBuild args flags pkg lbi = do
|
||||
-- noRGLmsg
|
||||
noRGLmsg
|
||||
let gf = default_gf lbi
|
||||
buildWeb gf flags (pkg,lbi)
|
||||
|
||||
gfPostInst args flags pkg lbi = do
|
||||
-- noRGLmsg
|
||||
noRGLmsg
|
||||
saveInstallPath args flags (pkg,lbi)
|
||||
installWeb (pkg,lbi)
|
||||
|
||||
gfPostCopy args flags pkg lbi = do
|
||||
-- noRGLmsg
|
||||
noRGLmsg
|
||||
saveCopyPath args flags (pkg,lbi)
|
||||
copyWeb flags (pkg,lbi)
|
||||
|
||||
@@ -73,9 +73,5 @@ dataDirFile = "DATA_DIR"
|
||||
default_gf :: LocalBuildInfo -> FilePath
|
||||
default_gf lbi = buildDir lbi </> exeName' </> exeNameReal
|
||||
where
|
||||
-- shadows Distribution.Simple.BuildPaths.exeExtension, which changed type signature in Cabal 2.4
|
||||
exeExtension = case hostPlatform lbi of
|
||||
Platform arch Windows -> "exe"
|
||||
_ -> ""
|
||||
exeName' = "gf"
|
||||
exeNameReal = exeName' <.> exeExtension
|
||||
|
||||
22
WebSetup.hs
22
WebSetup.hs
@@ -26,14 +26,6 @@ import Distribution.PackageDescription(PackageDescription(..))
|
||||
so users won't see this message unless they check the log.)
|
||||
-}
|
||||
|
||||
-- | Notice about contrib grammars
|
||||
noContribMsg :: IO ()
|
||||
noContribMsg = putStr $ unlines
|
||||
[ "Example grammars are no longer included in the main GF repository, but have moved to gf-contrib."
|
||||
, "If you want them to be built, clone the following repository in the same directory as gf-core:"
|
||||
, "https://github.com/GrammaticalFramework/gf-contrib.git"
|
||||
]
|
||||
|
||||
example_grammars :: [(String, String, [String])] -- [(pgf, subdir, source modules)]
|
||||
example_grammars =
|
||||
[("Letter.pgf","letter",letterSrc)
|
||||
@@ -58,8 +50,11 @@ buildWeb gf flags (pkg,lbi) = do
|
||||
contrib_exists <- doesDirectoryExist contrib_dir
|
||||
if contrib_exists
|
||||
then mapM_ build_pgf example_grammars
|
||||
-- else noContribMsg
|
||||
else return ()
|
||||
else putStr $ unlines
|
||||
[ "Example grammars are no longer included in the main GF repository, but have moved to gf-contrib."
|
||||
, "If you want these example grammars to be built, clone this repository in the same top-level directory as GF:"
|
||||
, "https://github.com/GrammaticalFramework/gf-contrib.git"
|
||||
]
|
||||
where
|
||||
gfo_dir = buildDir lbi </> "examples"
|
||||
|
||||
@@ -75,7 +70,7 @@ buildWeb gf flags (pkg,lbi) = do
|
||||
gf_lib_path = datadir (absoluteInstallDirs pkg lbi dest) </> "lib"
|
||||
args = numJobs flags++["-make","-s"] -- ,"-optimize-pgf"
|
||||
++["--gfo-dir="++tmp_dir,
|
||||
--"--gf-lib-path="++gf_lib_path,
|
||||
"--gf-lib-path="++gf_lib_path,
|
||||
"--name="++dropExtension pgf,
|
||||
"--output-dir="++gfo_dir]
|
||||
++[dir</>file|file<-src]
|
||||
@@ -109,10 +104,9 @@ setupWeb dest (pkg,lbi) = do
|
||||
copy_pgf (pgf,subdir,_) =
|
||||
do let src = gfo_dir </> pgf
|
||||
let dst = grammars_dir </> pgf
|
||||
putStrLn $ "Installing "++dst
|
||||
ex <- doesFileExist src
|
||||
if ex then do putStrLn $ "Installing "++dst
|
||||
copyFile src dst
|
||||
else putStrLn $ "Not installing "++dst
|
||||
if ex then copyFile src dst else return ()
|
||||
|
||||
gf_logo = "gf0.png"
|
||||
|
||||
|
||||
@@ -1,38 +1,33 @@
|
||||
#! /bin/bash
|
||||
|
||||
### This script builds a binary distribution of GF from source.
|
||||
### It assumes that you have Haskell and Cabal installed.
|
||||
### Two binary package formats are supported (specified with the FMT env var):
|
||||
### - plain tar files (.tar.gz)
|
||||
### - macOS installer packages (.pkg)
|
||||
### This script builds a binary distribution of GF from the source
|
||||
### package that this script is a part of. It assumes that you have installed
|
||||
### the Haskell Platform, version 2013.2.0.0 or 2012.4.0.0.
|
||||
### Two binary package formats are supported: plain tar files (.tar.gz) and
|
||||
### OS X Installer packages (.pkg).
|
||||
|
||||
os=$(uname) # Operating system name (e.g. Darwin or Linux)
|
||||
hw=$(uname -m) # Hardware name (e.g. i686 or x86_64)
|
||||
|
||||
cabal="cabal v1-" # Cabal >= 2.4
|
||||
# cabal="cabal " # Cabal <= 2.2
|
||||
|
||||
## Get GF version number from Cabal file
|
||||
# GF version number:
|
||||
ver=$(grep -i ^version: gf.cabal | sed -e 's/version://' -e 's/ //g')
|
||||
|
||||
name="gf-$ver"
|
||||
destdir="$PWD/dist/$name" # assemble binary dist here
|
||||
prefix=${PREFIX:-/usr/local} # where to install
|
||||
fmt=${FMT:-tar.gz} # binary package format (tar.gz or pkg)
|
||||
ghc=${GHC:-ghc} # which Haskell compiler to use
|
||||
|
||||
extralib="$destdir$prefix/lib"
|
||||
extrainclude="$destdir$prefix/include"
|
||||
extra="--extra-lib-dirs=$extralib --extra-include-dirs=$extrainclude"
|
||||
|
||||
set -e # Stop if an error occurs
|
||||
set -x # print commands before executing them
|
||||
set -x # print commands before exuting them
|
||||
|
||||
## First configure & build the C run-time system
|
||||
pushd src/runtime/c
|
||||
bash setup.sh configure --prefix="$prefix"
|
||||
bash setup.sh build
|
||||
bash setup.sh install prefix="$prefix" # hack required for GF build on macOS
|
||||
bash setup.sh install prefix="$destdir$prefix"
|
||||
popd
|
||||
|
||||
@@ -42,11 +37,11 @@ if which >/dev/null python; then
|
||||
EXTRA_INCLUDE_DIRS="$extrainclude" EXTRA_LIB_DIRS="$extralib" python setup.py build
|
||||
python setup.py install --prefix="$destdir$prefix"
|
||||
if [ "$fmt" == pkg ] ; then
|
||||
# A hack for Python on macOS to find the PGF modules
|
||||
pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')
|
||||
pydest="$destdir/Library/Python/$pyver/site-packages"
|
||||
mkdir -p "$pydest"
|
||||
ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf* "$pydest"
|
||||
# A hack for Python on OS X to find the PGF modules
|
||||
pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')
|
||||
pydest="$destdir/Library/Python/$pyver/site-packages"
|
||||
mkdir -p "$pydest"
|
||||
ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf* "$pydest"
|
||||
fi
|
||||
popd
|
||||
else
|
||||
@@ -57,42 +52,35 @@ fi
|
||||
if which >/dev/null javac && which >/dev/null jar ; then
|
||||
pushd src/runtime/java
|
||||
rm -f libjpgf.la # In case it contains the wrong INSTALL_PATH
|
||||
if make CFLAGS="-I$extrainclude -L$extralib" INSTALL_PATH="$prefix"
|
||||
if make CFLAGS="-I$extrainclude -L$extralib" INSTALL_PATH="$prefix/lib"
|
||||
then
|
||||
make INSTALL_PATH="$destdir$prefix" install
|
||||
make INSTALL_PATH="$destdir$prefix/lib" install
|
||||
else
|
||||
echo "Skipping the Java binding because of errors"
|
||||
echo "*** Skipping the Java binding because of errors"
|
||||
fi
|
||||
popd
|
||||
else
|
||||
echo "Java SDK is not installed, so the Java binding will not be included"
|
||||
fi
|
||||
|
||||
## To find dynamic C run-time libraries when building GF below
|
||||
export DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib"
|
||||
|
||||
## Build GF, with C run-time support enabled
|
||||
${cabal}install -w "$ghc" --only-dependencies -fserver -fc-runtime $extra
|
||||
${cabal}configure -w "$ghc" --prefix="$prefix" -fserver -fc-runtime $extra
|
||||
${cabal}build
|
||||
|
||||
## Copy GF to $destdir
|
||||
${cabal}copy --destdir="$destdir"
|
||||
cabal install --only-dependencies -fserver -fc-runtime $extra
|
||||
cabal configure --prefix="$prefix" -fserver -fc-runtime $extra
|
||||
DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib" cabal build
|
||||
cabal copy --destdir="$destdir"
|
||||
libdir=$(dirname $(find "$destdir" -name PGF.hi))
|
||||
${cabal}register --gen-pkg-config="$libdir/gf-$ver.conf"
|
||||
cabal register --gen-pkg-config=$libdir/gf-$ver.conf
|
||||
|
||||
## Create the binary distribution package
|
||||
case $fmt in
|
||||
tar.gz)
|
||||
targz="$name-bin-$hw-$os.tar.gz" # the final tar file
|
||||
tar --directory "$destdir/$prefix" --gzip --create --file "dist/$targz" .
|
||||
echo "Created $targz"
|
||||
;;
|
||||
targz="$name-bin-$hw-$os.tar.gz" # the final tar file
|
||||
tar -C "$destdir/$prefix" -zcf "dist/$targz" .
|
||||
echo "Created $targz, consider renaming it to something more user friendly"
|
||||
;;
|
||||
pkg)
|
||||
pkg=$name.pkg
|
||||
pkgbuild --identifier org.grammaticalframework.gf.pkg --version "$ver" --root "$destdir" --install-location / dist/$pkg
|
||||
echo "Created $pkg"
|
||||
pkg=$name.pkg
|
||||
pkgbuild --identifier org.grammaticalframework.gf.pkg --version "$ver" --root "$destdir" --install-location / dist/$pkg
|
||||
echo "Created $pkg"
|
||||
esac
|
||||
|
||||
## Cleanup
|
||||
rm -r "$destdir"
|
||||
|
||||
@@ -1,20 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
# This script finds all .t2t (txt2tags) and .md (Markdown) files
|
||||
# and deletes the corresponding HTML file of the same name.
|
||||
|
||||
find . -name '*.t2t' | while read t2t ; do
|
||||
html="${t2t%.t2t}.html"
|
||||
if [ -f "$html" ] ; then
|
||||
echo "$html"
|
||||
rm -f "$html"
|
||||
fi
|
||||
done
|
||||
|
||||
find . -name '*.md' | while read md ; do
|
||||
html="${md%.md}.html"
|
||||
if [ -f "$html" ] ; then
|
||||
echo "$html"
|
||||
rm -f "$html"
|
||||
fi
|
||||
done
|
||||
@@ -1,147 +0,0 @@
|
||||
<!DOCTYPE html>
|
||||
<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang$" xml:lang="$lang$"$if(dir)$ dir="$dir$"$endif$>
|
||||
<head>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
|
||||
$for(author-meta)$
|
||||
<meta name="author" content="$author-meta$" />
|
||||
$endfor$
|
||||
$if(date-meta)$
|
||||
<meta name="dcterms.date" content="$date-meta$" />
|
||||
$endif$
|
||||
$if(keywords)$
|
||||
<meta name="keywords" content="$for(keywords)$$keywords$$sep$, $endfor$" />
|
||||
$endif$
|
||||
<title>$if(title-prefix)$$title-prefix$ – $endif$$pagetitle$</title>
|
||||
<link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">
|
||||
<link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">
|
||||
$for(css)$
|
||||
<link rel="stylesheet" href="$css$" />
|
||||
$endfor$
|
||||
$if(math)$
|
||||
$math$
|
||||
$endif$
|
||||
<!--[if lt IE 9]>
|
||||
<script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
|
||||
<![endif]-->
|
||||
$for(header-includes)$
|
||||
$header-includes$
|
||||
$endfor$
|
||||
</head>
|
||||
<body class="bg-light">
|
||||
<div class="bg-white pb-5">
|
||||
$for(include-before)$
|
||||
$include-before$
|
||||
$endfor$
|
||||
<div class="container-fluid py-5" style="max-width:1200px">
|
||||
|
||||
$if(title)$
|
||||
<header id="title-block-header">
|
||||
<a href="$rel-root$" title="Home">
|
||||
<img src="$rel-root$/doc/Logos/gf1.svg" height="200" class="float-md-right ml-3 mb-3 bg-white" alt="GF Logo">
|
||||
</a>
|
||||
<h1 class="title">$title$</h1>
|
||||
$if(subtitle)$
|
||||
<p class="subtitle">$subtitle$</p>
|
||||
$endif$
|
||||
$for(author)$
|
||||
<p class="author">$author$</p>
|
||||
$endfor$
|
||||
$if(date)$
|
||||
<p class="date">$date$</p>
|
||||
$endif$
|
||||
</header>
|
||||
$endif$
|
||||
$if(toc)$
|
||||
<nav id="$idprefix$TOC">
|
||||
$if(table-of-contents)$
|
||||
<!-- pandoc >= 2.0 -->
|
||||
$table-of-contents$
|
||||
$else$
|
||||
<!-- pandoc < 2.0 -->
|
||||
$toc$
|
||||
$endif$
|
||||
</nav>
|
||||
$endif$
|
||||
$body$
|
||||
</div><!-- .container -->
|
||||
</div><!-- .bg-white -->
|
||||
|
||||
<footer class="py-5">
|
||||
<div class="container">
|
||||
<div class="row">
|
||||
|
||||
<div class="col-6 col-sm-3">
|
||||
<a href="$rel-root$">
|
||||
<i class="fas fa-home"></i>
|
||||
Home
|
||||
</a>
|
||||
<h6 class="text-muted mt-3">Get started</h6>
|
||||
<ul class="list-unstyled">
|
||||
<li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>
|
||||
<li><a href="http://cloud.grammaticalframework.org/">GF Cloud</a></li>
|
||||
<li>
|
||||
<a href="$rel-root$/doc/tutorial/gf-tutorial.html">Tutorial</a>
|
||||
·
|
||||
<a href="$rel-root$/lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
|
||||
</li>
|
||||
<li><a href="$rel-root$/doc/gf-video-tutorials.html">Video Tutorials</a></li>
|
||||
<li><a href="$rel-root$/download"><strong>Download GF</strong></a></li>
|
||||
</ul>
|
||||
</div>
|
||||
|
||||
<div class="col-6 col-sm-3">
|
||||
<h6 class="text-muted">Learn more</h6>
|
||||
<ul class="list-unstyled">
|
||||
<li><a href="$rel-root$/gf-book">The GF Book</a></li>
|
||||
<li><a href="$rel-root$/doc/gf-refman.html">Reference Manual</a></li>
|
||||
<li><a href="$rel-root$/doc/gf-shell-reference.html">GF Shell Reference</a></li>
|
||||
<li><a href="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</a></li>
|
||||
<li><a href="$rel-root$/lib/doc/synopsis/index.html"><strong>RGL Synopsis</strong></a></li>
|
||||
</ul>
|
||||
</div>
|
||||
|
||||
<div class="col-6 col-sm-3">
|
||||
<h6 class="text-muted">Develop</h6>
|
||||
<ul class="list-unstyled">
|
||||
<li><a href="$rel-root$/doc/gf-developers.html">Developers Guide</a></li>
|
||||
<li><a href="http://hackage.haskell.org/package/gf/docs/PGF.html">PGF library API (Haskell runtime)</a></li>
|
||||
<li><a href="$rel-root$/doc/runtime-api.html">PGF library API (C runtime)</a></li>
|
||||
<li><a href="http://hackage.haskell.org/package/gf/docs/GF.html">GF compiler API</a></li>
|
||||
<li><a href="$rel-root$/doc/gf-editor-modes.html">Text Editor Support</a></li>
|
||||
</ul>
|
||||
</div>
|
||||
|
||||
<div class="col-6 col-sm-3">
|
||||
<h6 class="text-muted">Contribute</h6>
|
||||
<ul class="list-unstyled">
|
||||
<li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>
|
||||
<li><a href="https://github.com/GrammaticalFramework/gf-core/issues">Issue Tracker</a></li>
|
||||
<li><a href="$rel-root$/doc/gf-people.html">Authors</a></li>
|
||||
<li><a href="http://school.grammaticalframework.org/2018/">Summer School</a></li>
|
||||
</ul>
|
||||
<h6 class="text-muted">
|
||||
Repositories
|
||||
<i class="fab fa-github ml-1"></i>
|
||||
</h6>
|
||||
<a href="https://github.com/GrammaticalFramework/gf-core">GF</a> ·
|
||||
<a href="https://github.com/GrammaticalFramework/gf-rgl">RGL</a> ·
|
||||
<a href="https://github.com/GrammaticalFramework/gf-contrib">Contributions</a>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</footer>
|
||||
$for(include-after)$
|
||||
$include-after$
|
||||
$endfor$
|
||||
<script type="text/javascript">
|
||||
var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");
|
||||
document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E"));
|
||||
</script>
|
||||
<script type="text/javascript">
|
||||
try {
|
||||
var pageTracker = _gat._getTracker("UA-7811807-3");
|
||||
pageTracker._trackPageview();
|
||||
} catch(err) {}</script>
|
||||
</body>
|
||||
</html>
|
||||
159
bin/update_html
159
bin/update_html
@@ -1,156 +1,11 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Generate HTML from txt2tags (.t2t) and Markdown (.md)
|
||||
# Usage:
|
||||
# - update_html
|
||||
# Look for all .t2t and .md files in the current directory and below,
|
||||
# generating the output HTML when the source is newer than the HTML.
|
||||
# - update_html path/to/file.t2t path/to/another.md
|
||||
# Generate HTML for the specified file(s), ignoring modification time.
|
||||
#
|
||||
# Requires:
|
||||
# - txt2tags for .t2t files. Tested with 2.6.
|
||||
# - pandoc for both .t2t and .md files. Tested with 1.16.0.2 and 2.3.1.
|
||||
# - the template file `template.html` in the same directory as this script.
|
||||
#
|
||||
# Tested with Ubuntu 16.04 and macOS Mojave.
|
||||
#
|
||||
# See also clean_html for removing the files generated by this script.
|
||||
### This script finds all .t2t (txt2tags) files and updates the corresponding
|
||||
### .html file, if it is out-of-date.
|
||||
|
||||
# Path to directory where this script is
|
||||
# https://stackoverflow.com/a/246128/98600
|
||||
DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null && pwd )"
|
||||
|
||||
# HTML template
|
||||
template="$DIR/template.html"
|
||||
|
||||
# Render txt2tags into html file
|
||||
# Arguments:
|
||||
# 1. txt2tags source file, e.g. download/index.t2t
|
||||
# 2. html target file, e.g. download/index.html
|
||||
function render_t2t_html {
|
||||
t2t="$1"
|
||||
html="$2"
|
||||
tmp="$2.tmp"
|
||||
relroot="$( dirname $t2t | sed -E 's/^.\///' | sed -E 's/[^/]+/../g' )"
|
||||
|
||||
# First render with txt2tags to handle pre/post processing
|
||||
txt2tags \
|
||||
--target=html \
|
||||
--no-headers \
|
||||
--quiet \
|
||||
--outfile="$tmp" \
|
||||
--infile="$t2t"
|
||||
|
||||
# Replace <A NAME="toc3"></A> with <div id="toc3"></div> so that Pandoc retains it
|
||||
# Do this for both cases since BSD sed doesn't support /i
|
||||
sed -i.bak "s/<a name=\"\(.*\)\"><\/a>/<div id=\"\1\"><\/div>/" "$tmp"
|
||||
sed -i.bak "s/<A NAME=\"\(.*\)\"><\/A>/<div id=\"\1\"><\/div>/" "$tmp"
|
||||
rm -f "$tmp.bak"
|
||||
|
||||
# Capture first 3 lines of t2t file: title, author, date
|
||||
# Documentation here: https://txt2tags.org/userguide/headerarea
|
||||
l1=$(head -n 1 "$t2t")
|
||||
l2=$(tail -n+2 "$t2t" | head -n 1)
|
||||
l3=$(tail -n+3 "$t2t" | head -n 1)
|
||||
title=
|
||||
author=
|
||||
date=
|
||||
if [ -n "$l1" ] ; then
|
||||
title="$l1"
|
||||
if [ -n "$l2" ] ; then author="$l2" ; fi
|
||||
if [ -n "$l3" ] ; then date="$l3" ; fi
|
||||
find . -name '*.t2t' | while read t2t ; do
|
||||
html="${t2t%.t2t}.html"
|
||||
if [ "$t2t" -nt "$html" ] ; then
|
||||
txt2tags -thtml "$t2t"
|
||||
fi
|
||||
|
||||
# Run txt2tag's HTML through Pandoc for cleanup
|
||||
pandoc \
|
||||
--from=html \
|
||||
--to=html5 \
|
||||
--standalone \
|
||||
--template="$template" \
|
||||
--variable="lang:en" \
|
||||
--variable="rel-root:$relroot" \
|
||||
--metadata="title:$title" \
|
||||
--metadata="author:$author" \
|
||||
--metadata="date:$date" \
|
||||
"$tmp" \
|
||||
--output="$html"
|
||||
rm -f "$tmp"
|
||||
|
||||
# Final post-processing
|
||||
if [ -f "$html" ] ; then
|
||||
sed -i.bak "s/<table/<table class=\"table\"/" "$html" && rm "$html.bak"
|
||||
echo "$html"
|
||||
fi
|
||||
}
|
||||
|
||||
# Render markdown into html file
|
||||
# Arguments:
|
||||
# 1. markdown source file, e.g. download/index.md
|
||||
# 2. html target file, e.g. download/index.html
|
||||
function render_md_html {
|
||||
md="$1"
|
||||
html="$2"
|
||||
relroot="$( dirname $md | sed -E 's/^.\///' | sed -E 's/[^/]+/../g' )"
|
||||
|
||||
# Look for `show-toc: true` in metadata (first ten lines of file)
|
||||
if head -n 10 "$md" | grep --quiet 'show-toc: true' ; then
|
||||
tocflag='--table-of-contents'
|
||||
else
|
||||
tocflag=''
|
||||
fi
|
||||
|
||||
pandoc \
|
||||
--from=markdown \
|
||||
--to=html5 \
|
||||
--standalone \
|
||||
$tocflag \
|
||||
--template="$template" \
|
||||
--variable="lang:en" \
|
||||
--variable="rel-root:$relroot" \
|
||||
"$md" \
|
||||
--output="$html"
|
||||
|
||||
# Final post-processing
|
||||
if [ -f "$html" ] ; then
|
||||
# add "table" class to tables
|
||||
sed -i.bak "s/<table/<table class=\"table\"/" "$html"
|
||||
# rewrite anchors that Pandoc 1.16 ignores: [content]{#anchor} -> <span id="anchor">content</span>
|
||||
sed -i.bak -E "s/\[(.*)\]\{#(.+)\}/<span id=\"\2\">\1<\/span>/" "$html"
|
||||
rm -f "$html.bak"
|
||||
echo "$html"
|
||||
fi
|
||||
}
|
||||
|
||||
# Main entry point
|
||||
# Script can be run in one of two modes:
|
||||
if [ $# -gt 0 ] ; then
|
||||
# Render specific file(s) from args, ignoring dates
|
||||
for file in "$@" ; do
|
||||
ext="${file##*.}"
|
||||
html="${file%.$ext}.html"
|
||||
case $ext in
|
||||
"md")
|
||||
render_md_html "$file" "$html"
|
||||
;;
|
||||
"t2t")
|
||||
render_t2t_html "$file" "$html"
|
||||
;;
|
||||
esac
|
||||
done
|
||||
else
|
||||
# Render all files found in cwd and deeper if source is newer
|
||||
find . -name '*.t2t' | while read file ; do
|
||||
html="${file%.t2t}.html"
|
||||
if [ "$file" -nt "$html" ] || [ "$template" -nt "$html" ] ; then
|
||||
render_t2t_html "$file" "$html"
|
||||
fi
|
||||
done
|
||||
find . -name '*.md' | while read file ; do
|
||||
if [[ "$file" == *"README.md" ]] || [[ "$file" == *"RELEASE.md" ]] ; then continue ; fi
|
||||
html="${file%.md}.html"
|
||||
if [ "$file" -nt "$html" ] || [ "$template" -nt "$html" ] ; then
|
||||
render_md_html "$file" "$html"
|
||||
fi
|
||||
done
|
||||
fi
|
||||
done
|
||||
@@ -17,7 +17,10 @@ h1 img.nofloat { float: none; }
|
||||
img.right { float: right; }
|
||||
|
||||
ol.languages {
|
||||
column-width: 12em;
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
flex-wrap: wrap;
|
||||
height: 12em;
|
||||
}
|
||||
|
||||
.grow {
|
||||
|
||||
24
debian/changelog
vendored
24
debian/changelog
vendored
@@ -1,27 +1,3 @@
|
||||
gf (3.10.4-1) xenial bionic cosmic; urgency=low
|
||||
|
||||
* GF 3.10.4
|
||||
|
||||
-- Thomas Hallgren <hallgren@chalmers.se> Fri, 18 Nov 2019 15:00:00 +0100
|
||||
|
||||
gf (3.10.3-1) xenial bionic cosmic; urgency=low
|
||||
|
||||
* GF 3.10.3
|
||||
|
||||
-- Thomas Hallgren <hallgren@chalmers.se> Fri, 5 Mar 2019 19:30:00 +0100
|
||||
|
||||
gf (3.10-2) xenial bionic cosmic; urgency=low
|
||||
|
||||
* GF 3.10
|
||||
|
||||
-- Thomas Hallgren <hallgren@chalmers.se> Fri, 5 Mar 2019 16:00:00 +0100
|
||||
|
||||
gf (3.10-1) xenial bionic cosmic; urgency=low
|
||||
|
||||
* GF 3.10
|
||||
|
||||
-- Thomas Hallgren <hallgren@chalmers.se> Fri, 2 Dec 2018 15:00:00 +0100
|
||||
|
||||
gf (3.9-1) vivid xenial zesty; urgency=low
|
||||
|
||||
* GF 3.9
|
||||
|
||||
4
debian/control
vendored
4
debian/control
vendored
@@ -3,14 +3,14 @@ Section: devel
|
||||
Priority: optional
|
||||
Maintainer: Thomas Hallgren <hallgren@chalmers.se>
|
||||
Standards-Version: 3.9.2
|
||||
Build-Depends: debhelper (>= 5), haskell-platform (>= 2011.2.0.1), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev, java-sdk
|
||||
Build-Depends: debhelper (>= 5), haskell-platform (>= 2011.2.0.1), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev, java-sdk, txt2tags
|
||||
Homepage: http://www.grammaticalframework.org/
|
||||
|
||||
Package: gf
|
||||
Architecture: any
|
||||
Depends: ${shlibs:Depends}
|
||||
Description: Tools for GF, a grammar formalism based on type theory
|
||||
Grammatical Framework (GF) is a grammar formalism based on type theory.
|
||||
Grammatical Framework (GF) is a grammar formalism based on type theory.
|
||||
It consists of a special-purpose programming language,
|
||||
a compiler of the language, and a generic grammar processor.
|
||||
.
|
||||
|
||||
39
debian/rules
vendored
Executable file → Normal file
39
debian/rules
vendored
Executable file → Normal file
@@ -1,6 +1,6 @@
|
||||
#!/usr/bin/make -f
|
||||
|
||||
%:
|
||||
%:
|
||||
+dh $@
|
||||
|
||||
#dh_shlibdeps has a problem finding which package some of the Haskell
|
||||
@@ -13,27 +13,12 @@
|
||||
override_dh_shlibdeps:
|
||||
dh_shlibdeps --dpkg-shlibdeps-params=--ignore-missing-info
|
||||
|
||||
override_dh_auto_configure:
|
||||
cd src/runtime/c && bash setup.sh configure --prefix=/usr
|
||||
cd src/runtime/c && bash setup.sh build
|
||||
cabal update
|
||||
cabal install --only-dependencies
|
||||
cabal configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c
|
||||
|
||||
SET_LDL=LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs
|
||||
|
||||
override_dh_auto_build:
|
||||
cd src/runtime/python && EXTRA_INCLUDE_DIRS=$(CURDIR)/src/runtime/c EXTRA_LIB_DIRS=$(CURDIR)/src/runtime/c/.libs python setup.py build
|
||||
cd src/runtime/java && make CFLAGS="-I$(CURDIR)/src/runtime/c -L$(CURDIR)/src/runtime/c/.libs" INSTALL_PATH=/usr
|
||||
echo $(SET_LDL)
|
||||
-$(SET_LDL) cabal build
|
||||
|
||||
override_dh_auto_install:
|
||||
$(SET_LDL) cabal copy --destdir=$(CURDIR)/debian/gf
|
||||
cd src/runtime/c && bash setup.sh copy prefix=$(CURDIR)/debian/gf/usr
|
||||
cd src/runtime/python && python setup.py install --prefix=$(CURDIR)/debian/gf/usr
|
||||
cd src/runtime/java && make INSTALL_PATH=$(CURDIR)/debian/gf/usr install
|
||||
D="`find debian/gf -name site-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv site-packages dist-packages
|
||||
cd src/runtime/java && make CFLAGS="-I$(CURDIR)/src/runtime/c -L$(CURDIR)/src/runtime/c/.libs" INSTALL_PATH=/usr/lib
|
||||
echo LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs
|
||||
LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal build
|
||||
make html
|
||||
|
||||
override_dh_auto_clean:
|
||||
rm -fr dist/build
|
||||
@@ -41,6 +26,20 @@ override_dh_auto_clean:
|
||||
-cd src/runtime/java && make clean
|
||||
-cd src/runtime/c && make clean
|
||||
|
||||
override_dh_auto_configure:
|
||||
cd src/runtime/c && bash setup.sh configure --prefix=/usr
|
||||
cd src/runtime/c && bash setup.sh build
|
||||
cabal update
|
||||
cabal install --only-dependencies
|
||||
cabal configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c
|
||||
|
||||
override_dh_auto_install:
|
||||
LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs cabal copy --destdir=$(CURDIR)/debian/gf
|
||||
cd src/runtime/c && bash setup.sh copy prefix=$(CURDIR)/debian/gf/usr
|
||||
cd src/runtime/python && python setup.py install --prefix=$(CURDIR)/debian/gf/usr
|
||||
cd src/runtime/java && make INSTALL_PATH=$(CURDIR)/debian/gf/usr/lib install
|
||||
D="`find debian/gf -name site-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv site-packages dist-packages
|
||||
|
||||
override_dh_auto_test:
|
||||
ifneq (nocheck,$(filter nocheck,$(DEB_BUILD_OPTIONS)))
|
||||
true
|
||||
|
||||
15
doc/Makefile
15
doc/Makefile
@@ -1,3 +1,18 @@
|
||||
resource:
|
||||
gfdoc -txt2 ../lib/resource-1.0/abstract/*.gf
|
||||
gfdoc -txt2 ../lib/resource-1.0/*/Paradigms*.gf
|
||||
txt2tags --toc resource.txt
|
||||
# cat resource-preamble resource.tex >final-resource.tex
|
||||
sed -i 's/\\docum/%\\docum/g' resource.tex
|
||||
sed -i 's/ion\*{/ion{/g' resource.tex
|
||||
sed -i 's/\\paragraph{}//g' resource.tex
|
||||
sed -i 's/}\\\\/}/g' resource.tex
|
||||
cat resource-preamble resource.tex >resource.tmp
|
||||
mv resource.tmp resource.tex
|
||||
latex resource.tex
|
||||
latex resource.tex
|
||||
dvipdf resource.dvi
|
||||
|
||||
gf-help-full.txt::
|
||||
{ echo ; echo ; echo ; } > $@
|
||||
echo help -full -t2t | gf -run >> $@
|
||||
|
||||
@@ -1,551 +0,0 @@
|
||||
Compiler.hs
|
||||
mainGFC :: Options -> [FilePath] -> IO ()
|
||||
_ | null fs -> fail $ "No input files."
|
||||
_ | all (extensionIs ".pgf") fs -> unionPGFFiles opts fs
|
||||
_ -> fail $ "Don't know what to do with these input files: " ++ unwords fs)
|
||||
|
||||
|
||||
----------------------------------------
|
||||
Compile.hs
|
||||
|
||||
compileModule
|
||||
case length file1s of
|
||||
0 -> raise (render ("Unable to find: " $$ nest 2 candidates))
|
||||
1 -> do return $ head file1s
|
||||
_ -> do putIfVerb opts1 ("matched multiple candidates: " +++ show file1s)
|
||||
return $ head file1s
|
||||
else raise (render ("File" <+> file <+> "does not exist"))
|
||||
|
||||
---------------------------------------
|
||||
Grammar.Lexer.x
|
||||
token :: P Token
|
||||
AlexError (AI pos _ _) -> PFailed pos "lexical error"
|
||||
|
||||
|
||||
---------------------------------------
|
||||
Grammar.Parser.y
|
||||
|
||||
happyError = fail "syntax error"
|
||||
|
||||
tryLoc (c,mty,Just e) = return (c,(mty,e))
|
||||
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ showIdent c +++ "without value")
|
||||
|
||||
mkR [] = return $ RecType [] --- empty record always interpreted as record type
|
||||
mkR fs@(f:_) =
|
||||
case f of
|
||||
(lab,Just ty,Nothing) -> mapM tryRT fs >>= return . RecType
|
||||
_ -> mapM tryR fs >>= return . R
|
||||
where
|
||||
tryRT (lab,Just ty,Nothing) = return (ident2label lab,ty)
|
||||
tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ showIdent lab --- manifest fields ?!
|
||||
|
||||
tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))
|
||||
tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ showIdent lab
|
||||
|
||||
|
||||
---------------------------------------
|
||||
ModDeps.hs
|
||||
|
||||
mkSourceGrammar :: [SourceModule] -> Err SourceGrammar
|
||||
deplist <- either
|
||||
return
|
||||
(\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $
|
||||
|
||||
|
||||
checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
|
||||
test ms = testErr (all (`notElem` ns) ms)
|
||||
("import names clashing with module names among" +++ unwords (map prt ms))
|
||||
|
||||
|
||||
moduleDeps :: [SourceModule] -> Err Dependencies
|
||||
deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of
|
||||
MTConcrete a -> do
|
||||
am <- lookupModuleType gr a
|
||||
testErr (mtype am == MTAbstract) "the of-module is not an abstract syntax"
|
||||
|
||||
testErr (all (compatMType ety . mtype) ests) "inappropriate extension module type"
|
||||
|
||||
|
||||
---------------------------------------
|
||||
Update.hs
|
||||
|
||||
buildAnyTree
|
||||
Just i -> case unifyAnyInfo m i j of
|
||||
Ok k -> go (Map.insert c k map) is
|
||||
Bad _ -> fail $ render ("conflicting information in module"<+>m $$
|
||||
nest 4 (ppJudgement Qualified (c,i)) $$
|
||||
"and" $+$
|
||||
nest 4 (ppJudgement Qualified (c,j)))
|
||||
extendModule
|
||||
unless (sameMType (mtype m) (mtype mo))
|
||||
(checkError ("illegal extension type to module" <+> name))
|
||||
|
||||
rebuildModule
|
||||
unless (null is || mstatus mi == MSIncomplete)
|
||||
(checkError ("module" <+> i <+>
|
||||
"has open interfaces and must therefore be declared incomplete"))
|
||||
|
||||
unless (isModRes m1)
|
||||
(checkError ("interface expected instead of" <+> i0))
|
||||
js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)
|
||||
|
||||
unless (stat' == MSComplete || stat == MSIncomplete)
|
||||
(checkError ("module" <+> i <+> "remains incomplete"))
|
||||
|
||||
|
||||
extendMod
|
||||
checkError ("cannot unify the information" $$
|
||||
nest 4 (ppJudgement Qualified (c,i)) $$
|
||||
"in module" <+> name <+> "with" $$
|
||||
nest 4 (ppJudgement Qualified (c,j)) $$
|
||||
"in module" <+> base)
|
||||
|
||||
unifyAnyInfo
|
||||
(ResValue (L l1 t1), ResValue (L l2 t2))
|
||||
| t1==t2 -> return (ResValue (L l1 t1))
|
||||
| otherwise -> fail ""
|
||||
|
||||
(AnyInd b1 m1, AnyInd b2 m2) -> do
|
||||
testErr (b1 == b2) $ "indirection status"
|
||||
testErr (m1 == m2) $ "different sources of indirection"
|
||||
|
||||
unifAbsDefs _ _ = fail ""
|
||||
|
||||
----------------------------------
|
||||
|
||||
Rename.hs
|
||||
|
||||
renameIdentTerm'
|
||||
_ -> case lookupTreeManyAll showIdent opens c of
|
||||
[f] -> return (f c)
|
||||
[] -> alt c ("constant not found:" <+> c $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
|
||||
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
|
||||
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
return t
|
||||
|
||||
renameInfo
|
||||
renLoc ren (L loc x) =
|
||||
checkInModule cwd mi loc ("Happened in the renaming of" <+> i) $ do
|
||||
|
||||
renameTerm
|
||||
| otherwise -> checks [ renid' (Q (MN r,label2ident l)) -- .. and qualified expression second.
|
||||
, renid' t >>= \t -> return (P t l) -- try as a constant at the end
|
||||
, checkError ("unknown qualified constant" <+> trm)
|
||||
]
|
||||
|
||||
renamePattern env patt =
|
||||
do r@(p',vs) <- renp patt
|
||||
let dupl = vs \\ nub vs
|
||||
unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4
|
||||
patt)
|
||||
return r
|
||||
|
||||
case c' of
|
||||
Q d -> renp $ PM d
|
||||
_ -> checkError ("unresolved pattern" <+> patt)
|
||||
|
||||
Q _ -> checkError ("data constructor expected but" <+> ppTerm Qualified 0 c' <+> "is found instead")
|
||||
_ -> checkError ("unresolved data constructor" <+> ppTerm Qualified 0 c')
|
||||
|
||||
PM c -> do
|
||||
x <- renid (Q c)
|
||||
c' <- case x of
|
||||
(Q c') -> return c'
|
||||
_ -> checkError ("not a pattern macro" <+> ppPatt Qualified 0 patt)
|
||||
|
||||
PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
|
||||
QC c -> return (PP c [],[])
|
||||
_ -> checkError (pp "not a constructor")
|
||||
, return (patt, [x])
|
||||
|
||||
|
||||
|
||||
-----------------------------------
|
||||
CheckGrammar.hs
|
||||
|
||||
checkRestrictedInheritance :: FilePath -> SourceGrammar -> SourceModule -> Check ()
|
||||
let illegals = [(f,is) |
|
||||
(f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
|
||||
case illegals of
|
||||
[] -> return ()
|
||||
cs -> checkWarn ("In inherited module" <+> i <> ", dependence of excluded constants:" $$
|
||||
nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))
|
||||
|
||||
checkCompleteGrammar :: Options -> FilePath -> Grammar -> Module -> Module -> Check Module
|
||||
case info of
|
||||
CncCat (Just (L loc (RecType []))) _ _ _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
|
||||
_ -> Bad "no def lin"
|
||||
|
||||
where noLinOf c = checkWarn ("no linearization of" <+> c)
|
||||
|
||||
Ok (CncCat Nothing md mr mp mpmcfg) -> do
|
||||
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
|
||||
return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
|
||||
_ -> do
|
||||
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
|
||||
|
||||
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
|
||||
|
||||
Ok (_,AbsFun {}) ->
|
||||
checkError ("lincat:"<+>c<+>"is a fun, not a cat")
|
||||
-}
|
||||
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
|
||||
|
||||
checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
|
||||
(Just (L loct ty), Nothing) -> do
|
||||
chIn loct "operation" $
|
||||
checkError (pp "No definition given to the operation")
|
||||
|
||||
ResOverload os tysts -> chIn NoLoc "overloading" $ do
|
||||
|
||||
checkUniq xss = case xss of
|
||||
x:y:xs
|
||||
| x == y -> checkError $ "ambiguous for type" <+>
|
||||
ppType (mkFunType (tail x) (head x))
|
||||
|
||||
compAbsTyp g t = case t of
|
||||
Vr x -> maybe (checkError ("no value given to variable" <+> x)) return $ lookup x g
|
||||
|
||||
checkReservedId x =
|
||||
when (isReservedWord x) $
|
||||
checkWarn ("reserved word used as identifier:" <+> x)
|
||||
|
||||
|
||||
--------------------------------
|
||||
TypeCheck/Abstract.hs
|
||||
|
||||
grammar2theory :: SourceGrammar -> Theory
|
||||
Bad s -> case lookupCatContext gr m f of
|
||||
Ok cont -> return $ cont2val cont
|
||||
_ -> Bad s
|
||||
|
||||
|
||||
--------------------------------
|
||||
TypeCheck/ConcreteNew.hs
|
||||
-- Concrete.hs has all its code commented out
|
||||
|
||||
|
||||
--------------------------------
|
||||
TypeCheck/RConcrete.hs
|
||||
-- seems to be used more than ConcreteNew
|
||||
|
||||
computeLType :: SourceGrammar -> Context -> Type -> Check Type
|
||||
AdHocOverload ts -> do
|
||||
over <- getOverload gr g (Just typeType) t
|
||||
case over of
|
||||
Just (tr,_) -> return tr
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t)
|
||||
|
||||
inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)
|
||||
Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
|
||||
Nothing -> checkError ("unknown in Predef:" <+> ident)
|
||||
|
||||
Q ident -> checks [
|
||||
checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
|
||||
]
|
||||
|
||||
QC ident -> checks [
|
||||
checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
|
||||
]
|
||||
|
||||
Vr ident -> termWith trm $ checkLookup ident g
|
||||
|
||||
AdHocOverload ts -> do
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
|
||||
|
||||
App f a -> do
|
||||
case fty' of
|
||||
Prod bt z arg val -> do
|
||||
_ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)
|
||||
|
||||
S f x -> do
|
||||
_ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
|
||||
|
||||
P t i -> do
|
||||
Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
|
||||
_ -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
|
||||
" instead of the inferred:" <+> ppTerm Unqualified 0 ty')
|
||||
|
||||
R r -> do
|
||||
checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
|
||||
|
||||
T ti pts -> do -- tries to guess: good in oper type inference
|
||||
[] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
|
||||
|
||||
---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
|
||||
Strs (Cn c : ts) | c == cConflict -> do
|
||||
checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
|
||||
|
||||
ExtR r s -> do
|
||||
case (rT', sT') of
|
||||
(RecType rs, RecType ss) -> do
|
||||
_ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
|
||||
|
||||
_ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
|
||||
|
||||
|
||||
getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))
|
||||
matchOverload f typs ttys = do
|
||||
checkWarn $ "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
|
||||
"for" $$
|
||||
nest 2 (showTypes tys) $$
|
||||
"using" $$
|
||||
nest 2 (showTypes pre)
|
||||
([],[]) -> do
|
||||
checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
|
||||
"for" $$
|
||||
nest 2 stysError $$
|
||||
"among" $$
|
||||
nest 2 (vcat stypsError) $$
|
||||
maybe empty (\x -> "with value type" <+> ppType x) mt
|
||||
([],[(val,fun)]) -> do
|
||||
checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot)
|
||||
(nps1,nps2) -> do
|
||||
checkWarn $ "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
|
||||
---- "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$
|
||||
"resolved by selecting the first of the alternatives" $$
|
||||
nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
|
||||
case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of
|
||||
[] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f
|
||||
|
||||
checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)
|
||||
Abs bt x c -> do
|
||||
case typ of
|
||||
Prod bt' z a b -> do
|
||||
_ -> checkError $ "function type expected instead of" <+> ppType typ
|
||||
AdHocOverload ts -> do
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
|
||||
T _ [] ->
|
||||
checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
|
||||
T _ cs -> case typ of
|
||||
else checkWarn ("patterns never reached:" $$
|
||||
nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
|
||||
_ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
|
||||
V arg0 vs ->
|
||||
if length vs1 == length vs
|
||||
then return ()
|
||||
else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm
|
||||
|
||||
R r -> case typ of --- why needed? because inference may be too difficult
|
||||
RecType rr -> do
|
||||
_ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
|
||||
|
||||
ExtR r s -> case typ of
|
||||
case trm' of
|
||||
RecType _ -> termWith trm' $ return typeType
|
||||
ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType
|
||||
-- ext t = t ** ...
|
||||
_ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
|
||||
|
||||
case typ2 of
|
||||
RecType ss -> return $ map fst ss
|
||||
_ -> checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
|
||||
_ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
|
||||
|
||||
S tab arg -> checks [ do
|
||||
_ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
|
||||
|
||||
_ -> do
|
||||
(trm',ty') <- inferLType gr g trm
|
||||
termWith trm' $ checkEqLType gr g typ ty' trm'
|
||||
|
||||
checkM rms (l,ty) = case lookup l rms of
|
||||
_ -> checkError $
|
||||
if isLockLabel l
|
||||
then let cat = drop 5 (showIdent (label2ident l))
|
||||
in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <>
|
||||
"; try wrapping it with lin" <+> cat
|
||||
else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
|
||||
|
||||
checkEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check Type
|
||||
False -> checkError $ s <+> "type of" <+> ppTerm Unqualified 0 trm $$
|
||||
"expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$
|
||||
"inferred:" <+> ppTerm Qualified 0 u -- ppqType u t
|
||||
|
||||
checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
|
||||
Ok lo -> do
|
||||
checkWarn $ "missing lock field" <+> fsep lo
|
||||
|
||||
missingLock g t u = case (t,u) of
|
||||
_:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
|
||||
|
||||
|
||||
|
||||
pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context
|
||||
checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p)
|
||||
(length cont == length ps)
|
||||
PR r -> do
|
||||
_ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
|
||||
|
||||
PAlt p' q -> do
|
||||
g1 <- pattContext env g typ p'
|
||||
g2 <- pattContext env g typ q
|
||||
let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
|
||||
checkCond
|
||||
("incompatible bindings of" <+>
|
||||
fsep pts <+>
|
||||
"in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts)
|
||||
return g1 -- must be g1 == g2
|
||||
|
||||
noBind typ p' = do
|
||||
co <- pattContext env g typ p'
|
||||
if not (null co)
|
||||
then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p)
|
||||
>> return []
|
||||
else return []
|
||||
|
||||
checkLookup :: Ident -> Context -> Check Type -- used for looking up Vr x type in context
|
||||
[] -> checkError ("unknown variable" <+> x)
|
||||
|
||||
|
||||
|
||||
-------------------------------
|
||||
Grammar/Lookup.hs
|
||||
|
||||
lookupIdent :: ErrorMonad m => Ident -> BinTree Ident b -> m b
|
||||
Bad _ -> raise ("unknown identifier" +++ showIdent c)
|
||||
|
||||
lookupResDefLoc
|
||||
_ -> raise $ render (c <+> "is not defined in resource" <+> m)
|
||||
|
||||
lookupResType :: ErrorMonad m => Grammar -> QIdent -> m Type
|
||||
_ -> raise $ render (c <+> "has no type defined in resource" <+> m)
|
||||
|
||||
lookupOverloadTypes :: ErrorMonad m => Grammar -> QIdent -> m [(Term,Type)]
|
||||
_ -> raise $ render (c <+> "has no types defined in resource" <+> m)
|
||||
|
||||
lookupOverload :: ErrorMonad m => Grammar -> QIdent -> m [([Type],(Type,Term))]
|
||||
_ -> raise $ render (c <+> "is not an overloaded operation")
|
||||
|
||||
|
||||
lookupParamValues :: ErrorMonad m => Grammar -> QIdent -> m [Term]
|
||||
case info of
|
||||
ResParam _ (Just pvs) -> return pvs
|
||||
_ -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
|
||||
|
||||
|
||||
allParamValues :: ErrorMonad m => Grammar -> Type -> m [Term]
|
||||
_ -> raise (render ("cannot find parameter values for" <+> ptyp))
|
||||
|
||||
|
||||
lookupFunType :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Type
|
||||
_ -> raise (render ("cannot find type of" <+> c))
|
||||
|
||||
lookupCatContext :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Context
|
||||
_ -> raise (render ("unknown category" <+> c))
|
||||
|
||||
|
||||
-------------------------
|
||||
PatternMatch.hs
|
||||
|
||||
matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)
|
||||
if not (isInConstantForm term)
|
||||
then raise (render ("variables occur in" <+> pp term))
|
||||
|
||||
findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)
|
||||
[] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))
|
||||
(patts,_):_ | length patts /= length terms ->
|
||||
raise (render ("wrong number of args for patterns :" <+> hsep patts <+>
|
||||
"cannot take" <+> hsep terms))
|
||||
|
||||
tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
|
||||
(PNeg p',_) -> case tryMatch (p',t) of
|
||||
Bad _ -> return []
|
||||
_ -> raise (render ("no match with negative pattern" <+> p))
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
Compile.Optimize.hs
|
||||
|
||||
mkLinDefault :: SourceGrammar -> Type -> Err Term
|
||||
_ -> Bad (render ("no parameter values given to type" <+> ppQIdent Qualified p))
|
||||
_ -> Bad (render ("linearization type field cannot be" <+> typ))
|
||||
|
||||
mkLinReference :: SourceGrammar -> Type -> Err Term
|
||||
[] -> Bad "no string"
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
Compile.Compute.Concrete.hs
|
||||
|
||||
nfx env@(GE _ _ _ loc) t = do
|
||||
Left i -> fail ("variable #"++show i++" is out of scope")
|
||||
|
||||
var :: CompleteEnv -> Ident -> Err OpenValue
|
||||
var env x = maybe unbound pick' (elemIndex x (local env))
|
||||
where
|
||||
unbound = fail ("Unknown variable: "++showIdent x)
|
||||
pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
|
||||
err i vs = bug $ "Stack problem: "++showIdent x++": "
|
||||
++unwords (map showIdent (local env))
|
||||
++" => "++show (i,length vs)
|
||||
|
||||
resource env (m,c) =
|
||||
where e = fail $ "Not found: "++render m++"."++showIdent c
|
||||
|
||||
extR t vv =
|
||||
(VRecType rs1, VRecType rs2) ->
|
||||
case intersect (map fst rs1) (map fst rs2) of
|
||||
[] -> VRecType (rs1 ++ rs2)
|
||||
ls -> error $ "clash"<+>show ls
|
||||
(v1,v2) -> error $ "not records" $$ show v1 $$ show v2
|
||||
where
|
||||
error explain = ppbug $ "The term" <+> t
|
||||
<+> "is not reducible" $$ explain
|
||||
|
||||
glue env (v1,v2) = glu v1 v2
|
||||
ppL loc (hang "unsupported token gluing:" 4
|
||||
(Glue (vt v1) (vt v2)))
|
||||
|
||||
strsFromValue :: Value -> Err [Str]
|
||||
_ -> fail ("cannot get Str from value " ++ show t)
|
||||
|
||||
match loc cs v =
|
||||
case value2term loc [] v of
|
||||
Left i -> bad ("variable #"++show i++" is out of scope")
|
||||
Right t -> err bad return (matchPattern cs t)
|
||||
where
|
||||
bad = fail . ("In pattern matching: "++)
|
||||
|
||||
inlinePattMacro p =
|
||||
VPatt p' -> inlinePattMacro p'
|
||||
_ -> ppbug $ hang "Expected pattern macro:" 4
|
||||
|
||||
linPattVars p =
|
||||
if null dups
|
||||
then return pvs
|
||||
else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)
|
||||
|
||||
---------------------------------------------
|
||||
Compile.Compute.Abstract.hs
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
PGF.Linearize.hs
|
||||
|
||||
bracketedLinearize :: PGF -> Language -> Tree -> [BracketedString]
|
||||
cnc = lookMap (error "no lang") lang (concretes pgf)
|
||||
|
||||
|
||||
---------------------------------------------
|
||||
PGF.TypeCheck.hs
|
||||
|
||||
ppTcError :: TcError -> Doc
|
||||
ppTcError (UnknownCat cat) = text "Category" <+> ppCId cat <+> text "is not in scope"
|
||||
ppTcError (UnknownFun fun) = text "Function" <+> ppCId fun <+> text "is not in scope"
|
||||
ppTcError (WrongCatArgs xs ty cat m n) = text "Category" <+> ppCId cat <+> text "should have" <+> int m <+> text "argument(s), but has been given" <+> int n $$
|
||||
text "In the type:" <+> ppType 0 xs ty
|
||||
ppTcError (TypeMismatch xs e ty1 ty2) = text "Couldn't match expected type" <+> ppType 0 xs ty1 $$
|
||||
text " against inferred type" <+> ppType 0 xs ty2 $$
|
||||
text "In the expression:" <+> ppExpr 0 xs e
|
||||
ppTcError (NotFunType xs e ty) = text "A function type is expected for the expression" <+> ppExpr 0 xs e <+> text "instead of type" <+> ppType 0 xs ty
|
||||
ppTcError (CannotInferType xs e) = text "Cannot infer the type of expression" <+> ppExpr 0 xs e
|
||||
ppTcError (UnresolvedMetaVars xs e ms) = text "Meta variable(s)" <+> fsep (List.map ppMeta ms) <+> text "should be resolved" $$
|
||||
text "in the expression:" <+> ppExpr 0 xs e
|
||||
ppTcError (UnexpectedImplArg xs e) = braces (ppExpr 0 xs e) <+> text "is implicit argument but not implicit argument is expected here"
|
||||
ppTcError (UnsolvableGoal xs metaid ty)= text "The goal:" <+> ppMeta metaid <+> colon <+> ppType 0 xs ty $$
|
||||
text "cannot be solved"
|
||||
|
||||
@@ -1,27 +0,0 @@
|
||||
## unsupported token gluing `foo + bar`
|
||||
|
||||
There was a problem in an expression using +, e.g. `foo + bar`.
|
||||
This can be due to two causes, check which one applies in your case.
|
||||
|
||||
1. You are trying to use + on runtime arguments. Even if you are using
|
||||
`foo + bar` in an oper, make sure that the oper isn't called in a
|
||||
linearization that takes arguments. Both of the following are illegal:
|
||||
|
||||
lin Test foo bar = foo.s + bar.s -- explicit + in a lin
|
||||
lin Test foo bar = opWithPlus foo bar -- the oper uses +
|
||||
|
||||
2. One of the arguments in `foo + bar` is a bound variable
|
||||
from pattern matching a string, but the cases are non-exhaustive.
|
||||
Example:
|
||||
case "test" of {
|
||||
x + "a" => x + "b" -- no applicable case for "test", so x = ???
|
||||
} ;
|
||||
|
||||
You can fix this by adding a catch-all case in the end:
|
||||
{ x + "a" => x + "b" ;
|
||||
_ => "default case" } ;
|
||||
|
||||
3. If neither applies to your problem, submit a bug report and we
|
||||
will update the error message and this documentation.
|
||||
|
||||
https://github.com/GrammaticalFramework/gf-core/issues
|
||||
@@ -1,8 +1,16 @@
|
||||
GF Developers Guide
|
||||
Authors: Björn Bringert, Krasimir Angelov and Thomas Hallgren
|
||||
Last update: %%mtime(%F, %H:%M)
|
||||
|
||||
2018-07-26
|
||||
% NOTE: this is a txt2tags file.
|
||||
% Create an html file from this file using:
|
||||
% txt2tags -t html gf-developers.t2t
|
||||
|
||||
%!style:../css/style.css
|
||||
%!target:html
|
||||
%!options(html): --toc
|
||||
%!encoding:utf-8
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
== Before you start ==
|
||||
|
||||
@@ -55,6 +63,18 @@ Other required tools included in the Haskell Platform are
|
||||
and
|
||||
[Happy http://www.haskell.org/happy/].
|
||||
|
||||
%=== Darcs ===
|
||||
%
|
||||
%To get the GF source code, you also need //Darcs//, version 2 or later.
|
||||
%Darcs 2.10 is recommended (July 2015).
|
||||
%
|
||||
%//Darcs//
|
||||
%is a distributed version control system, see http://darcs.net/ for
|
||||
%more information. There are precompiled packages for many platforms
|
||||
%available and source code if you want to compile it yourself. Darcs
|
||||
%is also written in Haskell and so you can use GHC to compile it.
|
||||
|
||||
|
||||
=== Git ===
|
||||
|
||||
To get the GF source code, you also need //Git//.
|
||||
@@ -391,8 +411,6 @@ bindings are found in the ``src/runtime/python`` and ``src/runtime/java``
|
||||
directories, respecively. Compile them by following the instructions in
|
||||
the ``INSTALL`` files in those directories.
|
||||
|
||||
The Python library can also be installed from PyPI using `pip install pgf`.
|
||||
|
||||
== Compilation of RGL ==
|
||||
|
||||
As of 2018-07-26, the RGL is distributed separately from the GF compiler and runtimes.
|
||||
@@ -407,13 +425,13 @@ There is also ``make build``, ``make copy`` and ``make clean`` which do what you
|
||||
=== Advanced ===
|
||||
For advanced build options, call the Haskell build script directly:
|
||||
```
|
||||
$ runghc Setup.hs ...
|
||||
$ runghc Make.hs ...
|
||||
```
|
||||
For more details see the [README https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md].
|
||||
|
||||
=== Haskell-free ===
|
||||
If you do not have Haskell installed, you can use the simple build script ``Setup.sh``
|
||||
(or ``Setup.bat`` for Windows).
|
||||
If you do not have Haskell installed, you can use the simple build script ``Make.sh``
|
||||
(or ``Make.bat`` for Windows).
|
||||
|
||||
|
||||
== Creating binary distribution packages ==
|
||||
|
||||
@@ -1,6 +1,12 @@
|
||||
Editor modes & IDE integration for GF
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!options(html): --toc
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!encoding:utf-8
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
We collect GF modes for various editors on this page. Contributions are
|
||||
welcome!
|
||||
|
||||
|
||||
91
doc/gf-faq.t2t
Normal file
91
doc/gf-faq.t2t
Normal file
@@ -0,0 +1,91 @@
|
||||
Grammatical Framework: Frequently Asked Quuestions
|
||||
Aarne Ranta
|
||||
%%date(%c)
|
||||
|
||||
% NOTE: this is a txt2tags file.
|
||||
% Create an html file from this file using:
|
||||
% txt2tags gf-bibliography.t2t
|
||||
|
||||
%!style:../css/style.css
|
||||
%!target:html
|
||||
%!options(html): --toc
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): #BR <br>
|
||||
%!encoding:utf-8
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
|
||||
===What has been done with GF?===
|
||||
|
||||
**Translation**: systems with any number of parallel languages, with input in one language and output in all the others.
|
||||
|
||||
**Natural language generation** (NLG): translation from a formal language to natural languages.
|
||||
|
||||
**Ontology verbalization** is a special case of NLG.
|
||||
|
||||
**Language training**: grammar and vocabulary training systems.
|
||||
|
||||
**Human-computer interaction**: natural language interfaces, spoken dialogue systems.
|
||||
|
||||
**Linguistics**: comparisons between languages.
|
||||
|
||||
|
||||
|
||||
===What parts does GF have?===
|
||||
|
||||
A **grammar compiler**, used for compiling grammars to parsing, generation, and translation code.
|
||||
|
||||
A **run-time system**, used for parsing, generation and translation. The run-time system is available in several languages:
|
||||
Haskell, Java, C, C++, Javascript, and Python. The point with this is that you can include GF-based parsing and generation in
|
||||
larger programs written in any of these languages.
|
||||
|
||||
A **resource grammar library**, containing the morphology and basic syntax of currently 26 languages.
|
||||
|
||||
A **web application toolkit**, containing server-side (Haskell) and client-side (Javascript) libraries.
|
||||
|
||||
An **integrated development environment**, the GF-Eclipse plug-in.
|
||||
|
||||
A **shell**, i.e. a command interpreter for testing and developing GF grammars. This is the program started by the command ``gf`` in a terminal.
|
||||
|
||||
|
||||
|
||||
===Is GF open-source?===
|
||||
|
||||
|
||||
===Can I use GF for commercial applications?===
|
||||
|
||||
Yes. Those parts of GF that you will need to distribute - the run-time system and the libraries - are licensed under LGPL and BSD; it's up to you to choose which.
|
||||
|
||||
|
||||
|
||||
===When was GF started?===
|
||||
|
||||
|
||||
===Where does the name GF come from?===
|
||||
|
||||
GF = Grammatical Framework = LF + concrete syntax
|
||||
|
||||
LF = Logical Framework
|
||||
|
||||
Logical Frameworks are implementations of type theory, which have been built since the 1980's to support formalized mathematics. GF has its roots in
|
||||
type theory, which is widely used in the semantics of natural language. Some of these ideas were first implemented in ALF, Another Logical Framework,
|
||||
in 1992; the book //Type-Theoretical Grammar// (by A. Ranta, OUP 1994) has a chapter and an appendix on this. The first implementations did not have
|
||||
a parser, and GF proper, started in 1998, was an implementation of yet another LF together with concrete syntax supporting generation and parsing.
|
||||
Grammatical Framework was a natural name for this. We tried to avoid it in the beginning, because it sounded pretentious in its generality. But the
|
||||
name was just too natural to be avoided.
|
||||
|
||||
|
||||
|
||||
===Is GF backward compatible?===
|
||||
|
||||
|
||||
|
||||
===Do I need Haskell to use GF?===
|
||||
|
||||
No. GF is a language of its own, and you don't need to know Haskell. And if you download the GF binary, you don't need any Haskell tools. But if you want to
|
||||
become a GF developer, then it's better you install GF from the latest source, and then you need the GHC Haskell compiler to compile GF. But even then, you
|
||||
don't need to know Haskell yourself.
|
||||
|
||||
|
||||
===What is a lock field?===
|
||||
|
||||
@@ -68,9 +68,9 @@ metavariables and the type of the expression.
|
||||
Prints a set of strings in the .dot format (the graphviz format).
|
||||
The graph can be saved in a file by the wf command as usual.
|
||||
If the -view flag is defined, the graph is saved in a temporary file
|
||||
which is processed by 'dot' (graphviz) and displayed by the program indicated
|
||||
by the view flag. The target format is png, unless overridden by the
|
||||
flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).
|
||||
which is processed by graphviz and displayed by the program indicated
|
||||
by the flag. The target format is postscript, unless overridden by the
|
||||
flag -format.
|
||||
|
||||
|
||||
- Options:
|
||||
@@ -151,7 +151,6 @@ of a pipe.
|
||||
| ``-one`` | pick the first strings, if there is any, from records and tables
|
||||
| ``-table`` | show all strings labelled by parameters
|
||||
| ``-unqual`` | hide qualifying module names
|
||||
| ``-trace`` | trace computations
|
||||
|
||||
|
||||
#NORMAL
|
||||
@@ -243,7 +242,7 @@ and thus cannot be a part of a pipe.
|
||||
|
||||
====e = empty====
|
||||
#NOINDENT
|
||||
``e`` = ``empty``: //empty the environment (except the command history).//
|
||||
``e`` = ``empty``: //empty the environment.//
|
||||
|
||||
#TINY
|
||||
|
||||
@@ -282,19 +281,6 @@ but the resulting .gf file must be imported separately.
|
||||
#NORMAL
|
||||
|
||||
|
||||
#VSPACE
|
||||
|
||||
====eh = execute_history====
|
||||
#NOINDENT
|
||||
``eh`` = ``execute_history``: //read commands from a file and execute them.//
|
||||
|
||||
#TINY
|
||||
|
||||
- Syntax: ``eh FILE``
|
||||
|
||||
#NORMAL
|
||||
|
||||
|
||||
#VSPACE
|
||||
|
||||
====gr = generate_random====
|
||||
@@ -448,14 +434,12 @@ sequences; see example.
|
||||
| ``-list`` | show all forms and variants, comma-separated on one line (cf. l -all)
|
||||
| ``-multi`` | linearize to all languages (default)
|
||||
| ``-table`` | show all forms labelled by parameters
|
||||
| ``-tabtreebank`` | show the tree and its linearizations on a tab-separated line
|
||||
| ``-treebank`` | show the tree and tag linearizations with language names
|
||||
| ``-bind`` | bind tokens separated by Prelude.BIND, i.e. &+
|
||||
| ``-chars`` | lexer that makes every non-space character a token
|
||||
| ``-from_amharic`` | from unicode to GF Amharic transliteration
|
||||
| ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration
|
||||
| ``-from_arabic`` | from unicode to GF Arabic transliteration
|
||||
| ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration
|
||||
| ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-from_devanagari`` | from unicode to GF Devanagari transliteration
|
||||
| ``-from_greek`` | from unicode to GF modern Greek transliteration
|
||||
@@ -469,14 +453,11 @@ sequences; see example.
|
||||
| ``-from_urdu`` | from unicode to GF Urdu transliteration
|
||||
| ``-from_utf8`` | decode from utf8 (default)
|
||||
| ``-lexcode`` | code-like lexer
|
||||
| ``-lexgreek`` | lexer normalizing ancient Greek accentuation
|
||||
| ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations
|
||||
| ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])
|
||||
| ``-lextext`` | text-like lexer
|
||||
| ``-to_amharic`` | from GF Amharic transliteration to unicode
|
||||
| ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode
|
||||
| ``-to_arabic`` | from GF Arabic transliteration to unicode
|
||||
| ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode
|
||||
| ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-to_devanagari`` | from GF Devanagari transliteration to unicode
|
||||
| ``-to_greek`` | from GF modern Greek transliteration to unicode
|
||||
@@ -492,7 +473,6 @@ sequences; see example.
|
||||
| ``-to_utf8`` | encode to utf8 (default)
|
||||
| ``-unchars`` | unlexer that puts no spaces between tokens
|
||||
| ``-unlexcode`` | code-like unlexer
|
||||
| ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation
|
||||
| ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])
|
||||
| ``-unlextext`` | text-like unlexer
|
||||
| ``-unwords`` | unlexer that puts a single space between tokens (default)
|
||||
@@ -533,7 +513,6 @@ trees where a function node is a metavariable.
|
||||
| ``-from_amharic`` | from unicode to GF Amharic transliteration
|
||||
| ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration
|
||||
| ``-from_arabic`` | from unicode to GF Arabic transliteration
|
||||
| ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration
|
||||
| ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-from_devanagari`` | from unicode to GF Devanagari transliteration
|
||||
| ``-from_greek`` | from unicode to GF modern Greek transliteration
|
||||
@@ -547,14 +526,11 @@ trees where a function node is a metavariable.
|
||||
| ``-from_urdu`` | from unicode to GF Urdu transliteration
|
||||
| ``-from_utf8`` | decode from utf8 (default)
|
||||
| ``-lexcode`` | code-like lexer
|
||||
| ``-lexgreek`` | lexer normalizing ancient Greek accentuation
|
||||
| ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations
|
||||
| ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])
|
||||
| ``-lextext`` | text-like lexer
|
||||
| ``-to_amharic`` | from GF Amharic transliteration to unicode
|
||||
| ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode
|
||||
| ``-to_arabic`` | from GF Arabic transliteration to unicode
|
||||
| ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode
|
||||
| ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-to_devanagari`` | from GF Devanagari transliteration to unicode
|
||||
| ``-to_greek`` | from GF modern Greek transliteration to unicode
|
||||
@@ -570,7 +546,6 @@ trees where a function node is a metavariable.
|
||||
| ``-to_utf8`` | encode to utf8 (default)
|
||||
| ``-unchars`` | unlexer that puts no spaces between tokens
|
||||
| ``-unlexcode`` | code-like unlexer
|
||||
| ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation
|
||||
| ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])
|
||||
| ``-unlextext`` | text-like unlexer
|
||||
| ``-unwords`` | unlexer that puts a single space between tokens (default)
|
||||
@@ -691,9 +666,10 @@ command (flag -printer):
|
||||
fa finite automaton in graphviz format
|
||||
gsl Nuance speech recognition format
|
||||
haskell Haskell (abstract syntax)
|
||||
java Java (abstract syntax)
|
||||
js JavaScript (whole grammar)
|
||||
jsgf JSGF speech recognition format
|
||||
lambda_prolog LambdaProlog (abstract syntax)
|
||||
lp_byte_code Bytecode for Teyjus (abstract syntax, experimental)
|
||||
pgf_pretty human-readable pgf
|
||||
prolog Prolog (whole grammar)
|
||||
python Python (whole grammar)
|
||||
@@ -777,7 +753,6 @@ To see transliteration tables, use command ut.
|
||||
| ``-from_amharic`` | from unicode to GF Amharic transliteration
|
||||
| ``-from_ancientgreek`` | from unicode to GF ancient Greek transliteration
|
||||
| ``-from_arabic`` | from unicode to GF Arabic transliteration
|
||||
| ``-from_arabic_unvocalized`` | from unicode to GF unvocalized Arabic transliteration
|
||||
| ``-from_cp1251`` | decode from cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-from_devanagari`` | from unicode to GF Devanagari transliteration
|
||||
| ``-from_greek`` | from unicode to GF modern Greek transliteration
|
||||
@@ -791,14 +766,11 @@ To see transliteration tables, use command ut.
|
||||
| ``-from_urdu`` | from unicode to GF Urdu transliteration
|
||||
| ``-from_utf8`` | decode from utf8 (default)
|
||||
| ``-lexcode`` | code-like lexer
|
||||
| ``-lexgreek`` | lexer normalizing ancient Greek accentuation
|
||||
| ``-lexgreek2`` | lexer normalizing ancient Greek accentuation for text with vowel length annotations
|
||||
| ``-lexmixed`` | mixture of text and code, as in LaTeX (code between $...$, \(...)\, \[...\])
|
||||
| ``-lextext`` | text-like lexer
|
||||
| ``-to_amharic`` | from GF Amharic transliteration to unicode
|
||||
| ``-to_ancientgreek`` | from GF ancient Greek transliteration to unicode
|
||||
| ``-to_arabic`` | from GF Arabic transliteration to unicode
|
||||
| ``-to_arabic_unvocalized`` | from GF unvocalized Arabic transliteration to unicode
|
||||
| ``-to_cp1251`` | encode to cp1251 (Cyrillic used in Bulgarian resource)
|
||||
| ``-to_devanagari`` | from GF Devanagari transliteration to unicode
|
||||
| ``-to_greek`` | from GF modern Greek transliteration to unicode
|
||||
@@ -814,7 +786,6 @@ To see transliteration tables, use command ut.
|
||||
| ``-to_utf8`` | encode to utf8 (default)
|
||||
| ``-unchars`` | unlexer that puts no spaces between tokens
|
||||
| ``-unlexcode`` | code-like unlexer
|
||||
| ``-unlexgreek`` | unlexer de-normalizing ancient Greek accentuation
|
||||
| ``-unlexmixed`` | mixture of text and code (code between $...$, \(...)\, \[...\])
|
||||
| ``-unlextext`` | text-like unlexer
|
||||
| ``-unwords`` | unlexer that puts a single space between tokens (default)
|
||||
@@ -828,14 +799,13 @@ To see transliteration tables, use command ut.
|
||||
|
||||
- Examples:
|
||||
|
||||
| ``l (EAdd 3 4) | ps -unlexcode`` | linearize code-like output
|
||||
| ``ps -lexcode | p -cat=Exp`` | parse code-like input
|
||||
| ``l (EAdd 3 4) | ps -code`` | linearize code-like output
|
||||
| ``ps -lexer=code | p -cat=Exp`` | parse code-like input
|
||||
| ``gr -cat=QCl | l | ps -bind`` | linearization output from LangFin
|
||||
| ``ps -to_devanagari "A-p"`` | show Devanagari in UTF8 terminal
|
||||
| ``rf -file=Hin.gf | ps -env=quotes -to_devanagari`` | convert translit to UTF8
|
||||
| ``rf -file=Ara.gf | ps -from_utf8 -env=quotes -from_arabic`` | convert UTF8 to transliteration
|
||||
| ``ps -to=chinese.trans "abc"`` | apply transliteration defined in file chinese.trans
|
||||
| ``ps -lexgreek "a)gavoi` a)'nvrwpoi' tines*"`` | normalize ancient greek accentuation
|
||||
|
||||
|
||||
#NORMAL
|
||||
@@ -858,6 +828,7 @@ are type checking and semantic computation.
|
||||
- Options:
|
||||
|
||||
| ``-compute`` | compute by using semantic definitions (def)
|
||||
| ``-paraphrase`` | paraphrase by using semantic definitions (def)
|
||||
| ``-largest`` | sort trees from largest to smallest, in number of nodes
|
||||
| ``-nub`` | remove duplicate trees
|
||||
| ``-smallest`` | sort trees from smallest to largest, in number of nodes
|
||||
@@ -867,10 +838,12 @@ are type checking and semantic computation.
|
||||
- Flags:
|
||||
|
||||
| ``-number`` | take at most this many trees
|
||||
| ``-transfer`` | syntactic transfer by applying function, recursively in subtrees
|
||||
|
||||
- Examples:
|
||||
|
||||
| ``pt -compute (plus one two)`` | compute value
|
||||
| ``p "4 dogs love 5 cats" | pt -transfer=digits2numeral | l`` | four...five...
|
||||
|
||||
|
||||
#NORMAL
|
||||
@@ -1017,6 +990,8 @@ This command requires a source grammar to be in scope, imported with 'import -re
|
||||
The operations include the parameter constructors that are in scope.
|
||||
The optional TYPE filters according to the value type.
|
||||
The grep STRINGs filter according to other substrings of the type signatures.
|
||||
This command must be a line of its own, and thus cannot be a part
|
||||
of a pipe.
|
||||
|
||||
- Syntax: ``so (-grep=STRING)* TYPE?``
|
||||
- Options:
|
||||
@@ -1027,12 +1002,6 @@ The grep STRINGs filter according to other substrings of the type signatures.
|
||||
|
||||
| ``-grep`` | substring used for filtering (the command can have many of these)
|
||||
|
||||
- Examples:
|
||||
|
||||
| ``so Det`` | show all opers that create a Det
|
||||
| ``so -grep=Prep`` | find opers relating to Prep
|
||||
| ``so | wf -file=/tmp/opers`` | write the list of opers to a file
|
||||
|
||||
|
||||
#NORMAL
|
||||
|
||||
@@ -1144,7 +1113,6 @@ This command must be a line of its own, and thus cannot be a part of a pipe.
|
||||
| ``-amharic`` | Amharic
|
||||
| ``-ancientgreek`` | ancient Greek
|
||||
| ``-arabic`` | Arabic
|
||||
| ``-arabic_unvocalized`` | unvocalized Arabic
|
||||
| ``-devanagari`` | Devanagari
|
||||
| ``-greek`` | modern Greek
|
||||
| ``-hebrew`` | unvocalized Hebrew
|
||||
@@ -1169,41 +1137,35 @@ This command must be a line of its own, and thus cannot be a part of a pipe.
|
||||
#TINY
|
||||
|
||||
Prints a dependency tree in the .dot format (the graphviz format, default)
|
||||
or LaTeX (flag -output=latex)
|
||||
or the CoNLL/MaltParser format (flag -output=conll for training, malt_input
|
||||
for unanalysed input).
|
||||
By default, the last argument is the head of every abstract syntax
|
||||
function; moreover, the head depends on the head of the function above.
|
||||
The graph can be saved in a file by the wf command as usual.
|
||||
If the -view flag is defined, the graph is saved in a temporary file
|
||||
which is processed by dot (graphviz) and displayed by the program indicated
|
||||
by the view flag. The target format is png, unless overridden by the
|
||||
flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).
|
||||
See also 'vp -showdep' for another visualization of dependencies.
|
||||
which is processed by graphviz and displayed by the program indicated
|
||||
by the flag. The target format is png, unless overridden by the
|
||||
flag -format.
|
||||
|
||||
|
||||
- Options:
|
||||
|
||||
| ``-v`` | show extra information
|
||||
| ``-conll2latex`` | convert conll to latex
|
||||
|
||||
- Flags:
|
||||
|
||||
| ``-abslabels`` | abstract configuration file for labels, format per line 'fun label*'
|
||||
| ``-cnclabels`` | concrete configuration file for labels, format per line 'fun {words|*} pos label head'
|
||||
| ``-file`` | same as abslabels (abstract configuration file)
|
||||
| ``-format`` | format of the visualization file using dot (default "png")
|
||||
| ``-output`` | output format of graph source (latex, conll, dot (default but deprecated))
|
||||
| ``-view`` | program to open the resulting graph file (default "open")
|
||||
| ``-file`` | configuration file for labels per fun, format 'fun l1 ... label ... l2'
|
||||
| ``-format`` | format of the visualization file (default "png")
|
||||
| ``-output`` | output format of graph source (default "dot")
|
||||
| ``-view`` | program to open the resulting file (default "open")
|
||||
| ``-lang`` | the language of analysis
|
||||
|
||||
- Examples:
|
||||
|
||||
| ``gr | vd`` | generate a tree and show dependency tree in .dot
|
||||
| ``gr | vd -view=open`` | generate a tree and display dependency tree on with Mac's 'open'
|
||||
| ``gr | vd -view=open -output=latex`` | generate a tree and display latex dependency tree with Mac's 'open'
|
||||
| ``gr -number=1000 | vd -abslabels=Lang.labels -cnclabels=LangSwe.labels -output=conll`` | generate a random treebank
|
||||
| ``rf -file=ex.conll | vd -conll2latex | wf -file=ex.tex`` | convert conll file to latex
|
||||
| ``gr | vd -view=open`` | generate a tree and display dependency tree on a Mac
|
||||
| ``gr -number=1000 | vd -file=dep.labels -output=malt`` | generate training treebank
|
||||
| ``gr -number=100 | vd -file=dep.labels -output=malt_input`` | generate test sentences
|
||||
|
||||
|
||||
#NORMAL
|
||||
@@ -1220,16 +1182,15 @@ See also 'vp -showdep' for another visualization of dependencies.
|
||||
Prints a parse tree in the .dot format (the graphviz format).
|
||||
The graph can be saved in a file by the wf command as usual.
|
||||
If the -view flag is defined, the graph is saved in a temporary file
|
||||
which is processed by dot (graphviz) and displayed by the program indicated
|
||||
by the view flag. The target format is png, unless overridden by the
|
||||
flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).
|
||||
which is processed by graphviz and displayed by the program indicated
|
||||
by the flag. The target format is png, unless overridden by the
|
||||
flag -format.
|
||||
|
||||
|
||||
- Options:
|
||||
|
||||
| ``-showcat`` | show categories in the tree nodes (default)
|
||||
| ``-nocat`` | don't show categories
|
||||
| ``-showdep`` | show dependency labels
|
||||
| ``-showfun`` | show function names in the tree nodes
|
||||
| ``-nofun`` | don't show function names (default)
|
||||
| ``-showleaves`` | show the leaves of the tree (default)
|
||||
@@ -1237,8 +1198,6 @@ flag -format. Results from multiple trees are combined to pdf with convert (Imag
|
||||
|
||||
- Flags:
|
||||
|
||||
| ``-lang`` | the language to visualize
|
||||
| ``-file`` | configuration file for dependency labels with -deps, format per line 'fun label*'
|
||||
| ``-format`` | format of the visualization file (default "png")
|
||||
| ``-view`` | program to open the resulting file (default "open")
|
||||
| ``-nodefont`` | font for tree nodes (default: Times -- graphviz standard font)
|
||||
@@ -1251,8 +1210,7 @@ flag -format. Results from multiple trees are combined to pdf with convert (Imag
|
||||
- Examples:
|
||||
|
||||
| ``p "John walks" | vp`` | generate a tree and show parse tree as .dot script
|
||||
| ``gr | vp -view=open`` | generate a tree and display parse tree on a Mac
|
||||
| ``p "she loves us" | vp -view=open -showdep -file=uddeps.labels -nocat`` | show a visual variant of a dependency tree
|
||||
| ``gr | vp -view="open"`` | generate a tree and display parse tree on a Mac
|
||||
|
||||
|
||||
#NORMAL
|
||||
@@ -1269,9 +1227,9 @@ flag -format. Results from multiple trees are combined to pdf with convert (Imag
|
||||
Prints a set of trees in the .dot format (the graphviz format).
|
||||
The graph can be saved in a file by the wf command as usual.
|
||||
If the -view flag is defined, the graph is saved in a temporary file
|
||||
which is processed by dot (graphviz) and displayed by the command indicated
|
||||
by the view flag. The target format is postscript, unless overridden by the
|
||||
flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).
|
||||
which is processed by graphviz and displayed by the program indicated
|
||||
by the flag. The target format is postscript, unless overridden by the
|
||||
flag -format.
|
||||
With option -mk, use for showing library style function names of form 'mkC'.
|
||||
|
||||
|
||||
|
||||
BIN
doc/gf-lrec-2010.pdf
Normal file
BIN
doc/gf-lrec-2010.pdf
Normal file
Binary file not shown.
132
doc/gf-people.html
Normal file
132
doc/gf-people.html
Normal file
@@ -0,0 +1,132 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
|
||||
<head>
|
||||
<title>GF People</title>
|
||||
<meta charset="UTF-8">
|
||||
<link rel=stylesheet href="../css/style.css">
|
||||
<meta name = "viewport" content = "width = device-width">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
<center>
|
||||
<IMG SRC="Logos/gf0.png" alt="[GF]">
|
||||
|
||||
<h1>Grammatical Framework: Authors and Acknowledgements</h1>
|
||||
|
||||
</center>
|
||||
|
||||
The current developers and maintainers are
|
||||
<a href="http://www.chalmers.se/cse/EN/organization/divisions/computing-science/people/angelov-krasimir">Krasimir Angelov</a>,
|
||||
<a href="http://www.cse.chalmers.se/~hallgren/">Thomas Hallgren</a>,
|
||||
and
|
||||
<a href="http://www.cse.chalmers.se/~aarne/">Aarne Ranta</a>. Bug reports should be
|
||||
posted via the
|
||||
<a href="http://code.google.com/p/grammatical-framework/issues/list">GF bug tracker</a>.
|
||||
|
||||
|
||||
<p>
|
||||
|
||||
Also the following people have contributed code to some of the versions:
|
||||
|
||||
<dl>
|
||||
|
||||
<dt>Grégoire Détrez (University of Gothenburg)
|
||||
<dt>Ramona Enache (University of Gothenburg)
|
||||
<dt>
|
||||
<a href="http://www.cse.chalmers.se/alumni/bringert">Björn Bringert</a> (University of Gothenburg)
|
||||
<dt>
|
||||
Håkan Burden (University of Gothenburg)
|
||||
<dt>
|
||||
Hans-Joachim Daniels (Karlsruhe)
|
||||
<dt>
|
||||
<a href="http://www.cs.chalmers.se/~markus">Markus Forsberg</a> (Chalmers)
|
||||
<dt>
|
||||
<a href="http://www.cs.chalmers.se/~krijo">Kristofer Johannisson</a> (University of Gothenburg)
|
||||
<dt>
|
||||
<a href="http://www.cs.chalmers.se/~janna">Janna Khegai</a> (Chalmers)
|
||||
<dt>
|
||||
<a href="http://www.cse.chalmers.se/~peb">Peter Ljunglöf</a> (University of Gothenburg)
|
||||
<dt>
|
||||
Petri Mäenpää (Nokia)
|
||||
</dl>
|
||||
|
||||
|
||||
At least the following colleagues are thanked for suggestions,
|
||||
bug reports, and other indirect contributions to the code. (Notice:
|
||||
these are early contributors - the list has not been updated since 2004 or so).
|
||||
|
||||
<p>
|
||||
|
||||
<a href="http://www.di.unito.it/~stefano/">Stefano Berardi</a> (Torino),
|
||||
|
||||
Pascal Boldini (Paris),
|
||||
|
||||
<a href="http://www.dur.ac.uk/~dcs0pcc/">Paul Callaghan</a> (Durham),
|
||||
|
||||
Lauri Carlson (Helsinki),
|
||||
|
||||
<a href="http://www.cse.chalmers.se/~koen">Koen Claessen</a> (Chalmers),
|
||||
|
||||
<a href="http://www.cling.gu.se/~cooper">Robin Cooper</a> (Gothenburg),
|
||||
|
||||
<a href="http://www.cse.chalmers.se/~coquand">Thierry Coquand</a> (Chalmers),
|
||||
|
||||
<a
|
||||
href="http://www.xrce.xerox.com/people/dymetman/dymetman.html">Marc
|
||||
Dymetman</a> (XRCE),
|
||||
|
||||
Bertrand Grégoire (Tudor Institure, Luxembourg),
|
||||
|
||||
<a href="http://www.cse.chalmers.se/~reiner">Reiner Hähnle</a> (Chalmers),
|
||||
|
||||
<a href="http://pauillac.inria.fr/~huet/">Gérard Huet</a> (INRIA),
|
||||
|
||||
<a href="http://www.cse.chalmers.se/~patrikj">Patrik Jansson</a> (Chalmers),
|
||||
|
||||
Bernard Jaulin (Paris),
|
||||
|
||||
<a href="http://www.xrce.xerox.com/people/karttunen/karttunen.html">
|
||||
Lauri Karttunen</a> (PARC),
|
||||
|
||||
Matti Kinnunen (Nokia),
|
||||
|
||||
<a
|
||||
href="http://www.xrce.xerox.com/people/lux/">Veronika
|
||||
Lux</a> (XRCE),
|
||||
|
||||
Per Martin-Löf (Stockholm),
|
||||
|
||||
<a href="http://www.cse.chalmers.se/~bengt">Bengt Nordström</a> (Chalmers),
|
||||
|
||||
<a
|
||||
href="http://www.cis.uni-muenchen.de/studenten/stud_homepages/okrslar/reklame.html">
|
||||
Martin Okrslar</a> (CIS),
|
||||
|
||||
Jianmin Pang (Durham),
|
||||
|
||||
<a
|
||||
href="http://www.xrce.xerox.com/people/pogodalla/index.fr.html">Sylvain
|
||||
Pogodalla</a> (XRCE),
|
||||
|
||||
<a href="http://www.inria.fr/Loic.Pottier">Loïc Pottier</a> (INRIA),
|
||||
|
||||
|
||||
<a href="http://www2.parc.com/istl/members/zaenen/">Annie Zaenen</a> (PARC)
|
||||
|
||||
<p>
|
||||
|
||||
The GF logo was designed by Uula Ranta.
|
||||
|
||||
<p>
|
||||
|
||||
From 2001 to 2004, GF enjoyed funding from the
|
||||
<a href="http://www.vinnova.se">Vinnova</a> foundation, within the
|
||||
<a href="http://www.cse.chalmers.se/research/group/Language-technology/ILT.html">
|
||||
Interactive Languge Technology</a> project.
|
||||
|
||||
|
||||
</body>
|
||||
</html>
|
||||
|
||||
@@ -1,64 +0,0 @@
|
||||
---
|
||||
title: "Grammatical Framework: Authors and Acknowledgements"
|
||||
---
|
||||
|
||||
## Current maintainers
|
||||
|
||||
The current maintainers of GF are
|
||||
|
||||
[Krasimir Angelov](http://www.chalmers.se/cse/EN/organization/divisions/computing-science/people/angelov-krasimir),
|
||||
[Thomas Hallgren](http://www.cse.chalmers.se/~hallgren/),
|
||||
[Aarne Ranta](http://www.cse.chalmers.se/~aarne/),
|
||||
[John J. Camilleri](http://johnjcamilleri.com), and
|
||||
[Inari Listenmaa](https://inariksit.github.io/).
|
||||
|
||||
This page is otherwise not up to date.
|
||||
For detailed data about contributors to the code repositories since 2007, see
|
||||
[here (gf-core)](https://github.com/GrammaticalFramework/gf-core/graphs/contributors)
|
||||
and
|
||||
[here (gf-rgl)](https://github.com/GrammaticalFramework/gf-rgl/graphs/contributors).
|
||||
|
||||
## Previous contributors
|
||||
|
||||
The following people have contributed code to some of the versions:
|
||||
|
||||
- Grégoire Détrez (University of Gothenburg)
|
||||
- Ramona Enache (University of Gothenburg)
|
||||
- [Björn Bringert](http://www.cse.chalmers.se/alumni/bringert) (University of Gothenburg)
|
||||
- Håkan Burden (University of Gothenburg)
|
||||
- Hans-Joachim Daniels (Karlsruhe)
|
||||
- [Markus Forsberg](http://www.cs.chalmers.se/~markus) (Chalmers)
|
||||
- [Kristofer Johannisson](http://www.cs.chalmers.se/~krijo) (University of Gothenburg)
|
||||
- [Janna Khegai](http://www.cs.chalmers.se/~janna) (Chalmers)
|
||||
- [Peter Ljunglöf](http://www.cse.chalmers.se/~peb) (University of Gothenburg)
|
||||
- Petri Mäenpää (Nokia)
|
||||
- Lauri Alanko (University of Helsinki)
|
||||
|
||||
At least the following colleagues are thanked for suggestions, bug
|
||||
reports, and other indirect contributions to the code.
|
||||
|
||||
- [Stefano Berardi](http://www.di.unito.it/~stefano/) (Torino)
|
||||
- Pascal Boldini (Paris)
|
||||
- [Paul Callaghan](http://www.dur.ac.uk/~dcs0pcc/) (Durham)
|
||||
- Lauri Carlson (Helsinki)
|
||||
- [Koen Claessen](http://www.cse.chalmers.se/~koen) (Chalmers)
|
||||
- [Robin Cooper](http://www.cling.gu.se/~cooper) (Gothenburg)
|
||||
- [Thierry Coquand](http://www.cse.chalmers.se/~coquand) (Chalmers)
|
||||
- [Marc Dymetman](http://www.xrce.xerox.com/people/dymetman/dymetman.html) (XRCE)
|
||||
- Bertrand Grégoire (Tudor Institute, Luxembourg)
|
||||
- [Reiner Hähnle](http://www.cse.chalmers.se/~reiner) (Chalmers)
|
||||
- [Gérard Huet](http://pauillac.inria.fr/~huet/) (INRIA)
|
||||
- [Patrik Jansson](http://www.cse.chalmers.se/~patrikj) (Chalmers)
|
||||
- Bernard Jaulin (Paris)
|
||||
- [Lauri Karttunen](http://www.xrce.xerox.com/people/karttunen/karttunen.html) (PARC)
|
||||
- Matti Kinnunen (Nokia)
|
||||
- [Veronika Lux](http://www.xrce.xerox.com/people/lux/) (XRCE)
|
||||
- Per Martin-Löf (Stockholm)
|
||||
- [Bengt Nordström](http://www.cse.chalmers.se/~bengt) (Chalmers)
|
||||
- [Martin Okrslar](http://www.cis.uni-muenchen.de/studenten/stud_homepages/okrslar/reklame.html) (CIS)
|
||||
- Jianmin Pang (Durham)
|
||||
- [Sylvain Pogodalla](http://www.xrce.xerox.com/people/pogodalla/index.fr.html) (XRCE)
|
||||
- [Loïc Pottier](http://www.inria.fr/Loic.Pottier) (INRIA)
|
||||
- [Annie Zaenen](http://www2.parc.com/istl/members/zaenen/) (PARC)
|
||||
|
||||
The GF logo was designed by Uula Ranta.
|
||||
158
doc/gf-quickstart.html
Normal file
158
doc/gf-quickstart.html
Normal file
@@ -0,0 +1,158 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title>GF Quickstart</title>
|
||||
<link rel=stylesheet href="../css/style.css">
|
||||
<meta name = "viewport" content = "width = device-width">
|
||||
</head>
|
||||
|
||||
|
||||
<body>
|
||||
|
||||
<center>
|
||||
<img src="Logos/gf0.png">
|
||||
<p>
|
||||
Aarne Ranta
|
||||
<p>
|
||||
October 2011 for GF 3.3
|
||||
|
||||
<p>
|
||||
|
||||
<h1>Grammatical Framework Quick Start</h1>
|
||||
|
||||
</center>
|
||||
|
||||
This Quick Start shows a few examples of how GF can be used.
|
||||
We assume that you have downloaded and installed GF, so that
|
||||
the command <tt>gf</tt> works for you. See download and install
|
||||
instructions <a href="../download/index.html">here</a>.
|
||||
|
||||
<h2>Want to try without downloading?</h2>
|
||||
|
||||
<a href="../demos/phrasebook/">Using GF translation</a> with an existing grammar.
|
||||
|
||||
<p>
|
||||
|
||||
<a href="../demos/gfse/">Writing GF grammars</a> in the cloud, without installing GF.
|
||||
|
||||
|
||||
|
||||
|
||||
<h2>Using GF for translation and generation</h2>
|
||||
|
||||
When you have downloaded and installed GF:
|
||||
<ol>
|
||||
<li> Copy the files
|
||||
<a href="../examples/tutorial/food/Food.gf"><tt>Food.gf</tt></a>,
|
||||
<a href="../examples/tutorial/food/FoodEng.gf"><tt>FoodEng.gf</tt></a>, and
|
||||
<a href="../examples/tutorial/food/FoodIta.gf"><tt>FoodIta.gf</tt></a>.
|
||||
Or go to <tt>GF/examples/tutorial/food/</tt>, if you have downloaded the
|
||||
GF sources.
|
||||
|
||||
<li> Start GF with the shell command (without the prompt <tt>$</tt>)
|
||||
<pre>
|
||||
$ gf FoodIta.gf FoodEng.gf
|
||||
</pre>
|
||||
Alternatively, start GF with <tt>gf</tt> and give the GF command <tt>import FoodIta.gf FoodEng.gf</tt>.
|
||||
|
||||
<li> <b>Translation</b>. Try your first translation by giving the GF command
|
||||
<pre>
|
||||
parse "this cheese is very very Italian" | linearize
|
||||
</pre>
|
||||
Notice that the parser accept the tabulator for word completion.
|
||||
|
||||
<li> <b>Generation</b>. Random-generate sentences in two languages:
|
||||
<pre>
|
||||
generate_random | linearize
|
||||
</pre>
|
||||
|
||||
<li> <b>Other commands</b>. Use the help command
|
||||
<pre>
|
||||
help
|
||||
</pre>
|
||||
<li> <b>More examples</b>. Go to <tt>GF/examples/phrasebook</tt> or some other
|
||||
subdirectory of <tt>GF/examples/</tt>. Or try a resource grammar by, for instance,
|
||||
<pre>
|
||||
import alltenses/LangEng.gfo alltenses/LangGer.gfo
|
||||
|
||||
parse -lang=Eng "I love you" | linearize -treebank
|
||||
</pre>
|
||||
The resource grammars are found relative to the value of <tt>GF_LIB_PATH</tt>, which
|
||||
you may have to set; see <a href="../download/index.html">here</a> for instructions.
|
||||
|
||||
|
||||
|
||||
</ol>
|
||||
|
||||
|
||||
|
||||
<h2>Grammar development</h2>
|
||||
|
||||
Add words to the <tt>Food</tt>
|
||||
grammars and try the above commands again. For instance, add the following lines:
|
||||
<pre>
|
||||
Bread : Kind ; -- in Food.gf
|
||||
Bread = {s = "bread"} ; -- in FoodEng.gf
|
||||
Bread = {s = "pane"} ; -- in FoodIta.gf
|
||||
</pre>
|
||||
and start GF again with the same command. Now you can even translate
|
||||
<i>this bread is very Italian</i>.
|
||||
</ol>
|
||||
To lear more on GF commands and
|
||||
grammar development, go to the one of the tutorials:
|
||||
<ul>
|
||||
<li> <a href="tutorial/gf-tutorial.html">GF Tutorial</a>: older, more programmer-oriented
|
||||
<li> <a href="gf-lrec-2010.pdf">GF Resource Tutorial</a>: newer, more linguist-oriented
|
||||
</ul>
|
||||
To learn about how GF is used for easily writing grammars for 16 languages, consult the
|
||||
<ul>
|
||||
<li> <a href="../lib/doc/synopsis.html">GF Resource Grammar Library</a>.
|
||||
</ul>
|
||||
|
||||
|
||||
|
||||
<h2>Run-time grammars and web applications</h2>
|
||||
|
||||
GF has its own "machine language", PGF (Portable Grammar Format),
|
||||
which is recommended for use in applications at run time. To produce a PGF file from
|
||||
the two grammars above, do
|
||||
<pre>
|
||||
gf -make FoodIta.gf FoodEng.gf
|
||||
wrote Food.pgf
|
||||
</pre>
|
||||
You can use this in Haskell and Java programs, and also on web services, such as
|
||||
<ul>
|
||||
<li> the
|
||||
<a href="http://cloud.grammaticalframework.org/minibar/minibar.html">minibar</a>
|
||||
fridge magnets
|
||||
</ul>
|
||||
|
||||
The quickest way to provide a GF web service is to start GF with the <tt>-server</tt> option:
|
||||
<pre>
|
||||
$ gf -server
|
||||
This is GF version 3.3
|
||||
Built on linux/i386 with ghc-7.0, flags: interrupt server cclazy
|
||||
Document root = /usr/local/share/gf-3.3/www
|
||||
Starting HTTP server, open http://localhost:41296/ in your web browser.
|
||||
</pre>
|
||||
You can view it locally by pointing your
|
||||
browser to the URL shown. You can add your own <tt>.pgf</tt> grammar to the service by
|
||||
copying it over to the <tt>documentRoot</tt> directory. Just push "reload" in
|
||||
your browser after each such update.
|
||||
|
||||
<p>
|
||||
|
||||
To build more customized web application, consult the
|
||||
<a href="http://code.google.com/p/grammatical-framework/wiki/SideBar?tm=6">developer wiki</a>.
|
||||
|
||||
|
||||
<h2>User group</h2>
|
||||
|
||||
You are welcome to join the <A HREF="http://groups.google.com/group/gf-dev">User Group</A>
|
||||
to get help and discuss GF-related issues!
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
</body></html>
|
||||
BIN
doc/gf-reference.pdf
Normal file
BIN
doc/gf-reference.pdf
Normal file
Binary file not shown.
493
doc/gf-reference.t2t
Normal file
493
doc/gf-reference.t2t
Normal file
@@ -0,0 +1,493 @@
|
||||
GF Quick Reference
|
||||
Aarne Ranta
|
||||
April 4, 2006
|
||||
|
||||
% NOTE: this is a txt2tags file.
|
||||
% Create an html file from this file using:
|
||||
% txt2tags -thtml gf-reference.t2t
|
||||
|
||||
%!style:../css/style.css
|
||||
%!target:html
|
||||
%!options: --toc
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
This is a quick reference on GF grammars. It aims to
|
||||
cover all forms of expression available when writing
|
||||
grammars. It assumes basic knowledge of GF, which
|
||||
can be acquired from the
|
||||
[GF Tutorial http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html].
|
||||
Help on GF commands is obtained on line by the
|
||||
help command (``help``), and help on invoking
|
||||
GF with (``gf -help``).
|
||||
|
||||
|
||||
===A complete example===
|
||||
|
||||
This is a complete example of a GF grammar divided
|
||||
into three modules in files. The grammar recognizes the
|
||||
phrases //one pizza// and //two pizzas//.
|
||||
|
||||
File ``Order.gf``:
|
||||
```
|
||||
abstract Order = {
|
||||
cat
|
||||
Order ;
|
||||
Item ;
|
||||
fun
|
||||
One, Two : Item -> Order ;
|
||||
Pizza : Item ;
|
||||
}
|
||||
```
|
||||
File ``OrderEng.gf`` (the top file):
|
||||
```
|
||||
--# -path=.:prelude
|
||||
concrete OrderEng of Order =
|
||||
open Res, Prelude in {
|
||||
flags startcat=Order ;
|
||||
lincat
|
||||
Order = SS ;
|
||||
Item = {s : Num => Str} ;
|
||||
lin
|
||||
One it = ss ("one" ++ it.s ! Sg) ;
|
||||
Two it = ss ("two" ++ it.s ! Pl) ;
|
||||
Pizza = regNoun "pizza" ;
|
||||
}
|
||||
```
|
||||
File ``Res.gf``:
|
||||
```
|
||||
resource Res = open Prelude in {
|
||||
param Num = Sg | Pl ;
|
||||
oper regNoun : Str -> {s : Num => Str} =
|
||||
\dog -> {s = table {
|
||||
Sg => dog ;
|
||||
_ => dog + "s"
|
||||
}
|
||||
} ;
|
||||
}
|
||||
```
|
||||
To use this example, do
|
||||
```
|
||||
% gf -- in shell: start GF
|
||||
> i OrderEng.gf -- in GF: import grammar
|
||||
> p "one pizza" -- parse string
|
||||
> l Two Pizza -- linearize tree
|
||||
```
|
||||
|
||||
|
||||
|
||||
===Modules and files===
|
||||
|
||||
One module per file.
|
||||
File named ``Foo.gf`` contains module named
|
||||
``Foo``.
|
||||
|
||||
Each module has the structure
|
||||
```
|
||||
moduletypename =
|
||||
Inherits ** -- optional
|
||||
open Opens in -- optional
|
||||
{ Judgements }
|
||||
```
|
||||
Inherits are names of modules of the same type.
|
||||
Inheritance can be restricted:
|
||||
```
|
||||
Mo[f,g], -- inherit only f,g from Mo
|
||||
Lo-[f,g] -- inheris all but f,g from Lo
|
||||
```
|
||||
Opens are possible in ``concrete`` and ``resource``.
|
||||
They are names of modules of these two types, possibly
|
||||
qualified:
|
||||
```
|
||||
(M = Mo), -- refer to f as M.f or Mo.f
|
||||
(Lo = Lo) -- refer to f as Lo.f
|
||||
```
|
||||
Module types and judgements in them:
|
||||
```
|
||||
abstract A -- cat, fun, def, data
|
||||
concrete C of A -- lincat, lin, lindef, printname
|
||||
resource R -- param, oper
|
||||
|
||||
interface I -- like resource, but can have
|
||||
oper f : T without definition
|
||||
instance J of I -- like resource, defines opers
|
||||
that I leaves undefined
|
||||
incomplete -- functor: concrete that opens
|
||||
concrete CI of A = one or more interfaces
|
||||
open I in ...
|
||||
concrete CJ of A = -- completion: concrete that
|
||||
CI with instantiates a functor by
|
||||
(I = J) instances of open interfaces
|
||||
```
|
||||
The forms
|
||||
``param``, ``oper``
|
||||
may appear in ``concrete`` as well, but are then
|
||||
not inherited to extensions.
|
||||
|
||||
All modules can moreover have ``flags`` and comments.
|
||||
Comments have the forms
|
||||
```
|
||||
-- till the end of line
|
||||
{- any number of lines between -}
|
||||
--# used for compiler pragmas
|
||||
```
|
||||
A ``concrete`` can be opened like a ``resource``.
|
||||
It is translated as follows:
|
||||
```
|
||||
cat C ---> oper C : Type =
|
||||
lincat C = T T ** {lock_C : {}}
|
||||
|
||||
fun f : G -> C ---> oper f : A* -> C* = \g ->
|
||||
lin f = t t g ** {lock_C = <>}
|
||||
```
|
||||
An ``abstract`` can be opened like an ``interface``.
|
||||
Any ``concrete`` of it then works as an ``instance``.
|
||||
|
||||
|
||||
|
||||
===Judgements===
|
||||
|
||||
```
|
||||
cat C -- declare category C
|
||||
cat C (x:A)(y:B x) -- dependent category C
|
||||
cat C A B -- same as C (x : A)(y : B)
|
||||
fun f : T -- declare function f of type T
|
||||
def f = t -- define f as t
|
||||
def f p q = t -- define f by pattern matching
|
||||
data C = f | g -- set f,g as constructors of C
|
||||
data f : A -> C -- same as
|
||||
fun f : A -> C; data C=f
|
||||
|
||||
lincat C = T -- define lin.type of cat C
|
||||
lin f = t -- define lin. of fun f
|
||||
lin f x y = t -- same as lin f = \x y -> t
|
||||
lindef C = \s -> t -- default lin. of cat C
|
||||
printname fun f = s -- printname shown in menus
|
||||
printname cat C = s -- printname shown in menus
|
||||
printname f = s -- same as printname fun f = s
|
||||
|
||||
param P = C | D Q R -- define parameter type P
|
||||
with constructors
|
||||
C : P, D : Q -> R -> P
|
||||
oper h : T = t -- define oper h of type T
|
||||
oper h = t -- omit type, if inferrable
|
||||
|
||||
flags p=v -- set value of flag p
|
||||
```
|
||||
Judgements are terminated by semicolons (``;``).
|
||||
Subsequent judgments of the same form may share the
|
||||
keyword:
|
||||
```
|
||||
cat C ; D ; -- same as cat C ; cat D ;
|
||||
```
|
||||
Judgements can also share RHS:
|
||||
```
|
||||
fun f,g : A -- same as fun f : A ; g : A
|
||||
```
|
||||
|
||||
|
||||
===Types===
|
||||
|
||||
Abstract syntax (in ``fun``):
|
||||
```
|
||||
C -- basic type, if cat C
|
||||
C a b -- basic type for dep. category
|
||||
(x : A) -> B -- dep. functions from A to B
|
||||
(_ : A) -> B -- nondep. functions from A to B
|
||||
(p,q : A) -> B -- same as (p : A)-> (q : A) -> B
|
||||
A -> B -- same as (_ : A) -> B
|
||||
Int -- predefined integer type
|
||||
Float -- predefined float type
|
||||
String -- predefined string type
|
||||
```
|
||||
Concrete syntax (in ``lincat``):
|
||||
```
|
||||
Str -- token lists
|
||||
P -- parameter type, if param P
|
||||
P => B -- table type, if P param. type
|
||||
{s : Str ; p : P}-- record type
|
||||
{s,t : Str} -- same as {s : Str ; t : Str}
|
||||
{a : A} **{b : B}-- record type extension, same as
|
||||
{a : A ; b : B}
|
||||
A * B * C -- tuple type, same as
|
||||
{p1 : A ; p2 : B ; p3 : C}
|
||||
Ints n -- type of n first integers
|
||||
```
|
||||
Resource (in ``oper``): all those of concrete, plus
|
||||
```
|
||||
Tok -- tokens (subtype of Str)
|
||||
A -> B -- functions from A to B
|
||||
Int -- integers
|
||||
Strs -- list of prefixes (for pre)
|
||||
PType -- parameter type
|
||||
Type -- any type
|
||||
```
|
||||
As parameter types, one can use any finite type:
|
||||
``P`` defined in ``param P``,
|
||||
``Ints n``, and record types of parameter types.
|
||||
|
||||
|
||||
|
||||
===Expressions===
|
||||
|
||||
Syntax trees = full function applications
|
||||
```
|
||||
f a b -- : C if fun f : A -> B -> C
|
||||
1977 -- : Int
|
||||
3.14 -- : Float
|
||||
"foo" -- : String
|
||||
```
|
||||
Higher-Order Abstract syntax (HOAS): functions as arguments:
|
||||
```
|
||||
F a (\x -> c) -- : C if a : A, c : C (x : B),
|
||||
fun F : A -> (B -> C) -> C
|
||||
```
|
||||
Tokens and token lists
|
||||
```
|
||||
"hello" -- : Tok, singleton Str
|
||||
"hello" ++ "world" -- : Str
|
||||
["hello world"] -- : Str, same as "hello" ++ "world"
|
||||
"hello" + "world" -- : Tok, computes to "helloworld"
|
||||
[] -- : Str, empty list
|
||||
```
|
||||
Parameters
|
||||
```
|
||||
Sg -- atomic constructor
|
||||
VPres Sg P2 -- applied constructor
|
||||
{n = Sg ; p = P3} -- record of parameters
|
||||
```
|
||||
Tables
|
||||
```
|
||||
table { -- by full branches
|
||||
Sg => "mouse" ;
|
||||
Pl => "mice"
|
||||
}
|
||||
table { -- by pattern matching
|
||||
Pl => "mice" ;
|
||||
_ => "mouse" -- wildcard pattern
|
||||
}
|
||||
table {
|
||||
n => regn n "cat" -- variable pattern
|
||||
}
|
||||
table Num {...} -- table given with arg. type
|
||||
table ["ox"; "oxen"] -- table as course of values
|
||||
\\_ => "fish" -- same as table {_ => "fish"}
|
||||
\\p,q => t -- same as \\p => \\q => t
|
||||
|
||||
t ! p -- select p from table t
|
||||
case e of {...} -- same as table {...} ! e
|
||||
```
|
||||
Records
|
||||
```
|
||||
{s = "Liz"; g = Fem} -- record in full form
|
||||
{s,t = "et"} -- same as {s = "et";t= "et"}
|
||||
{s = "Liz"} ** -- record extension: same as
|
||||
{g = Fem} {s = "Liz" ; g = Fem}
|
||||
|
||||
<a,b,c> -- tuple, same as {p1=a;p2=b;p3=c}
|
||||
```
|
||||
Functions
|
||||
```
|
||||
\x -> t -- lambda abstract
|
||||
\x,y -> t -- same as \x -> \y -> t
|
||||
\x,_ -> t -- binding not in t
|
||||
```
|
||||
Local definitions
|
||||
```
|
||||
let x : A = d in t -- let definition
|
||||
let x = d in t -- let defin, type inferred
|
||||
let x=d ; y=e in t -- same as
|
||||
let x=d in let y=e in t
|
||||
let {...} in t -- same as let ... in t
|
||||
|
||||
t where {...} -- same as let ... in t
|
||||
```
|
||||
Free variation
|
||||
```
|
||||
variants {x ; y} -- both x and y possible
|
||||
variants {} -- nothing possible
|
||||
```
|
||||
Prefix-dependent choices
|
||||
```
|
||||
pre {"a" ; "an" / v} -- "an" before v, "a" otherw.
|
||||
strs {"a" ; "i" ;"o"}-- list of condition prefixes
|
||||
```
|
||||
Typed expression
|
||||
```
|
||||
<t:T> -- same as t, to help type inference
|
||||
```
|
||||
Accessing bound variables in ``lin``: use fields ``$1, $2, $3,...``.
|
||||
Example:
|
||||
```
|
||||
fun F : (A : Set) -> (El A -> Prop) -> Prop ;
|
||||
lin F A B = {s = ["for all"] ++ A.s ++ B.$1 ++ B.s}
|
||||
```
|
||||
|
||||
|
||||
===Pattern matching===
|
||||
|
||||
These patterns can be used in branches of ``table`` and
|
||||
``case`` expressions. Patterns are matched in the order in
|
||||
which they appear in the grammar.
|
||||
```
|
||||
C -- atomic param constructor
|
||||
C p q -- param constr. applied to patterns
|
||||
x -- variable, matches anything
|
||||
_ -- wildcard, matches anything
|
||||
"foo" -- string
|
||||
56 -- integer
|
||||
{s = p ; y = q} -- record, matches extensions too
|
||||
<p,q> -- tuple, same as {p1=p ; p2=q}
|
||||
p | q -- disjunction, binds to first match
|
||||
x@p -- binds x to what p matches
|
||||
- p -- negation
|
||||
p + "s" -- sequence of two string patterns
|
||||
p* -- repetition of a string pattern
|
||||
```
|
||||
|
||||
===Sample library functions===
|
||||
|
||||
```
|
||||
-- lib/prelude/Predef.gf
|
||||
drop : Int -> Tok -> Tok -- drop prefix of length
|
||||
take : Int -> Tok -> Tok -- take prefix of length
|
||||
tk : Int -> Tok -> Tok -- drop suffix of length
|
||||
dp : Int -> Tok -> Tok -- take suffix of length
|
||||
occur : Tok -> Tok -> PBool -- test if substring
|
||||
occurs : Tok -> Tok -> PBool -- test if any char occurs
|
||||
show : (P:Type) -> P ->Tok -- param to string
|
||||
read : (P:Type) -> Tok-> P -- string to param
|
||||
toStr : (L:Type) -> L ->Str -- find "first" string
|
||||
|
||||
-- lib/prelude/Prelude.gf
|
||||
param Bool = True | False
|
||||
oper
|
||||
SS : Type -- the type {s : Str}
|
||||
ss : Str -> SS -- construct SS
|
||||
cc2 : (_,_ : SS) -> SS -- concat SS's
|
||||
optStr : Str -> Str -- string or empty
|
||||
strOpt : Str -> Str -- empty or string
|
||||
bothWays : Str -> Str -> Str -- X++Y or Y++X
|
||||
init : Tok -> Tok -- all but last char
|
||||
last : Tok -> Tok -- last char
|
||||
prefixSS : Str -> SS -> SS
|
||||
postfixSS : Str -> SS -> SS
|
||||
infixSS : Str -> SS -> SS -> SS
|
||||
if_then_else : (A : Type) -> Bool -> A -> A -> A
|
||||
if_then_Str : Bool -> Str -> Str -> Str
|
||||
```
|
||||
|
||||
|
||||
===Flags===
|
||||
|
||||
Flags can appear, with growing priority,
|
||||
- in files, judgement ``flags`` and without dash (``-``)
|
||||
- as flags to ``gf`` when invoked, with dash
|
||||
- as flags to various GF commands, with dash
|
||||
|
||||
|
||||
Some common flags used in grammars:
|
||||
```
|
||||
startcat=cat use this category as default
|
||||
|
||||
lexer=literals int and string literals recognized
|
||||
lexer=code like program code
|
||||
lexer=text like text: spacing, capitals
|
||||
lexer=textlit text, unknowns as string lits
|
||||
|
||||
unlexer=code like program code
|
||||
unlexer=codelit code, remove string lit quotes
|
||||
unlexer=text like text: punctuation, capitals
|
||||
unlexer=textlit text, remove string lit quotes
|
||||
unlexer=concat remove all spaces
|
||||
unlexer=bind remove spaces around "&+"
|
||||
|
||||
optimize=all_subs best for almost any concrete
|
||||
optimize=values good for lexicon concrete
|
||||
optimize=all usually good for resource
|
||||
optimize=noexpand for resource, if =all too big
|
||||
```
|
||||
For the full set of values for ``FLAG``,
|
||||
use on-line ``h -FLAG``.
|
||||
|
||||
|
||||
|
||||
===File import search paths===
|
||||
|
||||
Colon-separated list of directories searched in the
|
||||
given order:
|
||||
```
|
||||
--# -path=.:../abstract:../common:prelude
|
||||
```
|
||||
This can be (in order of increasing priority), as
|
||||
first line in the file, as flag to ``gf``
|
||||
when invoked, or as flag to the ``i`` command.
|
||||
The prefix ``--#`` is used only in files.
|
||||
|
||||
GF attempts to satisfy an ``import`` command by searching for the
|
||||
import filename in the above search paths, initially qualified
|
||||
relative to the current working directory. If the file is not found in
|
||||
that initial expansion, the search paths are re-qualified relative to
|
||||
the directories given in the ``GF_LIB_PATH`` environment variable. If
|
||||
``GF_LIB_PATH`` is not defined, its default value is
|
||||
``/usr/local/share/gf-3.9/lib`` (assuming you have GF version 3.9).
|
||||
|
||||
If your GF resource grammar libraries are installed somewhere else,
|
||||
you will want to set ``GF_LIB_PATH`` to point there instead. In a
|
||||
pinch, you can point to the ``GF/lib/src/`` folder in your clone of
|
||||
the GF source code repository.
|
||||
|
||||
Developers of resource grammars may find it useful to define multiple
|
||||
directories, colon-separated, in ``GF_LIB_PATH``.
|
||||
|
||||
|
||||
===Alternative grammar formats===
|
||||
|
||||
**Old GF** (before GF 2.0):
|
||||
all judgements in any kinds of modules,
|
||||
division into files uses ``include``s.
|
||||
A file ``Foo.gf`` is recognized as the old format
|
||||
if it lacks a module header.
|
||||
|
||||
**Context-free** (file ``foo.cf``). The form of rules is e.g.
|
||||
```
|
||||
Fun. S ::= NP "is" AP ;
|
||||
```
|
||||
If ``Fun`` is omitted, it is generated automatically.
|
||||
Rules must be one per line. The RHS can be empty.
|
||||
|
||||
**Extended BNF** (file ``foo.ebnf``). The form of rules is e.g.
|
||||
```
|
||||
S ::= (NP+ ("is" | "was") AP | V NP*) ;
|
||||
```
|
||||
where the RHS is a regular expression of categories
|
||||
and quoted tokens: ``"foo", CAT, T U, T|U, T*, T+, T?``, or empty.
|
||||
Rule labels are generated automatically.
|
||||
|
||||
|
||||
**Probabilistic grammars** (not a separate format).
|
||||
You can set the probability of a function ``f`` (in its value category) by
|
||||
```
|
||||
--# prob f 0.009
|
||||
```
|
||||
These are put into a file given to GF using the ``probs=File`` flag
|
||||
on command line. This file can be the grammar file itself.
|
||||
|
||||
**Example-based grammars** (file ``foo.gfe``). Expressions of the form
|
||||
```
|
||||
in Cat "example string"
|
||||
```
|
||||
are preprocessed by using a parser given by the flag
|
||||
```
|
||||
--# -resource=File
|
||||
```
|
||||
and the result is written to ``foo.gf``.
|
||||
|
||||
|
||||
===References===
|
||||
|
||||
[GF Homepage http://www.grammaticalframework.org/]
|
||||
|
||||
A. Ranta, Grammatical Framework: A Type-Theoretical Grammar Formalism.
|
||||
//The Journal of Functional Programming//, vol. 14:2. 2004, pp. 145-189.
|
||||
|
||||
4584
doc/gf-refman.html
Normal file
4584
doc/gf-refman.html
Normal file
File diff suppressed because it is too large
Load Diff
2787
doc/gf-refman.md
2787
doc/gf-refman.md
File diff suppressed because it is too large
Load Diff
@@ -1,8 +1,11 @@
|
||||
The GF Software System
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!options(html): --toc
|
||||
%!options(html): --toc-level=4
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): "#VSPACE" "<hr>"
|
||||
%!postproc(html): "#NORMAL" ""
|
||||
%!postproc(html): "#TINY" ""
|
||||
@@ -10,7 +13,7 @@ The GF Software System
|
||||
|
||||
The GF software system implements the GF programming language. Its
|
||||
components are
|
||||
- the //compiler//,
|
||||
- the //compiler//,
|
||||
translating ``.gf`` source files to ``.gfo`` object files, to
|
||||
``.pgf`` run-time grammars, and to various other formats
|
||||
- the //run-time system//,
|
||||
@@ -40,7 +43,7 @@ The shell maintains a //state//, to which belong
|
||||
|
||||
|
||||
Unless file arguments are provided to the ``gf`` command, the shell starts in an
|
||||
empty state, with no grammars and no history.
|
||||
empty state, with no grammars and no history.
|
||||
|
||||
In the shell, a set of commands
|
||||
is available. Some of these commands may change the grammars in the state. The general
|
||||
@@ -56,7 +59,7 @@ syntax of commands is given by the following BNF grammar:
|
||||
ARGUMENT ::= QUOTED_STRING | TREE
|
||||
VALUE ::= IDENT | QUOTED_STRING
|
||||
```
|
||||
A command pipe is a sequence of commands interpreted in such a way
|
||||
A command pipe is a sequence of commands interpreted in such a way
|
||||
that the output of each command
|
||||
is send as input to the next. The option ``-tr`` causes GF to show a trace,
|
||||
i.e. the intermediate result of the command to which it is attached.
|
||||
@@ -66,7 +69,7 @@ executed one by one, in the order of appearance.
|
||||
|
||||
===GF shell commands===
|
||||
|
||||
The full set of GF shell commands is listed below with explanations.
|
||||
The full set of GF shell commands is listed below with explanations.
|
||||
This list can also be obtained in the GF shell by the command ``help -full``.
|
||||
|
||||
%!include: gf-help-full.txt
|
||||
@@ -74,14 +77,14 @@ This list can also be obtained in the GF shell by the command ``help -full``.
|
||||
==The GF batch compiler==
|
||||
|
||||
With the option ``-batch``, GF can be invoked in batch mode, i.e.
|
||||
without opening the shell, to compile files from ``.gf`` to ``.gfo``.
|
||||
The ``-s`` option ("silent") eliminates all messages except errors.
|
||||
without opening the shell, to compile files from ``.gf`` to ``.gfo``.
|
||||
The ``-s`` option ("silent") eliminates all messages except errors.
|
||||
```
|
||||
$ gf -batch -s LangIta.gf
|
||||
```
|
||||
With the option ``-make``, and as a set of
|
||||
top-level grammar files (with the same abstract syntax) as arguments,
|
||||
GF produces a ``.pgf`` file. The flag ``-optimize-pgf`` minimizes
|
||||
GF produces a ``.pgf`` file. The flag ``-optimize-pgf`` minimizes
|
||||
the size of the ``.pgf`` file, and is recommended for grammars to be shipped.
|
||||
```
|
||||
$ gf -make -optimize-pgf LangIta.gf LangEng.gf LangGer.gf
|
||||
@@ -104,3 +107,5 @@ To run GF from a //script//, redirection of standard input can be used:
|
||||
```
|
||||
The file ``script.gfs`` should then contain a sequence of GF commands, one per line.
|
||||
Unrecognized command lines are skipped without terminating GF.
|
||||
|
||||
|
||||
|
||||
@@ -1,35 +0,0 @@
|
||||
---
|
||||
title: "Video tutorials"
|
||||
---
|
||||
|
||||
The GF [YouTube channel](https://www.youtube.com/channel/UCZ96DechSUVcXAhtOId9VVA) keeps a playlist of [all GF videos](https://www.youtube.com/playlist?list=PLrgqBB5thLeT15fUtJ8_Dtk8ppdtH90MK), and more specific playlists for narrower topics.
|
||||
If you make a video about GF, let us know and we'll add it to the suitable playlist(s)!
|
||||
|
||||
- [General introduction to GF](#general-introduction-to-gf)
|
||||
- [Beginner resources](#beginner-resources)
|
||||
- [Resource grammar tutorials](#resource-grammar-tutorials)
|
||||
|
||||
## General introduction to GF
|
||||
|
||||
These videos introduce GF at a high level, and present some use cases.
|
||||
|
||||
__Grammatical Framework: Formalizing the Grammars of the World__
|
||||
|
||||
<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/x1LFbDQhbso" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
|
||||
|
||||
__Aarne Ranta: Automatic Translation for Consumers and Producers__
|
||||
|
||||
<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/An-AmFScw1o" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
|
||||
|
||||
## Beginner resources
|
||||
|
||||
These videos show how to install GF on your computer (Mac or Windows), and how to play with simple grammars in a [Jupyter notebook](https://github.com/GrammaticalFramework/gf-binder) (any platform, hosted at [mybinder.org](https://mybinder.org)).
|
||||
|
||||
<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/videoseries?list=PLrgqBB5thLeRa8eViJJnjT8jBhxqCPMF2" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
|
||||
|
||||
## Resource grammar tutorials
|
||||
|
||||
These videos show incremental improvements to a [miniature version of the resource grammar](https://github.com/inariksit/comp-syntax-2020/tree/master/lab2/grammar/dummy#readme).
|
||||
They assume some prior knowledge of GF, roughly lessons 1-3 from the [GF tutorial](http://www.grammaticalframework.org/doc/tutorial/gf-tutorial.html).
|
||||
|
||||
<iframe width="560" height="315" src="https://www.youtube-nocookie.com/embed/videoseries?list=PLrgqBB5thLeTPkp88lnOmRtprCa8g0wX2" frameborder="0" allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
|
||||
69
doc/index.html
Normal file
69
doc/index.html
Normal file
@@ -0,0 +1,69 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<title>GF Documentation</title>
|
||||
<link rel=stylesheet href="../css/style.css">
|
||||
</head>
|
||||
|
||||
|
||||
<body>
|
||||
|
||||
<div class=center>
|
||||
<a href="../"><img src="Logos/gf0.png"></a>
|
||||
|
||||
|
||||
|
||||
|
||||
<h1>Grammatical Framework Documents</h1>
|
||||
</div>
|
||||
|
||||
|
||||
<b>Top-5 documents</b>:
|
||||
|
||||
<a href="gf-quickstart.html">Quick start instruction</a>.
|
||||
|
||||
|
||||
<a href="tutorial/gf-tutorial.html">Old Tutorial</a>, application-oriented.
|
||||
|
||||
<a href="gf-lrec-2010.pdf">New Tutorial</a>, linguistics-oriented.
|
||||
|
||||
<a href="gf-refman.html">ReferenceManual</a>.
|
||||
|
||||
<a href="../lib/resource/doc/synopsis.html">LibrarySynopsis</a>.
|
||||
|
||||
|
||||
|
||||
|
||||
<h2>Language and system documentation</h2>
|
||||
|
||||
<ul>
|
||||
|
||||
<li>
|
||||
<a href="gf-reference.html">GF Quick Reference</a>. Also available in
|
||||
<a href="gf-reference.pdf">pdf</a>. Covers all features of GF language
|
||||
in a summary format.
|
||||
|
||||
<li>
|
||||
<a href="gf-refman.html">GF Reference Manual</a>. A full-scale reference
|
||||
manual of the GF language.
|
||||
|
||||
<li>
|
||||
<a href="gf-shell-reference.html">GF Shell Reference</a>.
|
||||
Describes the commands available in the interactive GF shell. Also
|
||||
summarizes how to run GF as a batch compiler.
|
||||
|
||||
<li>
|
||||
<a href="gf-editor-modes.html">Editor modes for GF</a>.
|
||||
Editor modes for GF provides syntax highligting, automatic indentation and
|
||||
other features that makes editing GF grammar files easier.
|
||||
|
||||
</ul>
|
||||
|
||||
|
||||
<h2>Publications</h2>
|
||||
|
||||
<a href="gf-bibliography.html">
|
||||
Bibliography</a>: more publications on GF, as well as background literature.
|
||||
|
||||
|
||||
</body></html>
|
||||
13
doc/index.md
13
doc/index.md
@@ -1,13 +0,0 @@
|
||||
---
|
||||
title: Grammatical Framework Documentation
|
||||
---
|
||||
|
||||
Perhaps you're looking for one of the following:
|
||||
|
||||
- [Tutorial](tutorial/gf-tutorial.html). This is a hands-on introduction to grammar writing in GF.
|
||||
- [Reference Manual](gf-refman.html). A full-scale reference manual of the GF language.
|
||||
- [RGL Tutorial](../lib/doc/rgl-tutorial/index.html)
|
||||
- [RGL Synopsis](../lib/doc/synopsis/index.html). Documentation of the Resource Grammar Library, including the syntax API and lexical paradigms for each language.
|
||||
- [Shell Reference](gf-shell-reference.html). Describes the commands available in the interactive GF shell.
|
||||
Also summarizes how to run GF as a batch compiler.
|
||||
- [Developers Guide](gf-developers/html). Detailed information about building and developing GF.
|
||||
@@ -1,26 +1,29 @@
|
||||
<!DOCTYPE html>
|
||||
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
|
||||
<html>
|
||||
<head>
|
||||
<title>C Runtime API</title>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
|
||||
<link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">
|
||||
<style>
|
||||
pre {
|
||||
background-color:#eee;
|
||||
margin-top: 1em;
|
||||
padding: 0.5em 1em;
|
||||
}
|
||||
pre.python {display: none}
|
||||
pre.haskell {display: block}
|
||||
pre.java {display: none}
|
||||
pre.csharp {display: none}
|
||||
body { background: #eee; padding-top: 200px; }
|
||||
|
||||
pre.python {background-color:#ffc; display: none}
|
||||
pre.haskell {background-color:#ffc; display: block}
|
||||
pre.java {background-color:#ffc; display: none}
|
||||
pre.csharp {background-color:#ffc; display: none}
|
||||
span.python {display: none}
|
||||
span.haskell {display: inline}
|
||||
span.java {display: none}
|
||||
span.csharp {display: none}
|
||||
|
||||
.header {
|
||||
position: fixed;
|
||||
top: 0;
|
||||
left: 0;
|
||||
background: #ddd;
|
||||
width: 100%;
|
||||
padding: 5pt;
|
||||
border-bottom: solid #bbb 2pt;
|
||||
}
|
||||
</style>
|
||||
|
||||
|
||||
<script lang="javascript">
|
||||
function change_language(href) {
|
||||
var name = href.split("#")[1];
|
||||
@@ -47,28 +50,14 @@
|
||||
</script>
|
||||
</head>
|
||||
<body onload="change_language(window.location.href); window.addEventListener('hashchange', function(e){change_language(window.location.href);});">
|
||||
<div class="container-fluid" style="max-width: 1200px">
|
||||
<div class="header sticky-top border-bottom py-3 bg-white">
|
||||
<a href=".." title="Home">
|
||||
<img src="../doc/Logos/gf1.svg" height="120px" class="float-md-right ml-3 mb-3 bg-white" alt="GF Logo">
|
||||
</a>
|
||||
<h1>
|
||||
Using the
|
||||
<span class="python">Python</span>
|
||||
<span class="haskell">Haskell</span>
|
||||
<span class="java">Java</span>
|
||||
<span class="csharp">C#</span>
|
||||
binding to the C runtime
|
||||
</h1>
|
||||
<h4 class="text-muted">Krasimir Angelov, July 2015 - August 2017</h4>
|
||||
Choose a language:
|
||||
<a href="#haskell" class="mx-1">Haskell</a>
|
||||
<a href="#python" class="mx-1">Python</a>
|
||||
<a href="#java" class="mx-1">Java</a>
|
||||
<a href="#csharp" class="mx-1">C#</a>
|
||||
</div>
|
||||
<main class="py-4">
|
||||
<span class="header">
|
||||
<h1>Using the <span class="python">Python</span> <span class="haskell">Haskell</span> <span class="java">Java</span> <span class="csharp">C#</span> binding to the C runtime</h1>
|
||||
|
||||
Choose a language: <a href="#haskell">Haskell</a> <a href="#python">Python</a> <a href="#java">Java</a> <a href="#csharp">C#</a>
|
||||
</span>
|
||||
|
||||
<h4>Krasimir Angelov, July 2015 - August 2017</h4>
|
||||
|
||||
<h2>Loading the Grammar</h2>
|
||||
|
||||
Before you use the <span class="python">Python</span> binding you need to import the <span class="haskell">PGF2 module</span><span class="python">pgf module</span><span class="java">pgf package</span><span class="csharp">PGFSharp package</span>:
|
||||
@@ -138,7 +127,7 @@ Concr eng = gr.Languages["AppEng"];
|
||||
|
||||
<h2>Parsing</h2>
|
||||
|
||||
All language specific services are available as
|
||||
All language specific services are available as
|
||||
<span class="python">methods of the class <tt>pgf.Concr</tt></span><span class="haskell">functions that take as an argument an object of type <tt>Concr</tt></span><span class="java">methods of the class <tt>Concr</tt></span><span class="csharp">methods of the class <tt>Concr</tt></span>.
|
||||
For example to invoke the parser, you can call:
|
||||
<pre class="python">
|
||||
@@ -231,10 +220,10 @@ Console.WriteLine(ep.Item1);
|
||||
PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA small_A) (UseN theatre_N)))))))) NoVoc
|
||||
</pre>
|
||||
|
||||
<p>Note that depending on the grammar it is absolutely possible that for
|
||||
a single sentence you might get infinitely many trees.
|
||||
<p>Note that depending on the grammar it is absolutely possible that for
|
||||
a single sentence you might get infinitely many trees.
|
||||
In other cases the number of trees might be finite but still enormous.
|
||||
The parser is specifically designed to be lazy, which means that
|
||||
The parser is specifically designed to be lazy, which means that
|
||||
each tree is returned as soon as it is found before exhausting
|
||||
the full search space. For grammars with a patological number of
|
||||
trees it is advisable to pick only the top <tt>N</tt> trees
|
||||
@@ -257,16 +246,16 @@ parsing with a different start category can be done as follows:</p>
|
||||
</pre>
|
||||
</span>
|
||||
<span class="haskell">
|
||||
There is also the function <tt>parseWithHeuristics</tt> which
|
||||
takes two more paramaters which let you to have a better control
|
||||
There is also the function <tt>parseWithHeuristics</tt> which
|
||||
takes two more paramaters which let you to have a better control
|
||||
over the parser's behaviour:
|
||||
<pre class="haskell">
|
||||
Prelude PGF2> let res = parseWithHeuristics eng (startCat gr) heuristic_factor callbacks
|
||||
</pre>
|
||||
</span>
|
||||
<span class="java">
|
||||
There is also the method <tt>parseWithHeuristics</tt> which
|
||||
takes two more paramaters which let you to have a better control
|
||||
There is also the method <tt>parseWithHeuristics</tt> which
|
||||
takes two more paramaters which let you to have a better control
|
||||
over the parser's behaviour:
|
||||
<pre class="java">
|
||||
Iterable<ExprProb> iterable = eng.parseWithHeuristics(gr.startCat(), heuristic_factor, callbacks);
|
||||
@@ -292,7 +281,7 @@ to factor 0.0. When we increase the factor then parsing becomes faster
|
||||
but at the same time the sorting becomes imprecise. The worst
|
||||
factor is 1.0. In any case the parser always returns the same set of
|
||||
trees but in different order. Our experience is that even a factor
|
||||
of about 0.6-0.8 with the translation grammar still orders
|
||||
of about 0.6-0.8 with the translation grammar still orders
|
||||
the most probable tree on top of the list but further down the list,
|
||||
the trees become shuffled.
|
||||
</p>
|
||||
@@ -468,7 +457,7 @@ the object has the following public final variables:
|
||||
</span>
|
||||
</p>
|
||||
|
||||
The linearization works even if there are functions in the tree
|
||||
The linearization works even if there are functions in the tree
|
||||
that doesn't have linearization definitions. In that case you
|
||||
will just see the name of the function in the generated string.
|
||||
It is sometimes helpful to be able to see whether a function
|
||||
@@ -494,7 +483,7 @@ true
|
||||
|
||||
<p>
|
||||
An already constructed tree can be analyzed and transformed
|
||||
in the host application. For example you can deconstruct
|
||||
in the host application. For example you can deconstruct
|
||||
a tree into a function name and a list of arguments:
|
||||
<pre class="python">
|
||||
>>> e.unpack()
|
||||
@@ -534,8 +523,8 @@ literal. For example the result from:
|
||||
<span class="haskell">
|
||||
The result from <tt>unApp</tt> is <tt>Just</tt> if the expression
|
||||
is an application and <tt>Nothing</tt> in all other cases.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>unStr</tt> will be <tt>Just</tt> with the actual literal.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>unStr</tt> will be <tt>Just</tt> with the actual literal.
|
||||
For example the result from:
|
||||
</span>
|
||||
<pre class="haskell">
|
||||
@@ -545,8 +534,8 @@ Prelude PGF2> readExpr "\"literal\"" >>= unStr
|
||||
<span class="java">
|
||||
The result from <tt>unApp</tt> is not <tt>null</tt> if the expression
|
||||
is an application, and <tt>null</tt> in all other cases.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>unStr</tt> will not be <tt>null</tt> with the actual literal.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>unStr</tt> will not be <tt>null</tt> with the actual literal.
|
||||
For example the output from:
|
||||
</span>
|
||||
<pre class="java">
|
||||
@@ -556,15 +545,15 @@ System.out.println(elit.unStr());
|
||||
<span class="csharp">
|
||||
The result from <tt>UnApp</tt> is not <tt>null</tt> if the expression
|
||||
is an application, and <tt>null</tt> in all other cases.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>UnStr</tt> will not be <tt>null</tt> with the actual literal.
|
||||
Similarly, if the tree is a literal string then the return value
|
||||
from <tt>UnStr</tt> will not be <tt>null</tt> with the actual literal.
|
||||
For example the output from:
|
||||
</span>
|
||||
<pre class="csharp">
|
||||
Expr elit = Expr.ReadExpr("\"literal\"");
|
||||
Console.WriteLine(elit.UnStr());
|
||||
</pre>
|
||||
is just the string "literal".
|
||||
is just the string "literal".
|
||||
<span class="python">Situations like this can be detected
|
||||
in Python by checking the type of the result from <tt>unpack</tt>.
|
||||
It is also possible to get an integer or a floating point number
|
||||
@@ -580,7 +569,7 @@ There are also the methods <tt>UnAbs</tt>, <tt>UnInt</tt>, <tt>UnFloat</tt> and
|
||||
</span>
|
||||
</p>
|
||||
|
||||
Constructing new trees is also easy. You can either use
|
||||
Constructing new trees is also easy. You can either use
|
||||
<tt>readExpr</tt> to read trees from strings, or you can
|
||||
construct new trees from existing pieces. This is possible by
|
||||
<span class="python">
|
||||
@@ -623,7 +612,7 @@ Console.WriteLine(e2);
|
||||
<p>If the host application needs to do a lot of expression manipulations,
|
||||
then it is helpful to use a higher-level API to the grammar,
|
||||
also known as "embedded grammars" in GF. The advantage is that
|
||||
you can construct and analyze expressions in a more compact way.</p>
|
||||
you can construct and analyze expressions in a more compact way.</p>
|
||||
|
||||
<span class="python">
|
||||
<p>In Python you first have to <tt>embed</tt> the grammar by calling:
|
||||
@@ -732,7 +721,7 @@ call the method <tt>default</tt>. The following is an example:
|
||||
def on_DetCN(self,quant,cn):
|
||||
print("Found DetCN")
|
||||
cn.visit(self)
|
||||
|
||||
|
||||
def on_AdjCN(self,adj,cn):
|
||||
print("Found AdjCN")
|
||||
cn.visit(self)
|
||||
@@ -1018,7 +1007,7 @@ Traceback (most recent call last):
|
||||
pgf.PGFError: The concrete syntax is not loaded
|
||||
</pre>
|
||||
|
||||
Before using the concrete syntax, you need to explicitly load it:
|
||||
Before using the concrete syntax, you need to explicitly load it:
|
||||
<pre class="python">
|
||||
>>> eng.load("AppEng.pgf_c")
|
||||
>>> print(eng.lookupMorpho("letter"))
|
||||
@@ -1071,7 +1060,7 @@ Traceback (most recent call last):
|
||||
pgf.PGFError: The concrete syntax is not loaded
|
||||
</pre>
|
||||
|
||||
Before using the concrete syntax, you need to explicitly load it:
|
||||
Before using the concrete syntax, you need to explicitly load it:
|
||||
<pre class="java">
|
||||
eng.load("AppEng.pgf_c")
|
||||
for (MorphoAnalysis an : eng.lookupMorpho("letter")) {
|
||||
@@ -1300,7 +1289,6 @@ graph {
|
||||
}
|
||||
</pre>
|
||||
|
||||
</main>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
||||
|
||||
@@ -8,7 +8,7 @@ December 2010 for GF 3.2
|
||||
% txt2tags --toc -ttex gf-tutorial.txt
|
||||
|
||||
%!target:html
|
||||
%!encoding: utf-8
|
||||
%!encoding: iso-8859-1
|
||||
%!options: --toc
|
||||
|
||||
%!postproc(tex) : "\\subsection\*" "\\newslide"
|
||||
@@ -618,32 +618,32 @@ and **semantic definitions**.
|
||||
|
||||
|
||||
|
||||
% #NEW
|
||||
%
|
||||
% ==Slides==
|
||||
%
|
||||
% You can chop this tutorial into a set of slides by the command
|
||||
% ```
|
||||
% htmls gf-tutorial.html
|
||||
% ```
|
||||
% where the program ``htmls`` is distributed with GF (see below), in
|
||||
%
|
||||
% [``GF/src/tools/Htmls.hs`` http://grammaticalframework.org/src/tools/Htmls.hs]
|
||||
%
|
||||
% The slides will appear as a set of files beginning with ``01-gf-tutorial.htmls``.
|
||||
%
|
||||
% Internal links will not work in the slide format, except for those in the
|
||||
% upper left corner of each slide, and the links behind the "Contents" link.
|
||||
#NEW
|
||||
|
||||
==Slides==
|
||||
|
||||
You can chop this tutorial into a set of slides by the command
|
||||
```
|
||||
htmls gf-tutorial.html
|
||||
```
|
||||
where the program ``htmls`` is distributed with GF (see below), in
|
||||
|
||||
[``GF/src/tools/Htmls.hs`` http://grammaticalframework.org/src/tools/Htmls.hs]
|
||||
|
||||
The slides will appear as a set of files beginning with ``01-gf-tutorial.htmls``.
|
||||
|
||||
Internal links will not work in the slide format, except for those in the
|
||||
upper left corner of each slide, and the links behind the "Contents" link.
|
||||
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchaptwo
|
||||
|
||||
=Lesson 1: Getting Started with GF=
|
||||
|
||||
|
||||
#Lchaptwo
|
||||
|
||||
Goals:
|
||||
- install and run GF
|
||||
- write the first GF grammar: a "Hello World" grammar in three languages
|
||||
@@ -836,8 +836,8 @@ Finnish and an Italian concrete syntaxes:
|
||||
lin
|
||||
Hello recip = {s = "terve" ++ recip.s} ;
|
||||
World = {s = "maailma"} ;
|
||||
Mum = {s = "äiti"} ;
|
||||
Friends = {s = "ystävät"} ;
|
||||
Mum = {s = "äiti"} ;
|
||||
Friends = {s = "ystävät"} ;
|
||||
}
|
||||
|
||||
concrete HelloIta of Hello = {
|
||||
@@ -898,7 +898,7 @@ Parentheses are only needed for grouping.
|
||||
Parsing something that is not in grammar will fail:
|
||||
```
|
||||
> parse "hello dad"
|
||||
The parser failed at token 2: "dad"
|
||||
Unknown words: dad
|
||||
|
||||
> parse "world hello"
|
||||
no tree found
|
||||
@@ -925,7 +925,7 @@ Default of the language flag (``-lang``): the last-imported concrete syntax.
|
||||
**Multilingual generation**:
|
||||
```
|
||||
> parse -lang=HelloEng "hello friends" | linearize
|
||||
terve ystävät
|
||||
terve ystävät
|
||||
ciao amici
|
||||
hello friends
|
||||
```
|
||||
@@ -1037,10 +1037,9 @@ Application programs, using techniques from #Rchapeight:
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapthree
|
||||
|
||||
=Lesson 2: Designing a grammar for complex phrases=
|
||||
|
||||
#Lchapthree
|
||||
|
||||
Goals:
|
||||
- build a larger grammar: phrases about food in English and Italian
|
||||
@@ -1336,7 +1335,7 @@ Just (?) replace English words with their dictionary equivalents:
|
||||
Phrase, Item, Kind, Quality = {s : Str} ;
|
||||
|
||||
lin
|
||||
Is item quality = {s = item.s ++ "è" ++ quality.s} ;
|
||||
Is item quality = {s = item.s ++ "č" ++ quality.s} ;
|
||||
This kind = {s = "questo" ++ kind.s} ;
|
||||
That kind = {s = "quel" ++ kind.s} ;
|
||||
QKind quality kind = {s = kind.s ++ quality.s} ;
|
||||
@@ -1447,11 +1446,11 @@ linearizations in different languages:
|
||||
> gr -number=2 | l -treebank
|
||||
|
||||
Is (That Cheese) (Very Boring)
|
||||
quel formaggio è molto noioso
|
||||
quel formaggio č molto noioso
|
||||
that cheese is very boring
|
||||
|
||||
Is (That Cheese) Fresh
|
||||
quel formaggio è fresco
|
||||
quel formaggio č fresco
|
||||
that cheese is fresh
|
||||
```
|
||||
|
||||
@@ -1473,14 +1472,14 @@ answer given in another language.
|
||||
You can interrupt the quiz by entering a line consisting of a dot ('.').
|
||||
|
||||
this fish is warm
|
||||
questo pesce è caldo
|
||||
questo pesce č caldo
|
||||
> Yes.
|
||||
Score 1/1
|
||||
|
||||
this cheese is Italian
|
||||
questo formaggio è noioso
|
||||
> No, not questo formaggio è noioso, but
|
||||
questo formaggio è italiano
|
||||
questo formaggio č noioso
|
||||
> No, not questo formaggio č noioso, but
|
||||
questo formaggio č italiano
|
||||
|
||||
Score 1/2
|
||||
this fish is expensive
|
||||
@@ -1757,7 +1756,7 @@ Simultaneous extension and opening:
|
||||
lincat
|
||||
Question = SS ;
|
||||
lin
|
||||
QIs item quality = ss (item.s ++ "è" ++ quality.s) ;
|
||||
QIs item quality = ss (item.s ++ "č" ++ quality.s) ;
|
||||
Pizza = ss "pizza" ;
|
||||
}
|
||||
```
|
||||
@@ -1798,10 +1797,9 @@ where
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapfour
|
||||
|
||||
=Lesson 3: Grammars with parameters=
|
||||
|
||||
#Lchapfour
|
||||
|
||||
Goals:
|
||||
- implement sophisticated linguistic structures:
|
||||
@@ -2366,10 +2364,10 @@ in English, with special care taken of variations with the suffix
|
||||
|
||||
+ Implement the German **Umlaut** operation on word stems.
|
||||
The operation changes the vowel of the stressed stem syllable as follows:
|
||||
//a// to //ä//, //au// to //äu//, //o// to //ö//, and //u// to //ü//. You
|
||||
//a// to //ä//, //au// to //äu//, //o// to //ö//, and //u// to //ü//. You
|
||||
can assume that the operation only takes syllables as arguments. Test the
|
||||
operation to see whether it correctly changes //Arzt// to //Ärzt//,
|
||||
//Baum// to //Bäum//, //Topf// to //Töpf//, and //Kuh// to //Küh//.
|
||||
operation to see whether it correctly changes //Arzt// to //Ärzt//,
|
||||
//Baum// to //Bäum//, //Topf// to //Töpf//, and //Kuh// to //Küh//.
|
||||
|
||||
|
||||
|
||||
@@ -2475,19 +2473,24 @@ can be used to read a text and return for each word its analyses
|
||||
```
|
||||
The command ``morpho_quiz = mq`` generates inflection exercises.
|
||||
```
|
||||
% gf alltenses/IrregFre.gfo
|
||||
% gf -path=alltenses:prelude $GF_LIB_PATH/alltenses/IrregFre.gfo
|
||||
|
||||
> morpho_quiz -cat=V
|
||||
|
||||
Welcome to GF Morphology Quiz.
|
||||
...
|
||||
|
||||
réapparaître : VFin VCondit Pl P2
|
||||
réapparaitriez
|
||||
> No, not réapparaitriez, but
|
||||
réapparaîtriez
|
||||
réapparaître : VFin VCondit Pl P2
|
||||
réapparaitriez
|
||||
> No, not réapparaitriez, but
|
||||
réapparaîtriez
|
||||
Score 0/1
|
||||
```
|
||||
To create a list for later use, use the command ``morpho_list = ml``
|
||||
```
|
||||
> morpho_list -number=25 -cat=V | write_file exx.txt
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -2560,7 +2563,7 @@ We need only number variation for the copula.
|
||||
```
|
||||
copula : Number -> Str =
|
||||
\n -> case n of {
|
||||
Sg => "è" ;
|
||||
Sg => "č" ;
|
||||
Pl => "sono"
|
||||
} ;
|
||||
```
|
||||
@@ -2646,12 +2649,12 @@ The verb //switch off// is called a
|
||||
|
||||
We can define transitive verbs and their combinations as follows:
|
||||
```
|
||||
lincat V2 = {s : Number => Str ; part : Str} ;
|
||||
lincat TV = {s : Number => Str ; part : Str} ;
|
||||
|
||||
fun AppV2 : Item -> V2 -> Item -> Phrase ;
|
||||
fun AppTV : Item -> TV -> Item -> Phrase ;
|
||||
|
||||
lin AppV2 subj v2 obj =
|
||||
{s = subj.s ++ v2.s ! subj.n ++ obj.s ++ v2.part} ;
|
||||
lin AppTV subj tv obj =
|
||||
{s = subj.s ++ tv.s ! subj.n ++ obj.s ++ tv.part} ;
|
||||
```
|
||||
|
||||
**Exercise**. Define the language ``a^n b^n c^n`` in GF, i.e.
|
||||
@@ -2717,11 +2720,11 @@ This topic will be covered in #Rseclexing.
|
||||
|
||||
The symbol ``**`` is used for both record types and record objects.
|
||||
```
|
||||
lincat V2 = Verb ** {c : Case} ;
|
||||
lincat TV = Verb ** {c : Case} ;
|
||||
|
||||
lin Follow = regVerb "folgen" ** {c = Dative} ;
|
||||
```
|
||||
``V2`` (transitive verb) becomes a **subtype** of ``Verb``.
|
||||
``TV`` becomes a **subtype** of ``Verb``.
|
||||
|
||||
If //T// is a subtype of //R//, an object of //T// can be used whenever
|
||||
an object of //R// is required.
|
||||
@@ -2752,11 +2755,7 @@ Thus the labels ``p1, p2,...`` are hard-coded.
|
||||
English indefinite article:
|
||||
```
|
||||
oper artIndef : Str =
|
||||
pre {
|
||||
("a" | "e" | "i" | "o") => "an" ;
|
||||
_ => "a"
|
||||
} ;
|
||||
|
||||
pre {"a" ; "an" / strs {"a" ; "e" ; "i" ; "o"}} ;
|
||||
```
|
||||
Thus
|
||||
```
|
||||
@@ -2773,10 +2772,9 @@ Thus
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapfive
|
||||
|
||||
=Lesson 4: Using the resource grammar library=
|
||||
|
||||
#Lchapfive
|
||||
|
||||
Goals:
|
||||
- navigate in the GF resource grammar library and use it in applications
|
||||
@@ -2947,7 +2945,7 @@ We need the following combinations:
|
||||
```
|
||||
We also need **lexical insertion**, to form phrases from single words:
|
||||
```
|
||||
mkCN : N -> CN ;
|
||||
mkCN : N -> NP ;
|
||||
mkAP : A -> AP ;
|
||||
```
|
||||
Naming convention: to construct a //C//, use a function ``mk``//C//.
|
||||
@@ -2968,7 +2966,7 @@ can be built as follows:
|
||||
```
|
||||
mkCl
|
||||
(mkNP these_Det
|
||||
(mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_N)))
|
||||
(mkCN (mkAP very_AdA (mkAP warm_A)) (mkCN pizza_CN)))
|
||||
(mkAP italian_AP)
|
||||
```
|
||||
The task now: to define the concrete syntax of ``Foods`` so that
|
||||
@@ -3307,13 +3305,13 @@ we can write a **functor instantiation**,
|
||||
oper
|
||||
wine_N = mkN "Wein" ;
|
||||
pizza_N = mkN "Pizza" "Pizzen" feminine ;
|
||||
cheese_N = mkN "Käse" "Käsen" masculine ;
|
||||
cheese_N = mkN "Käse" "Käsen" masculine ;
|
||||
fish_N = mkN "Fisch" ;
|
||||
fresh_A = mkA "frisch" ;
|
||||
warm_A = mkA "warm" "wärmer" "wärmste" ;
|
||||
warm_A = mkA "warm" "wärmer" "wärmste" ;
|
||||
italian_A = mkA "italienisch" ;
|
||||
expensive_A = mkA "teuer" ;
|
||||
delicious_A = mkA "köstlich" ;
|
||||
delicious_A = mkA "köstlich" ;
|
||||
boring_A = mkA "langweilig" ;
|
||||
}
|
||||
```
|
||||
@@ -3364,11 +3362,11 @@ Lexicon instance
|
||||
cheese_N = mkN "juusto" ;
|
||||
fish_N = mkN "kala" ;
|
||||
fresh_A = mkA "tuore" ;
|
||||
warm_A = mkA "lämmin" ;
|
||||
warm_A = mkA "lämmin" ;
|
||||
italian_A = mkA "italialainen" ;
|
||||
expensive_A = mkA "kallis" ;
|
||||
delicious_A = mkA "herkullinen" ;
|
||||
boring_A = mkA "tylsä" ;
|
||||
boring_A = mkA "tylsä" ;
|
||||
}
|
||||
```
|
||||
Functor instantiation
|
||||
@@ -3616,10 +3614,9 @@ tenses and moods, e.g. the Romance languages.
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapsix
|
||||
|
||||
=Lesson 5: Refining semantics in abstract syntax=
|
||||
|
||||
#Lchapsix
|
||||
|
||||
Goals:
|
||||
- include semantic conditions in grammars, by using
|
||||
@@ -3629,7 +3626,7 @@ Goals:
|
||||
- semantic definitions
|
||||
|
||||
These concepts are inherited from **type theory** (more precisely:
|
||||
constructive type theory, or Martin-Löf type theory).
|
||||
constructive type theory, or Martin-Löf type theory).
|
||||
|
||||
Type theory is the basis **logical frameworks**.
|
||||
|
||||
@@ -3717,24 +3714,48 @@ Concrete syntax does not know if a category is a dependent type.
|
||||
```
|
||||
Notice that the ``Kind`` argument is suppressed in linearization.
|
||||
|
||||
Parsing with dependent types consists of two phases:
|
||||
Parsing with dependent types is performed in two phases:
|
||||
+ context-free parsing
|
||||
+ filtering through type checker
|
||||
|
||||
Parsing a type-correct command works as expected:
|
||||
|
||||
By just doing the first phase, the ``kind`` argument is not found:
|
||||
```
|
||||
> parse "dim the light"
|
||||
CAction light dim (DKindOne light)
|
||||
CAction ? dim (DKindOne light)
|
||||
```
|
||||
However, type-incorrect commands are rejected by the typecheck:
|
||||
Moreover, type-incorrect commands are not rejected:
|
||||
```
|
||||
> parse "dim the fan"
|
||||
The parsing is successful but the type checking failed with error(s):
|
||||
Couldn't match expected type Device light
|
||||
against the interred type Device fan
|
||||
In the expression: DKindOne fan
|
||||
CAction ? dim (DKindOne fan)
|
||||
```
|
||||
The term ``?`` is a **metavariable**, returned by the parser
|
||||
for any subtree that is suppressed by a linearization rule.
|
||||
These are the same kind of metavariables as were used #Rsecediting
|
||||
to mark incomplete parts of trees in the syntax editor.
|
||||
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
===Solving metavariables===
|
||||
|
||||
Use the command ``put_tree = pt`` with the option ``-typecheck``:
|
||||
```
|
||||
> parse "dim the light" | put_tree -typecheck
|
||||
CAction light dim (DKindOne light)
|
||||
```
|
||||
The ``typecheck`` process may fail, in which case an error message
|
||||
is shown and no tree is returned:
|
||||
```
|
||||
> parse "dim the fan" | put_tree -typecheck
|
||||
|
||||
Error in tree UCommand (CAction ? 0 dim (DKindOne fan)) :
|
||||
(? 0 <> fan) (? 0 <> light)
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
@@ -3761,19 +3782,23 @@ to express Haskell-type library functions:
|
||||
\_,_,_,f,x,y -> f y x ;
|
||||
```
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
===Dependent types: exercises===
|
||||
|
||||
1. Write an abstract syntax module with above contents
|
||||
and an appropriate English concrete syntax. Try to parse the commands
|
||||
//dim the light// and //dim the fan//.
|
||||
//dim the light// and //dim the fan//, with and without ``solve`` filtering.
|
||||
|
||||
2. Perform random and exhaustive generation.
|
||||
|
||||
2. Perform random and exhaustive generation, with and without
|
||||
``solve`` filtering.
|
||||
|
||||
3. Add some device kinds and actions to the grammar.
|
||||
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
==Proof objects==
|
||||
@@ -3883,6 +3908,7 @@ fun
|
||||
Classes for new actions can be added incrementally.
|
||||
|
||||
|
||||
|
||||
#NEW
|
||||
|
||||
==Variable bindings==
|
||||
@@ -4151,11 +4177,11 @@ Type checking can be invoked with ``put_term -transform=solve``.
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapseven
|
||||
|
||||
==Lesson 6: Grammars of formal languages==
|
||||
|
||||
|
||||
#Lchapseven
|
||||
|
||||
Goals:
|
||||
- write grammars for formal languages (mathematical notation, programming languages)
|
||||
- interface between formal and natural langauges
|
||||
@@ -4170,8 +4196,7 @@ We construct a calculator with addition, subtraction, multiplication, and
|
||||
division of integers.
|
||||
```
|
||||
abstract Calculator = {
|
||||
flags startcat = Exp ;
|
||||
|
||||
|
||||
cat Exp ;
|
||||
|
||||
fun
|
||||
@@ -4197,7 +4222,7 @@ We begin with a
|
||||
concrete syntax that always uses parentheses around binary
|
||||
operator applications:
|
||||
```
|
||||
concrete CalculatorP of Calculator = open Prelude in {
|
||||
concrete CalculatorP of Calculator = {
|
||||
|
||||
lincat
|
||||
Exp = SS ;
|
||||
@@ -4491,10 +4516,9 @@ point literals as arguments.
|
||||
|
||||
#NEW
|
||||
|
||||
#Lchapeight
|
||||
|
||||
=Lesson 7: Embedded grammars=
|
||||
|
||||
#Lchapeight
|
||||
|
||||
Goals:
|
||||
- use grammars as parts of programs written in Haskell and JavaScript
|
||||
@@ -4615,7 +4639,7 @@ output. Therefore it can be a part of a pipe and read and write files.
|
||||
The simplest way to translate is to ``echo`` input to the program:
|
||||
```
|
||||
% echo "this wine is delicious" | ./trans Food.pgf
|
||||
questo vino è delizioso
|
||||
questo vino č delizioso
|
||||
```
|
||||
The result is given in all languages except the input language.
|
||||
|
||||
@@ -4708,6 +4732,10 @@ abstract Query = {
|
||||
|
||||
To make it easy to define a transfer function, we export the
|
||||
abstract syntax to a system of Haskell datatypes:
|
||||
```
|
||||
% gf --output-format=haskell Query.pgf
|
||||
```
|
||||
It is also possible to produce the Haskell file together with PGF, by
|
||||
```
|
||||
% gf -make --output-format=haskell QueryEng.gf
|
||||
```
|
||||
@@ -4930,12 +4958,12 @@ syntax name. This file contains the multilingual grammar as a JavaScript object.
|
||||
===Using the JavaScript grammar===
|
||||
|
||||
To perform parsing and linearization, the run-time library
|
||||
``gflib.js`` is used. It is included in ``/src/runtime/javascript/``, together with
|
||||
``gflib.js`` is used. It is included in ``GF/lib/javascript/``, together with
|
||||
some other JavaScript and HTML files; these files can be used
|
||||
as templates for building applications.
|
||||
|
||||
An example of usage is
|
||||
[``translator.html`` ../../src/runtime/javascript/translator.html],
|
||||
[``translator.html`` http://grammaticalframework.org:41296],
|
||||
which is in fact initialized with
|
||||
a pointer to the Food grammar, so that it provides translation between the English
|
||||
and Italian grammars:
|
||||
|
||||
13
doc/txt2html.sh
Normal file
13
doc/txt2html.sh
Normal file
@@ -0,0 +1,13 @@
|
||||
#!/bin/sh
|
||||
|
||||
FILES="darcs.txt transfer-reference.txt transfer-tutorial.txt \
|
||||
transfer.txt"
|
||||
|
||||
for f in $FILES; do
|
||||
h=`basename "$f" ".txt"`.html
|
||||
if [ "$f" -nt "$h" ]; then
|
||||
txt2tags $f
|
||||
else
|
||||
echo "$h is newer than $f, skipping"
|
||||
fi
|
||||
done
|
||||
@@ -1,6 +1,10 @@
|
||||
GF character encoding changes
|
||||
Thomas Hallgren
|
||||
2013-12-18
|
||||
%%mtime(%F)
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Changes to character encodings in GF grammar files ==
|
||||
|
||||
|
||||
25
download/gfc
Normal file
25
download/gfc
Normal file
@@ -0,0 +1,25 @@
|
||||
#!/bin/sh
|
||||
|
||||
prefix="/usr/local"
|
||||
|
||||
case "i386-apple-darwin9.3.0" in
|
||||
*-cygwin)
|
||||
prefix=`cygpath -w "$prefix"`;;
|
||||
esac
|
||||
|
||||
exec_prefix="${prefix}"
|
||||
GF_BIN_DIR="${exec_prefix}/bin"
|
||||
GF_DATA_DIR="${prefix}/share/GF-3.0-beta"
|
||||
|
||||
GFBIN="$GF_BIN_DIR/gf"
|
||||
|
||||
if [ ! -x "${GFBIN}" ]; then
|
||||
GFBIN=`which gf`
|
||||
fi
|
||||
|
||||
if [ ! -x "${GFBIN}" ]; then
|
||||
echo "gf not found."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
exec $GFBIN --batch "$@"
|
||||
@@ -16,7 +16,7 @@ GF 3.1.6 released 23 April 2010.
|
||||
- Windows (zipped executable):
|
||||
[``gf-3.1.6-bin-i486-windows.zip`` gf-3.1.6-bin-i486-windows.zip]
|
||||
(1.6 MB)
|
||||
- Ubuntu Linux (gzipped executable):
|
||||
- Ubuntu Linux (gzipped executable):
|
||||
[``gf-3.1.6-bin-i486-linux.gz`` gf-3.1.6-bin-i486-linux.gz]
|
||||
(1.7 MB)
|
||||
- compiled library package:
|
||||
@@ -25,7 +25,7 @@ GF 3.1.6 released 23 April 2010.
|
||||
- full source package (GF system, libraries, examples, documentation):
|
||||
[``gf-3.1.6-src.tar.gz`` gf-3.1.6-src.tar.gz]
|
||||
(11 MB)
|
||||
|
||||
|
||||
GF is also on [Hackage http://hackage.haskell.org/package/gf]
|
||||
|
||||
|
||||
@@ -40,7 +40,7 @@ What's new? See the [release notes release-3.1.6.html].
|
||||
==Installation instructions==
|
||||
|
||||
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
It finds the libraries relative to the ``.exe`` file.
|
||||
|
||||
To install a binary package for MacOS X or Linux: uncompress the executable and
|
||||
|
||||
@@ -1,201 +0,0 @@
|
||||
---
|
||||
title: Grammatical Framework Download and Installation
|
||||
...
|
||||
|
||||
**GF 3.10** was released on 2 December 2018.
|
||||
|
||||
What's new? See the [release notes](release-3.10.html).
|
||||
|
||||
## Binary packages
|
||||
|
||||
These binary packages include both the GF core (compiler and runtime) as well as the pre-compiled RGL.
|
||||
|
||||
| Platform | Download | Features | How to install |
|
||||
|:----------------|:---------------------------------------------------|:---------------|:-----------------------------------|
|
||||
| macOS | [gf-3.10.pkg](gf-3.10.pkg) | GF, S, C, J, P | Double-click on the package icon |
|
||||
| Raspbian 10 (buster) | [gf\_3.10-2\_armhf.deb](gf_3.10-2_armhf.deb) | GF,S,C,J,P | `sudo dpkg -i gf_3.10-2_armhf.deb` |
|
||||
| Ubuntu (32-bit) | [gf\_3.10-2\_i386.deb](gf_3.10-2_i386.deb) | GF, S, C, J, P | `sudo dpkg -i gf_3.10-2_i386.deb` |
|
||||
| Ubuntu (64-bit) | [gf\_3.10-2\_amd64.deb](gf_3.10-2_amd64.deb) | GF, S, C, J, P | `sudo dpkg -i gf_3.10-2_amd64.deb` |
|
||||
| Windows | [gf-3.10-bin-windows.zip](gf-3.10-bin-windows.zip) | GF, S | `unzip gf-3.10-bin-windows.zip` |
|
||||
|
||||
<!--
|
||||
| macOS | [gf-3.10-bin-intel-mac.tar.gz](gf-3.10-bin-intel-mac.tar.gz) | GF,S,C,J,P | `sudo tar -C /usr/local -zxf gf-3.10-bin-intel-mac.tar.gz` |
|
||||
-->
|
||||
|
||||
**Features**
|
||||
|
||||
- GF = GF shell and grammar compiler
|
||||
- S = `gf -server` mode
|
||||
- C = C run-time system
|
||||
- J/P = Java/Python binding to the C run-time system
|
||||
|
||||
### Notes
|
||||
|
||||
The Windows package is installed by just unpacking it anywhere. You will
|
||||
probably need to set the `PATH` and `GF_LIB_PATH` environment variables,
|
||||
see Inari's notes on [Installing GF on Windows](http://www.grammaticalframework.org/~inari/gf-windows.html#toc3).
|
||||
|
||||
The Ubuntu `.deb` packages should work on Ubuntu 16.04 and 18.04 and
|
||||
similar Linux distributions. The `.deb` packages were updated
|
||||
to version 3.10-2 after the release of GF 3.10.
|
||||
(Because of a packaging bug the Resource Grammar Library was missing
|
||||
in the 3.10-1 packages.)
|
||||
|
||||
<!-- The Raspbian `.deb` package was created on a Raspberry Pi 3 and will
|
||||
probably work on other ARM-based systems running Debian 9 (stretch) or
|
||||
similar Linux distributions. -->
|
||||
|
||||
The packages for macOS (Mac OS X) should work on at least 10.13 and
|
||||
10.14 (High Sierra and Mojave)
|
||||
|
||||
<!-- The Mac OS and Linux `.tar.gz` packages are designed to be installed in
|
||||
`/usr/local`. You can install them in other locations, but then you need
|
||||
to set the `GF_LIB_PATH` environment variable:
|
||||
|
||||
```
|
||||
export GF_LIB_PATH=/usr/local/share/gf-3.10/lib
|
||||
```
|
||||
|
||||
where `/usr/local` should be replaced with the path to the location
|
||||
where you unpacked the package. -->
|
||||
|
||||
## Installing the latest release from source
|
||||
|
||||
[GF is on Hackage](http://hackage.haskell.org/package/gf), so under
|
||||
normal circumstances the procedure is fairly simple:
|
||||
|
||||
1. Install a recent version of the [Haskell
|
||||
Platform](http://hackage.haskell.org/platform) (see note below)
|
||||
2. `cabal update`
|
||||
3. On Linux: install some C libraries from your Linux distribution (see note below)
|
||||
4. `cabal install gf`
|
||||
|
||||
This installs the GF executable and Haskell libraries, but **does not include the RGL**.
|
||||
|
||||
You can also download the source code release from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases),
|
||||
and follow the instructions below under **Installing from the latest developer source code**.
|
||||
|
||||
### Notes
|
||||
|
||||
**Installation location**
|
||||
|
||||
The above steps installs GF for a single user. The executables are put
|
||||
in `$HOME/.cabal/bin` (or, with recent versions of the Haskell platform
|
||||
on Mac OS X, in `$HOME/Library/Haskell/bin`), so it is a good idea to
|
||||
put a line in your `.bash_profile` or `.profile` to add that directory
|
||||
to you path:
|
||||
|
||||
```
|
||||
PATH=$HOME/.cabal/bin:$PATH
|
||||
```
|
||||
|
||||
or
|
||||
|
||||
```
|
||||
PATH=$HOME/Library/Haskell/bin:$PATH
|
||||
```
|
||||
|
||||
**Build tools**
|
||||
|
||||
In order to compile GF you need the build tools **Alex** and **Happy**.
|
||||
These can be installed via Cabal, e.g.:
|
||||
|
||||
```
|
||||
cabal install alex happy
|
||||
```
|
||||
|
||||
or obtained by other means, depending on your OS.
|
||||
|
||||
**Haskeline**
|
||||
|
||||
GF uses [`haskeline`](http://hackage.haskell.org/package/haskeline), which
|
||||
on Linux depends on some non-Haskell libraries that won't be installed
|
||||
automatically by cabal, and therefore need to be installed manually.
|
||||
Here is one way to do this:
|
||||
|
||||
- On Ubuntu: `sudo apt-get install libghc-haskeline-dev`
|
||||
- On Fedora: `sudo dnf install ghc-haskeline-devel`
|
||||
|
||||
**GHC version**
|
||||
|
||||
The GF source code has been updated to compile with GHC 8.4.
|
||||
Using older versions of GHC (e.g. 8.2, 8.0 and 7.10) should still work too.
|
||||
|
||||
## Installing from the latest developer source code
|
||||
|
||||
If you haven't already, clone the repository with:
|
||||
|
||||
```
|
||||
git clone https://github.com/GrammaticalFramework/gf-core.git
|
||||
```
|
||||
|
||||
If you've already cloned the repository previously, update with:
|
||||
|
||||
```
|
||||
git pull
|
||||
```
|
||||
|
||||
Then install with:
|
||||
|
||||
```
|
||||
cabal install
|
||||
```
|
||||
|
||||
or, if you're a Stack user:
|
||||
|
||||
```
|
||||
stack install
|
||||
```
|
||||
|
||||
The above notes for installing from source apply also in these cases.
|
||||
For more info on working with the GF source code, see the
|
||||
[GF Developers Guide](../doc/gf-developers.html).
|
||||
|
||||
## Installing the RGL from source
|
||||
|
||||
To install the RGL from source,
|
||||
you can download a release from [GitHub](https://github.com/GrammaticalFramework/gf-rgl/releases)
|
||||
or get the latest version by cloning the repository:
|
||||
|
||||
```
|
||||
git clone https://github.com/GrammaticalFramework/gf-rgl.git
|
||||
```
|
||||
|
||||
In both cases, once you have the RGL sources you can install them by running:
|
||||
|
||||
```
|
||||
make
|
||||
```
|
||||
|
||||
in the RGL folder.
|
||||
This assumes that you already have GF installed.
|
||||
For more details about building the RGL, see the [RGL README](https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md).
|
||||
|
||||
## Installing the Python bindings from PyPI
|
||||
|
||||
The Python library is available on PyPI as `pgf`, so it can be installed using:
|
||||
|
||||
```
|
||||
pip install pgf
|
||||
```
|
||||
|
||||
We provide binary wheels for Linux and OSX (with Windows missing so far), which
|
||||
include the C runtime and a ready-to-go. If there is no binary distribution for
|
||||
your platform, this will install the source tarball, which will attempt to build
|
||||
the binding during installation, and requires the GF C runtime to be installed on
|
||||
your system.
|
||||
|
||||
## Older releases
|
||||
|
||||
- [GF 3.9](index-3.9.html) (August 2017)
|
||||
- [GF 3.8](index-3.8.html) (June 2016)
|
||||
- [GF 3.7.1](index-3.7.1.html) (October 2015)
|
||||
- [GF 3.7](index-3.7.html) (June 2015)
|
||||
- [GF 3.6](index-3.6.html) (June 2014)
|
||||
- [GF 3.5](index-3.5.html) (August 2013)
|
||||
- [GF 3.4](index-3.4.html) (January 2013)
|
||||
- [GF 3.3.3](index-3.3.3.html) (March 2012)
|
||||
- [GF 3.3](index-3.3.html) (October 2011)
|
||||
- [GF 3.2.9](index-3.2.9.html) source-only snapshot (September 2011)
|
||||
- [GF 3.2](index-3.2.html) (December 2010)
|
||||
- [GF 3.1.6](index-3.1.6.html) (April 2010)
|
||||
@@ -1,173 +0,0 @@
|
||||
---
|
||||
title: Grammatical Framework Download and Installation
|
||||
...
|
||||
|
||||
**GF 3.11** was released on ... December 2020.
|
||||
|
||||
What's new? See the [release notes](release-3.11.html).
|
||||
|
||||
#### Note: GF core and the RGL
|
||||
|
||||
The following instructions explain how to install **GF core**, i.e. the compiler, shell and run-time systems.
|
||||
Obtaining the **Resource Grammar Library (RGL)** is done separately; see the section at the bottom of this page.
|
||||
|
||||
---
|
||||
|
||||
## Installing from a binary package
|
||||
|
||||
Binary packages are available for Debian/Ubuntu, macOS, and Windows and include:
|
||||
|
||||
- GF shell and grammar compiler
|
||||
- `gf -server` mode
|
||||
- C run-time system
|
||||
- Java & Python bindings to the C run-time system
|
||||
|
||||
Unlike in previous versions, the binaries **do not** include the RGL.
|
||||
|
||||
[Binary packages on GitHub](https://github.com/GrammaticalFramework/gf-core/releases/tag/RELEASE-3.11)
|
||||
|
||||
#### Debian/Ubuntu
|
||||
|
||||
To install the package use:
|
||||
```
|
||||
sudo dpkg -i gf_3.11.deb
|
||||
```
|
||||
|
||||
The Ubuntu `.deb` packages should work on Ubuntu 16.04, 18.04 and similar Linux distributions.
|
||||
|
||||
#### macOS
|
||||
|
||||
To install the package, just double-click it and follow the installer instructions.
|
||||
|
||||
The packages should work on at least 10.13 (High Sierra) and 10.14 (Mojave).
|
||||
|
||||
#### Windows
|
||||
|
||||
To install the package, unpack it anywhere.
|
||||
|
||||
You will probably need to update the `PATH` environment variable to include your chosen install location.
|
||||
|
||||
For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).
|
||||
|
||||
## Installing the latest Hackage release (macOS, Linux, and WSL2 on Windows)
|
||||
|
||||
[GF is on Hackage](http://hackage.haskell.org/package/gf), so under
|
||||
normal circumstances the procedure is fairly simple:
|
||||
|
||||
1. Install ghcup https://www.haskell.org/ghcup/
|
||||
2. `ghcup install ghc 8.10.4`
|
||||
3. `ghcup set ghc 8.10.4`
|
||||
4. `cabal update`
|
||||
5. On Linux: install some C libraries from your Linux distribution (see note below)
|
||||
6. `cabal install gf-3.11`
|
||||
|
||||
You can also download the source code release from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases),
|
||||
and follow the instructions below under **Installing from the latest developer source code**.
|
||||
|
||||
### Notes
|
||||
|
||||
**Installation location**
|
||||
|
||||
The above steps installs GF for a single user.
|
||||
The executables are put in `$HOME/.cabal/bin` (or on macOS in `$HOME/Library/Haskell/bin`),
|
||||
so you might want to add this directory to your path (in `.bash_profile` or similar):
|
||||
|
||||
```
|
||||
PATH=$HOME/.cabal/bin:$PATH
|
||||
```
|
||||
|
||||
**Haskeline**
|
||||
|
||||
GF uses [`haskeline`](http://hackage.haskell.org/package/haskeline), which
|
||||
on Linux depends on some non-Haskell libraries that won't be installed
|
||||
automatically by cabal, and therefore need to be installed manually.
|
||||
Here is one way to do this:
|
||||
|
||||
- On Ubuntu: `sudo apt-get install libghc-haskeline-dev`
|
||||
- On Fedora: `sudo dnf install ghc-haskeline-devel`
|
||||
|
||||
**GHC version**
|
||||
|
||||
The GF source code has been updated to compile with GHC versions 7.10 through to 8.8.
|
||||
|
||||
## Installing from the latest developer source code
|
||||
|
||||
If you haven't already, clone the repository with:
|
||||
|
||||
```
|
||||
git clone https://github.com/GrammaticalFramework/gf-core.git
|
||||
```
|
||||
|
||||
If you've already cloned the repository previously, update with:
|
||||
|
||||
```
|
||||
git pull
|
||||
```
|
||||
|
||||
Then install with:
|
||||
|
||||
```
|
||||
cabal install
|
||||
```
|
||||
|
||||
or, if you're a Stack user:
|
||||
|
||||
```
|
||||
stack install
|
||||
```
|
||||
|
||||
The above notes for installing from source apply also in these cases.
|
||||
For more info on working with the GF source code, see the
|
||||
[GF Developers Guide](../doc/gf-developers.html).
|
||||
|
||||
## Installing the Python bindings from PyPI
|
||||
|
||||
The Python library is available on PyPI as `pgf`, so it can be installed using:
|
||||
|
||||
```
|
||||
pip install pgf
|
||||
```
|
||||
|
||||
We provide binary wheels for Linux and macOS, which include the C runtime and are ready-to-go.
|
||||
If there is no binary distribution for your platform, this will install the source tarball,
|
||||
which will attempt to build the binding during installation,
|
||||
and requires the GF C runtime to be installed on your system.
|
||||
|
||||
---
|
||||
|
||||
## Installing the RGL from a binary release
|
||||
|
||||
Binary releases of the RGL are made available on [GitHub](https://github.com/GrammaticalFramework/gf-rgl/releases).
|
||||
In general the steps to follow are:
|
||||
|
||||
1. Download a binary release and extract it somewhere on your system.
|
||||
2. Set the environment variable `GF_LIB_PATH` to point to wherever you extracted the RGL.
|
||||
|
||||
## Installing the RGL from source
|
||||
|
||||
To compile the RGL, you will need to have GF already installed and in your path.
|
||||
|
||||
1. Obtain the RGL source code, either by:
|
||||
- cloning with `git clone https://github.com/GrammaticalFramework/gf-rgl.git`
|
||||
- downloading a source archive [here](https://github.com/GrammaticalFramework/gf-rgl/archive/master.zip)
|
||||
2. Run `make` in the source code folder.
|
||||
|
||||
For more options, see the [RGL README](https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md).
|
||||
|
||||
---
|
||||
|
||||
## Older releases
|
||||
|
||||
- [GF 3.10](index-3.10.html) (December 2018)
|
||||
- [GF 3.9](index-3.9.html) (August 2017)
|
||||
- [GF 3.8](index-3.8.html) (June 2016)
|
||||
- [GF 3.7.1](index-3.7.1.html) (October 2015)
|
||||
- [GF 3.7](index-3.7.html) (June 2015)
|
||||
- [GF 3.6](index-3.6.html) (June 2014)
|
||||
- [GF 3.5](index-3.5.html) (August 2013)
|
||||
- [GF 3.4](index-3.4.html) (January 2013)
|
||||
- [GF 3.3.3](index-3.3.3.html) (March 2012)
|
||||
- [GF 3.3](index-3.3.html) (October 2011)
|
||||
- [GF 3.2.9](index-3.2.9.html) source-only snapshot (September 2011)
|
||||
- [GF 3.2](index-3.2.html) (December 2010)
|
||||
- [GF 3.1.6](index-3.1.6.html) (April 2010)
|
||||
@@ -1,6 +1,11 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.2.9** source-only snapshot was released on 12 September 2011.
|
||||
|
||||
What's new? Faster grammar compilation!
|
||||
@@ -72,3 +77,9 @@ The above notes for installing from source apply also in this case.
|
||||
- [GF 3.2 index-3.2.html] (December 2011).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
|
||||
@@ -1,6 +1,11 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.2** was released on 23 December 2010.
|
||||
|
||||
What's new? See the [Release notes release-3.2.html].
|
||||
@@ -22,7 +27,7 @@ More packages might be added later.
|
||||
|
||||
===Notes===
|
||||
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
It finds the libraries relative to the ``.exe`` file.
|
||||
|
||||
The ``.deb`` packages work on Ubuntu 10.04 and 10.10.
|
||||
@@ -100,3 +105,8 @@ Subsequently:
|
||||
```
|
||||
|
||||
The above notes for installing from source apply also in this case.
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
|
||||
@@ -1,6 +1,12 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.3.3** was released on 3 March 2012.
|
||||
|
||||
What's new? See the [Release notes release-3.3.3.html].
|
||||
@@ -18,7 +24,7 @@ What's new? See the [Release notes release-3.3.3.html].
|
||||
|
||||
===Notes===
|
||||
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
It finds the libraries relative to the ``.exe`` file.
|
||||
|
||||
%The ``.deb`` packages work on Ubuntu 10.04 and 10.10.
|
||||
@@ -121,3 +127,9 @@ For more info, see the [GF Developers Guide ../doc/gf-developers.html].
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
|
||||
@@ -1,6 +1,11 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.3** was released on 27 October 2011.
|
||||
|
||||
What's new? See the [Release notes release-3.3.html].
|
||||
@@ -22,7 +27,7 @@ More packages might be added later.
|
||||
|
||||
===Notes===
|
||||
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
The Windows package is installed by just unpacking it anywhere.
|
||||
It finds the libraries relative to the ``.exe`` file.
|
||||
|
||||
%The ``.deb`` packages work on Ubuntu 10.04 and 10.10.
|
||||
@@ -110,3 +115,9 @@ The above notes for installing from source apply also in this case.
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
|
||||
@@ -1,6 +1,13 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): </HEAD> <STYLE>body { color: #333; } li>code,p>code,pre { color: #730; }</STYLE></HEAD>
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.4** was released on 31 January 2013.
|
||||
|
||||
What's new? See the [Release notes release-3.4.html].
|
||||
@@ -13,11 +20,14 @@ What's new? See the [Release notes release-3.4.html].
|
||||
| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | ``sudo rpm -i ...``
|
||||
| Ubuntu (32-bit) | [gf_3.4-1_i386.deb gf_3.4-1_i386.deb] | ``sudo dpkg -i gf_3.4-1_i386.deb``
|
||||
| Ubuntu (64-bit) | [gf_3.4-1_amd64.deb gf_3.4-1_amd64.deb] | ``sudo dpkg -i gf_3.4-1_amd64.deb``
|
||||
| Windows | [gf-3.4-bin-windows.zip gf-3.4-bin-windows.zip] | -
|
||||
| Windows | [gf-3.4-bin-windows.zip gf-3.4-bin-windows.zip] |
|
||||
%| ... | ... | ...
|
||||
|
||||
%More binary packages might be added later.
|
||||
|
||||
===Notes===
|
||||
|
||||
%The Windows package is installed by just unpacking it anywhere.
|
||||
%The Windows package is installed by just unpacking it anywhere.
|
||||
%It finds the libraries relative to the ``.exe`` file.
|
||||
|
||||
The ``.deb`` packages work on Ubuntu 12.04, 12.10 and 13.04.
|
||||
@@ -143,3 +153,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,13 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): </HEAD> <STYLE>body { color: #333; } li>code,p>code,pre { color: #730; }</STYLE></HEAD>
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <TD><B> <TH>
|
||||
%!postproc(html): </B></TD> </TH>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
**GF 3.5** was released on 6 August 2013.
|
||||
|
||||
What's new? See the [Release notes release-3.5.html].
|
||||
@@ -150,3 +157,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,13 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): </HEAD> <STYLE>body { color: #333; } li>code,p>code,pre { color: #730; }</STYLE></HEAD>
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): <TD><I> <TD><small>
|
||||
%!postproc(html): </I></TD> </small></TD>
|
||||
|
||||
**GF 3.6** was released on 23 June 2014.
|
||||
|
||||
What's new? See the [Release notes release-3.6.html].
|
||||
@@ -170,3 +177,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,12 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): <TD><I> <TD><small>
|
||||
%!postproc(html): </I></TD> </small></TD>
|
||||
|
||||
**GF 3.7.1** was released on 2 October 2015.
|
||||
|
||||
What's new? See the [Release notes release-3.7.1.html].
|
||||
@@ -40,7 +46,7 @@ The ``.deb`` packages work on Ubuntu 12.04, 14.04 and 15.04.
|
||||
|
||||
The packages for Mac OS X should work on at least 10.9, 10.10 and 10.11 (Mavericks, Yosemite and El Capitan).
|
||||
|
||||
(*) **Note** that for compatibility with OS X 10.11,
|
||||
(*) **Note** that for compatibility with OS X 10.11,
|
||||
``gf-3.7.1.pkg`` will install the ``gf`` executable in ``/usr/local/bin``
|
||||
instead of ``/usr/bin``, so make sure ``/usr/local/bin`` is in your ``$PATH``.
|
||||
Also, if you still have an older version of GF installed in ``/usr/bin``,
|
||||
@@ -174,3 +180,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,13 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): </HEAD> <STYLE>body { color: #333; } li>code,p>code,pre { color: #730; }</STYLE></HEAD>
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): <TD><I> <TD><small>
|
||||
%!postproc(html): </I></TD> </small></TD>
|
||||
|
||||
**GF 3.7** was released on 25 June 2015.
|
||||
|
||||
What's new? See the [Release notes release-3.7.html].
|
||||
@@ -166,3 +173,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,12 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): <TD><I> <TD><small>
|
||||
%!postproc(html): </I></TD> </small></TD>
|
||||
|
||||
**GF 3.8** was released on 22 June 2016.
|
||||
|
||||
What's new? See the [Release notes release-3.8.html].
|
||||
@@ -43,7 +49,7 @@ Linux distributions.
|
||||
|
||||
The packages for Mac OS X should work on at least 10.9, 10.10 and 10.11 (Mavericks, Yosemite and El Capitan).
|
||||
|
||||
(*) **Note** that for compatibility with OS X 10.11,
|
||||
(*) **Note** that for compatibility with OS X 10.11,
|
||||
``gf-3.8.pkg`` will install the ``gf`` executable in ``/usr/local/bin``
|
||||
instead of ``/usr/bin``, so make sure ``/usr/local/bin`` is in your ``$PATH``.
|
||||
Also, if you still have an older version of GF installed in ``/usr/bin``,
|
||||
@@ -165,3 +171,8 @@ For more info on working with the GF source code, see the
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,8 +0,0 @@
|
||||
<html>
|
||||
<head>
|
||||
<meta http-equiv="refresh" content="0; URL=/download/index-3.10.html" />
|
||||
</head>
|
||||
<body>
|
||||
You are being redirected to <a href="index-3.10.html">the current version</a> of this page.
|
||||
</body>
|
||||
</html>
|
||||
@@ -1,6 +1,12 @@
|
||||
Grammatical Framework Download and Installation
|
||||
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
%!postproc(html): <TD><I> <TD><small>
|
||||
%!postproc(html): </I></TD> </small></TD>
|
||||
|
||||
**GF 3.9** was released on 11 August 2017.
|
||||
|
||||
What's new? See the [Release notes release-3.9.html].
|
||||
@@ -12,11 +18,10 @@ What's new? See the [Release notes release-3.9.html].
|
||||
| macOS | [gf-3.9.pkg gf-3.9.pkg] | //GF+S+C+J+P// | Double-click on the package icon
|
||||
| macOS | [gf-3.9-bin-intel-mac.tar.gz gf-3.9-bin-intel-mac.tar.gz] | //GF+S+C+J+P// | ``sudo tar -C /usr/local -zxf gf-3.9-bin-intel-mac.tar.gz``
|
||||
%| Fedora (32-bit) | [Fedora RPMs /~hallgren/tmp/Fedora/] | //GF+S+C+J+P// | ``sudo rpm -i ...``
|
||||
| Raspbian 9.1 | [gf_3.9-1_armhf.deb gf_3.9-1_armhf.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_armhf.deb``
|
||||
| Raspian 9.1 | [gf_3.9-1_armhf.deb gf_3.9-1_armhf.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_armhf.deb``
|
||||
| Ubuntu (32-bit) | [gf_3.9-1_i386.deb gf_3.9-1_i386.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_i386.deb``
|
||||
| Ubuntu (64-bit) | [gf_3.9-1_amd64.deb gf_3.9-1_amd64.deb] | //GF+S+C+J+P// | ``sudo dpkg -i gf_3.9-1_amd64.deb``
|
||||
| Windows | [gf-3.9-bin-windows.zip gf-3.9-bin-windows.zip] | //GF+S// | ``unzip gf-3.9-bin-windows.zip``
|
||||
|
||||
%| MINGW | [gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz] | //GF+S+C// | ``tar -C / gf-3.9-bin-i686-MINGW32_NT-6.1.tar.gz``
|
||||
%| ... | ... | ... | ...
|
||||
|
||||
@@ -171,11 +176,6 @@ The above notes for installing from source apply also in these cases.
|
||||
For more info on working with the GF source code, see the
|
||||
[GF Developers Guide ../doc/gf-developers.html].
|
||||
|
||||
==Using Stack==
|
||||
|
||||
You can also use [Stack https://www.haskellstack.org] to compile GF, just replace ``cabal install`` above
|
||||
with ``stack install`` (assuming you already have Stack set up).
|
||||
|
||||
==Older releases==
|
||||
|
||||
- [GF 3.8 index-3.8.html] (June 2016)
|
||||
@@ -190,3 +190,8 @@ with ``stack install`` (assuming you already have Stack set up).
|
||||
- [GF 3.2 index-3.2.html] (December 2010).
|
||||
- [GF 3.1.6 index-3.1.6.html] (April 2010).
|
||||
- [GF 3.1 old-index.html] (December 2009).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
@@ -5,13 +5,13 @@ GF Version 3.1.6 Release Notes
|
||||
=Installation=
|
||||
|
||||
The binaries now work out of the box for each platform and support
|
||||
completions (file names and parsing), because readline has been
|
||||
completions (file names and parsing), because readline has been
|
||||
changed to haskeline.
|
||||
|
||||
To compile from source, GHC 6.12 is now required. But GHC is not needed
|
||||
if the binary executables are used.
|
||||
|
||||
Binaries (``.gfo`` and ``.pgf`` files) compiled with GF 3.1 are incompatible
|
||||
Binaries (``.gfo`` and ``.pgf`` files) compiled with GF 3.1 are incompatible
|
||||
with 3.1.6 and must either be removed; alternatively, the ``-src`` flag can be
|
||||
used when compiling.
|
||||
|
||||
@@ -24,8 +24,8 @@ Grammar language
|
||||
- improved support for dependent types (see ``SUMO``, ``nqueens`` in ``examples``)
|
||||
|
||||
|
||||
Shell commands and options (see ``help`` in GF for more information)
|
||||
- ``eb``: example-based grammar file conversion
|
||||
Shell commands and options (see ``help`` in GF for more information)
|
||||
- ``eb``: example-based grammar file conversion
|
||||
(see ``examples/animals/QuestionI.gf``)
|
||||
- ``vd = visualize_dependency``: show dependency tree
|
||||
- ``vp = visualize_parse``: show parse tree
|
||||
@@ -57,3 +57,8 @@ Internal
|
||||
|
||||
Javascript generation is not updated to the new PGF format.
|
||||
[GF 3.1 old-index.html] should still be used for building Javascript applications.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,66 +0,0 @@
|
||||
---
|
||||
title: GF 3.10 Release Notes
|
||||
date: 2 December 2018
|
||||
...
|
||||
|
||||
## Installation
|
||||
|
||||
See the [download page](index.html).
|
||||
|
||||
## What's new
|
||||
|
||||
In this release, the GF "core" (compiler and runtimes) and RGL have been split into separate repositories.
|
||||
The binary packages on the downloads page contain both GF and the RGL, but the sources are now separate:
|
||||
[gf-core](https://github.com/GrammaticalFramework/gf-core) and
|
||||
[gf-rgl](https://github.com/GrammaticalFramework/gf-rgl).
|
||||
|
||||
Over 300 changes have been pushed to GF and over 600 changes have been made to the RGL
|
||||
since the release of GF 3.9 in August 2017.
|
||||
|
||||
## General
|
||||
|
||||
- Travis integration:
|
||||
GF [](https://travis-ci.org/GrammaticalFramework/gf-core) and
|
||||
RGL [](https://travis-ci.org/GrammaticalFramework/gf-rgl)
|
||||
- A lot of bug fixes and repository cleanup, including things moved to new repositories:
|
||||
- [Phrasebook](https://github.com/GrammaticalFramework/gf-contrib/tree/master/phrasebook)
|
||||
- [Wide coverage translator](https://github.com/GrammaticalFramework/wide-coverage)
|
||||
- [Mobile apps](https://github.com/GrammaticalFramework/gf-offline-translator)
|
||||
- [gftest](https://github.com/GrammaticalFramework/gftest)
|
||||
- [gf-mode](https://github.com/GrammaticalFramework/gf-emacs-mode) for Emacs
|
||||
- [RGL browser](https://github.com/GrammaticalFramework/rgl-source-browser) (live [here](http://www.grammaticalframework.org/~john/rgl-browser/))
|
||||
- A fresh look for the GF website.
|
||||
|
||||
## GF compiler and run-time library
|
||||
|
||||
- Extensive improvements in the C runtime and bindings to it from Python, Java, Haskell, C#
|
||||
- A GF shell which uses the C runtime
|
||||
- Better error messages
|
||||
- GF now has a Stack configuration file
|
||||
- The compiler source code has been updated for compatibility with GHC 8.4.3.
|
||||
- `GF_LIB_PATH` can now be `path1:path2:path3`, not just `path1`
|
||||
- Add TypeScript type definitions for `gflib.js`
|
||||
- New compiler/shell options
|
||||
- added option `-output-format=java` for producing code for embedded grammars in Java
|
||||
- `rf -paragraphs`
|
||||
- `linearize -tabtreebank`
|
||||
- A new function called `completions` is added in the Haskell runtime and used in PGFService. This makes the extraction of completions more platform independent
|
||||
|
||||
## Resource Grammar Library
|
||||
|
||||
- [Bash build script](https://github.com/GrammaticalFramework/gf-rgl/blob/master/Setup.sh), for building the RGL without Haskell
|
||||
- [Windows build script](https://github.com/GrammaticalFramework/gf-rgl/blob/master/Setup.bat), for building the RGL without Haskell on a regular Windows command shell
|
||||
- New languages:
|
||||
- Basque
|
||||
- Portuguese
|
||||
- Big progress with Arabic, Turkish, Persian
|
||||
- Introduction of `Extend` module to combine the functions of `Extra` and `Extensions` in a more disciplined way
|
||||
- Various fixes for several languages.
|
||||
- Various fixes in the translation dictionaries.
|
||||
|
||||
## Apps and Cloud services
|
||||
|
||||
- Sort list of public grammars by age by default
|
||||
- Browser compatibility fixes
|
||||
- Allow public grammars to be deleted in more cases
|
||||
- Show grammar comments in the list of public grammars
|
||||
@@ -1,40 +0,0 @@
|
||||
---
|
||||
title: GF 3.11 Release Notes
|
||||
date: ... December 2020
|
||||
...
|
||||
|
||||
## Installation
|
||||
|
||||
See the [download page](index-3.11.html).
|
||||
|
||||
## What's new
|
||||
|
||||
From this release, the binary GF core packages do not contain the RGL.
|
||||
The RGL's release cycle is now completely separate from GF's. See [RGL releases](https://github.com/GrammaticalFramework/gf-rgl/releases).
|
||||
|
||||
Over 400 changes have been pushed to GF core
|
||||
since the release of GF 3.10 in December 2018.
|
||||
|
||||
## General
|
||||
|
||||
- Make the test suite work again.
|
||||
- Compatibility with new versions of GHC, including multiple Stack files for the different versions.
|
||||
- Updates to build scripts and CI.
|
||||
- Bug fixes.
|
||||
|
||||
## GF compiler and run-time library
|
||||
|
||||
- Huge improvements in time & space requirements for grammar compilation (pending [#87](https://github.com/GrammaticalFramework/gf-core/pull/87)).
|
||||
- Add CoNLL output to `visualize_tree` shell command.
|
||||
- Add canonical GF as output format in the compiler.
|
||||
- Add PGF JSON as output format in the compiler.
|
||||
- Deprecate JavaScript runtime in favour of updated [TypeScript runtime](https://github.com/GrammaticalFramework/gf-typescript).
|
||||
- Improvements to Haskell export.
|
||||
- Improvements to the C runtime.
|
||||
- Improvements to `gf -server` mode.
|
||||
- Clearer compiler error messages.
|
||||
|
||||
## Other
|
||||
|
||||
- Web page and documentation improvements.
|
||||
- Add WordNet module to GFSE.
|
||||
@@ -1,6 +1,9 @@
|
||||
GF Version 3.2 Release Notes
|
||||
December 2010
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <H1> <H1><IMG src="../doc/Logos/gf0.png">
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -31,3 +34,8 @@ See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
|
||||
- GF compiler: GPL
|
||||
- Run-time libraries and Resource Grammar Library: LGPL + BSD
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF Version 3.3.3 Release Notes
|
||||
March 2012
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><IMG src="../doc/Logos/gf0.png">
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -21,3 +25,8 @@ See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
- Fix for a bug that prevented the shell commands ``abstract_info``,
|
||||
``generate_random`` and ``generate_trees`` from working properly.
|
||||
- Various other small improvements and bug fixes.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,13 +1,17 @@
|
||||
GF Version 3.3 Release Notes
|
||||
October 2011
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta name = "viewport" content = "width = device-width"><TITLE>
|
||||
%!postproc(html): <H1> <H1><IMG src="../doc/Logos/gf0.png">
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
|
||||
==New features==
|
||||
|
||||
- Source language extension: it is now possible to override the oper definitions in an interface, by using the
|
||||
- Source language extension: it is now possible to override the oper definitions in an interface, by using the
|
||||
header syntax ``instance Foo of Bar - [f,g,h]``.
|
||||
- New functionalities in GF shell commands (more information with ``help`` command-name).
|
||||
- ``aw`` = ``align_words`` option ``-giza`` prints word alignments in Giza++ format.
|
||||
@@ -25,3 +29,8 @@ See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
and the web-based grammar editor.
|
||||
- Faster grammar compilation (also included in the GF 3.2.9 source-only
|
||||
snapshot).
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF Version 3.4 Release Notes
|
||||
January 2013
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -42,3 +46,8 @@ See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
- Some new functionality in the web-based grammar editor, e.g. preliminary
|
||||
support for public grammars.
|
||||
- Various other small improvements and bug fixes.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.5 Release Notes
|
||||
August 2013
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -66,3 +70,7 @@ of GF 3.4.
|
||||
[``network-2.4.1.1`` https://github.com/haskell/network/commit/f2168b1f8978b4ad9c504e545755f0795ac869ce].
|
||||
- Various other small improvements and bug fixes.
|
||||
%- [...]
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.6 Release Notes
|
||||
June 2014
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -22,7 +26,7 @@ Closed [issues http://code.google.com/p/grammatical-framework/issues/list]:
|
||||
as ``--# -coding=``//enc//, instead of ``flags coding=``//enc//.
|
||||
See the separate document
|
||||
[GF character encoding changes encoding-change.html] for more details.
|
||||
- Record update: in record objects (but not types) of form ``r ** s``, the values assigned
|
||||
- Record update: in record objects (but not types) of form ``r ** s``, the values assigned
|
||||
in ``s`` now overwrite those in ``r``. In previous versions, record extensions with
|
||||
overlapping assignments in ``r`` and ``s`` were not supported, and their behaviour was
|
||||
unpredictable.
|
||||
@@ -103,3 +107,8 @@ Closed [issues http://code.google.com/p/grammatical-framework/issues/list]:
|
||||
- ``c-wordforword``: this works as ``c-translate`` but does a
|
||||
word-for-word lookup to create a (potentially very low quality)
|
||||
translation that can be used if all else fails.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.7.1 Release Notes
|
||||
October 2015
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -14,10 +18,10 @@ Over 170 changes have been pushed to the source repository since
|
||||
|
||||
====New features and notable changes====
|
||||
|
||||
- GF shell: ``cc -trace`` (preliminary): you can now do things like
|
||||
|
||||
- GF shell: ``cc -trace`` (preliminary): you can now do things like
|
||||
|
||||
``cc -trace mkV "debug"``
|
||||
|
||||
|
||||
to see a trace of all opers with their arguments and results during the
|
||||
computation of ``mkV "debug"``.
|
||||
|
||||
@@ -25,7 +29,7 @@ Over 170 changes have been pushed to the source repository since
|
||||
from the GF shell by starting GF with ``gf -cshell`` or ``gf -crun``.
|
||||
Only limited functionality is available when running the shell in these
|
||||
modes (use the ``help`` command in the shell for details):
|
||||
|
||||
|
||||
- You can only import ``.pgf`` files, not source files.
|
||||
- The ``-retain`` flag can not be used and the commands that require it to
|
||||
work are not available.
|
||||
@@ -73,3 +77,8 @@ Over 170 changes have been pushed to the source repository since
|
||||
you can leave ``&+`` uninterpreted instead of gluing the adjacent tokens.
|
||||
This means that the output is left in a format that can be parsed in
|
||||
a subsequent request.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.7 Release Notes
|
||||
June 2015
|
||||
|
||||
%!style:../css/style.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -36,7 +40,7 @@ Over 800 changes have been pushed to the source repository since
|
||||
``BIND``, ``SOFT_BIND``, ``SOFT_SPACE``, ``CAPIT``, ``ALL_CAPIT`` and
|
||||
``nonExist``.
|
||||
- It is now possible to define callbacks for literals from the Haskell
|
||||
binding to the C runtime. This is used for instance in
|
||||
binding to the C runtime. This is used for instance in
|
||||
the Wide Coverage translator on the Web.
|
||||
|
||||
|
||||
@@ -99,3 +103,8 @@ Over 800 changes have been pushed to the source repository since
|
||||
unused for 24 hours, to keep memory use down in long running servers.
|
||||
- PGF service: limit the number of parallel calls to the C run-time parse
|
||||
function to 4 by default. The limit can be changed with the ``-j`` flag.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.8 Release Notes
|
||||
June 2016
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -21,7 +25,7 @@ Roughly 400 changes have been pushed to the source repository since
|
||||
[universal dependency http://universaldependencies.org/] diagrams
|
||||
in various formats, see ``help vd``.
|
||||
- The C runtime now includes an experimental library for managing
|
||||
and querying ontologies built on top of the abstract syntax of
|
||||
and querying ontologies built on top of the abstract syntax of
|
||||
a grammar. Since the ontology is based on an abstract syntax,
|
||||
it is language independent by design. For now the library is
|
||||
only used in the GF Offline Translator. The library uses
|
||||
@@ -96,3 +100,7 @@ Roughly 400 changes have been pushed to the source repository since
|
||||
translations in the domain they cover.
|
||||
You can change the order in which the selected grammars are tried
|
||||
by dragging them up and down in the list.
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
@@ -1,6 +1,10 @@
|
||||
GF 3.9 Release Notes
|
||||
August 2017
|
||||
|
||||
%!style:../css/notes.css
|
||||
%!postproc(html): <TITLE> <meta charset="UTF-8"><meta name = "viewport" content = "width = device-width"> <TITLE>
|
||||
%!postproc(html): <H1> <H1><a href="../"><IMG src="../doc/Logos/gf0.png"></a>
|
||||
|
||||
==Installation==
|
||||
|
||||
See the [download page http://www.grammaticalframework.org/download/index.html].
|
||||
@@ -32,7 +36,7 @@ very innefficient for some grammars.
|
||||
|
||||
- A new .NET binding for the GF runtime is available.
|
||||
|
||||
- The API in the Java binding is extended and it covers more from
|
||||
- The API in the Java binding is extended and it covers more from
|
||||
the full functionality of the C runtime.
|
||||
|
||||
|
||||
@@ -62,3 +66,8 @@ the full functionality of the C runtime.
|
||||
|
||||
- PGF service: support for language-specific depencency configurations in
|
||||
``command=deptree``.
|
||||
|
||||
|
||||
--------------------
|
||||
|
||||
[www.grammaticalframework.org http://www.grammaticalframework.org]
|
||||
|
||||
BIN
favicon.ico
BIN
favicon.ico
Binary file not shown.
|
Before Width: | Height: | Size: 15 KiB |
59
gf.cabal
59
gf.cabal
@@ -1,5 +1,5 @@
|
||||
name: gf
|
||||
version: 3.10.4-git
|
||||
version: 3.9-git
|
||||
|
||||
cabal-version: >= 1.22
|
||||
build-type: Custom
|
||||
@@ -11,10 +11,9 @@ description: GF, Grammatical Framework, is a programming language for multilingu
|
||||
homepage: http://www.grammaticalframework.org/
|
||||
bug-reports: https://github.com/GrammaticalFramework/gf-core/issues
|
||||
maintainer: Thomas Hallgren
|
||||
tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||
tested-with: GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2
|
||||
|
||||
data-dir: src
|
||||
extra-source-files: WebSetup.hs
|
||||
data-files:
|
||||
www/*.html
|
||||
www/*.css
|
||||
@@ -43,7 +42,7 @@ data-files:
|
||||
custom-setup
|
||||
setup-depends:
|
||||
base,
|
||||
Cabal >=1.22.0.0,
|
||||
Cabal >=1.4.0.0,
|
||||
directory,
|
||||
filepath,
|
||||
process >=1.0.1.1
|
||||
@@ -68,11 +67,16 @@ flag network-uri
|
||||
-- Description: Make -new-comp the default
|
||||
-- Default: True
|
||||
|
||||
flag custom-binary
|
||||
Description: Use a customised version of the binary package
|
||||
Default: True
|
||||
Manual: True
|
||||
|
||||
flag c-runtime
|
||||
Description: Include functionality from the C run-time library (which must be installed already)
|
||||
Default: False
|
||||
|
||||
library
|
||||
Library
|
||||
default-language: Haskell2010
|
||||
build-depends: base >= 4.6 && <5,
|
||||
array,
|
||||
@@ -82,27 +86,26 @@ library
|
||||
random,
|
||||
pretty,
|
||||
mtl,
|
||||
exceptions,
|
||||
fail,
|
||||
-- For compatability with ghc < 8
|
||||
-- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant.
|
||||
transformers-compat,
|
||||
ghc-prim
|
||||
exceptions
|
||||
hs-source-dirs: src/runtime/haskell
|
||||
|
||||
other-modules:
|
||||
-- not really part of GF but I have changed the original binary library
|
||||
-- and we have to keep the copy for now.
|
||||
Data.Binary
|
||||
Data.Binary.Put
|
||||
Data.Binary.Get
|
||||
Data.Binary.Builder
|
||||
Data.Binary.IEEE754
|
||||
if flag(custom-binary)
|
||||
other-modules:
|
||||
-- not really part of GF but I have changed the original binary library
|
||||
-- and we have to keep the copy for now.
|
||||
Data.Binary
|
||||
Data.Binary.Put
|
||||
Data.Binary.Get
|
||||
Data.Binary.Builder
|
||||
Data.Binary.IEEE754
|
||||
else
|
||||
build-depends: binary, data-binary-ieee754
|
||||
|
||||
--ghc-options: -fwarn-unused-imports
|
||||
--if impl(ghc>=7.8)
|
||||
-- ghc-options: +RTS -A20M -RTS
|
||||
ghc-prof-options: -fprof-auto
|
||||
extensions:
|
||||
|
||||
exposed-modules:
|
||||
PGF
|
||||
@@ -146,8 +149,8 @@ library
|
||||
|
||||
---- GF compiler as a library:
|
||||
|
||||
build-depends: filepath, directory>=1.2, time,
|
||||
process, haskeline, parallel>=3, json
|
||||
build-depends: filepath, directory, time, time-compat, old-locale,
|
||||
process, haskeline, parallel>=3
|
||||
|
||||
hs-source-dirs: src/compiler
|
||||
exposed-modules:
|
||||
@@ -155,7 +158,6 @@ library
|
||||
GF.Support
|
||||
GF.Text.Pretty
|
||||
GF.Text.Lexing
|
||||
GF.Grammar.Canonical
|
||||
|
||||
other-modules:
|
||||
GF.Main GF.Compiler GF.Interactive
|
||||
@@ -178,7 +180,9 @@ library
|
||||
GF.Command.TreeOperations
|
||||
GF.Compile.CFGtoPGF
|
||||
GF.Compile.CheckGrammar
|
||||
GF.Compile.Compute.Concrete
|
||||
GF.Compile.Compute.AppPredefined
|
||||
GF.Compile.Compute.ConcreteNew
|
||||
-- GF.Compile.Compute.ConcreteNew1
|
||||
GF.Compile.Compute.Predef
|
||||
GF.Compile.Compute.Value
|
||||
GF.Compile.ExampleBased
|
||||
@@ -192,10 +196,7 @@ library
|
||||
GF.Compile.PGFtoJava
|
||||
GF.Haskell
|
||||
GF.Compile.ConcreteToHaskell
|
||||
GF.Compile.GrammarToCanonical
|
||||
GF.Grammar.CanonicalJSON
|
||||
GF.Compile.PGFtoJS
|
||||
GF.Compile.PGFtoJSON
|
||||
GF.Compile.PGFtoProlog
|
||||
GF.Compile.PGFtoPython
|
||||
GF.Compile.ReadFiles
|
||||
@@ -207,6 +208,7 @@ library
|
||||
GF.Compile.TypeCheck.Concrete
|
||||
GF.Compile.TypeCheck.ConcreteNew
|
||||
GF.Compile.TypeCheck.Primitives
|
||||
GF.Compile.TypeCheck.RConcrete
|
||||
GF.Compile.TypeCheck.TC
|
||||
GF.Compile.Update
|
||||
GF.Data.BacktrackM
|
||||
@@ -273,7 +275,7 @@ library
|
||||
cpp-options: -DC_RUNTIME
|
||||
|
||||
if flag(server)
|
||||
build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7,
|
||||
build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7, json,
|
||||
cgi>=3001.2.2.0
|
||||
if flag(network-uri)
|
||||
build-depends: network-uri>=2.6, network>=2.6
|
||||
@@ -319,7 +321,7 @@ library
|
||||
if impl(ghc>=8.2)
|
||||
ghc-options: -fhide-source-paths
|
||||
|
||||
executable gf
|
||||
Executable gf
|
||||
hs-source-dirs: src/programs
|
||||
main-is: gf-main.hs
|
||||
default-language: Haskell2010
|
||||
@@ -352,5 +354,4 @@ test-suite gf-tests
|
||||
main-is: run.hs
|
||||
hs-source-dirs: testsuite
|
||||
build-depends: base>=4.3 && <5, Cabal>=1.8, directory, filepath, process
|
||||
build-tool-depends: gf:gf
|
||||
default-language: Haskell2010
|
||||
|
||||
733
index.html
733
index.html
@@ -1,414 +1,418 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<!DOCTYPE html>
|
||||
<HTML>
|
||||
<HEAD>
|
||||
<TITLE>GF - Grammatical Framework</TITLE>
|
||||
<meta charset="UTF-8">
|
||||
<link rel="stylesheet" href="css/newstyle.css" title="GF">
|
||||
<link rel="alternate" href="https://github.com/GrammaticalFramework/gf-core/" title="GF GitHub repository">
|
||||
<meta name = "viewport" content = "width = device-width">
|
||||
<script type="text/javascript">
|
||||
function sitesearch() {
|
||||
var q=document.forms[0].q.value;
|
||||
var site=" site:www.grammaticalframework.org";
|
||||
var search=encodeURIComponent(q+site)
|
||||
document.location.href="http://www.google.com/search?q="+search
|
||||
return false;
|
||||
}
|
||||
</script>
|
||||
<meta name="keywords" content="machine translation">
|
||||
</HEAD>
|
||||
|
||||
<title>GF - Grammatical Framework</title>
|
||||
<meta name="keywords" content="machine translation">
|
||||
<body class=new>
|
||||
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
|
||||
<link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">
|
||||
<link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">
|
||||
|
||||
<link rel="alternate" href="https://github.com/GrammaticalFramework/gf-core/" title="GF GitHub repository">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div class="container-fluid my-5" style="max-width:1200px">
|
||||
|
||||
<div class="text-center">
|
||||
<img style="height:250px" src="doc/Logos/gf1.svg" alt="GF Logo">
|
||||
<h1 class="display-4" style="text-shadow: 1px 1px 5px #999;">Grammatical Framework</h1>
|
||||
<h4 class="text-black-50">A programming language for multilingual grammar applications</h4>
|
||||
<div class="header sky blue">
|
||||
<img class="gflogo" src="doc/Logos/gf1.svg" alt="">
|
||||
<H1>Grammatical Framework</H1>
|
||||
<small class=tagline>A programming language for multilingual grammar applications</small>
|
||||
</div>
|
||||
|
||||
<div class="row mt-4">
|
||||
<div class=menu>
|
||||
|
||||
<div class="col-sm-6 col-md-3 mb-4">
|
||||
<h3>Get started</h3>
|
||||
<ul class="mb-2">
|
||||
<li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>
|
||||
<li>
|
||||
<a href="//cloud.grammaticalframework.org/">
|
||||
GF Cloud
|
||||
<img src="src/www/P/gf-cloud.png" style="height:30px" class="ml-2" alt="Cloud logo">
|
||||
</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="doc/tutorial/gf-tutorial.html">Tutorial</a>
|
||||
/
|
||||
<a href="lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
|
||||
</li>
|
||||
<li><a href="doc/gf-video-tutorials.html">Video Tutorials</a></li>
|
||||
</ul>
|
||||
<div class=links>
|
||||
<h4>Use GF</h4>
|
||||
<ul>
|
||||
<li><a href="http://cloud.grammaticalframework.org/">GF Cloud<img class=right src="src/www/P/gf-cloud.png" alt="GF Cloud Service" title="GF Cloud Service"></a>
|
||||
<li><A HREF="demos/index.html">Other Demos</A>
|
||||
</ul>
|
||||
<ul>
|
||||
<li><A HREF="http://www.grammaticalframework.org/download/index.html"><b>Download GF</b></A>
|
||||
<li><a href="doc/gf-editor-modes.html">GF Editor Modes</a>
|
||||
</ul>
|
||||
|
||||
<a href="download/index.html" class="btn btn-primary ml-3">
|
||||
<i class="fas fa-download mr-1"></i>
|
||||
Download GF
|
||||
</a>
|
||||
</div>
|
||||
<ul>
|
||||
<li><A HREF="http://groups.google.com/group/gf-dev">User Group</A>
|
||||
<li><a href="https://github.com/GrammaticalFramework/gf-core/issues">Bug Reports</a>
|
||||
(<a href="http://code.google.com/p/grammatical-framework/issues/list">old</a>)
|
||||
</ul>
|
||||
</div>
|
||||
|
||||
<div class="col-sm-6 col-md-3 mb-4">
|
||||
<h3>Learn more</h3>
|
||||
<div class=links>
|
||||
<h4>Learn GF</h4>
|
||||
<ul>
|
||||
<li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a>
|
||||
<li><A HREF="doc/gf-quickstart.html">QuickStart</A>
|
||||
<li><A HREF="doc/gf-reference.html">QuickRefCard</A>
|
||||
<li><A HREF="doc/gf-shell-reference.html">GF Shell Reference</A>
|
||||
<li><a href="http://school.grammaticalframework.org/"><b>GF Summer School</b></a>
|
||||
</ul>
|
||||
<ul>
|
||||
<li><A HREF="gf-book">The GF Book</A>
|
||||
<li><A HREF="doc/tutorial/gf-tutorial.html">GF Tutorial</A>
|
||||
<li><A HREF="doc/gf-refman.html">Reference Manual</A>
|
||||
<li><A HREF="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</A> <small>[PDF]</small>
|
||||
</ul>
|
||||
<ul>
|
||||
<li><A HREF="lib/doc/synopsis.html">Library Synopsis</A>
|
||||
<li><A HREF="doc/gf-lrec-2010.pdf">Library Tutorial</A> <small>[PDF]</small>
|
||||
<li><A HREF="http://www.postcrashgames.com/gf_world/">Coverage Map</A>
|
||||
</ul>
|
||||
|
||||
<ul class="mb-2">
|
||||
<li><a href="gf-book">The GF Book</a></li>
|
||||
<li><a href="doc/gf-refman.html">Reference Manual</a></li>
|
||||
<li><a href="doc/gf-shell-reference.html">Shell Reference</a></li>
|
||||
<li><a href="http://www.molto-project.eu/sites/default/files/MOLTO_D2.3.pdf">Best Practices</a> <small>[PDF]</small></li>
|
||||
<li><a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Scaling Up (Computational Linguistics 2020)</a></li>
|
||||
</ul>
|
||||
</div>
|
||||
<div class=links>
|
||||
<h4>Develop GF</h4>
|
||||
<ul>
|
||||
<li><a href="doc/gf-developers.html">GF Developers Guide</a>
|
||||
<li><A HREF="https://github.com/GrammaticalFramework/">GF on GitHub</A>
|
||||
<li><a href="/~hallgren/gf-experiment/browse/">Browse Source Code</a>
|
||||
<li><A HREF="doc/gf-people.html">Authors</A>
|
||||
</ul>
|
||||
<h4>Develop Applications</h4>
|
||||
<ul>
|
||||
<li><a href="http://hackage.haskell.org/package/gf-3.9/docs/PGF.html">PGF library API (Old Runtime)</a>
|
||||
<li><a href="doc/runtime-api.html">PGF library API (New Runtime)</a>
|
||||
<li><a href="src/ui/android/README">GF on Android (new)</a>
|
||||
<li><A HREF="/android/">GF on Android (old) </A>
|
||||
</ul>
|
||||
</div>
|
||||
<div class=links>
|
||||
<h4>Related to GF</h4>
|
||||
<ul>
|
||||
<li><A HREF="doc/gf-bibliography.html">Publications</A>
|
||||
<li><A HREF="http://remu.grammaticalframework.org/">The REMU Project</A>
|
||||
<li><A HREF="http://www.molto-project.eu">The MOLTO Project</A>
|
||||
<li><a href="http://en.wikipedia.org/wiki/Grammatical_Framework">GF on Wikipedia</a>
|
||||
<li><p><a href="Http://www.digitalgrammars.com/">Digital Grammars AB</a>
|
||||
</ul>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<a href="lib/doc/synopsis/index.html" class="btn btn-primary ml-3">
|
||||
<i class="fab fa-readme mr-1"></i>
|
||||
RGL Synopsis
|
||||
</a>
|
||||
</div>
|
||||
|
||||
<div class="col-sm-6 col-md-3 mb-4">
|
||||
<h3>Develop</h3>
|
||||
<ul class="mb-2">
|
||||
<li><a href="doc/gf-developers.html">Developers Guide</a></li>
|
||||
<!-- <li><a href="/~hallgren/gf-experiment/browse/">Browse Source Code</a></li> -->
|
||||
<li>PGF library API:<br>
|
||||
<a href="http://hackage.haskell.org/package/gf/docs/PGF.html">Haskell</a> /
|
||||
<a href="doc/runtime-api.html">C runtime</a>
|
||||
</li>
|
||||
<li><a href="http://hackage.haskell.org/package/gf/docs/GF.html">GF compiler API</a></li>
|
||||
<!-- <li><a href="src/ui/android/README">GF on Android (new)</a></li>
|
||||
<li><a href="/android/">GF on Android (old) </a></li> -->
|
||||
<li><a href="doc/gf-editor-modes.html">Text Editor Support</a></li>
|
||||
<li><a href="http://www.grammaticalframework.org/~john/rgl-browser/">RGL source browser</a></li>
|
||||
</ul>
|
||||
</div>
|
||||
<script type="text/javascript">
|
||||
document.write('<div style="float: right; margin-top: 3ex;"> <form onsubmit="return sitesearch()" method=get action="http://www.google.com/search"> <input type=search name="q" placeholder="site search"> <input type=submit value="Search"> </form></div>')
|
||||
</script>
|
||||
|
||||
<div class="col-sm-6 col-md-3 mb-4">
|
||||
<h3>Contribute</h3>
|
||||
<ul class="mb-2">
|
||||
<li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>
|
||||
<li><a href="https://github.com/GrammaticalFramework/gf-core/issues">Issue Tracker</a></li>
|
||||
<li><a href="doc/gf-people.html">Authors</a></li>
|
||||
<li><a href="//school.grammaticalframework.org/2020/">Summer School</a></li>
|
||||
</ul>
|
||||
<a href="https://github.com/GrammaticalFramework/" class="btn btn-primary ml-3">
|
||||
<i class="fab fa-github mr-1"></i>
|
||||
GF on GitHub
|
||||
</a>
|
||||
</div>
|
||||
<H2 class=noclear>News</H2>
|
||||
|
||||
<div class=news2>
|
||||
|
||||
<table class=news>
|
||||
<tr><td>2018-07-25:<td>The GF repository has been split in two:
|
||||
<a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and
|
||||
<a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.
|
||||
The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.
|
||||
<tr><td>2017-08-11:<td><strong>GF 3.9 released!</strong>
|
||||
<a href="download/release-3.9.html">Release notes</a>.
|
||||
<tr><td>2017-06-29:<td>GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>!
|
||||
<tr><td>2017-03-13:<td><strong>GF Summer School in Riga (Latvia), 14-25 August 2017</strong>
|
||||
<a href="http://school.grammaticalframework.org/2017/">Summer
|
||||
School web page</a>.
|
||||
<tr><td>2016-09-07:<td><strong>Google Tech Talk on GF</strong> <a
|
||||
href="https://www.youtube.com/watch?v=x1LFbDQhbso">on Youtube</a>.
|
||||
<tr><td>2016-07-05:<td>GitHub mirror temporarily not updated, due to server migration.
|
||||
<tr><td>2016-06-22:<td><strong>GF 3.8 released!</strong>
|
||||
<a href="download/release-3.8.html">Release notes</a>.
|
||||
<tr><td>2015-06-21:<td><strong>Summer School in Rule-Based Machine
|
||||
Translation in Alacant/Alicante (Spain), 11-21 July 2016</strong>
|
||||
featuring GF, Apertium, Matxin, and TectoMT.
|
||||
<a href="http://xixona.dlsi.ua.es/rbmt-summer-school/2016/">Summer
|
||||
School web page</a>.
|
||||
<tr><td>2016-06-14:<td>New resource grammar language: Nynorsk.
|
||||
<tr><td>2015-10-02:<td><strong>GF 3.7.1 released!</strong>
|
||||
<a href="download/release-3.7.1.html">Release notes</a>.
|
||||
<tr><td>2015-06-25:<td><strong>GF 3.7 released!</strong>
|
||||
<a href="download/release-3.7.html">Release notes</a>.
|
||||
<tr><td>2015-03-13:<td>New resource grammar language: Mongolian.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2015-02-09:<td><strong>GF Summer School in Gozo (Malta), 13-24 July 2015</strong>
|
||||
<a href="http://school.grammaticalframework.org/2015/">Summer
|
||||
School web page</a>.
|
||||
<tr><td>2014-06-23:<td><strong>GF 3.6 released!</strong>
|
||||
<a href="download/release-3.6.html">Release notes</a>.
|
||||
<tr><td>2014-03-11:
|
||||
<td>A company for commercial applications of GF has been founded:
|
||||
<a href="http://www.digitalgrammars.com/">Digital Grammars</a>.
|
||||
<tr><td>2013-11-25:
|
||||
<td>The default character encoding in GF grammar files will be changed
|
||||
from Latin-1 to UTF-8. See
|
||||
<a href="download/encoding-change.html">GF character encoding changes</a>
|
||||
for details.
|
||||
<tr><td>2013-10-18:<td>New resource grammar language: Estonian.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2013-09-18:<td>New <a href="https://github.com/GrammaticalFramework/gf-contrib">GF contributions repository</a>, hosted on GitHub.
|
||||
<tr><td>2013-08-06:<td><strong>GF 3.5 released!</strong>
|
||||
<a href="download/release-3.5.html">Release notes</a>.
|
||||
<tr><td>2013-07-26:<td>Started a page with <A HREF="lib/doc/rgl-publications.html">RGL Documentation and Publications</A>.
|
||||
<tr><td>2013-06-24:<td>We are now running the IRC channel <a href="https://webchat.freenode.net/?channels=gf"><strong><code>#gf</code></strong></a> on the Freenode network.
|
||||
<tr><td>2013-06-19:<td>New resource grammar language: Maltese.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2013-04-25:<td>New resource grammar language: Greek.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2013-01-31:<td><strong>GF 3.4 released!</strong>
|
||||
<a href="download/release-3.4.html">Release notes</a>.
|
||||
<tr><td>2012-12-10:<td>
|
||||
<a href="http://www.postcrashgames.com/gf_world/">Resource Grammar Library
|
||||
coverage map</a>, created by Tommi Nieminen.
|
||||
<!--
|
||||
<tr><td>2012-11-18:<td>
|
||||
<A HREF="http://school.grammaticalframework.org/2013">GF Summer School</A>
|
||||
in Frauenchiemsee, 18-30 August 2013.
|
||||
<tr><td>2012-11-18:<td>New resource grammar language: Chinese.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
Complete but not yet perfect.
|
||||
<tr><td>2012-06-29:<td>GF sources now mirrored in GitHub, with change
|
||||
statistics and other browsing features.
|
||||
See <a href="https://github.com/GrammaticalFramework/GF/"><tt>github.com/GrammaticalFramework/GF</tt></a>
|
||||
<tr><td>2012-05-07:<td>New resource grammar language: Japanese.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2012-03-23:<td>There will be a
|
||||
<a href="gf-tutorial-icfp-2012/">GF tutorial at ICFP 2012</a>
|
||||
in Copenhagen.
|
||||
<tr><td>2012-03-03:<td><strong>GF 3.3.3 released!</strong>
|
||||
<a href="download/release-3.3.3.html">Release notes</a>.
|
||||
<tr><td>2012-02-24:<td>New resource grammar languages: Hindi, Sindhi.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2011-12-29:<td>New resource grammar languages: Latvian, Thai.
|
||||
See <a href="lib/doc/synopsis.html">library synopsis</a>.
|
||||
<tr><td>2011-10-27:<td><strong>GF 3.3 released!</strong>
|
||||
<a href="download/release-3.3.html">Release notes</a>.
|
||||
<tr><td>2011-09-20:<td>There is now a page collecting
|
||||
<a href="doc/gf-editor-modes.html">editor modes for GF</a>.
|
||||
Contributions are welcome!
|
||||
<tr><td>2011-09-12:<td><strong>GF 3.2.9</strong> source snapshot with faster grammar compilation available. See <a href="download/index.html">Downloads</a>.
|
||||
<tr><td>2011-04-22:<td><a href="android/tutorial/">JPGF Android Tutorial</a> added.
|
||||
<tr><td>2011-04-15:<td>The <a href="gf-book">GF Book</a> is available.
|
||||
<tr><td>2011-01-13:<td><a href="http://www.molto-project.eu/node/1177">Phrasedroid
|
||||
available on the Android Market</a>.
|
||||
<tr><td>2011-01-04:<td>GF is part of the
|
||||
<a href="http://www.clt.gu.se/clt-toolkit">CLT Toolkit</a>.
|
||||
<tr><td>2010-12-23:<td><strong>GF 3.2 released!</strong>
|
||||
<a href="download/release-3.2.html">Release notes</a>.
|
||||
-->
|
||||
</table>
|
||||
|
||||
</div>
|
||||
|
||||
<h2>What is GF?</h2>
|
||||
<p>
|
||||
<H2>What is GF</H2>
|
||||
<P>
|
||||
GF, Grammatical Framework, is a programming language for
|
||||
<strong>multilingual grammar applications</strong>. It is
|
||||
</p>
|
||||
<ul>
|
||||
<li>a <strong>special-purpose language for grammars</strong>, like
|
||||
<B>multilingual grammar applications</B>. It is
|
||||
</P>
|
||||
<UL>
|
||||
<LI>a <B>special-purpose language for grammars</B>, like
|
||||
<a href="http://dinosaur.compilertools.net/yacc/">YACC</a>,
|
||||
<a href="http://www.gnu.org/software/bison/">Bison</a>,
|
||||
<a href="http://www.haskell.org/happy/">Happy</a>,
|
||||
<a href="http://bnfc.digitalgrammars.com/">BNFC</a>,
|
||||
but not restricted to programming languages
|
||||
</li>
|
||||
<li>a <strong>functional programming language</strong>, like
|
||||
<LI>a <B>functional programming language</B>, like
|
||||
<a href="http://www.haskell.org/">Haskell</a>,
|
||||
<a href="http://en.wikipedia.org/wiki/Lisp_(programming_language)">Lisp</a>,
|
||||
<a href="http://ocaml.org/">OCaml</a>,
|
||||
<a href="http://www.smlnj.org/">SML</a>,
|
||||
<a href="http://schemers.org/">Scheme</a>,
|
||||
but specialized to grammar writing
|
||||
</li>
|
||||
<li>a <strong>development platform for natural language grammars</strong>, like
|
||||
<LI>a <B>development platform for natural language grammars</B>, like
|
||||
<a href="http://moin.delph-in.net/LkbTop">LKB</a>,
|
||||
<a href="http://www2.parc.com/isl/groups/nltt/xle/">XLE</a>,
|
||||
<a href="http://www.issco.unige.ch/en/research/projects/regulus/news.shtml">Regulus</a>,
|
||||
but based on functional programming and type theory
|
||||
</li>
|
||||
<li>a <strong>categorial grammar formalism</strong>, like
|
||||
<LI>a <B>categorial grammar formalism</B>, like
|
||||
<a href="http://www.loria.fr/equipes/calligramme/acg/">ACG</a>,
|
||||
<a href="http://openccg.sourceforge.net/">CCG</a>,
|
||||
but specialized for multilingual grammars,
|
||||
</li>
|
||||
<li>a <strong>logical framework</strong>, like
|
||||
<LI>a <B>logical framework</B>, like
|
||||
<a href="http://wiki.portal.chalmers.se/agda/pmwiki.php">Agda</a>,
|
||||
<a href="http://coq.inria.fr/">Coq</a>,
|
||||
<a href="http://www.cl.cam.ac.uk/research/hvg/Isabelle/">Isabelle</a>,
|
||||
but equipped with concrete syntax in addition to logic
|
||||
</li>
|
||||
<li>a <strong>platform for machine translation</strong>, like
|
||||
<li>a <b>platform for machine translation</b>, like
|
||||
<a href="http://www.statmt.org/moses/">Moses</a>,
|
||||
<a href="http://www.apertium.org/">Apertium</a>,
|
||||
but based on deep structural analysis (and usually applied for
|
||||
limited fragments of language).
|
||||
</li>
|
||||
</ul>
|
||||
</UL>
|
||||
|
||||
<p>
|
||||
<P>
|
||||
Don't worry if you don't know most of the references above - but if you do know at
|
||||
least one, it may help you to get a first idea of what GF is.
|
||||
</P>
|
||||
<H2>Applications</H2>
|
||||
<P>
|
||||
GF can be used for building
|
||||
</P>
|
||||
<UL>
|
||||
<LI><A HREF="http://cloud.grammaticalframework.org/translator/">translation systems</A>
|
||||
<LI><A HREF="http://cloud.grammaticalframework.org/minibar/minibar.html">multilingual web gadgets</A>
|
||||
<LI><A HREF="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">natural-language interfaces</A>
|
||||
<LI><A HREF="http://www.youtube.com/watch?v=1bfaYHWS6zU">dialogue systems</A>
|
||||
<LI><A HREF="lib/doc/synopsis.html">natural language resources</A>
|
||||
</UL>
|
||||
|
||||
<H2>Availability</H2>
|
||||
<P>
|
||||
GF is <B>open-source</B>, licensed under <A HREF="LICENSE">GPL</A> (the program) and
|
||||
<A HREF="./LICENSE">LGPL</A> and <A HREF="./LICENSE">BSD</A> (the libraries). It
|
||||
is available for
|
||||
</P>
|
||||
<UL>
|
||||
<LI>Linux
|
||||
<LI>Mac OS X
|
||||
<LI>Windows
|
||||
<li>Android mobile platform (via Java; runtime)
|
||||
<LI>via compilation to JavaScript, almost any platform that has a web browser (runtime)
|
||||
</UL>
|
||||
|
||||
<H2>Projects</H2>
|
||||
<P>
|
||||
GF was first created in 1998 at
|
||||
<A HREF="http://www.xrce.xerox.com/">Xerox Research Centre Europe</A>,
|
||||
Grenoble, in the project
|
||||
Multilingual Document Authoring. At Xerox, it was used for prototypes including
|
||||
a restaurant phrase book,
|
||||
a database query system,
|
||||
a formalization of an alarm system instructions with translations to 5 languages, and
|
||||
an authoring system for medical drug descriptions.
|
||||
</P>
|
||||
<P>
|
||||
Later projects using GF and involving third parties include, in chronological order,
|
||||
</P>
|
||||
<UL>
|
||||
<LI><A HREF="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">GF-Alfa</A>:
|
||||
natural language interface to formal proofs
|
||||
<LI><A HREF="http://efficient.citi.tudor.lu/index_noframe.html">Efficient</A>:
|
||||
authoring tool for business models.
|
||||
<LI><A HREF="http://www.key-project.org/">GF-KeY</A>:
|
||||
authoring and translation of software specifications
|
||||
<LI><A HREF="http://www.talk-project.org">TALK</A>:
|
||||
multilingual and multimodal spoken dialogue systems
|
||||
<LI><A HREF="http://webalt.math.helsinki.fi/">WebALT</A>:
|
||||
multilingual generation of mathematical exercises (commercial project)
|
||||
<LI><A HREF="http://spraakbanken.gu.se/sal/">SALDO</A>:
|
||||
Swedish morphological dictionary based on rules developed for GF and
|
||||
<A HREF="http://www.cse.chalmers.se/alumni/markus/FM/">Functional Morphology</A>
|
||||
<LI><a href="http://www.molto-project.eu">MOLTO</a>:
|
||||
multilingual online translation
|
||||
<LI><a href="http://remu.grammaticalframework.org">REMU</a>:
|
||||
reliable multilingual digital communication.
|
||||
</UL>
|
||||
<p>
|
||||
Here is a <a
|
||||
href="http://videos.xrce.xerox.com/index.php/videos/index/618">talk
|
||||
about GF at XRCE</a>,
|
||||
14 years later.
|
||||
|
||||
<P>
|
||||
Academically, GF has been used in at least ten PhD theses and resulted
|
||||
in more than a hundred
|
||||
scientific publications (see <A HREF="doc/gf-bibliography.html">GF publication list</A>).
|
||||
</P>
|
||||
<H2>Programming in GF</H2>
|
||||
<P>
|
||||
GF is easy to learn by following the <A HREF="doc/tutorial/gf-tutorial.html">tutorial</A>.
|
||||
You can write your first translator in 15 minutes.
|
||||
</P>
|
||||
<P>
|
||||
GF has an interactive command interpreter, as well as a batch compiler.
|
||||
Grammars can be compiled to parser and translator code in many different
|
||||
formats. These components can then be embedded in applications written
|
||||
in other programming languages. The formats currently supported are:
|
||||
</P>
|
||||
<UL>
|
||||
<LI>Haskell
|
||||
<li>Java, in particular the Android platform
|
||||
<LI>JavaScript
|
||||
<LI>Speech recognition: HTK/ATK, Nuance, JSGF
|
||||
</UL>
|
||||
|
||||
<P>
|
||||
The GF programming language is high-level and advanced, featuring
|
||||
</P>
|
||||
<UL>
|
||||
<LI>static type checking
|
||||
<LI>higher-order functions
|
||||
<LI>dependent types
|
||||
<LI>pattern matching with data constructors and regular expressions
|
||||
<LI>module system with multiple inheritance and parametrized modules
|
||||
</UL>
|
||||
|
||||
<h3>Getting help</h3>
|
||||
<p>
|
||||
If you need some help with GF, the first places to start are the <a href="doc/tutorial/gf-tutorial.html">Tutorial</a> and <a href="doc/gf-refman.html">Reference</a> pages.
|
||||
The printed <a href="gf-book">book</a> contains all the material in the tutorial and some extra bits, and is the recommended reference for GF.
|
||||
</p>
|
||||
|
||||
<hr>
|
||||
<p>
|
||||
We run the IRC channel <strong><code>#gf</code></strong> on the Freenode network, where you are welcome to look for help with small questions or just start a general discussion.
|
||||
IRC logs (in raw format) are available <a href="irc/">here</a>.
|
||||
If you have a larger question which the community may benefit from, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.
|
||||
</p>
|
||||
|
||||
<div class="row">
|
||||
<H2>Libraries</H2>
|
||||
<P>
|
||||
Libraries are at the heart of modern software engineering. In natural language
|
||||
applications, libraries are a way to cope with thousands of details involved in
|
||||
syntax, lexicon, and inflection. The
|
||||
<A HREF="lib/doc/synopsis.html">GF resource grammar library</A> has
|
||||
support for an increasing number of languages, currently including
|
||||
</P>
|
||||
<ol class=languages>
|
||||
<LI>Afrikaans
|
||||
<LI>Amharic (partial)
|
||||
<LI>Arabic (partial)
|
||||
<LI>Bulgarian
|
||||
<LI>Catalan
|
||||
<LI>Chinese
|
||||
<LI>Danish
|
||||
<LI>Dutch
|
||||
<LI>English
|
||||
<LI>Estonian
|
||||
<LI>Finnish
|
||||
<LI>French
|
||||
<LI>German
|
||||
<li>Greek ancient (partial)
|
||||
<li>Greek modern
|
||||
<li>Hebrew (fragments)
|
||||
<LI>Hindi
|
||||
<LI><A HREF="http://www.interlingua.com/">Interlingua</A>
|
||||
<LI>Japanese
|
||||
<LI>Italian
|
||||
<LI>Latin (fragments)
|
||||
<LI>Latvian
|
||||
<li>Maltese
|
||||
<li>Mongolian
|
||||
<LI>Nepali
|
||||
<LI>Norwegian bokmål
|
||||
<LI>Norwegian nynorsk
|
||||
<LI>Persian
|
||||
<LI>Polish
|
||||
<li>Punjabi
|
||||
<LI>Romanian
|
||||
<LI>Russian
|
||||
<LI>Sindhi
|
||||
<LI>Slovene (partial)
|
||||
<LI>Spanish
|
||||
<li>Swahili (fragments)
|
||||
<LI>Swedish
|
||||
<LI>Thai
|
||||
<LI>Turkish (fragments)
|
||||
<LI>Urdu
|
||||
</ol>
|
||||
|
||||
<div class="col-md-6">
|
||||
<h2>Applications & Availability</h2>
|
||||
<p>
|
||||
GF can be used for building
|
||||
<a href="//cloud.grammaticalframework.org/translator/">translation systems</a>,
|
||||
<a href="//cloud.grammaticalframework.org/minibar/minibar.html">multilingual web gadgets</a>,
|
||||
<a href="http://www.cse.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">natural-language interfaces</a>,
|
||||
<a href="http://www.youtube.com/watch?v=1bfaYHWS6zU">dialogue systems</a>, and
|
||||
<a href="lib/doc/synopsis/index.html">natural language resources</a>.
|
||||
</p>
|
||||
<P>
|
||||
Adding a language to the resource library takes 3 to 9
|
||||
months - contributions
|
||||
are welcome! You can start with the <A HREF="doc/gf-lrec-2010.pdf">resource grammarian's tutorial</A>.
|
||||
|
||||
<p>
|
||||
GF is <strong>open-source</strong>, licensed under <a href="LICENSE">GPL</a> (the program) and
|
||||
<a href="LICENSE">LGPL</a> and <a href="LICENSE">BSD</a> (the libraries). It
|
||||
is available for
|
||||
</p>
|
||||
<ul>
|
||||
<li>Linux</li>
|
||||
<li>macOS</li>
|
||||
<li>Windows</li>
|
||||
<li>Android mobile platform (via Java; runtime)</li>
|
||||
<li>iOS mobile platform (iPhone, iPad)</li>
|
||||
<li>via compilation to JavaScript, almost any platform that has a web browser (runtime)</li>
|
||||
</ul>
|
||||
|
||||
<h2>Programming in GF</h2>
|
||||
<p>
|
||||
GF is easy to learn by following the <a href="doc/tutorial/gf-tutorial.html">tutorial</a>.
|
||||
You can write your first translator in 15 minutes.
|
||||
</p>
|
||||
<p>
|
||||
GF has an interactive command interpreter, as well as a batch compiler.
|
||||
Grammars can be compiled to parser and translator code in many different
|
||||
formats. These components can then be embedded in applications written
|
||||
in other programming languages. The formats currently supported are:
|
||||
</p>
|
||||
<ul>
|
||||
<li>Haskell</li>
|
||||
<li>Java, in particular the Android platform</li>
|
||||
<li>JavaScript</li>
|
||||
<li>Speech recognition: HTK/ATK, Nuance, JSGF</li>
|
||||
</ul>
|
||||
|
||||
<p>
|
||||
The GF programming language is high-level and advanced, featuring:
|
||||
</p>
|
||||
<ul>
|
||||
<li>static type checking</li>
|
||||
<li>higher-order functions</li>
|
||||
<li>dependent types</li>
|
||||
<li>pattern matching with data constructors and regular expressions</li>
|
||||
<li>module system with multiple inheritance and parametrized modules</li>
|
||||
</ul>
|
||||
|
||||
<h3>Getting help</h3>
|
||||
<p>
|
||||
If you need some help with GF, the first places to start are the <a href="doc/tutorial/gf-tutorial.html">Tutorial</a> and <a href="doc/gf-refman.html">Reference</a> pages.
|
||||
The printed <a href="gf-book">book</a> contains all the material in the tutorial and some extra bits, and is the recommended reference for GF.
|
||||
</p>
|
||||
|
||||
<p>
|
||||
We run the IRC channel <strong><code>#gf</code></strong> on the Freenode network, where you are welcome to look for help with small questions or just start a general discussion.
|
||||
You can <a href="https://webchat.freenode.net/?channels=gf">open a web chat</a>
|
||||
or <a href="/irc/">browse the channel logs</a>.
|
||||
</p>
|
||||
<p>
|
||||
If you have a larger question which the community may benefit from, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.
|
||||
</p>
|
||||
|
||||
</div>
|
||||
|
||||
<div class="col-md-6">
|
||||
<h2>News</h2>
|
||||
|
||||
<dl class="row">
|
||||
<dt class="col-sm-3 text-center text-nowrap">2021-05-05</dt>
|
||||
<dd class="col-sm-9">
|
||||
<a href="https://cloud.grammaticalframework.org/wordnet/">GF WordNet</a> now supports languages for which there are no other WordNets. New additions: Afrikaans, German, Korean, Maltese, Polish, Somali, Swahili.
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2021-03-01</dt>
|
||||
<dd class="col-sm-9">
|
||||
<a href="//school.grammaticalframework.org/2020/">Seventh GF Summer School</a>, in Singapore and online, 26 July – 8 August 2021.
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2020-09-29</dt>
|
||||
<dd class="col-sm-9">
|
||||
<a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Abstract Syntax as Interlingua</a>: Scaling Up the Grammatical Framework from Controlled Languages to Robust Pipelines. A paper in Computational Linguistics (2020) summarizing much of the development in GF in the past ten years.
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2018-12-03</dt>
|
||||
<dd class="col-sm-9">
|
||||
<a href="//school.grammaticalframework.org/2018/">Sixth GF Summer School</a> in Stellenbosch (South Africa), 3–14 December 2018
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2018-12-02</dt>
|
||||
<dd class="col-sm-9">
|
||||
<strong>GF 3.10 released.</strong>
|
||||
<a href="download/release-3.10.html">Release notes</a>
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2018-07-25</dt>
|
||||
<dd class="col-sm-9">
|
||||
The GF repository has been split in two:
|
||||
<a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and
|
||||
<a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.
|
||||
The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2017-08-11</dt>
|
||||
<dd class="col-sm-9">
|
||||
<strong>GF 3.9 released.</strong>
|
||||
<a href="download/release-3.9.html">Release notes</a>
|
||||
</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2017-06-29</dt>
|
||||
<dd class="col-sm-9">
|
||||
GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>.</dd>
|
||||
<dt class="col-sm-3 text-center text-nowrap">2017-03-13</dt>
|
||||
<dd class="col-sm-9">
|
||||
<a href="//school.grammaticalframework.org/2017/">GF Summer School</a> in Riga (Latvia), 14-25 August 2017
|
||||
</dd>
|
||||
</dl>
|
||||
|
||||
<h2>Projects</h2>
|
||||
<p>
|
||||
GF was first created in 1998 at
|
||||
<a href="http://www.xrce.xerox.com/">Xerox Research Centre Europe</a>,
|
||||
Grenoble, in the project
|
||||
Multilingual Document Authoring. At Xerox, it was used for prototypes including
|
||||
a restaurant phrase book,
|
||||
a database query system,
|
||||
a formalization of an alarm system instructions with translations to 5 languages, and
|
||||
an authoring system for medical drug descriptions.
|
||||
</p>
|
||||
<p>
|
||||
Later projects using GF and involving third parties include, in chronological order:
|
||||
</p>
|
||||
<ul>
|
||||
<li>
|
||||
<a href="http://www.cse.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">GF-Alfa</a>:
|
||||
natural language interface to formal proofs
|
||||
</li>
|
||||
<li>
|
||||
<a href="http://efficient.citi.tudor.lu/index_noframe.html">Efficient</a>:
|
||||
authoring tool for business models.
|
||||
</li>
|
||||
<li>
|
||||
<a href="http://www.key-project.org/">GF-KeY</a>:
|
||||
authoring and translation of software specifications
|
||||
</li>
|
||||
<li>
|
||||
<a href="http://www.talk-project.org">TALK</a>:
|
||||
multilingual and multimodal spoken dialogue systems
|
||||
</li>
|
||||
<li>
|
||||
<a href="http://webalt.math.helsinki.fi/">WebALT</a>:
|
||||
multilingual generation of mathematical exercises (commercial project)
|
||||
</li>
|
||||
<li>
|
||||
<a href="http://spraakbanken.gu.se/sal/">SALDO</a>:
|
||||
Swedish morphological dictionary based on rules developed for GF and
|
||||
<a href="http://www.cse.chalmers.se/alumni/markus/FM/">Functional Morphology</a>
|
||||
</li>
|
||||
<li>
|
||||
<a href="//www.molto-project.eu">MOLTO</a>:
|
||||
multilingual online translation
|
||||
</li>
|
||||
<li>
|
||||
<a href="//remu.grammaticalframework.org">REMU</a>:
|
||||
reliable multilingual digital communication
|
||||
</li>
|
||||
</ul>
|
||||
<!-- <p>
|
||||
Here is a <a
|
||||
href="http://videos.xrce.xerox.com/index.php/videos/index/618">talk
|
||||
about GF at XRCE</a>,
|
||||
14 years later.
|
||||
</p> -->
|
||||
|
||||
<p>
|
||||
Academically, GF has been used in at least ten PhD theses and resulted
|
||||
in more than a hundred scientific publications.
|
||||
<!-- (see <a href="doc/gf-bibliography.html">GF publication list</a>). -->
|
||||
</p>
|
||||
|
||||
<h2>Libraries</h2>
|
||||
<p>
|
||||
Libraries are at the heart of modern software engineering. In natural language
|
||||
applications, libraries are a way to cope with thousands of details involved in
|
||||
syntax, lexicon, and inflection. The
|
||||
<a href="lib/doc/synopsis/index.html">GF resource grammar library</a> has
|
||||
support for an increasing number of languages, currently including
|
||||
Afrikaans,
|
||||
Amharic (partial),
|
||||
Arabic (partial),
|
||||
Basque (partial),
|
||||
Bulgarian,
|
||||
Catalan,
|
||||
Chinese,
|
||||
Czech (partial),
|
||||
Danish,
|
||||
Dutch,
|
||||
English,
|
||||
Estonian,
|
||||
Finnish,
|
||||
French,
|
||||
German,
|
||||
Greek ancient (partial),
|
||||
Greek modern,
|
||||
Hebrew (fragments),
|
||||
Hindi,
|
||||
Hungarian (partial),
|
||||
Interlingua,
|
||||
Italian,
|
||||
Japanese,
|
||||
Korean (partial),
|
||||
Latin (partial),
|
||||
Latvian,
|
||||
Maltese,
|
||||
Mongolian,
|
||||
Nepali,
|
||||
Norwegian bokmål,
|
||||
Norwegian nynorsk,
|
||||
Persian,
|
||||
Polish,
|
||||
Punjabi,
|
||||
Romanian,
|
||||
Russian,
|
||||
Sindhi,
|
||||
Slovak (partial),
|
||||
Slovene (partial),
|
||||
Somali (partial),
|
||||
Spanish,
|
||||
Swahili (fragments),
|
||||
Swedish,
|
||||
Thai,
|
||||
Turkish (fragments),
|
||||
and
|
||||
Urdu.
|
||||
</p>
|
||||
|
||||
<p>
|
||||
Adding a language to the resource library takes 3 to 9
|
||||
months - contributions
|
||||
are welcome! You can start with the <a href="lib/doc/rgl-tutorial/index.html">resource grammarian's tutorial</a>.
|
||||
</p>
|
||||
|
||||
</div><!-- .col-6 -->
|
||||
|
||||
</div><!-- .row -->
|
||||
|
||||
</div><!-- .container -->
|
||||
|
||||
<footer class="bg-light mt-5 py-4">
|
||||
<div class="container mb-3">
|
||||
<div class="text-center text-muted">
|
||||
<img style="height:50px; filter: opacity(.5) grayscale(1);" class="mb-3" src="doc/Logos/gf0.svg" alt="GF Logo"><br>
|
||||
Grammatical Framework is free and open source,<br>
|
||||
with some support from <a href="https://www.digitalgrammars.com/">Digital Grammars AB</a>.
|
||||
</div>
|
||||
</div>
|
||||
</footer>
|
||||
|
||||
<script type="text/javascript">
|
||||
var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");
|
||||
@@ -419,6 +423,5 @@ try {
|
||||
var pageTracker = _gat._getTracker("UA-7811807-3");
|
||||
pageTracker._trackPageview();
|
||||
} catch(err) {}</script>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
</BODY>
|
||||
</HTML>
|
||||
|
||||
@@ -19,9 +19,7 @@ module GF(
|
||||
module GF.Grammar.Printer,
|
||||
module GF.Infra.Ident,
|
||||
-- ** Binary serialisation
|
||||
module GF.Grammar.Binary,
|
||||
-- * Canonical GF
|
||||
module GF.Compile.GrammarToCanonical
|
||||
module GF.Grammar.Binary
|
||||
) where
|
||||
import GF.Main
|
||||
import GF.Compiler
|
||||
@@ -38,5 +36,3 @@ import GF.Grammar.Macros
|
||||
import GF.Grammar.Printer
|
||||
import GF.Infra.Ident
|
||||
import GF.Grammar.Binary
|
||||
|
||||
import GF.Compile.GrammarToCanonical
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
|
||||
module GF.Command.Commands (
|
||||
PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
|
||||
options,flags,
|
||||
@@ -34,7 +34,6 @@ import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import GF.Text.Pretty
|
||||
import Data.List (sort)
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
--import Debug.Trace
|
||||
|
||||
|
||||
@@ -45,7 +44,7 @@ pgfEnv pgf = Env pgf mos
|
||||
|
||||
class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
|
||||
|
||||
instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where
|
||||
instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
|
||||
typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
|
||||
. flip inferExpr e . pgf) =<< getPGFEnv
|
||||
|
||||
@@ -724,7 +723,7 @@ pgfCommands = Map.fromList [
|
||||
case toExprs arg of
|
||||
[EFun id] -> case Map.lookup id (funs (abstract pgf)) of
|
||||
Just fd -> do putStrLn $ render (ppFun id fd)
|
||||
let (_,_,_,prob) = fd
|
||||
let (_,_,_,_,prob) = fd
|
||||
putStrLn ("Probability: "++show prob)
|
||||
return void
|
||||
Nothing -> case Map.lookup id (cats (abstract pgf)) of
|
||||
@@ -733,7 +732,7 @@ pgfCommands = Map.fromList [
|
||||
if null (functionsToCat pgf id)
|
||||
then empty
|
||||
else ' ' $$
|
||||
vcat [ppFun fid (ty,0,Just ([],[]),0) | (fid,ty) <- functionsToCat pgf id] $$
|
||||
vcat [ppFun fid (ty,[],0,Just ([],[]),0) | (fid,ty) <- functionsToCat pgf id] $$
|
||||
' ')
|
||||
let (_,_,prob) = cd
|
||||
putStrLn ("Probability: "++show prob)
|
||||
@@ -741,7 +740,7 @@ pgfCommands = Map.fromList [
|
||||
Nothing -> do putStrLn ("unknown category of function identifier "++show id)
|
||||
return void
|
||||
[e] -> case inferExpr pgf e of
|
||||
Left tcErr -> errorWithoutStackTrace $ render (ppTcError tcErr)
|
||||
Left tcErr -> error $ render (ppTcError tcErr)
|
||||
Right (e,ty) -> do putStrLn ("Expression: "++showExpr [] e)
|
||||
putStrLn ("Type: "++showType [] ty)
|
||||
putStrLn ("Probability: "++show (probTree pgf e))
|
||||
@@ -910,7 +909,7 @@ pgfCommands = Map.fromList [
|
||||
| otherwise = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
|
||||
return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
|
||||
|
||||
funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))]
|
||||
funsigs pgf = [(f,ty) | (f,(ty,_,_,_,_)) <- Map.assocs (funs (abstract pgf))]
|
||||
showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"
|
||||
|
||||
morphos (Env pgf mos) opts s =
|
||||
@@ -1019,7 +1018,3 @@ stanzas = map unlines . chop . lines where
|
||||
chop ls = case break (=="") ls of
|
||||
(ls1,[]) -> [ls1]
|
||||
(ls1,_:ls2) -> ls1 : chop ls2
|
||||
|
||||
#if !(MIN_VERSION_base(4,9,0))
|
||||
errorWithoutStackTrace = error
|
||||
#endif
|
||||
@@ -18,7 +18,6 @@ import Data.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import GF.Text.Pretty
|
||||
import Control.Monad(mplus)
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
|
||||
data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
|
||||
@@ -26,7 +25,7 @@ data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
|
||||
pgfEnv pgf = Env (Just pgf) (languages pgf)
|
||||
emptyPGFEnv = Env Nothing Map.empty
|
||||
|
||||
class (Fail.MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
|
||||
class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
|
||||
|
||||
instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
|
||||
typeCheckArg e = do env <- getPGFEnv
|
||||
@@ -807,22 +806,14 @@ hsExpr c =
|
||||
Just (f,cs) -> H.mkApp (H.mkCId f) (map hsExpr cs)
|
||||
_ -> case unStr c of
|
||||
Just str -> H.mkStr str
|
||||
_ -> case unInt c of
|
||||
Just n -> H.mkInt n
|
||||
_ -> case unFloat c of
|
||||
Just d -> H.mkFloat d
|
||||
_ -> error $ "GF.Command.Commands2.hsExpr "++show c
|
||||
_ -> error $ "GF.Command.Commands2.hsExpr "++show c
|
||||
|
||||
cExpr e =
|
||||
case H.unApp e of
|
||||
Just (f,es) -> mkApp (H.showCId f) (map cExpr es)
|
||||
_ -> case H.unStr e of
|
||||
Just str -> mkStr str
|
||||
_ -> case H.unInt e of
|
||||
Just n -> mkInt n
|
||||
_ -> case H.unFloat e of
|
||||
Just d -> mkFloat d
|
||||
_ -> error $ "GF.Command.Commands2.cExpr "++show e
|
||||
_ -> error $ "GF.Command.Commands2.cExpr "++show e
|
||||
|
||||
needPGF exec opts ts =
|
||||
do Env mb_pgf cncs <- getPGFEnv
|
||||
|
||||
@@ -15,7 +15,6 @@ import GF.Command.Abstract --(isOpt,valStrOpts,prOpt)
|
||||
import GF.Text.Pretty
|
||||
import GF.Text.Transliterations
|
||||
import GF.Text.Lexing(stringOp,opInEnv)
|
||||
import Data.Char (isSpace)
|
||||
|
||||
import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
|
||||
|
||||
@@ -171,8 +170,7 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
|
||||
restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo
|
||||
fmap fromString $ restricted $ readFile tmpo,
|
||||
-}
|
||||
fmap (fromStrings . lines) . restricted . readShellProcess syst . unlines . map (dropWhile (=='\n')) $ toStrings $ arg,
|
||||
|
||||
fmap fromString . restricted . readShellProcess syst $ toString arg,
|
||||
flags = [
|
||||
("command","the system command applied to the argument")
|
||||
],
|
||||
|
||||
@@ -11,8 +11,6 @@ import GF.Infra.UseIO(putStrLnE)
|
||||
|
||||
import Control.Monad(when)
|
||||
import qualified Data.Map as Map
|
||||
import GF.Infra.UseIO (Output)
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
data CommandEnv m = CommandEnv {
|
||||
commands :: Map.Map String (CommandInfo m),
|
||||
@@ -24,7 +22,6 @@ data CommandEnv m = CommandEnv {
|
||||
mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
|
||||
|
||||
--interpretCommandLine :: CommandEnv -> String -> SIO ()
|
||||
interpretCommandLine :: (Fail.MonadFail m, Output m, TypeCheckArg m) => CommandEnv m -> String -> m ()
|
||||
interpretCommandLine env line =
|
||||
case readCommandLine line of
|
||||
Just [] -> return ()
|
||||
|
||||
@@ -18,8 +18,8 @@ import GF.Grammar.Parser (runP, pExp)
|
||||
import GF.Grammar.ShowTerm
|
||||
import GF.Grammar.Lookup (allOpers,allOpersTo)
|
||||
import GF.Compile.Rename(renameSourceTerm)
|
||||
import GF.Compile.Compute.Concrete(normalForm,resourceValues)
|
||||
import GF.Compile.TypeCheck.Concrete as TC(inferLType,ppType)
|
||||
import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)
|
||||
import GF.Compile.TypeCheck.RConcrete as TC(inferLType,ppType)
|
||||
import GF.Infra.Dependencies(depGraph)
|
||||
import GF.Infra.CheckM(runCheck)
|
||||
|
||||
@@ -259,7 +259,7 @@ checkComputeTerm os sgr t =
|
||||
((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
|
||||
inferLType sgr [] t
|
||||
let opts = modifyFlags (\fs->fs{optTrace=isOpt "trace" os})
|
||||
t1 = normalForm (resourceValues opts sgr) (L NoLoc identW) t
|
||||
t1 = CN.normalForm (CN.resourceValues opts sgr) (L NoLoc identW) t
|
||||
t2 = evalStr t1
|
||||
checkPredefError t2
|
||||
where
|
||||
|
||||
@@ -35,7 +35,7 @@ cf2abstr cfg = Abstr aflags afuns acats
|
||||
| (cat,rules) <- (Map.toList . Map.fromListWith (++))
|
||||
[(cat2id cat, catRules cfg cat) |
|
||||
cat <- allCats' cfg]]
|
||||
afuns = Map.fromList [(mkRuleName rule, (cftype [cat2id c | NonTerminal c <- ruleRhs rule] (cat2id (ruleLhs rule)), 0, Nothing, 0))
|
||||
afuns = Map.fromList [(mkRuleName rule, (cftype [cat2id c | NonTerminal c <- ruleRhs rule] (cat2id (ruleLhs rule)), [], 0, Nothing, 0))
|
||||
| rule <- allRules cfg]
|
||||
|
||||
cat2id = mkCId . fst
|
||||
@@ -56,7 +56,7 @@ cf2concr cfg = Concr Map.empty Map.empty
|
||||
map mkSequence rules)
|
||||
sequences = listArray (0,Set.size sequences0-1) (Set.toList sequences0)
|
||||
|
||||
idFun = CncFun wildCId (listArray (0,0) [seqid])
|
||||
idFun = CncFun [wildCId] (listArray (0,0) [seqid])
|
||||
where
|
||||
seq = listArray (0,0) [SymCat 0 0]
|
||||
seqid = binSearch seq sequences (bounds sequences)
|
||||
@@ -77,7 +77,7 @@ cf2concr cfg = Concr Map.empty Map.empty
|
||||
let args = [PArg [] (cat2arg c) | NonTerminal c <- ruleRhs rule]
|
||||
prod = PApply funid args
|
||||
seqid = binSearch (mkSequence rule) sequences (bounds sequences)
|
||||
fun = CncFun (mkRuleName rule) (listArray (0,0) [seqid])
|
||||
fun = CncFun [mkRuleName rule] (listArray (0,0) [seqid])
|
||||
funid' = funid+1
|
||||
in funid' `seq` ((funid',fun:funs),let (c,ps) = ruleLhs rule in [(cat2fid c p, prod) | p <- ps])
|
||||
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/11/11 23:24:33 $
|
||||
-- > CVS $Date: 2005/11/11 23:24:33 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.31 $
|
||||
--
|
||||
@@ -27,20 +27,21 @@ import GF.Infra.Ident
|
||||
import GF.Infra.Option
|
||||
|
||||
import GF.Compile.TypeCheck.Abstract
|
||||
import GF.Compile.TypeCheck.Concrete(computeLType,checkLType,inferLType,ppType)
|
||||
import qualified GF.Compile.TypeCheck.ConcreteNew as CN(checkLType,inferLType)
|
||||
import qualified GF.Compile.Compute.Concrete as CN(normalForm,resourceValues)
|
||||
import GF.Compile.TypeCheck.RConcrete
|
||||
import qualified GF.Compile.TypeCheck.ConcreteNew as CN
|
||||
import qualified GF.Compile.Compute.ConcreteNew as CN
|
||||
|
||||
import GF.Grammar
|
||||
import GF.Grammar.Lexer
|
||||
import GF.Grammar.Lookup
|
||||
--import GF.Grammar.Predef
|
||||
--import GF.Grammar.PatternMatch
|
||||
|
||||
import GF.Data.Operations
|
||||
import GF.Infra.CheckM
|
||||
|
||||
import Data.List
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import Control.Monad
|
||||
import GF.Text.Pretty
|
||||
|
||||
@@ -58,7 +59,7 @@ checkModule opts cwd sgr mo@(m,mi) = do
|
||||
where
|
||||
updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check
|
||||
where check (i,info) = fmap ((,) i) (checkInfo opts cwd sgr mo i info)
|
||||
update mo@(m,mi) (i,info) = (m,mi{jments=Map.insert i info (jments mi)})
|
||||
update mo@(m,mi) (i,info) = (m,mi{jments=updateTree (i,info) (jments mi)})
|
||||
|
||||
-- check if restricted inheritance modules are still coherent
|
||||
-- i.e. that the defs of remaining names don't depend on omitted names
|
||||
@@ -71,12 +72,12 @@ checkRestrictedInheritance cwd sgr (name,mo) = checkInModule cwd mo NoLoc empty
|
||||
where
|
||||
mos = modules sgr
|
||||
checkRem ((i,m),mi) = do
|
||||
let (incl,excl) = partition (isInherited mi) (Map.keys (jments m))
|
||||
let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
|
||||
let incld c = Set.member c (Set.fromList incl)
|
||||
let illegal c = Set.member c (Set.fromList excl)
|
||||
let illegals = [(f,is) |
|
||||
let illegals = [(f,is) |
|
||||
(f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
|
||||
case illegals of
|
||||
case illegals of
|
||||
[] -> return ()
|
||||
cs -> checkWarn ("In inherited module" <+> i <> ", dependence of excluded constants:" $$
|
||||
nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))
|
||||
@@ -88,16 +89,16 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
|
||||
let jsc = jments cnc
|
||||
|
||||
-- check that all concrete constants are in abstract; build types for all lin
|
||||
jsc <- foldM checkCnc Map.empty (Map.toList jsc)
|
||||
jsc <- foldM checkCnc emptyBinTree (tree2list jsc)
|
||||
|
||||
-- check that all abstract constants are in concrete; build default lin and lincats
|
||||
jsc <- foldM checkAbs jsc (Map.toList jsa)
|
||||
|
||||
jsc <- foldM checkAbs jsc (tree2list jsa)
|
||||
|
||||
return (cm,cnc{jments=jsc})
|
||||
where
|
||||
checkAbs js i@(c,info) =
|
||||
case info of
|
||||
AbsFun (Just (L loc ty)) _ _ _
|
||||
AbsFun (Just (L loc ty)) _ _ _
|
||||
-> do let mb_def = do
|
||||
let (cxt,(_,i),_) = typeForm ty
|
||||
info <- lookupIdent i js
|
||||
@@ -112,17 +113,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
|
||||
case lookupIdent c js of
|
||||
Ok (AnyInd _ _) -> return js
|
||||
Ok (CncFun ty (Just def) mn mf) ->
|
||||
return $ Map.insert c (CncFun ty (Just def) mn mf) js
|
||||
return $ updateTree (c,CncFun ty (Just def) mn mf) js
|
||||
Ok (CncFun ty Nothing mn mf) ->
|
||||
case mb_def of
|
||||
Ok def -> return $ Map.insert c (CncFun ty (Just (L NoLoc def)) mn mf) js
|
||||
Ok def -> return $ updateTree (c,CncFun ty (Just (L NoLoc def)) mn mf) js
|
||||
Bad _ -> do noLinOf c
|
||||
return js
|
||||
_ -> do
|
||||
case mb_def of
|
||||
Ok def -> do (cont,val) <- linTypeOfType gr cm ty
|
||||
let linty = (snd (valCat ty),cont,val)
|
||||
return $ Map.insert c (CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
|
||||
return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
|
||||
Bad _ -> do noLinOf c
|
||||
return js
|
||||
where noLinOf c = checkWarn ("no linearization of" <+> c)
|
||||
@@ -131,42 +132,36 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
|
||||
Ok (CncCat (Just _) _ _ _ _) -> return js
|
||||
Ok (CncCat Nothing md mr mp mpmcfg) -> do
|
||||
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
|
||||
return $ Map.insert c (CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
|
||||
return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
|
||||
_ -> do
|
||||
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
|
||||
return $ Map.insert c (CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
|
||||
return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
|
||||
_ -> return js
|
||||
|
||||
checkCnc js (c,info) =
|
||||
|
||||
checkCnc js i@(c,info) =
|
||||
case info of
|
||||
CncFun _ d mn mf -> case lookupOrigInfo gr (am,c) of
|
||||
Ok (_,AbsFun (Just (L _ ty)) _ _ _) ->
|
||||
Ok (_,AbsFun (Just (L _ ty)) _ _ _) ->
|
||||
do (cont,val) <- linTypeOfType gr cm ty
|
||||
let linty = (snd (valCat ty),cont,val)
|
||||
return $ Map.insert c (CncFun (Just linty) d mn mf) js
|
||||
return $ updateTree (c,CncFun (Just linty) d mn mf) js
|
||||
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
|
||||
return js
|
||||
CncCat {} ->
|
||||
case lookupOrigInfo gr (am,c) of
|
||||
Ok (_,AbsCat _) -> return $ Map.insert c info js
|
||||
{- -- This might be too pedantic:
|
||||
Ok (_,AbsFun {}) ->
|
||||
checkError ("lincat:"<+>c<+>"is a fun, not a cat")
|
||||
-}
|
||||
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
|
||||
return js
|
||||
|
||||
_ -> return $ Map.insert c info js
|
||||
CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
|
||||
Ok _ -> return $ updateTree i js
|
||||
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
|
||||
return js
|
||||
_ -> return $ updateTree i js
|
||||
|
||||
|
||||
-- | General Principle: only Just-values are checked.
|
||||
-- | General Principle: only Just-values are checked.
|
||||
-- A May-value has always been checked in its origin module.
|
||||
checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
|
||||
checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
checkReservedId c
|
||||
case info of
|
||||
AbsCat (Just (L loc cont)) ->
|
||||
mkCheck loc "the category" $
|
||||
AbsCat (Just (L loc cont)) ->
|
||||
mkCheck loc "the category" $
|
||||
checkContext gr cont
|
||||
|
||||
AbsFun (Just (L loc typ0)) ma md moper -> do
|
||||
@@ -181,7 +176,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
|
||||
CncCat mty mdef mref mpr mpmcfg -> do
|
||||
mty <- case mty of
|
||||
Just (L loc typ) -> chIn loc "linearization type of" $
|
||||
Just (L loc typ) -> chIn loc "linearization type of" $
|
||||
(if False --flag optNewComp opts
|
||||
then do (typ,_) <- CN.checkLType (CN.resourceValues opts gr) typ typeType
|
||||
typ <- computeLType gr [] typ
|
||||
@@ -191,19 +186,19 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
return (Just (L loc typ)))
|
||||
Nothing -> return Nothing
|
||||
mdef <- case (mty,mdef) of
|
||||
(Just (L _ typ),Just (L loc def)) ->
|
||||
(Just (L _ typ),Just (L loc def)) ->
|
||||
chIn loc "default linearization of" $ do
|
||||
(def,_) <- checkLType gr [] def (mkFunType [typeStr] typ)
|
||||
return (Just (L loc def))
|
||||
_ -> return Nothing
|
||||
mref <- case (mty,mref) of
|
||||
(Just (L _ typ),Just (L loc ref)) ->
|
||||
(Just (L _ typ),Just (L loc ref)) ->
|
||||
chIn loc "reference linearization of" $ do
|
||||
(ref,_) <- checkLType gr [] ref (mkFunType [typ] typeStr)
|
||||
return (Just (L loc ref))
|
||||
_ -> return Nothing
|
||||
mpr <- case mpr of
|
||||
(Just (L loc t)) ->
|
||||
(Just (L loc t)) ->
|
||||
chIn loc "print name of" $ do
|
||||
(t,_) <- checkLType gr [] t typeStr
|
||||
return (Just (L loc t))
|
||||
@@ -212,13 +207,13 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
|
||||
CncFun mty mt mpr mpmcfg -> do
|
||||
mt <- case (mty,mt) of
|
||||
(Just (cat,cont,val),Just (L loc trm)) ->
|
||||
(Just (cat,cont,val),Just (L loc trm)) ->
|
||||
chIn loc "linearization of" $ do
|
||||
(trm,_) <- checkLType gr [] trm (mkFunType (map (\(_,_,ty) -> ty) cont) val) -- erases arg vars
|
||||
return (Just (L loc trm))
|
||||
_ -> return mt
|
||||
mpr <- case mpr of
|
||||
(Just (L loc t)) ->
|
||||
(Just (L loc t)) ->
|
||||
chIn loc "print name of" $ do
|
||||
(t,_) <- checkLType gr [] t typeStr
|
||||
return (Just (L loc t))
|
||||
@@ -251,16 +246,16 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
ResOverload os tysts -> chIn NoLoc "overloading" $ do
|
||||
tysts' <- mapM (uncurry $ flip (\(L loc1 t) (L loc2 ty) -> checkLType gr [] t ty >>= \(t,ty) -> return (L loc1 t, L loc2 ty))) tysts -- return explicit ones
|
||||
tysts0 <- lookupOverload gr (m,c) -- check against inherited ones too
|
||||
tysts1 <- mapM (uncurry $ flip (checkLType gr []))
|
||||
tysts1 <- mapM (uncurry $ flip (checkLType gr []))
|
||||
[(mkFunType args val,tr) | (args,(val,tr)) <- tysts0]
|
||||
--- this can only be a partial guarantee, since matching
|
||||
--- with value type is only possible if expected type is given
|
||||
checkUniq $
|
||||
checkUniq $
|
||||
sort [let (xs,t) = typeFormCnc x in t : map (\(b,x,t) -> t) xs | (_,x) <- tysts1]
|
||||
return (ResOverload os [(y,x) | (x,y) <- tysts'])
|
||||
|
||||
ResParam (Just (L loc pcs)) _ -> do
|
||||
ts <- chIn loc "parameter type" $
|
||||
ts <- chIn loc "parameter type" $
|
||||
liftM concat $ mapM mkPar pcs
|
||||
return (ResParam (Just (L loc pcs)) (Just ts))
|
||||
|
||||
@@ -270,13 +265,13 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c)
|
||||
|
||||
mkPar (f,co) = do
|
||||
vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co
|
||||
vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
|
||||
return $ map (mkApp (QC (m,f))) vs
|
||||
|
||||
checkUniq xss = case xss of
|
||||
x:y:xs
|
||||
x:y:xs
|
||||
| x == y -> checkError $ "ambiguous for type" <+>
|
||||
ppType (mkFunType (tail x) (head x))
|
||||
ppType (mkFunType (tail x) (head x))
|
||||
| otherwise -> checkUniq $ y:xs
|
||||
_ -> return ()
|
||||
|
||||
@@ -294,7 +289,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
|
||||
t' <- compAbsTyp ((x,Vr x):g) t
|
||||
return $ Prod b x a' t'
|
||||
Abs _ _ _ -> return t
|
||||
_ -> composOp (compAbsTyp g) t
|
||||
_ -> composOp (compAbsTyp g) t
|
||||
|
||||
|
||||
-- | for grammars obtained otherwise than by parsing ---- update!!
|
||||
|
||||
64
src/compiler/GF/Compile/Coding.hs
Normal file
64
src/compiler/GF/Compile/Coding.hs
Normal file
@@ -0,0 +1,64 @@
|
||||
module GF.Compile.Coding where
|
||||
{-
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Macros
|
||||
import GF.Text.Coding
|
||||
--import GF.Infra.Option
|
||||
import GF.Data.Operations
|
||||
|
||||
--import Data.Char
|
||||
import System.IO
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
|
||||
encodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule
|
||||
encodeStringsInModule enc = codeSourceModule (BS.unpack . encodeUnicode enc)
|
||||
|
||||
decodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule
|
||||
decodeStringsInModule enc mo = codeSourceModule (decodeUnicode enc . BS.pack) mo
|
||||
|
||||
codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
|
||||
codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)})
|
||||
where
|
||||
codj (c,info) = case info of
|
||||
ResOper pty pt -> ResOper (codeLTerms co pty) (codeLTerms co pt)
|
||||
ResOverload es tyts -> ResOverload es [(codeLTerm co ty,codeLTerm co t) | (ty,t) <- tyts]
|
||||
CncCat mcat mdef mref mpr mpmcfg -> CncCat mcat (codeLTerms co mdef) (codeLTerms co mref) (codeLTerms co mpr) mpmcfg
|
||||
CncFun mty mt mpr mpmcfg -> CncFun mty (codeLTerms co mt) (codeLTerms co mpr) mpmcfg
|
||||
_ -> info
|
||||
|
||||
codeLTerms co = fmap (codeLTerm co)
|
||||
|
||||
codeLTerm :: (String -> String) -> L Term -> L Term
|
||||
codeLTerm = fmap . codeTerm
|
||||
|
||||
codeTerm :: (String -> String) -> Term -> Term
|
||||
codeTerm co = codt
|
||||
where
|
||||
codt t = case t of
|
||||
K s -> K (co s)
|
||||
T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
|
||||
EPatt p -> EPatt (codp p)
|
||||
_ -> composSafeOp codt t
|
||||
|
||||
codp p = case p of --- really: composOpPatt
|
||||
PR rs -> PR [(l,codp p) | (l,p) <- rs]
|
||||
PString s -> PString (co s)
|
||||
PChars s -> PChars (co s)
|
||||
PT x p -> PT x (codp p)
|
||||
PAs x p -> PAs x (codp p)
|
||||
PNeg p -> PNeg (codp p)
|
||||
PRep p -> PRep (codp p)
|
||||
PSeq p q -> PSeq (codp p) (codp q)
|
||||
PAlt p q -> PAlt (codp p) (codp q)
|
||||
_ -> p
|
||||
|
||||
-- | Run an encoding function on all string literals within the given string.
|
||||
codeStringLiterals :: (String -> String) -> String -> String
|
||||
codeStringLiterals _ [] = []
|
||||
codeStringLiterals co ('"':cs) = '"' : inStringLiteral cs
|
||||
where inStringLiteral [] = error "codeStringLiterals: unterminated string literal"
|
||||
inStringLiteral ('"':ds) = '"' : codeStringLiterals co ds
|
||||
inStringLiteral ('\\':d:ds) = '\\' : co [d] ++ inStringLiteral ds
|
||||
inStringLiteral (d:ds) = co [d] ++ inStringLiteral ds
|
||||
codeStringLiterals co (c:cs) = c : codeStringLiterals co cs
|
||||
-}
|
||||
143
src/compiler/GF/Compile/Compute/AppPredefined.hs
Normal file
143
src/compiler/GF/Compile/Compute/AppPredefined.hs
Normal file
@@ -0,0 +1,143 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : AppPredefined
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/10/06 14:21:34 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.13 $
|
||||
--
|
||||
-- Predefined function type signatures and definitions.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Compile.Compute.AppPredefined ({-
|
||||
isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined-}
|
||||
) where
|
||||
{-
|
||||
import GF.Compile.TypeCheck.Primitives
|
||||
import GF.Infra.Option
|
||||
import GF.Data.Operations
|
||||
import GF.Grammar
|
||||
import GF.Grammar.Predef
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import GF.Text.Pretty
|
||||
import Data.Char (isUpper,toUpper,toLower)
|
||||
|
||||
-- predefined function type signatures and definitions. AR 12/3/2003.
|
||||
|
||||
isInPredefined :: Ident -> Bool
|
||||
isInPredefined f = Map.member f primitives
|
||||
|
||||
arrityPredefined :: Ident -> Maybe Int
|
||||
arrityPredefined f = do ty <- typPredefined f
|
||||
let (ctxt,_) = typeFormCnc ty
|
||||
return (length ctxt)
|
||||
|
||||
predefModInfo :: SourceModInfo
|
||||
predefModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "Predef.gf" Nothing primitives
|
||||
|
||||
appPredefined :: Term -> Err (Term,Bool)
|
||||
appPredefined t = case t of
|
||||
App f x0 -> do
|
||||
(x,_) <- appPredefined x0
|
||||
case f of
|
||||
-- one-place functions
|
||||
Q (mod,f) | mod == cPredef ->
|
||||
case x of
|
||||
(K s) | f == cLength -> retb $ EInt $ length s
|
||||
(K s) | f == cIsUpper -> retb $ if (all isUpper s) then predefTrue else predefFalse
|
||||
(K s) | f == cToUpper -> retb $ K $ map toUpper s
|
||||
(K s) | f == cToLower -> retb $ K $ map toLower s
|
||||
(K s) | f == cError -> retb $ Error s
|
||||
|
||||
_ -> retb t
|
||||
|
||||
-- two-place functions
|
||||
App (Q (mod,f)) z0 | mod == cPredef -> do
|
||||
(z,_) <- appPredefined z0
|
||||
case (norm z, norm x) of
|
||||
(EInt i, K s) | f == cDrop -> retb $ K (drop i s)
|
||||
(EInt i, K s) | f == cTake -> retb $ K (take i s)
|
||||
(EInt i, K s) | f == cTk -> retb $ K (take (max 0 (length s - i)) s)
|
||||
(EInt i, K s) | f == cDp -> retb $ K (drop (max 0 (length s - i)) s)
|
||||
(K s, K t) | f == cEqStr -> retb $ if s == t then predefTrue else predefFalse
|
||||
(K s, K t) | f == cOccur -> retb $ if substring s t then predefTrue else predefFalse
|
||||
(K s, K t) | f == cOccurs -> retb $ if any (flip elem t) s then predefTrue else predefFalse
|
||||
(EInt i, EInt j) | f == cEqInt -> retb $ if i==j then predefTrue else predefFalse
|
||||
(EInt i, EInt j) | f == cLessInt -> retb $ if i<j then predefTrue else predefFalse
|
||||
(EInt i, EInt j) | f == cPlus -> retb $ EInt $ i+j
|
||||
(_, t) | f == cShow && notVar t -> retb $ foldrC $ map K $ words $ render (ppTerm Unqualified 0 t)
|
||||
(_, K s) | f == cRead -> retb $ Cn (identS s) --- because of K, only works for atomic tags
|
||||
(_, t) | f == cToStr -> trm2str t >>= retb
|
||||
_ -> retb t ---- prtBad "cannot compute predefined" t
|
||||
|
||||
-- three-place functions
|
||||
App (App (Q (mod,f)) z0) y0 | mod == cPredef -> do
|
||||
(y,_) <- appPredefined y0
|
||||
(z,_) <- appPredefined z0
|
||||
case (z, y, x) of
|
||||
(ty,op,t) | f == cMapStr -> retf $ mapStr ty op t
|
||||
_ | f == cEqVal && notVar y && notVar x -> retb $ if y==x then predefTrue else predefFalse
|
||||
_ -> retb t ---- prtBad "cannot compute predefined" t
|
||||
|
||||
_ -> retb t ---- prtBad "cannot compute predefined" t
|
||||
_ -> retb t
|
||||
---- should really check the absence of arg variables
|
||||
where
|
||||
retb t = return (retc t,True) -- no further computing needed
|
||||
retf t = return (retc t,False) -- must be computed further
|
||||
retc t = case t of
|
||||
K [] -> t
|
||||
K s -> foldr1 C (map K (words s))
|
||||
_ -> t
|
||||
norm t = case t of
|
||||
Empty -> K []
|
||||
C u v -> case (norm u,norm v) of
|
||||
(K x,K y) -> K (x +++ y)
|
||||
_ -> t
|
||||
_ -> t
|
||||
notVar t = case t of
|
||||
Vr _ -> False
|
||||
App f a -> notVar f && notVar a
|
||||
_ -> True ---- would need to check that t is a value
|
||||
foldrC ts = if null ts then Empty else foldr1 C ts
|
||||
|
||||
-- read makes variables into constants
|
||||
|
||||
predefTrue = QC (cPredef,cPTrue)
|
||||
predefFalse = QC (cPredef,cPFalse)
|
||||
|
||||
substring :: String -> String -> Bool
|
||||
substring s t = case (s,t) of
|
||||
(c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds
|
||||
([],_) -> True
|
||||
_ -> False
|
||||
|
||||
trm2str :: Term -> Err Term
|
||||
trm2str t = case t of
|
||||
R ((_,(_,s)):_) -> trm2str s
|
||||
T _ ((_,s):_) -> trm2str s
|
||||
V _ (s:_) -> trm2str s
|
||||
C _ _ -> return $ t
|
||||
K _ -> return $ t
|
||||
S c _ -> trm2str c
|
||||
Empty -> return $ t
|
||||
_ -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t))
|
||||
|
||||
-- simultaneous recursion on type and term: type arg is essential!
|
||||
-- But simplify the task by assuming records are type-annotated
|
||||
-- (this has been done in type checking)
|
||||
mapStr :: Type -> Term -> Term -> Term
|
||||
mapStr ty f t = case (ty,t) of
|
||||
_ | elem ty [typeStr,typeTok] -> App f t
|
||||
(_, R ts) -> R [(l,mapField v) | (l,v) <- ts]
|
||||
(Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs]
|
||||
_ -> t
|
||||
where
|
||||
mapField (mty,te) = case mty of
|
||||
Just ty -> (mty,mapStr ty f te)
|
||||
_ -> (mty,te)
|
||||
-}
|
||||
@@ -1,588 +1,3 @@
|
||||
-- | Functions for computing the values of terms in the concrete syntax, in
|
||||
-- | preparation for PMCFG generation.
|
||||
module GF.Compile.Compute.Concrete
|
||||
(GlobalEnv, GLocation, resourceValues, geLoc, geGrammar,
|
||||
normalForm,
|
||||
Value(..), Bind(..), Env, value2term, eval, vapply
|
||||
) where
|
||||
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
|
||||
|
||||
import GF.Grammar hiding (Env, VGen, VApp, VRecType)
|
||||
import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
|
||||
import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,cTrace,cPBool)
|
||||
import GF.Grammar.PatternMatch(matchPattern,measurePatt)
|
||||
import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel
|
||||
import GF.Compile.Compute.Value hiding (Error)
|
||||
import GF.Compile.Compute.Predef(predef,predefName,delta)
|
||||
import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)
|
||||
import GF.Data.Operations(Err,err,errIn,maybeErr,mapPairsM)
|
||||
import GF.Data.Utilities(mapFst,mapSnd)
|
||||
import GF.Infra.Option
|
||||
import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus
|
||||
import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf
|
||||
--import Data.Char (isUpper,toUpper,toLower)
|
||||
import GF.Text.Pretty
|
||||
import qualified Data.Map as Map
|
||||
import Debug.Trace(trace)
|
||||
|
||||
-- * Main entry points
|
||||
|
||||
normalForm :: GlobalEnv -> L Ident -> Term -> Term
|
||||
normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)
|
||||
|
||||
nfx env@(GE _ _ _ loc) t = do
|
||||
v <- eval env [] t
|
||||
case value2term loc [] v of
|
||||
Left i -> fail ("variable #"++show i++" is out of scope")
|
||||
Right t -> return t
|
||||
|
||||
eval :: GlobalEnv -> Env -> Term -> Err Value
|
||||
eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t
|
||||
where
|
||||
cenv = CE gr rvs opts loc (map fst env)
|
||||
|
||||
--apply env = apply' env
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- * Environments
|
||||
|
||||
type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))
|
||||
|
||||
data GlobalEnv = GE Grammar ResourceValues Options GLocation
|
||||
data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,
|
||||
opts::Options,
|
||||
gloc::GLocation,local::LocalScope}
|
||||
type GLocation = L Ident
|
||||
type LocalScope = [Ident]
|
||||
type Stack = [Value]
|
||||
type OpenValue = Stack->Value
|
||||
|
||||
geLoc (GE _ _ _ loc) = loc
|
||||
geGrammar (GE gr _ _ _) = gr
|
||||
|
||||
ext b env = env{local=b:local env}
|
||||
extend bs env = env{local=bs++local env}
|
||||
global env = GE (srcgr env) (rvs env) (opts env) (gloc env)
|
||||
|
||||
var :: CompleteEnv -> Ident -> Err OpenValue
|
||||
var env x = maybe unbound pick' (elemIndex x (local env))
|
||||
where
|
||||
unbound = fail ("Unknown variable: "++showIdent x)
|
||||
pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
|
||||
err i vs = bug $ "Stack problem: "++showIdent x++": "
|
||||
++unwords (map showIdent (local env))
|
||||
++" => "++show (i,length vs)
|
||||
ok v = --trace ("var "++show x++" = "++show v) $
|
||||
v
|
||||
|
||||
pick :: Int -> Stack -> Maybe Value
|
||||
pick 0 (v:_) = Just v
|
||||
pick i (_:vs) = pick (i-1) vs
|
||||
pick i vs = Nothing -- bug $ "pick "++show (i,vs)
|
||||
|
||||
resource env (m,c) =
|
||||
-- err bug id $
|
||||
if isPredefCat c
|
||||
then value0 env =<< lockRecType c defLinType -- hmm
|
||||
else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)
|
||||
where e = fail $ "Not found: "++render m++"."++showIdent c
|
||||
|
||||
-- | Convert operators once, not every time they are looked up
|
||||
resourceValues :: Options -> SourceGrammar -> GlobalEnv
|
||||
resourceValues opts gr = env
|
||||
where
|
||||
env = GE gr rvs opts (L NoLoc identW)
|
||||
rvs = Map.mapWithKey moduleResources (moduleMap gr)
|
||||
moduleResources m = Map.mapWithKey (moduleResource m) . jments
|
||||
moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)
|
||||
let loc = L l c
|
||||
qloc = L l (Q (m,c))
|
||||
eval (GE gr rvs opts loc) [] (traceRes qloc t)
|
||||
|
||||
traceRes = if flag optTrace opts
|
||||
then traceResource
|
||||
else const id
|
||||
|
||||
-- * Tracing
|
||||
|
||||
-- | Insert a call to the trace function under the top-level lambdas
|
||||
traceResource (L l q) t =
|
||||
case termFormCnc t of
|
||||
(abs,body) -> mkAbs abs (mkApp traceQ [args,body])
|
||||
where
|
||||
args = R $ tuple2record (K lstr:[Vr x|(bt,x)<-abs,bt==Explicit])
|
||||
lstr = render (l<>":"<>ppTerm Qualified 0 q)
|
||||
traceQ = Q (cPredef,cTrace)
|
||||
|
||||
-- * Computing values
|
||||
|
||||
-- | Computing the value of a top-level term
|
||||
value0 :: CompleteEnv -> Term -> Err Value
|
||||
value0 env = eval (global env) []
|
||||
|
||||
-- | Computing the value of a term
|
||||
value :: CompleteEnv -> Term -> Err OpenValue
|
||||
value env t0 =
|
||||
-- Each terms is traversed only once by this function, using only statically
|
||||
-- available information. Notably, the values of lambda bound variables
|
||||
-- will be unknown during the term traversal phase.
|
||||
-- The result is an OpenValue, which is a function that may be applied many
|
||||
-- times to different dynamic values, but without the term traversal overhead
|
||||
-- and without recomputing other statically known information.
|
||||
-- For this to work, there should be no recursive calls under lambdas here.
|
||||
-- Whenever we need to construct the OpenValue function with an explicit
|
||||
-- lambda, we have to lift the recursive calls outside the lambda.
|
||||
-- (See e.g. the rules for Let, Prod and Abs)
|
||||
{-
|
||||
trace (render $ text "value"<+>sep [ppL (gloc env)<>text ":",
|
||||
brackets (fsep (map ppIdent (local env))),
|
||||
ppTerm Unqualified 10 t0]) $
|
||||
--}
|
||||
errIn (render t0) $
|
||||
case t0 of
|
||||
Vr x -> var env x
|
||||
Q x@(m,f)
|
||||
| m == cPredef -> if f==cErrorType -- to be removed
|
||||
then let p = identS "P"
|
||||
in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])
|
||||
else if f==cPBool
|
||||
then const # resource env x
|
||||
else const . flip VApp [] # predef f
|
||||
| otherwise -> const # resource env x --valueResDef (fst env) x
|
||||
QC x -> return $ const (VCApp x [])
|
||||
App e1 e2 -> apply' env e1 . (:[]) =<< value env e2
|
||||
Let (x,(oty,t)) body -> do vb <- value (ext x env) body
|
||||
vt <- value env t
|
||||
return $ \ vs -> vb (vt vs:vs)
|
||||
Meta i -> return $ \ vs -> VMeta i (zip (local env) vs) []
|
||||
Prod bt x t1 t2 ->
|
||||
do vt1 <- value env t1
|
||||
vt2 <- value (ext x env) t2
|
||||
return $ \ vs -> VProd bt (vt1 vs) x $ Bind $ \ vx -> vt2 (vx:vs)
|
||||
Abs bt x t -> do vt <- value (ext x env) t
|
||||
return $ VAbs bt x . Bind . \ vs vx -> vt (vx:vs)
|
||||
EInt n -> return $ const (VInt n)
|
||||
EFloat f -> return $ const (VFloat f)
|
||||
K s -> return $ const (VString s)
|
||||
Empty -> return $ const (VString "")
|
||||
Sort s | s == cTok -> return $ const (VSort cStr) -- to be removed
|
||||
| otherwise -> return $ const (VSort s)
|
||||
ImplArg t -> (VImplArg.) # value env t
|
||||
Table p res -> liftM2 VTblType # value env p <# value env res
|
||||
RecType rs -> do lovs <- mapPairsM (value env) rs
|
||||
return $ \vs->VRecType $ mapSnd ($vs) lovs
|
||||
t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
|
||||
FV ts -> ((vfv .) # sequence) # mapM (value env) ts
|
||||
R as -> do lovs <- mapPairsM (value env.snd) as
|
||||
return $ \ vs->VRec $ mapSnd ($vs) lovs
|
||||
T i cs -> valueTable env i cs
|
||||
V ty ts -> do pvs <- paramValues env ty
|
||||
((VV ty pvs .) . sequence) # mapM (value env) ts
|
||||
C t1 t2 -> ((ok2p vconcat.) # both id) # both (value env) (t1,t2)
|
||||
S t1 t2 -> ((select env.) # both id) # both (value env) (t1,t2)
|
||||
P t l -> --maybe (bug $ "project "++show l++" from "++show v) id $
|
||||
do ov <- value env t
|
||||
return $ \ vs -> let v = ov vs
|
||||
in maybe (VP v l) id (proj l v)
|
||||
Alts t tts -> (\v vts -> VAlts # v <# mapM (both id) vts) # value env t <# mapM (both (value env)) tts
|
||||
Strs ts -> ((VStrs.) # sequence) # mapM (value env) ts
|
||||
Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)
|
||||
ELin c r -> (unlockVRec (gloc env) c.) # value env r
|
||||
EPatt p -> return $ const (VPatt p) -- hmm
|
||||
EPattType ty -> do vt <- value env ty
|
||||
return (VPattType . vt)
|
||||
Typed t ty -> value env t
|
||||
t -> fail.render $ "value"<+>ppTerm Unqualified 10 t $$ show t
|
||||
|
||||
vconcat vv@(v1,v2) =
|
||||
case vv of
|
||||
(VString "",_) -> v2
|
||||
(_,VString "") -> v1
|
||||
(VApp NonExist _,_) -> v1
|
||||
(_,VApp NonExist _) -> v2
|
||||
_ -> VC v1 v2
|
||||
|
||||
proj l v | isLockLabel l = return (VRec [])
|
||||
---- a workaround 18/2/2005: take this away and find the reason
|
||||
---- why earlier compilation destroys the lock field
|
||||
proj l v =
|
||||
case v of
|
||||
VFV vs -> liftM vfv (mapM (proj l) vs)
|
||||
VRec rs -> lookup l rs
|
||||
-- VExtR v1 v2 -> proj l v2 `mplus` proj l v1 -- hmm
|
||||
VS (VV pty pvs rs) v2 -> flip VS v2 . VV pty pvs # mapM (proj l) rs
|
||||
_ -> return (ok1 VP v l)
|
||||
|
||||
ok1 f v1@(VError {}) _ = v1
|
||||
ok1 f v1 v2 = f v1 v2
|
||||
|
||||
ok2 f v1@(VError {}) _ = v1
|
||||
ok2 f _ v2@(VError {}) = v2
|
||||
ok2 f v1 v2 = f v1 v2
|
||||
|
||||
ok2p f (v1@VError {},_) = v1
|
||||
ok2p f (_,v2@VError {}) = v2
|
||||
ok2p f vv = f vv
|
||||
|
||||
unlockVRec loc c0 v0 = v0
|
||||
{-
|
||||
unlockVRec loc c0 v0 = unlockVRec' c0 v0
|
||||
where
|
||||
unlockVRec' ::Ident -> Value -> Value
|
||||
unlockVRec' c v =
|
||||
case v of
|
||||
-- VClosure env t -> err bug (VClosure env) (unlockRecord c t)
|
||||
VAbs bt x (Bind f) -> VAbs bt x (Bind $ \ v -> unlockVRec' c (f v))
|
||||
VRec rs -> plusVRec rs lock
|
||||
-- _ -> VExtR v (VRec lock) -- hmm
|
||||
_ -> {-trace (render $ ppL loc $ "unlock non-record "++show v0)-} v -- hmm
|
||||
-- _ -> bugloc loc $ "unlock non-record "++show v0
|
||||
where
|
||||
lock = [(lockLabel c,VRec [])]
|
||||
-}
|
||||
|
||||
-- suspicious, but backwards compatible
|
||||
plusVRec rs1 rs2 = VRec ([(l,v)|(l,v)<-rs1,l `notElem` ls2] ++ rs2)
|
||||
where ls2 = map fst rs2
|
||||
|
||||
extR t vv =
|
||||
case vv of
|
||||
(VFV vs,v2) -> vfv [extR t (v1,v2)|v1<-vs]
|
||||
(v1,VFV vs) -> vfv [extR t (v1,v2)|v2<-vs]
|
||||
(VRecType rs1, VRecType rs2) ->
|
||||
case intersect (map fst rs1) (map fst rs2) of
|
||||
[] -> VRecType (rs1 ++ rs2)
|
||||
ls -> error $ "clash"<+>show ls
|
||||
(VRec rs1, VRec rs2) -> plusVRec rs1 rs2
|
||||
(v1 , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm
|
||||
(VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s
|
||||
-- (v1,v2) -> ok2 VExtR v1 v2 -- hmm
|
||||
(v1,v2) -> error $ "not records" $$ show v1 $$ show v2
|
||||
where
|
||||
error explain = ppbug $ "The term" <+> t
|
||||
<+> "is not reducible" $$ explain
|
||||
|
||||
glue env (v1,v2) = glu v1 v2
|
||||
where
|
||||
glu v1 v2 =
|
||||
case (v1,v2) of
|
||||
(VFV vs,v2) -> vfv [glu v1 v2|v1<-vs]
|
||||
(v1,VFV vs) -> vfv [glu v1 v2|v2<-vs]
|
||||
(VString s1,VString s2) -> VString (s1++s2)
|
||||
(v1,VAlts d vs) -> VAlts (glx d) [(glx v,c) | (v,c) <- vs]
|
||||
where glx v2 = glu v1 v2
|
||||
(v1@(VAlts {}),v2) ->
|
||||
--err (const (ok2 VGlue v1 v2)) id $
|
||||
err bug id $
|
||||
do y' <- strsFromValue v2
|
||||
x' <- strsFromValue v1
|
||||
return $ vfv [foldr1 VC (map VString (str2strings (glueStr v u))) | v <- x', u <- y']
|
||||
(VC va vb,v2) -> VC va (glu vb v2)
|
||||
(v1,VC va vb) -> VC (glu v1 va) vb
|
||||
(VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb
|
||||
(v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb
|
||||
(v1@(VApp NonExist _),_) -> v1
|
||||
(_,v2@(VApp NonExist _)) -> v2
|
||||
-- (v1,v2) -> ok2 VGlue v1 v2
|
||||
(v1,v2) -> if flag optPlusAsBind (opts env)
|
||||
then VC v1 (VC (VApp BIND []) v2)
|
||||
else let loc = gloc env
|
||||
vt v = case value2term loc (local env) v of
|
||||
Left i -> Error ('#':show i)
|
||||
Right t -> t
|
||||
originalMsg = render $ ppL loc (hang "unsupported token gluing" 4
|
||||
(Glue (vt v1) (vt v2)))
|
||||
term = render $ pp $ Glue (vt v1) (vt v2)
|
||||
in error $ unlines
|
||||
[originalMsg
|
||||
,""
|
||||
,"There was a problem in the expression `"++term++"`, either:"
|
||||
,"1) You are trying to use + on runtime arguments, possibly via an oper."
|
||||
,"2) One of the arguments in `"++term++"` is a bound variable from pattern matching a string, but the cases are non-exhaustive."
|
||||
,"For more help see https://github.com/GrammaticalFramework/gf-core/tree/master/doc/errors/gluing.md"
|
||||
]
|
||||
|
||||
|
||||
-- | to get a string from a value that represents a sequence of terminals
|
||||
strsFromValue :: Value -> Err [Str]
|
||||
strsFromValue t = case t of
|
||||
VString s -> return [str s]
|
||||
VC s t -> do
|
||||
s' <- strsFromValue s
|
||||
t' <- strsFromValue t
|
||||
return [plusStr x y | x <- s', y <- t']
|
||||
{-
|
||||
VGlue s t -> do
|
||||
s' <- strsFromValue s
|
||||
t' <- strsFromValue t
|
||||
return [glueStr x y | x <- s', y <- t']
|
||||
-}
|
||||
VAlts d vs -> do
|
||||
d0 <- strsFromValue d
|
||||
v0 <- mapM (strsFromValue . fst) vs
|
||||
c0 <- mapM (strsFromValue . snd) vs
|
||||
--let vs' = zip v0 c0
|
||||
return [strTok (str2strings def) vars |
|
||||
def <- d0,
|
||||
vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
|
||||
vv <- sequence v0]
|
||||
]
|
||||
VFV ts -> concat # mapM strsFromValue ts
|
||||
VStrs ts -> concat # mapM strsFromValue ts
|
||||
|
||||
_ -> fail ("cannot get Str from value " ++ show t)
|
||||
|
||||
vfv vs = case nub vs of
|
||||
[v] -> v
|
||||
vs -> VFV vs
|
||||
|
||||
select env vv =
|
||||
case vv of
|
||||
(v1,VFV vs) -> vfv [select env (v1,v2)|v2<-vs]
|
||||
(VFV vs,v2) -> vfv [select env (v1,v2)|v1<-vs]
|
||||
(v1@(VV pty vs rs),v2) ->
|
||||
err (const (VS v1 v2)) id $
|
||||
do --ats <- allParamValues (srcgr env) pty
|
||||
--let vs = map (value0 env) ats
|
||||
i <- maybeErr "no match" $ findIndex (==v2) vs
|
||||
return (ix (gloc env) "select" rs i)
|
||||
(VT _ _ [(PW,Bind b)],_) -> {-trace "eliminate wild card table" $-} b []
|
||||
(v1@(VT _ _ cs),v2) ->
|
||||
err (\_->ok2 VS v1 v2) (err bug id . valueMatch env) $
|
||||
match (gloc env) cs v2
|
||||
(VS (VV pty pvs rs) v12,v2) -> VS (VV pty pvs [select env (v11,v2)|v11<-rs]) v12
|
||||
(v1,v2) -> ok2 VS v1 v2
|
||||
|
||||
match loc cs v =
|
||||
case value2term loc [] v of
|
||||
Left i -> bad ("variable #"++show i++" is out of scope")
|
||||
Right t -> err bad return (matchPattern cs t)
|
||||
where
|
||||
bad = fail . ("In pattern matching: "++)
|
||||
|
||||
valueMatch :: CompleteEnv -> (Bind Env,Substitution) -> Err Value
|
||||
valueMatch env (Bind f,env') = f # mapPairsM (value0 env) env'
|
||||
|
||||
valueTable :: CompleteEnv -> TInfo -> [Case] -> Err OpenValue
|
||||
valueTable env i cs =
|
||||
case i of
|
||||
TComp ty -> do pvs <- paramValues env ty
|
||||
((VV ty pvs .) # sequence) # mapM (value env.snd) cs
|
||||
_ -> do ty <- getTableType i
|
||||
cs' <- mapM valueCase cs
|
||||
err (dynamic cs' ty) return (convert cs' ty)
|
||||
where
|
||||
dynamic cs' ty _ = cases cs' # value env ty
|
||||
|
||||
cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
|
||||
where
|
||||
keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
|
||||
VT wild (vty vs) (mapSnd ($vs) cs')
|
||||
|
||||
wild = case i of TWild _ -> True; _ -> False
|
||||
|
||||
convertv cs' vty =
|
||||
case value2term (gloc env) [] vty of
|
||||
Left i -> fail ("variable #"++show i++" is out of scope")
|
||||
Right pty -> convert' cs' =<< paramValues'' env pty
|
||||
|
||||
convert cs' ty = convert' cs' =<< paramValues' env ty
|
||||
|
||||
convert' cs' ((pty,vs),pvs) =
|
||||
do sts <- mapM (matchPattern cs') vs
|
||||
return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
|
||||
(mapFst ($vs) sts)
|
||||
|
||||
valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
|
||||
pvs <- linPattVars p'
|
||||
vt <- value (extend pvs env) t
|
||||
return (p',\vs-> Bind $ \bs-> vt (push' p' bs pvs vs))
|
||||
|
||||
inlinePattMacro p =
|
||||
case p of
|
||||
PM qc -> do r <- resource env qc
|
||||
case r of
|
||||
VPatt p' -> inlinePattMacro p'
|
||||
_ -> ppbug $ hang "Expected pattern macro:" 4
|
||||
(show r)
|
||||
_ -> composPattOp inlinePattMacro p
|
||||
|
||||
|
||||
paramValues env ty = snd # paramValues' env ty
|
||||
|
||||
paramValues' env ty = paramValues'' env =<< nfx (global env) ty
|
||||
|
||||
paramValues'' env pty = do ats <- allParamValues (srcgr env) pty
|
||||
pvs <- mapM (eval (global env) []) ats
|
||||
return ((pty,ats),pvs)
|
||||
|
||||
push' p bs xs = if length bs/=length xs
|
||||
then bug $ "push "++show (p,bs,xs)
|
||||
else push bs xs
|
||||
|
||||
push :: Env -> LocalScope -> Stack -> Stack
|
||||
push bs [] vs = vs
|
||||
push bs (x:xs) vs = maybe err id (lookup x bs):push bs xs vs
|
||||
where err = bug $ "Unbound pattern variable "++showIdent x
|
||||
|
||||
apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
|
||||
apply' env t [] = value env t
|
||||
apply' env t vs =
|
||||
case t of
|
||||
QC x -> return $ \ svs -> VCApp x (map ($svs) vs)
|
||||
{-
|
||||
Q x@(m,f) | m==cPredef -> return $
|
||||
let constr = --trace ("predef "++show x) .
|
||||
VApp x
|
||||
in \ svs -> maybe constr id (Map.lookup f predefs)
|
||||
$ map ($svs) vs
|
||||
| otherwise -> do r <- resource env x
|
||||
return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
|
||||
-}
|
||||
App t1 t2 -> apply' env t1 . (:vs) =<< value env t2
|
||||
_ -> do fv <- value env t
|
||||
return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)
|
||||
|
||||
vapply :: GLocation -> Value -> [Value] -> Value
|
||||
vapply loc v [] = v
|
||||
vapply loc v vs =
|
||||
case v of
|
||||
VError {} -> v
|
||||
-- VClosure env (Abs b x t) -> beta gr env b x t vs
|
||||
VAbs bt _ (Bind f) -> vbeta loc bt f vs
|
||||
VApp pre vs1 -> delta' pre (vs1++vs)
|
||||
where
|
||||
delta' Trace (v1:v2:vs) = let vr = vapply loc v2 vs
|
||||
in vtrace loc v1 vr
|
||||
delta' pre vs = err msg vfv $ mapM (delta pre) (varyList vs)
|
||||
--msg = const (VApp pre (vs1++vs))
|
||||
msg = bug . (("Applying Predef."++showIdent (predefName pre)++": ")++)
|
||||
VS (VV t pvs fs) s -> VS (VV t pvs [vapply loc f vs|f<-fs]) s
|
||||
VFV fs -> vfv [vapply loc f vs|f<-fs]
|
||||
VCApp f vs0 -> VCApp f (vs0++vs)
|
||||
VMeta i env vs0 -> VMeta i env (vs0++vs)
|
||||
VGen i vs0 -> VGen i (vs0++vs)
|
||||
v -> bug $ "vapply "++show v++" "++show vs
|
||||
|
||||
vbeta loc bt f (v:vs) =
|
||||
case (bt,v) of
|
||||
(Implicit,VImplArg v) -> ap v
|
||||
(Explicit, v) -> ap v
|
||||
where
|
||||
ap (VFV avs) = vfv [vapply loc (f v) vs|v<-avs]
|
||||
ap v = vapply loc (f v) vs
|
||||
|
||||
vary (VFV vs) = vs
|
||||
vary v = [v]
|
||||
varyList = mapM vary
|
||||
|
||||
{-
|
||||
beta env b x t (v:vs) =
|
||||
case (b,v) of
|
||||
(Implicit,VImplArg v) -> apply' (ext (x,v) env) t vs
|
||||
(Explicit, v) -> apply' (ext (x,v) env) t vs
|
||||
-}
|
||||
|
||||
vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res
|
||||
where
|
||||
pv v = case v of
|
||||
VRec (f:as) -> hang (pf f) 4 (fsep (map pa as))
|
||||
_ -> ppV v
|
||||
pf (_,VString n) = pp n
|
||||
pf (_,v) = ppV v
|
||||
pa (_,v) = ppV v
|
||||
ppV v = case value2term' True loc [] v of
|
||||
Left i -> "variable #" <> pp i <+> "is out of scope"
|
||||
Right t -> ppTerm Unqualified 10 t
|
||||
|
||||
-- | Convert a value back to a term
|
||||
value2term :: GLocation -> [Ident] -> Value -> Either Int Term
|
||||
value2term = value2term' False
|
||||
value2term' stop loc xs v0 =
|
||||
case v0 of
|
||||
VApp pre vs -> liftM (foldl App (Q (cPredef,predefName pre))) (mapM v2t vs)
|
||||
VCApp f vs -> liftM (foldl App (QC f)) (mapM v2t vs)
|
||||
VGen j vs -> liftM2 (foldl App) (var j) (mapM v2t vs)
|
||||
VMeta j env vs -> liftM (foldl App (Meta j)) (mapM v2t vs)
|
||||
VProd bt v x f -> liftM2 (Prod bt x) (v2t v) (v2t' x f)
|
||||
VAbs bt x f -> liftM (Abs bt x) (v2t' x f)
|
||||
VInt n -> return (EInt n)
|
||||
VFloat f -> return (EFloat f)
|
||||
VString s -> return (if null s then Empty else K s)
|
||||
VSort s -> return (Sort s)
|
||||
VImplArg v -> liftM ImplArg (v2t v)
|
||||
VTblType p res -> liftM2 Table (v2t p) (v2t res)
|
||||
VRecType rs -> liftM RecType (mapM (\(l,v) -> fmap ((,) l) (v2t v)) rs)
|
||||
VRec as -> liftM R (mapM (\(l,v) -> v2t v >>= \t -> return (l,(Nothing,t))) as)
|
||||
VV t _ vs -> liftM (V t) (mapM v2t vs)
|
||||
VT wild v cs -> v2t v >>= \t -> liftM (T ((if wild then TWild else TTyped) t)) (mapM nfcase cs)
|
||||
VFV vs -> liftM FV (mapM v2t vs)
|
||||
VC v1 v2 -> liftM2 C (v2t v1) (v2t v2)
|
||||
VS v1 v2 -> liftM2 S (v2t v1) (v2t v2)
|
||||
VP v l -> v2t v >>= \t -> return (P t l)
|
||||
VPatt p -> return (EPatt p)
|
||||
VPattType v -> v2t v >>= return . EPattType
|
||||
VAlts v vvs -> liftM2 Alts (v2t v) (mapM (\(x,y) -> liftM2 (,) (v2t x) (v2t y)) vvs)
|
||||
VStrs vs -> liftM Strs (mapM v2t vs)
|
||||
-- VGlue v1 v2 -> Glue (v2t v1) (v2t v2)
|
||||
-- VExtR v1 v2 -> ExtR (v2t v1) (v2t v2)
|
||||
VError err -> return (Error err)
|
||||
|
||||
where
|
||||
v2t = v2txs xs
|
||||
v2txs = value2term' stop loc
|
||||
v2t' x f = v2txs (x:xs) (bind f (gen xs))
|
||||
|
||||
var j
|
||||
| j<length xs = Right (Vr (reverse xs !! j))
|
||||
| otherwise = Left j
|
||||
|
||||
|
||||
pushs xs e = foldr push e xs
|
||||
push x (env,xs) = ((x,gen xs):env,x:xs)
|
||||
gen xs = VGen (length xs) []
|
||||
|
||||
nfcase (p,f) = liftM ((,) p) (v2txs xs' (bind f env'))
|
||||
where (env',xs') = pushs (pattVars p) ([],xs)
|
||||
|
||||
bind (Bind f) x = if stop
|
||||
then VSort (identS "...") -- hmm
|
||||
else f x
|
||||
|
||||
|
||||
linPattVars p =
|
||||
if null dups
|
||||
then return pvs
|
||||
else fail.render $ hang "Pattern is not linear. All variable names on the left-hand side must be distinct." 4 (ppPatt Unqualified 0 p)
|
||||
where
|
||||
allpvs = allPattVars p
|
||||
pvs = nub allpvs
|
||||
dups = allpvs \\ pvs
|
||||
|
||||
pattVars = nub . allPattVars
|
||||
allPattVars p =
|
||||
case p of
|
||||
PV i -> [i]
|
||||
PAs i p -> i:allPattVars p
|
||||
_ -> collectPattOp allPattVars p
|
||||
|
||||
---
|
||||
ix loc fn xs i =
|
||||
if i<n
|
||||
then xs !! i
|
||||
else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
|
||||
where n = length xs
|
||||
|
||||
infixl 1 #,<# --,@@
|
||||
|
||||
f # x = fmap f x
|
||||
mf <# mx = ap mf mx
|
||||
--m1 @@ m2 = (m1 =<<) . m2
|
||||
|
||||
both f (x,y) = (,) # f x <# f y
|
||||
|
||||
bugloc loc s = ppbug $ ppL loc s
|
||||
|
||||
bug msg = ppbug msg
|
||||
ppbug doc = error $ render $ hang "Internal error in Compute.Concrete:" 4 doc
|
||||
module GF.Compile.Compute.Concrete{-(module M)-} where
|
||||
--import GF.Compile.Compute.ConcreteLazy as M -- New
|
||||
--import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient
|
||||
|
||||
580
src/compiler/GF/Compile/Compute/ConcreteNew.hs
Normal file
580
src/compiler/GF/Compile/Compute/ConcreteNew.hs
Normal file
@@ -0,0 +1,580 @@
|
||||
-- | Functions for computing the values of terms in the concrete syntax, in
|
||||
-- | preparation for PMCFG generation.
|
||||
module GF.Compile.Compute.ConcreteNew
|
||||
(GlobalEnv, GLocation, resourceValues, geLoc, geGrammar,
|
||||
normalForm,
|
||||
Value(..), Bind(..), Env, value2term, eval, vapply
|
||||
) where
|
||||
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
|
||||
|
||||
import GF.Grammar hiding (Env, VGen, VApp, VRecType)
|
||||
import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
|
||||
import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,cTrace,cPBool)
|
||||
import GF.Grammar.PatternMatch(matchPattern,measurePatt)
|
||||
import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel
|
||||
import GF.Compile.Compute.Value hiding (Error)
|
||||
import GF.Compile.Compute.Predef(predef,predefName,delta)
|
||||
import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)
|
||||
import GF.Data.Operations(Err,err,errIn,maybeErr,combinations,mapPairsM)
|
||||
import GF.Data.Utilities(mapFst,mapSnd)
|
||||
import GF.Infra.Option
|
||||
import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus
|
||||
import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf
|
||||
--import Data.Char (isUpper,toUpper,toLower)
|
||||
import GF.Text.Pretty
|
||||
import qualified Data.Map as Map
|
||||
import Debug.Trace(trace)
|
||||
|
||||
-- * Main entry points
|
||||
|
||||
normalForm :: GlobalEnv -> L Ident -> Term -> Term
|
||||
normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)
|
||||
|
||||
nfx env@(GE _ _ _ loc) t = do
|
||||
v <- eval env [] t
|
||||
case value2term loc [] v of
|
||||
Left i -> fail ("variable #"++show i++" is out of scope")
|
||||
Right t -> return t
|
||||
|
||||
eval :: GlobalEnv -> Env -> Term -> Err Value
|
||||
eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t
|
||||
where
|
||||
cenv = CE gr rvs opts loc (map fst env)
|
||||
|
||||
--apply env = apply' env
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- * Environments
|
||||
|
||||
type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))
|
||||
|
||||
data GlobalEnv = GE Grammar ResourceValues Options GLocation
|
||||
data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,
|
||||
opts::Options,
|
||||
gloc::GLocation,local::LocalScope}
|
||||
type GLocation = L Ident
|
||||
type LocalScope = [Ident]
|
||||
type Stack = [Value]
|
||||
type OpenValue = Stack->Value
|
||||
|
||||
geLoc (GE _ _ _ loc) = loc
|
||||
geGrammar (GE gr _ _ _) = gr
|
||||
|
||||
ext b env = env{local=b:local env}
|
||||
extend bs env = env{local=bs++local env}
|
||||
global env = GE (srcgr env) (rvs env) (opts env) (gloc env)
|
||||
|
||||
var :: CompleteEnv -> Ident -> Err OpenValue
|
||||
var env x = maybe unbound pick' (elemIndex x (local env))
|
||||
where
|
||||
unbound = fail ("Unknown variable: "++showIdent x)
|
||||
pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
|
||||
err i vs = bug $ "Stack problem: "++showIdent x++": "
|
||||
++unwords (map showIdent (local env))
|
||||
++" => "++show (i,length vs)
|
||||
ok v = --trace ("var "++show x++" = "++show v) $
|
||||
v
|
||||
|
||||
pick :: Int -> Stack -> Maybe Value
|
||||
pick 0 (v:_) = Just v
|
||||
pick i (_:vs) = pick (i-1) vs
|
||||
pick i vs = Nothing -- bug $ "pick "++show (i,vs)
|
||||
|
||||
resource env (m,c) =
|
||||
-- err bug id $
|
||||
if isPredefCat c
|
||||
then value0 env =<< lockRecType c defLinType -- hmm
|
||||
else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)
|
||||
where e = fail $ "Not found: "++render m++"."++showIdent c
|
||||
|
||||
-- | Convert operators once, not every time they are looked up
|
||||
resourceValues :: Options -> SourceGrammar -> GlobalEnv
|
||||
resourceValues opts gr = env
|
||||
where
|
||||
env = GE gr rvs opts (L NoLoc identW)
|
||||
rvs = Map.mapWithKey moduleResources (moduleMap gr)
|
||||
moduleResources m = Map.mapWithKey (moduleResource m) . jments
|
||||
moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)
|
||||
let loc = L l c
|
||||
qloc = L l (Q (m,c))
|
||||
eval (GE gr rvs opts loc) [] (traceRes qloc t)
|
||||
|
||||
traceRes = if flag optTrace opts
|
||||
then traceResource
|
||||
else const id
|
||||
|
||||
-- * Tracing
|
||||
|
||||
-- | Insert a call to the trace function under the top-level lambdas
|
||||
traceResource (L l q) t =
|
||||
case termFormCnc t of
|
||||
(abs,body) -> mkAbs abs (mkApp traceQ [args,body])
|
||||
where
|
||||
args = R $ tuple2record (K lstr:[Vr x|(bt,x)<-abs,bt==Explicit])
|
||||
lstr = render (l<>":"<>ppTerm Qualified 0 q)
|
||||
traceQ = Q (cPredef,cTrace)
|
||||
|
||||
-- * Computing values
|
||||
|
||||
-- | Computing the value of a top-level term
|
||||
value0 :: CompleteEnv -> Term -> Err Value
|
||||
value0 env = eval (global env) []
|
||||
|
||||
-- | Computing the value of a term
|
||||
value :: CompleteEnv -> Term -> Err OpenValue
|
||||
value env t0 =
|
||||
-- Each terms is traversed only once by this function, using only statically
|
||||
-- available information. Notably, the values of lambda bound variables
|
||||
-- will be unknown during the term traversal phase.
|
||||
-- The result is an OpenValue, which is a function that may be applied many
|
||||
-- times to different dynamic values, but without the term traversal overhead
|
||||
-- and without recomputing other statically known information.
|
||||
-- For this to work, there should be no recursive calls under lambdas here.
|
||||
-- Whenever we need to construct the OpenValue function with an explicit
|
||||
-- lambda, we have to lift the recursive calls outside the lambda.
|
||||
-- (See e.g. the rules for Let, Prod and Abs)
|
||||
{-
|
||||
trace (render $ text "value"<+>sep [ppL (gloc env)<>text ":",
|
||||
brackets (fsep (map ppIdent (local env))),
|
||||
ppTerm Unqualified 10 t0]) $
|
||||
--}
|
||||
errIn (render t0) $
|
||||
case t0 of
|
||||
Vr x -> var env x
|
||||
Q x@(m,f)
|
||||
| m == cPredef -> if f==cErrorType -- to be removed
|
||||
then let p = identS "P"
|
||||
in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])
|
||||
else if f==cPBool
|
||||
then const # resource env x
|
||||
else const . flip VApp [] # predef f
|
||||
| otherwise -> const # resource env x --valueResDef (fst env) x
|
||||
QC x -> return $ const (VCApp x [])
|
||||
App e1 e2 -> apply' env e1 . (:[]) =<< value env e2
|
||||
Let (x,(oty,t)) body -> do vb <- value (ext x env) body
|
||||
vt <- value env t
|
||||
return $ \ vs -> vb (vt vs:vs)
|
||||
Meta i -> return $ \ vs -> VMeta i (zip (local env) vs) []
|
||||
Prod bt x t1 t2 ->
|
||||
do vt1 <- value env t1
|
||||
vt2 <- value (ext x env) t2
|
||||
return $ \ vs -> VProd bt (vt1 vs) x $ Bind $ \ vx -> vt2 (vx:vs)
|
||||
Abs bt x t -> do vt <- value (ext x env) t
|
||||
return $ VAbs bt x . Bind . \ vs vx -> vt (vx:vs)
|
||||
EInt n -> return $ const (VInt n)
|
||||
EFloat f -> return $ const (VFloat f)
|
||||
K s -> return $ const (VString s)
|
||||
Empty -> return $ const (VString "")
|
||||
Sort s | s == cTok -> return $ const (VSort cStr) -- to be removed
|
||||
| otherwise -> return $ const (VSort s)
|
||||
ImplArg t -> (VImplArg.) # value env t
|
||||
Table p res -> liftM2 VTblType # value env p <# value env res
|
||||
RecType rs -> do lovs <- mapPairsM (value env) rs
|
||||
return $ \vs->VRecType $ mapSnd ($vs) lovs
|
||||
t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
|
||||
FV ts -> ((vfv .) # sequence) # mapM (value env) ts
|
||||
R as -> do lovs <- mapPairsM (value env.snd) as
|
||||
return $ \ vs->VRec $ mapSnd ($vs) lovs
|
||||
T i cs -> valueTable env i cs
|
||||
V ty ts -> do pvs <- paramValues env ty
|
||||
((VV ty pvs .) . sequence) # mapM (value env) ts
|
||||
C t1 t2 -> ((ok2p vconcat.) # both id) # both (value env) (t1,t2)
|
||||
S t1 t2 -> ((select env.) # both id) # both (value env) (t1,t2)
|
||||
P t l -> --maybe (bug $ "project "++show l++" from "++show v) id $
|
||||
do ov <- value env t
|
||||
return $ \ vs -> let v = ov vs
|
||||
in maybe (VP v l) id (proj l v)
|
||||
Alts t tts -> (\v vts -> VAlts # v <# mapM (both id) vts) # value env t <# mapM (both (value env)) tts
|
||||
Strs ts -> ((VStrs.) # sequence) # mapM (value env) ts
|
||||
Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)
|
||||
ELin c r -> (unlockVRec (gloc env) c.) # value env r
|
||||
EPatt p -> return $ const (VPatt p) -- hmm
|
||||
EPattType ty -> do vt <- value env ty
|
||||
return (VPattType . vt)
|
||||
Typed t ty -> value env t
|
||||
t -> fail.render $ "value"<+>ppTerm Unqualified 10 t $$ show t
|
||||
|
||||
vconcat vv@(v1,v2) =
|
||||
case vv of
|
||||
(VString "",_) -> v2
|
||||
(_,VString "") -> v1
|
||||
(VApp NonExist _,_) -> v1
|
||||
(_,VApp NonExist _) -> v2
|
||||
_ -> VC v1 v2
|
||||
|
||||
proj l v | isLockLabel l = return (VRec [])
|
||||
---- a workaround 18/2/2005: take this away and find the reason
|
||||
---- why earlier compilation destroys the lock field
|
||||
proj l v =
|
||||
case v of
|
||||
VFV vs -> liftM vfv (mapM (proj l) vs)
|
||||
VRec rs -> lookup l rs
|
||||
-- VExtR v1 v2 -> proj l v2 `mplus` proj l v1 -- hmm
|
||||
VS (VV pty pvs rs) v2 -> flip VS v2 . VV pty pvs # mapM (proj l) rs
|
||||
_ -> return (ok1 VP v l)
|
||||
|
||||
ok1 f v1@(VError {}) _ = v1
|
||||
ok1 f v1 v2 = f v1 v2
|
||||
|
||||
ok2 f v1@(VError {}) _ = v1
|
||||
ok2 f _ v2@(VError {}) = v2
|
||||
ok2 f v1 v2 = f v1 v2
|
||||
|
||||
ok2p f (v1@VError {},_) = v1
|
||||
ok2p f (_,v2@VError {}) = v2
|
||||
ok2p f vv = f vv
|
||||
|
||||
unlockVRec loc c0 v0 = v0
|
||||
{-
|
||||
unlockVRec loc c0 v0 = unlockVRec' c0 v0
|
||||
where
|
||||
unlockVRec' ::Ident -> Value -> Value
|
||||
unlockVRec' c v =
|
||||
case v of
|
||||
-- VClosure env t -> err bug (VClosure env) (unlockRecord c t)
|
||||
VAbs bt x (Bind f) -> VAbs bt x (Bind $ \ v -> unlockVRec' c (f v))
|
||||
VRec rs -> plusVRec rs lock
|
||||
-- _ -> VExtR v (VRec lock) -- hmm
|
||||
_ -> {-trace (render $ ppL loc $ "unlock non-record "++show v0)-} v -- hmm
|
||||
-- _ -> bugloc loc $ "unlock non-record "++show v0
|
||||
where
|
||||
lock = [(lockLabel c,VRec [])]
|
||||
-}
|
||||
|
||||
-- suspicious, but backwards compatible
|
||||
plusVRec rs1 rs2 = VRec ([(l,v)|(l,v)<-rs1,l `notElem` ls2] ++ rs2)
|
||||
where ls2 = map fst rs2
|
||||
|
||||
extR t vv =
|
||||
case vv of
|
||||
(VFV vs,v2) -> vfv [extR t (v1,v2)|v1<-vs]
|
||||
(v1,VFV vs) -> vfv [extR t (v1,v2)|v2<-vs]
|
||||
(VRecType rs1, VRecType rs2) ->
|
||||
case intersect (map fst rs1) (map fst rs2) of
|
||||
[] -> VRecType (rs1 ++ rs2)
|
||||
ls -> error $ "clash"<+>show ls
|
||||
(VRec rs1, VRec rs2) -> plusVRec rs1 rs2
|
||||
(v1 , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm
|
||||
(VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s
|
||||
-- (v1,v2) -> ok2 VExtR v1 v2 -- hmm
|
||||
(v1,v2) -> error $ "not records" $$ show v1 $$ show v2
|
||||
where
|
||||
error explain = ppbug $ "The term" <+> t
|
||||
<+> "is not reducible" $$ explain
|
||||
|
||||
glue env (v1,v2) = glu v1 v2
|
||||
where
|
||||
glu v1 v2 =
|
||||
case (v1,v2) of
|
||||
(VFV vs,v2) -> vfv [glu v1 v2|v1<-vs]
|
||||
(v1,VFV vs) -> vfv [glu v1 v2|v2<-vs]
|
||||
(VString s1,VString s2) -> VString (s1++s2)
|
||||
(v1,VAlts d vs) -> VAlts (glx d) [(glx v,c) | (v,c) <- vs]
|
||||
where glx v2 = glu v1 v2
|
||||
(v1@(VAlts {}),v2) ->
|
||||
--err (const (ok2 VGlue v1 v2)) id $
|
||||
err bug id $
|
||||
do y' <- strsFromValue v2
|
||||
x' <- strsFromValue v1
|
||||
return $ vfv [foldr1 VC (map VString (str2strings (glueStr v u))) | v <- x', u <- y']
|
||||
(VC va vb,v2) -> VC va (glu vb v2)
|
||||
(v1,VC va vb) -> VC (glu v1 va) vb
|
||||
(VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb
|
||||
(v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb
|
||||
(v1@(VApp NonExist _),_) -> v1
|
||||
(_,v2@(VApp NonExist _)) -> v2
|
||||
-- (v1,v2) -> ok2 VGlue v1 v2
|
||||
(v1,v2) -> if flag optPlusAsBind (opts env)
|
||||
then VC v1 (VC (VApp BIND []) v2)
|
||||
else let loc = gloc env
|
||||
vt v = case value2term loc (local env) v of
|
||||
Left i -> Error ('#':show i)
|
||||
Right t -> t
|
||||
in error . render $
|
||||
ppL loc (hang "unsupported token gluing:" 4
|
||||
(Glue (vt v1) (vt v2)))
|
||||
|
||||
|
||||
-- | to get a string from a value that represents a sequence of terminals
|
||||
strsFromValue :: Value -> Err [Str]
|
||||
strsFromValue t = case t of
|
||||
VString s -> return [str s]
|
||||
VC s t -> do
|
||||
s' <- strsFromValue s
|
||||
t' <- strsFromValue t
|
||||
return [plusStr x y | x <- s', y <- t']
|
||||
{-
|
||||
VGlue s t -> do
|
||||
s' <- strsFromValue s
|
||||
t' <- strsFromValue t
|
||||
return [glueStr x y | x <- s', y <- t']
|
||||
-}
|
||||
VAlts d vs -> do
|
||||
d0 <- strsFromValue d
|
||||
v0 <- mapM (strsFromValue . fst) vs
|
||||
c0 <- mapM (strsFromValue . snd) vs
|
||||
--let vs' = zip v0 c0
|
||||
return [strTok (str2strings def) vars |
|
||||
def <- d0,
|
||||
vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
|
||||
vv <- combinations v0]
|
||||
]
|
||||
VFV ts -> concat # mapM strsFromValue ts
|
||||
VStrs ts -> concat # mapM strsFromValue ts
|
||||
|
||||
_ -> fail ("cannot get Str from value " ++ show t)
|
||||
|
||||
vfv vs = case nub vs of
|
||||
[v] -> v
|
||||
vs -> VFV vs
|
||||
|
||||
select env vv =
|
||||
case vv of
|
||||
(v1,VFV vs) -> vfv [select env (v1,v2)|v2<-vs]
|
||||
(VFV vs,v2) -> vfv [select env (v1,v2)|v1<-vs]
|
||||
(v1@(VV pty vs rs),v2) ->
|
||||
err (const (VS v1 v2)) id $
|
||||
do --ats <- allParamValues (srcgr env) pty
|
||||
--let vs = map (value0 env) ats
|
||||
i <- maybeErr "no match" $ findIndex (==v2) vs
|
||||
return (ix (gloc env) "select" rs i)
|
||||
(VT _ _ [(PW,Bind b)],_) -> {-trace "eliminate wild card table" $-} b []
|
||||
(v1@(VT _ _ cs),v2) ->
|
||||
err (\_->ok2 VS v1 v2) (err bug id . valueMatch env) $
|
||||
match (gloc env) cs v2
|
||||
(VS (VV pty pvs rs) v12,v2) -> VS (VV pty pvs [select env (v11,v2)|v11<-rs]) v12
|
||||
(v1,v2) -> ok2 VS v1 v2
|
||||
|
||||
match loc cs v =
|
||||
case value2term loc [] v of
|
||||
Left i -> bad ("variable #"++show i++" is out of scope")
|
||||
Right t -> err bad return (matchPattern cs t)
|
||||
where
|
||||
bad = fail . ("In pattern matching: "++)
|
||||
|
||||
valueMatch :: CompleteEnv -> (Bind Env,Substitution) -> Err Value
|
||||
valueMatch env (Bind f,env') = f # mapPairsM (value0 env) env'
|
||||
|
||||
valueTable :: CompleteEnv -> TInfo -> [Case] -> Err OpenValue
|
||||
valueTable env i cs =
|
||||
case i of
|
||||
TComp ty -> do pvs <- paramValues env ty
|
||||
((VV ty pvs .) # sequence) # mapM (value env.snd) cs
|
||||
_ -> do ty <- getTableType i
|
||||
cs' <- mapM valueCase cs
|
||||
err (dynamic cs' ty) return (convert cs' ty)
|
||||
where
|
||||
dynamic cs' ty _ = cases cs' # value env ty
|
||||
|
||||
cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
|
||||
where
|
||||
keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
|
||||
VT wild (vty vs) (mapSnd ($vs) cs')
|
||||
|
||||
wild = case i of TWild _ -> True; _ -> False
|
||||
|
||||
convertv cs' vty =
|
||||
case value2term (gloc env) [] vty of
|
||||
Left i -> fail ("variable #"++show i++" is out of scope")
|
||||
Right pty -> convert' cs' =<< paramValues'' env pty
|
||||
|
||||
convert cs' ty = convert' cs' =<< paramValues' env ty
|
||||
|
||||
convert' cs' ((pty,vs),pvs) =
|
||||
do sts <- mapM (matchPattern cs') vs
|
||||
return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
|
||||
(mapFst ($vs) sts)
|
||||
|
||||
valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
|
||||
pvs <- linPattVars p'
|
||||
vt <- value (extend pvs env) t
|
||||
return (p',\vs-> Bind $ \bs-> vt (push' p' bs pvs vs))
|
||||
|
||||
inlinePattMacro p =
|
||||
case p of
|
||||
PM qc -> do r <- resource env qc
|
||||
case r of
|
||||
VPatt p' -> inlinePattMacro p'
|
||||
_ -> ppbug $ hang "Expected pattern macro:" 4
|
||||
(show r)
|
||||
_ -> composPattOp inlinePattMacro p
|
||||
|
||||
|
||||
paramValues env ty = snd # paramValues' env ty
|
||||
|
||||
paramValues' env ty = paramValues'' env =<< nfx (global env) ty
|
||||
|
||||
paramValues'' env pty = do ats <- allParamValues (srcgr env) pty
|
||||
pvs <- mapM (eval (global env) []) ats
|
||||
return ((pty,ats),pvs)
|
||||
|
||||
push' p bs xs = if length bs/=length xs
|
||||
then bug $ "push "++show (p,bs,xs)
|
||||
else push bs xs
|
||||
|
||||
push :: Env -> LocalScope -> Stack -> Stack
|
||||
push bs [] vs = vs
|
||||
push bs (x:xs) vs = maybe err id (lookup x bs):push bs xs vs
|
||||
where err = bug $ "Unbound pattern variable "++showIdent x
|
||||
|
||||
apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
|
||||
apply' env t [] = value env t
|
||||
apply' env t vs =
|
||||
case t of
|
||||
QC x -> return $ \ svs -> VCApp x (map ($svs) vs)
|
||||
{-
|
||||
Q x@(m,f) | m==cPredef -> return $
|
||||
let constr = --trace ("predef "++show x) .
|
||||
VApp x
|
||||
in \ svs -> maybe constr id (Map.lookup f predefs)
|
||||
$ map ($svs) vs
|
||||
| otherwise -> do r <- resource env x
|
||||
return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
|
||||
-}
|
||||
App t1 t2 -> apply' env t1 . (:vs) =<< value env t2
|
||||
_ -> do fv <- value env t
|
||||
return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)
|
||||
|
||||
vapply :: GLocation -> Value -> [Value] -> Value
|
||||
vapply loc v [] = v
|
||||
vapply loc v vs =
|
||||
case v of
|
||||
VError {} -> v
|
||||
-- VClosure env (Abs b x t) -> beta gr env b x t vs
|
||||
VAbs bt _ (Bind f) -> vbeta loc bt f vs
|
||||
VApp pre vs1 -> delta' pre (vs1++vs)
|
||||
where
|
||||
delta' Trace (v1:v2:vs) = let vr = vapply loc v2 vs
|
||||
in vtrace loc v1 vr
|
||||
delta' pre vs = err msg vfv $ mapM (delta pre) (varyList vs)
|
||||
--msg = const (VApp pre (vs1++vs))
|
||||
msg = bug . (("Applying Predef."++showIdent (predefName pre)++": ")++)
|
||||
VS (VV t pvs fs) s -> VS (VV t pvs [vapply loc f vs|f<-fs]) s
|
||||
VFV fs -> vfv [vapply loc f vs|f<-fs]
|
||||
VCApp f vs0 -> VCApp f (vs0++vs)
|
||||
VMeta i env vs0 -> VMeta i env (vs0++vs)
|
||||
VGen i vs0 -> VGen i (vs0++vs)
|
||||
v -> bug $ "vapply "++show v++" "++show vs
|
||||
|
||||
vbeta loc bt f (v:vs) =
|
||||
case (bt,v) of
|
||||
(Implicit,VImplArg v) -> ap v
|
||||
(Explicit, v) -> ap v
|
||||
where
|
||||
ap (VFV avs) = vfv [vapply loc (f v) vs|v<-avs]
|
||||
ap v = vapply loc (f v) vs
|
||||
|
||||
vary (VFV vs) = vs
|
||||
vary v = [v]
|
||||
varyList = mapM vary
|
||||
|
||||
{-
|
||||
beta env b x t (v:vs) =
|
||||
case (b,v) of
|
||||
(Implicit,VImplArg v) -> apply' (ext (x,v) env) t vs
|
||||
(Explicit, v) -> apply' (ext (x,v) env) t vs
|
||||
-}
|
||||
|
||||
vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res
|
||||
where
|
||||
pv v = case v of
|
||||
VRec (f:as) -> hang (pf f) 4 (fsep (map pa as))
|
||||
_ -> ppV v
|
||||
pf (_,VString n) = pp n
|
||||
pf (_,v) = ppV v
|
||||
pa (_,v) = ppV v
|
||||
ppV v = case value2term' True loc [] v of
|
||||
Left i -> "variable #" <> pp i <+> "is out of scope"
|
||||
Right t -> ppTerm Unqualified 10 t
|
||||
|
||||
-- | Convert a value back to a term
|
||||
value2term :: GLocation -> [Ident] -> Value -> Either Int Term
|
||||
value2term = value2term' False
|
||||
value2term' stop loc xs v0 =
|
||||
case v0 of
|
||||
VApp pre vs -> liftM (foldl App (Q (cPredef,predefName pre))) (mapM v2t vs)
|
||||
VCApp f vs -> liftM (foldl App (QC f)) (mapM v2t vs)
|
||||
VGen j vs -> liftM2 (foldl App) (var j) (mapM v2t vs)
|
||||
VMeta j env vs -> liftM (foldl App (Meta j)) (mapM v2t vs)
|
||||
VProd bt v x f -> liftM2 (Prod bt x) (v2t v) (v2t' x f)
|
||||
VAbs bt x f -> liftM (Abs bt x) (v2t' x f)
|
||||
VInt n -> return (EInt n)
|
||||
VFloat f -> return (EFloat f)
|
||||
VString s -> return (if null s then Empty else K s)
|
||||
VSort s -> return (Sort s)
|
||||
VImplArg v -> liftM ImplArg (v2t v)
|
||||
VTblType p res -> liftM2 Table (v2t p) (v2t res)
|
||||
VRecType rs -> liftM RecType (mapM (\(l,v) -> fmap ((,) l) (v2t v)) rs)
|
||||
VRec as -> liftM R (mapM (\(l,v) -> v2t v >>= \t -> return (l,(Nothing,t))) as)
|
||||
VV t _ vs -> liftM (V t) (mapM v2t vs)
|
||||
VT wild v cs -> v2t v >>= \t -> liftM (T ((if wild then TWild else TTyped) t)) (mapM nfcase cs)
|
||||
VFV vs -> liftM FV (mapM v2t vs)
|
||||
VC v1 v2 -> liftM2 C (v2t v1) (v2t v2)
|
||||
VS v1 v2 -> liftM2 S (v2t v1) (v2t v2)
|
||||
VP v l -> v2t v >>= \t -> return (P t l)
|
||||
VPatt p -> return (EPatt p)
|
||||
VPattType v -> v2t v >>= return . EPattType
|
||||
VAlts v vvs -> liftM2 Alts (v2t v) (mapM (\(x,y) -> liftM2 (,) (v2t x) (v2t y)) vvs)
|
||||
VStrs vs -> liftM Strs (mapM v2t vs)
|
||||
-- VGlue v1 v2 -> Glue (v2t v1) (v2t v2)
|
||||
-- VExtR v1 v2 -> ExtR (v2t v1) (v2t v2)
|
||||
VError err -> return (Error err)
|
||||
_ -> bug ("value2term "++show loc++" : "++show v0)
|
||||
where
|
||||
v2t = v2txs xs
|
||||
v2txs = value2term' stop loc
|
||||
v2t' x f = v2txs (x:xs) (bind f (gen xs))
|
||||
|
||||
var j
|
||||
| j<length xs = Right (Vr (reverse xs !! j))
|
||||
| otherwise = Left j
|
||||
|
||||
|
||||
pushs xs e = foldr push e xs
|
||||
push x (env,xs) = ((x,gen xs):env,x:xs)
|
||||
gen xs = VGen (length xs) []
|
||||
|
||||
nfcase (p,f) = liftM ((,) p) (v2txs xs' (bind f env'))
|
||||
where (env',xs') = pushs (pattVars p) ([],xs)
|
||||
|
||||
bind (Bind f) x = if stop
|
||||
then VSort (identS "...") -- hmm
|
||||
else f x
|
||||
|
||||
|
||||
linPattVars p =
|
||||
if null dups
|
||||
then return pvs
|
||||
else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)
|
||||
where
|
||||
allpvs = allPattVars p
|
||||
pvs = nub allpvs
|
||||
dups = allpvs \\ pvs
|
||||
|
||||
pattVars = nub . allPattVars
|
||||
allPattVars p =
|
||||
case p of
|
||||
PV i -> [i]
|
||||
PAs i p -> i:allPattVars p
|
||||
_ -> collectPattOp allPattVars p
|
||||
|
||||
---
|
||||
ix loc fn xs i =
|
||||
if i<n
|
||||
then xs !! i
|
||||
else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
|
||||
where n = length xs
|
||||
|
||||
infixl 1 #,<# --,@@
|
||||
|
||||
f # x = fmap f x
|
||||
mf <# mx = ap mf mx
|
||||
--m1 @@ m2 = (m1 =<<) . m2
|
||||
|
||||
both f (x,y) = (,) # f x <# f y
|
||||
|
||||
bugloc loc s = ppbug $ ppL loc s
|
||||
|
||||
bug msg = ppbug msg
|
||||
ppbug doc = error $ render $ hang "Internal error in Compute.ConcreteNew:" 4 doc
|
||||
@@ -12,8 +12,8 @@ data Value
|
||||
| VGen Int [Value] -- for lambda bound variables, possibly applied
|
||||
| VMeta MetaId Env [Value]
|
||||
-- -- | VClosure Env Term -- used in Typecheck.ConcreteNew
|
||||
| VAbs BindType Ident Binding -- used in Compute.Concrete
|
||||
| VProd BindType Value Ident Binding -- used in Compute.Concrete
|
||||
| VAbs BindType Ident Binding -- used in Compute.ConcreteNew
|
||||
| VProd BindType Value Ident Binding -- used in Compute.ConcreteNew
|
||||
| VInt Int
|
||||
| VFloat Double
|
||||
| VString String
|
||||
@@ -47,10 +47,10 @@ type Env = [(Ident,Value)]
|
||||
|
||||
-- | Predefined functions
|
||||
data Predefined = Drop | Take | Tk | Dp | EqStr | Occur | Occurs | ToUpper
|
||||
| ToLower | IsUpper | Length | Plus | EqInt | LessInt
|
||||
| ToLower | IsUpper | Length | Plus | EqInt | LessInt
|
||||
{- | Show | Read | ToStr | MapStr | EqVal -}
|
||||
| Error | Trace
|
||||
-- Canonical values below:
|
||||
| PBool | PFalse | PTrue | Int | Float | Ints | NonExist
|
||||
| PBool | PFalse | PTrue | Int | Float | Ints | NonExist
|
||||
| BIND | SOFT_BIND | SOFT_SPACE | CAPIT | ALL_CAPIT
|
||||
deriving (Show,Eq,Ord,Ix,Bounded,Enum)
|
||||
|
||||
@@ -1,350 +1,365 @@
|
||||
-- | Translate concrete syntax to Haskell
|
||||
module GF.Compile.ConcreteToHaskell(concretes2haskell,concrete2haskell) where
|
||||
import Data.List(isPrefixOf,sort,sortOn)
|
||||
import Data.List(sort,sortBy)
|
||||
import Data.Function(on)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import GF.Data.ErrM
|
||||
import GF.Data.Utilities(mapSnd)
|
||||
import GF.Text.Pretty
|
||||
--import GF.Grammar.Predef(cPredef,cInts)
|
||||
--import GF.Compile.Compute.Predef(predef)
|
||||
--import GF.Compile.Compute.Value(Predefined(..))
|
||||
import GF.Infra.Ident(Ident,identC,identS,identW,prefixIdent,showRawIdent,rawIdentS)
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Lookup(lookupFunType,lookupOrigInfo,allOrigInfos)--,allParamValues
|
||||
import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,mkAbs,mkApp)
|
||||
import GF.Grammar.Lockfield(isLockLabel)
|
||||
import GF.Grammar.Predef(cPredef,cInts)
|
||||
import GF.Compile.Compute.Predef(predef)
|
||||
import GF.Compile.Compute.Value(Predefined(..))
|
||||
import GF.Infra.Ident(Ident,identS,prefixIdent) --,moduleNameS
|
||||
import GF.Infra.Option
|
||||
import GF.Haskell as H
|
||||
import GF.Grammar.Canonical as C
|
||||
import GF.Compile.GrammarToCanonical
|
||||
import Debug.Trace(trace)
|
||||
import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
|
||||
import GF.Haskell
|
||||
import Debug.Trace
|
||||
|
||||
-- | Generate Haskell code for the all concrete syntaxes associated with
|
||||
-- the named abstract syntax in given the grammar.
|
||||
concretes2haskell opts absname gr =
|
||||
[(filename,render80 $ concrete2haskell opts abstr cncmod)
|
||||
| let Grammar abstr cncs = grammar2canonical opts absname gr,
|
||||
cncmod<-cncs,
|
||||
let ModId name = concName cncmod
|
||||
filename = showRawIdent name ++ ".hs" :: FilePath
|
||||
[(cncname,concrete2haskell opts gr cenv absname cnc cncmod)
|
||||
| let cenv = resourceValues opts gr,
|
||||
cnc<-allConcretes gr absname,
|
||||
let cncname = render cnc ++ ".hs" :: FilePath
|
||||
Ok cncmod = lookupModule gr cnc
|
||||
]
|
||||
|
||||
-- | Generate Haskell code for the given concrete module.
|
||||
-- The only options that make a difference are
|
||||
-- @-haskell=noprefix@ and @-haskell=variants@.
|
||||
concrete2haskell opts
|
||||
abstr@(Abstract _ _ cats funs)
|
||||
modinfo@(Concrete cnc absname _ ps lcs lns) =
|
||||
haskPreamble absname cnc $$
|
||||
vcat (
|
||||
nl:Comment "--- Parameter types ---":
|
||||
map paramDef ps ++
|
||||
nl:Comment "--- Type signatures for linearization functions ---":
|
||||
map signature cats ++
|
||||
nl:Comment "--- Linearization functions for empty categories ---":
|
||||
emptydefs ++
|
||||
nl:Comment "--- Linearization types ---":
|
||||
map lincatDef lcs ++
|
||||
nl:Comment "--- Linearization functions ---":
|
||||
lindefs ++
|
||||
nl:Comment "--- Type classes for projection functions ---":
|
||||
map labelClass (S.toList labels) ++
|
||||
nl:Comment "--- Record types ---":
|
||||
concatMap recordType recs)
|
||||
concrete2haskell opts gr cenv absname cnc modinfo =
|
||||
renderStyle style{lineLength=80,ribbonsPerLine=1} $
|
||||
haskPreamble va absname cnc $$ vcat (
|
||||
nl:Comment "--- Parameter types ---":
|
||||
neededParamTypes S.empty (params defs) ++
|
||||
nl:Comment "--- Type signatures for linearization functions ---":
|
||||
map signature (S.toList allcats)++
|
||||
nl:Comment "--- Linearization functions for empty categories ---":
|
||||
emptydefs ++
|
||||
nl:Comment "--- Linearization types and linearization functions ---":
|
||||
map ppDef defs ++
|
||||
nl:Comment "--- Type classes for projection functions ---":
|
||||
map labelClass (S.toList labels) ++
|
||||
nl:Comment "--- Record types ---":
|
||||
concatMap recordType recs)
|
||||
where
|
||||
nl = Comment ""
|
||||
recs = S.toList (S.difference (records (lcs,lns)) common_records)
|
||||
|
||||
labels = S.difference (S.unions (map S.fromList recs)) common_labels
|
||||
recs = S.toList (S.difference (records rhss) common_records)
|
||||
common_records = S.fromList [[label_s]]
|
||||
common_labels = S.fromList [label_s]
|
||||
label_s = LabelId (rawIdentS "s")
|
||||
label_s = ident2label (identS "s")
|
||||
|
||||
signature (CatDef c _) = TypeSig lf (Fun abs (pure lin))
|
||||
rhss = map (either snd (snd.snd)) defs
|
||||
defs = sortBy (compare `on` either (const Nothing) (Just . fst)) .
|
||||
concatMap (toHaskell gId gr absname cenv) .
|
||||
M.toList $
|
||||
jments modinfo
|
||||
|
||||
-- signature c = "lin"<>c<+>"::"<+>"A."<>gId c<+>"->"<+>"Lin"<>c
|
||||
-- signature c = "--lin"<>c<+>":: (Applicative f,Monad f) =>"<+>"A."<>gId c<+>"->"<+>"f Lin"<>c
|
||||
signature c = TypeSig lf (Fun abs (pure lin))
|
||||
where
|
||||
abs = tcon0 (prefixIdent "A." (gId c))
|
||||
lin = tcon0 lc
|
||||
lf = linfunName c
|
||||
lc = lincatName c
|
||||
lf = prefixIdent "lin" c
|
||||
lc = prefixIdent "Lin" c
|
||||
|
||||
emptydefs = map emptydef (S.toList emptyCats)
|
||||
emptydef c = Eqn (linfunName c,[WildP]) (Const "undefined")
|
||||
emptydef c = Eqn (prefixIdent "lin" c,[WildP]) (Const "undefined")
|
||||
|
||||
emptyCats = allcats `S.difference` linfuncats
|
||||
where
|
||||
--funcats = S.fromList [c | FunDef f (C.Type _ (TypeApp c _))<-funs]
|
||||
allcats = S.fromList [c | CatDef c _<-cats]
|
||||
emptyCats = allcats `S.difference` cats
|
||||
cats = S.fromList [c|Right (c,_)<-defs]
|
||||
allcats = S.fromList [c|((_,c),AbsCat (Just _))<-allOrigInfos gr absname]
|
||||
|
||||
gId :: ToIdent i => i -> Ident
|
||||
gId = (if haskellOption opts HaskellNoPrefix then id else prefixIdent "G")
|
||||
. toIdent
|
||||
params = S.toList . S.unions . map params1
|
||||
params1 (Left (_,rhs)) = paramTypes gr rhs
|
||||
params1 (Right (_,(_,rhs))) = tableTypes gr [rhs]
|
||||
|
||||
ppDef (Left (lhs,rhs)) = lhs (convType va gId rhs)
|
||||
ppDef (Right (_,(lhs,rhs))) = lhs (convert va gId gr rhs)
|
||||
|
||||
gId :: Ident -> Ident
|
||||
gId = if haskellOption opts HaskellNoPrefix then id else prefixIdent "G"
|
||||
va = haskellOption opts HaskellVariants
|
||||
pure = if va then ListT else id
|
||||
|
||||
haskPreamble :: ModId -> ModId -> Doc
|
||||
haskPreamble absname cncname =
|
||||
"{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, LambdaCase #-}" $$
|
||||
"module" <+> cncname <+> "where" $$
|
||||
"import Prelude hiding (Ordering(..))" $$
|
||||
"import Control.Applicative((<$>),(<*>))" $$
|
||||
"import PGF.Haskell" $$
|
||||
"import qualified" <+> absname <+> "as A" $$
|
||||
"" $$
|
||||
"--- Standard definitions ---" $$
|
||||
"linString (A.GString s) ="<+>pure "R_s [TK s]" $$
|
||||
"linInt (A.GInt i) ="<+>pure "R_s [TK (show i)]" $$
|
||||
"linFloat (A.GFloat x) ="<+>pure "R_s [TK (show x)]" $$
|
||||
"" $$
|
||||
"----------------------------------------------------" $$
|
||||
"-- Automatic translation from GF to Haskell follows" $$
|
||||
"----------------------------------------------------"
|
||||
neededParamTypes have [] = []
|
||||
neededParamTypes have (q:qs) =
|
||||
if q `S.member` have
|
||||
then neededParamTypes have qs
|
||||
else let ((got,need),def) = paramType va gId gr q
|
||||
in def++neededParamTypes (S.union got have) (S.toList need++qs)
|
||||
|
||||
haskPreamble :: Bool -> ModuleName -> ModuleName -> Doc
|
||||
haskPreamble va absname cncname =
|
||||
"{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, LambdaCase #-}" $$
|
||||
"module" <+> cncname <+> "where" $$
|
||||
"import Prelude hiding (Ordering(..))" $$
|
||||
"import Control.Applicative((<$>),(<*>))" $$
|
||||
"import PGF.Haskell" $$
|
||||
"import qualified" <+> absname <+> "as A" $$
|
||||
"" $$
|
||||
"--- Standard definitions ---" $$
|
||||
"linString (A.GString s) ="<+>pure "R_s [TK s]" $$
|
||||
"linInt (A.GInt i) ="<+>pure "R_s [TK (show i)]" $$
|
||||
"linFloat (A.GFloat x) ="<+>pure "R_s [TK (show x)]" $$
|
||||
"" $$
|
||||
"----------------------------------------------------" $$
|
||||
"-- Automatic translation from GF to Haskell follows" $$
|
||||
"----------------------------------------------------"
|
||||
where
|
||||
pure = if va then brackets else pp
|
||||
|
||||
toHaskell gId gr absname cenv (name,jment) =
|
||||
case jment of
|
||||
CncCat (Just (L loc typ)) _ _ pprn _ ->
|
||||
[Left (tsyn0 (prefixIdent "Lin" name),nf loc typ)]
|
||||
CncFun (Just r@(cat,ctx,lincat)) (Just (L loc def)) pprn _ ->
|
||||
-- trace (render (name<+>hcat[parens (x<>"::"<>t)|(_,x,t)<-ctx]<+>"::"<+>cat)) $
|
||||
[Right (cat,(Eqn (prefixIdent "lin" cat,lhs),coerce [] lincat rhs))]
|
||||
where
|
||||
pure = if va then brackets else pp
|
||||
Ok abstype = lookupFunType gr absname name
|
||||
(absctx,_abscat,_absargs) = typeForm abstype
|
||||
|
||||
paramDef pd =
|
||||
case pd of
|
||||
ParamAliasDef p t -> H.Type (conap0 (gId p)) (convLinType t)
|
||||
ParamDef p pvs -> Data (conap0 (gId p)) (map paramCon pvs) derive
|
||||
where
|
||||
paramCon (Param c cs) = ConAp (gId c) (map (tcon0.gId) cs)
|
||||
derive = ["Eq","Ord","Show"]
|
||||
e' = unAbs (length params) $
|
||||
nf loc (mkAbs params (mkApp def (map Vr args)))
|
||||
params = [(b,prefixIdent "g" x)|(b,x,_)<-ctx]
|
||||
args = map snd params
|
||||
abs_args = map (prefixIdent "abs_") args
|
||||
lhs = [ConP (aId name) (map VarP abs_args)]
|
||||
rhs = foldr letlin e' (zip args absctx)
|
||||
letlin (a,(_,_,at)) =
|
||||
Let (a,(Just (con ("Lin"++render at)),(App (con ("lin"++render at)) (con ("abs_"++render a)))))
|
||||
AnyInd _ m -> case lookupOrigInfo gr (m,name) of
|
||||
Ok (m,jment) -> toHaskell gId gr absname cenv (name,jment)
|
||||
_ -> []
|
||||
_ -> []
|
||||
where
|
||||
nf loc = normalForm cenv (L loc name)
|
||||
aId n = prefixIdent "A." (gId n)
|
||||
|
||||
convLinType = ppT
|
||||
where
|
||||
ppT t =
|
||||
case t of
|
||||
FloatType -> tcon0 (identS "Float")
|
||||
IntType -> tcon0 (identS "Int")
|
||||
ParamType (ParamTypeId p) -> tcon0 (gId p)
|
||||
RecordType rs -> tcon (rcon' ls) (map ppT ts)
|
||||
where (ls,ts) = unzip $ sortOn fst [(l,t)|RecordRow l t<-rs]
|
||||
StrType -> tcon0 (identS "Str")
|
||||
TableType pt lt -> Fun (ppT pt) (ppT lt)
|
||||
-- TupleType lts ->
|
||||
|
||||
lincatDef (LincatDef c t) = tsyn0 (lincatName c) (convLinType t)
|
||||
|
||||
linfuncats = S.fromList linfuncatl
|
||||
(linfuncatl,lindefs) = unzip (linDefs lns)
|
||||
|
||||
linDefs = map eqn . sortOn fst . map linDef
|
||||
where eqn (cat,(f,(ps,rhs))) = (cat,Eqn (f,ps) rhs)
|
||||
|
||||
linDef (LinDef f xs rhs0) =
|
||||
(cat,(linfunName cat,(lhs,rhs)))
|
||||
where
|
||||
lhs = [ConP (aId f) (map VarP abs_args)]
|
||||
aId f = prefixIdent "A." (gId f)
|
||||
|
||||
[lincat] = [lincat | LincatDef c lincat<-lcs,c==cat]
|
||||
[C.Type absctx (TypeApp cat _)] = [t | FunDef f' t<-funs, f'==f]
|
||||
|
||||
abs_args = map abs_arg args
|
||||
abs_arg = prefixIdent "abs_"
|
||||
args = map (prefixIdent "g" . toIdent) xs
|
||||
|
||||
rhs = lets (zipWith letlin args absctx)
|
||||
(convert vs (coerce env lincat rhs0))
|
||||
where
|
||||
vs = [(VarValueId (Unqual x),a)|(VarId x,a)<-zip xs args]
|
||||
env= [(VarValueId (Unqual x),lc)|(VarId x,lc)<-zip xs (map arglincat absctx)]
|
||||
|
||||
letlin a (TypeBinding _ (C.Type _ (TypeApp acat _))) =
|
||||
(a,Ap (Var (linfunName acat)) (Var (abs_arg a)))
|
||||
|
||||
arglincat (TypeBinding _ (C.Type _ (TypeApp acat _))) = lincat
|
||||
where
|
||||
[lincat] = [lincat | LincatDef c lincat<-lcs,c==acat]
|
||||
|
||||
convert = convert' va
|
||||
|
||||
convert' va vs = ppT
|
||||
where
|
||||
ppT0 = convert' False vs
|
||||
ppTv vs' = convert' va vs'
|
||||
|
||||
pure = if va then single else id
|
||||
|
||||
ppT t =
|
||||
case t of
|
||||
TableValue ty cs -> pure (table cs)
|
||||
Selection t p -> select (ppT t) (ppT p)
|
||||
ConcatValue t1 t2 -> concat (ppT t1) (ppT t2)
|
||||
RecordValue r -> aps (rcon ls) (map ppT ts)
|
||||
where (ls,ts) = unzip $ sortOn fst [(l,t)|RecordRow l t<-r]
|
||||
PredefValue p -> single (Var (toIdent p)) -- hmm
|
||||
Projection t l -> ap (proj l) (ppT t)
|
||||
VariantValue [] -> empty
|
||||
VariantValue ts@(_:_) -> variants ts
|
||||
VarValue x -> maybe (Var (gId x)) (pure . Var) $ lookup x vs
|
||||
PreValue vs t' -> pure (alts t' vs)
|
||||
ParamConstant (Param c vs) -> aps (Var (pId c)) (map ppT vs)
|
||||
ErrorValue s -> ap (Const "error") (Const (show s)) -- !!
|
||||
LiteralValue l -> ppL l
|
||||
_ -> error ("convert "++show t)
|
||||
|
||||
ppL l =
|
||||
case l of
|
||||
FloatConstant x -> pure (lit x)
|
||||
IntConstant n -> pure (lit n)
|
||||
StrConstant s -> pure (token s)
|
||||
|
||||
pId p@(ParamId s) =
|
||||
if "to_R_" `isPrefixOf` unqual s then toIdent p else gId p -- !! a hack
|
||||
|
||||
table cs =
|
||||
if all (null.patVars) ps
|
||||
then lets ds (LambdaCase [(ppP p,t')|(p,t')<-zip ps ts'])
|
||||
else LambdaCase (map ppCase cs)
|
||||
where
|
||||
(ds,ts') = dedup ts
|
||||
(ps,ts) = unzip [(p,t)|TableRow p t<-cs]
|
||||
ppCase (TableRow p t) = (ppP p,ppTv (patVars p++vs) t)
|
||||
{-
|
||||
ppPredef n =
|
||||
case predef n of
|
||||
Ok BIND -> single (c "BIND")
|
||||
Ok SOFT_BIND -> single (c "SOFT_BIND")
|
||||
Ok SOFT_SPACE -> single (c "SOFT_SPACE")
|
||||
Ok CAPIT -> single (c "CAPIT")
|
||||
Ok ALL_CAPIT -> single (c "ALL_CAPIT")
|
||||
_ -> Var n
|
||||
-}
|
||||
ppP p =
|
||||
case p of
|
||||
ParamPattern (Param c ps) -> ConP (gId c) (map ppP ps)
|
||||
RecordPattern r -> ConP (rcon' ls) (map ppP ps)
|
||||
where (ls,ps) = unzip $ sortOn fst [(l,p)|RecordRow l p<-r]
|
||||
WildPattern -> WildP
|
||||
|
||||
token s = single (c "TK" `Ap` lit s)
|
||||
|
||||
alts t' vs = single (c "TP" `Ap` List (map alt vs) `Ap` ppT0 t')
|
||||
where
|
||||
alt (s,t) = Pair (List (pre s)) (ppT0 t)
|
||||
pre s = map lit s
|
||||
|
||||
c = Const
|
||||
lit s = c (show s) -- hmm
|
||||
concat = if va then concat' else plusplus
|
||||
where
|
||||
concat' (List [List ts1]) (List [List ts2]) = List [List (ts1++ts2)]
|
||||
concat' t1 t2 = Op t1 "+++" t2
|
||||
|
||||
pure' = single -- forcing the list monad
|
||||
|
||||
select = if va then select' else Ap
|
||||
select' (List [t]) (List [p]) = Op t "!" p
|
||||
select' (List [t]) p = Op t "!$" p
|
||||
select' t p = Op t "!*" p
|
||||
|
||||
ap = if va then ap' else Ap
|
||||
where
|
||||
ap' (List [f]) x = fmap f x
|
||||
ap' f x = Op f "<*>" x
|
||||
fmap f (List [x]) = pure' (Ap f x)
|
||||
fmap f x = Op f "<$>" x
|
||||
|
||||
-- join = if va then join' else id
|
||||
join' (List [x]) = x
|
||||
join' x = c "concat" `Ap` x
|
||||
|
||||
empty = if va then List [] else c "error" `Ap` c (show "empty variant")
|
||||
variants = if va then \ ts -> join' (List (map ppT ts))
|
||||
else \ (t:_) -> ppT t
|
||||
|
||||
aps f [] = f
|
||||
aps f (a:as) = aps (ap f a) as
|
||||
|
||||
dedup ts =
|
||||
if M.null dups
|
||||
then ([],map ppT ts)
|
||||
else ([(ev i,ppT t)|(i,t)<-defs],zipWith entry ts is)
|
||||
where
|
||||
entry t i = maybe (ppT t) (Var . ev) (M.lookup i dups)
|
||||
ev i = identS ("e'"++show i)
|
||||
|
||||
defs = [(i1,t)|(t,i1:_:_)<-ms]
|
||||
dups = M.fromList [(i2,i1)|(_,i1:is@(_:_))<-ms,i2<-i1:is]
|
||||
ms = M.toList m
|
||||
m = fmap sort (M.fromListWith (++) (zip ts [[i]|i<-is]))
|
||||
is = [0..]::[Int]
|
||||
unAbs 0 t = t
|
||||
unAbs n (Abs _ _ t) = unAbs (n-1) t
|
||||
unAbs _ t = t
|
||||
|
||||
|
||||
--con = Cn . identS
|
||||
con = Cn . identS
|
||||
|
||||
class Records t where
|
||||
records :: t -> S.Set [LabelId]
|
||||
tableTypes gr ts = S.unions (map tabtys ts)
|
||||
where
|
||||
tabtys t =
|
||||
case t of
|
||||
V t cc -> S.union (paramTypes gr t) (tableTypes gr cc)
|
||||
T (TTyped t) cs -> S.union (paramTypes gr t) (tableTypes gr (map snd cs))
|
||||
_ -> collectOp tabtys t
|
||||
|
||||
instance Records t => Records [t] where
|
||||
records = S.unions . map records
|
||||
paramTypes gr t =
|
||||
case t of
|
||||
RecType fs -> S.unions (map (paramTypes gr.snd) fs)
|
||||
Table t1 t2 -> S.union (paramTypes gr t1) (paramTypes gr t2)
|
||||
App tf ta -> S.union (paramTypes gr tf) (paramTypes gr ta)
|
||||
Sort _ -> S.empty
|
||||
EInt _ -> S.empty
|
||||
Q q -> lookup q
|
||||
QC q -> lookup q
|
||||
FV ts -> S.unions (map (paramTypes gr) ts)
|
||||
_ -> ignore
|
||||
where
|
||||
lookup q = case lookupOrigInfo gr q of
|
||||
Ok (_,ResOper _ (Just (L _ t))) ->
|
||||
S.insert q (paramTypes gr t)
|
||||
Ok (_,ResParam {}) -> S.singleton q
|
||||
_ -> ignore
|
||||
|
||||
instance (Records t1,Records t2) => Records (t1,t2) where
|
||||
records (t1,t2) = S.union (records t1) (records t2)
|
||||
|
||||
instance Records LincatDef where
|
||||
records (LincatDef _ lt) = records lt
|
||||
|
||||
instance Records LinDef where
|
||||
records (LinDef _ _ lv) = records lv
|
||||
|
||||
instance Records LinType where
|
||||
records t =
|
||||
case t of
|
||||
RecordType r -> rowRecords r
|
||||
TableType pt lt -> records (pt,lt)
|
||||
TupleType ts -> records ts
|
||||
_ -> S.empty
|
||||
|
||||
rowRecords r = S.insert (sort ls) (records ts)
|
||||
where (ls,ts) = unzip [(l,t)|RecordRow l t<-r]
|
||||
|
||||
instance Records LinValue where
|
||||
records v =
|
||||
case v of
|
||||
ConcatValue v1 v2 -> records (v1,v2)
|
||||
ParamConstant (Param c vs) -> records vs
|
||||
RecordValue r -> rowRecords r
|
||||
TableValue t r -> records (t,r)
|
||||
TupleValue vs -> records vs
|
||||
VariantValue vs -> records vs
|
||||
PreValue alts d -> records (map snd alts,d)
|
||||
Projection v l -> records v
|
||||
Selection v1 v2 -> records (v1,v2)
|
||||
_ -> S.empty
|
||||
|
||||
instance Records rhs => Records (TableRow rhs) where
|
||||
records (TableRow _ v) = records v
|
||||
ignore = trace ("Ignore: "++show t) S.empty
|
||||
|
||||
|
||||
|
||||
records ts = S.unions (map recs ts)
|
||||
where
|
||||
recs t =
|
||||
case t of
|
||||
R r -> S.insert (labels r) (records (map (snd.snd) r))
|
||||
RecType r -> S.insert (labels r) (records (map snd r))
|
||||
_ -> collectOp recs t
|
||||
|
||||
labels = sort . filter (not . isLockLabel) . map fst
|
||||
|
||||
|
||||
-- | Record subtyping is converted into explicit coercions in Haskell
|
||||
coerce env ty t =
|
||||
case (ty,t) of
|
||||
(_,VariantValue ts) -> VariantValue (map (coerce env ty) ts)
|
||||
(TableType ti tv,TableValue _ cs) ->
|
||||
TableValue ti [TableRow p (coerce env tv t)|TableRow p t<-cs]
|
||||
(RecordType rt,RecordValue r) ->
|
||||
RecordValue [RecordRow l (coerce env ft f) |
|
||||
RecordRow l f<-r,ft<-[ft | RecordRow l' ft <- rt, l'==l]]
|
||||
(RecordType rt,VarValue x)->
|
||||
case (ty,t) of
|
||||
(_,Let d t) -> Let d (coerce (extend env d) ty t)
|
||||
(_,FV ts) -> FV (map (coerce env ty) ts)
|
||||
(Table ti tv,V _ ts) -> V ti (map (coerce env tv) ts)
|
||||
(Table ti tv,T (TTyped _) cs) -> T (TTyped ti) (mapSnd (coerce env tv) cs)
|
||||
(RecType rt,R r) ->
|
||||
R [(l,(Just ft,coerce env ft f))|(l,(_,f))<-r,Just ft<-[lookup l rt]]
|
||||
(RecType rt,Vr x)->
|
||||
case lookup x env of
|
||||
Just ty' | ty'/=ty -> -- better to compare to normal form of ty'
|
||||
--trace ("coerce "++render ty'++" to "++render ty) $
|
||||
app (to_rcon rt) [t]
|
||||
| otherwise -> t -- types match, no coercion needed
|
||||
_ -> trace (render ("missing type to coerce"<+>x<+>"to"<+>render ty
|
||||
$$ "in" <+> map fst env))
|
||||
t
|
||||
--trace ("coerce "++render ty'++" to "++render ty) $
|
||||
App (to_rcon (map fst rt)) t
|
||||
_ -> trace ("no coerce to "++render ty) t
|
||||
_ -> t
|
||||
where
|
||||
app f ts = ParamConstant (Param f ts) -- !! a hack
|
||||
to_rcon = ParamId . Unqual . rawIdentS . to_rcon' . labels
|
||||
extend env (x,(Just ty,rhs)) = (x,ty):env
|
||||
extend env _ = env
|
||||
|
||||
patVars p = []
|
||||
convert va gId gr = convert' va gId [] gr
|
||||
|
||||
labels r = [l | RecordRow l _ <- r]
|
||||
convert' va gId vs gr = ppT
|
||||
where
|
||||
ppT0 = convert' False gId vs gr
|
||||
ppTv vs' = convert' va gId vs' gr
|
||||
|
||||
proj = Var . identS . proj'
|
||||
proj' (LabelId l) = "proj_" ++ showRawIdent l
|
||||
rcon = Var . rcon'
|
||||
ppT t =
|
||||
case t of
|
||||
-- Only for 'let' inserted on the top-level by this converter:
|
||||
Let (x,(_,xt)) t -> let1 x (ppT0 xt) (ppT t)
|
||||
-- Abs b x t -> ...
|
||||
V ty ts -> pure (c "table" `Ap` dedup ts)
|
||||
T (TTyped ty) cs -> pure (LambdaCase (map ppCase cs))
|
||||
S t p -> select (ppT t) (ppT p)
|
||||
C t1 t2 -> concat (ppT t1) (ppT t2)
|
||||
App f a -> ap (ppT f) (ppT a)
|
||||
R r -> aps (ppT (rcon (map fst r))) (fields r)
|
||||
P t l -> ap (ppT (proj l)) (ppT t)
|
||||
FV [] -> empty
|
||||
Vr x -> if x `elem` vs then pure (Var x) else Var x
|
||||
Cn x -> pure (Var x)
|
||||
Con c -> pure (Var (gId c))
|
||||
Sort k -> pure (Var k)
|
||||
EInt n -> pure (lit n)
|
||||
Q (m,n) -> if m==cPredef then pure (ppPredef n) else Var (qual m n)
|
||||
QC (m,n) -> pure (Var (gId (qual m n)))
|
||||
K s -> pure (token s)
|
||||
Empty -> pure (List [])
|
||||
FV ts@(_:_) -> variants ts
|
||||
Alts t' vs -> pure (alts t' vs)
|
||||
|
||||
ppCase (p,t) = (ppP p,ppTv (patVars p++vs) t)
|
||||
|
||||
ppPredef n =
|
||||
case predef n of
|
||||
Ok BIND -> single (c "BIND")
|
||||
Ok SOFT_BIND -> single (c "SOFT_BIND")
|
||||
Ok SOFT_SPACE -> single (c "SOFT_SPACE")
|
||||
Ok CAPIT -> single (c "CAPIT")
|
||||
Ok ALL_CAPIT -> single (c "ALL_CAPIT")
|
||||
_ -> Var n
|
||||
|
||||
ppP p =
|
||||
case p of
|
||||
PC c ps -> ConP (gId c) (map ppP ps)
|
||||
PP (_,c) ps -> ConP (gId c) (map ppP ps)
|
||||
PR r -> ConP (rcon' (map fst r)) (map (ppP.snd) (filter (not.isLockLabel.fst) r))
|
||||
PW -> WildP
|
||||
PV x -> VarP x
|
||||
PString s -> Lit (show s) -- !!
|
||||
PInt i -> Lit (show i)
|
||||
PFloat x -> Lit (show x)
|
||||
PT _ p -> ppP p
|
||||
PAs x p -> AsP x (ppP p)
|
||||
|
||||
token s = single (c "TK" `Ap` lit s)
|
||||
|
||||
alts t' vs = single (c "TP" `Ap` List (map alt vs) `Ap` ppT0 t')
|
||||
where
|
||||
alt (t,p) = Pair (List (pre p)) (ppT0 t)
|
||||
|
||||
pre (K s) = [lit s]
|
||||
pre (Strs ts) = concatMap pre ts
|
||||
pre (EPatt p) = pat p
|
||||
pre t = error $ "pre "++show t
|
||||
|
||||
pat (PString s) = [lit s]
|
||||
pat (PAlt p1 p2) = pat p1++pat p2
|
||||
pat p = error $ "pat "++show p
|
||||
|
||||
fields = map (ppT.snd.snd) . sort . filter (not.isLockLabel.fst)
|
||||
|
||||
c = Const
|
||||
lit s = c (show s) -- hmm
|
||||
concat = if va then concat' else plusplus
|
||||
where
|
||||
concat' (List [List ts1]) (List [List ts2]) = List [List (ts1++ts2)]
|
||||
concat' t1 t2 = Op t1 "+++" t2
|
||||
pure = if va then single else id
|
||||
pure' = single -- forcing the list monad
|
||||
|
||||
select = if va then select' else Ap
|
||||
select' (List [t]) (List [p]) = Op t "!" p
|
||||
select' (List [t]) p = Op t "!$" p
|
||||
select' t p = Op t "!*" p
|
||||
|
||||
ap = if va then ap' else Ap
|
||||
where
|
||||
ap' (List [f]) x = fmap f x
|
||||
ap' f x = Op f "<*>" x
|
||||
fmap f (List [x]) = pure' (Ap f x)
|
||||
fmap f x = Op f "<$>" x
|
||||
|
||||
-- join = if va then join' else id
|
||||
join' (List [x]) = x
|
||||
join' x = c "concat" `Ap` x
|
||||
|
||||
empty = if va then List [] else c "error" `Ap` c (show "empty variant")
|
||||
variants = if va then \ ts -> join' (List (map ppT ts))
|
||||
else \ (t:_) -> ppT t
|
||||
|
||||
aps f [] = f
|
||||
aps f (a:as) = aps (ap f a) as
|
||||
|
||||
dedup ts =
|
||||
if M.null dups
|
||||
then List (map ppT ts)
|
||||
else Lets [(ev i,ppT t)|(i,t)<-defs] (List (zipWith entry ts is))
|
||||
where
|
||||
entry t i = maybe (ppT t) (Var . ev) (M.lookup i dups)
|
||||
ev i = identS ("e'"++show i)
|
||||
|
||||
defs = [(i1,t)|(t,i1:_:_)<-ms]
|
||||
dups = M.fromList [(i2,i1)|(_,i1:is@(_:_))<-ms,i2<-i1:is]
|
||||
ms = M.toList m
|
||||
m = fmap sort (M.fromListWith (++) (zip ts [[i]|i<-is]))
|
||||
is = [0..]::[Int]
|
||||
|
||||
patVars p =
|
||||
case p of
|
||||
PV x -> [x]
|
||||
PAs x p -> x:patVars p
|
||||
_ -> collectPattOp patVars p
|
||||
|
||||
convType va gId = ppT
|
||||
where
|
||||
ppT t =
|
||||
case t of
|
||||
Table ti tv -> Fun (ppT ti) (if va then ListT (ppT tv) else ppT tv)
|
||||
RecType rt -> tcon (rcon' (map fst rt)) (fields rt)
|
||||
App tf ta -> TAp (ppT tf) (ppT ta)
|
||||
FV [] -> tcon0 (identS "({-empty variant-})")
|
||||
Sort k -> tcon0 k
|
||||
EInt n -> tcon0 (identS ("({-"++show n++"-})")) -- type level numeric literal
|
||||
FV (t:ts) -> ppT t -- !!
|
||||
QC (m,n) -> tcon0 (gId (qual m n))
|
||||
Q (m,n) -> tcon0 (gId (qual m n))
|
||||
_ -> error $ "Missing case in convType for: "++show t
|
||||
|
||||
fields = map (ppT.snd) . sort . filter (not.isLockLabel.fst)
|
||||
|
||||
proj = con . proj'
|
||||
proj' l = "proj_"++render l
|
||||
rcon = con . rcon_name
|
||||
rcon' = identS . rcon_name
|
||||
rcon_name ls = "R"++concat (sort ['_':showRawIdent l | LabelId l <- ls])
|
||||
rcon_name ls = "R"++concat (sort ['_':render l|l<-ls,not (isLockLabel l)])
|
||||
to_rcon = con . to_rcon'
|
||||
to_rcon' = ("to_"++) . rcon_name
|
||||
|
||||
recordType ls =
|
||||
@@ -385,6 +400,31 @@ labelClass l =
|
||||
r = identS "r"
|
||||
a = identS "a"
|
||||
|
||||
paramType va gId gr q@(_,n) =
|
||||
case lookupOrigInfo gr q of
|
||||
Ok (m,ResParam (Just (L _ ps)) _)
|
||||
{- - | m/=cPredef && m/=moduleNameS "Prelude"-} ->
|
||||
((S.singleton (m,n),argTypes ps),
|
||||
[Data (conap0 name) (map (param m) ps)["Eq","Ord","Show"],
|
||||
Instance [] (TId (identS "EnumAll") `TAp` TId name)
|
||||
[(lhs0 "enumAll",foldr1 plusplus (map (enumParam m) ps))]]
|
||||
)
|
||||
where name = gId (qual m n)
|
||||
Ok (m,ResOper _ (Just (L _ t)))
|
||||
| m==cPredef && n==cInts ->
|
||||
((S.singleton (m,n),S.empty),
|
||||
[Type (ConAp (gId (qual m n)) [identS "n"]) (TId (identS "Int"))])
|
||||
| otherwise ->
|
||||
((S.singleton (m,n),paramTypes gr t),
|
||||
[Type (conap0 (gId (qual m n))) (convType va gId t)])
|
||||
_ -> ((S.empty,S.empty),[])
|
||||
where
|
||||
param m (n,ctx) = ConAp (gId (qual m n)) [convType va gId t|(_,_,t)<-ctx]
|
||||
argTypes = S.unions . map argTypes1
|
||||
argTypes1 (n,ctx) = S.unions [paramTypes gr t|(_,_,t)<-ctx]
|
||||
|
||||
enumParam m (n,ctx) = enumCon (gId (qual m n)) (length ctx)
|
||||
|
||||
enumCon name arity =
|
||||
if arity==0
|
||||
then single (Var name)
|
||||
@@ -393,23 +433,5 @@ enumCon name arity =
|
||||
ap (List [f]) a = Op f "<$>" a
|
||||
ap f a = Op f "<*>" a
|
||||
|
||||
lincatName,linfunName :: CatId -> Ident
|
||||
lincatName c = prefixIdent "Lin" (toIdent c)
|
||||
linfunName c = prefixIdent "lin" (toIdent c)
|
||||
|
||||
class ToIdent i where toIdent :: i -> Ident
|
||||
|
||||
instance ToIdent ParamId where toIdent (ParamId q) = qIdentC q
|
||||
instance ToIdent PredefId where toIdent (PredefId s) = identC s
|
||||
instance ToIdent CatId where toIdent (CatId s) = identC s
|
||||
instance ToIdent C.FunId where toIdent (FunId s) = identC s
|
||||
instance ToIdent VarValueId where toIdent (VarValueId q) = qIdentC q
|
||||
|
||||
qIdentC = identS . unqual
|
||||
|
||||
unqual (Qual (ModId m) n) = showRawIdent m++"_"++ showRawIdent n
|
||||
unqual (Unqual n) = showRawIdent n
|
||||
|
||||
instance ToIdent VarId where
|
||||
toIdent Anonymous = identW
|
||||
toIdent (VarId s) = identC s
|
||||
qual :: ModuleName -> Ident -> Ident
|
||||
qual m = prefixIdent (render m++"_")
|
||||
|
||||
@@ -3,11 +3,9 @@ module GF.Compile.Export where
|
||||
import PGF
|
||||
import PGF.Internal(ppPGF)
|
||||
import GF.Compile.PGFtoHaskell
|
||||
--import GF.Compile.PGFtoAbstract
|
||||
import GF.Compile.PGFtoJava
|
||||
import GF.Compile.PGFtoProlog
|
||||
import GF.Compile.PGFtoJS
|
||||
import GF.Compile.PGFtoJSON
|
||||
import GF.Compile.PGFtoPython
|
||||
import GF.Infra.Option
|
||||
--import GF.Speech.CFG
|
||||
@@ -36,10 +34,7 @@ exportPGF :: Options
|
||||
exportPGF opts fmt pgf =
|
||||
case fmt of
|
||||
FmtPGFPretty -> multi "txt" (render . ppPGF)
|
||||
FmtCanonicalGF -> [] -- canon "gf" (render80 . abstract2canonical)
|
||||
FmtCanonicalJson-> []
|
||||
FmtJavaScript -> multi "js" pgf2js
|
||||
FmtJSON -> multi "json" pgf2json
|
||||
FmtPython -> multi "py" pgf2python
|
||||
FmtHaskell -> multi "hs" (grammar2haskell opts name)
|
||||
FmtJava -> multi "java" (grammar2java opts name)
|
||||
@@ -62,12 +57,9 @@ exportPGF opts fmt pgf =
|
||||
multi :: String -> (PGF -> String) -> [(FilePath,String)]
|
||||
multi ext pr = [(name <.> ext, pr pgf)]
|
||||
|
||||
-- canon ext pr = [("canonical"</>name<.>ext,pr pgf)]
|
||||
|
||||
single :: String -> (PGF -> CId -> String) -> [(FilePath,String)]
|
||||
single ext pr = [(showCId cnc <.> ext, pr pgf cnc) | cnc <- languages pgf]
|
||||
|
||||
|
||||
-- | Get the name of the concrete syntax to generate output from.
|
||||
-- FIXME: there should be an option to change this.
|
||||
outputConcr :: PGF -> CId
|
||||
|
||||
@@ -25,7 +25,7 @@ import GF.Data.BacktrackM
|
||||
import GF.Data.Operations
|
||||
import GF.Infra.UseIO (ePutStr,ePutStrLn) -- IOE,
|
||||
import GF.Data.Utilities (updateNthM) --updateNth
|
||||
import GF.Compile.Compute.Concrete(normalForm,resourceValues)
|
||||
import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.List as List
|
||||
@@ -41,7 +41,6 @@ import Control.Monad
|
||||
import Control.Monad.Identity
|
||||
--import Control.Exception
|
||||
--import Debug.Trace(trace)
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- main conversion function
|
||||
@@ -82,7 +81,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
|
||||
(goB b1 CNil [])
|
||||
(pres,pargs)
|
||||
pmcfg = getPMCFG pmcfgEnv1
|
||||
|
||||
|
||||
stats = let PMCFG prods funs = pmcfg
|
||||
(s,e) = bounds funs
|
||||
!prods_cnt = length prods
|
||||
@@ -103,7 +102,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
|
||||
newArgs = map getFIds newArgs'
|
||||
in addFunction env0 newCat fun newArgs
|
||||
|
||||
addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat))
|
||||
addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat))
|
||||
mdef@(Just (L loc1 def))
|
||||
mref@(Just (L loc2 ref))
|
||||
mprn
|
||||
@@ -162,7 +161,7 @@ pgfCncCat :: SourceGrammar -> Type -> Int -> CncCat
|
||||
pgfCncCat gr lincat index =
|
||||
let ((_,size),schema) = computeCatRange gr lincat
|
||||
in PGF.CncCat index (index+size-1)
|
||||
(mkArray (map (renderStyle style{mode=OneLineMode} . ppPath)
|
||||
(mkArray (map (renderStyle style{mode=OneLineMode} . ppPath)
|
||||
(getStrPaths schema)))
|
||||
where
|
||||
getStrPaths :: Schema Identity s c -> [Path]
|
||||
@@ -197,9 +196,6 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
|
||||
-> ([ProtoFCat],[Symbol])
|
||||
-> Branch b}
|
||||
|
||||
instance Fail.MonadFail CnvMonad where
|
||||
fail = bug
|
||||
|
||||
instance Applicative CnvMonad where
|
||||
pure = return
|
||||
(<*>) = ap
|
||||
@@ -243,7 +239,7 @@ choices nr path = do (args,_) <- get
|
||||
| (value,index) <- values])
|
||||
descend schema path rpath = bug $ "descend "++show (schema,path,rpath)
|
||||
|
||||
updateEnv path value gr c (args,seq) =
|
||||
updateEnv path value gr c (args,seq) =
|
||||
case updateNthM (restrictProtoFCat path value) nr args of
|
||||
Just args -> c value (args,seq)
|
||||
Nothing -> bug "conflict in updateEnv"
|
||||
@@ -606,7 +602,7 @@ restrictProtoFCat path v (PFCat cat f schema) = do
|
||||
Just index -> return (CPar (m,[(v,index)]))
|
||||
Nothing -> mzero
|
||||
addConstraint CNil v (CStr _) = bug "restrictProtoFCat: string path"
|
||||
|
||||
|
||||
update k0 f [] = return []
|
||||
update k0 f (x@(k,Identity v):xs)
|
||||
| k0 == k = do v <- f v
|
||||
@@ -618,23 +614,6 @@ mkArray lst = listArray (0,length lst-1) lst
|
||||
mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
|
||||
|
||||
bug msg = ppbug msg
|
||||
ppbug msg = error completeMsg
|
||||
where
|
||||
originalMsg = render $ hang "Internal error in GeneratePMCFG:" 4 msg
|
||||
completeMsg =
|
||||
case render msg of -- the error message for pattern matching a runtime string
|
||||
"descend (CStr 0,CNil,CProj (LIdent (Id {rawId2utf8 = \"s\"})) CNil)"
|
||||
-> unlines [originalMsg -- add more helpful output
|
||||
,""
|
||||
,"1) Check that you are not trying to pattern match a /runtime string/."
|
||||
," These are illegal:"
|
||||
," lin Test foo = case foo.s of {"
|
||||
," \"str\" => … } ; <- explicit matching argument of a lin"
|
||||
," lin Test foo = opThatMatches foo <- calling an oper that pattern matches"
|
||||
,""
|
||||
,"2) Not about pattern matching? Submit a bug report and we update the error message."
|
||||
," https://github.com/GrammaticalFramework/gf-core/issues"
|
||||
]
|
||||
_ -> originalMsg -- any other message: just print it as is
|
||||
ppbug msg = error . render $ hang "Internal error in GeneratePMCFG:" 4 msg
|
||||
|
||||
ppU = ppTerm Unqualified
|
||||
|
||||
@@ -1,439 +0,0 @@
|
||||
-- | Translate grammars to Canonical form
|
||||
-- (a common intermediate representation to simplify export to other formats)
|
||||
module GF.Compile.GrammarToCanonical(
|
||||
grammar2canonical,abstract2canonical,concretes2canonical,
|
||||
projection,selection
|
||||
) where
|
||||
import Data.List(nub,partition)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe(fromMaybe)
|
||||
import qualified Data.Set as S
|
||||
import GF.Data.ErrM
|
||||
import GF.Text.Pretty
|
||||
import GF.Grammar.Grammar as G
|
||||
import GF.Grammar.Lookup(lookupOrigInfo,allOrigInfos,allParamValues)
|
||||
import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,composSafeOp,mkAbs,mkApp,term2patt,sortRec)
|
||||
import GF.Grammar.Lockfield(isLockLabel)
|
||||
import GF.Grammar.Predef(cPredef,cInts)
|
||||
import GF.Compile.Compute.Predef(predef)
|
||||
import GF.Compile.Compute.Value(Predefined(..))
|
||||
import GF.Infra.Ident(ModuleName(..),Ident,ident2raw,rawIdentS,showIdent,isWildIdent)
|
||||
import GF.Infra.Option(Options,optionsPGF)
|
||||
import PGF.Internal(Literal(..))
|
||||
import GF.Compile.Compute.Concrete(GlobalEnv,normalForm,resourceValues)
|
||||
import GF.Grammar.Canonical as C
|
||||
import System.FilePath ((</>), (<.>))
|
||||
import qualified Debug.Trace as T
|
||||
|
||||
|
||||
-- | Generate Canonical code for the named abstract syntax and all associated
|
||||
-- concrete syntaxes
|
||||
grammar2canonical :: Options -> ModuleName -> G.Grammar -> C.Grammar
|
||||
grammar2canonical opts absname gr =
|
||||
Grammar (abstract2canonical absname gr)
|
||||
(map snd (concretes2canonical opts absname gr))
|
||||
|
||||
-- | Generate Canonical code for the named abstract syntax
|
||||
abstract2canonical :: ModuleName -> G.Grammar -> Abstract
|
||||
abstract2canonical absname gr =
|
||||
Abstract (modId absname) (convFlags gr absname) cats funs
|
||||
where
|
||||
cats = [CatDef (gId c) (convCtx ctx) | ((_,c),AbsCat ctx) <- adefs]
|
||||
|
||||
funs = [FunDef (gId f) (convType ty) |
|
||||
((_,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs]
|
||||
|
||||
adefs = allOrigInfos gr absname
|
||||
|
||||
convCtx = maybe [] (map convHypo . unLoc)
|
||||
convHypo (bt,name,t) =
|
||||
case typeForm t of
|
||||
([],(_,cat),[]) -> gId cat -- !!
|
||||
tf -> error $ "abstract2canonical convHypo: " ++ show tf
|
||||
|
||||
convType t =
|
||||
case typeForm t of
|
||||
(hyps,(_,cat),args) -> Type bs (TypeApp (gId cat) as)
|
||||
where
|
||||
bs = map convHypo' hyps
|
||||
as = map convType args
|
||||
|
||||
convHypo' (bt,name,t) = TypeBinding (gId name) (convType t)
|
||||
|
||||
-- | Generate Canonical code for the all concrete syntaxes associated with
|
||||
-- the named abstract syntax in given the grammar.
|
||||
concretes2canonical :: Options -> ModuleName -> G.Grammar -> [(FilePath, Concrete)]
|
||||
concretes2canonical opts absname gr =
|
||||
[(cncname,concrete2canonical gr cenv absname cnc cncmod)
|
||||
| let cenv = resourceValues opts gr,
|
||||
cnc<-allConcretes gr absname,
|
||||
let cncname = "canonical" </> render cnc <.> "gf"
|
||||
Ok cncmod = lookupModule gr cnc
|
||||
]
|
||||
|
||||
-- | Generate Canonical GF for the given concrete module.
|
||||
concrete2canonical :: G.Grammar -> GlobalEnv -> ModuleName -> ModuleName -> ModuleInfo -> Concrete
|
||||
concrete2canonical gr cenv absname cnc modinfo =
|
||||
Concrete (modId cnc) (modId absname) (convFlags gr cnc)
|
||||
(neededParamTypes S.empty (params defs))
|
||||
[lincat | (_,Left lincat) <- defs]
|
||||
[lin | (_,Right lin) <- defs]
|
||||
where
|
||||
defs = concatMap (toCanonical gr absname cenv) .
|
||||
M.toList $
|
||||
jments modinfo
|
||||
|
||||
params = S.toList . S.unions . map fst
|
||||
|
||||
neededParamTypes have [] = []
|
||||
neededParamTypes have (q:qs) =
|
||||
if q `S.member` have
|
||||
then neededParamTypes have qs
|
||||
else let ((got,need),def) = paramType gr q
|
||||
in def++neededParamTypes (S.union got have) (S.toList need++qs)
|
||||
|
||||
toCanonical :: G.Grammar -> ModuleName -> GlobalEnv -> (Ident, Info) -> [(S.Set QIdent, Either LincatDef LinDef)]
|
||||
toCanonical gr absname cenv (name,jment) =
|
||||
case jment of
|
||||
CncCat (Just (L loc typ)) _ _ pprn _ ->
|
||||
[(pts,Left (LincatDef (gId name) (convType ntyp)))]
|
||||
where
|
||||
pts = paramTypes gr ntyp
|
||||
ntyp = nf loc typ
|
||||
CncFun (Just r@(cat,ctx,lincat)) (Just (L loc def)) pprn _ ->
|
||||
[(tts,Right (LinDef (gId name) (map gId args) (convert gr e')))]
|
||||
where
|
||||
tts = tableTypes gr [e']
|
||||
|
||||
e' = cleanupRecordFields lincat $
|
||||
unAbs (length params) $
|
||||
nf loc (mkAbs params (mkApp def (map Vr args)))
|
||||
params = [(b,x)|(b,x,_)<-ctx]
|
||||
args = map snd params
|
||||
|
||||
AnyInd _ m -> case lookupOrigInfo gr (m,name) of
|
||||
Ok (m,jment) -> toCanonical gr absname cenv (name,jment)
|
||||
_ -> []
|
||||
_ -> []
|
||||
where
|
||||
nf loc = normalForm cenv (L loc name)
|
||||
|
||||
unAbs 0 t = t
|
||||
unAbs n (Abs _ _ t) = unAbs (n-1) t
|
||||
unAbs _ t = t
|
||||
|
||||
tableTypes :: G.Grammar -> [Term] -> S.Set QIdent
|
||||
tableTypes gr ts = S.unions (map tabtys ts)
|
||||
where
|
||||
tabtys t =
|
||||
case t of
|
||||
V t cc -> S.union (paramTypes gr t) (tableTypes gr cc)
|
||||
T (TTyped t) cs -> S.union (paramTypes gr t) (tableTypes gr (map snd cs))
|
||||
_ -> collectOp tabtys t
|
||||
|
||||
paramTypes :: G.Grammar -> G.Type -> S.Set QIdent
|
||||
paramTypes gr t =
|
||||
case t of
|
||||
RecType fs -> S.unions (map (paramTypes gr.snd) fs)
|
||||
Table t1 t2 -> S.union (paramTypes gr t1) (paramTypes gr t2)
|
||||
App tf ta -> S.union (paramTypes gr tf) (paramTypes gr ta)
|
||||
Sort _ -> S.empty
|
||||
EInt _ -> S.empty
|
||||
Q q -> lookup q
|
||||
QC q -> lookup q
|
||||
FV ts -> S.unions (map (paramTypes gr) ts)
|
||||
_ -> ignore
|
||||
where
|
||||
lookup q = case lookupOrigInfo gr q of
|
||||
Ok (_,ResOper _ (Just (L _ t))) ->
|
||||
S.insert q (paramTypes gr t)
|
||||
Ok (_,ResParam {}) -> S.singleton q
|
||||
_ -> ignore
|
||||
|
||||
ignore = T.trace ("Ignore: " ++ show t) S.empty
|
||||
|
||||
-- | Filter out record fields from definitions which don't appear in lincat.
|
||||
cleanupRecordFields :: G.Type -> Term -> Term
|
||||
cleanupRecordFields (RecType ls) (R as) =
|
||||
let defnFields = M.fromList ls
|
||||
in R
|
||||
[ (lbl, (mty, t'))
|
||||
| (lbl, (mty, t)) <- as
|
||||
, M.member lbl defnFields
|
||||
, let Just ty = M.lookup lbl defnFields
|
||||
, let t' = cleanupRecordFields ty t
|
||||
]
|
||||
cleanupRecordFields ty t@(FV _) = composSafeOp (cleanupRecordFields ty) t
|
||||
cleanupRecordFields _ t = t
|
||||
|
||||
convert :: G.Grammar -> Term -> LinValue
|
||||
convert gr = convert' gr []
|
||||
|
||||
convert' :: G.Grammar -> [Ident] -> Term -> LinValue
|
||||
convert' gr vs = ppT
|
||||
where
|
||||
ppT0 = convert' gr vs
|
||||
ppTv vs' = convert' gr vs'
|
||||
|
||||
ppT t =
|
||||
case t of
|
||||
-- Abs b x t -> ...
|
||||
-- V ty ts -> VTableValue (convType ty) (map ppT ts)
|
||||
V ty ts -> TableValue (convType ty) [TableRow (ppP p) (ppT t)|(p,t)<-zip ps ts]
|
||||
where
|
||||
Ok pts = allParamValues gr ty
|
||||
Ok ps = mapM term2patt pts
|
||||
T (TTyped ty) cs -> TableValue (convType ty) (map ppCase cs)
|
||||
S t p -> selection (ppT t) (ppT p)
|
||||
C t1 t2 -> concatValue (ppT t1) (ppT t2)
|
||||
App f a -> ap (ppT f) (ppT a)
|
||||
R r -> RecordValue (fields (sortRec r))
|
||||
P t l -> projection (ppT t) (lblId l)
|
||||
Vr x -> VarValue (gId x)
|
||||
Cn x -> VarValue (gId x) -- hmm
|
||||
Con c -> ParamConstant (Param (gId c) [])
|
||||
Sort k -> VarValue (gId k)
|
||||
EInt n -> LiteralValue (IntConstant n)
|
||||
Q (m,n) -> if m==cPredef then ppPredef n else VarValue (gQId m n)
|
||||
QC (m,n) -> ParamConstant (Param (gQId m n) [])
|
||||
K s -> LiteralValue (StrConstant s)
|
||||
Empty -> LiteralValue (StrConstant "")
|
||||
FV ts -> VariantValue (map ppT ts)
|
||||
Alts t' vs -> alts vs (ppT t')
|
||||
_ -> error $ "convert' ppT: " ++ show t
|
||||
|
||||
ppCase (p,t) = TableRow (ppP p) (ppTv (patVars p++vs) t)
|
||||
|
||||
ppPredef n =
|
||||
case predef n of
|
||||
Ok BIND -> p "BIND"
|
||||
Ok SOFT_BIND -> p "SOFT_BIND"
|
||||
Ok SOFT_SPACE -> p "SOFT_SPACE"
|
||||
Ok CAPIT -> p "CAPIT"
|
||||
Ok ALL_CAPIT -> p "ALL_CAPIT"
|
||||
_ -> VarValue (gQId cPredef n) -- hmm
|
||||
where
|
||||
p = PredefValue . PredefId . rawIdentS
|
||||
|
||||
ppP p =
|
||||
case p of
|
||||
PC c ps -> ParamPattern (Param (gId c) (map ppP ps))
|
||||
PP (m,c) ps -> ParamPattern (Param (gQId m c) (map ppP ps))
|
||||
PR r -> RecordPattern (fields r) {-
|
||||
PW -> WildPattern
|
||||
PV x -> VarP x
|
||||
PString s -> Lit (show s) -- !!
|
||||
PInt i -> Lit (show i)
|
||||
PFloat x -> Lit (show x)
|
||||
PT _ p -> ppP p
|
||||
PAs x p -> AsP x (ppP p) -}
|
||||
_ -> error $ "convert' ppP: " ++ show p
|
||||
where
|
||||
fields = map field . filter (not.isLockLabel.fst)
|
||||
field (l,p) = RecordRow (lblId l) (ppP p)
|
||||
|
||||
-- patToParam p = case ppP p of ParamPattern pv -> pv
|
||||
|
||||
-- token s = single (c "TK" `Ap` lit s)
|
||||
|
||||
alts vs = PreValue (map alt vs)
|
||||
where
|
||||
alt (t,p) = (pre p,ppT0 t)
|
||||
|
||||
pre (K s) = [s]
|
||||
pre Empty = [""] -- Empty == K ""
|
||||
pre (Strs ts) = concatMap pre ts
|
||||
pre (EPatt p) = pat p
|
||||
pre t = error $ "convert' alts pre: " ++ show t
|
||||
|
||||
pat (PString s) = [s]
|
||||
pat (PAlt p1 p2) = pat p1++pat p2
|
||||
pat (PSeq p1 p2) = [s1++s2 | s1<-pat p1, s2<-pat p2]
|
||||
pat p = error $ "convert' alts pat: "++show p
|
||||
|
||||
fields = map field . filter (not.isLockLabel.fst)
|
||||
field (l,(_,t)) = RecordRow (lblId l) (ppT t)
|
||||
--c = Const
|
||||
--c = VarValue . VarValueId
|
||||
--lit s = c (show s) -- hmm
|
||||
|
||||
ap f a = case f of
|
||||
ParamConstant (Param p ps) ->
|
||||
ParamConstant (Param p (ps++[a]))
|
||||
_ -> error $ "convert' ap: "++render (ppA f <+> ppA a)
|
||||
|
||||
concatValue :: LinValue -> LinValue -> LinValue
|
||||
concatValue v1 v2 =
|
||||
case (v1,v2) of
|
||||
(LiteralValue (StrConstant ""),_) -> v2
|
||||
(_,LiteralValue (StrConstant "")) -> v1
|
||||
_ -> ConcatValue v1 v2
|
||||
|
||||
-- | Smart constructor for projections
|
||||
projection :: LinValue -> LabelId -> LinValue
|
||||
projection r l = fromMaybe (Projection r l) (proj r l)
|
||||
|
||||
proj :: LinValue -> LabelId -> Maybe LinValue
|
||||
proj r l =
|
||||
case r of
|
||||
RecordValue r -> case [v | RecordRow l' v <- r, l'==l] of
|
||||
[v] -> Just v
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
|
||||
-- | Smart constructor for selections
|
||||
selection :: LinValue -> LinValue -> LinValue
|
||||
selection t v =
|
||||
-- Note: impossible cases can become possible after grammar transformation
|
||||
case t of
|
||||
TableValue tt r ->
|
||||
case nub [rv | TableRow _ rv <- keep] of
|
||||
[rv] -> rv
|
||||
_ -> Selection (TableValue tt r') v
|
||||
where
|
||||
-- Don't introduce wildcard patterns, true to the canonical format,
|
||||
-- annotate (or eliminate) rhs in impossible rows
|
||||
r' = map trunc r
|
||||
trunc r@(TableRow p e) = if mightMatchRow v r
|
||||
then r
|
||||
else TableRow p (impossible e)
|
||||
{-
|
||||
-- Creates smaller tables, but introduces wildcard patterns
|
||||
r' = if null discard
|
||||
then r
|
||||
else keep++[TableRow WildPattern impossible]
|
||||
-}
|
||||
(keep,discard) = partition (mightMatchRow v) r
|
||||
_ -> Selection t v
|
||||
|
||||
impossible :: LinValue -> LinValue
|
||||
impossible = CommentedValue "impossible"
|
||||
|
||||
mightMatchRow :: LinValue -> TableRow rhs -> Bool
|
||||
mightMatchRow v (TableRow p _) =
|
||||
case p of
|
||||
WildPattern -> True
|
||||
_ -> mightMatch v p
|
||||
|
||||
mightMatch :: LinValue -> LinPattern -> Bool
|
||||
mightMatch v p =
|
||||
case v of
|
||||
ConcatValue _ _ -> False
|
||||
ParamConstant (Param c1 pvs) ->
|
||||
case p of
|
||||
ParamPattern (Param c2 pps) -> c1==c2 && length pvs==length pps &&
|
||||
and [mightMatch v p|(v,p)<-zip pvs pps]
|
||||
_ -> False
|
||||
RecordValue rv ->
|
||||
case p of
|
||||
RecordPattern rp ->
|
||||
and [maybe False (`mightMatch` p) (proj v l) | RecordRow l p<-rp]
|
||||
_ -> False
|
||||
_ -> True
|
||||
|
||||
patVars :: Patt -> [Ident]
|
||||
patVars p =
|
||||
case p of
|
||||
PV x -> [x]
|
||||
PAs x p -> x:patVars p
|
||||
_ -> collectPattOp patVars p
|
||||
|
||||
convType :: Term -> LinType
|
||||
convType = ppT
|
||||
where
|
||||
ppT t =
|
||||
case t of
|
||||
Table ti tv -> TableType (ppT ti) (ppT tv)
|
||||
RecType rt -> RecordType (convFields rt)
|
||||
-- App tf ta -> TAp (ppT tf) (ppT ta)
|
||||
-- FV [] -> tcon0 (identS "({-empty variant-})")
|
||||
Sort k -> convSort k
|
||||
-- EInt n -> tcon0 (identS ("({-"++show n++"-})")) -- type level numeric literal
|
||||
FV (t:ts) -> ppT t -- !!
|
||||
QC (m,n) -> ParamType (ParamTypeId (gQId m n))
|
||||
Q (m,n) -> ParamType (ParamTypeId (gQId m n))
|
||||
_ -> error $ "convType ppT: " ++ show t
|
||||
|
||||
convFields = map convField . filter (not.isLockLabel.fst)
|
||||
convField (l,r) = RecordRow (lblId l) (ppT r)
|
||||
|
||||
convSort k = case showIdent k of
|
||||
"Float" -> FloatType
|
||||
"Int" -> IntType
|
||||
"Str" -> StrType
|
||||
_ -> error $ "convType convSort: " ++ show k
|
||||
|
||||
toParamType :: Term -> ParamType
|
||||
toParamType t = case convType t of
|
||||
ParamType pt -> pt
|
||||
_ -> error $ "toParamType: " ++ show t
|
||||
|
||||
toParamId :: Term -> ParamId
|
||||
toParamId t = case toParamType t of
|
||||
ParamTypeId p -> p
|
||||
|
||||
paramType :: G.Grammar
|
||||
-> (ModuleName, Ident)
|
||||
-> ((S.Set (ModuleName, Ident), S.Set QIdent), [ParamDef])
|
||||
paramType gr q@(_,n) =
|
||||
case lookupOrigInfo gr q of
|
||||
Ok (m,ResParam (Just (L _ ps)) _)
|
||||
{- - | m/=cPredef && m/=moduleNameS "Prelude"-} ->
|
||||
((S.singleton (m,n),argTypes ps),
|
||||
[ParamDef name (map (param m) ps)]
|
||||
)
|
||||
where name = gQId m n
|
||||
Ok (m,ResOper _ (Just (L _ t)))
|
||||
| m==cPredef && n==cInts ->
|
||||
((S.empty,S.empty),[]) {-
|
||||
((S.singleton (m,n),S.empty),
|
||||
[Type (ConAp ((gQId m n)) [identS "n"]) (TId (identS "Int"))])-}
|
||||
| otherwise ->
|
||||
((S.singleton (m,n),paramTypes gr t),
|
||||
[ParamAliasDef (gQId m n) (convType t)])
|
||||
_ -> ((S.empty,S.empty),[])
|
||||
where
|
||||
param m (n,ctx) = Param (gQId m n) [toParamId t|(_,_,t)<-ctx]
|
||||
argTypes = S.unions . map argTypes1
|
||||
argTypes1 (n,ctx) = S.unions [paramTypes gr t|(_,_,t)<-ctx]
|
||||
|
||||
lblId :: Label -> C.LabelId
|
||||
lblId (LIdent ri) = LabelId ri
|
||||
lblId (LVar i) = LabelId (rawIdentS (show i)) -- hmm
|
||||
|
||||
modId :: ModuleName -> C.ModId
|
||||
modId (MN m) = ModId (ident2raw m)
|
||||
|
||||
class FromIdent i where
|
||||
gId :: Ident -> i
|
||||
|
||||
instance FromIdent VarId where
|
||||
gId i = if isWildIdent i then Anonymous else VarId (ident2raw i)
|
||||
|
||||
instance FromIdent C.FunId where gId = C.FunId . ident2raw
|
||||
instance FromIdent CatId where gId = CatId . ident2raw
|
||||
instance FromIdent ParamId where gId = ParamId . unqual
|
||||
instance FromIdent VarValueId where gId = VarValueId . unqual
|
||||
|
||||
class FromIdent i => QualIdent i where
|
||||
gQId :: ModuleName -> Ident -> i
|
||||
|
||||
instance QualIdent ParamId where gQId m n = ParamId (qual m n)
|
||||
instance QualIdent VarValueId where gQId m n = VarValueId (qual m n)
|
||||
|
||||
qual :: ModuleName -> Ident -> QualId
|
||||
qual m n = Qual (modId m) (ident2raw n)
|
||||
|
||||
unqual :: Ident -> QualId
|
||||
unqual n = Unqual (ident2raw n)
|
||||
|
||||
convFlags :: G.Grammar -> ModuleName -> Flags
|
||||
convFlags gr mn =
|
||||
Flags [(rawIdentS n,convLit v) |
|
||||
(n,v)<-err (const []) (optionsPGF.mflags) (lookupModule gr mn)]
|
||||
where
|
||||
convLit l =
|
||||
case l of
|
||||
LStr s -> Str s
|
||||
LInt i -> C.Int i
|
||||
LFlt d -> Flt d
|
||||
@@ -6,11 +6,11 @@ import GF.Compile.GeneratePMCFG
|
||||
import GF.Compile.GenerateBC
|
||||
|
||||
import PGF(CId,mkCId,utf8CId)
|
||||
import PGF.Internal(fidInt,fidFloat,fidString,fidVar)
|
||||
import PGF.Internal(fidInt,fidFloat,fidString,fidVar,DepPragma(..))
|
||||
import PGF.Internal(updateProductionIndices)
|
||||
import qualified PGF.Internal as C
|
||||
import qualified PGF.Internal as D
|
||||
import GF.Grammar.Predef
|
||||
--import GF.Grammar.Printer
|
||||
import GF.Grammar.Grammar
|
||||
import qualified GF.Grammar.Lookup as Look
|
||||
import qualified GF.Grammar as A
|
||||
@@ -22,21 +22,24 @@ import GF.Infra.UseIO (IOE)
|
||||
import GF.Data.Operations
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.IntMap as IntMap
|
||||
import Data.Array.IArray
|
||||
|
||||
|
||||
mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE D.PGF
|
||||
mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE C.PGF
|
||||
mkCanon2pgf opts gr am = do
|
||||
(an,abs) <- mkAbstr am
|
||||
depconf <- case flag optLabelsFile opts of
|
||||
Nothing -> return Map.empty
|
||||
Just fpath -> readDepConfig fpath
|
||||
(an,abs) <- mkAbstr am depconf
|
||||
cncs <- mapM mkConcr (allConcretes gr am)
|
||||
return $ updateProductionIndices (D.PGF Map.empty an abs (Map.fromList cncs))
|
||||
return $ updateProductionIndices (C.PGF Map.empty an abs (Map.fromList cncs))
|
||||
where
|
||||
cenv = resourceValues opts gr
|
||||
|
||||
mkAbstr am = return (mi2i am, D.Abstr flags funs cats)
|
||||
mkAbstr am depconf = return (mi2i am, C.Abstr flags funs cats)
|
||||
where
|
||||
aflags = err (const noOptions) mflags (lookupModule gr am)
|
||||
|
||||
@@ -46,7 +49,7 @@ mkCanon2pgf opts gr am = do
|
||||
|
||||
flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF aflags]
|
||||
|
||||
funs = Map.fromList [(i2i f, (mkType [] ty, arity, mkDef gr arity mdef, 0)) |
|
||||
funs = Map.fromList [(i2i f, (mkType [] ty, fromMaybe [] (Map.lookup (i2i f) depconf), arity, mkDef gr arity mdef, 0)) |
|
||||
((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,
|
||||
let arity = mkArity ma mdef ty]
|
||||
|
||||
@@ -57,9 +60,7 @@ mkCanon2pgf opts gr am = do
|
||||
[(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]
|
||||
|
||||
mkConcr cm = do
|
||||
let cflags = err (const noOptions) mflags (lookupModule gr cm)
|
||||
ciCmp | flag optCaseSensitive cflags = compare
|
||||
| otherwise = C.compareCaseInsensitve
|
||||
let cflags = err (const noOptions) mflags (lookupModule gr cm)
|
||||
|
||||
(ex_seqs,cdefs) <- addMissingPMCFGs
|
||||
Map.empty
|
||||
@@ -68,17 +69,17 @@ mkCanon2pgf opts gr am = do
|
||||
|
||||
let flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF cflags]
|
||||
|
||||
seqs = (mkArray . C.sortNubBy ciCmp . concat) $
|
||||
seqs = (mkSetArray . Set.fromList . concat) $
|
||||
(Map.keys ex_seqs : [maybe [] elems (mseqs mi) | (m,mi) <- allExtends gr cm])
|
||||
|
||||
ex_seqs_arr = mkMapArray ex_seqs :: Array SeqId Sequence
|
||||
|
||||
!(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
|
||||
!(!fid_cnt2,!productions,!lindefs,!linrefs,!cncfuns)
|
||||
= genCncFuns gr am cm ex_seqs_arr ciCmp seqs cdefs fid_cnt1 cnccats
|
||||
|
||||
= genCncFuns gr am cm ex_seqs_arr seqs cdefs fid_cnt1 cnccats
|
||||
|
||||
printnames = genPrintNames cdefs
|
||||
return (mi2i cm, D.Concr flags
|
||||
return (mi2i cm, C.Concr flags
|
||||
printnames
|
||||
cncfuns
|
||||
lindefs
|
||||
@@ -186,58 +187,83 @@ genCncFuns :: Grammar
|
||||
-> ModuleName
|
||||
-> ModuleName
|
||||
-> Array SeqId Sequence
|
||||
-> (Sequence -> Sequence -> Ordering)
|
||||
-> Array SeqId Sequence
|
||||
-> [(QIdent, Info)]
|
||||
-> FId
|
||||
-> Map.Map CId D.CncCat
|
||||
-> Map.Map CId C.CncCat
|
||||
-> (FId,
|
||||
IntMap.IntMap (Set.Set D.Production),
|
||||
IntMap.IntMap (Set.Set C.Production),
|
||||
IntMap.IntMap [FunId],
|
||||
IntMap.IntMap [FunId],
|
||||
Array FunId D.CncFun)
|
||||
genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
|
||||
let (fid_cnt1,funs_cnt1,funs1,lindefs,linrefs) = mkCncCats cdefs fid_cnt 0 [] IntMap.empty IntMap.empty
|
||||
(fid_cnt2,funs_cnt2,funs2,prods) = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
|
||||
in (fid_cnt2,prods,lindefs,linrefs,array (0,funs_cnt2-1) funs2)
|
||||
Array FunId C.CncFun)
|
||||
genCncFuns gr am cm ex_seqs seqs cdefs fid_cnt cnccats =
|
||||
let (fid_cnt1,lindefs,linrefs,fun_st1) = mkCncCats cdefs fid_cnt IntMap.empty IntMap.empty Map.empty
|
||||
((fid_cnt2,crc,prods),fun_st2) = mkCncFuns cdefs lindefs ((fid_cnt1,Map.empty,IntMap.empty),fun_st1)
|
||||
in (fid_cnt2,prods,lindefs,linrefs,array (0,Map.size fun_st2-1) (Map.elems fun_st2))
|
||||
where
|
||||
mkCncCats [] fid_cnt funs_cnt funs lindefs linrefs =
|
||||
(fid_cnt,funs_cnt,funs,lindefs,linrefs)
|
||||
mkCncCats (((m,id),CncCat _ _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs linrefs =
|
||||
let !funs_cnt' = let (s_funid, e_funid) = bounds funs0
|
||||
in funs_cnt+(e_funid-s_funid+1)
|
||||
lindefs' = foldl' (toLinDef (am,id) funs_cnt) lindefs prods0
|
||||
linrefs' = foldl' (toLinRef (am,id) funs_cnt) linrefs prods0
|
||||
funs' = foldl' (toCncFun funs_cnt (m,mkLinDefId id)) funs (assocs funs0)
|
||||
in mkCncCats cdefs fid_cnt funs_cnt' funs' lindefs' linrefs'
|
||||
mkCncCats (_ :cdefs) fid_cnt funs_cnt funs lindefs linrefs =
|
||||
mkCncCats cdefs fid_cnt funs_cnt funs lindefs linrefs
|
||||
mkCncCats [] fid_cnt lindefs linrefs fun_st =
|
||||
(fid_cnt,lindefs,linrefs,fun_st)
|
||||
mkCncCats (((m,id),CncCat _ _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt lindefs linrefs fun_st =
|
||||
let mseqs = case lookupModule gr m of
|
||||
Ok (ModInfo{mseqs=Just mseqs}) -> mseqs
|
||||
_ -> ex_seqs
|
||||
(lindefs',fun_st1) = foldl' (toLinDef (m,id) funs0 mseqs) (lindefs,fun_st ) prods0
|
||||
(linrefs',fun_st2) = foldl' (toLinRef (m,id) funs0 mseqs) (linrefs,fun_st1) prods0
|
||||
in mkCncCats cdefs fid_cnt lindefs' linrefs' fun_st2
|
||||
mkCncCats (_ :cdefs) fid_cnt lindefs linrefs fun_st =
|
||||
mkCncCats cdefs fid_cnt lindefs linrefs fun_st
|
||||
|
||||
mkCncFuns [] fid_cnt funs_cnt funs lindefs crc prods =
|
||||
(fid_cnt,funs_cnt,funs,prods)
|
||||
mkCncFuns (((m,id),CncFun _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs crc prods =
|
||||
let ---Ok ty_C = fmap GM.typeForm (Look.lookupFunType gr am id)
|
||||
ty_C = err error (\x -> x) $ fmap GM.typeForm (Look.lookupFunType gr am id)
|
||||
!funs_cnt' = let (s_funid, e_funid) = bounds funs0
|
||||
in funs_cnt+(e_funid-s_funid+1)
|
||||
!(fid_cnt',crc',prods')
|
||||
= foldl' (toProd lindefs ty_C funs_cnt)
|
||||
(fid_cnt,crc,prods) prods0
|
||||
funs' = foldl' (toCncFun funs_cnt (m,id)) funs (assocs funs0)
|
||||
in mkCncFuns cdefs fid_cnt' funs_cnt' funs' lindefs crc' prods'
|
||||
mkCncFuns (_ :cdefs) fid_cnt funs_cnt funs lindefs crc prods =
|
||||
mkCncFuns cdefs fid_cnt funs_cnt funs lindefs crc prods
|
||||
mkCncFuns [] lindefs st = st
|
||||
mkCncFuns (((m,id),CncFun _ _ _ (Just (PMCFG prods0 funs0))):cdefs) lindefs st =
|
||||
let ty_C = err error (\x -> x) $ fmap GM.typeForm (Look.lookupFunType gr am id)
|
||||
mseqs = case lookupModule gr m of
|
||||
Ok (ModInfo{mseqs=Just mseqs}) -> mseqs
|
||||
_ -> ex_seqs
|
||||
bundles = [([(args0,res0) | Production res0 funid0 args0 <- prods0, funid0==funid],lins) | (funid,lins) <- assocs funs0]
|
||||
!st' = foldl' (toProd id lindefs mseqs ty_C) st bundles
|
||||
in mkCncFuns cdefs lindefs st'
|
||||
mkCncFuns (_ :cdefs) lindefs st =
|
||||
mkCncFuns cdefs lindefs st
|
||||
|
||||
toProd lindefs (ctxt_C,res_C,_) offs st (Production fid0 funid0 args0) =
|
||||
let !((fid_cnt,crc,prods),args) = mapAccumL mkArg st (zip ctxt_C args0)
|
||||
set0 = Set.fromList (map (C.PApply (offs+funid0)) (sequence args))
|
||||
fid = mkFId res_C fid0
|
||||
!prods' = case IntMap.lookup fid prods of
|
||||
Just set -> IntMap.insert fid (Set.union set0 set) prods
|
||||
Nothing -> IntMap.insert fid set0 prods
|
||||
in (fid_cnt,crc,prods')
|
||||
toLinDef mid funs0 mseqs st@(lindefs,fun_st) (Production res0 funid0 [arg0])
|
||||
| arg0 == [fidVar] =
|
||||
let res = mkFId mid res0
|
||||
|
||||
lins = amap (newSeqId mseqs) (funs0 ! funid0)
|
||||
|
||||
!funid = Map.size fun_st
|
||||
!fun_st' = Map.insert ([([C.PArg [] fidVar],res)],lins) (funid, C.CncFun [] lins) fun_st
|
||||
|
||||
!lindefs' = IntMap.insertWith (++) res [funid] lindefs
|
||||
in (lindefs',fun_st')
|
||||
toLinDef res funs0 mseqs st _ = st
|
||||
|
||||
toLinRef mid funs0 mseqs st (Production res0 funid0 [arg0])
|
||||
| res0 == fidVar =
|
||||
let arg = map (mkFId mid) arg0
|
||||
|
||||
lins = amap (newSeqId mseqs) (funs0 ! funid0)
|
||||
|
||||
in foldr (\arg (linrefs,fun_st) ->
|
||||
let !funid = Map.size fun_st
|
||||
!fun_st' = Map.insert ([([C.PArg [] arg],fidVar)],lins) (funid, C.CncFun [] lins) fun_st
|
||||
|
||||
!linrefs' = IntMap.insertWith (++) arg [funid] linrefs
|
||||
in (linrefs',fun_st'))
|
||||
st arg
|
||||
toLinRef res funs0 mseqs st _ = st
|
||||
|
||||
toProd id lindefs mseqs (ctxt_C,res_C,_) (prod_st,fun_st) (sigs0,lins0) =
|
||||
let (prod_st',sigs) = mapAccumL mkCncSig prod_st sigs0
|
||||
lins = amap (newSeqId mseqs) lins0
|
||||
in addBundle id (prod_st',fun_st) (concat sigs,lins)
|
||||
where
|
||||
mkArg st@(fid_cnt,crc,prods) ((_,_,ty),fid0s ) =
|
||||
mkCncSig prod_st (args0,res0) =
|
||||
let !(prod_st',args) = mapAccumL mkArg prod_st (zip ctxt_C args0)
|
||||
res = mkFId res_C res0
|
||||
in (prod_st',[(args,res) | args <- sequence args])
|
||||
|
||||
mkArg st@(fid_cnt,crc,prods) ((_,_,ty),fid0s) =
|
||||
case fid0s of
|
||||
[fid0] -> (st,map (flip C.PArg (mkFId arg_C fid0)) ctxt)
|
||||
fid0s -> case Map.lookup fids crc of
|
||||
@@ -247,45 +273,18 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
|
||||
in ((fid_cnt+1,crc',prods'),map (flip C.PArg fid_cnt) ctxt)
|
||||
where
|
||||
(hargs_C,arg_C) = GM.catSkeleton ty
|
||||
ctxt = mapM (mkCtxt lindefs) hargs_C
|
||||
ctxt = mapM mkCtxt hargs_C
|
||||
fids = map (mkFId arg_C) fid0s
|
||||
|
||||
mkLinDefId id = prefixIdent "lindef " id
|
||||
mkCtxt (_,cat) =
|
||||
case Map.lookup (i2i cat) cnccats of
|
||||
Just (C.CncCat s e _) -> [(C.fidVar,fid) | fid <- [s..e], Just _ <- [IntMap.lookup fid lindefs]]
|
||||
Nothing -> error "GrammarToPGF.mkCtxt failed"
|
||||
|
||||
toLinDef res offs lindefs (Production fid0 funid0 args) =
|
||||
if args == [[fidVar]]
|
||||
then IntMap.insertWith (++) fid [offs+funid0] lindefs
|
||||
else lindefs
|
||||
newSeqId mseqs i = binSearch (mseqs ! i) seqs (bounds seqs)
|
||||
where
|
||||
fid = mkFId res fid0
|
||||
|
||||
toLinRef res offs linrefs (Production fid0 funid0 [fargs]) =
|
||||
if fid0 == fidVar
|
||||
then foldr (\fid -> IntMap.insertWith (++) fid [offs+funid0]) linrefs fids
|
||||
else linrefs
|
||||
where
|
||||
fids = map (mkFId res) fargs
|
||||
|
||||
mkFId (_,cat) fid0 =
|
||||
case Map.lookup (i2i cat) cnccats of
|
||||
Just (C.CncCat s e _) -> s+fid0
|
||||
Nothing -> error ("GrammarToPGF.mkFId: missing category "++showIdent cat)
|
||||
|
||||
mkCtxt lindefs (_,cat) =
|
||||
case Map.lookup (i2i cat) cnccats of
|
||||
Just (C.CncCat s e _) -> [(C.fidVar,fid) | fid <- [s..e], Just _ <- [IntMap.lookup fid lindefs]]
|
||||
Nothing -> error "GrammarToPGF.mkCtxt failed"
|
||||
|
||||
toCncFun offs (m,id) funs (funid0,lins0) =
|
||||
let mseqs = case lookupModule gr m of
|
||||
Ok (ModInfo{mseqs=Just mseqs}) -> mseqs
|
||||
_ -> ex_seqs
|
||||
in (offs+funid0,C.CncFun (i2i id) (amap (newIndex mseqs) lins0)):funs
|
||||
where
|
||||
newIndex mseqs i = binSearch (mseqs ! i) seqs (bounds seqs)
|
||||
|
||||
binSearch v arr (i,j)
|
||||
| i <= j = case ciCmp v (arr ! k) of
|
||||
| i <= j = case compare v (arr ! k) of
|
||||
LT -> binSearch v arr (i,k-1)
|
||||
EQ -> k
|
||||
GT -> binSearch v arr (k+1,j)
|
||||
@@ -293,6 +292,24 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
|
||||
where
|
||||
k = (i+j) `div` 2
|
||||
|
||||
addBundle id ((fid_cnt,crc,prods),fun_st) bundle@(sigs,lins) =
|
||||
case Map.lookup bundle fun_st of
|
||||
Just (funid, C.CncFun funs lins) ->
|
||||
let !fun_st' = Map.insert bundle (funid, C.CncFun (i2i id:funs) lins) fun_st
|
||||
!prods' = foldl' (\prods (args,res) -> IntMap.insert res (Set.singleton (C.PApply funid args)) prods) prods sigs
|
||||
in ((fid_cnt,crc,prods'),fun_st')
|
||||
Nothing ->
|
||||
let !funid = Map.size fun_st
|
||||
!fun_st' = Map.insert bundle (funid, C.CncFun [i2i id] lins) fun_st
|
||||
!prods' = foldl' (\prods (args,res) -> IntMap.insert res (Set.singleton (C.PApply funid args)) prods) prods sigs
|
||||
in ((fid_cnt,crc,prods'),fun_st')
|
||||
|
||||
mkFId (_,cat) fid0 =
|
||||
case Map.lookup (i2i cat) cnccats of
|
||||
Just (C.CncCat s e _) -> s+fid0
|
||||
Nothing -> error ("GrammarToPGF.mkFId: missing category "++showIdent cat)
|
||||
|
||||
|
||||
genPrintNames cdefs =
|
||||
Map.fromAscList [(i2i id, name) | ((m,id),info) <- cdefs, name <- prn info]
|
||||
where
|
||||
@@ -304,5 +321,32 @@ genPrintNames cdefs =
|
||||
flatten (Alts x _) = flatten x
|
||||
flatten (C x y) = flatten x +++ flatten y
|
||||
|
||||
mkArray lst = listArray (0,length lst-1) lst
|
||||
--mkArray lst = listArray (0,length lst-1) lst
|
||||
mkMapArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
|
||||
mkSetArray set = listArray (0,Set.size set-1) [v | v <- Set.toList set]
|
||||
|
||||
|
||||
|
||||
readDepConfig :: FilePath -> IO (Map.Map CId [DepPragma])
|
||||
readDepConfig fpath =
|
||||
fmap (Map.fromList . concatMap toEntry . lines) $ readFile fpath
|
||||
where
|
||||
toEntry l =
|
||||
case words l of
|
||||
[] -> []
|
||||
("--":_) -> []
|
||||
(fun:ws) -> [(mkCId fun,[toPragma w | w <- ws])]
|
||||
|
||||
toPragma "head" = Head 0 ""
|
||||
toPragma ('h':'e':'a':'d':':':cs) =
|
||||
case break (==':') cs of
|
||||
(lbl,[] ) -> Head 0 lbl
|
||||
(lbl,':':cs) -> Head (read cs) lbl
|
||||
toPragma "rel" = Rel 0
|
||||
toPragma ('r':'e':'l':':':cs) = Rel (read cs)
|
||||
toPragma "_" = Skip
|
||||
toPragma "anchor" = Anch
|
||||
toPragma s =
|
||||
case break (==':') s of
|
||||
(lbl,[] ) -> Mod 0 lbl
|
||||
(lbl,':':cs) -> Mod (read cs) lbl
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/09/16 13:56:13 $
|
||||
-- > CVS $Date: 2005/09/16 13:56:13 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.18 $
|
||||
--
|
||||
@@ -21,16 +21,23 @@ import GF.Grammar.Printer
|
||||
import GF.Grammar.Macros
|
||||
import GF.Grammar.Lookup
|
||||
import GF.Grammar.Predef
|
||||
import GF.Compile.Compute.Concrete(GlobalEnv,normalForm,resourceValues)
|
||||
--import GF.Compile.Refresh
|
||||
--import GF.Compile.Compute.Concrete
|
||||
import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)
|
||||
--import GF.Compile.CheckGrammar
|
||||
--import GF.Compile.Update
|
||||
|
||||
import GF.Data.Operations
|
||||
--import GF.Infra.CheckM
|
||||
import GF.Infra.Option
|
||||
|
||||
import Control.Monad
|
||||
--import Data.List
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import GF.Text.Pretty
|
||||
import Debug.Trace
|
||||
|
||||
|
||||
-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
|
||||
|
||||
optimizeModule :: Options -> SourceGrammar -> SourceModule -> Err SourceModule
|
||||
@@ -47,7 +54,7 @@ optimizeModule opts sgr m@(name,mi)
|
||||
|
||||
updateEvalInfo mi (i,info) = do
|
||||
info <- evalInfo oopts resenv sgr (name,mi) i info
|
||||
return (mi{jments=Map.insert i info (jments mi)})
|
||||
return (mi{jments=updateTree (i,info) (jments mi)})
|
||||
|
||||
evalInfo :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
|
||||
evalInfo opts resenv sgr m c info = do
|
||||
@@ -90,7 +97,7 @@ evalInfo opts resenv sgr m c info = do
|
||||
let ppr' = fmap (evalPrintname resenv c) ppr
|
||||
return $ CncFun mt pde' ppr' mpmcfg -- only cat in type actually needed
|
||||
{-
|
||||
ResOper pty pde
|
||||
ResOper pty pde
|
||||
| not new && OptExpand `Set.member` optim -> do
|
||||
pde' <- case pde of
|
||||
Just (L loc de) -> do de <- computeConcrete gr de
|
||||
@@ -171,13 +178,13 @@ mkLinDefault gr typ = liftM (Abs Explicit varStr) $ mkDefField typ
|
||||
_ -> Bad (render ("linearization type field cannot be" <+> typ))
|
||||
|
||||
mkLinReference :: SourceGrammar -> Type -> Err Term
|
||||
mkLinReference gr typ =
|
||||
liftM (Abs Explicit varStr) $
|
||||
mkLinReference gr typ =
|
||||
liftM (Abs Explicit varStr) $
|
||||
case mkDefField typ (Vr varStr) of
|
||||
Bad "no string" -> return Empty
|
||||
x -> x
|
||||
where
|
||||
mkDefField ty trm =
|
||||
mkDefField ty trm =
|
||||
case ty of
|
||||
Table pty ty -> do ps <- allParamValues gr pty
|
||||
case ps of
|
||||
@@ -203,7 +210,7 @@ factor param c i t =
|
||||
T (TComp ty) cs -> factors ty [(p, factor param c (i+1) v) | (p, v) <- cs]
|
||||
_ -> composSafeOp (factor param c i) t
|
||||
where
|
||||
factors ty pvs0
|
||||
factors ty pvs0
|
||||
| not param = V ty (map snd pvs0)
|
||||
factors ty [] = V ty []
|
||||
factors ty pvs0@[(p,v)] = V ty [v]
|
||||
@@ -224,7 +231,7 @@ factor param c i t =
|
||||
replace :: Term -> Term -> Term -> Term
|
||||
replace old new trm =
|
||||
case trm of
|
||||
-- these are the important cases, since they can correspond to patterns
|
||||
-- these are the important cases, since they can correspond to patterns
|
||||
QC _ | trm == old -> new
|
||||
App _ _ | trm == old -> new
|
||||
R _ | trm == old -> new
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/06/17 12:39:07 $
|
||||
-- > CVS $Date: 2005/06/17 12:39:07 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
--
|
||||
@@ -22,65 +22,54 @@ import PGF.Internal
|
||||
import GF.Data.Operations
|
||||
import GF.Infra.Option
|
||||
|
||||
import Data.List(isPrefixOf,find,intercalate,intersperse,groupBy,sortBy)
|
||||
import Data.List --(isPrefixOf, find, intersperse)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
type Prefix = String -> String
|
||||
type DerivingClause = String
|
||||
|
||||
-- | the main function
|
||||
grammar2haskell :: Options
|
||||
-> String -- ^ Module name.
|
||||
-> PGF
|
||||
-> String
|
||||
grammar2haskell opts name gr = foldr (++++) [] $
|
||||
pragmas ++ haskPreamble gadt name derivingClause (extraImports ++ pgfImports) ++
|
||||
[types, gfinstances gId lexical gr'] ++ compos
|
||||
grammar2haskell opts name gr = foldr (++++) [] $
|
||||
pragmas ++ haskPreamble gadt name ++ [types, gfinstances gId lexical gr'] ++ compos
|
||||
where gr' = hSkeleton gr
|
||||
gadt = haskellOption opts HaskellGADT
|
||||
dataExt = haskellOption opts HaskellData
|
||||
pgf2 = haskellOption opts HaskellPGF2
|
||||
lexical cat = haskellOption opts HaskellLexical && isLexicalCat opts cat
|
||||
gId | haskellOption opts HaskellNoPrefix = rmForbiddenChars
|
||||
| otherwise = ("G"++) . rmForbiddenChars
|
||||
-- GF grammars allow weird identifier names inside '', e.g. 'VP/Object'
|
||||
rmForbiddenChars = filter (`notElem` "'!#$%&*+./<=>?@\\^|-~")
|
||||
pragmas | gadt = ["{-# LANGUAGE GADTs, FlexibleInstances, KindSignatures, RankNTypes, TypeSynonymInstances #-}"]
|
||||
| dataExt = ["{-# LANGUAGE DeriveDataTypeable #-}"]
|
||||
gId | haskellOption opts HaskellNoPrefix = id
|
||||
| otherwise = ("G"++)
|
||||
pragmas | gadt = ["{-# OPTIONS_GHC -fglasgow-exts #-}","{-# LANGUAGE GADTs #-}"]
|
||||
| otherwise = []
|
||||
derivingClause
|
||||
| dataExt = "deriving (Show,Data)"
|
||||
| otherwise = "deriving Show"
|
||||
extraImports | gadt = ["import Control.Monad.Identity", "import Data.Monoid"]
|
||||
| dataExt = ["import Data.Data"]
|
||||
| otherwise = []
|
||||
pgfImports | pgf2 = ["import PGF2 hiding (Tree)", "", "showCId :: CId -> String", "showCId = id"]
|
||||
| otherwise = ["import PGF hiding (Tree)"]
|
||||
types | gadt = datatypesGADT gId lexical gr'
|
||||
| otherwise = datatypes gId derivingClause lexical gr'
|
||||
| otherwise = datatypes gId lexical gr'
|
||||
compos | gadt = prCompos gId lexical gr' ++ composClass
|
||||
| otherwise = []
|
||||
|
||||
haskPreamble :: Bool -> String -> String -> [String] -> [String]
|
||||
haskPreamble gadt name derivingClause imports =
|
||||
haskPreamble gadt name =
|
||||
[
|
||||
"module " ++ name ++ " where",
|
||||
""
|
||||
] ++ imports ++ [
|
||||
"",
|
||||
] ++
|
||||
(if gadt then [
|
||||
"import Control.Monad.Identity",
|
||||
"import Data.Monoid"
|
||||
] else []) ++
|
||||
[
|
||||
"import PGF hiding (Tree)",
|
||||
"----------------------------------------------------",
|
||||
"-- automatic translation from GF to Haskell",
|
||||
"----------------------------------------------------",
|
||||
"",
|
||||
"",
|
||||
"class Gf a where",
|
||||
" gf :: a -> Expr",
|
||||
" fg :: Expr -> a",
|
||||
"",
|
||||
predefInst gadt derivingClause "GString" "String" "unStr" "mkStr",
|
||||
predefInst gadt "GString" "String" "unStr" "mkStr",
|
||||
"",
|
||||
predefInst gadt derivingClause "GInt" "Int" "unInt" "mkInt",
|
||||
predefInst gadt "GInt" "Int" "unInt" "mkInt",
|
||||
"",
|
||||
predefInst gadt derivingClause "GFloat" "Double" "unFloat" "mkFloat",
|
||||
predefInst gadt "GFloat" "Double" "unFloat" "mkFloat",
|
||||
"",
|
||||
"----------------------------------------------------",
|
||||
"-- below this line machine-generated",
|
||||
@@ -88,12 +77,11 @@ haskPreamble gadt name derivingClause imports =
|
||||
""
|
||||
]
|
||||
|
||||
predefInst :: Bool -> String -> String -> String -> String -> String -> String
|
||||
predefInst gadt derivingClause gtyp typ destr consr =
|
||||
predefInst gadt gtyp typ destr consr =
|
||||
(if gadt
|
||||
then []
|
||||
else "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ derivingClause ++ "\n\n"
|
||||
)
|
||||
then []
|
||||
else ("newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show\n\n")
|
||||
)
|
||||
++
|
||||
"instance Gf" +++ gtyp +++ "where" ++++
|
||||
" gf (" ++ gtyp +++ "x) =" +++ consr +++ "x" ++++
|
||||
@@ -106,24 +94,24 @@ type OIdent = String
|
||||
|
||||
type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
|
||||
|
||||
datatypes :: Prefix -> DerivingClause -> (OIdent -> Bool) -> (String,HSkeleton) -> String
|
||||
datatypes gId derivingClause lexical = foldr (+++++) "" . filter (/="") . map (hDatatype gId derivingClause lexical) . snd
|
||||
datatypes :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String
|
||||
datatypes gId lexical = (foldr (+++++) "") . (filter (/="")) . (map (hDatatype gId lexical)) . snd
|
||||
|
||||
gfinstances :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String
|
||||
gfinstances gId lexical (m,g) = foldr (+++++) "" $ filter (/="") $ map (gfInstance gId lexical m) g
|
||||
gfinstances gId lexical (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance gId lexical m)) g
|
||||
|
||||
|
||||
hDatatype :: Prefix -> DerivingClause -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String
|
||||
hDatatype _ _ _ ("Cn",_) = "" ---
|
||||
hDatatype gId _ _ (cat,[]) = "data" +++ gId cat
|
||||
hDatatype gId derivingClause _ (cat,rules) | isListCat (cat,rules) =
|
||||
"newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]"
|
||||
+++ derivingClause
|
||||
hDatatype gId derivingClause lexical (cat,rules) =
|
||||
hDatatype :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String
|
||||
hDatatype _ _ ("Cn",_) = "" ---
|
||||
hDatatype gId _ (cat,[]) = "data" +++ gId cat
|
||||
hDatatype gId _ (cat,rules) | isListCat (cat,rules) =
|
||||
"newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]"
|
||||
+++ "deriving Show"
|
||||
hDatatype gId lexical (cat,rules) =
|
||||
"data" +++ gId cat +++ "=" ++
|
||||
(if length rules == 1 then "" else "\n ") +++
|
||||
foldr1 (\x y -> x ++ "\n |" +++ y) constructors ++++
|
||||
" " +++ derivingClause
|
||||
" deriving Show"
|
||||
where
|
||||
constructors = [gId f +++ foldr (+++) "" (map (gId) xx) | (f,xx) <- nonLexicalRules (lexical cat) rules]
|
||||
++ if lexical cat then [lexicalConstructor cat +++ "String"] else []
|
||||
@@ -135,17 +123,16 @@ nonLexicalRules True rules = [r | r@(f,t) <- rules, not (null t)]
|
||||
lexicalConstructor :: OIdent -> String
|
||||
lexicalConstructor cat = "Lex" ++ cat
|
||||
|
||||
predefTypeSkel :: HSkeleton
|
||||
predefTypeSkel = [(c,[]) | c <- ["String", "Int", "Float"]]
|
||||
|
||||
-- GADT version of data types
|
||||
datatypesGADT :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String
|
||||
datatypesGADT gId lexical (_,skel) = unlines $
|
||||
datatypesGADT gId lexical (_,skel) = unlines $
|
||||
concatMap (hCatTypeGADT gId) (skel ++ predefTypeSkel) ++
|
||||
[
|
||||
"",
|
||||
[
|
||||
"",
|
||||
"data Tree :: * -> * where"
|
||||
] ++
|
||||
] ++
|
||||
concatMap (map (" "++) . hDatatypeGADT gId lexical) skel ++
|
||||
[
|
||||
" GString :: String -> Tree GString_",
|
||||
@@ -169,23 +156,23 @@ hCatTypeGADT gId (cat,rules)
|
||||
"data"+++gId cat++"_"]
|
||||
|
||||
hDatatypeGADT :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> [String]
|
||||
hDatatypeGADT gId lexical (cat, rules)
|
||||
hDatatypeGADT gId lexical (cat, rules)
|
||||
| isListCat (cat,rules) = [gId cat+++"::"+++"["++gId (elemCat cat)++"]" +++ "->" +++ t]
|
||||
| otherwise =
|
||||
[ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t
|
||||
[ gId f +++ "::" +++ concatMap (\a -> gId a +++ "-> ") args ++ t
|
||||
| (f,args) <- nonLexicalRules (lexical cat) rules ]
|
||||
++ if lexical cat then [lexicalConstructor cat +++ ":: String ->"+++ t] else []
|
||||
where t = "Tree" +++ gId cat ++ "_"
|
||||
|
||||
hEqGADT :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> [String]
|
||||
hEqGADT gId lexical (cat, rules)
|
||||
| isListCat (cat,rules) = let r = listr cat in ["(" ++ patt "x" r ++ "," ++ patt "y" r ++ ") -> " ++ listeqs]
|
||||
| isListCat (cat,rules) = let r = listr cat in ["(" ++ patt "x" r ++ "," ++ patt "y" r ++ ") -> " ++ listeqs]
|
||||
| otherwise = ["(" ++ patt "x" r ++ "," ++ patt "y" r ++ ") -> " ++ eqs r | r <- nonLexicalRules (lexical cat) rules]
|
||||
++ if lexical cat then ["(" ++ lexicalConstructor cat +++ "x" ++ "," ++ lexicalConstructor cat +++ "y" ++ ") -> x == y"] else []
|
||||
|
||||
where
|
||||
patt s (f,xs) = unwords (gId f : mkSVars s (length xs))
|
||||
eqs (_,xs) = unwords ("and" : "[" : intersperse "," [x ++ " == " ++ y |
|
||||
eqs (_,xs) = unwords ("and" : "[" : intersperse "," [x ++ " == " ++ y |
|
||||
(x,y) <- zip (mkSVars "x" (length xs)) (mkSVars "y" (length xs)) ] ++ ["]"])
|
||||
listr c = (c,["foo"]) -- foo just for length = 1
|
||||
listeqs = "and [x == y | (x,y) <- zip x1 y1]"
|
||||
@@ -194,26 +181,25 @@ prCompos :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> [String]
|
||||
prCompos gId lexical (_,catrules) =
|
||||
["instance Compos Tree where",
|
||||
" compos r a f t = case t of"]
|
||||
++
|
||||
++
|
||||
[" " ++ prComposCons (gId f) xs | (c,rs) <- catrules, not (isListCat (c,rs)),
|
||||
(f,xs) <- rs, not (null xs)]
|
||||
++
|
||||
(f,xs) <- rs, not (null xs)]
|
||||
++
|
||||
[" " ++ prComposCons (gId c) ["x1"] | (c,rs) <- catrules, isListCat (c,rs)]
|
||||
++
|
||||
++
|
||||
[" _ -> r t"]
|
||||
where
|
||||
prComposCons f xs = let vs = mkVars (length xs) in
|
||||
prComposCons f xs = let vs = mkVars (length xs) in
|
||||
f +++ unwords vs +++ "->" +++ rhs f (zip vs xs)
|
||||
rhs f vcs = "r" +++ f +++ unwords (map (prRec f) vcs)
|
||||
prRec f (v,c)
|
||||
prRec f (v,c)
|
||||
| isList f = "`a` foldr (a . a (r (:)) . f) (r [])" +++ v
|
||||
| otherwise = "`a`" +++ "f" +++ v
|
||||
isList f = gId "List" `isPrefixOf` f
|
||||
isList f = (gId "List") `isPrefixOf` f
|
||||
|
||||
gfInstance :: Prefix -> (OIdent -> Bool) -> String -> (OIdent, [(OIdent, [OIdent])]) -> String
|
||||
gfInstance gId lexical m crs = hInstance gId lexical m crs ++++ fInstance gId lexical m crs
|
||||
|
||||
hInstance :: (String -> String) -> (String -> Bool) -> String -> (String, [(OIdent, [OIdent])]) -> String
|
||||
----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004
|
||||
hInstance gId _ m (cat,[]) = unlines [
|
||||
"instance Show" +++ gId cat,
|
||||
@@ -222,15 +208,15 @@ hInstance gId _ m (cat,[]) = unlines [
|
||||
" gf _ = undefined",
|
||||
" fg _ = undefined"
|
||||
]
|
||||
hInstance gId lexical m (cat,rules)
|
||||
hInstance gId lexical m (cat,rules)
|
||||
| isListCat (cat,rules) =
|
||||
"instance Gf" +++ gId cat +++ "where" ++++
|
||||
" gf (" ++ gId cat +++ "[" ++ intercalate "," baseVars ++ "])"
|
||||
" gf (" ++ gId cat +++ "[" ++ concat (intersperse "," baseVars) ++ "])"
|
||||
+++ "=" +++ mkRHS ("Base"++ec) baseVars ++++
|
||||
" gf (" ++ gId cat +++ "(x:xs)) = "
|
||||
++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")]
|
||||
" gf (" ++ gId cat +++ "(x:xs)) = "
|
||||
++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")]
|
||||
-- no show for GADTs
|
||||
-- ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)"
|
||||
-- ++++ " gf (" ++ gId cat +++ "xs) = error (\"Bad " ++ cat ++ " value: \" ++ show xs)"
|
||||
| otherwise =
|
||||
"instance Gf" +++ gId cat +++ "where\n" ++
|
||||
unlines ([mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules]
|
||||
@@ -239,22 +225,19 @@ hInstance gId lexical m (cat,rules)
|
||||
ec = elemCat cat
|
||||
baseVars = mkVars (baseSize (cat,rules))
|
||||
mkInst f xx = let xx' = mkVars (length xx) in " gf " ++
|
||||
(if null xx then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
|
||||
(if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
|
||||
"=" +++ mkRHS f xx'
|
||||
mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++
|
||||
"[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
|
||||
mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++
|
||||
"[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
|
||||
|
||||
mkVars :: Int -> [String]
|
||||
mkVars = mkSVars "x"
|
||||
|
||||
mkSVars :: String -> Int -> [String]
|
||||
mkSVars s n = [s ++ show i | i <- [1..n]]
|
||||
|
||||
----fInstance m ("Cn",_) = "" ---
|
||||
fInstance _ _ m (cat,[]) = ""
|
||||
fInstance gId lexical m (cat,rules) =
|
||||
" fg t =" ++++
|
||||
(if isList
|
||||
(if isList
|
||||
then " " ++ gId cat ++ " (fgs t) where\n fgs t = case unApp t of"
|
||||
else " case unApp t of") ++++
|
||||
unlines [mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] ++++
|
||||
@@ -266,32 +249,31 @@ fInstance gId lexical m (cat,rules) =
|
||||
" Just (i," ++
|
||||
"[" ++ prTList "," xx' ++ "])" +++
|
||||
"| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx'
|
||||
where
|
||||
xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
|
||||
mkRHS f vars
|
||||
| isList =
|
||||
if "Base" `isPrefixOf` f
|
||||
then "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"
|
||||
else "fg" +++ (vars !! 0) +++ ":" +++ "fgs" +++ (vars !! 1)
|
||||
| otherwise =
|
||||
gId f +++
|
||||
prTList " " [prParenth ("fg" +++ x) | x <- vars]
|
||||
where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
|
||||
mkRHS f vars
|
||||
| isList =
|
||||
if "Base" `isPrefixOf` f
|
||||
then "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"
|
||||
else "fg" +++ (vars !! 0) +++ ":" +++ "fgs" +++ (vars !! 1)
|
||||
| otherwise =
|
||||
gId f +++
|
||||
prTList " " [prParenth ("fg" +++ x) | x <- vars]
|
||||
|
||||
--type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
|
||||
hSkeleton :: PGF -> (String,HSkeleton)
|
||||
hSkeleton gr =
|
||||
(showCId (absname gr),
|
||||
let fs =
|
||||
[(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) |
|
||||
hSkeleton gr =
|
||||
(showCId (absname gr),
|
||||
let fs =
|
||||
[(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) |
|
||||
fs@((_, (_,c)):_) <- fns]
|
||||
in fs ++ [(sc, []) | c <- cts, let sc = showCId c, sc `notElem` (["Int", "Float", "String"] ++ map fst fs)]
|
||||
in fs ++ [(sc, []) | c <- cts, let sc = showCId c, notElem sc (["Int", "Float", "String"] ++ map fst fs)]
|
||||
)
|
||||
where
|
||||
cts = Map.keys (cats (abstract gr))
|
||||
cts = Map.keys (cats (abstract gr))
|
||||
fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))
|
||||
valtyps (_, (_,x)) (_, (_,y)) = compare x y
|
||||
valtypg (_, (_,x)) (_, (_,y)) = x == y
|
||||
jty (f,(ty,_,_,_)) = (f,catSkeleton ty)
|
||||
jty (f,(ty,_,_,_,_)) = (f,catSkeleton ty)
|
||||
{-
|
||||
updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
|
||||
updateSkeleton cat skel rule =
|
||||
@@ -301,10 +283,9 @@ updateSkeleton cat skel rule =
|
||||
-}
|
||||
isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool
|
||||
isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
|
||||
&& ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
|
||||
where
|
||||
c = elemCat cat
|
||||
fs = map fst rules
|
||||
&& ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
|
||||
where c = elemCat cat
|
||||
fs = map fst rules
|
||||
|
||||
-- | Gets the element category of a list category.
|
||||
elemCat :: OIdent -> OIdent
|
||||
@@ -321,7 +302,7 @@ baseSize (_,rules) = length bs
|
||||
where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules
|
||||
|
||||
composClass :: [String]
|
||||
composClass =
|
||||
composClass =
|
||||
[
|
||||
"",
|
||||
"class Compos t where",
|
||||
@@ -348,3 +329,4 @@ composClass =
|
||||
"",
|
||||
"newtype C b a = C { unC :: b }"
|
||||
]
|
||||
|
||||
|
||||
@@ -32,8 +32,8 @@ pgf2js pgf =
|
||||
abstract2js :: String -> Abstr -> JS.Expr
|
||||
abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
|
||||
|
||||
absdef2js :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property
|
||||
absdef2js (f,(typ,_,_,_)) =
|
||||
absdef2js :: (CId,(Type,[DepPragma],Int,Maybe ([Equation],[[M.Instr]]),Double)) -> JS.Property
|
||||
absdef2js (f,(typ,_,_,_,_)) =
|
||||
let (args,cat) = M.catSkeleton typ in
|
||||
JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
|
||||
|
||||
@@ -78,7 +78,7 @@ frule2js (PCoerce arg) = new "Coerce" [JS.EInt arg]
|
||||
|
||||
farg2js (PArg hypos fid) = new "PArg" (map (JS.EInt . snd) hypos ++ [JS.EInt fid])
|
||||
|
||||
ffun2js (CncFun f lins) = new "CncFun" [JS.EStr (showCId f), JS.EArray (map JS.EInt (Array.elems lins))]
|
||||
ffun2js (CncFun fns lins) = new "CncFun" [JS.EArray (map (JS.EStr . showCId) fns), JS.EArray (map JS.EInt (Array.elems lins))]
|
||||
|
||||
seq2js :: Array.Array DotPos Symbol -> JS.Expr
|
||||
seq2js seq = JS.EArray [sym2js s | s <- Array.elems seq]
|
||||
|
||||
@@ -1,156 +0,0 @@
|
||||
module GF.Compile.PGFtoJSON (pgf2json) where
|
||||
|
||||
import PGF (showCId)
|
||||
import qualified PGF.Internal as M
|
||||
import PGF.Internal (
|
||||
Abstr,
|
||||
CId,
|
||||
CncCat(..),
|
||||
CncFun(..),
|
||||
Concr,
|
||||
DotPos,
|
||||
Equation(..),
|
||||
Literal(..),
|
||||
PArg(..),
|
||||
PGF,
|
||||
Production(..),
|
||||
Symbol(..),
|
||||
Type,
|
||||
absname,
|
||||
abstract,
|
||||
cflags,
|
||||
cnccats,
|
||||
cncfuns,
|
||||
concretes,
|
||||
funs,
|
||||
productions,
|
||||
sequences,
|
||||
totalCats
|
||||
)
|
||||
|
||||
import qualified Text.JSON as JSON
|
||||
import Text.JSON (JSValue(..))
|
||||
|
||||
import qualified Data.Array.IArray as Array
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.IntMap as IntMap
|
||||
|
||||
pgf2json :: PGF -> String
|
||||
pgf2json pgf =
|
||||
JSON.encode $ JSON.makeObj
|
||||
[ ("abstract", json_abstract)
|
||||
, ("concretes", json_concretes)
|
||||
]
|
||||
where
|
||||
n = showCId $ absname pgf
|
||||
as = abstract pgf
|
||||
cs = Map.assocs (concretes pgf)
|
||||
start = showCId $ M.lookStartCat pgf
|
||||
json_abstract = abstract2json n start as
|
||||
json_concretes = JSON.makeObj $ map concrete2json cs
|
||||
|
||||
abstract2json :: String -> String -> Abstr -> JSValue
|
||||
abstract2json name start ds =
|
||||
JSON.makeObj
|
||||
[ ("name", mkJSStr name)
|
||||
, ("startcat", mkJSStr start)
|
||||
, ("funs", JSON.makeObj $ map absdef2json (Map.assocs (funs ds)))
|
||||
]
|
||||
|
||||
absdef2json :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> (String,JSValue)
|
||||
absdef2json (f,(typ,_,_,_)) = (showCId f,sig)
|
||||
where
|
||||
(args,cat) = M.catSkeleton typ
|
||||
sig = JSON.makeObj
|
||||
[ ("args", JSArray $ map (mkJSStr.showCId) args)
|
||||
, ("cat", mkJSStr $ showCId cat)
|
||||
]
|
||||
|
||||
lit2json :: Literal -> JSValue
|
||||
lit2json (LStr s) = mkJSStr s
|
||||
lit2json (LInt n) = mkJSInt n
|
||||
lit2json (LFlt d) = JSRational True (toRational d)
|
||||
|
||||
concrete2json :: (CId,Concr) -> (String,JSValue)
|
||||
concrete2json (c,cnc) = (showCId c,obj)
|
||||
where
|
||||
obj = JSON.makeObj
|
||||
[ ("flags", JSON.makeObj [ (showCId k, lit2json v) | (k,v) <- Map.toList (cflags cnc) ])
|
||||
, ("productions", JSON.makeObj [ (show cat, JSArray (map frule2json (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)])
|
||||
, ("functions", JSArray (map ffun2json (Array.elems (cncfuns cnc))))
|
||||
, ("sequences", JSArray (map seq2json (Array.elems (sequences cnc))))
|
||||
, ("categories", JSON.makeObj $ map cats2json (Map.assocs (cnccats cnc)))
|
||||
, ("totalfids", mkJSInt (totalCats cnc))
|
||||
]
|
||||
|
||||
cats2json :: (CId, CncCat) -> (String,JSValue)
|
||||
cats2json (c,CncCat start end _) = (showCId c, ixs)
|
||||
where
|
||||
ixs = JSON.makeObj
|
||||
[ ("start", mkJSInt start)
|
||||
, ("end", mkJSInt end)
|
||||
]
|
||||
|
||||
frule2json :: Production -> JSValue
|
||||
frule2json (PApply fid args) =
|
||||
JSON.makeObj
|
||||
[ ("type", mkJSStr "Apply")
|
||||
, ("fid", mkJSInt fid)
|
||||
, ("args", JSArray (map farg2json args))
|
||||
]
|
||||
frule2json (PCoerce arg) =
|
||||
JSON.makeObj
|
||||
[ ("type", mkJSStr "Coerce")
|
||||
, ("arg", mkJSInt arg)
|
||||
]
|
||||
|
||||
farg2json :: PArg -> JSValue
|
||||
farg2json (PArg hypos fid) =
|
||||
JSON.makeObj
|
||||
[ ("type", mkJSStr "PArg")
|
||||
, ("hypos", JSArray $ map (mkJSInt . snd) hypos)
|
||||
, ("fid", mkJSInt fid)
|
||||
]
|
||||
|
||||
ffun2json :: CncFun -> JSValue
|
||||
ffun2json (CncFun f lins) =
|
||||
JSON.makeObj
|
||||
[ ("name", mkJSStr $ showCId f)
|
||||
, ("lins", JSArray (map mkJSInt (Array.elems lins)))
|
||||
]
|
||||
|
||||
seq2json :: Array.Array DotPos Symbol -> JSValue
|
||||
seq2json seq = JSArray [sym2json s | s <- Array.elems seq]
|
||||
|
||||
sym2json :: Symbol -> JSValue
|
||||
sym2json (SymCat n l) = new "SymCat" [mkJSInt n, mkJSInt l]
|
||||
sym2json (SymLit n l) = new "SymLit" [mkJSInt n, mkJSInt l]
|
||||
sym2json (SymVar n l) = new "SymVar" [mkJSInt n, mkJSInt l]
|
||||
sym2json (SymKS t) = new "SymKS" [mkJSStr t]
|
||||
sym2json (SymKP ts alts) = new "SymKP" [JSArray (map sym2json ts), JSArray (map alt2json alts)]
|
||||
sym2json SymBIND = new "SymKS" [mkJSStr "&+"]
|
||||
sym2json SymSOFT_BIND = new "SymKS" [mkJSStr "&+"]
|
||||
sym2json SymSOFT_SPACE = new "SymKS" [mkJSStr "&+"]
|
||||
sym2json SymCAPIT = new "SymKS" [mkJSStr "&|"]
|
||||
sym2json SymALL_CAPIT = new "SymKS" [mkJSStr "&|"]
|
||||
sym2json SymNE = new "SymNE" []
|
||||
|
||||
alt2json :: ([Symbol],[String]) -> JSValue
|
||||
alt2json (ps,ts) = new "Alt" [JSArray (map sym2json ps), JSArray (map mkJSStr ts)]
|
||||
|
||||
new :: String -> [JSValue] -> JSValue
|
||||
new f xs =
|
||||
JSON.makeObj
|
||||
[ ("type", mkJSStr f)
|
||||
, ("args", JSArray xs)
|
||||
]
|
||||
|
||||
-- | Make JSON value from string
|
||||
mkJSStr :: String -> JSValue
|
||||
mkJSStr = JSString . JSON.toJSString
|
||||
|
||||
-- | Make JSON value from integer
|
||||
mkJSInt :: Integral a => a -> JSValue
|
||||
mkJSInt = JSRational False . toRational
|
||||
@@ -54,11 +54,11 @@ plAbstract name abs
|
||||
let args = reverse [EFun x | (_,x) <- subst]] ++++
|
||||
plFacts name "fun" 3 "(?Fun, ?Type, ?[X:Type,...])"
|
||||
[[plp fun, plType cat args, plHypos hypos] |
|
||||
(fun, (typ, _, _, _)) <- Map.assocs (funs abs),
|
||||
(fun, (typ, _, _, _, _)) <- Map.assocs (funs abs),
|
||||
let (_, DTyp hypos cat args) = alphaConvert emptyEnv typ] ++++
|
||||
plFacts name "def" 2 "(?Fun, ?Expr)"
|
||||
[[plp fun, plp expr] |
|
||||
(fun, (_, _, Just (eqs,_), _)) <- Map.assocs (funs abs),
|
||||
(fun, (_, _, _, Just (eqs,_), _)) <- Map.assocs (funs abs),
|
||||
let (_, expr) = alphaConvert emptyEnv eqs]
|
||||
)
|
||||
where plType cat args = plTerm (plp cat) (map plp args)
|
||||
|
||||
@@ -40,8 +40,8 @@ pgf2python pgf = ("# -*- coding: utf-8 -*-" ++++
|
||||
abs = abstract pgf
|
||||
cncs = concretes pgf
|
||||
|
||||
pyAbsdef :: (Type, Int, Maybe ([Equation], [[M.Instr]]), Double) -> String
|
||||
pyAbsdef (typ, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]
|
||||
pyAbsdef :: (Type, [DepPragma], Int, Maybe ([Equation], [[M.Instr]]), Double) -> String
|
||||
pyAbsdef (typ, _, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]
|
||||
where (args, cat) = M.catSkeleton typ
|
||||
|
||||
pyLiteral :: Literal -> String
|
||||
@@ -62,7 +62,7 @@ pyConcrete cnc = pyDict 3 pyStr id [
|
||||
]
|
||||
where pyProds prods = pyList 5 pyProduction (Set.toList prods)
|
||||
pyCncCat (CncCat start end _) = pyList 0 pyCat [start..end]
|
||||
pyCncFun (CncFun f lins) = pyTuple 0 id [pyList 0 pySeq (Array.elems lins), pyCId f]
|
||||
pyCncFun (CncFun fns lins) = pyTuple 0 id [pyList 0 pySeq (Array.elems lins), pyList 0 pyCId fns]
|
||||
pySymbols syms = pyList 0 pySymbol (Array.elems syms)
|
||||
|
||||
pyProduction :: Production -> String
|
||||
|
||||
@@ -27,21 +27,19 @@ module GF.Compile.Rename (
|
||||
renameModule
|
||||
) where
|
||||
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.CheckM
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.Values
|
||||
import GF.Grammar.Predef
|
||||
import GF.Grammar.Lookup
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.CheckM
|
||||
import GF.Grammar.Macros
|
||||
import GF.Grammar.Printer
|
||||
--import GF.Grammar.Lookup
|
||||
--import GF.Grammar.Printer
|
||||
import GF.Data.Operations
|
||||
|
||||
import Control.Monad
|
||||
import Data.List (nub,(\\))
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe(mapMaybe)
|
||||
import GF.Text.Pretty
|
||||
|
||||
-- | this gives top-level access to renaming term input in the cc command
|
||||
@@ -57,9 +55,9 @@ renameModule cwd gr mo@(m,mi) = do
|
||||
js <- checkMapRecover (renameInfo cwd status mo) (jments mi)
|
||||
return (m, mi{jments = js})
|
||||
|
||||
type Status = (StatusMap, [(OpenSpec, StatusMap)])
|
||||
type Status = (StatusTree, [(OpenSpec, StatusTree)])
|
||||
|
||||
type StatusMap = Map.Map Ident StatusInfo
|
||||
type StatusTree = BinTree Ident StatusInfo
|
||||
|
||||
type StatusInfo = Ident -> Term
|
||||
|
||||
@@ -75,12 +73,12 @@ renameIdentTerm' env@(act,imps) t0 =
|
||||
Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
|
||||
Q (m',c) -> do
|
||||
m <- lookupErr m' qualifs
|
||||
f <- lookupIdent c m
|
||||
f <- lookupTree showIdent c m
|
||||
return $ f c
|
||||
QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
|
||||
QC (m',c) -> do
|
||||
m <- lookupErr m' qualifs
|
||||
f <- lookupIdent c m
|
||||
f <- lookupTree showIdent c m
|
||||
return $ f c
|
||||
_ -> return t0
|
||||
where
|
||||
@@ -95,40 +93,30 @@ renameIdentTerm' env@(act,imps) t0 =
|
||||
| otherwise = checkError s
|
||||
|
||||
ident alt c =
|
||||
case Map.lookup c act of
|
||||
Just f -> return (f c)
|
||||
_ -> case mapMaybe (Map.lookup c) opens of
|
||||
[f] -> return (f c)
|
||||
[] -> alt c ("constant not found:" <+> c $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
fs -> case nub [f c | f <- fs] of
|
||||
[tr] -> return tr
|
||||
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
|
||||
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
return (bestTerm ts) -- Heuristic for resource grammar. Returns t for all others.
|
||||
where
|
||||
-- Hotfix for https://github.com/GrammaticalFramework/gf-core/issues/56
|
||||
-- Real bug is probably somewhere deeper in recognising excluded functions. /IL 2020-06-06
|
||||
notFromCommonModule :: Term -> Bool
|
||||
notFromCommonModule term =
|
||||
let t = render $ ppTerm Qualified 0 term :: String
|
||||
in not $ any (\moduleName -> moduleName `L.isPrefixOf` t)
|
||||
["CommonX", "ConstructX", "ExtendFunctor"
|
||||
,"MarkHTMLX", "ParamX", "TenseX", "TextX"]
|
||||
case lookupTree showIdent c act of
|
||||
Ok f -> return (f c)
|
||||
_ -> case lookupTreeManyAll showIdent opens c of
|
||||
[f] -> return (f c)
|
||||
[] -> alt c ("constant not found:" <+> c $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
fs -> case nub [f c | f <- fs] of
|
||||
[tr] -> return tr
|
||||
{-
|
||||
ts -> return $ AdHocOverload ts
|
||||
-- name conflicts resolved as overloading in TypeCheck.RConcrete AR 31/1/2014
|
||||
-- the old definition is below and still presupposed in TypeCheck.Concrete
|
||||
-}
|
||||
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
|
||||
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
|
||||
"given" <+> fsep (punctuate ',' (map fst qualifs)))
|
||||
return t
|
||||
|
||||
-- If one of the terms comes from the common modules,
|
||||
-- we choose the other one, because that's defined in the grammar.
|
||||
bestTerm :: [Term] -> Term
|
||||
bestTerm [] = error "constant not found" -- not reached: bestTerm is only called for case ts@(t:_)
|
||||
bestTerm ts@(t:_) =
|
||||
let notCommon = [t | t <- ts, notFromCommonModule t]
|
||||
in case notCommon of
|
||||
[] -> t -- All terms are from common modules, return first of original list
|
||||
(u:_) -> u -- ≥1 terms are not from common modules, return first of those
|
||||
-- a warning will be generated in CheckGrammar, and the head returned
|
||||
-- in next V:
|
||||
-- Bad $ "conflicting imports:" +++ unwords (map prt ts)
|
||||
|
||||
info2status :: Maybe ModuleName -> Ident -> Info -> StatusInfo
|
||||
info2status mq c i = case i of
|
||||
info2status :: Maybe ModuleName -> (Ident,Info) -> StatusInfo
|
||||
info2status mq (c,i) = case i of
|
||||
AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
|
||||
ResValue _ -> maybe Con (curry QC) mq
|
||||
ResParam _ _ -> maybe Con (curry QC) mq
|
||||
@@ -136,10 +124,10 @@ info2status mq c i = case i of
|
||||
AnyInd False m -> maybe Cn (const (curry Q m)) mq
|
||||
_ -> maybe Cn (curry Q) mq
|
||||
|
||||
tree2status :: OpenSpec -> Map.Map Ident Info -> StatusMap
|
||||
tree2status :: OpenSpec -> BinTree Ident Info -> BinTree Ident StatusInfo
|
||||
tree2status o = case o of
|
||||
OSimple i -> Map.mapWithKey (info2status (Just i))
|
||||
OQualif i j -> Map.mapWithKey (info2status (Just j))
|
||||
OSimple i -> mapTree (info2status (Just i))
|
||||
OQualif i j -> mapTree (info2status (Just j))
|
||||
|
||||
buildStatus :: FilePath -> Grammar -> Module -> Check Status
|
||||
buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
|
||||
@@ -148,14 +136,14 @@ buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
|
||||
ops <- mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
|
||||
let sts = map modInfo2status (exts++ops)
|
||||
return (if isModCnc mi
|
||||
then (Map.empty, reverse sts) -- the module itself does not define any names
|
||||
then (emptyBinTree, reverse sts) -- the module itself does not define any names
|
||||
else (self2status m mi,reverse sts)) -- so the empty ident is not needed
|
||||
|
||||
modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusMap)
|
||||
modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusTree)
|
||||
modInfo2status (o,mo) = (o,tree2status o (jments mo))
|
||||
|
||||
self2status :: ModuleName -> ModuleInfo -> StatusMap
|
||||
self2status c m = Map.mapWithKey (info2status (Just c)) (jments m)
|
||||
self2status :: ModuleName -> ModuleInfo -> StatusTree
|
||||
self2status c m = mapTree (info2status (Just c)) (jments m)
|
||||
|
||||
|
||||
renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info
|
||||
@@ -256,7 +244,7 @@ renamePattern :: Status -> Patt -> Check (Patt,[Ident])
|
||||
renamePattern env patt =
|
||||
do r@(p',vs) <- renp patt
|
||||
let dupl = vs \\ nub vs
|
||||
unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear. All variable names on the left-hand side must be distinct.") 4
|
||||
unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4
|
||||
patt)
|
||||
return r
|
||||
where
|
||||
|
||||
@@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
module GF.Compile.TypeCheck.Concrete( checkLType, inferLType, computeLType, ppType ) where
|
||||
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
|
||||
|
||||
module GF.Compile.TypeCheck.Concrete( {-checkLType, inferLType, computeLType, ppType-} ) where
|
||||
{-
|
||||
import GF.Infra.CheckM
|
||||
import GF.Data.Operations
|
||||
|
||||
@@ -23,16 +22,10 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
|
||||
_ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed
|
||||
| isPredefConstant ty -> return ty ---- shouldn't be needed
|
||||
|
||||
Q (m,ident) -> checkIn ("module" <+> m) $ do
|
||||
Q (m,ident) -> checkIn (text "module" <+> ppIdent m) $ do
|
||||
ty' <- lookupResDef gr (m,ident)
|
||||
if ty' == ty then return ty else comp g ty' --- is this necessary to test?
|
||||
|
||||
AdHocOverload ts -> do
|
||||
over <- getOverload gr g (Just typeType) t
|
||||
case over of
|
||||
Just (tr,_) -> return tr
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t)
|
||||
|
||||
Vr ident -> checkLookup ident g -- never needed to compute!
|
||||
|
||||
App f a -> do
|
||||
@@ -80,26 +73,26 @@ inferLType gr g trm = case trm of
|
||||
|
||||
Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
|
||||
Just ty -> return ty
|
||||
Nothing -> checkError ("unknown in Predef:" <+> ident)
|
||||
Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
|
||||
|
||||
Q ident -> checks [
|
||||
termWith trm $ lookupResType gr ident >>= computeLType gr g
|
||||
,
|
||||
lookupResDef gr ident >>= inferLType gr g
|
||||
,
|
||||
checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
|
||||
checkError (text "cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
|
||||
]
|
||||
|
||||
QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
|
||||
Just ty -> return ty
|
||||
Nothing -> checkError ("unknown in Predef:" <+> ident)
|
||||
Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
|
||||
|
||||
QC ident -> checks [
|
||||
termWith trm $ lookupResType gr ident >>= computeLType gr g
|
||||
,
|
||||
lookupResDef gr ident >>= inferLType gr g
|
||||
,
|
||||
checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
|
||||
checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
|
||||
]
|
||||
|
||||
Vr ident -> termWith trm $ checkLookup ident g
|
||||
@@ -107,12 +100,7 @@ inferLType gr g trm = case trm of
|
||||
Typed e t -> do
|
||||
t' <- computeLType gr g t
|
||||
checkLType gr g e t'
|
||||
|
||||
AdHocOverload ts -> do
|
||||
over <- getOverload gr g Nothing trm
|
||||
case over of
|
||||
Just trty -> return trty
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
|
||||
return (e,t')
|
||||
|
||||
App f a -> do
|
||||
over <- getOverload gr g Nothing trm
|
||||
@@ -122,17 +110,13 @@ inferLType gr g trm = case trm of
|
||||
(f',fty) <- inferLType gr g f
|
||||
fty' <- computeLType gr g fty
|
||||
case fty' of
|
||||
Prod bt z arg val -> do
|
||||
Prod bt z arg val -> do
|
||||
a' <- justCheck g a arg
|
||||
ty <- if isWildIdent z
|
||||
ty <- if isWildIdent z
|
||||
then return val
|
||||
else substituteLType [(bt,z,a')] val
|
||||
return (App f' a',ty)
|
||||
_ ->
|
||||
let term = ppTerm Unqualified 0 f
|
||||
funName = pp . head . words .render $ term
|
||||
in checkError ("A function type is expected for" <+> term <+> "instead of type" <+> ppType fty $$
|
||||
"\n ** Maybe you gave too many arguments to" <+> funName <+> "\n")
|
||||
return (App f' a',ty)
|
||||
_ -> checkError (text "A function type is expected for" <+> ppTerm Unqualified 0 f <+> text "instead of type" <+> ppType fty)
|
||||
|
||||
S f x -> do
|
||||
(f', fty) <- inferLType gr g f
|
||||
@@ -140,7 +124,7 @@ inferLType gr g trm = case trm of
|
||||
Table arg val -> do
|
||||
x'<- justCheck g x arg
|
||||
return (S f' x', val)
|
||||
_ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
|
||||
_ -> checkError (text "table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
|
||||
|
||||
P t i -> do
|
||||
(t',ty) <- inferLType gr g t --- ??
|
||||
@@ -148,16 +132,16 @@ inferLType gr g trm = case trm of
|
||||
let tr2 = P t' i
|
||||
termWith tr2 $ case ty' of
|
||||
RecType ts -> case lookup i ts of
|
||||
Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
|
||||
Nothing -> checkError (text "unknown label" <+> ppLabel i <+> text "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
|
||||
Just x -> return x
|
||||
_ -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
|
||||
" instead of the inferred:" <+> ppTerm Unqualified 0 ty')
|
||||
_ -> checkError (text "record type expected for:" <+> ppTerm Unqualified 0 t $$
|
||||
text " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
|
||||
|
||||
R r -> do
|
||||
let (ls,fs) = unzip r
|
||||
fsts <- mapM inferM fs
|
||||
let ts = [ty | (Just ty,_) <- fsts]
|
||||
checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
|
||||
checkCond (text "cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
|
||||
return $ (R (zip ls fsts), RecType (zip ls ts))
|
||||
|
||||
T (TTyped arg) pts -> do
|
||||
@@ -168,10 +152,10 @@ inferLType gr g trm = case trm of
|
||||
checkLType gr g trm (Table arg val)
|
||||
T ti pts -> do -- tries to guess: good in oper type inference
|
||||
let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
|
||||
case pts' of
|
||||
[] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
|
||||
---- PInt k : _ -> return $ Ints $ max [i | PInt i <- pts']
|
||||
_ -> do
|
||||
case pts' of
|
||||
[] -> checkError (text "cannot infer table type of" <+> ppTerm Unqualified 0 trm)
|
||||
---- PInt k : _ -> return $ Ints $ max [i | PInt i <- pts']
|
||||
_ -> do
|
||||
(arg,val) <- checks $ map (inferCase Nothing) pts'
|
||||
checkLType gr g trm (Table arg val)
|
||||
V arg pts -> do
|
||||
@@ -182,9 +166,9 @@ inferLType gr g trm = case trm of
|
||||
K s -> do
|
||||
if elem ' ' s
|
||||
then do
|
||||
let ss = foldr C Empty (map K (words s))
|
||||
let ss = foldr C Empty (map K (words s))
|
||||
----- removed irritating warning AR 24/5/2008
|
||||
----- checkWarn ("token \"" ++ s ++
|
||||
----- checkWarn ("token \"" ++ s ++
|
||||
----- "\" converted to token list" ++ prt ss)
|
||||
return (ss, typeStr)
|
||||
else return (trm, typeStr)
|
||||
@@ -195,56 +179,50 @@ inferLType gr g trm = case trm of
|
||||
|
||||
Empty -> return (trm, typeStr)
|
||||
|
||||
C s1 s2 ->
|
||||
C s1 s2 ->
|
||||
check2 (flip (justCheck g) typeStr) C s1 s2 typeStr
|
||||
|
||||
Glue s1 s2 ->
|
||||
Glue s1 s2 ->
|
||||
check2 (flip (justCheck g) typeStr) Glue s1 s2 typeStr ---- typeTok
|
||||
|
||||
---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
|
||||
Strs (Cn c : ts) | c == cConflict -> do
|
||||
checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
|
||||
checkWarn (text "unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
|
||||
inferLType gr g (head ts)
|
||||
|
||||
Strs ts -> do
|
||||
ts' <- mapM (\t -> justCheck g t typeStr) ts
|
||||
ts' <- mapM (\t -> justCheck g t typeStr) ts
|
||||
return (Strs ts', typeStrs)
|
||||
|
||||
Alts t aa -> do
|
||||
t' <- justCheck g t typeStr
|
||||
aa' <- flip mapM aa (\ (c,v) -> do
|
||||
c' <- justCheck g c typeStr
|
||||
c' <- justCheck g c typeStr
|
||||
v' <- checks $ map (justCheck g v) [typeStrs, EPattType typeStr]
|
||||
return (c',v'))
|
||||
return (Alts t' aa', typeStr)
|
||||
|
||||
RecType r -> do
|
||||
let (ls,ts) = unzip r
|
||||
ts' <- mapM (flip (justCheck g) typeType) ts
|
||||
ts' <- mapM (flip (justCheck g) typeType) ts
|
||||
return (RecType (zip ls ts'), typeType)
|
||||
|
||||
ExtR r s -> do
|
||||
|
||||
--- over <- getOverload gr g Nothing r
|
||||
--- let r1 = maybe r fst over
|
||||
let r1 = r ---
|
||||
|
||||
(r',rT) <- inferLType gr g r1
|
||||
(r',rT) <- inferLType gr g r
|
||||
rT' <- computeLType gr g rT
|
||||
|
||||
(s',sT) <- inferLType gr g s
|
||||
sT' <- computeLType gr g sT
|
||||
|
||||
let trm' = ExtR r' s'
|
||||
---- trm' <- plusRecord r' s'
|
||||
case (rT', sT') of
|
||||
(RecType rs, RecType ss) -> do
|
||||
let rt = RecType ([field | field@(l,_) <- rs, notElem l (map fst ss)] ++ ss) -- select types of later fields
|
||||
rt <- plusRecType rT' sT'
|
||||
checkLType gr g trm' rt ---- return (trm', rt)
|
||||
_ | rT' == typeType && sT' == typeType -> do
|
||||
return (trm', typeType)
|
||||
_ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
|
||||
_ | rT' == typeType && sT' == typeType -> return (trm', typeType)
|
||||
_ -> checkError (text "records or record types expected in" <+> ppTerm Unqualified 0 trm)
|
||||
|
||||
Sort _ ->
|
||||
Sort _ ->
|
||||
termWith trm $ return typeType
|
||||
|
||||
Prod bt x a b -> do
|
||||
@@ -253,7 +231,7 @@ inferLType gr g trm = case trm of
|
||||
return (Prod bt x a' b', typeType)
|
||||
|
||||
Table p t -> do
|
||||
p' <- justCheck g p typeType --- check p partype!
|
||||
p' <- justCheck g p typeType --- check p partype!
|
||||
t' <- justCheck g t typeType
|
||||
return $ (Table p' t', typeType)
|
||||
|
||||
@@ -272,9 +250,9 @@ inferLType gr g trm = case trm of
|
||||
ELin c trm -> do
|
||||
(trm',ty) <- inferLType gr g trm
|
||||
ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
|
||||
return $ (ELin c trm', ty')
|
||||
return $ (ELin c trm', ty')
|
||||
|
||||
_ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
|
||||
_ -> checkError (text "cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
|
||||
|
||||
where
|
||||
isPredef m = elem m [cPredef,cPredefAbs]
|
||||
@@ -321,6 +299,7 @@ inferLType gr g trm = case trm of
|
||||
PChars _ -> return $ typeStr
|
||||
_ -> inferLType gr g (patt2term p) >>= return . snd
|
||||
|
||||
|
||||
-- type inference: Nothing, type checking: Just t
|
||||
-- the latter permits matching with value type
|
||||
getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))
|
||||
@@ -331,28 +310,15 @@ getOverload gr g mt ot = case appForm ot of
|
||||
v <- matchOverload f typs ttys
|
||||
return $ Just v
|
||||
_ -> return Nothing
|
||||
(AdHocOverload cs@(f:_), ts) -> do --- the function name f is only used in error messages
|
||||
let typs = concatMap collectOverloads cs
|
||||
ttys <- mapM (inferLType gr g) ts
|
||||
v <- matchOverload f typs ttys
|
||||
return $ Just v
|
||||
_ -> return Nothing
|
||||
|
||||
where
|
||||
collectOverloads tr@(Q c) = case lookupOverload gr c of
|
||||
Ok typs -> typs
|
||||
_ -> case lookupResType gr c of
|
||||
Ok ty -> let (args,val) = typeFormCnc ty in [(map (\(b,x,t) -> t) args,(val,tr))]
|
||||
_ -> []
|
||||
collectOverloads _ = [] --- constructors QC
|
||||
|
||||
matchOverload f typs ttys = do
|
||||
let (tts,tys) = unzip ttys
|
||||
let vfs = lookupOverloadInstance tys typs
|
||||
let matches = [vf | vf@((_,v,_),_) <- vfs, matchVal mt v]
|
||||
let showTypes ty = hsep (map ppType ty)
|
||||
|
||||
|
||||
|
||||
let (stys,styps) = (showTypes tys, [showTypes ty | (ty,_) <- typs])
|
||||
|
||||
-- to avoid strange error msg e.g. in case of unmatch record extension, show whole types if needed AR 28/1/2013
|
||||
@@ -363,57 +329,50 @@ getOverload gr g mt ot = case appForm ot of
|
||||
case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of
|
||||
([(_,val,fun)],_) -> return (mkApp fun tts, val)
|
||||
([],[(pre,val,fun)]) -> do
|
||||
checkWarn $ "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
|
||||
"for" $$
|
||||
checkWarn $ text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
|
||||
text "for" $$
|
||||
nest 2 (showTypes tys) $$
|
||||
"using" $$
|
||||
text "using" $$
|
||||
nest 2 (showTypes pre)
|
||||
return (mkApp fun tts, val)
|
||||
([],[]) -> do
|
||||
checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
|
||||
maybe empty (\x -> "with value type" <+> ppType x) mt $$
|
||||
"for argument list" $$
|
||||
checkError $ text "no overload instance of" <+> ppTerm Unqualified 0 f $$
|
||||
text "for" $$
|
||||
nest 2 stysError $$
|
||||
"among alternatives" $$
|
||||
nest 2 (vcat stypsError)
|
||||
|
||||
text "among" $$
|
||||
nest 2 (vcat stypsError) $$
|
||||
maybe empty (\x -> text "with value type" <+> ppType x) mt
|
||||
|
||||
(vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
|
||||
([(val,fun)],_) -> do
|
||||
return (mkApp fun tts, val)
|
||||
([],[(val,fun)]) -> do
|
||||
checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot)
|
||||
checkWarn (text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot)
|
||||
return (mkApp fun tts, val)
|
||||
|
||||
----- unsafely exclude irritating warning AR 24/5/2008
|
||||
----- checkWarn $ "overloading of" +++ prt f +++
|
||||
----- checkWarn $ "overloading of" +++ prt f +++
|
||||
----- "resolved by excluding partial applications:" ++++
|
||||
----- unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
|
||||
|
||||
--- now forgiving ambiguity with a warning AR 1/2/2014
|
||||
-- This gives ad hoc overloading the same behaviour as the choice of the first match in renaming did before.
|
||||
-- But it also gives a chance to ambiguous overloadings that were banned before.
|
||||
(nps1,nps2) -> do
|
||||
checkWarn $ "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
|
||||
---- "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$
|
||||
"resolved by selecting the first of the alternatives" $$
|
||||
nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
|
||||
case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of
|
||||
[] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f
|
||||
h:_ -> return h
|
||||
|
||||
_ -> checkError $ text "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
|
||||
text "for" <+> hsep (map ppType tys) $$
|
||||
text "with alternatives" $$
|
||||
nest 2 (vcat [ppType ty | (_,ty,_) <- if null vfs1 then vfs2 else vfs2])
|
||||
|
||||
matchVal mt v = elem mt [Nothing,Just v,Just (unlocked v)]
|
||||
|
||||
unlocked v = case v of
|
||||
RecType fs -> RecType $ filter (not . isLockLabel . fst) (sortRec fs)
|
||||
RecType fs -> RecType $ filter (not . isLockLabel . fst) fs
|
||||
_ -> v
|
||||
---- TODO: accept subtypes
|
||||
---- TODO: use a trie
|
||||
lookupOverloadInstance tys typs =
|
||||
[((pre,mkFunType rest val, t),isExact) |
|
||||
lookupOverloadInstance tys typs =
|
||||
[((pre,mkFunType rest val, t),isExact) |
|
||||
let lt = length tys,
|
||||
(ty,(val,t)) <- typs, length ty >= lt,
|
||||
let (pre,rest) = splitAt lt ty,
|
||||
let (pre,rest) = splitAt lt ty,
|
||||
let isExact = pre == tys,
|
||||
isExact || map unlocked pre == map unlocked tys
|
||||
]
|
||||
@@ -426,21 +385,20 @@ getOverload gr g mt ot = case appForm ot of
|
||||
|
||||
checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)
|
||||
checkLType gr g trm typ0 = do
|
||||
|
||||
typ <- computeLType gr g typ0
|
||||
|
||||
case trm of
|
||||
|
||||
Abs bt x c -> do
|
||||
case typ of
|
||||
Prod bt' z a b -> do
|
||||
Prod bt' z a b -> do
|
||||
(c',b') <- if isWildIdent z
|
||||
then checkLType gr ((bt,x,a):g) c b
|
||||
else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
|
||||
else do b' <- checkIn (text "abs") $ substituteLType [(bt',z,Vr x)] b
|
||||
checkLType gr ((bt,x,a):g) c b'
|
||||
return $ (Abs bt x c', Prod bt' z a b')
|
||||
_ -> checkError $ "function type expected instead of" <+> ppType typ $$
|
||||
"\n ** Double-check that the type signature of the operation" $$
|
||||
"matches the number of arguments given to it.\n"
|
||||
return $ (Abs bt x c', Prod bt' x a b')
|
||||
_ -> checkError $ text "function type expected instead of" <+> ppType typ
|
||||
|
||||
App f a -> do
|
||||
over <- getOverload gr g (Just typ) trm
|
||||
@@ -450,12 +408,6 @@ checkLType gr g trm typ0 = do
|
||||
(trm',ty') <- inferLType gr g trm
|
||||
termWith trm' $ checkEqLType gr g typ ty' trm'
|
||||
|
||||
AdHocOverload ts -> do
|
||||
over <- getOverload gr g Nothing trm
|
||||
case over of
|
||||
Just trty -> return trty
|
||||
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
|
||||
|
||||
Q _ -> do
|
||||
over <- getOverload gr g (Just typ) trm
|
||||
case over of
|
||||
@@ -465,21 +417,21 @@ checkLType gr g trm typ0 = do
|
||||
termWith trm' $ checkEqLType gr g typ ty' trm'
|
||||
|
||||
T _ [] ->
|
||||
checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
|
||||
T _ cs -> case typ of
|
||||
Table arg val -> do
|
||||
checkError (text "found empty table in type" <+> ppTerm Unqualified 0 typ)
|
||||
T _ cs -> case typ of
|
||||
Table arg val -> do
|
||||
case allParamValues gr arg of
|
||||
Ok vs -> do
|
||||
let ps0 = map fst cs
|
||||
ps <- testOvershadow ps0 vs
|
||||
if null ps
|
||||
then return ()
|
||||
else checkWarn ("patterns never reached:" $$
|
||||
if null ps
|
||||
then return ()
|
||||
else checkWarn (text "patterns never reached:" $$
|
||||
nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
|
||||
_ -> return () -- happens with variable types
|
||||
cs' <- mapM (checkCase arg val) cs
|
||||
return (T (TTyped arg) cs', typ)
|
||||
_ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
|
||||
_ -> checkError $ text "table type expected for table instead of" $$ nest 2 (ppType typ)
|
||||
V arg0 vs ->
|
||||
case typ of
|
||||
Table arg1 val ->
|
||||
@@ -487,54 +439,51 @@ checkLType gr g trm typ0 = do
|
||||
vs1 <- allParamValues gr arg1
|
||||
if length vs1 == length vs
|
||||
then return ()
|
||||
else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm
|
||||
else checkError $ text "wrong number of values in table" <+> ppTerm Unqualified 0 trm
|
||||
vs' <- map fst `fmap` sequence [checkLType gr g v val|v<-vs]
|
||||
return (V arg' vs',typ)
|
||||
|
||||
R r -> case typ of --- why needed? because inference may be too difficult
|
||||
RecType rr -> do
|
||||
--let (ls,_) = unzip rr -- labels of expected type
|
||||
let (ls,_) = unzip rr -- labels of expected type
|
||||
fsts <- mapM (checkM r) rr -- check that they are found in the record
|
||||
return $ (R fsts, typ) -- normalize record
|
||||
|
||||
_ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
|
||||
_ -> checkError (text "record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
|
||||
|
||||
ExtR r s -> case typ of
|
||||
_ | typ == typeType -> do
|
||||
trm' <- computeLType gr g trm
|
||||
case trm' of
|
||||
RecType _ -> termWith trm' $ return typeType
|
||||
ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType
|
||||
RecType _ -> termWith trm $ return typeType
|
||||
ExtR (Vr _) (RecType _) -> termWith trm $ return typeType
|
||||
-- ext t = t ** ...
|
||||
_ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
|
||||
_ -> checkError (text "invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
|
||||
|
||||
RecType rr -> do
|
||||
(r',ty,s') <- checks [
|
||||
do (r',ty) <- inferLType gr g r
|
||||
return (r',ty,s)
|
||||
,
|
||||
do (s',ty) <- inferLType gr g s
|
||||
return (s',ty,r)
|
||||
]
|
||||
|
||||
ll2 <- case s of
|
||||
R ss -> return $ map fst ss
|
||||
_ -> do
|
||||
(s',typ2) <- inferLType gr g s
|
||||
case typ2 of
|
||||
RecType ss -> return $ map fst ss
|
||||
_ -> checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
|
||||
let ll1 = [l | (l,_) <- rr, notElem l ll2]
|
||||
|
||||
--- over <- getOverload gr g Nothing r --- this would solve #66 but fail ParadigmsAra. AR 6/7/2020
|
||||
--- let r1 = maybe r fst over
|
||||
let r1 = r ---
|
||||
|
||||
(r',_) <- checkLType gr g r1 (RecType [field | field@(l,_) <- rr, elem l ll1])
|
||||
(s',_) <- checkLType gr g s (RecType [field | field@(l,_) <- rr, elem l ll2])
|
||||
|
||||
let rec = R ([(l,(Nothing,P r' l)) | l <- ll1] ++ [(l,(Nothing,P s' l)) | l <- ll2])
|
||||
return (rec, typ)
|
||||
case ty of
|
||||
RecType rr1 -> do
|
||||
let (rr0,rr2) = recParts rr rr1
|
||||
r2 <- justCheck g r' rr0
|
||||
s2 <- justCheck g s' rr2
|
||||
return $ (ExtR r2 s2, typ)
|
||||
_ -> checkError (text "record type expected in extension of" <+> ppTerm Unqualified 0 r $$
|
||||
text "but found" <+> ppTerm Unqualified 0 ty)
|
||||
|
||||
ExtR ty ex -> do
|
||||
r' <- justCheck g r ty
|
||||
s' <- justCheck g s ex
|
||||
return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ
|
||||
|
||||
_ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
|
||||
_ -> checkError (text "record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
|
||||
|
||||
FV vs -> do
|
||||
ttys <- mapM (flip (checkLType gr g) typ) vs
|
||||
@@ -549,7 +498,7 @@ checkLType gr g trm typ0 = do
|
||||
(arg',val) <- checkLType gr g arg p
|
||||
checkEqLType gr g typ t trm
|
||||
return (S tab' arg', t)
|
||||
_ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
|
||||
_ -> checkError (text "table type expected for applied table instead of" <+> ppType ty')
|
||||
, do
|
||||
(arg',ty) <- inferLType gr g arg
|
||||
ty' <- computeLType gr g ty
|
||||
@@ -558,8 +507,7 @@ checkLType gr g trm typ0 = do
|
||||
]
|
||||
Let (x,(mty,def)) body -> case mty of
|
||||
Just ty -> do
|
||||
(ty0,_) <- checkLType gr g ty typeType
|
||||
(def',ty') <- checkLType gr g def ty0
|
||||
(def',ty') <- checkLType gr g def ty
|
||||
body' <- justCheck ((Explicit,x,ty'):g) body typ
|
||||
return (Let (x,(Just ty',def')) body', typ)
|
||||
_ -> do
|
||||
@@ -575,10 +523,10 @@ checkLType gr g trm typ0 = do
|
||||
termWith trm' $ checkEqLType gr g typ ty' trm'
|
||||
where
|
||||
justCheck g ty te = checkLType gr g ty te >>= return . fst
|
||||
{-
|
||||
recParts rr t = (RecType rr1,RecType rr2) where
|
||||
(rr1,rr2) = partition (flip elem (map fst t) . fst) rr
|
||||
-}
|
||||
|
||||
recParts rr t = (RecType rr1,RecType rr2) where
|
||||
(rr1,rr2) = partition (flip elem (map fst t) . fst) rr
|
||||
|
||||
checkM rms (l,ty) = case lookup l rms of
|
||||
Just (Just ty0,t) -> do
|
||||
checkEqLType gr g ty ty0 t
|
||||
@@ -587,12 +535,12 @@ checkLType gr g trm typ0 = do
|
||||
Just (_,t) -> do
|
||||
(t',ty') <- checkLType gr g t ty
|
||||
return (l,(Just ty',t'))
|
||||
_ -> checkError $
|
||||
if isLockLabel l
|
||||
_ -> checkError $
|
||||
if isLockLabel l
|
||||
then let cat = drop 5 (showIdent (label2ident l))
|
||||
in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <>
|
||||
"; try wrapping it with lin" <+> cat
|
||||
else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
|
||||
in ppTerm Unqualified 0 (R rms) <+> text "is not in the lincat of" <+> text cat <>
|
||||
text "; try wrapping it with lin" <+> text cat
|
||||
else text "cannot find value for label" <+> ppLabel l <+> text "in" <+> ppTerm Unqualified 0 (R rms)
|
||||
|
||||
checkCase arg val (p,t) = do
|
||||
cont <- pattContext gr g arg p
|
||||
@@ -605,7 +553,7 @@ pattContext env g typ p = case p of
|
||||
PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
|
||||
t <- lookupResType env (q,c)
|
||||
let (cont,v) = typeFormCnc t
|
||||
checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p)
|
||||
checkCond (text "wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p)
|
||||
(length cont == length ps)
|
||||
checkEqLType env g typ v (patt2term p)
|
||||
mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat
|
||||
@@ -616,7 +564,7 @@ pattContext env g typ p = case p of
|
||||
let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
|
||||
----- checkWarn $ prt p ++++ show pts ----- debug
|
||||
mapM (uncurry (pattContext env g)) pts >>= return . concat
|
||||
_ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
|
||||
_ -> checkError (text "record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
|
||||
PT t p' -> do
|
||||
checkEqLType env g typ t (patt2term p')
|
||||
pattContext env g typ p'
|
||||
@@ -629,10 +577,10 @@ pattContext env g typ p = case p of
|
||||
g1 <- pattContext env g typ p'
|
||||
g2 <- pattContext env g typ q
|
||||
let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
|
||||
checkCond
|
||||
("incompatible bindings of" <+>
|
||||
fsep pts <+>
|
||||
"in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts)
|
||||
checkCond
|
||||
(text "incompatible bindings of" <+>
|
||||
fsep (map ppIdent pts) <+>
|
||||
text "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts)
|
||||
return g1 -- must be g1 == g2
|
||||
PSeq p q -> do
|
||||
g1 <- pattContext env g typ p
|
||||
@@ -642,11 +590,11 @@ pattContext env g typ p = case p of
|
||||
PNeg p' -> noBind typ p'
|
||||
|
||||
_ -> return [] ---- check types!
|
||||
where
|
||||
where
|
||||
noBind typ p' = do
|
||||
co <- pattContext env g typ p'
|
||||
if not (null co)
|
||||
then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p)
|
||||
then checkWarn (text "no variable bound inside pattern" <+> ppPatt Unqualified 0 p)
|
||||
>> return []
|
||||
else return []
|
||||
|
||||
@@ -655,31 +603,9 @@ checkEqLType gr g t u trm = do
|
||||
(b,t',u',s) <- checkIfEqLType gr g t u trm
|
||||
case b of
|
||||
True -> return t'
|
||||
False ->
|
||||
let inferredType = ppTerm Qualified 0 u
|
||||
expectedType = ppTerm Qualified 0 t
|
||||
term = ppTerm Unqualified 0 trm
|
||||
funName = pp . head . words .render $ term
|
||||
helpfulMsg =
|
||||
case (arrows inferredType, arrows expectedType) of
|
||||
(0,0) -> pp "" -- None of the types is a function
|
||||
_ -> "\n **" <+>
|
||||
if expectedType `isLessApplied` inferredType
|
||||
then "Maybe you gave too few arguments to" <+> funName
|
||||
else pp "Double-check that type signature and number of arguments match."
|
||||
in checkError $ s <+> "type of" <+> term $$
|
||||
"expected:" <+> expectedType $$ -- ppqType t u $$
|
||||
"inferred:" <+> inferredType $$ -- ppqType u t
|
||||
helpfulMsg
|
||||
where
|
||||
-- count the number of arrows in the prettyprinted term
|
||||
arrows :: Doc -> Int
|
||||
arrows = length . filter (=="->") . words . render
|
||||
|
||||
-- If prettyprinted type t has fewer arrows then prettyprinted type u,
|
||||
-- then t is "less applied", and we can print out more helpful error msg.
|
||||
isLessApplied :: Doc -> Doc -> Bool
|
||||
isLessApplied t u = arrows t < arrows u
|
||||
False -> checkError $ text s <+> text "type of" <+> ppTerm Unqualified 0 trm $$
|
||||
text "expected:" <+> ppType t $$
|
||||
text "inferred:" <+> ppType u
|
||||
|
||||
checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
|
||||
checkIfEqLType gr g t u trm = do
|
||||
@@ -691,62 +617,60 @@ checkIfEqLType gr g t u trm = do
|
||||
--- better: use a flag to forgive? (AR 31/1/2006)
|
||||
_ -> case missingLock [] t' u' of
|
||||
Ok lo -> do
|
||||
checkWarn $ "missing lock field" <+> fsep lo
|
||||
checkWarn $ text "missing lock field" <+> fsep (map ppLabel lo)
|
||||
return (True,t',u',[])
|
||||
Bad s -> return (False,t',u',s)
|
||||
|
||||
where
|
||||
|
||||
-- check that u is a subtype of t
|
||||
-- t is a subtype of u
|
||||
--- quick hack version of TC.eqVal
|
||||
alpha g t u = case (t,u) of
|
||||
alpha g t u = case (t,u) of
|
||||
|
||||
-- error (the empty type!) is subtype of any other type
|
||||
(_,u) | u == typeError -> True
|
||||
|
||||
-- contravariance
|
||||
(Prod _ x a b, Prod _ y c d) -> alpha g c a && alpha ((x,y):g) b d
|
||||
|
||||
(Prod _ x a b, Prod _ y c d) -> alpha g c a && alpha ((x,y):g) b d
|
||||
|
||||
-- record subtyping
|
||||
(RecType rs, RecType ts) -> all (\ (l,a) ->
|
||||
any (\ (k,b) -> l == k && alpha g a b) ts) rs
|
||||
(RecType rs, RecType ts) -> all (\ (l,a) ->
|
||||
any (\ (k,b) -> alpha g a b && l == k) ts) rs
|
||||
(ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
|
||||
(ExtR r s, t) -> alpha g r t || alpha g s t
|
||||
|
||||
-- the following say that Ints n is a subset of Int and of Ints m >= n
|
||||
-- But why does it also allow Int as a subtype of Ints m? /TH 2014-04-04
|
||||
(t,u) | Just m <- isTypeInts t, Just n <- isTypeInts u -> m >= n
|
||||
(t,u) | Just m <- isTypeInts t, Just n <- isTypeInts t -> m >= n
|
||||
| Just _ <- isTypeInts t, u == typeInt -> True ---- check size!
|
||||
| t == typeInt, Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005
|
||||
|
||||
---- this should be made in Rename
|
||||
(Q (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
(Q (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
|| elem n (allExtendsPlus gr m)
|
||||
|| m == n --- for Predef
|
||||
(QC (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
(QC (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
|| elem n (allExtendsPlus gr m)
|
||||
(QC (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
(QC (m,a), Q (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
|| elem n (allExtendsPlus gr m)
|
||||
(Q (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
(Q (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n)
|
||||
|| elem n (allExtendsPlus gr m)
|
||||
|
||||
-- contravariance
|
||||
(Table a b, Table c d) -> alpha g c a && alpha g b d
|
||||
(Table a b, Table c d) -> alpha g a c && alpha g b d
|
||||
(Vr x, Vr y) -> x == y || elem (x,y) g || elem (y,x) g
|
||||
_ -> t == u
|
||||
_ -> t == u
|
||||
--- the following should be one-way coercions only. AR 4/1/2001
|
||||
|| elem t sTypes && elem u sTypes
|
||||
|| (t == typeType && u == typePType)
|
||||
|| (u == typeType && t == typePType)
|
||||
|| (t == typeType && u == typePType)
|
||||
|| (u == typeType && t == typePType)
|
||||
|
||||
missingLock g t u = case (t,u) of
|
||||
(RecType rs, RecType ts) ->
|
||||
let
|
||||
ls = [l | (l,a) <- rs,
|
||||
missingLock g t u = case (t,u) of
|
||||
(RecType rs, RecType ts) ->
|
||||
let
|
||||
ls = [l | (l,a) <- rs,
|
||||
not (any (\ (k,b) -> alpha g a b && l == k) ts)]
|
||||
(locks,others) = partition isLockLabel ls
|
||||
in case others of
|
||||
_:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
|
||||
_:_ -> Bad $ render (text "missing record fields:" <+> fsep (punctuate comma (map ppLabel others)))
|
||||
_ -> return locks
|
||||
-- contravariance
|
||||
(Prod _ x a b, Prod _ y c d) -> do
|
||||
@@ -772,7 +696,7 @@ termWith t ct = do
|
||||
return (t,ty)
|
||||
|
||||
-- | compositional check\/infer of binary operations
|
||||
check2 :: (Term -> Check Term) -> (Term -> Term -> Term) ->
|
||||
check2 :: (Term -> Check Term) -> (Term -> Term -> Term) ->
|
||||
Term -> Term -> Type -> Check (Term,Type)
|
||||
check2 chk con a b t = do
|
||||
a' <- chk a
|
||||
@@ -784,18 +708,14 @@ ppType :: Type -> Doc
|
||||
ppType ty =
|
||||
case ty of
|
||||
RecType fs -> case filter isLockLabel $ map fst fs of
|
||||
[lock] -> pp (drop 5 (showIdent (label2ident lock)))
|
||||
[lock] -> text (drop 5 (showIdent (label2ident lock)))
|
||||
_ -> ppTerm Unqualified 0 ty
|
||||
Prod _ x a b -> ppType a <+> "->" <+> ppType b
|
||||
Prod _ x a b -> ppType a <+> text "->" <+> ppType b
|
||||
_ -> ppTerm Unqualified 0 ty
|
||||
{-
|
||||
ppqType :: Type -> Type -> Doc
|
||||
ppqType t u = case (ppType t, ppType u) of
|
||||
(pt,pu) | render pt == render pu -> ppTerm Qualified 0 t
|
||||
(pt,_) -> pt
|
||||
-}
|
||||
|
||||
checkLookup :: Ident -> Context -> Check Type
|
||||
checkLookup x g =
|
||||
case [ty | (b,y,ty) <- g, x == y] of
|
||||
[] -> checkError ("unknown variable" <+> x)
|
||||
[] -> checkError (text "unknown variable" <+> ppIdent x)
|
||||
(ty:_) -> return ty
|
||||
-}
|
||||
|
||||
@@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where
|
||||
|
||||
-- The code here is based on the paper:
|
||||
@@ -10,7 +9,7 @@ import GF.Grammar hiding (Env, VGen, VApp, VRecType)
|
||||
import GF.Grammar.Lookup
|
||||
import GF.Grammar.Predef
|
||||
import GF.Grammar.Lockfield
|
||||
import GF.Compile.Compute.Concrete
|
||||
import GF.Compile.Compute.ConcreteNew
|
||||
import GF.Compile.Compute.Predef(predef,predefName)
|
||||
import GF.Infra.CheckM
|
||||
import GF.Data.Operations
|
||||
@@ -20,7 +19,6 @@ import GF.Text.Pretty
|
||||
import Data.List (nub, (\\), tails)
|
||||
import qualified Data.IntMap as IntMap
|
||||
import Data.Maybe(fromMaybe,isNothing)
|
||||
import qualified Control.Monad.Fail as Fail
|
||||
|
||||
checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type)
|
||||
checkLType ge t ty = runTcM $ do
|
||||
@@ -133,7 +131,7 @@ tcRho ge scope t@(RecType rs) (Just ty) = do
|
||||
[] -> unifyVar ge scope i env vs vtypePType
|
||||
_ -> return ()
|
||||
ty -> do ty <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) ty
|
||||
tcError ("The record type" <+> ppTerm Unqualified 0 t $$
|
||||
tcError ("The record type" <+> ppTerm Unqualified 0 t $$
|
||||
"cannot be of type" <+> ppTerm Unqualified 0 ty)
|
||||
(rs,mb_ty) <- tcRecTypeFields ge scope rs (Just ty')
|
||||
return (f (RecType rs),ty)
|
||||
@@ -187,7 +185,7 @@ tcRho ge scope (R rs) (Just ty) = do
|
||||
case ty' of
|
||||
(VRecType ltys) -> do lttys <- checkRecFields ge scope rs ltys
|
||||
rs <- mapM (\(l,t,ty) -> tc_value2term (geLoc ge) (scopeVars scope) ty >>= \ty -> return (l, (Just ty, t))) lttys
|
||||
return ((f . R) rs,
|
||||
return ((f . R) rs,
|
||||
VRecType [(l, ty) | (l,t,ty) <- lttys]
|
||||
)
|
||||
ty -> do lttys <- inferRecFields ge scope rs
|
||||
@@ -277,11 +275,11 @@ tcApp ge scope (App fun arg) = -- APP2
|
||||
varg <- liftErr (eval ge (scopeEnv scope) arg)
|
||||
return (App fun arg, res_ty varg)
|
||||
tcApp ge scope (Q id) = -- VAR (global)
|
||||
mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) ->
|
||||
mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) ->
|
||||
do ty <- liftErr (eval ge [] ty)
|
||||
return (t,ty)
|
||||
tcApp ge scope (QC id) = -- VAR (global)
|
||||
mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) ->
|
||||
mkTcA (lookupOverloadTypes (geGrammar ge) id) `bindTcA` \(t,ty) ->
|
||||
do ty <- liftErr (eval ge [] ty)
|
||||
return (t,ty)
|
||||
tcApp ge scope t =
|
||||
@@ -350,7 +348,7 @@ tcPatt ge scope (PM q) ty0 = do
|
||||
Bad err -> tcError (pp err)
|
||||
tcPatt ge scope p ty = unimplemented ("tcPatt "++show p)
|
||||
|
||||
inferRecFields ge scope rs =
|
||||
inferRecFields ge scope rs =
|
||||
mapM (\(l,r) -> tcRecField ge scope l r Nothing) rs
|
||||
|
||||
checkRecFields ge scope [] ltys
|
||||
@@ -368,7 +366,7 @@ checkRecFields ge scope ((l,t):lts) ltys =
|
||||
where
|
||||
takeIt l1 [] = (Nothing, [])
|
||||
takeIt l1 (lty@(l2,ty):ltys)
|
||||
| l1 == l2 = (Just ty,ltys)
|
||||
| l1 == l2 = (Just ty,ltys)
|
||||
| otherwise = let (mb_ty,ltys') = takeIt l1 ltys
|
||||
in (mb_ty,lty:ltys')
|
||||
|
||||
@@ -390,7 +388,7 @@ tcRecTypeFields ge scope ((l,ty):rs) mb_ty = do
|
||||
| s == cPType -> return mb_ty
|
||||
VMeta _ _ _ -> return mb_ty
|
||||
_ -> do sort <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) sort
|
||||
tcError ("The record type field" <+> l <+> ':' <+> ppTerm Unqualified 0 ty $$
|
||||
tcError ("The record type field" <+> l <+> ':' <+> ppTerm Unqualified 0 ty $$
|
||||
"cannot be of type" <+> ppTerm Unqualified 0 sort)
|
||||
(rs,mb_ty) <- tcRecTypeFields ge scope rs mb_ty
|
||||
return ((l,ty):rs,mb_ty)
|
||||
@@ -444,11 +442,11 @@ subsCheckRho ge scope t (VApp p1 _) (VApp p2 _) -- Rule
|
||||
| predefName p1 == cInts && predefName p2 == cInt = return t
|
||||
subsCheckRho ge scope t (VApp p1 [VInt i]) (VApp p2 [VInt j]) -- Rule INT2
|
||||
| predefName p1 == cInts && predefName p2 == cInts =
|
||||
if i <= j
|
||||
if i <= j
|
||||
then return t
|
||||
else tcError ("Ints" <+> i <+> "is not a subtype of" <+> "Ints" <+> j)
|
||||
subsCheckRho ge scope t ty1@(VRecType rs1) ty2@(VRecType rs2) = do -- Rule REC
|
||||
let mkAccess scope t =
|
||||
let mkAccess scope t =
|
||||
case t of
|
||||
ExtR t1 t2 -> do (scope,mkProj1,mkWrap1) <- mkAccess scope t1
|
||||
(scope,mkProj2,mkWrap2) <- mkAccess scope t2
|
||||
@@ -557,7 +555,7 @@ unify ge scope v (VMeta i env vs) = unifyVar ge scope i env vs v
|
||||
unify ge scope v1 v2 = do
|
||||
t1 <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) v1
|
||||
t2 <- zonkTerm =<< tc_value2term (geLoc ge) (scopeVars scope) v2
|
||||
tcError ("Cannot unify terms:" <+> (ppTerm Unqualified 0 t1 $$
|
||||
tcError ("Cannot unify terms:" <+> (ppTerm Unqualified 0 t1 $$
|
||||
ppTerm Unqualified 0 t2))
|
||||
|
||||
-- | Invariant: tv1 is a flexible type variable
|
||||
@@ -609,7 +607,7 @@ quantify ge scope t tvs ty0 = do
|
||||
ty <- tc_value2term (geLoc ge) (scopeVars scope) ty0
|
||||
let used_bndrs = nub (bndrs ty) -- Avoid quantified type variables in use
|
||||
new_bndrs = take (length tvs) (allBinders \\ used_bndrs)
|
||||
mapM_ bind (tvs `zip` new_bndrs) -- 'bind' is just a cunning way
|
||||
mapM_ bind (tvs `zip` new_bndrs) -- 'bind' is just a cunning way
|
||||
ty <- zonkTerm ty -- of doing the substitution
|
||||
vty <- liftErr (eval ge [] (foldr (\v ty -> Prod Implicit v typeType ty) ty new_bndrs))
|
||||
return (foldr (Abs Implicit) t new_bndrs,vty)
|
||||
@@ -619,7 +617,7 @@ quantify ge scope t tvs ty0 = do
|
||||
bndrs (Prod _ x t1 t2) = [x] ++ bndrs t1 ++ bndrs t2
|
||||
bndrs _ = []
|
||||
|
||||
allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,...
|
||||
allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,...
|
||||
allBinders = [ identS [x] | x <- ['a'..'z'] ] ++
|
||||
[ identS (x : show i) | i <- [1 :: Integer ..], x <- ['a'..'z']]
|
||||
|
||||
@@ -648,16 +646,8 @@ instance Monad TcM where
|
||||
f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of
|
||||
TcOk x ms msgs -> unTcM (g x) ms msgs
|
||||
TcFail msgs -> TcFail msgs)
|
||||
|
||||
#if !(MIN_VERSION_base(4,13,0))
|
||||
-- Monad(fail) will be removed in GHC 8.8+
|
||||
fail = Fail.fail
|
||||
#endif
|
||||
|
||||
instance Fail.MonadFail TcM where
|
||||
fail = tcError . pp
|
||||
|
||||
|
||||
instance Applicative TcM where
|
||||
pure = return
|
||||
(<*>) = ap
|
||||
@@ -688,12 +678,12 @@ runTcM f = case unTcM f IntMap.empty [] of
|
||||
TcFail (msg:msgs) -> do checkWarnings msgs; checkError msg
|
||||
|
||||
newMeta :: Scope -> Sigma -> TcM MetaId
|
||||
newMeta scope ty = TcM (\ms msgs ->
|
||||
newMeta scope ty = TcM (\ms msgs ->
|
||||
let i = IntMap.size ms
|
||||
in TcOk i (IntMap.insert i (Unbound scope ty) ms) msgs)
|
||||
|
||||
getMeta :: MetaId -> TcM MetaValue
|
||||
getMeta i = TcM (\ms msgs ->
|
||||
getMeta i = TcM (\ms msgs ->
|
||||
case IntMap.lookup i ms of
|
||||
Just mv -> TcOk mv ms msgs
|
||||
Nothing -> TcFail (("Unknown metavariable" <+> ppMeta i) : msgs))
|
||||
@@ -702,7 +692,7 @@ setMeta :: MetaId -> MetaValue -> TcM ()
|
||||
setMeta i mv = TcM (\ms msgs -> TcOk () (IntMap.insert i mv ms) msgs)
|
||||
|
||||
newVar :: Scope -> Ident
|
||||
newVar scope = head [x | i <- [1..],
|
||||
newVar scope = head [x | i <- [1..],
|
||||
let x = identS ('v':show i),
|
||||
isFree scope x]
|
||||
where
|
||||
@@ -721,7 +711,7 @@ getMetaVars loc sc_tys = do
|
||||
return (foldr go [] tys)
|
||||
where
|
||||
-- Get the MetaIds from a term; no duplicates in result
|
||||
go (Vr tv) acc = acc
|
||||
go (Vr tv) acc = acc
|
||||
go (App x y) acc = go x (go y acc)
|
||||
go (Meta i) acc
|
||||
| i `elem` acc = acc
|
||||
@@ -741,7 +731,7 @@ getFreeVars loc sc_tys = do
|
||||
tys <- mapM (\(scope,ty) -> zonkTerm =<< tc_value2term loc (scopeVars scope) ty) sc_tys
|
||||
return (foldr (go []) [] tys)
|
||||
where
|
||||
go bound (Vr tv) acc
|
||||
go bound (Vr tv) acc
|
||||
| tv `elem` bound = acc
|
||||
| tv `elem` acc = acc
|
||||
| otherwise = tv : acc
|
||||
@@ -771,7 +761,7 @@ tc_value2term loc xs v =
|
||||
|
||||
|
||||
|
||||
data TcA x a
|
||||
data TcA x a
|
||||
= TcSingle (MetaStore -> [Message] -> TcResult a)
|
||||
| TcMany [x] (MetaStore -> [Message] -> [(a,MetaStore,[Message])])
|
||||
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user