Expose all modules in the gf compiler, for use by the lsp-server

This fixes nix builds of gf-lsp

.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: ["3.2"]
+        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: actions/setup-haskell@v1.1.4
+    - 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,33 +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: ["2.3.3"]
-        ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4"]
-        # ghc: ["8.8.3"]
+        stack: ["latest"]
+        ghc: ["8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2", "9.6.7"]
 
     steps:
     - uses: actions/checkout@v2
       if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
 
-    - uses: actions/setup-haskell@v1.1.4
+    - uses: haskell-actions/setup@v2
       name: Setup Haskell Stack
       with:
-        # ghc-version: ${{ matrix.ghc }}
-        stack-version: ${{ matrix.stack }}
+        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: |

.github/workflows/build-binary-packages.yml

@@ -3,6 +3,7 @@ name: Build Binary Packages
 on:
   workflow_dispatch:
   release:
+    types: ["created"]
 
 jobs:
 
@@ -10,11 +11,13 @@ jobs:
 
   ubuntu:
     name: Build Ubuntu package
-    runs-on: ubuntu-18.04
-    # strategy:
-    #   matrix:
-    #     ghc: ["8.6.5"]
-    #     cabal: ["2.4"]
+    strategy:
+      matrix:
+        ghc: ["9.6"]
+        cabal: ["3.10"]
+        os: ["ubuntu-24.04"]
+
+    runs-on: ${{ matrix.os }}
 
     steps:
     - uses: actions/checkout@v2
@@ -22,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: |
@@ -36,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
@@ -51,27 +56,41 @@ jobs:
         cp ../gf_*.deb dist/
 
     - name: Upload artifact
-      uses: actions/upload-artifact@v2
+      uses: actions/upload-artifact@v4
       with:
-        name: gf-${{ github.sha }}-ubuntu
+        name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
         path: dist/gf_*.deb
         if-no-files-found: error
 
+    - name: Rename package for specific ubuntu version
+      run: |
+        mv dist/gf_*.deb dist/gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
+
+    #- uses: actions/upload-release-asset@v1.0.2
+    #  env:
+    #    GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+    #  with:
+    #    upload_url: ${{ github.event.release.upload_url }}
+    #    asset_path: dist/gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
+    #    asset_name: gf-${{ github.event.release.tag_name }}-${{ matrix.os }}.deb
+    #    asset_content_type: application/octet-stream
+
 # ---
 
   macos:
     name: Build macOS package
-    runs-on: macos-10.15
     strategy:
       matrix:
-        ghc: ["8.6.5"]
-        cabal: ["2.4"]
+        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 }}
@@ -80,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: |
@@ -90,21 +111,35 @@ jobs:
         make pkg
 
     - name: Upload artifact
-      uses: actions/upload-artifact@v2
+      uses: actions/upload-artifact@v4
       with:
-        name: gf-${{ github.sha }}-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
+
 # ---
 
   windows:
     name: Build Windows package
-    runs-on: windows-2019
     strategy:
       matrix:
-        ghc: ["8.6.5"]
-        cabal: ["2.4"]
+        ghc: ["9.6.7"]
+        cabal: ["3.10"]
+        os: ["windows-2022"]
+    runs-on: ${{ matrix.os }}
 
     steps:
     - uses: actions/checkout@v2
@@ -116,6 +151,7 @@ jobs:
           base-devel
           gcc
           python-devel
+          autotools
 
     - name: Prepare dist folder
       shell: msys2 {0}
@@ -136,17 +172,23 @@ jobs:
         cp /mingw64/bin/libpgf-0.dll /c/tmp-dist/c
         cp /mingw64/bin/libgu-0.dll /c/tmp-dist/c
 
+    # JAVA_HOME_8_X64 = C:\hostedtoolcache\windows\Java_Adopt_jdk\8.0.292-10\x64
     - name: Build Java bindings
       shell: msys2 {0}
       run: |
-        export PATH="${PATH}:/c/Program Files/Java/jdk8u275-b01/bin"
+        echo $JAVA_HOME_8_X64
+        export JDKPATH="$(cygpath -u "${JAVA_HOME_8_X64}")"
+        export PATH="${PATH}:${JDKPATH}/bin"
         cd src/runtime/java
         make \
-          JNI_INCLUDES="-I \"/c/Program Files/Java/jdk8u275-b01/include\" -I \"/c/Program Files/Java/jdk8u275-b01/include/win32\" -I \"/mingw64/include\" -D__int64=int64_t" \
+          JNI_INCLUDES="-I \"${JDKPATH}/include\" -I \"${JDKPATH}/include/win32\" -I \"/mingw64/include\" -D__int64=int64_t" \
           WINDOWS_LDFLAGS="-L\"/mingw64/lib\" -no-undefined"
         make install
-        cp .libs//msys-jpgf-0.dll /c/tmp-dist/java/jpgf.dll
+        cp .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}
@@ -155,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.8/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 }}
@@ -172,14 +215,26 @@ 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.sha }}-windows
+        name: gf-${{ github.event.release.tag_name }}-windows
         path: C:\tmp-dist\*
         if-no-files-found: error
+
+    - name: Create archive
+      run: |
+        Compress-Archive C:\tmp-dist C:\gf-${{ github.event.release.tag_name }}-windows.zip
+    #- uses: actions/upload-release-asset@v1.0.2
+    #  env:
+    #    GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+    #  with:
+    #    upload_url: ${{ github.event.release.upload_url }}
+    #    asset_path: C:\gf-${{ github.event.release.tag_name }}-windows.zip
+    #    asset_name: gf-${{ github.event.release.tag_name }}-windows.zip
+    #    asset_content_type: application/zip

.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/*

.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

.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'"

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>

Makefile

@@ -1,31 +1,48 @@
-.PHONY: all build install doc clean gf html deb pkg bintar sdist
+.PHONY: all build install doc clean html deb pkg bintar sdist
 
 # This gets the numeric part of the version from the cabal file
 VERSION=$(shell sed -ne "s/^version: *\([0-9.]*\).*/\1/p" gf.cabal)
 
+# Check if stack is installed
+STACK=$(shell if hash stack 2>/dev/null; then echo "1"; else echo "0"; fi)
+
+# Check if cabal >= 2.4 is installed (with v1- and v2- commands)
+CABAL_NEW=$(shell if cabal v1-repl --help >/dev/null 2>&1 ; then echo "1"; else echo "0"; fi)
+
+ifeq ($(STACK),1)
+  CMD=stack
+else
+  CMD=cabal
+  ifeq ($(CABAL_NEW),1)
+    CMD_PFX=v1-
+  endif
+endif
+
 all: build
 
 dist/setup-config: gf.cabal Setup.hs WebSetup.hs
-	cabal configure
+ifneq ($(STACK),1)
+	cabal ${CMD_PFX}configure
+endif
 
 build: dist/setup-config
-	cabal build
+	${CMD} ${CMD_PFX}build
 
 install:
-	cabal copy
-	cabal register
+ifeq ($(STACK),1)
+	stack install
+else
+	cabal ${CMD_PFX}copy
+	cabal ${CMD_PFX}register
+endif
 
 doc:
-	cabal haddock
+	${CMD} ${CMD_PFX}haddock
 
 clean:
-	cabal clean
+	${CMD} ${CMD_PFX}clean
 	bash bin/clean_html
 
-gf:
-	cabal build rgl-none
-	strip dist/build/gf/gf
-
 html::
 	bash bin/update_html
 
@@ -33,9 +50,9 @@ html::
 # number to the top of debian/changelog.
 # (Tested on Ubuntu 15.04. You need to install dpkg-dev & debhelper.)
 deb:
-	dpkg-buildpackage -b -uc
+	dpkg-buildpackage -b -uc -d
 
-# Make an OS X Installer package
+# Make a macOS installer package
 pkg:
 	FMT=pkg bash bin/build-binary-dist.sh
 
@@ -48,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

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
 

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

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

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

debian/changelog

@@ -1,3 +1,14 @@
+gf (3.12) noble; urgency=low
+
+  * GF 3.12
+
+ -- Inari Listenmaa <inari@digitalgrammars.com>  Fri, 8 Aug 2025 18:29:29 +0100
+gf (3.11) bionic focal; urgency=low
+
+  * GF 3.11
+
+ -- Inari Listenmaa <inari@digitalgrammars.com>  Sun, 25 Jul 2021 10:27:40 +0800
+
 gf (3.10.4-1) xenial bionic cosmic; urgency=low
 
   * GF 3.10.4

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

debian/rules

@@ -17,28 +17,30 @@ override_dh_auto_configure:
 	cd src/runtime/c && bash setup.sh configure --prefix=/usr
 	cd src/runtime/c && bash setup.sh build
 	cabal update
-	cabal install --only-dependencies
-	cabal configure --prefix=/usr -fserver -fc-runtime --extra-lib-dirs=$(CURDIR)/src/runtime/c/.libs --extra-include-dirs=$(CURDIR)/src/runtime/c
+	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
 
 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 build
+	-$(SET_LDL) cabal v1-build
 
 override_dh_auto_install:
-	$(SET_LDL) cabal copy --destdir=$(CURDIR)/debian/gf
+	$(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:

doc/gf-developers-old-cabal.t2t

@@ -0,0 +1,201 @@
+GF Developer's Guide: Old installation instructions with Cabal
+
+
+This page contains the old installation instructions from the [Developer's Guide ../doc/gf-developers.html].
+We recommend Stack as a primary installation method, because it's easier for a Haskell beginner, and we want to keep the main instructions short.
+But if you are an experienced Haskeller and want to keep using Cabal, here are the old instructions using ``cabal install``.
+
+Note that some of these instructions may be outdated. Other parts may still be useful.
+
+== Compilation from source with Cabal ==
+
+The build system of GF is based on //Cabal//, which is part of the
+Haskell Platform, so no extra steps are needed to install it. In the simplest
+case, all you need to do to compile and install GF, after downloading the
+source code as described above, is
+
+```
+$ cabal install
+```
+
+This will automatically download any additional Haskell libraries needed to
+build GF. If this is the first time you use Cabal, you might need to run
+``cabal update`` first, to update the list of available libraries.
+
+If you want more control, the process can also be split up into the usual
+//configure//, //build// and //install// steps.
+
+=== Configure ===
+
+During the configuration phase Cabal will check that you have all
+necessary tools and libraries needed for GF. The configuration is
+started by the command:
+
+```
+$ cabal configure
+```
+
+If you don't see any error message from the above command then you
+have everything that is needed for GF. You can also add the option
+``-v`` to see more details about the configuration.
+
+You can use ``cabal configure --help`` to get a list of configuration options.
+
+=== Build ===
+
+The build phase does two things. First it builds the GF compiler from
+the Haskell source code and after that it builds the GF Resource Grammar
+Library using the already build compiler.  The simplest command is:
+
+```
+$ cabal build
+```
+
+Again you can add the option ``-v`` if you want to see more details.
+
+==== Parallel builds ====
+
+If you have Cabal>=1.20 you can enable parallel compilation by using
+
+```
+$ cabal build -j
+```
+
+or by putting a line
+```
+jobs: $ncpus
+```
+in your ``.cabal/config`` file. Cabal
+will pass this option to GHC when building the GF compiler, if you
+have GHC>=7.8.
+
+Cabal also passes ``-j`` to GF to enable parallel compilation of the
+Resource Grammar Library. This is done unconditionally to avoid
+causing problems for developers with Cabal<1.20. You can disable this
+by editing the last few lines in ``WebSetup.hs``.
+
+=== Install ===
+
+After you have compiled GF you need to install the executable and libraries
+to make the system usable.
+
+```
+$ cabal copy
+$ cabal register
+```
+
+This command installs the GF compiler for a single user, in the standard
+place used by Cabal.
+On Linux and Mac this could be ``$HOME/.cabal/bin``.
+On Mac it could also be ``$HOME/Library/Haskell/bin``.
+On Windows this is ``C:\Program Files\Haskell\bin``.
+
+The compiled GF Resource Grammar Library will be installed
+under the same prefix, e.g. in
+``$HOME/.cabal/share/gf-3.3.3/lib`` on Linux and
+in ``C:\Program Files\Haskell\gf-3.3.3\lib`` on Windows.
+
+If you want to install in some other place then use the ``--prefix``
+option during the configuration phase.
+
+=== Clean ===
+
+Sometimes you want to clean up the compilation and start again from clean
+sources. Use the clean command for this purpose:
+
+```
+$ cabal clean
+```
+
+
+%=== SDist ===
+%
+%You can use the command:
+%
+%% This does *NOT* include everything that is needed // TH 2012-08-06
+%```
+%$ cabal sdist
+%```
+%
+%to prepare archive with all source codes needed to compile GF.
+
+=== Known problems with Cabal ===
+
+Some versions of Cabal (at least version 1.16) seem to have a bug that can
+cause the following error:
+
+```
+Configuring gf-3.x...
+setup: Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed
+```
+
+The exact cause of this problem is unclear, but it seems to happen
+during the configure phase if the same version of GF is already installed,
+so a workaround is to remove the existing installation with
+
+```
+ghc-pkg unregister gf
+```
+
+You can check with ``ghc-pkg list gf`` that it is gone.
+
+== Compilation with make ==
+
+If you feel more comfortable with Makefiles then there is a thin Makefile
+wrapper arround Cabal for you. If you just type:
+```
+$ make
+```
+the configuration phase will be run automatically if needed and after that
+the sources will be compiled.
+
+%% cabal build rgl-none does not work with recent versions of Cabal
+%If you don't want to compile the resource library
+%every time then you can use:
+%```
+%$ make gf
+%```
+
+For installation use:
+```
+$ make install
+```
+For cleaning:
+```
+$ make clean
+```
+%and to build source distribution archive run:
+%```
+%$ make sdist
+%```
+
+
+== Partial builds of RGL ==
+
+**NOTE**: The following doesn't work with recent versions of ``cabal``. //(This comment was left in 2015, so make your own conclusions.)//
+%% // TH 2015-06-22
+
+%Sometimes you just want to work on the GF compiler and don't want to
+%recompile the resource library after each change. In this case use
+%this extended command:
+
+%```
+%$ cabal build rgl-none
+%```
+
+The resource grammar library can be compiled in two modes: with present
+tense only and with all tenses. By default it is compiled with all
+tenses. If you want to use the library with only present tense you can
+compile it in this special mode with the command:
+
+```
+$ cabal build present
+```
+
+You could also control which languages you want to be recompiled by
+adding the option ``langs=list``. For example the following command
+will compile only the English and the Swedish language:
+
+```
+$ cabal build langs=Eng,Swe
+```

doc/gf-developers.t2t

@@ -1,6 +1,6 @@
 GF Developers Guide
 
-2018-07-26
+2021-07-15
 
 %!options(html): --toc
 
@@ -15,388 +15,304 @@ you are a GF user who just wants to download and install GF
 == Setting up your system for building GF ==
 
 To build GF from source you need to install some tools on your
-system: the //Haskell Platform//, //Git// and the //Haskeline library//.
+system: the Haskell build tool //Stack//, the version control software //Git// and the //Haskeline// library.
 
-**On Linux** the best option is to install the tools via the standard
-software distribution channels, i.e. by using the //Software Center//
-in Ubuntu or the corresponding tool in other popular Linux distributions.
-Or, from a Terminal window, the following command should be enough:
+%**On Linux** the best option is to install the tools via the standard
+%software distribution channels, i.e. by using the //Software Center//
+%in Ubuntu or the corresponding tool in other popular Linux distributions.
 
-- On Ubuntu: ``sudo apt-get install haskell-platform git libghc6-haskeline-dev``
-- On Fedora: ``sudo dnf install haskell-platform git ghc-haskeline-devel``
+%**On Mac OS and Windows**, the tools can be downloaded from their respective
+%web sites, as described below.
+
+=== Stack ===
+The primary installation method is via //Stack//.
+(You can also use Cabal, but we recommend Stack to those who are new to Haskell.)
+
+To install Stack:
+
+- **On Linux and Mac OS**, do either
+
+    ``$ curl -sSL https://get.haskellstack.org/ | sh``
+
+  or
+
+    ``$ wget -qO- https://get.haskellstack.org/ | sh``
 
 
-**On Mac OS and Windows**, the tools can be downloaded from their respective
-web sites, as described below.
+- **On other operating systems**, see the [installation guide https://docs.haskellstack.org/en/stable/install_and_upgrade].
 
-=== The Haskell Platform ===
 
-GF is written in Haskell, so first of all you need
-the //Haskell Platform//, e.g. version 8.0.2 or 7.10.3. Downloads
-and installation instructions are available from here:
+%If you already have Stack installed, upgrade it to the latest version by running: ``stack upgrade``
 
-    http://hackage.haskell.org/platform/
-
-Once you have installed the Haskell Platform, open a terminal
-(Command Prompt on Windows) and try to execute the following command:
-```
-$ ghc --version
-```
-This command should show you which version of GHC you have. If the installation
-of the Haskell Platform	 was successful you should see a message like:
-
-```
-The Glorious Glasgow Haskell Compilation System, version 8.0.2
-```
-
-Other required tools included in the Haskell Platform are
-[Cabal http://www.haskell.org/cabal/],
-[Alex http://www.haskell.org/alex/]
-and
-[Happy http://www.haskell.org/happy/].
 
 === Git ===
 
-To get the GF source code, you also need //Git//.
-//Git// is a distributed version control system, see
-https://git-scm.com/downloads for more information.
+To get the GF source code, you also need //Git//, a distributed version control system.
 
-=== The haskeline library ===
+- **On Linux**, the best option is to install the tools via the standard
+software distribution channels:
+
+  - On Ubuntu: ``sudo apt-get install git-all``
+  - On Fedora: ``sudo dnf install git-all``
+
+
+- **On other operating systems**, see
+https://git-scm.com/book/en/v2/Getting-Started-Installing-Git for installation.
+
+
+
+=== Haskeline ===
 
 GF uses //haskeline// to enable command line editing in the GF shell.
-This should work automatically on Mac OS and Windows, but on Linux one
-extra step is needed to make sure the C libraries (terminfo)
-required by //haskeline// are installed.  Here is one way to do this:
 
-- On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``
-- On Fedora: ``sudo dnf install ghc-haskeline-devel``
+- **On Mac OS and Windows**, this should work automatically.
+
+- **On Linux**, an extra step is needed to make sure the C libraries (terminfo)
+required by //haskeline// are installed:
+
+  - On Ubuntu: ``sudo apt-get install libghc-haskeline-dev``
+  - On Fedora: ``sudo dnf install ghc-haskeline-devel``
 
 
-== Getting the source ==
+== Getting the source ==[getting-source]
 
-Once you have all tools in place you can get the GF source code. If you
-just want to compile and use GF then it is enough to have read-only
-access. It is also possible to make changes in the source code but if you
-want these changes to be applied back to the main source repository you will
-have to send the changes to us.  If you plan to work continuously on
-GF then you should consider getting read-write access.
+Once you have all tools in place you can get the GF source code from
+[GitHub https://github.com/GrammaticalFramework/]:
 
-=== Read-only access ===
+- https://github.com/GrammaticalFramework/gf-core for the GF compiler
+- https://github.com/GrammaticalFramework/gf-rgl for the Resource Grammar Library
 
-==== Getting a fresh copy for read-only access ====
 
-Anyone can get the latest development version of GF by running:
+=== Read-only access: clone the main repository ===
+
+If you only want to compile and use GF, you can just clone the repositories as follows:
 
 ```
-$ git clone https://github.com/GrammaticalFramework/gf-core.git
-$ git clone https://github.com/GrammaticalFramework/gf-rgl.git
+  $ git clone https://github.com/GrammaticalFramework/gf-core.git
+  $ git clone https://github.com/GrammaticalFramework/gf-rgl.git
 ```
 
-This will create directories ``gf-core`` and ``gf-rgl`` in the current directory.
-
-
-==== Updating your copy ====
-
-To get all new patches from each repo:
-```
-$ git pull
-```
-This can be done anywhere in your local repository.
-
-
-==== Recording local changes ====[record]
-
-Since every copy is a repository, you can have local version control
-of your changes.
-
-If you have added files, you first need to tell your local repository to
-keep them under revision control:
+To get new updates, run the following anywhere in your local copy of the repository:
 
 ```
-$ git add file1 file2 ...
+  $ git pull
 ```
 
-To record changes, use:
+=== Contribute your changes: fork the main repository ===
+
+If you want the possibility to contribute your changes,
+you should create your own fork, do your changes there,
+and then send a pull request to the main repository.
+
++ **Creating and cloning a fork  —**
+See GitHub documentation for instructions how to [create your own fork https://docs.github.com/en/get-started/quickstart/fork-a-repo]
+of the repository. Once you've done it, clone the fork to your local computer.
 
 ```
-$ git commit file1 file2 ...
+  $ git clone https://github.com/<YOUR_USERNAME>/gf-core.git
 ```
 
-This creates a patch against the previous version and stores it in your
-local repository. You can record any number of changes before
-pushing them to the main repo. In fact, you don't have to push them at
-all if you want to keep the changes only in your local repo.
-
-Instead of enumerating all modified files on the command line,
-you can use the flag ``-a`` to automatically record //all// modified
-files. You still need to use ``git add`` to add new files.
-
-
-=== Read-write access ===
-
-If you are a member of the GF project on GitHub, you can push your
-changes directly to the GF git repository on GitHub.
++ **Updating your copy —**
+Once you have cloned your fork, you need to set up the main repository as a remote:
 
 ```
-$ git push
+  $ git remote add upstream https://github.com/GrammaticalFramework/gf-core.git
 ```
 
-It is also possible for anyone else to contribute by
+Then you can get the latest updates by running the following:
 
-- creating a fork of the GF repository on GitHub,
-- working with local clone of the fork (obtained with ``git clone``),
-- pushing changes to the fork,
-- and finally sending a pull request.
+```
+  $ git pull upstream master
+```
+
++ **Recording local changes —**
+See Git tutorial on how to [record and push your changes https://git-scm.com/book/en/v2/Git-Basics-Recording-Changes-to-the-Repository] to your fork.
+
++ **Pull request —**
+When you want to contribute your changes to the main gf-core repository,
+[create a pull request https://docs.github.com/en/github/collaborating-with-pull-requests/proposing-changes-to-your-work-with-pull-requests/creating-a-pull-request]
+from your fork.
 
 
 
-== Compilation from source with Cabal ==
+If you want to contribute to the RGL as well, do the same process for the RGL repository.
 
-The build system of GF is based on //Cabal//, which is part of the
-Haskell Platform, so no extra steps are needed to install it. In the simplest
-case, all you need to do to compile and install GF, after downloading the
-source code as described above, is
+
+== Compilation from source ==
+
+By now you should have installed Stack and Haskeline, and cloned the Git repository on your own computer, in a directory called ``gf-core``.
+
+=== Primary recommendation: use Stack ===
+
+Open a terminal, go to the top directory (``gf-core``), and type the following command.
+
+```
+$ stack install
+```
+
+=== Alternative: use Cabal ===
+
+If you prefer Cabal, then you just need to manually choose a suitable GHC to build GF. We recommend GHC 9.6.7, see other supported options in [gf.cabal https://github.com/GrammaticalFramework/gf-core/blob/master/gf.cabal#L14].
+
+The actual installation process is similar to Stack: open a terminal, go to the top directory (``gf-core``), and type the following command.
 
 ```
 $ cabal install
 ```
 
-This will automatically download any additional Haskell libraries needed to
-build GF. If this is the first time you use Cabal, you might need to run
-``cabal update`` first, to update the list of available libraries.
+=== Nix ===
 
-If you want more control, the process can also be split up into the usual
-//configure//, //build// and //install// steps.
-
-=== Configure ===
-
-During the configuration phase Cabal will check that you have all
-necessary tools and libraries needed for GF. The configuration is
-started by the command:
+As of 3.12, GF can also be installed via Nix. You can install GF from github with the following command:
 
 ```
-$ cabal configure
+nix profile install github:GrammaticalFramework/gf-core#gf
 ```
 
-If you don't see any error message from the above command then you
-have everything that is needed for GF. You can also add the option
-``-v`` to see more details about the configuration.
+== Compiling GF with C runtime system support ==
 
-You can use ``cabal configure --help`` to get a list of configuration options.
-
-=== Build ===
-
-The build phase does two things. First it builds the GF compiler from
-the Haskell source code and after that it builds the GF Resource Grammar
-Library using the already build compiler.  The simplest command is:
-
-```
-$ cabal build
-```
-
-Again you can add the option ``-v`` if you want to see more details.
-
-==== Parallel builds ====
-
-If you have Cabal>=1.20 you can enable parallel compilation by using
-
-```
-$ cabal build -j
-```
-
-or by putting a line
-```
-jobs: $ncpus
-```
-in your ``.cabal/config`` file. Cabal
-will pass this option to GHC when building the GF compiler, if you
-have GHC>=7.8.
-
-Cabal also passes ``-j`` to GF to enable parallel compilation of the
-Resource Grammar Library. This is done unconditionally to avoid
-causing problems for developers with Cabal<1.20. You can disable this
-by editing the last few lines in ``WebSetup.hs``.
-
-
-==== Partial builds ====
-
-**NOTE**: The following doesn't work with recent versions of ``cabal``.
-%% // TH 2015-06-22
-
-Sometimes you just want to work on the GF compiler and don't want to
-recompile the resource library after each change. In this case use
-this extended command:
-
-```
-$ cabal build rgl-none
-```
-
-The resource library could also be compiled in two modes: with present
-tense only and with all tenses. By default it is compiled with all
-tenses. If you want to use the library with only present tense you can
-compile it in this special mode with the command:
-
-```
-$ cabal build present
-```
-
-You could also control which languages you want to be recompiled by
-adding the option ``langs=list``. For example the following command
-will compile only the English and the Swedish language:
-
-```
-$ cabal build langs=Eng,Swe
-```
-
-=== Install ===
-
-After you have compiled GF you need to install the executable and libraries
-to make the system usable.
-
-```
-$ cabal copy
-$ cabal register
-```
-
-This command installs the GF compiler for a single user, in the standard
-place used by Cabal.
-On Linux and Mac this could be ``$HOME/.cabal/bin``.
-On Mac it could also be ``$HOME/Library/Haskell/bin``.
-On Windows this is ``C:\Program Files\Haskell\bin``.
-
-The compiled GF Resource Grammar Library will be installed
-under the same prefix, e.g. in
-``$HOME/.cabal/share/gf-3.3.3/lib`` on Linux and
-in ``C:\Program Files\Haskell\gf-3.3.3\lib`` on Windows.
-
-If you want to install in some other place then use the ``--prefix``
-option during the configuration phase.
-
-=== Clean ===
-
-Sometimes you want to clean up the compilation and start again from clean
-sources. Use the clean command for this purpose:
-
-```
-$ cabal clean
-```
-
-
-%=== SDist ===
-%
-%You can use the command:
-%
-%% This does *NOT* include everything that is needed // TH 2012-08-06
-%```
-%$ cabal sdist
-%```
-%
-%to prepare archive with all source codes needed to compile GF.
-
-=== Known problems with Cabal ===
-
-Some versions of Cabal (at least version 1.16) seem to have a bug that can
-cause the following error:
-
-```
-Configuring gf-3.x...
-setup: Distribution/Simple/PackageIndex.hs:124:8-13: Assertion failed
-```
-
-The exact cause of this problem is unclear, but it seems to happen
-during the configure phase if the same version of GF is already installed,
-so a workaround is to remove the existing installation with
-
-```
-ghc-pkg unregister gf
-```
-
-You can check with ``ghc-pkg list gf`` that it is gone.
-
-== Compilation with make ==
-
-If you feel more comfortable with Makefiles then there is a thin Makefile
-wrapper arround Cabal for you. If you just type:
-```
-$ make
-```
-the configuration phase will be run automatically if needed and after that
-the sources will be compiled.
-
-%% cabal build rgl-none does not work with recent versions of Cabal
-%If you don't want to compile the resource library
-%every time then you can use:
-%```
-%$ make gf
-%```
-
-For installation use:
-```
-$ make install
-```
-For cleaning:
-```
-$ make clean
-```
-%and to build source distribution archive run:
-%```
-%$ make sdist
-%```
-
-== Compiling GF with C run-time system support ==
-
-The C run-time system is a separate implementation of the PGF run-time services.
+The C runtime system is a separate implementation of the PGF runtime services.
 It makes it possible to work with very large, ambiguous grammars, using
-probabilistic models to obtain probable parses. The C run-time system might
-also be easier to use than the Haskell run-time system on certain platforms,
+probabilistic models to obtain probable parses. The C runtime system might
+also be easier to use than the Haskell runtime system on certain platforms,
 e.g. Android and iOS.
 
-To install the C run-time system, go to the ``src/runtime/c`` directory
-%and follow the instructions in the ``INSTALL`` file.
-and use the ``install.sh`` script:
-```
-bash setup.sh configure
-bash setup.sh build
-bash setup.sh install
-```
-This will install
-the C header files and libraries need to write C programs that use PGF grammars.
-Some example C programs are included in the ``utils`` subdirectory, e.g.
-``pgf-translate.c``.
+To install the C runtime system, go to the ``src/runtime/c`` directory.
 
-When the C run-time system is installed, you can install GF with C run-time
-support by doing
+- **On Linux and Mac OS —**
+  You should have autoconf, automake, libtool and make.
+  If you are missing some of them, follow the
+  instructions in the [INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file.
+
+  Once you have the required libraries, the easiest way to install the C runtime is to use the ``install.sh`` script. Just type
+
+  ``$ bash install.sh``
+
+  This will install the C header files and libraries need to write C programs
+  that use PGF grammars.
+
+%  If this doesn't work for you, follow the manual instructions in the [INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file under your operating system.
+
+- **On other operating systems —** Follow the instructions in the
+[INSTALL https://github.com/GrammaticalFramework/gf-core/blob/master/src/runtime/c/INSTALL] file under your operating system.
+
+
+
+Depending on what you want to do with the C runtime, you can follow one or more of the following steps.
+
+=== Use the C runtime from another programming language ===[bindings]
+
+% **If you just want to use the C runtime from Python or Haskell, you don't need to change your GF installation.**
+
+- **What —**
+This is the most common use case for the C runtime: compile
+your GF grammars into PGF with the standard GF executable,
+and manipulate the PGFs from another programming language,
+using the bindings to the C runtime.
+
+
+- **How —**
+The Python, Java and Haskell bindings are found in the
+``src/runtime/{python,java,haskell-bind}`` directories,
+respecively. Compile them by following the instructions
+in the ``INSTALL`` or ``README`` files in those directories.
+
+The Python library can also be installed from PyPI using ``pip install pgf``.
+
+
+//If you are on Mac and get an error about ``clang`` version, you can try some of [these solutions https://stackoverflow.com/questions/63972113/big-sur-clang-invalid-version-error-due-to-macosx-deployment-target]—but be careful before removing any existing installations.//
+
+
+=== Use GF shell with C runtime support ===
+
+- **What —**
+If you want to use the GF shell with C runtime functionalities, then you need to (re)compile GF with special flags.
+
+The GF shell can be started with ``gf -cshell`` or ``gf -crun`` to use
+the C run-time system instead of the Haskell run-time system.
+Only limited functionality is available when running the shell in these
+modes (use the ``help`` command in the shell for details).
+
+(Re)compiling your GF with these flags will also give you
+Haskell bindings to the C runtime, as a library called ``PGF2``,
+but if you want Python bindings, you need to do [the previous step #bindings].
+
+% ``PGF2``: a module to import in Haskell programs, providing a binding to the C run-time system.
+
+- **How —**
+
+Add (or uncomment) the following lines in the ``stack.yaml`` file:
 
 ```
-cabal install -fserver -fc-runtime
+flags:
+   gf:
+     c-runtime: true
+extra-lib-dirs:
+   - /usr/local/lib
 ```
-from the top directory. This give you three new things:
+and then run ``stack install`` from the top directory (``gf-core``).
 
-- ``PGF2``: a module to import in Haskell programs, providing a binding to
-   the C run-time system.
+Run the newly built executable with the flag ``-cshell``, and you should see the following welcome message:
 
-- The GF shell can be started with ``gf -cshell`` or ``gf -crun`` to use
-  the C run-time system instead of the Haskell run-time system.
-  Only limited functionality is available when running the shell in these
-  modes (use the ``help`` command in the shell for details).
+```
+$ gf -cshell
 
-- ``gf -server`` mode is extended with new requests to call the C run-time
-   system, e.g. ``c-parse``, ``c-linearize`` and ``c-translate``.
+         *  *  *
+      *           *
+    *               *
+   *
+   *
+   *        * * * * * *
+   *        *         *
+    *       * * * *  *
+      *     *      *
+         *  *  *
+
+This is GF version 3.12.0.
+Built on ...
+Git info: ...
+
+Flags: interrupt server c-runtime
+License: see help -license.
+
+This shell uses the C run-time system. See help for available commands.
+>
+```
+
+//If you get an "``error while loading shared libraries``" when trying to run GF with C runtime, remember to declare your ``LD_LIBRARY_PATH``.//
+//Add ``export LD_LIBRARY_PATH="/usr/local/lib"`` to either your ``.bashrc`` or ``.profile``. You should now be able to start GF with C runtime.//
 
 
-=== Python and Java bindings ===
+=== Use GF server mode with C runtime ===
+
+- **What —**
+With this feature, ``gf -server`` mode is extended with new requests to call the C run-time
+system, e.g. ``c-parse``, ``c-linearize`` and ``c-translate``.
+
+- **How —**
+
+Add the following lines in the ``stack.yaml`` file:
+
+```
+flags:
+   gf:
+     c-runtime: true
+     server: true
+extra-lib-dirs:
+   - /usr/local/lib
+```
+
+and then run ``stack install``, also from the top directory.
 
-The C run-time system can also be used from Python and Java. Python and Java
-bindings are found in the ``src/runtime/python`` and ``src/runtime/java``
-directories, respecively. Compile them by following the instructions in
-the ``INSTALL`` files in those directories.
 
-The Python library can also be installed from PyPI using `pip install pgf`.
 
 == Compilation of RGL ==
 
 As of 2018-07-26, the RGL is distributed separately from the GF compiler and runtimes.
 
+To get the source, follow the previous instructions on [how to clone a repository with Git #getting-source].
+
+After cloning the RGL, you should have a directory named ``gf-rgl`` on your computer.
+
 === Simple ===
 To install the RGL, you can use the following commands from within the ``gf-rgl`` repository:
 ```
@@ -418,103 +334,68 @@ If you do not have Haskell installed, you can use the simple build script ``Setu
 
 == Creating binary distribution packages ==
 
-=== Creating .deb packages for Ubuntu ===
+The binaries are generated with Github Actions. More details can be viewed here:
 
-This was tested on Ubuntu 14.04 for the release of GF 3.6, and the
-resulting ``.deb`` packages appears to work on Ubuntu 12.04, 13.10 and 14.04.
-For the release of GF 3.7, we generated ``.deb`` packages on Ubuntu 15.04 and
-tested them on Ubuntu 12.04 and 14.04.
+https://github.com/GrammaticalFramework/gf-core/actions/workflows/build-binary-packages.yml
 
-Under Ubuntu, Haskell executables are statically linked against other Haskell
-libraries, so the .deb packages are fairly self-contained.
 
-==== Preparations ====
+== Running the test suite ==
+
+The GF test suite is run with one of the following commands from the top directory:
 
 ```
-sudo apt-get install dpkg-dev debhelper
+  $ cabal test
 ```
 
-==== Creating the package ====
-
-Make sure the ``debian/changelog`` starts with an entry that describes the
-version you are building. Then run
+or
 
 ```
-make deb
+  $ stack test
 ```
 
-If get error messages about missing dependencies
-(e.g. ``autoconf``, ``automake``, ``libtool-bin``, ``python-dev``,
-``java-sdk``, ``txt2tags``)
-use ``apt-get intall`` to install them, then try again.
-
-
-=== Creating OS X Installer packages ===
-
-Run
-
-```
-make pkg
-```
-
-=== Creating binary tar distributions ===
-
-Run
-
-```
-make bintar
-```
-
-=== Creating .rpm packages for Fedora ===
-
-This is possible, but the procedure has not been automated.
-It involves using the cabal-rpm tool,
-
-```
-sudo dnf install cabal-rpm
-```
-
-and following the Fedora guide
-[How to create an RPM package http://fedoraproject.org/wiki/How_to_create_an_RPM_package].
-
-Under Fedora, Haskell executables are dynamically linked against other Haskell
-libraries, so ``.rpm`` packages for all Haskell libraries that GF depends on
-are required. Most of them are already available in the Fedora distribution,
-but a few of them might have to be built and distributed along with
-the GF ``.rpm`` package.
-When building ``.rpm`` packages for GF 3.4, we also had to build ``.rpm``s for
-``fst`` and ``httpd-shed``.
-
-== Running the testsuite ==
-
-**NOTE:** The test suite has not been maintained recently, so expect many
-tests to fail.
-%% // TH 2012-08-06
-
-GF has testsuite. It is run with the following command:
-```
-$ cabal test
-```
 The testsuite architecture for GF is very simple but still very flexible.
 GF by itself is an interpreter and could execute commands in batch mode.
 This is everything that we need to organize a testsuite. The root of the
-testsuite is the testsuite/ directory. It contains subdirectories which
-themself contain GF batch files (with extension .gfs). The above command
-searches the subdirectories of the testsuite/ directory for files with extension
-.gfs and when it finds one it is executed with the GF interpreter.
-The output of the script is stored in file with extension .out and is compared
-with the content of the corresponding file with extension .gold, if there is one.
-If the contents are identical the command reports that the test was passed successfully.
-Otherwise the test had failed.
+testsuite is the ``testsuite/`` directory. It contains subdirectories
+which themselves contain GF batch files (with extension ``.gfs``).
+The above command searches the subdirectories of the ``testsuite/`` directory
+for files with extension ``.gfs`` and when it finds one, it is executed with
+the GF interpreter. The output of the script is stored in file with extension ``.out``
+and is compared with the content of the corresponding file with extension ``.gold``, if there is one.
 
-Every time when you make some changes to GF that have to be tested, instead of
-writing the commands by hand in the GF shell, add them to one .gfs file in the testsuite
-and run the test. In this way you can use the same test later and we will be sure
-that we will not incidentaly break your code later.
+Every time when you make some changes to GF that have to be tested,
+instead of writing the commands by hand in the GF shell, add them to one ``.gfs``
+file in the testsuite subdirectory where its ``.gf`` file resides and run the test.
+In this way you can use the same test later and we will be sure that we will not
+accidentally break your code later.
+
+**Test Outcome - Passed:** If the contents of the files with the ``.out`` extension
+are identical to their correspondingly-named files with the extension ``.gold``,
+the command will report that the tests passed successfully, e.g.
 
-If you don't want to run the whole testsuite you can write the path to the subdirectory
-in which you are interested. For example:
 ```
-$ cabal test testsuite/compiler
+ Running 1 test suites...
+ Test suite gf-tests: RUNNING...
+ Test suite gf-tests: PASS
+ 1 of 1 test suites (1 of 1 test cases) passed.
 ```
-will run only the testsuite for the compiler.
+
+**Test Outcome - Failed:**  If there is a contents mismatch between the files
+with the ``.out`` extension and their corresponding files with the extension ``.gold``,
+the test diagnostics will show a fail and the areas that failed. e.g.
+
+```
+  testsuite/compiler/compute/Records.gfs: OK
+  testsuite/compiler/compute/Variants.gfs: FAIL
+  testsuite/compiler/params/params.gfs: OK
+  Test suite gf-tests: FAIL
+  0 of 1 test suites (0 of 1 test cases) passed.
+```
+
+The fail results overview is available in gf-tests.html which shows 4 columns:
+
++ __Results__ - only areas that fail will appear. (Note: There are 3 failures in the gf-tests.html which are labelled as (expected). These failures should be ignored.)
++ __Input__ - which is the test written in the .gfs file
++ __Gold__ - the expected output from running the test set out in the .gfs file. This column refers to the contents from the .gold extension files.
++ __Output__ - This column refers to the contents from the .out extension files which are generated as test output.
+After fixing the areas which fail, rerun the test command. Repeat the entire process of fix-and-test until the test suite passes before  submitting a pull request to include your changes.

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)

doc/gf-editor-modes.t2t

@@ -1,72 +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
-
-==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]

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.
 

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)

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

download/index-3.11.md

@@ -1,8 +1,9 @@
 ---
 title: Grammatical Framework Download and Installation
-...
+date: 25 July 2021
+---
 
-**GF 3.11** was released on ... December 2020.
+**GF 3.11** was released on 25 July 2021.
 
 What's new? See the [release notes](release-3.11.html).
 
@@ -24,22 +25,25 @@ Binary packages are available for Debian/Ubuntu, macOS, and Windows and include:
 
 Unlike in previous versions, the binaries **do not** include the RGL.
 
-[Binary packages on GitHub](https://github.com/GrammaticalFramework/gf-core/releases/tag/RELEASE-3.11)
+[Binary packages on GitHub](https://github.com/GrammaticalFramework/gf-core/releases/tag/3.11)
 
 #### Debian/Ubuntu
 
+There are two versions: `gf-3.11-ubuntu-18.04.deb` for Ubuntu 18.04 (Cosmic), and `gf-3.11-ubuntu-20.04.deb` for Ubuntu 20.04 (Focal).
+
 To install the package use:
+
 ```
-sudo dpkg -i gf_3.11.deb
+sudo apt-get install ./gf-3.11-ubuntu-*.deb
 ```
 
-The Ubuntu `.deb` packages should work on Ubuntu 16.04, 18.04 and similar Linux distributions.
+<!-- The Ubuntu `.deb` packages should work on Ubuntu 16.04, 18.04 and similar Linux distributions. -->
 
 #### macOS
 
 To install the package, just double-click it and follow the installer instructions.
 
-The packages should work on at least 10.13 (High Sierra) and 10.14 (Mojave).
+The packages should work on at least Catalina and Big Sur.
 
 #### Windows
 
@@ -49,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):
 
@@ -80,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.
+**Obtaining**
 
-## Installing from the latest developer source code
+To obtain the source code for the **release**,
+download it from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases).
 
-If you haven't already, clone the repository with:
+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
 ```
@@ -116,10 +135,12 @@ or, if you're a Stack user:
 stack install
 ```
 
-The above notes for installing from source apply also in these cases.
+<!--The above notes for installing from source apply also in these cases.-->
 For more info on working with the GF source code, see the
 [GF Developers Guide](../doc/gf-developers.html).
 
+For macOS Sequoia, you need to downgrade the LLVM package, see instructions [here](https://github.com/GrammaticalFramework/gf-core/issues/172#issuecomment-2599365457).
+
 ## Installing the Python bindings from PyPI
 
 The Python library is available on PyPI as `pgf`, so it can be installed using:

download/index-3.12.md

@@ -0,0 +1,191 @@
+---
+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/release-3.12)
+
+#### Debian/Ubuntu
+
+The package targets Ubuntu 24.04 (Noble).
+To install it, use:
+
+```
+sudo apt install ./gf-3.12-ubuntu-24.04.deb 
+```
+
+#### macOS
+
+If you are on an Intel Mac (2019 or older), use `gf-3.12-macos-intel.pkg`.<br>
+For newer ARM-based Macs (Apple Silicon M1, M2, M3), use `gf-3.12-macos-arm.pkg`.
+
+After downloading, right click on the file and click on Open.[^1]
+You will see a dialog saying that "macOS cannot verify the developer of "gf-3.12-macos-intel.pkg". Are you sure you want to open it?". 
+Press Open.
+
+[^1]: If you just double click on the file, you will get an error message "gf-3.12-macos-intel.pkg" cannot be opened because it is from an unidentified developer.
+
+#### Windows
+
+To install the package:
+
+1. unpack it anywhere and take note of the full path to the folder containing the `.exe` file. 
+2. add it to the `PATH` environment variable
+
+For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).
+
+## Installing from Hackage
+
+_Instructions applicable for macOS, Linux, and WSL2 on Windows._
+
+[GF is on Hackage](http://hackage.haskell.org/package/gf), so under
+normal circumstances the procedure is fairly simple:
+
+```
+cabal update
+cabal install gf-3.12
+```
+
+### Notes
+
+#### GHC version
+
+The GF source code is known to be compilable with GHC versions 7.10 through to 9.6.7.
+
+#### Obtaining Haskell
+
+There are various ways of obtaining Haskell, including:
+
+- ghcup
+    1. Install from https://www.haskell.org/ghcup/
+    2. `ghcup install ghc 9.6.7`
+    3. `ghcup set ghc 9.6.7`
+- Stack: https://haskellstack.org/
+
+
+#### Installation location
+
+The above steps install GF for a single user.
+The executables are put in `$HOME/.cabal/bin` (or on macOS in `$HOME/Library/Haskell/bin`),
+so you might want to add this directory to your path (in `.bash_profile` or similar):
+
+```
+PATH=$HOME/.cabal/bin:$PATH
+```
+
+#### Haskeline
+
+GF uses [`haskeline`](http://hackage.haskell.org/package/haskeline), which
+on Linux depends on some non-Haskell libraries that won't be installed
+automatically by Cabal, and therefore need to be installed manually.
+Here is one way to do this:
+
+- On Ubuntu: `sudo apt-get install libghc-haskeline-dev`
+- On Fedora: `sudo dnf install ghc-haskeline-devel`
+
+## Installing from source code
+
+### Obtaining
+
+To obtain the source code for the **release**,
+download it from [GitHub](https://github.com/GrammaticalFramework/gf-core/releases).
+
+Alternatively, to obtain the **latest version** of the source code:
+
+1. If you haven't already, clone the repository with:
+```
+git clone https://github.com/GrammaticalFramework/gf-core.git
+```
+2. If you've already cloned the repository previously, update with:
+```
+git pull
+```
+
+### Installing
+
+You can then install with:
+```
+cabal install
+```
+
+or, if you're a Stack user:
+
+```
+stack install
+```
+
+<!--The above notes for installing from source apply also in these cases.-->
+For more info on working with the GF source code, see the
+[GF Developers Guide](../doc/gf-developers.html).
+
+## Installing the Python bindings from PyPI
+
+The Python library is available on PyPI as `pgf`, so it can be installed using:
+
+```
+pip install pgf
+```
+
+If this doesn't work, you will need to install the C runtime manually; see the instructions [here](https://www.grammaticalframework.org/doc/gf-developers.html#toc12).
+
+---
+
+## Installing the RGL from a binary release
+
+Binary releases of the RGL are made available on [GitHub](https://github.com/GrammaticalFramework/gf-rgl/releases).
+In general the steps to follow are:
+
+1. Download a binary release and extract it somewhere on your system.
+2. Set the environment variable `GF_LIB_PATH` to point to wherever you extracted the RGL.
+
+For more information, see [Using GF on Windows](https://www.grammaticalframework.org/~inari/gf-windows.html) (latest updated for Windows 10).
+
+## Installing the RGL from source
+
+To compile the RGL, you will need to have GF already installed and in your path.
+
+1. Obtain the RGL source code, either by:
+  - cloning with `git clone https://github.com/GrammaticalFramework/gf-rgl.git`
+  - downloading a source archive [here](https://github.com/GrammaticalFramework/gf-rgl/archive/master.zip)
+2. Run `make` in the source code folder.
+
+For more options, see the [RGL README](https://github.com/GrammaticalFramework/gf-rgl/blob/master/README.md).
+
+---
+
+## Older releases
+
+- [GF 3.11](index-3.11.html) (July 2021)
+- [GF 3.10](index-3.10.html) (December 2018)
+- [GF 3.9](index-3.9.html) (August 2017)
+- [GF 3.8](index-3.8.html) (June 2016)
+- [GF 3.7.1](index-3.7.1.html) (October 2015)
+- [GF 3.7](index-3.7.html) (June 2015)
+- [GF 3.6](index-3.6.html) (June 2014)
+- [GF 3.5](index-3.5.html) (August 2013)
+- [GF 3.4](index-3.4.html) (January 2013)
+- [GF 3.3.3](index-3.3.3.html) (March 2012)
+- [GF 3.3](index-3.3.html) (October 2011)
+- [GF 3.2.9](index-3.2.9.html) source-only snapshot (September 2011)
+- [GF 3.2](index-3.2.html) (December 2010)
+- [GF 3.1.6](index-3.1.6.html) (April 2010)

download/index.html

@@ -1,8 +1,8 @@
 <html>
 <head>
-  <meta http-equiv="refresh" content="0; URL=/download/index-3.10.html" />
+  <meta http-equiv="refresh" content="0; URL=/download/index-3.12.html" />
 </head>
 <body>
-  You are being redirected to <a href="index-3.10.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>

download/release-3.11.md

@@ -1,7 +1,7 @@
 ---
 title: GF 3.11 Release Notes
-date: ... December 2020
-...
+date: 25 July 2021
+---
 
 ## Installation
 
@@ -12,24 +12,27 @@ See the [download page](index-3.11.html).
 From this release, the binary GF core packages do not contain the RGL.
 The RGL's release cycle is now completely separate from GF's. See [RGL releases](https://github.com/GrammaticalFramework/gf-rgl/releases).
 
-Over 400 changes have been pushed to GF core
+Over 500 changes have been pushed to GF core
 since the release of GF 3.10 in December 2018.
 
 ## General
 
 - Make the test suite work again.
 - Compatibility with new versions of GHC, including multiple Stack files for the different versions.
-- Updates to build scripts and CI.
-- Bug fixes.
+- Support for newer version of Ubuntu 20.04 in the precompiled binaries.
+- Updates to build scripts and CI workflows.
+- Bug fixes and code cleanup.
 
 ## GF compiler and run-time library
 
-- Huge improvements in time & space requirements for grammar compilation (pending [#87](https://github.com/GrammaticalFramework/gf-core/pull/87)).
 - Add CoNLL output to `visualize_tree` shell command.
 - Add canonical GF as output format in the compiler.
 - Add PGF JSON as output format in the compiler.
 - Deprecate JavaScript runtime in favour of updated [TypeScript runtime](https://github.com/GrammaticalFramework/gf-typescript).
+- Improvements in time & space requirements when compiling certain grammars.
 - Improvements to Haskell export.
+- Improvements to the GF shell.
+- Improvements to canonical GF compilation.
 - Improvements to the C runtime.
 - Improvements to `gf -server` mode.
 - Clearer compiler error messages.

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

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
+}

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 = [ ];
+              });
+        });
+    };
+}

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 ;

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"} ;
 }

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ä" ;
 }

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" ;
 }

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" ;
 }

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 ;

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 {

gf.cabal

@@ -1,20 +1,24 @@
 name: gf
-version: 3.10.4-git
+version: 3.12.0
 
-cabal-version: >= 1.22
-build-type: Custom
+cabal-version: 1.22
+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
-homepage: http://www.grammaticalframework.org/
+maintainer: John J. Camilleri <john@digitalgrammars.com>
+homepage: https://www.grammaticalframework.org/
 bug-reports: https://github.com/GrammaticalFramework/gf-core/issues
-maintainer: Thomas Hallgren
-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.10.4, GHC==9.0.2, GHC==9.2.4, GHC==9.6.7
 
 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
@@ -40,25 +44,17 @@ data-files:
   www/translator/*.css
   www/translator/*.js
 
-custom-setup
-  setup-depends:
-    base,
-    Cabal >=1.22.0.0,
-    directory,
-    filepath,
-    process >=1.0.1.1
-
 source-repository head
-  type:     git
+  type: git
   location: https://github.com/GrammaticalFramework/gf-core.git
 
 flag interrupt
   Description: Enable Ctrl+Break in the shell
-  Default:     True
+  Default: True
 
 flag server
   Description: Include --server mode
-  Default:     True
+  Default: True
 
 flag network-uri
    description: Get Network.URI from the network-uri package
@@ -70,24 +66,29 @@ flag network-uri
 
 flag c-runtime
   Description: Include functionality from the C run-time library (which must be installed already)
-  Default:     False
+  Default: False
 
 library
-  default-language:    Haskell2010
-  build-depends: base >= 4.6 && <5,
-                 array,
-                 containers,
-                 bytestring,
-                 utf8-string,
-                 random,
-                 pretty,
-                 mtl,
-                 exceptions,
-                 fail,
-                 -- For compatability with ghc < 8
-                 -- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant.
-                 transformers-compat,
-                 ghc-prim
+  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:
@@ -102,7 +103,7 @@ library
 --ghc-options: -fwarn-unused-imports
 --if impl(ghc>=7.8)
 --  ghc-options: +RTS -A20M -RTS
-  ghc-prof-options: -fprof-auto
+  -- ghc-prof-options: -fprof-auto
 
   exposed-modules:
     PGF
@@ -136,18 +137,29 @@ library
 
   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
+    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
+    c-sources: src/runtime/haskell-bind/utils.c
+    cc-options: -std=c99
 
 ---- GF compiler as a library:
 
-  build-depends: filepath, directory>=1.2, time,
-                 process, haskeline, parallel>=3, json
+  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 && < 2.21
 
   hs-source-dirs: src/compiler
   exposed-modules:
@@ -157,13 +169,19 @@ library
     GF.Text.Lexing
     GF.Grammar.Canonical
 
-  other-modules:
-    GF.Main GF.Compiler GF.Interactive
+    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
@@ -273,12 +291,17 @@ library
     cpp-options: -DC_RUNTIME
 
   if flag(server)
-    build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7,
-                   cgi>=3001.2.2.0
+    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, network>=2.6
+      build-depends:
+        network-uri >= 2.6.1.0 && < 2.7,
+        network>=2.6 && <3.2
     else
-      build-depends: network<2.6
+      build-depends:
+        network >= 2.5 && <3.2
 
     cpp-options: -DSERVER_MODE
     other-modules:
@@ -295,7 +318,10 @@ library
       Fold
       ExampleDemo
       ExampleService
-    hs-source-dirs: src/server src/server/transfer src/example-based
+    hs-source-dirs:
+      src/server
+      src/server/transfer
+      src/example-based
 
   if flag(interrupt)
     cpp-options: -DUSE_INTERRUPT
@@ -304,17 +330,30 @@ library
     other-modules: GF.System.NoSignal
 
   if impl(ghc>=7.8)
-    build-tools: happy>=1.19, alex>=3.1
+    build-tools:
+      happy>=1.19,
+      alex>=3.1
 --  ghc-options: +RTS -A20M -RTS
   else
-    build-tools: happy, alex>=3
+    build-tools:
+      happy,
+      alex>=3
 
   ghc-options: -fno-warn-tabs
 
   if os(windows)
-    build-depends: Win32
+    build-depends:
+      Win32 >= 2.3.1.1 && < 2.7
   else
-    build-depends: unix, terminfo>=0.4
+    build-depends:
+      terminfo >=0.4.0 && < 0.5
+
+    if impl(ghc >= 9.6)
+      build-depends: unix >= 2.8 && < 2.9
+
+    else
+      build-depends: unix >= 2.7.2 && < 2.8
+
 
   if impl(ghc>=8.2)
     ghc-options: -fhide-source-paths
@@ -322,8 +361,10 @@ library
 executable gf
   hs-source-dirs: src/programs
   main-is: gf-main.hs
-  default-language:    Haskell2010
-  build-depends: gf, base
+  default-language: Haskell2010
+  build-depends:
+    gf,
+    base >= 4.9.1 && < 4.22
   ghc-options: -threaded
 --ghc-options: -fwarn-unused-imports
 
@@ -332,25 +373,35 @@ executable gf
     if impl(ghc<7.8)
       ghc-options: -with-rtsopts=-K64M
 
-  ghc-prof-options: -auto-all
+  -- ghc-prof-options: -auto-all
 
   if impl(ghc>=8.2)
     ghc-options: -fhide-source-paths
 
-executable pgf-shell
---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
+-- 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
+  type: exitcode-stdio-1.0
+  main-is: run.hs
   hs-source-dirs: testsuite
-  build-depends:  base>=4.3 && <5, Cabal>=1.8, directory, filepath, process
+  build-depends:
+    base >= 4.9.1 && < 4.22,
+    Cabal >= 1.8,
+    directory >= 1.3.0 && < 1.4,
+    filepath >= 1.4.1 && < 1.5,
+    process >= 1.4.3 && < 1.7
   build-tool-depends: gf:gf
-  default-language:    Haskell2010
+  default-language: Haskell2010

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,60 +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 Freenode network, where you are welcome to look for help with small questions or just start a general discussion.
-    You can <a href="https://webchat.freenode.net/?channels=gf">open a web chat</a>
-    or <a href="/irc/">browse the channel logs</a>.
+    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>
-
     <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; 8 August 2021.
-      </dd>
       <dt class="col-sm-3 text-center text-nowrap">2020-09-29</dt>
       <dd class="col-sm-9">
         <a href="https://www.mitpressjournals.org/doi/pdf/10.1162/COLI_a_00378">Abstract Syntax as Interlingua</a>: Scaling Up the Grammatical Framework from Controlled Languages to Robust Pipelines. A paper in Computational Linguistics (2020) summarizing much of the development in GF in the past ten years.
       </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-12-03</dt>
-      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2018/">Sixth GF Summer School</a> in Stellenbosch (South Africa), 3–14 December 2018
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-12-02</dt>
-      <dd class="col-sm-9">
-        <strong>GF 3.10 released.</strong>
-        <a href="download/release-3.10.html">Release notes</a>
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2018-07-25</dt>
-      <dd class="col-sm-9">
-        The GF repository has been split in two:
-        <a href="https://github.com/GrammaticalFramework/gf-core">gf-core</a> and
-        <a href="https://github.com/GrammaticalFramework/gf-rgl">gf-rgl</a>.
-        The original <a href="https://github.com/GrammaticalFramework/GF">GF</a> repository is now archived.
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-08-11</dt>
-      <dd class="col-sm-9">
-        <strong>GF 3.9 released.</strong>
-        <a href="download/release-3.9.html">Release notes</a>
-      </dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-06-29</dt>
-      <dd class="col-sm-9">
-        GF is moving to <a href="https://github.com/GrammaticalFramework/GF/">GitHub</a>.</dd>
-      <dt class="col-sm-3 text-center text-nowrap">2017-03-13</dt>
-      <dd class="col-sm-9">
-        <a href="//school.grammaticalframework.org/2017/">GF Summer School</a> in Riga (Latvia), 14-25 August 2017
-      </dd>
     </dl>
 
     <h2>Projects</h2>
@@ -337,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),

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

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

src/compiler/GF/Command/Commands.hs

@@ -4,6 +4,7 @@ module GF.Command.Commands (
   options,flags,
   ) where
 import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+import System.Info(os)
 
 import PGF
 
@@ -21,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
 
@@ -165,14 +167,15 @@ pgfCommands = Map.fromList [
      synopsis = "generate random trees in the current abstract syntax",
      syntax = "gr [-cat=CAT] [-number=INT]",
      examples = [
-       mkEx "gr                     -- one tree in the startcat of the current grammar",
-       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,",
        "given in a file in the -probs flag."
@@ -181,13 +184,13 @@ pgfCommands = Map.fromList [
        ("cat","generation category"),
        ("lang","uses only functions that have linearizations in all these languages"),
        ("number","number of trees generated"),
-       ("depth","the maximum generation depth"),
+       ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
        ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
        ],
      exec = getEnv $ \ opts arg (Env pgf mos) -> do
        pgf <- optProbs opts (optRestricted opts pgf)
        gen <- newStdGen
-       let dp = valIntOpts "depth" 4 opts
+       let dp = valIntOpts "depth" Common.default_depth opts
        let ts  = case mexp (toExprs arg) of
                    Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
                    Nothing -> generateRandomDepth     gen pgf (optType pgf opts) (Just dp)
@@ -198,28 +201,28 @@ pgfCommands = Map.fromList [
      synopsis = "generates a list of trees, by default exhaustive",
      explanation = unlines [
        "Generates all trees of a given category. By default, ",
-       "the depth is limited to 4, but this can be changed by a flag.",
+       "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."
        ],
      flags = [
        ("cat","the generation category"),
-       ("depth","the maximum generation depth"),
+       ("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, to depth 4",
-       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 ?))"
+       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 = getEnv $ \ opts arg (Env pgf mos) -> do
        let pgfr = optRestricted opts pgf
-       let dp = valIntOpts "depth" 4 opts
-       let ts = case mexp (toExprs arg) of
-                  Just ex -> generateFromDepth pgfr ex (Just dp)
-                  Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp)
+       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 {
@@ -427,7 +430,8 @@ pgfCommands = Map.fromList [
        "are type checking and semantic computation."
        ],
      examples = [
-       mkEx "pt -compute (plus one two)                               -- compute value"
+       mkEx "pt -compute (plus one two)                               -- compute value",
+       mkEx ("p \"the 4 dogs\" | pt -transfer=digits2numeral | l  -- \"the four dogs\" ")
        ],
      exec = getEnv $ \ opts arg (Env pgf mos) ->
             returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,
@@ -545,7 +549,7 @@ 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 = getEnv $ \ opts arg (Env pgf mos) -> do
          let absname = abstractName pgf
@@ -758,7 +762,7 @@ pgfCommands = Map.fromList [
                   []        -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
                   open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
      where
-       dp = valIntOpts "depth" 4 opts
+       dp = valIntOpts "depth" Common.default_depth opts
 
    fromParse opts = foldr (joinPiped . fromParse1 opts) void
 
@@ -798,9 +802,9 @@ pgfCommands = Map.fromList [
        _ | 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   
+       _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t
        _ -> [s | lang <- optLangs pgf opts, s<-linear pgf opts lang t]
-   linChunks pgf opts t = 
+   linChunks pgf opts t =
      [(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]
 
    linear :: PGF -> [Option] -> CId -> Expr -> [String]
@@ -882,11 +886,15 @@ pgfCommands = Map.fromList [
                        Right ty   -> ty
           Nothing -> error ("Can't parse '"++str++"' as a type")
    optViewFormat opts = valStrOpts "format" "png" opts
-   optViewGraph opts = valStrOpts "view" "open" 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)
 
+   open_cmd | os == "linux"   = "xdg-open"
+            | os == "mingw32" = "start"
+            | otherwise       = "open"
+
    returnFromExprs es = return $ case es of
      [] -> pipeMessage "no trees found"
      _  -> fromExprs es
@@ -1000,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}"]
@@ -1022,4 +1030,4 @@ stanzas = map unlines . chop . lines where
 
 #if !(MIN_VERSION_base(4,9,0))
 errorWithoutStackTrace = error
-#endif
+#endif

src/compiler/GF/Command/CommonCommands.hs

@@ -19,6 +19,12 @@ import Data.Char (isSpace)
 
 import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
 
+-- store default generation depth in a variable and use everywhere
+default_depth :: Int
+default_depth = 5
+default_depth_str = show default_depth
+
+
 extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased
 
 commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)

src/compiler/GF/Command/TreeOperations.hs

@@ -5,6 +5,8 @@ module GF.Command.TreeOperations (
   ) where
 
 import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
+import PGF.Data(Expr(EApp,EFun))
+import PGF.TypeCheck(inferExpr)
 import Data.List
 
 type TreeOp = [Expr] -> [Expr]
@@ -16,15 +18,17 @@ 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]))
   ]
 
@@ -48,3 +52,18 @@ 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)

src/compiler/GF/Compile/CFGtoPGF.hs

@@ -18,7 +18,7 @@ import Data.List
 --------------------------
 
 cf2pgf :: FilePath -> ParamCFG -> PGF
-cf2pgf fpath cf = 
+cf2pgf fpath cf =
  let pgf = PGF Map.empty aname (cf2abstr cf) (Map.singleton cname (cf2concr cf))
  in updateProductionIndices pgf
  where
@@ -33,7 +33,7 @@ cf2abstr cfg = Abstr aflags afuns acats
 
     acats  = Map.fromList [(cat, ([], [(0,mkRuleName rule) | rule <- rules], 0))
                             | (cat,rules) <- (Map.toList . Map.fromListWith (++))
-                                                [(cat2id cat, catRules cfg cat) | 
+                                                [(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]
@@ -52,7 +52,7 @@ cf2concr cfg = Concr Map.empty Map.empty
     cats  = allCats' cfg
     rules = allRules cfg
 
-    sequences0 = Set.fromList (listArray (0,0) [SymCat 0 0] : 
+    sequences0 = Set.fromList (listArray (0,0) [SymCat 0 0] :
                                map mkSequence rules)
     sequences  = listArray (0,Set.size sequences0-1) (Set.toList sequences0)
 
@@ -102,7 +102,7 @@ cf2concr cfg = Concr Map.empty Map.empty
 
     mkLinDefRef (cat,_) =
       (cat2fid cat 0,[0])
-      
+
     addProd prods (fid,prod) =
       case IntMap.lookup fid prods of
         Just set -> IntMap.insert fid (Set.insert prod set) prods
@@ -130,5 +130,5 @@ cf2concr cfg = Concr Map.empty Map.empty
 
 mkRuleName rule =
   case ruleName rule of
-	CFObj n _ -> n
-	_         -> wildCId
+    CFObj n _ -> n
+    _         -> wildCId

src/compiler/GF/Compile/CheckGrammar.hs

@@ -175,7 +175,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do
         checkTyp gr typ
       case md of
         Just eqs -> mapM_ (\(L loc eq) -> mkCheck loc "the definition of function" $
-	                                        checkDef gr (m,c) typ eq) eqs
+                                          checkDef gr (m,c) typ eq) eqs
         Nothing  -> return ()
       return (AbsFun (Just (L loc typ)) ma md moper)
 
@@ -316,7 +316,7 @@ linTypeOfType cnc m typ = do
    mkLinArg (i,(n,mc@(m,cat))) = do
      val  <- lookLin mc
      let vars = mkRecType varLabel $ replicate n typeStr
-	 symb = argIdent n cat i
+         symb = argIdent n cat i
      rec <- if n==0 then return val else
                        errIn (render ("extending" $$
                                       nest 2 vars $$

src/compiler/GF/Compile/Compute/Concrete.hs

@@ -30,11 +30,12 @@ import Debug.Trace(trace)
 normalForm :: GlobalEnv -> L Ident -> Term -> Term
 normalForm (GE gr rv opts _) loc = err (bugloc loc) id . nfx (GE gr rv opts loc)
 
+nfx :: GlobalEnv -> Term -> Err Term
 nfx env@(GE _ _ _ loc) t = do
   v <- eval env [] t
-  case value2term loc [] v of
-    Left i  -> fail ("variable #"++show i++" is out of scope")
-    Right t -> return t
+  return (value2term loc [] v)
+    -- Old value2term error message:
+    -- Left i  -> fail ("variable #"++show i++" is out of scope")
 
 eval :: GlobalEnv -> Env -> Term -> Err Value
 eval (GE gr rvs opts loc) env t = ($ (map snd env)) # value cenv t
@@ -171,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
@@ -288,9 +289,9 @@ glue env (v1,v2) = glu v1 v2
           (v1,v2) -> if flag optPlusAsBind (opts env)
                        then VC v1 (VC (VApp BIND []) v2)
                        else let loc  = gloc env
-                                vt v = case value2term loc (local env) v of
-                                         Left i  -> Error ('#':show i)
-                                         Right t -> t
+                                vt v = value2term loc (local env) v
+                                        -- Old value2term error message:
+                                        --  Left i  -> Error ('#':show i)
                                 originalMsg = render $ ppL loc (hang "unsupported token gluing" 4
                                                                (Glue (vt v1) (vt v2)))
                                 term = render $ pp  $ Glue (vt v1) (vt v2)
@@ -355,9 +356,9 @@ select env vv =
       (v1,v2) -> ok2 VS v1 v2
 
 match loc cs v =
-  case value2term loc [] v of
-    Left i  -> bad ("variable #"++show i++" is out of scope")
-    Right t -> err bad return (matchPattern cs t)
+  err bad return (matchPattern cs (value2term loc [] v))
+    -- Old value2term error message:
+    -- Left i  -> bad ("variable #"++show i++" is out of scope")
   where
     bad = fail . ("In pattern matching: "++)
 
@@ -375,24 +376,23 @@ 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
 
     convertv cs' vty =
-      case value2term (gloc env) [] vty of
-        Left i    -> fail ("variable #"++show i++" is out of scope")
-        Right pty -> convert' cs' =<< paramValues'' env pty
+      convert' cs' =<< paramValues'' env (value2term (gloc env) [] vty)
+        -- Old value2term error message: Left i    -> fail ("variable #"++show i++" is out of scope")
 
     convert cs' ty = convert' cs' =<< paramValues' env ty
 
     convert' cs' ((pty,vs),pvs) =
       do sts  <- mapM (matchPattern cs') vs
          return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
-                                           (mapFst ($vs) sts)
+                                           (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
@@ -492,58 +492,60 @@ vtrace loc arg res = trace (render (hang (pv arg) 4 ("->"<+>pv res))) res
     pf (_,VString n) = pp n
     pf (_,v) = ppV v
     pa (_,v) = ppV v
-    ppV v = case value2term' True loc [] v of
-              Left i  -> "variable #" <> pp i <+> "is out of scope"
-              Right t -> ppTerm Unqualified 10 t
+    ppV v = ppTerm Unqualified 10 (value2term' True loc [] v)
+              -- Old value2term error message:
+              -- Left i  -> "variable #" <> pp i <+> "is out of scope"
 
 -- | Convert a value back to a term
-value2term :: GLocation -> [Ident] -> Value -> Either Int Term
+value2term :: GLocation -> [Ident] -> Value -> Term
 value2term = value2term' False
+
+value2term' :: Bool -> p -> [Ident] -> Value -> Term
 value2term' stop loc xs v0 =
   case v0 of
-    VApp pre vs    -> liftM (foldl App (Q (cPredef,predefName pre))) (mapM v2t vs)
-    VCApp f vs     -> liftM  (foldl App (QC f))   (mapM v2t vs)
-    VGen j vs      -> liftM2 (foldl App) (var j)  (mapM v2t vs)
-    VMeta j env vs -> liftM  (foldl App (Meta j)) (mapM v2t vs)
-    VProd bt v x f -> liftM2 (Prod bt x) (v2t v) (v2t' x f)
-    VAbs  bt   x f -> liftM  (Abs  bt x)         (v2t' x f)
-    VInt n         -> return (EInt n)
-    VFloat f       -> return (EFloat f)
-    VString s      -> return (if null s then Empty else K s)
-    VSort s        -> return (Sort s)
-    VImplArg v     -> liftM  ImplArg (v2t v)
-    VTblType p res -> liftM2 Table (v2t p) (v2t res)
-    VRecType rs    -> liftM  RecType (mapM (\(l,v) -> fmap ((,) l) (v2t v)) rs)
-    VRec as        -> liftM  R       (mapM (\(l,v) -> v2t v >>= \t -> return (l,(Nothing,t))) as)
-    VV t _ vs      -> liftM  (V t)   (mapM v2t vs)
-    VT wild v cs   -> v2t v >>= \t -> liftM (T ((if wild then TWild else TTyped) t)) (mapM nfcase cs)
-    VFV vs         -> liftM  FV (mapM v2t vs)
-    VC v1 v2       -> liftM2 C (v2t v1) (v2t v2)
-    VS v1 v2       -> liftM2 S (v2t v1) (v2t v2)
-    VP v l         -> v2t v >>= \t -> return (P t l)
-    VPatt p        -> return (EPatt p)
-    VPattType v    -> v2t v >>= return . EPattType
-    VAlts v vvs    -> liftM2 Alts (v2t v) (mapM (\(x,y) -> liftM2 (,) (v2t x) (v2t y)) vvs)
-    VStrs vs       -> liftM  Strs (mapM v2t vs)
+    VApp pre vs    -> applyMany (Q (cPredef,predefName pre)) vs
+    VCApp f vs     -> applyMany (QC f)                       vs
+    VGen j vs      -> applyMany (var j)                      vs
+    VMeta j env vs -> applyMany (Meta j)                     vs
+    VProd bt v x f -> Prod bt x (v2t v)  (v2t' x f)
+    VAbs  bt   x f -> Abs  bt x          (v2t' x f)
+    VInt n         -> EInt n
+    VFloat f       -> EFloat f
+    VString s      -> if null s then Empty else K s
+    VSort s        -> Sort s
+    VImplArg v     -> ImplArg (v2t v)
+    VTblType p res -> Table (v2t p) (v2t res)
+    VRecType rs    -> RecType [(l, v2t v) | (l,v) <- rs]
+    VRec as        -> R       [(l, (Nothing, v2t v)) | (l,v) <- as]
+    VV t _ vs      -> V t     (map v2t vs)
+    VT wild v cs   -> T ((if wild then TWild else TTyped) (v2t v)) (map nfcase cs)
+    VFV vs         -> FV (map v2t vs)
+    VC v1 v2       -> C (v2t v1) (v2t v2)
+    VS v1 v2       -> S (v2t v1) (v2t v2)
+    VP v l         -> P (v2t v) l
+    VPatt p        -> EPatt p
+    VPattType v    -> EPattType $ v2t v
+    VAlts v vvs    -> Alts (v2t v) [(v2t x, v2t y) | (x,y) <- vvs]
+    VStrs vs       -> Strs (map v2t vs)
 --  VGlue v1 v2    -> Glue (v2t v1) (v2t v2)
 --  VExtR v1 v2    -> ExtR (v2t v1) (v2t v2)
-    VError err     -> return (Error err)
-
+    VError err     -> Error err
   where
+    applyMany f vs = foldl App f (map v2t vs)
     v2t = v2txs xs
     v2txs = value2term' stop loc
     v2t' x f = v2txs (x:xs) (bind f (gen xs))
 
     var j
-      | j<length xs = Right (Vr (reverse xs !! j))
-      | otherwise   = Left  j
+      | j<length xs = Vr (reverse xs !! j)
+      | otherwise   = error ("variable #"++show j++" is out of scope")
 
 
     pushs xs e = foldr push e xs
     push x (env,xs) = ((x,gen xs):env,x:xs)
     gen xs = VGen (length xs) []
 
-    nfcase (p,f) = liftM ((,) p) (v2txs xs' (bind f env'))
+    nfcase (p,f) = (,) p (v2txs xs' (bind f env'))
       where (env',xs') = pushs (pattVars p) ([],xs)
 
     bind (Bind f) x = if stop

src/compiler/GF/Compile/Compute/Predef.hs

@@ -27,6 +27,10 @@ instance Predef Int where
 
 instance Predef Bool where
   toValue = boolV
+  fromValue v = case v of
+    VCApp (mn,i) [] | mn == cPredef && i == cPTrue -> return True
+    VCApp (mn,i) [] | mn == cPredef && i == cPFalse -> return False
+    _ -> verror "Bool" v
 
 instance Predef String where
   toValue = string

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -201,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

src/compiler/GF/Compile/GetGrammar.hs

@@ -42,11 +42,12 @@ 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}

src/compiler/GF/Compile/PGFtoHaskell.hs

@@ -51,7 +51,7 @@ grammar2haskell opts name gr = foldr (++++) [] $
           derivingClause
                  | dataExt = "deriving (Show,Data)"
                  | otherwise = "deriving Show"
-          extraImports | gadt = ["import Control.Monad.Identity", "import Data.Monoid"]
+          extraImports | gadt = ["import Control.Monad.Identity", "import Control.Monad", "import Data.Monoid"]
                        | dataExt = ["import Data.Data"]
                        | otherwise = []
           pgfImports | pgf2 = ["import PGF2 hiding (Tree)", "", "showCId :: CId -> String", "showCId = id"]

src/compiler/GF/Compile/Rename.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/30 18:39:44 $ 
+-- > CVS $Date: 2005/05/30 18:39:44 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.19 $
 --
@@ -23,9 +23,9 @@
 -----------------------------------------------------------------------------
 
 module GF.Compile.Rename (
-	       renameSourceTerm,
-	       renameModule
-	      ) where
+     renameSourceTerm,
+     renameModule
+    ) where
 
 import GF.Infra.Ident
 import GF.Infra.CheckM
@@ -68,7 +68,7 @@ renameIdentTerm env = accumulateError (renameIdentTerm' env)
 
 -- Fails immediately on error, makes it possible to try other possibilities
 renameIdentTerm' :: Status -> Term -> Check Term
-renameIdentTerm' env@(act,imps) t0 = 
+renameIdentTerm' env@(act,imps) t0 =
   case t0 of
     Vr c -> ident predefAbs c
     Cn c -> ident (\_ s -> checkError s) c
@@ -85,8 +85,8 @@ renameIdentTerm' env@(act,imps) t0 =
     _ -> return t0
   where
     opens   = [st  | (OSimple _,st) <- imps]
-    qualifs = [(m, st) | (OQualif m _, st) <- imps] ++ 
-              [(m, st) | (OQualif _ m, st) <- imps] ++ 
+    qualifs = [(m, st) | (OQualif m _, st) <- imps] ++
+              [(m, st) | (OQualif _ m, st) <- imps] ++
               [(m, st) | (OSimple m, st) <- imps] -- qualif is always possible
 
     -- this facility is mainly for BWC with GF1: you need not import PredefAbs
@@ -94,7 +94,7 @@ renameIdentTerm' env@(act,imps) t0 =
       | isPredefCat c = return (Q (cPredefAbs,c))
       | otherwise     = checkError s
 
-    ident alt c = 
+    ident alt c =
       case Map.lookup c act of
         Just f -> return (f c)
         _      -> case mapMaybe (Map.lookup c) opens of
@@ -157,7 +157,7 @@ modInfo2status (o,mo) = (o,tree2status o (jments mo))
 self2status :: ModuleName -> ModuleInfo -> StatusMap
 self2status c m = Map.mapWithKey (info2status (Just c)) (jments m)
 
-  
+
 renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info
 renameInfo cwd status (m,mi) i info =
   case info of
@@ -208,7 +208,7 @@ renameTerm env vars = ren vars where
     Abs b x t    -> liftM  (Abs b x) (ren (x:vs) t)
     Prod bt x a b -> liftM2 (Prod bt x) (ren vs a) (ren (x:vs) b)
     Typed a b  -> liftM2 Typed (ren vs a) (ren vs b)
-    Vr x      
+    Vr x
       | elem x vs -> return trm
       | otherwise -> renid trm
     Cn _   -> renid trm
@@ -219,7 +219,7 @@ renameTerm env vars = ren vars where
       i' <- case i of
         TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source
         _ -> return i
-      liftM (T i') $ mapM (renCase vs) cs  
+      liftM (T i') $ mapM (renCase vs) cs
 
     Let (x,(m,a)) b -> do
       m' <- case m of
@@ -229,7 +229,7 @@ renameTerm env vars = ren vars where
       b' <- ren (x:vs) b
       return $ Let (x,(m',a')) b'
 
-    P t@(Vr r) l                                               -- Here we have $r.l$ and this is ambiguous it could be either 
+    P t@(Vr r) l                                               -- Here we have $r.l$ and this is ambiguous it could be either
                                                                -- record projection from variable or constant $r$ or qualified expression with module $r$
       | elem r vs -> return trm                                -- try var proj first ..
       | otherwise -> checks [ renid' (Q (MN r,label2ident l))      -- .. and qualified expression second.
@@ -331,7 +331,7 @@ renamePattern env patt =
 renameContext :: Status -> Context -> Check Context
 renameContext b = renc [] where
   renc vs cont = case cont of
-    (bt,x,t) : xts 
+    (bt,x,t) : xts
       | isWildIdent x -> do
           t'   <- ren vs t
           xts' <- renc vs xts

src/compiler/GF/Compile/TypeCheck/Abstract.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/15 16:22:02 $ 
+-- > CVS $Date: 2005/09/15 16:22:02 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.16 $
 --
@@ -13,11 +13,11 @@
 -----------------------------------------------------------------------------
 
 module GF.Compile.TypeCheck.Abstract (-- * top-level type checking functions; TC should not be called directly.
-		  checkContext,
-		  checkTyp,
-		  checkDef,
-		  checkConstrs,
-		 ) where
+    checkContext,
+    checkTyp,
+    checkDef,
+    checkConstrs,
+   ) where
 
 import GF.Data.Operations
 
@@ -33,8 +33,8 @@ import GF.Text.Pretty
 --import Control.Monad (foldM, liftM, liftM2)
 
 -- | invariant way of creating TCEnv from context
-initTCEnv gamma = 
-  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma) 
+initTCEnv gamma =
+  (length gamma,[(x,VGen i x) | ((x,_),i) <- zip gamma [0..]], gamma)
 
 -- interface to TC type checker
 

src/compiler/GF/Compile/TypeCheck/Concrete.hs

@@ -69,7 +69,6 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
       lockRecType c t' ---- locking to be removed AR 20/6/2009
 
     _ | ty == typeTok -> return typeStr
-    _ | isPredefConstant ty -> return ty
 
     _ -> composOp (comp g) ty
 

src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs

@@ -396,7 +396,7 @@ tcRecTypeFields ge scope ((l,ty):rs) mb_ty = do
   return ((l,ty):rs,mb_ty)
 
 -- | Invariant: if the third argument is (Just rho),
--- 	            then rho is in weak-prenex form
+--              then rho is in weak-prenex form
 instSigma :: GlobalEnv -> Scope -> Term -> Sigma -> Maybe Rho -> TcM (Term, Rho)
 instSigma ge scope t ty1 Nothing    = return (t,ty1)           -- INST1
 instSigma ge scope t ty1 (Just ty2) = do                       -- INST2
@@ -568,9 +568,9 @@ unifyVar ge scope i env vs ty2 = do            -- Check whether i is bound
     Bound ty1       -> do v <- liftErr (eval ge env ty1)
                           unify ge scope (vapply (geLoc ge) v vs) ty2
     Unbound scope' _ -> case value2term (geLoc ge) (scopeVars scope') ty2 of
-                          Left i     -> let (v,_) = reverse scope !! i
-                                        in tcError ("Variable" <+> pp v <+> "has escaped")
-                          Right ty2' -> do ms2 <- getMetaVars (geLoc ge) [(scope,ty2)]
+                          -- Left i     -> let (v,_) = reverse scope !! i
+                          --               in tcError ("Variable" <+> pp v <+> "has escaped")
+                                ty2' -> do ms2 <- getMetaVars (geLoc ge) [(scope,ty2)]
                                            if i `elem` ms2
                                              then tcError ("Occurs check for" <+> ppMeta i <+> "in:" $$
                                                            nest 2 (ppTerm Unqualified 0 ty2'))
@@ -631,8 +631,8 @@ allBinders = [ identS [x]          | x <- ['a'..'z'] ] ++
 type Scope = [(Ident,Value)]
 
 type Sigma = Value
-type Rho   = Value	-- No top-level ForAll
-type Tau   = Value	-- No ForAlls anywhere
+type Rho   = Value -- No top-level ForAll
+type Tau   = Value -- No ForAlls anywhere
 
 data MetaValue
   = Unbound Scope Sigma
@@ -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
@@ -724,8 +724,8 @@ getMetaVars loc sc_tys = do
     go (Vr tv)    acc = acc
     go (App x y)  acc = go x (go y acc)
     go (Meta i)   acc
-	  | i `elem` acc  = acc
-	  | otherwise	  = i : acc
+      | i `elem` acc  = acc
+      | otherwise     = i : acc
     go (Q _)      acc = acc
     go (QC _)     acc = acc
     go (Sort _)   acc = acc
@@ -742,9 +742,9 @@ getFreeVars loc sc_tys = do
   return (foldr (go []) [] tys)
   where
     go bound (Vr tv)            acc
-	  | tv `elem` bound             = acc
-	  | tv `elem` acc               = acc
-	  | otherwise                   = tv : acc
+      | tv `elem` bound             = acc
+      | tv `elem` acc               = acc
+      | otherwise                   = tv : acc
     go bound (App x y)          acc = go bound x (go bound y acc)
     go bound (Meta _)           acc = acc
     go bound (Q _)              acc = acc
@@ -765,9 +765,9 @@ zonkTerm (Meta i) = do
 zonkTerm t = composOp zonkTerm t
 
 tc_value2term loc xs v =
-  case value2term loc xs v of
-    Left i  -> tcError ("Variable #" <+> pp i <+> "has escaped")
-    Right t -> return t
+  return $ value2term loc xs v
+    -- Old value2term error message:
+    -- Left i  -> tcError ("Variable #" <+> pp i <+> "has escaped")
 
 
 

src/compiler/GF/Compile/TypeCheck/TC.hs

@@ -5,21 +5,22 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/02 20:50:19 $ 
+-- > CVS $Date: 2005/10/02 20:50:19 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.11 $
 --
 -- Thierry Coquand's type checking algorithm that creates a trace
 -----------------------------------------------------------------------------
 
-module GF.Compile.TypeCheck.TC (AExp(..),
-	   Theory,
-	   checkExp,
-	   inferExp,
-	   checkBranch,
-	   eqVal,
-	   whnf
-	  ) where
+module GF.Compile.TypeCheck.TC (
+    AExp(..),
+    Theory,
+    checkExp,
+    inferExp,
+    checkBranch,
+    eqVal,
+    whnf
+  ) where
 
 import GF.Data.Operations
 import GF.Grammar
@@ -31,17 +32,17 @@ import Data.Maybe
 import GF.Text.Pretty
 
 data AExp =
-     AVr   Ident Val 
+     AVr   Ident Val
    | ACn   QIdent Val
-   | AType 
-   | AInt  Int 
+   | AType
+   | AInt  Int
    | AFloat Double
    | AStr  String
    | AMeta MetaId Val
    | ALet  (Ident,(Val,AExp)) AExp
-   | AApp  AExp AExp Val 
-   | AAbs  Ident Val AExp 
-   | AProd Ident AExp AExp 
+   | AApp  AExp AExp Val
+   | AAbs  Ident Val AExp
+   | AProd Ident AExp AExp
 -- -- | AEqs  [([Exp],AExp)] --- not used
    | ARecType [ALabelling]
    | AR    [AAssign]
@@ -50,7 +51,7 @@ data AExp =
    | AData Val
   deriving (Eq,Show)
 
-type ALabelling = (Label, AExp) 
+type ALabelling = (Label, AExp)
 type AAssign = (Label, (Val, AExp))
 
 type Theory = QIdent -> Err Val
@@ -71,7 +72,7 @@ whnf :: Val -> Err Val
 whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug
          case v of
   VApp u w -> do
-    u' <- whnf u 
+    u' <- whnf u
     w' <- whnf w
     app u' w'
   VClos env e -> eval env e
@@ -81,9 +82,9 @@ app :: Val -> Val -> Err Val
 app u v = case u of
   VClos env (Abs _ x e) -> eval ((x,v):env) e
   _ -> return $ VApp u v
-  
+
 eval :: Env -> Term -> Err Val
-eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $ 
+eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $
              case e of
   Vr x    -> lookupVar env x
   Q c   -> return $ VCn c
@@ -95,23 +96,23 @@ eval env e = ---- errIn ("eval" +++ prt e +++ "in" +++ prEnv env) $
   _ -> return $ VClos env e
 
 eqVal :: Int -> Val -> Val -> Err [(Val,Val)]
-eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $ 
+eqVal k u1 u2 = ---- errIn (prt u1 +++ "<>" +++ prBracket (show k) +++ prt u2) $
                 do
   w1 <- whnf u1
-  w2 <- whnf u2 
+  w2 <- whnf u2
   let v = VGen k
   case (w1,w2) of
     (VApp f1 a1, VApp f2 a2) -> liftM2 (++) (eqVal k f1 f2) (eqVal k a1 a2)
     (VClos env1 (Abs _ x1 e1), VClos env2 (Abs _ x2 e2)) ->
       eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2)
     (VClos env1 (Prod _ x1 a1 e1), VClos env2 (Prod _ x2 a2 e2)) ->
-      liftM2 (++) 
+      liftM2 (++)
         (eqVal k     (VClos            env1  a1) (VClos            env2  a2))
         (eqVal (k+1) (VClos ((x1,v x1):env1) e1) (VClos ((x2,v x1):env2) e2))
     (VGen i _, VGen j _) -> return [(w1,w2) | i /= j]
-    (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j] 
+    (VCn (_, i), VCn (_,j)) -> return [(w1,w2) | i /= j]
     --- thus ignore qualifications; valid because inheritance cannot
-    --- be qualified. Simplifies annotation. AR 17/3/2005 
+    --- be qualified. Simplifies annotation. AR 17/3/2005
     _ -> return [(w1,w2) | w1 /= w2]
 -- invariant: constraints are in whnf
 
@@ -127,10 +128,10 @@ checkExp th tenv@(k,rho,gamma) e ty = do
 
     Abs _ x t -> case typ of
       VClos env (Prod _ y a b) -> do
-	a' <- whnf $ VClos env a ---
-	(t',cs) <- checkExp th 
-                           (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
-	return (AAbs x a' t', cs)
+                           a' <- whnf $ VClos env a ---
+                           (t',cs) <- checkExp th
+                                          (k+1,(x,v x):rho, (x,a'):gamma) t (VClos ((y,v x):env) b)
+                           return (AAbs x a' t', cs)
       _ -> Bad (render ("function type expected for" <+> ppTerm Unqualified 0 e <+> "instead of" <+> ppValue Unqualified 0 typ))
 
     Let (x, (mb_typ, e1)) e2 -> do
@@ -150,7 +151,7 @@ checkExp th tenv@(k,rho,gamma) e ty = do
       (b',csb) <- checkType th (k+1, (x,v x):rho, (x,VClos rho a):gamma) b
       return (AProd x a' b', csa ++ csb)
 
-    R xs -> 
+    R xs ->
       case typ of
         VRecType ys -> do case [l | (l,_) <- ys, isNothing (lookup l xs)] of
                             [] -> return ()
@@ -174,7 +175,7 @@ checkInferExp th tenv@(k,_,_) e typ = do
   (e',w,cs1) <- inferExp th tenv e
   cs2 <- eqVal k w typ
   return (e',cs1 ++ cs2)
-      
+
 inferExp :: Theory -> TCEnv -> Term -> Err (AExp, Val, [(Val,Val)])
 inferExp th tenv@(k,rho,gamma) e = case e of
    Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
@@ -200,13 +201,13 @@ inferExp th tenv@(k,rho,gamma) e = case e of
     (e2,val2,cs2) <- inferExp th (k,rho,(x,val1):gamma) e2
     return (ALet (x,(val1,e1)) e2, val2, cs1++cs2)
    App f t -> do
-    (f',w,csf) <- inferExp th tenv f 
+    (f',w,csf) <- inferExp th tenv f
     typ <- whnf w
     case typ of
       VClos env (Prod _ x a b) -> do
         (a',csa) <- checkExp th tenv t (VClos env a)
-	b' <- whnf $ VClos ((x,VClos rho t):env) b
-	return $ (AApp f' a' b', b', csf ++ csa)
+        b' <- whnf $ VClos ((x,VClos rho t):env) b
+        return $ (AApp f' a' b', b', csf ++ csa)
       _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
    _ -> Bad (render ("cannot infer type of expression" <+> ppTerm Unqualified 0 e))
 
@@ -232,9 +233,9 @@ checkAssign th tenv@(k,rho,gamma) typs (lbl,(Nothing,exp)) = do
                    return ((lbl,(val,aexp)),cs)
 
 checkBranch :: Theory -> TCEnv -> Equation -> Val -> Err (([Term],AExp),[(Val,Val)])
-checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $ 
-                                  chB tenv' ps' ty 
- where 
+checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
+                                  chB tenv' ps' ty
+ where
 
   (ps',_,rho2,k') = ps2ts k ps
   tenv' = (k, rho2++rho, gamma) ---- k' ?
@@ -245,11 +246,11 @@ checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
       typ <- whnf ty
       case typ of
         VClos env (Prod _ y a b) -> do
-	  a' <- whnf $ VClos env a
+          a' <- whnf $ VClos env a
           (p', sigma, binds, cs1) <- checkP tenv p y a'
           let tenv' = (length binds, sigma ++ rho, binds ++ gamma)
           ((ps',exp),cs2) <- chB tenv' ps2 (VClos ((y,p'):env) b)
-	  return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
+          return ((p:ps',exp), cs1 ++ cs2) -- don't change the patt
         _ -> Bad (render ("Product expected for definiens" <+> ppTerm Unqualified 0 t <+> "instead of" <+> ppValue Unqualified 0 typ))
     [] -> do
       (e,cs) <- checkExp th tenv t ty
@@ -259,15 +260,15 @@ checkBranch th tenv b@(ps,t) ty = errIn ("branch" +++ show b) $
      let sigma = [(x, VGen i x) | ((x,_),i) <- zip delta [k..]]
      return (VClos sigma t, sigma, delta, cs)
 
-  ps2ts k = foldr p2t ([],0,[],k) 
+  ps2ts k = foldr p2t ([],0,[],k)
   p2t p (ps,i,g,k) = case p of
-     PW      -> (Meta i : ps, i+1,g,k) 
+     PW      -> (Meta i : ps, i+1,g,k)
      PV x    -> (Vr x   : ps, i, upd x k g,k+1)
      PAs x p -> p2t p (ps,i,g,k)
      PString s -> (K s : ps, i, g, k)
      PInt n -> (EInt n : ps, i, g, k)
      PFloat n -> (EFloat n : ps, i, g, k)
-     PP c xs -> (mkApp (Q c) xss : ps, j, g',k') 
+     PP c xs -> (mkApp (Q c) xss : ps, j, g',k')
                     where (xss,j,g',k') = foldr p2t ([],i,g,k) xs
      PImplArg p -> p2t p (ps,i,g,k)
      PTilde t -> (t : ps, i, g, k)
@@ -307,8 +308,8 @@ checkPatt th tenv exp val = do
        case typ of
          VClos env (Prod _ x a b) -> do
            (a',_,csa) <- checkExpP tenv t (VClos env a)
-	   b' <- whnf $ VClos ((x,VClos rho t):env) b
-	   return $ (AApp f' a' b', b', csf ++ csa)
+           b' <- whnf $ VClos ((x,VClos rho t):env) b
+           return $ (AApp f' a' b', b', csf ++ csa)
          _ -> Bad (render ("Prod expected for function" <+> ppTerm Unqualified 0 f <+> "instead of" <+> ppValue Unqualified 0 typ))
      _ -> Bad (render ("cannot typecheck pattern" <+> ppTerm Unqualified 0 exp))
 
@@ -321,4 +322,3 @@ mkAnnot :: (Val -> AExp) -> Err (Val,[(Val,Val)]) -> Err (AExp,Val,[(Val,Val)])
 mkAnnot a ti = do
   (v,cs) <- ti
   return (a v, v, cs)
-

src/compiler/GF/Compile/Update.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/05/30 18:39:44 $ 
+-- > CVS $Date: 2005/05/30 18:39:44 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.8 $
 --
@@ -34,14 +34,14 @@ buildAnyTree :: Fail.MonadFail m => ModuleName -> [(Ident,Info)] -> m (Map.Map I
 buildAnyTree m = go Map.empty
   where
     go map []         = return map
-    go map ((c,j):is) = do
+    go map ((c,j):is) =
       case Map.lookup c map of
         Just i  -> case unifyAnyInfo m i j of
-		     Ok k  -> go (Map.insert c k map) is
-		     Bad _ -> fail $ render ("conflicting information in module"<+>m $$
-		                             nest 4 (ppJudgement Qualified (c,i)) $$
-		                             "and" $+$
-		                             nest 4 (ppJudgement Qualified (c,j)))
+          Ok k  -> go (Map.insert c k map) is
+          Bad _ -> fail $ render ("conflicting information in module"<+>m $$
+                                  nest 4 (ppJudgement Qualified (c,i)) $$
+                                  "and" $+$
+                                  nest 4 (ppJudgement Qualified (c,j)))
         Nothing -> go (Map.insert c j map) is
 
 extendModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
@@ -51,14 +51,14 @@ extendModule cwd gr (name,m)
   ---- Should be replaced by real control. AR 4/2/2005
   | mstatus m == MSIncomplete && isModCnc m = return (name,m)
   | otherwise                               = checkInModule cwd m NoLoc empty $ do
-                                                 m' <- foldM extOne m (mextend m) 
+                                                 m' <- foldM extOne m (mextend m)
                                                  return (name,m')
  where
    extOne mo (n,cond) = do
      m0 <- lookupModule gr n
 
      -- test that the module types match, and find out if the old is complete
-     unless (sameMType (mtype m) (mtype mo)) 
+     unless (sameMType (mtype m) (mtype mo))
             (checkError ("illegal extension type to module" <+> name))
 
      let isCompl = isCompleteModule m0
@@ -67,7 +67,7 @@ extendModule cwd gr (name,m)
      js1 <- extendMod gr isCompl ((n,m0), isInherited cond) name (jments mo)
 
      -- if incomplete, throw away extension information
-     return $ 
+     return $
           if isCompl
             then mo {jments = js1}
             else mo {mextend= filter ((/=n) . fst) (mextend mo)
@@ -75,7 +75,7 @@ extendModule cwd gr (name,m)
                     ,jments = js1
                     }
 
--- | rebuilding instance + interface, and "with" modules, prior to renaming. 
+-- | rebuilding instance + interface, and "with" modules, prior to renaming.
 -- AR 24/10/2003
 rebuildModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
 rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js_)) =
@@ -88,8 +88,8 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
 
     -- add the information given in interface into an instance module
     Nothing -> do
-      unless (null is || mstatus mi == MSIncomplete) 
-             (checkError ("module" <+> i <+> 
+      unless (null is || mstatus mi == MSIncomplete)
+             (checkError ("module" <+> i <+>
                           "has open interfaces and must therefore be declared incomplete"))
       case mt of
         MTInstance (i0,mincl) -> do
@@ -113,7 +113,7 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
       let stat' = if all (flip elem infs) is
                     then MSComplete
                     else MSIncomplete
-      unless (stat' == MSComplete || stat == MSIncomplete) 
+      unless (stat' == MSComplete || stat == MSIncomplete)
              (checkError ("module" <+> i <+> "remains incomplete"))
       ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext
       let ops1 = nub $
@@ -141,24 +141,24 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
 extendMod :: Grammar ->
              Bool -> (Module,Ident -> Bool) -> ModuleName ->
              Map.Map Ident Info -> Check (Map.Map Ident Info)
-extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jments mi) 
+extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jments mi)
   where
     try new (c,i0)
       | not (cond c) = return new
       | otherwise    = case Map.lookup c new of
                          Just j -> case unifyAnyInfo name i j of
-		                     Ok k  -> return $ Map.insert c k new
-		                     Bad _ -> do (base,j) <- case j of 
-		                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
-		                                               _          -> return (base,j)
-		                                 (name,i) <- case i of 
+                                     Ok k  -> return $ Map.insert c k new
+                                     Bad _ -> do (base,j) <- case j of
+                                                               AnyInd _ m -> lookupOrigInfo gr (m,c)
+                                                               _          -> return (base,j)
+                                                 (name,i) <- case i of
                                                                AnyInd _ m -> lookupOrigInfo gr (m,c)
                                                                _          -> return (name,i)
-		                                 checkError ("cannot unify the information" $$ 
-		                                             nest 4 (ppJudgement Qualified (c,i)) $$
-		                                             "in module" <+> name <+> "with" $$
-		                                             nest 4 (ppJudgement Qualified (c,j)) $$
-		                                             "in module" <+> base)
+                                                 checkError ("cannot unify the information" $$
+                                                             nest 4 (ppJudgement Qualified (c,i)) $$
+                                                             "in module" <+> name <+> "with" $$
+                                                             nest 4 (ppJudgement Qualified (c,j)) $$
+                                                             "in module" <+> base)
                          Nothing-> if isCompl
                                      then return $ Map.insert c (indirInfo name i) new
                                      else return $ Map.insert c i new
@@ -166,11 +166,11 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
         i = globalizeLoc (msrc mi) i0
 
     indirInfo :: ModuleName -> Info -> Info
-    indirInfo n info = AnyInd b n' where 
+    indirInfo n info = AnyInd b n' where
       (b,n') = case info of
         ResValue _ -> (True,n)
         ResParam _ _ -> (True,n)
-        AbsFun _ _ Nothing _ -> (True,n) 
+        AbsFun _ _ Nothing _ -> (True,n)
         AnyInd b k -> (b,k)
         _ -> (False,n) ---- canonical in Abs
 
@@ -194,24 +194,24 @@ globalizeLoc fpath i =
 
 unifyAnyInfo :: ModuleName -> Info -> Info -> Err Info
 unifyAnyInfo m i j = case (i,j) of
-  (AbsCat mc1, AbsCat mc2) -> 
+  (AbsCat mc1, AbsCat mc2) ->
     liftM AbsCat (unifyMaybeL mc1 mc2)
-  (AbsFun mt1 ma1 md1 moper1, AbsFun mt2 ma2 md2 moper2) -> 
+  (AbsFun mt1 ma1 md1 moper1, AbsFun mt2 ma2 md2 moper2) ->
     liftM4 AbsFun (unifyMaybeL mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) (unifyMaybe moper1 moper2) -- adding defs
 
   (ResParam mt1 mv1, ResParam mt2 mv2) ->
     liftM2 ResParam (unifyMaybeL mt1 mt2) (unifyMaybe mv1 mv2)
-  (ResValue (L l1 t1), ResValue (L l2 t2)) 
+  (ResValue (L l1 t1), ResValue (L l2 t2))
       | t1==t2    -> return (ResValue (L l1 t1))
       | otherwise -> fail ""
   (_, ResOverload ms t) | elem m ms ->
     return $ ResOverload ms t
-  (ResOper mt1 m1, ResOper mt2 m2) -> 
+  (ResOper mt1 m1, ResOper mt2 m2) ->
     liftM2 ResOper (unifyMaybeL mt1 mt2) (unifyMaybeL m1 m2)
 
-  (CncCat mc1 md1 mr1 mp1 mpmcfg1, CncCat mc2 md2 mr2 mp2 mpmcfg2) -> 
+  (CncCat mc1 md1 mr1 mp1 mpmcfg1, CncCat mc2 md2 mr2 mp2 mpmcfg2) ->
     liftM5 CncCat (unifyMaybeL mc1 mc2) (unifyMaybeL md1 md2) (unifyMaybeL mr1 mr2) (unifyMaybeL mp1 mp2)  (unifyMaybe mpmcfg1 mpmcfg2)
-  (CncFun m mt1 md1 mpmcfg1, CncFun _ mt2 md2 mpmcfg2) -> 
+  (CncFun m mt1 md1 mpmcfg1, CncFun _ mt2 md2 mpmcfg2) ->
     liftM3 (CncFun m) (unifyMaybeL mt1 mt2) (unifyMaybeL md1 md2) (unifyMaybe mpmcfg1 mpmcfg2)
 
   (AnyInd b1 m1, AnyInd b2 m2) -> do

src/compiler/GF/CompileInParallel.hs

@@ -61,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"]
 
@@ -175,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)
 
@@ -238,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

src/compiler/GF/Data/BacktrackM.hs

@@ -16,18 +16,18 @@
 {-# LANGUAGE CPP #-}
 module GF.Data.BacktrackM (
                     -- * the backtracking state monad
-		    BacktrackM,
-		    -- * monad specific utilities
-		    member,
-		    cut,
-		    -- * running the monad
-		    foldBM,          runBM,
-		    foldSolutions,   solutions,
-		    foldFinalStates, finalStates,
-		    
-		    -- * reexport the 'MonadState' class
-		    module Control.Monad.State.Class,
-		  ) where
+                    BacktrackM,
+                    -- * monad specific utilities
+                    member,
+                    cut,
+                    -- * running the monad
+                    foldBM,          runBM,
+                    foldSolutions,   solutions,
+                    foldFinalStates, finalStates,
+
+                    -- * reexport the 'MonadState' class
+                    module Control.Monad.State.Class,
+                  ) where
 
 import Data.List
 import Control.Applicative
@@ -64,13 +64,13 @@ 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
+        where unBM (BM m) = m
 
 #if !(MIN_VERSION_base(4,13,0))
     fail = Fail.fail

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

src/compiler/GF/Data/Graph.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/10 16:43:44 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.2 $
 --
@@ -34,7 +34,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 
 data Graph n a b = Graph [n] ![Node n a] ![Edge n b]
-		 deriving (Eq,Show)
+    deriving (Eq,Show)
 
 type Node n a = (n,a)
 type Edge n b = (n,n,b)
@@ -63,7 +63,7 @@ emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es]
 
 -- | Add a node to the graph.
 newNode :: a               -- ^ Node label
-        -> Graph n a b 
+        -> Graph n a b
         -> (Graph n a b,n) -- ^ Node graph and name of new node
 newNode l (Graph (c:cs) ns es) = (Graph cs ((c,l):ns) es, c)
 
@@ -83,7 +83,7 @@ newEdges es g = foldl' (flip newEdge) g es
 -- lazy version:
 -- newEdges es' (Graph c ns es) = Graph c ns (es'++es)
 
-insertEdgeWith :: Eq n => 
+insertEdgeWith :: Eq n =>
                   (b -> b -> b) -> Edge n b -> Graph n a b -> Graph n a b
 insertEdgeWith f e@(x,y,l) (Graph c ns es) = Graph c ns (h es)
   where h [] = [e]
@@ -97,7 +97,7 @@ removeNode n = removeNodes (Set.singleton n)
 -- | Remove a set of nodes and all edges to and from those nodes.
 removeNodes :: Ord n => Set n -> Graph n a b -> Graph n a b
 removeNodes xs (Graph c ns es) = Graph c ns' es'
-  where 
+  where
   keepNode n = not (Set.member n xs)
   ns' = [ x | x@(n,_) <- ns, keepNode n ]
   es' = [ e | e@(f,t,_) <- es, keepNode f && keepNode t ]
@@ -105,7 +105,7 @@ removeNodes xs (Graph c ns es) = Graph c ns' es'
 -- | Get a map of node names to info about each node.
 nodeInfo :: Ord n => Graph n a b -> NodeInfo n a b
 nodeInfo g = Map.fromList [ (n, (x, fn inc n, fn out n)) | (n,x) <- nodes g ]
-  where 
+  where
   inc = groupEdgesBy edgeTo g
   out = groupEdgesBy edgeFrom g
   fn m n = fromMaybe [] (Map.lookup n m)
@@ -148,16 +148,16 @@ reverseGraph :: Graph n a b -> Graph n a b
 reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]
 
 -- | Add the nodes from the second graph to the first graph.
---   The nodes in the second graph will be renamed using the name 
+--   The nodes in the second graph will be renamed using the name
 --   supply in the first graph.
 --   This function is more efficient when the second graph
 --   is smaller than the first.
-mergeGraphs :: Ord m => Graph n a b -> Graph m a b 
+mergeGraphs :: Ord m => Graph n a b -> Graph m a b
             -> (Graph n a b, m -> n) -- ^ The new graph and a function translating
                                       --  the old names of nodes in the second graph
                                       --  to names in the new graph.
 mergeGraphs (Graph c ns1 es1) g2 = (Graph c' (ns2++ns1) (es2++es1), newName)
-  where 
+  where
   (xs,c') = splitAt (length (nodes g2)) c
   newNames = Map.fromList (zip (map fst (nodes g2)) xs)
   newName n = fromJust $ Map.lookup n newNames
@@ -170,7 +170,7 @@ renameNodes :: (n -> m) -- ^ renaming function
             -> Graph n a b -> Graph m a b
 renameNodes newName c (Graph _ ns es) = Graph c ns' es'
     where ns' = map' (\ (n,x) -> (newName n,x)) ns
-	  es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
+          es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
 
 -- | A strict 'map'
 map' :: (a -> b) -> [a] -> [b]

src/compiler/GF/Data/Graphviz.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/15 18:10:44 $ 
+-- > CVS $Date: 2005/09/15 18:10:44 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.2 $
 --
@@ -13,14 +13,14 @@
 -----------------------------------------------------------------------------
 
 module GF.Data.Graphviz (
-				  Graph(..), GraphType(..), 
-				  Node(..), Edge(..),
-				  Attr,
-                                  addSubGraphs,
-                                  setName,
-                                  setAttr,
-				  prGraphviz
-			) where
+                          Graph(..), GraphType(..),
+                          Node(..), Edge(..),
+                          Attr,
+                          addSubGraphs,
+                          setName,
+                          setAttr,
+                          prGraphviz
+                        ) where
 
 import Data.Char
 
@@ -70,14 +70,14 @@ prGraphviz g@(Graph t i _ _ _ _) =
     graphtype t ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}\n"
 
 prSubGraph :: Graph -> String
-prSubGraph g@(Graph _ i _ _ _ _) = 
+prSubGraph g@(Graph _ i _ _ _ _) =
     "subgraph" ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}"
 
 prGraph :: Graph -> String
-prGraph (Graph t id at ns es ss) = 
+prGraph (Graph t id at ns es ss) =
     unlines $ map (++";") (map prAttr at
-		           ++ map prNode ns 
-		           ++ map (prEdge t) es
+                           ++ map prNode ns
+                           ++ map (prEdge t) es
                            ++ map prSubGraph ss)
 
 graphtype :: GraphType -> String
@@ -96,7 +96,7 @@ edgeop Undirected = "--"
 
 prAttrList :: [Attr] -> String
 prAttrList [] = ""
-prAttrList at =	"[" ++ join "," (map prAttr at) ++ "]"
+prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"
 
 prAttr :: Attr -> String
 prAttr (n,v) = esc n ++ " = " ++ esc v

src/compiler/GF/Data/Operations.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/11 16:12:41 $ 
+-- > CVS $Date: 2005/11/11 16:12:41 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.22 $
 --
@@ -15,34 +15,34 @@
 -----------------------------------------------------------------------------
 
 module GF.Data.Operations (
-		   -- ** The Error monad
-		   Err(..), err, maybeErr, testErr, fromErr, errIn, 
-		   lookupErr,
+     -- ** The Error monad
+     Err(..), err, maybeErr, testErr, fromErr, errIn,
+     lookupErr,
 
-		   -- ** Error monad class
-		   ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
-                   liftErr,
-		   
-		   -- ** Checking
-		   checkUnique, unifyMaybeBy, unifyMaybe,
+     -- ** Error monad class
+     ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
+                 liftErr,
 
-           -- ** Monadic operations on lists and pairs
-		   mapPairsM, pairM,
- 
-		   -- ** Printing
-		   indent, (+++), (++-), (++++), (+++-), (+++++),
-		   prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly, 
-		   prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
-		   numberedParagraphs, prConjList, prIfEmpty, wrapLines,
+     -- ** Checking
+     checkUnique, unifyMaybeBy, unifyMaybe,
 
-		   -- ** Topological sorting
-		   topoTest, topoTest2,
+         -- ** Monadic operations on lists and pairs
+     mapPairsM, pairM,
 
-		   -- ** Misc
-		   readIntArg,
-		   iterFix,  chunks,
-                
-		  ) where
+     -- ** Printing
+     indent, (+++), (++-), (++++), (+++-), (+++++),
+     prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
+     prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
+     numberedParagraphs, prConjList, prIfEmpty, wrapLines,
+
+     -- ** Topological sorting
+     topoTest, topoTest2,
+
+     -- ** Misc
+     readIntArg,
+     iterFix,  chunks,
+
+    ) where
 
 import Data.Char (isSpace, toUpper, isSpace, isDigit)
 import Data.List (nub, partition, (\\))
@@ -107,7 +107,7 @@ indent i s = replicate i ' ' ++ s
 (+++), (++-), (++++), (+++-), (+++++) :: String -> String -> String
 a +++ b   = a ++ " "    ++ b
 
-a ++- ""  = a 
+a ++- ""  = a
 a ++- b   = a +++ b
 
 a ++++ b  = a ++ "\n"   ++ b
@@ -145,20 +145,20 @@ prCurly   s = "{" ++ s ++ "}"
 prBracket s = "[" ++ s ++ "]"
 
 prArgList, prSemicList, prCurlyList :: [String] -> String
-prArgList   = prParenth . prTList "," 
+prArgList   = prParenth . prTList ","
 prSemicList = prTList " ; "
 prCurlyList = prCurly . prSemicList
 
 restoreEscapes :: String -> String
-restoreEscapes s = 
-  case s of 
+restoreEscapes s =
+  case s of
     []       -> []
     '"' : t  -> '\\' : '"'  : restoreEscapes t
     '\\': t  -> '\\' : '\\' : restoreEscapes t
     c   : t  -> c : restoreEscapes t
 
 numberedParagraphs :: [[String]] -> [String]
-numberedParagraphs t = case t of 
+numberedParagraphs t = case t of
   []   -> []
   p:[] -> p
   _    -> concat [(show n ++ ".") : s | (n,s) <- zip [1..] t]
@@ -204,12 +204,12 @@ topoTest2 g0 = maybe (Right cycles) Left (tsort g)
         ([],[]) -> Just []
         ([],_) -> Nothing
         (ns,rest) -> (leaves:) `fmap` tsort [(n,es \\ leaves) | (n,es)<-rest]
-	  where leaves = map fst ns
+            where leaves = map fst ns
 
 
 -- | Fix point iterator (for computing e.g. transitive closures or reachability)
 iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
-iterFix more start = iter start start 
+iterFix more start = iter start start
   where
     iter old new = if (null new')
                       then old
@@ -241,7 +241,7 @@ liftErr e = err raise return e
 {-
 instance ErrorMonad (STM s) where
   raise msg = STM (\s -> raise msg)
-  handle (STM f) g = STM (\s -> (f s) 
+  handle (STM f) g = STM (\s -> (f s)
                                 `handle` (\e -> let STM g' = (g e) in
                                                     g' s))
 

src/compiler/GF/Data/Relation.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 17:13:13 $ 
+-- > CVS $Date: 2005/10/26 17:13:13 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.1 $
 --
@@ -83,7 +83,7 @@ transitiveClosure r = fix (Map.map growSet) r
   where growSet ys = foldl Set.union ys (map (allRelated r) $ Set.toList ys)
 
 reflexiveClosure_ :: Ord a => [a] -- ^ The set over which the relation is defined.
-		 -> Rel a -> Rel a
+                  -> Rel a -> Rel a
 reflexiveClosure_ u r = relates [(x,x) | x <- u] r
 
 -- | Uses 'domain'
@@ -104,7 +104,7 @@ reflexiveElements :: Ord a => Rel a -> Set a
 reflexiveElements r = Set.fromList [ x | (x,ys) <- Map.toList r, x `Set.member` ys ]
 
 -- | Keep the related pairs for which the predicate is true.
-filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a 
+filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a
 filterRel p = fst . purgeEmpty . Map.mapWithKey (Set.filter . p)
 
 -- | Remove keys that map to no elements.
@@ -112,16 +112,16 @@ purgeEmpty :: Ord a => Rel a -> (Rel a, Set a)
 purgeEmpty r = let (r',r'') = Map.partition (not . Set.null) r
                 in (r', Map.keysSet r'')
 
--- | Get the equivalence classes from an equivalence relation. 
+-- | Get the equivalence classes from an equivalence relation.
 equivalenceClasses :: Ord a => Rel a -> [Set a]
 equivalenceClasses r = equivalenceClasses_ (Map.keys r) r
  where equivalenceClasses_ [] _ = []
        equivalenceClasses_ (x:xs) r = ys:equivalenceClasses_ zs r
-	   where ys = allRelated r x
-                 zs = [x' | x' <- xs, not (x' `Set.member` ys)]
+          where ys = allRelated r x
+                zs = [x' | x' <- xs, not (x' `Set.member` ys)]
 
 isTransitive :: Ord a => Rel a -> Bool
-isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r, 
+isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r,
                       y <- Set.toList ys, z <- Set.toList (allRelated r y)]
 
 isReflexive :: Ord a => Rel a -> Bool
@@ -181,7 +181,7 @@ remove x r = let (mss,r') = Map.updateLookupWithKey (\_ _ -> Nothing) x r
                    Nothing      -> (r', Set.empty, Set.empty)
                    -- remove element from all incoming and outgoing sets
                    -- of other elements
-                   Just (is,os) -> 
+                   Just (is,os) ->
                        let r''  = foldr (\i -> Map.adjust (\ (is',os') -> (is', Set.delete x os')) i) r'  $ Set.toList is
                            r''' = foldr (\o -> Map.adjust (\ (is',os') -> (Set.delete x is', os')) o) r'' $ Set.toList os
                         in (r''', is, os)
@@ -190,4 +190,4 @@ incoming :: Ord a => a -> Rel' a -> Set a
 incoming x r = maybe Set.empty fst $ Map.lookup x r
 
 --outgoing :: Ord a => a -> Rel' a -> Set a
---outgoing x r = maybe Set.empty snd $ Map.lookup x r
+--outgoing x r = maybe Set.empty snd $ Map.lookup x r

src/compiler/GF/Data/Utilities.hs

@@ -4,7 +4,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/26 18:47:16 $ 
+-- > CVS $Date: 2005/10/26 18:47:16 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.6 $
 --
@@ -33,7 +33,7 @@ longerThan    n = not . notLongerThan n
 lookupList :: Eq a => a -> [(a, b)] -> [b]
 lookupList a [] = []
 lookupList a (p:ps) | a == fst p = snd p : lookupList a ps
-		    | otherwise  =         lookupList a ps
+                    | otherwise  =         lookupList a ps
 
 split :: [a] -> ([a], [a])
 split (x : y : as) = (x:xs, y:ys)
@@ -48,8 +48,8 @@ splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys)
 foldMerge :: (a -> a -> a) -> a -> [a] -> a
 foldMerge merge zero = fm
     where fm [] = zero
-	  fm [a] = a
-	  fm abs = let (as, bs) = split abs in fm as `merge` fm bs
+          fm [a] = a
+          fm abs = let (as, bs) = split abs in fm as `merge` fm bs
 
 select :: [a] -> [(a, [a])]
 select [] = []
@@ -68,7 +68,7 @@ safeInit :: [a] -> [a]
 safeInit [] = []
 safeInit xs = init xs
 
--- | Sorts and then groups elements given an ordering of the 
+-- | Sorts and then groups elements given an ordering of the
 --   elements.
 sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
 sortGroupBy f = groupBy (compareEq f) . sortBy f

src/compiler/GF/Grammar/Canonical.hs

@@ -45,12 +45,12 @@ data LincatDef = LincatDef CatId LinType  deriving Show
 data LinDef    = LinDef FunId [VarId] LinValue  deriving Show
 
 -- | Linearization type, RHS of @lincat@
-data LinType = FloatType 
-             | IntType 
+data LinType = FloatType
+             | IntType
              | ParamType ParamType
              | RecordType [RecordRowType]
-             | StrType 
-             | TableType LinType LinType 
+             | StrType
+             | TableType LinType LinType
              | TupleType [LinType]
               deriving (Eq,Ord,Show)
 
@@ -60,7 +60,7 @@ newtype ParamType = ParamTypeId ParamId deriving (Eq,Ord,Show)
 data LinValue = ConcatValue LinValue LinValue
               | LiteralValue LinLiteral
               | ErrorValue String
-              | ParamConstant ParamValue 
+              | ParamConstant ParamValue
               | PredefValue PredefId
               | RecordValue [RecordRowValue]
               | TableValue LinType [TableRowValue]
@@ -74,9 +74,9 @@ data LinValue = ConcatValue LinValue LinValue
               | CommentedValue String LinValue
               deriving (Eq,Ord,Show)
 
-data LinLiteral = FloatConstant Float 
-                | IntConstant Int 
-                | StrConstant String 
+data LinLiteral = FloatConstant Float
+                | IntConstant Int
+                | StrConstant String
                 deriving (Eq,Ord,Show)
 
 data LinPattern = ParamPattern ParamPattern
@@ -107,7 +107,7 @@ newtype PredefId = PredefId Id        deriving (Eq,Ord,Show)
 newtype LabelId  = LabelId Id         deriving (Eq,Ord,Show)
 data VarValueId  = VarValueId QualId  deriving (Eq,Ord,Show)
 
--- | Name of param type or param value 
+-- | Name of param type or param value
 newtype ParamId = ParamId QualId  deriving (Eq,Ord,Show)
 
 --------------------------------------------------------------------------------
@@ -250,7 +250,7 @@ instance PPA LinLiteral where
             FloatConstant f -> pp f
             IntConstant n -> pp n
             StrConstant s -> doubleQuotes s -- hmm
-  
+
 instance RhsSeparator LinValue where rhsSep _ = pp "="
 
 instance Pretty LinPattern where
@@ -265,7 +265,7 @@ instance PPA LinPattern where
       ParamPattern pv -> ppA pv
       RecordPattern r -> block r
       TuplePattern ps -> "<"<>punctuate "," ps<>">"
-      WildPattern     -> pp "_"                
+      WildPattern     -> pp "_"
 
 instance RhsSeparator LinPattern where rhsSep _ = pp "="
 

src/compiler/GF/Grammar/Grammar.hs

@@ -78,6 +78,7 @@ 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
 
 
@@ -125,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)

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
@@ -267,7 +274,7 @@ type AlexInput2 = (AlexInput,AlexInput)
 
 data ParseResult a
   = POk AlexInput2 a
-  | PFailed Posn	-- The position of the error
+  | PFailed Posn        -- The position of the error
             String      -- The error message
 
 newtype P a = P { unP :: AlexInput2 -> ParseResult a }
@@ -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

src/compiler/GF/Grammar/Lookup.hs

@@ -6,7 +6,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/27 13:21:53 $ 
+-- > CVS $Date: 2005/10/27 13:21:53 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.15 $
 --
@@ -20,17 +20,17 @@ module GF.Grammar.Lookup (
            lookupOrigInfo,
            allOrigInfos,
            lookupResDef, lookupResDefLoc,
-           lookupResType, 
+           lookupResType,
            lookupOverload,
            lookupOverloadTypes,
-           lookupParamValues, 
+           lookupParamValues,
            allParamValues,
-           lookupAbsDef, 
-           lookupLincat, 
+           lookupAbsDef,
+           lookupLincat,
            lookupFunType,
            lookupCatContext,
            allOpers, allOpersTo
-	      ) where
+          ) where
 
 import GF.Data.Operations
 import GF.Infra.Ident
@@ -69,7 +69,7 @@ lookupResDef gr x = fmap unLoc (lookupResDefLoc gr x)
 lookupResDefLoc gr (m,c)
   | isPredefCat c = fmap noLoc (lock c defLinType)
   | otherwise     = look m c
-  where 
+  where
     look m c = do
       info <- lookupQIdentInfo gr (m,c)
       case info of
@@ -77,7 +77,7 @@ lookupResDefLoc gr (m,c)
         ResOper _ Nothing  -> return (noLoc (Q (m,c)))
         CncCat (Just (L l ty)) _ _ _ _ -> fmap (L l) (lock c ty)
         CncCat _ _ _ _ _         -> fmap noLoc (lock c defLinType)
-      
+
         CncFun (Just (cat,_,_)) (Just (L l tr)) _ _ -> fmap (L l) (unlock cat tr)
         CncFun _                (Just ltr) _ _ -> return ltr
 
@@ -95,7 +95,7 @@ lookupResType gr (m,c) = do
     -- used in reused concrete
     CncCat _ _ _ _ _ -> return typeType
     CncFun (Just (cat,cont,val)) _ _ _ -> do
-          val' <- lock cat val 
+          val' <- lock cat val
           return $ mkProd cont val' []
     AnyInd _ n        -> lookupResType gr (n,c)
     ResParam _ _      -> return typePType
@@ -111,7 +111,7 @@ lookupOverloadTypes gr id@(m,c) = do
     -- used in reused concrete
     CncCat _ _ _ _ _ -> ret typeType
     CncFun (Just (cat,cont,val)) _ _ _ -> do
-          val' <- lock cat val 
+          val' <- lock cat val
           ret $ mkProd cont val' []
     ResParam _ _      -> ret typePType
     ResValue (L _ t)  -> ret t
@@ -130,8 +130,8 @@ lookupOverload gr (m,c) = do
     case info of
       ResOverload os tysts -> do
             tss <- mapM (\x -> lookupOverload gr (x,c)) os
-            return $ [let (args,val) = typeFormCnc ty in (map (\(b,x,t) -> t) args,(val,tr)) | 
-                      (L _ ty,L _ tr) <- tysts] ++ 
+            return $ [let (args,val) = typeFormCnc ty in (map (\(b,x,t) -> t) args,(val,tr)) |
+                      (L _ ty,L _ tr) <- tysts] ++
                      concat tss
 
       AnyInd _ n  -> lookupOverload gr (n,c)
@@ -216,7 +216,7 @@ lookupCatContext gr m c = do
 -- notice that it only gives the modules that are reachable and the opers that are included
 
 allOpers :: Grammar -> [(QIdent,Type,Location)]
-allOpers gr = 
+allOpers gr =
   [((m,op),typ,loc) |
       (m,mi)  <- maybe [] (allExtends gr) (greatestResource gr),
       (op,info)  <- Map.toList (jments mi),

src/compiler/GF/Grammar/Parser.y

@@ -37,6 +37,9 @@ import PGF(mkCId)
 %name pBNFCRules ListCFRule
 %name pEBNFRules ListEBNFRule
 
+%errorhandlertype explist
+%error { happyError }
+
 -- no lexer declaration
 %monad { P } { >>= } { return }
 %lexer { lexer } { T_EOF }
@@ -430,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 }
@@ -701,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"

src/compiler/GF/Grammar/PatternMatch.hs

@@ -5,18 +5,19 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/10/12 12:38:29 $ 
+-- > CVS $Date: 2005/10/12 12:38:29 $
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.7 $
 --
 -- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003
 -----------------------------------------------------------------------------
 
-module GF.Grammar.PatternMatch (matchPattern,
-		     testOvershadow, 
-		     findMatch,
-                     measurePatt
-		    ) where
+module GF.Grammar.PatternMatch (
+                                matchPattern,
+                                testOvershadow,
+                                findMatch,
+                                measurePatt
+                               ) where
 
 import GF.Data.Operations
 import GF.Grammar.Grammar
@@ -30,7 +31,7 @@ import GF.Text.Pretty
 --import Debug.Trace
 
 matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)
-matchPattern pts term = 
+matchPattern pts term =
   if not (isInConstantForm term)
     then raise (render ("variables occur in" <+> pp term))
   else do
@@ -61,15 +62,15 @@ testOvershadow pts vs = do
 findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)
 findMatch cases terms = case cases of
    [] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))
-   (patts,_):_ | length patts /= length terms -> 
-       raise (render ("wrong number of args for patterns :" <+> hsep patts <+> 
+   (patts,_):_ | length patts /= length terms ->
+       raise (render ("wrong number of args for patterns :" <+> hsep patts <+>
                     "cannot take" <+> hsep terms))
    (patts,val):cc -> case mapM tryMatch (zip patts terms) of
        Ok substs -> return (val, concat substs)
        _         -> findMatch cc terms
 
 tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
-tryMatch (p,t) = do 
+tryMatch (p,t) = do
   t' <- termForm t
   trym p t'
  where
@@ -83,26 +84,26 @@ tryMatch (p,t) = do
       (PString s, ([],K i,[])) | s==i -> return []
       (PInt s, ([],EInt i,[])) | s==i -> return []
       (PFloat s,([],EFloat i,[])) | s==i -> return [] --- rounding?
-      (PC p pp, ([], Con f, tt)) | 
+      (PC p pp, ([], Con f, tt)) |
             p `eqStrIdent` f && length pp == length tt ->
          do matches <- mapM tryMatch (zip pp tt)
             return (concat matches)
 
-      (PP (q,p) pp, ([], QC (r,f), tt)) | 
+      (PP (q,p) pp, ([], QC (r,f), tt)) |
             -- q `eqStrIdent` r &&  --- not for inherited AR 10/10/2005
             p `eqStrIdent` f && length pp == length tt ->
          do matches <- mapM tryMatch (zip pp tt)
             return (concat matches)
       ---- hack for AppPredef bug
-      (PP (q,p) pp, ([], Q (r,f), tt)) | 
-            -- q `eqStrIdent` r && --- 
+      (PP (q,p) pp, ([], Q (r,f), tt)) |
+            -- q `eqStrIdent` r && ---
             p `eqStrIdent` f && length pp == length tt ->
          do matches <- mapM tryMatch (zip pp tt)
             return (concat matches)
 
       (PR r, ([],R r',[])) |
             all (`elem` map fst r') (map fst r) ->
-         do matches <- mapM tryMatch 
+         do matches <- mapM tryMatch
                             [(p,snd a) | (l,p) <- r, let Just a = lookup l r']
             return (concat matches)
       (PT _ p',_) -> trym p' t'
@@ -125,7 +126,7 @@ tryMatch (p,t) = do
       (PMSeq mp1 mp2, ([],K s, [])) -> matchPMSeq mp1 mp2 s
 
       (PRep p1, ([],K s, [])) -> checks [
-         trym (foldr (const (PSeq p1)) (PString "") 
+         trym (foldr (const (PSeq p1)) (PString "")
            [1..n]) t' | n <- [0 .. length s]
         ] >>
         return []

src/compiler/GF/Grammar/Printer.hs

@@ -1,365 +1,364 @@
-----------------------------------------------------------------------
--- |
--- Module      : GF.Grammar.Printer
--- Maintainer  : Krasimir Angelov
--- Stability   : (stable)
--- Portability : (portable)
---
------------------------------------------------------------------------------
-
-{-# LANGUAGE FlexibleContexts #-}
-module GF.Grammar.Printer
-           ( -- ** Pretty printing
-             TermPrintQual(..)
-           , ppModule
-           , ppJudgement
-           , ppParams
-           , ppTerm
-           , ppPatt
-           , ppValue
-           , ppConstrs
-           , ppQIdent
-           , ppMeta
-           , getAbs
-           ) where
-import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
-
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Grammar.Values
-import GF.Grammar.Grammar
-
-import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)
-
-import GF.Text.Pretty
-import Data.Maybe (isNothing)
-import Data.List  (intersperse)
-import qualified Data.Map as Map
---import qualified Data.IntMap as IntMap
---import qualified Data.Set as Set
-import qualified Data.Array.IArray as Array
-
-data TermPrintQual 
-  = Terse | Unqualified | Qualified | Internal
-  deriving Eq                 
-
-instance Pretty Grammar where
-  pp = vcat . map (ppModule Qualified) . modules
-
-ppModule :: TermPrintQual -> SourceModule -> Doc
-ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) =
-    hdr $$ 
-    nest 2 (ppOptions opts $$ 
-            vcat (map (ppJudgement q) (Map.toList jments)) $$
-            maybe empty (ppSequences q) mseqs) $$
-    ftr
-    where
-      hdr = complModDoc <+> modTypeDoc <+> '=' <+> 
-            hsep (intersperse (pp "**") $
-                  filter (not . isEmpty)  $ [ commaPunct ppExtends exts
-                                            , maybe empty ppWith with
-                                            , if null opens
-                                                then pp '{'
-                                                else "open" <+> commaPunct ppOpenSpec opens <+> "in" <+> '{'
-                                            ])
-
-      ftr = '}'
-
-      complModDoc =
-        case mstat of
-          MSComplete   -> empty
-          MSIncomplete -> pp "incomplete"
-
-      modTypeDoc =
-        case mtype of
-          MTAbstract         -> "abstract"  <+> mn
-          MTResource         -> "resource"  <+> mn
-          MTConcrete abs     -> "concrete"  <+> mn <+> "of" <+> abs
-          MTInterface        -> "interface" <+> mn
-          MTInstance ie      -> "instance"  <+> mn <+> "of" <+> ppExtends ie
-
-      ppExtends (id,MIAll        ) = pp id
-      ppExtends (id,MIOnly   incs) = id         <+> brackets (commaPunct pp incs)
-      ppExtends (id,MIExcept incs) = id <+> '-' <+> brackets (commaPunct pp incs)
-      
-      ppWith (id,ext,opens) = ppExtends (id,ext) <+> "with" <+> commaPunct ppInstSpec opens
-
-ppOptions opts = 
-  "flags" $$
-  nest 2 (vcat [option <+> '=' <+> ppLit value <+> ';' | (option,value) <- optionsGFO opts])
-
-ppJudgement q (id, AbsCat pcont ) =
-  "cat" <+> id <+>
-  (case pcont of
-     Just (L _ cont) -> hsep (map (ppDecl q) cont)
-     Nothing         -> empty) <+> ';'
-ppJudgement q (id, AbsFun ptype _ pexp poper) =
-  let kind | isNothing pexp      = "data"
-           | poper == Just False = "oper"
-           | otherwise           = "fun"
-  in
-  (case ptype of
-     Just (L _ typ) -> kind <+> id <+> ':' <+> ppTerm q 0 typ <+> ';'
-     Nothing        -> empty) $$
-  (case pexp of
-     Just []  -> empty
-     Just eqs -> "def" <+> vcat [id <+> hsep (map (ppPatt q 2) ps) <+> '=' <+> ppTerm q 0 e <+> ';' | L _ (ps,e) <- eqs]
-     Nothing  -> empty)
-ppJudgement q (id, ResParam pparams _) = 
-  "param" <+> id <+>
-  (case pparams of
-     Just (L _ ps) -> '=' <+> ppParams q ps
-     _             -> empty) <+> ';'
-ppJudgement q (id, ResValue pvalue) = 
-  "-- param constructor" <+> id <+> ':' <+> 
-  (case pvalue of
-     (L _ ty) -> ppTerm q 0 ty) <+> ';'
-ppJudgement q (id, ResOper  ptype pexp) =
-  "oper" <+> id <+>
-  (case ptype of {Just (L _ t) -> ':'  <+> ppTerm q 0 t; Nothing -> empty} $$
-   case pexp  of {Just (L _ e) -> '=' <+> ppTerm q 0 e; Nothing -> empty}) <+> ';'
-ppJudgement q (id, ResOverload ids defs) =
-  "oper" <+> id <+> '=' <+> 
-  ("overload" <+> '{' $$
-   nest 2 (vcat [id <+> (':' <+> ppTerm q 0 ty $$ '=' <+> ppTerm q 0 e <+> ';') | (L _ ty,L _ e) <- defs]) $$
-   '}') <+> ';'
-ppJudgement q (id, CncCat pcat pdef pref pprn mpmcfg) =
-  (case pcat of
-     Just (L _ typ) -> "lincat" <+> id <+> '=' <+> ppTerm q 0 typ <+> ';'
-     Nothing        -> empty) $$
-  (case pdef of
-     Just (L _ exp) -> "lindef" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
-     Nothing        -> empty) $$
-  (case pref of
-     Just (L _ exp) -> "linref" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
-     Nothing        -> empty) $$
-  (case pprn of
-     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
-     Nothing        -> empty) $$
-  (case (mpmcfg,q) of
-     (Just (PMCFG prods funs),Internal)
-                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
-                       nest 2 (vcat (map ppProduction prods) $$
-                               ' ' $$
-                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> 
-                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
-                                         (Array.assocs funs))) $$
-                       '}'
-     _              -> empty)
-ppJudgement q (id, CncFun  ptype pdef pprn mpmcfg) =
-  (case pdef of
-     Just (L _ e) -> let (xs,e') = getAbs e
-                     in "lin" <+> id <+> hsep (map ppBind xs) <+> '=' <+> ppTerm q 0 e' <+> ';'
-     Nothing      -> empty) $$
-  (case pprn of
-     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
-     Nothing        -> empty) $$
-  (case (mpmcfg,q) of
-     (Just (PMCFG prods funs),Internal)
-                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
-                       nest 2 (vcat (map ppProduction prods) $$
-                               ' ' $$
-                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+> 
-                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
-                                         (Array.assocs funs))) $$
-                       '}'
-     _              -> empty)
-ppJudgement q (id, AnyInd cann mid) =
-  case q of
-    Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';'
-    _        -> empty
-
-instance Pretty Term where pp = ppTerm Unqualified 0
-
-ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)
-                           in prec d 0 ('\\' <> commaPunct ppBind xs <+> "->" <+> ppTerm q 0 e')
-ppTerm q d (T TRaw xs) = case getCTable (T TRaw xs) of
-                           ([],_) -> "table" <+> '{' $$
-	  		             nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-			             '}'
-                           (vs,e) -> prec d 0 ("\\\\" <> commaPunct pp vs <+> "=>" <+> ppTerm q 0 e)
-ppTerm q d (T (TTyped t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-			       '}'
-ppTerm q d (T (TComp  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-		 	       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-			       '}'
-ppTerm q d (T (TWild  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
-			       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-			       '}'
-ppTerm q d (Prod bt x a b)= if x == identW && bt == Explicit
-                              then prec d 0 (ppTerm q 4 a <+> "->" <+> ppTerm q 0 b)
-                              else prec d 0 (parens (ppBind (bt,x) <+> ':' <+> ppTerm q 0 a) <+> "->" <+> ppTerm q 0 b)
-ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> "=>" <+> ppTerm q 0 vt)
-ppTerm q d (Let l e)    = let (ls,e') = getLet e
-                          in prec d 0 ("let" <+> vcat (map (ppLocDef q) (l:ls)) $$ "in" <+> ppTerm q 0 e')
-ppTerm q d (Example e s)=prec d 0 ("in" <+> ppTerm q 5 e <+> str s)
-ppTerm q d (C e1 e2)    =prec d 1 (hang (ppTerm q 2 e1) 2 ("++" <+> ppTerm q 1 e2))
-ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> '+'  <+> ppTerm q 2 e2)
-ppTerm q d (S x y)     = case x of
-                           T annot xs -> let e = case annot of
-			                           TRaw     -> y
-			                           TTyped t -> Typed y t
-			                           TComp  t -> Typed y t
-			                           TWild  t -> Typed y t
-			                 in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$
-			                    nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
-			                   '}'
-			   _          -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y))
-ppTerm q d (ExtR x y)  = prec d 3 (ppTerm q 3 x <+> "**" <+> ppTerm q 4 y)
-ppTerm q d (App x y)   = prec d 4 (ppTerm q 4 x <+> ppTerm q 5 y)
-ppTerm q d (V e es)    = hang "table" 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate ';' (map (ppTerm q 0) es)))])
-ppTerm q d (FV es)     = prec d 4 ("variants" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es))))
-ppTerm q d (AdHocOverload es)     = "overload" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
-ppTerm q d (Alts e xs) = prec d 4 ("pre" <+> braces (ppTerm q 0 e <> ';' <+> fsep (punctuate ';' (map (ppAltern q) xs))))
-ppTerm q d (Strs es)   = "strs" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
-ppTerm q d (EPatt p)   = prec d 4 ('#' <+> ppPatt q 2 p)
-ppTerm q d (EPattType t)=prec d 4 ("pattern" <+> ppTerm q 0 t)
-ppTerm q d (P t l)     = prec d 5 (ppTerm q 5 t <> '.' <> l)
-ppTerm q d (Cn id)     = pp id
-ppTerm q d (Vr id)     = pp id
-ppTerm q d (Q  id)     = ppQIdent q id
-ppTerm q d (QC id)     = ppQIdent q id
-ppTerm q d (Sort id)   = pp id
-ppTerm q d (K s)       = str s
-ppTerm q d (EInt n)    = pp n
-ppTerm q d (EFloat f)  = pp f
-ppTerm q d (Meta i)    = ppMeta i
-ppTerm q d (Empty)     = pp "[]"
-ppTerm q d (R [])      = pp "<>" -- to distinguish from {} empty RecType
-ppTerm q d (R xs)      = braces (fsep (punctuate ';' [l <+> 
-                                                       fsep [case mb_t of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty},
-                                                             '=' <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))
-ppTerm q d (RecType xs)
-  | q == Terse         = case [cat | (l,_) <- xs, let (p,cat) = splitAt 5 (showIdent (label2ident l)), p == "lock_"] of
-                           [cat] -> pp cat
-                           _     -> doc
-  | otherwise          = doc
-  where
-    doc = braces (fsep (punctuate ';' [l <+> ':' <+> ppTerm q 0 t | (l,t) <- xs]))
-ppTerm q d (Typed e t) = '<' <> ppTerm q 0 e <+> ':' <+> ppTerm q 0 t <> '>'
-ppTerm q d (ImplArg e) = braces (ppTerm q 0 e)
-ppTerm q d (ELincat cat t) = prec d 4 ("lincat" <+> cat <+> ppTerm q 5 t)
-ppTerm q d (ELin cat t) = prec d 4 ("lin" <+> cat <+> ppTerm q 5 t)
-ppTerm q d (Error s)   = prec d 4 ("Predef.error" <+> str s)
-
-ppEquation q (ps,e) = hcat (map (ppPatt q 2) ps) <+> "->" <+> ppTerm q 0 e
-
-ppCase q (p,e) = ppPatt q 0 p <+> "=>" <+> ppTerm q 0 e
-
-instance Pretty Patt where pp = ppPatt Unqualified 0
-
-ppPatt q d (PAlt p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '|' <+> ppPatt q 1 p2)
-ppPatt q d (PSeq p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
-ppPatt q d (PMSeq (_,p1) (_,p2)) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
-ppPatt q d (PC f ps)    = if null ps
-                            then pp f
-                            else prec d 1 (f <+> hsep (map (ppPatt q 3) ps))
-ppPatt q d (PP f ps)    = if null ps
-                            then ppQIdent q f
-                            else prec d 1 (ppQIdent q f <+> hsep (map (ppPatt q 3) ps))
-ppPatt q d (PRep p)     = prec d 1 (ppPatt q 3 p <> '*')
-ppPatt q d (PAs f p)    = prec d 2 (f <> '@' <> ppPatt q 3 p)
-ppPatt q d (PNeg p)     = prec d 2 ('-' <> ppPatt q 3 p)
-ppPatt q d (PChar)      = pp '?'
-ppPatt q d (PChars s)   = brackets (str s)
-ppPatt q d (PMacro id)  = '#' <> id
-ppPatt q d (PM id)      = '#' <> ppQIdent q id
-ppPatt q d PW           = pp '_'
-ppPatt q d (PV id)      = pp id
-ppPatt q d (PInt n)     = pp n
-ppPatt q d (PFloat f)   = pp f
-ppPatt q d (PString s)  = str s
-ppPatt q d (PR xs)      = braces (hsep (punctuate ';' [l <+> '=' <+> ppPatt q 0 e | (l,e) <- xs]))
-ppPatt q d (PImplArg p) = braces (ppPatt q 0 p)
-ppPatt q d (PTilde t)   = prec d 2 ('~' <> ppTerm q 6 t)
-
-ppValue :: TermPrintQual -> Int -> Val -> Doc
-ppValue q d (VGen i x)    = x <> "{-" <> i <> "-}" ---- latter part for debugging
-ppValue q d (VApp u v)    = prec d 4 (ppValue q 4 u <+> ppValue q 5 v)
-ppValue q d (VCn (_,c))   = pp c
-ppValue q d (VClos env e) = case e of
-                              Meta _ -> ppTerm q d e <> ppEnv env
-                              _      -> ppTerm q d e ---- ++ prEnv env ---- for debugging
-ppValue q d (VRecType xs) = braces (hsep (punctuate ',' [l <> '=' <> ppValue q 0 v | (l,v) <- xs]))
-ppValue q d VType         = pp "Type"
-
-ppConstrs :: Constraints -> [Doc]
-ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> "<>" <+> ppValue Unqualified 0 w))
-
-ppEnv :: Env -> Doc
-ppEnv e = hcat (map (\(x,t) -> braces (x <> ":=" <> ppValue Unqualified 0 t)) e)
-
-str s = doubleQuotes s
-
-ppDecl q (_,id,typ)
-  | id == identW = ppTerm q 3 typ
-  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
-
-ppDDecl q (_,id,typ)
-  | id == identW = ppTerm q 6 typ
-  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
-
-ppQIdent :: TermPrintQual -> QIdent -> Doc
-ppQIdent q (m,id) =
-  case q of
-    Terse       ->          pp id
-    Unqualified ->          pp id
-    Qualified   -> m <> '.' <> id
-    Internal    -> m <> '.' <> id
-    
-
-instance Pretty Label where pp = pp . label2ident
-
-ppOpenSpec (OSimple id)   = pp id
-ppOpenSpec (OQualif id n) = parens (id <+> '=' <+> n)
-
-ppInstSpec (id,n) = parens (id <+> '=' <+> n)
-
-ppLocDef q (id, (mbt, e)) =
-  id <+>
-  (case mbt of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty} <+> '=' <+> ppTerm q 0 e) <+> ';'
-
-ppBind (Explicit,v) = pp v
-ppBind (Implicit,v) = braces v
-
-ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y
-
-ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps))
-ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt)
-
-ppProduction (Production fid funid args) =
-  ppFId fid <+> "->" <+> ppFunId funid <> 
-  brackets (hcat (punctuate "," (map (hsep . intersperse (pp '|') . map ppFId) args)))
-
-ppSequences q seqsArr
-  | null seqs || q /= Internal = empty
-  | otherwise                  = "sequences" <+> '{' $$
-                                 nest 2 (vcat (map ppSeq seqs)) $$
-                                 '}'
-  where
-    seqs = Array.assocs seqsArr
-
-commaPunct f ds = (hcat (punctuate "," (map f ds)))
-
-prec d1 d2 doc
-  | d1 > d2   = parens doc
-  | otherwise = doc
-
-getAbs :: Term -> ([(BindType,Ident)], Term)
-getAbs (Abs bt v e) = let (xs,e') = getAbs e
-                      in ((bt,v):xs,e')
-getAbs e            = ([],e)
-
-getCTable :: Term -> ([Ident], Term)
-getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
-                                in (v:vs,e')
-getCTable (T TRaw [(PW,  e)]) = let (vs,e') = getCTable e
-                                in (identW:vs,e')
-getCTable e                   = ([],e)
-
-getLet :: Term -> ([LocalDef], Term)
-getLet (Let l e) = let (ls,e') = getLet e
-                   in (l:ls,e')
-getLet e         = ([],e)
-
+----------------------------------------------------------------------
+-- |
+-- Module      : GF.Grammar.Printer
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE FlexibleContexts #-}
+module GF.Grammar.Printer
+           ( -- ** Pretty printing
+             TermPrintQual(..)
+           , ppModule
+           , ppJudgement
+           , ppParams
+           , ppTerm
+           , ppPatt
+           , ppValue
+           , ppConstrs
+           , ppQIdent
+           , ppMeta
+           , getAbs
+           ) where
+import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
+
+import GF.Infra.Ident
+import GF.Infra.Option
+import GF.Grammar.Values
+import GF.Grammar.Grammar
+
+import PGF.Internal (ppMeta, ppLit, ppFId, ppFunId, ppSeqId, ppSeq)
+
+import GF.Text.Pretty
+import Data.Maybe (isNothing)
+import Data.List  (intersperse)
+import qualified Data.Map as Map
+--import qualified Data.IntMap as IntMap
+--import qualified Data.Set as Set
+import qualified Data.Array.IArray as Array
+
+data TermPrintQual
+  = Terse | Unqualified | Qualified | Internal
+  deriving Eq
+
+instance Pretty Grammar where
+  pp = vcat . map (ppModule Qualified) . modules
+
+ppModule :: TermPrintQual -> SourceModule -> Doc
+ppModule q (mn, ModInfo mtype mstat opts exts with opens _ _ mseqs jments) =
+    hdr $$
+    nest 2 (ppOptions opts $$
+            vcat (map (ppJudgement q) (Map.toList jments)) $$
+            maybe empty (ppSequences q) mseqs) $$
+    ftr
+    where
+      hdr = complModDoc <+> modTypeDoc <+> '=' <+>
+            hsep (intersperse (pp "**") $
+                  filter (not . isEmpty)  $ [ commaPunct ppExtends exts
+                                            , maybe empty ppWith with
+                                            , if null opens
+                                                then pp '{'
+                                                else "open" <+> commaPunct ppOpenSpec opens <+> "in" <+> '{'
+                                            ])
+
+      ftr = '}'
+
+      complModDoc =
+        case mstat of
+          MSComplete   -> empty
+          MSIncomplete -> pp "incomplete"
+
+      modTypeDoc =
+        case mtype of
+          MTAbstract         -> "abstract"  <+> mn
+          MTResource         -> "resource"  <+> mn
+          MTConcrete abs     -> "concrete"  <+> mn <+> "of" <+> abs
+          MTInterface        -> "interface" <+> mn
+          MTInstance ie      -> "instance"  <+> mn <+> "of" <+> ppExtends ie
+
+      ppExtends (id,MIAll        ) = pp id
+      ppExtends (id,MIOnly   incs) = id         <+> brackets (commaPunct pp incs)
+      ppExtends (id,MIExcept incs) = id <+> '-' <+> brackets (commaPunct pp incs)
+
+      ppWith (id,ext,opens) = ppExtends (id,ext) <+> "with" <+> commaPunct ppInstSpec opens
+
+ppOptions opts =
+  "flags" $$
+  nest 2 (vcat [option <+> '=' <+> ppLit value <+> ';' | (option,value) <- optionsGFO opts])
+
+ppJudgement q (id, AbsCat pcont ) =
+  "cat" <+> id <+>
+  (case pcont of
+     Just (L _ cont) -> hsep (map (ppDecl q) cont)
+     Nothing         -> empty) <+> ';'
+ppJudgement q (id, AbsFun ptype _ pexp poper) =
+  let kind | isNothing pexp      = "data"
+           | poper == Just False = "oper"
+           | otherwise           = "fun"
+  in
+  (case ptype of
+     Just (L _ typ) -> kind <+> id <+> ':' <+> ppTerm q 0 typ <+> ';'
+     Nothing        -> empty) $$
+  (case pexp of
+     Just []  -> empty
+     Just eqs -> "def" <+> vcat [id <+> hsep (map (ppPatt q 2) ps) <+> '=' <+> ppTerm q 0 e <+> ';' | L _ (ps,e) <- eqs]
+     Nothing  -> empty)
+ppJudgement q (id, ResParam pparams _) =
+  "param" <+> id <+>
+  (case pparams of
+     Just (L _ ps) -> '=' <+> ppParams q ps
+     _             -> empty) <+> ';'
+ppJudgement q (id, ResValue pvalue) =
+  "-- param constructor" <+> id <+> ':' <+>
+  (case pvalue of
+     (L _ ty) -> ppTerm q 0 ty) <+> ';'
+ppJudgement q (id, ResOper  ptype pexp) =
+  "oper" <+> id <+>
+  (case ptype of {Just (L _ t) -> ':'  <+> ppTerm q 0 t; Nothing -> empty} $$
+   case pexp  of {Just (L _ e) -> '=' <+> ppTerm q 0 e; Nothing -> empty}) <+> ';'
+ppJudgement q (id, ResOverload ids defs) =
+  "oper" <+> id <+> '=' <+>
+  ("overload" <+> '{' $$
+   nest 2 (vcat [id <+> (':' <+> ppTerm q 0 ty $$ '=' <+> ppTerm q 0 e <+> ';') | (L _ ty,L _ e) <- defs]) $$
+   '}') <+> ';'
+ppJudgement q (id, CncCat pcat pdef pref pprn mpmcfg) =
+  (case pcat of
+     Just (L _ typ) -> "lincat" <+> id <+> '=' <+> ppTerm q 0 typ <+> ';'
+     Nothing        -> empty) $$
+  (case pdef of
+     Just (L _ exp) -> "lindef" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
+     Nothing        -> empty) $$
+  (case pref of
+     Just (L _ exp) -> "linref" <+> id <+> '=' <+> ppTerm q 0 exp <+> ';'
+     Nothing        -> empty) $$
+  (case pprn of
+     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
+     Nothing        -> empty) $$
+  (case (mpmcfg,q) of
+     (Just (PMCFG prods funs),Internal)
+                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
+                       nest 2 (vcat (map ppProduction prods) $$
+                               ' ' $$
+                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+>
+                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
+                                         (Array.assocs funs))) $$
+                       '}'
+     _              -> empty)
+ppJudgement q (id, CncFun  ptype pdef pprn mpmcfg) =
+  (case pdef of
+     Just (L _ e) -> let (xs,e') = getAbs e
+                     in "lin" <+> id <+> hsep (map ppBind xs) <+> '=' <+> ppTerm q 0 e' <+> ';'
+     Nothing      -> empty) $$
+  (case pprn of
+     Just (L _ prn) -> "printname" <+> id <+> '=' <+> ppTerm q 0 prn <+> ';'
+     Nothing        -> empty) $$
+  (case (mpmcfg,q) of
+     (Just (PMCFG prods funs),Internal)
+                    -> "pmcfg" <+> id <+> '=' <+> '{' $$
+                       nest 2 (vcat (map ppProduction prods) $$
+                               ' ' $$
+                               vcat (map (\(funid,arr) -> ppFunId funid <+> ":=" <+>
+                                                          parens (hcat (punctuate ',' (map ppSeqId (Array.elems arr)))))
+                                         (Array.assocs funs))) $$
+                       '}'
+     _              -> empty)
+ppJudgement q (id, AnyInd cann mid) =
+  case q of
+    Internal -> "ind" <+> id <+> '=' <+> (if cann then pp "canonical" else empty) <+> mid <+> ';'
+    _        -> empty
+
+instance Pretty Term where pp = ppTerm Unqualified 0
+
+ppTerm q d (Abs b v e)   = let (xs,e') = getAbs (Abs b v e)
+                           in prec d 0 ('\\' <> commaPunct ppBind xs <+> "->" <+> ppTerm q 0 e')
+ppTerm q d (T TRaw xs) = case getCTable (T TRaw xs) of
+                           ([],_) -> "table" <+> '{' $$
+                                       nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+                                     '}'
+                           (vs,e) -> prec d 0 ("\\\\" <> commaPunct pp vs <+> "=>" <+> ppTerm q 0 e)
+ppTerm q d (T (TTyped t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+                                '}'
+ppTerm q d (T (TComp  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+                               '}'
+ppTerm q d (T (TWild  t) xs) = "table" <+> ppTerm q 0 t <+> '{' $$
+                                 nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+                                '}'
+ppTerm q d (Prod bt x a b)= if x == identW && bt == Explicit
+                              then prec d 0 (ppTerm q 4 a <+> "->" <+> ppTerm q 0 b)
+                              else prec d 0 (parens (ppBind (bt,x) <+> ':' <+> ppTerm q 0 a) <+> "->" <+> ppTerm q 0 b)
+ppTerm q d (Table kt vt)=prec d 0 (ppTerm q 3 kt <+> "=>" <+> ppTerm q 0 vt)
+ppTerm q d (Let l e)    = let (ls,e') = getLet e
+                          in prec d 0 ("let" <+> vcat (map (ppLocDef q) (l:ls)) $$ "in" <+> ppTerm q 0 e')
+ppTerm q d (Example e s)=prec d 0 ("in" <+> ppTerm q 5 e <+> str s)
+ppTerm q d (C e1 e2)    =prec d 1 (hang (ppTerm q 2 e1) 2 ("++" <+> ppTerm q 1 e2))
+ppTerm q d (Glue e1 e2) =prec d 2 (ppTerm q 3 e1 <+> '+'  <+> ppTerm q 2 e2)
+ppTerm q d (S x y)     = case x of
+                           T annot xs -> let e = case annot of
+                                                   TRaw     -> y
+                                                   TTyped t -> Typed y t
+                                                   TComp  t -> Typed y t
+                                                   TWild  t -> Typed y t
+                                         in "case" <+> ppTerm q 0 e <+>"of" <+> '{' $$
+                                            nest 2 (vcat (punctuate ';' (map (ppCase q) xs))) $$
+                                           '}'
+                           _          -> prec d 3 (hang (ppTerm q 3 x) 2 ("!" <+> ppTerm q 4 y))
+ppTerm q d (ExtR x y)  = prec d 3 (ppTerm q 3 x <+> "**" <+> ppTerm q 4 y)
+ppTerm q d (App x y)   = prec d 4 (ppTerm q 4 x <+> ppTerm q 5 y)
+ppTerm q d (V e es)    = hang "table" 2 (sep [ppTerm q 6 e,brackets (fsep (punctuate ';' (map (ppTerm q 0) es)))])
+ppTerm q d (FV es)     = prec d 4 ("variants" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es))))
+ppTerm q d (AdHocOverload es)     = "overload" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
+ppTerm q d (Alts e xs) = prec d 4 ("pre" <+> braces (ppTerm q 0 e <> ';' <+> fsep (punctuate ';' (map (ppAltern q) xs))))
+ppTerm q d (Strs es)   = "strs" <+> braces (fsep (punctuate ';' (map (ppTerm q 0) es)))
+ppTerm q d (EPatt p)   = prec d 4 ('#' <+> ppPatt q 2 p)
+ppTerm q d (EPattType t)=prec d 4 ("pattern" <+> ppTerm q 0 t)
+ppTerm q d (P t l)     = prec d 5 (ppTerm q 5 t <> '.' <> l)
+ppTerm q d (Cn id)     = pp id
+ppTerm q d (Vr id)     = pp id
+ppTerm q d (Q  id)     = ppQIdent q id
+ppTerm q d (QC id)     = ppQIdent q id
+ppTerm q d (Sort id)   = pp id
+ppTerm q d (K s)       = str s
+ppTerm q d (EInt n)    = pp n
+ppTerm q d (EFloat f)  = pp f
+ppTerm q d (Meta i)    = ppMeta i
+ppTerm q d (Empty)     = pp "[]"
+ppTerm q d (R [])      = pp "<>" -- to distinguish from {} empty RecType
+ppTerm q d (R xs)      = braces (fsep (punctuate ';' [l <+>
+                                                       fsep [case mb_t of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty},
+                                                             '=' <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))
+ppTerm q d (RecType xs)
+  | q == Terse         = case [cat | (l,_) <- xs, let (p,cat) = splitAt 5 (showIdent (label2ident l)), p == "lock_"] of
+                           [cat] -> pp cat
+                           _     -> doc
+  | otherwise          = doc
+  where
+    doc = braces (fsep (punctuate ';' [l <+> ':' <+> ppTerm q 0 t | (l,t) <- xs]))
+ppTerm q d (Typed e t) = '<' <> ppTerm q 0 e <+> ':' <+> ppTerm q 0 t <> '>'
+ppTerm q d (ImplArg e) = braces (ppTerm q 0 e)
+ppTerm q d (ELincat cat t) = prec d 4 ("lincat" <+> cat <+> ppTerm q 5 t)
+ppTerm q d (ELin cat t) = prec d 4 ("lin" <+> cat <+> ppTerm q 5 t)
+ppTerm q d (Error s)   = prec d 4 ("Predef.error" <+> str s)
+
+ppEquation q (ps,e) = hcat (map (ppPatt q 2) ps) <+> "->" <+> ppTerm q 0 e
+
+ppCase q (p,e) = ppPatt q 0 p <+> "=>" <+> ppTerm q 0 e
+
+instance Pretty Patt where pp = ppPatt Unqualified 0
+
+ppPatt q d (PAlt p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '|' <+> ppPatt q 1 p2)
+ppPatt q d (PSeq p1 p2) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
+ppPatt q d (PMSeq (_,p1) (_,p2)) = prec d 0 (ppPatt q 0 p1 <+> '+' <+> ppPatt q 1 p2)
+ppPatt q d (PC f ps)    = if null ps
+                            then pp f
+                            else prec d 1 (f <+> hsep (map (ppPatt q 3) ps))
+ppPatt q d (PP f ps)    = if null ps
+                            then ppQIdent q f
+                            else prec d 1 (ppQIdent q f <+> hsep (map (ppPatt q 3) ps))
+ppPatt q d (PRep p)     = prec d 1 (ppPatt q 3 p <> '*')
+ppPatt q d (PAs f p)    = prec d 2 (f <> '@' <> ppPatt q 3 p)
+ppPatt q d (PNeg p)     = prec d 2 ('-' <> ppPatt q 3 p)
+ppPatt q d (PChar)      = pp '?'
+ppPatt q d (PChars s)   = brackets (str s)
+ppPatt q d (PMacro id)  = '#' <> id
+ppPatt q d (PM id)      = '#' <> ppQIdent q id
+ppPatt q d PW           = pp '_'
+ppPatt q d (PV id)      = pp id
+ppPatt q d (PInt n)     = pp n
+ppPatt q d (PFloat f)   = pp f
+ppPatt q d (PString s)  = str s
+ppPatt q d (PR xs)      = braces (hsep (punctuate ';' [l <+> '=' <+> ppPatt q 0 e | (l,e) <- xs]))
+ppPatt q d (PImplArg p) = braces (ppPatt q 0 p)
+ppPatt q d (PTilde t)   = prec d 2 ('~' <> ppTerm q 6 t)
+
+ppValue :: TermPrintQual -> Int -> Val -> Doc
+ppValue q d (VGen i x)    = x <> "{-" <> i <> "-}" ---- latter part for debugging
+ppValue q d (VApp u v)    = prec d 4 (ppValue q 4 u <+> ppValue q 5 v)
+ppValue q d (VCn (_,c))   = pp c
+ppValue q d (VClos env e) = case e of
+                              Meta _ -> ppTerm q d e <> ppEnv env
+                              _      -> ppTerm q d e ---- ++ prEnv env ---- for debugging
+ppValue q d (VRecType xs) = braces (hsep (punctuate ',' [l <> '=' <> ppValue q 0 v | (l,v) <- xs]))
+ppValue q d VType         = pp "Type"
+
+ppConstrs :: Constraints -> [Doc]
+ppConstrs = map (\(v,w) -> braces (ppValue Unqualified 0 v <+> "<>" <+> ppValue Unqualified 0 w))
+
+ppEnv :: Env -> Doc
+ppEnv e = hcat (map (\(x,t) -> braces (x <> ":=" <> ppValue Unqualified 0 t)) e)
+
+str s = doubleQuotes s
+
+ppDecl q (_,id,typ)
+  | id == identW = ppTerm q 3 typ
+  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
+
+ppDDecl q (_,id,typ)
+  | id == identW = ppTerm q 6 typ
+  | otherwise    = parens (id <+> ':' <+> ppTerm q 0 typ)
+
+ppQIdent :: TermPrintQual -> QIdent -> Doc
+ppQIdent q (m,id) =
+  case q of
+    Terse       ->          pp id
+    Unqualified ->          pp id
+    Qualified   -> m <> '.' <> id
+    Internal    -> m <> '.' <> id
+
+
+instance Pretty Label where pp = pp . label2ident
+
+ppOpenSpec (OSimple id)   = pp id
+ppOpenSpec (OQualif id n) = parens (id <+> '=' <+> n)
+
+ppInstSpec (id,n) = parens (id <+> '=' <+> n)
+
+ppLocDef q (id, (mbt, e)) =
+  id <+>
+  (case mbt of {Just t -> ':' <+> ppTerm q 0 t; Nothing -> empty} <+> '=' <+> ppTerm q 0 e) <+> ';'
+
+ppBind (Explicit,v) = pp v
+ppBind (Implicit,v) = braces v
+
+ppAltern q (x,y) = ppTerm q 0 x <+> '/' <+> ppTerm q 0 y
+
+ppParams q ps = fsep (intersperse (pp '|') (map (ppParam q) ps))
+ppParam q (id,cxt) = id <+> hsep (map (ppDDecl q) cxt)
+
+ppProduction (Production fid funid args) =
+  ppFId fid <+> "->" <+> ppFunId funid <>
+  brackets (hcat (punctuate "," (map (hsep . intersperse (pp '|') . map ppFId) args)))
+
+ppSequences q seqsArr
+  | null seqs || q /= Internal = empty
+  | otherwise                  = "sequences" <+> '{' $$
+                                 nest 2 (vcat (map ppSeq seqs)) $$
+                                 '}'
+  where
+    seqs = Array.assocs seqsArr
+
+commaPunct f ds = (hcat (punctuate "," (map f ds)))
+
+prec d1 d2 doc
+  | d1 > d2   = parens doc
+  | otherwise = doc
+
+getAbs :: Term -> ([(BindType,Ident)], Term)
+getAbs (Abs bt v e) = let (xs,e') = getAbs e
+                      in ((bt,v):xs,e')
+getAbs e            = ([],e)
+
+getCTable :: Term -> ([Ident], Term)
+getCTable (T TRaw [(PV v,e)]) = let (vs,e') = getCTable e
+                                in (v:vs,e')
+getCTable (T TRaw [(PW,  e)]) = let (vs,e') = getCTable e
+                                in (identW:vs,e')
+getCTable e                   = ([],e)
+
+getLet :: Term -> ([LocalDef], Term)
+getLet (Let l e) = let (ls,e') = getLet e
+                   in (l:ls,e')
+getLet e         = ([],e)

src/compiler/GF/Grammar/Values.hs

@@ -5,22 +5,23 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:22:32 $ 
+-- > CVS $Date: 2005/04/21 16:22:32 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.7 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
 
-module GF.Grammar.Values (-- ** Values used in TC type checking
-	       Val(..), Env,
-	       -- ** Annotated tree used in editing
+module GF.Grammar.Values (
+               -- ** Values used in TC type checking
+               Val(..), Env,
+               -- ** Annotated tree used in editing
                Binds, Constraints, MetaSubst,
-	       -- ** For TC
-	       valAbsInt, valAbsFloat, valAbsString, vType,
-	       isPredefCat,
-	       eType, 
-	      ) where
+               -- ** For TC
+               valAbsInt, valAbsFloat, valAbsString, vType,
+               isPredefCat,
+               eType,
+              ) where
 
 import GF.Infra.Ident
 import GF.Grammar.Grammar

src/compiler/GF/Infra/BuildInfo.hs

@@ -1,13 +1,34 @@
 {-# 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

src/compiler/GF/Infra/CheckM.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:22:33 $ 
+-- > CVS $Date: 2005/04/21 16:22:33 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.5 $
 --
@@ -14,10 +14,10 @@
 
 module GF.Infra.CheckM
           (Check, CheckResult, Message, runCheck, runCheck',
-	   checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
-	   checkIn, checkInModule, checkMap, checkMapRecover,
+           checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
+           checkIn, checkInModule, checkMap, checkMapRecover,
            parallelCheck, accumulateError, commitCheck,
-	  ) where
+          ) where
 import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
 
 import GF.Data.Operations
@@ -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
@@ -141,10 +141,10 @@ checkMapRecover f = fmap Map.fromList . parallelCheck . map f' . Map.toList
   where f' (k,v) = fmap ((,)k) (f k v)
 
 {-
-checkMapRecover f mp = do 
+checkMapRecover f mp = do
   let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp)
   case [s | (_,Bad s) <- xs] of
-    ss@(_:_) -> checkError (text (unlines ss)) 
+    ss@(_:_) -> checkError (text (unlines ss))
     _   -> do
       let (kx,ss) = unzip [((k,x),s) | (k, Ok (x,s)) <- xs]
       if not (all null ss) then checkWarn (text (unlines ss)) else return ()

src/compiler/GF/Infra/SIO.hs

@@ -52,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

src/compiler/GF/Interactive.hs

@@ -32,15 +32,17 @@ import qualified Text.ParserCombinators.ReadP as RP
 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)
-import GF.Infra.UseIO (Output)
--- Provides an orphan instance of MonadFail for StateT in ghc versions < 8
+#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 ()
@@ -56,6 +58,7 @@ mainGFI opts files = do
 
 shell opts files = flip evalStateT (emptyGFEnv opts) $
                    do mapStateT runSIO $ importInEnv opts files
+                      modify $ \ gfenv0 -> gfenv0 {history = [unwords ("i":files)]}
                       loop
 
 #ifdef SERVER_MODE
@@ -433,7 +436,7 @@ wc_type = cmd_name
         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
+                [x] -> Just x
                 _   -> Nothing
 
     isIdent c = c == '_' || c == '\'' || isAlphaNum c

src/compiler/GF/Interactive2.hs

@@ -12,7 +12,7 @@ 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
@@ -58,6 +58,7 @@ mainGFI opts files = do
 
 shell opts files = flip evalStateT (emptyGFEnv opts) $
                    do mapStateT runSIO $ importInEnv opts files
+                      modify $ \ gfenv0 -> gfenv0 {history = [unwords ("i":files)]}
                       loop
 
 {-
@@ -101,7 +102,7 @@ timeIt act =
 
 -- | Optionally show how much CPU time was used to run an IO action
 optionallyShowCPUTime :: (Monad m,MonadSIO m) => Options -> m a -> m a
-optionallyShowCPUTime opts act 
+optionallyShowCPUTime opts act
   | not (verbAtLeast opts Normal) = act
   | otherwise = do (dt,r) <- timeIt act
                    liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
@@ -358,7 +359,7 @@ wordCompletion gfenv (left,right) = do
     CmplIdent _ pref
       -> case mb_pgf of
            Just pgf -> ret (length pref)
-                           [Haskeline.simpleCompletion name 
+                           [Haskeline.simpleCompletion name
                             | name <- C.functions pgf,
                               isPrefixOf pref name]
            _ -> ret (length pref) []
@@ -369,7 +370,7 @@ wordCompletion gfenv (left,right) = do
     cmdEnv = commandenv gfenv
 {-
     optLang opts = valStrOpts "lang" (head $ Map.keys (concretes cmdEnv)) opts
-    optType opts = 
+    optType opts =
       let str = valStrOpts "cat" (H.showCId $ H.lookStartCat pgf) opts
       in case H.readType str of
            Just ty -> ty
@@ -416,7 +417,7 @@ wc_type = cmd_name
     option x y (c  :cs)
       | isIdent c       = option x y cs
       | otherwise       = cmd x cs
-      
+
     optValue x y ('"':cs) = str x y cs
     optValue x y cs       = cmd x cs
 
@@ -434,9 +435,9 @@ wc_type = cmd_name
       where
         x1 = take (length x - length y - d) x
         x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=' || c == '"') x1
-        
+
         cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of
-	        [x] -> Just x
+                [x] -> Just x
                 _   -> Nothing
 
     isIdent c = c == '_' || c == '\'' || isAlphaNum c

src/compiler/GF/Main.hs

@@ -16,18 +16,21 @@ import Data.Version
 import System.Directory
 import System.Environment (getArgs)
 import System.Exit
-import GF.System.Console (setConsoleEncoding)
+import GHC.IO.Encoding
+-- import GF.System.Console (setConsoleEncoding)
 
 -- | Run the GF main program, taking arguments from the command line.
 -- (It calls 'setConsoleEncoding' and 'getOptions', then 'mainOpts'.)
 -- Run @gf --help@ for usage info.
 main :: IO ()
 main = do
-  --setConsoleEncoding
+  setLocaleEncoding utf8
+  -- setConsoleEncoding
   uncurry mainOpts =<< getOptions
 
 -- | Get and parse GF command line arguments. Fix relative paths.
 -- Calls 'getArgs' and 'parseOptions'.
+getOptions :: IO (Options, [FilePath])
 getOptions = do
   args <- getArgs
   case parseOptions args of
@@ -43,9 +46,12 @@ getOptions = do
 -- the options it invokes 'mainGFC', 'mainGFI', 'mainRunGFI', 'mainServerGFI',
 -- or it just prints version/usage info.
 mainOpts :: Options -> [FilePath] -> IO ()
-mainOpts opts files = 
+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 -> GFI1.mainServerGFI opts port files
       ModeCompiler    -> mainGFC opts files

src/compiler/GF/Speech/FiniteState.hs

@@ -5,37 +5,37 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/10 16:43:44 $ 
+-- > CVS $Date: 2005/11/10 16:43:44 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.16 $
 --
 -- A simple finite state network module.
 -----------------------------------------------------------------------------
 module GF.Speech.FiniteState (FA(..), State, NFA, DFA,
-			      startState, finalStates,
-			      states, transitions,
+                              startState, finalStates,
+                              states, transitions,
                               isInternal,
-			      newFA, newFA_,
-			      addFinalState,
-			      newState, newStates,
+                              newFA, newFA_,
+                              addFinalState,
+                              newState, newStates,
                               newTransition, newTransitions,
                               insertTransitionWith, insertTransitionsWith,
-			      mapStates, mapTransitions,
+                              mapStates, mapTransitions,
                               modifyTransitions,
-                              nonLoopTransitionsTo, nonLoopTransitionsFrom, 
+                              nonLoopTransitionsTo, nonLoopTransitionsFrom,
                               loops,
                               removeState,
                               oneFinalState,
                               insertNFA,
                               onGraph,
-			      moveLabelsToNodes, removeTrivialEmptyNodes,
+                              moveLabelsToNodes, removeTrivialEmptyNodes,
                               minimize,
                               dfa2nfa,
                               unusedNames, renameStates,
-			      prFAGraphviz, faToGraphviz) where
+                              prFAGraphviz, faToGraphviz) where
 
 import Data.List
-import Data.Maybe 
+import Data.Maybe
 --import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -98,13 +98,13 @@ newTransition f t l = onGraph (newEdge (f,t,l))
 newTransitions :: [(n, n, b)] -> FA n a b -> FA n a b
 newTransitions es = onGraph (newEdges es)
 
-insertTransitionWith :: Eq n => 
+insertTransitionWith :: Eq n =>
                         (b -> b -> b) -> (n, n, b) -> FA n a b -> FA n a b
 insertTransitionWith f t = onGraph (insertEdgeWith f t)
 
-insertTransitionsWith :: Eq n => 
+insertTransitionsWith :: Eq n =>
                          (b -> b -> b) -> [(n, n, b)] -> FA n a b -> FA n a b
-insertTransitionsWith f ts fa = 
+insertTransitionsWith f ts fa =
     foldl' (flip (insertTransitionWith f)) fa ts
 
 mapStates :: (a -> c) -> FA n a b -> FA n c b
@@ -128,11 +128,11 @@ unusedNames (FA (Graph names _ _) _ _) = names
 -- | Gets all incoming transitions to a given state, excluding
 -- transtions from the state itself.
 nonLoopTransitionsTo :: Eq n => n -> FA n a b -> [(n,b)]
-nonLoopTransitionsTo s fa = 
+nonLoopTransitionsTo s fa =
     [(f,l) | (f,t,l) <- transitions fa, t == s && f /= s]
 
 nonLoopTransitionsFrom :: Eq n => n -> FA n a b -> [(n,b)]
-nonLoopTransitionsFrom s fa = 
+nonLoopTransitionsFrom s fa =
     [(t,l) | (f,t,l) <- transitions fa, f == s && t /= s]
 
 loops :: Eq n => n -> FA n a b -> [b]
@@ -145,7 +145,7 @@ renameStates :: Ord x => [y] -- ^ Infinite supply of new names
 renameStates supply (FA g s fs) = FA (renameNodes newName rest g) s' fs'
     where (ns,rest) = splitAt (length (nodes g)) supply
           newNodes = Map.fromList (zip (map fst (nodes g)) ns)
-	  newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes
+          newName n = Map.findWithDefault (error "FiniteState.newName") n newNodes
           s' = newName s
           fs' = map newName fs
 
@@ -154,9 +154,9 @@ insertNFA :: NFA a -- ^ NFA to insert into
           -> (State, State) -- ^ States to insert between
           -> NFA a -- ^ NFA to insert.
           -> NFA a
-insertNFA (FA g1 s1 fs1) (f,t) (FA g2 s2 fs2) 
+insertNFA (FA g1 s1 fs1) (f,t) (FA g2 s2 fs2)
     = FA (newEdges es g') s1 fs1
-    where 
+    where
     es = (f,ren s2,Nothing):[(ren f2,t,Nothing) | f2 <- fs2]
     (g',ren) = mergeGraphs g1 g2
 
@@ -182,9 +182,9 @@ oneFinalState nl el fa =
 moveLabelsToNodes :: (Ord n,Eq a) => FA n () (Maybe a) -> FA n (Maybe a) ()
 moveLabelsToNodes = onGraph f
   where f g@(Graph c _ _) = Graph c' ns (concat ess)
-	    where is = [ ((n,l),inc) | (n, (l,inc,_)) <- Map.toList (nodeInfo g)]
-		  (c',is') = mapAccumL fixIncoming c is
-		  (ns,ess) = unzip (concat is')
+         where is = [ ((n,l),inc) | (n, (l,inc,_)) <- Map.toList (nodeInfo g)]
+               (c',is') = mapAccumL fixIncoming c is
+               (ns,ess) = unzip (concat is')
 
 
 -- | Remove empty nodes which are not start or final, and have
@@ -196,12 +196,12 @@ removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes
 --   This is not done if the pointed-to node is a final node.
 skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
 skipSimpleEmptyNodes fa = onGraph og fa
-  where 
+  where
   og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es')
     where
     es' = concatMap changeEdge es
     info = nodeInfo g
-    changeEdge e@(f,t,()) 
+    changeEdge e@(f,t,())
       | isNothing (getNodeLabel info t)
        -- && (i * o <= i + o)
         && not (isFinal fa t)
@@ -223,28 +223,28 @@ pruneUnusable fa = onGraph f fa
  where
  f g = if Set.null rns then g else f (removeNodes rns g)
   where info = nodeInfo g
-        rns = Set.fromList [ n | (n,_) <- nodes g, 
+        rns = Set.fromList [ n | (n,_) <- nodes g,
                              isInternal fa n,
-                             inDegree info n == 0 
+                             inDegree info n == 0
                              || outDegree info n == 0]
 
-fixIncoming :: (Ord n, Eq a) => [n] 
+fixIncoming :: (Ord n, Eq a) => [n]
             -> (Node n (),[Edge n (Maybe a)]) -- ^ A node and its incoming edges
             -> ([n],[(Node n (Maybe a),[Edge n ()])]) -- ^ Replacement nodes with their
                                                       -- incoming edges.
 fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
   where ls = nub $ map edgeLabel es
-	(cs',cs'') = splitAt (length ls) cs
-	newNodes = zip cs' ls
-	es' = [ (x,n,()) | x <- map fst newNodes ]
-	-- separate cyclic and non-cyclic edges
-	(cyc,ncyc) = partition (\ (f,_,_) -> f == n) es
-	          -- keep all incoming non-cyclic edges with the right label
-	to (x,l) = [ (f,x,()) | (f,_,l') <- ncyc, l == l']
-	          -- for each cyclic edge with the right label, 
-	          -- add an edge from each of the new nodes (including this one)
-		    ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]
-	newContexts = [ (v, to v) | v <- newNodes ]
+        (cs',cs'') = splitAt (length ls) cs
+        newNodes = zip cs' ls
+        es' = [ (x,n,()) | x <- map fst newNodes ]
+        -- separate cyclic and non-cyclic edges
+        (cyc,ncyc) = partition (\ (f,_,_) -> f == n) es
+                  -- keep all incoming non-cyclic edges with the right label
+        to (x,l) = [ (f,x,()) | (f,_,l') <- ncyc, l == l']
+                  -- for each cyclic edge with the right label,
+                  -- add an edge from each of the new nodes (including this one)
+                  ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]
+        newContexts = [ (v, to v) | v <- newNodes ]
 
 --alphabet :: Eq b => Graph n a (Maybe b) -> [b]
 --alphabet = nub . catMaybes . map edgeLabel . edges
@@ -254,19 +254,19 @@ determinize (FA g s f) = let (ns,es) = h (Set.singleton start) Set.empty Set.emp
                              (ns',es') = (Set.toList ns, Set.toList es)
                              final = filter isDFAFinal ns'
                              fa = FA (Graph undefined [(n,()) | n <- ns'] es') start final
- 		          in renameStates [0..] fa
+                         in renameStates [0..] fa
   where info = nodeInfo g
 --        reach = nodesReachable out
-	start = closure info $ Set.singleton s
+        start = closure info $ Set.singleton s
         isDFAFinal n = not (Set.null (Set.fromList f `Set.intersection` n))
-	h currentStates oldStates es
-	    | Set.null currentStates = (oldStates,es)
-	    | otherwise = ((h $! uniqueNewStates) $! allOldStates) $! es'
-	    where 
-	    allOldStates = oldStates `Set.union` currentStates
+        h currentStates oldStates es
+            | Set.null currentStates = (oldStates,es)
+            | otherwise = ((h $! uniqueNewStates) $! allOldStates) $! es'
+            where
+            allOldStates = oldStates `Set.union` currentStates
             (newStates,es') = new (Set.toList currentStates) Set.empty es
-	    uniqueNewStates = newStates Set.\\ allOldStates
-        -- Get the sets of states reachable from the given states 
+            uniqueNewStates = newStates Set.\\ allOldStates
+        -- Get the sets of states reachable from the given states
         -- by consuming one symbol, and the associated edges.
         new [] rs es = (rs,es)
         new (n:ns) rs es = new ns rs' es'
@@ -281,7 +281,7 @@ closure info x = closure_ x x
   where closure_ acc check | Set.null check = acc
                            | otherwise = closure_ acc' check'
             where
-            reach = Set.fromList [y | x <- Set.toList check, 
+            reach = Set.fromList [y | x <- Set.toList check,
                                       (_,y,Nothing) <- getOutgoing info x]
             acc' = acc `Set.union` reach
             check' = reach Set.\\ acc
@@ -296,8 +296,8 @@ reachable1 info ns = Map.fromListWith (++) [(c, [y]) | n <- Set.toList ns, (_,y,
 reverseNFA :: NFA a -> NFA a
 reverseNFA (FA g s fs) = FA g''' s' [s]
     where g' = reverseGraph g
-	  (g'',s') = newNode () g'
-	  g''' = newEdges [(s',f,Nothing) | f <- fs] g''
+          (g'',s') = newNode () g'
+          g''' = newEdges [(s',f,Nothing) | f <- fs] g''
 
 dfa2nfa :: DFA a -> NFA a
 dfa2nfa = mapTransitions Just
@@ -313,13 +313,13 @@ prFAGraphviz  = Dot.prGraphviz . faToGraphviz
 --prFAGraphviz_  = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show
 
 faToGraphviz :: (Eq n,Show n) => FA n String String -> Dot.Graph
-faToGraphviz (FA (Graph _ ns es) s f) 
+faToGraphviz (FA (Graph _ ns es) s f)
     = Dot.Graph Dot.Directed Nothing [] (map mkNode ns) (map mkEdge es) []
    where mkNode (n,l) = Dot.Node (show n) attrs
-	     where attrs = [("label",l)]
-			   ++ if n == s then [("shape","box")] else []
-			   ++ if n `elem` f then [("style","bold")] else []
-	 mkEdge (x,y,l) = Dot.Edge (show x) (show y) [("label",l)]
+          where attrs = [("label",l)]
+                 ++ if n == s then [("shape","box")] else []
+                 ++ if n `elem` f then [("style","bold")] else []
+         mkEdge (x,y,l) = Dot.Edge (show x) (show y) [("label",l)]
 
 --
 -- * Utilities

src/compiler/GF/Speech/GSL.hs

@@ -26,14 +26,14 @@ width = 75
 
 gslPrinter :: Options -> PGF -> CId -> String
 gslPrinter opts pgf cnc = renderStyle st $ prGSL $ makeNonLeftRecursiveSRG opts pgf cnc
-  where st = style { lineLength = width } 
+  where st = style { lineLength = width }
 
 prGSL :: SRG -> Doc
 prGSL srg = header $++$ mainCat $++$ foldr ($++$) empty (map prRule (srgRules srg))
     where
     header = ";GSL2.0" $$
-	     comment ("Nuance speech recognition grammar for " ++ srgName srg) $$
-             comment ("Generated by GF") 
+             comment ("Nuance speech recognition grammar for " ++ srgName srg) $$
+             comment ("Generated by GF")
     mainCat = ".MAIN" <+> prCat (srgStartCat srg)
     prRule (SRGRule cat rhs) = prCat cat <+> union (map prAlt rhs)
     -- FIXME: use the probability

src/compiler/GF/Speech/JSGF.hs

@@ -31,7 +31,7 @@ width :: Int
 width = 75
 
 jsgfPrinter :: Options
-	    -> PGF 
+            -> PGF
             -> CId -> String
 jsgfPrinter opts pgf cnc = renderStyle st $ prJSGF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
   where st = style { lineLength = width }
@@ -44,7 +44,7 @@ prJSGF sisr srg
     header = "#JSGF" <+> "V1.0" <+> "UTF-8" <+> lang <> ';' $$
              comment ("JSGF speech recognition grammar for " ++ srgName srg) $$
              comment "Generated by GF" $$
-	     ("grammar " ++ srgName srg ++ ";") 
+             ("grammar " ++ srgName srg ++ ";")
     lang = maybe empty pp (srgLanguage srg)
     mainCat = rule True "MAIN" [prCat (srgStartCat srg)]
     prRule (SRGRule cat rhs) = rule (isExternalCat srg cat) cat (map prAlt rhs)
@@ -62,7 +62,7 @@ prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc
 prItem sisr t = f 0
   where
     f _ (REUnion [])  = pp "<VOID>"
-    f p (REUnion xs) 
+    f p (REUnion xs)
         | not (null es) = brackets (f 0 (REUnion nes))
         | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs))
       where (es,nes) = partition isEpsilon xs
@@ -110,4 +110,3 @@ prepunctuate p (x:xs) = x : map (p <>) xs
 
 ($++$) :: Doc -> Doc -> Doc
 x $++$ y = x $$ emptyLine $$ y
-

src/compiler/GF/Speech/PGFToCFG.hs

@@ -28,7 +28,7 @@ toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc
 
 type Profile = [Int]
 
-pgfToCFG :: PGF 
+pgfToCFG :: PGF
           -> CId   -- ^ Concrete syntax name
           -> CFG
 pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ concatMap ruleToCFRule rules)
@@ -40,8 +40,8 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
                          , prod <- Set.toList set]
 
     fcatCats :: Map FId Cat
-    fcatCats = Map.fromList [(fc, showCId c ++ "_" ++ show i) 
-                                 | (c,CncCat s e lbls) <- Map.toList (cnccats cnc), 
+    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
@@ -58,7 +58,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
     topdownRules cat = f cat []
       where
         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
 
@@ -67,13 +67,13 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
     extCats = Set.fromList $ map ruleLhs startRules
 
     startRules :: [CFRule]
-    startRules = [Rule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0) 
-                      | (c,CncCat s e lbls) <- Map.toList (cnccats cnc), 
+    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) = 
+    ruleToCFRule (c,PApply funid args) =
         [Rule (fcatToCat c l) (mkRhs row) (profilesToTerm [fixProfile row n | n <- [0..length args-1]])
            | (l,seqid) <- Array.assocs rhs
            , let row = sequences cnc ! seqid
@@ -106,7 +106,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
         fixProfile row i = [k | (k,j) <- nts, j == i]
             where
               nts = zip [0..] [j | nt <- Array.elems row, j <- getPos nt]
-              
+
               getPos (SymCat j _) = [j]
               getPos (SymLit j _) = [j]
               getPos _            = []

src/compiler/GF/Speech/SRG.hs

@@ -2,8 +2,8 @@
 -- |
 -- Module      : SRG
 --
--- Representation of, conversion to, and utilities for 
--- printing of a general Speech Recognition Grammar. 
+-- Representation of, conversion to, and utilities for
+-- printing of a general Speech Recognition Grammar.
 --
 -- FIXME: remove \/ warn \/ fail if there are int \/ string literal
 -- categories in the grammar
@@ -40,20 +40,20 @@ import qualified Data.Set as Set
 --import Debug.Trace
 
 data SRG = SRG { srgName :: String    -- ^ grammar name
-		 , srgStartCat :: Cat     -- ^ start category name
-                 , srgExternalCats :: Set Cat
-                 , srgLanguage :: Maybe String -- ^ The language for which the grammar 
-                                                   --   is intended, e.g. en-UK
-	         , srgRules :: [SRGRule] 
-	       }
-	 deriving (Eq,Show)
+               , srgStartCat :: Cat     -- ^ start category name
+               , srgExternalCats :: Set Cat
+               , srgLanguage :: Maybe String -- ^ The language for which the grammar
+                                             --   is intended, e.g. en-UK
+               , srgRules :: [SRGRule]
+               }
+        deriving (Eq,Show)
 
 data SRGRule = SRGRule Cat [SRGAlt]
-	     deriving (Eq,Show)
+        deriving (Eq,Show)
 
 -- | maybe a probability, a rule name and an EBNF right-hand side
 data SRGAlt = SRGAlt (Maybe Double) CFTerm SRGItem
-	      deriving (Eq,Show)
+        deriving (Eq,Show)
 
 type SRGItem = RE SRGSymbol
 
@@ -65,7 +65,7 @@ type SRGNT = (Cat, Int)
 ebnfPrinter :: Options -> PGF -> CId -> String
 ebnfPrinter opts pgf cnc = prSRG opts $ makeSRG opts pgf cnc
 
--- | Create a compact filtered non-left-recursive SRG. 
+-- | Create a compact filtered non-left-recursive SRG.
 makeNonLeftRecursiveSRG :: Options -> PGF -> CId -> SRG
 makeNonLeftRecursiveSRG opts = makeSRG opts'
     where
@@ -76,11 +76,11 @@ makeSRG opts = mkSRG cfgToSRG preprocess
     where
       cfgToSRG cfg = [cfRulesToSRGRule rs | (_,rs) <- allRulesGrouped cfg]
       preprocess =   maybeTransform opts CFGMergeIdentical mergeIdentical
-                   . maybeTransform opts CFGNoLR removeLeftRecursion 
+                   . maybeTransform opts CFGNoLR removeLeftRecursion
                    . maybeTransform opts CFGRegular makeRegular
                    . maybeTransform opts CFGTopDownFilter topDownFilter
                    . maybeTransform opts CFGBottomUpFilter bottomUpFilter
-                   . maybeTransform opts CFGRemoveCycles removeCycles 
+                   . maybeTransform opts CFGRemoveCycles removeCycles
                    . maybeTransform opts CFGStartCatOnly purgeExternalCats
 
 setDefaultCFGTransform :: Options -> CFGTransform -> Bool -> Options
@@ -95,7 +95,7 @@ stats g = "Categories: " ++ show (countCats g)
           ++ ", External categories: " ++ show (Set.size (cfgExternalCats g))
           ++ ", Rules: " ++ show (countRules g)
 -}
-makeNonRecursiveSRG :: Options 
+makeNonRecursiveSRG :: Options
                     -> PGF
                     -> CId -- ^ Concrete syntax name.
                     -> SRG
@@ -111,26 +111,26 @@ makeNonRecursiveSRG opts = mkSRG cfgToSRG id
 mkSRG :: (CFG -> [SRGRule]) -> (CFG -> CFG) -> PGF -> CId -> SRG
 mkSRG mkRules preprocess pgf cnc =
     SRG { srgName = showCId cnc,
-	  srgStartCat = cfgStartCat cfg,
+          srgStartCat = cfgStartCat cfg,
           srgExternalCats = cfgExternalCats cfg,
           srgLanguage = languageCode pgf cnc,
-	  srgRules = mkRules cfg }
+          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), 
+-- | 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.
 renameCats :: String -> CFG -> CFG
 renameCats prefix cfg = mapCFGCats renameCat cfg
   where renameCat c | isExternal c = c ++ "_cat"
                     | otherwise = Map.findWithDefault (badCat c) c names
-        isExternal c = c `Set.member` cfgExternalCats cfg        
+        isExternal c = c `Set.member` cfgExternalCats cfg
         catsByPrefix = buildMultiMap [(takeWhile (/='_') cat, cat) | cat <- allCats' cfg, not (isExternal cat)]
         names = Map.fromList [(c,pref++"_"++show i) | (pref,cs) <- catsByPrefix, (c,i) <- zip cs [1..]]
         badCat c = error ("GF.Speech.SRG.renameCats: " ++ c ++ "\n" ++ prCFG cfg)
 
 cfRulesToSRGRule :: [CFRule] -> SRGRule
 cfRulesToSRGRule rs@(r:_) = SRGRule (ruleLhs r) rhs
-    where 
+    where
       alts = [((n,Nothing),mkSRGSymbols 0 ss) | Rule c ss n <- rs]
       rhs = [SRGAlt p n (srgItem sss) | ((n,p),sss) <- buildMultiMap alts ]
 
@@ -153,7 +153,7 @@ srgItem = unionRE . map mergeItems . sortGroupBy (compareBy filterCats)
 -- non-optimizing version:
 --srgItem = unionRE . map seqRE
 
--- | Merges a list of right-hand sides which all have the same 
+-- | Merges a list of right-hand sides which all have the same
 -- sequence of non-terminals.
 mergeItems :: [[SRGSymbol]] -> SRGItem
 mergeItems = minimizeRE . ungroupTokens . minimizeRE . unionRE . map seqRE . map groupTokens
@@ -174,16 +174,16 @@ ungroupTokens = joinRE . mapRE (symbol (RESymbol . NonTerminal) (REConcat . map
 
 prSRG :: Options -> SRG -> String
 prSRG opts srg = prProductions $ map prRule $ ext ++ int
-    where 
+    where
       sisr = flag optSISR opts
       (ext,int) = partition (isExternalCat srg . srgLHSCat) (srgRules srg)
       prRule (SRGRule c alts) = (c,unwords (intersperse "|" (concatMap prAlt alts)))
-      prAlt (SRGAlt _ t rhs) = 
-          -- FIXME: hack: we high-jack the --sisr flag to add 
+      prAlt (SRGAlt _ t rhs) =
+          -- FIXME: hack: we high-jack the --sisr flag to add
           -- a simple lambda calculus format for semantic interpretation
           -- Maybe the --sisr flag should be renamed.
           case sisr of
-            Just _  -> 
+            Just _  ->
                 -- copy tags to each part of a top-level union,
                 -- to get simpler output
                 case rhs of

src/compiler/GF/Speech/SRGS_ABNF.hs

@@ -5,7 +5,7 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/01 20:09:04 $ 
+-- > CVS $Date: 2005/11/01 20:09:04 $
 -- > CVS $Author: bringert $
 -- > CVS $Revision: 1.16 $
 --
@@ -38,7 +38,7 @@ width :: Int
 width = 75
 
 srgsAbnfPrinter :: Options
-	        -> PGF -> CId -> String
+                -> PGF -> CId -> String
 srgsAbnfPrinter opts pgf cnc = showDoc $ prABNF sisr $ makeNonLeftRecursiveSRG opts pgf cnc
     where sisr = flag optSISR opts
 
@@ -72,7 +72,7 @@ prItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> Doc
 prItem sisr t = f 0
   where
     f _ (REUnion [])  = pp "$VOID"
-    f p (REUnion xs) 
+    f p (REUnion xs)
         | not (null es) = brackets (f 0 (REUnion nes))
         | otherwise = (if p >= 1 then parens else id) (alts (map (f 1) xs))
       where (es,nes) = partition isEpsilon xs
@@ -84,13 +84,13 @@ prItem sisr t = f 0
 
 prSymbol :: Maybe SISRFormat -> CFTerm -> SRGSymbol -> Doc
 prSymbol sisr cn (NonTerminal n@(c,_)) = prCat c <+> tag sisr (catSISR cn n)
-prSymbol _ cn (Terminal t) 
+prSymbol _ cn (Terminal t)
     | all isPunct t = empty  -- removes punctuation
     | otherwise = pp t -- FIXME: quote if there is whitespace or odd chars
 
 tag :: Maybe SISRFormat -> (SISRFormat -> SISRTag) -> Doc
 tag Nothing _ = empty
-tag (Just fmt) t = 
+tag (Just fmt) t =
     case t fmt of
       [] -> empty
       -- grr, silly SRGS ABNF does not have an escaping mechanism
@@ -125,4 +125,3 @@ prepunctuate p (x:xs) = x : map (p <>) xs
 
 ($++$) :: Doc -> Doc -> Doc
 x $++$ y = x $$ emptyLine $$ y
-

src/compiler/GF/Speech/SRGS_XML.hs

@@ -34,13 +34,13 @@ prSrgsXml :: Maybe SISRFormat -> SRG -> String
 prSrgsXml sisr srg = showXMLDoc (optimizeSRGS xmlGr)
     where
     xmlGr = grammar sisr (srgStartCat srg) (srgLanguage srg) $
-              [meta "description" 
+              [meta "description"
                  ("SRGS XML speech recognition grammar for " ++ srgName srg ++ "."),
                meta "generator" "Grammatical Framework"]
-	    ++ map ruleToXML (srgRules srg)
+               ++ map ruleToXML (srgRules srg)
     ruleToXML (SRGRule cat alts) = Tag "rule" ([("id",cat)]++pub) (prRhs alts)
         where pub = if isExternalCat srg cat then [("scope","public")] else []
-    prRhs rhss = [oneOf (map (mkProd sisr) rhss)] 
+    prRhs rhss = [oneOf (map (mkProd sisr) rhss)]
 
 mkProd :: Maybe SISRFormat -> SRGAlt -> XML
 mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf)
@@ -50,9 +50,9 @@ mkProd sisr (SRGAlt mp n rhs) = Tag "item" [] (ti ++ [x] ++ tf)
 
 mkItem :: Maybe SISRFormat -> CFTerm -> SRGItem -> XML
 mkItem sisr cn = f
-  where 
+  where
     f (REUnion [])  = ETag "ruleref" [("special","VOID")]
-    f (REUnion xs) 
+    f (REUnion xs)
         | not (null es) = Tag "item" [("repeat","0-1")] [f (REUnion nes)]
         | otherwise = oneOf (map f xs)
       where (es,nes) = partition isEpsilon xs
@@ -62,7 +62,7 @@ mkItem sisr cn = f
     f (RESymbol s)  = symItem sisr cn s
 
 symItem :: Maybe SISRFormat -> CFTerm -> Symbol SRGNT Token -> XML
-symItem sisr cn (NonTerminal n@(c,_)) = 
+symItem sisr cn (NonTerminal n@(c,_)) =
     Tag "item" [] $ [ETag "ruleref" [("uri","#" ++ c)]] ++ tag sisr (catSISR cn n)
 symItem _ _ (Terminal t) = Tag "item" [] [Data (showToken t)]
 
@@ -81,12 +81,12 @@ oneOf = Tag "one-of" []
 grammar :: Maybe SISRFormat
         -> String  -- ^ root
         -> Maybe String -- ^language
-	-> [XML] -> XML
-grammar sisr root ml = 
+        -> [XML] -> XML
+grammar sisr root ml =
     Tag "grammar" $ [("xmlns","http://www.w3.org/2001/06/grammar"),
-		     ("version","1.0"),
-		     ("mode","voice"),
-		     ("root",root)]
+                     ("version","1.0"),
+                     ("mode","voice"),
+                     ("root",root)]
                  ++ (if isJust sisr then [("tag-format","semantics/1.0")] else [])
                  ++ maybe [] (\l -> [("xml:lang", l)]) ml
 
@@ -94,7 +94,7 @@ meta :: String -> String -> XML
 meta n c = ETag "meta" [("name",n),("content",c)]
 
 optimizeSRGS :: XML -> XML
-optimizeSRGS = bottomUpXML f 
+optimizeSRGS = bottomUpXML f
   where f (Tag "item" [] [x@(Tag "item" _ _)]) = x
         f (Tag "item" [] [x@(Tag "one-of" _ _)]) = x
         f (Tag "item" as [Tag "item" [] xs]) = Tag "item" as xs

src/compiler/GF/Text/Coding.hs

@@ -38,7 +38,7 @@ decodeUnicode :: TextEncoding -> ByteString -> String
 decodeUnicode enc bs = unsafePerformIO $ decodeUnicodeIO enc bs
 
 decodeUnicodeIO enc (PS fptr l len) = do
-    let bbuf = Buffer{bufRaw=fptr, bufState=ReadBuffer, bufSize=len, bufL=l, bufR=l+len}
+    let bbuf = (emptyBuffer fptr len ReadBuffer) { bufL=l, bufR=l+len }
     cbuf <- newCharBuffer 128 WriteBuffer
     case enc of
       TextEncoding {mkTextDecoder=mk} -> do decoder <- mk

src/compiler/GF/Text/Transliterations.hs

@@ -17,7 +17,7 @@ import qualified Data.Map as Map
 -- to add a new one: define the Unicode range and the corresponding ASCII strings,
 -- which may be one or more characters long
 
--- conventions to be followed: 
+-- conventions to be followed:
 --   each character is either [letter] or [letter+nonletters]
 --   when using a sparse range of unicodes, mark missing codes as "-" in transliterations
 --   characters can be invisible: ignored in translation to unicode
@@ -33,7 +33,7 @@ transliterateWithFile name src isFrom =
   (if isFrom then appTransFromUnicode else appTransToUnicode) (getTransliterationFile name src)
 
 transliteration :: String -> Maybe Transliteration
-transliteration s = Map.lookup s allTransliterations 
+transliteration s = Map.lookup s allTransliterations
 
 allTransliterations = Map.fromList [
   ("amharic",transAmharic),
@@ -67,25 +67,25 @@ data Transliteration = Trans {
   }
 
 appTransToUnicode :: Transliteration -> String -> String
-appTransToUnicode trans = 
+appTransToUnicode trans =
   concat .
   map (\c -> maybe c (return . toEnum) $
              Map.lookup c (trans_to_unicode trans)
-      ) . 
-  filter (flip notElem (invisible_chars trans)) . 
+      ) .
+  filter (flip notElem (invisible_chars trans)) .
   unchar
 
 appTransFromUnicode :: Transliteration -> String -> String
-appTransFromUnicode trans = 
+appTransFromUnicode trans =
   concat .
-  map (\c -> maybe [toEnum c] id $ 
+  map (\c -> maybe [toEnum c] id $
              Map.lookup c (trans_from_unicode trans)
-      ) . 
+      ) .
   map fromEnum
 
 
 mkTransliteration :: String -> [String] -> [Int] -> Transliteration
-mkTransliteration name ts us = 
+mkTransliteration name ts us =
  Trans (Map.fromList (tzip ts us)) (Map.fromList (uzip us ts)) [] name
   where
     tzip ts us = [(t,u) | (t,u) <- zip ts us, t /= "-"]
@@ -102,7 +102,7 @@ getTransliterationFile name = uncurry (mkTransliteration name) . codes
 
 unchar :: String -> [String]
 unchar s = case s of
-  c:d:cs 
+  c:d:cs
    | isAlpha d -> [c]    : unchar (d:cs)
    | isSpace d -> [c]:[d]: unchar cs
    | otherwise -> let (ds,cs2) = break (\x -> isAlpha x || isSpace x) cs in
@@ -122,8 +122,8 @@ transThai = mkTransliteration "Thai" allTrans allCodes where
   allCodes = [0x0e00 .. 0x0e7f]
 
 transDevanagari :: Transliteration
-transDevanagari = 
-  (mkTransliteration "Devanagari" 
+transDevanagari =
+  (mkTransliteration "Devanagari"
     allTransUrduHindi allCodes){invisible_chars = ["a"]} where
       allCodes = [0x0900 .. 0x095f] ++ [0x0966 .. 0x096f]
 
@@ -136,13 +136,13 @@ allTransUrduHindi = words $
     "-  -  -  -  -  -  -  -  q  x  g.  z  R R'  f  -  " ++
     "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 "
 
-
+
 transUrdu :: Transliteration
-transUrdu = 
+transUrdu =
   (mkTransliteration "Urdu" allTrans allCodes) where
-    allCodes = [0x0622 .. 0x062f] ++ [0x0630 .. 0x063a] ++ [0x0641,0x0642] ++ [0x06A9] ++ [0x0644 .. 0x0648] ++ 
+    allCodes = [0x0622 .. 0x062f] ++ [0x0630 .. 0x063a] ++ [0x0641,0x0642] ++ [0x06A9] ++ [0x0644 .. 0x0648] ++
                [0x0654,0x0658,0x0679,0x067e,0x0686,0x0688,0x0691,0x0698,0x06af,0x06c1,0x06c3,0x06cc,0x06ba,0x06be,0x06d2] ++
-			   [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]
+               [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]
     allTrans = words $
       "A - w^ - y^ a b - t C j H K d " ++  -- 0622 - 062f
       "Z r z s X S Z- t- z- e G "   ++  -- 0630 - 063a
@@ -151,22 +151,22 @@ transUrdu =
       "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 " ++ "? ."
 
 transSindhi :: Transliteration
-transSindhi = 
+transSindhi =
   (mkTransliteration "Sindhi" allTrans allCodes) where
     allCodes = [0x062e] ++ [0x0627 .. 0x062f] ++ [0x0630 .. 0x063a] ++ [0x0641 .. 0x0648] ++
                [0x067a,0x067b,0x067d,0x067e,0x067f] ++ [0x0680 .. 0x068f] ++
                [0x0699,0x0918,0x06a6,0x061d,0x06a9,0x06af,0x06b3,0x06bb,0x06be,0x06f6,0x064a,0x06b1, 0x06aa, 0x06fd, 0x06fe] ++
-			   [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]
+               [0x06f0 .. 0x06f9] ++ [0x061f,0x06D4]
     allTrans = words $
       "K a b - t C j H - d " ++  -- 0626 - 062f
       "Z r z s X S Z- t- z- e G "   ++  -- 0630 - 063a
       "f q - L m n - W "    ++  -- 0641 - 0648
       "T! B T p T' " ++  -- 067a,067b,067d,067e,067f
       "B' - - Y' J' - c c' - - d! - d' D - D' " ++  -- 0680 - 068f
-      "R - F' - k' g G' t' h' e' y c! k A M " ++  -- 0699, 0918, 06a6, 061d, 06a9,06af,06b3,06bb,06be,06f6,06cc,06b1 
+      "R - F' - k' g G' t' h' e' y c! k A M " ++  -- 0699, 0918, 06a6, 061d, 06a9,06af,06b3,06bb,06be,06f6,06cc,06b1
       "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 " ++ "? ."
 
-    
+
 
 transArabic :: Transliteration
 transArabic = mkTransliteration "Arabic" allTrans allCodes where
@@ -175,8 +175,8 @@ transArabic = mkTransliteration "Arabic" allTrans allCodes where
     "W  r  z  s  C S  D  T  Z  c  G "                 ++  -- 0630 - 063a
     "   f  q  k  l  m  n  h  w  y. y a. u. i. a  u "  ++  -- 0641 - 064f
     "i  v2 o  a: V+ V- i: a+ "                        ++  -- 0650 - 0657
-    "A*  q?"                                              -- 0671 (used by AED) 
-  allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++ 
+    "A*  q?"                                              -- 0671 (used by AED)
+  allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++
              [0x0641..0x064f] ++ [0x0650..0x0657] ++ [0x0671,0x061f]
 
 
@@ -193,16 +193,16 @@ transPersian = (mkTransliteration "Persian/Farsi" allTrans allCodes)
     "   V  A: A? w? A- y? A  b  t. t  t-  j  H  K  d " ++  -- 0621 - 062f
     "W  r  z  s  C  S  D  T  Z  c  G "                 ++  -- 0630 - 063a
     "   f  q  -  l  m  n  h  v  -  y. a. u. i. a  u "   ++  -- 0640 - 064f
-    "i  v2 o  a: V+ V- i: a+ " ++                          -- 0650 - 0657 
+    "i  v2 o  a: V+ V- i: a+ " ++                          -- 0650 - 0657
     "p  c^ J  k  g  y q? Z0"
-  allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++ 
-             [0x0641..0x064f] ++ [0x0650..0x0657] ++ 
+  allCodes = [0x0621..0x062f] ++ [0x0630..0x063a] ++
+             [0x0641..0x064f] ++ [0x0650..0x0657] ++
              [0x067e,0x0686,0x0698,0x06a9,0x06af,0x06cc,0x061f,0x200c]
 
 transNepali :: Transliteration
 transNepali = mkTransliteration "Nepali" allTrans allCodes where
   allTrans = words $
-    "z+  z= " ++ 
+    "z+  z= " ++
     "-  V  M  h: -  H  A  i: I: f  F  Z  -  -  -  e: " ++
     "E: -  -  O  W  k  K  g  G  n: C  c  j  J  Y  q  " ++
     "Q  x  X  N  t  T  d  D  n  -  p  P  b  B  m  y  " ++
@@ -241,7 +241,7 @@ transGreek = mkTransliteration "modern Greek" allTrans allCodes where
     "i= A  B  G  D  E  Z  H  V  I  K  L  M  N  X  O  " ++
     "P  R  -  S  T  Y  F  C  Q  W  I- Y- a' e' h' i' " ++
     "y= a  b  g  d  e  z  h  v  i  k  l  m  n  x  o  " ++
-    "p  r  s* s  t  y  f  c  q  w  i- y- o' y' w' -  "    
+    "p  r  s* s  t  y  f  c  q  w  i- y- o' y' w' -  "
   allCodes = [0x0380 .. 0x03cf]
 
 transAncientGreek :: Transliteration
@@ -261,32 +261,32 @@ transAncientGreek = mkTransliteration "ancient Greek" allTrans allCodes where
    "y)  y(  y)` y(` y)' y(' y)~ y(~ -   Y(  -   Y(` -   Y(' -   Y(~ " ++
    "w)  w(  w)` w(` w)' w(' w)~ w(~ W)  W(  W)` W(` W)' W(' W)~ W(~ " ++
    "a`  a'  e`  e'  h`  h'  i`  i'  o`  o'  y`  y'  w`  w'  -   -   " ++
-   "a|) a|( a|)` a|(` a|)' a|(' a|)~ a|(~ - - - - - - - - " ++ -- 1f80-  
-   "h|) h|( h|)` h|(` h|)' h|(' h|)~ h|(~ - - - - - - - - " ++ -- 1f90-  
-   "w|) w|( w|)` w|(` w|)' w|(' w|)~ w|(~ - - - - - - - - " ++ -- 1fa0-  
+   "a|) a|( a|)` a|(` a|)' a|(' a|)~ a|(~ - - - - - - - - " ++ -- 1f80-
+   "h|) h|( h|)` h|(` h|)' h|(' h|)~ h|(~ - - - - - - - - " ++ -- 1f90-
+   "w|) w|( w|)` w|(` w|)' w|(' w|)~ w|(~ - - - - - - - - " ++ -- 1fa0-
    "a.  a_  a|` a|  a|'  -  a~ a|~ - - - - - - - - " ++ -- 1fb0-
    "-  -  h|` h|  h|'  -  h~ h|~ - - - - - - - - " ++ -- 1fc0-
    "i. i_ i=` i=' -    -  i~ i=~ - - - - - - - - " ++ -- 1fd0-
-   "y. y_ y=` y=' r)   r( y~ y=~ - - - - - - - - " ++ -- 1fe0-   
+   "y. y_ y=` y=' r)   r( y~ y=~ - - - - - - - - " ++ -- 1fe0-
    "-  -  w|` w|  w|'  -  w~ w|~ - - - - - - - - " ++ -- 1ff0-
    -- HL, Private Use Area Code Points (New Athena Unicode, Cardo, ALPHABETUM, Antioch)
    -- see: http://apagreekkeys.org/technicalDetails.html
    --      GreekKeys Support by Donald Mastronarde
-   "- - - - - - - - - e. o. R) Y) Y)` Y)' Y)~ "    ++ -- e1a0-e1af  
+   "- - - - - - - - - e. o. R) Y) Y)` Y)' Y)~ "    ++ -- e1a0-e1af
    "e~ e)~ e(~ e_ e_' e_` e_) e_( e_)` e_(` e_)' e_(' E)~ E(~ E_ E. " ++ -- e1b0-e1bf
    "o~ o)~ o(~ o_ o_' o_` o_) o_( o_)` o_(` o_)' o_(' O)~ O(~ O_ O. " ++ -- e1c0-e1cf
-   "a_` - a_~ a_)` a_(` a_)~ a_(~ - a.` a.) a.)` a.(' a.(` - - - "    ++ -- eaf0-eaff  
-   "a_' - - - a_) a_( - a_)' - a_(' a.' a.( a.)' - - - "              ++ -- eb00-eb0f  
+   "a_` - a_~ a_)` a_(` a_)~ a_(~ - a.` a.) a.)` a.(' a.(` - - - "    ++ -- eaf0-eaff
+   "a_' - - - a_) a_( - a_)' - a_(' a.' a.( a.)' - - - "              ++ -- eb00-eb0f
    "e_)~ e_(~ - - - - - e_~ - - - - - - - - "                         ++ -- eb20-eb2f
-   "- - - - - - i_~ - i_` i_' - - i_) i_)' i_( i_(' "                 ++ -- eb30-eb3f   
+   "- - - - - - i_~ - i_` i_' - - i_) i_)' i_( i_(' "                 ++ -- eb30-eb3f
    "i.' i.) i.)' i.( i.` i.)` - i.(' i.(` - - - - - - - "             ++ -- eb40-eb4f
    "- - - - i_)` i_(` - i_)~ i_(~ - o_~ o_)~ o_(~ - - - "             ++ -- eb50-eb5f
    "y_` " ++ -- eb6f
    "y_~ y_)` - - - y_(` - y_)~ y_(~ - y_' - - y_) y_( y_)' "  ++         -- eb70-eb7f
    "y_(' y.' y.( y.` y.) y.)' - - y.)` y.(' y.(` - - - - - "             -- eb80-eb8f
- allCodes =  -- [0x00B0 .. 0x00Bf] 
-             [0x0380 .. 0x03cf] ++ [0x1f00 .. 0x1fff] 
-          ++ [0xe1a0 .. 0xe1af] 
+ allCodes =  -- [0x00B0 .. 0x00Bf]
+             [0x0380 .. 0x03cf] ++ [0x1f00 .. 0x1fff]
+          ++ [0xe1a0 .. 0xe1af]
           ++ [0xe1b0 .. 0xe1bf]
           ++ [0xe1c0 .. 0xe1cf]
           ++ [0xeaf0 .. 0xeaff]
@@ -297,36 +297,34 @@ transAncientGreek = mkTransliteration "ancient Greek" allTrans allCodes where
           ++ [0xeb50 .. 0xeb5f] ++ [0xeb6f]
           ++ [0xeb70 .. 0xeb7f]
           ++ [0xeb80 .. 0xeb8f]
- 
-transAmharic :: Transliteration
+
+transAmharic :: Transliteration
 transAmharic = mkTransliteration "Amharic" allTrans allCodes where
- 
-allTrans = words $
-    
-  	" h.  h-  h'  h(  h)  h  h?  h*  l.  l-  l'  l(  l)  l  l?  l*  "++
-	" H.  H-  H'  H(  H)  H  H?  H*  m.  m-  m'  m(  m)  m  m?  m*  "++
-	" s.  s-  s'  s(  s)  s  s?  s*  r.  r-  r'  r(  r)  r  r?  r* "++
-	" -   -   -   -   -  -   -  -   x.  x-  x'  x(  x)  x  x?   x* "++
-	" q.  q-  q'  q(  q)  q  q?  q*  -   -   -   -   -   -  -   - "++
-	" -   -   -   -   -   -  -   -   -   -   -   -   -   -  -   - "++
-	" b.  b-  b'  b(  b)  b  b?  b*  v.  v-  v'  v(  v)  v  v?  v* "++
-	" t.  t-  t'  t(  t)  t  t?  t*  c.  c-  c'  c(  c)  c  c?  c* "++
-	" X.  X-  X'  X(  X)  X  X?  -   -   -   -   X*  -   -  -   - "++
-	" n.  n-  n'  n(  n)  n  n?  n*  N.  N-  N'  N(  N)  N  N?  N* "++
-	" a   u   i   A   E   e  o   e*  k.  k-  k'  k(  k)  k  k?  - "++
-	" -   -   -   k*  -   -  -   -   -   -   -   -   -   -  -   - "++
-	" -   -   -   -   -   -  -   -   w.  w-  w'  w(  w)  w  w?  w* "++
-	" -   -   -   -   -   -  -   -   z.  z-  z'  z(  z)  z  z?  z* "++
-	" Z.  Z-  Z'  Z(  Z)  Z  Z?  Z*  y.  y-  y'  y(  y)  y  y?  y* "++
-	" d.  d-  d'  d(  d)  d  d?  d*  -   -   -   -   -   -  -   - "++
-	" j.  j-  j'  j(  j)  j  j?  j*  g.  g-  g'  g(  g)  g  g?  - "++
-	" -   -   -   g*  -   -  -   -   -   -   -   -   -   -  -   - "++
-	" T.  T-  T'  T(  T)  T  T?  T*  C.  C-  C'  C(  C)  C  C?  C* "++
-	" P.  P-  P'  P(  P)  P  P?  P*  S.  S-  S'  S(  S)  S  S?  S* "++
-	" -   -   -   -   -   -  -   -   f.  f-  f'  f(  f)  f  f?  f*"++
-	" p.  p-  p'  p(  p)  p  p?  p*" 	
-allCodes = [0x1200..0x1357]
- 
+  allTrans = words $
+    " h.  h-  h'  h(  h)  h  h?  h*  l.  l-  l'  l(  l)  l  l?  l*  "++
+    " H.  H-  H'  H(  H)  H  H?  H*  m.  m-  m'  m(  m)  m  m?  m*  "++
+    " s.  s-  s'  s(  s)  s  s?  s*  r.  r-  r'  r(  r)  r  r?  r* "++
+    " -   -   -   -   -  -   -  -   x.  x-  x'  x(  x)  x  x?   x* "++
+    " q.  q-  q'  q(  q)  q  q?  q*  -   -   -   -   -   -  -   - "++
+    " -   -   -   -   -   -  -   -   -   -   -   -   -   -  -   - "++
+    " b.  b-  b'  b(  b)  b  b?  b*  v.  v-  v'  v(  v)  v  v?  v* "++
+    " t.  t-  t'  t(  t)  t  t?  t*  c.  c-  c'  c(  c)  c  c?  c* "++
+    " X.  X-  X'  X(  X)  X  X?  -   -   -   -   X*  -   -  -   - "++
+    " n.  n-  n'  n(  n)  n  n?  n*  N.  N-  N'  N(  N)  N  N?  N* "++
+    " a   u   i   A   E   e  o   e*  k.  k-  k'  k(  k)  k  k?  - "++
+    " -   -   -   k*  -   -  -   -   -   -   -   -   -   -  -   - "++
+    " -   -   -   -   -   -  -   -   w.  w-  w'  w(  w)  w  w?  w* "++
+    " -   -   -   -   -   -  -   -   z.  z-  z'  z(  z)  z  z?  z* "++
+    " Z.  Z-  Z'  Z(  Z)  Z  Z?  Z*  y.  y-  y'  y(  y)  y  y?  y* "++
+    " d.  d-  d'  d(  d)  d  d?  d*  -   -   -   -   -   -  -   - "++
+    " j.  j-  j'  j(  j)  j  j?  j*  g.  g-  g'  g(  g)  g  g?  - "++
+    " -   -   -   g*  -   -  -   -   -   -   -   -   -   -  -   - "++
+    " T.  T-  T'  T(  T)  T  T?  T*  C.  C-  C'  C(  C)  C  C?  C* "++
+    " P.  P-  P'  P(  P)  P  P?  P*  S.  S-  S'  S(  S)  S  S?  S* "++
+    " -   -   -   -   -   -  -   -   f.  f-  f'  f(  f)  f  f?  f*"++
+    " p.  p-  p'  p(  p)  p  p?  p*"
+  allCodes = [0x1200..0x1357]
+
 -- by Prasad 31/5/2013
 transSanskrit :: Transliteration
 transSanskrit = (mkTransliteration "Sanskrit" allTrans allCodes) {invisible_chars = ["a"]} where

src/compiler/SimpleEditor/Syntax.hs

@@ -23,10 +23,10 @@ data Fun      = Fun      { fname:: FunId, ftype:: Type }
 
 data Concrete = Concrete { langcode:: Id,
                            opens:: [ModId],
-		           params:: [Param],
-		           lincats:: [Lincat],
-		           opers:: [Oper],
-		           lins:: [Lin] }
+                           params:: [Param],
+                           lincats:: [Lincat],
+                           opers:: [Oper],
+                           lins:: [Lin] }
                 deriving Show
 
 data Param  = Param  {pname:: Id, prhs:: String}              deriving Show

src/programs/gf-main.hs

@@ -1,3 +1,5 @@
+module Main where
+
 import qualified GF
 
 main = GF.main

src/runtime/c/INSTALL

@@ -14,6 +14,9 @@ For Linux users
 
 You will need the packages: autoconf, automake, libtool, make
 
+- On Ubuntu: $ apt-get install autotools-dev
+- On Fedora: $ dnf install autoconf automake libtool
+
 The compilation steps are:
 
 $ autoreconf -i
@@ -28,7 +31,7 @@ For Mac OSX users
 The following is what I did to make it work on MacOSX 10.8:
 
 - Install XCode and XCode command line tools
-- Install Homebrew: http://mxcl.github.com/homebrew/
+- Install Homebrew: https://brew.sh
 
 $ brew install automake autoconf libtool
 $ glibtoolize
@@ -41,7 +44,7 @@ $ make install
 For Windows users
 -----------------
 
-- Install MinGW: http://www.mingw.org/. From the installer you need
+- Install MinGW: http://www.mingw-w64.org/. From the installer you need
   to select at least the following packages:
      - Mingw-developer-toolkit
      - Mingw-base
@@ -49,7 +52,7 @@ For Windows users
   After the installation, don't forget to fix the fstab file. See here:
      http://www.mingw.org/wiki/Getting_Started
 
-- From the MSYS shell (c:/MinGW/msys/1.0/msys.bat) go to the directory 
+- From the MSYS shell (c:/MinGW/msys/1.0/msys.bat) go to the directory
   which contains the INSTALL file and do:
 
   $ autoreconf -i

src/runtime/c/configure.ac

@@ -30,6 +30,7 @@ AM_PROG_CC_C_O
  -Wall\
  -Wextra\
  -Wno-missing-field-initializers\
+ -fpermissive\
  -Wno-unused-parameter\
  -Wno-unused-value"
 fi]
@@ -43,8 +44,10 @@ case "$target_cpu" in
 		   [Define if lightning is targeting the sparc architecture]) ;;
 	powerpc) cpu=ppc; AC_DEFINE(LIGHTNING_PPC, 1,
 		   [Define if lightning is targeting the powerpc architecture]) ;;
-    arm*)    cpu=arm; AC_DEFINE(LIGHTNING_ARM, 1,
+	arm*)    cpu=arm; AC_DEFINE(LIGHTNING_ARM, 1,
 		   [Define if lightning is targeting the arm architecture]) ;;
+	aarch64) cpu=aarch64; AC_DEFINE(LIGHTNING_AARCH64, 1,
+		   [Define if lightning is targeting the aarch64 architecture]) ;;
 	*)	 AC_MSG_ERROR([cpu $target_cpu not supported])	;;
 esac
 

src/runtime/c/gu/fun.h

@@ -12,17 +12,17 @@ typedef void (*GuFn2)(GuFn* clo, void* arg1, void* arg2);
 
 static inline void
 gu_apply0(GuFn* fn) {
-	(*fn)(fn);
+	((GuFn0)(*fn))(fn);
 }
 
 static inline void
 gu_apply1(GuFn* fn, void* arg1) {
-	(*fn)(fn, arg1);
+	((GuFn1)(*fn))(fn, arg1);
 }
 
 static inline void
 gu_apply2(GuFn* fn, void* arg1, void* arg2) {
-	(*fn)(fn, arg1, arg2);
+	((GuFn2)(*fn))(fn, arg1, arg2);
 }
 
 #define gu_apply(fn_, ...)			\

src/runtime/c/install.sh

@@ -0,0 +1,3 @@
+bash setup.sh configure
+bash setup.sh build
+bash setup.sh install

src/runtime/c/pgf/jit.c

@@ -4,10 +4,49 @@
 #include <pgf/data.h>
 #include <pgf/reasoner.h>
 #include <pgf/reader.h>
+
+#if !defined(__aarch64__)
 #include "lightning.h"
+#endif
 
 //#define PGF_JIT_DEBUG
 
+#if defined(EMSCRIPTEN) || defined(__aarch64__)
+
+PGF_INTERNAL PgfJitState*
+pgf_new_jit(PgfReader* rdr)
+{
+	return NULL;
+}
+
+PGF_INTERNAL PgfEvalGates*
+pgf_jit_gates(PgfReader* rdr)
+{
+    PgfEvalGates* gates = gu_new(PgfEvalGates, rdr->opool);
+    memset(gates, 0, sizeof(*gates));
+    return gates;
+}
+
+PGF_INTERNAL void
+pgf_jit_predicate(PgfReader* rdr, PgfAbstr* abstr,
+                  PgfAbsCat* abscat)
+{
+	size_t n_funs = pgf_read_len(rdr);
+	gu_return_on_exn(rdr->err, );
+
+	for (size_t i = 0; i < n_funs; i++) {
+		gu_in_f64be(rdr->in, rdr->err);  // ignore
+		gu_return_on_exn(rdr->err,);
+		pgf_read_cid(rdr, rdr->tmp_pool);
+	}
+}
+
+PGF_INTERNAL void
+pgf_jit_done(PgfReader* rdr, PgfAbstr* abstr)
+{
+}
+
+#else
 
 struct PgfJitState {
 	jit_state jit;
@@ -1329,3 +1368,5 @@ pgf_jit_done(PgfReader* rdr, PgfAbstr* abstr)
 	
 	jit_flush_code(rdr->jit_state->buf, jit_get_ip().ptr);
 }
+
+#endif

src/runtime/c/pgf/lightning/aarch64/asm.h

@@ -0,0 +1 @@
+// DUMMY

src/runtime/c/pgf/lightning/aarch64/core.h

@@ -0,0 +1 @@
+

src/runtime/c/pgf/lightning/aarch64/fp.h

@@ -0,0 +1 @@
+

src/runtime/c/pgf/lightning/aarch64/funcs.h

@@ -0,0 +1 @@
+// DUMMY

src/runtime/c/pgf/parser.c

@@ -44,6 +44,7 @@ typedef struct {
     PgfParseState *before;
     PgfParseState *after;
     PgfToken prefix;
+    bool prefix_bind;
     PgfTokenProb* tp;
     PgfExprEnum en;    // enumeration for the generated trees/tokens
 #ifdef PGF_COUNTS_DEBUG
@@ -1009,6 +1010,7 @@ pgf_new_parse_state(PgfParsing* ps, size_t start_offset,
 	                    (start_offset == end_offset);
 	state->start_offset = start_offset;
 	state->end_offset = end_offset;
+
 	state->viterbi_prob = viterbi_prob;
  	state->lexicon_idx =
 		gu_new_buf(PgfLexiconIdxEntry, ps->pool);
@@ -1381,20 +1383,30 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
 		break;
 	}
 	case PGF_SYMBOL_BIND: {
-		if (ps->before->start_offset == ps->before->end_offset &&
-		    ps->before->needs_bind) {
-			PgfParseState* state =
-				pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD,
-				                    item->inside_prob+item->conts->outside_prob);
-			if (state != NULL) {
-				pgf_item_advance(item, ps->pool);
-                gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
-			} else {
-				pgf_item_free(ps, item);
-			}
-		} else {
-			pgf_item_free(ps, item);
-		}
+        if (!ps->prefix_bind && ps->prefix != NULL && *(ps->sentence + ps->before->end_offset) == 0) {
+            PgfProductionApply* papp = gu_variant_data(item->prod);
+
+			ps->tp = gu_new(PgfTokenProb, ps->out_pool);
+			ps->tp->tok  = NULL;
+			ps->tp->cat  = item->conts->ccat->cnccat->abscat->name;
+			ps->tp->fun  = papp->fun->absfun->name;
+			ps->tp->prob = item->inside_prob + item->conts->outside_prob;
+        } else {
+            if (ps->before->start_offset == ps->before->end_offset &&
+                ps->before->needs_bind) {
+                PgfParseState* state =
+                    pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD,
+                                        item->inside_prob+item->conts->outside_prob);
+                if (state != NULL) {
+                    pgf_item_advance(item, ps->pool);
+                    gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
+                } else {
+                    pgf_item_free(ps, item);
+                }
+            } else {
+                pgf_item_free(ps, item);
+            }
+        }
 		break;
 	}
 	case PGF_SYMBOL_SOFT_BIND:
@@ -2337,7 +2349,8 @@ pgf_parser_completions_next(GuEnum* self, void* to, GuPool* pool)
 
 PGF_API GuEnum*
 pgf_complete(PgfConcr* concr, PgfType* type, GuString sentence, 
-             GuString prefix, GuExn *err, GuPool* pool)
+             GuString prefix, bool prefix_bind,
+             GuExn *err, GuPool* pool)
 {
 	if (concr->sequences == NULL ||
 	    concr->cnccats == NULL) {
@@ -2377,6 +2390,7 @@ pgf_complete(PgfConcr* concr, PgfType* type, GuString sentence,
 	// Now begin enumerating the completions
 	ps->en.next = pgf_parser_completions_next;
 	ps->prefix  = prefix;
+    ps->prefix_bind = prefix_bind;
 	ps->tp      = NULL;
 	return &ps->en;
 }

src/runtime/c/pgf/pgf.h

@@ -251,7 +251,8 @@ typedef struct {
 
 PGF_API_DECL GuEnum*
 pgf_complete(PgfConcr* concr, PgfType* type, GuString string, 
-             GuString prefix, GuExn* err, GuPool* pool);
+             GuString prefix, bool prefix_bind,
+             GuExn* err, GuPool* pool);
 
 typedef struct PgfLiteralCallback PgfLiteralCallback;
 

src/runtime/haskell-bind/PGF2.hsc

@@ -1026,7 +1026,10 @@ complete lang (Type ctype _) sent pfx =
           touchConcr lang
           return []
         else do
-          tok <- peekUtf8CString =<< (#peek PgfTokenProb, tok) cmpEntry
+          p_tok <- (#peek PgfTokenProb, tok) cmpEntry
+          tok <- if p_tok == nullPtr
+                   then return "&+"
+                   else peekUtf8CString p_tok
           cat <- peekUtf8CString =<< (#peek PgfTokenProb, cat) cmpEntry
           fun <- peekUtf8CString =<< (#peek PgfTokenProb, fun) cmpEntry
           prob <- (#peek PgfTokenProb, prob) cmpEntry