Merge branch 'c-runtime' into compact-pgf

silence encoding error
2019-09-20 14:08:30 +02:00 · 2019-09-20 14:07:07 +02:00 · 2019-09-20 11:22:15 +02:00 · 2019-09-20 11:18:17 +02:00 · 2019-09-20 10:55:23 +02:00 · 2019-09-20 10:52:40 +02:00
266 changed files with 58457 additions and 15276 deletions
--- a/.github/workflows/build-all-versions.yml
+++ b/.github/workflows/build-all-versions.yml
@@ -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
--- a/.github/workflows/build-binary-packages.yml
+++ b/.github/workflows/build-binary-packages.yml
@@ -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
--- a/.github/workflows/build-python-package.yml
+++ b/.github/workflows/build-python-package.yml
@@ -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/*
--- a/.gitignore
+++ b/.gitignore
@@ -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
@@ -53,10 +46,6 @@ 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
--- a/README.md
+++ b/README.md
@@ -2,6 +2,8 @@

 # Grammatical Framework (GF)

+[![Build Status](https://travis-ci.org/GrammaticalFramework/gf-core.svg?branch=master)](https://travis-ci.org/GrammaticalFramework/gf-core)
+
 The Grammatical Framework is a grammar formalism based on type theory.
 It consists of:

@@ -30,16 +32,13 @@ 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:
-```
-stack install
-```

-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

--- a/RELEASE.md
+++ b/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.
--- a/Setup.hs
+++ b/Setup.hs
@@ -19,6 +19,7 @@ main = defaultMainWithHooks simpleUserHooks
  , preInst   = gfPreInst
  , postInst  = gfPostInst
  , postCopy  = gfPostCopy
+  , sDistHook = gfSDist
  }
  where
    gfPreBuild args  = gfPre args . buildDistPref
@@ -28,17 +29,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)

--- a/WebSetup.hs
+++ b/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"

--- a/bin/build-binary-dist.sh
+++ b/bin/build-binary-dist.sh
@@ -1,18 +1,15 @@
 #! /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
+### a recent version of the Haskell Platform.
+### 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"
@@ -32,7 +29,6 @@ set -x                             # print commands before executing them
 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 +38,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 +53,52 @@ 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
+cabal install -w "$ghc" --only-dependencies -fserver -fc-runtime $extra
+cabal configure -w "$ghc" --prefix="$prefix" -fserver -fc-runtime $extra
+DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib" cabal build
+  # Building the example grammars will fail, because the RGL is missing
+cabal copy --destdir="$destdir"  # create www directory
+
+## Build the RGL and copy it to $destdir
+PATH=$PWD/dist/build/gf:$PATH
+export GF_LIB_PATH="$(dirname $(find "$destdir" -name www))/lib"   # hmm
+mkdir -p "$GF_LIB_PATH"
+pushd ../gf-rgl
+make build
+make copy
+popd
+
+# Build GF again, including example grammars that need the RGL
+DYLD_LIBRARY_PATH="$extralib" LD_LIBRARY_PATH="$extralib" cabal build

 ## Copy GF to $destdir
-${cabal}copy --destdir="$destdir"
+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"
--- a/bin/template.html
+++ b/bin/template.html
@@ -82,10 +82,9 @@ $body$
          <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>
--- a/bin/update_html
+++ b/bin/update_html
@@ -147,7 +147,7 @@ else
    fi
  done
  find . -name '*.md' | while read file ; do
-    if [[ "$file" == *"README.md" ]] || [[ "$file" == *"RELEASE.md" ]] ; then continue ; fi
+    if [[ "$file" == *"README.md" ]] ; then continue ; fi
    html="${file%.md}.html"
    if [ "$file" -nt "$html" ] || [ "$template" -nt "$html" ] ; then
      render_md_html "$file" "$html"
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,9 +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
--- a/debian/control
+++ b/debian/control
@@ -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, pandoc
 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.
 .
--- a/debian/rules
+++ b/debian/rules
@@ -1,6 +1,6 @@
 #!/usr/bin/make -f

-%:
+%: 
 	+dh $@

 #dh_shlibdeps has a problem finding which package some of the Haskell
@@ -24,15 +24,19 @@ 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
+	cd src/runtime/java && make CFLAGS="-I$(CURDIR)/src/runtime/c -L$(CURDIR)/src/runtime/c/.libs" INSTALL_PATH=/usr/lib
 	echo $(SET_LDL)
-	-$(SET_LDL) cabal build
+	-$(SET_LDL) cabal build # builds gf, fails to build example grammars
+	export $(SET_LDL); PATH=$(CURDIR)/dist/build/gf:$$PATH && make -C ../gf-rgl build
+	GF_LIB_PATH=$(CURDIR)/../gf-rgl/dist $(SET_LDL) cabal build # have RGL now, ok to build example grammars
+	make html

 override_dh_auto_install:
-	$(SET_LDL) cabal copy --destdir=$(CURDIR)/debian/gf
+	$(SET_LDL) cabal copy --destdir=$(CURDIR)/debian/gf # creates www directory
+	export GF_LIB_PATH="$$(dirname $$(find "$(CURDIR)/debian/gf" -name www))/lib" && echo "GF_LIB_PATH=$$GF_LIB_PATH" && mkdir -p "$$GF_LIB_PATH" && make -C ../gf-rgl copy
 	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
+	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_clean:
--- a/doc/errors/gluing.md
+++ b/doc/errors/gluing.md
@@ -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
--- a/doc/gf-developers.t2t
+++ b/doc/gf-developers.t2t
@@ -391,8 +391,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.
--- a/doc/gf-people.md
+++ b/doc/gf-people.md
@@ -32,7 +32,6 @@ The following people have contributed code to some of the versions:
 - [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.
--- a/doc/gf-refman.md
+++ b/doc/gf-refman.md
@@ -1809,23 +1809,6 @@ As the last rule, subtyping is transitive:
 -   if *A* is a subtype of *B* and *B* is a subtype of *C*, then *A* is
    a subtype of *C*.

-### List categories
-
-[]{#lists}
-
-Since categories of lists of elements of another category are a common idiom, the following syntactic sugar is available:
-
-    cat [C] {n}
-
-abbreviates a set of three judgements:
-
-   cat ListC ;
-   fun BaseC : C -> ... -> C -> ListC ; --n C’s
-   fun ConsC : C -> ListC -> ListC
-
-The functions `BaseC` and `ConsC` are automatically generated in the abstract syntax, but their linearizations, as well as the linearization type of `ListC`, must be defined manually. The type expression `[C]` is in all contexts interchangeable with `ListC`.
-
-More information on lists in GF can be found [here](https://inariksit.github.io/gf/2021/02/22/lists.html).

 ### Tables and table types

@@ -2130,7 +2113,7 @@ of *x*, and the application thereby disappears.

 []{#reuse}

-*This section is valid for GF 3.0, which abandons the \"[lock field](https://inariksit.github.io/gf/2018/05/25/subtyping-gf.html#lock-fields)\"*
+*This section is valid for GF 3.0, which abandons the \"lock field\"*
 *discipline of GF 2.8.*

 As explained [here](#openabstract), abstract syntax modules can be
--- a/doc/gf-video-tutorials.md
+++ b/doc/gf-video-tutorials.md
@@ -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>
--- a/doc/tutorial/gf-tutorial.t2t
+++ b/doc/tutorial/gf-tutorial.t2t
@@ -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
@@ -2475,7 +2475,7 @@ 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

@@ -2488,6 +2488,11 @@ The command ``morpho_quiz = mq`` generates inflection exercises.
  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
+```
+



@@ -2646,12 +2651,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 +2722,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 +2757,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
 ```
@@ -2947,7 +2948,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 +2969,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
@@ -3717,24 +3718,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 +3786,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 +3912,7 @@ fun
 Classes for new actions can be added incrementally.


+
 #NEW

 ==Variable bindings==
@@ -4170,8 +4200,7 @@ We construct a calculator with addition, subtraction, multiplication, and
 division of integers.
 ```
  abstract Calculator = {
-  flags startcat = Exp ;
-  
+
  cat Exp ;

  fun
@@ -4197,7 +4226,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 ;
@@ -4708,6 +4737,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
 ```
--- a/download/gfc
+++ b/download/gfc
@@ -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 "$@"
--- a/download/index-3.11.md
+++ b/download/index-3.11.md
@@ -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)
--- a/download/index.html
+++ b/download/index.html
@@ -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>
--- a/download/index-3.10.md
+++ b/download/index-3.10.md
@@ -114,7 +114,7 @@ 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`
+- On Fedora: `sudo yum install ghc-haskeline-devel`

 **GHC version**

@@ -171,20 +171,6 @@ 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)
--- a/download/release-3.11.md
+++ b/download/release-3.11.md
@@ -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.
--- a/gf.cabal
+++ b/gf.cabal
@@ -1,5 +1,5 @@
 name: gf
-version: 3.10.4-git
+version: 3.10.3-git

 cabal-version: >= 1.22
 build-type: Custom
@@ -14,7 +14,6 @@ maintainer: Thomas Hallgren
 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

 data-dir: src
-extra-source-files: WebSetup.hs
 data-files:
  www/*.html
  www/*.css
@@ -48,6 +47,10 @@ custom-setup
    filepath,
    process >=1.0.1.1

+--source-repository head
+--  type:     darcs
+--  location: http://www.grammaticalframework.org/
+
 source-repository head
  type:     git
  location: https://github.com/GrammaticalFramework/gf-core.git
@@ -64,17 +67,12 @@ flag network-uri
   description: Get Network.URI from the network-uri package
   default: True

--flag new-comp
--  Description: Make -new-comp the default
--  Default:     True
-
-flag c-runtime
-  Description: Include functionality from the C run-time library (which must be installed already)
-  Default:     False
-
-library
+executable gf
+  hs-source-dirs: src/programs
+  main-is: gf-main.hs
  default-language:    Haskell2010
-  build-depends: base >= 4.6 && <5,
+  build-depends: pgf2,
+                 base >= 4.6 && <5,
                 array,
                 containers,
                 bytestring,
@@ -83,81 +81,27 @@ library
                 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
-  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
-
--ghc-options: -fwarn-unused-imports
--if impl(ghc>=7.8)
--  ghc-options: +RTS -A20M -RTS
-  ghc-prof-options: -fprof-auto
-
-  exposed-modules:
-    PGF
-    PGF.Internal
-    PGF.Haskell
-
-  other-modules:
-    PGF.Data
-    PGF.Macros
-    PGF.Binary
-    PGF.Optimize
-    PGF.Printer
-    PGF.CId
-    PGF.Expr
-    PGF.Generate
-    PGF.Linearize
-    PGF.Morphology
-    PGF.Paraphrase
-    PGF.Parse
-    PGF.Probabilistic
-    PGF.SortTop
-    PGF.Tree
-    PGF.Type
-    PGF.TypeCheck
-    PGF.Forest
-    PGF.TrieMap
-    PGF.VisualizeTree
-    PGF.ByteCode
-    PGF.OldBinary
-    PGF.Utilities
-
-  if flag(c-runtime)
-    exposed-modules: PGF2
-    other-modules:   PGF2.FFI PGF2.Expr PGF2.Type
-                     GF.Interactive2 GF.Command.Commands2
-    hs-source-dirs:  src/runtime/haskell-bind
-    build-tools:     hsc2hs
-    extra-libraries: pgf gu
-    c-sources:       src/runtime/haskell-bind/utils.c
-    cc-options:      -std=c99
-
---- GF compiler as a library:
-
-  build-depends: filepath, directory>=1.2, time,
+                 ghc-prim,
+                 filepath, directory>=1.2, time,
                 process, haskeline, parallel>=3, json
+  ghc-options: -threaded
+
+  if impl(ghc>=7.0)
+    ghc-options: -rtsopts -with-rtsopts=-I5
+    if impl(ghc<7.8)
+      ghc-options: -with-rtsopts=-K64M
+
+  ghc-prof-options: -auto-all

  hs-source-dirs: src/compiler
-  exposed-modules:
+
+  other-modules:
    GF
    GF.Support
    GF.Text.Pretty
    GF.Text.Lexing
    GF.Grammar.Canonical

-  other-modules:
    GF.Main GF.Compiler GF.Interactive

    GF.Compile GF.CompileInParallel GF.CompileOne  GF.Compile.GetGrammar
@@ -178,6 +122,7 @@ library
    GF.Command.TreeOperations
    GF.Compile.CFGtoPGF
    GF.Compile.CheckGrammar
+    GF.Compile.Compute.AppPredefined
    GF.Compile.Compute.ConcreteNew
    GF.Compile.Compute.Predef
    GF.Compile.Compute.Value
@@ -188,16 +133,14 @@ library
    GF.Compile.GrammarToPGF
    GF.Compile.Multi
    GF.Compile.Optimize
+    GF.Compile.OptimizePGF
    GF.Compile.PGFtoHaskell
    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
    GF.Compile.Rename
    GF.Compile.SubExOpt
@@ -267,11 +210,17 @@ library
    GF.System.Signal
    GF.Text.Clitics
    GF.Text.Coding
+    GF.Text.Lexing
    GF.Text.Transliterations
    Paths_gf
-
-  if flag(c-runtime)
-    cpp-options: -DC_RUNTIME
+    
+    -- 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(server)
    build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7,
@@ -294,8 +243,6 @@ library
      CGIUtils
      Cache
      Fold
-      ExampleDemo
-      ExampleService
    hs-source-dirs: src/server src/server/transfer src/example-based

  if flag(interrupt)
@@ -306,7 +253,6 @@ library

  if impl(ghc>=7.8)
    build-tools: happy>=1.19, alex>=3.1
--  ghc-options: +RTS -A20M -RTS
  else
    build-tools: happy, alex>=3

@@ -317,41 +263,17 @@ library
  else
    build-depends: unix, terminfo>=0.4

-  if impl(ghc>=8.2)
-    ghc-options: -fhide-source-paths

-executable gf
-  hs-source-dirs: src/programs
-  main-is: gf-main.hs
+test-suite rgl-tests
+  type:           exitcode-stdio-1.0
+  main-is:        run.hs
+  hs-source-dirs: lib/tests/
+  build-depends:  base, HTF, process, HUnit, filepath, directory
  default-language:    Haskell2010
-  build-depends: gf, base
-  ghc-options: -threaded
--ghc-options: -fwarn-unused-imports
-
-  if impl(ghc>=7.0)
-    ghc-options: -rtsopts -with-rtsopts=-I5
-    if impl(ghc<7.8)
-      ghc-options: -with-rtsopts=-K64M
-
-  ghc-prof-options: -auto-all
-
-  if impl(ghc>=8.2)
-    ghc-options: -fhide-source-paths
-
-executable pgf-shell
--if !flag(c-runtime)
-  buildable: False
-  main-is:             pgf-shell.hs
-  hs-source-dirs:      src/runtime/haskell-bind/examples
-  build-depends:       gf, base, containers, mtl, lifted-base
-  default-language:    Haskell2010
-  if impl(ghc>=7.0)
-    ghc-options: -rtsopts

 test-suite gf-tests
  type:           exitcode-stdio-1.0
  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
--- a/index.html
+++ b/index.html
@@ -22,9 +22,9 @@
  <h4 class="text-black-50">A programming language for multilingual grammar applications</h4>
 </div>

-<div class="row mt-4">
+<div class="row my-4">

-  <div class="col-sm-6 col-md-3 mb-4">
+  <div class="col-sm-6 col-md-3">
    <h3>Get started</h3>
    <ul class="mb-2">
      <li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>
@@ -39,7 +39,6 @@
        /
        <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>

    <a href="download/index.html" class="btn btn-primary ml-3">
@@ -48,7 +47,7 @@
    </a>
  </div>

-  <div class="col-sm-6 col-md-3 mb-4">
+  <div class="col-sm-6 col-md-3">
    <h3>Learn more</h3>

    <ul class="mb-2">
@@ -56,7 +55,6 @@
      <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>

    <a href="lib/doc/synopsis/index.html" class="btn btn-primary ml-3">
@@ -65,30 +63,27 @@
    </a>
  </div>

-  <div class="col-sm-6 col-md-3 mb-4">
+  <div class="col-sm-6 col-md-3">
    <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&nbsp;runtime</a>
-      </li>
+      <li><a href="http://hackage.haskell.org/package/gf/docs/PGF.html">PGF library API (Haskell runtime)</a></li>
+      <li><a href="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="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>

-  <div class="col-sm-6 col-md-3 mb-4">
+  <div class="col-sm-6 col-md-3">
    <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>
+      <li><a href="//school.grammaticalframework.org/2018/">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>
@@ -174,7 +169,6 @@ least one, it may help you to get a first idea of what GF is.
    <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>

@@ -228,18 +222,6 @@ least one, it may help you to get a first idea of what GF is.
    <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 &ndash; 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
@@ -342,11 +324,9 @@ least one, it may help you to get a first idea of what GF is.
    Afrikaans,
    Amharic (partial),
    Arabic (partial),
-    Basque (partial),
    Bulgarian,
    Catalan,
    Chinese,
-    Czech (partial),
    Danish,
    Dutch,
    English,
@@ -358,12 +338,10 @@ least one, it may help you to get a first idea of what GF is.
    Greek modern,
    Hebrew (fragments),
    Hindi,
-    Hungarian (partial),
    Interlingua,
-    Italian,
    Japanese,
-    Korean (partial),
-    Latin (partial),
+    Italian,
+    Latin (fragments),
    Latvian,
    Maltese,
    Mongolian,
@@ -376,9 +354,7 @@ least one, it may help you to get a first idea of what GF is.
    Romanian,
    Russian,
    Sindhi,
-    Slovak (partial),
    Slovene (partial),
-    Somali (partial),
    Spanish,
    Swahili (fragments),
    Swedish,
--- a/src/runtime/haskell/Data/Binary.hs
+++ b/src/runtime/haskell/Data/Binary.hs
--- a/src/runtime/haskell/Data/Binary/Builder.hs
+++ b/src/runtime/haskell/Data/Binary/Builder.hs
@@ -68,7 +68,7 @@ import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Base (inlinePerformIO)
 import qualified Data.ByteString.Base as S
 #else
-import Data.ByteString.Internal (accursedUnutterablePerformIO)
+import Data.ByteString.Internal (inlinePerformIO)
 import qualified Data.ByteString.Internal as S
 --import qualified Data.ByteString.Lazy.Internal as L
 #endif
@@ -199,7 +199,7 @@ defaultSize = 32 * k - overhead

 -- | Sequence an IO operation on the buffer
 unsafeLiftIO :: (Buffer -> IO Buffer) -> Builder
-unsafeLiftIO f =  Builder $ \ k buf -> accursedUnutterablePerformIO $ do
+unsafeLiftIO f =  Builder $ \ k buf -> inlinePerformIO $ do
    buf' <- f buf
    return (k buf')
 {-# INLINE unsafeLiftIO #-}
--- a/src/runtime/haskell/Data/Binary/Get.hs
+++ b/src/runtime/haskell/Data/Binary/Get.hs
@@ -101,10 +101,6 @@ import GHC.Word
 --import GHC.Int
 #endif

-- Control.Monad.Fail import will become redundant in GHC 8.8+
-import qualified Control.Monad.Fail as Fail
-
-
 -- | The parse state
 data S = S {-# UNPACK #-} !B.ByteString  -- current chunk
           L.ByteString                  -- the rest of the input
@@ -130,11 +126,6 @@ instance Monad Get where
                             (a, s') -> unGet (k a) s')
    {-# INLINE (>>=) #-}

-#if !(MIN_VERSION_base(4,13,0))
-    fail      = failDesc
-#endif
-
-instance Fail.MonadFail Get where
    fail      = failDesc

 instance MonadFix Get where
@@ -423,7 +414,7 @@ readN n f = fmap f $ getBytes n
 getPtr :: Storable a => Int -> Get a
 getPtr n = do
    (fp,o,_) <- readN n B.toForeignPtr
-    return . B.accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)
+    return . B.inlinePerformIO $ withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o)
 {- INLINE getPtr -}

 ------------------------------------------------------------------------
--- a/src/runtime/haskell/Data/Binary/IEEE754.lhs
+++ b/src/runtime/haskell/Data/Binary/IEEE754.lhs
--- a/src/runtime/haskell/Data/Binary/Put.hs
+++ b/src/runtime/haskell/Data/Binary/Put.hs
--- a/src/compiler/GF/Command/Abstract.hs
+++ b/src/compiler/GF/Command/Abstract.hs
@@ -1,6 +1,6 @@
 module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr,Term) where

-import PGF(CId,mkCId,Expr,showExpr)
+import PGF2(Expr,showExpr)
 import GF.Grammar.Grammar(Term)

 type Ident = String
@@ -11,7 +11,7 @@ type Pipe = [Command]

 data Command
   = Command Ident [Option] Argument
-   deriving (Eq,Ord,Show)
+   deriving Show

 data Option
  = OOpt Ident
@@ -29,13 +29,7 @@ data Argument
  | ATerm Term
  | ANoArg
  | AMacro Ident
-  deriving (Eq,Ord,Show)
-
-valCIdOpts :: String -> CId -> [Option] -> CId
-valCIdOpts flag def opts =
-  case [v | OFlag f (VId v) <- opts, f == flag] of
-    (v:_) -> mkCId v
-    _     -> def
+  deriving Show

 valIntOpts :: String -> Int -> [Option] -> Int
 valIntOpts flag def opts =
@@ -49,6 +43,18 @@ valStrOpts flag def opts =
    v:_ -> valueString v
    _   -> def

+maybeIntOpts :: String -> a -> (Int -> a) -> [Option] -> a
+maybeIntOpts flag def fn opts =
+  case [v | OFlag f (VInt v) <- opts, f == flag] of
+    (v:_) -> fn v
+    _     -> def
+
+maybeStrOpts :: String -> a -> (String -> a) -> [Option] -> a
+maybeStrOpts flag def fn opts =
+  case listFlags flag opts of
+    v:_ -> fn (valueString v)
+    _   -> def
+
 listFlags flag opts = [v | OFlag f v <- opts, f == flag]

 valueString v =
--- a/src/compiler/GF/Command/CommandInfo.hs
+++ b/src/compiler/GF/Command/CommandInfo.hs
@@ -3,8 +3,7 @@ import GF.Command.Abstract(Option,Expr,Term)
 import GF.Text.Pretty(render)
 import GF.Grammar.Printer() -- instance Pretty Term
 import GF.Grammar.Macros(string2term)
-import qualified PGF as H(showExpr)
-import qualified PGF.Internal as H(Literal(LStr),Expr(ELit)) ----
+import PGF2(mkStr,unStr,showExpr)

 data CommandInfo m = CommandInfo {
  exec     :: [Option] -> CommandArguments -> m CommandOutput,
@@ -38,21 +37,19 @@ class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr

 --------------------------------------------------------------------------------

-data CommandArguments = Exprs [Expr] | Strings [String] | Term Term
+data CommandArguments = Exprs [(Expr,Float)] | Strings [String] | Term Term

 newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc

 -- ** Converting command output
 fromStrings ss         = Piped (Strings ss, unlines ss)
-fromExprs   es         = Piped (Exprs es,unlines (map (H.showExpr []) es))
+fromExprs show_p es    = Piped (Exprs es,unlines (map (\(e,p) -> (if show_p then (++) ("["++show p++"] ") else id) (showExpr [] e)) es))
 fromString  s          = Piped (Strings [s], s)
 pipeWithMessage es msg = Piped (Exprs es,msg)
 pipeMessage msg        = Piped (Exprs [],msg)
 pipeExprs   es         = Piped (Exprs es,[]) -- only used in emptyCommandInfo
 void                   = Piped (Exprs [],"")

-stringAsExpr = H.ELit . H.LStr -- should be a pattern macro
-
 -- ** Converting command input

 toStrings args =
@@ -61,23 +58,23 @@ toStrings args =
      Exprs es -> zipWith showAsString (True:repeat False) es
      Term t -> [render t]
  where
-    showAsString first t =
-      case t of
-        H.ELit (H.LStr s) -> s
-        _ -> ['\n'|not first] ++
-             H.showExpr [] t ---newline needed in other cases than the first
+    showAsString first (e,p) =
+      case unStr e of
+        Just s  -> s
+        Nothing -> ['\n'|not first] ++
+                   showExpr [] e ---newline needed in other cases than the first

 toExprs args =
  case args of
-    Exprs es -> es
-    Strings ss -> map stringAsExpr ss
-    Term t -> [stringAsExpr (render t)]
+    Exprs es -> map fst es
+    Strings ss -> map mkStr ss
+    Term t -> [mkStr (render t)]

 toTerm args =
  case args of
    Term t -> t
    Strings ss -> string2term $ unwords ss -- hmm
-    Exprs es -> string2term $ unwords $ map (H.showExpr []) es -- hmm
+    Exprs es -> string2term $ unwords $ map (showExpr [] . fst) es -- hmm

 -- ** Creating documentation

--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -1,16 +1,12 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module GF.Command.Commands (
-  PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
+  HasPGF(..),pgfCommands,
  options,flags,
  ) where
-import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+import Prelude hiding (putStrLn)

-import PGF
-
-import PGF.Internal(lookStartCat,functionsToCat,lookValCat,restrictPGF,hasLin)
-import PGF.Internal(abstract,funs,cats,Expr(EFun)) ----
-import PGF.Internal(ppFun,ppCat)
-import PGF.Internal(optimizePGF)
+import PGF2
+import PGF2.Internal(writePGF)

 import GF.Compile.Export
 import GF.Compile.ToAPI
@@ -28,28 +24,25 @@ import GF.Command.TreeOperations ---- temporary place for typecheck and compute

 import GF.Data.Operations

-import PGF.Internal (encodeFile)
+import Data.Char
 import Data.List(intersperse,nub)
 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
+import Control.Monad(mplus)

+class (Functor m,Monad m,MonadSIO m) => HasPGF m where getPGF :: m (Maybe PGF)

-data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho}
+instance (Monad m,HasPGF m) => TypeCheckArg m where
+  typeCheckArg e = do mb_pgf <- getPGF
+                      case mb_pgf of
+                        Just pgf -> either fail
+                                           (return . fst)
+                                           (inferExpr pgf e)
+                        Nothing  -> fail "Import a grammar before using this command"

-pgfEnv pgf = Env pgf mos
-  where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf]
-
-class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
-
-instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where
-  typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
-                    . flip inferExpr e . pgf) =<< getPGFEnv
-
-pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)
+pgfCommands :: HasPGF m => Map.Map String (CommandInfo m)
 pgfCommands = Map.fromList [
  ("aw", emptyCommandInfo {
     longname = "align_words",
@@ -62,7 +55,7 @@ pgfCommands = Map.fromList [
       "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)."
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
+     exec = needPGF $ \ opts arg pgf -> do
         let es = toExprs arg
         let langs = optLangs pgf opts
         if isOpt "giza" opts
@@ -74,7 +67,7 @@ pgfCommands = Map.fromList [
             let grph = if null es then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align
             return $ fromString grph
           else do
-             let grphs = map (graphvizAlignment pgf langs) es
+             let grphs = map (graphvizWordAlignment langs graphvizDefaults) es
             if isFlag "view" opts || isFlag "format" opts
               then do
                 let view = optViewGraph opts
@@ -96,6 +89,7 @@ pgfCommands = Map.fromList [
       ("view",  "program to open the resulting file")
       ]
    }),
+
  ("ca", emptyCommandInfo {
     longname = "clitic_analyse",
     synopsis = "print the analyses of all words into stems and clitics",
@@ -106,16 +100,17 @@ pgfCommands = Map.fromList [
       "by the flag '-clitics'. The list of stems is given as the list of words",
       "of the language given by the '-lang' flag."
       ],
-     exec  = getEnv $ \opts ts env -> case opts of
-               _ | isOpt "raw" opts ->
-                    return . fromString .
-                    unlines . map (unwords . map (concat . intersperse "+")) .
-                    map (getClitics (isInMorpho (optMorpho env opts)) (optClitics opts)) .
-                    concatMap words $ toStrings ts
-               _ ->
-                    return . fromStrings .
-                    getCliticsText (isInMorpho (optMorpho env opts)) (optClitics opts) .
-                    concatMap words $ toStrings ts,
+     exec  = needPGF $ \opts ts pgf -> do
+               concr <- optLang pgf opts
+               case opts of
+                 _ | isOpt "raw" opts ->
+                       return . fromString .
+                       unlines . map (unwords . map (concat . intersperse "+")) .
+                       map (getClitics (not . null . lookupMorpho concr) (optClitics opts)) .
+                       concatMap words $ toStrings ts
+                 _ -> return . fromStrings .
+                      getCliticsText (not . null . lookupMorpho concr) (optClitics opts) .
+                      concatMap words $ toStrings ts,
     flags = [
       ("clitics","the list of possible clitics (comma-separated, no spaces)"),
       ("lang",   "the language of analysis")
@@ -147,19 +142,19 @@ pgfCommands = Map.fromList [
       ],
     flags = [
       ("file","the file to be converted (suffix .gfe must be given)"),
-       ("lang","the language in which to parse"),
-       ("probs","file with probabilities to rank the parses")
+       ("lang","the language in which to parse")
       ],
-     exec = getEnv $ \ opts _ env@(Env pgf mos) -> do
+     exec = needPGF $ \opts _ pgf -> do
       let file = optFile opts
-       pgf <- optProbs opts pgf
       let printer = if (isOpt "api" opts) then exprToAPI else (showExpr [])
-       let conf = configureExBased pgf (optMorpho env opts) (optLang pgf opts) printer
+       concr <- optLang pgf opts
+       let conf = configureExBased pgf concr printer
       (file',ws) <- restricted $ parseExamplesInGrammar conf file
       if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)
       return (fromString ("wrote " ++ file')),
     needsTypeCheck = False
     }),
+
  ("gr", emptyCommandInfo {
     longname = "generate_random",
     synopsis = "generate random trees in the current abstract syntax",
@@ -174,54 +169,53 @@ pgfCommands = Map.fromList [
     explanation = unlines [
       "Generates a list of random trees, by default one tree.",
       "If a tree argument is given, the command completes the Tree with values to",
-       "all metavariables in the tree. The generation can be biased by probabilities,",
-       "given in a file in the -probs flag."
+       "all metavariables in the tree. The generation can be biased by probabilities",
+       "if the grammar was compiled with option -probs"
+       ],
+     options = [
+       ("show_probs", "show the probability of each result")
       ],
     flags = [
       ("cat","generation category"),
       ("lang","uses only functions that have linearizations in all these languages"),
-       ("number","number of trees generated"),
-       ("depth","the maximum generation depth"),
-       ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
+       ("number","number of trees generated")
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-       pgf <- optProbs opts (optRestricted opts pgf)
+     exec = needPGF $ \opts arg pgf -> do
       gen <- newStdGen
-       let dp = valIntOpts "depth" 4 opts
       let ts  = case mexp (toExprs arg) of
-                   Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
-                   Nothing -> generateRandomDepth     gen pgf (optType pgf opts) (Just dp)
-       returnFromExprs $ take (optNum opts) ts
+                   Just ex -> generateRandomFrom gen pgf ex
+                   Nothing -> generateRandom     gen pgf (optType pgf opts)
+       returnFromExprs (isOpt "show_probs" opts) $ take (optNum opts) ts
     }),
+
  ("gt", emptyCommandInfo {
     longname = "generate_trees",
     synopsis = "generates a list of trees, by default exhaustive",
     explanation = unlines [
-       "Generates all trees of a given category. By default, ",
-       "the depth is limited to 4, but this can be changed by a flag.",
+       "Generates all trees of a given category.",
       "If a Tree argument is given, the command completes the Tree with values",
       "to all metavariables in the tree."
       ],
+     options = [
+       ("show_probs", "show the probability of each result")
+       ],
     flags = [
       ("cat","the generation category"),
-       ("depth","the maximum generation depth"),
       ("lang","excludes functions that have no linearization in this language"),
       ("number","the number of trees generated")
       ],
     examples = [
-       mkEx "gt                     -- all trees in the startcat, to depth 4",
+       mkEx "gt                     -- all trees in the startcat",
       mkEx "gt -cat=NP -number=16  -- 16 trees in the category NP",
-       mkEx "gt -cat=NP -depth=2    -- trees in the category NP to depth 2",
       mkEx "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-       let pgfr = optRestricted opts pgf
-       let dp = valIntOpts "depth" 4 opts
-       let ts = case mexp (toExprs arg) of
-                  Just ex -> generateFromDepth pgfr ex (Just dp)
-                  Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)
-       returnFromExprs $ take (optNumInf opts) ts
+     exec = needPGF $ \opts arg pgf -> do
+       let es = case mexp (toExprs arg) of
+                  Just ex -> generateAllFrom pgf ex
+                  Nothing -> generateAll     pgf (optType pgf opts)
+       returnFromExprs (isOpt "show_probs" opts) $ takeOptNum opts es
     }),
+
  ("i", emptyCommandInfo {
     longname = "import",
     synopsis = "import a grammar from source code or compiled .pgf file",
@@ -242,33 +236,28 @@ pgfCommands = Map.fromList [
       ("probs","file with biased probabilities for generation")
       ],
     options = [
-       -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]
       ("retain","retain operations (used for cc command)"),
       ("src",   "force compilation from source"),
       ("v",     "be verbose - show intermediate status information")
       ],
     needsTypeCheck = False
     }),
+
  ("l", emptyCommandInfo {
     longname = "linearize",
     synopsis = "convert an abstract syntax expression to string",
     explanation = unlines [
-       "Shows the linearization of a Tree by the grammars in scope.",
+       "Shows the linearization of a tree by the grammars in scope.",
       "The -lang flag can be used to restrict this to fewer languages.",
       "A sequence of string operations (see command ps) can be given",
       "as options, and works then like a pipe to the ps command, except",
-       "that it only affect the strings, not e.g. the table labels.",
-       "These can be given separately to each language with the unlexer flag",
-       "whose results are prepended to the other lexer flags. The value of the",
-       "unlexer flag is a space-separated list of comma-separated string operation",
-       "sequences; see example."
+       "that it only affect the strings, not e.g. the table labels."
       ],
     examples = [
       mkEx "l -lang=LangSwe,LangNor no_Utt   -- linearize tree to LangSwe and LangNor",
-       mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",
-       mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"
+       mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table"
       ],
-     exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings . optLins pgf opts $ toExprs ts,
+     exec = needPGF $ \ opts ts pgf -> return . fromStrings . optLins pgf opts $ toExprs ts,
     options = [
       ("all",    "show all forms and variants, one by line (cf. l -list)"),
       ("bracket","show tree structure with brackets and paths to nodes"),
@@ -276,33 +265,13 @@ pgfCommands = Map.fromList [
       ("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")
-       ] ++ stringOpOptions,
-     flags = [
-       ("lang","the languages of linearization (comma-separated, no spaces)"),
-       ("unlexer","set unlexers separately to each language (space-separated)")
-       ]
-     }),
-  ("lc", emptyCommandInfo {
-     longname = "linearize_chunks",
-     synopsis = "linearize a tree that has metavariables in maximal chunks without them",
-     explanation = unlines [
-       "A hopefully temporary command, intended to work around the type checker that fails",
-       "trees where a function node is a metavariable."
-       ],
-     examples = [
-       mkEx "l -lang=LangSwe,LangNor -chunks ? a b (? c d)"
-       ],
-     exec = getEnv $ \ opts ts (Env pgf mos) -> return . fromStrings $ optLins pgf (opts ++ [OOpt "chunks"]) (toExprs ts),
-     options = [
       ("treebank","show the tree and tag linearizations with language names")
       ] ++ stringOpOptions,
     flags = [
       ("lang","the languages of linearization (comma-separated, no spaces)")
-       ],
-     needsTypeCheck = False
+       ]
     }),
+
  ("ma", emptyCommandInfo {
     longname = "morpho_analyse",
     synopsis = "print the morphological analyses of all words in the string",
@@ -310,18 +279,20 @@ pgfCommands = Map.fromList [
       "Prints all the analyses of space-separated words in the input string,",
       "using the morphological analyser of the actual grammar (see command pg)"
       ],
-     exec  = getEnv $ \opts ts env -> case opts of
-               _ | isOpt "missing" opts ->
-                    return . fromString . unwords .
-                    morphoMissing (optMorpho env opts) .
-                    concatMap words $ toStrings ts
-               _ | isOpt "known" opts ->
-                    return . fromString . unwords .
-                    morphoKnown (optMorpho env opts) .
-                    concatMap words $ toStrings ts
-               _ -> return . fromString . unlines .
-                    map prMorphoAnalysis . concatMap (morphos env opts) .
-                    concatMap words $ toStrings ts,
+     exec  = needPGF $ \opts ts pgf -> do
+               concr <- optLang pgf opts
+               case opts of
+                 _ | isOpt "missing" opts ->
+                      return . fromString . unwords .
+                      morphoMissing concr .
+                      concatMap words $ toStrings ts
+                 _ | isOpt "known" opts ->
+                      return . fromString . unwords .
+                      morphoKnown concr .
+                      concatMap words $ toStrings ts
+                 _ -> return . fromString . unlines .
+                      map prMorphoAnalysis . concatMap (morphos pgf opts) .
+                      concatMap words $ toStrings ts,
     flags = [
       ("lang","the languages of analysis (comma-separated, no spaces)")
       ],
@@ -335,18 +306,16 @@ pgfCommands = Map.fromList [
     longname = "morpho_quiz",
     synopsis = "start a morphology quiz",
     syntax   = "mq (-cat=CAT)? (-probs=FILE)? TREE?",
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-         let lang = optLang pgf opts
+     exec = needPGF $ \ opts arg pgf -> do
+         lang <- optLang pgf opts
         let typ  = optType pgf opts
-         pgf <- optProbs opts pgf
         let mt = mexp (toExprs arg)
         restricted $ morphologyQuiz mt pgf lang typ
         return void,
     flags = [
       ("lang","language of the quiz"),
       ("cat","category of the quiz"),
-       ("number","maximum number of questions"),
-       ("probs","file with biased probabilities for generation")
+       ("number","maximum number of questions")
       ]
     }),

@@ -357,24 +326,25 @@ pgfCommands = Map.fromList [
       "Shows all trees returned by parsing a string in the grammars in scope.",
       "The -lang flag can be used to restrict this to fewer languages.",
       "The default start category can be overridden by the -cat flag.",
-       "See also the ps command for lexing and character encoding.",
-       "",
-       "The -openclass flag is experimental and allows some robustness in ",
-       "the parser. For example if -openclass=\"A,N,V\" is given, the parser",
-       "will accept unknown adjectives, nouns and verbs with the resource grammar."
+       "See also the ps command for lexing and character encoding."
+       ],
+     exec = needPGF $ \opts ts pgf ->
+              return $
+                foldr (joinPiped . fromParse1 opts) void 
+                  (concat [
+                              [(s,parse concr (optType pgf opts) s) |
+                                            concr <- optLangs pgf opts] 
+                           | s <- toStrings ts]),
+     options = [
+       ("show_probs", "show the probability of each result")
       ],
-     exec = getEnv $ \ opts ts (Env pgf mos) ->
-              return $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
     flags = [
       ("cat","target category of parsing"),
       ("lang","the languages of parsing (comma-separated, no spaces)"),
-       ("openclass","list of open-class categories for robust parsing"),
-       ("depth","maximal depth for proof search if the abstract syntax tree has meta variables")
-       ],
-     options = [
-       ("bracket","prints the bracketed string from the parser")
+       ("number","limit the results to the top N trees")
       ]
     }),
+
  ("pg", emptyCommandInfo { -----
     longname = "print_grammar",
     synopsis = "print the actual grammar with the given printer",
@@ -394,9 +364,8 @@ pgfCommands = Map.fromList [
        " " ++ opt ++ "\t\t" ++ expl |
           ((opt,_),expl) <- outputFormatsExpl, take 1 expl /= "*"
       ]),
-     exec  = getEnv $ \opts _ env -> prGrammar env opts,
+     exec  = needPGF $ \opts _ pgf -> prGrammar pgf opts,
     flags = [
-       --"cat",
       ("file",   "set the file name when printing with -pgf option"),
       ("lang",   "select languages for the some options (default all languages)"),
       ("printer","select the printing format (see flag values above)")
@@ -416,6 +385,7 @@ pgfCommands = Map.fromList [
       mkEx ("pg -funs | ? grep \" S ;\"  -- show functions with value cat S")
       ]
     }),
+
  ("pt", emptyCommandInfo {
     longname = "put_tree",
     syntax = "pt OPT? TREE",
@@ -429,11 +399,12 @@ pgfCommands = Map.fromList [
     examples = [
       mkEx "pt -compute (plus one two)                               -- compute value"
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) ->
-            returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,
+     exec = needPGF $ \opts arg pgf ->
+            returnFromExprs False .  takeOptNum opts . map (flip (,) 0) . treeOps pgf opts $ toExprs arg,
     options = treeOpOptions undefined{-pgf-},
     flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}
     }),
+
  ("rf",  emptyCommandInfo {
     longname = "read_file",
     synopsis = "read string or tree input from a file",
@@ -446,10 +417,9 @@ pgfCommands = Map.fromList [
       ],
     options = [
       ("lines","return the list of lines, instead of the singleton of all contents"),
-       ("paragraphs","return the list of paragraphs, as separated by empty lines"),
       ("tree","convert strings into trees")
       ],
-     exec = getEnv $ \ opts _ (Env pgf mos) -> do
+     exec = needPGF $ \ opts _ pgf -> do
       let file = valStrOpts "file" "_gftmp" opts
       let exprs []         = ([],empty)
           exprs ((n,s):ls) | null s
@@ -458,12 +428,12 @@ pgfCommands = Map.fromList [
                                Just e  -> let (es,err) = exprs ls
                                           in case inferExpr pgf e of
                                                Right (e,t) -> (e:es,err)
-                                                Left tcerr  -> (es,"on line" <+> n <> ':' $$ nest 2 (ppTcError tcerr) $$ err)
+                                                Left err    -> (es,"on line" <+> n <> ':' $$ nest 2 err $$ err)
                                Nothing -> let (es,err) = exprs ls
                                           in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)
           returnFromLines ls = case exprs ls of
                                  (es, err) | null es   -> return $ pipeMessage $ render (err $$ "no trees found")
-                                            | otherwise -> return $ pipeWithMessage es (render err)
+                                            | otherwise -> return $ pipeWithMessage (map (flip (,) 0) es) (render err)

       s <- restricted $ readFile file
       case opts of
@@ -472,56 +442,26 @@ pgfCommands = Map.fromList [
         _ | isOpt "tree" opts ->
               returnFromLines [(1::Int,s)]
         _ | isOpt "lines" opts -> return (fromStrings $ lines s)
-         _ | isOpt "paragraphs" opts -> return (fromStrings $ toParagraphs $ lines s)
         _ -> return (fromString s),
     flags = [("file","the input file name")]
     }),
-  ("rt", emptyCommandInfo {
-     longname = "rank_trees",
-     synopsis = "show trees in an order of decreasing probability",
-     explanation = unlines [
-       "Order trees from the most to the least probable, using either",
-       "even distribution in each category (default) or biased as specified",
-       "by the file given by flag -probs=FILE, where each line has the form",
-       "'function probability', e.g. 'youPol_Pron  0.01'."
-       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-         let ts = toExprs arg
-         pgf <- optProbs opts pgf
-         let tds = rankTreesByProbs pgf ts
-         if isOpt "v" opts
-           then putStrLn $
-                  unlines [showExpr []  t ++ "\t--" ++ show d | (t,d) <- tds]
-           else return ()
-         returnFromExprs $ map fst tds,
-     flags = [
-       ("probs","probabilities from this file (format 'f 0.6' per line)")
-       ],
-     options = [
-       ("v","show all trees with their probability scores")
-       ],
-     examples = [
-      mkEx "p \"you are here\" | rt -probs=probs | pt -number=1 -- most probable result"
-      ]
-     }),
+
  ("tq", emptyCommandInfo {
     longname = "translation_quiz",
     syntax   = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
     synopsis = "start a translation quiz",
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-         let from = optLangFlag "from" pgf opts
-         let to   = optLangFlag "to" pgf opts
+     exec = needPGF $ \ opts arg pgf -> do
+         from <- optLangFlag "from" pgf opts
+         to   <- optLangFlag "to"   pgf opts
         let typ  = optType pgf opts
         let mt   = mexp (toExprs arg)
-         pgf <- optProbs opts pgf
         restricted $ translationQuiz mt pgf from to typ
         return void,
     flags = [
       ("from","translate from this language"),
       ("to","translate to this language"),
       ("cat","translate in this category"),
-       ("number","the maximum number of questions"),
-       ("probs","file with biased probabilities for generation")
+       ("number","the maximum number of questions")
       ],
     examples = [
       mkEx ("tq -from=Eng -to=Swe                               -- any trees in startcat"),
@@ -529,7 +469,6 @@ pgfCommands = Map.fromList [
       ]
     }),

-
  ("vd", emptyCommandInfo {
     longname = "visualize_dependency",
     synopsis = "show word dependency tree graphically",
@@ -547,7 +486,7 @@ pgfCommands = Map.fromList [
       "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",
       "See also 'vp -showdep' for another visualization of dependencies." 
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
+     exec = needPGF $ \ opts arg pgf -> do
         let absname = abstractName pgf
         let es = toExprs arg
         let debug = isOpt "v" opts
@@ -560,8 +499,8 @@ pgfCommands = Map.fromList [
         mclab <- case cnclabels of
           "" -> return Nothing
           _  -> (Just . getCncDepLabels) `fmap` restricted (readFile cnclabels)
-         let lang = optLang pgf opts
-         let grphs = map (graphvizDependencyTree outp debug mlab mclab pgf lang) es
+         concr <- optLang pgf opts
+         let grphs = map (graphvizDependencyTree outp debug mlab mclab concr) es
         if isOpt "conll2latex" opts
           then return $ fromString $ conlls2latexDoc $ stanzas $ unlines $ toStrings arg
           else if isFlag "view" opts && valStrOpts "output" "" opts == "latex"
@@ -596,7 +535,6 @@ pgfCommands = Map.fromList [
       ]
    }),

-
  ("vp", emptyCommandInfo {
     longname = "visualize_parse",
     synopsis = "show parse tree graphically",
@@ -608,9 +546,8 @@ pgfCommands = Map.fromList [
       "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)."
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
-         let es = toExprs arg
-         let lang = optLang pgf opts
+     exec = needPGF $ \opts arg pgf -> do
+         let es        = toExprs arg
         let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),
                                          noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),
                                          noCat = isOpt "nocat" opts && not (isOpt "showcat" opts),
@@ -623,10 +560,11 @@ pgfCommands = Map.fromList [
                                          leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts
                                         }
         let depfile = valStrOpts "file" "" opts
+         concr  <- optLang pgf opts
         mlab <- case depfile of
           "" -> return Nothing
           _  -> (Just . getDepLabels) `fmap` restricted (readFile depfile)
-         let grphs = map (graphvizParseTreeDep mlab pgf lang gvOptions) es
+         let grphs = map (graphvizDependencyTree "dot" False mlab Nothing concr) es
         if isFlag "view" opts || isFlag "format" opts
           then do
             let view = optViewGraph opts
@@ -661,7 +599,6 @@ pgfCommands = Map.fromList [
       ]
    }),

-
  ("vt", emptyCommandInfo {
     longname = "visualize_tree",
     synopsis = "show a set of trees graphically",
@@ -674,7 +611,7 @@ pgfCommands = Map.fromList [
       "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",
       "With option -mk, use for showing library style function names of form 'mkC'."
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) ->
+     exec = needPGF $ \opts arg pgf ->
      let es = toExprs arg in
       if isOpt "mk" opts
       then return $ fromString $ unlines $ map (tree2mk pgf) es
@@ -686,7 +623,7 @@ pgfCommands = Map.fromList [
       else do
         let funs = not (isOpt "nofun" opts)
         let cats = not (isOpt "nocat" opts)
-         let grphs = map (graphvizAbstractTree pgf (funs,cats)) es
+         let grphs = map (graphvizAbstractTree pgf (graphvizDefaults{noFun=funs,noCat=cats})) es
         if isFlag "view" opts || isFlag "format" opts
           then do
             let view = optViewGraph opts
@@ -708,6 +645,7 @@ pgfCommands = Map.fromList [
       ("view","program to open the resulting file (default \"open\")")
       ]
     }),
+
  ("ai", emptyCommandInfo {
     longname = "abstract_info",
     syntax = "ai IDENTIFIER  or  ai EXPR",
@@ -720,205 +658,156 @@ pgfCommands = Map.fromList [
       "If a whole expression is given it prints the expression with refined",
       "metavariables and the type of the expression."
       ],
-     exec = getEnv $ \ opts arg (Env pgf mos) -> do
+     exec = needPGF $ \opts arg pgf -> do
       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
-                                      putStrLn ("Probability: "++show prob)
-                                      return void
-                        Nothing -> case Map.lookup id (cats (abstract pgf)) of
-                                     Just cd   -> do putStrLn $
-                                                        render (ppCat id cd $$
-                                                                if null (functionsToCat pgf id)
-                                                                  then empty
-                                                                  else ' ' $$
-                                                                       vcat [ppFun fid (ty,0,Just ([],[]),0) | (fid,ty) <- functionsToCat pgf id] $$
-                                                                       ' ')
-                                                     let (_,_,prob) = cd
-                                                     putStrLn ("Probability: "++show prob)
-                                                     return void
-                                     Nothing   -> do putStrLn ("unknown category of function identifier "++show id)
-                                                     return void
-         [e]         -> case inferExpr pgf e of
-                          Left tcErr   -> errorWithoutStackTrace $ render (ppTcError tcErr)
-                          Right (e,ty) -> do putStrLn ("Expression:  "++showExpr [] e)
-                                             putStrLn ("Type:        "++showType [] ty)
-                                             putStrLn ("Probability: "++show (probTree pgf e))
-                                             return void
+         [e] -> case unApp e of
+                  Just (id, []) -> case functionType pgf id of
+                                     Just ty -> do putStrLn (showFun pgf id ty)
+                                                   putStrLn ("Probability: "++show (treeProbability pgf e))
+                                                   return void
+                                     Nothing -> case categoryContext pgf id of
+                                                  Just hypos -> do putStrLn ("cat "++id++if null hypos then "" else ' ':showContext [] hypos)
+                                                                   let ls = [showFun pgf fn ty | fn <- functionsByCat pgf id, Just ty <- [functionType pgf fn]]
+                                                                   if null ls
+                                                                     then return ()
+                                                                     else putStrLn (unlines ("":ls))
+                                                                   putStrLn ("Probability: "++show (categoryProbability pgf id))
+                                                                   return void
+                                                  Nothing    -> do putStrLn ("unknown category of function identifier "++show id)
+                                                                   return void
+                  _             -> case inferExpr pgf e of
+                                     Left err     -> error err
+                                     Right (e,ty) -> do putStrLn ("Expression:  "++showExpr [] e)
+                                                        putStrLn ("Type:        "++showType [] ty)
+                                                        putStrLn ("Probability: "++show (treeProbability pgf e))
+                                                        return void
         _           -> do putStrLn "a single identifier or expression is expected from the command"
                           return void,
     needsTypeCheck = False
     })
  ]
 where
-   getEnv exec opts ts = liftSIO . exec opts ts =<< getPGFEnv
-
-   par pgf opts s = case optOpenTypes opts of
-                  []        -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
-                  open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
-     where
-       dp = valIntOpts "depth" 4 opts
-
-   fromParse opts = foldr (joinPiped . fromParse1 opts) void
+   needPGF exec opts ts = do
+     mb_pgf <- getPGF
+     case mb_pgf of
+       Just pgf -> liftSIO $ exec opts ts pgf
+       _ -> fail "Import a grammar before using this command"

   joinPiped (Piped (es1,ms1)) (Piped (es2,ms2)) = Piped (jA es1 es2,ms1+++-ms2)
     where
       jA (Exprs es1) (Exprs es2) = Exprs (es1++es2)
-       -- ^ fromParse1 always output Exprs

-   fromParse1 opts (s,(po,bs))
-     | isOpt "bracket" opts = pipeMessage (showBracketedString bs)
-     | otherwise            =
-         case po of
-           ParseOk ts      -> fromExprs ts
-           ParseFailed i   -> pipeMessage $ "The parser failed at token "
-                                             ++ show i ++": "
-                                             ++ show (words s !! max 0 (i-1))
-                                          -- ++ " in " ++ show s
-           ParseIncomplete -> pipeMessage "The sentence is not complete"
-           TypeError errs  ->
-             pipeMessage . render $
-               "The parsing is successful but the type checking failed with error(s):"
-               $$ nest 2 (vcat (map (ppTcError . snd) errs))
+   fromParse1 opts (s,po) =
+     case po of
+       ParseOk ts      -> fromExprs (isOpt "show_probs" opts) (takeOptNum opts ts)
+       ParseFailed i t -> pipeMessage $ "The parser failed at token "
+                                        ++ show i ++": "
+                                        ++ show t
+       ParseIncomplete -> pipeMessage "The sentence is not complete"

-   optLins pgf opts ts = case opts of
-     _ | isOpt "groups" opts ->
-       concatMap snd $ groupResults
-         [[(lang, s) | lang <- optLangs pgf opts,s <- linear pgf opts lang t] | t <- ts]
-     _ -> concatMap (optLin pgf opts) ts
+   optLins pgf opts ts = concatMap (optLin pgf opts) ts
   optLin pgf opts t =
     case opts of
       _ | isOpt "treebank" opts && isOpt "chunks" opts ->
-         (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
-         [showCId lang ++ ": " ++ li | (lang,li) <- linChunks pgf opts t] --linear pgf opts lang t | lang <- optLangs pgf opts]
+         (abstractName pgf ++ ": " ++ showExpr [] t) :
+         [lang ++ ": " ++ li | (lang,li) <- linChunks pgf opts t] --linear pgf opts lang t | lang <- optLangs pgf opts]
       _ | isOpt "treebank" opts ->
-         (showCId (abstractName pgf) ++ ": " ++ showExpr [] t) :
-         [showCId lang ++ ": " ++ s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]
-       _ | isOpt "tabtreebank" opts ->
-         return $ concat $ intersperse "\t" $ (showExpr [] t) :
-                   [s | lang <- optLangs pgf opts, s <- linear pgf opts lang t]
+         (abstractName pgf ++ ": " ++ showExpr [] t) :
+         [concreteName concr ++ ": " ++ s | concr <- optLangs pgf opts, s<-linear opts concr t]
       _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t   
-       _ -> [s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]
+       _ -> [s | concr <- optLangs pgf opts, s <- linear opts concr t]
   linChunks pgf opts t = 
-     [(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]
+     [(concreteName concr, unwords (intersperse "<+>" (map (unlines . linear opts concr) (treeChunks t)))) | concr <- optLangs pgf opts]

-   linear :: PGF -> [Option] -> CId -> Expr -> [String]
-   linear pgf opts lang = let unl = unlex opts lang in case opts of
-       _ | isOpt "all"     opts -> concat . -- intersperse [[]] .
-                                   map (map (unl . snd)) . tabularLinearizes pgf lang
+   linear :: [Option] -> Concr -> Expr -> [String]
+   linear opts concr = case opts of
+       _ | isOpt "all"     opts -> concat .
+                                   map (map snd) . tabularLinearizeAll concr
       _ | isOpt "list"    opts -> (:[]) . commaList . concat .
-                                   map (map (unl . snd)) . tabularLinearizes pgf lang
-       _ | isOpt "table"   opts -> concat . -- intersperse [[]] .
-                    map (map (\(p,v) -> p+++":"+++unl v)) . tabularLinearizes pgf lang
-       _ | isOpt "bracket" opts -> (:[]) . unwords . map showBracketedString . bracketedLinearize pgf lang
-       _                        -> (:[]) . unl . linearize pgf lang
+                                   map (map snd) . tabularLinearizeAll concr
+       _ | isOpt "table"   opts -> concat .
+                                    map (map (\(p,v) -> p+++":"+++v)) . tabularLinearizeAll concr
+       _ | isOpt "bracket" opts -> (:[]) . unwords . map showBracketedString . bracketedLinearize concr
+       _                        -> (:[]) . linearize concr

   -- replace each non-atomic constructor with mkC, where C is the val cat
   tree2mk pgf = showExpr [] . t2m where
     t2m t = case unApp t of
-       Just (cid,ts@(_:_)) -> mkApp (mk cid) (map t2m ts)
-       _ -> t
-     mk = mkCId . ("mk" ++) . showCId . lookValCat (abstract pgf)
-
-   unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----
-
-   getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
-     lexs -> case lookup lang
-               [(mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
-       Just le -> chunks ',' le
-       _ -> []
+               Just (cid,ts@(_:_)) -> mkApp (mk cid) (map t2m ts)
+               _                   -> t
+     mk f = case functionType pgf f of
+              Just ty -> let (_,cat,_) = unType ty
+                         in "mk" ++ cat
+              Nothing -> f

   commaList [] = []
   commaList ws = concat $ head ws : map (", " ++) (tail ws)

-- Proposed logic of coding in unlexing:
--   - If lang has no coding flag, or -to_utf8 is not in opts, just opts are used.
--   - If lang has flag coding=utf8, -to_utf8 is ignored.
--   - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.
-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly
-{-
-   unlexx pgf opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----
-     optsC = case lookConcrFlag pgf (mkCId lang) (mkCId "coding") of
-       Just (LStr "utf8") -> filter (/="to_utf8") $ map prOpt opts
-       Just (LStr other) | isOpt "to_utf8" opts ->
-                      let cod = ("from_" ++ other)
-                      in cod : filter (/=cod) (map prOpt opts)
-       _ -> map prOpt opts
-}
-   optRestricted opts pgf =
-     restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs pgf opts]) pgf
-
   optLang  = optLangFlag "lang"
   optLangs = optLangsFlag "lang"

-   optLangsFlag f pgf opts = case valStrOpts f "" opts of
-     "" -> languages pgf
-     lang -> map (completeLang pgf) (chunks ',' lang)
-   completeLang pgf la = let cla = (mkCId la) in
-     if elem cla (languages pgf)
-       then cla
-       else (mkCId (showCId (abstractName pgf) ++ la))
+   optLangFlag flag pgf opts =
+     case optLangsFlag flag pgf opts of
+       []     -> fail "no language specified"
+       (l:ls) -> return l

-   optLangFlag f pgf opts = head $ optLangsFlag f pgf opts ++ [wildCId]
+   optLangsFlag flag pgf opts =
+     case valStrOpts flag "" opts of
+       ""  -> Map.elems langs
+       str -> mapMaybe (completeLang pgf) (chunks ',' str)
+     where
+       langs = languages pgf

-   optOpenTypes opts = case valStrOpts "openclass" "" opts of
-     ""   -> []
-     cats -> mapMaybe readType (chunks ',' cats)
-
-   optProbs opts pgf = case valStrOpts "probs" "" opts of
-     ""   -> return pgf
-     file -> do
-       probs <- restricted $ readProbabilitiesFromFile file pgf
-       return (setProbabilities probs pgf)
+       completeLang pgf la =
+         mplus (Map.lookup la                       langs)
+               (Map.lookup (abstractName pgf ++ la) langs)

   optFile opts = valStrOpts "file" "_gftmp" opts

   optType pgf opts =
-     let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
-     in case readType str of
-          Just ty -> case checkType pgf ty of
-                       Left tcErr -> error $ render (ppTcError tcErr)
-                       Right ty   -> ty
-          Nothing -> error ("Can't parse '"++str++"' as a type")
+     let readOpt str = case readType str of
+                         Just ty -> case checkType pgf ty of
+                                      Left err -> error err
+                                      Right ty -> ty
+                         Nothing -> error ("Can't parse '"++str++"' as a type")
+     in maybeStrOpts "cat" (startCat pgf) readOpt opts
   optViewFormat opts = valStrOpts "format" "png" opts
   optViewGraph opts = valStrOpts "view" "open" opts
   optNum opts = valIntOpts "number" 1 opts
   optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
   takeOptNum opts = take (optNumInf opts)

-   returnFromExprs es = return $ case es of
-     [] -> pipeMessage "no trees found"
-     _  -> fromExprs es
+   returnFromExprs show_p es =
+     return $ 
+       case es of
+         [] -> pipeMessage "no trees found"
+         _  -> fromExprs show_p es

-   prGrammar (Env pgf mos) opts
+   prGrammar pgf opts
     | isOpt "pgf"      opts = do
-          let pgf1 = if isOpt "opt" opts then optimizePGF pgf else pgf
-          let outfile = valStrOpts "file" (showCId (abstractName pgf) ++ ".pgf") opts
-          restricted $ encodeFile outfile pgf1
+          let outfile = valStrOpts "file" (abstractName pgf ++ ".pgf") opts
+          restricted $ writePGF outfile pgf
          putStrLn $ "wrote file " ++ outfile
          return void
-     | isOpt "cats"     opts = return $ fromString $ unwords $ map showCId $ categories pgf
-     | isOpt "funs"     opts = return $ fromString $ unlines $ map showFun $ funsigs pgf
-     | isOpt "fullform" opts = return $ fromString $ concatMap (morpho mos "" prFullFormLexicon) $ optLangs pgf opts
-     | isOpt "langs"    opts = return $ fromString $ unwords $ map showCId $ languages pgf
+     | isOpt "cats"     opts = return $ fromString $ unwords $ categories pgf
+     | isOpt "funs"     opts = return $ fromString $ unlines [showFun pgf f ty | f <- functions pgf, Just ty <- [functionType pgf f]]
+     | isOpt "fullform" opts = return $ fromString $ concatMap prFullFormLexicon $ optLangs pgf opts
+     | isOpt "langs"    opts = return $ fromString $ unwords $ Map.keys $ languages pgf

-     | isOpt "lexc"     opts = return $ fromString $ concatMap (morpho mos "" prLexcLexicon) $ optLangs pgf opts
-     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
-                                                                  la <- optLangs pgf opts, let cs = missingLins pgf la]
-     | isOpt "words" opts = return $ fromString $ concatMap (morpho mos "" prAllWords) $ optLangs pgf opts
+     | isOpt "lexc"     opts = return $ fromString $ concatMap prLexcLexicon $ optLangs pgf opts
+     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (concreteName concr:":":[f | f <- functions pgf, not (hasLinearization concr f)]) |
+                                                                  concr <- optLangs pgf opts]
+     | isOpt "words" opts = return $ fromString $ concatMap prAllWords $ optLangs pgf opts
     | 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))]
-   showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"
+   showFun pgf id ty = kwd++" "++ id ++ " : " ++ showType [] ty
+                       where
+                         kwd | functionIsDataCon pgf id = "data"
+                             | otherwise                = "fun"

-   morphos (Env pgf mos) opts s =
-     [(s,morpho mos [] (\mo -> lookupMorpho mo s) la) | la <- optLangs pgf opts]
-
-   morpho mos z f la = maybe z f $ Map.lookup la mos
-
-   optMorpho (Env pgf mos) opts = morpho mos (error "no morpho") id (head (optLangs pgf opts))
+   morphos pgf opts s =
+     [(s,lookupMorpho concr s) | concr <- optLangs pgf opts]

   optClitics opts = case valStrOpts "clitics" "" opts of
     "" -> []
@@ -931,18 +820,28 @@ pgfCommands = Map.fromList [
   -- ps -f -g s returns g (f s)
   treeOps pgf opts s = foldr app s (reverse opts) where
     app (OOpt  op)         | Just (Left  f) <- treeOp pgf op = f
-     app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (mkCId x)
+     app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f x
     app _                                                    = id

+morphoMissing  :: Concr -> [String] -> [String]
+morphoMissing = morphoClassify False
+
+morphoKnown    :: Concr -> [String] -> [String]
+morphoKnown = morphoClassify True
+
+morphoClassify :: Bool -> Concr -> [String] -> [String]
+morphoClassify k concr ws = [w | w <- ws, k /= null (lookupMorpho concr w), notLiteral w] where
+  notLiteral w = not (all isDigit w)
+
 treeOpOptions pgf = [(op,expl) | (op,(expl,Left  _)) <- allTreeOps pgf]
 treeOpFlags   pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]

-translationQuiz :: Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()
+translationQuiz :: Maybe Expr -> PGF -> Concr -> Concr -> Type -> IO ()
 translationQuiz mex pgf ig og typ = do
  tts <- translationList mex pgf ig og typ infinity
  mkQuiz "Welcome to GF Translation Quiz." tts

-morphologyQuiz :: Maybe Expr -> PGF -> Language -> Type -> IO ()
+morphologyQuiz :: Maybe Expr -> PGF -> Concr -> Type -> IO ()
 morphologyQuiz mex pgf ig typ = do
  tts <- morphologyList mex pgf ig typ infinity
  mkQuiz "Welcome to GF Morphology Quiz." tts
@@ -951,30 +850,28 @@ morphologyQuiz mex pgf ig typ = do
 infinity :: Int
 infinity = 256

-prLexcLexicon :: Morpho -> String
-prLexcLexicon mo =
-  unlines $ "Multichar_Symbols":multichars:"":"LEXICON Root" : [prLexc l p ++ ":" ++ w  ++ " # ;" | (w,lps) <- morpho, (l,p) <- lps] ++ ["END"]
+prLexcLexicon :: Concr -> String
+prLexcLexicon concr =
+  unlines $ "Multichar_Symbols":multichars:"":"LEXICON Root" : [prLexc l p ++ ":" ++ w  ++ " # ;" | (w,lps) <- morpho, (l,p,_) <- lps] ++ ["END"]
 where
-  morpho = fullFormLexicon mo
-  prLexc l p = showCId l ++ concat (mkTags (words p))
+  morpho = fullFormLexicon concr
+  prLexc l p = l ++ concat (mkTags (words p))
  mkTags p = case p of
    "s":ws -> mkTags ws   --- remove record field
    ws -> map ('+':) ws

-  multichars = unwords $ nub $ concat [mkTags (words p) | (w,lps) <- morpho, (l,p) <- lps]
-  -- thick_A+(AAdj+Posit+Gen):thick's # ;
+  multichars = unwords $ nub $ concat [mkTags (words p) | (w,lps) <- morpho, (l,p,_) <- lps]

-prFullFormLexicon :: Morpho -> String
-prFullFormLexicon mo =
-  unlines (map prMorphoAnalysis (fullFormLexicon mo))
+prFullFormLexicon :: Concr -> String
+prFullFormLexicon concr =
+  unlines (map prMorphoAnalysis (fullFormLexicon concr))

-prAllWords :: Morpho -> String
-prAllWords mo =
-  unwords [w | (w,_) <- fullFormLexicon mo]
+prAllWords :: Concr -> String
+prAllWords concr =
+  unwords [w | (w,_) <- fullFormLexicon concr]

-prMorphoAnalysis :: (String,[(Lemma,Analysis)]) -> String
 prMorphoAnalysis (w,lps) =
-  unlines (w:[showCId l ++ " : " ++ p | (l,p) <- lps])
+  unlines (w:[l ++ " : " ++ p ++ show prob | (l,p,prob) <- lps])

 viewGraphviz :: String -> String -> String -> [String] -> SIO CommandOutput
 viewGraphviz view format name grphs = do
@@ -1019,7 +916,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
--- a/src/compiler/GF/Command/Commands2.hs
+++ b/src/compiler/GF/Command/Commands2.hs
@@ -1,831 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
-module GF.Command.Commands2 (
-  PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands,
-  options, flags,
-  ) where
-import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
-
-import PGF2
-import qualified PGF as H
-import GF.Compile.ToAPI(exprToAPI)
-import GF.Infra.UseIO(writeUTF8File)
-import GF.Infra.SIO(MonadSIO,liftSIO,putStrLn,restricted,restrictedSystem)
-import GF.Command.Abstract
-import GF.Command.CommandInfo
-import GF.Data.Operations
-import Data.List(intersperse,intersect,nub,sortBy)
-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}
-
-pgfEnv pgf = Env (Just pgf) (languages pgf)
-emptyPGFEnv = Env Nothing Map.empty
-
-class (Fail.MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
-
-instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
-  typeCheckArg e = do env <- getPGFEnv
-                      case pgf env of
-                        Just gr -> either fail
-                                          (return . hsExpr . fst)
-                                          (inferExpr gr (cExpr e))
-                        Nothing  -> fail "Import a grammar before using this command"
-
-pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)
-pgfCommands = Map.fromList [
-  ("aw", emptyCommandInfo {
-     longname = "align_words",
-     synopsis = "show word alignments between languages graphically",
-     explanation = unlines [
-       "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 graphviz and displayed by the program indicated",
-       "by the flag. The target format is postscript, unless overridden by the",
-       "flag -format."
-       ],
-     exec = needPGF $ \opts es env -> do
-         let cncs = optConcs env opts
-         if isOpt "giza" opts
-           then if length cncs == 2
-                  then let giz = map (gizaAlignment pgf (snd (cncs !! 0)) (snd (cncs !! 1)) . cExpr) (toExprs es)
-                           lsrc = unlines $ map (\(x,_,_) -> x) giz
-                           ltrg = unlines $ map (\(_,x,_) -> x) giz
-                           align = unlines $ map (\(_,_,x) -> x) giz
-                           grph = if null (toExprs es) then [] else lsrc ++ "\n--end_source--\n\n"++ltrg++"\n-end_target--\n\n"++align
-                       in return (fromString grph)
-                  else error "For giza alignment you need exactly two languages"
-           else let gvOptions=graphvizDefaults{leafFont = valStrOpts "font" "" opts,
-                                               leafColor = valStrOpts "color" "" opts,
-                                               leafEdgeStyle = valStrOpts "edgestyle" "" opts
-                                              }
-                    grph = if null (toExprs es) then [] else graphvizWordAlignment (map snd cncs) gvOptions (cExpr (head (toExprs es)))
-                in if isFlag "view" opts || isFlag "format" opts
-                     then do let file s = "_grph." ++ s
-                             let view = optViewGraph opts
-                             let format = optViewFormat opts
-                             restricted $ writeUTF8File (file "dot") grph
-                             restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
-                             restrictedSystem $ view ++ " " ++ file format
-                             return void
-                     else return (fromString grph),
-     examples = [
-       ("gr | aw"                         , "generate a tree and show word alignment as graph script"),
-       ("gr | aw -view=\"open\""          , "generate a tree and display alignment on Mac"),
-       ("gr | aw -view=\"eog\""           , "generate a tree and display alignment on Ubuntu"),
-       ("gt | aw -giza | wf -file=aligns" , "generate trees, send giza alignments to file")
-       ],
-     options = [
-       ("giza",  "show alignments in the Giza format; the first two languages")
-       ],
-     flags = [
-       ("format","format of the visualization file (default \"png\")"),
-       ("lang",  "alignments for this list of languages (default: all)"),
-       ("view",  "program to open the resulting file"),
-       ("font",  "font for the words"),
-       ("color", "color for the words"),
-       ("edgestyle", "the style for links between words")
-       ]
-    }),
-{-
-  ("eb", emptyCommandInfo {
-     longname = "example_based",
-     syntax = "eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe",
-     synopsis = "converts .gfe files to .gf files by parsing examples to trees",
-     explanation = unlines [
-       "Reads FILE.gfe and writes FILE.gf. Each expression of form",
-       "'%ex CAT QUOTEDSTRING' in FILE.gfe is replaced by a syntax tree.",
-       "This tree is the first one returned by the parser; a biased ranking",
-       "can be used to regulate the order. If there are more than one parses",
-       "the rest are shown in comments, with probabilities if the order is biased.",
-       "The probabilities flag and configuration file is similar to the commands",
-       "gr and rt. Notice that the command doesn't change the environment,",
-       "but the resulting .gf file must be imported separately."
-       ],
-     options = [
-       ("api","convert trees to overloaded API expressions (using Syntax not Lang)")
-       ],
-     flags = [
-       ("file","the file to be converted (suffix .gfe must be given)"),
-       ("lang","the language in which to parse"),
-       ("probs","file with probabilities to rank the parses")
-       ],
-     exec = \env@(pgf, mos) opts _ -> do
-       let file = optFile opts
-       pgf <- optProbs opts pgf
-       let printer = if (isOpt "api" opts) then exprToAPI else (H.showExpr [])
-       let conf = configureExBased pgf (optMorpho env opts) (optLang pgf opts) printer
-       (file',ws) <- restricted $ parseExamplesInGrammar conf file
-       if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)
-       return (fromString ("wrote " ++ file')),
-     needsTypeCheck = False
-     }),
-}
-{-
-  ("gr", emptyCommandInfo {
-     longname = "generate_random",
-     synopsis = "generate random trees in the current abstract syntax",
-     syntax = "gr [-cat=CAT] [-number=INT]",
-     examples = [
-       mkEx "gr                     -- one tree in the startcat of the current grammar",
-       mkEx "gr -cat=NP -number=16  -- 16 trees in the category NP",
-       mkEx "gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",
-       mkEx "gr -probs=FILE         -- generate with bias",
-       mkEx "gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"
-       ],
-     explanation = unlines [
-       "Generates a list of random trees, by default one tree.",
-       "If a tree argument is given, the command completes the Tree with values to",
-       "all metavariables in the tree. The generation can be biased by probabilities,",
-       "given in a file in the -probs flag."
-       ],
-     flags = [
-       ("cat","generation category"),
-       ("lang","uses only functions that have linearizations in all these languages"),
-       ("number","number of trees generated"),
-       ("depth","the maximum generation depth"),
-       ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
-       ],
-     exec = \env@(pgf, mos) opts xs -> do
-       pgf <- optProbs opts (optRestricted opts pgf)
-       gen <- newStdGen
-       let dp = valIntOpts "depth" 4 opts
-       let ts  = case mexp xs of
-                   Just ex -> H.generateRandomFromDepth gen pgf ex (Just dp)
-                   Nothing -> H.generateRandomDepth     gen pgf (optType pgf opts) (Just dp)
-       returnFromExprs $ take (optNum opts) ts
-     }),
-}
-  ("gt", emptyCommandInfo {
-     longname = "generate_trees",
-     synopsis = "generates a list of trees, by default exhaustive",
-     flags = [("cat","the generation category"),
-              ("number","the number of trees generated")],
-     examples = [
-       mkEx "gt                     -- all trees in the startcat",
-       mkEx "gt -cat=NP -number=16  -- 16 trees in the category NP"],
-     exec = needPGF $ \ opts _ env@(pgf,_) ->
-            let ts = map fst (generateAll pgf cat)
-                cat = optType pgf opts
-            in returnFromCExprs (takeOptNum opts ts),
-     needsTypeCheck = False
-     }),
-  ("i", emptyCommandInfo {
-     longname = "import",
-     synopsis = "import a grammar from a compiled .pgf file",
-     explanation = unlines [
-       "Reads a grammar from a compiled .pgf file.",
-       "Old modules are discarded.",
-{-
-       "The grammar parser depends on the file name suffix:",
-
-       "  .cf    context-free (labelled BNF) source",
-       "  .ebnf  extended BNF source",
-       "  .gfm   multi-module GF source",
-       "  .gf    normal GF source",
-       "  .gfo   compiled GF source",
-}
-       "  .pgf   precompiled grammar in Portable Grammar Format"
-       ],
-     flags = [
--     ("probs","file with biased probabilities for generation")
-       ],
-     options = [
-       -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]
--     ("retain","retain operations (used for cc command)"),
--     ("src",   "force compilation from source"),
--     ("v",     "be verbose - show intermediate status information")
-       ],
-     needsTypeCheck = False
-     }),
-  ("l", emptyCommandInfo {
-     longname = "linearize",
-     synopsis = "convert an abstract syntax expression to string",
-     explanation = unlines [
-       "Shows the linearization of a Tree by the grammars in scope.",
-       "The -lang flag can be used to restrict this to fewer languages.",
-       "A sequence of string operations (see command ps) can be given",
-       "as options, and works then like a pipe to the ps command, except",
-       "that it only affect the strings, not e.g. the table labels.",
-       "These can be given separately to each language with the unlexer flag",
-       "whose results are prepended to the other lexer flags. The value of the",
-       "unlexer flag is a space-separated list of comma-separated string operation",
-       "sequences; see example."
-       ],
-     examples = [
-       mkEx "l -lang=LangSwe,LangNor no_Utt   -- linearize a tree to LangSwe and LangNor",
-       mkEx "gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",
-       mkEx "l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"
-       ],
-     exec = needPGF $ \ opts arg env ->
-                      return . fromStrings . optLins env opts . map cExpr $ toExprs arg,
-     options = [
-       ("all",    "show all forms and variants, one by line (cf. l -list)"),
-       ("bracket","show tree structure with brackets and paths to nodes"),
-       ("groups", "all languages, grouped by lang, remove duplicate strings"),
-       ("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"),
-       ("treebank","show the tree and tag linearizations with language names")
-       ],
-     flags = [
-       ("lang","the languages of linearization (comma-separated, no spaces)")
-       ]
-     }),
-  ("ma", emptyCommandInfo {
-     longname = "morpho_analyse",
-     synopsis = "print the morphological analyses of the (multiword) expression in the string",
-     explanation = unlines [
-       "Prints all the analyses of the (multiword) expression in the input string,",
-       "using the morphological analyser of the actual grammar (see command pg)"
-       ],
-     exec  = needPGF $ \opts args env -> 
-               return ((fromString . unlines .
-                        map prMorphoAnalysis . concatMap (morphos env opts) . toStrings) args),
-     flags = [
-       ("lang","the languages of analysis (comma-separated, no spaces)")
-       ]
-     }),
-{-
-  ("mq", emptyCommandInfo {
-     longname = "morpho_quiz",
-     synopsis = "start a morphology quiz",
-     syntax   = "mq (-cat=CAT)? (-probs=FILE)? TREE?",
-     exec = \env@(pgf, mos) opts xs -> do
-         let lang = optLang pgf opts
-         let typ  = optType pgf opts
-         pgf <- optProbs opts pgf
-         let mt = mexp xs
-         restricted $ morphologyQuiz mt pgf lang typ
-         return void,
-     flags = [
-       ("lang","language of the quiz"),
-       ("cat","category of the quiz"),
-       ("number","maximum number of questions"),
-       ("probs","file with biased probabilities for generation")
-       ]
-     }),
-}
-  ("p", emptyCommandInfo {
-     longname = "parse",
-     synopsis = "parse a string to abstract syntax expression",
-     explanation = unlines [
-       "Shows all trees returned by parsing a string in the grammars in scope.",
-       "The -lang flag can be used to restrict this to fewer languages.",
-       "The default start category can be overridden by the -cat flag.",
-       "See also the ps command for lexing and character encoding."
-       ],
-     flags = [
-       ("cat","target category of parsing"),
-       ("lang","the languages of parsing (comma-separated, no spaces)"),
-       ("number","maximum number of trees returned")
-       ],
-     examples = [
-         mkEx "p  \"this fish is fresh\" | l -lang=Swe  -- try parsing with all languages and translate the successful parses to Swedish"
-       ],
-     exec = needPGF $ \ opts ts env -> return . cParse env opts $ toStrings ts
-     }),
-  ("pg", emptyCommandInfo {
-     longname = "print_grammar",
-     synopsis = "prints different information about the grammar",
-     exec  = needPGF $ \opts _ env -> prGrammar env opts,
-     options = [
-       ("cats",   "show just the names of abstract syntax categories"),
-       ("fullform", "print the fullform lexicon"),
-       ("funs",   "show just the names and types of abstract syntax functions"),
-       ("langs",  "show just the names of top concrete syntax modules"),
-       ("lexc", "print the lexicon in Xerox LEXC format"),
-       ("missing","show just the names of functions that have no linearization"),
-       ("words", "print the list of words")
-       ],
-     flags = [
-       ("lang","the languages that need to be printed")
-       ],
-     examples = [
-       mkEx "pg -langs -- show the names of top concrete syntax modules",
-       mkEx "pg -funs | ? grep \" S ;\"  -- show functions with value cat S"
-       ]
-     }),
-
-{-
-  ("pt", emptyCommandInfo {
-     longname = "put_tree",
-     syntax = "pt OPT? TREE",
-     synopsis = "return a tree, possibly processed with a function",
-     explanation = unlines [
-       "Returns a tree obtained from its argument tree by applying",
-       "tree processing functions in the order given in the command line",
-       "option list. Thus 'pt -f -g s' returns g (f s). Typical tree processors",
-       "are type checking and semantic computation."
-       ],
-     examples = [
-       mkEx "pt -compute (plus one two)                               -- compute value",
-       mkEx "p \"4 dogs love 5 cats\" | pt -transfer=digits2numeral | l -- four...five..."
-       ],
-     exec = \env@(pgf, mos) opts ->
-            returnFromExprs . takeOptNum opts . treeOps pgf opts,
-     options = treeOpOptions undefined{-pgf-},
-     flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}
-     }),
-}
-  ("rf",  emptyCommandInfo {
-     longname = "read_file",
-     synopsis = "read string or tree input from a file",
-     explanation = unlines [
-       "Reads input from file. The filename must be in double quotes.",
-       "The input is interpreted as a string by default, and can hence be",
-       "piped e.g. to the parse command. The option -tree interprets the",
-       "input as a tree, which can be given e.g. to the linearize command.",
-       "The option -lines will result in a list of strings or trees, one by line."
-       ],
-     options = [
-       ("lines","return the list of lines, instead of the singleton of all contents"),
-       ("tree","convert strings into trees")
-       ],
-     exec = needPGF $ \opts _ env@(pgf, mos) -> do
-       let file = optFile opts
-       let exprs []         = ([],empty)
-           exprs ((n,s):ls) | null s
-                            = exprs ls
-           exprs ((n,s):ls) = case readExpr s of
-                                Just e  -> let (es,err) = exprs ls
-                                           in case inferExpr pgf e of
-                                                Right (e,t) -> (e:es,err)
-                                                Left msg    -> (es,"on line" <+> n <> ':' $$ msg $$ err)
-                                Nothing -> let (es,err) = exprs ls
-                                           in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)
-           returnFromLines ls = case exprs ls of
-                                  (es, err) | null es   -> return $ pipeMessage $ render (err $$ "no trees found")
-                                            | otherwise -> return $ pipeWithMessage (map hsExpr es) (render err)
-
-       s <- restricted $ readFile file
-       case opts of
-         _ | isOpt "lines" opts && isOpt "tree" opts ->
-               returnFromLines (zip [1::Int ..] (lines s))
-         _ | isOpt "tree" opts ->
-               returnFromLines [(1::Int,s)]
-         _ | isOpt "lines" opts -> return (fromStrings $ lines s)
-         _ -> return (fromString s),
-     flags = [("file","the input file name")]
-     }),
-  ("rt", emptyCommandInfo {
-     longname = "rank_trees",
-     synopsis = "show trees in an order of decreasing probability",
-     explanation = unlines [
-       "Order trees from the most to the least probable, using either",
-       "even distribution in each category (default) or biased as specified",
-       "by the file given by flag -probs=FILE, where each line has the form",
-       "'function probability', e.g. 'youPol_Pron  0.01'."
-       ],
-     exec = needPGF $ \opts es env@(pgf, _) -> do
-         let tds = sortBy (\(_,p) (_,q) -> compare p q)
-                          [(t, treeProbability pgf t) | t <- map cExpr (toExprs es)]
-         if isOpt "v" opts
-           then putStrLn $
-                  unlines [PGF2.showExpr []  t ++ "\t--" ++ show d | (t,d) <- tds]
-           else return ()
-         returnFromExprs $ map (hsExpr . fst) tds,
-     flags = [
-       ("probs","probabilities from this file (format 'f 0.6' per line)")
-       ],
-     options = [
-       ("v","show all trees with their probability scores")
-       ],
-     examples = [
-      mkEx "p \"you are here\" | rt -probs=probs | pt -number=1 -- most probable result"
-      ]
-     }),
-{-
-  ("tq", emptyCommandInfo {
-     longname = "translation_quiz",
-     syntax   = "tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
-     synopsis = "start a translation quiz",
-     exec = \env@(pgf, mos) opts xs -> do
-         let from = optLangFlag "from" pgf opts
-         let to   = optLangFlag "to" pgf opts
-         let typ  = optType pgf opts
-         let mt   = mexp xs
-         pgf <- optProbs opts pgf
-         restricted $ translationQuiz mt pgf from to typ
-         return void,
-     flags = [
-       ("from","translate from this language"),
-       ("to","translate to this language"),
-       ("cat","translate in this category"),
-       ("number","the maximum number of questions"),
-       ("probs","file with biased probabilities for generation")
-       ],
-     examples = [
-       mkEx ("tq -from=Eng -to=Swe                               -- any trees in startcat"),
-       mkEx ("tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?))  -- only trees of this form")
-       ]
-     }),
-  ("vd", emptyCommandInfo {
-     longname = "visualize_dependency",
-     synopsis = "show word dependency tree graphically",
-     explanation = unlines [
-       "Prints a dependency tree in the .dot format (the graphviz format, default)",
-       "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 graphviz and displayed by the program indicated",
-       "by the flag. The target format is png, unless overridden by the",
-       "flag -format."
-       ],
-     exec = \env@(pgf, mos) opts es -> do
-         let debug = isOpt "v" opts
-         let file = valStrOpts "file" "" opts
-         let outp = valStrOpts "output" "dot" opts
-         mlab <- case file of
-           "" -> return Nothing
-           _  -> (Just . H.getDepLabels . lines) `fmap` restricted (readFile file)
-         let lang = optLang pgf opts
-         let grphs = unlines $ map (H.graphvizDependencyTree outp debug mlab Nothing pgf lang) es
-         if isFlag "view" opts || isFlag "format" opts then do
-           let file s = "_grphd." ++ s
-           let view = optViewGraph opts
-           let format = optViewFormat opts
-           restricted $ writeUTF8File (file "dot") grphs
-           restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
-           restrictedSystem $ view ++ " " ++ file format
-           return void
-          else return $ fromString grphs,
-     examples = [
-       mkEx "gr | vd              -- generate a tree and show dependency tree in .dot",
-       mkEx "gr | vd -view=open   -- generate a tree and display dependency tree on a Mac",
-       mkEx "gr -number=1000 | vd -file=dep.labels -output=malt      -- generate training treebank",
-       mkEx "gr -number=100 | vd -file=dep.labels -output=malt_input -- generate test sentences"
-       ],
-     options = [
-       ("v","show extra information")
-       ],
-     flags = [
-       ("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")
-       ]
-    }),
-}
-
-  ("vp", emptyCommandInfo {
-     longname = "visualize_parse",
-     synopsis = "show parse tree graphically",
-     explanation = unlines [
-       "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 graphviz and displayed by the program indicated",
-       "by the flag. The target format is png, unless overridden by the",
-       "flag -format."
-       ],
-     exec = needPGF $ \opts arg env@(pgf, concs) ->
-      do let es = toExprs arg
-         let concs = optConcs env opts
-
-         let gvOptions=graphvizDefaults{noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),
-                                        noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),
-                                        noCat = isOpt "nocat" opts && not (isOpt "showcat" opts),
-                                        nodeFont = valStrOpts "nodefont" "" opts,
-                                        leafFont = valStrOpts "leaffont" "" opts,
-                                        nodeColor = valStrOpts "nodecolor" "" opts,
-                                        leafColor = valStrOpts "leafcolor" "" opts,
-                                        nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts,
-                                        leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts
-                                       }
-
-         let grph= if null es || null concs
-                   then []
-                   else graphvizParseTree (snd (head concs)) gvOptions (cExpr (head es))
-         if isFlag "view" opts || isFlag "format" opts then do
-           let file s = "_grph." ++ s
-           let view = optViewGraph opts
-           let format = optViewFormat opts
-           restricted $ writeUTF8File (file "dot") grph
-           restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
-           restrictedSystem $ view ++ " " ++ file format
-           return void
-          else return $ fromString grph,
-     examples = [
-       mkEx "p -lang=Eng \"John walks\" | vp  -- generate a tree and show parse tree as .dot script",
-       mkEx "gr | vp -view=\"open\" -- generate a tree and display parse tree on a Mac"
-       ],
-     options = [
-       ("showcat","show categories in the tree nodes (default)"),
-       ("nocat","don't show categories"),
-       ("showfun","show function names in the tree nodes"),
-       ("nofun","don't show function names (default)"),
-       ("showleaves","show the leaves of the tree (default)"),
-       ("noleaves","don't show the leaves of the tree (i.e., only the abstract tree)")
-       ],
-     flags = [
-       ("lang","the language to visualize"),
-       ("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)"),
-       ("leaffont","font for tree leaves (default: nodefont)"),
-       ("nodecolor","color for tree nodes (default: black -- graphviz standard color)"),
-       ("leafcolor","color for tree leaves (default: nodecolor)"),
-       ("nodeedgestyle","edge style between tree nodes (solid/dashed/dotted/bold, default: solid)"),
-       ("leafedgestyle","edge style for links to leaves (solid/dashed/dotted/bold, default: dashed)")
-       ]
-    }),
-
-  ("vt", emptyCommandInfo {
-     longname = "visualize_tree",
-     synopsis = "show a set of trees graphically",
-     explanation = unlines [
-       "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 graphviz and displayed by the program indicated",
-       "by the flag. The target format is postscript, unless overridden by the",
-       "flag -format."
-       ],
-     exec = needPGF $ \opts arg env@(pgf, _) ->
-       let es = toExprs arg in
-       if isOpt "api" opts
-       then do
-         mapM_ (putStrLn . exprToAPI) es
-         return void
-       else do
-         let gvOptions=graphvizDefaults{noFun = isOpt "nofun" opts,
-                                        noCat = isOpt "nocat" opts,
-                                        nodeFont = valStrOpts "nodefont" "" opts,
-                                        nodeColor = valStrOpts "nodecolor" "" opts,
-                                        nodeEdgeStyle = valStrOpts "nodeedgestyle" "solid" opts
-                                       }
-         let grph = unlines (map (graphvizAbstractTree pgf gvOptions . cExpr) es)
-         if isFlag "view" opts || isFlag "format" opts then do
-           let file s = "_grph." ++ s
-           let view = optViewGraph opts
-           let format = optViewFormat opts
-           restricted $ writeUTF8File (file "dot") grph
-           restrictedSystem $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format
-           restrictedSystem $ view  ++ " " ++ file format
-           return void
-          else return $ fromString grph,
-     examples = [
-       mkEx "p \"hello\" | vt              -- parse a string and show trees as graph script",
-       mkEx "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac"
-       ],
-     options = [
-       ("api", "show the tree with function names converted to 'mkC' with value cats C"),
-       ("nofun","don't show functions but only categories"),
-       ("nocat","don't show categories but only functions")
-       ],
-     flags = [
-       ("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)"),
-       ("nodecolor","color for tree nodes (default: black -- graphviz standard color)"),
-       ("nodeedgestyle","edge style between tree nodes (solid/dashed/dotted/bold, default: solid)")
-       ]
-     }),
-
-  ("ai", emptyCommandInfo {
-     longname = "abstract_info",
-     syntax = "ai IDENTIFIER  or  ai EXPR",
-     synopsis = "Provides an information about a function, an expression or a category from the abstract syntax",
-     explanation = unlines [
-       "The command has one argument which is either function, expression or",
-       "a category defined in the abstract syntax of the current grammar. ",
-       "If the argument is a function then its type is printed out.",
-       "If it is a category then the category definition is printed.",
-       "If a whole expression is given it prints the expression with refined",
-       "metavariables and the type of the expression."
-       ],
-     exec = needPGF $ \opts args env@(pgf,cncs) ->
-       case map cExpr (toExprs args) of
-         [e] -> case unApp e of
-                  Just (id,[]) -> return (fromString 
-                                            (case functionType pgf id of
-                                               Just ty -> showFun id ty
-                                               Nothing -> let funs = functionsByCat pgf id
-                                                          in showCat id funs))
-                                  where
-                                    showCat c funs = "cat "++c++
-                                                     " ;\n\n"++
-                                                     unlines [showFun f ty| f<-funs,
-                                                                            Just ty <- [functionType pgf f]]
-                                    showFun f ty = "fun "++f++" : "++showType [] ty++" ;"
-                  _  -> case inferExpr pgf e of
-                          Left msg     -> error msg
-                          Right (e,ty) -> do putStrLn ("Expression:  "++PGF2.showExpr [] e)
-                                             putStrLn ("Type:        "++PGF2.showType [] ty)
-                                             putStrLn ("Probability: "++show (treeProbability pgf e))
-                                             return void
-         _           -> do putStrLn "a single function name or category name is expected"
-                           return void,
-     needsTypeCheck = False
-     })
-  ]
- where
-   cParse env@(pgf,_) opts ss = 
-        parsed [ parse cnc cat s | s<-ss,(lang,cnc)<-cncs]
-     where
-       cat = optType pgf opts
-       cncs = optConcs env opts
-       parsed rs = Piped (Exprs ts,unlines msgs)
-          where
-            ts = [hsExpr t|ParseOk ts<-rs,(t,p)<-takeOptNum opts ts]
-            msgs = concatMap mkMsg rs
-
-            mkMsg (ParseOk ts) = (map (PGF2.showExpr [] . fst).takeOptNum opts) ts
-            mkMsg (ParseFailed _ tok) = ["Parse failed: "++tok]
-            mkMsg (ParseIncomplete)   = ["The sentence is incomplete"]
-
-   optLins env opts ts = case opts of
-     _ | isOpt "groups" opts ->
-       concatMap snd $ groupResults
-         [[(lang, s) | (lang,concr) <- optConcs env opts,s <- linear opts lang concr t] | t <- ts]
-     _ -> concatMap (optLin env opts) ts
-   optLin env@(pgf,_) opts t =
-     case opts of
-       _ | isOpt "treebank" opts ->
-         (abstractName pgf ++ ": " ++ PGF2.showExpr [] t) :
-         [lang ++ ": " ++ s | (lang,concr) <- optConcs env opts, s<-linear opts lang concr t]
-       _ -> [s | (lang,concr) <- optConcs env opts, s<-linear opts lang concr t]
-
-   linear :: [Option] -> ConcName -> Concr -> PGF2.Expr -> [String]
-   linear opts lang concr = case opts of
-       _ | isOpt "all"     opts -> concat . map (map snd) . tabularLinearizeAll concr
-       _ | isOpt "list"    opts -> (:[]) . commaList .
-                                   concatMap (map snd) . tabularLinearizeAll concr
-       _ | isOpt "table"   opts -> concatMap (map (\(p,v) -> p+++":"+++v)) . tabularLinearizeAll concr
-       _ | isOpt "bracket" opts -> (:[]) . unwords . map showBracketedString . bracketedLinearize concr
-       _                        -> (:[]) . linearize concr
-
-   groupResults :: [[(ConcName,String)]] -> [(ConcName,[String])]
-   groupResults = Map.toList . foldr more Map.empty . start . concat
-     where
-       start ls = [(l,[s]) | (l,s) <- ls]
-       more (l,s) = 
-          Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
-
-   optConcs = optConcsFlag "lang"
-
-   optConcsFlag f (pgf,cncs) opts =
-       case valStrOpts f "" opts of
-         "" -> Map.toList cncs
-         lang -> mapMaybe pickLang (chunks ',' lang)
-     where
-       pickLang l = pick l `mplus` pick fl
-         where
-           fl = abstractName pgf++l
-           pick l = (,) l `fmap` Map.lookup l cncs
-
-{-
-   -- replace each non-atomic constructor with mkC, where C is the val cat
-   tree2mk pgf = H.showExpr [] . t2m where
-     t2m t = case H.unApp t of
-       Just (cid,ts@(_:_)) -> H.mkApp (mk cid) (map t2m ts)
-       _ -> t
-     mk = H.mkCId . ("mk" ++) . H.showCId . H.lookValCat (H.abstract pgf)
-
-   unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ----
-
-   getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
-     lexs -> case lookup lang
-               [(H.mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
-       Just le -> chunks ',' le
-       _ -> []
-}
-   commaList [] = []
-   commaList ws = concat $ head ws : map (", " ++) (tail ws)
-
-   optFile opts = valStrOpts "file" "_gftmp" opts
-
-   optType pgf opts =
-     case listFlags "cat" opts of
-       v:_ -> let str = valueString v
-              in case readType str of
-                   Just ty -> case checkType pgf ty of
-                                Left msg -> error msg
-                                Right ty -> ty
-                   Nothing -> error ("Can't parse '"++str++"' as a type")
-       _   -> startCat pgf
-
-   optViewFormat opts = valStrOpts "format" "png" opts
-   optViewGraph opts = valStrOpts "view" "open" opts
-{-
-   optNum opts = valIntOpts "number" 1 opts
-}
-   optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
-   takeOptNum opts = take (optNumInf opts)
-
-   returnFromCExprs = returnFromExprs . map hsExpr
-   returnFromExprs es =
-      return $ case es of
-                 [] -> pipeMessage "no trees found"
-                 _  -> fromExprs es
-
-   prGrammar env@(pgf,cncs) opts
-     | isOpt "langs" opts = return . fromString . unwords $ (map fst (optConcs env opts))
-     | isOpt "cats" opts = return . fromString . unwords $ categories pgf
-     | isOpt "funs" opts = return . fromString . unwords $ functions pgf
-     | isOpt "missing" opts = return . fromString . unwords $
-                                 [f | f <- functions pgf, not (and [hasLinearization concr f | (_,concr) <- optConcs env opts])]
-     | isOpt "fullform" opts = return $ fromString $ concatMap (prFullFormLexicon . snd) $ optConcs env opts
-     | isOpt "words"    opts = return $ fromString $ concatMap (prAllWords . snd) $ optConcs env opts
-     | isOpt "lexc"     opts = return $ fromString $ concatMap (prLexcLexicon . snd) $ optConcs env opts
-     | otherwise = return void
-
-   gizaAlignment pgf src_cnc tgt_cnc e =
-     let src_res   = alignWords src_cnc e
-         tgt_res   = alignWords tgt_cnc e
-         alignment = [show i++"-"++show j | (i,(_,src_fids)) <- zip [0..] src_res, (j,(_,tgt_fids)) <- zip [0..] tgt_res, not (null (intersect src_fids tgt_fids))]
-     in (unwords (map fst src_res), unwords (map fst tgt_res), unwords alignment)
-
-   morphos env opts s =
-     [(s,res) | (lang,concr) <- optConcs env opts, let res = lookupMorpho concr s, not (null res)]
-{-
-   mexp xs = case xs of
-     t:_ -> Just t
-     _   -> Nothing
-}
-   -- ps -f -g s returns g (f s)
-{-
-   treeOps pgf opts s = foldr app s (reverse opts) where
-     app (OOpt  op)         | Just (Left  f) <- treeOp pgf op = f
-     app (OFlag op (VId x)) | Just (Right f) <- treeOp pgf op = f (H.mkCId x)
-     app _                                                    = id
-
-treeOpOptions pgf = [(op,expl) | (op,(expl,Left  _)) <- allTreeOps pgf]
-treeOpFlags   pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]
-
-translationQuiz :: Maybe H.Expr -> H.PGF -> H.Language -> H.Language -> H.Type -> IO ()
-translationQuiz mex pgf ig og typ = do
-  tts <- translationList mex pgf ig og typ infinity
-  mkQuiz "Welcome to GF Translation Quiz." tts
-
-morphologyQuiz :: Maybe H.Expr -> H.PGF -> H.Language -> H.Type -> IO ()
-morphologyQuiz mex pgf ig typ = do
-  tts <- morphologyList mex pgf ig typ infinity
-  mkQuiz "Welcome to GF Morphology Quiz." tts
-
-- | the maximal number of precompiled quiz problems
-infinity :: Int
-infinity = 256
-}
-prLexcLexicon :: Concr -> String
-prLexcLexicon concr =
-  unlines $ "Multichar_Symbols":multichars:"":"LEXICON Root" : [prLexc l p ++ ":" ++ w  ++ " # ;" | (w,lps) <- morpho, (l,p,_) <- lps] ++ ["END"]
- where
-  morpho = fullFormLexicon concr
-  prLexc l p = l ++ concat (mkTags (words p))
-  mkTags p = case p of
-    "s":ws -> mkTags ws   --- remove record field
-    ws -> map ('+':) ws
-
-  multichars = unwords $ nub $ concat [mkTags (words p) | (w,lps) <- morpho, (l,p,_) <- lps]
-  -- thick_A+(AAdj+Posit+Gen):thick's # ;
-
-prFullFormLexicon :: Concr -> String
-prFullFormLexicon concr =
-  unlines (map prMorphoAnalysis (fullFormLexicon concr))
-
-prAllWords :: Concr -> String
-prAllWords concr =
-  unwords [w | (w,_) <- fullFormLexicon concr]
-
-prMorphoAnalysis :: (String,[MorphoAnalysis]) -> String
-prMorphoAnalysis (w,lps) =
-  unlines (w:[fun ++ " : " ++ cat | (fun,cat,p) <- lps])
-
-hsExpr c =
-  case unApp c of
-    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
-
-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
-
-needPGF exec opts ts =
-  do Env mb_pgf cncs <- getPGFEnv
-     case mb_pgf of
-       Just pgf -> liftSIO $ exec opts ts (pgf,cncs)
-       _ -> fail "Import a grammar before using this command"
--- a/src/compiler/GF/Command/CommonCommands.hs
+++ b/src/compiler/GF/Command/CommonCommands.hs
@@ -3,7 +3,6 @@
 -- elsewhere
 module GF.Command.CommonCommands where
 import Data.List(sort)
-import Data.Char (isSpace)
 import GF.Command.CommandInfo
 import qualified Data.Map as Map
 import GF.Infra.SIO
@@ -16,7 +15,7 @@ import GF.Text.Pretty
 import GF.Text.Transliterations
 import GF.Text.Lexing(stringOp,opInEnv)

-import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
+import PGF2(showExpr)

 extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased

@@ -102,9 +101,7 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
       "To see transliteration tables, use command ut."
       ],
     examples = [
--       mkEx "l (EAdd 3 4) | ps -code         -- linearize code-like output",
       mkEx "l (EAdd 3 4) | ps -unlexcode    -- linearize code-like output",
--       mkEx "ps -lexer=code | p -cat=Exp     -- parse code-like input",
       mkEx "ps -lexcode | p -cat=Exp        -- parse code-like input",
       mkEx "gr -cat=QCl | l | ps -bind      -- linearization output from LangFin",
       mkEx "ps -to_devanagari \"A-p\"         -- show Devanagari in UTF8 terminal",
@@ -117,13 +114,11 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
               let (os,fs) = optsAndFlags opts
               trans <- optTranslit opts

-               case opts of
-                 _ | isOpt "lines" opts -> return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toStrings x
-                 _ | isOpt "paragraphs" opts -> return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toParagraphs $ toStrings x
-                 _ -> return ((fromString . trans . stringOps (envFlag fs) (map prOpt os) . toString) x),
+               if isOpt "lines" opts 
+                  then return $ fromStrings $ map (trans . stringOps (envFlag fs) (map prOpt os)) $ toStrings x
+                  else return ((fromString . trans . stringOps (envFlag fs) (map prOpt os) . toString) x),
     options = [
-       ("lines","apply the operation separately to each input line, returning a list of lines"),
-       ("paragraphs","apply separately to each input paragraph (as separated by empty lines), returning a list of lines")
+       ("lines","apply the operation separately to each input line, returning a list of lines")
       ] ++
       stringOpOptions,
     flags = [
@@ -178,12 +173,6 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
       mkEx "gt | l | ? wc  -- generate trees, linearize, and count words"
       ]
     }),
-  ("tt", emptyCommandInfo {
-     longname = "to_trie",
-     syntax = "to_trie",
-     synopsis = "combine a list of trees into a trie",
-     exec = \ _ -> return . fromString . trie . toExprs
-    }),
  ("ut", emptyCommandInfo {
     longname = "unicode_table",
     synopsis = "show a transliteration table for a unicode character set",
@@ -231,7 +220,6 @@ envFlag fs =
    _ -> Nothing

 stringOpOptions = sort $ [
-       ("bind","bind tokens separated by Prelude.BIND, i.e. &+"),
       ("chars","lexer that makes every non-space character a token"),
       ("from_cp1251","decode from cp1251 (Cyrillic used in Bulgarian resource)"),
       ("from_utf8","decode from utf8 (default)"),
@@ -256,27 +244,6 @@ stringOpOptions = sort $ [
        ("to_"   ++ p, "from GF " ++ n ++ " transliteration to unicode")] |
                                    (p,n) <- transliterationPrintNames]

-trie = render . pptss . H.toTrie . map H.toATree
-  where
-    pptss [ts] = "*"<+>nest 2 (ppts ts)
-    pptss tss  = vcat [i<+>nest 2 (ppts ts)|(i,ts)<-zip [(1::Int)..] tss]
-
-    ppts = vcat . map ppt
-
-    ppt t =
-      case t of
-        H.Oth e     -> pp (H.showExpr [] e)
-        H.Ap f [[]] -> pp (H.showCId f)
-        H.Ap f tss  -> H.showCId f $$ nest 2 (pptss tss)
-
 -- ** Converting command input
 toString  = unwords . toStrings
 toLines = unlines . toStrings
-
-toParagraphs = map (unwords . words) . toParas
-  where
-    toParas ls = case break (all isSpace) ls of
-      ([],[])   -> []
-      ([],_:ll) -> toParas ll
-      (l, [])   -> [unwords l]
-      (l, _:ll) -> unwords l : toParas ll
--- a/src/compiler/GF/Command/Importing.hs
+++ b/src/compiler/GF/Command/Importing.hs
@@ -1,7 +1,7 @@
 module GF.Command.Importing (importGrammar, importSource) where

-import PGF
-import PGF.Internal(optimizePGF,unionPGF,msgUnionPGF)
+import PGF2
+import PGF2.Internal(unionPGF)

 import GF.Compile
 import GF.Compile.Multi (readMulti)
@@ -17,14 +17,16 @@ import GF.Data.ErrM

 import System.FilePath
 import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Control.Monad(foldM)

 -- import a grammar in an environment where it extends an existing grammar
-importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
-importGrammar pgf0 _ [] = return pgf0
+importGrammar :: Maybe PGF -> Options -> [FilePath] -> IO (Maybe PGF)
+importGrammar pgf0 _    []    = return pgf0
 importGrammar pgf0 opts files =
  case takeExtensions (last files) of
-    ".cf"   -> importCF opts files getBNFCRules bnfc2cf
-    ".ebnf" -> importCF opts files getEBNFRules ebnf2cf
+    ".cf"   -> fmap Just $ importCF opts files getBNFCRules bnfc2cf
+    ".ebnf" -> fmap Just $ importCF opts files getEBNFRules ebnf2cf
    ".gfm"  -> do
      ascss <- mapM readMulti files
      let cs = concatMap snd ascss
@@ -36,14 +38,15 @@ importGrammar pgf0 opts files =
        Bad msg -> do putStrLn ('\n':'\n':msg)
                      return pgf0
    ".pgf" -> do
-      pgf2 <- mapM readPGF files >>= return . foldl1 unionPGF
-      ioUnionPGF pgf0 pgf2
+      mapM readPGF files >>= foldM ioUnionPGF pgf0
    ext -> die $ "Unknown filename extension: " ++ show ext

-ioUnionPGF :: PGF -> PGF -> IO PGF
-ioUnionPGF one two = case msgUnionPGF one two of
-  (pgf, Just msg) -> putStrLn msg >> return pgf
-  (pgf,_)         -> return pgf
+ioUnionPGF :: Maybe PGF -> PGF -> IO (Maybe PGF)
+ioUnionPGF Nothing    two = return (Just two)
+ioUnionPGF (Just one) two =
+  case unionPGF one two of
+    Nothing         -> putStrLn "Abstract changed, previous concretes discarded." >> return (Just two)
+    Just pgf        -> return (Just pgf)

 importSource :: Options -> [FilePath] -> IO SourceGrammar
 importSource opts files = fmap (snd.snd) (batchCompile opts files)
@@ -56,7 +59,6 @@ importCF opts files get convert = impCF
      startCat <- case rules of
                    (Rule cat _ _ : _) -> return cat
                    _                  -> fail "empty CFG"
-      let pgf = cf2pgf (last files) (mkCFG startCat Set.empty rules)
-      probs <- maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf
-      return $ setProbabilities probs 
-             $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
+      probs <- maybe (return Map.empty) readProbabilitiesFromFile (flag optProbsFile opts)
+      let pgf = cf2pgf opts (last files) (mkCFG startCat Set.empty rules) probs
+      return pgf
--- a/src/compiler/GF/Command/Interpreter.hs
+++ b/src/compiler/GF/Command/Interpreter.hs
@@ -6,13 +6,11 @@ module GF.Command.Interpreter (
 import GF.Command.CommandInfo
 import GF.Command.Abstract
 import GF.Command.Parse
-import PGF.Internal(Expr(..))
 import GF.Infra.UseIO(putStrLnE)
+import PGF2

 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 ()
@@ -56,17 +53,8 @@ interpretPipe env cs = do
 -- | macro definition applications: replace ?i by (exps !! i)
 appCommand :: CommandArguments -> Command -> Command
 appCommand args c@(Command i os arg) = case arg of
-  AExpr e -> Command i os (AExpr (app e))
+  AExpr e -> Command i os (AExpr (exprSubstitute e (toExprs args)))
  _       -> c
- where
-  xs = toExprs args
-
-  app e = case e of
-    EAbs b x e -> EAbs b x (app e)
-    EApp e1 e2 -> EApp (app e1) (app e2)
-    ELit l     -> ELit l
-    EMeta i    -> xs !! i
-    EFun x     -> EFun x

 -- | return the trees to be sent in pipe, and the output possibly printed
 --interpret :: CommandEnv -> [Expr] -> Command -> SIO CommandOutput
@@ -113,4 +101,4 @@ getCommandTrees env needsTypeCheck a args =
    ATerm t -> return (Term t)
    ANoArg  -> return args  -- use piped
  where
-    one e = return (Exprs [e]) -- ignore piped
+    one e = return (Exprs [(e,0)]) -- ignore piped
--- a/src/compiler/GF/Command/Parse.hs
+++ b/src/compiler/GF/Command/Parse.hs
@@ -1,6 +1,6 @@
 module GF.Command.Parse(readCommandLine, pCommand) where

-import PGF(pExpr,pIdent)
+import PGF2(pExpr,pIdent)
 import GF.Grammar.Parser(runPartial,pTerm)
 import GF.Command.Abstract

@@ -22,7 +22,7 @@ pCommandLine =
 pPipe = sepBy1 (skipSpaces >> pCommand) (skipSpaces >> char '|')

 pCommand = (do
-  cmd  <- pIdent <++ (char '%' >> fmap ('%':) pIdent)
+  cmd  <- readS_to_P pIdent <++ (char '%' >> fmap ('%':) (readS_to_P pIdent))
  skipSpaces
  opts <- sepBy pOption skipSpaces
  arg  <- if getCommandOp cmd == "cc" then pArgTerm else pArgument
@@ -37,7 +37,7 @@ pCommand = (do

 pOption = do
  char '-'
-  flg <- pIdent
+  flg <- readS_to_P pIdent
  option (OOpt flg) (fmap (OFlag flg) (char '=' >> pValue))

 pValue = do
@@ -52,9 +52,9 @@ pFilename = liftM2 (:) (satisfy isFileFirst) (munch (not . isSpace)) where

 pArgument =
  option ANoArg
-    (fmap AExpr pExpr
+    (fmap AExpr (readS_to_P pExpr)
              <++
-    (skipSpaces >> char '%' >> fmap AMacro pIdent))
+    (skipSpaces >> char '%' >> fmap AMacro (readS_to_P pIdent)))

 pArgTerm = ATerm `fmap` readS_to_P sTerm
  where
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -4,15 +4,15 @@ module GF.Command.TreeOperations (
  treeChunks
  ) where

-import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
+import PGF2(Expr,PGF,Fun,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
 import Data.List

 type TreeOp = [Expr] -> [Expr]

-treeOp :: PGF -> String -> Maybe (Either TreeOp (CId -> TreeOp))
+treeOp :: PGF -> String -> Maybe (Either TreeOp (Fun -> TreeOp))
 treeOp pgf f = fmap snd $ lookup f $ allTreeOps pgf

-allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
+allTreeOps :: PGF -> [(String,(String,Either TreeOp (Fun -> TreeOp)))]
 allTreeOps pgf = [
   ("compute",("compute by using semantic definitions (def)",
      Left  $ map (compute pgf))),
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -1,6 +1,6 @@
 module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where

-import GF.Compile.GrammarToPGF(mkCanon2pgf)
+import GF.Compile.GrammarToPGF(grammar2PGF)
 import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
                            importsOfModule)
 import GF.CompileOne(compileOne)
@@ -14,7 +14,7 @@ import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,
                      justModuleName,extendPathEnv,putStrE,putPointE)
 import GF.Data.Operations(raise,(+++),err)

-import Control.Monad(foldM,when,(<=<),filterM,liftM)
+import Control.Monad(foldM,when,(<=<))
 import GF.System.Directory(doesFileExist,getModificationTime)
 import System.FilePath((</>),isRelative,dropFileName)
 import qualified Data.Map as Map(empty,insert,elems) --lookup
@@ -22,8 +22,7 @@ import Data.List(nub)
 import Data.Time(UTCTime)
 import GF.Text.Pretty(render,($$),(<+>),nest)

-import PGF.Internal(optimizePGF)
-import PGF(PGF,defaultProbabilities,setProbabilities,readProbabilitiesFromFile)
+import PGF2(PGF,readProbabilitiesFromFile)

 -- | Compiles a number of source files and builds a 'PGF' structure for them.
 -- This is a composition of 'link' and 'batchCompile'.
@@ -36,11 +35,10 @@ link :: Options -> (ModuleName,Grammar) -> IOE PGF
 link opts (cnc,gr) =
  putPointE Normal opts "linking ... " $ do
    let abs = srcAbsName gr cnc
-    pgf <- mkCanon2pgf opts gr abs
-    probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
+    probs <- liftIO (maybe (return Map.empty) readProbabilitiesFromFile (flag optProbsFile opts))
+    pgf <- grammar2PGF opts gr abs probs
    when (verbAtLeast opts Normal) $ putStrE "OK"
-    return $ setProbabilities probs 
-           $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
+    return pgf

 -- | Returns the name of the abstract syntax corresponding to the named concrete syntax
 srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
@@ -78,14 +76,10 @@ compileModule opts1 env@(_,rfs) file =
  do file <- getRealFile file
     opts0 <- getOptionsFromFile file
     let curr_dir = dropFileName file
-     lib_dirs <- getLibraryDirectory (addOptions opts0 opts1)
-     let opts = addOptions (fixRelativeLibPaths curr_dir lib_dirs opts0) opts1
--     putIfVerb opts $ "curr_dir:" +++ show curr_dir ----
--     putIfVerb opts $ "lib_dir:" +++ show lib_dirs ----
+     lib_dir  <- getLibraryDirectory (addOptions opts0 opts1)
+     let opts = addOptions (fixRelativeLibPaths curr_dir lib_dir opts0) opts1
     ps0 <- extendPathEnv opts
     let ps = nub (curr_dir : ps0)
--     putIfVerb opts $ "options from file: " ++ show opts0
--     putIfVerb opts $ "augmented options: " ++ show opts
     putIfVerb opts $ "module search path:" +++ show ps ----
     files <- getAllFiles opts ps rfs file
     putIfVerb opts $ "files to read:" +++ show files ----
@@ -98,17 +92,13 @@ compileModule opts1 env@(_,rfs) file =
      if exists
        then return file
        else if isRelative file
-               then do
-                       lib_dirs <- getLibraryDirectory opts1
-                       let candidates = [ lib_dir </> file | lib_dir <- lib_dirs ]
-                       putIfVerb opts1 (render ("looking for: " $$ nest 2 candidates))
-                       file1s <- filterM doesFileExist candidates
-                       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"))
+               then do lib_dir <- getLibraryDirectory opts1
+                       let file1 = lib_dir </> file
+                       exists <- doesFileExist file1
+                       if exists
+                         then return file1
+                         else raise (render ("None of these files exists:" $$ nest 2 (file $$ file1)))
+               else raise (render ("File" <+> file <+> "does not exist."))

 compileOne' :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
 compileOne' opts env@(gr,_) = extendCompileEnv env <=< compileOne opts gr
--- a/src/compiler/GF/Compile/CFGtoPGF.hs
+++ b/src/compiler/GF/Compile/CFGtoPGF.hs
@@ -1,99 +1,110 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, ImplicitParams #-}
 module GF.Compile.CFGtoPGF (cf2pgf) where

 import GF.Grammar.CFG
 import GF.Infra.UseIO
+import GF.Infra.Option
+import GF.Compile.OptimizePGF

-import PGF
-import PGF.Internal
+import PGF2
+import PGF2.Internal

 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Data.Array.IArray
 import Data.List
+import Data.Maybe(fromMaybe)

 --------------------------
 -- the compiler ----------
 --------------------------

-cf2pgf :: FilePath -> ParamCFG -> PGF
-cf2pgf fpath cf = 
- let pgf = PGF Map.empty aname (cf2abstr cf) (Map.singleton cname (cf2concr cf))
- in updateProductionIndices pgf
+cf2pgf :: Options -> FilePath -> ParamCFG -> Map.Map Fun Double -> PGF
+cf2pgf opts fpath cf probs = 
+ build (let abstr = cf2abstr cf probs
+        in newPGF [] aname abstr [(cname, cf2concr opts abstr cf)])
 where
   name = justModuleName fpath
-   aname = mkCId (name ++ "Abs")
-   cname = mkCId name
+   aname = name ++ "Abs"
+   cname = name

-cf2abstr :: ParamCFG -> Abstr
-cf2abstr cfg = Abstr aflags afuns acats
+cf2abstr :: (?builder :: Builder s) => ParamCFG -> Map.Map Fun Double -> B s AbstrInfo
+cf2abstr cfg probs = newAbstr aflags acats afuns
  where
-    aflags = Map.singleton (mkCId "startcat") (LStr (fst (cfgStartCat cfg)))
+    aflags = [("startcat", LStr (fst (cfgStartCat cfg)))]

-    acats  = Map.fromList [(cat, ([], [(0,mkRuleName rule) | rule <- rules], 0))
-                            | (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))
-                            | rule <- allRules cfg]
+    acats  = [(c', [], toLogProb (fromMaybe 0 (Map.lookup c' probs))) | cat <- allCats' cfg, let c' = cat2id cat]
+    afuns  = [(f', dTyp [hypo Explicit "_" (dTyp [] (cat2id c) []) | NonTerminal c <- ruleRhs rule] (cat2id (ruleLhs rule)) [], 0, [], toLogProb (fromMaybe 0 (Map.lookup f' funs_probs)))
+                            | rule <- allRules cfg
+                            , let f' = mkRuleName rule]

-    cat2id = mkCId . fst
+    funs_probs = (Map.fromList . concat . Map.elems . fmap pad . Map.fromListWith (++))
+                     [(cat,[(f',Map.lookup f' probs)]) | rule <- allRules cfg,
+                                                         let cat = cat2id (ruleLhs rule),
+                                                         let f' = mkRuleName rule]
+      where
+        pad :: [(a,Maybe Double)] -> [(a,Double)]
+        pad pfs = [(f,fromMaybe deflt mb_p) | (f,mb_p) <- pfs]
+          where
+            deflt = case length [f | (f,Nothing) <- pfs] of
+                      0 -> 0
+                      n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)

-cf2concr :: ParamCFG -> Concr
-cf2concr cfg = Concr Map.empty Map.empty
-                     cncfuns lindefsrefs lindefsrefs
-                     sequences productions
-                     IntMap.empty Map.empty
-                     cnccats
-                     IntMap.empty
-                     totalCats
+    toLogProb = realToFrac . negate . log
+
+    cat2id = fst
+
+cf2concr :: (?builder :: Builder s) => Options -> B s AbstrInfo -> ParamCFG -> B s ConcrInfo
+cf2concr opts abstr cfg = 
+  let (lindefs',linrefs',productions',cncfuns',sequences',cnccats') =
+           (if flag optOptimizePGF opts then optimizePGF (fst (cfgStartCat cfg)) else id)
+                (lindefsrefs,lindefsrefs,IntMap.toList productions,cncfuns,sequences,cnccats)
+  in newConcr abstr [] []
+              lindefs' linrefs'
+              productions' cncfuns'
+              sequences' cnccats' totalCats
  where
    cats  = allCats' cfg
    rules = allRules cfg

-    sequences0 = Set.fromList (listArray (0,0) [SymCat 0 0] : 
-                               map mkSequence rules)
-    sequences  = listArray (0,Set.size sequences0-1) (Set.toList sequences0)
+    idSeq = [SymCat 0 0]

-    idFun = CncFun wildCId (listArray (0,0) [seqid])
-      where
-        seq   = listArray (0,0) [SymCat 0 0]
-        seqid = binSearch seq sequences (bounds sequences)
+    sequences0 = Set.fromList (idSeq : 
+                               map mkSequence rules)
+    sequences  = Set.toList sequences0
+
+    idFun = ("_",[Set.findIndex idSeq sequences0])
    ((fun_cnt,cncfuns0),productions0) = mapAccumL (convertRule cs) (1,[idFun]) rules
    productions = foldl addProd IntMap.empty (concat (productions0++coercions))
-    cncfuns = listArray (0,fun_cnt-1) (reverse cncfuns0)
+    cncfuns = reverse cncfuns0

-    lbls = listArray (0,0) ["s"]
-    (fid,cnccats0) = (mapAccumL mkCncCat 0 . Map.toList . Map.fromListWith max)
-                              [(c,p) | (c,ps) <- cats, p <- ps]
+    lbls = ["s"]
+    (fid,cnccats) = (mapAccumL mkCncCat 0 . Map.toList . Map.fromListWith max)
+                         [(c,p) | (c,ps) <- cats, p <- ps]
    ((totalCats,cs), coercions) = mapAccumL mkCoercions (fid,Map.empty) cats
-    cnccats = Map.fromList cnccats0

-    lindefsrefs =
-       IntMap.fromList (map mkLinDefRef cats)
+    lindefsrefs = map mkLinDefRef cats

    convertRule cs (funid,funs) rule =
      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])
+          seqid  = Set.findIndex (mkSequence rule) sequences0
+          fun    = (mkRuleName rule, [seqid])
          funid' = funid+1
      in funid' `seq` ((funid',fun:funs),let (c,ps) = ruleLhs rule in [(cat2fid c p, prod) | p <- ps])

-    mkSequence rule = listArray (0,length syms-1) syms
+    mkSequence rule = snd $ mapAccumL convertSymbol 0 (ruleRhs rule)
      where
-        syms   = snd $ mapAccumL convertSymbol 0 (ruleRhs rule)
-
        convertSymbol d (NonTerminal (c,_)) = (d+1,if c `elem` ["Int","Float","String"] then SymLit d 0 else SymCat d 0)
        convertSymbol d (Terminal t)        = (d,  SymKS t)

    mkCncCat fid (cat,n)
-      | cat == "Int"    = (fid, (mkCId cat, CncCat fidInt    fidInt    lbls))
-      | cat == "Float"  = (fid, (mkCId cat, CncCat fidFloat  fidFloat  lbls))
-      | cat == "String" = (fid, (mkCId cat, CncCat fidString fidString lbls))
+      | cat == "Int"    = (fid, (cat, fidInt,    fidInt,    lbls))
+      | cat == "Float"  = (fid, (cat, fidFloat,  fidFloat,  lbls))
+      | cat == "String" = (fid, (cat, fidString, fidString, lbls))
      | otherwise       = let fid' = fid+n+1
-                          in fid' `seq` (fid', (mkCId cat,CncCat fid (fid+n) lbls))
+                          in fid' `seq` (fid', (cat, fid, fid+n, lbls))

    mkCoercions (fid,cs) c@(cat,[p]) = ((fid,cs),[])
    mkCoercions (fid,cs) c@(cat,ps ) =
@@ -102,25 +113,16 @@ cf2concr cfg = Concr Map.empty Map.empty

    mkLinDefRef (cat,_) =
      (cat2fid cat 0,[0])
-      
+
    addProd prods (fid,prod) =
      case IntMap.lookup fid prods of
-        Just set -> IntMap.insert fid (Set.insert prod set) prods
-        Nothing  -> IntMap.insert fid (Set.singleton prod)  prods
-
-    binSearch v arr (i,j)
-      | i <= j    = case compare v (arr ! k) of
-                      LT -> binSearch v arr (i,k-1)
-                      EQ -> k
-                      GT -> binSearch v arr (k+1,j)
-      | otherwise = error "binSearch"
-      where
-        k = (i+j) `div` 2
+        Just set -> IntMap.insert fid (prod:set) prods
+        Nothing  -> IntMap.insert fid [prod]     prods

    cat2fid cat p =
-      case Map.lookup (mkCId cat) cnccats of
-        Just (CncCat fid _ _) -> fid+p
-        _                     -> error "cat2fid"
+      case [start | (cat',start,_,_) <- cnccats, cat == cat'] of
+        (start:_) -> fid+p
+        _         -> error "cat2fid"

    cat2arg c@(cat,[p]) = cat2fid cat p
    cat2arg c@(cat,ps ) =
@@ -131,4 +133,5 @@ cf2concr cfg = Concr Map.empty Map.empty
 mkRuleName rule =
  case ruleName rule of
 	CFObj n _ -> n
-	_         -> wildCId
+	_         -> "_"
+
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -21,7 +21,6 @@
 -----------------------------------------------------------------------------

 module GF.Compile.CheckGrammar(checkModule) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

 import GF.Infra.Ident
 import GF.Infra.Option
@@ -260,18 +259,30 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
      return (ResOverload os [(y,x) | (x,y) <- tysts'])

    ResParam (Just (L loc pcs)) _ -> do
-      ts <- chIn loc "parameter type" $ 
-              liftM concat $ mapM mkPar pcs
-      return (ResParam (Just (L loc pcs)) (Just ts))
+      (vs,pcs) <- chIn loc "parameter type" $
+                    mkParams 0 [] pcs
+      return (ResParam (Just (L loc pcs)) (Just vs))
+
+    ResValue (L loc ty) _ -> 
+      chIn loc "operation" $ do
+        let (_,Cn x) = typeFormCnc ty
+            is = case Map.lookup x (jments mo) of
+                   Just (ResParam (Just (L _ pcs)) _) -> [i | (f,_,i) <- pcs, f == c]
+                   _                                  -> []
+        case is of
+          [i] -> return (ResValue (L loc ty) i)
+          _   -> checkError (pp "Failed to find the value index for parameter" <+> pp c)

    _ ->  return info
 where
   gr = prependModule sgr (m,mo)
   chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c)

-   mkPar (f,co) = do
-       vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co
-       return $ map (mkApp (QC (m,f))) vs
+   mkParams i vs []             = return (vs,[])
+   mkParams i vs ((f,co,_):pcs) = do
+     vs0 <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
+     (vs,pcs) <- mkParams (i + length vs0) (vs ++ map (mkApp (QC (m,f))) vs0) pcs
+     return (vs,(f,co,i):pcs)

   checkUniq xss = case xss of
     x:y:xs 
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -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)
+-}
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -5,7 +5,6 @@ module GF.Compile.Compute.ConcreteNew
            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)
@@ -15,7 +14,7 @@ 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.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
@@ -291,17 +290,9 @@ glue env (v1,v2) = glu v1 v2
                                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"
-                                ]
+                            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
@@ -326,7 +317,7 @@ strsFromValue t = case t of
    return [strTok (str2strings def) vars | 
              def  <- d0,
              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
-                                                          vv <- sequence v0]
+                                                          vv <- combinations v0]
           ]
  VFV ts -> concat # mapM strsFromValue ts
  VStrs ts -> concat # mapM strsFromValue ts
@@ -528,7 +519,7 @@ value2term' stop loc xs v0 =
 --  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
@@ -554,7 +545,7 @@ value2term' stop loc xs v0 =
 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)
+    else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)
  where
    allpvs = allPattVars p
    pvs = nub allpvs
--- a/src/compiler/GF/Compile/Compute/Value.hs
+++ b/src/compiler/GF/Compile/Compute/Value.hs
@@ -1,6 +1,6 @@
 module GF.Compile.Compute.Value where
 import GF.Grammar.Grammar(Label,Type,MetaId,Patt,QIdent)
-import PGF.Internal(BindType)
+import PGF2(BindType)
 import GF.Infra.Ident(Ident)
 import Text.Show.Functions()
 import Data.Ix(Ix)
--- a/src/compiler/GF/Compile/ConcreteToHaskell.hs
+++ b/src/compiler/GF/Compile/ConcreteToHaskell.hs
@@ -7,7 +7,7 @@ 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.Infra.Ident(Ident,identS,identW,prefixIdent)
 import GF.Infra.Option
 import GF.Haskell as H
 import GF.Grammar.Canonical as C
@@ -21,7 +21,7 @@ concretes2haskell opts absname gr =
     | let Grammar abstr cncs = grammar2canonical opts absname gr,
       cncmod<-cncs,
       let ModId name = concName cncmod
-           filename = showRawIdent name ++ ".hs" :: FilePath
+           filename = name ++ ".hs" :: FilePath
  ]

 -- | Generate Haskell code for the given concrete module.
@@ -53,7 +53,7 @@ concrete2haskell opts
    labels = S.difference (S.unions (map S.fromList recs)) common_labels
    common_records = S.fromList [[label_s]]
    common_labels = S.fromList [label_s]
-    label_s = LabelId (rawIdentS "s")
+    label_s = LabelId "s"

    signature (CatDef c _) = TypeSig lf (Fun abs (pure lin))
      where
@@ -69,7 +69,7 @@ concrete2haskell opts
      where
     --funcats = S.fromList [c | FunDef f (C.Type _ (TypeApp c _))<-funs]
       allcats = S.fromList [c | CatDef c _<-cats]
-
+      
    gId :: ToIdent i => i -> Ident
    gId = (if haskellOption opts HaskellNoPrefix then id else prefixIdent "G")
          . toIdent
@@ -116,7 +116,7 @@ concrete2haskell opts
              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 ->
+--          TupleType lts -> 

    lincatDef (LincatDef c t) = tsyn0 (lincatName c) (convLinType t)

@@ -126,7 +126,7 @@ concrete2haskell opts
    linDefs = map eqn . sortOn fst . map linDef
      where eqn (cat,(f,(ps,rhs))) = (cat,Eqn (f,ps) rhs)

-    linDef (LinDef f xs rhs0) =
+    linDef (LinDef f xs rhs0) = 
        (cat,(linfunName cat,(lhs,rhs)))
      where
        lhs = [ConP (aId f) (map VarP abs_args)]
@@ -144,7 +144,7 @@ concrete2haskell opts
          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)))

@@ -187,7 +187,7 @@ concrete2haskell opts

        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'])
@@ -315,13 +315,13 @@ instance Records rhs => Records (TableRow rhs) where

 -- | Record subtyping is converted into explicit coercions in Haskell
 coerce env ty t =
-  case (ty,t) of
+  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]]
+                     RecordRow l f<-r,ft<-[ft|RecordRow l' ft<-rt,l'==l]]
    (RecordType rt,VarValue x)->
      case lookup x env of
        Just ty' | ty'/=ty -> -- better to compare to normal form of ty'
@@ -334,17 +334,18 @@ coerce env ty t =
    _ -> t
  where
    app f ts = ParamConstant (Param f ts) -- !! a hack
-    to_rcon = ParamId . Unqual . rawIdentS . to_rcon' . labels
+    to_rcon = ParamId . Unqual . to_rcon' . labels

 patVars p = []

-labels r = [l | RecordRow l _ <- r]
+labels r = [l|RecordRow l _<-r]

 proj = Var . identS . proj'
-proj' (LabelId l) = "proj_" ++ showRawIdent l
+proj' (LabelId l) = "proj_"++l
 rcon = Var . rcon'
 rcon' = identS . rcon_name
-rcon_name ls = "R"++concat (sort ['_':showRawIdent l | LabelId l <- ls])
+rcon_name ls = "R"++concat (sort ['_':l|LabelId l<-ls])
+
 to_rcon' = ("to_"++) . rcon_name

 recordType ls =
@@ -399,17 +400,17 @@ 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
+instance ToIdent ParamId where toIdent (ParamId q) = qIdentS q
+instance ToIdent PredefId where toIdent (PredefId s) = identS s
+instance ToIdent CatId   where toIdent (CatId s) = identS s
+instance ToIdent C.FunId where toIdent (FunId s) = identS s
+instance ToIdent VarValueId where toIdent (VarValueId q) = qIdentS q

-qIdentC = identS . unqual
+qIdentS = identS . unqual

-unqual (Qual (ModId m) n) = showRawIdent m++"_"++ showRawIdent n
-unqual (Unqual n) = showRawIdent n
+unqual (Qual (ModId m) n) = m++"_"++n
+unqual (Unqual n) = n

 instance ToIdent VarId where
  toIdent Anonymous = identW
-  toIdent (VarId s) = identC s
+  toIdent (VarId s) = identS s
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -3,11 +3,7 @@ module GF.Compile.ExampleBased (
  configureExBased
  ) where

-import PGF
--import PGF.Probabilistic
--import PGF.Morphology
--import GF.Compile.ToAPI
-
+import PGF2
 import Data.List

 parseExamplesInGrammar :: ExConfiguration -> FilePath -> IO (FilePath,[String])
@@ -37,47 +33,38 @@ convertFile conf src file = do
      (ex,   end) = break (=='"') (tail exend)
    in ((unwords (words cat),ex), tail end)  -- quotes ignored
  pgf = resource_pgf conf
-  morpho = resource_morpho conf
  lang = language conf 
  convEx (cat,ex) = do
    appn "("
    let typ = maybe (error "no valid cat") id $ readType cat
-    ws <- case fst (parse_ pgf lang typ (Just 4) ex) of
-      ParseFailed _ -> do
-        let ws = morphoMissing morpho (words ex)
+    ws <- case parse lang typ ex of
+      ParseFailed _ _ -> do
        appv ("WARNING: cannot parse example " ++ ex) 
-        case ws of
-          [] -> return ()
-          _  -> appv ("  missing words: " ++ unwords ws)
-        return ws
-      TypeError _ ->
        return []
      ParseIncomplete ->
        return []
      ParseOk ts ->
-        case rank ts of
+        case ts of
          (t:tt) -> do
            if null tt 
              then return ()
              else appv ("WARNING: ambiguous example " ++ ex) 
-            appn t 
-            mapM_ (appn . ("  --- " ++)) tt
+            appn (printExp conf (fst t))
+            mapM_ (appn . ("  --- " ++) . printExp conf . fst) tt
            appn ")" 
            return [] 
    return ws
-  rank ts = [printExp conf t ++ "  -- " ++ show p | (t,p) <- rankTreesByProbs pgf ts]
  appf = appendFile file
  appn s = appf s >> appf "\n"
  appv s = appn ("--- " ++ s) >> putStrLn s

 data ExConfiguration = ExConf {
-  resource_pgf    :: PGF,
-  resource_morpho :: Morpho,
+  resource_pgf :: PGF,
  verbose  :: Bool,
-  language :: Language,
-  printExp :: Tree -> String
+  language :: Concr,
+  printExp :: Expr -> String
  }

-configureExBased :: PGF -> Morpho -> Language -> (Tree -> String) -> ExConfiguration
-configureExBased pgf morpho lang pr = ExConf pgf morpho False lang pr
+configureExBased :: PGF -> Concr -> (Expr -> String) -> ExConfiguration
+configureExBased pgf concr pr = ExConf pgf False concr pr

--- a/src/compiler/GF/Compile/Export.hs
+++ b/src/compiler/GF/Compile/Export.hs
@@ -1,14 +1,10 @@
 module GF.Compile.Export where

-import PGF
-import PGF.Internal(ppPGF)
+import PGF2
 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
 import GF.Speech.PGFToCFG
@@ -22,6 +18,7 @@ import GF.Speech.SLF
 import GF.Speech.PrRegExp

 import Data.Maybe
+import qualified Data.Map as Map
 import System.FilePath
 import GF.Text.Pretty

@@ -35,15 +32,12 @@ exportPGF :: Options
          -> [(FilePath,String)] -- ^ List of recommended file names and contents.
 exportPGF opts fmt pgf = 
    case fmt of
-      FmtPGFPretty    -> multi "txt" (render . ppPGF)
+      FmtPGFPretty    -> multi "txt" (showPGF)
      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)
-      FmtProlog       -> multi "pl"  grammar2prolog
      FmtBNF          -> single "bnf"   bnfPrinter
      FmtEBNF         -> single "ebnf"  (ebnfPrinter opts)
      FmtSRGS_XML     -> single "grxml" (srgsXmlPrinter opts)
@@ -57,20 +51,13 @@ exportPGF opts fmt pgf =
      FmtRegExp       -> single "rexp" regexpPrinter
      FmtFA           -> single "dot"  slfGraphvizPrinter
 where
-   name = fromMaybe (showCId (abstractName pgf)) (flag optName opts)
+   name = fromMaybe (abstractName pgf) (flag optName opts)

   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]
+   single :: String -> (PGF -> Concr -> String) -> [(FilePath,String)]
+   single ext pr = [(concreteName cnc <.> ext, pr pgf cnc) | cnc <- Map.elems (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
-outputConcr pgf = case languages pgf of
-                    []     -> error "No concrete syntax."
-                    cnc:_  -> cnc
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -1,10 +1,10 @@
+{-# LANGUAGE CPP #-}
 module GF.Compile.GenerateBC(generateByteCode) where

 import GF.Grammar
 import GF.Grammar.Lookup(lookupAbsDef,lookupFunType)
 import GF.Data.Operations
-import PGF(CId,utf8CId)
-import PGF.Internal(CodeLabel,Instr(..),IVal(..),TailInfo(..),Literal(..))
+import PGF2.Internal(CodeLabel,Instr(..),IVal(..),TailInfo(..),Literal(..))
 import qualified Data.Map as Map
 import Data.List(nub,mapAccumL)
 import Data.Maybe(fromMaybe)
@@ -63,7 +63,7 @@ compileEquations gr arity st (i:is) eqs       fl bs = whilePP eqs Map.empty

    case_instr t =
      case t of
-        (Q (_,id)) -> CASE (i2i id)
+        (Q (_,id)) -> CASE (showIdent id)
        (EInt n)   -> CASE_LIT (LInt n)
        (K s)      -> CASE_LIT (LStr s)
        (EFloat d) -> CASE_LIT (LFlt d)
@@ -105,7 +105,7 @@ compileFun gr eval st vs (App e1 e2) h0 bs args =
 compileFun gr eval st vs (Q (m,id))  h0 bs args =
  case lookupAbsDef gr m id of
    Ok (_,Just _)
-       -> (h0,bs,eval st (GLOBAL (i2i id)) args)
+       -> (h0,bs,eval st (GLOBAL (showIdent id)) args)
    _  -> let Ok ty = lookupFunType gr m id
              (ctxt,_,_) = typeForm ty
              c_arity    = length ctxt
@@ -114,14 +114,14 @@ compileFun gr eval st vs (Q (m,id))  h0 bs args =
              diff   = c_arity-n_args
          in if diff <= 0
               then if n_args == 0
-                      then (h0,bs,eval st (GLOBAL (i2i id)) [])
+                      then (h0,bs,eval st (GLOBAL (showIdent id)) [])
                      else let h1  = h0 + 2 + n_args
-                           in (h1,bs,PUT_CONSTR (i2i id):is1++eval st (HEAP h0) [])
+                           in (h1,bs,PUT_CONSTR (showIdent id):is1++eval st (HEAP h0) [])
               else let h1  = h0 + 1 + n_args
                        is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
                        b   = CHECK_ARGS diff :
                              ALLOC (c_arity+2) : 
-                              PUT_CONSTR (i2i id) : 
+                              PUT_CONSTR (showIdent id) : 
                              is2 ++
                              TUCK (ARG_VAR 0) diff :
                              EVAL (HEAP h0) (TailCall diff) :
@@ -167,16 +167,16 @@ compileFun gr eval st vs e _ _ _ = error (show e)

 compileArg gr st vs (Q(m,id)) h0 bs =
  case lookupAbsDef gr m id of
-    Ok (_,Just _) -> (h0,bs,GLOBAL (i2i id),[])
+    Ok (_,Just _) -> (h0,bs,GLOBAL (showIdent id),[])
    _             -> let Ok ty = lookupFunType gr m id
                         (ctxt,_,_) = typeForm ty
                         c_arity    = length ctxt
                     in if c_arity == 0
-                          then (h0,bs,GLOBAL (i2i id),[])
+                          then (h0,bs,GLOBAL (showIdent id),[])
                          else let is2 = [SET (ARG_VAR (i+1)) | i <- [0..c_arity-1]]
                                   b   = CHECK_ARGS c_arity :
                                         ALLOC (c_arity+2) :
-                                         PUT_CONSTR (i2i id) :
+                                         PUT_CONSTR (showIdent id) :
                                         is2 ++
                                         TUCK (ARG_VAR 0) c_arity :
                                         EVAL (HEAP h0) (TailCall c_arity) :
@@ -224,12 +224,12 @@ compileArg gr st vs e           h0 bs =
                diff   = c_arity-n_args
            in if diff <= 0
                 then let h2  = h1 + 2 + n_args
-                      in (h2,bs1,HEAP h1,is1 ++ (PUT_CONSTR (i2i id) : is2))
+                      in (h2,bs1,HEAP h1,is1 ++ (PUT_CONSTR (showIdent id) : is2))
                 else let h2  = h1 + 1 + n_args
                          is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
                          b   = CHECK_ARGS diff :
                                ALLOC (c_arity+2) :
-                                PUT_CONSTR (i2i id) :
+                                PUT_CONSTR (showIdent id) :
                                is2 ++
                                TUCK (ARG_VAR 0) diff :
                                EVAL (HEAP h0) (TailCall diff) :
@@ -298,9 +298,6 @@ freeVars xs (Vr x)
  | not (elem x xs)     = [x]
 freeVars xs e           = collectOp (freeVars xs) e

-i2i :: Ident -> CId
-i2i = utf8CId . ident2utf8
-
 push_is :: Int -> Int -> [IVal] -> [IVal]
 push_is i 0 is = is
 push_is i n is = ARG_VAR i : push_is (i-1) (n-1) is
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -13,8 +13,9 @@ module GF.Compile.GeneratePMCFG
    (generatePMCFG, pgfCncCat, addPMCFG, resourceValues
    ) where

--import PGF.CId
-import PGF.Internal as PGF(CncCat(..),Symbol(..),fidVar)
+import qualified PGF2 as PGF2
+import qualified PGF2.Internal as PGF2
+import PGF2.Internal(Symbol(..),fidVar)

 import GF.Infra.Option
 import GF.Grammar hiding (Env, mkRecord, mkTable)
@@ -41,7 +42,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
@@ -69,7 +69,7 @@ mapAccumWithKeyM f a m = do let xs = Map.toAscList m


 --addPMCFG :: Options -> SourceGrammar -> GlobalEnv -> Maybe FilePath -> Ident -> Ident -> SeqSet -> Ident -> Info -> IOE (SeqSet, Info)
-addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont,val)) mlin@(Just (L loc term)) mprn Nothing) = do
+addPMCFG opts gr cenv opath am cm seqs id (CncFun mty@(Just (cat,cont,val)) mlin@(Just (L loc term)) mprn Nothing) = do
 --when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" ...")
  let pres  = protoFCat gr res val
      pargs = [protoFCat gr (snd $ catSkeleton ty) lincat | ((_,_,ty),(_,_,lincat)) <- zip ctxt cont]
@@ -93,7 +93,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncFun mty@(Just (cat,cont
    ePutStr ("\n+ "++showIdent id++" "++show (product (map catFactor pargs)))
  seqs1 `seq` stats `seq` return ()
  when (verbAtLeast opts Verbose) $ ePutStr (" "++show stats)
-  return (seqs1,GF.Grammar.CncFun mty mlin mprn (Just pmcfg))
+  return (seqs1,CncFun mty mlin mprn (Just pmcfg))
  where
    (ctxt,res,_) = err bug typeForm (lookupFunType gr am id)

@@ -103,11 +103,11 @@ 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)) 
-                                                             mdef@(Just (L loc1 def))
-                                                             mref@(Just (L loc2 ref))
-                                                             mprn
-                                                             Nothing) = do
+addPMCFG opts gr cenv opath am cm seqs id (CncCat mty@(Just (L _ lincat)) 
+                                                  mdef@(Just (L loc1 def))
+                                                  mref@(Just (L loc2 ref))
+                                                  mprn
+                                                  Nothing) = do
  let pcat = protoFCat gr (am,id) lincat
      pvar = protoFCat gr (MN identW,cVar) typeStr

@@ -132,7 +132,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ linc
  let pmcfg     = getPMCFG pmcfgEnv2

  when (verbAtLeast opts Verbose) $ ePutStr ("\n+ "++showIdent id++" "++show (catFactor pcat))
-  seqs2 `seq` pmcfg `seq` return (seqs2,GF.Grammar.CncCat mty mdef mref mprn (Just pmcfg))
+  seqs2 `seq` pmcfg `seq` return (seqs2,CncCat mty mdef mref mprn (Just pmcfg))
  where
    addLindef lins (newCat', newArgs') env0 =
      let [newCat] = getFIds newCat'
@@ -158,12 +158,15 @@ convert opts gr cenv loc term ty@(_,val) pargs =
            args = map Vr vars
            vars = map (\(bt,x,t) -> x) context

-pgfCncCat :: SourceGrammar -> Type -> Int -> CncCat
-pgfCncCat gr lincat index =
+pgfCncCat :: SourceGrammar -> PGF2.Cat -> Type -> Int -> (PGF2.Cat,Int,Int,[String])
+pgfCncCat gr id lincat index =
  let ((_,size),schema) = computeCatRange gr lincat
-  in PGF.CncCat index (index+size-1)
-                      (mkArray (map (renderStyle style{mode=OneLineMode} . ppPath) 
-                                    (getStrPaths schema)))
+  in ( id
+     , index
+     , index+size-1
+     , map (renderStyle style{mode=OneLineMode} . ppPath)
+           (getStrPaths schema)
+     )
  where
    getStrPaths :: Schema Identity s c -> [Path]
    getStrPaths = collect CNil []
@@ -197,9 +200,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
@@ -475,7 +475,7 @@ goV (CPar t)     rpath ss = restrictHead (reversePath rpath) t >> return ss
 ----------------------------------------------------------------------
 -- SeqSet

-type SeqSet   = Map.Map Sequence SeqId
+type SeqSet   = Map.Map [Symbol] SeqId

 addSequencesB :: SeqSet -> Branch (Value [Symbol]) -> (SeqSet, Branch (Value SeqId))
 addSequencesB seqs (Case nr path bs) = let !(seqs1,bs1) = mapAccumL' (\seqs (trm,b) -> let !(seqs',b') = addSequencesB seqs b
@@ -504,13 +504,11 @@ mapAccumL' f s (x:xs) = (s'',y:ys)
                              !(s'',ys) = mapAccumL' f s' xs

 addSequence :: SeqSet -> [Symbol] -> (SeqSet,SeqId)
-addSequence seqs lst =
+addSequence seqs seq =
  case Map.lookup seq seqs of
    Just id -> (seqs,id)
    Nothing -> let !last_seq = Map.size seqs
               in (Map.insert seq last_seq seqs, last_seq)
-  where
-    seq = mkArray lst


 ------------------------------------------------------------
@@ -618,23 +616,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
--- a/src/compiler/GF/Compile/GetGrammar.hs
+++ b/src/compiler/GF/Compile/GetGrammar.hs
@@ -50,20 +50,13 @@ getSourceModule opts file0 =
       Right (i,mi0) ->
         do liftIO $ removeTemp tmp
            let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}
-                optCoding' = renameEncoding `fmap` flag optEncoding (mflags mi0)
-            case (optCoding,optCoding') of
-              {-
-              (Nothing,Nothing) ->
-                  unless (BS.all isAscii raw) $
-                    ePutStrLn $ file0++":\n    Warning: default encoding has changed from Latin-1 to UTF-8"
-              -}
-              (_,Just coding') -> 
-                  when (coding/=coding') $
+            case renameEncoding `fmap` flag optEncoding (mflags mi0) of
+              Just coding' -> 
+                when (coding/=coding') $
                  raise $ "Encoding mismatch: "++coding++" /= "++coding'
                where coding = maybe defaultEncoding renameEncoding optCoding
              _ -> return ()
-          --liftIO $ transcodeModule' (i,mi) -- old lexer
-            return (i,mi) -- new lexer
+            return (i,mi)

 getBNFCRules :: Options -> FilePath -> IOE [BNFCRule]
 getBNFCRules opts fpath = do
--- a/src/compiler/GF/Compile/GrammarToCanonical.hs
+++ b/src/compiler/GF/Compile/GrammarToCanonical.hs
@@ -6,35 +6,30 @@ module GF.Compile.GrammarToCanonical(
       ) 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.Grammar
 import GF.Grammar.Lookup(lookupOrigInfo,allOrigInfos,allParamValues)
-import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,composSafeOp,mkAbs,mkApp,term2patt,sortRec)
+import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,mkAbs,mkApp,term2patt)
 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.ConcreteNew(GlobalEnv,normalForm,resourceValues)
+import GF.Infra.Ident(ModuleName(..),Ident,prefixIdent,showIdent,isWildIdent)
+import GF.Infra.Option(optionsPGF)
+import PGF2.Internal(Literal(..))
+import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
 import GF.Grammar.Canonical as C
-import System.FilePath ((</>), (<.>))
-import qualified Debug.Trace as T
-
+import Debug.Trace

 -- | 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
@@ -49,7 +44,6 @@ abstract2canonical absname gr =
    convHypo (bt,name,t) =
      case typeForm t of
        ([],(_,cat),[]) -> gId cat -- !!
-        tf -> error $ "abstract2canonical convHypo: " ++ show tf

    convType t =
      case typeForm t of
@@ -60,26 +54,25 @@ abstract2canonical absname gr =

    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"
+       let cncname = "canonical/"++render cnc ++ ".gf" :: FilePath
           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]
+      [lincat|(_,Left lincat)<-defs]
+      [lin|(_,Right lin)<-defs]
  where
-    defs = concatMap (toCanonical gr absname cenv) .
+    defs = concatMap (toCanonical gr absname cenv) . 
           M.toList $
           jments modinfo

@@ -92,7 +85,6 @@ concrete2canonical gr cenv absname cnc modinfo =
        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 _ ->
@@ -105,8 +97,7 @@ toCanonical gr absname cenv (name,jment) =
      where
        tts = tableTypes gr [e']

-        e' = cleanupRecordFields lincat $
-             unAbs (length params) $
+        e' = unAbs (length params) $
             nf loc (mkAbs params (mkApp def (map Vr args)))
        params = [(b,x)|(b,x,_)<-ctx]
        args = map snd params
@@ -117,12 +108,12 @@ toCanonical gr absname cenv (name,jment) =
    _ -> []
  where
    nf loc = normalForm cenv (L loc name)
+--  aId n = prefixIdent "A." (gId n)

    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 =
@@ -131,7 +122,6 @@ tableTypes gr ts = S.unions (map tabtys ts)
        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)
@@ -150,26 +140,11 @@ paramTypes gr t =
                 Ok (_,ResParam {}) -> S.singleton q
                 _ -> ignore

-    ignore = T.trace ("Ignore: " ++ show t) S.empty
+    ignore = 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
@@ -187,20 +162,20 @@ convert' gr vs = ppT
        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))
+        R r -> RecordValue (fields 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) [])
+        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
+        _ -> error $ "convert' "++show t

    ppCase (p,t) = TableRow (ppP p) (ppTv (patVars p++vs) t)

@@ -213,12 +188,12 @@ convert' gr vs = ppT
        Ok ALL_CAPIT  -> p "ALL_CAPIT"
        _ -> VarValue (gQId cPredef n) -- hmm
      where
-       p = PredefValue . PredefId . rawIdentS
-
+       p = PredefValue . PredefId
+      
    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))
+        PP (m,c) ps -> ParamPattern (Param ((gQId m c)) (map ppP ps))
        PR r -> RecordPattern (fields r) {-
        PW -> WildPattern
        PV x -> VarP x
@@ -227,7 +202,6 @@ convert' gr vs = ppT
        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)
@@ -244,12 +218,12 @@ convert' gr vs = ppT
        pre Empty = [""]  -- Empty == K ""
        pre (Strs ts) = concatMap pre ts
        pre (EPatt p) = pat p
-        pre t = error $ "convert' alts pre: " ++ show t
+        pre t = error $ "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
+        pat p = error $ "pat "++show p

    fields = map field . filter (not.isLockLabel.fst)
    field (l,(_,t)) = RecordRow (lblId l) (ppT t)
@@ -262,7 +236,6 @@ convert' gr vs = ppT
                 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
@@ -270,24 +243,21 @@ concatValue v1 v2 =
    _ -> ConcatValue v1 v2

 -- | Smart constructor for projections
-projection :: LinValue -> LabelId -> LinValue
-projection r l = fromMaybe (Projection r l) (proj r l)
+projection r l = maybe (Projection r l) id (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
+    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
+        case nub [rv|TableRow _ rv<-keep] of
          [rv] -> rv
          _ -> Selection (TableValue tt r') v
      where
@@ -306,16 +276,13 @@ selection t v =
        (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
@@ -327,18 +294,16 @@ mightMatch v p =
    RecordValue rv ->
      case p of
        RecordPattern rp ->
-          and [maybe False (`mightMatch` p) (proj v l) | RecordRow l p<-rp]
+          and [maybe False (flip 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 =
@@ -350,9 +315,9 @@ convType = ppT
        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
+        QC (m,n) -> ParamType (ParamTypeId ((gQId m n)))
+        Q (m,n) -> ParamType (ParamTypeId ((gQId m n)))
+        _ -> error $ "Missing case in convType for: "++show t

    convFields = map convField . filter (not.isLockLabel.fst)
    convField (l,r) = RecordRow (lblId l) (ppT r)
@@ -361,20 +326,15 @@ convType = ppT
                   "Float" -> FloatType
                   "Int" -> IntType
                   "Str" -> StrType
-                   _ -> error $ "convType convSort: " ++ show k
+                   _ -> error ("convSort "++show k)

-toParamType :: Term -> ParamType
 toParamType t = case convType t of
                  ParamType pt -> pt
-                  _ -> error $ "toParamType: " ++ show t
+                  _ -> 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)) _)
@@ -382,7 +342,7 @@ paramType gr q@(_,n) =
         ((S.singleton (m,n),argTypes ps),
          [ParamDef name (map (param m) ps)]
         )
-       where name = gQId m n
+       where name = (gQId m n)
      Ok (m,ResOper  _ (Just (L _ t)))
        | m==cPredef && n==cInts ->
           ((S.empty,S.empty),[]) {-
@@ -390,46 +350,36 @@ paramType gr q@(_,n) =
            [Type (ConAp ((gQId m n)) [identS "n"]) (TId (identS "Int"))])-}
        | otherwise ->
           ((S.singleton (m,n),paramTypes gr t),
-            [ParamAliasDef (gQId m n) (convType t)])
+            [ParamAliasDef ((gQId m n)) (convType t)])
      _ -> ((S.empty,S.empty),[])
  where
-    param m (n,ctx) = Param (gQId m n) [toParamId t|(_,_,t)<-ctx]
+    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]
+    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
+lblId = LabelId . render -- hmm
+modId (MN m) = ModId (showIdent m)

-modId :: ModuleName -> C.ModId
-modId (MN m) = ModId (ident2raw m)
-
-class FromIdent i where
-  gId :: Ident -> i
+class FromIdent i where gId :: Ident -> i

 instance FromIdent VarId where
-  gId i = if isWildIdent i then Anonymous else VarId (ident2raw i)
+  gId i = if isWildIdent i then Anonymous else VarId (showIdent i)

-instance FromIdent C.FunId where gId = C.FunId . ident2raw
-instance FromIdent CatId where gId = CatId . ident2raw
+instance FromIdent C.FunId where gId = C.FunId . showIdent
+instance FromIdent CatId where gId = CatId . showIdent
 instance FromIdent ParamId where gId = ParamId . unqual
 instance FromIdent VarValueId where gId = VarValueId . unqual

-class FromIdent i => QualIdent i where
-  gQId :: ModuleName -> Ident -> i
+class FromIdent i => QualIdent i where gQId :: ModuleName -> Ident -> i

-instance QualIdent ParamId where gQId m n = ParamId (qual m n)
+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)
+qual m n = Qual (modId m) (showIdent n)
+unqual n = Unqual (showIdent n)

-unqual :: Ident -> QualId
-unqual n = Unqual (ident2raw n)
-
-convFlags :: G.Grammar -> ModuleName -> Flags
 convFlags gr mn =
-  Flags [(rawIdentS n,convLit v) |
+  Flags [(n,convLit v) |
         (n,v)<-err (const []) (optionsPGF.mflags) (lookupModule gr mn)]
  where
    convLit l =
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -1,17 +1,14 @@
-{-# LANGUAGE BangPatterns, FlexibleContexts #-}
-module GF.Compile.GrammarToPGF (mkCanon2pgf) where
+{-# LANGUAGE ImplicitParams, BangPatterns, FlexibleContexts, MagicHash #-}
+module GF.Compile.GrammarToPGF (grammar2PGF) where

--import GF.Compile.Export
 import GF.Compile.GeneratePMCFG
 import GF.Compile.GenerateBC
+import GF.Compile.OptimizePGF

-import PGF(CId,mkCId,utf8CId)
-import PGF.Internal(fidInt,fidFloat,fidString,fidVar)
-import PGF.Internal(updateProductionIndices)
-import qualified PGF.Internal as C
-import qualified PGF.Internal as D
+import PGF2 hiding (mkType)
+import PGF2.Internal
 import GF.Grammar.Predef
-import GF.Grammar.Grammar
+import GF.Grammar.Grammar hiding (Production)
 import qualified GF.Grammar.Lookup as Look
 import qualified GF.Grammar as A
 import qualified GF.Grammar.Macros as GM
@@ -22,111 +19,141 @@ import GF.Infra.UseIO (IOE)
 import GF.Data.Operations

 import Data.List
+import Data.Char
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Data.Array.IArray
+import Data.Maybe(fromMaybe)

+import GHC.Prim
+import GHC.Base(getTag)

-mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE D.PGF
-mkCanon2pgf opts gr am = do
-  (an,abs) <- mkAbstr am
-  cncs     <- mapM mkConcr (allConcretes gr am)
-  return $ updateProductionIndices (D.PGF Map.empty an abs (Map.fromList cncs))
+grammar2PGF :: Options -> SourceGrammar -> ModuleName -> Map.Map PGF2.Fun Double -> IO PGF
+grammar2PGF opts gr am probs = do
+  cnc_infos <- getConcreteInfos gr am
+  return $
+    build (let gflags   = if flag optSplitPGF opts 
+                            then [("split", LStr "true")]
+                            else []
+               (an,abs) = mkAbstr am probs
+               cncs     = map (mkConcr opts abs) cnc_infos
+           in newPGF gflags an abs cncs)
  where
    cenv = resourceValues opts gr
+    aflags = err (const noOptions) mflags (lookupModule gr am)

-    mkAbstr am = return (mi2i am, D.Abstr flags funs cats)
+    mkAbstr :: (?builder :: Builder s) => ModuleName -> Map.Map PGF2.Fun Double -> (AbsName, B s AbstrInfo)
+    mkAbstr am probs = (mi2i am, newAbstr flags cats funs)
      where
-        aflags = err (const noOptions) mflags (lookupModule gr am)
-
        adefs =
            [((cPredefAbs,c), AbsCat (Just (L NoLoc []))) | c <- [cFloat,cInt,cString]] ++ 
            Look.allOrigInfos gr am

-        flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF aflags]
+        flags = optionsPGF aflags

-        funs = Map.fromList [(i2i f, (mkType [] ty, arity, mkDef gr arity mdef, 0)) | 
+        toLogProb = realToFrac . negate . log
+
+        cats = [(c', snd (mkContext [] cont), toLogProb (fromMaybe 0 (Map.lookup c' probs))) |
+                                   ((m,c),AbsCat (Just (L _ cont))) <- adefs, let c' = i2i c]
+
+        funs = [(f', mkType [] ty, arity, bcode, toLogProb (fromMaybe 0 (Map.lookup f' funs_probs))) |
                                   ((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,
-                                   let arity = mkArity ma mdef ty]
+                                   let arity = mkArity ma mdef ty,
+                                   let bcode = mkDef gr arity mdef,
+                                   let f' = i2i f]
+                                   
+        funs_probs = (Map.fromList . concat . Map.elems . fmap pad . Map.fromListWith (++))
+                        [(i2i cat,[(i2i f,Map.lookup f' probs)]) | ((m,f),AbsFun (Just (L _ ty)) _ _ _) <- adefs,
+                                                                   let (_,(_,cat),_) = GM.typeForm ty,
+                                                                   let f' = i2i f]
+          where
+            pad :: [(a,Maybe Double)] -> [(a,Double)]
+            pad pfs = [(f,fromMaybe deflt mb_p) | (f,mb_p) <- pfs]
+              where
+                deflt = case length [f | (f,Nothing) <- pfs] of
+                          0 -> 0
+                          n -> max 0 ((1 - sum [d | (f,Just d) <- pfs]) / fromIntegral n)

-        cats = Map.fromList [(i2i c, (snd (mkContext [] cont),catfuns c, 0)) |
-                                   ((m,c),AbsCat (Just (L _ cont))) <- adefs]
-
-        catfuns cat =
-              [(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]
-
-    mkConcr cm = do
+    mkConcr opts abs (cm,ex_seqs,cdefs) =
      let cflags = err (const noOptions) mflags (lookupModule gr cm)
          ciCmp | flag optCaseSensitive cflags = compare
-                | otherwise                    = C.compareCaseInsensitve
+                | otherwise                    = compareCaseInsensitive

-      (ex_seqs,cdefs) <- addMissingPMCFGs
-                            Map.empty 
-                            ([((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]] ++
-                             Look.allOrigInfos gr cm)
+          flags = optionsPGF aflags

-      let flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF cflags]
-
-          seqs = (mkArray . C.sortNubBy ciCmp . concat) $
-                     (Map.keys ex_seqs : [maybe [] elems (mseqs mi) | (m,mi) <- allExtends gr cm])
-
-          ex_seqs_arr = mkMapArray ex_seqs :: Array SeqId Sequence
+          seqs = (mkSetArray . Set.fromList . concat) $
+                       (elems (ex_seqs :: Array SeqId [Symbol]) : [maybe [] elems (mseqs mi) | (m,mi) <- allExtends gr cm])

          !(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
+          cnccat_ranges = Map.fromList (map (\(cid,s,e,_) -> (cid,(s,e))) cnccats)
          !(!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 ciCmp seqs cdefs fid_cnt1 cnccat_ranges

          printnames = genPrintNames cdefs
-      return (mi2i cm, D.Concr flags
-                              printnames
-                              cncfuns
-                              lindefs
-                              linrefs
-                              seqs
-                              productions
-                              IntMap.empty
-                              Map.empty
-                              cnccats
-                              IntMap.empty
-                              fid_cnt2)
+
+          startCat = (fromMaybe "S" (flag optStartCat aflags))
+
+          (lindefs',linrefs',productions',cncfuns',sequences',cnccats') =
+               (if flag optOptimizePGF opts then optimizePGF startCat else id)
+                    (lindefs,linrefs,productions,cncfuns,elems seqs,cnccats)
+
+      in (mi2i cm, newConcr abs
+                            flags
+                            printnames
+                            lindefs'
+                            linrefs'
+                            productions'
+                            cncfuns'
+                            sequences'
+                            cnccats'
+                            fid_cnt2)
+
+    getConcreteInfos gr am = mapM flatten (allConcretes gr am)
      where
+        flatten cm = do
+          (seqs,infos) <- addMissingPMCFGs cm Map.empty
+                                           (lit_infos ++ Look.allOrigInfos gr cm)
+          return (cm,mkMapArray seqs :: Array SeqId [Symbol],infos)
+
+        lit_infos = [((cPredefAbs,c), CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing Nothing Nothing) | c <- [cInt,cFloat,cString]]
+
        -- if some module was compiled with -no-pmcfg, then
        -- we have to create the PMCFG code just before linking
-        addMissingPMCFGs seqs []                  = return (seqs,[])
-        addMissingPMCFGs seqs (((m,id), info):is) = do
-          (seqs,info) <- addPMCFG opts gr cenv Nothing am cm seqs id info
-          (seqs,is  ) <- addMissingPMCFGs seqs is
-          return (seqs, ((m,id), info) : is)
+        addMissingPMCFGs cm seqs []                  = return (seqs,[])
+        addMissingPMCFGs cm seqs (((m,id), info):is) = do
+          (seqs,info)  <- addPMCFG opts gr cenv Nothing am cm seqs id info
+          (seqs,infos) <- addMissingPMCFGs cm seqs is
+          return (seqs, ((m,id), info) : infos)

-i2i :: Ident -> CId
-i2i = utf8CId . ident2utf8
+i2i :: Ident -> String
+i2i = showIdent

-mi2i :: ModuleName -> CId
+mi2i :: ModuleName -> String
 mi2i (MN i) = i2i i

-mkType :: [Ident] -> A.Type -> C.Type
+mkType :: (?builder :: Builder s) => [Ident] -> A.Type -> B s PGF2.Type
 mkType scope t =
  case GM.typeForm t of
    (hyps,(_,cat),args) -> let (scope',hyps') = mkContext scope hyps
-                           in C.DTyp hyps' (i2i cat) (map (mkExp scope') args)
+                           in dTyp hyps' (i2i cat) (map (mkExp scope') args)

-mkExp :: [Ident] -> A.Term -> C.Expr
-mkExp scope t = 
+mkExp :: (?builder :: Builder s) => [Ident] -> A.Term -> B s Expr
+mkExp scope t =
  case t of
-    Q (_,c)  -> C.EFun (i2i c)
-    QC (_,c) -> C.EFun (i2i c)
+    Q (_,c)  -> eFun (i2i c)
+    QC (_,c) -> eFun (i2i c)
    Vr x     -> case lookup x (zip scope [0..]) of
-                  Just i  -> C.EVar  i
-                  Nothing -> C.EMeta 0
-    Abs b x t-> C.EAbs b (i2i x) (mkExp (x:scope) t)
-    App t1 t2-> C.EApp (mkExp scope t1) (mkExp scope t2)
-    EInt i   -> C.ELit (C.LInt (fromIntegral i))
-    EFloat f -> C.ELit (C.LFlt f)
-    K s      -> C.ELit (C.LStr s)
-    Meta i   -> C.EMeta i
-    _        -> C.EMeta 0
-
+                  Just i  -> eVar  i
+                  Nothing -> eMeta 0
+    Abs b x t-> eAbs b (i2i x) (mkExp (x:scope) t)
+    App t1 t2-> eApp (mkExp scope t1) (mkExp scope t2)
+    EInt i   -> eLit (LInt (fromIntegral i))
+    EFloat f -> eLit (LFlt f)
+    K s      -> eLit (LStr s)
+    Meta i   -> eMeta i
+    _        -> eMeta 0
+{-
 mkPatt scope p = 
  case p of
    A.PP (_,c) ps->let (scope',ps') = mapAccumL mkPatt scope ps
@@ -141,67 +168,64 @@ mkPatt scope p =
    A.PImplArg p-> let (scope',p') = mkPatt scope p
                   in (scope',C.PImplArg p')
    A.PTilde t  -> (  scope,C.PTilde (mkExp scope t))
-
-mkContext :: [Ident] -> A.Context -> ([Ident],[C.Hypo])
+-}
+mkContext :: (?builder :: Builder s) => [Ident] -> A.Context -> ([Ident],[B s PGF2.Hypo])
 mkContext scope hyps = mapAccumL (\scope (bt,x,ty) -> let ty' = mkType scope ty
                                                      in if x == identW
-                                                           then (  scope,(bt,i2i x,ty'))
-                                                           else (x:scope,(bt,i2i x,ty'))) scope hyps 
+                                                           then (  scope,hypo bt (i2i x) ty')
+                                                           else (x:scope,hypo bt (i2i x) ty')) scope hyps 

-mkDef gr arity (Just eqs) = Just ([C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
-                                 ,generateByteCode gr arity eqs
-                                 )
-mkDef gr arity Nothing    = Nothing
+mkDef gr arity (Just eqs) = generateByteCode gr arity eqs
+mkDef gr arity Nothing    = []

 mkArity (Just a) _        ty = a   -- known arity, i.e. defined function
 mkArity Nothing  (Just _) ty = 0   -- defined function with no arity - must be an axiom
 mkArity Nothing  _        ty = let (ctxt, _, _) = GM.typeForm ty  -- constructor
                               in length ctxt

-genCncCats gr am cm cdefs =
-  let (index,cats) = mkCncCats 0 cdefs
-  in (index, Map.fromList cats)
+genCncCats gr am cm cdefs = mkCncCats 0 cdefs
  where
    mkCncCats index []                                                = (index,[])
    mkCncCats index (((m,id),CncCat (Just (L _ lincat)) _ _ _ _):cdefs) 
      | id == cInt    = 
-            let cc            = pgfCncCat gr lincat fidInt
+            let cc            = pgfCncCat gr (i2i id) lincat fidInt
                (index',cats) = mkCncCats index cdefs
-            in (index', (i2i id,cc) : cats)
+            in (index', cc : cats)
      | id == cFloat  = 
-            let cc            = pgfCncCat gr lincat fidFloat
+            let cc            = pgfCncCat gr (i2i id) lincat fidFloat
                (index',cats) = mkCncCats index cdefs
-            in (index', (i2i id,cc) : cats)
+            in (index', cc : cats)
      | id == cString = 
-            let cc            = pgfCncCat gr lincat fidString
+            let cc            = pgfCncCat gr (i2i id) lincat fidString
                (index',cats) = mkCncCats index cdefs
-            in (index', (i2i id,cc) : cats)
+            in (index', cc : cats)
      | otherwise     =
-            let cc@(C.CncCat _s e _) = pgfCncCat gr lincat index
-                (index',cats)        = mkCncCats (e+1) cdefs
-            in (index', (i2i id,cc) : cats)
-    mkCncCats index (_                      :cdefs) = mkCncCats index cdefs
+            let cc@(_, _s, e, _) = pgfCncCat gr (i2i id) lincat index
+                (index',cats)    = mkCncCats (e+1) cdefs
+            in (index', cc : cats)
+    mkCncCats index (_                                          :cdefs) = mkCncCats index cdefs

 genCncFuns :: Grammar
           -> ModuleName
           -> ModuleName
-           -> Array SeqId Sequence
-           -> (Sequence -> Sequence -> Ordering)
-           -> Array SeqId Sequence
+           -> Array SeqId [Symbol]
+           -> ([Symbol] -> [Symbol] -> Ordering)
+           -> Array SeqId [Symbol]
           -> [(QIdent, Info)]
           -> FId
-           -> Map.Map CId D.CncCat
+           -> Map.Map PGF2.Cat (Int,Int)
           -> (FId,
-               IntMap.IntMap (Set.Set D.Production),
-               IntMap.IntMap [FunId],
-               IntMap.IntMap [FunId],
-               Array FunId D.CncFun)
-genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
+               [(FId, [Production])],
+               [(FId, [FunId])],
+               [(FId, [FunId])],
+               [(PGF2.Fun,[SeqId])])
+genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccat_ranges =
  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)
+      (fid_cnt2,funs_cnt2,funs2,prods0)          = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
+      prods                                      = [(fid,Set.toList prodSet) | (fid,prodSet) <- IntMap.toList prods0]
+  in (fid_cnt2,prods,IntMap.toList lindefs,IntMap.toList linrefs,reverse funs2)
  where
-    mkCncCats []                                                        fid_cnt funs_cnt funs lindefs linrefs =
+    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
@@ -210,17 +234,16 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
          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 cdefs fid_cnt funs_cnt funs lindefs linrefs

    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)
+      let 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') 
+          !(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)
@@ -228,23 +251,23 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
    mkCncFuns (_                                                :cdefs) fid_cnt funs_cnt funs lindefs crc prods = 
      mkCncFuns cdefs fid_cnt funs_cnt funs lindefs crc prods

-    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))
+    toProd lindefs (ctxt_C,res_C,_) offs st (A.Production fid0 funid0 args0) =
+      let !((fid_cnt,crc,prods),args) = mapAccumL mkArg st (zip ctxt_C args0)
+          set0    = Set.fromList (map (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')
      where
-        mkArg st@(fid_cnt,crc,prods) ((_,_,ty),fid0s ) =
+        mkArg st@(fid_cnt,crc,prods) ((_,_,ty),fid0s) =
          case fid0s of
-            [fid0] -> (st,map (flip C.PArg (mkFId arg_C fid0)) ctxt)
+            [fid0] -> (st,map (flip PArg (mkFId arg_C fid0)) ctxt)
            fid0s  -> case Map.lookup fids crc of
-                        Just fid -> (st,map (flip C.PArg fid) ctxt)
+                        Just fid -> (st,map (flip PArg fid) ctxt)
                        Nothing  -> let !crc'   = Map.insert fids fid_cnt crc
-                                        !prods' = IntMap.insert fid_cnt (Set.fromList (map C.PCoerce fids)) prods
-                                    in ((fid_cnt+1,crc',prods'),map (flip C.PArg fid_cnt) ctxt)
+                                        !prods' = IntMap.insert fid_cnt (Set.fromList (map PCoerce fids)) prods
+                                    in ((fid_cnt+1,crc',prods'),map (flip PArg fid_cnt) ctxt)
          where
            (hargs_C,arg_C) = GM.catSkeleton ty
            ctxt = mapM (mkCtxt lindefs) hargs_C
@@ -252,14 +275,14 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =

    mkLinDefId id = prefixIdent "lindef " id

-    toLinDef res offs lindefs (Production fid0 funid0 args) =
+    toLinDef res offs lindefs (A.Production fid0 funid0 args) =
      if args == [[fidVar]]
        then IntMap.insertWith (++) fid [offs+funid0] lindefs
        else lindefs
      where
        fid = mkFId res fid0

-    toLinRef res offs linrefs (Production fid0 funid0 [fargs]) =
+    toLinRef res offs linrefs (A.Production fid0 funid0 [fargs]) =
      if fid0 == fidVar
        then foldr (\fid -> IntMap.insertWith (++) fid [offs+funid0]) linrefs fids
        else linrefs
@@ -267,20 +290,20 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
        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)
+      case Map.lookup (i2i cat) cnccat_ranges of
+        Just (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"
+      case Map.lookup (i2i cat) cnccat_ranges of
+        Just (s,e) -> [(fid,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                                          
+      in (i2i id, map (newIndex mseqs) (elems lins0)):funs
      where
        newIndex mseqs i = binSearch (mseqs ! i) seqs (bounds seqs)

@@ -293,8 +316,9 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
          where
            k = (i+j) `div` 2

+
 genPrintNames cdefs =
-  Map.fromAscList [(i2i id, name) | ((m,id),info) <- cdefs, name <- prn info]
+  [(i2i id, name) | ((m,id),info) <- cdefs, name <- prn info]
  where
    prn (CncFun _ _   (Just (L _ tr)) _) = [flatten tr]
    prn (CncCat _ _ _ (Just (L _ tr)) _) = [flatten tr]
@@ -306,3 +330,118 @@ genPrintNames cdefs =

 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) (Set.toList set)
+
+-- The following is a version of Data.List.sortBy which together
+-- with the sorting also eliminates duplicate values 
+sortNubBy cmp = mergeAll . sequences
+  where
+    sequences (a:b:xs) =
+      case cmp a b of
+        GT -> descending b [a]  xs
+        EQ -> sequences (b:xs)
+        LT -> ascending  b (a:) xs
+    sequences xs = [xs]
+
+    descending a as []     = [a:as]
+    descending a as (b:bs) =
+      case cmp a b of
+        GT -> descending b (a:as) bs
+        EQ -> descending a as bs
+        LT -> (a:as) : sequences (b:bs)
+
+    ascending a as []     = let !x = as [a]
+                            in [x]
+    ascending a as (b:bs) =
+      case cmp a b of
+        GT -> let !x = as [a]
+              in x : sequences (b:bs)
+        EQ -> ascending a as bs
+        LT -> ascending b (\ys -> as (a:ys)) bs
+
+    mergeAll [x] = x
+    mergeAll xs  = mergeAll (mergePairs xs)
+
+    mergePairs (a:b:xs) = let !x = merge a b
+                          in x : mergePairs xs
+    mergePairs xs       = xs
+
+    merge as@(a:as') bs@(b:bs') =
+      case cmp a b of
+        GT -> b:merge as  bs'
+        EQ -> a:merge as' bs'
+        LT -> a:merge as' bs
+    merge [] bs         = bs
+    merge as []         = as
+
+-- The following function does case-insensitive comparison of sequences.
+-- This is used to allow case-insensitive parsing, while
+-- the linearizer still has access to the original cases.
+
+compareCaseInsensitive []     []     = EQ
+compareCaseInsensitive []     _      = LT
+compareCaseInsensitive _      []     = GT
+compareCaseInsensitive (x:xs) (y:ys) =
+  case compareSym x y of
+    EQ -> compareCaseInsensitive xs ys
+    x  -> x
+  where
+    compareSym s1 s2 =
+      case s1 of
+        SymCat d1 r1
+          -> case s2 of
+               SymCat d2 r2
+                 -> case compare d1 d2 of
+                      EQ -> r1 `compare` r2
+                      x  -> x
+               _ -> LT
+        SymLit d1 r1
+          -> case s2 of
+               SymCat {} -> GT
+               SymLit d2 r2
+                 -> case compare d1 d2 of
+                      EQ -> r1 `compare` r2
+                      x  -> x
+               _ -> LT
+        SymVar d1 r1
+          -> if tagToEnum# (getTag s2 ># 2#)
+               then LT
+               else case s2 of
+                      SymVar d2 r2
+                        -> case compare d1 d2 of
+                             EQ -> r1 `compare` r2
+                             x  -> x
+                      _ -> GT
+        SymKS t1
+          -> if tagToEnum# (getTag s2 ># 3#)
+               then LT
+               else case s2 of
+                      SymKS t2 -> t1 `compareToken` t2
+                      _          -> GT
+        SymKP a1 b1
+          -> if tagToEnum# (getTag s2 ># 4#)
+               then LT
+               else case s2 of
+                      SymKP a2 b2
+                        -> case compare a1 a2 of
+                             EQ -> b1 `compare` b2
+                             x  -> x
+                      _ -> GT
+        _ -> let t1 = getTag s1
+                 t2 = getTag s2
+             in if tagToEnum# (t1 <# t2) 
+                  then LT
+                  else if tagToEnum# (t1 ==# t2)
+                         then EQ
+                         else GT
+  
+    compareToken []     []     = EQ
+    compareToken []     _      = LT
+    compareToken _      []     = GT
+    compareToken (x:xs) (y:ys)
+      | x == y    = compareToken xs ys
+      | otherwise = case compare (toLower x) (toLower y) of
+                      EQ -> case compareToken xs ys of
+                              EQ -> compare x y
+                              x  -> x
+                      x  -> x
--- a/src/compiler/GF/Compile/OptimizePGF.hs
+++ b/src/compiler/GF/Compile/OptimizePGF.hs
@@ -0,0 +1,189 @@
+{-# LANGUAGE BangPatterns #-}
+module GF.Compile.OptimizePGF(optimizePGF) where
+
+import PGF2(Cat,Fun)
+import PGF2.Internal
+import Data.Array.ST
+import Data.Array.Unboxed
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.IntSet as IntSet
+import qualified Data.IntMap as IntMap
+import qualified Data.List as List
+import Control.Monad.ST
+
+type ConcrData = ([(FId,[FunId])],          -- ^ Lindefs
+                  [(FId,[FunId])],          -- ^ Linrefs
+                  [(FId,[Production])],     -- ^ Productions
+                  [(Fun,[SeqId])],          -- ^ Concrete functions   (must be sorted by Fun)
+                  [[Symbol]],               -- ^ Sequences            (must be sorted)
+                  [(Cat,FId,FId,[String])]) -- ^ Concrete categories
+
+optimizePGF :: Cat -> ConcrData -> ConcrData
+optimizePGF startCat = topDownFilter startCat . bottomUpFilter
+
+catString = "String"
+catInt    = "Int"
+catFloat  = "Float"
+catVar    = "__gfVar"
+
+topDownFilter :: Cat -> ConcrData -> ConcrData
+topDownFilter startCat (lindefs,linrefs,prods,cncfuns,sequences,cnccats) =
+  let env0             = (Map.empty,Map.empty)
+      (env1,lindefs')  = List.mapAccumL (\env (fid,funids) -> let (env',funids') = List.mapAccumL (optimizeFun fid [PArg [] fidVar]) env funids in (env',(fid,funids')))
+                                        env0
+                                        lindefs
+      (env2,linrefs')  = List.mapAccumL (\env (fid,funids) -> let (env',funids') = List.mapAccumL (optimizeFun fidVar [PArg [] fid]) env funids in (env',(fid,funids')))
+                                        env1
+                                        linrefs
+      (env3,prods')    = List.mapAccumL (\env (fid,set)    -> let (env',set') = List.mapAccumL (optimizeProd fid) env set in (env',(fid,set')))
+                                        env2
+                                        prods
+      cnccats' = map filterCatLabels cnccats
+      (sequences',cncfuns') = env3
+  in (lindefs',linrefs',prods',mkSetArray cncfuns',mkSetArray  sequences',cnccats')
+  where
+    cncfuns_array   = listArray (0,length cncfuns-1)   cncfuns   :: Array FunId (Fun, [SeqId])
+    sequences_array = listArray (0,length sequences-1) sequences :: Array SeqId [Symbol]
+    prods_map  = IntMap.fromList prods
+    fid2catMap = IntMap.fromList ((fidVar,catVar) :  [(fid,cat) | (cat,start,end,lbls) <- cnccats,
+                                                                  fid <- [start..end]])
+
+    fid2cat fid =
+      case IntMap.lookup fid fid2catMap of
+        Just cat -> cat
+        Nothing  -> case [fid | Just set <- [IntMap.lookup fid prods_map], PCoerce fid <- set] of
+                      (fid:_) -> fid2cat fid
+                      _       -> error "unknown forest id"
+
+    starts =
+      [(startCat,lbl) | (cat,_,_,lbls) <- cnccats, cat==startCat, lbl <- [0..length lbls-1]]
+
+    allRelations =
+      Map.unionsWith Set.union
+                     [rel fid prod | (fid,set) <- prods, prod <- set]
+      where
+        rel fid (PApply funid args) = Map.fromList [((fid2cat fid,lbl),deps args seqid) | (lbl,seqid) <- zip [0..] lin]
+          where
+            (_,lin) = cncfuns_array ! funid
+        rel fid _                   = Map.empty
+
+        deps args seqid = Set.fromList [let PArg _ fid = args !! r in (fid2cat fid,d) | SymCat r d <- seq]
+          where
+            seq = sequences_array ! seqid
+
+    -- here we create a mapping from a category to an array of indices.
+    -- An element of the array is equal to -1 if the corresponding index
+    -- is not going to be used in the optimized grammar, or the new index
+    -- if it will be used
+    closure :: Map.Map Cat [Int]
+    closure = runST $ do
+      set <- initSet
+      addLitCat catString set
+      addLitCat catInt    set
+      addLitCat catFloat  set
+      addLitCat catVar    set
+      closureSet set starts
+      doneSet set
+      where
+        initSet :: ST s (Map.Map Cat (STUArray s Int Int))
+        initSet =
+          fmap Map.fromList $ sequence
+                        [fmap ((,) cat) (newArray (0,length lbls-1) (-1))
+                                             | (cat,_,_,lbls) <- cnccats]
+
+        addLitCat cat set =
+          case Map.lookup cat set of
+            Just indices -> writeArray indices 0 0
+            Nothing      -> return ()
+
+        closureSet set []                 = return ()
+        closureSet set (x@(cat,index):xs) =
+          case Map.lookup cat set of
+            Just indices -> do v <- readArray indices index
+                               writeArray indices index 0
+                               if v < 0
+                                 then case Map.lookup x allRelations of
+                                        Just ys -> closureSet set (Set.toList ys++xs)
+                                        Nothing -> closureSet set xs
+                                 else closureSet set xs
+            Nothing      -> error "unknown cat"
+
+        doneSet :: Map.Map Cat (STUArray s Int Int) -> ST s (Map.Map Cat [Int])
+        doneSet set =
+          fmap Map.fromAscList $ mapM done (Map.toAscList set)
+          where
+            done (cat,indices) = do
+              indices <- fmap (reindex 0) (getElems indices)
+              return (cat,indices)
+
+            reindex k []     = []
+            reindex k (v:vs)
+              | v < 0        = v : reindex k     vs
+              | otherwise    = k : reindex (k+1) vs
+
+    optimizeProd res env (PApply funid args) =
+      let (env',funid') = optimizeFun res args env funid
+      in (env', PApply funid' args)
+    optimizeProd res env prod = (env,prod)
+
+    optimizeFun res args (seqs,funs) funid =
+      let (seqs',lin')   = List.mapAccumL addUnique seqs [map updateSymbol (sequences_array ! seqid) | 
+                                                                   (idx,seqid) <- zip (indicesOf res) lin, idx >= 0]
+          (funs',funid') = addUnique funs (fun, lin')
+      in ((seqs',funs'), funid')
+      where
+        (fun,lin) = cncfuns_array ! funid
+
+        indicesOf fid
+          | fid < 0   = [0]
+          | otherwise =
+              case Map.lookup (fid2cat fid) closure of
+                Just indices -> indices
+                Nothing      -> error "unknown category"
+
+        addUnique seqs seq =
+          case Map.lookup seq seqs of
+            Just seqid -> (seqs,seqid)
+            Nothing    -> let seqid = Map.size seqs
+                          in (Map.insert seq seqid seqs, seqid)
+
+        updateSymbol (SymCat r d) = let PArg _ fid = args !! r in SymCat r (indicesOf fid !! d)
+        updateSymbol s            = s
+
+    filterCatLabels (cat,start,end,lbls) =
+      case Map.lookup cat closure of
+        Just indices -> let lbls' = [lbl | (idx,lbl) <- zip indices lbls, idx >= 0]
+                        in (cat,start,end,lbls')
+        Nothing      -> error ("unknown category")
+
+    mkSetArray map = sortSnd (Map.toList map)
+      where
+        sortSnd = List.map fst . List.sortBy (\(_,i) (_,j) -> compare i j)
+
+
+bottomUpFilter :: ConcrData -> ConcrData
+bottomUpFilter (lindefs,linrefs,prods,cncfuns,sequences,cnccats) =
+  (lindefs,linrefs,filterProductions IntMap.empty IntSet.empty prods,cncfuns,sequences,cnccats)
+
+filterProductions prods0 hoc0 prods
+  | prods0 == prods1 = IntMap.toList prods0
+  | otherwise        = filterProductions prods1 hoc1 prods
+  where
+    (prods1,hoc1) = foldl foldProdSet (IntMap.empty,IntSet.empty) prods
+
+    foldProdSet (!prods,!hoc) (fid,set)
+      | null set1 = (prods,hoc)
+      | otherwise = (IntMap.insert fid set1 prods,hoc1)
+      where
+        set1 = filter filterRule set
+        hoc1 = foldl accumHOC hoc set1
+
+    filterRule (PApply funid args) = all (\(PArg _ fid) -> isLive fid) args
+    filterRule (PCoerce fid)       = isLive fid
+    filterRule _                   = True
+
+    isLive fid = isPredefFId fid || IntMap.member fid prods0 || IntSet.member fid hoc0
+
+    accumHOC hoc (PApply funid args) = List.foldl' (\hoc (PArg hypos _) -> List.foldl' (\hoc fid -> IntSet.insert fid hoc) hoc (map snd hypos)) hoc args
+    accumHOC hoc _                   = hoc
--- a/src/compiler/GF/Compile/PGFtoHaskell.hs
+++ b/src/compiler/GF/Compile/PGFtoHaskell.hs
@@ -16,68 +16,61 @@

 module GF.Compile.PGFtoHaskell (grammar2haskell) where

-import PGF(showCId)
-import PGF.Internal
+import PGF2
+import PGF2.Internal

 import GF.Data.Operations
 import GF.Infra.Option

-import Data.List --(isPrefixOf, find, intersperse)
+import Data.List
+import Data.Maybe(mapMaybe)
 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 ++
-  [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
          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 #-}"]
                  | otherwise = []
-          derivingClause
-                 | dataExt = "deriving (Show,Data)"
-                 | otherwise = "deriving Show"
-          extraImports | gadt = ["import Control.Monad.Identity",
-                                 "import Data.Monoid"]
-                       | dataExt = ["import Data.Data"]
-                       | otherwise = []
          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 gadt name derivingClause extraImports =
+haskPreamble gadt name =
 [
  "module " ++ name ++ " where",
  ""
- ] ++ extraImports ++ [
+ ] ++
+ (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",
@@ -85,11 +78,11 @@ haskPreamble gadt name derivingClause extraImports =
  ""
 ]

-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" ++++
@@ -102,24 +95,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


-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 []
@@ -249,7 +242,7 @@ fInstance gId lexical m (cat,rules) =
    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] ++++
-  (if lexical cat then "      Just (i,[]) -> " ++ lexicalConstructor cat +++ "(showCId i)" else "") ++++
+  (if lexical cat then "      Just (i,[]) -> " ++ lexicalConstructor cat +++ "i" else "") ++++
  "      _ -> error (\"no" +++ cat ++ " \" ++ show t)"
   where
    isList = isListCat (cat,rules)
@@ -270,18 +263,21 @@ fInstance gId lexical m (cat,rules) =
 --type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
 hSkeleton :: PGF -> (String,HSkeleton)
 hSkeleton gr = 
-  (showCId (absname gr), 
+  (abstractName 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, notElem sc (["Int", "Float", "String"] ++ map fst fs)]
+         [(c, [(f, cs) | (f, cs,_) <- fs]) | 
+                                        fs@((_, _,c):_) <- fns]
+   in fs ++ [(c, []) | c <- cts, notElem c (["Int", "Float", "String"] ++ map fst fs)]
  )
 where
-   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)
+   cts = categories gr
+   fns = groupBy valtypg (sortBy valtyps (mapMaybe jty (functions gr)))
+   valtyps (_,_,x) (_,_,y) = compare x y
+   valtypg (_,_,x) (_,_,y) = x == y
+   jty f = case functionType gr f of
+             Just ty -> let (hypos,valcat,_) = unType ty
+                        in Just (f,[argcat | (_,_,ty) <- hypos, let (_,argcat,_) = unType ty],valcat)
+             Nothing -> Nothing
 {-
 updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
 updateSkeleton cat skel rule =
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -1,105 +0,0 @@
-module GF.Compile.PGFtoJS (pgf2js) where
-
-import PGF(showCId)
-import PGF.Internal as M
-import qualified GF.JavaScript.AbsJS as JS
-import qualified GF.JavaScript.PrintJS as JS
-
--import GF.Data.ErrM
--import GF.Infra.Option
-
--import Control.Monad (mplus)
--import Data.Array.Unboxed (UArray)
-import qualified Data.Array.IArray as Array
--import Data.Maybe (fromMaybe)
-import Data.Map (Map)
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
-
-pgf2js :: PGF -> String
-pgf2js pgf =
-  JS.printTree $ JS.Program [JS.ElStmt $ JS.SDeclOrExpr $ JS.Decl [JS.DInit (JS.Ident n) grammar]]
- where
-   n  = showCId $ absname pgf
-   as = abstract pgf
-   cs = Map.assocs (concretes pgf)
-   start = showCId $ M.lookStartCat pgf
-   grammar = new "GFGrammar" [js_abstract, js_concrete]
-   js_abstract = abstract2js start as
-   js_concrete = JS.EObj $ map concrete2js cs
-
-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,_,_,_)) =
-  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)])
-
-lit2js (LStr s) = JS.EStr s
-lit2js (LInt n) = JS.EInt n
-lit2js (LFlt d) = JS.EDbl d
-
-concrete2js :: (CId,Concr) -> JS.Property
-concrete2js (c,cnc) =
-  JS.Prop l (new "GFConcrete" [mapToJSObj (lit2js) $ cflags cnc,
-                               JS.EObj $ [JS.Prop (JS.IntPropName cat) (JS.EArray (map frule2js (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)],
-                               JS.EArray $ (map ffun2js (Array.elems (cncfuns cnc))),
-                               JS.EArray $ (map seq2js (Array.elems (sequences cnc))),
-                               JS.EObj $ map cats (Map.assocs (cnccats cnc)),
-                               JS.EInt (totalCats cnc)])
-  where 
-   l  = JS.IdentPropName (JS.Ident (showCId c))
-{-
-   litslins = [JS.Prop (JS.StringPropName    "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), 
-               JS.Prop (JS.StringPropName  "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
-               JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
-}
-   cats (c,CncCat start end _) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
-                                                                                            ,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
-{-
-mkStr :: String -> JS.Expr
-mkStr s = new "Str" [JS.EStr s]
-
-mkSeq :: [JS.Expr] -> JS.Expr
-mkSeq [x] = x
-mkSeq xs = new "Seq" xs
-
-argIdent :: Integer -> JS.Ident
-argIdent n = JS.Ident ("x" ++ show n)
-}
-children :: JS.Ident
-children = JS.Ident "cs"
-
-frule2js :: Production -> JS.Expr
-frule2js (PApply funid args) = new "Apply"  [JS.EInt funid, JS.EArray (map farg2js args)]
-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))]
-
-seq2js :: Array.Array DotPos Symbol -> JS.Expr
-seq2js seq = JS.EArray [sym2js s | s <- Array.elems seq]
-
-sym2js :: Symbol -> JS.Expr
-sym2js (SymCat n l)    = new "SymCat" [JS.EInt n, JS.EInt l]
-sym2js (SymLit n l)    = new "SymLit" [JS.EInt n, JS.EInt l]
-sym2js (SymVar n l)    = new "SymVar" [JS.EInt n, JS.EInt l]
-sym2js (SymKS t)       = new "SymKS"  [JS.EStr t]
-sym2js (SymKP ts alts) = new "SymKP"  [JS.EArray (map sym2js ts), JS.EArray (map alt2js alts)]
-sym2js SymBIND         = new "SymKS"  [JS.EStr "&+"]
-sym2js SymSOFT_BIND    = new "SymKS"  [JS.EStr "&+"]
-sym2js SymSOFT_SPACE   = new "SymKS"  [JS.EStr "&+"]
-sym2js SymCAPIT        = new "SymKS"  [JS.EStr "&|"]
-sym2js SymALL_CAPIT    = new "SymKS"  [JS.EStr "&|"]
-sym2js SymNE           = new "SymNE"  []
-
-alt2js (ps,ts) = new "Alt" [JS.EArray (map sym2js ps), JS.EArray (map JS.EStr ts)]
-
-new :: String -> [JS.Expr] -> JS.Expr
-new f xs = JS.ENew (JS.Ident f) xs
-
-mapToJSObj :: (a -> JS.Expr) -> Map CId a -> JS.Expr
-mapToJSObj f m = JS.EObj [ JS.Prop (JS.IdentPropName (JS.Ident (showCId k))) (f v) | (k,v) <- Map.toList m ]
--- a/src/compiler/GF/Compile/PGFtoJSON.hs
+++ b/src/compiler/GF/Compile/PGFtoJSON.hs
@@ -1,156 +1,110 @@
 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 PGF2
+import PGF2.Internal
+import Text.JSON
 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)))
+  encode $ makeObj
+    [ ("abstract", abstract2json pgf)
+    , ("concretes", makeObj $ map concrete2json
+                                (Map.toList (languages pgf)))
    ]

-absdef2json :: (CId,(Type,Int,Maybe ([Equation],[[M.Instr]]),Double)) -> (String,JSValue)
-absdef2json (f,(typ,_,_,_)) = (showCId f,sig)
+abstract2json :: PGF -> JSValue
+abstract2json pgf =
+  makeObj
+    [ ("name", showJSON (abstractName pgf))
+    , ("startcat", showJSON (showType [] (startCat pgf)))
+    , ("funs", makeObj $ map (absdef2json pgf) (functions pgf))
+    ]
+
+absdef2json :: PGF -> Fun -> (String,JSValue)
+absdef2json pgf f = (f,sig)
  where
-    (args,cat) = M.catSkeleton typ
-    sig = JSON.makeObj
-      [ ("args", JSArray $ map (mkJSStr.showCId) args)
-      , ("cat", mkJSStr $ showCId cat)
+    Just (hypos,cat,_) = fmap unType (functionType pgf f)
+    sig = makeObj
+      [ ("args", showJSON $ map (\(_,_,ty) -> showType [] ty) hypos)
+      , ("cat", showJSON cat)
      ]

 lit2json :: Literal -> JSValue
-lit2json (LStr s) = mkJSStr s
-lit2json (LInt n) = mkJSInt n
-lit2json (LFlt d) = JSRational True (toRational d)
+lit2json (LStr s) = showJSON s
+lit2json (LInt n) = showJSON n
+lit2json (LFlt d) = showJSON d

-concrete2json :: (CId,Concr) -> (String,JSValue)
-concrete2json (c,cnc) = (showCId c,obj)
+concrete2json :: (ConcName,Concr) -> (String,JSValue)
+concrete2json (c,cnc) = (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))
+    obj = makeObj
+      [ ("flags", makeObj [(k, lit2json v) | (k,v) <- concrFlags cnc])
+      , ("productions", makeObj [(show fid, showJSON (map frule2json (concrProductions cnc fid))) | (_,start,end,_) <- concrCategories cnc, fid <- [start..end]])
+      , ("functions", showJSON [ffun2json funid (concrFunction cnc funid) | funid <- [0..concrTotalFuns cnc-1]])
+      , ("sequences", showJSON [seq2json seqid (concrSequence cnc seqid) | seqid <- [0..concrTotalSeqs cnc-1]])
+      , ("categories", makeObj $ map cat2json (concrCategories cnc))
+      , ("totalfids", showJSON (concrTotalCats cnc))
      ]

-cats2json :: (CId, CncCat) -> (String,JSValue)
-cats2json (c,CncCat start end _) = (showCId c, ixs)
+cat2json :: (Cat,FId,FId,[String]) -> (String,JSValue)
+cat2json (cat,start,end,_) = (cat, ixs)
  where
-    ixs = JSON.makeObj
-      [ ("start", mkJSInt start)
-      , ("end", mkJSInt end)
+    ixs = makeObj
+      [ ("start", showJSON start)
+      , ("end",   showJSON end)
      ]

 frule2json :: Production -> JSValue
 frule2json (PApply fid args) =
-  JSON.makeObj
-    [ ("type", mkJSStr "Apply")
-    , ("fid", mkJSInt fid)
-    , ("args", JSArray (map farg2json args))
+  makeObj
+    [ ("type", showJSON "Apply")
+    , ("fid",  showJSON fid)
+    , ("args", showJSON (map farg2json args))
    ]
 frule2json (PCoerce arg) =
-  JSON.makeObj
-    [ ("type", mkJSStr "Coerce")
-    , ("arg", mkJSInt arg)
+  makeObj
+    [ ("type", showJSON "Coerce")
+    , ("arg",  showJSON arg)
    ]

 farg2json :: PArg -> JSValue
 farg2json (PArg hypos fid) =
-  JSON.makeObj
-    [ ("type", mkJSStr "PArg")
-    , ("hypos", JSArray $ map (mkJSInt . snd) hypos)
-    , ("fid", mkJSInt fid)
+  makeObj
+    [ ("type", showJSON "PArg")
+    , ("hypos", JSArray $ map (showJSON . snd) hypos)
+    , ("fid", showJSON fid)
    ]

-ffun2json :: CncFun -> JSValue
-ffun2json (CncFun f lins) =
-  JSON.makeObj
-    [ ("name", mkJSStr $ showCId f)
-    , ("lins", JSArray (map mkJSInt (Array.elems lins)))
+ffun2json :: FunId -> (Fun,[SeqId]) -> JSValue
+ffun2json funid (fun,seqids) =
+  makeObj
+    [ ("name", showJSON fun)
+    , ("lins", showJSON seqids)
    ]

-seq2json :: Array.Array DotPos Symbol -> JSValue
-seq2json seq = JSArray [sym2json s | s <- Array.elems seq]
+seq2json :: SeqId -> [Symbol] -> JSValue
+seq2json seqid seq = showJSON [sym2json sym | sym <- 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 (SymCat n l)    = new "SymCat" [showJSON n, showJSON l]
+sym2json (SymLit n l)    = new "SymLit" [showJSON n, showJSON l]
+sym2json (SymVar n l)    = new "SymVar" [showJSON n, showJSON l]
+sym2json (SymKS t)       = new "SymKS"  [showJSON 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 SymBIND         = new "SymKS"  [showJSON "&+"]
+sym2json SymSOFT_BIND    = new "SymKS"  [showJSON "&+"]
+sym2json SymSOFT_SPACE   = new "SymKS"  [showJSON "&+"]
+sym2json SymCAPIT        = new "SymKS"  [showJSON "&|"]
+sym2json SymALL_CAPIT    = new "SymKS"  [showJSON "&|"]
 sym2json SymNE           = new "SymNE"  []

 alt2json :: ([Symbol],[String]) -> JSValue
-alt2json (ps,ts) = new "Alt" [JSArray (map sym2json ps), JSArray (map mkJSStr ts)]
+alt2json (ps,ts) = new "Alt" [showJSON (map sym2json ps), showJSON ts]

 new :: String -> [JSValue] -> JSValue
 new f xs =
-  JSON.makeObj
-    [ ("type", mkJSStr f)
-    , ("args", JSArray xs)
+  makeObj
+    [ ("type", showJSON f)
+    , ("args", showJSON 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
--- a/src/compiler/GF/Compile/PGFtoJava.hs
+++ b/src/compiler/GF/Compile/PGFtoJava.hs
@@ -1,6 +1,6 @@
 module GF.Compile.PGFtoJava (grammar2java) where

-import PGF
+import PGF2
 import Data.Maybe(maybe)
 import Data.List(intercalate)
 import GF.Infra.Option
@@ -24,9 +24,8 @@ javaPreamble name =
 ]
 
 javaMethod gr fun =
-  "  public static Expr "++name++"("++arg_decls++") { return new Expr("++show name++args++"); }"
+  "  public static Expr "++fun++"("++arg_decls++") { return new Expr("++show fun++args++"); }"
  where
-    name  = showCId fun
    arity = maybe 0 getArrity (functionType gr fun)
    vars  = ['e':show i | i <- [1..arity]]
    
--- a/src/compiler/GF/Compile/PGFtoProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoProlog.hs
@@ -1,262 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : PGFtoProlog
-- Maintainer  : Peter Ljunglöf
--
-- exports a GF grammar into a Prolog module
-----------------------------------------------------------------------------
-
-module GF.Compile.PGFtoProlog (grammar2prolog) where
-
-import PGF(mkCId,wildCId,showCId)
-import PGF.Internal
--import PGF.Macros
-
-import GF.Data.Operations
-
-import qualified Data.Array.IArray as Array
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
-import Data.Char (isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, ord)
-import Data.List (isPrefixOf, mapAccumL)
-
-grammar2prolog :: PGF -> String
-grammar2prolog pgf
-    = ("%% This file was automatically generated by GF" +++++
-       ":- style_check(-singleton)." +++++
-       plFacts wildCId "abstract" 1 "(?AbstractName)"
-                   [[plp name]] ++++
-       plFacts wildCId "concrete" 2 "(?AbstractName, ?ConcreteName)" 
-                   [[plp name, plp cncname] | 
-                    cncname <- Map.keys (concretes pgf)] ++++
-       plFacts wildCId "flag" 2 "(?Flag, ?Value): global flags" 
-                   [[plp f, plp v] | 
-                    (f, v) <- Map.assocs (gflags pgf)] ++++
-       plAbstract name (abstract pgf) ++++
-       unlines (map plConcrete (Map.assocs (concretes pgf)))
-      )
-    where name = absname pgf
-
----------------------------------------------------------------------
-- abstract syntax
-
-plAbstract :: CId -> Abstr -> String
-plAbstract name abs 
-    = (plHeader "Abstract syntax" ++++
-       plFacts name "flag" 2 "(?Flag, ?Value): flags for abstract syntax"
-                   [[plp f, plp v] | 
-                    (f, v) <- Map.assocs (aflags abs)] ++++
-       plFacts name "cat" 2 "(?Type, ?[X:Type,...])"
-                   [[plType cat args, plHypos hypos'] |
-                    (cat, (hypos,_,_)) <- Map.assocs (cats abs),
-                    let ((_, subst), hypos') = mapAccumL alphaConvertHypo emptyEnv hypos,
-                        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),
-                    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),
-                    let (_, expr) = alphaConvert emptyEnv eqs]
-      )
-    where plType cat args = plTerm (plp cat) (map plp args)
-          plHypos hypos = plList [plOper ":" (plp x) (plp ty) | (_, x, ty) <- hypos]
-
----------------------------------------------------------------------
-- concrete syntax
-
-plConcrete :: (CId, Concr) -> String
-plConcrete (name, cnc) 
-    = (plHeader ("Concrete syntax: " ++ plp name) ++++
-       plFacts name "flag" 2 "(?Flag, ?Value): flags for concrete syntax"
-                   [[plp f, plp v] | 
-                    (f, v) <- Map.assocs (cflags cnc)] ++++
-       plFacts name "printname" 2 "(?AbsFun/AbsCat, ?Atom)"
-                   [[plp f, plp n] | 
-                    (f, n) <- Map.assocs (printnames cnc)] ++++
-       plFacts name "lindef" 2 "(?CncCat, ?CncFun)"
-                   [[plCat cat, plFun fun] | 
-                    (cat, funs) <- IntMap.assocs (lindefs cnc),
-                    fun <- funs] ++++
-       plFacts name "prod" 3 "(?CncCat, ?CncFun, ?[CncCat])"
-                   [[plCat cat, fun, plTerm "c" (map plCat args)] |
-                    (cat, set) <- IntMap.toList (productions cnc),
-                    (fun, args) <- map plProduction (Set.toList set)] ++++
-       plFacts name "cncfun" 3 "(?CncFun, ?[Seq,...], ?AbsFun)"
-                   [[plFun fun, plTerm "s" (map plSeq (Array.elems lins)), plp absfun] |
-                    (fun, CncFun absfun lins) <- Array.assocs (cncfuns cnc)] ++++
-       plFacts name "seq" 2 "(?Seq, ?[Term])"
-                   [[plSeq seq, plp (Array.elems symbols)] |
-                    (seq, symbols) <- Array.assocs (sequences cnc)] ++++
-       plFacts name "cnccat" 2 "(?AbsCat, ?[CnCCat])" 
-                   [[plp cat, plList (map plCat [start..end])] |
-                    (cat, CncCat start end _) <- Map.assocs (cnccats cnc)]
-      )
-    where plProduction (PCoerce arg)       = ("-", [arg])
-          plProduction (PApply funid args) = (plFun funid, [fid | PArg hypos fid <- args])
-
----------------------------------------------------------------------
-- prolog-printing pgf datatypes
-
-instance PLPrint Type where
-    plp (DTyp hypos cat args) 
-        | null hypos = result
-        | otherwise  = plOper " -> " plHypos result
-        where result = plTerm (plp cat) (map plp args)
-              plHypos = plList [plOper ":" (plp x) (plp ty) | (_,x,ty) <- hypos]
-
-instance PLPrint Expr where
-    plp (EFun x)    = plp x
-    plp (EAbs _ x e)= plOper "^" (plp x) (plp e)
-    plp (EApp e e') = plOper " * " (plp e) (plp e')
-    plp (ELit lit)  = plp lit
-    plp (EMeta n)   = "Meta_" ++ show n
-
-instance PLPrint Patt where
-    plp (PVar x)    = plp x
-    plp (PApp f ps) = plOper " * " (plp f) (plp ps)
-    plp (PLit lit)  = plp lit
-
-instance PLPrint Equation where
-    plp (Equ patterns result) = plOper ":" (plp patterns) (plp result)
-
-instance PLPrint CId where
-    plp cid | isLogicalVariable str || cid == wildCId = plVar str
-            | otherwise = plAtom str
-        where str = showCId cid
-
-instance PLPrint Literal where
-    plp (LStr s) = plp s
-    plp (LInt n) = plp (show n)
-    plp (LFlt f) = plp (show f)
-
-instance PLPrint Symbol where
-    plp (SymCat n l)    = plOper ":" (show n) (show l)
-    plp (SymLit n l)    = plTerm "lit" [show n, show l]
-    plp (SymVar n l)    = plTerm "var" [show n, show l]
-    plp (SymKS t)       = plAtom t
-    plp (SymKP ts alts) = plTerm "pre" [plList (map plp ts), plList (map plAlt alts)]
-        where plAlt (ps,ts) = plOper "/" (plList (map plp ps)) (plList (map plAtom ts))
-
-class PLPrint a where
-    plp :: a -> String
-    plps :: [a] -> String
-    plps = plList . map plp
-
-instance PLPrint Char where
-    plp  c = plAtom [c]
-    plps s = plAtom s
-
-instance PLPrint a => PLPrint [a] where
-    plp = plps
-
----------------------------------------------------------------------
-- other prolog-printing functions
-
-plCat :: Int -> String
-plCat n = plAtom ('c' : show n)
-
-plFun :: Int -> String
-plFun n = plAtom ('f' : show n)
-
-plSeq :: Int -> String
-plSeq n = plAtom ('s' : show n)
-
-plHeader :: String -> String
-plHeader hdr = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n%% " ++ hdr ++ "\n"
-
-plFacts :: CId -> String -> Int -> String -> [[String]] -> String
-plFacts mod pred arity comment facts = "%% " ++ pred ++ comment ++++ clauses
-    where clauses = (if facts == [] then ":- dynamic " ++ pred ++ "/" ++ show arity ++ ".\n"
-                     else unlines [mod' ++ plTerm pred args ++ "." | args <- facts])
-          mod' = if mod == wildCId then "" else plp mod ++ ": "
-
-plTerm :: String -> [String] -> String
-plTerm fun args = plAtom fun ++ prParenth (prTList ", " args)
-
-plList :: [String] -> String
-plList xs = prBracket (prTList "," xs)
-
-plOper :: String -> String -> String -> String
-plOper op a b = prParenth (a ++ op ++ b)
-
-plVar :: String -> String
-plVar = varPrefix  . concatMap changeNonAlphaNum 
-    where varPrefix var@(c:_) | isAsciiUpper c || c=='_' = var
-                              | otherwise = "_" ++ var
-          changeNonAlphaNum c | isAlphaNumUnderscore c = [c]
-                              | otherwise = "_" ++ show (ord c) ++ "_"
-
-plAtom :: String -> String
-plAtom "" = "''"
-plAtom atom@(c:cs) | isAsciiLower c && all isAlphaNumUnderscore cs 
-                     || c == '\'' && cs /= "" && last cs == '\''   = atom
-                   | otherwise = "'" ++ changeQuote atom ++ "'"
-    where changeQuote ('\'':cs) = '\\' : '\'' : changeQuote cs
-          changeQuote ('\\':cs) = '\\' : '\\' : changeQuote cs
-          changeQuote (c:cs) = c : changeQuote cs
-          changeQuote "" = ""
-
-isAlphaNumUnderscore :: Char -> Bool
-isAlphaNumUnderscore c = (isAscii c && isAlphaNum c) || c == '_'
-
----------------------------------------------------------------------
-- prolog variables 
-
-createLogicalVariable :: Int -> CId
-createLogicalVariable n = mkCId (logicalVariablePrefix ++ show n)
-
-isLogicalVariable :: String -> Bool
-isLogicalVariable = isPrefixOf logicalVariablePrefix 
-
-logicalVariablePrefix :: String 
-logicalVariablePrefix = "X"
-
----------------------------------------------------------------------
-- alpha convert variables to (unique) logical variables
-- * this is needed if we want to translate variables to Prolog variables
-- * used for abstract syntax, not concrete
-- * not (yet?) used for variables bound in pattern equations
-
-type ConvertEnv = (Int, [(CId,CId)])
-
-emptyEnv :: ConvertEnv
-emptyEnv = (0, [])
-
-class AlphaConvert a where
-    alphaConvert :: ConvertEnv -> a -> (ConvertEnv, a)
-
-instance AlphaConvert a => AlphaConvert [a] where
-    alphaConvert env [] = (env, [])
-    alphaConvert env (a:as) = (env'', a':as')
-        where (env',  a')  = alphaConvert env  a
-              (env'', as') = alphaConvert env' as
-
-instance AlphaConvert Type where
-    alphaConvert env@(_,subst) (DTyp hypos cat args) 
-        = ((ctr,subst), DTyp hypos' cat args')
-        where (env',   hypos') = mapAccumL alphaConvertHypo env hypos
-              ((ctr,_), args') = alphaConvert env' args
-
-alphaConvertHypo env (b,x,typ) = ((ctr+1,(x,x'):subst), (b,x',typ'))
-    where ((ctr,subst), typ') = alphaConvert env typ
-          x' = createLogicalVariable ctr
-
-instance AlphaConvert Expr where
-    alphaConvert (ctr,subst) (EAbs b x e) = ((ctr',subst), EAbs b x' e')
-        where ((ctr',_), e') = alphaConvert (ctr+1,(x,x'):subst) e
-              x' = createLogicalVariable ctr
-    alphaConvert env (EApp e1 e2) = (env'', EApp e1' e2')
-        where (env',  e1') = alphaConvert env  e1
-              (env'', e2') = alphaConvert env' e2
-    alphaConvert env expr@(EFun i) = (env, maybe expr EFun (lookup i (snd env)))
-    alphaConvert env expr = (env, expr)
-
-- pattern variables are not alpha converted
-- (but they probably should be...)
-instance AlphaConvert Equation where
-    alphaConvert env@(_,subst) (Equ patterns result)
-        = ((ctr,subst), Equ patterns result')
-        where ((ctr,_), result') = alphaConvert env result
--- a/src/compiler/GF/Compile/PGFtoPython.hs
+++ b/src/compiler/GF/Compile/PGFtoPython.hs
@@ -1,122 +0,0 @@
----------------------------------------------------------------------
-- |
-- Module      : PGFtoPython
-- Maintainer  : Peter Ljunglöf
--
-- exports a GF grammar into a Python module
-----------------------------------------------------------------------------
-
-{-# LANGUAGE FlexibleContexts #-}
-module GF.Compile.PGFtoPython (pgf2python) where
-
-import PGF(showCId)
-import PGF.Internal as M
-
-import GF.Data.Operations
-
-import qualified Data.Array.IArray as Array
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
--import Data.List (intersperse)
-
-pgf2python :: PGF -> String
-pgf2python pgf = ("# -*- coding: utf-8 -*-" ++++
-                  "# This file was automatically generated by GF" +++++
-                  showCId name +++ "=" +++ 
-                  pyDict 1 pyStr id [
-                              ("flags", pyDict 2 pyCId pyLiteral (Map.assocs (gflags pgf))),
-                              ("abstract", pyDict 2 pyStr id [
-                                              ("name", pyCId name), 
-                                              ("start", pyCId start), 
-                                              ("flags", pyDict 3 pyCId pyLiteral (Map.assocs (aflags abs))),
-                                              ("funs", pyDict 3 pyCId pyAbsdef (Map.assocs (funs abs)))
-                                             ]),
-                              ("concretes", pyDict 2 pyCId pyConcrete (Map.assocs cncs))
-                             ] ++ "\n")
-    where
-      name  = absname pgf
-      start = M.lookStartCat pgf
-      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]
-    where (args, cat) = M.catSkeleton typ 
-
-pyLiteral :: Literal -> String
-pyLiteral (LStr s) = pyStr s
-pyLiteral (LInt n) = show n
-pyLiteral (LFlt d) = show d
-
-pyConcrete :: Concr -> String
-pyConcrete cnc = pyDict 3 pyStr id [
-                  ("flags", pyDict 0 pyCId pyLiteral (Map.assocs (cflags cnc))),
-                  ("printnames", pyDict 4 pyCId pyStr (Map.assocs (printnames cnc))),
-                  ("lindefs", pyDict 4 pyCat (pyList 0 pyFun) (IntMap.assocs (lindefs cnc))),
-                  ("productions", pyDict 4 pyCat pyProds (IntMap.assocs (productions cnc))),
-                  ("cncfuns", pyDict 4 pyFun pyCncFun (Array.assocs (cncfuns cnc))),
-                  ("sequences",  pyDict 4 pySeq pySymbols (Array.assocs (sequences cnc))),
-                  ("cnccats", pyDict 4 pyCId pyCncCat (Map.assocs (cnccats cnc))),
-                  ("size",  show (totalCats cnc))
-                 ]
-    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]
-          pySymbols syms = pyList 0 pySymbol (Array.elems syms)
-
-pyProduction :: Production -> String
-pyProduction (PCoerce arg)       = pyTuple 0 id [pyStr "", pyList 0 pyCat [arg]]
-pyProduction (PApply funid args) = pyTuple 0 id [pyFun funid, pyList 0 pyPArg args]
-    where pyPArg (PArg [] fid) = pyCat fid
-          pyPArg (PArg hypos fid) = pyTuple 0 pyCat (fid : map snd hypos)
-
-pySymbol :: Symbol -> String
-pySymbol (SymCat n l)    = pyTuple 0 show [n, l]
-pySymbol (SymLit n l)    = pyDict 0 pyStr id [("lit", pyTuple 0 show [n, l])]
-pySymbol (SymVar n l)    = pyDict 0 pyStr id [("var", pyTuple 0 show [n, l])]
-pySymbol (SymKS t)       = pyStr t
-pySymbol (SymKP ts alts) = pyDict 0 pyStr id [("pre", pyList 0 pySymbol ts), ("alts", pyList 0 alt2py alts)]
-    where alt2py (ps,ts) = pyTuple 0 (pyList 0 pyStr) [map pySymbol ps, ts]
-pySymbol SymBIND         = pyStr "&+"
-pySymbol SymSOFT_BIND    = pyStr "&+"
-pySymbol SymSOFT_SPACE   = pyStr "&+"
-pySymbol SymCAPIT        = pyStr "&|"
-pySymbol SymALL_CAPIT    = pyStr "&|"
-pySymbol SymNE           = pyDict 0 pyStr id [("nonExist", pyTuple 0 id [])]
-
----------------------------------------------------------------------
-- python helpers 
-
-pyDict :: Int -> (k -> String) -> (v -> String) -> [(k, v)] -> String
-pyDict n pk pv [] = "{}"
-pyDict n pk pv kvlist = prCurly (pyIndent n ++ prTList ("," ++ pyIndent n) (map pyKV kvlist) ++ pyIndent n)
-    where pyKV (k, v) = pk k ++ ":" ++ pv v
-
-pyList :: Int -> (v -> String) -> [v] -> String
-pyList n pv [] = "[]"
-pyList n pv xs = prBracket (pyIndent n ++ prTList ("," ++ pyIndent n) (map pv xs) ++ pyIndent n)
-
-pyTuple :: Int -> (v -> String) -> [v] -> String
-pyTuple n pv [] = "()"
-pyTuple n pv [x] = prParenth (pyIndent n ++ pv x ++ "," ++ pyIndent n)
-pyTuple n pv xs = prParenth (pyIndent n ++ prTList ("," ++ pyIndent n) (map pv xs) ++ pyIndent n)
-
-pyCat :: Int -> String
-pyCat n = pyStr ('C' : show n)
-
-pyFun :: Int -> String
-pyFun n = pyStr ('F' : show n)
-
-pySeq :: Int -> String
-pySeq n = pyStr ('S' : show n)
-
-pyStr :: String -> String
-pyStr s = 'u' : prQuotedString s
-
-pyCId :: CId -> String
-pyCId = pyStr . showCId
-
-pyIndent :: Int -> String
-pyIndent n | n > 0 = "\n" ++ replicate n ' '
-           | otherwise = ""
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -110,7 +110,7 @@ renameIdentTerm' env@(act,imps) t0 =
 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
+  ResValue _ _  -> maybe Con (curry QC) mq
  ResParam _ _  -> maybe Con (curry QC) mq
  AnyInd True m -> maybe Con (const (curry QC m)) mq
  AnyInd False m -> maybe Cn (const (curry Q m)) mq
@@ -148,9 +148,9 @@ renameInfo cwd status (m,mi) i info =
    ResParam (Just pp) m -> do
      pp' <- renLoc (mapM (renParam status)) pp
      return (ResParam (Just pp') m)
-    ResValue t -> do
-      t <- renLoc (renameTerm status []) t
-      return (ResValue t)
+    ResValue ty offset -> do
+      t <- renLoc (renameTerm status []) ty
+      return (ResValue ty offset)
    CncCat mcat mdef mref mpr mpmcfg -> liftM5 CncCat (renTerm mcat) (renTerm mdef) (renTerm mref) (renTerm mpr) (return mpmcfg)
    CncFun mty mtr mpr mpmcfg -> liftM3 (CncFun mty)         (renTerm mtr) (renTerm mpr) (return mpmcfg)
    _ -> return info
@@ -178,9 +178,9 @@ renameInfo cwd status (m,mi) i info =
        return (ps',t')

    renParam :: Status -> Param -> Check Param
-    renParam env (c,co) = do
+    renParam env (c,co,i) = do
      co' <- renameContext env co
-      return (c,co')
+      return (c,co',i)

 renameTerm :: Status -> [Ident] -> Term -> Check Term
 renameTerm env vars = ren vars where
@@ -236,7 +236,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
--- a/src/compiler/GF/Compile/Tags.hs
+++ b/src/compiler/GF/Compile/Tags.hs
@@ -31,7 +31,7 @@ getLocalTags x (m,mi) =
    getLocations (AbsFun mb_type _ mb_eqs _)    = maybe (ltype "fun")        mb_type ++
                                                  maybe (list (loc "def"))   mb_eqs  
    getLocations (ResParam mb_params _)         = maybe (loc "param")        mb_params
-    getLocations (ResValue mb_type)             = ltype "param-value"          mb_type
+    getLocations (ResValue mb_type _)           = ltype "param-value"          mb_type
    getLocations (ResOper  mb_type mb_def)      = maybe (ltype "oper-type")  mb_type ++
                                                  maybe (loc "oper-def")     mb_def
    getLocations (ResOverload _ defs)           = list (\(x,y) -> ltype "overload-type" x ++ 
--- a/src/compiler/GF/Compile/ToAPI.hs
+++ b/src/compiler/GF/Compile/ToAPI.hs
@@ -2,8 +2,7 @@ module GF.Compile.ToAPI
 (stringToAPI,exprToAPI)
  where

-import PGF.Internal
-import PGF(showCId)
+import PGF2
 import Data.Maybe
 --import System.IO
 --import Control.Monad
@@ -47,12 +46,12 @@ exprToFunc :: Expr -> APIfunc
 exprToFunc expr = 
   case unApp expr of
      Just (cid,l) -> 
-         case Map.lookup (showCId cid) syntaxFuncs of 
+         case Map.lookup cid syntaxFuncs of 
            Just sig -> mkAPI True (fst sig,expr)
            _        -> case l of 
-                          [] -> BasicFunc (showCId cid) 
+                          [] -> BasicFunc cid 
                          _  -> let es = map exprToFunc l 
-                                   in  AppFunc (showCId cid) es
+                                   in  AppFunc cid es
      _ -> BasicFunc (showExpr [] expr)

        
@@ -69,8 +68,8 @@ mkAPI opt (ty,expr) =
  where
     rephraseSentence ty expr = 
       case unApp expr of 
-         Just (cid,es) -> if isPrefixOf "Use" (showCId cid) then 
-                                                             let newCat = drop 3 (showCId cid)
+         Just (cid,es) -> if isPrefixOf "Use" cid then 
+                                                             let newCat = drop 3 cid
                                                                 afClause = mkAPI True (newCat, es !! 2)
                                                                 afPol = mkAPI True ("Pol",es !! 1)                                         
                                                                 lTense = mkAPI True ("Temp", head es)                                        
@@ -98,9 +97,9 @@ mkAPI opt (ty,expr) =
 computeAPI :: (String,Expr) ->  APIfunc
 computeAPI (ty,expr) =
   case (unApp expr) of 
-     Just (cid,[]) ->  getSimpCat (showCId cid) ty
+     Just (cid,[]) ->  getSimpCat cid ty
     Just (cid,es) -> 
-        let p = specFunction (showCId cid) es  
+        let p = specFunction cid es  
          in if isJust p then fromJust p
              else case Map.lookup (show cid) syntaxFuncs of
                    Nothing -> exprToFunc expr    
@@ -147,23 +146,23 @@ optimize expr = optimizeNP expr
 optimizeNP expr = 
   case unApp expr of
     Just (cid,es) -> 
-         if showCId cid == "MassNP" then let afs = nounAsCN (head es)
-                                           in AppFunc "mkNP" [afs]
-           else if showCId cid == "DetCN" then let quants = quantAsDet (head es)
-                                                   ns     = nounAsCN (head $ tail es)
-                                                  in AppFunc "mkNP" (quants ++ [ns])
+         if cid == "MassNP" then let afs = nounAsCN (head es)
+                                 in AppFunc "mkNP" [afs]
+           else if cid == "DetCN" then let quants = quantAsDet (head es)
+                                           ns     = nounAsCN (head $ tail es)
+                                       in AppFunc "mkNP" (quants ++ [ns])
                 else mkAPI False ("NP",expr)
     _             -> error $ "incorrect expression " ++ (showExpr [] expr)
    where 
     nounAsCN expr = 
      case unApp expr of 
-       Just (cid,es) -> if showCId cid == "UseN" then (mkAPI False) ("N",head es)
+       Just (cid,es) -> if cid == "UseN" then (mkAPI False) ("N",head es)
           else (mkAPI False) ("CN",expr)
       _ -> error $ "incorrect expression "++ (showExpr [] expr)

     quantAsDet expr =
       case unApp expr of
-        Just (cid,es) -> if showCId cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
+        Just (cid,es) -> if cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
                           else [mkAPI False ("Det",expr)]
                                  
        _             -> error $ "incorrect expression "++ (showExpr [] expr)
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 module GF.Compile.TypeCheck.ConcreteNew( checkLType, inferLType ) where

 -- The code here is based on the paper:
@@ -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
@@ -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
--- a/src/compiler/GF/Compile/TypeCheck/Primitives.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Primitives.hs
@@ -8,7 +8,7 @@ typPredefined :: Ident -> Maybe Type
 typPredefined f = case Map.lookup f primitives of
                    Just (ResOper (Just (L _ ty)) _) -> Just ty
                    Just (ResParam _ _)              -> Just typePType
-                    Just (ResValue (L _ ty))         -> Just ty
+                    Just (ResValue (L _ ty) _)       -> Just ty
                    _                                -> Nothing

 primitives = Map.fromList
@@ -16,9 +16,9 @@ primitives = Map.fromList
  , (cInt      , ResOper (Just (noLoc typePType)) Nothing)
  , (cFloat    , ResOper (Just (noLoc typePType)) Nothing)
  , (cInts     , fun [typeInt] typePType)
-  , (cPBool    , ResParam (Just (noLoc [(cPTrue,[]),(cPFalse,[])])) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))
-  , (cPTrue    , ResValue (noLoc typePBool))
-  , (cPFalse   , ResValue (noLoc typePBool))
+  , (cPBool    , ResParam (Just (noLoc [(cPTrue,[],0),(cPFalse,[],1)])) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))
+  , (cPTrue    , ResValue (noLoc typePBool) 0)
+  , (cPFalse   , ResValue (noLoc typePBool) 1)
  , (cError    , fun [typeStr] typeError)  -- non-can. of empty set
  , (cLength   , fun [typeTok] typeInt)
  , (cDrop     , fun [typeInt,typeTok] typeTok)
--- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE PatternGuards #-}
 module GF.Compile.TypeCheck.RConcrete( checkLType, inferLType, computeLType, ppType ) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

 import GF.Infra.CheckM
 import GF.Data.Operations
@@ -127,12 +126,8 @@ inferLType gr g trm = case trm of
             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 ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)

   S f x -> do
     (f', fty) <- inferLType gr g f
@@ -224,14 +219,8 @@ inferLType gr g trm = case trm of
     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

@@ -337,7 +326,7 @@ getOverload gr g mt ot = case appForm ot of
       v <- matchOverload f typs ttys
       return $ Just v
     _ -> return Nothing
-     
+
 where
   collectOverloads tr@(Q c) = case lookupOverload gr c of 
     Ok typs -> typs
@@ -405,7 +394,7 @@ getOverload gr g mt ot = case appForm ot of
   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
@@ -438,9 +427,7 @@ checkLType gr g trm typ0 = do
                       else do b' <- checkIn (pp "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"
+        _ -> checkError $ "function type expected instead of" <+> ppType typ

    App f a -> do
       over <- getOverload gr g (Just typ) trm
@@ -518,13 +505,8 @@ checkLType gr g trm typ0 = do
               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])
+         (r',_) <- checkLType gr g r (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)
@@ -655,31 +637,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 $ 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)
 checkIfEqLType gr g t u trm = do
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -27,10 +27,9 @@ import Data.List
 import qualified Data.Map as Map
 import Control.Monad
 import GF.Text.Pretty
-import qualified Control.Monad.Fail as Fail

 -- | combine a list of definitions into a balanced binary search tree
-buildAnyTree :: Fail.MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
+buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (Map.Map Ident Info)
 buildAnyTree m = go Map.empty
  where
    go map []         = return map
@@ -110,9 +109,8 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
    -- add the instance opens to an incomplete module "with" instances
    Just (ext,incl,ops) -> do
      let (infs,insts) = unzip ops
-      let stat' = if all (flip elem infs) is
-                    then MSComplete
-                    else MSIncomplete
+      let stat' = ifNull MSComplete (const MSIncomplete)
+                    [i | i <- is, notElem i infs]
      unless (stat' == MSComplete || stat == MSIncomplete) 
             (checkError ("module" <+> i <+> "remains incomplete"))
      ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
@@ -168,7 +166,7 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
    indirInfo :: ModuleName -> Info -> Info
    indirInfo n info = AnyInd b n' where 
      (b,n') = case info of
-        ResValue _ -> (True,n)
+        ResValue _ _ -> (True,n)
        ResParam _ _ -> (True,n)
        AbsFun _ _ Nothing _ -> (True,n) 
        AnyInd b k -> (b,k)
@@ -179,7 +177,7 @@ globalizeLoc fpath i =
    AbsCat mc             -> AbsCat (fmap gl mc)
    AbsFun mt ma md moper -> AbsFun (fmap gl mt) ma (fmap (fmap gl) md) moper
    ResParam mt mv        -> ResParam (fmap gl mt) mv
-    ResValue t            -> ResValue (gl t)
+    ResValue t offset     -> ResValue (gl t) offset
    ResOper mt m          -> ResOper (fmap gl mt) (fmap gl m)
    ResOverload ms os     -> ResOverload ms (map (\(x,y) -> (gl x,gl y)) os)
    CncCat mc md mr mp mpmcfg-> CncCat (fmap gl mc) (fmap gl md) (fmap gl mr) (fmap gl mp) mpmcfg
@@ -201,9 +199,9 @@ unifyAnyInfo m i j = case (i,j) of

  (ResParam mt1 mv1, ResParam mt2 mv2) ->
    liftM2 ResParam (unifyMaybeL mt1 mt2) (unifyMaybe mv1 mv2)
-  (ResValue (L l1 t1), ResValue (L l2 t2)) 
-      | t1==t2    -> return (ResValue (L l1 t1))
-      | otherwise -> fail ""
+  (ResValue (L l1 t1) i1, ResValue (L l2 t2) i2) 
+      | t1==t2 && i1 == i2 -> return (ResValue (L l1 t1) i1)
+      | otherwise          -> fail ""
  (_, ResOverload ms t) | elem m ms ->
    return $ ResOverload ms t
  (ResOper mt1 m1, ResOper mt2 m2) -> 
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -1,6 +1,6 @@
 -- | Parallel grammar compilation
 module GF.CompileInParallel(parallelBatchCompile) where
-import Prelude hiding (catch,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+import Prelude hiding (catch)
 import Control.Monad(join,ap,when,unless)
 import Control.Applicative
 import GF.Infra.Concurrency
@@ -20,8 +20,6 @@ import GF.Infra.Ident(moduleNameS)
 import GF.Text.Pretty
 import GF.System.Console(TermColors(..),getTermColors)
 import qualified Data.ByteString.Lazy as BS
-- Control.Monad.Fail import will become redundant in GHC 8.8+
-import qualified Control.Monad.Fail as Fail

 -- | Compile the given grammar files and everything they depend on,
 -- like 'batchCompile'. This function compiles modules in parallel.
@@ -36,11 +34,8 @@ import qualified Control.Monad.Fail as Fail
 parallelBatchCompile jobs opts rootfiles0 =
  do setJobs jobs
     rootfiles <- mapM canonical rootfiles0
-     lib_dirs1 <- getLibraryDirectory opts
-     lib_dirs2 <- mapM canonical lib_dirs1
-     let lib_dir = head lib_dirs2
-     when (length lib_dirs2 >1) $ ePutStrLn ("GF_LIB_PATH defines more than one directory; using the first, " ++ show lib_dir)
-     filepaths <- mapM (getPathFromFile [lib_dir] opts) rootfiles
+     lib_dir  <- canonical =<< getLibraryDirectory opts
+     filepaths <- mapM (getPathFromFile lib_dir opts) rootfiles
     let groups = groupFiles lib_dir filepaths
         n = length groups
     when (n>1) $ ePutStrLn "Grammar mixes present and alltenses, dividing modules into two groups"
@@ -85,7 +80,7 @@ batchCompile1 lib_dir (opts,filepaths) =
     let rel = relativeTo lib_dir cwd
         prelude_dir = lib_dir</>"prelude"
         gfoDir = flag optGFODir opts
-     maybe (return ()) (D.createDirectoryIfMissing True) gfoDir
+     maybe done (D.createDirectoryIfMissing True) gfoDir
 {-
     liftIO $ writeFile (maybe "" id gfoDir</>"paths")
                        (unlines . map (unwords . map rel) . nub $ map snd filepaths)
@@ -243,14 +238,14 @@ instance (Functor m,Monad m) => Applicative (CollectOutput m) where
  (<*>) = ap

 instance Monad m => Monad (CollectOutput m) where
-  return x = CO (return (return (),x))
+  return x = CO (return (done,x))
  CO m >>= f = CO $ do (o1,x) <- m
                       let CO m2 = f x
                       (o2,y) <- m2
                       return (o1>>o2,y)
 instance MonadIO m => MonadIO (CollectOutput m) where
  liftIO io = CO $ do x <- liftIO io
-                      return (return (),x)
+                      return (done,x)

 instance Output m => Output (CollectOutput m) where
  ePutStr   s = CO (return (ePutStr s,()))
@@ -258,9 +253,6 @@ instance Output m => Output (CollectOutput m) where
  putStrLnE s = CO (return (putStrLnE s,()))
  putStrE   s = CO (return (putStrE s,()))

-instance Fail.MonadFail m => Fail.MonadFail (CollectOutput m) where
-  fail = CO . fail
-
 instance ErrorMonad m => ErrorMonad (CollectOutput m) where
  raise e = CO (raise e)
  handle (CO m) h = CO $ handle m (unCO . h)
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -21,7 +21,7 @@ import GF.Grammar.Binary(decodeModule,encodeModule)
 import GF.Infra.Option
 import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,MonadIO(..),Output(..),putPointE)
 import GF.Infra.CheckM(runCheck')
-import GF.Data.Operations(ErrorMonad,liftErr,(+++))
+import GF.Data.Operations(ErrorMonad,liftErr,(+++),done)

 import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
 import System.FilePath(makeRelative)
@@ -30,13 +30,12 @@ import qualified Data.Map as Map
 import GF.Text.Pretty(render,(<+>),($$)) --Doc,
 import GF.System.Console(TermColors(..),getTermColors)
 import Control.Monad((<=<))
-import qualified Control.Monad.Fail as Fail

 type OneOutput = (Maybe FullPath,CompiledModule)
 type CompiledModule = Module

 compileOne, reuseGFO, useTheSource ::
-    (Output m,ErrorMonad m,MonadIO m, Fail.MonadFail m) =>
+    (Output m,ErrorMonad m,MonadIO m) =>
    Options -> Grammar -> FullPath -> m OneOutput

 -- | Compile a given source file (or just load a .gfo file),
@@ -67,7 +66,7 @@ reuseGFO opts srcgr file =

     if flag optTagsOnly opts
       then writeTags opts srcgr (gf2gftags opts file) sm1
-       else return ()
+       else done

     return (Just file,sm)

@@ -138,7 +137,7 @@ compileSourceModule opts cwd mb_gfFile gr =
           idump opts pass (dump out)
           return (ret out)

-    maybeM f = maybe (return ()) f
+    maybeM f = maybe done f


 --writeGFO :: Options -> InitPath -> FilePath -> SourceModule -> IOE ()
@@ -159,12 +158,12 @@ writeGFO opts cwd file mo =
 --intermOut :: Options -> Dump -> Doc -> IOE ()
 intermOut opts d doc
  | dump opts d = ePutStrLn (render ("\n\n--#" <+> show d $$ doc))
-  | otherwise   = return ()
+  | otherwise   = done

 idump opts pass = intermOut opts (Dump pass) . ppModule Internal

 warnOut opts warnings
-  | null warnings = return ()
+  | null warnings = done
  | otherwise     = do t <- getTermColors
                       ePutStr (blueFg t);ePutStr ws;ePutStrLn (restore t)
  where
--- a/src/compiler/GF/Compiler.hs
+++ b/src/compiler/GF/Compiler.hs
@@ -1,8 +1,7 @@
-module GF.Compiler (mainGFC, linkGrammars, writePGF, writeOutputs) where
+module GF.Compiler (mainGFC, linkGrammars, writeGrammar, writeOutputs) where

-import PGF
-import PGF.Internal(concretes,optimizePGF,unionPGF)
-import PGF.Internal(putSplitAbs,encodeFile,runPut)
+import PGF2
+import PGF2.Internal(unionPGF,writePGF,writeConcr)
 import GF.Compile as S(batchCompile,link,srcAbsName)
 import GF.CompileInParallel as P(parallelBatchCompile)
 import GF.Compile.Export
@@ -92,7 +91,7 @@ compileSourceFiles opts fs =
 -- in the 'Options') from the output of 'parallelBatchCompile'.
 -- If a @.pgf@ file by the same name already exists and it is newer than the
 -- source grammar files (as indicated by the 'UTCTime' argument), it is not
-- recreated. Calls 'writePGF' and 'writeOutputs'.
+-- recreated. Calls 'writeGrammar' and 'writeOutputs'.
 linkGrammars opts (t_src,~cnc_grs@(~(cnc,gr):_)) =
    do let abs = render (srcAbsName gr cnc)
           pgfFile = outputPath opts (grammarName' opts abs<.>"pgf")
@@ -102,10 +101,8 @@ linkGrammars opts (t_src,~cnc_grs@(~(cnc,gr):_)) =
       if t_pgf >= Just t_src
         then putIfVerb opts $ pgfFile ++ " is up-to-date."
         else do pgfs <- mapM (link opts) cnc_grs
-                 let pgf0 = foldl1 unionPGF pgfs
-                 probs <- maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf0
-                 let pgf = setProbabilities probs pgf0
-                 writePGF opts pgf
+                 let pgf = foldl1 (\one two -> fromMaybe two (unionPGF one two)) pgfs
+                 writeGrammar opts pgf
                 writeOutputs opts pgf

 compileCFFiles :: Options -> [FilePath] -> IOE ()
@@ -115,12 +112,11 @@ compileCFFiles opts fs = do
  startCat <- case rules of
                (Rule cat _ _ : _) -> return cat
                _                  -> fail "empty CFG"
-  let pgf = cf2pgf (last fs) (mkCFG startCat Set.empty rules)
+  probs <- liftIO (maybe (return Map.empty) readProbabilitiesFromFile (flag optProbsFile opts))
+  let pgf = cf2pgf opts (last fs) (mkCFG startCat Set.empty rules) probs
  unless (flag optStopAfterPhase opts == Compile) $
-     do probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
-        let pgf' = setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
-        writePGF opts pgf'
-        writeOutputs opts pgf'
+     do writeGrammar opts pgf
+        writeOutputs opts pgf

 unionPGFFiles :: Options -> [FilePath] -> IOE ()
 unionPGFFiles opts fs =
@@ -138,14 +134,11 @@ unionPGFFiles opts fs =

    doIt =
      do pgfs <- mapM readPGFVerbose fs
-         let pgf0 = foldl1 unionPGF pgfs
-             pgf1 = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
-         probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf1)
-         let pgf  = setProbabilities probs pgf1
-             pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
+         let pgf = foldl1 (\one two -> fromMaybe two (unionPGF one two)) pgfs
+         let pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
         if pgfFile `elem` fs
           then putStrLnE $ "Refusing to overwrite " ++ pgfFile
-           else writePGF opts pgf
+           else writeGrammar opts pgf
         writeOutputs opts pgf

    readPGFVerbose f =
@@ -162,21 +155,20 @@ writeOutputs opts pgf = do
 -- | Write the result of compiling a grammar (e.g. with 'compileToPGF' or
 -- 'link') to a @.pgf@ file.
 -- A split PGF file is output if the @-split-pgf@ option is used.
-writePGF :: Options -> PGF -> IOE ()
-writePGF opts pgf =
-    if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
+writeGrammar :: Options -> PGF -> IOE ()
+writeGrammar opts pgf =
+  if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
  where
    writeNormalPGF =
       do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
-          writing opts outfile $ encodeFile outfile pgf
+          writing opts outfile (writePGF outfile pgf)

    writeSplitPGF =
      do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
-         writing opts outfile $ BSL.writeFile outfile (runPut (putSplitAbs pgf))
-                                --encodeFile_ outfile (putSplitAbs pgf)
-         forM_ (Map.toList (concretes pgf)) $ \cnc -> do
-           let outfile = outputPath opts (showCId (fst cnc) <.> "pgf_c")
-           writing opts outfile $ encodeFile outfile cnc
+         writing opts outfile $ writePGF outfile pgf
+         forM_ (Map.toList (languages pgf)) $ \(concrname,concr) -> do
+           let outfile = outputPath opts (concrname <.> "pgf_c")
+           writing opts outfile (writeConcr outfile concr)


 writeOutput :: Options -> FilePath-> String -> IOE ()
@@ -186,7 +178,7 @@ writeOutput opts file str = writing opts path $ writeUTF8File path str
 -- * Useful helper functions

 grammarName :: Options -> PGF -> String
-grammarName opts pgf = grammarName' opts (showCId (abstractName pgf))
+grammarName opts pgf = grammarName' opts (abstractName pgf)
 grammarName' opts abs = fromMaybe abs (flag optName opts)

 outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/src/compiler/GF/Data/BacktrackM.hs
@@ -13,7 +13,6 @@
 -----------------------------------------------------------------------------

 {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
-{-# LANGUAGE CPP #-}
 module GF.Data.BacktrackM (
                    -- * the backtracking state monad
 		    BacktrackM,
@@ -33,7 +32,6 @@ import Data.List
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State.Class
-import qualified Control.Monad.Fail as Fail

 ----------------------------------------------------------------------
 -- Combining endomorphisms and continuations
@@ -71,12 +69,6 @@ instance Monad (BacktrackM s) where
    return a   = BM (\c s b -> c a s b)
    BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
 	where unBM (BM m) = m
-
-#if !(MIN_VERSION_base(4,13,0))
-    fail = Fail.fail
-#endif
-
-instance Fail.MonadFail (BacktrackM s) where
    fail _ = mzero

 instance Functor (BacktrackM s) where
--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -12,12 +12,10 @@
 -- hack for BNFC generated files. AR 21/9/2003
 -----------------------------------------------------------------------------

-{-# LANGUAGE CPP #-}
 module GF.Data.ErrM where

 import Control.Monad (MonadPlus(..),ap)
 import Control.Applicative
-import qualified Control.Monad.Fail as Fail

 -- | Like 'Maybe' type with error msgs
 data Err a = Ok a | Bad String
@@ -35,19 +33,10 @@ fromErr a = err (const a) id

 instance Monad Err where
  return      = Ok
+  fail        = Bad
  Ok a  >>= f = f a
  Bad s >>= f = Bad s

-#if !(MIN_VERSION_base(4,13,0))
-  -- Monad(fail) will be removed in GHC 8.8+
-  fail = Fail.fail
-#endif
-
-instance Fail.MonadFail Err where
-  fail        = Bad
-
-
-
 -- | added 2\/10\/2003 by PEB
 instance Functor Err where
  fmap f (Ok a) = Ok (f a)
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -26,8 +26,8 @@ module GF.Data.Operations (
 		   -- ** Checking
 		   checkUnique, unifyMaybeBy, unifyMaybe,

-           -- ** Monadic operations on lists and pairs
-		   mapPairsM, pairM,
+                   -- ** Monadic operations on lists and pairs
+		   mapPairListM, mapPairsM, pairM,
 
 		   -- ** Printing
 		   indent, (+++), (++-), (++++), (+++-), (+++++),
@@ -39,7 +39,8 @@ module GF.Data.Operations (
 		   topoTest, topoTest2,

 		   -- ** Misc
-		   readIntArg,
+		   ifNull,
+		   combinations, done, readIntArg, --singleton,
 		   iterFix,  chunks,
                
 		  ) where
@@ -53,13 +54,15 @@ import Control.Monad (liftM,liftM2) --,ap

 import GF.Data.ErrM
 import GF.Data.Relation
-import qualified Control.Monad.Fail as Fail

 infixr 5 +++
 infixr 5 ++-
 infixr 5 ++++
 infixr 5 +++++

+ifNull :: b -> ([a] -> b) -> [a] -> b
+ifNull b f xs = if null xs then b else f xs
+
 -- the Error monad

 -- | Add msg s to 'Maybe' failures
@@ -67,7 +70,7 @@ maybeErr :: ErrorMonad m => String -> Maybe a -> m a
 maybeErr s = maybe (raise s) return

 testErr :: ErrorMonad m => Bool -> String -> m ()
-testErr cond msg = if cond then return () else raise msg
+testErr cond msg = if cond then done else raise msg

 errIn :: ErrorMonad m => String -> m a -> m a
 errIn msg m = handle m (\s -> raise (s ++++ "OCCURRED IN" ++++ msg))
@@ -75,6 +78,9 @@ errIn msg m = handle m (\s -> raise (s ++++ "OCCURRED IN" ++++ msg))
 lookupErr :: (ErrorMonad m,Eq a,Show a) => a -> [(a,b)] -> m b
 lookupErr a abs = maybeErr ("Unknown" +++ show a) (lookup a abs)

+mapPairListM :: Monad m => ((a,b) -> m c) -> [(a,b)] -> m [(a,c)]
+mapPairListM f xys = mapM (\ p@(x,_) -> liftM ((,) x) (f p)) xys
+
 mapPairsM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
 mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys

@@ -89,10 +95,10 @@ checkUnique ss = ["overloaded" +++ show s | s <- nub overloads] where
  overloaded s = length (filter (==s) ss) > 1

 -- | this is what happens when matching two values in the same module
-unifyMaybe :: (Eq a, Fail.MonadFail m) => Maybe a -> Maybe a -> m (Maybe a)
+unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a)
 unifyMaybe = unifyMaybeBy id

-unifyMaybeBy :: (Eq b, Fail.MonadFail m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
+unifyMaybeBy :: (Eq b, Monad m) => (a->b) -> Maybe a -> Maybe a -> m (Maybe a)
 unifyMaybeBy f (Just p1) (Just p2)
  | f p1==f p2                     = return (Just p1)
  | otherwise                      = fail ""
@@ -187,6 +193,21 @@ wrapLines n s@(c:cs) =
                     l = length w
            _ -> s -- give up!!

+--- optWrapLines = if argFlag "wraplines" True then wrapLines 0 else id
+
+-- | 'combinations' is the same as 'sequence'!!!
+-- peb 30\/5-04
+combinations :: [[a]] -> [[a]]
+combinations t = case t of 
+  []    -> [[]]
+  aa:uu -> [a:u | a <- aa, u <- combinations uu]
+
+{-
+-- | 'singleton' is the same as 'return'!!!
+singleton :: a -> [a]
+singleton = (:[])
+-}
+
 -- | Topological sorting with test of cyclicity
 topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]
 topoTest = topologicalSort . mkRel'
@@ -226,6 +247,10 @@ chunks sep ws = case span (/= sep) ws of
 readIntArg :: String -> Int
 readIntArg n = if (not (null n) && all isDigit n) then read n else 0

+-- | @return ()@
+done :: Monad m => m ()
+done = return ()
+
 class (Functor m,Monad m) => ErrorMonad m where
  raise   :: String -> m a
  handle  :: m a -> (String -> m a) -> m a
--- a/src/compiler/GF/Grammar/Analyse.hs
+++ b/src/compiler/GF/Grammar/Analyse.hs
@@ -29,7 +29,7 @@ stripInfo i = case i of
  AbsCat _ -> i
  AbsFun mt mi me mb -> AbsFun mt mi Nothing mb
  ResParam mp mt -> ResParam mp Nothing
-  ResValue lt -> i ----
+  ResValue _ lt -> i ----
  ResOper mt md -> ResOper mt Nothing
  ResOverload is fs -> ResOverload is [(lty, L loc (EInt 0)) | (lty,L loc _) <- fs]
  CncCat mty mte _ mtf mpmcfg -> CncCat mty Nothing Nothing Nothing Nothing
@@ -107,8 +107,8 @@ sizeInfo i = case i of
  AbsFun mt mi me mb -> 1 + msize mt + 
    sum [sum (map (sizeTerm . patt2term) ps) + sizeTerm t | Just es <- [me], L _ (ps,t) <- es]
  ResParam mp mt -> 
-    1 + sum [1 + sum [1 + sizeTerm ty | (_,_,ty) <- co] | Just (L _ ps) <- [mp], (_,co) <- ps]
-  ResValue lt -> 0
+    1 + sum [1 + sum [1 + sizeTerm ty | (_,_,ty) <- co] | Just (L _ ps) <- [mp], (_,co,_) <- ps]
+  ResValue _ lt -> 0
  ResOper mt md -> 1 + msize mt + msize md
  ResOverload is fs -> 1 + sum [sizeTerm ty + sizeTerm tr | (L _ ty, L _ tr) <- fs]
  CncCat mty _ _ _ _ -> 1 + msize mty   -- ignoring lindef, linref and printname
--- a/src/compiler/GF/Grammar/BNFC.hs
+++ b/src/compiler/GF/Grammar/BNFC.hs
@@ -15,7 +15,6 @@
 module GF.Grammar.BNFC(BNFCRule(..), BNFCSymbol, Symbol(..), CFTerm(..), bnfc2cf) where

 import GF.Grammar.CFG
-import PGF (Token, mkCId)
 import Data.List (partition)

 type IsList = Bool
@@ -64,12 +63,12 @@ transformRules sepMap (BNFCCoercions c num) = rules ++ [lastRule]
                lastRule = Rule (c',[0]) ss rn
                  where c' = c ++ show num
                        ss = [Terminal "(", NonTerminal (c,[0]), Terminal ")"]
-                        rn = CFObj (mkCId $ "coercion_" ++ c) []
+                        rn = CFObj ("coercion_" ++ c) []

 fRules c n = Rule (c',[0]) ss rn
   where c' = if n == 0 then c else c ++ show n
         ss = [NonTerminal (c ++ show (n+1),[0])]
-         rn = CFObj (mkCId $ "coercion_" ++ c') []
+         rn = CFObj ("coercion_" ++ c') []

 transformSymb :: SepMap -> BNFCSymbol -> (String, ParamCFSymbol)
 transformSymb sepMap s = case s of
@@ -94,7 +93,7 @@ createListRules' ne isSep symb c = ruleBase : ruleCons
                       then [NonTerminal (c,[0]) | ne]
                       else [NonTerminal (c,[0]) | ne] ++
                            [Terminal symb | symb /= "" && ne]
-                rn   = CFObj (mkCId $ "Base" ++ c) []
+                rn   = CFObj ("Base" ++ c) []
        ruleCons
          | isSep && symb /= "" && not ne = [Rule ("List" ++ c,[1]) smbs0 rn
                                            ,Rule ("List" ++ c,[1]) smbs1 rn]
@@ -107,4 +106,4 @@ createListRules' ne isSep symb c = ruleBase : ruleCons
                smbs = [NonTerminal (c,[0])] ++
                       [Terminal symb | symb /= ""] ++
                       [NonTerminal ("List" ++ c,[0])]
-                rn   = CFObj (mkCId $ "Cons" ++ c) []
+                rn   = CFObj ("Cons" ++ c) []
--- a/src/compiler/GF/Grammar/Binary.hs
+++ b/src/compiler/GF/Grammar/Binary.hs
@@ -10,9 +10,9 @@
 module GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader,decodeModule,encodeModule) where

 import Prelude hiding (catch)
+import Control.Monad
 import Control.Exception(catch,ErrorCall(..),throwIO)
-
-import PGF.Internal(Binary(..),Word8,putWord8,getWord8,encodeFile,decodeFile)
+import Data.Binary
 import qualified Data.Map as Map(empty)
 import qualified Data.ByteString.Char8 as BS

@@ -22,11 +22,10 @@ import GF.Infra.Option
 import GF.Infra.UseIO(MonadIO(..))
 import GF.Grammar.Grammar

-import PGF() -- Binary instances
-import PGF.Internal(Literal(..))
+import PGF2.Internal(Literal(..),Symbol(..))

 -- Please change this every time when the GFO format is changed
-gfoVersion = "GF04"
+gfoVersion = "GF05"

 instance Binary Ident where
  put id = put (ident2utf8 id)
@@ -120,7 +119,7 @@ instance Binary Info where
  put (AbsCat x)       = putWord8 0 >> put x
  put (AbsFun w x y z) = putWord8 1 >> put (w,x,y,z)
  put (ResParam x y)   = putWord8 2 >> put (x,y)
-  put (ResValue x)     = putWord8 3 >> put x
+  put (ResValue x y)   = putWord8 3 >> put (x,y)
  put (ResOper x y)    = putWord8 4 >> put (x,y)
  put (ResOverload x y)= putWord8 5 >> put (x,y)
  put (CncCat v w x y z)=putWord8 6 >> put (v,w,x,y,z)
@@ -131,7 +130,7 @@ instance Binary Info where
             0 -> get >>= \x         -> return (AbsCat x)
             1 -> get >>= \(w,x,y,z) -> return (AbsFun w x y z)
             2 -> get >>= \(x,y)     -> return (ResParam x y)
-             3 -> get >>= \x         -> return (ResValue x)
+             3 -> get >>= \(x,y)     -> return (ResValue x y)
             4 -> get >>= \(x,y)     -> return (ResOper x y)
             5 -> get >>= \(x,y)     -> return (ResOverload x y)
             6 -> get >>= \(v,w,x,y,z)->return (CncCat v w x y z)
@@ -298,6 +297,53 @@ instance Binary Label where
             1 -> fmap LVar   get
             _ -> decodingError

+instance Binary BindType where
+  put Explicit = putWord8 0
+  put Implicit = putWord8 1
+  get = do tag <- getWord8
+           case tag of
+             0 -> return Explicit
+             1 -> return Implicit
+             _ -> decodingError
+
+instance Binary Literal where
+  put (LStr s) = putWord8 0 >> put s
+  put (LInt i) = putWord8 1 >> put i
+  put (LFlt d) = putWord8 2 >> put d
+  get = do tag <- getWord8
+           case tag of
+             0 -> liftM  LStr get
+             1 -> liftM  LInt get
+             2 -> liftM  LFlt get
+             _ -> decodingError
+
+instance Binary Symbol where
+  put (SymCat n l)       = putWord8 0 >> put (n,l)
+  put (SymLit n l)       = putWord8 1 >> put (n,l)
+  put (SymVar n l)       = putWord8 2 >> put (n,l)
+  put (SymKS ts)         = putWord8 3 >> put ts
+  put (SymKP d vs)       = putWord8 4 >> put (d,vs)
+  put SymBIND            = putWord8 5
+  put SymSOFT_BIND       = putWord8 6
+  put SymNE              = putWord8 7
+  put SymSOFT_SPACE      = putWord8 8
+  put SymCAPIT           = putWord8 9
+  put SymALL_CAPIT       = putWord8 10
+  get = do tag <- getWord8
+           case tag of
+             0 -> liftM2 SymCat get get
+             1 -> liftM2 SymLit get get
+             2 -> liftM2 SymVar get get
+             3 -> liftM  SymKS  get
+             4 -> liftM2 (\d vs -> SymKP d vs) get get
+             5 -> return SymBIND
+             6 -> return SymSOFT_BIND
+             7 -> return SymNE
+             8 -> return SymSOFT_SPACE
+             9 -> return SymCAPIT
+             10-> return SymALL_CAPIT
+             _ -> decodingError
+
 --putGFOVersion = mapM_ (putWord8 . fromIntegral . ord) gfoVersion
 --getGFOVersion = replicateM (length gfoVersion) (fmap (chr . fromIntegral) getWord8)
 --putGFOVersion = put gfoVersion
--- a/src/compiler/GF/Grammar/CFG.hs
+++ b/src/compiler/GF/Grammar/CFG.hs
@@ -4,10 +4,11 @@
 --
 -- Context-free grammar representation and manipulation.
 ----------------------------------------------------------------------
-module GF.Grammar.CFG where
+module GF.Grammar.CFG(Cat,Token, module GF.Grammar.CFG) where

 import GF.Data.Utilities
-import PGF
+import PGF2(Fun,Cat)
+import PGF2.Internal(Token)
 import GF.Data.Relation

 import Data.Map (Map)
@@ -20,8 +21,6 @@ import qualified Data.Set as Set
 -- * Types
 --

-type Cat = String
-
 data Symbol c t = NonTerminal c | Terminal t
  deriving (Eq, Ord, Show)

@@ -39,12 +38,12 @@ data Grammar c t = Grammar {
  deriving (Eq, Ord, Show)

 data CFTerm
-    = CFObj CId [CFTerm] -- ^ an abstract syntax function with arguments
+    = CFObj Fun [CFTerm] -- ^ an abstract syntax function with arguments
    | CFAbs Int CFTerm -- ^ A lambda abstraction. The Int is the variable id.
    | CFApp CFTerm CFTerm -- ^ Application
    | CFRes Int -- ^ The result of the n:th (0-based) non-terminal
    | CFVar Int -- ^ A lambda-bound variable
-    | CFMeta CId -- ^ A metavariable
+    | CFMeta Fun -- ^ A metavariable
  deriving (Eq, Ord, Show)

 type CFSymbol = Symbol  Cat Token
@@ -232,7 +231,7 @@ uniqueFuns = snd . mapAccumL uniqueFun Set.empty
    uniqueFun funs (Rule cat items (CFObj fun args)) = (Set.insert fun' funs,Rule cat items (CFObj fun' args))
      where
        fun' = head [fun'|suffix<-"":map show ([2..]::[Int]),
-                          let fun'=mkCId (showCId fun++suffix),
+                          let fun'=fun++suffix,
                          not (fun' `Set.member` funs)]

 -- | Gets all rules in a CFG.
@@ -310,12 +309,12 @@ prProductions prods =
 prCFTerm :: CFTerm -> String
 prCFTerm = pr 0
  where
-    pr p (CFObj f args) = paren p (showCId f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
+    pr p (CFObj f args) = paren p (f ++ " (" ++ concat (intersperse "," (map (pr 0) args)) ++ ")")
    pr p (CFAbs i t) = paren p ("\\x" ++ show i ++ ". " ++ pr 0 t)
    pr p (CFApp t1 t2) = paren p (pr 1 t1 ++ "(" ++ pr 0 t2 ++ ")")
    pr _ (CFRes i) = "$" ++ show i
    pr _ (CFVar i) = "x" ++ show i
-    pr _ (CFMeta c) = "?" ++ showCId c
+    pr _ (CFMeta c) = "?" ++ c
    paren 0 x = x
    paren 1 x = "(" ++ x ++ ")"

@@ -323,12 +322,12 @@ prCFTerm = pr 0
 -- * CFRule Utilities
 --

-ruleFun :: Rule c t -> CId
+ruleFun :: Rule c t -> Fun
 ruleFun (Rule _ _ t) = f t
  where f (CFObj n _) = n
        f (CFApp _ x) = f x
        f (CFAbs _ x) = f x
-        f _ = mkCId ""
+        f _ = ""

 -- | Check if any of the categories used on the right-hand side
 --   are in the given list of categories.
@@ -336,7 +335,7 @@ anyUsedBy :: Eq c => [c] -> Rule c t -> Bool
 anyUsedBy cs (Rule _ ss _) = any (`elem` cs) (filterCats ss)

 mkCFTerm :: String -> CFTerm
-mkCFTerm n = CFObj (mkCId n) []
+mkCFTerm n = CFObj n []

 ruleIsNonRecursive :: Ord c => Set c -> Rule c t -> Bool
 ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs
--- a/src/compiler/GF/Grammar/Canonical.hs
+++ b/src/compiler/GF/Grammar/Canonical.hs
@@ -11,7 +11,6 @@
 module GF.Grammar.Canonical where
 import Prelude hiding ((<>))
 import GF.Text.Pretty
-import GF.Infra.Ident (RawIdent)

 -- | A Complete grammar
 data Grammar = Grammar Abstract [Concrete] deriving Show
@@ -127,7 +126,7 @@ data FlagValue = Str String | Int Int | Flt Double deriving Show

 -- *** Identifiers

-type Id = RawIdent
+type Id = String
 data QualId = Qual ModId Id | Unqual Id  deriving (Eq,Ord,Show)

 --------------------------------------------------------------------------------
@@ -266,6 +265,7 @@ instance PPA LinPattern where
      RecordPattern r -> block r
      TuplePattern ps -> "<"<>punctuate "," ps<>">"
      WildPattern     -> pp "_"                
+      _ -> parens p

 instance RhsSeparator LinPattern where rhsSep _ = pp "="

--- a/src/compiler/GF/Grammar/CanonicalJSON.hs
+++ b/src/compiler/GF/Grammar/CanonicalJSON.hs
@@ -6,8 +6,6 @@ import Text.JSON
 import Control.Applicative ((<|>))
 import Data.Ratio (denominator, numerator)
 import GF.Grammar.Canonical
-import Control.Monad (guard)
-import GF.Infra.Ident (RawIdent,showRawIdent,rawIdentS)


 encodeJSON :: FilePath -> Grammar -> IO ()
@@ -30,7 +28,7 @@ instance JSON Grammar where
 -- ** Abstract Syntax

 instance JSON Abstract where
-  showJSON (Abstract absid flags cats funs)
+  showJSON (Abstract absid flags cats funs) 
    = makeObj [("abs", showJSON absid),
               ("flags", showJSON flags),
               ("cats", showJSON cats),
@@ -82,7 +80,7 @@ instance JSON TypeBinding where
 -- ** Concrete syntax

 instance JSON Concrete where
-  showJSON (Concrete cncid absid flags params lincats lins)
+  showJSON (Concrete cncid absid flags params lincats lins) 
    = makeObj [("cnc", showJSON cncid),
               ("abs", showJSON absid),
               ("flags", showJSON flags),
@@ -128,10 +126,10 @@ instance JSON LinType where
  -- records are encoded as records:
  showJSON (RecordType rows) = showJSON rows

-  readJSON o = StrType   <$ parseString "Str"   o
-    <|>        FloatType <$ parseString "Float" o
-    <|>        IntType   <$ parseString "Int"   o
-    <|>        ParamType <$> readJSON o
+  readJSON o = do "Str"   <- readJSON o; return StrType
+    <|>        do "Float" <- readJSON o; return FloatType
+    <|>        do "Int"   <- readJSON o; return IntType
+    <|>        do  ptype  <- readJSON o; return (ParamType ptype)
    <|>        TableType  <$> o!".tblarg" <*> o!".tblval"
    <|>        TupleType  <$> o!".tuple"
    <|>        RecordType <$> readJSON o
@@ -188,7 +186,7 @@ instance JSON LinPattern where
  -- and records as records:
  showJSON (RecordPattern r) = showJSON r

-  readJSON o = do  p  <- parseString "_" o; return WildPattern
+  readJSON o = do "_" <- readJSON o; return WildPattern
    <|>        do  p  <- readJSON o; return (ParamPattern (Param p []))
    <|>        ParamPattern  <$> readJSON o
    <|>        RecordPattern <$> readJSON o
@@ -205,12 +203,12 @@ instance JSON a => JSON (RecordRow a) where
  -- record rows and lists of record rows are both encoded as JSON records (i.e., objects)
  showJSON  row  = showJSONs [row]
  showJSONs rows = makeObj (map toRow rows)
-    where toRow (RecordRow (LabelId lbl) val) = (showRawIdent lbl, showJSON val)
+    where toRow (RecordRow (LabelId lbl) val) = (lbl, showJSON val)

  readJSON  obj = head <$> readJSONs obj
  readJSONs obj = mapM fromRow (assocsJSObject obj)
    where fromRow (lbl, jsvalue) = do value <- readJSON jsvalue
-                                      return (RecordRow (LabelId (rawIdentS lbl)) value)
+                                      return (RecordRow (LabelId lbl) value)

 instance JSON rhs => JSON (TableRow rhs) where
  showJSON (TableRow l v) = makeObj [(".pattern", showJSON l), (".value", showJSON v)]
@@ -220,47 +218,43 @@ instance JSON rhs => JSON (TableRow rhs) where

 -- *** Identifiers in Concrete Syntax

-instance JSON PredefId   where showJSON (PredefId    s) = showJSON s ; readJSON = fmap PredefId    . readJSON
-instance JSON LabelId    where showJSON (LabelId     s) = showJSON s ; readJSON = fmap LabelId     . readJSON
-instance JSON VarValueId where showJSON (VarValueId  s) = showJSON s ; readJSON = fmap VarValueId  . readJSON
-instance JSON ParamId    where showJSON (ParamId     s) = showJSON s ; readJSON = fmap ParamId     . readJSON
-instance JSON ParamType  where showJSON (ParamTypeId s) = showJSON s ; readJSON = fmap ParamTypeId . readJSON
+instance JSON PredefId   where showJSON (PredefId    s) = showJSON s ; readJSON = fmap PredefId    . readJSON 
+instance JSON LabelId    where showJSON (LabelId     s) = showJSON s ; readJSON = fmap LabelId     . readJSON 
+instance JSON VarValueId where showJSON (VarValueId  s) = showJSON s ; readJSON = fmap VarValueId  . readJSON 
+instance JSON ParamId    where showJSON (ParamId     s) = showJSON s ; readJSON = fmap ParamId     . readJSON 
+instance JSON ParamType  where showJSON (ParamTypeId s) = showJSON s ; readJSON = fmap ParamTypeId . readJSON 


 --------------------------------------------------------------------------------
 -- ** Used in both Abstract and Concrete Syntax

-instance JSON ModId where showJSON (ModId s) = showJSON s ; readJSON = fmap ModId . readJSON
-instance JSON CatId where showJSON (CatId s) = showJSON s ; readJSON = fmap CatId . readJSON
-instance JSON FunId where showJSON (FunId s) = showJSON s ; readJSON = fmap FunId . readJSON
+instance JSON ModId where showJSON (ModId s) = showJSON s ; readJSON = fmap ModId . readJSON 
+instance JSON CatId where showJSON (CatId s) = showJSON s ; readJSON = fmap CatId . readJSON 
+instance JSON FunId where showJSON (FunId s) = showJSON s ; readJSON = fmap FunId . readJSON 

 instance JSON VarId where
  -- the anonymous variable is the underscore:
  showJSON Anonymous = showJSON "_"
  showJSON (VarId x) = showJSON x

-  readJSON o = do parseString "_" o; return Anonymous
+  readJSON o = do "_" <- readJSON o; return Anonymous
    <|>        VarId <$> readJSON o

 instance JSON QualId where
-  showJSON (Qual (ModId m) n) = showJSON (showRawIdent m++"."++showRawIdent n)
+  showJSON (Qual (ModId m) n) = showJSON (m++"."++n)
  showJSON (Unqual n) = showJSON n

  readJSON o = do qualid <- readJSON o
                  let (mod, id) = span (/= '.') qualid
-                  return $ if null mod then Unqual (rawIdentS id) else Qual (ModId (rawIdentS mod)) (rawIdentS id)
-
-instance JSON RawIdent where
-  showJSON i = showJSON $ showRawIdent i
-  readJSON o = rawIdentS <$> readJSON o
+                  return $ if null mod then Unqual id else Qual (ModId mod) id

 instance JSON Flags where
  -- flags are encoded directly as JSON records (i.e., objects):
-  showJSON (Flags fs) = makeObj [(showRawIdent f, showJSON v) | (f, v) <- fs]
+  showJSON (Flags fs) = makeObj [(f, showJSON v) | (f, v) <- fs]

  readJSON obj = Flags <$> mapM fromRow (assocsJSObject obj)
    where fromRow (lbl, jsvalue) = do value <- readJSON jsvalue
-                                      return (rawIdentS lbl, value)
+                                      return (lbl, value)

 instance JSON FlagValue where
  -- flag values are encoded as basic JSON types:
@@ -274,9 +268,6 @@ instance JSON FlagValue where
 --------------------------------------------------------------------------------
 -- ** Convenience functions

-parseString :: String -> JSValue -> Result ()
-parseString s o = guard . (== s) =<< readJSON o
-
 (!) :: JSON a => JSValue -> String -> Result a
 obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key)
            readJSON
--- a/src/compiler/GF/Grammar/EBNF.hs
+++ b/src/compiler/GF/Grammar/EBNF.hs
@@ -16,7 +16,6 @@ module GF.Grammar.EBNF (EBNF, ERule, ERHS(..), ebnf2cf) where

 import GF.Data.Operations
 import GF.Grammar.CFG
-import PGF (mkCId)

 type EBNF = [ERule]
 type ERule = (ECat, ERHS)
@@ -40,7 +39,7 @@ ebnf2cf :: EBNF -> [ParamCFRule]
 ebnf2cf ebnf = 
  [Rule cat items (mkCFF i cat) | (i,(cat,items)) <- zip [0..] (normEBNF ebnf)]
  where
-    mkCFF i (c,_) = CFObj (mkCId ("Mk" ++ c ++ "_" ++ show i)) []
+    mkCFF i (c,_) = CFObj ("Mk" ++ c ++ "_" ++ show i) []

 normEBNF :: EBNF -> [CFJustRule]
 normEBNF erules = let
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -64,7 +64,7 @@ module GF.Grammar.Grammar (
        Location(..), L(..), unLoc, noLoc, ppLocation, ppL,

        -- ** PMCFG        
-        PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence
+        PMCFG(..), Production(..), FId, FunId, SeqId, LIndex
        ) where

 import GF.Infra.Ident
@@ -73,7 +73,8 @@ import GF.Infra.Location

 import GF.Data.Operations

-import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..))
+import PGF2(LIndex, BindType(..))
+import PGF2.Internal(FId, FunId, SeqId, Symbol)

 import Data.Array.IArray(Array)
 import Data.Array.Unboxed(UArray)
@@ -99,7 +100,7 @@ data ModuleInfo = ModInfo {
    mopens  :: [OpenSpec],
    mexdeps :: [ModuleName],
    msrc    :: FilePath,
-    mseqs   :: Maybe (Array SeqId Sequence),
+    mseqs   :: Maybe (Array SeqId [Symbol]),
    jments  :: Map.Map Ident Info
  }

@@ -329,7 +330,7 @@ data Info =

 -- judgements in resource
 | ResParam (Maybe (L [Param])) (Maybe [Term])   -- ^ (/RES/) the second parameter is list of all possible values
- | ResValue (L Type)                             -- ^ (/RES/) to mark parameter constructors for lookup
+ | ResValue (L Type) Int                         -- ^ (/RES/) to mark parameter constructors for lookup
 | ResOper  (Maybe (L Type)) (Maybe (L Term))    -- ^ (/RES/)

 | ResOverload [ModuleName] [(L Type,L Term)]         -- ^ (/RES/) idents: modules inherited
@@ -458,7 +459,7 @@ type Case = (Patt, Term)
 --type Cases = ([Patt], Term) 
 type LocalDef = (Ident, (Maybe Type, Term))

-type Param = (Ident, Context) 
+type Param = (Ident, Context, Int) 
 type Altern = (Term, [(Term, Term)])

 type Substitution =  [(Ident, Term)]
--- a/src/compiler/GF/Grammar/Lexer.x
+++ b/src/compiler/GF/Grammar/Lexer.x
@@ -1,6 +1,5 @@
 -- -*- haskell -*-
 {
-{-# LANGUAGE CPP #-}
 module GF.Grammar.Lexer
         ( Token(..), Posn(..)
         , P, runP, runPartial, token, lexer, getPosn, failLoc
@@ -19,7 +18,6 @@ import qualified Data.Map as Map
 import Data.Word(Word8)
 import Data.Char(readLitChar)
 --import Debug.Trace(trace)
-import qualified Control.Monad.Fail as Fail
 }


@@ -35,7 +33,7 @@ $u = [.\n]                -- universal: any character

 :-
 "--" [.]* ; -- Toss single line comments
-"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 

 $white+ ;
@rsyms                          { tok ident }
@@ -138,7 +136,7 @@ data Token

 res = eitherResIdent
 eitherResIdent :: (Ident -> Token) -> Ident -> Token
-eitherResIdent tv s =
+eitherResIdent tv s = 
  case Map.lookup s resWords of
    Just t  -> t
    Nothing -> tv s
@@ -284,16 +282,8 @@ instance Monad P where
  (P m) >>= k = P $ \ s -> case m s of
                             POk s a          -> unP (k a) s
                             PFailed posn err -> PFailed posn err
-
-#if !(MIN_VERSION_base(4,13,0))
-  -- Monad(fail) will be removed in GHC 8.8+
-  fail = Fail.fail
-#endif
-
-instance Fail.MonadFail P where
  fail msg    = P $ \(_,AI posn _ _) -> PFailed posn msg

-
 runP :: P a -> BS.ByteString -> Either (Posn,String) a
 runP p bs = snd <$> runP' p (Pn 1 0,bs)

--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -23,10 +23,11 @@ module GF.Grammar.Lookup (
           lookupResType, 
           lookupOverload,
           lookupOverloadTypes,
-           lookupParamValues, 
+           lookupParamValues,
           allParamValues,
-           lookupAbsDef, 
-           lookupLincat, 
+           lookupParamValueIndex,
+           lookupAbsDef,
+           lookupLincat,
           lookupFunType,
           lookupCatContext,
           allOpers, allOpersTo
@@ -83,7 +84,7 @@ lookupResDefLoc gr (m,c)

        AnyInd _ n        -> look n c
        ResParam _ _      -> return (noLoc (QC (m,c)))
-        ResValue _        -> return (noLoc (QC (m,c)))
+        ResValue _ _      -> return (noLoc (QC (m,c)))
        _   -> raise $ render (c <+> "is not defined in resource" <+> m)

 lookupResType :: ErrorMonad m => Grammar -> QIdent -> m Type
@@ -99,7 +100,7 @@ lookupResType gr (m,c) = do
          return $ mkProd cont val' []
    AnyInd _ n        -> lookupResType gr (n,c)
    ResParam _ _      -> return typePType
-    ResValue (L _ t)  -> return t
+    ResValue (L _ t) _-> return t
    _   -> raise $ render (c <+> "has no type defined in resource" <+> m)

 lookupOverloadTypes :: ErrorMonad m => Grammar -> QIdent -> m [(Term,Type)]
@@ -113,8 +114,8 @@ lookupOverloadTypes gr id@(m,c) = do
    CncFun (Just (cat,cont,val)) _ _ _ -> do
          val' <- lock cat val 
          ret $ mkProd cont val' []
-    ResParam _ _      -> ret typePType
-    ResValue (L _ t)  -> ret t
+    ResParam _ _       -> ret typePType
+    ResValue (L _ t) _ -> ret t
    ResOverload os tysts -> do
            tss <- mapM (\x -> lookupOverloadTypes gr (x,c)) os
            return $ [(tr,ty) | (L _ ty,L _ tr) <- tysts] ++
@@ -166,16 +167,23 @@ allParamValues cnc ptyp =
    RecType r -> do
       let (ls,tys) = unzip $ sortByFst r
       tss <- mapM (allParamValues cnc) tys
-       return [R (zipAssign ls ts) | ts <- sequence tss]
+       return [R (zipAssign ls ts) | ts <- combinations tss]
    Table pt vt -> do
       pvs <- allParamValues cnc pt
       vvs <- allParamValues cnc vt
-       return [V pt ts | ts <- sequence (replicate (length pvs) vvs)]
+       return [V pt ts | ts <- combinations (replicate (length pvs) vvs)]
    _ -> raise (render ("cannot find parameter values for" <+> ptyp))
  where
    -- to normalize records and record types
    sortByFst = sortBy (\ x y -> compare (fst x) (fst y))

+lookupParamValueIndex :: ErrorMonad m => Grammar -> QIdent -> m Int
+lookupParamValueIndex gr c = do
+  (_,info) <- lookupOrigInfo gr c
+  case info of
+    ResValue _ i -> return i
+    _            -> raise $ render (ppQIdent Qualified c <+> "has no parameter index defined")
+
 lookupAbsDef :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m (Maybe Int,Maybe [Equation])
 lookupAbsDef gr m c = errIn (render ("looking up absdef of" <+> c)) $ do
  info <- lookupQIdentInfo gr (m,c)
@@ -226,7 +234,7 @@ allOpers gr =
    typesIn info = case info of
      AbsFun  (Just ltyp) _ _ _ -> [ltyp]
      ResOper (Just ltyp) _     -> [ltyp]
-      ResValue ltyp             -> [ltyp]
+      ResValue ltyp _           -> [ltyp]
      ResOverload _ tytrs       -> [ltyp | (ltyp,_) <- tytrs]
      CncFun  (Just (i,ctx,typ)) _ _ _ ->
                                   [L NoLoc (mkProdSimple ctx (lock' i typ))]
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/11/11 16:38:00 $
+-- > CVS $Date: 2005/11/11 16:38:00 $ 
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.24 $
 --
@@ -32,7 +32,6 @@ import Control.Monad (liftM, liftM2, liftM3)
 import Data.List (sortBy,nub)
 import Data.Monoid
 import GF.Text.Pretty(render,(<+>),hsep,fsep)
-import qualified Control.Monad.Fail as Fail

 -- ** Functions for constructing and analysing source code terms.

@@ -48,17 +47,17 @@ typeForm t =
    Q  c -> ([],c,[])
    QC c -> ([],c,[])
    Sort c -> ([],(MN identW, c),[])
-    _      -> error (render ("no normal form of type" <+> ppTerm Unqualified 0 t))
+    _      -> error (render ("no normal form of type" <+> show t))

 typeFormCnc :: Type -> (Context, Type)
-typeFormCnc t =
+typeFormCnc t = 
  case t of
    Prod b x a t -> let (x', v) = typeFormCnc t
                    in ((b,x,a):x',v)
    _            -> ([],t)

 valCat :: Type -> Cat
-valCat typ =
+valCat typ = 
  let (_,cat,_) = typeForm typ
  in cat

@@ -99,7 +98,7 @@ isHigherOrderType t = fromErr True $ do  -- pessimistic choice
 contextOfType :: Monad m => Type -> m Context
 contextOfType typ = case typ of
  Prod b x a t -> liftM ((b,x,a):) $ contextOfType t
-  _            -> return []
+  _            -> return [] 

 termForm :: Monad m => Term -> m ([(BindType,Ident)], Term, [Term])
 termForm t = case t of
@@ -108,8 +107,8 @@ termForm t = case t of
        return ((b,x):x', fun, args)
   App c a ->
     do (_,fun, args) <- termForm c
-        return ([],fun,args ++ [a])
-   _       ->
+        return ([],fun,args ++ [a]) 
+   _       -> 
     return ([],t,[])

 termFormCnc :: Term -> ([(BindType,Ident)], Term)
@@ -238,7 +237,7 @@ isPredefConstant t = case t of
  Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True
  _                                               -> False

-checkPredefError :: Fail.MonadFail m => Term -> m Term
+checkPredefError :: Monad m => Term -> m Term
 checkPredefError t =
    case t of
      Error s -> fail ("Error: "++s)
@@ -254,7 +253,7 @@ mkTable :: [Term] -> Term -> Term
 mkTable tt t = foldr Table t tt

 mkCTable :: [(BindType,Ident)] -> Term -> Term
-mkCTable ids v = foldr ccase v ids where
+mkCTable ids v = foldr ccase v ids where 
  ccase (_,x) t = T TRaw [(PV x,t)]

 mkHypo :: Term -> Hypo
@@ -287,7 +286,7 @@ plusRecType t1 t2 = case (t1, t2) of
    filter (`elem` (map fst r1)) (map fst r2) of
      [] -> return (RecType (r1 ++ r2))
      ls -> raise $ render ("clashing labels" <+> hsep ls)
-  _ -> raise $ render ("cannot add record types" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2)
+  _ -> raise $ render ("cannot add record types" <+> ppTerm Unqualified 0 t1 <+> "and" <+> ppTerm Unqualified 0 t2) 

 --plusRecord :: Term -> Term -> Err Term
 plusRecord t1 t2 =
@@ -304,7 +303,7 @@ defLinType = RecType [(theLinLabel,  typeStr)]

 -- | refreshing variables
 mkFreshVar :: [Ident] -> Ident
-mkFreshVar olds = varX (maxVarIndex olds + 1)
+mkFreshVar olds = varX (maxVarIndex olds + 1) 

 -- | trying to preserve a given symbol
 mkFreshVarX :: [Ident] -> Ident -> Ident
@@ -313,7 +312,7 @@ mkFreshVarX olds x = if (elem x olds) then (varX (maxVarIndex olds + 1)) else x
 maxVarIndex :: [Ident] -> Int
 maxVarIndex = maximum . ((-1):) . map varIndex

-mkFreshVars :: Int -> [Ident] -> [Ident]
+mkFreshVars :: Int -> [Ident] -> [Ident] 
 mkFreshVars n olds = [varX (maxVarIndex olds + i) | i <- [1..n]]

 -- | quick hack for refining with var in editor
@@ -413,11 +412,11 @@ patt2term pt = case pt of
  PC c pp   -> mkApp (Con c) (map patt2term pp)
  PP c pp   -> mkApp (QC  c) (map patt2term pp)

-  PR r      -> R [assign l (patt2term p) | (l,p) <- r]
+  PR r      -> R [assign l (patt2term p) | (l,p) <- r] 
  PT _ p    -> patt2term p
  PInt i    -> EInt i
  PFloat i  -> EFloat i
-  PString s -> K s
+  PString s -> K s 

  PAs x p   -> appCons cAs    [Vr x, patt2term p]            --- an encoding
  PChar     -> appCons cChar  []                             --- an encoding
@@ -436,7 +435,7 @@ composSafeOp op = runIdentity . composOp (return . op)

 -- | to define compositional term functions
 composOp :: Monad m => (Term -> m Term) -> Term -> m Term
-composOp co trm =
+composOp co trm = 
 case trm of
   App c a          -> liftM2 App (co c) (co a)
   Abs b x t        -> liftM (Abs b x) (co t)
@@ -552,15 +551,19 @@ strsFromTerm t = case t of
    v0 <- mapM (strsFromTerm . fst) vs
    c0 <- mapM (strsFromTerm . snd) vs
  --let vs' = zip v0 c0
-    return [strTok (str2strings def) vars |
+    return [strTok (str2strings def) vars | 
              def  <- d0,
-              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
-                                                          vv <- sequence v0]
+              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
+                                                          vv <- combinations v0]
           ]
  FV ts -> mapM strsFromTerm ts >>= return . concat
-  Strs ts -> mapM strsFromTerm ts >>= return . concat
+  Strs ts -> mapM strsFromTerm ts >>= return . concat  
  _ -> raise (render ("cannot get Str from term" <+> ppTerm Unqualified 0 t))

+-- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg
+stringFromTerm :: Term -> String
+stringFromTerm = err id (ifNull "" (sstr . head)) . strsFromTerm
+
 getTableType :: TInfo -> Err Type
 getTableType i = case i of
  TTyped ty -> return ty
@@ -590,11 +593,11 @@ noExist = FV []
 defaultLinType :: Type
 defaultLinType = mkRecType linLabel [typeStr]

-- | normalize records and record types; put s first
+-- normalize records and record types; put s first

 sortRec :: [(Label,a)] -> [(Label,a)]
 sortRec = sortBy ordLabel where
-  ordLabel (r1,_) (r2,_) =
+  ordLabel (r1,_) (r2,_) = 
    case (showIdent (label2ident r1), showIdent (label2ident r2)) of
      ("s",_) -> LT
      (_,"s") -> GT
@@ -605,19 +608,21 @@ sortRec = sortBy ordLabel where
 -- | dependency check, detecting circularities and returning topo-sorted list

 allDependencies :: (ModuleName -> Bool) -> Map.Map Ident Info -> [(Ident,[Ident])]
-allDependencies ism b =
+allDependencies ism b = 
  [(f, nub (concatMap opty (pts i))) | (f,i) <- Map.toList b]
  where
    opersIn t = case t of
      Q  (n,c) | ism n -> [c]
      QC (n,c) | ism n -> [c]
+      Cn c             -> [c]
      _ -> collectOp opersIn t
    opty (Just (L _ ty)) = opersIn ty
    opty _ = []
    pts i = case i of
      ResOper pty pt -> [pty,pt]
      ResOverload _ tyts -> concat [[Just ty, Just tr] | (ty,tr) <- tyts]
-      ResParam (Just (L loc ps)) _ -> [Just (L loc t) | (_,cont) <- ps, (_,_,t) <- cont]
+      ResParam (Just (L loc ps)) _ -> [Just (L loc t) | (_,cont,_) <- ps, (_,_,t) <- cont]
+      ResValue pty _ -> [Just pty]
      CncCat pty _ _ _ _ -> [pty]
      CncFun _   pt _ _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
      AbsFun pty _ ptr _ -> [pty] --- ptr is def, which can be mutual
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -25,7 +25,6 @@ import GF.Compile.Update (buildAnyTree)
 import Data.List(intersperse)
 import Data.Char(isAlphaNum)
 import qualified Data.Map as Map
-import PGF(mkCId)

 }

@@ -268,7 +267,7 @@ DataDef
 ParamDef :: { [(Ident,Info)] }
 ParamDef
  : Posn LhsIdent '=' ListParConstr Posn { ($2, ResParam (Just (mkL $1 $5 [param | L loc param <- $4])) Nothing) :
-                                        [(f, ResValue (L loc (mkProdSimple co (Cn $2)))) | L loc (f,co) <- $4] }
+                                        [(f, ResValue (L loc (mkProdSimple co (Cn $2))) i) | L loc (f,co,i) <- $4] }
  | Posn LhsIdent                   Posn { [($2, ResParam Nothing Nothing)] }

 OperDef :: { [(Ident,Info)] }
@@ -303,7 +302,7 @@ ListDataConstr

 ParConstr :: { L Param }
 ParConstr
-  : Posn Ident ListDDecl Posn { mkL $1 $4 ($2,$3) } 
+  : Posn Ident ListDDecl Posn { mkL $1 $4 ($2,$3,0) } 

 ListLinDef :: { [(Ident,Info)] }
 ListLinDef
@@ -625,7 +624,7 @@ ListCFRule

 CFRule :: { [BNFCRule] }
 CFRule
-  : Ident '.' Ident '::=' ListCFSymbol ';' { [BNFCRule (showIdent $3) $5 (CFObj (mkCId (showIdent $1)) [])]
+  : Ident '.' Ident '::=' ListCFSymbol ';' { [BNFCRule (showIdent $3) $5 (CFObj (showIdent $1) [])]
                                           }
  | Ident '::=' ListCFRHS ';'              { let { cat = showIdent $1;
                                                   mkFun cat its =
@@ -638,7 +637,7 @@ CFRule
                                                       Terminal    c     -> filter isAlphaNum c;
                                                       NonTerminal (t,_) -> t
                                                     }
-                                             } in map (\rhs -> BNFCRule cat rhs (CFObj (mkCId (mkFun cat rhs)) [])) $3
+                                             } in map (\rhs -> BNFCRule cat rhs (CFObj (mkFun cat rhs) [])) $3
                                           }
  | 'coercions' Ident Integer ';'          { [BNFCCoercions (showIdent $2) $3]}
  | 'terminator' NonEmpty Ident String ';' { [BNFCTerminator $2 (showIdent $3) $4] }
@@ -775,7 +774,7 @@ checkInfoType mt jment@(id,info) =
    CncCat pty pd pr ppn _->ifConcrete mt (locPerh pty ++ locPerh pd ++ locPerh pr ++ locPerh ppn)
    CncFun _   pd ppn _  -> ifConcrete mt (locPerh pd ++ locPerh ppn)
    ResParam pparam _    -> ifResource mt (locPerh pparam)
-    ResValue ty          -> ifResource mt (locL ty)
+    ResValue ty _        -> ifResource mt (locL ty)
    ResOper  pty pt      -> ifOper mt pty pt
    ResOverload _ xs     -> ifResource mt (concat [[loc1,loc2] | (L loc1 _,L loc2 _) <- xs])
  where
--- a/src/compiler/GF/Grammar/PatternMatch.hs
+++ b/src/compiler/GF/Grammar/PatternMatch.hs
@@ -73,13 +73,14 @@ tryMatch (p,t) = do
  t' <- termForm t
  trym p t'
 where
+
+  isInConstantFormt = True -- tested already in matchPattern
  trym p t' =
    case (p,t') of
 --    (_,(x,Typed e ty,y)) -> trym p (x,e,y) -- Add this? /TH 2013-09-05
      (_,(x,Empty,y)) -> trym p (x,K [],y)   -- because "" = [""] = []
-      (PW, _) -> return [] -- optimization with wildcard
-      (PV x,([],K s,[])) -> return [(x,words2term (words s))]
-      (PV x,  _) -> return [(x,t)]
+      (PW, _) | isInConstantFormt -> return [] -- optimization with wildcard
+      (PV x,  _) | isInConstantFormt -> return [(x,t)]
      (PString s, ([],K i,[])) | s==i -> return []
      (PInt s, ([],EInt i,[])) | s==i -> return []
      (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
@@ -107,10 +108,6 @@ tryMatch (p,t) = do
            return (concat matches)
      (PT _ p',_) -> trym p' t'

-      (PAs x p',([],K s,[])) -> do
-         subst <- trym p' t'
-         return $ (x,words2term (words s)) : subst
-
      (PAs x p',_) -> do
         subst <- trym p' t'
         return $ (x,t) : subst
@@ -135,11 +132,6 @@ tryMatch (p,t) = do

      _ -> raise (render ("no match in case expr for" <+> t))

-  words2term []     = Empty
-  words2term [w]    = K w
-  words2term (w:ws) = C (K w) (words2term ws)
-
-
 matchPMSeq (m1,p1) (m2,p2) s = matchPSeq' m1 p1 m2 p2 s
 --matchPSeq p1 p2 s = matchPSeq' (0,maxBound::Int) p1 (0,maxBound::Int) p2 s
 matchPSeq p1 p2 s = matchPSeq' (lengthBounds p1) p1 (lengthBounds p2) p2 s
@@ -217,4 +209,4 @@ isMatchingForms ps ts = all match (zip ps ts') where
  match _ = True
  ts' = map appForm ts

-}
+-}
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -22,21 +22,17 @@ module GF.Grammar.Printer
           , ppMeta
           , getAbs
           ) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

+import PGF2 as PGF2
+import PGF2.Internal as PGF2
 import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.Values
 import GF.Grammar.Grammar
-
-import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)
-
 import GF.Text.Pretty
 import Data.Maybe (isNothing)
 import Data.List  (intersperse)
 import qualified Data.Map as Map
--import qualified Data.IntMap as IntMap
--import qualified Data.Set as Set
 import qualified Data.Array.IArray as Array

 data TermPrintQual 
@@ -110,8 +106,8 @@ ppJudgement q (id, ResParam pparams _) =
  (case pparams of
     Just (L _ ps) -> '=' <+> ppParams q ps
     _             -> empty) <+> ';'
-ppJudgement q (id, ResValue pvalue) = 
-  "-- param constructor" <+> id <+> ':' <+> 
+ppJudgement q (id, ResValue pvalue i) = 
+  "-- param constructor" <+> "[index" <+> i <> "]" <+> id <+> ':' <+> 
  (case pvalue of
     (L _ ty) -> ppTerm q 0 ty) <+> ';'
 ppJudgement q (id, ResOper  ptype pexp) =
@@ -326,7 +322,7 @@ ppBind (Implicit,v) = braces v
 ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y

 ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps))
-ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt)
+ppParam q (id,cxt,_) = id <+> hsep (map (ppDDecl q) cxt)

 ppProduction (Production fid funid args) =
  ppFId fid <+> "->" <+> ppFunId funid <> 
@@ -363,3 +359,39 @@ getLet (Let l e) = let (ls,e') = getLet e
                   in (l:ls,e')
 getLet e         = ([],e)

+ppFunId funid = pp 'F' <> pp funid
+ppSeqId seqid = pp 'S' <> pp seqid
+
+ppFId fid
+  | fid == PGF2.fidString = pp "CString"
+  | fid == PGF2.fidInt    = pp "CInt"
+  | fid == PGF2.fidFloat  = pp "CFloat"
+  | fid == PGF2.fidVar    = pp "CVar"
+  | fid == PGF2.fidStart  = pp "CStart"
+  | otherwise             = pp 'C' <> pp fid
+
+ppMeta :: Int -> Doc
+ppMeta n
+  | n == 0    = pp '?'
+  | otherwise = pp '?' <> pp n
+
+ppLit (PGF2.LStr s) = pp (show s)
+ppLit (PGF2.LInt n) = pp n
+ppLit (PGF2.LFlt d) = pp d
+
+ppSeq (seqid,seq) = 
+  ppSeqId seqid <+> pp ":=" <+> hsep (map ppSymbol seq)
+
+ppSymbol (PGF2.SymCat d r) = pp '<' <> pp d <> pp ',' <> pp r <> pp '>'
+ppSymbol (PGF2.SymLit d r) = pp '{' <> pp d <> pp ',' <> pp r <> pp '}'
+ppSymbol (PGF2.SymVar d r) = pp '<' <> pp d <> pp ',' <> pp '$' <> pp r <> pp '>'
+ppSymbol (PGF2.SymKS t)    = doubleQuotes (pp t)
+ppSymbol PGF2.SymNE        = pp "nonExist"
+ppSymbol PGF2.SymBIND      = pp "BIND"
+ppSymbol PGF2.SymSOFT_BIND = pp "SOFT_BIND"
+ppSymbol PGF2.SymSOFT_SPACE= pp "SOFT_SPACE"
+ppSymbol PGF2.SymCAPIT     = pp "CAPIT"
+ppSymbol PGF2.SymALL_CAPIT = pp "ALL_CAPIT"
+ppSymbol (PGF2.SymKP syms alts) = pp "pre" <+> braces (hsep (punctuate (pp ';') (hsep (map ppSymbol syms) : map ppAlt alts)))
+
+ppAlt (syms,ps) = hsep (map ppSymbol syms) <+> pp '/' <+> hsep (map (doubleQuotes . pp) ps)
--- a/src/compiler/GF/Infra/BuildInfo.hs
+++ b/src/compiler/GF/Infra/BuildInfo.hs
@@ -14,9 +14,3 @@ buildInfo =
 #ifdef SERVER_MODE
    ++" server"
 #endif
-#ifdef NEW_COMP
-    ++" new-comp"
-#endif
-#ifdef C_RUNTIME
-    ++" c-runtime"
-#endif
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -18,7 +18,6 @@ module GF.Infra.CheckM
 	   checkIn, checkInModule, checkMap, checkMapRecover,
           parallelCheck, accumulateError, commitCheck,
 	  ) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

 import GF.Data.Operations
 --import GF.Infra.Ident
@@ -32,7 +31,6 @@ import System.FilePath(makeRelative)
 import Control.Parallel.Strategies(parList,rseq,using)
 import Control.Monad(liftM,ap)
 import Control.Applicative(Applicative(..))
-import qualified Control.Monad.Fail as Fail

 type Message = Doc
 type Error   = Message
@@ -54,9 +52,6 @@ instance Monad Check where
                 (ws,Success x) -> unCheck (g x) {-ctxt-} ws
                 (ws,Fail msg)  -> (ws,Fail msg)

-instance Fail.MonadFail Check where
-  fail = raise
-
 instance Applicative Check where
  pure = return
  (<*>) = ap
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
-- > CVS $Date: 2005/11/15 11:43:33 $
+-- > CVS $Date: 2005/11/15 11:43:33 $ 
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.8 $
 --
@@ -13,25 +13,25 @@
 -----------------------------------------------------------------------------

 module GF.Infra.Ident (-- ** Identifiers
-  ModuleName(..), moduleNameS,
-  Ident, ident2utf8, showIdent, prefixIdent,
-  -- *** Normal identifiers (returned by the parser)
-  identS, identC, identW,
-  -- *** Special identifiers for internal use
-  identV, identA, identAV,
-  argIdent, isArgIdent, getArgIndex,
-  varStr, varX, isWildIdent, varIndex,
-  -- *** Raw identifiers
-  RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
-  isPrefixOf, showRawIdent
-) where
+          ModuleName(..), moduleNameS,
+          Ident, ident2utf8, showIdent, prefixIdent,
+          -- *** Normal identifiers (returned by the parser)
+          identS, identC, identW,
+          -- *** Special identifiers for internal use
+          identV, identA, identAV,
+          argIdent, isArgIdent, getArgIndex,
+          varStr, varX, isWildIdent, varIndex,
+          -- *** Raw identifiers
+          RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
+          isPrefixOf, showRawIdent
+	     ) where

 import qualified Data.ByteString.UTF8 as UTF8
 import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
                 -- Limit use of BS functions to the ones that work correctly on
                 -- UTF-8-encoded bytestrings!
 import Data.Char(isDigit)
-import PGF.Internal(Binary(..))
+import Data.Binary(Binary(..))
 import GF.Text.Pretty


@@ -46,7 +46,7 @@ instance Pretty ModuleName where pp (MN m) = pp m

 -- | the constructors labelled /INTERNAL/ are
 -- internal representation never returned by the parser
-data Ident =
+data Ident = 
   IC  {-# UNPACK #-} !RawIdent                                           -- ^ raw identifier after parsing, resolved in Rename
 | IW                                                                     -- ^ wildcard
 --
@@ -54,7 +54,7 @@ data Ident =
 | IV  {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int                       -- ^ /INTERNAL/ variable
 | IA  {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int                       -- ^ /INTERNAL/ argument of cat at position
 | IAV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int {-# UNPACK #-} !Int   -- ^ /INTERNAL/ argument of cat with bindings at position
--
+-- 
  deriving (Eq, Ord, Show, Read)

 -- | Identifiers are stored as UTF-8-encoded bytestrings.
@@ -70,13 +70,14 @@ rawIdentS = Id . pack
 rawIdentC = Id
 showRawIdent = unpack . rawId2utf8

-prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
+prefixRawIdent (Id x) (Id y) = Id (BS.append x y) 
 isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y

 instance Binary RawIdent where
  put = put . rawId2utf8
  get = fmap rawIdentC get

+
 -- | This function should be used with care, since the returned ByteString is
 -- UTF-8-encoded.
 ident2utf8 :: Ident -> UTF8.ByteString
@@ -87,7 +88,6 @@ ident2utf8 i = case i of
  IAV (Id s) b j -> BS.append s (pack ('_':show b ++ '_':show j))
  IW -> pack "_"

-ident2raw :: Ident -> RawIdent
 ident2raw = Id . ident2utf8

 showIdent :: Ident -> String
@@ -95,14 +95,13 @@ showIdent i = unpack $! ident2utf8 i

 instance Pretty Ident where pp = pp . showIdent

-instance Pretty RawIdent where pp = pp . showRawIdent
-
 identS :: String -> Ident
 identS = identC . rawIdentS

 identC :: RawIdent -> Ident
 identW :: Ident

+
 prefixIdent :: String -> Ident -> Ident
 prefixIdent pref = identC . Id . BS.append (pack pref) . ident2utf8

@@ -113,7 +112,7 @@ identV :: RawIdent -> Int -> Ident
 identA :: RawIdent -> Int -> Ident
 identAV:: RawIdent -> Int -> Int -> Ident

-(identC, identV, identA, identAV, identW) =
+(identC, identV, identA, identAV, identW) = 
    (IC,     IV,     IA,     IAV,     IW)

 -- | to mark argument variables
--- a/src/compiler/GF/Infra/Location.hs
+++ b/src/compiler/GF/Infra/Location.hs
@@ -1,6 +1,5 @@
 -- | Source locations
 module GF.Infra.Location where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import GF.Text.Pretty

 -- ** Source locations
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -34,18 +34,14 @@ import Data.Maybe
 import GF.Infra.Ident
 import GF.Infra.GetOpt
 import GF.Grammar.Predef
--import System.Console.GetOpt
 import System.FilePath
--import System.IO
+import PGF2.Internal(Literal(..))

 import GF.Data.Operations(Err,ErrorMonad(..),liftErr)

 import Data.Set (Set)
 import qualified Data.Set as Set

-import PGF.Internal(Literal(..))
-import qualified Control.Monad.Fail as Fail
-
 usageHeader :: String
 usageHeader = unlines 
 ["Usage: gf [OPTIONS] [FILE [...]]",
@@ -76,7 +72,6 @@ errors = raise . unlines

 data Mode = ModeVersion | ModeHelp
          | ModeInteractive | ModeRun
-          | ModeInteractive2 | ModeRun2
          | ModeCompiler
          | ModeServer {-port::-}Int
  deriving (Show,Eq,Ord)
@@ -90,12 +85,9 @@ data Phase = Preproc | Convert | Compile | Link
 data OutputFormat = FmtPGFPretty
                  | FmtCanonicalGF
                  | FmtCanonicalJson
-                  | FmtJavaScript 
                  | FmtJSON
-                  | FmtPython 
                  | FmtHaskell 
                  | FmtJava
-                  | FmtProlog
                  | FmtBNF
                  | FmtEBNF
                  | FmtRegular
@@ -132,7 +124,7 @@ data CFGTransform = CFGNoLR
  deriving (Show,Eq,Ord)

 data HaskellOption = HaskellNoPrefix | HaskellGADT | HaskellLexical
-                   | HaskellConcrete | HaskellVariants | HaskellData
+                   | HaskellConcrete | HaskellVariants
  deriving (Show,Eq,Ord)

 data Warning = WarnMissingLincat
@@ -157,7 +149,7 @@ data Flags = Flags {
      optLiteralCats     :: Set Ident,
      optGFODir          :: Maybe FilePath,
      optOutputDir       :: Maybe FilePath,
-      optGFLibPath       :: Maybe [FilePath],
+      optGFLibPath       :: Maybe FilePath,
      optDocumentRoot    :: Maybe FilePath, -- For --server mode
      optRecomp          :: Recomp,
      optProbsFile       :: Maybe FilePath,
@@ -212,10 +204,9 @@ parseModuleOptions args = do
    then return opts
    else errors $ map ("Non-option among module options: " ++) nonopts

-fixRelativeLibPaths curr_dir lib_dirs (Options o) = Options (fixPathFlags . o)
+fixRelativeLibPaths curr_dir lib_dir (Options o) = Options (fixPathFlags . o)
  where
-    fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [parent </> dir
-                                                                                      | parent <- curr_dir : lib_dirs]) path}
+    fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [curr_dir </> dir, lib_dir </> dir]) path}

 -- Showing options

@@ -311,8 +302,6 @@ optDescr =
     Option ['j'] ["jobs"] (OptArg jobs "N") "Compile N modules in parallel with -batch (default 1).",
     Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
     Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).",
-     Option [] ["cshell"] (NoArg (mode ModeInteractive2)) "Start the C run-time shell.",
-     Option [] ["crun"] (NoArg (mode ModeRun2)) "Start the C run-time shell, showing output only (no other messages).",
     Option [] ["server"] (OptArg modeServer "port") $
       "Run in HTTP server mode on given port (default "++show defaultPort++").",
     Option [] ["document-root"] (ReqArg gfDocuRoot "DIR")
@@ -349,7 +338,7 @@ optDescr =
           "Overrides the value of GF_LIB_PATH.",
     Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp)) 
                 "Always recompile from source.",
-     Option [] ["recomp-if-newer"] (NoArg (recomp RecompIfNewer)) 
+     Option [] ["gfo","recomp-if-newer"] (NoArg (recomp RecompIfNewer)) 
                 "(default) Recompile from source if the source is newer than the .gfo file.",
     Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) 
                 "Never recompile from source, if there is already .gfo file.",
@@ -427,7 +416,7 @@ optDescr =
       literalCat  x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) }
       lexicalCat  x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) }
       outDir      x = set $ \o -> o { optOutputDir = Just x }
-       gfLibPath   x = set $ \o -> o { optGFLibPath = Just $ splitInModuleSearchPath x }
+       gfLibPath   x = set $ \o -> o { optGFLibPath = Just x }
       gfDocuRoot  x = set $ \o -> o { optDocumentRoot = Just x }
       recomp      x = set $ \o -> o { optRecomp = x }
       probsFile   x = set $ \o -> o { optProbsFile = Just x }
@@ -475,12 +464,9 @@ outputFormatsExpl =
    [(("pgf_pretty",   FmtPGFPretty),"human-readable pgf"),
     (("canonical_gf", FmtCanonicalGF),"Canonical GF source files"),
     (("canonical_json", FmtCanonicalJson),"Canonical JSON source files"),
-     (("js",           FmtJavaScript),"JavaScript (whole grammar)"),
     (("json",         FmtJSON),"JSON (whole grammar)"),
-     (("python",       FmtPython),"Python (whole grammar)"),
     (("haskell",      FmtHaskell),"Haskell (abstract syntax)"),
     (("java",         FmtJava),"Java (abstract syntax)"),
-     (("prolog",       FmtProlog),"Prolog (whole grammar)"),
     (("bnf",          FmtBNF),"BNF (context-free grammar)"),
     (("ebnf",         FmtEBNF),"Extended BNF"),
     (("regular",      FmtRegular),"* regular grammar"),
@@ -531,8 +517,7 @@ haskellOptionNames =
     ("gadt",     HaskellGADT),
     ("lexical",  HaskellLexical),
     ("concrete", HaskellConcrete),
-     ("variants", HaskellVariants),
-     ("data",     HaskellData)]
+     ("variants", HaskellVariants)]

 -- | This is for bacward compatibility. Since GHC 6.12 we
 -- started using the native Unicode support in GHC but it
@@ -549,7 +534,7 @@ lookupShow xs z = fromMaybe "lookupShow" $ lookup z [(y,x) | (x,y) <- xs]
 lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
 lookupReadsPrec xs _ s = [(z,rest) | (x,rest) <- lex s, (y,z) <- xs, y == x]

-onOff :: Fail.MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a)
+onOff :: Monad m => (Bool -> m a) -> Bool -> ArgDescr (m a)
 onOff f def = OptArg g "[on,off]"
  where g ma = maybe (return def) readOnOff ma >>= f
        readOnOff x = case map toLower x of
@@ -557,7 +542,7 @@ onOff f def = OptArg g "[on,off]"
                        "off" -> return False
                        _     -> fail $ "Expected [on,off], got: " ++ show x

-readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat
+readOutputFormat :: Monad m => String -> m OutputFormat
 readOutputFormat s = 
    maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats

--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -12,9 +12,6 @@ module GF.Infra.SIO(
       newStdGen,print,putStr,putStrLn,
       -- ** Specific to GF
       importGrammar,importSource,
-#ifdef C_RUNTIME
-       readPGF2,
-#endif
       putStrLnFlush,runInterruptibly,lazySIO,
       -- * Restricted accesss to arbitrary (potentially unsafe) IO operations
       -- | If the environment variable GF_RESTRICTED is defined, these
@@ -39,10 +36,6 @@ import qualified System.Random as IO(newStdGen)
 import qualified GF.Infra.UseIO as IO(getLibraryDirectory)
 import qualified GF.System.Signal as IO(runInterruptibly)
 import qualified GF.Command.Importing as GF(importGrammar, importSource)
-#ifdef C_RUNTIME
-import qualified PGF2
-#endif
-import qualified Control.Monad.Fail as Fail

 -- * The SIO monad

@@ -59,9 +52,6 @@ instance Monad SIO where
  return x = SIO (const (return x))
  SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h

-instance Fail.MonadFail SIO where
-  fail = lift0 . fail
-
 instance Output SIO where
  ePutStr = lift0 . ePutStr
  ePutStrLn = lift0 . ePutStrLn
@@ -127,7 +117,3 @@ lazySIO              = lift1   lazyIO

 importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files
 importSource      opts files = lift0 $ GF.importSource      opts files
-
-#ifdef C_RUNTIME
-readPGF2 = lift0 . PGF2.readPGF
-#endif
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -38,7 +38,6 @@ import Control.Monad(when,liftM,foldM)
 import Control.Monad.Trans(MonadIO(..))
 import Control.Monad.State(StateT,lift)
 import Control.Exception(evaluate)
-import Data.List (nub)

 --putIfVerb :: MonadIO io => Options -> String -> io ()
 putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg
@@ -52,32 +51,28 @@ type FullPath = String
 gfLibraryPath    = "GF_LIB_PATH"
 gfGrammarPathVar = "GF_GRAMMAR_PATH"

-getLibraryDirectory :: MonadIO io => Options -> io [FilePath]
+getLibraryDirectory :: MonadIO io => Options -> io FilePath
 getLibraryDirectory opts =
  case flag optGFLibPath opts of
    Just path -> return path
-    Nothing   -> liftM splitSearchPath $ liftIO (catch (getEnv gfLibraryPath)
-                                                (\ex -> fmap (</> "lib") getDataDir))
+    Nothing   -> liftIO $ catch (getEnv gfLibraryPath)
+                                (\ex -> fmap (</> "lib") getDataDir)

-getGrammarPath :: MonadIO io => [FilePath] -> io [FilePath]
-getGrammarPath lib_dirs = liftIO $ do
+getGrammarPath :: MonadIO io => FilePath -> io [FilePath]
+getGrammarPath lib_dir = liftIO $ do
  catch (fmap splitSearchPath $ getEnv gfGrammarPathVar) 
-        (\_ -> return $ concat [[lib_dir </> "alltenses", lib_dir </> "prelude"]
-                               | lib_dir <- lib_dirs ])     -- e.g. GF_GRAMMAR_PATH
+        (\_ -> return [lib_dir </> "alltenses",lib_dir </> "prelude"])     -- e.g. GF_GRAMMAR_PATH

 -- | extends the search path with the
 -- 'gfLibraryPath' and 'gfGrammarPathVar'
 -- environment variables. Returns only existing paths.
 extendPathEnv :: MonadIO io => Options -> io [FilePath]
 extendPathEnv opts = liftIO $ do
-  let opt_path = nub $ flag optLibraryPath opts         -- e.g. paths given as options
-  lib_dirs <- getLibraryDirectory opts                  -- e.g. GF_LIB_PATH
-  grm_path <- getGrammarPath lib_dirs                   -- e.g. GF_GRAMMAR_PATH
-  let paths = opt_path ++ lib_dirs ++ grm_path
-  when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: opt_path is "++ show opt_path)
-  when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: lib_dirs is "++ show lib_dirs)
-  when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: grm_path is "++ show grm_path)
-  ps <- liftM (nub . concat) $ mapM allSubdirs (nub paths)
+  let opt_path = flag optLibraryPath opts         -- e.g. paths given as options
+  lib_dir  <- getLibraryDirectory opts                  -- e.g. GF_LIB_PATH
+  grm_path <- getGrammarPath lib_dir                   -- e.g. GF_GRAMMAR_PATH
+  let paths = opt_path ++ [lib_dir] ++ grm_path
+  ps <- liftM concat $ mapM allSubdirs paths
  mapM canonicalizePath ps
  where
    allSubdirs :: FilePath -> IO [FilePath]
@@ -85,15 +80,11 @@ extendPathEnv opts = liftIO $ do
    allSubdirs p = case last p of
      '*' -> do let path = init p
                fs <- getSubdirs path
-                let starpaths = [path </> f | f <- fs]
-                when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: * found "++show starpaths)
-                return starpaths
+                return [path </> f | f <- fs]
      _   -> do exists <- doesDirectoryExist p
                if exists
-                  then do
-                       when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: found path "++show p)
-                       return [p]
-                  else do when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: ignore path "++ show p)
+                  then return [p]
+                  else do when (verbAtLeast opts Verbose) $ putStrLn ("ignore path "++p)
                          return []

 getSubdirs :: FilePath -> IO [FilePath]
@@ -159,9 +150,6 @@ instance ErrorMonad IO where
                                then h (ioeGetErrorString e)
                                else ioError e
 {-
-- Control.Monad.Fail import will become redundant in GHC 8.8+
-import qualified Control.Monad.Fail as Fail
-
 instance Functor IOE where fmap = liftM

 instance Applicative IOE where
@@ -173,15 +161,7 @@ instance  Monad IOE where
  IOE c >>= f = IOE $ do 
                  x <- c          -- Err a
                  appIOE $ err raise f x         -- f :: a -> IOE a
-
- #if !(MIN_VERSION_base(4,13,0))
  fail = raise
- #endif
-
-instance Fail.MonadFail IOE where
-  fail = raise
-
-
 -}

 -- | Print the error message and return a default value if the IO operation 'fail's
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -5,14 +5,14 @@ module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where
 import Prelude hiding (putStrLn,print)
 import qualified Prelude as P(putStrLn)
 import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
-import GF.Command.Commands(PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
+import GF.Command.Commands(HasPGF(..),pgfCommands)
 import GF.Command.CommonCommands(commonCommands,extend)
 import GF.Command.SourceCommands
 import GF.Command.CommandInfo
 import GF.Command.Help(helpCommand)
 import GF.Command.Abstract
 import GF.Command.Parse(readCommandLine,pCommand)
-import GF.Data.Operations (Err(..))
+import GF.Data.Operations (Err(..),done)
 import GF.Data.Utilities(whenM,repeatM)
 import GF.Grammar hiding (Ident,isPrefixOf)
 import GF.Infra.UseIO(ioErrorText,putStrLnE)
@@ -20,15 +20,12 @@ import GF.Infra.SIO
 import GF.Infra.Option
 import qualified System.Console.Haskeline as Haskeline

-import PGF
-import PGF.Internal(abstract,funs,lookStartCat,emptyPGF)
+import PGF2

 import Data.Char
 import Data.List(isPrefixOf)
 import qualified Data.Map as Map
 import qualified Text.ParserCombinators.ReadP as RP
--import System.IO(utf8)
--import System.CPUTime(getCPUTime)
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import Control.Exception(SomeException,fromException,evaluate,try)
 import Control.Monad.State hiding (void)
@@ -38,9 +35,6 @@ import GF.Server(server)
 #endif

 import GF.Command.Messages(welcome)
-import GF.Infra.UseIO (Output)
-- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
-import Control.Monad.Trans.Instances ()

 -- | Run the GF Shell in quiet mode (@gf -run@).
 mainRunGFI :: Options -> [FilePath] -> IO ()
@@ -102,7 +96,7 @@ timeIt act =

 -- | Optionally show how much CPU time was used to run an IO action
 optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
-optionallyShowCPUTime opts act
+optionallyShowCPUTime opts act 
  | not (verbAtLeast opts Normal) = act
  | otherwise = do (dt,r) <- timeIt act
                   liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
@@ -165,7 +159,7 @@ execute1' s0 =
      do execute . lines =<< lift (restricted (readFile w))
         continue
      where
-        execute []           = return ()
+        execute [] = done
        execute (line:lines) = whenM (execute1' line) (execute lines)

    execute_history _   =
@@ -280,18 +274,19 @@ importInEnv opts files =
     if flag optRetainResource opts
      then do src <- lift $ importSource opts files
              pgf <- lift . lazySIO $ importPGF pgf0 -- duplicates some work, better to link src
-              modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgfEnv pgf)}
+              modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgf)}
      else do pgf1 <- lift $ importPGF pgf0
              modify $ \ gfenv->gfenv { retain=False,
-                                        pgfenv = (emptyGrammar,pgfEnv pgf1) }
+                                        pgfenv = (emptyGrammar,pgf1) }
  where
    importPGF pgf0 =
      do let opts' = addOptions (setOptimization OptCSE False) opts
         pgf1 <- importGrammar pgf0 opts' files
         if (verbAtLeast opts Normal)
-           then putStrLnFlush $
-                  unwords $ "\nLanguages:" : map showCId (languages pgf1)
-           else return ()
+           then case pgf1 of
+                  Just pgf -> putStrLnFlush $ unwords $ "\nLanguages:" : Map.keys (languages pgf)
+                  Nothing  -> done
+           else done
         return pgf1

 tryGetLine = do
@@ -301,12 +296,12 @@ tryGetLine = do
   Right l -> return l

 prompt env
-  | retain env || abs == wildCId = "> "
-  | otherwise      = showCId abs ++ "> "
-  where
-    abs = abstractName (multigrammar env)
+  | retain env = "> "
+  | otherwise  = case multigrammar env of
+                   Just pgf -> abstractName pgf ++ "> "
+                   Nothing  -> "> "

-type CmdEnv = (Grammar,PGFEnv)
+type CmdEnv = (Grammar,Maybe PGF)

 data GFEnv = GFEnv {
    startOpts :: Options,
@@ -318,10 +313,10 @@ data GFEnv = GFEnv {

 emptyGFEnv opts = GFEnv opts False emptyCmdEnv emptyCommandEnv []

-emptyCmdEnv = (emptyGrammar,pgfEnv emptyPGF)
+emptyCmdEnv = (emptyGrammar,Nothing)

 emptyCommandEnv = mkCommandEnv allCommands
-multigrammar = pgf . snd . pgfenv
+multigrammar = snd . pgfenv

 allCommands =
  extend pgfCommands (helpCommand allCommands:moreCommands)
@@ -329,24 +324,35 @@ allCommands =
  `Map.union` commonCommands

 instance HasGrammar ShellM where getGrammar = gets (fst . pgfenv)
-instance HasPGFEnv ShellM where getPGFEnv = gets (snd . pgfenv)
+instance HasPGF ShellM where getPGF = gets (snd . pgfenv)

 wordCompletion gfenv (left,right) = do
  case wc_type (reverse left) of
    CmplCmd pref
      -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
    CmplStr (Just (Command _ opts _)) s0
-      -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))
-            case mb_state0 of
-              Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)
-                                  s            = reverse rs
-                                  prefix       = reverse rprefix
-                                  ws           = words s
-                              in case loop state0 ws of
-                                   Nothing    -> ret 0 []
-                                   Just state -> let compls = getCompletions state prefix
-                                                 in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))
-              Left (_ :: SomeException) -> ret 0 []
+      -> case multigrammar gfenv of
+           Just pgf -> let langs = languages pgf
+                           optLang opts = case valStrOpts "lang" "" opts of
+                                            ""   -> case Map.minView langs of
+                                                      Nothing        -> Nothing
+                                                      Just (concr,_) -> Just concr
+                                            lang -> mplus (Map.lookup lang                       langs)
+                                                          (Map.lookup (abstractName pgf ++ lang) langs)
+                           optType opts = let readOpt str = case readType str of
+                                                              Just ty -> case checkType pgf ty of
+                                                                           Left _   -> Nothing
+                                                                           Right ty -> Just ty
+                                                              Nothing -> Nothing
+                                          in maybeStrOpts "cat" (Just (startCat pgf)) readOpt opts
+                           (rprefix,rs) = break isSpace (reverse s0)
+                           s            = reverse rs
+                           prefix       = reverse rprefix
+                       in case (optLang opts, optType opts) of
+                            (Just lang,Just cat) -> let compls = [t | (t,_,_,_) <- complete lang cat s prefix]
+                                                    in ret (length prefix) (map Haskeline.simpleCompletion compls)
+                            _                    -> ret 0 []
+           Nothing  -> ret 0 []
    CmplOpt (Just (Command n _ _)) pref
      -> case Map.lookup n (commands cmdEnv) of
           Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags   inf, isPrefixOf pref flg]
@@ -357,23 +363,15 @@ wordCompletion gfenv (left,right) = do
    CmplIdent (Just (Command "i" _ _)) _        -- HACK: file name completion for command i
      -> Haskeline.completeFilename (left,right)
    CmplIdent _ pref
-      -> do mb_abs <- try (evaluate (abstract pgf))
-            case mb_abs of
-              Right abs -> ret (length pref) [Haskeline.simpleCompletion name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name]
-              Left (_ :: SomeException) -> ret (length pref) []
+      -> case multigrammar gfenv of
+           Just pgf -> ret (length pref) [Haskeline.simpleCompletion name | name <- functions pgf, isPrefixOf pref name]
+           Nothing  -> ret (length pref) []
    _ -> ret 0 []
  where
-    pgf    = multigrammar gfenv
    cmdEnv = commandenv gfenv
-    optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
-    optType opts =
-      let str = valStrOpts "cat" (showCId $ lookStartCat pgf) opts
-      in case readType str of
-           Just ty -> ty
-           Nothing -> error ("Can't parse '"++str++"' as type")

    loop ps []     = Just ps
-    loop ps (t:ts) = case nextState ps (simpleParseInput t) of
+    loop ps (t:ts) = case error "nextState ps (simpleParseInput t)" of
                       Left  es -> Nothing
                       Right ps -> loop ps ts

@@ -413,7 +411,7 @@ wc_type = cmd_name
    option x y (c  :cs)
      | isIdent c       = option x y cs
      | otherwise       = cmd x cs
-
+      
    optValue x y ('"':cs) = str x y cs
    optValue x y cs       = cmd x cs

@@ -431,7 +429,7 @@ wc_type = cmd_name
      where
        x1 = take (length x - length y - d) x
        x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
-
+        
        cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
 	        [x] -> Just x
                _   -> Nothing
--- a/src/compiler/GF/Interactive2.hs
+++ b/src/compiler/GF/Interactive2.hs
@@ -1,442 +0,0 @@
-{-# LANGUAGE CPP, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
-- | GF interactive mode (with the C run-time system)
-module GF.Interactive2 (mainGFI,mainRunGFI{-,mainServerGFI-}) where
-import Prelude hiding (putStrLn,print)
-import qualified Prelude as P(putStrLn)
-import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine)
-import GF.Command.Commands2(PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands)
-import GF.Command.CommonCommands
-import GF.Command.CommandInfo
-import GF.Command.Help(helpCommand)
-import GF.Command.Abstract
-import GF.Command.Parse(readCommandLine,pCommand)
-import GF.Data.Operations (Err(..))
-import GF.Data.Utilities(whenM,repeatM)
-
-import GF.Infra.UseIO(ioErrorText,putStrLnE)
-import GF.Infra.SIO
-import GF.Infra.Option
-import qualified System.Console.Haskeline as Haskeline
-
-import qualified PGF2 as C
-import qualified PGF as H
-
-import Data.Char
-import Data.List(isPrefixOf)
-import qualified Data.Map as Map
-
-import qualified Text.ParserCombinators.ReadP as RP
--import System.IO(utf8)
--import System.CPUTime(getCPUTime)
-import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
-import System.FilePath(takeExtensions)
-import Control.Exception(SomeException,fromException,try)
--import Control.Monad
-import Control.Monad.State hiding (void)
-
-import qualified GF.System.Signal as IO(runInterruptibly)
-{-
-#ifdef SERVER_MODE
-import GF.Server(server)
-#endif
-}
-
-import GF.Command.Messages(welcome)
-
-- | Run the GF Shell in quiet mode (@gf -run@).
-mainRunGFI :: Options -> [FilePath] -> IO ()
-mainRunGFI opts files = shell (beQuiet opts) files
-
-beQuiet = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet}))
-
-- | Run the interactive GF Shell
-mainGFI :: Options -> [FilePath] -> IO ()
-mainGFI opts files = do
-  P.putStrLn welcome
-  P.putStrLn "This shell uses the C run-time system. See help for available commands."
-  shell opts files
-
-shell opts files = flip evalStateT (emptyGFEnv opts) $
-                   do mapStateT runSIO $ importInEnv opts files
-                      loop
-
-{-
-#ifdef SERVER_MODE
-- | Run the GF Server (@gf -server@).
-- The 'Int' argument is the port number for the HTTP service.
-mainServerGFI opts0 port files =
-    server jobs port root (execute1 opts)
-      =<< runSIO (importInEnv (emptyGFEnv opts) opts files)
-  where
-    root = flag optDocumentRoot opts
-    opts = beQuiet opts0
-    jobs = join (flag optJobs opts)
-#else
-mainServerGFI opts port files =
-  error "GF has not been compiled with server mode support"
-#endif
-}
-- | Read end execute commands until it is time to quit
-loop :: StateT GFEnv IO ()
-loop = repeatM readAndExecute1
-
-- | Read and execute one command, returning 'True' to continue execution,
-- | 'False' when it is time to quit
-readAndExecute1 :: StateT GFEnv IO Bool
-readAndExecute1 = mapStateT runSIO . execute1 =<< readCommand
-
-- | Read a command
-readCommand :: StateT GFEnv IO String
-readCommand =
-  do opts <- gets startOpts
-     case flag optMode opts of
-       ModeRun -> lift tryGetLine
-       _       -> lift . fetchCommand =<< get
-
-timeIt act =
-  do t1 <- liftSIO $ getCPUTime
-     a <-  act
-     t2 <- liftSIO $ getCPUTime
-     return (t2-t1,a)
-
-- | Optionally show how much CPU time was used to run an IO action
-optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
-optionallyShowCPUTime opts act 
-  | not (verbAtLeast opts Normal) = act
-  | otherwise = do (dt,r) <- timeIt act
-                   liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
-                   return r
-
-type ShellM = StateT GFEnv SIO
-
-- | Execute a given command line, returning 'True' to continue execution,
-- | 'False' when it is time to quit
-execute1 :: String -> ShellM Bool
-execute1 s0 =
-  do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}
-     execute1' s0
-
-- | Execute a given command line, without adding it to the history
-execute1' s0 =
-  do opts <- gets startOpts
-     interruptible $ optionallyShowCPUTime opts $
-       case pwords s0 of
-      -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
-      -- special commands
-         "q" :_   -> quit
-         "!" :ws  -> system_command ws
-         "eh":ws  -> execute_history ws
-         "i" :ws  -> do import_ ws; continue
-      -- other special commands, working on GFEnv
-         "dc":ws  -> define_command ws
-         "dt":ws  -> define_tree ws
-      -- ordinary commands
-         _        -> do env <- gets commandenv
-                        interpretCommandLine env s0
-                        continue
-  where
-    continue,stop :: ShellM Bool
-    continue = return True
-    stop = return False
-
-    interruptible :: ShellM Bool -> ShellM Bool
-    interruptible act =
-      do gfenv <- get
-         mapStateT (
-           either (\e -> printException e >> return (True,gfenv)) return
-             <=< runInterruptibly) act
-
-  -- Special commands:
-
-    quit = do opts <- gets startOpts
-              when (verbAtLeast opts Normal) $ putStrLnE "See you."
-              stop
-
-    system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
-
-
-       {-"eh":w:_ -> do
-                  cs <- readFile w >>= return . map words . lines
-                  gfenv' <- foldM (flip (process False benv)) gfenv cs
-                  loopNewCPU gfenv' -}
-    execute_history [w] =
-      do execute . lines =<< lift (restricted (readFile w))
-         continue
-      where
-        execute :: [String] -> ShellM ()
-        execute [] = return ()
-        execute (line:lines) = whenM (execute1' line) (execute lines)
-
-    execute_history _   =
-       do putStrLnE "eh command not parsed"
-          continue
-
-    define_command (f:ws) =
-        case readCommandLine (unwords ws) of
-           Just comm ->
-             do modify $
-                  \ gfenv ->
-                    let env = commandenv gfenv
-                    in gfenv {
-                         commandenv = env {
-                           commandmacros = Map.insert f comm (commandmacros env)
-                         }
-                       }
-                continue
-           _ -> dc_not_parsed
-    define_command _ = dc_not_parsed
-
-    dc_not_parsed = putStrLnE "command definition not parsed" >> continue
-
-    define_tree (f:ws) =
-        case H.readExpr (unwords ws) of
-          Just exp ->
-           do modify $
-                \ gfenv ->
-                  let env = commandenv gfenv
-                  in gfenv { commandenv = env {
-                               expmacros = Map.insert f exp (expmacros env) } }
-              continue
-          _ -> dt_not_parsed
-    define_tree _ = dt_not_parsed
-
-    dt_not_parsed = putStrLnE "value definition not parsed" >> continue
-
-pwords s = case words s of
-             w:ws -> getCommandOp w :ws
-             ws -> ws
-import_ args =
-  do case parseOptions args of
-       Ok (opts',files) -> do
-         opts <- gets startOpts
-         curr_dir <- lift getCurrentDirectory
-         lib_dir  <- lift $ getLibraryDirectory (addOptions opts opts')
-         importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
-       Bad err ->
-         do putStrLnE $ "Command parse error: " ++ err
-
-- | Commands that work on 'GFEnv'
-moreCommands = [
-  ("e",  emptyCommandInfo {
-     longname = "empty",
-     synopsis = "empty the environment (except the command history)",
-     exec = \ _ _ ->
-            do modify $ \ gfenv -> (emptyGFEnv (startOpts gfenv))
-                                     { history=history gfenv }
-               return void
-     }),
-  ("ph", emptyCommandInfo {
-     longname = "print_history",
-     synopsis = "print command history",
-     explanation = unlines [
-       "Prints the commands issued during the GF session.",
-       "The result is readable by the eh command.",
-       "The result can be used as a script when starting GF."
-       ],
-     examples = [
-      mkEx "ph | wf -file=foo.gfs  -- save the history into a file"
-      ],
-     exec = \ _ _ ->
-            fmap (fromString . unlines . reverse . drop 1 . history) get
-     }),
-  ("r",  emptyCommandInfo {
-     longname = "reload",
-     synopsis = "repeat the latest import command",
-     exec = \ _ _ ->
-       do gfenv0 <- get
-          let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
-          case imports of
-            (s,ws):_ -> do
-              putStrLnE $ "repeating latest import: " ++ s
-              import_ ws
-            _ -> do
-              putStrLnE $ "no import in history"
-          return void
-     })
-  ]
-
-
-printException e = maybe (print e) (putStrLn . ioErrorText) (fromException e)
-
-fetchCommand :: GFEnv -> IO String
-fetchCommand gfenv = do
-  path <- getAppUserDataDirectory "gf_history"
-  let settings =
-        Haskeline.Settings {
-          Haskeline.complete = wordCompletion gfenv,
-          Haskeline.historyFile = Just path,
-          Haskeline.autoAddHistory = True
-        }
-  res <- IO.runInterruptibly $ Haskeline.runInputT settings (Haskeline.getInputLine (prompt gfenv))
-  case res of
-    Left  _        -> return ""
-    Right Nothing  -> return "q"
-    Right (Just s) -> return s
-
-importInEnv :: Options -> [FilePath] -> ShellM ()
-importInEnv opts files =
-  case files of
-    _ | flag optRetainResource opts ->
-          putStrLnE "Flag -retain is not supported in this shell"
-    [file] | takeExtensions file == ".pgf" -> importPGF file
-    [] -> return ()
-    _ -> do putStrLnE "Can only import one .pgf file"
-  where
-    importPGF file =
-      do gfenv <- get
-         case multigrammar gfenv of
-           Just _ -> putStrLnE "Discarding previous grammar"
-           _ -> return ()
-         pgf1 <- lift $ readPGF2 file
-         let gfenv' = gfenv { pgfenv = pgfEnv pgf1 }
-         when (verbAtLeast opts Normal) $
-           let langs = Map.keys . concretes $ gfenv'
-           in putStrLnE . unwords $ "\nLanguages:":langs
-         put gfenv'
-
-tryGetLine = do
-  res <- try getLine
-  case res of
-   Left (e :: SomeException) -> return "q"
-   Right l -> return l
-
-prompt env = abs ++ "> "
-  where
-    abs = maybe "" C.abstractName (multigrammar env)
-
-data GFEnv = GFEnv {
-    startOpts :: Options,
-  --grammar :: (), -- gfo grammar -retain
-  --retain :: (),  -- grammar was imported with -retain flag
-    pgfenv :: PGFEnv,
-    commandenv :: CommandEnv ShellM,
-    history    :: [String]
-  }
-
-emptyGFEnv opts = GFEnv opts {-() ()-} emptyPGFEnv emptyCommandEnv []
-
-emptyCommandEnv = mkCommandEnv allCommands
-multigrammar = pgf . pgfenv
-concretes = concs . pgfenv
-
-allCommands =
-  extend pgfCommands (helpCommand allCommands:moreCommands)
-  `Map.union` commonCommands
-
-instance HasPGFEnv ShellM where getPGFEnv = gets pgfenv
-
-- ** Completion
-
-wordCompletion gfenv (left,right) = do
-  case wc_type (reverse left) of
-    CmplCmd pref
-      -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
-{-
-    CmplStr (Just (Command _ opts _)) s0
-      -> do mb_state0 <- try (evaluate (H.initState pgf (optLang opts) (optType opts)))
-            case mb_state0 of
-              Right state0 -> let (rprefix,rs) = break isSpace (reverse s0)
-                                  s            = reverse rs
-                                  prefix       = reverse rprefix
-                                  ws           = words s
-                              in case loop state0 ws of
-                                   Nothing    -> ret 0 []
-                                   Just state -> let compls = H.getCompletions state prefix
-                                                 in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls))
-              Left (_ :: SomeException) -> ret 0 []
-}
-    CmplOpt (Just (Command n _ _)) pref
-      -> case Map.lookup n (commands cmdEnv) of
-           Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags   inf, isPrefixOf pref flg]
-                              opt_compls = [Haskeline.Completion ('-':opt)      ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt]
-                          ret (length pref+1)
-                              (flg_compls++opt_compls)
-           Nothing  -> ret (length pref) []
-    CmplIdent (Just (Command "i" _ _)) _        -- HACK: file name completion for command i
-      -> Haskeline.completeFilename (left,right)
-
-    CmplIdent _ pref
-      -> case mb_pgf of
-           Just pgf -> ret (length pref)
-                           [Haskeline.simpleCompletion name 
-                            | name <- C.functions pgf,
-                              isPrefixOf pref name]
-           _ -> ret (length pref) []
-
-    _ -> ret 0 []
-  where
-    mb_pgf = multigrammar gfenv
-    cmdEnv = commandenv gfenv
-{-
-    optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts
-    optType opts = 
-      let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts
-      in case H.readType str of
-           Just ty -> ty
-           Nothing -> error ("Can't parse '"++str++"' as type")
-
-    loop ps []     = Just ps
-    loop ps (t:ts) = case H.nextState ps (H.simpleParseInput t) of
-                       Left  es -> Nothing
-                       Right ps -> loop ps ts
-}
-    ret len xs  = return (drop len left,xs)
-
-
-data CompletionType
-  = CmplCmd                   Ident
-  | CmplStr   (Maybe Command) String
-  | CmplOpt   (Maybe Command) Ident
-  | CmplIdent (Maybe Command) Ident
-  deriving Show
-
-wc_type :: String -> CompletionType
-wc_type = cmd_name
-  where
-    cmd_name cs =
-      let cs1 = dropWhile isSpace cs
-      in go cs1 cs1
-      where
-        go x []       = CmplCmd x
-        go x (c:cs)
-          | isIdent c = go x cs
-          | otherwise = cmd x cs
-
-    cmd x []       = ret CmplIdent x "" 0
-    cmd _ ('|':cs) = cmd_name cs
-    cmd _ (';':cs) = cmd_name cs
-    cmd x ('"':cs) = str x cs cs
-    cmd x ('-':cs) = option x cs cs
-    cmd x (c  :cs)
-      | isIdent c  = ident x (c:cs) cs
-      | otherwise  = cmd x cs
-
-    option x y []       = ret CmplOpt x y 1
-    option x y ('=':cs) = optValue x y cs
-    option x y (c  :cs)
-      | isIdent c       = option x y cs
-      | otherwise       = cmd x cs
-      
-    optValue x y ('"':cs) = str x y cs
-    optValue x y cs       = cmd x cs
-
-    ident x y []     = ret CmplIdent x y 0
-    ident x y (c:cs)
-      | isIdent c    = ident x y cs
-      | otherwise    = cmd x cs
-
-    str x y []          = ret CmplStr x y 1
-    str x y ('\"':cs)   = cmd x cs
-    str x y ('\\':c:cs) = str x y cs
-    str x y (c:cs)      = str x y cs
-
-    ret f x y d = f cmd y
-      where
-        x1 = take (length x - length y - d) x
-        x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
-        
-        cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
-	        [x] -> Just x
-                _   -> Nothing
-
-    isIdent c = c == '_' || c == '\'' || isAlphaNum c
--- a/src/compiler/GF/Main.hs
+++ b/src/compiler/GF/Main.hs
@@ -2,10 +2,7 @@
 {-# LANGUAGE CPP #-}
 module GF.Main where
 import GF.Compiler
-import qualified GF.Interactive as GFI1
-#ifdef C_RUNTIME
-import qualified GF.Interactive2 as GFI2
-#endif
+import GF.Interactive
 import GF.Data.ErrM
 import GF.Infra.Option
 import GF.Infra.UseIO
@@ -47,17 +44,7 @@ mainOpts opts files =
    case flag optMode opts of
      ModeVersion     -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo
      ModeHelp        -> putStrLn helpMessage
-      ModeServer port -> GFI1.mainServerGFI opts port files
+      ModeServer port -> mainServerGFI opts port files
      ModeCompiler    -> mainGFC opts files
-      ModeInteractive -> GFI1.mainGFI opts files
-      ModeRun         -> GFI1.mainRunGFI opts files
-#ifdef C_RUNTIME
-      ModeInteractive2 -> GFI2.mainGFI opts files
-      ModeRun2         -> GFI2.mainRunGFI opts files
-#else
-      ModeInteractive2 -> noCruntime
-      ModeRun2         -> noCruntime
-  where
-    noCruntime = do ePutStrLn "GF configured without C run-time support"
-                    exitFailure
-#endif
+      ModeInteractive -> mainGFI opts files
+      ModeRun         -> mainRunGFI opts files
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -18,13 +18,8 @@ module GF.Quiz (
  morphologyList
  ) where

-import PGF
--import PGF.Linearize
+import PGF2
 import GF.Data.Operations
--import GF.Infra.UseIO
--import GF.Infra.Option
--import PGF.Probabilistic
-
 import System.Random
 import Data.List (nub)

@@ -38,7 +33,7 @@ mkQuiz msg tts = do
  teachDialogue qas msg

 translationList :: 
-  Maybe Expr -> PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
+  Maybe Expr -> PGF -> Concr -> Concr -> Type -> Int -> IO [(String,[String])]
 translationList mex pgf ig og typ number = do
  gen <- newStdGen
  let ts   = take number $ case mex of
@@ -46,19 +41,22 @@ translationList mex pgf ig og typ number = do
                             Nothing -> generateRandom     gen pgf typ
  return $ map mkOne $ ts
 where
-   mkOne t = (norml (linearize pgf ig t), 
+   mkOne t = (norml (linearize ig t), 
              map norml (concatMap lins (homonyms t)))
-   homonyms = parse pgf ig typ . linearize pgf ig
-   lins = nub . concatMap (map snd) . tabularLinearizes pgf og
+   homonyms t = 
+     case (parse ig typ . linearize ig) t of
+       ParseOk res -> map fst res
+       _           -> []
+   lins = nub . concatMap (map snd) . tabularLinearizeAll og

 morphologyList :: 
-  Maybe Expr -> PGF -> Language -> Type -> Int -> IO [(String,[String])]
+  Maybe Expr -> PGF -> Concr -> Type -> Int -> IO [(String,[String])]
 morphologyList mex pgf ig typ number = do
  gen <- newStdGen
  let ts   = take (max 1 number) $ case mex of
                                     Just ex -> generateRandomFrom gen pgf ex
                                     Nothing -> generateRandom     gen pgf typ
-  let ss    = map (tabularLinearizes pgf ig) ts
+  let ss    = map (tabularLinearizeAll ig) ts
  let size  = length (head (head ss))
  let forms = take number $ randomRs (0,size-1) gen
  return [(snd (head pws0) +++ fst (pws0 !! i), ws) | 
--- a/Show More
+++ b/Show More
Author	SHA1	Message	Date
krangelov	320ead943c	Merge branch 'c-runtime' into compact-pgf	2019-09-20 14:08:30 +02:00
krangelov	c119d5e34b	silence encoding error	2019-09-20 14:07:07 +02:00
krangelov	529635e0e9	Merge branch 'c-runtime' into compact-pgf	2019-09-20 11:22:15 +02:00
krangelov	a33a84df3d	funnel the generated byte code to the runtime	2019-09-20 11:18:17 +02:00
krangelov	9e3512db81	Merge branch 'c-runtime' into compact-pgf	2019-09-20 10:55:23 +02:00
krangelov	8a419f66a6	Merge branch 'master' into c-runtime	2019-09-20 10:52:40 +02:00
krangelov	a27bcb8092	Merge branch 'master' into c-runtime	2019-09-20 10:42:50 +02:00
krangelov	e989cc69a2	compute the parameter indices	2019-09-20 09:49:46 +02:00
krangelov	5c5af8df79	Merge branch 'c-runtime' into compact-pgf	2019-09-20 08:10:46 +02:00
krangelov	084b345663	added option to show the probabilities of results	2019-09-20 08:09:54 +02:00
krangelov	400aad1d07	Merge branch 'c-runtime' into compact-pgf	2019-09-20 07:19:47 +02:00
krangelov	a0cfe09e09	added option -number to limit the number of parse results	2019-09-20 07:18:58 +02:00
krangelov	12912299be	added extra integer to store the offset of a parameter constructor	2019-09-19 22:53:07 +02:00
krangelov	b3c07d45b9	remove the old Haskell runtime	2019-09-19 22:40:40 +02:00
krangelov	acb70ccc1b	cleanup	2019-09-19 22:30:08 +02:00
krangelov	4a71464ca7	Merge with master and drop the Haskell runtime completely	2019-09-19 22:01:57 +02:00
krangelov	e993ae59f8	drop the haskell runtime, part 2	2019-09-19 10:06:06 +02:00
krangelov	f12557acf8	remove the dependency to the Haskell runtime completely	2019-09-19 10:03:04 +02:00
Krasimir Angelov	6a5053daeb	move the PGF optimizer in the compiler	2018-11-02 14:48:30 +01:00
Krasimir Angelov	5a2b200948	manually copy the "c-runtime" branch from the old repository.	2018-11-02 14:38:44 +01:00
Krasimir Angelov	bf5abe2948	the compiler and the Haskell runtime now support abstract senses	2018-11-02 14:01:54 +01:00