Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

do not upload release assets
Add a nix flake for building with nix (#185 )
2026-04-09 04:59:31 -06:00 · 2025-08-08 20:15:46 +02:00 · 2025-08-08 20:15:37 +02:00 · 2025-08-08 20:02:17 +02:00 · 2025-08-08 19:55:33 +02:00 · 2025-08-08 19:44:48 +02:00
208 changed files with 12387 additions and 3285 deletions
--- a/.github/workflows/build-all-versions.yml
+++ b/.github/workflows/build-all-versions.yml
@@ -12,28 +12,34 @@ jobs:
    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.1"
+          - "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@v1
+    - uses: haskell-actions/setup@v2
      id: setup-haskell-cabal
      name: Setup Haskell
      with:
@@ -44,7 +50,7 @@ jobs:
      run: |
        cabal freeze

-    - uses: actions/cache@v1
+    - uses: actions/cache@v4
      name: Cache ~/.cabal/store
      with:
        path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
@@ -62,34 +68,40 @@ jobs:

  stack:
    name: stack / ghc ${{ matrix.ghc }}
-    runs-on: ubuntu-latest
+    runs-on: ${{ matrix.ghc == '7.10.3' && 'ubuntu-20.04' || 'ubuntu-latest' }}
    strategy:
+      fail-fast: false
      matrix:
        stack: ["latest"]
-        ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4"]
-        # ghc: ["8.8.3"]
+        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@v1
+    - uses: haskell-actions/setup@v2
      name: Setup Haskell Stack
      with:
        ghc-version: ${{ matrix.ghc }}
        stack-version: 'latest'
        enable-stack: true

-    - uses: actions/cache@v1
+
+    # 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
+        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 --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
-        # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
+        stack build --test --no-run-tests --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml

    - name: Test
      run: |
--- a/.github/workflows/build-binary-packages.yml
+++ b/.github/workflows/build-binary-packages.yml
@@ -2,7 +2,7 @@ name: Build Binary Packages

 on:
  workflow_dispatch:
-  release: 
+  release:
    types: ["created"]

 jobs:
@@ -13,9 +13,9 @@ jobs:
    name: Build Ubuntu package
    strategy:
      matrix:
-        os:
-        - ubuntu-18.04
-        - ubuntu-20.04
+        ghc: ["9.6"]
+        cabal: ["3.10"]
+        os: ["ubuntu-24.04"]

    runs-on: ${{ matrix.os }}

@@ -25,12 +25,13 @@ jobs:
    # Note: `haskell-platform` is listed as requirement in debian/control,
    # which is why it's installed using apt instead of the Setup Haskell action.

-    # - name: Setup Haskell
-    #   uses: actions/setup-haskell@v1
-    #   id: setup-haskell-cabal
-    #   with:
-    #     ghc-version: ${{ matrix.ghc }}
-    #     cabal-version: ${{ matrix.cabal }}
+    - name: 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: |
@@ -39,14 +40,15 @@ jobs:
          make \
          dpkg-dev \
          debhelper \
-          haskell-platform \
          libghc-json-dev \
-          python-dev \
          default-jdk \
-          libtool-bin
-
+          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
@@ -54,7 +56,7 @@ jobs:
        cp ../gf_*.deb dist/

    - name: Upload artifact
-      uses: actions/upload-artifact@v2
+      uses: actions/upload-artifact@v4
      with:
        name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
        path: dist/gf_*.deb
@@ -64,14 +66,14 @@ jobs:
      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
+    #- 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

 # ---

@@ -79,16 +81,16 @@ jobs:
    name: Build macOS package
    strategy:
      matrix:
-        ghc: ["8.6.5"]
-        cabal: ["2.4"]
-        os: ["macos-10.15"]
+        ghc: ["9.6"]
+        cabal: ["3.10"]
+        os: ["macos-latest", "macos-13"]
    runs-on: ${{ matrix.os }}

    steps:
    - uses: actions/checkout@v2

    - name: Setup Haskell
-      uses: actions/setup-haskell@v1
+      uses: haskell-actions/setup@v2
      id: setup-haskell-cabal
      with:
        ghc-version: ${{ matrix.ghc }}
@@ -97,8 +99,10 @@ jobs:
    - name: Install build tools
      run: |
        brew install \
-          automake
+          automake \
+          libtool
        cabal v1-install alex happy
+        pip install setuptools

    - name: Build package
      run: |
@@ -107,24 +111,24 @@ jobs:
        make pkg

    - name: Upload artifact
-      uses: actions/upload-artifact@v2
+      uses: actions/upload-artifact@v4
      with:
-        name: gf-${{ github.event.release.tag_name }}-macos
+        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
+    #- 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

 # ---

@@ -132,9 +136,9 @@ jobs:
    name: Build Windows package
    strategy:
      matrix:
-        ghc: ["8.6.5"]
-        cabal: ["2.4"]
-        os: ["windows-2019"]
+        ghc: ["9.6.7"]
+        cabal: ["3.10"]
+        os: ["windows-2022"]
    runs-on: ${{ matrix.os }}

    steps:
@@ -147,6 +151,7 @@ jobs:
          base-devel
          gcc
          python-devel
+          autotools

    - name: Prepare dist folder
      shell: msys2 {0}
@@ -171,7 +176,8 @@ jobs:
    - name: Build Java bindings
      shell: msys2 {0}
      run: |
-        export JDKPATH=/c/hostedtoolcache/windows/Java_Adopt_jdk/8.0.292-10/x64
+        echo $JAVA_HOME_8_X64
+        export JDKPATH="$(cygpath -u "${JAVA_HOME_8_X64}")"
        export PATH="${PATH}:${JDKPATH}/bin"
        cd src/runtime/java
        make \
@@ -180,6 +186,9 @@ jobs:
        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}
@@ -188,12 +197,13 @@ jobs:
        EXTRA_LIB_DIRS: /mingw64/lib
      run: |
        cd src/runtime/python
+        pacman --noconfirm -S python-setuptools
        python setup.py build
        python setup.py install
-        cp /usr/lib/python3.9/site-packages/pgf* /c/tmp-dist/python
+        cp -r /usr/lib/python3.12/site-packages/pgf* /c/tmp-dist/python

    - name: Setup Haskell
-      uses: actions/setup-haskell@v1
+      uses: haskell-actions/setup@v2
      id: setup-haskell-cabal
      with:
        ghc-version: ${{ matrix.ghc }}
@@ -205,13 +215,13 @@ jobs:

    - name: Build GF
      run: |
-        cabal install --only-dependencies -fserver
+        cabal install -fserver --only-dependencies 
        cabal configure -fserver
        cabal build
-        copy dist\build\gf\gf.exe C:\tmp-dist
+        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@v2
+      uses: actions/upload-artifact@v4
      with:
        name: gf-${{ github.event.release.tag_name }}-windows
        path: C:\tmp-dist\*
@@ -220,11 +230,11 @@ jobs:
    - 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
+    #- 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
@@ -13,24 +13,25 @@ jobs:
    strategy:
      fail-fast: true
      matrix:
-        os: [ubuntu-18.04, macos-10.15]
+        os: [ubuntu-latest, macos-latest, macos-13]

    steps:
-    - uses: actions/checkout@v1
+    - uses: actions/checkout@v4

-    - uses: actions/setup-python@v1
+    - uses: actions/setup-python@v5
      name: Install Python
      with:
-        python-version: '3.7'
+        python-version: '3.x'

    - name: Install cibuildwheel
      run: |
-        python -m pip install git+https://github.com/joerick/cibuildwheel.git@main
+        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
@@ -42,30 +43,32 @@ jobs:
    - name: Build wheels on OSX
      if: startsWith(matrix.os, 'macos')
      env:
-        CIBW_BEFORE_BUILD: cd src/runtime/c && glibtoolize && autoreconf -i && ./configure && make && make install
+        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@v2
+    - 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@v2
+      - uses: actions/checkout@v4

-      - uses: actions/setup-python@v2
+      - uses: actions/setup-python@v5
        name: Install Python
        with:
-          python-version: '3.7'
+          python-version: '3.10'

      - name: Build sdist
        run: cd src/runtime/python && python setup.py sdist

-      - uses: actions/upload-artifact@v2
+      - uses: actions/upload-artifact@v4
        with:
+          name: wheel-source
          path: ./src/runtime/python/dist/*.tar.gz

  upload_pypi:
@@ -75,24 +78,25 @@ jobs:
    if: github.ref == 'refs/heads/master' && github.event_name == 'push'

    steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4

      - name: Set up Python
-        uses: actions/setup-python@v2
+        uses: actions/setup-python@v5
        with:
          python-version: '3.x'

      - name: Install twine
        run: pip install twine

-      - uses: actions/download-artifact@v2
+      - uses: actions/download-artifact@v4.1.7
        with:
-          name: artifact
+          pattern: wheel-*
+          merge-multiple: true
          path: ./dist

      - name: Publish
        env:
          TWINE_USERNAME: __token__
-          TWINE_PASSWORD: ${{ secrets.pypi_password }}
+          TWINE_PASSWORD: ${{ secrets.PYPI_PASSWORD }}
        run: |
-          (cd ./src/runtime/python && curl -I --fail https://pypi.org/project/$(python setup.py --name)/$(python setup.py --version)/) || twine upload dist/*
+          twine upload --verbose --non-interactive --skip-existing dist/*
--- a/.gitignore
+++ b/.gitignore
@@ -73,3 +73,9 @@ 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
@@ -1,14 +0,0 @@
-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
@@ -0,0 +1,12 @@
+### 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/8
+++ b/8
@@ -50,7 +50,7 @@ html::
 # number to the top of debian/changelog.
 # (Tested on Ubuntu 15.04. You need to install dpkg-dev & debhelper.)
 deb:
-	dpkg-buildpackage -b -uc
+	dpkg-buildpackage -b -uc -d

 # Make a macOS installer package
 pkg:
@@ -65,6 +65,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:
-	test -d dist || mkdir dist
-	git archive --format=tar.gz --output=dist/gf-${VERSION}.tar.gz HEAD
+# sdist:
+# 	test -d dist || mkdir dist
+# 	git archive --format=tar.gz --output=dist/gf-${VERSION}.tar.gz HEAD
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-![GF Logo](doc/Logos/gf1.svg)
+![GF Logo](https://www.grammaticalframework.org/doc/Logos/gf1.svg)

 # Grammatical Framework (GF)

@@ -38,8 +38,23 @@ 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:

-For more information, including links to precompiled binaries, see the [download page](http://www.grammaticalframework.org/download/index.html).
+  "No person, no problem" (Нет человека – нет проблемы).
+
+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
@@ -47,11 +47,14 @@ but the generated _artifacts_ must be manually attached to the release as _asset

 In order to do this you will need to be added the [GF maintainers](https://hackage.haskell.org/package/gf/maintainers/) on Hackage.

-1. Run `make sdist`
+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 `dist/gf-X.Y.tar.gz`
-    2. **via Cabal (≥2.4)**: `cabal upload dist/gf-X.Y.tar.gz`
-3. If the documentation-building fails on the Hackage server, do:
+    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
--- a/Setup.hs
+++ b/Setup.hs
@@ -4,42 +4,68 @@ 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
-  { preBuild  = gfPreBuild
+  { preConf   = gfPreConf
+  , preBuild  = gfPreBuild
  , postBuild = gfPostBuild
  , preInst   = gfPreInst
  , postInst  = gfPostInst
  , postCopy  = gfPostCopy
  }
  where
-    gfPreBuild args  = gfPre args . buildDistPref
-    gfPreInst args = gfPre args . installDistPref
+    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

    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`
@@ -47,27 +73,16 @@ main = defaultMainWithHooks simpleUserHooks
    gfSDist pkg lbi hooks flags = do
      return ()

-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"
+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"
+  ]

 -- | Get path to locally-built gf
 default_gf :: LocalBuildInfo -> FilePath
--- a/bin/build-binary-dist.sh
+++ b/bin/build-binary-dist.sh
@@ -32,7 +32,7 @@ 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="$prefix" # hack required for GF build on macOS
 bash setup.sh install prefix="$destdir$prefix"
 popd

@@ -46,7 +46,7 @@ if which >/dev/null python; then
        pyver=$(ls "$destdir$prefix/lib" | sed -n 's/^python//p')
        pydest="$destdir/Library/Python/$pyver/site-packages"
        mkdir -p "$pydest"
-        ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf* "$pydest"
+        ln "$destdir$prefix/lib/python$pyver/site-packages"/pgf*.so "$pydest"
    fi
    popd
 else
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,8 @@
+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
--- 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), haskell-platform (>= 2011.2.0.1), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev, java-sdk
+Build-Depends: debhelper (>= 5), libghc-haskeline-dev, libghc-mtl-dev, libghc-json-dev, autoconf, automake, libtool-bin, python-dev-is-python3, java-sdk
 Homepage: http://www.grammaticalframework.org/

 Package: gf
--- a/debian/rules
+++ b/debian/rules
@@ -16,7 +16,7 @@ override_dh_shlibdeps:
 override_dh_auto_configure:
 	cd src/runtime/c && bash setup.sh configure --prefix=/usr
 	cd src/runtime/c && bash setup.sh build
-	cabal v1-update
+	cabal update
 	cabal v1-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

@@ -24,7 +24,7 @@ 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
 	echo $(SET_LDL)
 	-$(SET_LDL) cabal v1-build

@@ -32,13 +32,15 @@ override_dh_auto_install:
 	$(SET_LDL) cabal v1-copy --destdir=$(CURDIR)/debian/gf
 	cd src/runtime/c && bash setup.sh copy prefix=$(CURDIR)/debian/gf/usr
 	cd src/runtime/python && python setup.py install --prefix=$(CURDIR)/debian/gf/usr
-	cd src/runtime/java && make INSTALL_PATH=$(CURDIR)/debian/gf/usr install
-	D="`find debian/gf -name site-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv site-packages dist-packages
+	# cd src/runtime/java && make INSTALL_PATH=$(CURDIR)/debian/gf/usr install
+	# D="`find debian/gf -name dist-packages`" && [ -n "$$D" ] && cd $$D && cd .. && mv dist-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/gf-editor-modes.md
+++ b/doc/gf-editor-modes.md
@@ -0,0 +1,75 @@
+# 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
@@ -1,78 +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.
-
-==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
@@ -46,7 +46,7 @@
 #TINY

 The command has one argument which is either function, expression or
-a category defined in the abstract syntax of the current grammar. 
+a category defined in the abstract syntax of the current grammar.
 If the argument is a function then ?its type is printed out.
 If it is a category then the category definition is printed.
 If a whole expression is given it prints the expression with refined
@@ -303,7 +303,7 @@ but the resulting .gf file must be imported separately.

 #TINY

-Generates a list of random trees, by default one tree.
+Generates a list of random trees, by default one tree up to depth 5.
 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,13 +315,14 @@ 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
+ | ``-depth`` | the maximum generation depth (default: 5)
 | ``-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 ?))
@@ -338,8 +339,8 @@ given in a file in the -probs flag.

 #TINY

-Generates all trees of a given category. By default, 
-the depth is limited to 4, but this can be changed by a flag.
+Generates all trees of a given category. By default,
+the depth is limited to 5, 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.

@@ -353,7 +354,7 @@ to all metavariables in the tree.

 - Examples:

- | ``gt`` | all trees in the startcat, to depth 4
+ | ``gt`` | all trees in the startcat, to depth 5
 | ``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 ?))
@@ -582,7 +583,7 @@ trees where a function node is a metavariable.

 - Examples:

- | ``l -lang=LangSwe,LangNor -chunks ? a b (? c d)`` | 
+ | ``l -lang=LangSwe,LangNor -chunks ? a b (? c d)`` |


 #NORMAL
@@ -647,7 +648,7 @@ The -lang flag can be used to restrict this to fewer languages.
 The default start category can be overridden by the -cat flag.
 See also the ps command for lexing and character encoding.

-The -openclass flag is experimental and allows some robustness in 
+The -openclass flag is experimental and allows some robustness in
 the parser. For example if -openclass="A,N,V" is given, the parser
 will accept unknown adjectives, nouns and verbs with the resource grammar.

--- a/doc/gf-people.md
+++ b/doc/gf-people.md
@@ -7,7 +7,6 @@ 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/).
@@ -22,6 +21,7 @@ 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)
--- a/doc/tutorial/gf-tutorial.t2t
+++ b/doc/tutorial/gf-tutorial.t2t
@@ -1188,7 +1188,7 @@ use ``generate_trees = gt``.
  this wine is fresh
  this wine is warm
 ```
-The default **depth** is 3; the depth can be
+The default **depth** is 5; the depth can be
 set by using the ``depth`` flag:
 ```
  > generate_trees -depth=2 | l
@@ -1265,10 +1265,16 @@ 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. Its default is ``"open"``, which works
-on Mac OS X. On Ubuntu Linux, one can write
+telling what command to use to view the file.
+
+This works on Mac OS X:
 ```
-  > parse "this delicious cheese is very Italian" | visualize_tree -view="eog"
+  > parse "this delicious cheese is very Italian" | visualize_tree -view=open
+```
+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
 ```


@@ -1733,6 +1739,13 @@ 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:
 ```
@@ -3733,7 +3746,7 @@ However, type-incorrect commands are rejected by the typecheck:
  The parsing is successful but the type checking failed with error(s):
    Couldn't match expected type Device light
       against the interred type Device fan
-    In the expression: DKindOne fan       
+    In the expression: DKindOne fan
 ```

 #NEW
@@ -4171,7 +4184,7 @@ division of integers.
 ```
  abstract Calculator = {
  flags startcat = Exp ;
-  
+
  cat Exp ;

  fun
@@ -4578,7 +4591,7 @@ in any multilingual grammar between any languages in the grammar.
 module Main where

 import PGF
-import System (getArgs)
+import System.Environment (getArgs)

 main :: IO ()
 main = do
--- a/download/index-3.11.md
+++ b/download/index-3.11.md
@@ -53,26 +53,39 @@ You will probably need to update the `PATH` environment variable to include your

 For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).

-<!--## Installing the latest Hackage release (macOS, Linux, and WSL2 on Windows)
+## 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:

-1.  Install ghcup https://www.haskell.org/ghcup/
-2.  `ghcup install ghc 8.10.4`
-3.  `ghcup set ghc 8.10.4`
-4.  `cabal update`
-5.  On Linux: install some C libraries from your Linux distribution (see note below)
-6.  `cabal install gf-3.11`
-
-You can also download the source code release from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases),
-and follow the instructions below under **Installing from the latest developer source code**.
+```
+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 installs GF for a single user.
+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):

@@ -84,32 +97,34 @@ PATH=$HOME/.cabal/bin:$PATH

 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.
+automatically by Cabal, and therefore need to be installed manually.
 Here is one way to do this:

 - On Ubuntu: `sudo apt-get install libghc-haskeline-dev`
 - On Fedora: `sudo dnf install ghc-haskeline-devel`

-**GHC version**
+## Installing from source code

-The GF source code has been updated to compile with GHC versions 7.10 through to 8.8.
-->
-## Installing from the latest developer source code
+**Obtaining**

-If you haven't already, clone the repository with:
+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
 ```
-
-If you've already cloned the repository previously, update with:
-
+2. If you've already cloned the repository previously, update with:
 ```
 git pull
 ```

-Then install with:

+**Installing**
+
+You can then install with:
 ```
 cabal install
 ```
@@ -124,6 +139,8 @@ stack install
 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:
--- a/download/index-3.12.md
+++ b/download/index-3.12.md
@@ -0,0 +1,184 @@
+---
+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
+
+To install the package, just double-click it and follow the installer instructions.
+
+#### 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
@@ -3,6 +3,6 @@
  <meta http-equiv="refresh" content="0; URL=/download/index-3.11.html" />
 </head>
 <body>
-  You are being redirected to <a href="index-3.11.html">the current version</a> of this page.
+  You are being redirected to <a href="index-3.12.html">the current version</a> of this page.
 </body>
 </html>
--- a/download/release-3.12.md
+++ b/download/release-3.12.md
@@ -0,0 +1,37 @@
+---
+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
@@ -0,0 +1,43 @@
+{
+  "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
@@ -0,0 +1,50 @@
+{
+  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
@@ -8,13 +8,13 @@ instance LexFoodsFin of LexFoods =
    cheese_N = mkN "juusto" ;
    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" 
-         "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
-	 ) 
-    "lämpimämpi" "lämpimin" ;
+    warm_A = mkA
+    (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ä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
@@ -1,16 +1,16 @@
 -- (c) 2009 Aarne Ranta under LGPL

-instance LexFoodsGer of LexFoods = 
+instance LexFoodsGer of LexFoods =
    open SyntaxGer, ParadigmsGer in {
  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" ;
-    boring_A = mkA "tråkig" ;
+    delicious_A = mkA "läcker" ;
+    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
@@ -43,10 +43,10 @@ oper
    } ;

  auxVerb : Aux -> Verb = \a -> case a of {
-    Avere => 
+    Avere =>
      mkVerb "avere" "ho" "hai" "ha" "abbiamo" "avete" "hanno" "avuto" Avere ;
-    Essere => 
-      mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere
+    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,19 +1,24 @@
 name: gf
-version: 3.11.0-git
+version: 3.12.0

 cabal-version: 1.22
-build-type: Custom
+build-type: Simple
 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: 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
+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4, GHC==9.0.2, GHC==9.2.4

 data-dir: src
-extra-source-files: WebSetup.hs
+extra-source-files:
+  README.md
+  CHANGELOG.md
+  WebSetup.hs
+  doc/Logos/gf0.png
 data-files:
  www/*.html
  www/*.css
@@ -39,14 +44,6 @@ data-files:
  www/translator/*.css
  www/translator/*.js

-custom-setup
-  setup-depends:
-    base >= 4.9.1 && < 4.15,
-    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
@@ -63,38 +60,129 @@ flag network-uri
   description: Get Network.URI from the network-uri package
   default: True

-executable gf
-  hs-source-dirs: src/programs, src/compiler
-  main-is: gf-main.hs
-  default-language:    Haskell2010
-  build-depends: pgf2,
-                 base >= 4.6 && <5,
-                 array,
-                 containers,
-                 bytestring,
-                 utf8-string,
-                 random,
-                 pretty,
-                 mtl,
-                 exceptions,
-                 ghc-prim,
-                 filepath, directory>=1.2, time,
-                 process, haskeline, parallel>=3, json
-  ghc-options: -threaded
+--flag new-comp
+--  Description: Make -new-comp the default
+--  Default:     True
+
+flag c-runtime
+  Description: Include functionality from the C run-time library (which must be installed already)
+  Default: False
+
+library
+  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
+
+  hs-source-dirs: src/runtime/haskell

  other-modules:
+    -- not really part of GF but I have changed the original binary library
+    -- and we have to keep the copy for now.
+    Data.Binary
+    Data.Binary.Put
+    Data.Binary.Get
+    Data.Binary.Builder
+    Data.Binary.IEEE754
+
+--ghc-options: -fwarn-unused-imports
+--if impl(ghc>=7.8)
+--  ghc-options: +RTS -A20M -RTS
+  -- ghc-prof-options: -fprof-auto
+
+  exposed-modules:
+    PGF
+    PGF.Internal
+    PGF.Haskell
+
+  other-modules:
+    PGF.Data
+    PGF.Macros
+    PGF.Binary
+    PGF.Optimize
+    PGF.Printer
+    PGF.CId
+    PGF.Expr
+    PGF.Generate
+    PGF.Linearize
+    PGF.Morphology
+    PGF.Paraphrase
+    PGF.Parse
+    PGF.Probabilistic
+    PGF.SortTop
+    PGF.Tree
+    PGF.Type
+    PGF.TypeCheck
+    PGF.Forest
+    PGF.TrieMap
+    PGF.VisualizeTree
+    PGF.ByteCode
+    PGF.OldBinary
+    PGF.Utilities
+
+  if flag(c-runtime)
+    exposed-modules: PGF2
+    other-modules:
+      PGF2.FFI
+      PGF2.Expr
+      PGF2.Type
+      GF.Interactive2
+      GF.Command.Commands2
+    hs-source-dirs: src/runtime/haskell-bind
+    build-tools: hsc2hs
+    extra-libraries: pgf gu
+    c-sources: src/runtime/haskell-bind/utils.c
+    cc-options: -std=c99
+
+---- GF compiler as a library:
+
+  build-depends:
+    directory >= 1.3.0 && < 1.4,
+    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
+
+  hs-source-dirs: src/compiler
+  exposed-modules:
    GF
    GF.Support
    GF.Text.Pretty
    GF.Text.Lexing
    GF.Grammar.Canonical

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

-    GF.Compile GF.CompileInParallel GF.CompileOne  GF.Compile.GetGrammar
+    GF.Compile
+    GF.CompileInParallel
+    GF.CompileOne
+    GF.Compile.GetGrammar
    GF.Grammar

-    GF.Data.Operations GF.Infra.Option GF.Infra.UseIO
+    GF.Data.Operations
+    GF.Infra.Option
+    GF.Infra.UseIO

    GF.Command.Abstract
    GF.Command.CommandInfo
@@ -109,9 +197,9 @@ executable gf
    GF.Command.TreeOperations
    GF.Compile.CFGtoPGF
    GF.Compile.CheckGrammar
+    GF.Compile.Compute.Concrete
    GF.Compile.Compute.Predef
    GF.Compile.Compute.Value
-    GF.Compile.Compute.Concrete
    GF.Compile.ExampleBased
    GF.Compile.Export
    GF.Compile.GenerateBC
@@ -119,14 +207,16 @@ executable gf
    GF.Compile.GrammarToPGF
    GF.Compile.Multi
    GF.Compile.Optimize
-    GF.Compile.OptimizePGF
    GF.Compile.PGFtoHaskell
    GF.Compile.PGFtoJava
    GF.Haskell
    GF.Compile.ConcreteToHaskell
    GF.Compile.GrammarToCanonical
    GF.Grammar.CanonicalJSON
+    GF.Compile.PGFtoJS
    GF.Compile.PGFtoJSON
+    GF.Compile.PGFtoProlog
+    GF.Compile.PGFtoPython
    GF.Compile.ReadFiles
    GF.Compile.Rename
    GF.Compile.SubExOpt
@@ -193,35 +283,123 @@ executable gf
    GF.System.Directory
    GF.System.Process
    GF.System.Signal
-    GF.System.NoSignal
    GF.Text.Clitics
    GF.Text.Coding
-    GF.Text.Lexing
    GF.Text.Transliterations
    Paths_gf
-    
-    -- not really part of GF but I have changed the original binary library
-    -- and we have to keep the copy for now.
-    Data.Binary
-    Data.Binary.Put
-    Data.Binary.Get
-    Data.Binary.Builder
-    Data.Binary.IEEE754
+
+  if flag(c-runtime)
+    cpp-options: -DC_RUNTIME
+
+  if flag(server)
+    build-depends:
+      cgi >= 3001.3.0.2 && < 3001.6,
+      httpd-shed >= 0.4.0 && < 0.5,
+      network>=2.3 && <3.2
+    if flag(network-uri)
+      build-depends:
+        network-uri >= 2.6.1.0 && < 2.7,
+        network>=2.6 && <3.2
+    else
+      build-depends:
+        network >= 2.5 && <3.2
+
+    cpp-options: -DSERVER_MODE
+    other-modules:
+      GF.Server
+      PGFService
+      RunHTTP
+      SimpleEditor.Convert
+      SimpleEditor.JSON
+      SimpleEditor.Syntax
+      URLEncoding
+      CGI
+      CGIUtils
+      Cache
+      Fold
+      ExampleDemo
+      ExampleService
+    hs-source-dirs:
+      src/server
+      src/server/transfer
+      src/example-based
+
+  if flag(interrupt)
+    cpp-options: -DUSE_INTERRUPT
+    other-modules: GF.System.UseSignal
+  else
+    other-modules: GF.System.NoSignal
+
+  if impl(ghc>=7.8)
+    build-tools:
+      happy>=1.19,
+      alex>=3.1
+--  ghc-options: +RTS -A20M -RTS
+  else
+    build-tools:
+      happy,
+      alex>=3
+
+  ghc-options: -fno-warn-tabs

  if os(windows)
    build-depends:
      Win32 >= 2.3.1.1 && < 2.7
  else
    build-depends:
-      terminfo >=0.4.0 && < 0.5,
-      unix >= 2.7.2 && < 2.8
+      terminfo >=0.4.0 && < 0.5
+
+    if impl(ghc >= 9.6.6)
+      build-depends: unix >= 2.8
+
+    else
+      build-depends: unix >= 2.7.2 && < 2.8
+
+
+  if impl(ghc>=8.2)
+    ghc-options: -fhide-source-paths
+
+executable gf
+  hs-source-dirs: src/programs
+  main-is: gf-main.hs
+  default-language: Haskell2010
+  build-depends:
+    gf,
+    base
+  ghc-options: -threaded
+--ghc-options: -fwarn-unused-imports
+
+  if impl(ghc>=7.0)
+    ghc-options: -rtsopts -with-rtsopts=-I5
+    if impl(ghc<7.8)
+      ghc-options: -with-rtsopts=-K64M
+
+  -- ghc-prof-options: -auto-all
+
+  if impl(ghc>=8.2)
+    ghc-options: -fhide-source-paths
+
+-- executable pgf-shell
+-- --if !flag(c-runtime)
+--   buildable: False
+--   main-is: pgf-shell.hs
+--   hs-source-dirs: src/runtime/haskell-bind/examples
+--   build-depends:
+--     gf,
+--     base,
+--     containers,
+--     mtl,
+--     lifted-base
+--   default-language: Haskell2010
+--   if impl(ghc>=7.0)
+--     ghc-options: -rtsopts

 test-suite gf-tests
  type: exitcode-stdio-1.0
  main-is: run.hs
  hs-source-dirs: testsuite
  build-depends:
-    base >= 4.9.1 && < 4.15,
+    base >= 4.9.1,
    Cabal >= 1.8,
    directory >= 1.3.0 && < 1.4,
    filepath >= 1.4.1 && < 1.5,
--- 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.4.2/css/all.css" integrity="sha384-/rXc/GQVaYpyDdyxK+ecHPVYJSN9bmVFBvjA/9eOB+pb3F2w2N6fc5qB9Ew5yIns" crossorigin="anonymous">
+  <link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.15.4/css/all.css" crossorigin="anonymous">

  <link rel="alternate" href="https://github.com/GrammaticalFramework/gf-core/" title="GF GitHub repository">
 </head>
@@ -57,6 +57,7 @@
      <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">
@@ -85,10 +86,22 @@
  <div class="col-sm-6 col-md-3 mb-4">
    <h3>Contribute</h3>
    <ul class="mb-2">
-      <li><a href="http://groups.google.com/group/gf-dev">Mailing List</a></li>
+      <li>
+        <a href="https://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="//school.grammaticalframework.org/2020/">Summer School</a></li>
    </ul>
    <a href="https://github.com/GrammaticalFramework/" class="btn btn-primary ml-3">
      <i class="fab fa-github mr-1"></i>
@@ -154,7 +167,7 @@ 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>,
@@ -214,64 +227,50 @@ least one, it may help you to get a first idea of what GF is.
    </p>

    <p>
-    We run the IRC channel <strong><code>#gf</code></strong> on the Libera network, where you are welcome to look for help with small questions or just start a general discussion.
-    You can <a href="https://web.libera.chat/?channels=#gf">open a web chat</a>
-    or <a href="https://www.grammaticalframework.org/irc/?C=M;O=D">browse the channel logs</a>.
+    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.
    </p>
+
+
    <p>
-    If you have a larger question which the community may benefit from, we recommend you ask it on the <a href="http://groups.google.com/group/gf-dev">mailing list</a>.
+    For bug reports and feature requests, please create an issue in the
+    <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>
-    <dt class="col-sm-3 text-center text-nowrap">2021-07-25</dt>
-    <dd class="col-sm-9">
-      <strong>GF 3.11 released.</strong>
-      <a href="download/release-3.11.html">Release notes</a>
-    </dd>
    <dl class="row">
+      <dt class="col-sm-3 text-center text-nowrap">2025-08-08</dt>
+      <dd class="col-sm-9">
+        <strong>GF 3.12 released.</strong>
+        <a href="download/release-3.12.html">Release notes</a>
+      </dd>
+      <dt class="col-sm-3 text-center text-nowrap">2025-01-18</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.
+      </dd>
+      <dt class="col-sm-3 text-center text-nowrap">2023-01-24</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.
+      </dd>
+      <dt class="col-sm-3 text-center text-nowrap">2021-07-25</dt>
+      <dd class="col-sm-9">
+        <strong>GF 3.11 released.</strong>
+        <a href="download/release-3.11.html">Release notes</a>
+      </dd>
      <dt class="col-sm-3 text-center text-nowrap">2021-05-05</dt>
      <dd class="col-sm-9">
        <a href="https://cloud.grammaticalframework.org/wordnet/">GF WordNet</a> now supports languages for which there are no other WordNets. New additions: Afrikaans, German, Korean, Maltese, Polish, Somali, Swahili.
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2021-03-01</dt>
-      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2020/">Seventh GF Summer School</a>, in Singapore and online, 26 July &ndash; 6 August 2021.
-      </dd>
      <dt class="col-sm-3 text-center text-nowrap">2020-09-29</dt>
      <dd class="col-sm-9">
        <a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Abstract Syntax as Interlingua</a>: Scaling Up the Grammatical Framework from Controlled Languages to Robust Pipelines. A paper in Computational Linguistics (2020) summarizing much of the development in GF in the past ten years.
      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-12-03</dt>
-      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2018/">Sixth GF Summer School</a> in Stellenbosch (South Africa), 3–14 December 2018
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-12-02</dt>
-      <dd class="col-sm-9">
-        <strong>GF 3.10 released.</strong>
-        <a href="download/release-3.10.html">Release notes</a>
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-07-25</dt>
-      <dd class="col-sm-9">
-        The GF repository has been split in two:
-        <a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and
-        <a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.
-        The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-08-11</dt>
-      <dd class="col-sm-9">
-        <strong>GF 3.9 released.</strong>
-        <a href="download/release-3.9.html">Release notes</a>
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-06-29</dt>
-      <dd class="col-sm-9">
-        GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>.</dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-03-13</dt>
-      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2017/">GF Summer School</a> in Riga (Latvia), 14-25 August 2017
-      </dd>
    </dl>

    <h2>Projects</h2>
@@ -341,7 +340,7 @@ 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> has
+    <a href="lib/doc/synopsis/index.html">GF resource grammar library</a> (RGL) has
    support for an increasing number of languages, currently including
    Afrikaans,
    Amharic (partial),
--- a/nix/expose-all.patch
+++ b/nix/expose-all.patch
@@ -0,0 +1,12 @@
+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
@@ -0,0 +1,193 @@
+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/Abstract.hs
+++ b/src/compiler/GF/Command/Abstract.hs
@@ -1,6 +1,6 @@
 module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr,Term) where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 -- ** Creating documentation

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

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

 import GF.Compile.Export
 import GF.Compile.ToAPI
@@ -17,6 +22,7 @@ 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

@@ -24,28 +30,28 @@ import GF.Command.TreeOperations ---- temporary place for typecheck and compute

 import GF.Data.Operations

-import Data.Char
+import PGF.Internal (encodeFile)
 import Data.List(intersperse,nub)
 import Data.Maybe
 import qualified Data.Map as Map
 import GF.Text.Pretty
 import Data.List (sort)
-import Control.Monad(mplus)
 import qualified Control.Monad.Fail as Fail
 --import Debug.Trace


-class (Functor m,Monad m,MonadSIO m) => HasPGF m where getPGF :: m (Maybe PGF)
+data PGFEnv = Env {pgf::PGF,mos::Map.Map Language Morpho}

-instance (Monad m,HasPGF m,Fail.MonadFail m) => TypeCheckArg m where
-  typeCheckArg e = do mb_pgf <- getPGF
-                      case mb_pgf of
-                        Just pgf -> either fail
-                                           (return . fst)
-                                           (inferExpr pgf e)
-                        Nothing  -> fail "Import a grammar before using this command"
+pgfEnv pgf = Env pgf mos
+  where mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf]

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

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

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

+
  ("vd", emptyCommandInfo {
     longname = "visualize_dependency",
     synopsis = "show word dependency tree graphically",
@@ -487,9 +549,9 @@ pgfCommands = Map.fromList [
       "which is processed by dot (graphviz) and displayed by the program indicated",
       "by the view flag. The target format is png, unless overridden by the",
       "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",
-       "See also 'vp -showdep' for another visualization of dependencies." 
+       "See also 'vp -showdep' for another visualization of dependencies."
       ],
-     exec = needPGF $ \ opts arg pgf -> do
+     exec = getEnv $ \ opts arg (Env pgf mos) -> do
         let absname = abstractName pgf
         let es = toExprs arg
         let debug = isOpt "v" opts
@@ -502,8 +564,8 @@ pgfCommands = Map.fromList [
         mclab <- case cnclabels of
           "" -> return Nothing
           _  -> (Just . getCncDepLabels) `fmap` restricted (readFile cnclabels)
-         concr <- optLang pgf opts
-         let grphs = map (graphvizDependencyTree outp debug mlab mclab concr) es
+         let lang = optLang pgf opts
+         let grphs = map (graphvizDependencyTree outp debug mlab mclab pgf lang) es
         if isOpt "conll2latex" opts
           then return $ fromString $ conlls2latexDoc $ stanzas $ unlines $ toStrings arg
           else if isFlag "view" opts && valStrOpts "output" "" opts == "latex"
@@ -538,6 +600,7 @@ pgfCommands = Map.fromList [
       ]
    }),

+
  ("vp", emptyCommandInfo {
     longname = "visualize_parse",
     synopsis = "show parse tree graphically",
@@ -549,8 +612,9 @@ pgfCommands = Map.fromList [
       "by the view flag. The target format is png, unless overridden by the",
       "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)."
       ],
-     exec = needPGF $ \opts arg pgf -> do
-         let es        = toExprs arg
+     exec = getEnv $ \ opts arg (Env pgf mos) -> do
+         let es = toExprs arg
+         let lang = optLang pgf opts
         let gvOptions = GraphvizOptions {noLeaves = isOpt "noleaves" opts && not (isOpt "showleaves" opts),
                                          noFun = isOpt "nofun" opts || not (isOpt "showfun" opts),
                                          noCat = isOpt "nocat" opts && not (isOpt "showcat" opts),
@@ -563,11 +627,10 @@ pgfCommands = Map.fromList [
                                          leafEdgeStyle = valStrOpts "leafedgestyle" "dashed" opts
                                         }
         let depfile = valStrOpts "file" "" opts
-         concr  <- optLang pgf opts
         mlab <- case depfile of
           "" -> return Nothing
           _  -> (Just . getDepLabels) `fmap` restricted (readFile depfile)
-         let grphs = map (graphvizDependencyTree "dot" False mlab Nothing concr) es
+         let grphs = map (graphvizParseTreeDep mlab pgf lang gvOptions) es
         if isFlag "view" opts || isFlag "format" opts
           then do
             let view = optViewGraph opts
@@ -602,6 +665,7 @@ pgfCommands = Map.fromList [
       ]
    }),

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

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

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

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

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

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

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

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

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

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

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

   optFile opts = valStrOpts "file" "_gftmp" opts

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

-   returnFromExprs show_p es =
-     return $ 
-       case es of
-         [] -> pipeMessage "no trees found"
-         _  -> fromExprs show_p es
+   open_cmd | os == "linux"   = "xdg-open"
+            | os == "mingw32" = "start"
+            | otherwise       = "open"

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

-     | isOpt "lexc"     opts = return $ fromString $ concatMap prLexcLexicon $ optLangs pgf opts
-     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (concreteName concr:":":[f | f <- functions pgf, not (hasLinearization concr f)]) |
-                                                                  concr <- optLangs pgf opts]
-     | isOpt "words" opts = return $ fromString $ concatMap prAllWords $ optLangs pgf opts
+     | isOpt "lexc"     opts = return $ fromString $ concatMap (morpho mos "" prLexcLexicon) $ optLangs pgf opts
+     | isOpt "missing"  opts = return $ fromString $ unlines $ [unwords (showCId la:":": map showCId cs) |
+                                                                  la <- optLangs pgf opts, let cs = missingLins pgf la]
+     | isOpt "words" opts = return $ fromString $ concatMap (morpho mos "" prAllWords) $ optLangs pgf opts
     | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
                                  return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf

-   showFun pgf id ty = kwd++" "++ id ++ " : " ++ showType [] ty
-                       where
-                         kwd | functionIsDataCon pgf id = "data"
-                             | otherwise                = "fun"
+   funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))]
+   showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"

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

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

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

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

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

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

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

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

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

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

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

-import PGF2(showExpr)
+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

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

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

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

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

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

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

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

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

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

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

 import Control.Monad(when)
 import qualified Data.Map as Map
@@ -56,8 +56,17 @@ interpretPipe env cs = do
 -- | macro definition applications: replace ?i by (exps !! i)
 appCommand :: CommandArguments -> Command -> Command
 appCommand args c@(Command i os arg) = case arg of
-  AExpr e -> Command i os (AExpr (exprSubstitute e (toExprs args)))
+  AExpr e -> Command i os (AExpr (app e))
  _       -> c
+ where
+  xs = toExprs args
+
+  app e = case e of
+    EAbs b x e -> EAbs b x (app e)
+    EApp e1 e2 -> EApp (app e1) (app e2)
+    ELit l     -> ELit l
+    EMeta i    -> xs !! i
+    EFun x     -> EFun x

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

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

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

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

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

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

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

 pArgTerm = ATerm `fmap` readS_to_P sTerm
  where
--- a/src/compiler/GF/Command/TreeOperations.hs
+++ b/src/compiler/GF/Command/TreeOperations.hs
@@ -1,29 +1,34 @@
 module GF.Command.TreeOperations (
  treeOp,
  allTreeOps,
+  treeChunks
  ) where

-import PGF2(Expr,PGF,Fun,compute,mkApp,unApp,unMeta,exprSize,exprFunctions)
+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]

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

-allTreeOps :: PGF -> [(String,(String,Either TreeOp (Fun -> TreeOp)))]
+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",("remove duplicate trees",
+   ("nub\t",("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",("return all fun functions appearing in the tree, with duplications",
+   ("funs\t",("return all fun functions appearing in the tree, with duplications",
      Left  $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))
  ]

@@ -33,7 +38,32 @@ largest = reverse . smallest
 smallest :: [Expr] -> [Expr]
 smallest = sortBy (\t u -> compare (exprSize t) (exprSize u))

+treeChunks :: Expr -> [Expr]
+treeChunks = snd . cks where
+  cks t = 
+    case unapply t of
+      (t, ts) -> case unMeta t of
+                   Just _  -> (False,concatMap (snd . cks) ts)
+                   Nothing -> case unzip (map cks ts) of
+                                (bs,_) | and bs      -> (True, [t])
+                                (_,cts)              -> (False,concat cts)
+
 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.hs
+++ b/src/compiler/GF/Compile.hs
@@ -1,6 +1,6 @@
 module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    convertRule cs (funid,funs) rule =
      let args   = [PArg [] (cat2arg c) | NonTerminal c <- ruleRhs rule]
          prod   = PApply funid args
-          seqid  = Set.findIndex (mkSequence rule) sequences0
-          fun    = (mkRuleName rule, [seqid])
+          seqid  = binSearch (mkSequence rule) sequences (bounds sequences)
+          fun    = CncFun (mkRuleName rule) (listArray (0,0) [seqid])
          funid' = funid+1
      in funid' `seq` ((funid',fun:funs),let (c,ps) = ruleLhs rule in [(cat2fid c p, prod) | p <- ps])

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

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

    mkCoercions (fid,cs) c@(cat,[p]) = ((fid,cs),[])
    mkCoercions (fid,cs) c@(cat,ps ) =
@@ -116,13 +105,22 @@ cf2concr opts abstr cfg =

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

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

    cat2arg c@(cat,[p]) = cat2fid cat p
    cat2arg c@(cat,ps ) =
@@ -132,5 +130,5 @@ cf2concr opts abstr cfg =

 mkRuleName rule =
  case ruleName rule of
-	CFObj n _ -> n
-	_         -> "_"
+    CFObj n _ -> n
+    _         -> wildCId
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -21,8 +21,8 @@
 -----------------------------------------------------------------------------

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

-import Prelude hiding ((<>))
 import GF.Infra.Ident
 import GF.Infra.Option

--- a/src/compiler/GF/Compile/Compute/Concrete.hs
+++ b/src/compiler/GF/Compile/Compute/Concrete.hs
@@ -172,11 +172,11 @@ value env t0 =
    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
+                     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
+                  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
@@ -376,10 +376,10 @@ valueTable env i cs =
  where
    dynamic cs' ty _ = cases cs' # value env ty

-    cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
+    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')
+                   VT wild (vty vs) (mapSnd ($ vs) cs')

    wild = case i of TWild _ -> True; _ -> False

@@ -392,7 +392,7 @@ valueTable env i cs =
    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)
+                                           (mapFst ($ vs) sts)

    valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
                         pvs <- linPattVars p'
@@ -430,19 +430,19 @@ 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)
+    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
+                                          $ map ($ svs) vs
              | otherwise  -> do r <- resource env x
-                                 return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
+                                 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)
+                                 return $ \ svs -> vapply (gloc env) (fv svs) (map ($ svs) vs)

 vapply :: GLocation -> Value -> [Value] -> Value
 vapply loc v [] = v
--- a/src/compiler/GF/Compile/Compute/Value.hs
+++ b/src/compiler/GF/Compile/Compute/Value.hs
@@ -1,6 +1,6 @@
 module GF.Compile.Compute.Value where
 import GF.Grammar.Grammar(Label,Type,MetaId,Patt,QIdent)
-import PGF2(BindType)
+import PGF.Internal(BindType)
 import GF.Infra.Ident(Ident)
 import Text.Show.Functions()
 import Data.Ix(Ix)
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -3,7 +3,11 @@ module GF.Compile.ExampleBased (
  configureExBased
  ) where

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

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

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

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

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

-import PGF2
+import PGF
+import PGF.Internal(ppPGF)
 import GF.Compile.PGFtoHaskell
 --import GF.Compile.PGFtoAbstract
 import GF.Compile.PGFtoJava
+import GF.Compile.PGFtoProlog
+import GF.Compile.PGFtoJS
 import GF.Compile.PGFtoJSON
+import GF.Compile.PGFtoPython
 import GF.Infra.Option
 --import GF.Speech.CFG
 import GF.Speech.PGFToCFG
@@ -18,7 +22,6 @@ import GF.Speech.SLF
 import GF.Speech.PrRegExp

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

@@ -32,12 +35,15 @@ exportPGF :: Options
          -> [(FilePath,String)] -- ^ List of recommended file names and contents.
 exportPGF opts fmt pgf = 
    case fmt of
-      FmtPGFPretty    -> multi "txt" (showPGF)
+      FmtPGFPretty    -> multi "txt" (render . ppPGF)
      FmtCanonicalGF  -> [] -- canon "gf" (render80 . abstract2canonical)
      FmtCanonicalJson-> []
+      FmtJavaScript   -> multi "js"  pgf2js
      FmtJSON         -> multi "json"  pgf2json
+      FmtPython       -> multi "py"  pgf2python
      FmtHaskell      -> multi "hs"  (grammar2haskell opts name)
      FmtJava         -> multi "java" (grammar2java opts name)
+      FmtProlog       -> multi "pl"  grammar2prolog
      FmtBNF          -> single "bnf"   bnfPrinter
      FmtEBNF         -> single "ebnf"  (ebnfPrinter opts)
      FmtSRGS_XML     -> single "grxml" (srgsXmlPrinter opts)
@@ -51,13 +57,20 @@ exportPGF opts fmt pgf =
      FmtRegExp       -> single "rexp" regexpPrinter
      FmtFA           -> single "dot"  slfGraphvizPrinter
 where
-   name = fromMaybe (abstractName pgf) (flag optName opts)
+   name = fromMaybe (showCId (abstractName pgf)) (flag optName opts)

   multi :: String -> (PGF -> String) -> [(FilePath,String)]
   multi ext pr = [(name <.> ext, pr pgf)]

 -- canon ext pr = [("canonical"</>name<.>ext,pr pgf)]

-   single :: String -> (PGF -> Concr -> String) -> [(FilePath,String)]
-   single ext pr = [(concreteName cnc <.> ext, pr pgf cnc) | cnc <- Map.elems (languages pgf)]
+   single :: String -> (PGF -> CId -> String) -> [(FilePath,String)]
+   single ext pr = [(showCId cnc <.> ext, pr pgf cnc) | cnc <- languages pgf]

+
+-- | Get the name of the concrete syntax to generate output from.
+-- FIXME: there should be an option to change this.
+outputConcr :: PGF -> CId
+outputConcr pgf = case languages pgf of
+                    []     -> error "No concrete syntax."
+                    cnc:_  -> cnc
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE CPP #-}
 module GF.Compile.GenerateBC(generateByteCode) where

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

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

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

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

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

 import GF.Infra.Option
 import GF.Grammar hiding (Env, mkRecord, mkTable)
@@ -70,7 +69,7 @@ mapAccumWithKeyM f a m = do let xs = Map.toAscList m


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

@@ -104,11 +103,11 @@ addPMCFG opts gr cenv opath am cm seqs id (CncFun mty@(Just (cat,cont,val)) mlin
          newArgs  = map getFIds newArgs'
      in addFunction env0 newCat fun newArgs

-addPMCFG opts gr cenv opath am cm seqs id (CncCat mty@(Just (L _ lincat)) 
-                                                  mdef@(Just (L loc1 def))
-                                                  mref@(Just (L loc2 ref))
-                                                  mprn
-                                                  Nothing) = do
+addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ lincat))
+                                                             mdef@(Just (L loc1 def))
+                                                             mref@(Just (L loc2 ref))
+                                                             mprn
+                                                             Nothing) = do
  let pcat = protoFCat gr (am,id) lincat
      pvar = protoFCat gr (MN identW,cVar) typeStr

@@ -133,7 +132,7 @@ addPMCFG opts gr cenv opath am cm seqs id (CncCat mty@(Just (L _ lincat))
  let pmcfg     = getPMCFG pmcfgEnv2

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

-pgfCncCat :: SourceGrammar -> PGF2.Cat -> Type -> Int -> (PGF2.Cat,Int,Int,[String])
-pgfCncCat gr id lincat index =
+pgfCncCat :: SourceGrammar -> Type -> Int -> CncCat
+pgfCncCat gr lincat index =
  let ((_,size),schema) = computeCatRange gr lincat
-  in ( id
-     , index
-     , index+size-1
-     , map (renderStyle style{mode=OneLineMode} . ppPath)
-           (getStrPaths schema)
-     )
+  in PGF.CncCat index (index+size-1)
+                      (mkArray (map (renderStyle style{mode=OneLineMode} . ppPath)
+                                    (getStrPaths schema)))
  where
    getStrPaths :: Schema Identity s c -> [Path]
    getStrPaths = collect CNil []
@@ -205,11 +201,11 @@ instance Fail.MonadFail CnvMonad where
  fail = bug

 instance Applicative CnvMonad where
-  pure = return
+  pure a = CM (\gr c s -> c a s)
  (<*>) = ap

 instance Monad CnvMonad where
-    return a   = CM (\gr c s -> c a s)
+    return     = pure
    CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)

 instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where
@@ -479,7 +475,7 @@ goV (CPar t)     rpath ss = restrictHead (reversePath rpath) t >> return ss
 ----------------------------------------------------------------------
 -- SeqSet

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

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

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


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

 getBNFCRules :: Options -> FilePath -> IOE [BNFCRule]
 getBNFCRules opts fpath = do
--- a/src/compiler/GF/Compile/GrammarToCanonical.hs
+++ b/src/compiler/GF/Compile/GrammarToCanonical.hs
@@ -19,7 +19,7 @@ import GF.Compile.Compute.Predef(predef)
 import GF.Compile.Compute.Value(Predefined(..))
 import GF.Infra.Ident(ModuleName(..),Ident,ident2raw,rawIdentS,showIdent,isWildIdent)
 import GF.Infra.Option(Options,optionsPGF)
-import PGF2.Internal(Literal(..))
+import PGF.Internal(Literal(..))
 import GF.Compile.Compute.Concrete(GlobalEnv,normalForm,resourceValues)
 import GF.Grammar.Canonical as C
 import System.FilePath ((</>), (<.>))
@@ -92,7 +92,7 @@ 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 :: 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 _ ->
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -1,14 +1,17 @@
-{-# LANGUAGE ImplicitParams, BangPatterns, FlexibleContexts, MagicHash #-}
-module GF.Compile.GrammarToPGF (grammar2PGF) where
+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
+module GF.Compile.GrammarToPGF (mkCanon2pgf) where

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

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

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

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

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

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

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

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

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

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

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

          !(!fid_cnt1,!cnccats) = genCncCats gr am cm cdefs
-          cnccat_ranges = Map.fromList (map (\(cid,s,e,_) -> (cid,(s,e))) cnccats)
          !(!fid_cnt2,!productions,!lindefs,!linrefs,!cncfuns)
-                                = genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt1 cnccat_ranges
+                                = genCncFuns gr am cm ex_seqs_arr ciCmp seqs cdefs fid_cnt1 cnccats

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

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

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

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

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

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

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

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

 genCncFuns :: Grammar
           -> ModuleName
           -> ModuleName
-           -> Array SeqId [Symbol]
-           -> ([Symbol] -> [Symbol] -> Ordering)
-           -> Array SeqId [Symbol]
+           -> Array SeqId Sequence
+           -> (Sequence -> Sequence -> Ordering)
+           -> Array SeqId Sequence
           -> [(QIdent, Info)]
           -> FId
-           -> Map.Map PGF2.Cat (Int,Int)
+           -> Map.Map CId D.CncCat
           -> (FId,
-               [(FId, [Production])],
-               [(FId, [FunId])],
-               [(FId, [FunId])],
-               [(PGF2.Fun,[SeqId])])
-genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccat_ranges =
+               IntMap.IntMap (Set.Set D.Production),
+               IntMap.IntMap [FunId],
+               IntMap.IntMap [FunId],
+               Array FunId D.CncFun)
+genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccats =
  let (fid_cnt1,funs_cnt1,funs1,lindefs,linrefs) = mkCncCats cdefs fid_cnt  0 [] IntMap.empty IntMap.empty
-      (fid_cnt2,funs_cnt2,funs2,prods0)          = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
-      prods                                      = [(fid,Set.toList prodSet) | (fid,prodSet) <- IntMap.toList prods0]
-  in (fid_cnt2,prods,IntMap.toList lindefs,IntMap.toList linrefs,reverse funs2)
+      (fid_cnt2,funs_cnt2,funs2,prods)           = mkCncFuns cdefs fid_cnt1 funs_cnt1 funs1 lindefs Map.empty IntMap.empty
+  in (fid_cnt2,prods,lindefs,linrefs,array (0,funs_cnt2-1) funs2)
  where
-    mkCncCats []                                                          fid_cnt funs_cnt funs lindefs linrefs =
+    mkCncCats []                                                        fid_cnt funs_cnt funs lindefs linrefs =
      (fid_cnt,funs_cnt,funs,lindefs,linrefs)
    mkCncCats (((m,id),CncCat _ _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs linrefs =
      let !funs_cnt' = let (s_funid, e_funid) = bounds funs0
@@ -234,16 +210,17 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccat_ranges =
          linrefs'   = foldl' (toLinRef (am,id) funs_cnt) linrefs prods0
          funs'      = foldl' (toCncFun funs_cnt (m,mkLinDefId id)) funs (assocs funs0)
      in mkCncCats cdefs fid_cnt funs_cnt' funs' lindefs' linrefs'
-    mkCncCats (_                                                  :cdefs) fid_cnt funs_cnt funs lindefs linrefs =
+    mkCncCats (_                                                :cdefs) fid_cnt funs_cnt funs lindefs linrefs =
      mkCncCats cdefs fid_cnt funs_cnt funs lindefs linrefs

    mkCncFuns []                                                        fid_cnt funs_cnt funs lindefs crc prods =
      (fid_cnt,funs_cnt,funs,prods)
    mkCncFuns (((m,id),CncFun _ _ _ (Just (PMCFG prods0 funs0))):cdefs) fid_cnt funs_cnt funs lindefs crc prods =
-      let ty_C           = err error (\x -> x) $ fmap GM.typeForm (Look.lookupFunType gr am id)
+      let ---Ok ty_C        = fmap GM.typeForm (Look.lookupFunType gr am id)
+          ty_C           = err error (\x -> x) $ fmap GM.typeForm (Look.lookupFunType gr am id)
          !funs_cnt'     = let (s_funid, e_funid) = bounds funs0
                           in funs_cnt+(e_funid-s_funid+1)
-          !(fid_cnt',crc',prods')
+          !(fid_cnt',crc',prods') 
                         = foldl' (toProd lindefs ty_C funs_cnt)
                                  (fid_cnt,crc,prods) prods0
          funs'          = foldl' (toCncFun funs_cnt (m,id)) funs (assocs funs0)
@@ -251,23 +228,23 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccat_ranges =
    mkCncFuns (_                                                :cdefs) fid_cnt funs_cnt funs lindefs crc prods = 
      mkCncFuns cdefs fid_cnt funs_cnt funs lindefs crc prods

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

    mkLinDefId id = prefixIdent "lindef " id

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

-    toLinRef res offs linrefs (A.Production fid0 funid0 [fargs]) =
+    toLinRef res offs linrefs (Production fid0 funid0 [fargs]) =
      if fid0 == fidVar
        then foldr (\fid -> IntMap.insertWith (++) fid [offs+funid0]) linrefs fids
        else linrefs
@@ -290,20 +267,20 @@ genCncFuns gr am cm ex_seqs ciCmp seqs cdefs fid_cnt cnccat_ranges =
        fids = map (mkFId res) fargs

    mkFId (_,cat) fid0 =
-      case Map.lookup (i2i cat) cnccat_ranges of
-        Just (s,e) -> s+fid0
-        Nothing    -> error ("GrammarToPGF.mkFId: missing category "++showIdent cat)
+      case Map.lookup (i2i cat) cnccats of
+        Just (C.CncCat s e _) -> s+fid0
+        Nothing               -> error ("GrammarToPGF.mkFId: missing category "++showIdent cat)

    mkCtxt lindefs (_,cat) =
-      case Map.lookup (i2i cat) cnccat_ranges of
-        Just (s,e) -> [(fid,fid) | fid <- [s..e], Just _ <- [IntMap.lookup fid lindefs]]
-        Nothing    -> error "GrammarToPGF.mkCtxt failed"
+      case Map.lookup (i2i cat) cnccats of
+        Just (C.CncCat s e _) -> [(C.fidVar,fid) | fid <- [s..e], Just _ <- [IntMap.lookup fid lindefs]]
+        Nothing               -> error "GrammarToPGF.mkCtxt failed"

    toCncFun offs (m,id) funs (funid0,lins0) =
      let mseqs = case lookupModule gr m of
                    Ok (ModInfo{mseqs=Just mseqs}) -> mseqs
                    _                              -> ex_seqs
-      in (i2i id, map (newIndex mseqs) (elems lins0)):funs
+      in (offs+funid0,C.CncFun (i2i id) (amap (newIndex mseqs) lins0)):funs                                          
      where
        newIndex mseqs i = binSearch (mseqs ! i) seqs (bounds seqs)

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

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

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

 module GF.Compile.PGFtoHaskell (grammar2haskell) where

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

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

 import Data.List(isPrefixOf,find,intercalate,intersperse,groupBy,sortBy)
-import Data.Maybe(mapMaybe)
 import qualified Data.Map as Map

 type Prefix = String -> String
@@ -259,7 +258,7 @@ fInstance gId lexical m (cat,rules) =
    then "    " ++ gId cat ++ " (fgs t) where\n     fgs t = case unApp t of"
    else "    case unApp t of") ++++
  unlines [mkInst f xx | (f,xx) <- nonLexicalRules (lexical cat) rules] ++++
-  (if lexical cat then "      Just (i,[]) -> " ++ lexicalConstructor cat +++ "i" else "") ++++
+  (if lexical cat then "      Just (i,[]) -> " ++ lexicalConstructor cat +++ "(showCId i)" else "") ++++
  "      _ -> error (\"no" +++ cat ++ " \" ++ show t)"
   where
    isList = isListCat (cat,rules)
@@ -280,22 +279,19 @@ fInstance gId lexical m (cat,rules) =

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

-import PGF2
-import PGF2.Internal
-import Text.JSON
+import PGF (showCId)
+import qualified PGF.Internal as M
+import PGF.Internal (
+  Abstr,
+  CId,
+  CncCat(..),
+  CncFun(..),
+  Concr,
+  DotPos,
+  Equation(..),
+  Literal(..),
+  PArg(..),
+  PGF,
+  Production(..),
+  Symbol(..),
+  Type,
+  absname,
+  abstract,
+  cflags,
+  cnccats,
+  cncfuns,
+  concretes,
+  funs,
+  productions,
+  sequences,
+  totalCats
+  )
+
+import qualified Text.JSON as JSON
+import Text.JSON (JSValue(..))
+
+import qualified Data.Array.IArray as Array
+import Data.Map (Map)
+import qualified Data.Set as Set
 import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap

 pgf2json :: PGF -> String
 pgf2json pgf =
-  encode $ makeObj
-    [ ("abstract", abstract2json pgf)
-    , ("concretes", makeObj $ map concrete2json
-                                (Map.toList (languages pgf)))
+  JSON.encode $ JSON.makeObj
+    [ ("abstract", json_abstract)
+    , ("concretes", json_concretes)
+    ]
+ where
+   n  = showCId $ absname pgf
+   as = abstract pgf
+   cs = Map.assocs (concretes pgf)
+   start = showCId $ M.lookStartCat pgf
+   json_abstract = abstract2json n start as
+   json_concretes = JSON.makeObj $ map concrete2json cs
+
+abstract2json :: String -> String -> Abstr -> JSValue
+abstract2json name start ds =
+  JSON.makeObj
+    [ ("name", mkJSStr name)
+    , ("startcat", mkJSStr start)
+    , ("funs", JSON.makeObj $ map absdef2json (Map.assocs (funs ds)))
    ]

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

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

-concrete2json :: (ConcName,Concr) -> (String,JSValue)
-concrete2json (c,cnc) = (c,obj)
+concrete2json :: (CId,Concr) -> (String,JSValue)
+concrete2json (c,cnc) = (showCId c,obj)
  where
-    obj = makeObj
-      [ ("flags", makeObj [(k, lit2json v) | (k,v) <- concrFlags cnc])
-      , ("productions", makeObj [(show fid, showJSON (map frule2json (concrProductions cnc fid))) | (_,start,end,_) <- concrCategories cnc, fid <- [start..end]])
-      , ("functions", showJSON [ffun2json funid (concrFunction cnc funid) | funid <- [0..concrTotalFuns cnc-1]])
-      , ("sequences", showJSON [seq2json seqid (concrSequence cnc seqid) | seqid <- [0..concrTotalSeqs cnc-1]])
-      , ("categories", makeObj $ map cat2json (concrCategories cnc))
-      , ("totalfids", showJSON (concrTotalCats cnc))
+    obj = JSON.makeObj
+      [ ("flags", JSON.makeObj [ (showCId k, lit2json v) | (k,v) <- Map.toList (cflags cnc) ])
+      , ("productions", JSON.makeObj [ (show cat, JSArray (map frule2json (Set.toList set))) | (cat,set) <- IntMap.toList (productions cnc)])
+      , ("functions", JSArray (map ffun2json (Array.elems (cncfuns cnc))))
+      , ("sequences", JSArray (map seq2json (Array.elems (sequences cnc))))
+      , ("categories", JSON.makeObj $ map cats2json (Map.assocs (cnccats cnc)))
+      , ("totalfids", mkJSInt (totalCats cnc))
      ]

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

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

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

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

-seq2json :: SeqId -> [Symbol] -> JSValue
-seq2json seqid seq = showJSON [sym2json sym | sym <- seq]
+seq2json :: Array.Array DotPos Symbol -> JSValue
+seq2json seq = JSArray [sym2json s | s <- Array.elems seq]

 sym2json :: Symbol -> JSValue
-sym2json (SymCat n l)    = new "SymCat" [showJSON n, showJSON l]
-sym2json (SymLit n l)    = new "SymLit" [showJSON n, showJSON l]
-sym2json (SymVar n l)    = new "SymVar" [showJSON n, showJSON l]
-sym2json (SymKS t)       = new "SymKS"  [showJSON t]
+sym2json (SymCat n l)    = new "SymCat" [mkJSInt n, mkJSInt l]
+sym2json (SymLit n l)    = new "SymLit" [mkJSInt n, mkJSInt l]
+sym2json (SymVar n l)    = new "SymVar" [mkJSInt n, mkJSInt l]
+sym2json (SymKS t)       = new "SymKS"  [mkJSStr t]
 sym2json (SymKP ts alts) = new "SymKP"  [JSArray (map sym2json ts), JSArray (map alt2json alts)]
-sym2json SymBIND         = new "SymKS"  [showJSON "&+"]
-sym2json SymSOFT_BIND    = new "SymKS"  [showJSON "&+"]
-sym2json SymSOFT_SPACE   = new "SymKS"  [showJSON "&+"]
-sym2json SymCAPIT        = new "SymKS"  [showJSON "&|"]
-sym2json SymALL_CAPIT    = new "SymKS"  [showJSON "&|"]
+sym2json SymBIND         = new "SymKS"  [mkJSStr "&+"]
+sym2json SymSOFT_BIND    = new "SymKS"  [mkJSStr "&+"]
+sym2json SymSOFT_SPACE   = new "SymKS"  [mkJSStr "&+"]
+sym2json SymCAPIT        = new "SymKS"  [mkJSStr "&|"]
+sym2json SymALL_CAPIT    = new "SymKS"  [mkJSStr "&|"]
 sym2json SymNE           = new "SymNE"  []

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

 new :: String -> [JSValue] -> JSValue
 new f xs =
-  makeObj
-    [ ("type", showJSON f)
-    , ("args", showJSON xs)
+  JSON.makeObj
+    [ ("type", mkJSStr f)
+    , ("args", JSArray xs)
    ]
+
+-- | Make JSON value from string
+mkJSStr :: String -> JSValue
+mkJSStr = JSString . JSON.toJSString
+
+-- | Make JSON value from integer
+mkJSInt :: Integral a => a -> JSValue
+mkJSInt = JSRational False . toRational
--- a/src/compiler/GF/Compile/PGFtoJava.hs
+++ b/src/compiler/GF/Compile/PGFtoJava.hs
@@ -1,6 +1,6 @@
 module GF.Compile.PGFtoJava (grammar2java) where

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

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

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

     quantAsDet expr =
       case unApp expr of
-        Just (cid,es) -> if cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
+        Just (cid,es) -> if showCId cid == "DetQuant" then map (mkAPI False) [("Quant", head es),("Num",head $ tail es)]
                           else [mkAPI False ("Det",expr)]
                                  
        _             -> error $ "incorrect expression "++ (showExpr [] expr)
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -644,7 +644,7 @@ data TcResult a
 newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}

 instance Monad TcM where
-  return x = TcM (\ms msgs -> TcOk x ms msgs)
+  return = pure
  f >>= g  = TcM (\ms msgs -> case unTcM f ms msgs of
                                TcOk x ms msgs -> unTcM (g x) ms msgs
                                TcFail    msgs -> TcFail msgs)
@@ -659,7 +659,7 @@ instance Fail.MonadFail TcM where


 instance Applicative TcM where
-  pure = return
+  pure x = TcM (\ms msgs -> TcOk x ms msgs)
  (<*>) = ap

 instance Functor TcM where
--- a/src/compiler/GF/CompileInParallel.hs
+++ b/src/compiler/GF/CompileInParallel.hs
@@ -1,6 +1,6 @@
 -- | Parallel grammar compilation
 module GF.CompileInParallel(parallelBatchCompile) where
-import Prelude hiding (catch,(<>))
+import Prelude hiding (catch,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 import Control.Monad(join,ap,when,unless)
 import Control.Applicative
 import GF.Infra.Concurrency
@@ -36,8 +36,11 @@ import qualified Control.Monad.Fail as Fail
 parallelBatchCompile jobs opts rootfiles0 =
  do setJobs jobs
     rootfiles <- mapM canonical rootfiles0
-     lib_dir  <- canonical =<< getLibraryDirectory opts
-     filepaths <- mapM (getPathFromFile lib_dir opts) rootfiles
+     lib_dirs1 <- getLibraryDirectory opts
+     lib_dirs2 <- mapM canonical lib_dirs1
+     let lib_dir = head lib_dirs2
+     when (length lib_dirs2 >1) $ ePutStrLn ("GF_LIB_PATH defines more than one directory; using the first, " ++ show lib_dir)
+     filepaths <- mapM (getPathFromFile [lib_dir] opts) rootfiles
     let groups = groupFiles lib_dir filepaths
         n = length groups
     when (n>1) $ ePutStrLn "Grammar mixes present and alltenses, dividing modules into two groups"
@@ -58,11 +61,11 @@ parallelBatchCompile jobs opts rootfiles0 =

        usesPresent (_,paths) = take 1 libs==["present"]
          where
-            libs = [p|path<-paths,
-                      let (d,p0) = splitAt n path
-                          p = dropSlash p0,
-                      d==lib_dir,p `elem` all_modes]
-            n = length lib_dir  
+            libs = [p | path<-paths,
+                        let (d,p0) = splitAt n path
+                            p = dropSlash p0,
+                      d==lib_dir, p `elem` all_modes]
+            n = length lib_dir

        all_modes = ["alltenses","present"]

@@ -172,7 +175,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)

@@ -235,12 +238,12 @@ runCO (CO m) = do (o,x) <- m
 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 = return
+instance (Functor m,Monad m) => Applicative (CollectOutput m) where
+  pure x = CO (return (return (),x))
  (<*>) = ap

 instance Monad m => Monad (CollectOutput m) where
-  return x = CO (return (return (),x))
+  return     = pure
  CO m >>= f = CO $ do (o1,x) <- m
                       let CO m2 = f x
                       (o2,y) <- m2
--- a/src/compiler/GF/Compiler.hs
+++ b/src/compiler/GF/Compiler.hs
@@ -1,7 +1,8 @@
-module GF.Compiler (mainGFC, linkGrammars, writeGrammar, writeOutputs) where
+module GF.Compiler (mainGFC, linkGrammars, writePGF, writeOutputs) where

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

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

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

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

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

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


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

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

 outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
--- a/src/compiler/GF/Data/BacktrackM.hs
+++ b/src/compiler/GF/Data/BacktrackM.hs
@@ -64,11 +64,11 @@ finalStates :: BacktrackM s () -> s -> [s]
 finalStates bm = map fst . runBM bm

 instance Applicative (BacktrackM s) where
-    pure = return
+    pure a = BM (\c s b -> c a s b)
    (<*>) = ap

 instance Monad (BacktrackM s) where
-    return a   = BM (\c s b -> c a s b)
+    return     = pure
    BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
        where unBM (BM m) = m

--- a/src/compiler/GF/Data/ErrM.hs
+++ b/src/compiler/GF/Data/ErrM.hs
@@ -34,7 +34,7 @@ fromErr :: a -> Err a -> a
 fromErr a = err (const a) id

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

@@ -54,7 +54,7 @@ instance Functor Err where
  fmap f (Bad s) = Bad s

 instance Applicative Err where
-  pure = return
+  pure = Ok
  (<*>) = ap

 -- | added by KJ
--- a/src/compiler/GF/Grammar/BNFC.hs
+++ b/src/compiler/GF/Grammar/BNFC.hs
@@ -15,6 +15,7 @@
 module GF.Grammar.BNFC(BNFCRule(..), BNFCSymbol, Symbol(..), CFTerm(..), bnfc2cf) where

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

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

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

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

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

@@ -22,7 +22,8 @@ import GF.Infra.Option
 import GF.Infra.UseIO(MonadIO(..))
 import GF.Grammar.Grammar

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

 -- Please change this every time when the GFO format is changed
 gfoVersion = "GF04"
@@ -297,53 +298,6 @@ instance Binary Label where
             1 -> fmap LVar   get
             _ -> decodingError

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

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

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

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

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

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

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

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

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

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

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

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

 ruleIsNonRecursive :: Ord c => Set c -> Rule c t -> Bool
 ruleIsNonRecursive cs = noCatsInSet cs . ruleRhs
--- a/src/compiler/GF/Grammar/EBNF.hs
+++ b/src/compiler/GF/Grammar/EBNF.hs
@@ -16,6 +16,7 @@ module GF.Grammar.EBNF (EBNF, ERule, ERHS(..), ebnf2cf) where

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

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

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

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

 import GF.Infra.Ident
@@ -73,12 +73,12 @@ import GF.Infra.Location

 import GF.Data.Operations

-import PGF2(BindType(..))
-import PGF2.Internal(FId, FunId, SeqId, LIndex, Symbol)
+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


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

@@ -126,10 +126,20 @@ extends :: ModuleInfo -> [ModuleName]
 extends = map fst . mextend

 isInherited :: MInclude -> Ident -> Bool
-isInherited c i = case c of
-  MIAll -> True
-  MIOnly is -> elem i is
-  MIExcept is -> notElem i is
+isInherited c =
+  case c of
+    MIAll -> const True
+    MIOnly is -> elemOrd 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
@@ -4,7 +4,7 @@
 module GF.Grammar.Lexer
         ( Token(..), Posn(..)
         , P, runP, runPartial, token, lexer, getPosn, failLoc
-         , isReservedWord
+         , isReservedWord, invMap
         ) where

 import Control.Applicative
@@ -134,7 +134,7 @@ data Token
 | T_Double  Double          -- double precision float literals
 | T_Ident   Ident
 | T_EOF
-- deriving Show -- debug
+  deriving (Eq, Ord, Show) -- debug

 res = eitherResIdent
 eitherResIdent :: (Ident -> Token) -> Ident -> Token
@@ -224,6 +224,13 @@ 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
@@ -276,11 +283,11 @@ instance Functor P where
  fmap = liftA

 instance Applicative P where
-  pure = return
+  pure a = a `seq` (P $ \s -> POk s a)
  (<*>) = ap

 instance Monad P where
-  return a    = a `seq` (P $ \s -> POk s a)
+  return      = pure
  (P m) >>= k = P $ \ s -> case m s of
                             POk s a          -> unP (k a) s
                             PFailed posn err -> PFailed posn err
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -25,6 +25,7 @@ import GF.Compile.Update (buildAnyTree)
 import Data.List(intersperse)
 import Data.Char(isAlphaNum)
 import qualified Data.Map as Map
+import PGF(mkCId)

 }

@@ -36,6 +37,9 @@ import qualified Data.Map as Map
 %name pBNFCRules ListCFRule
 %name pEBNFRules ListEBNFRule

+%errorhandlertype explist
+%error { happyError }
+
 -- no lexer declaration
 %monad { P } { >>= } { return }
 %lexer { lexer } { T_EOF }
@@ -429,6 +433,7 @@ 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 }
@@ -624,7 +629,7 @@ ListCFRule

 CFRule :: { [BNFCRule] }
 CFRule
-  : Ident '.' Ident '::=' ListCFSymbol ';' { [BNFCRule (showIdent $3) $5 (CFObj (showIdent $1) [])]
+  : Ident '.' Ident '::=' ListCFSymbol ';' { [BNFCRule (showIdent $3) $5 (CFObj (mkCId (showIdent $1)) [])]
                                           }
  | Ident '::=' ListCFRHS ';'              { let { cat = showIdent $1;
                                                   mkFun cat its =
@@ -637,7 +642,7 @@ CFRule
                                                       Terminal    c     -> filter isAlphaNum c;
                                                       NonTerminal (t,_) -> t
                                                     }
-                                             } in map (\rhs -> BNFCRule cat rhs (CFObj (mkFun cat rhs) [])) $3
+                                             } in map (\rhs -> BNFCRule cat rhs (CFObj (mkCId (mkFun cat rhs)) [])) $3
                                           }
  | 'coercions' Ident Integer ';'          { [BNFCCoercions (showIdent $2) $3]}
  | 'terminator' NonEmpty Ident String ';' { [BNFCTerminator $2 (showIdent $3) $4] }
@@ -700,8 +705,18 @@ Posn

 {

-happyError :: P a
-happyError = fail "syntax error"
+happyError :: (Token, [String]) -> P a
+happyError (t,strs) = fail $ 
+  "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/Printer.hs
+++ b/src/compiler/GF/Grammar/Printer.hs
@@ -24,13 +24,13 @@ module GF.Grammar.Printer
           ) where
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

-import PGF2 as PGF2
-import PGF2.Internal as PGF2
 import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.Values
 import GF.Grammar.Grammar

+import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)
+
 import GF.Text.Pretty
 import Data.Maybe (isNothing)
 import Data.List  (intersperse)
@@ -362,40 +362,3 @@ getLet :: Term -> ([LocalDef], Term)
 getLet (Let l e) = let (ls,e') = getLet e
                   in (l:ls,e')
 getLet e         = ([],e)
-
-ppFunId funid = pp 'F' <> pp funid
-ppSeqId seqid = pp 'S' <> pp seqid
-
-ppFId fid
-  | fid == PGF2.fidString = pp "CString"
-  | fid == PGF2.fidInt    = pp "CInt"
-  | fid == PGF2.fidFloat  = pp "CFloat"
-  | fid == PGF2.fidVar    = pp "CVar"
-  | fid == PGF2.fidStart  = pp "CStart"
-  | otherwise             = pp 'C' <> pp fid
-
-ppMeta :: Int -> Doc
-ppMeta n
-  | n == 0    = pp '?'
-  | otherwise = pp '?' <> pp n
-
-ppLit (PGF2.LStr s) = pp (show s)
-ppLit (PGF2.LInt n) = pp n
-ppLit (PGF2.LFlt d) = pp d
-
-ppSeq (seqid,seq) = 
-  ppSeqId seqid <+> pp ":=" <+> hsep (map ppSymbol seq)
-
-ppSymbol (PGF2.SymCat d r) = pp '<' <> pp d <> pp ',' <> pp r <> pp '>'
-ppSymbol (PGF2.SymLit d r) = pp '{' <> pp d <> pp ',' <> pp r <> pp '}'
-ppSymbol (PGF2.SymVar d r) = pp '<' <> pp d <> pp ',' <> pp '$' <> pp r <> pp '>'
-ppSymbol (PGF2.SymKS t)    = doubleQuotes (pp t)
-ppSymbol PGF2.SymNE        = pp "nonExist"
-ppSymbol PGF2.SymBIND      = pp "BIND"
-ppSymbol PGF2.SymSOFT_BIND = pp "SOFT_BIND"
-ppSymbol PGF2.SymSOFT_SPACE= pp "SOFT_SPACE"
-ppSymbol PGF2.SymCAPIT     = pp "CAPIT"
-ppSymbol PGF2.SymALL_CAPIT = pp "ALL_CAPIT"
-ppSymbol (PGF2.SymKP syms alts) = pp "pre" <+> braces (hsep (punctuate (pp ';') (hsep (map ppSymbol syms) : map ppAlt alts)))
-
-ppAlt (syms,ps) = hsep (map ppSymbol syms) <+> pp '/' <+> hsep (map (doubleQuotes . pp) ps)
--- a/src/compiler/GF/Infra/BuildInfo.hs
+++ b/src/compiler/GF/Infra/BuildInfo.hs
@@ -1,16 +1,43 @@
 {-# 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
-    ++", flags:"
+    ++" with "++compilerName++"-"++showVersion compilerVersion ++ " at " ++ buildTime ++ "\nGit info: " ++ gitInfo
+    ++"\nFlags:"
 #ifdef USE_INTERRUPT
    ++" interrupt"
 #endif
 #ifdef SERVER_MODE
    ++" server"
 #endif
+#ifdef NEW_COMP
+    ++" new-comp"
+#endif
+#ifdef C_RUNTIME
+    ++" c-runtime"
+#endif
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -18,8 +18,8 @@ module GF.Infra.CheckM
           checkIn, checkInModule, checkMap, checkMapRecover,
           parallelCheck, accumulateError, commitCheck,
          ) where
-
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+
 import GF.Data.Operations
 --import GF.Infra.Ident
 --import GF.Grammar.Grammar(msrc) -- ,Context
@@ -48,7 +48,7 @@ newtype Check a
 instance Functor Check where fmap = liftM

 instance Monad Check where
-  return x = Check $ \{-ctxt-} ws -> (ws,Success x)
+  return   = pure
  f >>= g  = Check $ \{-ctxt-} ws ->
               case unCheck f {-ctxt-} ws of
                 (ws,Success x) -> unCheck (g x) {-ctxt-} ws
@@ -58,7 +58,7 @@ instance Fail.MonadFail Check where
  fail = raise

 instance Applicative Check where
-  pure = return
+  pure x = Check $ \{-ctxt-} ws -> (ws,Success x)
  (<*>) = ap

 instance ErrorMonad Check where
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -31,7 +31,7 @@ import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
                 -- Limit use of BS functions to the ones that work correctly on
                 -- UTF-8-encoded bytestrings!
 import Data.Char(isDigit)
-import Data.Binary(Binary(..))
+import PGF.Internal(Binary(..))
 import GF.Text.Pretty


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

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

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

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

+import PGF.Internal(Literal(..))
 import qualified Control.Monad.Fail as Fail

 usageHeader :: String
@@ -74,6 +76,7 @@ errors = raise . unlines

 data Mode = ModeVersion | ModeHelp
          | ModeInteractive | ModeRun
+          | ModeInteractive2 | ModeRun2
          | ModeCompiler
          | ModeServer {-port::-}Int
  deriving (Show,Eq,Ord)
@@ -92,6 +95,7 @@ data OutputFormat = FmtPGFPretty
                  | FmtPython
                  | FmtHaskell
                  | FmtJava
+                  | FmtProlog
                  | FmtBNF
                  | FmtEBNF
                  | FmtRegular
@@ -158,7 +162,7 @@ data Flags = Flags {
      optLiteralCats     :: Set Ident,
      optGFODir          :: Maybe FilePath,
      optOutputDir       :: Maybe FilePath,
-      optGFLibPath       :: Maybe FilePath,
+      optGFLibPath       :: Maybe [FilePath],
      optDocumentRoot    :: Maybe FilePath, -- For --server mode
      optRecomp          :: Recomp,
      optProbsFile       :: Maybe FilePath,
@@ -213,9 +217,10 @@ parseModuleOptions args = do
    then return opts
    else errors $ map ("Non-option among module options: " ++) nonopts

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

 -- Showing options

@@ -311,6 +316,8 @@ optDescr =
     Option ['j'] ["jobs"] (OptArg jobs "N") "Compile N modules in parallel with -batch (default 1).",
     Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
     Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).",
+     Option [] ["cshell"] (NoArg (mode ModeInteractive2)) "Start the C run-time shell.",
+     Option [] ["crun"] (NoArg (mode ModeRun2)) "Start the C run-time shell, showing output only (no other messages).",
     Option [] ["server"] (OptArg modeServer "port") $
       "Run in HTTP server mode on given port (default "++show defaultPort++").",
     Option [] ["document-root"] (ReqArg gfDocuRoot "DIR")
@@ -425,7 +432,7 @@ optDescr =
       literalCat  x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) }
       lexicalCat  x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) }
       outDir      x = set $ \o -> o { optOutputDir = Just x }
-       gfLibPath   x = set $ \o -> o { optGFLibPath = Just x }
+       gfLibPath   x = set $ \o -> o { optGFLibPath = Just $ splitInModuleSearchPath x }
       gfDocuRoot  x = set $ \o -> o { optDocumentRoot = Just x }
       recomp      x = set $ \o -> o { optRecomp = x }
       probsFile   x = set $ \o -> o { optProbsFile = Just x }
@@ -473,9 +480,12 @@ outputFormatsExpl =
    [(("pgf_pretty",   FmtPGFPretty),"human-readable pgf"),
     (("canonical_gf", FmtCanonicalGF),"Canonical GF source files"),
     (("canonical_json", FmtCanonicalJson),"Canonical JSON source files"),
+     (("js",           FmtJavaScript),"JavaScript (whole grammar)"),
     (("json",         FmtJSON),"JSON (whole grammar)"),
+     (("python",       FmtPython),"Python (whole grammar)"),
     (("haskell",      FmtHaskell),"Haskell (abstract syntax)"),
     (("java",         FmtJava),"Java (abstract syntax)"),
+     (("prolog",       FmtProlog),"Prolog (whole grammar)"),
     (("bnf",          FmtBNF),"BNF (context-free grammar)"),
     (("ebnf",         FmtEBNF),"Extended BNF"),
     (("regular",      FmtRegular),"* regular grammar"),
--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -12,6 +12,9 @@ module GF.Infra.SIO(
       newStdGen,print,putStr,putStrLn,
       -- ** Specific to GF
       importGrammar,importSource,
+#ifdef C_RUNTIME
+       readPGF2,
+#endif
       putStrLnFlush,runInterruptibly,lazySIO,
       -- * Restricted accesss to arbitrary (potentially unsafe) IO operations
       -- | If the environment variable GF_RESTRICTED is defined, these
@@ -36,6 +39,9 @@ import qualified System.Random as IO(newStdGen)
 import qualified GF.Infra.UseIO as IO(getLibraryDirectory)
 import qualified GF.System.Signal as IO(runInterruptibly)
 import qualified GF.Command.Importing as GF(importGrammar, importSource)
+#ifdef C_RUNTIME
+import qualified PGF2
+#endif
 import qualified Control.Monad.Fail as Fail

 -- * The SIO monad
@@ -46,11 +52,11 @@ newtype SIO a = SIO {unS::PutStr->IO a}
 instance Functor SIO where fmap = liftM

 instance Applicative SIO where
-  pure = return
+  pure x = SIO (const (pure x))
  (<*>) = ap

 instance Monad SIO where
-  return x = SIO (const (return x))
+  return         = pure
  SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h

 instance Fail.MonadFail SIO where
@@ -121,3 +127,7 @@ lazySIO              = lift1   lazyIO

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

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

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

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

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

 getSubdirs :: FilePath -> IO [FilePath]
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -5,7 +5,7 @@ module GF.Interactive (mainGFI,mainRunGFI,mainServerGFI) where
 import Prelude hiding (putStrLn,print)
 import qualified Prelude as P(putStrLn)
 import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
-import GF.Command.Commands(HasPGF(..),pgfCommands)
+import GF.Command.Commands(PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
 import GF.Command.CommonCommands(commonCommands,extend)
 import GF.Command.SourceCommands
 import GF.Command.CommandInfo
@@ -20,21 +20,29 @@ import GF.Infra.SIO
 import GF.Infra.Option
 import qualified System.Console.Haskeline as Haskeline

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

 import Data.Char
 import Data.List(isPrefixOf)
 import qualified Data.Map as Map
 import qualified Text.ParserCombinators.ReadP as RP
+--import System.IO(utf8)
+--import System.CPUTime(getCPUTime)
 import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
 import Control.Exception(SomeException,fromException,evaluate,try)
 import Control.Monad.State hiding (void)
+import Control.Monad (join, when, (<=<))
 import qualified GF.System.Signal as IO(runInterruptibly)
 #ifdef SERVER_MODE
 import GF.Server(server)
 #endif

 import GF.Command.Messages(welcome)
+#if !(MIN_VERSION_base(4,9,0))
+-- Needed to make it compile on GHC < 8
+import Control.Monad.Trans.Instances ()
+#endif

 -- | Run the GF Shell in quiet mode (@gf -run@).
 mainRunGFI :: Options -> [FilePath] -> IO ()
@@ -275,18 +283,17 @@ importInEnv opts files =
     if flag optRetainResource opts
      then do src <- lift $ importSource opts files
              pgf <- lift . lazySIO $ importPGF pgf0 -- duplicates some work, better to link src
-              modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgf)}
+              modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgfEnv pgf)}
      else do pgf1 <- lift $ importPGF pgf0
              modify $ \ gfenv->gfenv { retain=False,
-                                        pgfenv = (emptyGrammar,pgf1) }
+                                        pgfenv = (emptyGrammar,pgfEnv pgf1) }
  where
    importPGF pgf0 =
      do let opts' = addOptions (setOptimization OptCSE False) opts
         pgf1 <- importGrammar pgf0 opts' files
         if (verbAtLeast opts Normal)
-           then case pgf1 of
-                  Just pgf -> putStrLnFlush $ unwords $ "\nLanguages:" : Map.keys (languages pgf)
-                  Nothing  -> return ()
+           then putStrLnFlush $
+                  unwords $ "\nLanguages:" : map showCId (languages pgf1)
           else return ()
         return pgf1

@@ -297,12 +304,12 @@ tryGetLine = do
   Right l -> return l

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

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

 data GFEnv = GFEnv {
    startOpts :: Options,
@@ -314,10 +321,10 @@ data GFEnv = GFEnv {

 emptyGFEnv opts = GFEnv opts False emptyCmdEnv emptyCommandEnv []

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

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

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

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

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

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

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

 -- | Run the GF main program, taking arguments from the command line.
@@ -20,6 +24,7 @@ import System.Exit
 -- Run @gf --help@ for usage info.
 main :: IO ()
 main = do
+  setLocaleEncoding utf8
  -- setConsoleEncoding
  uncurry mainOpts =<< getOptions

@@ -43,9 +48,22 @@ getOptions = do
 mainOpts :: Options -> [FilePath] -> IO ()
 mainOpts opts files =
    case flag optMode opts of
-      ModeVersion     -> putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ buildInfo
+      ModeVersion     -> do datadir <- getDataDir
+                            putStrLn $ "Grammatical Framework (GF) version " ++ showVersion version ++ "\n" ++ 
+                                       buildInfo ++ "\n" ++
+                                       "Shared folder: " ++ datadir
      ModeHelp        -> putStrLn helpMessage
-      ModeServer port -> mainServerGFI opts port files
+      ModeServer port -> GFI1.mainServerGFI opts port files
      ModeCompiler    -> mainGFC opts files
-      ModeInteractive -> mainGFI opts files
-      ModeRun         -> mainRunGFI opts files
+      ModeInteractive -> GFI1.mainGFI opts files
+      ModeRun         -> GFI1.mainRunGFI opts files
+#ifdef C_RUNTIME
+      ModeInteractive2 -> GFI2.mainGFI opts files
+      ModeRun2         -> GFI2.mainRunGFI opts files
+#else
+      ModeInteractive2 -> noCruntime
+      ModeRun2         -> noCruntime
+  where
+    noCruntime = do ePutStrLn "GF configured without C run-time support"
+                    exitFailure
+#endif
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -18,8 +18,13 @@ module GF.Quiz (
  morphologyList
  ) where

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

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

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

 morphologyList :: 
-  Maybe Expr -> PGF -> Concr -> Type -> Int -> IO [(String,[String])]
+  Maybe Expr -> PGF -> Language -> Type -> Int -> IO [(String,[String])]
 morphologyList mex pgf ig typ number = do
  gen <- newStdGen
  let ts   = take (max 1 number) $ case mex of
                                     Just ex -> generateRandomFrom gen pgf ex
                                     Nothing -> generateRandom     gen pgf typ
-  let ss    = map (tabularLinearizeAll ig) ts
+  let ss    = map (tabularLinearizes pgf ig) ts
  let size  = length (head (head ss))
  let forms = take number $ randomRs (0,size-1) gen
  return [(snd (head pws0) +++ fst (pws0 !! i), ws) | 
--- a/src/compiler/GF/Server.hs
+++ b/src/compiler/GF/Server.hs
@@ -3,6 +3,7 @@
 module GF.Server(server) where
 import Data.List(partition,stripPrefix,isInfixOf)
 import qualified Data.Map as M
+import Control.Applicative -- for GHC<7.10
 import Control.Monad(when)
 import Control.Monad.State(StateT(..),get,gets,put)
 import Control.Monad.Except(ExceptT(..),runExceptT)
@@ -33,7 +34,7 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),noCache)
 --import qualified Network.FastCGI as FCGI -- from hackage direct-fastcgi
 import Network.CGI(handleErrors,liftIO)
 import CGIUtils(handleCGIErrors)--,outputJSONP,stderrToFile
-import Text.JSON(encode,showJSON,makeObj)
+import Text.JSON(JSValue(..),Result(..),valFromObj,encode,decode,showJSON,makeObj)
 --import System.IO.Silently(hCapture)
 import System.Process(readProcessWithExitCode)
 import System.Exit(ExitCode(..))
@@ -42,6 +43,7 @@ import GF.Infra.UseIO(readBinaryFile,writeBinaryFile,ePutStrLn)
 import GF.Infra.SIO(captureSIO)
 import GF.Data.Utilities(apSnd,mapSnd)
 import qualified PGFService as PS
+import qualified ExampleService as ES
 import Data.Version(showVersion)
 import Paths_gf(getDataDir,version)
 import GF.Infra.BuildInfo (buildInfo)
@@ -169,6 +171,7 @@ handle logLn documentroot state0 cache execute1 stateVar
               (_  ,_             ,".pgf") -> do --debug $ "PGF service: "++path
                                                 wrapCGI $ PS.cgiMain' cache path
               (dir,"grammars.cgi",_     ) -> grammarList dir (decoded qs)
+               (dir  ,"exb.fcgi"  ,_    ) -> wrapCGI $ ES.cgiMain' root dir (PS.pgfCache cache)
               _ -> serveStaticFile rpath path
             where path = translatePath rpath
           _ -> return $ resp400 upath
@@ -177,7 +180,7 @@ handle logLn documentroot state0 cache execute1 stateVar

    translatePath rpath = root</>rpath -- hmm, check for ".."

-    versionInfo c =
+    versionInfo (c1,c2) =
        html200 . unlines $
           "<!DOCTYPE html>":
           "<meta name = \"viewport\" content = \"width = device-width\">":
@@ -185,7 +188,8 @@ handle logLn documentroot state0 cache execute1 stateVar
           "":
           ("<h2>"++hdr++"</h2>"):
           (zipWith (++) ("<p>":repeat "<br>") buildinfo)++
-           sh "Run-time system" c
+           sh "Haskell run-time system" c1++
+           sh "C run-time system" c2
      where
        hdr:buildinfo = lines gf_version
        rel = makeRelative documentroot
@@ -280,13 +284,17 @@ handle logLn documentroot state0 cache execute1 stateVar
    skip_empty = filter (not.null.snd)

    jsonList = jsonList' return
-    jsonListLong = jsonList' (mapM addTime)
+    jsonListLong ext = jsonList' (mapM (addTime ext)) ext
    jsonList' details ext = fmap (json200) (details =<< ls_ext "." ext)

-    addTime path =
+    addTime ext path =
        do t <- getModificationTime path
-           return $ makeObj ["path".=path,"time".=format t]
+           if ext==".json"
+             then addComment (time t) <$> liftIO (try $ getComment path)
+             else return . makeObj $ time t
      where
+        addComment t = makeObj . either (const t) (\c->t++["comment".=c])
+        time t = ["path".=path,"time".=format t]
        format = formatTime defaultTimeLocale rfc822DateFormat

    rm path | takeExtension path `elem` ok_to_delete =
@@ -328,6 +336,11 @@ handle logLn documentroot state0 cache execute1 stateVar
        do paths <- getDirectoryContents dir
           return [path | path<-paths, takeExtension path==ext]

+    getComment path =
+       do Ok (JSObject obj) <- decode <$> readFile path
+          Ok cmnt <- return (valFromObj "comment" obj)
+          return (cmnt::String)
+
 -- * Dynamic content

 jsonresult cwd dir cmd (ecode,stdout,stderr) files =
--- a/src/compiler/GF/Speech/CFGToFA.hs
+++ b/src/compiler/GF/Speech/CFGToFA.hs
@@ -14,6 +14,7 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set

+import PGF.Internal
 import GF.Data.Utilities
 import GF.Grammar.CFG
 --import GF.Speech.PGFToCFG
--- a/src/compiler/GF/Speech/GSL.hs
+++ b/src/compiler/GF/Speech/GSL.hs
@@ -7,13 +7,15 @@
 -----------------------------------------------------------------------------

 module GF.Speech.GSL (gslPrinter) where
+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

-import Prelude hiding ((<>))
+--import GF.Data.Utilities
 import GF.Grammar.CFG
 import GF.Speech.SRG
 import GF.Speech.RegExp
 import GF.Infra.Option
-import PGF2
+--import GF.Infra.Ident
+import PGF

 import Data.Char (toUpper,toLower)
 import Data.List (partition)
@@ -22,7 +24,7 @@ import GF.Text.Pretty
 width :: Int
 width = 75

-gslPrinter :: Options -> PGF -> Concr -> String
+gslPrinter :: Options -> PGF -> CId -> String
 gslPrinter opts pgf cnc = renderStyle st $ prGSL $ makeNonLeftRecursiveSRG opts pgf cnc
  where st = style { lineLength = width }

--- a/src/compiler/GF/Speech/JSGF.hs
+++ b/src/compiler/GF/Speech/JSGF.hs
@@ -11,14 +11,15 @@
 -----------------------------------------------------------------------------

 module GF.Speech.JSGF (jsgfPrinter) where
+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

-import Prelude hiding ((<>))
+--import GF.Data.Utilities
 import GF.Infra.Option
 import GF.Grammar.CFG
 import GF.Speech.RegExp
 import GF.Speech.SISR
 import GF.Speech.SRG
-import PGF2
+import PGF

 import Data.Char
 import Data.List
@@ -30,8 +31,8 @@ width :: Int
 width = 75

 jsgfPrinter :: Options
-	        -> PGF 
-            -> Concr -> String
+            -> PGF
+            -> CId -> String
 jsgfPrinter opts pgf cnc = renderStyle st $ prJSGF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
  where st = style { lineLength = width }
        sisr = flag optSISR opts
--- a/src/compiler/GF/Speech/PGFToCFG.hs
+++ b/src/compiler/GF/Speech/PGFToCFG.hs
@@ -6,54 +6,60 @@
 ----------------------------------------------------------------------
 module GF.Speech.PGFToCFG (bnfPrinter, pgfToCFG) where

-import PGF2
-import PGF2.Internal
+import PGF(showCId)
+import PGF.Internal as PGF
+--import GF.Infra.Ident
 import GF.Grammar.CFG hiding (Symbol)

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

-bnfPrinter :: PGF -> Concr -> String
+bnfPrinter :: PGF -> CId -> String
 bnfPrinter = toBNF id

-toBNF :: (CFG -> CFG) -> PGF -> Concr -> String
+toBNF :: (CFG -> CFG) -> PGF -> CId -> String
 toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc

 type Profile = [Int]

-pgfToCFG :: PGF -> Concr -> CFG
-pgfToCFG pgf cnc = mkCFG start_cat extCats (startRules ++ concatMap ruleToCFRule rules)
+pgfToCFG :: PGF
+          -> CId   -- ^ Concrete syntax name
+          -> CFG
+pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ concatMap ruleToCFRule rules)
  where
-    (_,start_cat,_) = unType (startCat pgf)
+    cnc = lookConcr pgf lang

    rules :: [(FId,Production)]
-    rules = [(fcat,prod) | fcat <- [0..concrTotalCats cnc],
-                           prod <- concrProductions cnc fcat]
+    rules = [(fcat,prod) | (fcat,set) <- IntMap.toList (PGF.productions cnc)
+                         , prod <- Set.toList set]

    fcatCats :: Map FId Cat
-    fcatCats = Map.fromList [(fc, c ++ "_" ++ show i) 
-                                 | (c,s,e,lbls) <- concrCategories cnc,
-                                   (fc,i) <- zip [s..e] [1..]]
+    fcatCats = Map.fromList [(fc, showCId c ++ "_" ++ show i)
+                                 | (c,CncCat s e lbls) <- Map.toList (cnccats cnc),
+                                   (fc,i) <- zip (range (s,e)) [1..]]

    fcatCat :: FId -> Cat
    fcatCat c = Map.findWithDefault ("Unknown_" ++ show c) c fcatCats

-    fcatToCat :: FId -> Int -> Cat
+    fcatToCat :: FId -> LIndex -> Cat
    fcatToCat c l = fcatCat c ++ row
      where row = if catLinArity c == 1 then "" else "_" ++ show l

    -- gets the number of fields in the lincat for the given category
    catLinArity :: FId -> Int
-    catLinArity c = maximum (1:[length rhs | ((_,rhs), _) <- topdownRules c])
+    catLinArity c = maximum (1:[rangeSize (bounds rhs) | (CncFun _ rhs, _) <- topdownRules c])

    topdownRules cat = f cat []
      where
-        f cat rules = foldr g rules (concrProductions cnc cat)
-	 
-        g (PApply funid args) rules = (concrFunction cnc funid,args) : rules
+        f cat rules = maybe rules (Set.foldr g rules) (IntMap.lookup cat (productions cnc))
+
+        g (PApply funid args) rules = (cncfuns cnc ! funid,args) : rules
        g (PCoerce cat)       rules = f cat rules


@@ -61,26 +67,26 @@ pgfToCFG pgf cnc = mkCFG start_cat extCats (startRules ++ concatMap ruleToCFRule
    extCats = Set.fromList $ map ruleLhs startRules

    startRules :: [CFRule]
-    startRules = [Rule c [NonTerminal (fcatToCat fc r)] (CFRes 0) 
-                      | (c,s,e,lbls) <- concrCategories cnc,
-                        fc <- [s..e], not (isPredefFId fc),
+    startRules = [Rule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0)
+                      | (c,CncCat s e lbls) <- Map.toList (cnccats cnc),
+                        fc <- range (s,e), not (isPredefFId fc),
                        r <- [0..catLinArity fc-1]]

    ruleToCFRule :: (FId,Production) -> [CFRule]
    ruleToCFRule (c,PApply funid args) =
        [Rule (fcatToCat c l) (mkRhs row) (profilesToTerm [fixProfile row n | n <- [0..length args-1]])
-           | (l,seqid) <- zip [0..] rhs
-           , let row = concrSequence cnc seqid
+           | (l,seqid) <- Array.assocs rhs
+           , let row = sequences cnc ! seqid
           , not (containsLiterals row)]
      where
-        (f, rhs) = concrFunction cnc funid
+        CncFun f rhs = cncfuns cnc ! funid

-        mkRhs :: [Symbol] -> [CFSymbol]
-        mkRhs = concatMap symbolToCFSymbol
+        mkRhs :: Array DotPos Symbol -> [CFSymbol]
+        mkRhs = concatMap symbolToCFSymbol . Array.elems

-        containsLiterals :: [Symbol] -> Bool
-        containsLiterals row = not (null ([n | SymLit n _ <- row] ++
-                                          [n | SymVar n _ <- row]))
+        containsLiterals :: Array DotPos Symbol -> Bool
+        containsLiterals row = not (null ([n | SymLit n _ <- Array.elems row] ++
+                                          [n | SymVar n _ <- Array.elems row]))

        symbolToCFSymbol :: Symbol -> [CFSymbol]
        symbolToCFSymbol (SymCat n l)    = [let PArg _ fid = args!!n in NonTerminal (fcatToCat fid l)]
@@ -96,10 +102,10 @@ pgfToCFG pgf cnc = mkCFG start_cat extCats (startRules ++ concatMap ruleToCFRule
        symbolToCFSymbol SymALL_CAPIT    = [Terminal "&|"]
        symbolToCFSymbol SymNE           = []

-        fixProfile :: [Symbol] -> Int -> Profile
+        fixProfile :: Array DotPos Symbol -> Int -> Profile
        fixProfile row i = [k | (k,j) <- nts, j == i]
            where
-              nts = zip [0..] [j | nt <- row, j <- getPos nt]
+              nts = zip [0..] [j | nt <- Array.elems row, j <- getPos nt]

              getPos (SymCat j _) = [j]
              getPos (SymLit j _) = [j]
@@ -107,10 +113,9 @@ pgfToCFG pgf cnc = mkCFG start_cat extCats (startRules ++ concatMap ruleToCFRule

        profilesToTerm :: [Profile] -> CFTerm
        profilesToTerm ps = CFObj f (zipWith profileToTerm argTypes ps)
-            where Just (hypos,_,_) = fmap unType (functionType pgf f)
-                  argTypes = [cat | (_,_,ty) <- hypos, let (_,cat,_) = unType ty]
+            where (argTypes,_) = catSkeleton $ lookType (abstract pgf) f

-        profileToTerm :: Fun -> Profile -> CFTerm
+        profileToTerm :: CId -> Profile -> CFTerm
        profileToTerm t [] = CFMeta t
        profileToTerm _ xs = CFRes (last xs) -- FIXME: unify
    ruleToCFRule (c,PCoerce c') =
--- a/src/compiler/GF/Speech/PrRegExp.hs
+++ b/src/compiler/GF/Speech/PrRegExp.hs
@@ -11,12 +11,12 @@ import GF.Grammar.CFG
 import GF.Speech.CFGToFA
 import GF.Speech.PGFToCFG
 import GF.Speech.RegExp
-import PGF2
+import PGF

-regexpPrinter :: PGF -> Concr -> String
+regexpPrinter :: PGF -> CId -> String
 regexpPrinter pgf cnc = (++"\n") $ prRE id $ dfa2re $ cfgToFA $ pgfToCFG pgf cnc

-multiRegexpPrinter :: PGF -> Concr -> String
+multiRegexpPrinter :: PGF -> CId -> String
 multiRegexpPrinter pgf cnc = prREs $ mfa2res $ cfgToMFA $ pgfToCFG pgf cnc

 prREs :: [(String,RE CFSymbol)] -> String
--- a/src/compiler/GF/Speech/SISR.hs
+++ b/src/compiler/GF/Speech/SISR.hs
@@ -10,9 +10,13 @@ module GF.Speech.SISR (SISRFormat(..), SISRTag, prSISR,

 import Data.List

+--import GF.Data.Utilities
+--import GF.Infra.Ident
 import GF.Infra.Option (SISRFormat(..))
 import GF.Grammar.CFG
 import GF.Speech.SRG (SRGNT)
+import PGF(showCId)
+
 import qualified GF.JavaScript.AbsJS   as JS
 import qualified GF.JavaScript.PrintJS as JS

@@ -46,12 +50,12 @@ catSISR t (c,i) fmt
 profileFinalSISR :: CFTerm -> SISRFormat -> SISRTag
 profileFinalSISR term fmt = [JS.DExpr $ fmtOut fmt `ass` f term]
  where 
-        f (CFObj n ts) = tree n (map f ts)
+        f (CFObj n ts) = tree (showCId n) (map f ts)
        f (CFAbs v x) = JS.EFun [var v] [JS.SReturn (f x)]
        f (CFApp x y) = JS.ECall (f x) [f y]
        f (CFRes i) = JS.EIndex (JS.EVar args) (JS.EInt (fromIntegral i))
        f (CFVar v) = JS.EVar (var v)
-        f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr typ)]
+        f (CFMeta typ) = obj [("name",JS.EStr "?"), ("type",JS.EStr (showCId typ))]

 fmtOut SISR_WD20030401 = JS.EVar (JS.Ident "$")
 fmtOut SISR_1_0 = JS.EVar (JS.Ident "out")
--- a/src/compiler/GF/Speech/SLF.hs
+++ b/src/compiler/GF/Speech/SLF.hs
@@ -16,14 +16,17 @@ module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,
 import GF.Data.Utilities
 import GF.Grammar.CFG
 import GF.Speech.FiniteState
+--import GF.Speech.CFG
 import GF.Speech.CFGToFA
 import GF.Speech.PGFToCFG
 import qualified GF.Data.Graphviz as Dot
-import PGF2
+import PGF
+--import PGF.CId

 import Control.Monad
 import qualified Control.Monad.State as STM
 import Data.Char (toUpper)
+--import Data.List
 import Data.Maybe

 data SLFs = SLFs [(String,SLF)] SLF
@@ -40,7 +43,7 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }

 type SLF_FA = FA State (Maybe CFSymbol) ()

-mkFAs :: PGF -> Concr -> (SLF_FA, [(String,SLF_FA)])
+mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])
 mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
  where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc
        main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa
@@ -61,7 +64,7 @@ renameSubs (MFA start subs) = MFA (newName start) subs'
 -- * SLF graphviz printing (without sub-networks)
 --

-slfGraphvizPrinter :: PGF -> Concr -> String
+slfGraphvizPrinter :: PGF -> CId -> String
 slfGraphvizPrinter pgf cnc
    = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
  where 
@@ -71,7 +74,7 @@ slfGraphvizPrinter pgf cnc
 -- * SLF graphviz printing (with sub-networks)
 --

-slfSubGraphvizPrinter :: PGF -> Concr -> String
+slfSubGraphvizPrinter :: PGF -> CId -> String
 slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g
  where (main, subs) = mkFAs pgf cnc
        g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] 
@@ -97,7 +100,7 @@ gvSLFFA n fa =
 -- * SLF printing (without sub-networks)
 --

-slfPrinter :: PGF -> Concr -> String
+slfPrinter :: PGF -> CId -> String
 slfPrinter pgf cnc
    = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc

@@ -106,7 +109,7 @@ slfPrinter pgf cnc
 --

 -- | Make a network with subnetworks in SLF
-slfSubPrinter :: PGF -> Concr -> String
+slfSubPrinter :: PGF -> CId -> String
 slfSubPrinter pgf cnc = prSLFs slfs
  where 
  (main,subs) = mkFAs pgf cnc
--- a/src/compiler/GF/Speech/SRG.hs
+++ b/src/compiler/GF/Speech/SRG.hs
@@ -17,15 +17,21 @@ module GF.Speech.SRG (SRG(..), SRGRule(..), SRGAlt(..), SRGItem, SRGSymbol
                     , lookupFM_
                     ) where

-import PGF2
+--import GF.Data.Operations
 import GF.Data.Utilities
+--import GF.Infra.Ident
 import GF.Infra.Option
 import GF.Grammar.CFG
 import GF.Speech.PGFToCFG
+--import GF.Data.Relation
+--import GF.Speech.FiniteState
 import GF.Speech.RegExp
 import GF.Speech.CFGToFA
+--import GF.Infra.Option
+import PGF

 import Data.List
+--import Data.Maybe (fromMaybe, maybeToList)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -56,16 +62,16 @@ type SRGSymbol = Symbol SRGNT Token
 -- | An SRG non-terminal. Category name and its number in the profile.
 type SRGNT = (Cat, Int)

-ebnfPrinter :: Options -> PGF -> Concr -> String
+ebnfPrinter :: Options -> PGF -> CId -> String
 ebnfPrinter opts pgf cnc = prSRG opts $ makeSRG opts pgf cnc

-- | Create a compact filtered non-left-recursive SRG. 
-makeNonLeftRecursiveSRG :: Options -> PGF -> Concr -> SRG
+-- | Create a compact filtered non-left-recursive SRG.
+makeNonLeftRecursiveSRG :: Options -> PGF -> CId -> SRG
 makeNonLeftRecursiveSRG opts = makeSRG opts'
    where
      opts' = setDefaultCFGTransform opts CFGNoLR True

-makeSRG :: Options -> PGF -> Concr -> SRG
+makeSRG :: Options -> PGF -> CId -> SRG
 makeSRG opts = mkSRG cfgToSRG preprocess
    where
      cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
@@ -91,7 +97,7 @@ stats g = "Categories: " ++ show (countCats g)
 -}
 makeNonRecursiveSRG :: Options
                    -> PGF
-                    -> Concr
+                    -> CId -- ^ Concrete syntax name.
                    -> SRG
 makeNonRecursiveSRG opts = mkSRG cfgToSRG id
    where
@@ -99,17 +105,17 @@ makeNonRecursiveSRG opts = mkSRG cfgToSRG id
          where
            MFA _ dfas = cfgToMFA cfg
            dfaToSRGItem = mapRE dummySRGNT . minimizeRE . dfa2re
-            dummyCFTerm = CFMeta "dummy"
+            dummyCFTerm = CFMeta (mkCId "dummy")
            dummySRGNT = mapSymbol (\c -> (c,0)) id

-mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> Concr -> SRG
+mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
 mkSRG mkRules preprocess pgf cnc =
-    SRG { srgName = concreteName cnc,
-	      srgStartCat = cfgStartCat cfg,
+    SRG { srgName = showCId cnc,
+          srgStartCat = cfgStartCat cfg,
          srgExternalCats = cfgExternalCats cfg,
-          srgLanguage = languageCode cnc,
-	  srgRules = mkRules cfg }
-    where cfg = renameCats (concreteName cnc) $ preprocess $ pgfToCFG pgf cnc
+          srgLanguage = languageCode pgf cnc,
+          srgRules = mkRules cfg }
+    where cfg = renameCats (showCId cnc) $ preprocess $ pgfToCFG pgf cnc

 -- | Renames all external cats C to C_cat, and all internal cats C_X (where X is any string),
 --   to C_N where N is an integer.
--- a/src/compiler/GF/Speech/SRGS_ABNF.hs
+++ b/src/compiler/GF/Speech/SRGS_ABNF.hs
@@ -18,27 +18,31 @@
 -----------------------------------------------------------------------------

 module GF.Speech.SRGS_ABNF (srgsAbnfPrinter, srgsAbnfNonRecursivePrinter) where
+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

-import Prelude hiding ((<>))
+--import GF.Data.Utilities
 import GF.Infra.Option
 import GF.Grammar.CFG
 import GF.Speech.SISR as SISR
 import GF.Speech.SRG
 import GF.Speech.RegExp
-import PGF2 (PGF,Concr)
+import PGF (PGF, CId)

+--import Data.Char
 import Data.List
 import Data.Maybe
 import GF.Text.Pretty
+--import Debug.Trace

 width :: Int
 width = 75

-srgsAbnfPrinter :: Options -> PGF -> Concr -> String
+srgsAbnfPrinter :: Options
+                -> PGF -> CId -> String
 srgsAbnfPrinter opts pgf cnc = showDoc $ prABNF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
    where sisr = flag optSISR opts

-srgsAbnfNonRecursivePrinter :: Options -> PGF -> Concr -> String
+srgsAbnfNonRecursivePrinter :: Options -> PGF -> CId -> String
 srgsAbnfNonRecursivePrinter opts pgf cnc = showDoc $ prABNF Nothing $ makeNonRecursiveSRG opts pgf cnc

 showDoc = renderStyle (style { lineLength = width })
--- a/src/compiler/GF/Speech/SRGS_XML.hs
+++ b/src/compiler/GF/Speech/SRGS_XML.hs
@@ -13,7 +13,7 @@ import GF.Grammar.CFG
 import GF.Speech.RegExp
 import GF.Speech.SISR as SISR
 import GF.Speech.SRG
-import PGF2 (PGF, Concr)
+import PGF (PGF, CId, Token)

 --import Control.Monad
 --import Data.Char (toUpper,toLower)
@@ -22,11 +22,11 @@ import Data.Maybe
 --import qualified Data.Map as Map

 srgsXmlPrinter :: Options
-               -> PGF -> Concr -> String
+               -> PGF -> CId -> String
 srgsXmlPrinter opts pgf cnc = prSrgsXml sisr $ makeNonLeftRecursiveSRG opts pgf cnc
    where sisr = flag optSISR opts

-srgsXmlNonRecursivePrinter :: Options -> PGF -> Concr -> String
+srgsXmlNonRecursivePrinter :: Options -> PGF -> CId -> String
 srgsXmlNonRecursivePrinter opts pgf cnc = prSrgsXml Nothing $ makeNonRecursiveSRG opts pgf cnc


--- a/Show More
+++ b/Show More
Author	SHA1	Message	Date
Arianna Masciolini	17ebcac84f	Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core	2025-08-08 20:15:46 +02:00
Arianna Masciolini	7d018dde62	do not upload release assets	2025-08-08 20:15:37 +02:00
Andreas Källberg	4dba12c0ce	Add a nix flake for building with nix (#185 ) Also based on #165 --------- Co-authored-by: o1lo01ol1o <tim.pierson@gmail.com> Co-authored-by: Tim Pierson <o1lo01ol1o@users.noreply.github.com>	2025-08-08 20:02:17 +02:00
Arianna Masciolini	5ca230dd2a	remove info about specific versions of macOS for which binaries work	2025-08-08 19:55:33 +02:00
Arianna Masciolini	242cdcfa22	Update installation instructions (#195 ) * update install instructions some dates * change when to install c runtime manually	2025-08-08 19:44:48 +02:00
Arianna Masciolini	052916b454	try server mode on windows (#194 )	2025-08-08 19:33:02 +02:00
Inari Listenmaa	d07646e753	Merge pull request #192 from GrammaticalFramework/build-timestamp Add build timestamps to GF prompt	2025-08-08 19:32:52 +02:00
Inari Listenmaa	3b69a28dbd	Delete src/runtime/python/pgf.egg-info directory remove files that were committed by accident	2025-08-08 19:29:44 +02:00
Inari Listenmaa	aa004246d2	Merge pull request #190 from GrammaticalFramework/pgf-1.1 Publish PGF 1.1	2025-08-08 19:14:01 +02:00
Inari Listenmaa	7c6f53d003	add macos-13 to build for intel mac	2025-08-08 19:04:18 +02:00
Arianna Masciolini	a6d5d9a50c	Merge pull request #193 from GrammaticalFramework/release3.12 Update version numbers, changelog etc. for 3.12 release	2025-08-08 18:34:26 +02:00
Arianna Masciolini	7792c3cc90	update debian changelog	2025-08-08 18:31:45 +02:00
Arianna Masciolini	a7d73a6861	link to changelog from CHANGELOG.md	2025-08-08 18:31:33 +02:00
Arianna Masciolini	646cfbea0c	update cabal version number for 3.12 release	2025-08-08 18:31:17 +02:00
Arianna Masciolini	7ddb61eb48	update 3.12 release date in web news	2025-08-08 18:30:57 +02:00
Arianna Masciolini	dcae5f929e	fix typo	2025-08-08 18:20:47 +02:00
Arianna Masciolini	638ed39fa4	readd changelog item on Java	2025-08-08 18:20:10 +02:00
Arianna Masciolini	726fb3467c	Merge pull request #191 from GrammaticalFramework/minor-updates-binary-packages Update release scripts for 3.12	2025-08-08 18:17:45 +02:00
Andreas Källberg	b02bb08532	Fix warnings for ghc-9.6 about multiplicity syntax	2025-08-08 18:12:39 +02:00
Inari Listenmaa	c7e26d7cd2	also add the 9.6 compatibility fixes to PGF2	2025-08-08 18:12:26 +02:00
Inari Listenmaa	4fea7cf37f	Update release scripts for 3.12	2025-08-08 18:11:52 +02:00
Herbert Lange	9e5701b13c	hide ambiguous function	2025-08-08 18:06:03 +02:00
Herbert Lange	78beac7598	change date/time formating	2025-08-08 18:02:59 +02:00
Herbert Lange	f96830f7de	change template haskell required version	2025-08-08 17:50:33 +02:00
Herbert Lange	1c4cde7c66	updating formating for git info	2025-08-08 17:43:56 +02:00
Herbert Lange	e0ad7594dd	add build time and git info to BuildInfo	2025-08-08 17:36:03 +02:00
Inari Listenmaa	a218903a2d	use setuptools (so it works for 3.12+) + bump version to 1.1	2025-08-03 17:26:26 +02:00
Inari Listenmaa	f1c1d157b6	minor fixes in uploading to PyPI	2025-08-03 17:25:52 +02:00
Arianna Masciolini	e7c0b6dada	add to what's new	2025-08-02 23:04:49 +02:00
Arianna Masciolini	8f4e8c73d2	Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into release-3.12	2025-08-02 23:01:53 +02:00
Arianna Masciolini	d983255326	Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core	2025-08-02 23:01:29 +02:00
Arianna Masciolini	288984d243	fix compatibility with newer gcc versions	2025-08-02 23:01:20 +02:00
Inari Listenmaa	c23a03a2d1	Merge pull request #184 from inariksit/update-depth-documentation Update default depth to 5 + less hardcoding in documentation	2025-08-02 22:05:29 +02:00
Inari Listenmaa	183e421a0f	update default depth in tutorial and help text	2025-08-02 22:04:32 +02:00
Inari Listenmaa	3e0c0fa463	define default depths for shell and server only once	2025-08-02 21:46:13 +02:00
Arianna Masciolini	c2431e06b2	slightly less optimistic release date	2025-08-02 21:32:51 +02:00
Arianna Masciolini	eeab15bee1	redirect to 3.12 download page	2025-08-02 21:26:19 +02:00
Arianna Masciolini	b36b95c4d6	add news item about 3.12 release	2025-08-02 21:25:15 +02:00
Arianna Masciolini	2627e73b63	draft changelog for 3.12	2025-08-02 21:23:42 +02:00
Arianna Masciolini	e2ff43da0b	init download page for 3.12 with 3.11 instructions with minor changes	2025-08-02 21:23:26 +02:00
Inari Listenmaa	af09351b66	Merge pull request #183 from inariksit/ghc-9.6.7 replace 9.6.6 with 9.6.7	2025-08-02 20:43:59 +02:00
Inari Listenmaa	8c89ba4e76	convert editor-modes into markdown	2025-08-02 20:36:03 +02:00
Inari Listenmaa	218c61b004	make 9.6.7 into default stack.yaml	2025-08-02 20:35:39 +02:00
Inari Listenmaa	52df0ed4fe	replace 9.6.6 with 9.6.7	2025-08-02 20:35:22 +02:00
Arianna Masciolini	2324fe795c	Merge pull request #181 from GrammaticalFramework/pr-174bis (also close #174 ) PR #174bis	2025-08-02 20:26:36 +02:00
Arianna Masciolini	703b1e5d92	add eval.gfs to expected failures	2025-08-02 20:18:28 +02:00
Inari Listenmaa	f1a72a066f	Merge pull request #182 from inariksit/fix-encoding use UTF8 for several GF files	2025-08-02 19:26:06 +02:00
Inari Listenmaa	6f9f9642d7	use UTF8 for several GF files	2025-08-02 19:14:15 +02:00
Arianna Masciolini	f5752b345a	fail slow	2025-08-02 19:14:09 +02:00
Arianna Masciolini	5170668ff2	Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into hleiss/master	2025-08-02 19:02:30 +02:00
Inari Listenmaa	65e85c5a3c	Merge pull request #175 from inariksit/new-ghc Changes to make it work with newer stack/GHC: - unix library changed API in 2.8 - Monad of no return & Semigroup as a superclass of Monoid - import Control.Monad (join, when, (<=<)) - fixed CI issues	2025-08-02 18:59:07 +02:00
Inari Listenmaa	01c4f82e07	misc small fixes: - update actions/cache to v4 - update haskell/actions/setup to haskell-actions/setup - stack doesn't support ghc < 8.4, remove from CI - don't fail immediately - add -fpermissive flag to gcc - only build 9.6.6 with macos and windows latest - bump base upper bound	2025-08-02 18:46:00 +02:00
Inari Listenmaa	e81d668605	higher upper bound for base,mtl,ghc-prim,json,time	2025-08-02 16:39:31 +02:00
Inari Listenmaa	155b9da861	choose openFd based on version of unix	2025-08-02 16:39:31 +02:00
Inari Listenmaa	ab0f09e9f7	build-depends for unix depending on ghc version	2025-08-02 16:39:31 +02:00
Inari Listenmaa	9fa8ac934a	add stack file for GHC 9.6.6	2025-08-02 16:39:31 +02:00
Inari Listenmaa	e84826ed2a	explicitly import join, when, (<=<) from Control.Monad	2025-08-02 16:39:31 +02:00
Inari Listenmaa	bbf12458c7	use openFd from unix >= 2.8	2025-08-02 16:39:31 +02:00
Inari Listenmaa	b914a25de3	define return in terms of pure, >> as *>, mappend as <> In preparation for deprecation, see https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid and https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return	2025-08-02 16:39:31 +02:00
Inari Listenmaa	1037b209ae	add whitespace on list comprehensions, applications etc. text editor interprets these things as errors (e.g. unterminated qq for list comprehension) and underlines red, even though there is no real error.	2025-08-02 16:39:31 +02:00
Inari Listenmaa	981d6b9bdd	Specify that extending a grammar doesn't inherit the startcat	2025-02-20 20:52:21 +01:00
Hans Leiss	5776b567a2	Reactivate the gf-shell command 'pt -transfer'	2025-02-19 12:59:43 +01:00
Hans Leiss	643617ccc4	Bug fix for gf-shell command 'pt -compute' in Expr.hs by tryMatch p (VConst _ _) env = match sig f eqs as0	2025-02-18 12:41:14 +01:00
Inari Listenmaa	41f45e572b	Instruction to downgrade LLVM for macOS Sequoia	2025-01-18 07:27:46 +01:00
Inari Listenmaa	c7226cc11c	add GFSS2025 + remove IRC channel	2025-01-18 07:13:24 +01:00
aarneranta	bc56b54dd1	random generation of literals now has ten different values for each built in type; maybe a better solution for most cases than just one value	2025-01-07 11:20:23 +01:00
Krasimir Angelov	aa061aff0c	Update robots.txt	2024-11-26 12:15:41 +01:00
Inari Listenmaa	934afc9655	Merge pull request #169 from GrammaticalFramework/dependabot/github_actions/dot-github/workflows/actions/download-artifact-4.1.7 Bump actions/download-artifact from 2 to 4.1.7 in /.github/workflows	2024-11-01 10:29:45 +01:00
Andreas Källberg	33b0bab610	Use different artifact names as is required by upload-artifact@v4	2024-10-23 16:22:59 +02:00
Andreas Källberg	9492967fc6	add sudo to make install to fix CI failure	2024-10-23 16:08:09 +02:00
Andreas Källberg	5eab0a626d	add glibtoolize dependency for mac CI	2024-10-23 15:47:14 +02:00
Andreas Källberg	fc614cd48e	Bump more action versions	2024-10-23 15:40:29 +02:00
Andreas Källberg	eaec428a89	fix typo	2024-10-23 15:35:39 +02:00
Andreas Källberg	ed0a8ca0df	Update setup-python github action Let's see if this fixes CI	2024-10-23 15:34:01 +02:00
dependabot[bot]	c65dc70aaf	Bump actions/download-artifact from 2 to 4.1.7 in /.github/workflows Bumps [actions/download-artifact](https://github.com/actions/download-artifact) from 2 to 4.1.7. - [Release notes](https://github.com/actions/download-artifact/releases) - [Commits](https://github.com/actions/download-artifact/compare/v2...v4.1.7) --- updated-dependencies: - dependency-name: actions/download-artifact dependency-type: direct:production ... Signed-off-by: dependabot[bot] <support@github.com>	2024-09-03 21:17:51 +00:00
Inari Listenmaa	2a654c085f	be consistent in the use of quotes	2024-04-29 20:44:53 +08:00
Inari Listenmaa	b855a094f8	Clarify description for vt	2024-04-29 20:42:51 +08:00
Inari Listenmaa	2f31bbab23	Apply gt to all arguments when piped	2024-03-15 12:43:17 +01:00
aarneranta	7e707508a7	showExpr and linearize now refresh the printed variables if needed	2024-03-01 09:17:08 +01:00
Aarne Ranta	c2182274df	visualize_dependencies (vd) now creates latex in landscape mode to show long trees better	2023-12-14 11:56:11 +01:00
Inari Listenmaa	e11017abc0	Merge pull request #166 from GrammaticalFramework/fix-python-ci Fix CI for "Build & Publish Python Package": use python 3.10 instead of latest	2023-11-17 14:36:06 +01:00
Inari Listenmaa	b59fe24c11	use older python version to keep distutils	2023-11-17 14:11:59 +01:00
Inari Listenmaa	9204884463	Merge pull request #164 from BeFunctional/tp_pgf_support_ghc_94 Support GHC 9.4 for the PGF library	2023-11-17 14:02:06 +01:00
o1lo01ol1o	2c98075a0b	support ghc9.4	2023-11-15 12:04:41 -06:00
Inari Listenmaa	7d9015e2e1	Merge pull request #161 from anka-213/indent-errors Indent each line of error messages	2023-09-25 17:29:50 +02:00
Andreas Källberg	cf1ef40789	gh-actions: Bump the python version cibuildwheel requires python >= 3.8	2023-09-25 12:55:15 +02:00
Andreas Källberg	37f06a4ae8	gh-actions: Don't use ubuntu-18 and macos-10.15 There are no longer any gihub actions runners available for these Note that this means we can't build for ubuntu-18 anymore, but that should hopefully no longer be relevant, since it's over 5 years old now.	2023-09-25 12:48:56 +02:00
Andreas Källberg	30c1376232	Don't build twice for tests in CI	2023-09-25 12:43:19 +02:00
Andreas Källberg	ea3cef46b0	Update test to match new error	2023-09-25 12:01:56 +02:00
Andreas Källberg	268a25f59c	Indent each line of an error message By indenting each line instead of just the first, we simplify the work of the gf-lsp parser, so we can see which errors are the same	2023-09-25 09:55:02 +02:00
Inari Listenmaa	318b710a14	Merge pull request #160 from anka-213/prettier-syntax-errors Improve syntax error messages	2023-09-13 08:24:07 +02:00
Andreas Källberg	b90666455e	Fix typo	2023-09-11 13:17:19 +02:00
Andreas Källberg	88db715c3d	Fix ghc-7.10.3 build in gh-actions ghc-7.10.3 is not supported in the latest builder, so we need an older version of ubuntu for it to work	2023-09-11 13:03:05 +02:00
Andreas Källberg	003ab57576	Bump version of haskell github action The old one was failing	2023-09-11 18:43:14 +08:00
Andreas Källberg	ffd7b27abd	Improve syntax error messages Now you will get error messages like these: example.gf:1:21: Syntax error: Unexpected token '}'. Expected one of: - '{' - 'open' - an identifier	2023-09-11 12:30:28 +02:00
Krasimir Angelov	096b36c21d	Update jit.c	2023-09-07 17:37:25 +02:00
Krasimir Angelov	86af7b12b3	the jitter should still read the absfuns even for EMSCRIPTEN and aarch64	2023-08-11 10:47:29 +02:00
Krasimir Angelov	e2c2763d59	One more place with __aarch64__	2023-08-09 10:59:53 +02:00
Krasimir Angelov	fae2fc4c6c	Try with __aarch64__	2023-08-09 10:58:50 +02:00
Krasimir Angelov	5131fadd1f	lightning.h not included on aarch64	2023-08-08 16:18:49 +02:00
Krasimir Angelov	0e1cbfaa7e	Disable the jit on aarch64	2023-08-04 15:01:31 +02:00
Krasimir Angelov	95e5976b03	Create funcs.h	2023-08-04 14:49:55 +02:00
Krasimir Angelov	9dee033e2c	Create Create aarch64/fp.h	2023-08-04 14:49:22 +02:00
Krasimir Angelov	83a4a0525e	Create aarch64/core.h	2023-08-04 14:48:58 +02:00
Krasimir Angelov	f58697f31f	Create aarch64/asm.h	2023-08-04 14:48:01 +02:00
Krasimir Angelov	8f6dc916b6	added aarch64 configure.ac	2023-08-04 14:46:27 +02:00
Inari Listenmaa	6a36b486fa	Update instructions for Geany	2023-03-03 01:17:28 +01:00
Krasimir Angelov	8190d9fe49	export BindType(..)	2023-03-01 09:57:48 +01:00
Inari Listenmaa	527a4451d3	update to System.Environment (getArgs)	2023-02-10 10:46:10 +08:00
Krasimir Angelov	2c13f529f9	Update INSTALL	2023-02-05 09:40:14 +01:00
Inari Listenmaa	8b82f1ab33	remove 2020-specific link	2023-01-24 16:33:28 +08:00
Inari Listenmaa	7bcc70e79d	Summer school 2023	2023-01-24 16:19:22 +08:00
Inari Listenmaa	85038d0175	Merge pull request #149 from anka-213/ghc-9.2 Add support for ghc-9.2.4	2022-10-10 12:00:40 +02:00
Inari Listenmaa	6edd449d68	Merge pull request #147 from anka-213/extend-performance-issue Improve performance with long extend-lists	2022-10-10 12:00:23 +02:00
Andreas Källberg	a58c6d49d4	Extract the previous optimization to its own function	2022-10-04 17:01:47 +02:00
Andreas Källberg	fef7b80d8e	Use a Set in isInherited to speed up long extend lists Now the time is O(log(n)m) instead of O(nm) where n is the number of items in the extend list e.g. abstract FromWordNet = WordNet [ a_couple_Card, a_la_carte_Adv, a_la_mode_Adv, a_little_Card, ... ];	2022-10-04 17:01:47 +02:00
Andreas Källberg	03df25bb7a	Add support for ghc-9.2.4	2022-10-04 17:01:23 +02:00
Inari Listenmaa	3122590e35	Merge pull request #148 from anka-213/fix-ghc-7.10-build Fix ghc-7.10 build	2022-10-04 16:59:53 +02:00
Andreas Källberg	0a16b76875	Only include transformers-compat for ghc < 8 Since that's the only place where it's needed and we don't have to fight with versions elsewhere	2022-10-04 13:28:23 +02:00
Andreas Källberg	51b7117a3d	Restore build with ghc-7.10.3	2022-10-04 13:07:07 +02:00
Andreas Källberg	fef03e755b	Update some old unused code to support newer ghc	2022-10-04 13:07:07 +02:00
Aarne Ranta	223f92d4f6	using an unparsable variable name in the internal desugaring of table extension to avoid captures; captures with iterated table extensions might still be possible, which needs further analysis	2022-10-04 11:06:56 +02:00
aarneranta	83483b93ba	New construct: table update. Syntax t ** { cases }. Syntactic sugar for table {cases ; vvv => t \! vvv}.t	2022-10-03 17:04:29 +02:00
Krasimir Angelov	dc8dce90a0	added a Setup script to compile without cabal-install	2022-08-24 14:00:22 +02:00
Krasimir Angelov	e9bbd38f68	`gf --version` now prints the shared folder to be used by the RGL	2022-08-24 12:02:10 +02:00
Krasimir Angelov	3fac8415ca	forgot to mention sudo	2022-08-24 12:00:43 +02:00
Krasimir Angelov	1294269cd6	workaround for the Nix madness	2022-08-24 11:57:47 +02:00
krangelov	3acb7d2da4	silence harmless warnings	2022-08-12 10:54:43 +02:00
krangelov	08fb29e6b8	fix the reference counting for pgf.BIND	2022-08-12 10:51:56 +02:00
Inari Listenmaa	f69babef6d	add link to Inari's blog	2022-07-27 14:53:58 +02:00
Krasimir Angelov	a42cec2107	support for BIND tokens in the Python bindings	2022-07-16 20:29:36 +02:00
Krasimir Angelov	4d446fcd3f	Merge branch 'master' of github.com:GrammaticalFramework/gf-core	2022-07-04 10:42:59 +02:00
Krasimir Angelov	ae460e76b6	allow compilation with emscripten	2022-07-04 10:42:34 +02:00
John J. Camilleri	65308861bc	Merge branch 'master' of github.com:GrammaticalFramework/gf-core	2022-06-18 21:09:23 +02:00
Krasimir Angelov	b7672b67a3	adjust the -view command depending on the OS	2022-05-31 10:15:50 +02:00
Krasimir Angelov	e33de168fd	use a relative link to WordNet	2022-05-31 07:44:25 +02:00
Inari Listenmaa	fc5b3e9037	Merge pull request #141 from anka-213/hardcode-utf8 Always use UTF8 encoding in the gf executable	2022-05-18 09:46:03 +02:00
Andreas Källberg	9b9905c0b2	Always use UTF8 encoding in the gf executable This fixes many of the "Invalid character" messages you can get on different platforms. This has helped both with a nix-installation that didn't have global locale set and with a windows installation.	2022-05-18 14:42:01 +08:00
Inari Listenmaa	ec70e4a83e	Merge pull request #136 from mengwong/ghc9 compiles with GHC 9.0.2	2022-05-06 03:26:00 +02:00
Inari Listenmaa	e6ade90679	update nightly to latest lts	2022-05-06 08:45:12 +08:00
Inari Listenmaa	6414bc8923	Merge pull request #140 from anka-213/no-profile-bind Don't add automatic cost centres to Data.Binary.Get	2022-05-04 10:46:37 +02:00
Andreas Källberg	b0b2a06f3b	Improve comment	2022-05-03 13:10:29 +08:00
Andreas Källberg	221597bd79	When profiling, don't add cost centres in Data.Binary.Get This change speeds up profiling by an order of magnitude. Without it, the >>= function for Get dominates runtime completely during profiling.	2022-05-03 13:08:35 +08:00
Inari Listenmaa	862aeb5d9b	Update base <4.15 to <4.16 for tests + pgf*.cabal	2022-03-05 13:42:11 +08:00
Inari Listenmaa	25dd1354c7	Merge pull request #135 from mengwong/base-4-15 prepare for GHC 9, base 4.15, by using Buffer constructor interface	2022-03-05 06:28:17 +01:00
Inari Listenmaa	b762e24a82	Add ghc-9.0.2 to CI	2022-03-05 13:25:26 +08:00
Meng Weng Wong	20453193fe	add compilation support for ghc 9.0.2	2022-03-05 13:15:40 +08:00
Meng Weng Wong	b53a102c98	if this PR is accepted we don't need these instructions	2022-03-05 12:59:25 +08:00
Meng Weng Wong	bc14a56f83	"now try this" instructions for people flailing with Apple Silicon M1	2022-03-05 12:59:25 +08:00
Meng Weng Wong	3a1213ab37	prepare for GHC 9, base 4.15, by using Buffer constructor interface	2022-03-05 12:59:25 +08:00
Inari Listenmaa	1b41e94f83	Merge pull request #138 from anka-213/patch-1 Fix stack ci	2022-03-05 05:49:43 +01:00
Andreas Källberg	308f4773dc	Upgrade to ghc-8.10.7 This version has better support for m1 macbooks	2022-03-05 12:25:46 +08:00
Andreas Källberg	05fc093b5e	Add restore key to cache	2022-03-05 12:25:46 +08:00
Andreas Källberg	4caf6d684e	Another attempt at fixing linker errors	2022-03-05 12:25:46 +08:00
Andreas Källberg	bfd8f9c16d	Upgrade haskell setup action	2022-03-05 12:24:38 +08:00
Andreas Källberg	aefac84670	Clear stack cache and make cache-key more fine-grained Attempt at fixing #137	2022-03-05 12:24:10 +08:00
John J. Camilleri	9f2a3de7a3	Add simpler VSCode extension to editor modes page	2021-11-08 12:30:21 +01:00
krangelov	e4b2f281d9	Merge branch 'master' of github.com:GrammaticalFramework/gf-core	2021-09-22 14:11:27 +02:00
krangelov	063c517f3c	more tests for variants	2021-09-22 14:11:11 +02:00
John J. Camilleri	bedb46527d	Move Thomas from current to previous on maintainers page	2021-08-17 10:18:34 +02:00
John J. Camilleri	0258a87257	Add IRC, Discord, SO links to "contribute" section at top of homepage	2021-08-17 09:57:50 +02:00
John J. Camilleri	ef0e831c9e	Update installation instructions from Hackage, source code	2021-08-17 09:38:20 +02:00
Inari Listenmaa	8ec13b1030	Uncomment installation instructions from Hackage	2021-08-16 09:07:59 +08:00
John J. Camilleri	058526ec5d	Remove Travis CI workflow, we use GitHub actions now Closes #123	2021-08-12 15:27:10 +02:00
John J. Camilleri	974e8b0835	Typos in homepage	2021-08-12 15:20:29 +02:00
John J. Camilleri	bbe4682c3d	Update homepage - Add Discord link - Point to GitHub issues, Stack Overflow in "Getting help" - Remove old news	2021-08-12 15:19:17 +02:00
John J. Camilleri	e477ce4b1f	HTML fix on homepage	2021-08-12 10:05:45 +02:00
John J. Camilleri	7a63ba34b4	Add changelog This will hopefully help us keep track of changes for the next release	2021-08-12 09:56:34 +02:00
John J. Camilleri	723bec1ba0	Changes made in order to get Hackage upload working	2021-08-09 13:41:25 +02:00