Simple hello world working with node-addon-api (C++)

Clear old contents of src/runtime/javascript, add README for upcoming bindings
2019-07-22 11:31:19 +02:00 · 2019-07-15 11:30:21 +02:00
302 changed files with 61088 additions and 12427 deletions
--- a/.github/workflows/build-all-versions.yml
+++ b/.github/workflows/build-all-versions.yml
@@ -1,108 +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:
      fail-fast: false
      matrix:
        os: [ubuntu-latest, macos-latest, windows-latest]
        cabal: ["latest"]
        ghc:
          - "8.6.5"
          - "8.8.3"
          - "8.10.7"
          - "9.6.7"
        exclude:
          - os: macos-latest
            ghc: 8.8.3
          - os: macos-latest
            ghc: 8.6.5
          - os: macos-latest
            ghc: 8.10.7
          - os: windows-latest
            ghc: 8.8.3
          - os: windows-latest
            ghc: 8.6.5
          - os: windows-latest
            ghc: 8.10.7
    steps:
    - uses: actions/checkout@v2
      if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
    - uses: haskell-actions/setup@v2
      id: setup-haskell-cabal
      name: Setup Haskell
      with:
        ghc-version: ${{ matrix.ghc }}
        cabal-version: ${{ matrix.cabal }}
    - name: Freeze
      run: |
        cabal freeze
    - uses: actions/cache@v4
      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: ${{ matrix.ghc == '7.10.3' && 'ubuntu-20.04' || 'ubuntu-latest' }}
    strategy:
      fail-fast: false
      matrix:
        stack: ["latest"]
        ghc: ["8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2", "9.6.7"]
    steps:
    - uses: actions/checkout@v2
      if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
    - uses: haskell-actions/setup@v2
      name: Setup Haskell Stack
      with:
        ghc-version: ${{ matrix.ghc }}
        stack-version: 'latest'
        enable-stack: true
    # Fix linker errrors on ghc-7.10.3 for ubuntu (see https://github.com/commercialhaskell/stack/blob/255cd830627870cdef34b5e54d670ef07882523e/doc/faq.md#i-get-strange-ld-errors-about-recompiling-with--fpic)
    - run: sed -i.bak 's/"C compiler link flags", "/&-no-pie /' /home/runner/.ghcup/ghc/7.10.3/lib/ghc-7.10.3/settings
      if: matrix.ghc == '7.10.3'
    - uses: actions/cache@v4
      name: Cache ~/.stack
      with:
        path: ~/.stack
        key: ${{ runner.os }}-${{ matrix.ghc }}-stack--${{ hashFiles(format('stack-ghc{0}', matrix.ghc)) }}
        restore-keys: |
             ${{ runner.os }}-${{ matrix.ghc }}-stack
    - name: Build
      run: |
        stack build --test --no-run-tests --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
    - 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,240 +0,0 @@
 name: Build Binary Packages
 on:
  workflow_dispatch:
  release:
    types: ["created"]
 jobs:
 # ---
  ubuntu:
    name: Build Ubuntu package
    strategy:
      matrix:
        ghc: ["9.6"]
        cabal: ["3.10"]
        os: ["ubuntu-24.04"]
    runs-on: ${{ matrix.os }}
    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: haskell-actions/setup@v2
      id: setup-haskell-cabal
      with:
        ghc-version: ${{ matrix.ghc }}
        cabal-version: ${{ matrix.cabal }}
      if: matrix.os == 'ubuntu-24.04'
    - name: Install build tools
      run: |
        sudo apt-get update
        sudo apt-get install -y \
          make \
          dpkg-dev \
          debhelper \
          libghc-json-dev \
          default-jdk \
          python-dev-is-python3 \
          libtool-bin 
        cabal install alex happy
    - name: Build package
      run: |
        export PYTHONPATH="/home/runner/work/gf-core/gf-core/debian/gf/usr/local/lib/python3.12/dist-packages/"
        make deb
    - name: Copy package
      run: |
        cp ../gf_*.deb dist/
    - name: Upload artifact
      uses: actions/upload-artifact@v4
      with:
        name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
        path: dist/gf_*.deb
        if-no-files-found: error
    - name: Rename package for specific ubuntu version
      run: |
        mv dist/gf_*.deb dist/gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
    #- uses: actions/upload-release-asset@v1.0.2
    #  env:
    #    GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
    #  with:
    #    upload_url: ${{ github.event.release.upload_url }}
    #    asset_path: dist/gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
    #    asset_name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
    #    asset_content_type: application/octet-stream
 # ---
  macos:
    name: Build macOS package
    strategy:
      matrix:
        ghc: ["9.6"]
        cabal: ["3.10"]
        os: ["macos-latest", "macos-13"]
    runs-on: ${{ matrix.os }}
    steps:
    - uses: actions/checkout@v2
    - name: Setup Haskell
      uses: haskell-actions/setup@v2
      id: setup-haskell-cabal
      with:
        ghc-version: ${{ matrix.ghc }}
        cabal-version: ${{ matrix.cabal }}
    - name: Install build tools
      run: |
        brew install \
          automake \
          libtool
        cabal v1-install alex happy
        pip install setuptools
    - 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@v4
      with:
        name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}
        path: dist/gf-*.pkg
        if-no-files-found: error
    - name: Rename package
      run: |
        mv dist/gf-*.pkg dist/gf-${{ github.event.release.tag_name }}-macos.pkg
    #- uses: actions/upload-release-asset@v1.0.2
    #  env:
    #    GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
    #  with:
    #    upload_url: ${{ github.event.release.upload_url }}
    #    asset_path: dist/gf-${{ github.event.release.tag_name }}-macos.pkg
    #    asset_name: gf-${{ github.event.release.tag_name }}-macos.pkg
    #    asset_content_type: application/octet-stream
 # ---
  windows:
    name: Build Windows package
    strategy:
      matrix:
        ghc: ["9.6.7"]
        cabal: ["3.10"]
        os: ["windows-2022"]
    runs-on: ${{ matrix.os }}
    steps:
    - uses: actions/checkout@v2
    - name: Setup MSYS2
      uses: msys2/setup-msys2@v2
      with:
        install: >-
          base-devel
          gcc
          python-devel
          autotools
    - 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
    # JAVA_HOME_8_X64 = C:\hostedtoolcache\windows\Java_Adopt_jdk\8.0.292-10\x64
    - name: Build Java bindings
      shell: msys2 {0}
      run: |
        echo $JAVA_HOME_8_X64
        export JDKPATH="$(cygpath -u "${JAVA_HOME_8_X64}")"
        export PATH="${PATH}:${JDKPATH}/bin"
        cd src/runtime/java
        make \
          JNI_INCLUDES="-I \"${JDKPATH}/include\" -I \"${JDKPATH}/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
      if: false
    # - uses: actions/setup-python@v5
    - name: Build Python bindings
      shell: msys2 {0}
      env:
        EXTRA_INCLUDE_DIRS: /mingw64/include
        EXTRA_LIB_DIRS: /mingw64/lib
      run: |
        cd src/runtime/python
        pacman --noconfirm -S python-setuptools
        python setup.py build
        python setup.py install
        cp -r /usr/lib/python3.12/site-packages/pgf* /c/tmp-dist/python
    - name: Setup Haskell
      uses: haskell-actions/setup@v2
      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 -fserver --only-dependencies 
        cabal configure -fserver
        cabal build
        copy dist-newstyle/build/x86_64-windows/ghc-${{matrix.ghc}}/*/x/gf/build/gf/gf.exe C:/tmp-dist
    - name: Upload artifact
      uses: actions/upload-artifact@v4
      with:
        name: gf-${{ github.event.release.tag_name }}-windows
        path: C:\tmp-dist\*
        if-no-files-found: error
    - name: Create archive
      run: |
        Compress-Archive C:\tmp-dist C:\gf-${{ github.event.release.tag_name }}-windows.zip
    #- uses: actions/upload-release-asset@v1.0.2
    #  env:
    #    GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
    #  with:
    #    upload_url: ${{ github.event.release.upload_url }}
    #    asset_path: C:\gf-${{ github.event.release.tag_name }}-windows.zip
    #    asset_name: gf-${{ github.event.release.tag_name }}-windows.zip
    #    asset_content_type: application/zip
--- a/.github/workflows/build-python-package.yml
+++ b/.github/workflows/build-python-package.yml
@@ -1,102 +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-latest, macos-latest, macos-13]
    steps:
    - uses: actions/checkout@v4
    - uses: actions/setup-python@v5
      name: Install Python
      with:
        python-version: '3.x'
    - name: Install cibuildwheel
      run: |
        python -m pip install cibuildwheel
    - name: Install build tools for OSX
      if: startsWith(matrix.os, 'macos')
      run: |
        brew install automake
        brew install libtool
    - 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 && sudo make install
      run: |
        python -m cibuildwheel src/runtime/python --output-dir wheelhouse
    - uses: actions/upload-artifact@v4
      with:
        name: wheel-${{ matrix.os }}
        path: ./wheelhouse
  build_sdist:
    name: Build source distribution
    runs-on: ubuntu-latest
    steps:
      - uses: actions/checkout@v4
      - uses: actions/setup-python@v5
        name: Install Python
        with:
          python-version: '3.10'
      - name: Build sdist
        run: cd src/runtime/python && python setup.py sdist
      - uses: actions/upload-artifact@v4
        with:
          name: wheel-source
          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@v4
      - name: Set up Python
        uses: actions/setup-python@v5
        with:
          python-version: '3.x'
      - name: Install twine
        run: pip install twine
      - uses: actions/download-artifact@v4.1.7
        with:
          pattern: wheel-*
          merge-multiple: true
          path: ./dist
      - name: Publish
        env:
          TWINE_USERNAME: __token__
          TWINE_PASSWORD: ${{ secrets.PYPI_PASSWORD }}
        run: |
          twine upload --verbose --non-interactive --skip-existing 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
@@ -51,12 +44,6 @@ cabal.sandbox.config
 .stack-work
 DATA_DIR
 stack*.yaml.lock
 # Output files for test suite
 *.out
 gf-tests.html
 # Generated documentation (not exhaustive)
 demos/index-numbers.html
 demos/resourcegrammars.html
@@ -73,9 +60,3 @@ doc/icfp-2012.html
 download/*.html
 gf-book/index.html
 src/www/gf-web-api.html
 .devenv
 .direnv
 result
 .vscode
 .envrc
 .pre-commit-config.yaml
--- a/.travis.yml
+++ b/.travis.yml
@@ -0,0 +1,14 @@
 sudo: required
 language: c
 services:
  - docker
 before_install:
  - docker pull odanoburu/gf-src:3.9
 script:
  - |
    docker run --mount src="$(pwd)",target=/home/gfer,type=bind odanoburu/gf-src:3.9 /bin/bash -c "cd /home/gfer/src/runtime/c &&
    autoreconf -i && ./configure && make && make install ; cd /home/gfer ; cabal install -fserver -fc-runtime --extra-lib-dirs='/usr/local/lib'"
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,12 +0,0 @@
 ### New since 3.12 (WIP)
 ### 3.12
 See <https://www.grammaticalframework.org/download/release-3.12.html>
 ### 3.11
 See <https://www.grammaticalframework.org/download/release-3.11.html>
 ### 3.10
 See <https://www.grammaticalframework.org/download/release-3.10.html>
--- a/49
+++ b/49
@@ -1,48 +1,31 @@
-.PHONY: all build install doc clean html deb pkg bintar sdist
+.PHONY: all build install doc clean gf html deb pkg bintar sdist
 # This gets the numeric part of the version from the cabal file
 VERSION=$(shell sed -ne "s/^version: *\([0-9.]*\).*/\1/p" gf.cabal)
 # Check if stack is installed
 STACK=$(shell if hash stack 2>/dev/null; then echo "1"; else echo "0"; fi)
 # Check if cabal >= 2.4 is installed (with v1- and v2- commands)
 CABAL_NEW=$(shell if cabal v1-repl --help >/dev/null 2>&1 ; then echo "1"; else echo "0"; fi)
 ifeq ($(STACK),1)
  CMD=stack
 else
  CMD=cabal
  ifeq ($(CABAL_NEW),1)
    CMD_PFX=v1-
  endif
 endif
 all: build
 dist/setup-config: gf.cabal Setup.hs WebSetup.hs
-ifneq ($(STACK),1)
+	cabal configure
 	cabal ${CMD_PFX}configure
 endif
 build: dist/setup-config
-	${CMD} ${CMD_PFX}build
+	cabal build
 install:
-ifeq ($(STACK),1)
+	cabal copy
-	stack install
+	cabal register
 else
 	cabal ${CMD_PFX}copy
 	cabal ${CMD_PFX}register
 endif
 doc:
-	${CMD} ${CMD_PFX}haddock
+	cabal haddock
 clean:
-	${CMD} ${CMD_PFX}clean
+	cabal clean
 	bash bin/clean_html
 gf:
 	cabal build rgl-none
 	strip dist/build/gf/gf
 html::
 	bash bin/update_html
@@ -50,9 +33,9 @@ html::
 # number to the top of debian/changelog.
 # (Tested on Ubuntu 15.04. You need to install dpkg-dev & debhelper.)
 deb:
-	dpkg-buildpackage -b -uc -d
+	dpkg-buildpackage -b -uc
-# Make a macOS installer package
+# Make an OS X Installer package
 pkg:
 	FMT=pkg bash bin/build-binary-dist.sh
@@ -65,6 +48,6 @@ bintar:
 # Make a source tar.gz distribution using git to make sure that everything is included.
 # We put the distribution in dist/ so it is removed on `make clean`
-# sdist:
+sdist:
-# 	test -d dist || mkdir dist
+	test -d dist || mkdir dist
-# 	git archive --format=tar.gz --output=dist/gf-${VERSION}.tar.gz HEAD
+	git archive --format=tar.gz --output=dist/gf-${VERSION}.tar.gz HEAD
--- a/README.md
+++ b/README.md
@@ -1,7 +1,9 @@
-![GF Logo](https://www.grammaticalframework.org/doc/Logos/gf1.svg)
+![GF Logo](doc/Logos/gf1.svg)
 # 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,31 +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
 ```
 Note that if you are unlucky to have Cabal 3.0 or later, then it uses
 the so-called Nix style commands. Using those for GF development is
 a pain. Every time when you change something in the source code, Cabal
 will generate a new folder for GF to look for the GF libraries and
 the GF cloud. Either reinstall everything with every change in the
 compiler, or be sane and stop using cabal-install. Instead you can do:
 ```
 runghc Setup.hs configure
 runghc Setup.hs build
 sudo runghc Setup.hs install
 ```
 The script will install the GF dependencies globally. The only solution
 to the Nix madness that I found is radical:
-  "No person, no problem" (Нет человека – нет проблемы).
+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).
 For more information, including links to precompiled binaries, see the [download page](https://www.grammaticalframework.org/download/index.html).
 ## About this repository
--- a/RELEASE.md
+++ b/RELEASE.md
@@ -1,69 +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 `stack sdist --test-tarball` and address any issues.
 2. Upload the package, either:
    1. **Manually**: visit <https://hackage.haskell.org/upload> and upload the file generated by the previous command.
    2. **via Stack**: `stack upload . --candidate`
 3. After testing the candidate, publish it:
    1. **Manually**: visit <https://hackage.haskell.org/package/gf-X.Y.Z/candidate/publish>
    1. **via Stack**: `stack upload .`
 4. 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
@@ -4,68 +4,43 @@ import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs
 import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..))
 import Distribution.PackageDescription(PackageDescription(..),emptyHookedBuildInfo)
 import Distribution.Simple.BuildPaths(exeExtension)
 import System.Directory
 import System.FilePath((</>),(<.>))
 import System.Process
 import Control.Monad(forM_,unless)
 import Control.Exception(bracket_)
 import Data.Char(isSpace)
 import WebSetup
 -- | Notice about RGL not built anymore
 noRGLmsg :: IO ()
 noRGLmsg = putStrLn "Notice: the RGL is not built as part of GF anymore. See https://github.com/GrammaticalFramework/gf-rgl"
 main :: IO ()
 main = defaultMainWithHooks simpleUserHooks
-  { preConf   = gfPreConf
+  { preBuild  = gfPreBuild
  , preBuild  = gfPreBuild
  , postBuild = gfPostBuild
  , preInst   = gfPreInst
  , postInst  = gfPostInst
  , postCopy  = gfPostCopy
  , sDistHook = gfSDist
  }
  where
-    gfPreConf args flags = do
+    gfPreBuild args  = gfPre args . buildDistPref
-      pkgs <- fmap (map (dropWhile isSpace) . tail . lines)
+    gfPreInst args = gfPre args . installDistPref
                   (readProcess "ghc-pkg" ["list"] "")
      forM_ dependencies $ \pkg -> do
        let name = takeWhile (/='/') (drop 36 pkg)
        unless (name `elem` pkgs) $ do
          let fname = name <.> ".tar.gz"
          callProcess "wget" [pkg,"-O",fname]
          callProcess "tar"  ["-xzf",fname]
          removeFile fname
          bracket_ (setCurrentDirectory name) (setCurrentDirectory ".." >> removeDirectoryRecursive name) $ do
            exists <- doesFileExist "Setup.hs"
            unless exists $ do
              writeFile "Setup.hs" (unlines [
                  "import Distribution.Simple",
                  "main = defaultMain"
                ])
            let to_descr = reverse .
                           (++) (reverse ".cabal") . 
                           drop 1 . 
                           dropWhile (/='-') . 
                           reverse
            callProcess "wget"   [to_descr pkg, "-O", to_descr name]
            callProcess "runghc" ["Setup.hs","configure"]
            callProcess "runghc" ["Setup.hs","build"]
            callProcess "sudo" ["runghc","Setup.hs","install"]
      preConf simpleUserHooks args flags
    gfPreBuild args = gfPre args . buildDistPref
    gfPreInst  args = gfPre args . installDistPref
    gfPre args distFlag = do
      return emptyHookedBuildInfo
    gfPostBuild args flags pkg lbi = do
      noRGLmsg
      let gf = default_gf lbi
      buildWeb gf flags (pkg,lbi)
    gfPostInst args flags pkg lbi = do
      noRGLmsg
      saveInstallPath args flags (pkg,lbi)
      installWeb (pkg,lbi)
    gfPostCopy args flags  pkg lbi = do
      noRGLmsg
      saveCopyPath args flags (pkg,lbi)
      copyWeb flags (pkg,lbi)
    -- `cabal sdist` will not make a proper dist archive, for that see `make sdist`
@@ -73,16 +48,27 @@ main = defaultMainWithHooks simpleUserHooks
    gfSDist pkg lbi hooks flags = do
      return ()
-dependencies = [
+saveInstallPath :: [String] -> InstallFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
-  "https://hackage.haskell.org/package/utf8-string-1.0.2/utf8-string-1.0.2.tar.gz",
+saveInstallPath args flags bi = do
-  "https://hackage.haskell.org/package/json-0.10/json-0.10.tar.gz",
+  let
-  "https://hackage.haskell.org/package/network-bsd-2.8.1.0/network-bsd-2.8.1.0.tar.gz",
+    dest = NoCopyDest
-  "https://hackage.haskell.org/package/httpd-shed-0.4.1.1/httpd-shed-0.4.1.1.tar.gz",
+    dir = datadir (uncurry absoluteInstallDirs bi dest)
-  "https://hackage.haskell.org/package/exceptions-0.10.5/exceptions-0.10.5.tar.gz",
+  writeFile dataDirFile dir
-  "https://hackage.haskell.org/package/stringsearch-0.3.6.6/stringsearch-0.3.6.6.tar.gz",
+
-  "https://hackage.haskell.org/package/multipart-0.2.1/multipart-0.2.1.tar.gz",
+saveCopyPath :: [String] -> CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
-  "https://hackage.haskell.org/package/cgi-3001.5.0.0/cgi-3001.5.0.0.tar.gz"
+saveCopyPath args flags bi = do
-  ]
+  let
    dest = case copyDest flags of
      NoFlag -> NoCopyDest
      Flag d -> d
    dir = datadir (uncurry absoluteInstallDirs bi dest)
  writeFile dataDirFile dir
 -- | Name of file where installation's data directory is recording
 -- This is a last-resort way in which the seprate RGL build script
 -- can determine where to put the compiled RGL files
 dataDirFile :: String
 dataDirFile = "DATA_DIR"
 -- | Get path to locally-built gf
 default_gf :: LocalBuildInfo -> FilePath
--- 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 putStr $ unlines
-  else return ()
+    [ "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.
+### This script builds a binary distribution of GF from the source
-### It assumes that you have Haskell and Cabal installed.
+### package that this script is a part of. It assumes that you have installed
-### Two binary package formats are supported (specified with the FMT env var):
+### a recent version of the Haskell Platform.
-### - plain tar files (.tar.gz)
+### Two binary package formats are supported: plain tar files (.tar.gz) and
-### - macOS installer packages (.pkg)
+### 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
+# GF version number:
 # cabal="cabal " # Cabal <= 2.2
 ## Get GF version number from Cabal file
 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
+	# A hack for Python on OS X to find the PGF modules
-        pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')
+	pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')
-        pydest="$destdir/Library/Python/$pyver/site-packages"
+	pydest="$destdir/Library/Python/$pyver/site-packages"
-        mkdir -p "$pydest"
+	mkdir -p "$pydest"
-        ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf*.so "$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 install -w "$ghc" --only-dependencies -fserver -fc-runtime $extra
-${cabal}configure -w "$ghc" --prefix="$prefix" -fserver -fc-runtime $extra
+cabal configure -w "$ghc" --prefix="$prefix" -fserver -fc-runtime $extra
-${cabal}build
+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
+	targz="$name-bin-$hw-$os.tar.gz"     # the final tar file
-        tar --directory "$destdir/$prefix" --gzip --create --file "dist/$targz" .
+	tar -C "$destdir/$prefix" -zcf "dist/$targz" .
-        echo "Created $targz"
+	echo "Created $targz, consider renaming it to something more user friendly"
-        ;;
+	;;
    pkg)
-        pkg=$name.pkg
+	pkg=$name.pkg
-        pkgbuild --identifier org.grammaticalframework.gf.pkg --version "$ver" --root "$destdir" --install-location / dist/$pkg
+	pkgbuild --identifier org.grammaticalframework.gf.pkg --version "$ver" --root "$destdir" --install-location / dist/$pkg
-        echo "Created $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,20 +1,3 @@
 gf (3.12) noble; urgency=low
  * GF 3.12
 -- Inari Listenmaa <inari@digitalgrammars.com>  Fri, 8 Aug 2025 18:29:29 +0100
 gf (3.11) bionic focal; urgency=low
  * GF 3.11
 -- Inari Listenmaa <inari@digitalgrammars.com>  Sun, 25 Jul 2021 10:27:40 +0800
 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,7 +3,7 @@ Section: devel
 Priority: optional
 Maintainer: Thomas Hallgren <hallgren@chalmers.se>
 Standards-Version: 3.9.2
-Build-Depends: debhelper (>= 5), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev-is-python3, 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
--- a/debian/rules
+++ b/debian/rules
@@ -17,30 +17,32 @@ override_dh_auto_configure:
 	cd src/runtime/c && bash setup.sh configure --prefix=/usr
 	cd src/runtime/c && bash setup.sh build
 	cabal update
-	cabal v1-install --only-dependencies
+	cabal install --only-dependencies
-	cabal v1-configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c
+	cabal configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c
 SET_LDL=LD_LIBRARY_PATH=$$LD_LIBRARY_PATH:$(CURDIR)/src/runtime/c/.libs
 override_dh_auto_build:
 	cd src/runtime/python && EXTRA_INCLUDE_DIRS=$(CURDIR)/src/runtime/c EXTRA_LIB_DIRS=$(CURDIR)/src/runtime/c/.libs python setup.py build
-	# cd src/runtime/java && make CFLAGS="-I$(CURDIR)/src/runtime/c -L$(CURDIR)/src/runtime/c/.libs" INSTALL_PATH=/usr
+	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 v1-build
+	$(SET_LDL) cabal build # builds gf, fails to build example grammars 
 	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 v1-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 dist-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv dist-packages dist-packages
+	D="`find debian/gf -name site-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv site-packages dist-packages
 override_dh_usrlocal:
 override_dh_auto_clean:
 	rm -fr dist/build
 	-cd src/runtime/python && rm -fr build
-	# -cd src/runtime/java && make clean
+	-cd src/runtime/java && make clean
 	-cd src/runtime/c && make clean
 override_dh_auto_test:
--- 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-old-cabal.t2t
+++ b/doc/gf-developers-old-cabal.t2t
@@ -1,201 +0,0 @@
 GF Developer's Guide: Old installation instructions with Cabal
 This page contains the old installation instructions from the [Developer's Guide ../doc/gf-developers.html].
 We recommend Stack as a primary installation method, because it's easier for a Haskell beginner, and we want to keep the main instructions short.
 But if you are an experienced Haskeller and want to keep using Cabal, here are the old instructions using ``cabal install``.
 Note that some of these instructions may be outdated. Other parts may still be useful.
 == Compilation from source with Cabal ==
 The build system of GF is based on //Cabal//, which is part of the
 Haskell Platform, so no extra steps are needed to install it. In the simplest
 case, all you need to do to compile and install GF, after downloading the
 source code as described above, is
 ```
 $ cabal install
 ```
 This will automatically download any additional Haskell libraries needed to
 build GF. If this is the first time you use Cabal, you might need to run
 ``cabal update`` first, to update the list of available libraries.
 If you want more control, the process can also be split up into the usual
 //configure//, //build// and //install// steps.
 === Configure ===
 During the configuration phase Cabal will check that you have all
 necessary tools and libraries needed for GF. The configuration is
 started by the command:
 ```
 $ cabal configure
 ```
 If you don't see any error message from the above command then you
 have everything that is needed for GF. You can also add the option
 ``-v`` to see more details about the configuration.
 You can use ``cabal configure --help`` to get a list of configuration options.
 === Build ===
 The build phase does two things. First it builds the GF compiler from
 the Haskell source code and after that it builds the GF Resource Grammar
 Library using the already build compiler.  The simplest command is:
 ```
 $ cabal build
 ```
 Again you can add the option ``-v`` if you want to see more details.
 ==== Parallel builds ====
 If you have Cabal>=1.20 you can enable parallel compilation by using
 ```
 $ cabal build -j
 ```
 or by putting a line
 ```
 jobs: $ncpus
 ```
 in your ``.cabal/config`` file. Cabal
 will pass this option to GHC when building the GF compiler, if you
 have GHC>=7.8.
 Cabal also passes ``-j`` to GF to enable parallel compilation of the
 Resource Grammar Library. This is done unconditionally to avoid
 causing problems for developers with Cabal<1.20. You can disable this
 by editing the last few lines in ``WebSetup.hs``.
 === Install ===
 After you have compiled GF you need to install the executable and libraries
 to make the system usable.
 ```
 $ cabal copy
 $ cabal register
 ```
 This command installs the GF compiler for a single user, in the standard
 place used by Cabal.
 On Linux and Mac this could be ``$HOME/.cabal/bin``.
 On Mac it could also be ``$HOME/Library/Haskell/bin``.
 On Windows this is ``C:\Program Files\Haskell\bin``.
 The compiled GF Resource Grammar Library will be installed
 under the same prefix, e.g. in
 ``$HOME/.cabal/share/gf-3.3.3/lib`` on Linux and
 in ``C:\Program Files\Haskell\gf-3.3.3\lib`` on Windows.
 If you want to install in some other place then use the ``--prefix``
 option during the configuration phase.
 === Clean ===
 Sometimes you want to clean up the compilation and start again from clean
 sources. Use the clean command for this purpose:
 ```
 $ cabal clean
 ```
 %=== SDist ===
 %
 %You can use the command:
 %
 %% This does *NOT* include everything that is needed // TH 2012-08-06
 %```
 %$ cabal sdist
 %```
 %
 %to prepare archive with all source codes needed to compile GF.
 === Known problems with Cabal ===
 Some versions of Cabal (at least version 1.16) seem to have a bug that can
 cause the following error:
 ```
 Configuring gf-3.x...
 setup: Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed
 ```
 The exact cause of this problem is unclear, but it seems to happen
 during the configure phase if the same version of GF is already installed,
 so a workaround is to remove the existing installation with
 ```
 ghc-pkg unregister gf
 ```
 You can check with ``ghc-pkg list gf`` that it is gone.
 == Compilation with make ==
 If you feel more comfortable with Makefiles then there is a thin Makefile
 wrapper arround Cabal for you. If you just type:
 ```
 $ make
 ```
 the configuration phase will be run automatically if needed and after that
 the sources will be compiled.
 %% cabal build rgl-none does not work with recent versions of Cabal
 %If you don't want to compile the resource library
 %every time then you can use:
 %```
 %$ make gf
 %```
 For installation use:
 ```
 $ make install
 ```
 For cleaning:
 ```
 $ make clean
 ```
 %and to build source distribution archive run:
 %```
 %$ make sdist
 %```
 == Partial builds of RGL ==
 **NOTE**: The following doesn't work with recent versions of ``cabal``. //(This comment was left in 2015, so make your own conclusions.)//
 %% // TH 2015-06-22
 %Sometimes you just want to work on the GF compiler and don't want to
 %recompile the resource library after each change. In this case use
 %this extended command:
 %```
 %$ cabal build rgl-none
 %```
 The resource grammar library can be compiled in two modes: with present
 tense only and with all tenses. By default it is compiled with all
 tenses. If you want to use the library with only present tense you can
 compile it in this special mode with the command:
 ```
 $ cabal build present
 ```
 You could also control which languages you want to be recompiled by
 adding the option ``langs=list``. For example the following command
 will compile only the English and the Swedish language:
 ```
 $ cabal build langs=Eng,Swe
 ```
--- a/doc/gf-developers.t2t
+++ b/doc/gf-developers.t2t
@@ -1,6 +1,6 @@
 GF Developers Guide
-2021-07-15
+2018-07-26
 %!options(html): --toc
@@ -15,304 +15,386 @@ you are a GF user who just wants to download and install GF
 == Setting up your system for building GF ==
 To build GF from source you need to install some tools on your
-system: the Haskell build tool //Stack//, the version control software //Git// and the //Haskeline// library.
+system: the //Haskell Platform//, //Git// and the //Haskeline library//.
-%**On Linux** the best option is to install the tools via the standard
+**On Linux** the best option is to install the tools via the standard
-%software distribution channels, i.e. by using the //Software Center//
+software distribution channels, i.e. by using the //Software Center//
-%in Ubuntu or the corresponding tool in other popular Linux distributions.
+in Ubuntu or the corresponding tool in other popular Linux distributions.
 Or, from a Terminal window, the following command should be enough:
-%**On Mac OS and Windows**, the tools can be downloaded from their respective
+- On Ubuntu: ``sudo apt-get install haskell-platform git libghc6-haskeline-dev``
-%web sites, as described below.
+- On Fedora: ``sudo dnf install haskell-platform git ghc-haskeline-devel``
 === Stack ===
 The primary installation method is via //Stack//.
 (You can also use Cabal, but we recommend Stack to those who are new to Haskell.)
 To install Stack:
 - **On Linux and Mac OS**, do either
    ``$ curl -sSL https://get.haskellstack.org/ | sh``
  or
    ``$ wget -qO- https://get.haskellstack.org/ | sh``
- **On other operating systems**, see the [installation guide https://docs.haskellstack.org/en/stable/install_and_upgrade].
+**On Mac OS and Windows**, the tools can be downloaded from their respective
 web sites, as described below.
 === The Haskell Platform ===
-%If you already have Stack installed, upgrade it to the latest version by running: ``stack upgrade``
+GF is written in Haskell, so first of all you need
 the //Haskell Platform//, e.g. version 8.0.2 or 7.10.3. Downloads
 and installation instructions are available from here:
    http://hackage.haskell.org/platform/
 Once you have installed the Haskell Platform, open a terminal
 (Command Prompt on Windows) and try to execute the following command:
 ```
 $ ghc --version
 ```
 This command should show you which version of GHC you have. If the installation
 of the Haskell Platform	 was successful you should see a message like:
 ```
 The Glorious Glasgow Haskell Compilation System, version 8.0.2
 ```
 Other required tools included in the Haskell Platform are
 [Cabal http://www.haskell.org/cabal/],
 [Alex http://www.haskell.org/alex/]
 and
 [Happy http://www.haskell.org/happy/].
 === Git ===
-To get the GF source code, you also need //Git//, a distributed version control system.
+To get the GF source code, you also need //Git//.
 //Git// is a distributed version control system, see
 https://git-scm.com/downloads for more information.
- **On Linux**, the best option is to install the tools via the standard
+=== The haskeline library ===
 software distribution channels:
  - On Ubuntu: ``sudo apt-get install git-all``
  - On Fedora: ``sudo dnf install git-all``
 - **On other operating systems**, see
 https://git-scm.com/book/en/v2/Getting-Started-Installing-Git for installation.
 === Haskeline ===
 GF uses //haskeline// to enable command line editing in the GF shell.
 This should work automatically on Mac OS and Windows, but on Linux one
 extra step is needed to make sure the C libraries (terminfo)
 required by //haskeline// are installed.  Here is one way to do this:
- **On Mac OS and Windows**, this should work automatically.
+- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``
-
+- On Fedora: ``sudo dnf install ghc-haskeline-devel``
 - **On Linux**, an extra step is needed to make sure the C libraries (terminfo)
 required by //haskeline// are installed:
  - On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``
  - On Fedora: ``sudo dnf install ghc-haskeline-devel``
-== Getting the source ==[getting-source]
+== Getting the source ==
-Once you have all tools in place you can get the GF source code from
+Once you have all tools in place you can get the GF source code. If you
-[GitHub https://github.com/GrammaticalFramework/]:
+just want to compile and use GF then it is enough to have read-only
 access. It is also possible to make changes in the source code but if you
 want these changes to be applied back to the main source repository you will
 have to send the changes to us.  If you plan to work continuously on
 GF then you should consider getting read-write access.
- https://github.com/GrammaticalFramework/gf-core for the GF compiler
+=== Read-only access ===
 - https://github.com/GrammaticalFramework/gf-rgl for the Resource Grammar Library
 ==== Getting a fresh copy for read-only access ====
-=== Read-only access: clone the main repository ===
+Anyone can get the latest development version of GF by running:
 If you only want to compile and use GF, you can just clone the repositories as follows:
 ```
-  $ git clone https://github.com/GrammaticalFramework/gf-core.git
+$ git clone https://github.com/GrammaticalFramework/gf-core.git
-  $ git clone https://github.com/GrammaticalFramework/gf-rgl.git
+$ git clone https://github.com/GrammaticalFramework/gf-rgl.git
 ```
-To get new updates, run the following anywhere in your local copy of the repository:
+This will create directories ``gf-core`` and ``gf-rgl`` in the current directory.
 ==== Updating your copy ====
 To get all new patches from each repo:
 ```
 $ git pull
 ```
 This can be done anywhere in your local repository.
 ==== Recording local changes ====[record]
 Since every copy is a repository, you can have local version control
 of your changes.
 If you have added files, you first need to tell your local repository to
 keep them under revision control:
 ```
-  $ git pull
+$ git add file1 file2 ...
 ```
-=== Contribute your changes: fork the main repository ===
+To record changes, use:
 If you want the possibility to contribute your changes,
 you should create your own fork, do your changes there,
 and then send a pull request to the main repository.
 + **Creating and cloning a fork  —**
 See GitHub documentation for instructions how to [create your own fork https://docs.github.com/en/get-started/quickstart/fork-a-repo]
 of the repository. Once you've done it, clone the fork to your local computer.
 ```
-  $ git clone https://github.com/<YOUR_USERNAME>/gf-core.git
+$ git commit file1 file2 ...
 ```
-+ **Updating your copy —**
+This creates a patch against the previous version and stores it in your
-Once you have cloned your fork, you need to set up the main repository as a remote:
+local repository. You can record any number of changes before
 pushing them to the main repo. In fact, you don't have to push them at
 all if you want to keep the changes only in your local repo.
 Instead of enumerating all modified files on the command line,
 you can use the flag ``-a`` to automatically record //all// modified
 files. You still need to use ``git add`` to add new files.
 === Read-write access ===
 If you are a member of the GF project on GitHub, you can push your
 changes directly to the GF git repository on GitHub.
 ```
-  $ git remote add upstream https://github.com/GrammaticalFramework/gf-core.git
+$ git push
 ```
-Then you can get the latest updates by running the following:
+It is also possible for anyone else to contribute by
-```
+- creating a fork of the GF repository on GitHub,
-  $ git pull upstream master
+- working with local clone of the fork (obtained with ``git clone``),
-```
+- pushing changes to the fork,
-
+- and finally sending a pull request.
 + **Recording local changes —**
 See Git tutorial on how to [record and push your changes https://git-scm.com/book/en/v2/Git-Basics-Recording-Changes-to-the-Repository] to your fork.
 + **Pull request —**
 When you want to contribute your changes to the main gf-core repository,
 [create a pull request https://docs.github.com/en/github/collaborating-with-pull-requests/proposing-changes-to-your-work-with-pull-requests/creating-a-pull-request]
 from your fork.
-If you want to contribute to the RGL as well, do the same process for the RGL repository.
+== Compilation from source with Cabal ==
-
+The build system of GF is based on //Cabal//, which is part of the
-== Compilation from source ==
+Haskell Platform, so no extra steps are needed to install it. In the simplest
-
+case, all you need to do to compile and install GF, after downloading the
-By now you should have installed Stack and Haskeline, and cloned the Git repository on your own computer, in a directory called ``gf-core``.
+source code as described above, is
 === Primary recommendation: use Stack ===
 Open a terminal, go to the top directory (``gf-core``), and type the following command.
 ```
 $ stack install
 ```
 === Alternative: use Cabal ===
 If you prefer Cabal, then you just need to manually choose a suitable GHC to build GF. We recommend GHC 9.6.7, see other supported options in [gf.cabal https://github.com/GrammaticalFramework/gf-core/blob/master/gf.cabal#L14].
 The actual installation process is similar to Stack: open a terminal, go to the top directory (``gf-core``), and type the following command.
 ```
 $ cabal install
 ```
-=== Nix ===
+This will automatically download any additional Haskell libraries needed to
 build GF. If this is the first time you use Cabal, you might need to run
 ``cabal update`` first, to update the list of available libraries.
-As of 3.12, GF can also be installed via Nix. You can install GF from github with the following command:
+If you want more control, the process can also be split up into the usual
 //configure//, //build// and //install// steps.
 === Configure ===
 During the configuration phase Cabal will check that you have all
 necessary tools and libraries needed for GF. The configuration is
 started by the command:
 ```
-nix profile install github:GrammaticalFramework/gf-core#gf
+$ cabal configure
 ```
-== Compiling GF with C runtime system support ==
+If you don't see any error message from the above command then you
 have everything that is needed for GF. You can also add the option
 ``-v`` to see more details about the configuration.
-The C runtime system is a separate implementation of the PGF runtime services.
+You can use ``cabal configure --help`` to get a list of configuration options.
 === Build ===
 The build phase does two things. First it builds the GF compiler from
 the Haskell source code and after that it builds the GF Resource Grammar
 Library using the already build compiler.  The simplest command is:
 ```
 $ cabal build
 ```
 Again you can add the option ``-v`` if you want to see more details.
 ==== Parallel builds ====
 If you have Cabal>=1.20 you can enable parallel compilation by using
 ```
 $ cabal build -j
 ```
 or by putting a line
 ```
 jobs: $ncpus
 ```
 in your ``.cabal/config`` file. Cabal
 will pass this option to GHC when building the GF compiler, if you
 have GHC>=7.8.
 Cabal also passes ``-j`` to GF to enable parallel compilation of the
 Resource Grammar Library. This is done unconditionally to avoid
 causing problems for developers with Cabal<1.20. You can disable this
 by editing the last few lines in ``WebSetup.hs``.
 ==== Partial builds ====
 **NOTE**: The following doesn't work with recent versions of ``cabal``.
 %% // TH 2015-06-22
 Sometimes you just want to work on the GF compiler and don't want to
 recompile the resource library after each change. In this case use
 this extended command:
 ```
 $ cabal build rgl-none
 ```
 The resource library could also be compiled in two modes: with present
 tense only and with all tenses. By default it is compiled with all
 tenses. If you want to use the library with only present tense you can
 compile it in this special mode with the command:
 ```
 $ cabal build present
 ```
 You could also control which languages you want to be recompiled by
 adding the option ``langs=list``. For example the following command
 will compile only the English and the Swedish language:
 ```
 $ cabal build langs=Eng,Swe
 ```
 === Install ===
 After you have compiled GF you need to install the executable and libraries
 to make the system usable.
 ```
 $ cabal copy
 $ cabal register
 ```
 This command installs the GF compiler for a single user, in the standard
 place used by Cabal.
 On Linux and Mac this could be ``$HOME/.cabal/bin``.
 On Mac it could also be ``$HOME/Library/Haskell/bin``.
 On Windows this is ``C:\Program Files\Haskell\bin``.
 The compiled GF Resource Grammar Library will be installed
 under the same prefix, e.g. in
 ``$HOME/.cabal/share/gf-3.3.3/lib`` on Linux and
 in ``C:\Program Files\Haskell\gf-3.3.3\lib`` on Windows.
 If you want to install in some other place then use the ``--prefix``
 option during the configuration phase.
 === Clean ===
 Sometimes you want to clean up the compilation and start again from clean
 sources. Use the clean command for this purpose:
 ```
 $ cabal clean
 ```
 %=== SDist ===
 %
 %You can use the command:
 %
 %% This does *NOT* include everything that is needed // TH 2012-08-06
 %```
 %$ cabal sdist
 %```
 %
 %to prepare archive with all source codes needed to compile GF.
 === Known problems with Cabal ===
 Some versions of Cabal (at least version 1.16) seem to have a bug that can
 cause the following error:
 ```
 Configuring gf-3.x...
 setup: Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed
 ```
 The exact cause of this problem is unclear, but it seems to happen
 during the configure phase if the same version of GF is already installed,
 so a workaround is to remove the existing installation with
 ```
 ghc-pkg unregister gf
 ```
 You can check with ``ghc-pkg list gf`` that it is gone.
 == Compilation with make ==
 If you feel more comfortable with Makefiles then there is a thin Makefile
 wrapper arround Cabal for you. If you just type:
 ```
 $ make
 ```
 the configuration phase will be run automatically if needed and after that
 the sources will be compiled.
 %% cabal build rgl-none does not work with recent versions of Cabal
 %If you don't want to compile the resource library
 %every time then you can use:
 %```
 %$ make gf
 %```
 For installation use:
 ```
 $ make install
 ```
 For cleaning:
 ```
 $ make clean
 ```
 %and to build source distribution archive run:
 %```
 %$ make sdist
 %```
 == Compiling GF with C run-time system support ==
 The C run-time system is a separate implementation of the PGF run-time services.
 It makes it possible to work with very large, ambiguous grammars, using
-probabilistic models to obtain probable parses. The C runtime system might
+probabilistic models to obtain probable parses. The C run-time system might
-also be easier to use than the Haskell runtime system on certain platforms,
+also be easier to use than the Haskell run-time system on certain platforms,
 e.g. Android and iOS.
-To install the C runtime system, go to the ``src/runtime/c`` directory.
+To install the C run-time system, go to the ``src/runtime/c`` directory
 %and follow the instructions in the ``INSTALL`` file.
 and use the ``install.sh`` script:
 ```
 bash setup.sh configure
 bash setup.sh build
 bash setup.sh install
 ```
 This will install
 the C header files and libraries need to write C programs that use PGF grammars.
 Some example C programs are included in the ``utils`` subdirectory, e.g.
 ``pgf-translate.c``.
- **On Linux and Mac OS —**
+When the C run-time system is installed, you can install GF with C run-time
-  You should have autoconf, automake, libtool and make.
+support by doing
  If you are missing some of them, follow the
  instructions in the [INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file.
  Once you have the required libraries, the easiest way to install the C runtime is to use the ``install.sh`` script. Just type
  ``$ bash install.sh``
  This will install the C header files and libraries need to write C programs
  that use PGF grammars.
 %  If this doesn't work for you, follow the manual instructions in the [INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file under your operating system.
 - **On other operating systems —** Follow the instructions in the
 [INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file under your operating system.
 Depending on what you want to do with the C runtime, you can follow one or more of the following steps.
 === Use the C runtime from another programming language ===[bindings]
 % **If you just want to use the C runtime from Python or Haskell, you don't need to change your GF installation.**
 - **What —**
 This is the most common use case for the C runtime: compile
 your GF grammars into PGF with the standard GF executable,
 and manipulate the PGFs from another programming language,
 using the bindings to the C runtime.
 - **How —**
 The Python, Java and Haskell bindings are found in the
 ``src/runtime/{python,java,haskell-bind}`` directories,
 respecively. Compile them by following the instructions
 in the ``INSTALL`` or ``README`` files in those directories.
 The Python library can also be installed from PyPI using ``pip install pgf``.
 //If you are on Mac and get an error about ``clang`` version, you can try some of [these solutions https://stackoverflow.com/questions/63972113/big-sur-clang-invalid-version-error-due-to-macosx-deployment-target]—but be careful before removing any existing installations.//
 === Use GF shell with C runtime support ===
 - **What —**
 If you want to use the GF shell with C runtime functionalities, then you need to (re)compile GF with special flags.
 The GF shell can be started with ``gf -cshell`` or ``gf -crun`` to use
 the C run-time system instead of the Haskell run-time system.
 Only limited functionality is available when running the shell in these
 modes (use the ``help`` command in the shell for details).
 (Re)compiling your GF with these flags will also give you
 Haskell bindings to the C runtime, as a library called ``PGF2``,
 but if you want Python bindings, you need to do [the previous step #bindings].
 % ``PGF2``: a module to import in Haskell programs, providing a binding to the C run-time system.
 - **How —**
 Add (or uncomment) the following lines in the ``stack.yaml`` file:
 ```
-flags:
+cabal install -fserver -fc-runtime
   gf:
     c-runtime: true
 extra-lib-dirs:
   - /usr/local/lib
 ```
-and then run ``stack install`` from the top directory (``gf-core``).
+from the top directory. This give you three new things:
-Run the newly built executable with the flag ``-cshell``, and you should see the following welcome message:
+- ``PGF2``: a module to import in Haskell programs, providing a binding to
   the C run-time system.
-```
+- The GF shell can be started with ``gf -cshell`` or ``gf -crun`` to use
-$ gf -cshell
+  the C run-time system instead of the Haskell run-time system.
  Only limited functionality is available when running the shell in these
  modes (use the ``help`` command in the shell for details).
-         *  *  *
+- ``gf -server`` mode is extended with new requests to call the C run-time
-      *           *
+   system, e.g. ``c-parse``, ``c-linearize`` and ``c-translate``.
    *               *
   *
   *
   *        * * * * * *
   *        *         *
    *       * * * *  *
      *     *      *
         *  *  *
 This is GF version 3.12.0.
 Built on ...
 Git info: ...
 Flags: interrupt server c-runtime
 License: see help -license.
 This shell uses the C run-time system. See help for available commands.
 >
 ```
 //If you get an "``error while loading shared libraries``" when trying to run GF with C runtime, remember to declare your ``LD_LIBRARY_PATH``.//
 //Add ``export LD_LIBRARY_PATH="/usr/local/lib"`` to either your ``.bashrc`` or ``.profile``. You should now be able to start GF with C runtime.//
-=== Use GF server mode with C runtime ===
+=== Python and Java bindings ===
 - **What —**
 With this feature, ``gf -server`` mode is extended with new requests to call the C run-time
 system, e.g. ``c-parse``, ``c-linearize`` and ``c-translate``.
 - **How —**
 Add the following lines in the ``stack.yaml`` file:
 ```
 flags:
   gf:
     c-runtime: true
     server: true
 extra-lib-dirs:
   - /usr/local/lib
 ```
 and then run ``stack install``, also from the top directory.
 The C run-time system can also be used from Python and Java. Python and Java
 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.
 == Compilation of RGL ==
 As of 2018-07-26, the RGL is distributed separately from the GF compiler and runtimes.
 To get the source, follow the previous instructions on [how to clone a repository with Git #getting-source].
 After cloning the RGL, you should have a directory named ``gf-rgl`` on your computer.
 === Simple ===
 To install the RGL, you can use the following commands from within the ``gf-rgl`` repository:
 ```
@@ -334,68 +416,103 @@ If you do not have Haskell installed, you can use the simple build script ``Setu
 == Creating binary distribution packages ==
-The binaries are generated with Github Actions. More details can be viewed here:
+=== Creating .deb packages for Ubuntu ===
-https://github.com/GrammaticalFramework/gf-core/actions/workflows/build-binary-packages.yml
+This was tested on Ubuntu 14.04 for the release of GF 3.6, and the
 resulting ``.deb`` packages appears to work on Ubuntu 12.04, 13.10 and 14.04.
 For the release of GF 3.7, we generated ``.deb`` packages on Ubuntu 15.04 and
 tested them on Ubuntu 12.04 and 14.04.
 Under Ubuntu, Haskell executables are statically linked against other Haskell
 libraries, so the .deb packages are fairly self-contained.
-== Running the test suite ==
+==== Preparations ====
 The GF test suite is run with one of the following commands from the top directory:
 ```
-  $ cabal test
+sudo apt-get install dpkg-dev debhelper
 ```
-or
+==== Creating the package ====
 Make sure the ``debian/changelog`` starts with an entry that describes the
 version you are building. Then run
 ```
-  $ stack test
+make deb
 ```
 If get error messages about missing dependencies
 (e.g. ``autoconf``, ``automake``, ``libtool-bin``, ``python-dev``,
 ``java-sdk``, ``txt2tags``)
 use ``apt-get intall`` to install them, then try again.
 === Creating OS X Installer packages ===
 Run
 ```
 make pkg
 ```
 === Creating binary tar distributions ===
 Run
 ```
 make bintar
 ```
 === Creating .rpm packages for Fedora ===
 This is possible, but the procedure has not been automated.
 It involves using the cabal-rpm tool,
 ```
 sudo dnf install cabal-rpm
 ```
 and following the Fedora guide
 [How to create an RPM package http://fedoraproject.org/wiki/How_to_create_an_RPM_package].
 Under Fedora, Haskell executables are dynamically linked against other Haskell
 libraries, so ``.rpm`` packages for all Haskell libraries that GF depends on
 are required. Most of them are already available in the Fedora distribution,
 but a few of them might have to be built and distributed along with
 the GF ``.rpm`` package.
 When building ``.rpm`` packages for GF 3.4, we also had to build ``.rpm``s for
 ``fst`` and ``httpd-shed``.
 == Running the testsuite ==
 **NOTE:** The test suite has not been maintained recently, so expect many
 tests to fail.
 %% // TH 2012-08-06
 GF has testsuite. It is run with the following command:
 ```
 $ cabal test
 ```
 The testsuite architecture for GF is very simple but still very flexible.
 GF by itself is an interpreter and could execute commands in batch mode.
 This is everything that we need to organize a testsuite. The root of the
-testsuite is the ``testsuite/`` directory. It contains subdirectories
+testsuite is the testsuite/ directory. It contains subdirectories which
-which themselves contain GF batch files (with extension ``.gfs``).
+themself contain GF batch files (with extension .gfs). The above command
-The above command searches the subdirectories of the ``testsuite/`` directory
+searches the subdirectories of the testsuite/ directory for files with extension
-for files with extension ``.gfs`` and when it finds one, it is executed with
+.gfs and when it finds one it is executed with the GF interpreter.
-the GF interpreter. The output of the script is stored in file with extension ``.out``
+The output of the script is stored in file with extension .out and is compared
-and is compared with the content of the corresponding file with extension ``.gold``, if there is one.
+with the content of the corresponding file with extension .gold, if there is one.
 If the contents are identical the command reports that the test was passed successfully.
 Otherwise the test had failed.
-Every time when you make some changes to GF that have to be tested,
+Every time when you make some changes to GF that have to be tested, instead of
-instead of writing the commands by hand in the GF shell, add them to one ``.gfs``
+writing the commands by hand in the GF shell, add them to one .gfs file in the testsuite
-file in the testsuite subdirectory where its ``.gf`` file resides and run the test.
+and run the test. In this way you can use the same test later and we will be sure
-In this way you can use the same test later and we will be sure that we will not
+that we will not incidentaly break your code later.
 accidentally break your code later.
 **Test Outcome - Passed:** If the contents of the files with the ``.out`` extension
 are identical to their correspondingly-named files with the extension ``.gold``,
 the command will report that the tests passed successfully, e.g.
 If you don't want to run the whole testsuite you can write the path to the subdirectory
 in which you are interested. For example:
 ```
- Running 1 test suites...
+$ cabal test testsuite/compiler
 Test suite gf-tests: RUNNING...
 Test suite gf-tests: PASS
 1 of 1 test suites (1 of 1 test cases) passed.
 ```
-
+will run only the testsuite for the compiler.
 **Test Outcome - Failed:**  If there is a contents mismatch between the files
 with the ``.out`` extension and their corresponding files with the extension ``.gold``,
 the test diagnostics will show a fail and the areas that failed. e.g.
 ```
  testsuite/compiler/compute/Records.gfs: OK
  testsuite/compiler/compute/Variants.gfs: FAIL
  testsuite/compiler/params/params.gfs: OK
  Test suite gf-tests: FAIL
  0 of 1 test suites (0 of 1 test cases) passed.
 ```
 The fail results overview is available in gf-tests.html which shows 4 columns:
 + __Results__ - only areas that fail will appear. (Note: There are 3 failures in the gf-tests.html which are labelled as (expected). These failures should be ignored.)
 + __Input__ - which is the test written in the .gfs file
 + __Gold__ - the expected output from running the test set out in the .gfs file. This column refers to the contents from the .gold extension files.
 + __Output__ - This column refers to the contents from the .out extension files which are generated as test output.
 After fixing the areas which fail, rerun the test command. Repeat the entire process of fix-and-test until the test suite passes before  submitting a pull request to include your changes.
--- a/doc/gf-editor-modes.md
+++ b/doc/gf-editor-modes.md
@@ -1,75 +0,0 @@
 # Editor modes & IDE integration for GF
 We collect GF modes for various editors on this page. Contributions are welcome!
 ## Emacs
 [gf.el](https://github.com/GrammaticalFramework/gf-emacs-mode) by Johan
 Bockgård provides syntax highlighting and automatic indentation and
 lets you run the GF Shell in an emacs buffer.  See installation
 instructions inside.
 ## Atom
 [language-gf](https://atom.io/packages/language-gf), by John J. Camilleri
 ## Visual Studio Code
 * [Grammatical Framework Language Server](https://marketplace.visualstudio.com/items?itemName=anka-213.gf-vscode) by Andreas Källberg.
 This provides syntax highlighting and a client for the Grammatical Framework language server. Follow the installation instructions in the link.
 * [Grammatical Framework](https://marketplace.visualstudio.com/items?itemName=GrammaticalFramework.gf-vscode) is a simpler extension
 without any external dependencies which provides only syntax highlighting.
 ## Eclipse
 [GF Eclipse Plugin](https://github.com/GrammaticalFramework/gf-eclipse-plugin/), by John J. Camilleri
 ## Gedit
 By John J. Camilleri
 Copy the file below to
 `~/.local/share/gtksourceview-3.0/language-specs/gf.lang` (under Ubuntu).
 * [gf.lang](../src/tools/gf.lang)
 Some helpful notes/links:
 * The code is based heavily on the `haskell.lang` file which I found in
 `/usr/share/gtksourceview-2.0/language-specs/haskell.lang`.
 * Ruslan Osmanov recommends
 [registering your file extension as its own MIME type](http://osmanov-dev-notes.blogspot.com/2011/04/how-to-add-new-highlight-mode-in-gedit.html)
 (see also [here](https://help.ubuntu.com/community/AddingMimeTypes)),
 however on my system the `.gf` extension was already registered
 as a generic font (`application/x-tex-gf`) and I didn't want to risk
 messing any of that up.
 * This is a quick 5-minute job and might require some tweaking.
 [The GtkSourceView language definition tutorial](http://developer.gnome.org/gtksourceview/stable/lang-tutorial.html)
 is the place to start looking.
 * Contributions are welcome!
 ## Geany
 By John J. Camilleri
 [Custom filetype](http://www.geany.org/manual/dev/index.html#custom-filetypes)
 config files for syntax highlighting in [Geany](http://www.geany.org/).
 For version 1.36 and above, copy one of the files below to
 `/usr/share/geany/filedefs/filetypes.GF.conf` (under Ubuntu).
 If you're using a version older than 1.36, copy the file to `/usr/share/geany/filetypes.GF.conf`.
 You will need to manually create the file.
 * [light-filetypes.GF.conf](../src/tools/light-filetypes.GF.conf)
 * [dark-filetypes.GF.conf](../src/tools/dark-filetypes.GF.conf)
 You will also need to edit the `filetype_extensions.conf` file and add the
 following line somewhere:
 ```
 GF=*.gf
 ```
 ## Vim
 [vim-gf](https://github.com/gdetrez/vim-gf)
--- a/doc/gf-editor-modes.t2t
+++ b/doc/gf-editor-modes.t2t
@@ -0,0 +1,72 @@
 Editor modes & IDE integration for GF
 We collect GF modes for various editors on this page. Contributions are
 welcome!
 ==Emacs==
 [gf.el https://github.com/GrammaticalFramework/gf-emacs-mode] by Johan
 Bockgård provides syntax highlighting and automatic indentation and
 lets you run the GF Shell in an emacs buffer.  See installation
 instructions inside.
 ==Atom==
 [language-gf https://atom.io/packages/language-gf], by John J. Camilleri
 ==Eclipse==
 [GF Eclipse Plugin https://github.com/GrammaticalFramework/gf-eclipse-plugin/], by John J. Camilleri
 ==Gedit==
 By John J. Camilleri
 Copy the file below to
 ``~/.local/share/gtksourceview-3.0/language-specs/gf.lang`` (under Ubuntu).
 - [gf.lang ../src/tools/gf.lang]
 Some helpful notes/links:
 - The code is based heavily on the ``haskell.lang`` file which I found in
  ``/usr/share/gtksourceview-2.0/language-specs/haskell.lang``.
 - Ruslan Osmanov recommends
  [registering your file extension as its own MIME type http://osmanov-dev-notes.blogspot.com/2011/04/how-to-add-new-highlight-mode-in-gedit.html]
  (see also [here https://help.ubuntu.com/community/AddingMimeTypes]),
  however on my system the ``.gf`` extension was already registered
  as a generic font (``application/x-tex-gf``) and I didn't want to risk
  messing any of that up.
 - This is a quick 5-minute job and might require some tweaking.
  [The GtkSourceView language definition tutorial http://developer.gnome.org/gtksourceview/stable/lang-tutorial.html]
  is the place to start looking.
 - Contributions are welcome!
 ==Geany==
 By John J. Camilleri
 [Custom filetype http://www.geany.org/manual/dev/index.html#custom-filetypes]
 config files for syntax highlighting in [Geany http://www.geany.org/].
 Copy one of the files below to ``/usr/share/geany/filetypes.GF.conf``
 (under Ubuntu). You will need to manually create the file.
 - [light-filetypes.GF.conf ../src/tools/light-filetypes.GF.conf]
 - [dark-filetypes.GF.conf ../src/tools/dark-filetypes.GF.conf]
 You will also need to edit the ``filetype_extensions.conf`` file and add the
 following line somewhere:
 ```
 GF=*.gf
 ```
 ==Vim==
 [vim-gf https://github.com/gdetrez/vim-gf]
--- a/doc/gf-help-full.txt
+++ b/doc/gf-help-full.txt
@@ -303,7 +303,7 @@ but the resulting .gf file must be imported separately.
 #TINY
-Generates a list of random trees, by default one tree up to depth 5.
+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.
@@ -315,14 +315,13 @@ given in a file in the -probs flag.
 | ``-cat`` | generation category
 | ``-lang`` | uses only functions that have linearizations in all these languages
 | ``-number`` | number of trees generated
- | ``-depth`` | the maximum generation depth (default: 5)
+ | ``-depth`` | the maximum generation depth
 | ``-probs`` | file with biased probabilities (format 'f 0.4' one by line)
 - Examples:
 | ``gr`` | one tree in the startcat of the current grammar
 | ``gr -cat=NP -number=16`` | 16 trees in the category NP
 | ``gr -cat=NP -depth=2`` | one tree in the category NP, up to depth 2
 | ``gr -lang=LangHin,LangTha -cat=Cl`` | Cl, both in LangHin and LangTha
 | ``gr -probs=FILE`` | generate with bias
 | ``gr (AdjCN ? (UseN ?))`` | generate trees of form (AdjCN ? (UseN ?))
@@ -340,7 +339,7 @@ given in a file in the -probs flag.
 #TINY
 Generates all trees of a given category. By default, 
-the depth is limited to 5, but this can be changed by a flag.
+the depth is limited to 4, but this can be changed by a flag.
 If a Tree argument is given, the command completes the Tree with values
 to all metavariables in the tree.
@@ -354,7 +353,7 @@ to all metavariables in the tree.
 - Examples:
- | ``gt`` | all trees in the startcat, to depth 5
+ | ``gt`` | all trees in the startcat, to depth 4
 | ``gt -cat=NP -number=16`` | 16 trees in the category NP
 | ``gt -cat=NP -depth=2`` | trees in the category NP to depth 2
 | ``gt (AdjCN ? (UseN ?))`` | trees of form (AdjCN ? (UseN ?))
--- a/doc/gf-people.md
+++ b/doc/gf-people.md
@@ -7,6 +7,7 @@ title: "Grammatical Framework: Authors and Acknowledgements"
 The current maintainers of GF are
 [Krasimir Angelov](http://www.chalmers.se/cse/EN/organization/divisions/computing-science/people/angelov-krasimir),
 [Thomas Hallgren](http://www.cse.chalmers.se/~hallgren/),
 [Aarne Ranta](http://www.cse.chalmers.se/~aarne/),
 [John J. Camilleri](http://johnjcamilleri.com), and
 [Inari Listenmaa](https://inariksit.github.io/).
@@ -21,7 +22,6 @@ and
 The following people have contributed code to some of the versions:
 - [Thomas Hallgren](http://www.cse.chalmers.se/~hallgren/) (University of Gothenburg)
 - Grégoire Détrez (University of Gothenburg)
 - Ramona Enache (University of Gothenburg)
 - [Björn Bringert](http://www.cse.chalmers.se/alumni/bringert) (University of Gothenburg)
@@ -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
@@ -1188,7 +1188,7 @@ use ``generate_trees = gt``.
  this wine is fresh
  this wine is warm
 ```
-The default **depth** is 5; the depth can be
+The default **depth** is 3; the depth can be
 set by using the ``depth`` flag:
 ```
  > generate_trees -depth=2 | l
@@ -1265,16 +1265,10 @@ Human eye may prefer to see a visualization: ``visualize_tree = vt``:
  > parse "this delicious cheese is very Italian" | visualize_tree
 ```
 The tree is generated in postscript (``.ps``) file. The ``-view`` option is used for
-telling what command to use to view the file.
+telling what command to use to view the file. Its default is ``"open"``, which works
-
+on Mac OS X. On Ubuntu Linux, one can write
 This works on Mac OS X:
 ```
-  > parse "this delicious cheese is very Italian" | visualize_tree -view=open
+  > parse "this delicious cheese is very Italian" | visualize_tree -view="eog"
 ```
 On Linux, one can use one of the following commands.
 ```
  > parse "this delicious cheese is very Italian" | visualize_tree -view=eog
  > parse "this delicious cheese is very Italian" | visualize_tree -view=xdg-open
 ```
@@ -1739,13 +1733,6 @@ A new module can **extend** an old one:
      Pizza : Kind ;
  }
 ```
 Note that the extended grammar doesn't inherit the start
 category from the grammar it extends, so if you want to
 generate sentences with this grammar, you'll have to either
 add a startcat (e.g. ``flags startcat = Question ;``),
 or in the GF shell, specify the category to ``generate_random`` or ``geneate_trees``
 (e.g. ``gr -cat=Comment`` or ``gt -cat=Question``).
 Parallel to the abstract syntax, extensions can
 be built for concrete syntaxes:
 ```
@@ -2488,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
@@ -2501,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
 ```
@@ -2659,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 =
+  lin AppTV subj tv obj =
-    {s = subj.s ++ v2.s ! subj.n ++ obj.s ++ v2.part} ;
+    {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.
@@ -2730,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.
@@ -2765,11 +2757,7 @@ Thus the labels ``p1, p2,...`` are hard-coded.
 English indefinite article:
 ```
  oper artIndef : Str =
-     pre {
+    pre {"a" ; "an" / strs {"a" ; "e" ; "i" ; "o"}} ;
       ("a" | "e" | "i" | "o") => "an" ;
       _ => "a"
     } ;
 ```
 Thus
 ```
@@ -2960,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//.
@@ -2981,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
@@ -3730,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):
+  CAction ? dim (DKindOne fan)
    Couldn't match expected type Device light
       against the interred type Device fan
    In the expression: 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
@@ -3774,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==
@@ -3896,6 +3912,7 @@ fun
 Classes for new actions can be added incrementally.
 #NEW
 ==Variable bindings==
@@ -4183,7 +4200,6 @@ We construct a calculator with addition, subtraction, multiplication, and
 division of integers.
 ```
  abstract Calculator = {
  flags startcat = Exp ;
  cat Exp ;
@@ -4210,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 ;
@@ -4591,7 +4607,7 @@ in any multilingual grammar between any languages in the grammar.
 module Main where
 import PGF
-import System.Environment (getArgs)
+import System (getArgs)
 main :: IO ()
 main = do
@@ -4721,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,194 +0,0 @@
 ---
 title: Grammatical Framework Download and Installation
 date: 25 July 2021
 ---
 **GF 3.11** was released on 25 July 2021.
 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/3.11)
 #### Debian/Ubuntu
 There are two versions: `gf-3.11-ubuntu-18.04.deb` for Ubuntu 18.04 (Cosmic), and `gf-3.11-ubuntu-20.04.deb` for Ubuntu 20.04 (Focal).
 To install the package use:
 ```
 sudo apt-get install ./gf-3.11-ubuntu-*.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 Catalina and Big Sur.
 #### 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 from Hackage
 _Instructions applicable for 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:
 ```
 cabal update
 cabal install gf-3.11
 ```
 ### Notes
 **GHC version**
 The GF source code is known to be compilable with GHC versions 7.10 through to 8.10.
 **Obtaining Haskell**
 There are various ways of obtaining Haskell, including:
 - ghcup
    1.  Install from https://www.haskell.org/ghcup/
    2.  `ghcup install ghc 8.10.4`
    3.  `ghcup set ghc 8.10.4`
 - Haskell Platform https://www.haskell.org/platform/
 - Stack https://haskellstack.org/
 **Installation location**
 The above steps install 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`
 ## Installing from source code
 **Obtaining**
 To obtain the source code for the **release**,
 download it from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases).
 Alternatively, to obtain the **latest version** of the source code:
 1. If you haven't already, clone the repository with:
 ```
 git clone https://github.com/GrammaticalFramework/gf-core.git
 ```
 2. If you've already cloned the repository previously, update with:
 ```
 git pull
 ```
 **Installing**
 You can 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).
 For macOS Sequoia, you need to downgrade the LLVM package, see instructions [here](https://github.com/GrammaticalFramework/gf-core/issues/172#issuecomment-2599365457).
 ## 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-3.12.md
+++ b/download/index-3.12.md
@@ -1,191 +0,0 @@
 ---
 title: Grammatical Framework Download and Installation
 date: 8 August 2025
 ---
 **GF 3.12** was released on 8 August 2025.
 What's new? See the [release notes](release-3.12.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-the-rgl-from-a-binary-release).
 ---
 ## 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
 - Python bindings to the C run-time system
 [Binary packages on GitHub](https://github.com/GrammaticalFramework/gf-core/releases/tag/3.12)
 #### Debian/Ubuntu
 The package targets Ubuntu 24.04 (Noble).
 To install it, use:
 ```
 sudo apt install ./gf-3.12-ubuntu-24.04.deb 
 ```
 #### macOS
 If you are on an Intel Mac (2019 or older), use `gf-3.12-macos-intel.pkg`.<br>
 For newer ARM-based Macs (Apple Silicon M1, M2, M3), use `gf-3.12-macos-arm.pkg`.
 After downloading, right click on the file and click on Open.[^1]
 You will see a dialog saying that "macOS cannot verify the developer of "gf-3.12-macos-intel.pkg". Are you sure you want to open it?". 
 Press Open.
 [^1]: If you just double click on the file, you will get an error message "gf-3.12-macos-intel.pkg" cannot be opened because it is from an unidentified developer.
 #### Windows
 To install the package:
 1. unpack it anywhere and take note of the full path to the folder containing the `.exe` file. 
 2. add it to the `PATH` environment variable
 For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).
 ## Installing from Hackage
 _Instructions applicable for 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:
 ```
 cabal update
 cabal install gf-3.12
 ```
 ### Notes
 #### GHC version
 The GF source code is known to be compilable with GHC versions 7.10 through to 9.6.7.
 #### Obtaining Haskell
 There are various ways of obtaining Haskell, including:
 - ghcup
    1. Install from https://www.haskell.org/ghcup/
    2. `ghcup install ghc 9.6.7`
    3. `ghcup set ghc 9.6.7`
 - Stack: https://haskellstack.org/
 #### Installation location
 The above steps install 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`
 ## Installing from source code
 ### Obtaining
 To obtain the source code for the **release**,
 download it from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases).
 Alternatively, to obtain the **latest version** of the source code:
 1. If you haven't already, clone the repository with:
 ```
 git clone https://github.com/GrammaticalFramework/gf-core.git
 ```
 2. If you've already cloned the repository previously, update with:
 ```
 git pull
 ```
 ### Installing
 You can 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
 ```
 If this doesn't work, you will need to install the C runtime manually; see the instructions [here](https://www.grammaticalframework.org/doc/gf-developers.html#toc12).
 ---
 ## 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.
 For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).
 ## 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.11](index-3.11.html) (July 2021)
 - [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.11.html" />
 </head>
 <body>
  You are being redirected to <a href="index-3.12.html">the current version</a> of this page.
 </body>
 </html>
--- a/download/index-3.10.md
+++ b/download/index-3.10.md
@@ -13,13 +13,13 @@ These binary packages include both the GF core (compiler and runtime) as well as
 | Platform        | Download                                           | Features       | How to install                     |
 |:----------------|:---------------------------------------------------|:---------------|:-----------------------------------|
 | macOS           | [gf-3.10.pkg](gf-3.10.pkg)                         | GF, S, C, J, P | Double-click on the package icon   |
 | Raspbian 10 (buster) | [gf\_3.10-2\_armhf.deb](gf_3.10-2_armhf.deb)  | GF,S,C,J,P | `sudo dpkg -i gf_3.10-2_armhf.deb`     |
 | Ubuntu (32-bit) | [gf\_3.10-2\_i386.deb](gf_3.10-2_i386.deb)         | GF, S, C, J, P | `sudo dpkg -i gf_3.10-2_i386.deb`  |
 | Ubuntu (64-bit) | [gf\_3.10-2\_amd64.deb](gf_3.10-2_amd64.deb)       | GF, S, C, J, P | `sudo dpkg -i gf_3.10-2_amd64.deb` |
 | Windows         | [gf-3.10-bin-windows.zip](gf-3.10-bin-windows.zip) | GF, S          | `unzip gf-3.10-bin-windows.zip`    |
 <!--
 | macOS           | [gf-3.10-bin-intel-mac.tar.gz](gf-3.10-bin-intel-mac.tar.gz) | GF,S,C,J,P | `sudo tar -C /usr/local -zxf gf-3.10-bin-intel-mac.tar.gz` |
 | Raspbian 9.1     | [gf\_3.10-1\_armhf.deb](gf_3.10-1_armhf.deb)                 | GF,S,C,J,P | `sudo dpkg -i gf_3.10-1_armhf.deb`                         |
 -->
 **Features**
@@ -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,43 +0,0 @@
 ---
 title: GF 3.11 Release Notes
 date: 25 July 2021
 ---
 ## 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 500 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.
 - Support for newer version of Ubuntu 20.04 in the precompiled binaries.
 - Updates to build scripts and CI workflows.
 - Bug fixes and code cleanup.
 ## GF compiler and run-time library
 - 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 in time & space requirements when compiling certain grammars.
 - Improvements to Haskell export.
 - Improvements to the GF shell.
 - Improvements to canonical GF compilation.
 - 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/download/release-3.12.md
+++ b/download/release-3.12.md
@@ -1,37 +0,0 @@
 ---
 title: GF 3.12 Release Notes
 date: 08 August 2025
 ---
 ## Installation
 See the [download page](index-3.12.html).
 ## What's new
 This release adds support for Apple Silicon M1 Mac computers and newer versions of GHC, along with various improvements and bug fixes.
 Over 70 commits have been merged to gf-core since the release of GF 3.11 in July 2021.
 ## General
 - Support for ARM, allowing to run GF on Mac computers with Apple Silicon M1
 - Support for newer versions of GHC (8.10.7, 9.0.2, 9.2.4, 9.4, 9.6.7)
 - Support compiling with Nix
 - Better error messages
 - Improvements to several GF shell commands
 - Several bug fixes and performance improvements
 - Temporarily dropped support for Java bindings
 ## GF compiler and run-time library
 - Syntactic sugar for table update: `table {cases ; vvv => t \! vvv}.t` can now be written as `t ** { cases }`  
 - Adjust the `-view` command depending on the OS
 - Improve output of the `visualize_dependencies` (`vd`) command for large dependency trees
 - Reintroduce syntactic transfer with `pt -transfer` and fix a bug in `pt -compute`
 - Bug fix: apply `gt` to all arguments when piped
 - Fix many "Invalid character" messages by always encoding GF files in UTF-8
 - Improve performance with long extend-lists
 - Improve syntax error messages
 - Add support for BIND tokens in the Python bindings
 - Allow compilation with emscripten
 ## Other
 - Add support for Visual Studio Code
--- a/flake.lock
+++ b/flake.lock
@@ -1,43 +0,0 @@
 {
  "nodes": {
    "nixpkgs": {
      "locked": {
        "lastModified": 1704290814,
        "narHash": "sha256-LWvKHp7kGxk/GEtlrGYV68qIvPHkU9iToomNFGagixU=",
        "owner": "NixOS",
        "repo": "nixpkgs",
        "rev": "70bdadeb94ffc8806c0570eb5c2695ad29f0e421",
        "type": "github"
      },
      "original": {
        "owner": "NixOS",
        "ref": "nixos-23.05",
        "repo": "nixpkgs",
        "type": "github"
      }
    },
    "root": {
      "inputs": {
        "nixpkgs": "nixpkgs",
        "systems": "systems"
      }
    },
    "systems": {
      "locked": {
        "lastModified": 1681028828,
        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
        "owner": "nix-systems",
        "repo": "default",
        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
        "type": "github"
      },
      "original": {
        "owner": "nix-systems",
        "repo": "default",
        "type": "github"
      }
    }
  },
  "root": "root",
  "version": 7
 }
--- a/flake.nix
+++ b/flake.nix
@@ -1,50 +0,0 @@
 {
  inputs = {
    nixpkgs.url = "github:NixOS/nixpkgs/nixos-23.05";
    systems.url = "github:nix-systems/default";
  };
  nixConfig = {
    # extra-trusted-public-keys =
    #   "devenv.cachix.org-1:w1cLUi8dv3hnoSPGAuibQv+f9TZLr6cv/Hm9XgU50cw=";
    # extra-substituters = "https://devenv.cachix.org";
  };
  outputs = { self, nixpkgs, systems, ... }@inputs:
    let forEachSystem = nixpkgs.lib.genAttrs (import systems);
    in {
      packages = forEachSystem (system:
        let
          pkgs = nixpkgs.legacyPackages.${system};
          haskellPackages = pkgs.haskell.packages.ghc925.override {
            overrides = self: _super: {
              cgi = pkgs.haskell.lib.unmarkBroken (pkgs.haskell.lib.dontCheck
                (self.callHackage "cgi" "3001.5.0.1" { }));
            };
          };
        in {
          gf = pkgs.haskell.lib.overrideCabal
            (haskellPackages.callCabal2nixWithOptions "gf" self "--flag=-server"
              { }) (_old: {
                # Fix utf8 encoding problems
                patches = [
                  # Already applied in master
                  # (
                  #   pkgs.fetchpatch {
                  #     url = "https://github.com/anka-213/gf-core/commit/6f1ca05fddbcbc860898ddf10a557b513dfafc18.patch";
                  #     sha256 = "17vn3hncxm1dwbgpfmrl6gk6wljz3r28j191lpv5zx741pmzgbnm";
                  #   }
                  # )
                  ./nix/expose-all.patch
                  ./nix/revert-new-cabal-madness.patch
                ];
                jailbreak = true;
                # executableSystemDepends = [
                #   (pkgs.ncurses.override { enableStatic = true; })
                # ];
                # executableHaskellDepends = [ ];
              });
        });
    };
 }
--- a/gf-book/examples/chapter2/FoodIta.gf
+++ b/gf-book/examples/chapter2/FoodIta.gf
@@ -2,7 +2,7 @@ concrete FoodIta of Food = {
  lincat
    Comment, Item, Kind, Quality = Str ;
  lin
-    Pred item quality = item ++ "è" ++ quality ;
+    Pred item quality = item ++ "è" ++ quality ;
    This kind = "questo" ++ kind ;
    That kind = "quel" ++ kind ;
    Mod quality kind = kind ++ quality ;
--- a/gf-book/examples/chapter3/ResIta.gf
+++ b/gf-book/examples/chapter3/ResIta.gf
@@ -32,5 +32,5 @@ resource ResIta = open Prelude in {
      in 
      adjective nero (ner+"a") (ner+"i") (ner+"e") ;
    copula : Number => Str = 
-      table {Sg => "è" ; Pl => "sono"} ;
+      table {Sg => "è" ; Pl => "sono"} ;
 }
--- a/gf-book/examples/chapter5/LexFoodsFin.gf
+++ b/gf-book/examples/chapter5/LexFoodsFin.gf
@@ -9,12 +9,12 @@ instance LexFoodsFin of LexFoods =
    fish_N = mkN "kala" ;
    fresh_A = mkA "tuore" ;
    warm_A = mkA 
-    (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään"
+    (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään" 
-         "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
+         "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
 	 ) 
-    "lämpimämpi" "lämpimin" ;
+    "lämpimämpi" "lämpimin" ;
    italian_A = mkA "italialainen" ;
    expensive_A = mkA "kallis" ;
    delicious_A = mkA "herkullinen" ;
-    boring_A = mkA "tylsä" ;
+    boring_A = mkA "tylsä" ;
 }
--- a/gf-book/examples/chapter5/LexFoodsGer.gf
+++ b/gf-book/examples/chapter5/LexFoodsGer.gf
@@ -5,12 +5,12 @@ instance LexFoodsGer of LexFoods =
  oper
    wine_N = mkN "Wein" ;
    pizza_N = mkN "Pizza" "Pizzen" feminine ;
-    cheese_N = mkN "Käse" "Käse" masculine ;
+    cheese_N = mkN "Käse" "Käse" masculine ;
    fish_N = mkN "Fisch" ;
    fresh_A = mkA "frisch" ;
-    warm_A = mkA "warm" "wärmer" "wärmste" ;
+    warm_A = mkA "warm" "wärmer" "wärmste" ;
    italian_A = mkA "italienisch" ;
    expensive_A = mkA "teuer" ;
-    delicious_A = mkA "köstlich" ;
+    delicious_A = mkA "köstlich" ;
    boring_A = mkA "langweilig" ;
 }
--- a/gf-book/examples/chapter5/LexFoodsSwe.gf
+++ b/gf-book/examples/chapter5/LexFoodsSwe.gf
@@ -7,10 +7,10 @@ instance LexFoodsSwe of LexFoods =
    pizza_N = mkN "pizza" ;
    cheese_N = mkN "ost" ;
    fish_N = mkN "fisk" ;
-    fresh_A = mkA "färsk" ;
+    fresh_A = mkA "färsk" ;
    warm_A = mkA "varm" ;
    italian_A = mkA "italiensk" ;
    expensive_A = mkA "dyr" ;
-    delicious_A = mkA "läcker" ;
+    delicious_A = mkA "läcker" ;
-    boring_A = mkA "tråkig" ;
+    boring_A = mkA "tråkig" ;
 }
--- a/gf-book/examples/chapter7/QueryFin.gf
+++ b/gf-book/examples/chapter7/QueryFin.gf
@@ -6,7 +6,7 @@ concrete QueryFin of Query = {
    Odd   = pred "pariton" ;
    Prime = pred "alkuluku" ;
    Number i = i.s ;
-    Yes = "kyllä" ;
+    Yes = "kyllä" ;
    No = "ei" ;
  oper
    pred : Str -> Str -> Str = \f,x -> "onko" ++ x ++ f ;
--- a/gf-book/examples/chapter9/ResIta.gf
+++ b/gf-book/examples/chapter9/ResIta.gf
@@ -46,7 +46,7 @@ oper
    Avere => 
      mkVerb "avere" "ho" "hai" "ha" "abbiamo" "avete" "hanno" "avuto" Avere ;
    Essere => 
-      mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere
+      mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere
    } ;
  agrPart : Verb -> Agr -> ClitAgr -> Str = \v,a,c -> case v.aux of {
--- a/gf.cabal
+++ b/gf.cabal
@@ -1,24 +1,19 @@
 name: gf
-version: 3.12.0
+version: 3.10.3-git
-cabal-version: 1.22
+cabal-version: >= 1.22
-build-type: Simple
+build-type: Custom
 license: OtherLicense
 license-file: LICENSE
 category: Natural Language Processing, Compiler
 synopsis: Grammatical Framework
 description: GF, Grammatical Framework, is a programming language for multilingual grammar applications
-maintainer: John J. Camilleri <john@digitalgrammars.com>
+homepage: http://www.grammaticalframework.org/
 homepage: https://www.grammaticalframework.org/
 bug-reports: https://github.com/GrammaticalFramework/gf-core/issues
-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4, GHC==9.0.2, GHC==9.2.4, GHC==9.6.7
+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:
  README.md
  CHANGELOG.md
  WebSetup.hs
  doc/Logos/gf0.png
 data-files:
  www/*.html
  www/*.css
@@ -44,17 +39,25 @@ data-files:
  www/translator/*.css
  www/translator/*.js
 custom-setup
  setup-depends:
    base,
    Cabal >=1.22.0.0,
    directory,
    filepath,
    process >=1.0.1.1
 source-repository head
-  type: git
+  type:     git
  location: https://github.com/GrammaticalFramework/gf-core.git
 flag interrupt
  Description: Enable Ctrl+Break in the shell
-  Default: True
+  Default:     True
 flag server
  Description: Include --server mode
-  Default: True
+  Default:     True
 flag network-uri
   description: Get Network.URI from the network-uri package
@@ -66,29 +69,20 @@ flag network-uri
 flag c-runtime
  Description: Include functionality from the C run-time library (which must be installed already)
-  Default: False
+  Default:     False
 library
  default-language: Haskell2010
  build-depends:
    -- GHC 8.0.2 to GHC 8.10.4
    array >= 0.5.1 && < 0.6,
    base >= 4.9.1 && < 4.22,
    bytestring >= 0.10.8 && < 0.12,
    containers >= 0.5.7 && < 0.7,
    exceptions >= 0.8.3 && < 0.11,
    ghc-prim >= 0.5.0 && <= 0.10.0,
    mtl >= 2.2.1 && <= 2.3.1,
    pretty >= 1.1.3 && < 1.2,
    random >= 1.1 && < 1.3,
    utf8-string >= 1.0.1.1 && < 1.1
  if impl(ghc<8.0)
    build-depends:
      -- We need this in order for ghc-7.10 to build
      transformers-compat >= 0.6.3 && < 0.7,
      fail >= 4.9.0 && < 4.10
 Library
  default-language:    Haskell2010
  build-depends: base >= 4.6 && <5,
                 array,
                 containers,
                 bytestring,
                 utf8-string,
                 random,
                 pretty,
                 mtl,
                 exceptions,
                 ghc-prim
  hs-source-dirs: src/runtime/haskell
  other-modules:
@@ -103,7 +97,9 @@ library
 --ghc-options: -fwarn-unused-imports
 --if impl(ghc>=7.8)
 --  ghc-options: +RTS -A20M -RTS
-  -- ghc-prof-options: -fprof-auto
+  ghc-prof-options: -fprof-auto
  if impl(ghc>=8.6)
    Default-extensions: NoMonadFailDesugaring
  exposed-modules:
    PGF
@@ -137,29 +133,18 @@ library
  if flag(c-runtime)
    exposed-modules: PGF2
-    other-modules:
+    other-modules:   PGF2.FFI PGF2.Expr PGF2.Type
-      PGF2.FFI
+                     GF.Interactive2 GF.Command.Commands2
-      PGF2.Expr
+    hs-source-dirs:  src/runtime/haskell-bind
-      PGF2.Type
+    build-tools:     hsc2hs
      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
+    c-sources:       src/runtime/haskell-bind/utils.c
-    cc-options: -std=c99
+    cc-options:      -std=c99
 ---- GF compiler as a library:
-  build-depends:
+  build-depends: filepath, directory>=1.2, time,
-    directory >= 1.3.0 && < 1.4,
+                 process, haskeline, parallel>=3, json
    filepath >= 1.4.1 && < 1.5,
    haskeline >= 0.7.3 && < 0.9,
    json >= 0.9.1 && <= 0.11,
    parallel >= 3.2.1.1 && < 3.3,
    process >= 1.4.3 && < 1.7,
    time >= 1.6.0 && <= 1.12.2,
    template-haskell >= 2.13.0.0 && < 2.21
  hs-source-dirs: src/compiler
  exposed-modules:
@@ -170,19 +155,12 @@ library
    GF.Grammar.Canonical
  other-modules:
-    GF.Main
+    GF.Main GF.Compiler GF.Interactive
    GF.Compiler
    GF.Interactive
-    GF.Compile
+    GF.Compile GF.CompileInParallel GF.CompileOne  GF.Compile.GetGrammar
    GF.CompileInParallel
    GF.CompileOne
    GF.Compile.GetGrammar
    GF.Grammar
-    GF.Data.Operations
+    GF.Data.Operations GF.Infra.Option GF.Infra.UseIO
    GF.Infra.Option
    GF.Infra.UseIO
    GF.Command.Abstract
    GF.Command.CommandInfo
@@ -197,7 +175,9 @@ library
    GF.Command.TreeOperations
    GF.Compile.CFGtoPGF
    GF.Compile.CheckGrammar
-    GF.Compile.Compute.Concrete
+    GF.Compile.Compute.AppPredefined
    GF.Compile.Compute.ConcreteNew
 --  GF.Compile.Compute.ConcreteNew1
    GF.Compile.Compute.Predef
    GF.Compile.Compute.Value
    GF.Compile.ExampleBased
@@ -226,6 +206,7 @@ library
    GF.Compile.TypeCheck.Concrete
    GF.Compile.TypeCheck.ConcreteNew
    GF.Compile.TypeCheck.Primitives
    GF.Compile.TypeCheck.RConcrete
    GF.Compile.TypeCheck.TC
    GF.Compile.Update
    GF.Data.BacktrackM
@@ -292,17 +273,12 @@ library
    cpp-options: -DC_RUNTIME
  if flag(server)
-    build-depends:
+    build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7,
-      cgi >= 3001.3.0.2 && < 3001.6,
+                   cgi>=3001.2.2.0
      httpd-shed >= 0.4.0 && < 0.5,
      network>=2.3 && <3.2
    if flag(network-uri)
-      build-depends:
+      build-depends: network-uri>=2.6, network>=2.6
        network-uri >= 2.6.1.0 && < 2.7,
        network>=2.6 && <3.2
    else
-      build-depends:
+      build-depends: network<2.6
        network >= 2.5 && <3.2
    cpp-options: -DSERVER_MODE
    other-modules:
@@ -319,10 +295,7 @@ library
      Fold
      ExampleDemo
      ExampleService
-    hs-source-dirs:
+    hs-source-dirs: src/server src/server/transfer src/example-based
      src/server
      src/server/transfer
      src/example-based
  if flag(interrupt)
    cpp-options: -DUSE_INTERRUPT
@@ -331,41 +304,26 @@ library
    other-modules: GF.System.NoSignal
  if impl(ghc>=7.8)
-    build-tools:
+    build-tools: happy>=1.19, alex>=3.1
      happy>=1.19,
      alex>=3.1
 --  ghc-options: +RTS -A20M -RTS
  else
-    build-tools:
+    build-tools: happy, alex>=3
      happy,
      alex>=3
  ghc-options: -fno-warn-tabs
  if os(windows)
-    build-depends:
+    build-depends: Win32
      Win32 >= 2.3.1.1 && < 2.7
  else
-    build-depends:
+    build-depends: unix, terminfo>=0.4
      terminfo >=0.4.0 && < 0.5
    if impl(ghc >= 9.6.6)
      build-depends: unix >= 2.8 && < 2.9
    else
      build-depends: unix >= 2.7.2 && < 2.8
  if impl(ghc>=8.2)
    ghc-options: -fhide-source-paths
-executable gf
+Executable gf
  hs-source-dirs: src/programs
  main-is: gf-main.hs
-  default-language: Haskell2010
+  default-language:    Haskell2010
-  build-depends:
+  build-depends: gf, base
    gf,
    base >= 4.9.1 && < 4.22
  ghc-options: -threaded
 --ghc-options: -fwarn-unused-imports
@@ -374,35 +332,24 @@ executable gf
    if impl(ghc<7.8)
      ghc-options: -with-rtsopts=-K64M
-  -- ghc-prof-options: -auto-all
+  ghc-prof-options: -auto-all
  if impl(ghc>=8.2)
    ghc-options: -fhide-source-paths
-- executable pgf-shell
+executable pgf-shell
-- --if !flag(c-runtime)
+--if !flag(c-runtime)
--   buildable: False
+  buildable: False
--   main-is: pgf-shell.hs
+  main-is:             pgf-shell.hs
--   hs-source-dirs: src/runtime/haskell-bind/examples
+  hs-source-dirs:      src/runtime/haskell-bind/examples
--   build-depends:
+  build-depends:       gf, base, containers, mtl, lifted-base
--     gf,
+  default-language:    Haskell2010
--     base,
+  if impl(ghc>=7.0)
--     containers,
+    ghc-options: -rtsopts
 --     mtl,
 --     lifted-base
 --   default-language: Haskell2010
 --   if impl(ghc>=7.0)
 --     ghc-options: -rtsopts
 test-suite gf-tests
-  type: exitcode-stdio-1.0
+  type:           exitcode-stdio-1.0
-  main-is: run.hs
+  main-is:        run.hs
  hs-source-dirs: testsuite
-  build-depends:
+  build-depends:  base>=4.3 && <5, Cabal>=1.8, directory, filepath, process
-    base >= 4.9.1 && < 4.22,
+  default-language:    Haskell2010
    Cabal >= 1.8,
    directory >= 1.3.0 && < 1.4,
    filepath >= 1.4.1 && < 1.5,
    process >= 1.4.3 && < 1.7
  build-tool-depends: gf:gf
  default-language: Haskell2010
--- a/index.html
+++ b/index.html
@@ -8,7 +8,7 @@
  <meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
  <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">
-  <link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.15.4/css/all.css" crossorigin="anonymous">
+  <link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">
  <link rel="alternate" href="https://github.com/GrammaticalFramework/gf-core/" title="GF GitHub repository">
 </head>
@@ -22,16 +22,16 @@
  <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>
      <li>
-        <a href="//cloud.grammaticalframework.org/">
+        <a href="http://cloud.grammaticalframework.org/">
          GF Cloud
-          <img src="src/www/P/gf-cloud.png" style="height:30px" class="ml-2" alt="Cloud logo">
+          <img src="http://www.grammaticalframework.org/src/www/P/gf-cloud.png" style="height:30px" class="ml-2" alt="Cloud logo">
        </a>
      </li>
      <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,8 +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>
      <li><a href="https://inariksit.github.io/blog/">GF blog</a></li>
    </ul>
    <a href="lib/doc/synopsis/index.html" class="btn btn-primary ml-3">
@@ -66,42 +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>
+      <li><a href="http://hackage.haskell.org/package/gf/docs/PGF.html">PGF library API (Haskell runtime)</a></li>
-        <a href="http://hackage.haskell.org/package/gf/docs/PGF.html">Haskell</a> /
+      <li><a href="doc/runtime-api.html">PGF library API (C runtime)</a></li>
        <a href="doc/runtime-api.html">C&nbsp;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>
+      <li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>
        <a href="https://discord.gg/EvfUsjzmaz">
          <i class="fab fa-discord"></i>
          Discord
        </a>
      </li>
      <li>
        <a href="https://stackoverflow.com/questions/tagged/gf">
          <i class="fab fa-stack-overflow"></i>
          Stack Overflow
        </a>
      </li>
      <li><a href="https://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="//school.grammaticalframework.org/">Summer School</a></li>
      <li><a href="doc/gf-people.html">Authors</a></li>
      <li><a href="http://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>
@@ -167,12 +149,12 @@ least one, it may help you to get a first idea of what GF is.
 <div class="row">
  <div class="col-md-6">
-    <h2>Applications & availability</h2>
+    <h2>Applications & Availability</h2>
    <p>
    GF can be used for building
-    <a href="//cloud.grammaticalframework.org/translator/">translation systems</a>,
+    <a href="http://cloud.grammaticalframework.org/translator/">translation systems</a>,
-    <a href="//cloud.grammaticalframework.org/minibar/minibar.html">multilingual web gadgets</a>,
+    <a href="http://cloud.grammaticalframework.org/minibar/minibar.html">multilingual web gadgets</a>,
-    <a href="http://www.cse.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">natural-language interfaces</a>,
+    <a href="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">natural-language interfaces</a>,
    <a href="http://www.youtube.com/watch?v=1bfaYHWS6zU">dialogue systems</a>, and
    <a href="lib/doc/synopsis/index.html">natural language resources</a>.
    </p>
@@ -187,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>
@@ -227,49 +208,47 @@ least one, it may help you to get a first idea of what GF is.
    </p>
    <p>
-    We run the <a href="https://discord.gg/EvfUsjzmaz">GF server on Discord</a>, where you are welcome to look for help with small questions or just start a general discussion.
+    We run the IRC channel <strong><code>#gf</code></strong> on the Freenode network, where you are welcome to look for help with small questions or just start a general discussion.
    You can <a href="https://webchat.freenode.net/?channels=gf">open a web chat</a>
    or <a href="http://www.grammaticalframework.org/irc/">browse the channel logs</a>.
    </p>
    <p>
-    For bug reports and feature requests, please create an issue in the
+    If you have a larger question which the community may benefit from, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.
    <a href="https://github.com/GrammaticalFramework/gf-core/issues">GF Core</a> or
    <a href="https://github.com/GrammaticalFramework/gf-rgl/issues">RGL</a> repository.
    For programming questions, consider asking them on <a href="https://stackoverflow.com/questions/tagged/gf">Stack Overflow with the <code>gf</code> tag</a>.
    If you have a more general question to the community, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.
    </p>
  </div>
  <div class="col-md-6">
    <h2>News</h2>
    <dl class="row">
-      <dt class="col-sm-3 text-center text-nowrap">2025-08-08</dt>
+      <dt class="col-sm-3 text-center text-nowrap">2018-12-03</dt>
      <dd class="col-sm-9">
-        <strong>GF 3.12 released.</strong>
+        <a href="http://school.grammaticalframework.org/2018/">Sixth GF Summer School</a> in Stellenbosch (South Africa), 3–14 December 2018
        <a href="download/release-3.12.html">Release notes</a>
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2025-01-18</dt>
+      <dt class="col-sm-3 text-center text-nowrap">2018-12-02</dt>
      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2025/">9th GF Summer School</a>, in Gothenburg, Sweden, 18 &ndash; 29 August 2025.
+        <strong>GF 3.10 released.</strong>
        <a href="download/release-3.10.html">Release notes</a>
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2023-01-24</dt>
+      <dt class="col-sm-3 text-center text-nowrap">2018-07-25</dt>
      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2023/">8th GF Summer School</a>, in Tampere, Finland, 14 &ndash; 25 August 2023.
+        The GF repository has been split in two:
        <a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and
        <a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.
        The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2021-07-25</dt>
+      <dt class="col-sm-3 text-center text-nowrap">2017-08-11</dt>
      <dd class="col-sm-9">
-        <strong>GF 3.11 released.</strong>
+        <strong>GF 3.9 released.</strong>
-        <a href="download/release-3.11.html">Release notes</a>
+        <a href="download/release-3.9.html">Release notes</a>
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2021-05-05</dt>
+      <dt class="col-sm-3 text-center text-nowrap">2017-06-29</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.
+        GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>.</dd>
-      </dd>
+      <dt class="col-sm-3 text-center text-nowrap">2017-03-13</dt>
      <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.
+        <a href="http://school.grammaticalframework.org/2017/">GF Summer School</a> in Riga (Latvia), 14-25 August 2017
      </dd>
    </dl>
@@ -289,7 +268,7 @@ least one, it may help you to get a first idea of what GF is.
    </p>
    <ul>
    <li>
-      <a href="http://www.cse.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">GF-Alfa</a>:
+      <a href="http://www.cs.chalmers.se/~hallgren/Alfa/Tutorial/GFplugin.html">GF-Alfa</a>:
      natural language interface to formal proofs
    </li>
    <li>
@@ -314,11 +293,11 @@ least one, it may help you to get a first idea of what GF is.
      <a href="http://www.cse.chalmers.se/alumni/markus/FM/">Functional Morphology</a>
    </li>
    <li>
-      <a href="//www.molto-project.eu">MOLTO</a>:
+      <a href="http://www.molto-project.eu">MOLTO</a>:
      multilingual online translation
    </li>
    <li>
-      <a href="//remu.grammaticalframework.org">REMU</a>:
+      <a href="http://remu.grammaticalframework.org">REMU</a>:
      reliable multilingual digital communication
    </li>
    </ul>
@@ -340,16 +319,14 @@ least one, it may help you to get a first idea of what GF is.
    Libraries are at the heart of modern software engineering. In natural language
    applications, libraries are a way to cope with thousands of details involved in
    syntax, lexicon, and inflection. The
-    <a href="lib/doc/synopsis/index.html">GF resource grammar library</a> (RGL) has
+    <a href="lib/doc/synopsis/index.html">GF resource grammar library</a> has
    support for an increasing number of languages, currently including
    Afrikaans,
    Amharic (partial),
    Arabic (partial),
    Basque (partial),
    Bulgarian,
    Catalan,
    Chinese,
    Czech (partial),
    Danish,
    Dutch,
    English,
@@ -361,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),
+    Italian,
-    Latin (partial),
+    Latin (fragments),
    Latvian,
    Maltese,
    Mongolian,
@@ -379,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/nix/expose-all.patch
+++ b/nix/expose-all.patch
@@ -1,12 +0,0 @@
 diff --git a/gf.cabal b/gf.cabal
 index 0076e7638..8d3fe4b49 100644
 --- a/gf.cabal
 +++ b/gf.cabal
@@ -168,7 +168,6 @@ Library
     GF.Text.Lexing
     GF.Grammar.Canonical
 -  other-modules:
     GF.Main
     GF.Compiler
     GF.Interactive
--- a/nix/revert-new-cabal-madness.patch
+++ b/nix/revert-new-cabal-madness.patch
@@ -1,193 +0,0 @@
 commit 45e5473fcd5707af93646d9a116867a4d4e3e9c9
 Author: Andreas Källberg <anka.213@gmail.com>
 Date:   Mon Oct 10 14:57:12 2022 +0200
    Revert "workaround for the Nix madness"
    This reverts commit 1294269cd60f3db7b056135104615625baeb528c.
    There are easier workarounds, like using
      cabal v1-build
    etc. instead of just `cabal build`
    These changes also broke a whole bunch of other stuff
 diff --git a/README.md b/README.md
 index ba35795a4..79e6ab68f 100644
 --- a/README.md
 +++ b/README.md
@@ -38,21 +38,6 @@ or:
 ```
 stack install
 ```
 -Note that if you are unlucky to have Cabal 3.0 or later, then it uses
 -the so-called Nix style commands. Using those for GF development is
 -a pain. Every time when you change something in the source code, Cabal
 -will generate a new folder for GF to look for the GF libraries and
 -the GF cloud. Either reinstall everything with every change in the
 -compiler, or be sane and stop using cabal-install. Instead you can do:
 -```
 -runghc Setup.hs configure
 -runghc Setup.hs build
 -sudo runghc Setup.hs install
 -```
 -The script will install the GF dependencies globally. The only solution
 -to the Nix madness that I found is radical:
 -
 -  "No person, no problem" (Нет человека – нет проблемы).
 For more information, including links to precompiled binaries, see the [download page](https://www.grammaticalframework.org/download/index.html).
 diff --git a/Setup.hs b/Setup.hs
 index 58dc3e0c6..f8309cc00 100644
 --- a/Setup.hs
 +++ b/Setup.hs
@@ -4,68 +4,42 @@ import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..),absoluteInstallDirs
 import Distribution.Simple.Setup(BuildFlags(..),Flag(..),InstallFlags(..),CopyDest(..),CopyFlags(..),SDistFlags(..))
 import Distribution.PackageDescription(PackageDescription(..),emptyHookedBuildInfo)
 import Distribution.Simple.BuildPaths(exeExtension)
 -import System.Directory
 import System.FilePath((</>),(<.>))
 -import System.Process
 -import Control.Monad(forM_,unless)
 -import Control.Exception(bracket_)
 -import Data.Char(isSpace)
 import WebSetup
 +-- | Notice about RGL not built anymore
 +noRGLmsg :: IO ()
 +noRGLmsg = putStrLn "Notice: the RGL is not built as part of GF anymore. See https://github.com/GrammaticalFramework/gf-rgl"
 +
 main :: IO ()
 main = defaultMainWithHooks simpleUserHooks
 -  { preConf   = gfPreConf
 -  , preBuild  = gfPreBuild
 +  { preBuild  = gfPreBuild
   , postBuild = gfPostBuild
   , preInst   = gfPreInst
   , postInst  = gfPostInst
   , postCopy  = gfPostCopy
   }
   where
 -    gfPreConf args flags = do
 -      pkgs <- fmap (map (dropWhile isSpace) . tail . lines)
 -                   (readProcess "ghc-pkg" ["list"] "")
 -      forM_ dependencies $ \pkg -> do
 -        let name = takeWhile (/='/') (drop 36 pkg)
 -        unless (name `elem` pkgs) $ do
 -          let fname = name <.> ".tar.gz"
 -          callProcess "wget" [pkg,"-O",fname]
 -          callProcess "tar"  ["-xzf",fname]
 -          removeFile fname
 -          bracket_ (setCurrentDirectory name) (setCurrentDirectory ".." >> removeDirectoryRecursive name) $ do
 -            exists <- doesFileExist "Setup.hs"
 -            unless exists $ do
 -              writeFile "Setup.hs" (unlines [
 -                  "import Distribution.Simple",
 -                  "main = defaultMain"
 -                ])
 -            let to_descr = reverse .
 -                           (++) (reverse ".cabal") . 
 -                           drop 1 . 
 -                           dropWhile (/='-') . 
 -                           reverse
 -            callProcess "wget"   [to_descr pkg, "-O", to_descr name]
 -            callProcess "runghc" ["Setup.hs","configure"]
 -            callProcess "runghc" ["Setup.hs","build"]
 -            callProcess "sudo" ["runghc","Setup.hs","install"]
 -          
 -      preConf simpleUserHooks args flags
 -
 -    gfPreBuild args = gfPre args . buildDistPref
 -    gfPreInst  args = gfPre args . installDistPref
 +    gfPreBuild args  = gfPre args . buildDistPref
 +    gfPreInst args = gfPre args . installDistPref
     gfPre args distFlag = do
       return emptyHookedBuildInfo
     gfPostBuild args flags pkg lbi = do
 +      -- noRGLmsg
       let gf = default_gf lbi
       buildWeb gf flags (pkg,lbi)
     gfPostInst args flags pkg lbi = do
 +      -- noRGLmsg
 +      saveInstallPath args flags (pkg,lbi)
       installWeb (pkg,lbi)
     gfPostCopy args flags  pkg lbi = do
 +      -- noRGLmsg
 +      saveCopyPath args flags (pkg,lbi)
       copyWeb flags (pkg,lbi)
     -- `cabal sdist` will not make a proper dist archive, for that see `make sdist`
@@ -73,16 +47,27 @@ main = defaultMainWithHooks simpleUserHooks
     gfSDist pkg lbi hooks flags = do
       return ()
 -dependencies = [
 -  "https://hackage.haskell.org/package/utf8-string-1.0.2/utf8-string-1.0.2.tar.gz",
 -  "https://hackage.haskell.org/package/json-0.10/json-0.10.tar.gz",
 -  "https://hackage.haskell.org/package/network-bsd-2.8.1.0/network-bsd-2.8.1.0.tar.gz",
 -  "https://hackage.haskell.org/package/httpd-shed-0.4.1.1/httpd-shed-0.4.1.1.tar.gz",
 -  "https://hackage.haskell.org/package/exceptions-0.10.5/exceptions-0.10.5.tar.gz",
 -  "https://hackage.haskell.org/package/stringsearch-0.3.6.6/stringsearch-0.3.6.6.tar.gz",
 -  "https://hackage.haskell.org/package/multipart-0.2.1/multipart-0.2.1.tar.gz",
 -  "https://hackage.haskell.org/package/cgi-3001.5.0.0/cgi-3001.5.0.0.tar.gz"
 -  ]
 +saveInstallPath :: [String] -> InstallFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
 +saveInstallPath args flags bi = do
 +  let
 +    dest = NoCopyDest
 +    dir = datadir (uncurry absoluteInstallDirs bi dest)
 +  writeFile dataDirFile dir
 +
 +saveCopyPath :: [String] -> CopyFlags -> (PackageDescription, LocalBuildInfo) -> IO ()
 +saveCopyPath args flags bi = do
 +  let
 +    dest = case copyDest flags of
 +      NoFlag -> NoCopyDest
 +      Flag d -> d
 +    dir = datadir (uncurry absoluteInstallDirs bi dest)
 +  writeFile dataDirFile dir
 +
 +-- | Name of file where installation's data directory is recording
 +-- This is a last-resort way in which the seprate RGL build script
 +-- can determine where to put the compiled RGL files
 +dataDirFile :: String
 +dataDirFile = "DATA_DIR"
 -- | Get path to locally-built gf
 default_gf :: LocalBuildInfo -> FilePath
 diff --git a/gf.cabal b/gf.cabal
 index a055b86be..d00a5b935 100644
 --- a/gf.cabal
 +++ b/gf.cabal
@@ -2,7 +2,7 @@ name: gf
 version: 3.11.0-git
 cabal-version: 1.22
 -build-type: Simple
 +build-type: Custom
 license: OtherLicense
 license-file: LICENSE
 category: Natural Language Processing, Compiler
@@ -44,6 +44,14 @@ data-files:
   www/translator/*.css
   www/translator/*.js
 +custom-setup
 +  setup-depends:
 +    base >= 4.9.1 && < 4.16,
 +    Cabal >= 1.22.0.0,
 +    directory >= 1.3.0 && < 1.4,
 +    filepath >= 1.4.1 && < 1.5,
 +    process >= 1.0.1.1 && < 1.7
 +
 source-repository head
   type: git
   location: https://github.com/GrammaticalFramework/gf-core.git
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 module GF.Command.Commands (
  PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
  options,flags,
  ) where
 import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import System.Info(os)
 import PGF
@@ -22,7 +21,6 @@ import GF.Infra.SIO
 import GF.Command.Abstract
 import GF.Command.CommandInfo
 import GF.Command.CommonCommands
 import qualified GF.Command.CommonCommands as Common
 import GF.Text.Clitics
 import GF.Quiz
@@ -36,7 +34,6 @@ import Data.Maybe
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Data.List (sort)
 import qualified Control.Monad.Fail as Fail
 --import Debug.Trace
@@ -47,7 +44,7 @@ pgfEnv pgf = Env pgf mos
 class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
-instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where
+instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
  typeCheckArg e = (either (fail . render . ppTcError) (return . fst)
                    . flip inferExpr e . pgf) =<< getPGFEnv
@@ -167,15 +164,14 @@ pgfCommands = Map.fromList [
     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, up to depth " ++ Common.default_depth_str,
+       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 -cat=NP -number=16  -- 16 trees in the category NP",
-       mkEx   "gr -cat=NP -depth=2    -- one tree in the category NP, up to depth 2",
+       mkEx "gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",
-       mkEx   "gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",
+       mkEx "gr -probs=FILE         -- generate with bias",
-       mkEx   "gr -probs=FILE         -- generate with bias",
+       mkEx "gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"
       mkEx   "gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"
       ],
     explanation = unlines [
-       "Generates a list of random trees, by default one tree up to depth " ++ Common.default_depth_str ++ ".",
+       "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."
@@ -184,13 +180,13 @@ pgfCommands = Map.fromList [
       ("cat","generation category"),
       ("lang","uses only functions that have linearizations in all these languages"),
       ("number","number of trees generated"),
-       ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
+       ("depth","the maximum generation depth"),
       ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
       ],
     exec = getEnv $ \ opts arg (Env pgf mos) -> do
       pgf <- optProbs opts (optRestricted opts pgf)
       gen <- newStdGen
-       let dp = valIntOpts "depth" Common.default_depth opts
+       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)
@@ -201,28 +197,28 @@ pgfCommands = Map.fromList [
     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 " ++ Common.default_depth_str ++ ", but this can be changed by a flag.",
+       "the depth is limited to 4, but this can be changed by a flag.",
       "If a Tree argument is given, the command completes the Tree with values",
       "to all metavariables in the tree."
       ],
     flags = [
       ("cat","the generation category"),
-       ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
+       ("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 " ++ Common.default_depth_str,
+       mkEx "gt                     -- all trees in the startcat, to depth 4",
-       mkEx   "gt -cat=NP -number=16  -- 16 trees in the category NP",
+       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 -cat=NP -depth=2    -- trees in the category NP to depth 2",
-       mkEx   "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"
+       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" Common.default_depth opts
+       let dp = valIntOpts "depth" 4 opts
-       let ts = case toExprs arg of
+       let ts = case mexp (toExprs arg) of
-                  [] -> generateAllDepth pgfr (optType pgf opts) (Just dp)
+                  Just ex -> generateFromDepth pgfr ex (Just dp)
-                  es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]
+                  Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)
       returnFromExprs $ take (optNumInf opts) ts
     }),
  ("i", emptyCommandInfo {
@@ -430,8 +426,7 @@ pgfCommands = Map.fromList [
       "are type checking and semantic computation."
       ],
     examples = [
-       mkEx "pt -compute (plus one two)                               -- compute value",
+       mkEx "pt -compute (plus one two)                               -- compute value"
       mkEx ("p \"the 4 dogs\" | pt -transfer=digits2numeral | l  -- \"the four dogs\" ")
       ],
     exec = getEnv $ \ opts arg (Env pgf mos) ->
            returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,
@@ -745,7 +740,7 @@ pgfCommands = Map.fromList [
                                     Nothing   -> do putStrLn ("unknown category of function identifier "++show id)
                                                     return void
         [e]         -> case inferExpr pgf e of
-                          Left tcErr   -> errorWithoutStackTrace $ render (ppTcError tcErr)
+                          Left tcErr   -> error $ render (ppTcError tcErr)
                          Right (e,ty) -> do putStrLn ("Expression:  "++showExpr [] e)
                                             putStrLn ("Type:        "++showType [] ty)
                                             putStrLn ("Probability: "++show (probTree pgf e))
@@ -762,7 +757,7 @@ pgfCommands = Map.fromList [
                  []        -> [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" Common.default_depth opts
+       dp = valIntOpts "depth" 4 opts
   fromParse opts = foldr (joinPiped . fromParse1 opts) void
@@ -886,15 +881,11 @@ pgfCommands = Map.fromList [
                       Right ty   -> ty
          Nothing -> error ("Can't parse '"++str++"' as a type")
   optViewFormat opts = valStrOpts "format" "png" opts
-   optViewGraph opts = valStrOpts "view" open_cmd 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)
   open_cmd | os == "linux"   = "xdg-open"
            | os == "mingw32" = "start"
            | otherwise       = "open"
   returnFromExprs es = return $ case es of
     [] -> pipeMessage "no trees found"
     _  -> fromExprs es
@@ -1027,7 +1018,3 @@ stanzas = map unlines . chop . lines where
  chop ls = case break (=="") ls of
    (ls1,[])  -> [ls1]
    (ls1,_:ls2) -> ls1 : chop ls2
 #if !(MIN_VERSION_base(4,9,0))
 errorWithoutStackTrace = error
 #endif
--- a/src/compiler/GF/Command/Commands2.hs
+++ b/src/compiler/GF/Command/Commands2.hs
@@ -18,7 +18,6 @@ import Data.Maybe
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Control.Monad(mplus)
 import qualified Control.Monad.Fail as Fail
 data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
@@ -26,7 +25,7 @@ data PGFEnv = Env {pgf::Maybe PGF,concs::Map.Map ConcName Concr}
 pgfEnv pgf = Env (Just pgf) (languages pgf)
 emptyPGFEnv = Env Nothing Map.empty
-class (Fail.MonadFail m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
+class (Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv
 instance (Monad m,HasPGFEnv m) => TypeCheckArg m where
  typeCheckArg e = do env <- getPGFEnv
@@ -807,22 +806,14 @@ hsExpr c =
    Just (f,cs) -> H.mkApp (H.mkCId f) (map hsExpr cs)
    _ -> case unStr c of
           Just str -> H.mkStr str
-           _ -> case unInt c of
+           _ -> error $ "GF.Command.Commands2.hsExpr "++show c
                  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
+           _ -> error $ "GF.Command.Commands2.cExpr "++show e
                  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
--- a/src/compiler/GF/Command/CommonCommands.hs
+++ b/src/compiler/GF/Command/CommonCommands.hs
@@ -15,16 +15,9 @@ import GF.Command.Abstract --(isOpt,valStrOpts,prOpt)
 import GF.Text.Pretty
 import GF.Text.Transliterations
 import GF.Text.Lexing(stringOp,opInEnv)
 import Data.Char (isSpace)
 import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
 -- store default generation depth in a variable and use everywhere
 default_depth :: Int
 default_depth = 5
 default_depth_str = show default_depth
 extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased
 commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)
@@ -177,8 +170,7 @@ commonCommands = fmap (mapCommandExec liftSIO) $ Map.fromList [
       restrictedSystem $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo
       fmap fromString $ restricted $ readFile tmpo,
       -}
-       fmap (fromStrings . lines) . restricted . readShellProcess syst . unlines . map (dropWhile (=='\n')) $ toStrings $ arg,
+       fmap fromString . restricted . readShellProcess syst $ toString arg,
     flags = [
       ("command","the system command applied to the argument")
       ],
--- a/src/compiler/GF/Command/Interpreter.hs
+++ b/src/compiler/GF/Command/Interpreter.hs
@@ -11,8 +11,6 @@ import GF.Infra.UseIO(putStrLnE)
 import Control.Monad(when)
 import qualified Data.Map as Map
 import GF.Infra.UseIO (Output)
 import qualified Control.Monad.Fail as Fail
 data CommandEnv m = CommandEnv {
  commands      :: Map.Map String (CommandInfo m),
@@ -24,7 +22,6 @@ data CommandEnv m = CommandEnv {
 mkCommandEnv cmds = CommandEnv cmds Map.empty Map.empty
 --interpretCommandLine :: CommandEnv -> String -> SIO ()
 interpretCommandLine :: (Fail.MonadFail m, Output m, TypeCheckArg m) => CommandEnv m -> String -> m ()
 interpretCommandLine env line =
  case readCommandLine line of
    Just []    -> return ()
--- a/src/compiler/GF/Command/SourceCommands.hs
+++ b/src/compiler/GF/Command/SourceCommands.hs
@@ -18,8 +18,8 @@ import GF.Grammar.Parser (runP, pExp)
 import GF.Grammar.ShowTerm
 import GF.Grammar.Lookup (allOpers,allOpersTo)
 import GF.Compile.Rename(renameSourceTerm)
-import GF.Compile.Compute.Concrete(normalForm,resourceValues)
+import qualified GF.Compile.Compute.ConcreteNew as CN(normalForm,resourceValues)
-import GF.Compile.TypeCheck.Concrete as TC(inferLType,ppType)
+import GF.Compile.TypeCheck.RConcrete as TC(inferLType,ppType)
 import GF.Infra.Dependencies(depGraph)
 import GF.Infra.CheckM(runCheck)
@@ -259,7 +259,7 @@ checkComputeTerm os sgr t =
     ((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
                                inferLType sgr [] t
     let opts = modifyFlags (\fs->fs{optTrace=isOpt "trace" os})
-         t1 = normalForm (resourceValues opts sgr) (L NoLoc identW) t
+         t1 = CN.normalForm (CN.resourceValues opts sgr) (L NoLoc identW) t
         t2 = evalStr t1
     checkPredefError t2
  where
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -5,8 +5,6 @@ module GF.Command.TreeOperations (
  ) where
 import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
 import PGF.Data(Expr(EApp,EFun))
 import PGF.TypeCheck(inferExpr)
 import Data.List
 type TreeOp = [Expr] -> [Expr]
@@ -18,17 +16,15 @@ allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
 allTreeOps pgf = [
   ("compute",("compute by using semantic definitions (def)",
      Left  $ map (compute pgf))),
   ("transfer",("apply this transfer function to all maximal subtrees of suitable type",
      Right $ \f -> map (transfer pgf f))), -- HL 12/24, modified from gf-3.3
   ("largest",("sort trees from largest to smallest, in number of nodes",
      Left  $ largest)),
-   ("nub\t",("remove duplicate trees",
+   ("nub",("remove duplicate trees",
      Left  $ nub)),
   ("smallest",("sort trees from smallest to largest, in number of nodes",
      Left  $ smallest)),
   ("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",
      Left  $ concatMap subtrees)),
-   ("funs\t",("return all fun functions appearing in the tree, with duplications",
+   ("funs",("return all fun functions appearing in the tree, with duplications",
      Left  $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))
  ]
@@ -52,18 +48,3 @@ subtrees :: Expr -> [Expr]
 subtrees t = t : case unApp t of
  Just (f,ts) -> concatMap subtrees ts
  _ -> []  -- don't go under abstractions
 -- Apply transfer function f:C -> D to all maximal subtrees s:C of tree e and replace
 -- these s by the values of f(s). This modifies the 'simple-minded transfer' of gf-3.3.
 -- If applied to strict subtrees s of e, better use with f:C -> C only.  HL 12/2024
 transfer :: PGF -> CId -> Expr -> Expr
 transfer pgf f e = case inferExpr pgf (appf e) of
     Left _err -> case e of
                    EApp g a -> EApp (transfer pgf f g) (transfer pgf f a)
                    _ -> e
     Right _ty -> case (compute pgf (appf e)) of
                    v | v /= (appf e) -> v
                    _ -> e          -- default case of f, or f has no computation rule
 where
  appf = EApp (EFun f)
--- a/src/compiler/GF/Compile/CFGtoPGF.hs
+++ b/src/compiler/GF/Compile/CFGtoPGF.hs
@@ -130,5 +130,5 @@ cf2concr cfg = Concr Map.empty Map.empty
 mkRuleName rule =
  case ruleName rule of
-    CFObj n _ -> n
+	CFObj n _ -> n
-    _         -> wildCId
+	_         -> wildCId
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -27,20 +27,21 @@ import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Compile.TypeCheck.Abstract
-import GF.Compile.TypeCheck.Concrete(computeLType,checkLType,inferLType,ppType)
+import GF.Compile.TypeCheck.RConcrete
-import qualified GF.Compile.TypeCheck.ConcreteNew as CN(checkLType,inferLType)
+import qualified GF.Compile.TypeCheck.ConcreteNew as CN
-import qualified GF.Compile.Compute.Concrete as CN(normalForm,resourceValues)
+import qualified GF.Compile.Compute.ConcreteNew as CN
 import GF.Grammar
 import GF.Grammar.Lexer
 import GF.Grammar.Lookup
 --import GF.Grammar.Predef
 --import GF.Grammar.PatternMatch
 import GF.Data.Operations
 import GF.Infra.CheckM
 import Data.List
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Control.Monad
 import GF.Text.Pretty
@@ -58,7 +59,7 @@ checkModule opts cwd sgr mo@(m,mi) = do
  where
    updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check
      where check (i,info) = fmap ((,) i) (checkInfo opts cwd sgr mo i info)
-    update mo@(m,mi) (i,info) = (m,mi{jments=Map.insert i info (jments mi)})
+    update mo@(m,mi) (i,info) = (m,mi{jments=updateTree (i,info) (jments mi)})
 -- check if restricted inheritance modules are still coherent
 -- i.e. that the defs of remaining names don't depend on omitted names
@@ -71,7 +72,7 @@ checkRestrictedInheritance cwd sgr (name,mo) = checkInModule cwd mo NoLoc empty
 where
   mos = modules sgr
   checkRem ((i,m),mi) = do
-     let (incl,excl) = partition (isInherited mi) (Map.keys (jments m))
+     let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
     let incld c   = Set.member c (Set.fromList incl)
     let illegal c = Set.member c (Set.fromList excl)
     let illegals = [(f,is) | 
@@ -88,10 +89,10 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
  let jsc = jments cnc
  -- check that all concrete constants are in abstract; build types for all lin
-  jsc <- foldM checkCnc Map.empty (Map.toList jsc)
+  jsc <- foldM checkCnc emptyBinTree (tree2list jsc)
  -- check that all abstract constants are in concrete; build default lin and lincats
-  jsc <- foldM checkAbs jsc (Map.toList jsa)
+  jsc <- foldM checkAbs jsc (tree2list jsa)
  return (cm,cnc{jments=jsc})
  where
@@ -112,17 +113,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
                 case lookupIdent c js of
                   Ok (AnyInd _ _) -> return js
                   Ok (CncFun ty (Just def) mn mf) ->
-                                 return $ Map.insert c (CncFun ty (Just def) mn mf) js
+                                 return $ updateTree (c,CncFun ty (Just def) mn mf) js
                   Ok (CncFun ty Nothing    mn mf) ->
                     case mb_def of
-                       Ok def -> return $ Map.insert c (CncFun ty (Just (L NoLoc def)) mn mf) js
+                       Ok def -> return $ updateTree (c,CncFun ty (Just (L NoLoc def)) mn mf) js
                       Bad _  -> do noLinOf c
                                    return js
                   _ -> do
                     case mb_def of
                       Ok def -> do (cont,val) <- linTypeOfType gr cm ty
                                    let linty = (snd (valCat ty),cont,val)
-                                    return $ Map.insert c (CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
+                                    return $ updateTree (c,CncFun (Just linty) (Just (L NoLoc def)) Nothing Nothing) js
                       Bad _  -> do noLinOf c
                                    return js
         where noLinOf c = checkWarn ("no linearization of" <+> c)
@@ -131,24 +132,24 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
         Ok (CncCat (Just _) _ _ _ _) -> return js
         Ok (CncCat Nothing md mr mp mpmcfg) -> do
           checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
-           return $ Map.insert c (CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
+           return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
         _ -> do
           checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
-           return $ Map.insert c (CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
+           return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) Nothing Nothing Nothing Nothing) js
       _ -> return js
-   checkCnc js (c,info) =
+   checkCnc js i@(c,info) =
     case info of
       CncFun _ d mn mf -> case lookupOrigInfo gr (am,c) of
                             Ok (_,AbsFun (Just (L _ ty)) _ _ _) -> 
                                        do (cont,val) <- linTypeOfType gr cm ty
                                           let linty = (snd (valCat ty),cont,val)
-                                           return $ Map.insert c (CncFun (Just linty) d mn mf) js
+                                           return $ updateTree (c,CncFun (Just linty) d mn mf) js
                             _       -> do checkWarn ("function" <+> c <+> "is not in abstract")
                                           return js
       CncCat {} ->
         case lookupOrigInfo gr (am,c) of
-           Ok (_,AbsCat _) -> return $ Map.insert c info js
+           Ok (_,AbsCat _) -> return $ updateTree i js
           {- -- This might be too pedantic:
           Ok (_,AbsFun {}) ->
                   checkError ("lincat:"<+>c<+>"is a fun, not a cat")
@@ -156,7 +157,7 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
           _ -> do checkWarn ("category" <+> c <+> "is not in abstract")
                   return js
-       _ -> return $ Map.insert c info js
+       _ -> return $ updateTree i js
 -- | General Principle: only Just-values are checked. 
@@ -175,7 +176,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
        checkTyp gr typ
      case md of
        Just eqs -> mapM_ (\(L loc eq) -> mkCheck loc "the definition of function" $
-                                          checkDef gr (m,c) typ eq) eqs
+	                                        checkDef gr (m,c) typ eq) eqs
        Nothing  -> return ()
      return (AbsFun (Just (L loc typ)) ma md moper)
@@ -270,7 +271,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
   chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c)
   mkPar (f,co) = do
-       vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co
+       vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co
       return $ map (mkApp (QC (m,f))) vs
   checkUniq xss = case xss of
@@ -316,7 +317,7 @@ linTypeOfType cnc m typ = do
   mkLinArg (i,(n,mc@(m,cat))) = do
     val  <- lookLin mc
     let vars = mkRecType varLabel $ replicate n typeStr
-         symb = argIdent n cat i
+	 symb = argIdent n cat i
     rec <- if n==0 then return val else
                       errIn (render ("extending" $$
                                      nest 2 vars $$
--- a/src/compiler/GF/Compile/Coding.hs
+++ b/src/compiler/GF/Compile/Coding.hs
@@ -0,0 +1,64 @@
 module GF.Compile.Coding where
 {-
 import GF.Grammar.Grammar
 import GF.Grammar.Macros
 import GF.Text.Coding
 --import GF.Infra.Option
 import GF.Data.Operations
 --import Data.Char
 import System.IO
 import qualified Data.ByteString.Char8 as BS
 encodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule
 encodeStringsInModule enc = codeSourceModule (BS.unpack . encodeUnicode enc)
 decodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule
 decodeStringsInModule enc mo = codeSourceModule (decodeUnicode enc . BS.pack) mo
 codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
 codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)})
 where
    codj (c,info) = case info of
      ResOper     pty pt   -> ResOper (codeLTerms co pty) (codeLTerms co pt) 
      ResOverload es tyts  -> ResOverload es [(codeLTerm co ty,codeLTerm co t) | (ty,t) <- tyts]
      CncCat mcat mdef mref mpr mpmcfg -> CncCat mcat (codeLTerms co mdef) (codeLTerms co mref) (codeLTerms co mpr) mpmcfg
      CncFun mty mt mpr mpmcfg -> CncFun mty (codeLTerms co mt) (codeLTerms co mpr) mpmcfg
      _ -> info
 codeLTerms co = fmap (codeLTerm co)
 codeLTerm :: (String -> String) -> L Term -> L Term
 codeLTerm = fmap . codeTerm
 codeTerm :: (String -> String) -> Term -> Term
 codeTerm co = codt
  where
    codt t = case t of
      K s -> K (co s)
      T ty cs -> T ty [(codp p,codt v) | (p,v) <- cs]
      EPatt p -> EPatt (codp p)
      _ -> composSafeOp codt t
    codp p = case p of  --- really: composOpPatt
      PR rs -> PR [(l,codp p) | (l,p) <- rs]
      PString s -> PString (co s)
      PChars s -> PChars (co s)
      PT x p -> PT x (codp p)
      PAs x p -> PAs x (codp p)
      PNeg p -> PNeg (codp p)
      PRep p -> PRep (codp p)
      PSeq p q -> PSeq (codp p) (codp q)
      PAlt p q -> PAlt (codp p) (codp q)
      _ -> p
 -- | Run an encoding function on all string literals within the given string.
 codeStringLiterals :: (String -> String) -> String -> String
 codeStringLiterals _ [] = []
 codeStringLiterals co ('"':cs) = '"' : inStringLiteral cs
  where inStringLiteral [] = error "codeStringLiterals: unterminated string literal"
        inStringLiteral ('"':ds) = '"' : codeStringLiterals co ds
        inStringLiteral ('\\':d:ds) = '\\' : co [d] ++ inStringLiteral ds
        inStringLiteral (d:ds) = co [d] ++ inStringLiteral ds
 codeStringLiterals co (c:cs) = c : codeStringLiterals co cs
 -}
--- 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/Concrete.hs
+++ b/src/compiler/GF/Compile/Compute/Concrete.hs
@@ -1,590 +1,3 @@
-- | Functions for computing the values of terms in the concrete syntax, in
+module GF.Compile.Compute.Concrete{-(module M)-} where
-- | preparation for PMCFG generation.
+--import GF.Compile.Compute.ConcreteLazy as M -- New
-module GF.Compile.Compute.Concrete
+--import GF.Compile.Compute.ConcreteStrict as M -- Old, inefficient
           (GlobalEnv, GLocation, resourceValues, geLoc, geGrammar,
            normalForm,
            Value(..), Bind(..), Env, value2term, eval, vapply
           ) where
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import GF.Grammar hiding (Env, VGen, VApp, VRecType)
 import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
 import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,cTrace,cPBool)
 import GF.Grammar.PatternMatch(matchPattern,measurePatt)
 import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel
 import GF.Compile.Compute.Value hiding (Error)
 import GF.Compile.Compute.Predef(predef,predefName,delta)
 import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)
 import GF.Data.Operations(Err,err,errIn,maybeErr,mapPairsM)
 import GF.Data.Utilities(mapFst,mapSnd)
 import GF.Infra.Option
 import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus
 import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf
 --import Data.Char (isUpper,toUpper,toLower)
 import GF.Text.Pretty
 import qualified Data.Map as Map
 import Debug.Trace(trace)
 -- * Main entry points
 normalForm :: GlobalEnv -> L Ident -> Term -> Term
 normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)
 nfx :: GlobalEnv -> Term -> Err Term
 nfx env@(GE _ _ _ loc) t = do
  v <- eval env [] t
  return (value2term loc [] v)
    -- Old value2term error message:
    -- Left i  -> fail ("variable #"++show i++" is out of scope")
 eval :: GlobalEnv -> Env -> Term -> Err Value
 eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t
  where
    cenv = CE gr rvs opts loc (map fst env)
 --apply env = apply' env
 --------------------------------------------------------------------------------
 -- * Environments
 type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))
 data GlobalEnv = GE Grammar ResourceValues Options GLocation
 data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,
                       opts::Options,
                       gloc::GLocation,local::LocalScope}
 type GLocation = L Ident
 type LocalScope = [Ident]
 type Stack = [Value]
 type OpenValue = Stack->Value
 geLoc     (GE _ _ _ loc) = loc
 geGrammar (GE gr _ _ _)  = gr
 ext b env = env{local=b:local env}
 extend bs env = env{local=bs++local env}
 global env = GE (srcgr env) (rvs env) (opts env) (gloc env)
 var :: CompleteEnv -> Ident -> Err OpenValue
 var env x = maybe unbound pick' (elemIndex x (local env))
  where
    unbound = fail ("Unknown variable: "++showIdent x)
    pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
    err i vs = bug $ "Stack problem: "++showIdent x++": "
                    ++unwords (map showIdent (local env))
                    ++" => "++show (i,length vs)
    ok v = --trace ("var "++show x++" = "++show v) $
           v
 pick :: Int -> Stack -> Maybe Value
 pick 0 (v:_) = Just v
 pick i (_:vs) = pick (i-1) vs
 pick i vs = Nothing -- bug $ "pick "++show (i,vs)
 resource env (m,c) =
 --  err bug id $
    if isPredefCat c
    then value0 env =<< lockRecType c defLinType -- hmm
    else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)
  where e = fail $ "Not found: "++render m++"."++showIdent c
 -- | Convert operators once, not every time they are looked up
 resourceValues :: Options -> SourceGrammar -> GlobalEnv
 resourceValues opts gr = env
  where
    env = GE gr rvs opts (L NoLoc identW)
    rvs = Map.mapWithKey moduleResources (moduleMap gr)
    moduleResources m = Map.mapWithKey (moduleResource m) . jments
    moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)
                                  let loc = L l c
                                      qloc = L l (Q (m,c))
                                  eval (GE gr rvs opts loc) [] (traceRes qloc t)
    traceRes = if flag optTrace opts
               then traceResource
               else const id
 -- * Tracing
 -- | Insert a call to the trace function under the top-level lambdas
 traceResource (L l q) t =
  case termFormCnc t of
    (abs,body) -> mkAbs abs (mkApp traceQ [args,body])
      where
        args = R $ tuple2record (K lstr:[Vr x|(bt,x)<-abs,bt==Explicit])
        lstr = render (l<>":"<>ppTerm Qualified 0 q)
        traceQ = Q (cPredef,cTrace)
 -- * Computing values
 -- | Computing the value of a top-level term
 value0 :: CompleteEnv -> Term -> Err Value
 value0 env = eval (global env) []
 -- | Computing the value of a term
 value :: CompleteEnv -> Term -> Err OpenValue
 value env t0 =
  -- Each terms is traversed only once by this function, using only statically
  -- available information. Notably, the values of lambda bound variables
  -- will be unknown during the term traversal phase.
  -- The result is an OpenValue, which is a function that may be applied many
  -- times to different dynamic values, but without the term traversal overhead
  -- and without recomputing other statically known information.
  -- For this to work, there should be no recursive calls under lambdas here.
  -- Whenever we need to construct the OpenValue function with an explicit
  -- lambda, we have to lift the recursive calls outside the lambda.
  -- (See e.g. the rules for Let, Prod and Abs)
 {-
  trace (render $ text "value"<+>sep [ppL (gloc env)<>text ":",
                                      brackets (fsep (map ppIdent (local env))),
                                      ppTerm Unqualified 10 t0]) $
 --}
  errIn (render t0) $
  case t0 of
    Vr x   -> var env x
    Q x@(m,f)
      | m == cPredef -> if f==cErrorType                -- to be removed
                        then let p = identS "P"
                             in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])
                        else if f==cPBool
                               then const # resource env x
                               else const . flip VApp [] # predef f
      | otherwise    -> const # resource env x --valueResDef (fst env) x
    QC x   -> return $ const (VCApp x [])
    App e1 e2 -> apply' env e1 . (:[]) =<< value env e2
    Let (x,(oty,t)) body -> do vb <- value (ext x env) body
                               vt <- value env t
                               return $ \ vs -> vb (vt vs:vs)
    Meta i -> return $ \ vs -> VMeta i (zip (local env) vs) []
    Prod bt x t1 t2 ->
       do vt1 <- value env t1
          vt2 <- value (ext x env) t2
          return $ \ vs -> VProd bt (vt1 vs) x $ Bind $ \ vx -> vt2 (vx:vs)
    Abs bt x t -> do vt <- value (ext x env) t
                     return $ VAbs bt x . Bind . \ vs vx -> vt (vx:vs)
    EInt n -> return $ const (VInt n)
    EFloat f -> return $ const (VFloat f)
    K s -> return $ const (VString s)
    Empty -> return $ const (VString "")
    Sort s | s == cTok -> return $ const (VSort cStr)        -- to be removed
           | otherwise -> return $ const (VSort s)
    ImplArg t -> (VImplArg.) # value env t
    Table p res -> liftM2 VTblType # value env p <# value env res
    RecType rs -> do lovs <- mapPairsM (value env) rs
                     return $ \vs->VRecType $ mapSnd ($ vs) lovs
    t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
    FV ts   -> ((vfv .) # sequence) # mapM (value env) ts
    R as    -> do lovs <- mapPairsM (value env.snd) as
                  return $ \ vs->VRec $ mapSnd ($ vs) lovs
    T i cs  -> valueTable env i cs
    V ty ts -> do pvs <- paramValues env ty
                  ((VV ty pvs .) . sequence) # mapM (value env) ts
    C t1 t2 -> ((ok2p vconcat.) # both id) # both (value env) (t1,t2)
    S t1 t2 -> ((select env.) # both id) # both (value env) (t1,t2)
    P t l   -> --maybe (bug $ "project "++show l++" from "++show v) id $
               do ov <- value env t
                  return $ \ vs -> let v = ov vs
                                   in maybe (VP v l) id (proj l v)
    Alts t tts -> (\v vts -> VAlts # v <# mapM (both id) vts) # value env t <# mapM (both (value env)) tts
    Strs ts    -> ((VStrs.) # sequence) # mapM (value env) ts
    Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)
    ELin c r -> (unlockVRec (gloc env) c.) # value env r
    EPatt p  -> return $ const (VPatt p) -- hmm
    EPattType ty -> do vt <- value env ty
                       return (VPattType . vt)
    Typed t ty -> value env t
    t -> fail.render $ "value"<+>ppTerm Unqualified 10 t $$ show t
 vconcat vv@(v1,v2) =
    case vv of
      (VString "",_) -> v2
      (_,VString "") -> v1
      (VApp NonExist _,_) -> v1
      (_,VApp NonExist _) -> v2
      _ -> VC v1 v2
 proj l v | isLockLabel l = return (VRec [])
                ---- a workaround 18/2/2005: take this away and find the reason
                ---- why earlier compilation destroys the lock field
 proj l v =
    case v of
      VFV vs -> liftM vfv (mapM (proj l) vs)
      VRec rs -> lookup l rs
 --    VExtR v1 v2 -> proj l v2 `mplus` proj l v1 -- hmm
      VS (VV pty pvs rs) v2 -> flip VS v2 . VV pty pvs # mapM (proj l) rs
      _ -> return (ok1 VP v l)
 ok1 f v1@(VError {}) _ = v1
 ok1 f v1 v2 = f v1 v2
 ok2 f v1@(VError {}) _ = v1
 ok2 f _ v2@(VError {}) = v2
 ok2 f v1 v2 = f v1 v2
 ok2p f (v1@VError {},_) = v1
 ok2p f (_,v2@VError {}) = v2
 ok2p f vv = f vv
 unlockVRec loc c0 v0 = v0
 {-
 unlockVRec loc c0 v0 = unlockVRec' c0 v0
  where
    unlockVRec' ::Ident -> Value -> Value
    unlockVRec' c v =
        case v of
    --    VClosure env t -> err bug (VClosure env) (unlockRecord c t)
          VAbs bt x (Bind f) -> VAbs bt x (Bind $ \ v -> unlockVRec' c (f v))
          VRec rs        -> plusVRec rs lock
    --    _              -> VExtR v (VRec lock) -- hmm
          _              -> {-trace (render $ ppL loc $ "unlock non-record "++show v0)-} v -- hmm
    --    _              -> bugloc loc $ "unlock non-record "++show v0
      where
        lock = [(lockLabel c,VRec [])]
 -}
 -- suspicious, but backwards compatible
 plusVRec rs1 rs2 = VRec ([(l,v)|(l,v)<-rs1,l `notElem` ls2] ++ rs2)
  where ls2 = map fst rs2
 extR t vv =
    case vv of
      (VFV vs,v2) -> vfv [extR t (v1,v2)|v1<-vs]
      (v1,VFV vs) -> vfv [extR t (v1,v2)|v2<-vs]
      (VRecType rs1, VRecType rs2) ->
          case intersect (map fst rs1) (map fst rs2) of
            [] -> VRecType (rs1 ++ rs2)
            ls -> error $ "clash"<+>show ls
      (VRec     rs1, VRec     rs2) -> plusVRec rs1 rs2
      (v1          , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm
      (VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s
 --    (v1,v2) -> ok2 VExtR v1 v2 -- hmm
      (v1,v2) -> error $ "not records" $$ show v1 $$ show v2
  where
    error explain = ppbug $ "The term" <+> t
                            <+> "is not reducible" $$ explain
 glue env (v1,v2) = glu v1 v2
  where
    glu v1 v2 =
        case (v1,v2) of
          (VFV vs,v2) -> vfv [glu v1 v2|v1<-vs]
          (v1,VFV vs) -> vfv [glu v1 v2|v2<-vs]
          (VString s1,VString s2) -> VString (s1++s2)
          (v1,VAlts d vs) -> VAlts (glx d) [(glx v,c) | (v,c) <- vs]
             where glx v2 = glu v1 v2
          (v1@(VAlts {}),v2) ->
           --err (const (ok2 VGlue v1 v2)) id $
             err bug id $
             do y' <- strsFromValue v2
                x' <- strsFromValue v1
                return $ vfv [foldr1 VC (map VString (str2strings (glueStr v u))) | v <- x', u <- y']
          (VC va vb,v2) -> VC va (glu vb v2)
          (v1,VC va vb) -> VC (glu v1 va) vb
          (VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb
          (v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb
          (v1@(VApp NonExist _),_) -> v1
          (_,v2@(VApp NonExist _)) -> v2
 --        (v1,v2) -> ok2 VGlue v1 v2
          (v1,v2) -> if flag optPlusAsBind (opts env)
                       then VC v1 (VC (VApp BIND []) v2)
                       else let loc  = gloc env
                                vt v = value2term loc (local env) v
                                        -- Old value2term error message:
                                        --  Left i  -> Error ('#':show i)
                                originalMsg = render $ ppL loc (hang "unsupported token gluing" 4
                                                               (Glue (vt v1) (vt v2)))
                                term = render $ pp  $ Glue (vt v1) (vt v2)
                            in error $ unlines
                                [originalMsg
                                ,""
                                ,"There was a problem in the expression `"++term++"`, either:"
                                ,"1) You are trying to use + on runtime arguments, possibly via an oper."
                                ,"2) One of the arguments in `"++term++"` is a bound variable from pattern matching a string, but the cases are non-exhaustive."
                                ,"For more help see https://github.com/GrammaticalFramework/gf-core/tree/master/doc/errors/gluing.md"
                                ]
 -- | to get a string from a value that represents a sequence of terminals
 strsFromValue :: Value -> Err [Str]
 strsFromValue t = case t of
  VString s   -> return [str s]
  VC s t -> do
    s' <- strsFromValue s
    t' <- strsFromValue t
    return [plusStr x y | x <- s', y <- t']
 {-
  VGlue s t -> do
    s' <- strsFromValue s
    t' <- strsFromValue t
    return [glueStr x y | x <- s', y <- t']
 -}
  VAlts d vs -> do
    d0 <- strsFromValue d
    v0 <- mapM (strsFromValue . fst) vs
    c0 <- mapM (strsFromValue . snd) vs
  --let vs' = zip v0 c0
    return [strTok (str2strings def) vars |
              def  <- d0,
              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] |
                                                          vv <- sequence v0]
           ]
  VFV ts -> concat # mapM strsFromValue ts
  VStrs ts -> concat # mapM strsFromValue ts
  _ -> fail ("cannot get Str from value " ++ show t)
 vfv vs = case nub vs of
           [v] -> v
           vs -> VFV vs
 select env vv =
    case vv of
      (v1,VFV vs) -> vfv [select env (v1,v2)|v2<-vs]
      (VFV vs,v2) -> vfv [select env (v1,v2)|v1<-vs]
      (v1@(VV pty vs rs),v2) ->
         err (const (VS v1 v2)) id $
         do --ats <- allParamValues (srcgr env) pty
            --let vs = map (value0 env) ats
            i <- maybeErr "no match" $ findIndex (==v2) vs
            return (ix (gloc env) "select" rs i)
      (VT _ _ [(PW,Bind b)],_) -> {-trace "eliminate wild card table" $-} b []
      (v1@(VT _ _ cs),v2) ->
                 err (\_->ok2 VS v1 v2) (err bug id . valueMatch env) $
                 match (gloc env) cs v2
      (VS (VV pty pvs rs) v12,v2) -> VS (VV pty pvs [select env (v11,v2)|v11<-rs]) v12
      (v1,v2) -> ok2 VS v1 v2
 match loc cs v =
  err bad return (matchPattern cs (value2term loc [] v))
    -- Old value2term error message:
    -- Left i  -> bad ("variable #"++show i++" is out of scope")
  where
    bad = fail . ("In pattern matching: "++)
 valueMatch :: CompleteEnv -> (Bind Env,Substitution) -> Err Value
 valueMatch env (Bind f,env') = f # mapPairsM (value0 env) env'
 valueTable :: CompleteEnv -> TInfo -> [Case] -> Err OpenValue
 valueTable env i cs =
    case i of
      TComp ty -> do pvs <- paramValues env ty
                     ((VV ty pvs .) # sequence) # mapM (value env.snd) cs
      _ -> do ty <- getTableType i
              cs' <- mapM valueCase cs
              err (dynamic cs' ty) return (convert cs' ty)
  where
    dynamic cs' ty _ = cases cs' # value env ty
    cases cs' vty vs = err keep ($ vs) (convertv cs' (vty vs))
      where
        keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
                   VT wild (vty vs) (mapSnd ($ vs) cs')
    wild = case i of TWild _ -> True; _ -> False
    convertv cs' vty =
      convert' cs' =<< paramValues'' env (value2term (gloc env) [] vty)
        -- Old value2term error message: Left i    -> fail ("variable #"++show i++" is out of scope")
    convert cs' ty = convert' cs' =<< paramValues' env ty
    convert' cs' ((pty,vs),pvs) =
      do sts  <- mapM (matchPattern cs') vs
         return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
                                           (mapFst ($ vs) sts)
    valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
                         pvs <- linPattVars p'
                         vt <- value (extend pvs env) t
                         return (p',\vs-> Bind $ \bs-> vt (push' p' bs pvs vs))
    inlinePattMacro p =
        case p of
          PM qc -> do r <- resource env qc
                      case r of
                        VPatt p' -> inlinePattMacro p'
                        _ -> ppbug $ hang "Expected pattern macro:" 4
                                          (show r)
          _ -> composPattOp inlinePattMacro p
 paramValues env ty = snd # paramValues' env ty
 paramValues' env ty = paramValues'' env =<< nfx (global env) ty
 paramValues'' env pty = do ats <- allParamValues (srcgr env) pty
                           pvs <- mapM (eval (global env) []) ats
                           return ((pty,ats),pvs)
 push' p bs xs = if length bs/=length xs
                then bug $ "push "++show (p,bs,xs)
                else push bs xs
 push :: Env -> LocalScope -> Stack -> Stack
 push bs [] vs = vs
 push bs (x:xs) vs = maybe err id (lookup x bs):push bs xs vs
  where  err = bug $ "Unbound pattern variable "++showIdent x
 apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
 apply' env t [] = value env t
 apply' env t vs =
  case t of
    QC x                   -> return $ \ svs -> VCApp x (map ($ svs) vs)
 {-
    Q x@(m,f) | m==cPredef -> return $
                              let constr = --trace ("predef "++show x) .
                                           VApp x
                              in \ svs -> maybe constr id (Map.lookup f predefs)
                                          $ map ($ svs) vs
              | otherwise  -> do r <- resource env x
                                 return $ \ svs -> vapply (gloc env) r (map ($ svs) vs)
 -}
    App t1 t2              -> apply' env t1 . (:vs) =<< value env t2
    _                      -> do fv <- value env t
                                 return $ \ svs -> vapply (gloc env) (fv svs) (map ($ svs) vs)
 vapply :: GLocation -> Value -> [Value] -> Value
 vapply loc v [] = v
 vapply loc v vs =
  case v of
    VError {} -> v
 --  VClosure env (Abs b x t) -> beta gr env b x t vs
    VAbs bt _ (Bind f) -> vbeta loc bt f vs
    VApp pre vs1 -> delta' pre (vs1++vs)
      where
        delta' Trace (v1:v2:vs) = let vr = vapply loc v2 vs
                                  in vtrace loc v1 vr
        delta' pre vs = err msg vfv $ mapM (delta pre) (varyList vs)
        --msg = const (VApp pre (vs1++vs))
        msg = bug . (("Applying Predef."++showIdent (predefName pre)++": ")++)
    VS (VV t pvs fs) s -> VS (VV t pvs [vapply loc f vs|f<-fs]) s
    VFV fs -> vfv [vapply loc f vs|f<-fs]
    VCApp f vs0 -> VCApp f (vs0++vs)
    VMeta i env vs0 -> VMeta i env (vs0++vs)
    VGen i vs0 -> VGen i (vs0++vs)
    v -> bug $ "vapply "++show v++" "++show vs
 vbeta loc bt f (v:vs) =
  case (bt,v) of
    (Implicit,VImplArg v) -> ap v
    (Explicit,         v) -> ap v
  where
    ap (VFV avs) = vfv [vapply loc (f v) vs|v<-avs]
    ap v         = vapply loc (f v) vs
 vary (VFV vs) = vs
 vary v = [v]
 varyList = mapM vary
 {-
 beta env b x t (v:vs) =
  case (b,v) of
    (Implicit,VImplArg v) -> apply' (ext (x,v) env) t vs
    (Explicit,         v) -> apply' (ext (x,v) env) t vs
 -}
 vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res
  where
    pv v = case v of
             VRec (f:as) -> hang (pf f) 4 (fsep (map pa as))
             _ -> ppV v
    pf (_,VString n) = pp n
    pf (_,v) = ppV v
    pa (_,v) = ppV v
    ppV v = ppTerm Unqualified 10 (value2term' True loc [] v)
              -- Old value2term error message:
              -- Left i  -> "variable #" <> pp i <+> "is out of scope"
 -- | Convert a value back to a term
 value2term :: GLocation -> [Ident] -> Value -> Term
 value2term = value2term' False
 value2term' :: Bool -> p -> [Ident] -> Value -> Term
 value2term' stop loc xs v0 =
  case v0 of
    VApp pre vs    -> applyMany (Q (cPredef,predefName pre)) vs
    VCApp f vs     -> applyMany (QC f)                       vs
    VGen j vs      -> applyMany (var j)                      vs
    VMeta j env vs -> applyMany (Meta j)                     vs
    VProd bt v x f -> Prod bt x (v2t v)  (v2t' x f)
    VAbs  bt   x f -> Abs  bt x          (v2t' x f)
    VInt n         -> EInt n
    VFloat f       -> EFloat f
    VString s      -> if null s then Empty else K s
    VSort s        -> Sort s
    VImplArg v     -> ImplArg (v2t v)
    VTblType p res -> Table (v2t p) (v2t res)
    VRecType rs    -> RecType [(l, v2t v) | (l,v) <- rs]
    VRec as        -> R       [(l, (Nothing, v2t v)) | (l,v) <- as]
    VV t _ vs      -> V t     (map v2t vs)
    VT wild v cs   -> T ((if wild then TWild else TTyped) (v2t v)) (map nfcase cs)
    VFV vs         -> FV (map v2t vs)
    VC v1 v2       -> C (v2t v1) (v2t v2)
    VS v1 v2       -> S (v2t v1) (v2t v2)
    VP v l         -> P (v2t v) l
    VPatt p        -> EPatt p
    VPattType v    -> EPattType $ v2t v
    VAlts v vvs    -> Alts (v2t v) [(v2t x, v2t y) | (x,y) <- vvs]
    VStrs vs       -> Strs (map v2t vs)
 --  VGlue v1 v2    -> Glue (v2t v1) (v2t v2)
 --  VExtR v1 v2    -> ExtR (v2t v1) (v2t v2)
    VError err     -> Error err
  where
    applyMany f vs = foldl App f (map v2t vs)
    v2t = v2txs xs
    v2txs = value2term' stop loc
    v2t' x f = v2txs (x:xs) (bind f (gen xs))
    var j
      | j<length xs = Vr (reverse xs !! j)
      | otherwise   = error ("variable #"++show j++" is out of scope")
    pushs xs e = foldr push e xs
    push x (env,xs) = ((x,gen xs):env,x:xs)
    gen xs = VGen (length xs) []
    nfcase (p,f) = (,) p (v2txs xs' (bind f env'))
      where (env',xs') = pushs (pattVars p) ([],xs)
    bind (Bind f) x = if stop
                      then VSort (identS "...") -- hmm
                      else f x
 linPattVars p =
    if null dups
    then return pvs
    else fail.render $ hang "Pattern is not linear. All variable names on the left-hand side must be distinct." 4 (ppPatt Unqualified 0 p)
  where
    allpvs = allPattVars p
    pvs = nub allpvs
    dups = allpvs \\ pvs
 pattVars = nub . allPattVars
 allPattVars p =
    case p of
      PV i    -> [i]
      PAs i p -> i:allPattVars p
      _       -> collectPattOp allPattVars p
 ---
 ix loc fn xs i =
    if i<n
    then xs !! i
    else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
  where n = length xs
 infixl 1 #,<# --,@@
 f # x = fmap f x
 mf <# mx  = ap mf mx
 --m1 @@ m2 = (m1 =<<) . m2
 both f (x,y) = (,) # f x <# f y
 bugloc loc s = ppbug $ ppL loc s
 bug msg = ppbug msg
 ppbug doc = error $ render $ hang "Internal error in Compute.Concrete:" 4 doc
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -0,0 +1,580 @@
 -- | Functions for computing the values of terms in the concrete syntax, in
 -- | preparation for PMCFG generation.
 module GF.Compile.Compute.ConcreteNew
           (GlobalEnv, GLocation, resourceValues, geLoc, geGrammar,
            normalForm,
            Value(..), Bind(..), Env, value2term, eval, vapply
           ) where
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import GF.Grammar hiding (Env, VGen, VApp, VRecType)
 import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
 import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,cTrace,cPBool)
 import GF.Grammar.PatternMatch(matchPattern,measurePatt)
 import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel
 import GF.Compile.Compute.Value hiding (Error)
 import GF.Compile.Compute.Predef(predef,predefName,delta)
 import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)
 import GF.Data.Operations(Err,err,errIn,maybeErr,combinations,mapPairsM)
 import GF.Data.Utilities(mapFst,mapSnd)
 import GF.Infra.Option
 import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus
 import Data.List (findIndex,intersect,nub,elemIndex,(\\)) --,isInfixOf
 --import Data.Char (isUpper,toUpper,toLower)
 import GF.Text.Pretty
 import qualified Data.Map as Map
 import Debug.Trace(trace)
 -- * Main entry points
 normalForm :: GlobalEnv -> L Ident -> Term -> Term
 normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)
 nfx env@(GE _ _ _ loc) t = do
  v <- eval env [] t
  case value2term loc [] v of
    Left i  -> fail ("variable #"++show i++" is out of scope")
    Right t -> return t
 eval :: GlobalEnv -> Env -> Term -> Err Value
 eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t
  where
    cenv = CE gr rvs opts loc (map fst env)
 --apply env = apply' env
 --------------------------------------------------------------------------------
 -- * Environments
 type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))
 data GlobalEnv = GE Grammar ResourceValues Options GLocation
 data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,
                       opts::Options,
                       gloc::GLocation,local::LocalScope}
 type GLocation = L Ident
 type LocalScope = [Ident]
 type Stack = [Value]
 type OpenValue = Stack->Value
 geLoc     (GE _ _ _ loc) = loc
 geGrammar (GE gr _ _ _)  = gr
 ext b env = env{local=b:local env}
 extend bs env = env{local=bs++local env}
 global env = GE (srcgr env) (rvs env) (opts env) (gloc env)
 var :: CompleteEnv -> Ident -> Err OpenValue
 var env x = maybe unbound pick' (elemIndex x (local env))
  where
    unbound = fail ("Unknown variable: "++showIdent x)
    pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
    err i vs = bug $ "Stack problem: "++showIdent x++": "
                    ++unwords (map showIdent (local env))
                    ++" => "++show (i,length vs)
    ok v = --trace ("var "++show x++" = "++show v) $
           v
 pick :: Int -> Stack -> Maybe Value
 pick 0 (v:_) = Just v
 pick i (_:vs) = pick (i-1) vs
 pick i vs = Nothing -- bug $ "pick "++show (i,vs)
 resource env (m,c) =
 --  err bug id $
    if isPredefCat c
    then value0 env =<< lockRecType c defLinType -- hmm
    else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)
  where e = fail $ "Not found: "++render m++"."++showIdent c
 -- | Convert operators once, not every time they are looked up
 resourceValues :: Options -> SourceGrammar -> GlobalEnv
 resourceValues opts gr = env
  where
    env = GE gr rvs opts (L NoLoc identW)
    rvs = Map.mapWithKey moduleResources (moduleMap gr)
    moduleResources m = Map.mapWithKey (moduleResource m) . jments
    moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)
                                  let loc = L l c
                                      qloc = L l (Q (m,c))
                                  eval (GE gr rvs opts loc) [] (traceRes qloc t)
    traceRes = if flag optTrace opts
               then traceResource
               else const id
 -- * Tracing
 -- | Insert a call to the trace function under the top-level lambdas
 traceResource (L l q) t =
  case termFormCnc t of
    (abs,body) -> mkAbs abs (mkApp traceQ [args,body])
      where
        args = R $ tuple2record (K lstr:[Vr x|(bt,x)<-abs,bt==Explicit])
        lstr = render (l<>":"<>ppTerm Qualified 0 q)
        traceQ = Q (cPredef,cTrace)
 -- * Computing values
 -- | Computing the value of a top-level term
 value0 :: CompleteEnv -> Term -> Err Value
 value0 env = eval (global env) []
 -- | Computing the value of a term
 value :: CompleteEnv -> Term -> Err OpenValue
 value env t0 =
  -- Each terms is traversed only once by this function, using only statically
  -- available information. Notably, the values of lambda bound variables 
  -- will be unknown during the term traversal phase.
  -- The result is an OpenValue, which is a function that may be applied many
  -- times to different dynamic values, but without the term traversal overhead
  -- and without recomputing other statically known information.
  -- For this to work, there should be no recursive calls under lambdas here.
  -- Whenever we need to construct the OpenValue function with an explicit
  -- lambda, we have to lift the recursive calls outside the lambda.
  -- (See e.g. the rules for Let, Prod and Abs)
 {-
  trace (render $ text "value"<+>sep [ppL (gloc env)<>text ":",
                                      brackets (fsep (map ppIdent (local env))),
                                      ppTerm Unqualified 10 t0]) $
 --}
  errIn (render t0) $
  case t0 of
    Vr x   -> var env x
    Q x@(m,f)
      | m == cPredef -> if f==cErrorType                -- to be removed
                        then let p = identS "P"
                             in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])
                        else if f==cPBool
                               then const # resource env x
                               else const . flip VApp [] # predef f
      | otherwise    -> const # resource env x --valueResDef (fst env) x
    QC x   -> return $ const (VCApp x [])
    App e1 e2 -> apply' env e1 . (:[]) =<< value env e2
    Let (x,(oty,t)) body -> do vb <- value (ext x env) body
                               vt <- value env t
                               return $ \ vs -> vb (vt vs:vs)
    Meta i -> return $ \ vs -> VMeta i (zip (local env) vs) []
    Prod bt x t1 t2 ->
       do vt1 <- value env t1
          vt2 <- value (ext x env) t2
          return $ \ vs -> VProd bt (vt1 vs) x $ Bind $ \ vx -> vt2 (vx:vs)
    Abs bt x t -> do vt <- value (ext x env) t
                     return $ VAbs bt x . Bind . \ vs vx -> vt (vx:vs)
    EInt n -> return $ const (VInt n)
    EFloat f -> return $ const (VFloat f)
    K s -> return $ const (VString s)
    Empty -> return $ const (VString "")
    Sort s | s == cTok -> return $ const (VSort cStr)        -- to be removed 
           | otherwise -> return $ const (VSort s)
    ImplArg t -> (VImplArg.) # value env t
    Table p res -> liftM2 VTblType # value env p <# value env res
    RecType rs -> do lovs <- mapPairsM (value env) rs
                     return $ \vs->VRecType $ mapSnd ($vs) lovs
    t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
    FV ts   -> ((vfv .) # sequence) # mapM (value env) ts
    R as    -> do lovs <- mapPairsM (value env.snd) as
                  return $ \ vs->VRec $ mapSnd ($vs) lovs
    T i cs  -> valueTable env i cs
    V ty ts -> do pvs <- paramValues env ty
                  ((VV ty pvs .) . sequence) # mapM (value env) ts
    C t1 t2 -> ((ok2p vconcat.) # both id) # both (value env) (t1,t2)
    S t1 t2 -> ((select env.) # both id) # both (value env) (t1,t2)
    P t l   -> --maybe (bug $ "project "++show l++" from "++show v) id $
               do ov <- value env t
                  return $ \ vs -> let v = ov vs
                                   in maybe (VP v l) id (proj l v)
    Alts t tts -> (\v vts -> VAlts # v <# mapM (both id) vts) # value env t <# mapM (both (value env)) tts
    Strs ts    -> ((VStrs.) # sequence) # mapM (value env) ts
    Glue t1 t2 -> ((ok2p (glue env).) # both id) # both (value env) (t1,t2)
    ELin c r -> (unlockVRec (gloc env) c.) # value env r
    EPatt p  -> return $ const (VPatt p) -- hmm
    EPattType ty -> do vt <- value env ty
                       return (VPattType . vt)
    Typed t ty -> value env t
    t -> fail.render $ "value"<+>ppTerm Unqualified 10 t $$ show t
 vconcat vv@(v1,v2) =
    case vv of
      (VString "",_) -> v2
      (_,VString "") -> v1
      (VApp NonExist _,_) -> v1
      (_,VApp NonExist _) -> v2
      _ -> VC v1 v2
 proj l v | isLockLabel l = return (VRec [])
                ---- a workaround 18/2/2005: take this away and find the reason
                ---- why earlier compilation destroys the lock field
 proj l v =
    case v of
      VFV vs -> liftM vfv (mapM (proj l) vs)
      VRec rs -> lookup l rs
 --    VExtR v1 v2 -> proj l v2 `mplus` proj l v1 -- hmm
      VS (VV pty pvs rs) v2 -> flip VS v2 . VV pty pvs # mapM (proj l) rs
      _ -> return (ok1 VP v l)
 ok1 f v1@(VError {}) _ = v1
 ok1 f v1 v2 = f v1 v2
 ok2 f v1@(VError {}) _ = v1
 ok2 f _ v2@(VError {}) = v2
 ok2 f v1 v2 = f v1 v2
 ok2p f (v1@VError {},_) = v1
 ok2p f (_,v2@VError {}) = v2
 ok2p f vv = f vv
 unlockVRec loc c0 v0 = v0
 {-
 unlockVRec loc c0 v0 = unlockVRec' c0 v0
  where
    unlockVRec' ::Ident -> Value -> Value
    unlockVRec' c v =
        case v of
    --    VClosure env t -> err bug (VClosure env) (unlockRecord c t)
          VAbs bt x (Bind f) -> VAbs bt x (Bind $ \ v -> unlockVRec' c (f v))
          VRec rs        -> plusVRec rs lock
    --    _              -> VExtR v (VRec lock) -- hmm
          _              -> {-trace (render $ ppL loc $ "unlock non-record "++show v0)-} v -- hmm
    --    _              -> bugloc loc $ "unlock non-record "++show v0
      where
        lock = [(lockLabel c,VRec [])]
 -}
 -- suspicious, but backwards compatible
 plusVRec rs1 rs2 = VRec ([(l,v)|(l,v)<-rs1,l `notElem` ls2] ++ rs2)
  where ls2 = map fst rs2
 extR t vv =
    case vv of
      (VFV vs,v2) -> vfv [extR t (v1,v2)|v1<-vs]
      (v1,VFV vs) -> vfv [extR t (v1,v2)|v2<-vs]
      (VRecType rs1, VRecType rs2) ->
          case intersect (map fst rs1) (map fst rs2) of
            [] -> VRecType (rs1 ++ rs2)
            ls -> error $ "clash"<+>show ls
      (VRec     rs1, VRec     rs2) -> plusVRec rs1 rs2
      (v1          , VRec [(l,_)]) | isLockLabel l -> v1 -- hmm
      (VS (VV t pvs vs) s,v2) -> VS (VV t pvs [extR t (v1,v2)|v1<-vs]) s
 --    (v1,v2) -> ok2 VExtR v1 v2 -- hmm
      (v1,v2) -> error $ "not records" $$ show v1 $$ show v2
  where
    error explain = ppbug $ "The term" <+> t
                            <+> "is not reducible" $$ explain
 glue env (v1,v2) = glu v1 v2
  where
    glu v1 v2 =
        case (v1,v2) of
          (VFV vs,v2) -> vfv [glu v1 v2|v1<-vs]
          (v1,VFV vs) -> vfv [glu v1 v2|v2<-vs]
          (VString s1,VString s2) -> VString (s1++s2)
          (v1,VAlts d vs) -> VAlts (glx d) [(glx v,c) | (v,c) <- vs]
             where glx v2 = glu v1 v2
          (v1@(VAlts {}),v2) ->
           --err (const (ok2 VGlue v1 v2)) id $
             err bug id $
             do y' <- strsFromValue v2
                x' <- strsFromValue v1
                return $ vfv [foldr1 VC (map VString (str2strings (glueStr v u))) | v <- x', u <- y']
          (VC va vb,v2) -> VC va (glu vb v2)
          (v1,VC va vb) -> VC (glu v1 va) vb
          (VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb
          (v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb
          (v1@(VApp NonExist _),_) -> v1
          (_,v2@(VApp NonExist _)) -> v2
 --        (v1,v2) -> ok2 VGlue v1 v2
          (v1,v2) -> if flag optPlusAsBind (opts env)
                       then VC v1 (VC (VApp BIND []) v2)
                       else let loc  = gloc env
                                vt v = case value2term loc (local env) v of
                                         Left i  -> Error ('#':show i)
                                         Right t -> t
                            in error . render $
                                         ppL loc (hang "unsupported token gluing:" 4
                                                        (Glue (vt v1) (vt v2)))
 -- | to get a string from a value that represents a sequence of terminals
 strsFromValue :: Value -> Err [Str]
 strsFromValue t = case t of
  VString s   -> return [str s]
  VC s t -> do
    s' <- strsFromValue s
    t' <- strsFromValue t
    return [plusStr x y | x <- s', y <- t']
 {-
  VGlue s t -> do
    s' <- strsFromValue s
    t' <- strsFromValue t
    return [glueStr x y | x <- s', y <- t']
 -}
  VAlts d vs -> do
    d0 <- strsFromValue d
    v0 <- mapM (strsFromValue . fst) vs
    c0 <- mapM (strsFromValue . snd) vs
  --let vs' = zip v0 c0
    return [strTok (str2strings def) vars | 
              def  <- d0,
              vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
                                                          vv <- combinations v0]
           ]
  VFV ts -> concat # mapM strsFromValue ts
  VStrs ts -> concat # mapM strsFromValue ts
  _ -> fail ("cannot get Str from value " ++ show t)
 vfv vs = case nub vs of
           [v] -> v
           vs -> VFV vs
 select env vv =
    case vv of
      (v1,VFV vs) -> vfv [select env (v1,v2)|v2<-vs]
      (VFV vs,v2) -> vfv [select env (v1,v2)|v1<-vs]
      (v1@(VV pty vs rs),v2) ->
         err (const (VS v1 v2)) id $
         do --ats <- allParamValues (srcgr env) pty
            --let vs = map (value0 env) ats
            i <- maybeErr "no match" $ findIndex (==v2) vs
            return (ix (gloc env) "select" rs i)
      (VT _ _ [(PW,Bind b)],_) -> {-trace "eliminate wild card table" $-} b []
      (v1@(VT _ _ cs),v2) ->
                 err (\_->ok2 VS v1 v2) (err bug id . valueMatch env) $
                 match (gloc env) cs v2
      (VS (VV pty pvs rs) v12,v2) -> VS (VV pty pvs [select env (v11,v2)|v11<-rs]) v12
      (v1,v2) -> ok2 VS v1 v2
 match loc cs v = 
  case value2term loc [] v of
    Left i  -> bad ("variable #"++show i++" is out of scope")
    Right t -> err bad return (matchPattern cs t)
  where
    bad = fail . ("In pattern matching: "++)
 valueMatch :: CompleteEnv -> (Bind Env,Substitution) -> Err Value
 valueMatch env (Bind f,env') = f # mapPairsM (value0 env) env'
 valueTable :: CompleteEnv -> TInfo -> [Case] -> Err OpenValue
 valueTable env i cs =
    case i of
      TComp ty -> do pvs <- paramValues env ty
                     ((VV ty pvs .) # sequence) # mapM (value env.snd) cs
      _ -> do ty <- getTableType i
              cs' <- mapM valueCase cs
              err (dynamic cs' ty) return (convert cs' ty)
  where
    dynamic cs' ty _ = cases cs' # value env ty
    cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
      where
        keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
                   VT wild (vty vs) (mapSnd ($vs) cs')
    wild = case i of TWild _ -> True; _ -> False
    convertv cs' vty = 
      case value2term (gloc env) [] vty of
        Left i    -> fail ("variable #"++show i++" is out of scope")
        Right pty -> convert' cs' =<< paramValues'' env pty
    convert cs' ty = convert' cs' =<< paramValues' env ty
    convert' cs' ((pty,vs),pvs) =
      do sts  <- mapM (matchPattern cs') vs
         return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
                                           (mapFst ($vs) sts)
    valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
                         pvs <- linPattVars p'
                         vt <- value (extend pvs env) t
                         return (p',\vs-> Bind $ \bs-> vt (push' p' bs pvs vs))
    inlinePattMacro p =
        case p of
          PM qc -> do r <- resource env qc
                      case r of
                        VPatt p' -> inlinePattMacro p'
                        _ -> ppbug $ hang "Expected pattern macro:" 4
                                          (show r)
          _ -> composPattOp inlinePattMacro p
 paramValues env ty = snd # paramValues' env ty
 paramValues' env ty = paramValues'' env =<< nfx (global env) ty
 paramValues'' env pty = do ats <- allParamValues (srcgr env) pty
                           pvs <- mapM (eval (global env) []) ats
                           return ((pty,ats),pvs)
 push' p bs xs = if length bs/=length xs
                then bug $ "push "++show (p,bs,xs)
                else push bs xs
 push :: Env -> LocalScope -> Stack -> Stack
 push bs [] vs = vs
 push bs (x:xs) vs = maybe err id (lookup x bs):push bs xs vs
  where  err = bug $ "Unbound pattern variable "++showIdent x
 apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
 apply' env t [] = value env t
 apply' env t vs =
  case t of
    QC x                   -> return $ \ svs -> VCApp x (map ($svs) vs)
 {-
    Q x@(m,f) | m==cPredef -> return $
                              let constr = --trace ("predef "++show x) .
                                           VApp x 
                              in \ svs -> maybe constr id (Map.lookup f predefs)
                                          $ map ($svs) vs
              | otherwise  -> do r <- resource env x
                                 return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
 -}
    App t1 t2              -> apply' env t1 . (:vs) =<< value env t2
    _                      -> do fv <- value env t
                                 return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)
 vapply :: GLocation -> Value -> [Value] -> Value
 vapply loc v [] = v
 vapply loc v vs =
  case v of
    VError {} -> v
 --  VClosure env (Abs b x t) -> beta gr env b x t vs
    VAbs bt _ (Bind f) -> vbeta loc bt f vs
    VApp pre vs1 -> delta' pre (vs1++vs)
      where
        delta' Trace (v1:v2:vs) = let vr = vapply loc v2 vs
                                  in vtrace loc v1 vr
        delta' pre vs = err msg vfv $ mapM (delta pre) (varyList vs)
        --msg = const (VApp pre (vs1++vs))
        msg = bug . (("Applying Predef."++showIdent (predefName pre)++": ")++)
    VS (VV t pvs fs) s -> VS (VV t pvs [vapply loc f vs|f<-fs]) s
    VFV fs -> vfv [vapply loc f vs|f<-fs]
    VCApp f vs0 -> VCApp f (vs0++vs)
    VMeta i env vs0 -> VMeta i env (vs0++vs)
    VGen i vs0 -> VGen i (vs0++vs)
    v -> bug $ "vapply "++show v++" "++show vs
 vbeta loc bt f (v:vs) =
  case (bt,v) of
    (Implicit,VImplArg v) -> ap v
    (Explicit,         v) -> ap v
  where
    ap (VFV avs) = vfv [vapply loc (f v) vs|v<-avs]
    ap v         = vapply loc (f v) vs
 vary (VFV vs) = vs
 vary v = [v]
 varyList = mapM vary
 {-
 beta env b x t (v:vs) =
  case (b,v) of
    (Implicit,VImplArg v) -> apply' (ext (x,v) env) t vs
    (Explicit,         v) -> apply' (ext (x,v) env) t vs
 -}
 vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res
  where
    pv v = case v of
             VRec (f:as) -> hang (pf f) 4 (fsep (map pa as))
             _ -> ppV v
    pf (_,VString n) = pp n
    pf (_,v) = ppV v
    pa (_,v) = ppV v
    ppV v = case value2term' True loc [] v of
              Left i  -> "variable #" <> pp i <+> "is out of scope"
              Right t -> ppTerm Unqualified 10 t
 -- | Convert a value back to a term
 value2term :: GLocation -> [Ident] -> Value -> Either Int Term
 value2term = value2term' False
 value2term' stop loc xs v0 =
  case v0 of
    VApp pre vs    -> liftM (foldl App (Q (cPredef,predefName pre))) (mapM v2t vs)
    VCApp f vs     -> liftM  (foldl App (QC f))   (mapM v2t vs)
    VGen j vs      -> liftM2 (foldl App) (var j)  (mapM v2t vs)
    VMeta j env vs -> liftM  (foldl App (Meta j)) (mapM v2t vs)
    VProd bt v x f -> liftM2 (Prod bt x) (v2t v) (v2t' x f)
    VAbs  bt   x f -> liftM  (Abs  bt x)         (v2t' x f)
    VInt n         -> return (EInt n)
    VFloat f       -> return (EFloat f)
    VString s      -> return (if null s then Empty else K s)
    VSort s        -> return (Sort s)
    VImplArg v     -> liftM  ImplArg (v2t v)
    VTblType p res -> liftM2 Table (v2t p) (v2t res)
    VRecType rs    -> liftM  RecType (mapM (\(l,v) -> fmap ((,) l) (v2t v)) rs)
    VRec as        -> liftM  R       (mapM (\(l,v) -> v2t v >>= \t -> return (l,(Nothing,t))) as)
    VV t _ vs      -> liftM  (V t)   (mapM v2t vs)
    VT wild v cs   -> v2t v >>= \t -> liftM (T ((if wild then TWild else TTyped) t)) (mapM nfcase cs)
    VFV vs         -> liftM  FV (mapM v2t vs)
    VC v1 v2       -> liftM2 C (v2t v1) (v2t v2)
    VS v1 v2       -> liftM2 S (v2t v1) (v2t v2)
    VP v l         -> v2t v >>= \t -> return (P t l)
    VPatt p        -> return (EPatt p)
    VPattType v    -> v2t v >>= return . EPattType
    VAlts v vvs    -> liftM2 Alts (v2t v) (mapM (\(x,y) -> liftM2 (,) (v2t x) (v2t y)) vvs)
    VStrs vs       -> liftM  Strs (mapM v2t vs)
 --  VGlue v1 v2    -> Glue (v2t v1) (v2t v2)
 --  VExtR v1 v2    -> ExtR (v2t v1) (v2t v2)
    VError err     -> return (Error err)
    _              -> bug ("value2term "++show loc++" : "++show v0)
  where
    v2t = v2txs xs
    v2txs = value2term' stop loc
    v2t' x f = v2txs (x:xs) (bind f (gen xs))
    var j
      | j<length xs = Right (Vr (reverse xs !! j))
      | otherwise   = Left  j
    pushs xs e = foldr push e xs
    push x (env,xs) = ((x,gen xs):env,x:xs)
    gen xs = VGen (length xs) []
    nfcase (p,f) = liftM ((,) p) (v2txs xs' (bind f env'))
      where (env',xs') = pushs (pattVars p) ([],xs)
    bind (Bind f) x = if stop
                      then VSort (identS "...") -- hmm
                      else f x
 linPattVars p =
    if null dups
    then return pvs
    else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)
  where
    allpvs = allPattVars p
    pvs = nub allpvs
    dups = allpvs \\ pvs
 pattVars = nub . allPattVars
 allPattVars p =
    case p of
      PV i    -> [i]
      PAs i p -> i:allPattVars p
      _       -> collectPattOp allPattVars p
 ---
 ix loc fn xs i =
    if i<n
    then xs !! i
    else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
  where n = length xs
 infixl 1 #,<# --,@@
 f # x = fmap f x
 mf <# mx  = ap mf mx
 --m1 @@ m2 = (m1 =<<) . m2
 both f (x,y) = (,) # f x <# f y
 bugloc loc s = ppbug $ ppL loc s
 bug msg = ppbug msg
 ppbug doc = error $ render $ hang "Internal error in Compute.ConcreteNew:" 4 doc
--- a/src/compiler/GF/Compile/Compute/Predef.hs
+++ b/src/compiler/GF/Compile/Compute/Predef.hs
@@ -27,10 +27,6 @@ instance Predef Int where
 instance Predef Bool where
  toValue = boolV
  fromValue v = case v of
    VCApp (mn,i) [] | mn == cPredef && i == cPTrue -> return True
    VCApp (mn,i) [] | mn == cPredef && i == cPFalse -> return False
    _ -> verror "Bool" v
 instance Predef String where
  toValue = string
--- a/src/compiler/GF/Compile/Compute/Value.hs
+++ b/src/compiler/GF/Compile/Compute/Value.hs
@@ -12,8 +12,8 @@ data Value
  | VGen Int [Value] -- for lambda bound variables, possibly applied
  | VMeta MetaId Env [Value]
 -- -- | VClosure Env Term -- used in Typecheck.ConcreteNew
-  | VAbs BindType Ident Binding -- used in Compute.Concrete
+  | VAbs BindType Ident Binding -- used in Compute.ConcreteNew
-  | VProd BindType Value Ident Binding -- used in Compute.Concrete
+  | VProd BindType Value Ident Binding -- used in Compute.ConcreteNew
  | VInt Int
  | VFloat Double
  | VString String
--- 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
@@ -321,7 +321,7 @@ coerce env ty t =
      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 ParamId where toIdent (ParamId q) = qIdentS q
-instance ToIdent PredefId where toIdent (PredefId s) = identC s
+instance ToIdent PredefId where toIdent (PredefId s) = identS s
-instance ToIdent CatId   where toIdent (CatId s) = identC s
+instance ToIdent CatId   where toIdent (CatId s) = identS s
-instance ToIdent C.FunId where toIdent (FunId s) = identC s
+instance ToIdent C.FunId where toIdent (FunId s) = identS s
-instance ToIdent VarValueId where toIdent (VarValueId q) = qIdentC q
+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 (Qual (ModId m) n) = m++"_"++n
-unqual (Unqual n) = showRawIdent 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/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -25,7 +25,7 @@ import GF.Data.BacktrackM
 import GF.Data.Operations
 import GF.Infra.UseIO (ePutStr,ePutStrLn) -- IOE,
 import GF.Data.Utilities (updateNthM) --updateNth
-import GF.Compile.Compute.Concrete(normalForm,resourceValues)
+import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.List as List
@@ -41,7 +41,6 @@ import Control.Monad
 import Control.Monad.Identity
 --import Control.Exception
 --import Debug.Trace(trace)
 import qualified Control.Monad.Fail as Fail
 ----------------------------------------------------------------------
 -- main conversion function
@@ -197,15 +196,12 @@ newtype CnvMonad a = CM {unCM :: SourceGrammar
                              -> ([ProtoFCat],[Symbol])
                              -> Branch b}
 instance Fail.MonadFail CnvMonad where
  fail = bug
 instance Applicative CnvMonad where
-  pure a = CM (\gr c s -> c a s)
+  pure = return
  (<*>) = ap
 instance Monad CnvMonad where
-    return     = pure
+    return a   = CM (\gr c s -> c a s)
    CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)
 instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where
@@ -618,23 +614,6 @@ mkArray    lst = listArray (0,length lst-1) lst
 mkSetArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
 bug msg = ppbug msg
-ppbug msg = error completeMsg
+ppbug msg = error . render $ hang "Internal error in GeneratePMCFG:" 4 msg
 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
 ppU = ppTerm Unqualified
--- a/src/compiler/GF/Compile/GetGrammar.hs
+++ b/src/compiler/GF/Compile/GetGrammar.hs
@@ -42,12 +42,11 @@ getSourceModule opts file0 =
     raw <- liftIO $ keepTemp tmp
   --ePutStrLn $ "1 "++file0
     (optCoding,parsed) <- parseSource opts pModDef raw
     let indentLines = unlines . map ("   "++) . lines
     case parsed of
       Left (Pn l c,msg) -> do file <- liftIO $ writeTemp tmp
                               cwd <- getCurrentDirectory
                               let location = makeRelative cwd file++":"++show l++":"++show c
-                               raise (location++":\n" ++ indentLines msg)
+                               raise (location++":\n   "++msg)
       Right (i,mi0) ->
         do liftIO $ removeTemp tmp
            let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}
--- 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.Ident(ModuleName(..),Ident,prefixIdent,showIdent,isWildIdent)
-import GF.Infra.Option(Options,optionsPGF)
+import GF.Infra.Option(optionsPGF)
 import PGF.Internal(Literal(..))
-import GF.Compile.Compute.Concrete(GlobalEnv,normalForm,resourceValues)
+import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
 import GF.Grammar.Canonical as C
-import System.FilePath ((</>), (<.>))
+import Debug.Trace
 import qualified Debug.Trace as T
 -- | Generate Canonical code for the named abstract syntax and all associated
 -- concrete syntaxes
 grammar2canonical :: Options -> ModuleName -> G.Grammar -> C.Grammar
 grammar2canonical opts absname gr =
   Grammar (abstract2canonical absname gr)
           (map snd (concretes2canonical opts absname gr))
 -- | Generate Canonical code for the named abstract syntax
 abstract2canonical :: ModuleName -> G.Grammar -> Abstract
 abstract2canonical absname gr =
    Abstract (modId absname) (convFlags gr absname) cats funs
  where
@@ -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,24 +54,23 @@ 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]
+      [lincat|(_,Left lincat)<-defs]
-      [lin | (_,Right lin) <- defs]
+      [lin|(_,Right lin)<-defs]
  where
    defs = concatMap (toCanonical gr absname cenv) . 
           M.toList $
@@ -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 $
+        e' = unAbs (length params) $
             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)
+        Q (m,n) -> if m==cPredef then ppPredef n else VarValue ((gQId m n))
-        QC (m,n) -> ParamConstant (Param (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)
@@ -241,15 +215,14 @@ convert' gr vs = ppT
        alt (t,p) = (pre p,ppT0 t)
        pre (K s) = [s]
        pre Empty = [""]  -- Empty == K ""
        pre (Strs ts) = concatMap pre ts
        pre (EPatt p) = pat p
-        pre t = error $ "convert' alts pre: " ++ show t
+        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 +235,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 +242,21 @@ concatValue v1 v2 =
    _ -> ConcatValue v1 v2
 -- | Smart constructor for projections
-projection :: LinValue -> LabelId -> LinValue
+projection r l = maybe (Projection r l) id (proj r l)
 projection r l = fromMaybe (Projection r l) (proj r l)
 proj :: LinValue -> LabelId -> Maybe LinValue
 proj r l =
  case r of
-    RecordValue r -> case [v | RecordRow l' v <- r, l'==l] of
+    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 +275,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 +293,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 +314,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))
+        QC (m,n) -> ParamType (ParamTypeId ((gQId m n)))
-        Q (m,n) -> ParamType (ParamTypeId (gQId m n))
+        Q (m,n) -> ParamType (ParamTypeId ((gQId m n)))
-        _ -> error $ "convType ppT: " ++ show t
+        _ -> 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 +325,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 +341,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 +349,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]
-lblId :: Label -> C.LabelId
+lblId = LabelId . render -- hmm
-lblId (LIdent ri) = LabelId ri
+modId (MN m) = ModId (showIdent m)
 lblId (LVar i) = LabelId (rawIdentS (show i)) -- hmm
-modId :: ModuleName -> C.ModId
+class FromIdent i where gId :: Ident -> i
 modId (MN m) = ModId (ident2raw m)
 class FromIdent i where
  gId :: Ident -> i
 instance FromIdent VarId where
-  gId i = if isWildIdent i then Anonymous else VarId (ident2raw i)
+  gId i = if isWildIdent i then Anonymous else VarId (showIdent i)
-instance FromIdent C.FunId where gId = C.FunId . ident2raw
+instance FromIdent C.FunId where gId = C.FunId . showIdent
-instance FromIdent CatId where gId = CatId . ident2raw
+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
+class FromIdent i => QualIdent i where gQId :: ModuleName -> Ident -> i
  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) (showIdent n)
-qual m n = Qual (modId m) (ident2raw 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,4 +1,4 @@
-{-# LANGUAGE BangPatterns, FlexibleContexts #-}
+{-# LANGUAGE BangPatterns, FlexibleContexts, MagicHash #-}
 module GF.Compile.GrammarToPGF (mkCanon2pgf) where
 --import GF.Compile.Export
@@ -8,13 +8,16 @@ import GF.Compile.GenerateBC
 import PGF(CId,mkCId,utf8CId)
 import PGF.Internal(fidInt,fidFloat,fidString,fidVar)
 import PGF.Internal(updateProductionIndices)
 --import qualified PGF.Macros as CM
 import qualified PGF.Internal as C
 import qualified PGF.Internal as D
 import GF.Grammar.Predef
 --import GF.Grammar.Printer
 import GF.Grammar.Grammar
 import qualified GF.Grammar.Lookup as Look
 import qualified GF.Grammar as A
 import qualified GF.Grammar.Macros as GM
 --import GF.Compile.GeneratePMCFG
 import GF.Infra.Ident
 import GF.Infra.Option
@@ -27,6 +30,9 @@ import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Data.Array.IArray
 import Data.Char
 import GHC.Prim
 import GHC.Base(getTag)
 mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE D.PGF
 mkCanon2pgf opts gr am = do
@@ -59,7 +65,7 @@ mkCanon2pgf opts gr am = do
    mkConcr cm = do
      let cflags = err (const noOptions) mflags (lookupModule gr cm)
          ciCmp | flag optCaseSensitive cflags = compare
-                | otherwise                    = C.compareCaseInsensitve
+                | otherwise                    = compareCaseInsensitve
      (ex_seqs,cdefs) <- addMissingPMCFGs
                            Map.empty 
@@ -68,7 +74,7 @@ mkCanon2pgf opts gr am = do
      let flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF cflags]
-          seqs = (mkArray . C.sortNubBy ciCmp . concat) $
+          seqs = (mkArray . 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
@@ -306,3 +312,119 @@ 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]
 -- 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.
 compareCaseInsensitve s1 s2 =
    compareSeq (elems s1) (elems s2)
    where
      compareSeq []     []     = EQ
      compareSeq []     _      = LT
      compareSeq _      []     = GT
      compareSeq (x:xs) (y:ys) =
        case compareSym x y of
          EQ -> compareSeq xs ys
          x  -> x
      compareSym s1 s2 =
        case s1 of
          D.SymCat d1 r1
            -> case s2 of
                 D.SymCat d2 r2
                   -> case compare d1 d2 of
                        EQ -> r1 `compare` r2
                        x  -> x
                 _ -> LT
          D.SymLit d1 r1
            -> case s2 of
                 D.SymCat {} -> GT
                 D.SymLit d2 r2
                   -> case compare d1 d2 of
                        EQ -> r1 `compare` r2
                        x  -> x
                 _ -> LT
          D.SymVar d1 r1
            -> if tagToEnum# (getTag s2 ># 2#)
                 then LT
                 else case s2 of
                        D.SymVar d2 r2
                          -> case compare d1 d2 of
                               EQ -> r1 `compare` r2
                               x  -> x
                        _ -> GT
          D.SymKS t1
            -> if tagToEnum# (getTag s2 ># 3#)
                 then LT
                 else case s2 of
                        D.SymKS t2 -> t1 `compareToken` t2
                        _          -> GT
          D.SymKP a1 b1
            -> if tagToEnum# (getTag s2 ># 4#)
                 then LT
                 else case s2 of
                        D.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/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -21,16 +21,23 @@ import GF.Grammar.Printer
 import GF.Grammar.Macros
 import GF.Grammar.Lookup
 import GF.Grammar.Predef
-import GF.Compile.Compute.Concrete(GlobalEnv,normalForm,resourceValues)
+--import GF.Compile.Refresh
 --import GF.Compile.Compute.Concrete
 import GF.Compile.Compute.ConcreteNew(GlobalEnv,normalForm,resourceValues)
 --import GF.Compile.CheckGrammar
 --import GF.Compile.Update
 import GF.Data.Operations
 --import GF.Infra.CheckM
 import GF.Infra.Option
 import Control.Monad
 --import Data.List
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Debug.Trace
 -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
 optimizeModule :: Options -> SourceGrammar -> SourceModule -> Err SourceModule
@@ -47,7 +54,7 @@ optimizeModule opts sgr m@(name,mi)
   updateEvalInfo mi (i,info) = do
     info <- evalInfo oopts resenv sgr (name,mi) i info
-     return (mi{jments=Map.insert i info (jments mi)})
+     return (mi{jments=updateTree (i,info) (jments mi)})
 evalInfo :: Options -> GlobalEnv -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
 evalInfo opts resenv sgr m c info = do
--- a/src/compiler/GF/Compile/PGFtoHaskell.hs
+++ b/src/compiler/GF/Compile/PGFtoHaskell.hs
@@ -22,11 +22,10 @@ import PGF.Internal
 import GF.Data.Operations
 import GF.Infra.Option
-import Data.List(isPrefixOf,find,intercalate,intersperse,groupBy,sortBy)
+import Data.List --(isPrefixOf, find, intersperse)
 import qualified Data.Map as Map
 type Prefix = String -> String
 type DerivingClause = String
 -- | the main function
 grammar2haskell :: Options
@@ -34,40 +33,30 @@ grammar2haskell :: Options
                -> PGF
                -> String
 grammar2haskell opts name gr = foldr (++++) [] $  
-  pragmas ++ haskPreamble gadt name derivingClause (extraImports ++ pgfImports) ++
+  pragmas ++ haskPreamble gadt name ++ [types, gfinstances gId lexical gr'] ++ compos
  [types, gfinstances gId lexical gr'] ++ compos
    where gr' = hSkeleton gr
          gadt = haskellOption opts HaskellGADT
          dataExt = haskellOption opts HaskellData
          pgf2 = haskellOption opts HaskellPGF2
          lexical cat = haskellOption opts HaskellLexical && isLexicalCat opts cat
-          gId | haskellOption opts HaskellNoPrefix = rmForbiddenChars
+          gId | haskellOption opts HaskellNoPrefix = id
-              | otherwise = ("G"++) . rmForbiddenChars
+              | otherwise = ("G"++)
-          -- GF grammars allow weird identifier names inside '', e.g. 'VP/Object'
+          pragmas | gadt = ["{-# OPTIONS_GHC -fglasgow-exts #-}","{-# LANGUAGE GADTs #-}"]
          rmForbiddenChars = filter (`notElem` "'!#$%&*+./<=>?@\\^|-~")
          pragmas | gadt = ["{-# LANGUAGE GADTs, FlexibleInstances, KindSignatures, RankNTypes, TypeSynonymInstances #-}"]
                  | dataExt = ["{-# LANGUAGE DeriveDataTypeable #-}"]
                  | otherwise = []
          derivingClause
                 | dataExt = "deriving (Show,Data)"
                 | otherwise = "deriving Show"
          extraImports | gadt = ["import Control.Monad.Identity", "import Control.Monad", "import Data.Monoid"]
                       | dataExt = ["import Data.Data"]
                       | otherwise = []
          pgfImports | pgf2 = ["import PGF2 hiding (Tree)", "", "showCId :: CId -> String", "showCId = id"]
                     | otherwise = ["import PGF hiding (Tree)"]
          types | gadt = datatypesGADT gId lexical gr'
-                | otherwise = datatypes gId derivingClause lexical gr'
+                | otherwise = datatypes gId lexical gr'
          compos | gadt = prCompos gId lexical gr' ++ composClass
                 | otherwise = []
-haskPreamble :: Bool -> String -> String -> [String] -> [String]
+haskPreamble gadt name =
 haskPreamble gadt name derivingClause imports =
 [
  "module " ++ name ++ " where",
  ""
- ] ++ imports ++ [
+ ] ++
-  "",
+ (if gadt then [
  "import Control.Monad.Identity",
  "import Data.Monoid"
  ] else []) ++
 [
  "import PGF hiding (Tree)",
  "----------------------------------------------------",
  "-- automatic translation from GF to Haskell",
  "----------------------------------------------------",
@@ -76,11 +65,11 @@ haskPreamble gadt name derivingClause imports =
  "  gf :: a -> Expr",
  "  fg :: Expr -> a",
  "",
-  predefInst gadt derivingClause "GString" "String"  "unStr"    "mkStr",
+  predefInst gadt "GString" "String"  "unStr"    "mkStr",
  "",
-  predefInst gadt derivingClause "GInt"    "Int"     "unInt"    "mkInt",
+  predefInst gadt "GInt"    "Int"     "unInt"    "mkInt",
  "",
-  predefInst gadt derivingClause "GFloat"  "Double"  "unFloat"  "mkFloat",
+  predefInst gadt "GFloat"  "Double"  "unFloat"  "mkFloat",
  "",
  "----------------------------------------------------",
  "-- below this line machine-generated",
@@ -88,11 +77,10 @@ haskPreamble gadt name derivingClause imports =
  ""
 ]
-predefInst :: Bool -> String -> String -> String -> String -> String -> String
+predefInst gadt gtyp typ destr consr = 
 predefInst gadt derivingClause gtyp typ destr consr =
  (if gadt
    then [] 
-    else "newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ derivingClause ++ "\n\n"
+    else ("newtype" +++ gtyp +++ "=" +++ gtyp +++ typ +++ " deriving Show\n\n") 
    ) 
  ++
  "instance Gf" +++ gtyp +++ "where" ++++
@@ -106,24 +94,24 @@ type OIdent = String
 type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
-datatypes :: Prefix -> DerivingClause -> (OIdent -> Bool) -> (String,HSkeleton) -> String
+datatypes :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String
-datatypes gId derivingClause lexical = foldr (+++++) "" . filter (/="") . map (hDatatype gId derivingClause lexical) . snd
+datatypes gId lexical = (foldr (+++++) "") . (filter (/="")) . (map (hDatatype gId lexical)) . snd
 gfinstances :: Prefix -> (OIdent -> Bool) -> (String,HSkeleton) -> String
-gfinstances gId lexical (m,g) = foldr (+++++) "" $ filter (/="") $ map (gfInstance gId lexical m) g
+gfinstances gId lexical (m,g) = (foldr (+++++) "") $ (filter (/="")) $ (map (gfInstance gId lexical m)) g
-hDatatype  :: Prefix -> DerivingClause -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String
+hDatatype  :: Prefix -> (OIdent -> Bool) -> (OIdent, [(OIdent, [OIdent])]) -> String
-hDatatype _ _ _ ("Cn",_) = "" ---
+hDatatype _ _ ("Cn",_) = "" ---
-hDatatype gId _ _ (cat,[]) = "data" +++ gId cat
+hDatatype gId _ (cat,[]) = "data" +++ gId cat
-hDatatype gId derivingClause _ (cat,rules) | isListCat (cat,rules) =
+hDatatype gId _ (cat,rules) | isListCat (cat,rules) = 
 "newtype" +++ gId cat +++ "=" +++ gId cat +++ "[" ++ gId (elemCat cat) ++ "]" 
-  +++ derivingClause
+  +++ "deriving Show"
-hDatatype gId derivingClause lexical (cat,rules) =
+hDatatype gId lexical (cat,rules) =
 "data" +++ gId cat +++ "=" ++
 (if length rules == 1 then "" else "\n  ") +++
 foldr1 (\x y -> x ++ "\n |" +++ y) constructors ++++
- " " +++ derivingClause
+ "  deriving Show"
  where
    constructors = [gId f +++ foldr (+++) "" (map (gId) xx) | (f,xx) <- nonLexicalRules (lexical cat) rules]
                   ++ if lexical cat then [lexicalConstructor cat +++ "String"] else []
@@ -135,7 +123,6 @@ nonLexicalRules True rules = [r | r@(f,t) <- rules, not (null t)]
 lexicalConstructor :: OIdent -> String
 lexicalConstructor cat = "Lex" ++ cat
 predefTypeSkel :: HSkeleton
 predefTypeSkel = [(c,[]) | c <- ["String", "Int", "Float"]]
 -- GADT version of data types
@@ -208,12 +195,11 @@ prCompos gId lexical (_,catrules) =
    prRec f (v,c) 
      | isList f  = "`a` foldr (a . a (r (:)) . f) (r [])" +++ v
      | otherwise = "`a`" +++ "f" +++ v
-    isList f = gId "List" `isPrefixOf` f
+    isList f = (gId "List") `isPrefixOf` f
 gfInstance :: Prefix -> (OIdent -> Bool) -> String -> (OIdent, [(OIdent, [OIdent])]) -> String
 gfInstance gId lexical m crs = hInstance gId lexical m crs ++++ fInstance gId lexical m crs
 hInstance :: (String -> String) -> (String -> Bool) -> String -> (String, [(OIdent, [OIdent])]) -> String
 ----hInstance m ("Cn",_) = "" --- seems to belong to an old applic. AR 18/5/2004
 hInstance gId _ m (cat,[]) = unlines [
  "instance Show" +++ gId cat,
@@ -225,7 +211,7 @@ hInstance gId _ m (cat,[]) = unlines [
 hInstance gId lexical m (cat,rules) 
 | isListCat (cat,rules) =
  "instance Gf" +++ gId cat +++ "where" ++++
-     "  gf (" ++ gId cat +++ "[" ++ intercalate "," baseVars ++ "])"
+     "  gf (" ++ gId cat +++ "[" ++ concat (intersperse "," baseVars) ++ "])" 
           +++ "=" +++ mkRHS ("Base"++ec) baseVars ++++
     "  gf (" ++ gId cat +++ "(x:xs)) = " 
           ++ mkRHS ("Cons"++ec) ["x",prParenth (gId cat+++"xs")] 
@@ -239,15 +225,12 @@ hInstance gId lexical m (cat,rules)
   ec = elemCat cat
   baseVars = mkVars (baseSize (cat,rules))
   mkInst f xx = let xx' = mkVars (length xx) in "  gf " ++
-     (if null xx then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
+     (if length xx == 0 then gId f else prParenth (gId f +++ foldr1 (+++) xx')) +++
     "=" +++ mkRHS f xx'
   mkRHS f vars = "mkApp (mkCId \"" ++ f ++ "\")" +++ 
-       "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
+		   "[" ++ prTList ", " ["gf" +++ x | x <- vars] ++ "]"
 mkVars :: Int -> [String]
 mkVars = mkSVars "x"
 mkSVars :: String -> Int -> [String]
 mkSVars s n = [s ++ show i | i <- [1..n]]
 ----fInstance m ("Cn",_) = "" ---
@@ -266,16 +249,15 @@ fInstance gId lexical m (cat,rules) =
     "      Just (i," ++
     "[" ++ prTList "," xx' ++ "])" +++
     "| i == mkCId \"" ++ f ++ "\" ->" +++ mkRHS f xx'
-       where
+       where xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
-         xx' = ["x" ++ show i | (_,i) <- zip xx [1..]]
+	     mkRHS f vars 
-         mkRHS f vars
+		 | isList =
-           | isList =
+		     if "Base" `isPrefixOf` f 
-               if "Base" `isPrefixOf` f
+                       then "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"
-                             then "[" ++ prTList ", " [ "fg" +++ x | x <- vars ] ++ "]"
+		       else "fg" +++ (vars !! 0) +++ ":" +++ "fgs" +++ (vars !! 1)
-                 else "fg" +++ (vars !! 0) +++ ":" +++ "fgs" +++ (vars !! 1)
+		 | otherwise = 
-           | otherwise =
+		     gId f +++  
-               gId f +++
+		     prTList " " [prParenth ("fg" +++ x) | x <- vars]
               prTList " " [prParenth ("fg" +++ x) | x <- vars]
 --type HSkeleton = [(OIdent, [(OIdent, [OIdent])])]
 hSkeleton :: PGF -> (String,HSkeleton)
@@ -284,7 +266,7 @@ hSkeleton gr =
   let fs = 
         [(showCId c, [(showCId f, map showCId cs) | (f, (cs,_)) <- fs]) | 
                                        fs@((_, (_,c)):_) <- fns]
-   in fs ++ [(sc, []) | c <- cts, let sc = showCId c, sc `notElem` (["Int", "Float", "String"] ++ map fst fs)]
+   in fs ++ [(sc, []) | c <- cts, let sc = showCId c, notElem sc (["Int", "Float", "String"] ++ map fst fs)]
  )
 where
   cts = Map.keys (cats (abstract gr)) 
@@ -301,10 +283,9 @@ updateSkeleton cat skel rule =
 -}
 isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool
 isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
-        && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
+		    && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
-    where
+    where c = elemCat cat
-      c = elemCat cat
+	  fs = map fst rules
      fs = map fst rules
 -- | Gets the element category of a list category.
 elemCat :: OIdent -> OIdent
@@ -348,3 +329,4 @@ composClass =
     "",
     "newtype C b a = C { unC :: b }"
    ]
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -23,25 +23,23 @@
 -----------------------------------------------------------------------------
 module GF.Compile.Rename (
-     renameSourceTerm,
+	       renameSourceTerm,
-     renameModule
+	       renameModule
-    ) where
+	      ) where
 import GF.Infra.Ident
 import GF.Infra.CheckM
 import GF.Grammar.Grammar
 import GF.Grammar.Values
 import GF.Grammar.Predef
-import GF.Grammar.Lookup
+import GF.Infra.Ident
 import GF.Infra.CheckM
 import GF.Grammar.Macros
 import GF.Grammar.Printer
 --import GF.Grammar.Lookup
 --import GF.Grammar.Printer
 import GF.Data.Operations
 import Control.Monad
 import Data.List (nub,(\\))
 import qualified Data.List as L
 import qualified Data.Map as Map
 import Data.Maybe(mapMaybe)
 import GF.Text.Pretty
 -- | this gives top-level access to renaming term input in the cc command
@@ -57,9 +55,9 @@ renameModule cwd gr mo@(m,mi) = do
  js     <- checkMapRecover (renameInfo cwd status mo) (jments mi)
  return (m, mi{jments = js})
-type Status = (StatusMap, [(OpenSpec, StatusMap)])
+type Status = (StatusTree, [(OpenSpec, StatusTree)])
-type StatusMap = Map.Map Ident StatusInfo
+type StatusTree = BinTree Ident StatusInfo
 type StatusInfo = Ident -> Term
@@ -75,12 +73,12 @@ renameIdentTerm' env@(act,imps) t0 =
    Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
    Q (m',c) -> do
      m <- lookupErr m' qualifs
-      f <- lookupIdent c m
+      f <- lookupTree showIdent c m
      return $ f c
    QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
    QC (m',c) -> do
      m <- lookupErr m' qualifs
-      f <- lookupIdent c m
+      f <- lookupTree showIdent c m
      return $ f c
    _ -> return t0
  where
@@ -95,40 +93,30 @@ renameIdentTerm' env@(act,imps) t0 =
      | otherwise     = checkError s
    ident alt c = 
-      case Map.lookup c act of
+      case lookupTree showIdent c act of
-        Just f -> return (f c)
+        Ok f -> return (f c)
-        _      -> case mapMaybe (Map.lookup c) opens of
+        _    -> case lookupTreeManyAll showIdent opens c of
-                    [f]  -> return (f c)
+                  [f]  -> return (f c)
-                    []   -> alt c ("constant not found:" <+> c $$
+                  []   -> alt c ("constant not found:" <+> c $$
-                                   "given" <+> fsep (punctuate ',' (map fst qualifs)))
+                                 "given" <+> fsep (punctuate ',' (map fst qualifs)))
-                    fs   -> case nub [f c | f <- fs]  of
+                  fs   -> case nub [f c | f <- fs]  of
-                              [tr]     -> return tr
+                            [tr]     -> return tr
-                              ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
+{-
-                                                        "conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
+                            ts       -> return $ AdHocOverload ts  
-                                                        "given" <+> fsep (punctuate ',' (map fst qualifs)))
+                                        -- name conflicts resolved as overloading in TypeCheck.RConcrete AR 31/1/2014
-                                             return (bestTerm ts) -- Heuristic for resource grammar. Returns t for all others.
+                                        -- the old definition is below and still presupposed in TypeCheck.Concrete
-       where
+-}
-        -- Hotfix for https://github.com/GrammaticalFramework/gf-core/issues/56
+                            ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
-        -- Real bug is probably somewhere deeper in recognising excluded functions. /IL 2020-06-06
+                                                      "conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
-        notFromCommonModule :: Term -> Bool
+                                                      "given" <+> fsep (punctuate ',' (map fst qualifs)))
-        notFromCommonModule term =
+                                           return t
          let t = render $ ppTerm Qualified 0 term :: String
           in not $ any (\moduleName -> moduleName `L.isPrefixOf` t)
                        ["CommonX", "ConstructX", "ExtendFunctor"
                        ,"MarkHTMLX", "ParamX", "TenseX", "TextX"]
-        -- If one of the terms comes from the common modules,
+            -- a warning will be generated in CheckGrammar, and the head returned
-        -- we choose the other one, because that's defined in the grammar.
+            -- in next V: 
-        bestTerm :: [Term] -> Term
+            -- Bad $ "conflicting imports:" +++ unwords (map prt ts) 
        bestTerm [] = error "constant not found" -- not reached: bestTerm is only called for case ts@(t:_)
        bestTerm ts@(t:_) =
          let notCommon = [t | t <- ts, notFromCommonModule t]
           in case notCommon of
                []    -> t -- All terms are from common modules, return first of original list
                (u:_) -> u -- ≥1 terms are not from common modules, return first of those
-info2status :: Maybe ModuleName -> Ident -> Info -> StatusInfo
+info2status :: Maybe ModuleName -> (Ident,Info) -> StatusInfo
-info2status mq c i = case i of
+info2status mq (c,i) = case i of
  AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
  ResValue _  -> maybe Con (curry QC) mq
  ResParam _ _  -> maybe Con (curry QC) mq
@@ -136,10 +124,10 @@ info2status mq c i = case i of
  AnyInd False m -> maybe Cn (const (curry Q m)) mq
  _           -> maybe Cn (curry Q) mq
-tree2status :: OpenSpec -> Map.Map Ident Info -> StatusMap
+tree2status :: OpenSpec -> BinTree Ident Info -> BinTree Ident StatusInfo
 tree2status o = case o of
-  OSimple i   -> Map.mapWithKey (info2status (Just i))
+  OSimple i   -> mapTree (info2status (Just i))
-  OQualif i j -> Map.mapWithKey (info2status (Just j))
+  OQualif i j -> mapTree (info2status (Just j))
 buildStatus :: FilePath -> Grammar -> Module -> Check Status
 buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
@@ -148,14 +136,14 @@ buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
  ops <- mapM (\o -> lookupModule gr1 (openedModule o) >>= \mi -> return (o,mi)) (mopens mi)
  let sts = map modInfo2status (exts++ops)
  return (if isModCnc mi
-            then (Map.empty,       reverse sts)  -- the module itself does not define any names
+            then (emptyBinTree,    reverse sts)  -- the module itself does not define any names
            else (self2status m mi,reverse sts)) -- so the empty ident is not needed
-modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusMap)
+modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusTree)
 modInfo2status (o,mo) = (o,tree2status o (jments mo))
-self2status :: ModuleName -> ModuleInfo -> StatusMap
+self2status :: ModuleName -> ModuleInfo -> StatusTree
-self2status c m = Map.mapWithKey (info2status (Just c)) (jments m)
+self2status c m = mapTree (info2status (Just c)) (jments m)
 renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info
@@ -256,7 +244,7 @@ renamePattern :: Status -> Patt -> Check (Patt,[Ident])
 renamePattern env patt =
    do r@(p',vs) <- renp patt
       let dupl = vs \\ nub vs
-       unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear. All variable names on the left-hand side must be distinct.") 4
+       unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4
                                             patt)
       return r
  where
--- a/src/compiler/GF/Compile/TypeCheck/Abstract.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Abstract.hs
@@ -13,11 +13,11 @@
 -----------------------------------------------------------------------------
 module GF.Compile.TypeCheck.Abstract (-- * top-level type checking functions; TC should not be called directly.
-    checkContext,
+		  checkContext,
-    checkTyp,
+		  checkTyp,
-    checkDef,
+		  checkDef,
-    checkConstrs,
+		  checkConstrs,
-   ) where
+		 ) where
 import GF.Data.Operations
--- a/src/compiler/GF/Compile/TypeCheck/Concrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/Concrete.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE PatternGuards #-}
-module GF.Compile.TypeCheck.Concrete( checkLType, inferLType, computeLType, ppType ) where
+module GF.Compile.TypeCheck.Concrete( {-checkLType, inferLType, computeLType, ppType-} ) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+{-
 import GF.Infra.CheckM
 import GF.Data.Operations
@@ -23,16 +22,10 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
    _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed
      | isPredefConstant ty     -> return ty ---- shouldn't be needed
-    Q (m,ident) -> checkIn ("module" <+> m) $ do
+    Q (m,ident) -> checkIn (text "module" <+> ppIdent m) $ do
      ty' <- lookupResDef gr (m,ident)
      if ty' == ty then return ty else comp g ty' --- is this necessary to test?
    AdHocOverload ts -> do
     over <- getOverload gr g (Just typeType) t
     case over of
       Just (tr,_) -> return tr
       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t)
    Vr ident  -> checkLookup ident g -- never needed to compute!
    App f a -> do
@@ -69,6 +62,7 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
      lockRecType c t' ---- locking to be removed AR 20/6/2009
    _ | ty == typeTok -> return typeStr
    _ | isPredefConstant ty -> return ty
    _ -> composOp (comp g) ty
@@ -79,26 +73,26 @@ inferLType gr g trm = case trm of
   Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                Just ty -> return ty
-                                                Nothing -> checkError ("unknown in Predef:" <+> ident)
+                                                Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
   Q ident -> checks [
     termWith trm $ lookupResType gr ident >>= computeLType gr g
     ,
     lookupResDef gr ident >>= inferLType gr g
     ,
-     checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
+     checkError (text "cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
     ]
   QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                 Just ty -> return ty
-                                                 Nothing -> checkError ("unknown in Predef:" <+> ident)
+                                                 Nothing -> checkError (text "unknown in Predef:" <+> ppIdent ident)
   QC ident -> checks [
       termWith trm $ lookupResType gr ident >>= computeLType gr g
       ,
       lookupResDef gr ident >>= inferLType gr g
       ,
-       checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
+       checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
       ]
   Vr ident -> termWith trm $ checkLookup ident g
@@ -106,12 +100,7 @@ inferLType gr g trm = case trm of
   Typed e t -> do
     t' <- computeLType gr g t
     checkLType gr g e t'
-
+     return (e,t')
   AdHocOverload ts -> do
     over <- getOverload gr g Nothing trm
     case over of
       Just trty -> return trty
       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
   App f a -> do
     over <- getOverload gr g Nothing trm
@@ -127,11 +116,7 @@ inferLType gr g trm = case trm of
                      then return val
                      else substituteLType [(bt,z,a')] val
             return (App f' a',ty) 
-           _ ->
+           _ -> checkError (text "A function type is expected for" <+> ppTerm Unqualified 0 f <+> text "instead of type" <+> ppType fty)
             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")
   S f x -> do
     (f', fty) <- inferLType gr g f
@@ -139,7 +124,7 @@ inferLType gr g trm = case trm of
       Table arg val -> do
         x'<- justCheck g x arg
         return (S f' x', val)
-       _ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
+       _ -> checkError (text "table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
   P t i -> do
     (t',ty) <- inferLType gr g t   --- ??
@@ -147,16 +132,16 @@ inferLType gr g trm = case trm of
     let tr2 = P t' i
     termWith tr2 $ case ty' of
       RecType ts -> case lookup i ts of
-                       Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
+                       Nothing -> checkError (text "unknown label" <+> ppLabel i <+> text "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
                       Just x  -> return x
-       _          -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
+       _          -> checkError (text "record type expected for:" <+> ppTerm Unqualified 0 t $$
-                                 " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
+                                 text " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
   R r -> do
     let (ls,fs) = unzip r
     fsts <- mapM inferM fs
     let ts = [ty | (Just ty,_) <- fsts]
-     checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
+     checkCond (text "cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
     return $ (R (zip ls fsts), RecType (zip ls ts))
   T (TTyped arg) pts -> do
@@ -168,7 +153,7 @@ inferLType gr g trm = case trm of
   T ti pts -> do  -- tries to guess: good in oper type inference
     let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
     case pts' of 
-       [] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
+       [] -> checkError (text "cannot infer table type of" <+> ppTerm Unqualified 0 trm)
 ----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
       _  -> do 
         (arg,val) <- checks $ map (inferCase Nothing) pts'
@@ -202,7 +187,7 @@ inferLType gr g trm = case trm of
 ---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
   Strs (Cn c : ts) | c == cConflict -> do
-     checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
+     checkWarn (text "unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
     inferLType gr g (head ts)
   Strs ts -> do
@@ -223,25 +208,19 @@ inferLType gr g trm = case trm of
     return (RecType (zip ls ts'), typeType)
   ExtR r s -> do
-
+     (r',rT) <- inferLType gr g r 
 ---     over <- getOverload gr g Nothing r
 ---     let r1 = maybe r fst over
     let r1 = r ---
     (r',rT) <- inferLType gr g r1
     rT'     <- computeLType gr g rT
     (s',sT) <- inferLType gr g s
     sT'     <- computeLType gr g sT
     let trm' = ExtR r' s'
     ---- trm'    <- plusRecord r' s'
     case (rT', sT') of
       (RecType rs, RecType ss) -> do
-         let rt = RecType ([field | field@(l,_) <- rs, notElem l (map fst ss)] ++ ss) -- select types of later fields
+         rt <- plusRecType rT' sT'
         checkLType gr g trm' rt ---- return (trm', rt)
-       _ | rT' == typeType && sT' == typeType -> do
+       _ | rT' == typeType && sT' == typeType -> return (trm', typeType)
-         return (trm', typeType)
+       _ -> checkError (text "records or record types expected in" <+> ppTerm Unqualified 0 trm)
       _ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
   Sort _     -> 
     termWith trm $ return typeType
@@ -273,7 +252,7 @@ inferLType gr g trm = case trm of
     ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
     return $ (ELin c trm', ty') 
-   _ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
+   _ -> checkError (text "cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
 where
   isPredef m = elem m [cPredef,cPredefAbs]
@@ -320,6 +299,7 @@ inferLType gr g trm = case trm of
     PChars _ -> return $ typeStr
     _ -> inferLType gr g (patt2term p) >>= return . snd
 -- type inference: Nothing, type checking: Just t
 -- the latter permits matching with value type
 getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))
@@ -330,21 +310,8 @@ getOverload gr g mt ot = case appForm ot of
         v <- matchOverload f typs ttys
         return $ Just v
       _ -> return Nothing
     (AdHocOverload cs@(f:_), ts) -> do     --- the function name f is only used in error messages
       let typs = concatMap collectOverloads cs
       ttys <- mapM (inferLType gr g) ts
       v <- matchOverload f typs ttys
       return $ Just v
     _ -> return Nothing
 where
   collectOverloads tr@(Q c) = case lookupOverload gr c of
     Ok typs -> typs
     _ -> case lookupResType gr c of
       Ok ty -> let (args,val) = typeFormCnc ty in [(map (\(b,x,t) -> t) args,(val,tr))]
       _ -> []
   collectOverloads _ = [] --- constructors QC
   matchOverload f typs ttys = do
     let (tts,tys) = unzip ttys
     let vfs = lookupOverloadInstance tys typs
@@ -362,26 +329,25 @@ getOverload gr g mt ot = case appForm ot of
     case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of
       ([(_,val,fun)],_) -> return (mkApp fun tts, val)
       ([],[(pre,val,fun)]) -> do
-         checkWarn $  "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
+         checkWarn $  text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
-                      "for" $$
+                      text "for" $$
                      nest 2 (showTypes tys) $$
-                      "using" $$
+                      text "using" $$
                      nest 2 (showTypes pre)
         return (mkApp fun tts, val)
       ([],[]) -> do
-         checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
+         checkError $ text "no overload instance of" <+> ppTerm Unqualified 0 f $$
-                      maybe empty (\x -> "with value type" <+> ppType x) mt $$
+                      text "for" $$
                      "for argument list" $$
                      nest 2 stysError $$
-                      "among alternatives" $$
+                      text "among" $$
-                      nest 2 (vcat stypsError)
+                      nest 2 (vcat stypsError) $$
-
+                      maybe empty (\x -> text "with value type" <+> ppType x) mt
       (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
         ([(val,fun)],_) -> do
           return (mkApp fun tts, val)
         ([],[(val,fun)]) -> do
-           checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot)
+           checkWarn (text "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) 
           return (mkApp fun tts, val)
 ----- unsafely exclude irritating warning AR 24/5/2008
@@ -389,22 +355,16 @@ getOverload gr g mt ot = case appForm ot of
 -----             "resolved by excluding partial applications:" ++++
 -----             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
--- now forgiving ambiguity with a warning AR 1/2/2014
+
--  This gives ad hoc overloading the same behaviour as the choice of the first match in renaming did before.
+         _ -> checkError $ text "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
--  But it also gives a chance to ambiguous overloadings that were banned before.
+                           text "for" <+> hsep (map ppType tys) $$ 
-         (nps1,nps2) -> do
+                           text "with alternatives" $$
-              checkWarn $  "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
+                           nest 2 (vcat [ppType ty | (_,ty,_) <- if null vfs1 then vfs2 else vfs2])
                  ----     "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$
                           "resolved by selecting the first of the alternatives" $$
                           nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
              case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of
                 [] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f
                 h:_ -> return h
   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
@@ -425,6 +385,7 @@ getOverload gr g mt ot = case appForm ot of
 checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)
 checkLType gr g trm typ0 = do
  typ <- computeLType gr g typ0
  case trm of
@@ -434,12 +395,10 @@ checkLType gr g trm typ0 = do
        Prod bt' z a b -> do 
          (c',b') <- if isWildIdent z
                       then checkLType gr ((bt,x,a):g) c b
-                       else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
+                       else do b' <- checkIn (text "abs") $ substituteLType [(bt',z,Vr x)] b
                               checkLType gr ((bt,x,a):g) c b'
-          return $ (Abs bt x c', Prod bt' z a b')
+          return $ (Abs bt x c', Prod bt' x a b')
-        _ -> checkError $ "function type expected instead of" <+> ppType typ $$
+        _ -> checkError $ text "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"
    App f a -> do
       over <- getOverload gr g (Just typ) trm
@@ -449,12 +408,6 @@ checkLType gr g trm typ0 = do
          (trm',ty') <- inferLType gr g trm
          termWith trm' $ checkEqLType gr g typ ty' trm'
    AdHocOverload ts -> do
      over <- getOverload gr g Nothing trm
      case over of
        Just trty -> return trty
        _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
    Q _ -> do
       over <- getOverload gr g (Just typ) trm
       case over of
@@ -464,7 +417,7 @@ checkLType gr g trm typ0 = do
          termWith trm' $ checkEqLType gr g typ ty' trm'
    T _ [] ->
-      checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
+      checkError (text "found empty table in type" <+> ppTerm Unqualified 0 typ)
    T _ cs -> case typ of 
      Table arg val -> do 
        case allParamValues gr arg of
@@ -473,12 +426,12 @@ checkLType gr g trm typ0 = do
            ps <- testOvershadow ps0 vs
            if null ps 
              then return () 
-              else checkWarn ("patterns never reached:" $$
+              else checkWarn (text "patterns never reached:" $$
                              nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
          _ -> return () -- happens with variable types
        cs' <- mapM (checkCase arg val) cs
        return (T (TTyped arg) cs', typ)
-      _ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
+      _ -> checkError $ text "table type expected for table instead of" $$ nest 2 (ppType typ)
    V arg0 vs ->
      case typ of
        Table arg1 val ->
@@ -486,54 +439,51 @@ checkLType gr g trm typ0 = do
              vs1 <- allParamValues gr arg1
              if length vs1 == length vs
                 then return ()
-                 else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm
+                 else checkError $ text "wrong number of values in table" <+> ppTerm Unqualified 0 trm
              vs' <- map fst `fmap` sequence [checkLType gr g v val|v<-vs]
              return (V arg' vs',typ)
    R r -> case typ of --- why needed? because inference may be too difficult
       RecType rr -> do
-       --let (ls,_) = unzip rr        -- labels of expected type
+         let (ls,_) = unzip rr        -- labels of expected type
         fsts <- mapM (checkM r) rr   -- check that they are found in the record
         return $ (R fsts, typ)       -- normalize record
-       _ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
+       _ -> checkError (text "record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
    ExtR r s -> case typ of
       _ | typ == typeType -> do
         trm' <- computeLType gr g trm
         case trm' of
-           RecType _ -> termWith trm' $ return typeType
+           RecType _ -> termWith trm $ return typeType
-           ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType
+           ExtR (Vr _) (RecType _) -> termWith trm $ return typeType 
                                      -- ext t = t ** ...
-           _ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
+           _ -> checkError (text "invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
       RecType rr -> do
         (r',ty,s') <- checks [
            do (r',ty) <- inferLType gr g r
               return (r',ty,s)
           ,
            do (s',ty) <- inferLType gr g s
               return (s',ty,r)
           ]
-         ll2 <- case s of
+         case ty of
-           R ss -> return $ map fst ss
+           RecType rr1 -> do
-           _ -> do
+                let (rr0,rr2) = recParts rr rr1
-             (s',typ2) <- inferLType gr g s
+                r2 <- justCheck g r' rr0
-             case typ2 of
+                s2 <- justCheck g s' rr2
-               RecType ss -> return $ map fst ss
+                return $ (ExtR r2 s2, typ) 
-               _ ->  checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
+           _ -> checkError (text "record type expected in extension of" <+> ppTerm Unqualified 0 r $$
-         let ll1 = [l | (l,_) <- rr, notElem l ll2]
+                            text "but found" <+> ppTerm Unqualified 0 ty)
 ---         over <- getOverload gr g Nothing r --- this would solve #66 but fail ParadigmsAra. AR 6/7/2020
 ---         let r1 = maybe r fst over
         let r1 = r ---
         (r',_) <- checkLType gr g r1 (RecType [field | field@(l,_) <- rr, elem l ll1])
         (s',_) <- checkLType gr g s  (RecType [field | field@(l,_) <- rr, elem l ll2])
         let rec = R ([(l,(Nothing,P r' l)) | l <- ll1] ++ [(l,(Nothing,P s' l)) | l <- ll2])
         return (rec, typ)
       ExtR ty ex -> do
         r' <- justCheck g r ty
         s' <- justCheck g s ex
         return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ
-       _ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
+       _ -> checkError (text "record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
    FV vs -> do
      ttys <- mapM (flip (checkLType gr g) typ) vs
@@ -548,7 +498,7 @@ checkLType gr g trm typ0 = do
          (arg',val) <- checkLType gr g arg p
          checkEqLType gr g typ t trm
          return (S tab' arg', t)
-        _ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
+        _ -> checkError (text "table type expected for applied table instead of" <+> ppType ty')
     , do
      (arg',ty) <- inferLType gr g arg
      ty'       <- computeLType gr g ty
@@ -557,8 +507,7 @@ checkLType gr g trm typ0 = do
      ]
    Let (x,(mty,def)) body -> case mty of
      Just ty -> do
-        (ty0,_)    <- checkLType gr g ty typeType
+        (def',ty') <- checkLType gr g def ty
        (def',ty') <- checkLType gr g def ty0
        body' <- justCheck ((Explicit,x,ty'):g) body typ
        return (Let (x,(Just ty',def')) body', typ)
      _ -> do
@@ -574,10 +523,10 @@ checkLType gr g trm typ0 = do
      termWith trm' $ checkEqLType gr g typ ty' trm'
 where
   justCheck g ty te = checkLType gr g ty te >>= return . fst
-{-
+
   recParts rr t = (RecType rr1,RecType rr2) where 
     (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
-}
+
   checkM rms (l,ty) = case lookup l rms of
     Just (Just ty0,t) -> do
       checkEqLType gr g ty ty0 t
@@ -589,9 +538,9 @@ checkLType gr g trm typ0 = do
     _ -> checkError $ 
            if isLockLabel l 
              then let cat = drop 5 (showIdent (label2ident l))
-                   in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <>
+                   in ppTerm Unqualified 0 (R rms) <+> text "is not in the lincat of" <+> text cat <> 
-                      "; try wrapping it with lin" <+> cat
+                      text "; try wrapping it with lin" <+> text cat
-              else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
+              else text "cannot find value for label" <+> ppLabel l <+> text "in" <+> ppTerm Unqualified 0 (R rms)
   checkCase arg val (p,t) = do
     cont <- pattContext gr g arg p
@@ -604,7 +553,7 @@ pattContext env g typ p = case p of
  PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
    t <- lookupResType env (q,c)
    let (cont,v) = typeFormCnc t
-    checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p)
+    checkCond (text "wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) 
              (length cont == length ps)
    checkEqLType env g typ v (patt2term p)
    mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat
@@ -615,7 +564,7 @@ pattContext env g typ p = case p of
        let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
        ----- checkWarn $ prt p ++++ show pts ----- debug
        mapM (uncurry (pattContext env g)) pts >>= return . concat
-      _ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
+      _ -> checkError (text "record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
  PT t p' -> do
    checkEqLType env g typ t (patt2term p')
    pattContext env g typ p'
@@ -629,9 +578,9 @@ pattContext env g typ p = case p of
    g2 <- pattContext env g typ q
    let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
    checkCond 
-      ("incompatible bindings of" <+>
+      (text "incompatible bindings of" <+>
-       fsep pts <+>
+       fsep (map ppIdent pts) <+> 
-       "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts)
+       text "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) 
    return g1 -- must be g1 == g2
  PSeq p q -> do
    g1 <- pattContext env g typ p
@@ -645,7 +594,7 @@ pattContext env g typ p = case p of
   noBind typ p' = do
    co <- pattContext env g typ p'
    if not (null co)
-      then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p)
+      then checkWarn (text "no variable bound inside pattern" <+> ppPatt Unqualified 0 p) 
           >> return []
      else return []
@@ -654,31 +603,9 @@ checkEqLType gr g t u trm = do
  (b,t',u',s) <- checkIfEqLType gr g t u trm
  case b of
    True  -> return t'
-    False ->
+    False -> checkError $ text s <+> text "type of" <+> ppTerm Unqualified 0 trm $$
-      let inferredType = ppTerm Qualified 0 u
+                          text "expected:" <+> ppType t $$
-          expectedType = ppTerm Qualified 0 t
+                          text "inferred:" <+> ppType u
          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
 checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
 checkIfEqLType gr g t u trm = do
@@ -690,13 +617,13 @@ checkIfEqLType gr g t u trm = do
    --- better: use a flag to forgive? (AR 31/1/2006)
    _ -> case missingLock [] t' u' of
      Ok lo -> do
-        checkWarn $ "missing lock field" <+> fsep lo
+        checkWarn $ text "missing lock field" <+> fsep (map ppLabel lo)
        return (True,t',u',[])
      Bad s -> return (False,t',u',s)
  where
-   -- check that u is a subtype of t
+   -- t is a subtype of u 
   --- quick hack version of TC.eqVal
   alpha g t u = case (t,u) of  
@@ -708,13 +635,12 @@ checkIfEqLType gr g t u trm = do
     -- record subtyping
     (RecType rs, RecType ts) -> all (\ (l,a) -> 
-                                   any (\ (k,b) -> l == k && alpha g a b) ts) rs
+                                   any (\ (k,b) -> alpha g a b && l == k) ts) rs
     (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
     (ExtR r s, t) -> alpha g r t || alpha g s t
     -- the following say that Ints n is a subset of Int and of Ints m >= n
-     -- But why does it also allow Int as a subtype of Ints m? /TH 2014-04-04
+     (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts t -> m >= n
     (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts u -> m >= n
           | Just _ <- isTypeInts t, u == typeInt           -> True ---- check size!
           | t == typeInt,           Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005
@@ -729,8 +655,7 @@ checkIfEqLType gr g t u trm = do
     (Q  (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) 
                                   || elem n (allExtendsPlus gr m)
-     -- contravariance
+     (Table a b,  Table c d)  -> alpha g a c && alpha g b d
     (Table a b,  Table c d)  -> alpha g c a && alpha g b d
     (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
     _                        -> t == u 
     --- the following should be one-way coercions only. AR 4/1/2001
@@ -745,7 +670,7 @@ checkIfEqLType gr g t u trm = do
                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
         (locks,others) = partition isLockLabel ls
       in case others of
-         _:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
+         _:_ -> Bad $ render (text "missing record fields:" <+> fsep (punctuate comma (map ppLabel others)))
         _ -> return locks
     -- contravariance
     (Prod _ x a b, Prod _ y c d) -> do
@@ -783,18 +708,14 @@ ppType :: Type -> Doc
 ppType ty =
  case ty of
    RecType fs   -> case filter isLockLabel $ map fst fs of
-                      [lock] -> pp (drop 5 (showIdent (label2ident lock)))
+                      [lock] -> text (drop 5 (showIdent (label2ident lock)))
                      _      -> ppTerm Unqualified 0 ty
-    Prod _ x a b -> ppType a <+> "->" <+> ppType b
+    Prod _ x a b -> ppType a <+> text "->" <+> ppType b
    _            -> ppTerm Unqualified 0 ty
-{-
+
 ppqType :: Type -> Type -> Doc
 ppqType t u = case (ppType t, ppType u) of
  (pt,pu) | render pt == render pu -> ppTerm Qualified 0 t
  (pt,_) -> pt
 -}
 checkLookup :: Ident -> Context -> Check Type
 checkLookup x g =
  case [ty | (b,y,ty) <- g, x == y] of
-    []     -> checkError ("unknown variable" <+> x)
+    []     -> checkError (text "unknown variable" <+> ppIdent x)
    (ty:_) -> return ty
 -}
--- 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:
@@ -10,7 +9,7 @@ import GF.Grammar hiding (Env, VGen, VApp, VRecType)
 import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Grammar.Lockfield
-import GF.Compile.Compute.Concrete
+import GF.Compile.Compute.ConcreteNew
 import GF.Compile.Compute.Predef(predef,predefName)
 import GF.Infra.CheckM
 import GF.Data.Operations
@@ -20,7 +19,6 @@ import GF.Text.Pretty
 import Data.List (nub, (\\), tails)
 import qualified Data.IntMap as IntMap
 import Data.Maybe(fromMaybe,isNothing)
 import qualified Control.Monad.Fail as Fail
 checkLType :: GlobalEnv -> Term -> Type -> Check (Term, Type)
 checkLType ge t ty = runTcM $ do
@@ -396,7 +394,7 @@ tcRecTypeFields ge scope ((l,ty):rs) mb_ty = do
  return ((l,ty):rs,mb_ty)
 -- | Invariant: if the third argument is (Just rho),
--              then rho is in weak-prenex form
+-- 	            then rho is in weak-prenex form
 instSigma :: GlobalEnv -> Scope -> Term -> Sigma -> Maybe Rho -> TcM (Term, Rho)
 instSigma ge scope t ty1 Nothing    = return (t,ty1)           -- INST1
 instSigma ge scope t ty1 (Just ty2) = do                       -- INST2
@@ -568,9 +566,9 @@ unifyVar ge scope i env vs ty2 = do            -- Check whether i is bound
    Bound ty1       -> do v <- liftErr (eval ge env ty1)
                          unify ge scope (vapply (geLoc ge) v vs) ty2
    Unbound scope' _ -> case value2term (geLoc ge) (scopeVars scope') ty2 of
-                          -- Left i     -> let (v,_) = reverse scope !! i
+                          Left i     -> let (v,_) = reverse scope !! i
-                          --               in tcError ("Variable" <+> pp v <+> "has escaped")
+                                        in tcError ("Variable" <+> pp v <+> "has escaped")
-                                ty2' -> do ms2 <- getMetaVars (geLoc ge) [(scope,ty2)]
+                          Right ty2' -> do ms2 <- getMetaVars (geLoc ge) [(scope,ty2)]
                                           if i `elem` ms2
                                             then tcError ("Occurs check for" <+> ppMeta i <+> "in:" $$
                                                           nest 2 (ppTerm Unqualified 0 ty2'))
@@ -631,8 +629,8 @@ allBinders = [ identS [x]          | x <- ['a'..'z'] ] ++
 type Scope = [(Ident,Value)]
 type Sigma = Value
-type Rho   = Value -- No top-level ForAll
+type Rho   = Value	-- No top-level ForAll
-type Tau   = Value -- No ForAlls anywhere
+type Tau   = Value	-- No ForAlls anywhere
 data MetaValue
  = Unbound Scope Sigma
@@ -644,22 +642,14 @@ data TcResult a
 newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}
 instance Monad TcM where
-  return = pure
+  return x = TcM (\ms msgs -> TcOk x ms msgs)
  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 x = TcM (\ms msgs -> TcOk x ms msgs)
+  pure = return
  (<*>) = ap
 instance Functor TcM where
@@ -724,8 +714,8 @@ getMetaVars loc sc_tys = do
    go (Vr tv)    acc = acc 
    go (App x y)  acc = go x (go y acc)
    go (Meta i)   acc
-      | i `elem` acc  = acc
+	  | i `elem` acc  = acc
-      | otherwise     = i : acc
+	  | otherwise	  = i : acc
    go (Q _)      acc = acc
    go (QC _)     acc = acc
    go (Sort _)   acc = acc
@@ -742,9 +732,9 @@ getFreeVars loc sc_tys = do
  return (foldr (go []) [] tys)
  where
    go bound (Vr tv)            acc 
-      | tv `elem` bound             = acc
+	  | tv `elem` bound             = acc
-      | tv `elem` acc               = acc
+	  | tv `elem` acc               = acc
-      | otherwise                   = tv : acc
+	  | otherwise                   = tv : acc
    go bound (App x y)          acc = go bound x (go bound y acc)
    go bound (Meta _)           acc = acc
    go bound (Q _)              acc = acc
@@ -765,9 +755,9 @@ zonkTerm (Meta i) = do
 zonkTerm t = composOp zonkTerm t
 tc_value2term loc xs v =
-  return $ value2term loc xs v
+  case value2term loc xs v of
-    -- Old value2term error message:
+    Left i  -> tcError ("Variable #" <+> pp i <+> "has escaped")
-    -- Left i  -> tcError ("Variable #" <+> pp i <+> "has escaped")
+    Right t -> return t
--- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
+++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs
@@ -0,0 +1,762 @@
 {-# 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
 import GF.Grammar
 import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Grammar.PatternMatch
 import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)
 import GF.Compile.TypeCheck.Primitives
 import Data.List
 import Control.Monad
 import GF.Text.Pretty
 computeLType :: SourceGrammar -> Context -> Type -> Check Type
 computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
 where
  comp g ty = case ty of
    _ | Just _ <- isTypeInts ty -> return ty ---- shouldn't be needed
      | isPredefConstant ty     -> return ty ---- shouldn't be needed
    Q (m,ident) -> checkIn ("module" <+> m) $ do
      ty' <- lookupResDef gr (m,ident)
      if ty' == ty then return ty else comp g ty' --- is this necessary to test?
    AdHocOverload ts -> do
     over <- getOverload gr g (Just typeType) t
     case over of
       Just (tr,_) -> return tr
       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t) 
    Vr ident  -> checkLookup ident g -- never needed to compute!
    App f a -> do
      f' <- comp g f
      a' <- comp g a
      case f' of
        Abs b x t -> comp ((b,x,a'):g) t
        _ -> return $ App f' a'
    Prod bt x a b -> do
      a' <- comp g a
      b' <- comp ((bt,x,Vr x) : g) b
      return $ Prod bt x a' b'
    Abs bt x b -> do
      b' <- comp ((bt,x,Vr x):g) b
      return $ Abs bt x b'
    Let (x,(_,a)) b -> comp ((Explicit,x,a):g) b
    ExtR r s -> do
      r' <- comp g r
      s' <- comp g s
      case (r',s') of
        (RecType rs, RecType ss) -> plusRecType r' s' >>= comp g
        _ -> return $ ExtR r' s'
    RecType fs -> do
      let fs' = sortRec fs
      liftM RecType $ mapPairsM (comp g) fs'
    ELincat c t -> do
      t' <- comp g t
      lockRecType c t' ---- locking to be removed AR 20/6/2009
    _ | ty == typeTok -> return typeStr
    _ | isPredefConstant ty -> return ty
    _ -> composOp (comp g) ty
 -- the underlying algorithms
 inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)
 inferLType gr g trm = case trm of
   Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                Just ty -> return ty
                                                Nothing -> checkError ("unknown in Predef:" <+> ident)
   Q ident -> checks [
     termWith trm $ lookupResType gr ident >>= computeLType gr g
     ,
     lookupResDef gr ident >>= inferLType gr g
     ,
     checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
     ]
   QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
                                                 Just ty -> return ty
                                                 Nothing -> checkError ("unknown in Predef:" <+> ident)
   QC ident -> checks [
       termWith trm $ lookupResType gr ident >>= computeLType gr g
       ,
       lookupResDef gr ident >>= inferLType gr g
       ,
       checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
       ]
   Vr ident -> termWith trm $ checkLookup ident g
   Typed e t -> do
     t' <- computeLType gr g t
     checkLType gr g e t'
   AdHocOverload ts -> do
     over <- getOverload gr g Nothing trm
     case over of
       Just trty -> return trty
       _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
   App f a -> do
     over <- getOverload gr g Nothing trm
     case over of
       Just trty -> return trty
       _ -> do
         (f',fty) <- inferLType gr g f
         fty' <- computeLType gr g fty
         case fty' of
           Prod bt z arg val -> do 
             a' <- justCheck g a arg
             ty <- if isWildIdent z 
                      then return val
                      else substituteLType [(bt,z,a')] val
             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
     case fty of
       Table arg val -> do
         x'<- justCheck g x arg
         return (S f' x', val)
       _ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
   P t i -> do
     (t',ty) <- inferLType gr g t   --- ??
     ty' <- computeLType gr g ty
     let tr2 = P t' i
     termWith tr2 $ case ty' of
       RecType ts -> case lookup i ts of
                       Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
                       Just x  -> return x
       _          -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
                                 " instead of the inferred:" <+> ppTerm Unqualified 0 ty')
   R r -> do
     let (ls,fs) = unzip r
     fsts <- mapM inferM fs
     let ts = [ty | (Just ty,_) <- fsts]
     checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
     return $ (R (zip ls fsts), RecType (zip ls ts))
   T (TTyped arg) pts -> do
     (_,val) <- checks $ map (inferCase (Just arg)) pts
     checkLType gr g trm (Table arg val)
   T (TComp arg) pts -> do
     (_,val) <- checks $ map (inferCase (Just arg)) pts
     checkLType gr g trm (Table arg val)
   T ti pts -> do  -- tries to guess: good in oper type inference
     let pts' = [pt | pt@(p,_) <- pts, isConstPatt p]
     case pts' of 
       [] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
 ----       PInt k : _ -> return $ Ints $ max [i | PInt i <- pts'] 
       _  -> do 
         (arg,val) <- checks $ map (inferCase Nothing) pts'
         checkLType gr g trm (Table arg val)
   V arg pts -> do
     (_,val) <- checks $ map (inferLType gr g) pts
 --   return (trm, Table arg val) -- old, caused issue 68
     checkLType gr g trm (Table arg val)
   K s  -> do
     if elem ' ' s
        then do
          let ss = foldr C Empty (map K (words s))  
          ----- removed irritating warning AR 24/5/2008
          ----- checkWarn ("token \"" ++ s ++ 
          -----              "\" converted to token list" ++ prt ss)
          return (ss, typeStr)
        else return (trm, typeStr)
   EInt i -> return (trm, typeInt)
   EFloat i -> return (trm, typeFloat)
   Empty -> return (trm, typeStr)
   C s1 s2 -> 
     check2 (flip (justCheck g) typeStr) C s1 s2 typeStr
   Glue s1 s2 -> 
     check2 (flip (justCheck g) typeStr) Glue s1 s2 typeStr ---- typeTok
 ---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
   Strs (Cn c : ts) | c == cConflict -> do
     checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
     inferLType gr g (head ts)
   Strs ts -> do
     ts' <- mapM (\t -> justCheck g t typeStr) ts 
     return (Strs ts', typeStrs)
   Alts t aa -> do
     t'  <- justCheck g t typeStr
     aa' <- flip mapM aa (\ (c,v) -> do
        c' <- justCheck g c typeStr 
        v' <- checks $ map (justCheck g v) [typeStrs, EPattType typeStr]
        return (c',v'))
     return (Alts t' aa', typeStr)
   RecType r -> do
     let (ls,ts) = unzip r
     ts' <- mapM (flip (justCheck g) typeType) ts 
     return (RecType (zip ls ts'), typeType)
   ExtR r s -> do
     (r',rT) <- inferLType gr g r 
     rT'     <- computeLType gr g rT
     (s',sT) <- inferLType gr g s
     sT'     <- computeLType gr g sT
     let trm' = ExtR r' s'
     case (rT', sT') of
       (RecType rs, RecType ss) -> do
         let rt = RecType ([field | field@(l,_) <- rs, notElem l (map fst ss)] ++ ss) -- select types of later fields 
         checkLType gr g trm' rt ---- return (trm', rt)
       _ | rT' == typeType && sT' == typeType -> do
         return (trm', typeType)
       _ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
   Sort _     -> 
     termWith trm $ return typeType
   Prod bt x a b -> do
     a' <- justCheck g a typeType
     b' <- justCheck ((bt,x,a'):g) b typeType
     return (Prod bt x a' b', typeType)
   Table p t  -> do
     p' <- justCheck g p typeType --- check p partype! 
     t' <- justCheck g t typeType
     return $ (Table p' t', typeType)
   FV vs -> do
     (_,ty) <- checks $ map (inferLType gr g) vs
 ---     checkIfComplexVariantType trm ty
     checkLType gr g trm ty
   EPattType ty -> do
     ty' <- justCheck g ty typeType
     return (EPattType ty',typeType)
   EPatt p -> do
     ty <- inferPatt p
     return (trm, EPattType ty)
   ELin c trm -> do
     (trm',ty) <- inferLType gr g trm
     ty' <- lockRecType c ty ---- lookup c; remove lock AR 20/6/2009
     return $ (ELin c trm', ty') 
   _ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
 where
   isPredef m = elem m [cPredef,cPredefAbs]
   justCheck g ty te = checkLType gr g ty te >>= return . fst
   -- for record fields, which may be typed
   inferM (mty, t) = do
     (t', ty') <- case mty of
       Just ty -> checkLType gr g t ty
       _ -> inferLType gr g t
     return (Just ty',t')
   inferCase mty (patt,term) = do
     arg  <- maybe (inferPatt patt) return mty
     cont <- pattContext gr g arg patt
     (_,val) <- inferLType gr (reverse cont ++ g) term
     return (arg,val)
   isConstPatt p = case p of
     PC _ ps -> True --- all isConstPatt ps
     PP _ ps -> True --- all isConstPatt ps
     PR ps -> all (isConstPatt . snd) ps
     PT _ p -> isConstPatt p
     PString _ -> True
     PInt _ -> True
     PFloat _ -> True
     PChar -> True
     PChars _ -> True
     PSeq p q -> isConstPatt p && isConstPatt q
     PAlt p q -> isConstPatt p && isConstPatt q
     PRep p -> isConstPatt p
     PNeg p -> isConstPatt p
     PAs _ p -> isConstPatt p
     _ -> False
   inferPatt p = case p of
     PP (q,c) ps | q /= cPredef -> liftM valTypeCnc (lookupResType gr (q,c))
     PAs _ p  -> inferPatt p
     PNeg p   -> inferPatt p
     PAlt p q -> checks [inferPatt p, inferPatt q]
     PSeq _ _ -> return $ typeStr
     PRep _   -> return $ typeStr
     PChar    -> return $ typeStr
     PChars _ -> return $ typeStr
     _ -> inferLType gr g (patt2term p) >>= return . snd
 -- type inference: Nothing, type checking: Just t
 -- the latter permits matching with value type
 getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))
 getOverload gr g mt ot = case appForm ot of
     (f@(Q c), ts) -> case lookupOverload gr c of
       Ok typs -> do
         ttys <- mapM (inferLType gr g) ts
         v <- matchOverload f typs ttys
         return $ Just v
       _ -> return Nothing
     (AdHocOverload cs@(f:_), ts) -> do     --- the function name f is only used in error messages
       let typs = concatMap collectOverloads cs
       ttys <- mapM (inferLType gr g) ts
       v <- matchOverload f typs ttys
       return $ Just v
     _ -> return Nothing
 where
   collectOverloads tr@(Q c) = case lookupOverload gr c of 
     Ok typs -> typs
     _ -> case lookupResType gr c of
       Ok ty -> let (args,val) = typeFormCnc ty in [(map (\(b,x,t) -> t) args,(val,tr))]
       _ -> []
   collectOverloads _ = [] --- constructors QC
   matchOverload f typs ttys = do
     let (tts,tys) = unzip ttys
     let vfs = lookupOverloadInstance tys typs
     let matches = [vf | vf@((_,v,_),_) <- vfs, matchVal mt v]
     let showTypes ty = hsep (map ppType ty)
     let (stys,styps) = (showTypes tys, [showTypes ty | (ty,_) <- typs])
     -- to avoid strange error msg e.g. in case of unmatch record extension, show whole types if needed AR 28/1/2013
     let (stysError,stypsError) = if elem (render stys) (map render styps)
            then (hsep (map (ppTerm Unqualified 0) tys), [hsep (map (ppTerm Unqualified 0) ty) | (ty,_) <- typs])
            else (stys,styps)
     case ([vf | (vf,True) <- matches],[vf | (vf,False) <- matches]) of
       ([(_,val,fun)],_) -> return (mkApp fun tts, val)
       ([],[(pre,val,fun)]) -> do
         checkWarn $  "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
                      "for" $$
                      nest 2 (showTypes tys) $$
                      "using" $$
                      nest 2 (showTypes pre)
         return (mkApp fun tts, val)
       ([],[]) -> do
         checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
                      maybe empty (\x -> "with value type" <+> ppType x) mt $$
                      "for argument list" $$
                      nest 2 stysError $$
                      "among alternatives" $$
                      nest 2 (vcat stypsError) 
       (vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
         ([(val,fun)],_) -> do
           return (mkApp fun tts, val)
         ([],[(val,fun)]) -> do
           checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot) 
           return (mkApp fun tts, val)
 ----- unsafely exclude irritating warning AR 24/5/2008
 -----           checkWarn $ "overloading of" +++ prt f +++ 
 -----             "resolved by excluding partial applications:" ++++
 -----             unlines [prtType env ty | (ty,_) <- vfs', not (noProd ty)]
 --- now forgiving ambiguity with a warning AR 1/2/2014
 --  This gives ad hoc overloading the same behaviour as the choice of the first match in renaming did before. 
 --  But it also gives a chance to ambiguous overloadings that were banned before. 
         (nps1,nps2) -> do 
              checkWarn $  "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
                  ----     "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$ 
                           "resolved by selecting the first of the alternatives" $$
                           nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
              case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of
                 [] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f
                 h:_ -> return h
   matchVal mt v = elem mt [Nothing,Just v,Just (unlocked v)]
   unlocked v = case v of
     RecType fs -> RecType $ filter (not . isLockLabel . fst) fs
     _ -> v
   ---- TODO: accept subtypes
   ---- TODO: use a trie
   lookupOverloadInstance tys typs = 
     [((pre,mkFunType rest val, t),isExact) | 
       let lt = length tys,
       (ty,(val,t)) <- typs, length ty >= lt,
       let (pre,rest) = splitAt lt ty, 
       let isExact = pre == tys,
       isExact || map unlocked pre == map unlocked tys
     ]
   noProds vfs = [(v,f) | (_,v,f) <- vfs, noProd v]
   noProd ty = case ty of
     Prod _ _ _ _ -> False
     _ -> True
 checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)
 checkLType gr g trm typ0 = do
  typ <- computeLType gr g typ0
  case trm of
    Abs bt x c -> do
      case typ of
        Prod bt' z a b -> do 
          (c',b') <- if isWildIdent z
                       then checkLType gr ((bt,x,a):g) c b
                       else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
                               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
    App f a -> do
       over <- getOverload gr g (Just typ) trm
       case over of
         Just trty -> return trty
         _ -> do
          (trm',ty') <- inferLType gr g trm
          termWith trm' $ checkEqLType gr g typ ty' trm'
    AdHocOverload ts -> do
      over <- getOverload gr g Nothing trm
      case over of
        Just trty -> return trty
        _ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm) 
    Q _ -> do
       over <- getOverload gr g (Just typ) trm
       case over of
         Just trty -> return trty
         _ -> do
          (trm',ty') <- inferLType gr g trm
          termWith trm' $ checkEqLType gr g typ ty' trm'
    T _ [] ->
      checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
    T _ cs -> case typ of 
      Table arg val -> do 
        case allParamValues gr arg of
          Ok vs -> do
            let ps0 = map fst cs
            ps <- testOvershadow ps0 vs
            if null ps 
              then return () 
              else checkWarn ("patterns never reached:" $$
                              nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
          _ -> return () -- happens with variable types
        cs' <- mapM (checkCase arg val) cs
        return (T (TTyped arg) cs', typ)
      _ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
    V arg0 vs ->
      case typ of
        Table arg1 val ->
           do arg' <- checkEqLType gr g arg0 arg1 trm
              vs1 <- allParamValues gr arg1
              if length vs1 == length vs
                 then return ()
                 else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm
              vs' <- map fst `fmap` sequence [checkLType gr g v val|v<-vs]
              return (V arg' vs',typ)
    R r -> case typ of --- why needed? because inference may be too difficult
       RecType rr -> do
       --let (ls,_) = unzip rr        -- labels of expected type
         fsts <- mapM (checkM r) rr   -- check that they are found in the record
         return $ (R fsts, typ)       -- normalize record
       _ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
    ExtR r s -> case typ of
       _ | typ == typeType -> do
         trm' <- computeLType gr g trm
         case trm' of
           RecType _ -> termWith trm' $ return typeType
           ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType 
                                      -- ext t = t ** ...
           _ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
       RecType rr -> do
         ll2 <- case s of
           R ss -> return $ map fst ss
           _ -> do
             (s',typ2) <- inferLType gr g s
             case typ2 of
               RecType ss -> return $ map fst ss
               _ ->  checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
         let ll1 = [l | (l,_) <- rr, notElem l ll2]
         (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)
       ExtR ty ex -> do
         r' <- justCheck g r ty
         s' <- justCheck g s ex
         return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ
       _ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
    FV vs -> do
      ttys <- mapM (flip (checkLType gr g) typ) vs
 ---      checkIfComplexVariantType trm typ
      return (FV (map fst ttys), typ) --- typ' ?
    S tab arg -> checks [ do
      (tab',ty) <- inferLType gr g tab
      ty'       <- computeLType gr g ty
      case ty' of
        Table p t -> do
          (arg',val) <- checkLType gr g arg p
          checkEqLType gr g typ t trm
          return (S tab' arg', t)
        _ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
     , do
      (arg',ty) <- inferLType gr g arg
      ty'       <- computeLType gr g ty
      (tab',_)  <- checkLType gr g tab (Table ty' typ)
      return (S tab' arg', typ)
      ]
    Let (x,(mty,def)) body -> case mty of
      Just ty -> do
        (ty0,_)    <- checkLType gr g ty typeType
        (def',ty') <- checkLType gr g def ty0
        body' <- justCheck ((Explicit,x,ty'):g) body typ
        return (Let (x,(Just ty',def')) body', typ)
      _ -> do
        (def',ty) <- inferLType gr g def  -- tries to infer type of local constant
        checkLType gr g (Let (x,(Just ty,def')) body) typ
    ELin c tr -> do
      tr1 <- unlockRecord c tr
      checkLType gr g tr1 typ
    _ -> do
      (trm',ty') <- inferLType gr g trm
      termWith trm' $ checkEqLType gr g typ ty' trm'
 where
   justCheck g ty te = checkLType gr g ty te >>= return . fst
 {-
   recParts rr t = (RecType rr1,RecType rr2) where 
     (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
 -}
   checkM rms (l,ty) = case lookup l rms of
     Just (Just ty0,t) -> do
       checkEqLType gr g ty ty0 t
       (t',ty') <- checkLType gr g t ty
       return (l,(Just ty',t'))
     Just (_,t) -> do
       (t',ty') <- checkLType gr g t ty
       return (l,(Just ty',t'))
     _ -> checkError $ 
            if isLockLabel l 
              then let cat = drop 5 (showIdent (label2ident l))
                   in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <> 
                      "; try wrapping it with lin" <+> cat
              else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
   checkCase arg val (p,t) = do
     cont <- pattContext gr g arg p
     t' <- justCheck (reverse cont ++ g) t val
     return (p,t')
 pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context
 pattContext env g typ p = case p of
  PV x -> return [(Explicit,x,typ)]
  PP (q,c) ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
    t <- lookupResType env (q,c)
    let (cont,v) = typeFormCnc t
    checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p) 
              (length cont == length ps)
    checkEqLType env g typ v (patt2term p)
    mapM (\((_,_,ty),p) -> pattContext env g ty p) (zip cont ps) >>= return . concat
  PR r -> do
    typ' <- computeLType env g typ
    case typ' of
      RecType t -> do
        let pts = [(ty,tr) | (l,tr) <- r, Just ty <- [lookup l t]]
        ----- checkWarn $ prt p ++++ show pts ----- debug
        mapM (uncurry (pattContext env g)) pts >>= return . concat
      _ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
  PT t p' -> do
    checkEqLType env g typ t (patt2term p')
    pattContext env g typ p'
  PAs x p -> do
    g' <- pattContext env g typ p
    return ((Explicit,x,typ):g')
  PAlt p' q -> do
    g1 <- pattContext env g typ p'
    g2 <- pattContext env g typ q
    let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
    checkCond 
      ("incompatible bindings of" <+>
       fsep pts <+> 
       "in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts) 
    return g1 -- must be g1 == g2
  PSeq p q -> do
    g1 <- pattContext env g typ p
    g2 <- pattContext env g typ q
    return $ g1 ++ g2
  PRep p' -> noBind typeStr p'
  PNeg p' -> noBind typ p'
  _ -> return [] ---- check types!
 where 
   noBind typ p' = do
    co <- pattContext env g typ p'
    if not (null co)
      then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p) 
           >> return []
      else return []
 checkEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check Type
 checkEqLType gr g t u trm = do
  (b,t',u',s) <- checkIfEqLType gr g t u trm
  case b of
    True  -> return t'
    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
  t' <- computeLType gr g t
  u' <- computeLType gr g u
  case t' == u' || alpha [] t' u' of
    True -> return (True,t',u',[])
    -- forgive missing lock fields by only generating a warning.
    --- better: use a flag to forgive? (AR 31/1/2006)
    _ -> case missingLock [] t' u' of
      Ok lo -> do
        checkWarn $ "missing lock field" <+> fsep lo
        return (True,t',u',[])
      Bad s -> return (False,t',u',s)
  where
   -- check that u is a subtype of t
   --- quick hack version of TC.eqVal
   alpha g t u = case (t,u) of  
     -- error (the empty type!) is subtype of any other type
     (_,u) | u == typeError -> True
     -- contravariance
     (Prod _ x a b, Prod _ y c d) -> alpha g c a && alpha ((x,y):g) b d 
     -- record subtyping
     (RecType rs, RecType ts) -> all (\ (l,a) -> 
                                   any (\ (k,b) -> l == k && alpha g a b) ts) rs
     (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
     (ExtR r s, t) -> alpha g r t || alpha g s t
     -- the following say that Ints n is a subset of Int and of Ints m >= n
     -- But why does it also allow Int as a subtype of Ints m? /TH 2014-04-04
     (t,u) | Just m <- isTypeInts t, Just n <- isTypeInts u -> m >= n
           | Just _ <- isTypeInts t, u == typeInt           -> True ---- check size!
           | t == typeInt,           Just _ <- isTypeInts u -> True ---- why this ???? AR 11/12/2005
     ---- this should be made in Rename
     (Q  (m,a), Q  (n,b)) | a == b -> elem m (allExtendsPlus gr n) 
                                   || elem n (allExtendsPlus gr m)
                                   || m == n --- for Predef
     (QC (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) 
                                   || elem n (allExtendsPlus gr m)
     (QC (m,a), Q  (n,b)) | a == b -> elem m (allExtendsPlus gr n) 
                                   || elem n (allExtendsPlus gr m)
     (Q  (m,a), QC (n,b)) | a == b -> elem m (allExtendsPlus gr n) 
                                   || elem n (allExtendsPlus gr m)
     -- contravariance
     (Table a b,  Table c d)  -> alpha g c a && alpha g b d
     (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
     _                        -> t == u 
     --- the following should be one-way coercions only. AR 4/1/2001
                                  || elem t sTypes && elem u sTypes
                                  || (t == typeType && u == typePType) 
                                  || (u == typeType && t == typePType) 
   missingLock g t u = case (t,u) of  
     (RecType rs, RecType ts) -> 
       let 
         ls = [l | (l,a) <- rs, 
                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
         (locks,others) = partition isLockLabel ls
       in case others of
         _:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
         _ -> return locks
     -- contravariance
     (Prod _ x a b, Prod _ y c d) -> do
        ls1 <- missingLock g c a
        ls2 <- missingLock g b d
        return $ ls1 ++ ls2
     _ -> Bad ""
   sTypes = [typeStr, typeTok, typeString]
 -- auxiliaries
 -- | light-weight substitution for dep. types
 substituteLType :: Context -> Type -> Check Type
 substituteLType g t = case t of
  Vr x -> return $ maybe t id $ lookup x [(x,t) | (_,x,t) <- g]
  _ -> composOp (substituteLType g) t
 termWith :: Term -> Check Type -> Check (Term, Type)
 termWith t ct = do
  ty <- ct
  return (t,ty)
 -- | compositional check\/infer of binary operations
 check2 :: (Term -> Check Term) -> (Term -> Term -> Term) -> 
          Term -> Term -> Type -> Check (Term,Type)
 check2 chk con a b t = do
  a' <- chk a
  b' <- chk b
  return (con a' b', t)
 -- printing a type with a lock field lock_C as C
 ppType :: Type -> Doc
 ppType ty =
  case ty of
    RecType fs   -> case filter isLockLabel $ map fst fs of
                      [lock] -> pp (drop 5 (showIdent (label2ident lock)))
                      _      -> ppTerm Unqualified 0 ty
    Prod _ x a b -> ppType a <+> "->" <+> ppType b
    _            -> ppTerm Unqualified 0 ty
 {-
 ppqType :: Type -> Type -> Doc
 ppqType t u = case (ppType t, ppType u) of
  (pt,pu) | render pt == render pu -> ppTerm Qualified 0 t
  (pt,_) -> pt
 -}
 checkLookup :: Ident -> Context -> Check Type
 checkLookup x g =
  case [ty | (b,y,ty) <- g, x == y] of
    []     -> checkError ("unknown variable" <+> x)
    (ty:_) -> return ty
--- a/src/compiler/GF/Compile/TypeCheck/TC.hs
+++ b/src/compiler/GF/Compile/TypeCheck/TC.hs
@@ -12,15 +12,14 @@
 -- Thierry Coquand's type checking algorithm that creates a trace
 -----------------------------------------------------------------------------
-module GF.Compile.TypeCheck.TC (
+module GF.Compile.TypeCheck.TC (AExp(..),
-    AExp(..),
+	   Theory,
-    Theory,
+	   checkExp,
-    checkExp,
+	   inferExp,
-    inferExp,
+	   checkBranch,
-    checkBranch,
+	   eqVal,
-    eqVal,
+	   whnf
-    whnf
+	  ) where
  ) where
 import GF.Data.Operations
 import GF.Grammar
@@ -128,10 +127,10 @@ checkExp th tenv@(k,rho,gamma) e ty = do
    Abs _ x t -> case typ of
      VClos env (Prod _ y a b) -> do
-                           a' <- whnf $ VClos env a ---
+	a' <- whnf $ VClos env a ---
-                           (t',cs) <- checkExp th
+	(t',cs) <- checkExp th 
-                                          (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
+                           (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
-                           return (AAbs x a' t', cs)
+	return (AAbs x a' t', cs)
      _ -> Bad (render ("function type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))
    Let (x, (mb_typ, e1)) e2 -> do
@@ -206,8 +205,8 @@ inferExp th tenv@(k,rho,gamma) e = case e of
    case typ of
      VClos env (Prod _ x a b) -> do
        (a',csa) <- checkExp th tenv t (VClos env a)
-        b' <- whnf $ VClos ((x,VClos rho t):env) b
+	b' <- whnf $ VClos ((x,VClos rho t):env) b
-        return $ (AApp f' a' b', b', csf ++ csa)
+	return $ (AApp f' a' b', b', csf ++ csa)
      _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
   _ -> Bad (render ("cannot infer type of expression" <+> ppTerm Unqualified 0 e))
@@ -246,11 +245,11 @@ checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
      typ <- whnf ty
      case typ of
        VClos env (Prod _ y a b) -> do
-          a' <- whnf $ VClos env a
+	  a' <- whnf $ VClos env a
          (p', sigma, binds, cs1) <- checkP tenv p y a'
          let tenv' = (length binds, sigma ++ rho, binds ++ gamma)
          ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)
-          return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
+	  return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
        _ -> Bad (render ("Product expected for definiens" <+> ppTerm Unqualified 0 t <+> "instead of" <+> ppValue Unqualified 0 typ))
    [] -> do
      (e,cs) <- checkExp th tenv t ty
@@ -308,8 +307,8 @@ checkPatt th tenv exp val = do
       case typ of
         VClos env (Prod _ x a b) -> do
           (a',_,csa) <- checkExpP tenv t (VClos env a)
-           b' <- whnf $ VClos ((x,VClos rho t):env) b
+	   b' <- whnf $ VClos ((x,VClos rho t):env) b
-           return $ (AApp f' a' b', b', csf ++ csa)
+	   return $ (AApp f' a' b', b', csf ++ csa)
         _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
     _ -> Bad (render ("cannot typecheck pattern" <+> ppTerm Unqualified 0 exp))
@@ -322,3 +321,4 @@ mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)])
 mkAnnot a ti = do
  (v,cs) <- ti
  return (a v, v, cs)
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -27,21 +27,20 @@ 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 (BinTree Ident Info)
 buildAnyTree m = go Map.empty
  where
    go map []         = return map
-    go map ((c,j):is) =
+    go map ((c,j):is) = do
      case Map.lookup c map of
        Just i  -> case unifyAnyInfo m i j of
-          Ok k  -> go (Map.insert c k map) is
+		     Ok k  -> go (Map.insert c k map) is
-          Bad _ -> fail $ render ("conflicting information in module"<+>m $$
+		     Bad _ -> fail $ render ("conflicting information in module"<+>m $$
-                                  nest 4 (ppJudgement Qualified (c,i)) $$
+		                             nest 4 (ppJudgement Qualified (c,i)) $$
-                                  "and" $+$
+		                             "and" $+$
-                                  nest 4 (ppJudgement Qualified (c,j)))
+		                             nest 4 (ppJudgement Qualified (c,j)))
        Nothing -> go (Map.insert c j map) is
 extendModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
@@ -102,17 +101,16 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
            []  -> return mi{jments=js'}
            j0s -> do
                m0s <- mapM (lookupModule gr) j0s
-                let notInM0 c _  = all (not . Map.member c . jments) m0s
+                let notInM0 c _  = all (not . isInBinTree c . jments) m0s
-                let js2 = Map.filterWithKey notInM0 js'
+                let js2 = filterBinTree notInM0 js'
                return mi{jments=js2}
        _ -> return mi
    -- 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
+      let stat' = ifNull MSComplete (const MSIncomplete)
-                    then MSComplete
+                    [i | i <- is, notElem i infs]
                    else MSIncomplete
      unless (stat' == MSComplete || stat == MSIncomplete) 
             (checkError ("module" <+> i <+> "remains incomplete"))
      ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
@@ -125,11 +123,8 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
      --- check if me is incomplete
      let fs1 = fs `addOptions` fs_                           -- new flags have priority
-      let js0 = Map.mapMaybeWithKey (\c j -> if isInherited incl c
+      let js0 = [(c,globalizeLoc fpath j) | (c,j) <- tree2list js, isInherited incl c]
-                                               then Just (globalizeLoc fpath j)
+      let js1 = buildTree (tree2list js_ ++ js0)
                                               else Nothing)
                                    js
      let js1 = Map.union js0 js_
      let med1= nub (ext : infs ++ insts ++ med_)
      return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 msrc_ env_ js1
@@ -140,28 +135,28 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
 -- If the extended module is incomplete, its judgements are just copied.
 extendMod :: Grammar ->
             Bool -> (Module,Ident -> Bool) -> ModuleName ->
-             Map.Map Ident Info -> Check (Map.Map Ident Info)
+             BinTree Ident Info -> Check (BinTree Ident Info)
 extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jments mi) 
  where
    try new (c,i0)
      | not (cond c) = return new
      | otherwise    = case Map.lookup c new of
                         Just j -> case unifyAnyInfo name i j of
-                                     Ok k  -> return $ Map.insert c k new
+		                     Ok k  -> return $ updateTree (c,k) new
-                                     Bad _ -> do (base,j) <- case j of
+		                     Bad _ -> do (base,j) <- case j of 
-                                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
+		                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
-                                                               _          -> return (base,j)
+		                                               _          -> return (base,j)
-                                                 (name,i) <- case i of
+		                                 (name,i) <- case i of 
                                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
                                                               _          -> return (name,i)
-                                                 checkError ("cannot unify the information" $$
+		                                 checkError ("cannot unify the information" $$ 
-                                                             nest 4 (ppJudgement Qualified (c,i)) $$
+		                                             nest 4 (ppJudgement Qualified (c,i)) $$
-                                                             "in module" <+> name <+> "with" $$
+		                                             "in module" <+> name <+> "with" $$
-                                                             nest 4 (ppJudgement Qualified (c,j)) $$
+		                                             nest 4 (ppJudgement Qualified (c,j)) $$
-                                                             "in module" <+> base)
+		                                             "in module" <+> base)
                         Nothing-> if isCompl
-                                     then return $ Map.insert c (indirInfo name i) new
+                                     then return $ updateTree (c,indirInfo name i) new
-                                     else return $ Map.insert c i new
+                                     else return $ updateTree (c,i) new
      where
        i = globalizeLoc (msrc mi) i0
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -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.
@@ -61,10 +59,10 @@ parallelBatchCompile jobs opts rootfiles0 =
        usesPresent (_,paths) = take 1 libs==["present"]
          where
-            libs = [p | path<-paths,
+            libs = [p|path<-paths,
-                        let (d,p0) = splitAt n path
+                      let (d,p0) = splitAt n path
-                            p = dropSlash p0,
+                          p = dropSlash p0,
-                      d==lib_dir, p `elem` all_modes]
+                      d==lib_dir,p `elem` all_modes]
            n = length lib_dir  
        all_modes = ["alltenses","present"]
@@ -85,7 +83,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)
@@ -175,7 +173,7 @@ batchCompile1 lib_dir (opts,filepaths) =
                   " from being compiled."
       else return (maximum ts,(cnc,gr))
-splitEither es = ([x | Left x<-es], [y | Right y<-es])
+splitEither es = ([x|Left x<-es],[y|Right y<-es])
 canonical path = liftIO $ D.canonicalizePath path `catch` const (return path)
@@ -239,18 +237,18 @@ instance Functor m => Functor (CollectOutput m) where
   fmap f (CO m) = CO (fmap (fmap f) m)
 instance (Functor m,Monad m) => Applicative (CollectOutput m) where 
-  pure x = CO (return (return (),x))
+  pure = return
  (<*>) = ap
 instance Monad m => Monad (CollectOutput m) where
-  return     = pure
+  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 +256,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/CompilerAPI.hs
+++ b/src/compiler/GF/CompilerAPI.hs
@@ -16,6 +16,8 @@ import GF.Compile.ReadFiles
 import GF.Compile.Update
 import GF.Compile.Refresh
 import GF.Compile.Coding
 import GF.Grammar.Grammar
 import GF.Grammar.Lookup
 import GF.Grammar.Printer
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/src/compiler/GF/Data/BacktrackM.hs
@@ -13,27 +13,25 @@
 -----------------------------------------------------------------------------
 {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
 module GF.Data.BacktrackM (
                    -- * the backtracking state monad
-                    BacktrackM,
+		    BacktrackM,
-                    -- * monad specific utilities
+		    -- * monad specific utilities
-                    member,
+		    member,
-                    cut,
+		    cut,
-                    -- * running the monad
+		    -- * running the monad
-                    foldBM,          runBM,
+		    foldBM,          runBM,
-                    foldSolutions,   solutions,
+		    foldSolutions,   solutions,
-                    foldFinalStates, finalStates,
+		    foldFinalStates, finalStates,
-                    -- * reexport the 'MonadState' class
+		    -- * reexport the 'MonadState' class
-                    module Control.Monad.State.Class,
+		    module Control.Monad.State.Class,
-                  ) where
+		  ) where
 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
@@ -64,19 +62,13 @@ finalStates :: BacktrackM s () -> s -> [s]
 finalStates bm = map fst . runBM bm
 instance Applicative (BacktrackM s) where
-    pure a = BM (\c s b -> c a s b)
+    pure = return
    (<*>) = ap
 instance Monad (BacktrackM s) where
-    return     = pure
+    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
+	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
@@ -34,27 +32,18 @@ fromErr :: a -> Err a -> a
 fromErr a = err (const a) id
 instance Monad Err where
-  return      = pure
+  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)
  fmap f (Bad s) = Bad s
 instance Applicative Err where
-  pure = Ok
+  pure = return
  (<*>) = ap
 -- | added by KJ
--- a/src/compiler/GF/Data/Graph.hs
+++ b/src/compiler/GF/Data/Graph.hs
@@ -34,7 +34,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 data Graph n a b = Graph [n] ![Node n a] ![Edge n b]
-    deriving (Eq,Show)
+		 deriving (Eq,Show)
 type Node n a = (n,a)
 type Edge n b = (n,n,b)
@@ -170,7 +170,7 @@ renameNodes :: (n -> m) -- ^ renaming function
            -> Graph n a b -> Graph m a b
 renameNodes newName c (Graph _ ns es) = Graph c ns' es'
    where ns' = map' (\ (n,x) -> (newName n,x)) ns
-          es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
+	  es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
 -- | A strict 'map'
 map' :: (a -> b) -> [a] -> [b]
--- a/src/compiler/GF/Data/Graphviz.hs
+++ b/src/compiler/GF/Data/Graphviz.hs
@@ -13,14 +13,14 @@
 -----------------------------------------------------------------------------
 module GF.Data.Graphviz (
-                          Graph(..), GraphType(..),
+				  Graph(..), GraphType(..), 
-                          Node(..), Edge(..),
+				  Node(..), Edge(..),
-                          Attr,
+				  Attr,
-                          addSubGraphs,
+                                  addSubGraphs,
-                          setName,
+                                  setName,
-                          setAttr,
+                                  setAttr,
-                          prGraphviz
+				  prGraphviz
-                        ) where
+			) where
 import Data.Char
@@ -76,8 +76,8 @@ prSubGraph g@(Graph _ i _ _ _ _) =
 prGraph :: Graph -> String
 prGraph (Graph t id at ns es ss) = 
    unlines $ map (++";") (map prAttr at
-                           ++ map prNode ns
+		           ++ map prNode ns 
-                           ++ map (prEdge t) es
+		           ++ map (prEdge t) es
                           ++ map prSubGraph ss)
 graphtype :: GraphType -> String
@@ -96,7 +96,7 @@ edgeop Undirected = "--"
 prAttrList :: [Attr] -> String
 prAttrList [] = ""
-prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"
+prAttrList at =	"[" ++ join "," (map prAttr at) ++ "]"
 prAttr :: Attr -> String
 prAttr (n,v) = esc n ++ " = " ++ esc v
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -15,34 +15,47 @@
 -----------------------------------------------------------------------------
 module GF.Data.Operations (
-     -- ** The Error monad
+		   -- ** The Error monad
-     Err(..), err, maybeErr, testErr, fromErr, errIn,
+		   Err(..), err, maybeErr, testErr, fromErr, errIn, 
-     lookupErr,
+		   lookupErr,
-     -- ** Error monad class
+		   -- ** Error monad class
-     ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
+		   ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
-                 liftErr,
+                   liftErr,
-     -- ** Checking
+		   -- ** Checking
-     checkUnique, unifyMaybeBy, unifyMaybe,
+		   checkUnique, unifyMaybeBy, unifyMaybe,
-         -- ** Monadic operations on lists and pairs
+                   -- ** Monadic operations on lists and pairs
-     mapPairsM, pairM,
+		   mapPairListM, mapPairsM, pairM,
-     -- ** Printing
+		   -- ** Binary search trees; now with FiniteMap
-     indent, (+++), (++-), (++++), (+++-), (+++++),
+		   BinTree, emptyBinTree, isInBinTree, --justLookupTree,
-     prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
+		   lookupTree, --lookupTreeMany,
-     prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
+                   lookupTreeManyAll, updateTree,
-     numberedParagraphs, prConjList, prIfEmpty, wrapLines,
+		   buildTree, filterBinTree,
                   mapTree, --mapMTree,
                   tree2list,
-     -- ** Topological sorting
+		   -- ** Printing
-     topoTest, topoTest2,
+		   indent, (+++), (++-), (++++), (+++-), (+++++),
 		   prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly, 
 		   prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
 		   numberedParagraphs, prConjList, prIfEmpty, wrapLines,
-     -- ** Misc
+		   -- ** Topological sorting
-     readIntArg,
+		   topoTest, topoTest2,
     iterFix,  chunks,
-    ) where
+		   -- ** Misc
 		   ifNull,
 		   combinations, done, readIntArg, --singleton,
 		   iterFix,  chunks,
 {-
 		   -- ** State monad with error; from Agda 6\/11\/2001
 		   STM(..), appSTM, stm, stmr, readSTM, updateSTM, writeSTM,
 -}
 		  ) where
 import Data.Char (isSpace, toUpper, isSpace, isDigit)
 import Data.List (nub, partition, (\\))
@@ -53,13 +66,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 +82,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 +90,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,16 +107,54 @@ 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 ""
 unifyMaybeBy _ Nothing   mp2       = return mp2
 unifyMaybeBy _ mp1       _         = return mp1
 -- binary search trees
 type BinTree a b = Map a b
 emptyBinTree :: BinTree a b
 emptyBinTree = Map.empty
 isInBinTree :: (Ord a) => a -> BinTree a b -> Bool
 isInBinTree = Map.member
 {-
 justLookupTree :: (ErrorMonad m,Ord a) => a -> BinTree a b -> m b
 justLookupTree = lookupTree (const [])
 -}
 lookupTree :: (ErrorMonad m,Ord a) => (a -> String) -> a -> BinTree a b -> m b
 lookupTree pr x = maybeErr no . Map.lookup x
  where no = "no occurrence of element" +++ pr x
 lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b]
 lookupTreeManyAll pr (t:ts) x = case lookupTree pr x t of
  Ok v -> v : lookupTreeManyAll pr ts x
  _ -> lookupTreeManyAll pr ts x
 lookupTreeManyAll pr [] x = []
 updateTree :: (Ord a) => (a,b) -> BinTree a b -> BinTree a b
 updateTree (a,b) = Map.insert a b
 buildTree :: (Ord a) => [(a,b)] -> BinTree a b
 buildTree = Map.fromList
 mapTree :: ((a,b) -> c) -> BinTree a b -> BinTree a c
 mapTree f = Map.mapWithKey (\k v -> f (k,v))
 filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b
 filterBinTree = Map.filterWithKey
 tree2list :: BinTree a b -> [(a,b)] -- inorder
 tree2list = Map.toList
 -- printing
 indent :: Int -> String -> String
@@ -187,6 +243,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'
@@ -204,7 +275,7 @@ topoTest2 g0 = maybe (Right cycles) Left (tsort g)
        ([],[]) -> Just []
        ([],_) -> Nothing
        (ns,rest) -> (leaves:) `fmap` tsort [(n,es \\ leaves) | (n,es)<-rest]
-            where leaves = map fst ns
+	  where leaves = map fst ns
 -- | Fix point iterator (for computing e.g. transitive closures or reachability)
@@ -226,6 +297,46 @@ 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
 {-
 -- state monad with error; from Agda 6/11/2001
 newtype STM s a = STM (s -> Err (a,s)) 
 appSTM :: STM s a -> s -> Err (a,s)
 appSTM (STM f) s = f s
 stm :: (s -> Err (a,s)) -> STM s a
 stm = STM
 stmr :: (s -> (a,s)) -> STM s a
 stmr f = stm (\s -> return (f s))
 instance Functor (STM s) where fmap = liftM
 instance Applicative (STM s) where
  pure = return
  (<*>) = ap
 instance  Monad (STM s) where
  return a    = STM (\s -> return (a,s))
  STM c >>= f = STM (\s -> do 
                        (x,s') <- c s
                        let STM f' = f x
                        f' s')
 readSTM :: STM s s
 readSTM = stmr (\s -> (s,s))
 updateSTM :: (s -> s) -> STM s () 
 updateSTM f = stmr (\s -> ((),f s))
 writeSTM :: s -> STM s ()
 writeSTM s = stmr (const ((),s))
 -}
 -- | @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/Data/Relation.hs
+++ b/src/compiler/GF/Data/Relation.hs
@@ -83,7 +83,7 @@ transitiveClosure r = fix (Map.map growSet) r
  where growSet ys = foldl Set.union ys (map (allRelated r) $ Set.toList ys)
 reflexiveClosure_ :: Ord a => [a] -- ^ The set over which the relation is defined.
-                  -> Rel a -> Rel a
+		 -> Rel a -> Rel a
 reflexiveClosure_ u r = relates [(x,x) | x <- u] r
 -- | Uses 'domain'
@@ -117,8 +117,8 @@ equivalenceClasses :: Ord a => Rel a -> [Set a]
 equivalenceClasses r = equivalenceClasses_ (Map.keys r) r
 where equivalenceClasses_ [] _ = []
       equivalenceClasses_ (x:xs) r = ys:equivalenceClasses_ zs r
-          where ys = allRelated r x
+	   where ys = allRelated r x
-                zs = [x' | x' <- xs, not (x' `Set.member` ys)]
+                 zs = [x' | x' <- xs, not (x' `Set.member` ys)]
 isTransitive :: Ord a => Rel a -> Bool
 isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r, 
--- a/src/compiler/GF/Data/Utilities.hs
+++ b/src/compiler/GF/Data/Utilities.hs
@@ -33,7 +33,7 @@ longerThan    n = not . notLongerThan n
 lookupList :: Eq a => a -> [(a, b)] -> [b]
 lookupList a [] = []
 lookupList a (p:ps) | a == fst p = snd p : lookupList a ps
-                    | otherwise  =         lookupList a ps
+		    | otherwise  =         lookupList a ps
 split :: [a] -> ([a], [a])
 split (x : y : as) = (x:xs, y:ys)
@@ -48,8 +48,8 @@ splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys)
 foldMerge :: (a -> a -> a) -> a -> [a] -> a
 foldMerge merge zero = fm
    where fm [] = zero
-          fm [a] = a
+	  fm [a] = a
-          fm abs = let (as, bs) = split abs in fm as `merge` fm bs
+	  fm abs = let (as, bs) = split abs in fm as `merge` fm bs
 select :: [a] -> [(a, [a])]
 select [] = []
--- 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 ()
@@ -128,10 +126,10 @@ instance JSON LinType where
  -- records are encoded as records:
  showJSON (RecordType rows) = showJSON rows
-  readJSON o = StrType   <$ parseString "Str"   o
+  readJSON o = do "Str"   <- readJSON o; return StrType
-    <|>        FloatType <$ parseString "Float" o
+    <|>        do "Float" <- readJSON o; return FloatType
-    <|>        IntType   <$ parseString "Int"   o
+    <|>        do "Int"   <- readJSON o; return IntType
-    <|>        ParamType <$> readJSON o
+    <|>        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)]
@@ -239,28 +237,24 @@ instance JSON VarId where
  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)
+                  return $ if null mod then Unqual id else Qual (ModId mod) id
 instance JSON RawIdent where
  showJSON i = showJSON $ showRawIdent i
  readJSON o = rawIdentS <$> readJSON o
 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/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -78,7 +78,6 @@ import PGF.Internal (FId, FunId, SeqId, LIndex, Sequence, BindType(..))
 import Data.Array.IArray(Array)
 import Data.Array.Unboxed(UArray)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import GF.Text.Pretty
@@ -126,20 +125,10 @@ extends :: ModuleInfo -> [ModuleName]
 extends = map fst . mextend
 isInherited :: MInclude -> Ident -> Bool
-isInherited c =
+isInherited c i = case c of
-  case c of
+  MIAll -> True
-    MIAll -> const True
+  MIOnly is -> elem i is
-    MIOnly is -> elemOrd is
+  MIExcept is -> notElem i is
    MIExcept is -> not . elemOrd is
 -- | Faster version of `elem`, using a `Set`.
 -- Make sure you give this the first argument _outside_ of the inner loop
 --
 -- Example:
 -- > myIntersection xs ys = filter (elemOrd xs) ys
 elemOrd :: Ord a => [a] -> a -> Bool
 elemOrd list = (`Set.member` set)
  where set = Set.fromList list
 inheritAll :: ModuleName -> (ModuleName,MInclude)
 inheritAll i = (i,MIAll)
--- a/src/compiler/GF/Grammar/Lexer.x
+++ b/src/compiler/GF/Grammar/Lexer.x
@@ -1,10 +1,9 @@
 -- -*- haskell -*-
 {
 {-# LANGUAGE CPP #-}
 module GF.Grammar.Lexer
         ( Token(..), Posn(..)
         , P, runP, runPartial, token, lexer, getPosn, failLoc
-         , isReservedWord, invMap
+         , isReservedWord
         ) where
 import Control.Applicative
@@ -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
 }
@@ -134,7 +132,7 @@ data Token
 | T_Double  Double          -- double precision float literals
 | T_Ident   Ident
 | T_EOF
-  deriving (Eq, Ord, Show) -- debug
+-- deriving Show -- debug
 res = eitherResIdent
 eitherResIdent :: (Ident -> Token) -> Ident -> Token
@@ -224,13 +222,6 @@ resWords = Map.fromList
 ]
 where b s t = (identS s, t)
 invMap :: Map.Map Token String
 invMap = res
  where
    lst = Map.toList resWords
    flp = map (\(k,v) -> (v,showIdent k)) lst
    res = Map.fromList flp
 unescapeInitTail :: String -> String
 unescapeInitTail = unesc . tail where
  unesc s = case s of
@@ -274,7 +265,7 @@ type AlexInput2 = (AlexInput,AlexInput)
 data ParseResult a
  = POk AlexInput2 a
-  | PFailed Posn        -- The position of the error
+  | PFailed Posn	-- The position of the error
            String      -- The error message
 newtype P a = P { unP :: AlexInput2 -> ParseResult a }
@@ -283,24 +274,16 @@ instance Functor P where
  fmap = liftA
 instance Applicative P where
-  pure a = a `seq` (P $ \s -> POk s a)
+  pure = return
  (<*>) = ap
 instance Monad P where
-  return      = pure
+  return a    = a `seq` (P $ \s -> POk s a)
  (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
@@ -30,7 +30,7 @@ module GF.Grammar.Lookup (
           lookupFunType,
           lookupCatContext,
           allOpers, allOpersTo
-          ) where
+	      ) where
 import GF.Data.Operations
 import GF.Infra.Ident
@@ -51,11 +51,11 @@ lock c = lockRecType c -- return
 unlock c = unlockRecord c -- return
 -- to look up a constant etc in a search tree --- why here? AR 29/5/2008
-lookupIdent :: ErrorMonad m => Ident -> Map.Map Ident b -> m b
+lookupIdent :: ErrorMonad m => Ident -> BinTree Ident b -> m b
 lookupIdent c t =
-  case Map.lookup c t of
+  case lookupTree showIdent c t of
-    Just v  -> return v
+    Ok v  -> return v
-    Nothing -> raise ("unknown identifier" +++ showIdent c)
+    Bad _ -> raise ("unknown identifier" +++ showIdent c)
 lookupIdentInfo :: ErrorMonad m => SourceModInfo -> Ident -> m Info
 lookupIdentInfo mo i = lookupIdent i (jments mo)
@@ -148,7 +148,7 @@ lookupOrigInfo gr (m,c) = do
 allOrigInfos :: Grammar -> ModuleName -> [(QIdent,Info)]
 allOrigInfos gr m = fromErr [] $ do
  mo <- lookupModule gr m
-  return [((m,c),i) | (c,_) <- Map.toList (jments mo), Ok (m,i) <- [lookupOrigInfo gr (m,c)]]
+  return [((m,c),i) | (c,_) <- tree2list (jments mo), Ok (m,i) <- [lookupOrigInfo gr (m,c)]]
 lookupParamValues :: ErrorMonad m => Grammar -> QIdent -> m [Term]
 lookupParamValues gr c = do
@@ -166,11 +166,11 @@ 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
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -22,17 +22,17 @@ import GF.Data.Operations
 import GF.Data.Str
 import GF.Infra.Ident
 import GF.Grammar.Grammar
 --import GF.Grammar.Values
 import GF.Grammar.Predef
 import GF.Grammar.Printer
 import Control.Monad.Identity(Identity(..))
 import qualified Data.Traversable as T(mapM)
 import qualified Data.Map as Map
 import Control.Monad (liftM, liftM2, liftM3)
 --import Data.Char (isDigit)
 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.
@@ -238,7 +238,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)
@@ -555,12 +555,16 @@ strsFromTerm 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]
           ]
  FV 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,7 +594,7 @@ 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
@@ -604,9 +608,9 @@ sortRec = sortBy ordLabel where
 -- | dependency check, detecting circularities and returning topo-sorted list
-allDependencies :: (ModuleName -> Bool) -> Map.Map Ident Info -> [(Ident,[Ident])]
+allDependencies :: (ModuleName -> Bool) -> BinTree Ident Info -> [(Ident,[Ident])]
 allDependencies ism b = 
-  [(f, nub (concatMap opty (pts i))) | (f,i) <- Map.toList b]
+  [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b]
  where
    opersIn t = case t of
      Q  (n,c) | ism n -> [c]
@@ -630,7 +634,7 @@ topoSortJments (m,mi) = do
          return
          (\cyc -> raise (render ("circular definitions:" <+> fsep (head cyc))))
          (topoTest (allDependencies (==m) (jments mi)))
-  return (reverse [(i,info) | i <- is, Just info <- [Map.lookup i (jments mi)]])
+  return (reverse [(i,info) | i <- is, Ok info <- [lookupTree showIdent i (jments mi)]])
 topoSortJments2 :: ErrorMonad m => SourceModule -> m [[(Ident,Info)]]
 topoSortJments2 (m,mi) = do
@@ -640,4 +644,4 @@ topoSortJments2 (m,mi) = do
                                   <+> fsep (head cyc))))
           (topoTest2 (allDependencies (==m) (jments mi)))
  return
-    [[(i,info) | i<-is,Just info<-[Map.lookup i (jments mi)]] | is<-iss]
+    [[(i,info) | i<-is,Ok info<-[lookupTree showIdent i (jments mi)]] | is<-iss]
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -24,7 +24,6 @@ import GF.Grammar.Lexer
 import GF.Compile.Update (buildAnyTree)
 import Data.List(intersperse)
 import Data.Char(isAlphaNum)
 import qualified Data.Map as Map
 import PGF(mkCId)
 }
@@ -37,9 +36,6 @@ import PGF(mkCId)
 %name pBNFCRules ListCFRule
 %name pEBNFRules ListEBNFRule
 %errorhandlertype explist
 %error { happyError }
 -- no lexer declaration
 %monad { P } { >>= } { return }
 %lexer { lexer } { T_EOF }
@@ -143,7 +139,7 @@ ModHeader
  : ComplMod ModType '=' ModHeaderBody { let { mstat = $1 ;
                                               (mtype,id) = $2 ;
                                               (extends,with,opens) = $4 }
-                                         in (id, ModInfo mtype mstat noOptions extends with opens [] "" Nothing Map.empty) }
+                                         in (id, ModInfo mtype mstat noOptions extends with opens [] "" Nothing emptyBinTree) }
 ComplMod :: { ModuleStatus }
 ComplMod 
@@ -433,7 +429,6 @@ Exp3
                                         RecType xs -> RecType (xs ++ [(tupleLabel (length xs+1),$3)])
                                         t          -> RecType [(tupleLabel 1,$1), (tupleLabel 2,$3)]  }
  | Exp3 '**' Exp4                   { ExtR $1 $3    }
  | Exp3 '**'  '{' ListCase '}'      { let v = identS "$vvv" in T TRaw ($4 ++ [(PV v, S $1 (Vr v))]) }
  | Exp4                             { $1            }
 Exp4 :: { Term }
@@ -705,18 +700,8 @@ Posn
 {
-happyError :: (Token, [String]) -> P a
+happyError :: P a
-happyError (t,strs) = fail $ 
+happyError = fail "syntax error"
  "Syntax error:\n     Unexpected " ++ showToken t ++ ".\n     Expected one of:\n" 
    ++ unlines (map (("     - "++).cleanupToken) strs)
  where
    cleanupToken "Ident" = "an identifier"
    cleanupToken x = x
    showToken (T_Ident i) = "identifier '" ++ showIdent i ++ "'"
    showToken t = case Map.lookup t invMap of 
      Nothing -> show t
      Just s -> "token '" ++ s ++"'"
 mkListId,mkConsId,mkBaseId  :: Ident -> Ident
 mkListId = prefixIdent "List"
--- a/src/compiler/GF/Grammar/PatternMatch.hs
+++ b/src/compiler/GF/Grammar/PatternMatch.hs
@@ -12,12 +12,11 @@
 -- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
 -----------------------------------------------------------------------------
-module GF.Grammar.PatternMatch (
+module GF.Grammar.PatternMatch (matchPattern,
-                                matchPattern,
+		     testOvershadow, 
-                                testOvershadow,
+		     findMatch,
-                                findMatch,
+                     measurePatt
-                                measurePatt
+		    ) where
                               ) where
 import GF.Data.Operations
 import GF.Grammar.Grammar
@@ -74,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
+      (PW, _) | isInConstantFormt -> return [] -- optimization with wildcard
-      (PV x,([],K s,[])) -> return [(x,words2term (words s))]
+      (PV x,  _) | isInConstantFormt -> return [(x,t)]
      (PV x,  _) -> 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?
@@ -108,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
@@ -136,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
--- a/src/compiler/GF/Grammar/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -175,18 +175,18 @@ ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)
                           in prec d 0 ('\\' <> commaPunct ppBind xs <+> "->" <+> ppTerm q 0 e')
 ppTerm q d (T TRaw xs) = case getCTable (T TRaw xs) of
                           ([],_) -> "table" <+> '{' $$
-                                       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+	  		             nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-                                     '}'
+			             '}'
                           (vs,e) -> prec d 0 ("\\\\" <> commaPunct pp vs <+> "=>" <+> ppTerm q 0 e)
 ppTerm q d (T (TTyped t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-                                '}'
+			       '}'
 ppTerm q d (T (TComp  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+		 	       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-                               '}'
+			       '}'
 ppTerm q d (T (TWild  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-                                '}'
+			       '}'
 ppTerm q d (Prod bt x a b)= if x == identW && bt == Explicit
                              then prec d 0 (ppTerm q 4 a <+> "->" <+> ppTerm q 0 b)
                              else prec d 0 (parens (ppBind (bt,x) <+> ':' <+> ppTerm q 0 a) <+> "->" <+> ppTerm q 0 b)
@@ -198,14 +198,14 @@ ppTerm q d (C e1 e2)    =prec d 1 (hang (ppTerm q 2 e1) 2 ("++" <+> ppTerm q 1 e
 ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> '+'  <+> ppTerm q 2 e2)
 ppTerm q d (S x y)     = case x of
                           T annot xs -> let e = case annot of
-                                                   TRaw     -> y
+			                           TRaw     -> y
-                                                   TTyped t -> Typed y t
+			                           TTyped t -> Typed y t
-                                                   TComp  t -> Typed y t
+			                           TComp  t -> Typed y t
-                                                   TWild  t -> Typed y t
+			                           TWild  t -> Typed y t
-                                         in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$
+			                 in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$
-                                            nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+			                    nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-                                           '}'
+			                   '}'
-                           _          -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y))
+			   _          -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y))
 ppTerm q d (ExtR x y)  = prec d 3 (ppTerm q 3 x <+> "**" <+> ppTerm q 4 y)
 ppTerm q d (App x y)   = prec d 4 (ppTerm q 4 x <+> ppTerm q 5 y)
 ppTerm q d (V e es)    = hang "table" 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate ';' (map (ppTerm q 0) es)))])
@@ -362,3 +362,4 @@ getLet :: Term -> ([LocalDef], Term)
 getLet (Let l e) = let (ls,e') = getLet e
                   in (l:ls,e')
 getLet e         = ([],e)
--- a/src/compiler/GF/Grammar/Values.hs
+++ b/src/compiler/GF/Grammar/Values.hs
@@ -12,16 +12,15 @@
 -- (Description of the module)
 -----------------------------------------------------------------------------
-module GF.Grammar.Values (
+module GF.Grammar.Values (-- ** Values used in TC type checking
-               -- ** Values used in TC type checking
+	       Val(..), Env,
-               Val(..), Env,
+	       -- ** Annotated tree used in editing
               -- ** Annotated tree used in editing
               Binds, Constraints, MetaSubst,
-               -- ** For TC
+	       -- ** For TC
-               valAbsInt, valAbsFloat, valAbsString, vType,
+	       valAbsInt, valAbsFloat, valAbsString, vType,
-               isPredefCat,
+	       isPredefCat,
-               eType,
+	       eType, 
-              ) where
+	      ) where
 import GF.Infra.Ident
 import GF.Grammar.Grammar
--- a/src/compiler/GF/Infra/BuildInfo.hs
+++ b/src/compiler/GF/Infra/BuildInfo.hs
@@ -1,34 +1,13 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 module GF.Infra.BuildInfo where
 import System.Info
 import Data.Version(showVersion)
 import Language.Haskell.TH.Syntax
 import Control.Monad.IO.Class
 import Control.Exception
 import Data.Time hiding (buildTime)
 import System.Process
 -- Use Template Haskell to get compile time
 buildTime :: String
 buildTime = $(do
                 timeZone <- liftIO getCurrentTimeZone
                 time <- liftIO $ utcToLocalTime timeZone <$> getCurrentTime
                 return $ LitE $ StringL $ formatTime defaultTimeLocale "%F %T" time )
 -- Use Template Haskell to get current Git information
 gitInfo :: String
 gitInfo = $(do
               info <- liftIO $ try $ readProcess "git" ["log", "--format=commit %h tag %(describe:tags=true)", "-1"] "" :: Q (Either SomeException String)
               return $ LitE $ StringL $ either (\_ -> "unavailable") id info )
 {-# NOINLINE buildInfo #-}
 buildInfo =
    "Built on "++os++"/"++arch
-    ++" with "++compilerName++"-"++showVersion compilerVersion ++ " at " ++ buildTime ++ "\nGit info: " ++ gitInfo
+    ++" with "++compilerName++"-"++showVersion compilerVersion
-    ++"\nFlags:"
+    ++", flags:"
 #ifdef USE_INTERRUPT
    ++" interrupt"
 #endif
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -14,10 +14,10 @@
 module GF.Infra.CheckM
          (Check, CheckResult, Message, runCheck, runCheck',
-           checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
+	   checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
-           checkIn, checkInModule, checkMap, checkMapRecover,
+	   checkIn, checkInModule, checkMap, checkMapRecover,
           parallelCheck, accumulateError, commitCheck,
-          ) where
+	  ) where
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import GF.Data.Operations
@@ -32,7 +32,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
@@ -48,17 +47,14 @@ newtype Check a
 instance Functor Check where fmap = liftM
 instance Monad Check where
-  return   = pure
+  return x = Check $ \{-ctxt-} ws -> (ws,Success x)
  f >>= g  = Check $ \{-ctxt-} ws ->
               case unCheck f {-ctxt-} ws of
                 (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 x = Check $ \{-ctxt-} ws -> (ws,Success x)
+  pure = return
  (<*>) = ap
 instance ErrorMonad Check where
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -13,18 +13,18 @@
 -----------------------------------------------------------------------------
 module GF.Infra.Ident (-- ** Identifiers
-  ModuleName(..), moduleNameS,
+              ModuleName(..), moduleNameS,
-  Ident, ident2utf8, showIdent, prefixIdent,
+	      Ident, ident2utf8, showIdent, prefixIdent,
-  -- *** Normal identifiers (returned by the parser)
+              -- *** Normal identifiers (returned by the parser)
-  identS, identC, identW,
+	      identS, identC, identW,
-  -- *** Special identifiers for internal use
+              -- *** Special identifiers for internal use
-  identV, identA, identAV,
+              identV, identA, identAV,
-  argIdent, isArgIdent, getArgIndex,
+	      argIdent, isArgIdent, getArgIndex,
-  varStr, varX, isWildIdent, varIndex,
+              varStr, varX, isWildIdent, varIndex,
-  -- *** Raw identifiers
+              -- *** Raw identifiers
-  RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
+              RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
-  isPrefixOf, showRawIdent
+              isPrefixOf, showRawIdent
-) where
+	     ) where
 import qualified Data.ByteString.UTF8 as UTF8
 import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
@@ -77,6 +77,7 @@ 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
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -44,7 +44,6 @@ 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 
@@ -131,13 +130,8 @@ data CFGTransform = CFGNoLR
                  | CFGRemoveCycles
  deriving (Show,Eq,Ord)
-data HaskellOption = HaskellNoPrefix
+data HaskellOption = HaskellNoPrefix | HaskellGADT | HaskellLexical
-                   | HaskellGADT
+                   | HaskellConcrete | HaskellVariants
                   | HaskellLexical
                   | HaskellConcrete
                   | HaskellVariants
                   | HaskellData
                   | HaskellPGF2
  deriving (Show,Eq,Ord)
 data Warning = WarnMissingLincat
@@ -354,7 +348,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.",
@@ -536,9 +530,7 @@ haskellOptionNames =
     ("gadt",     HaskellGADT),
     ("lexical",  HaskellLexical),
     ("concrete", HaskellConcrete),
-     ("variants", HaskellVariants),
+     ("variants", HaskellVariants)]
     ("data",     HaskellData),
     ("pgf2",     HaskellPGF2)]
 -- | This is for bacward compatibility. Since GHC 6.12 we
 -- started using the native Unicode support in GHC but it
@@ -555,7 +547,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
@@ -563,7 +555,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
@@ -42,7 +42,6 @@ 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
@@ -52,16 +51,13 @@ newtype SIO a = SIO {unS::PutStr->IO a}
 instance Functor SIO where fmap = liftM
 instance Applicative SIO where
-  pure x = SIO (const (pure x))
+  pure = return
  (<*>) = ap
 instance Monad SIO where
-  return         = pure
+  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
--- a/Show More
+++ b/Show More
Author	SHA1	Message	Date
John J. Camilleri	0c91c325be	Simple hello world working with node-addon-api (C++)	2019-07-22 11:31:19 +02:00
John J. Camilleri	ba93141317	Clear old contents of src/runtime/javascript, add README for upcoming bindings	2019-07-15 11:30:21 +02:00