GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into tp_nix_flake

Browse Source
This commit is contained in:
Andreas Källberg
2025-08-02 21:13:11 +02:00
parent 9c5d2d3d15 af09351b66
commit 8cb65432c7
42 changed files with 306 additions and 210 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
.github/workflows/build-all-versions.yml vendored
View File

@@ -12,6 +12,7 @@ jobs:
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }} name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
strategy: strategy:
fail-fast: false
matrix: matrix:
os: [ubuntu-latest, macos-latest, windows-latest] os: [ubuntu-latest, macos-latest, windows-latest]
cabal: ["latest"] cabal: ["latest"]
@@ -19,21 +20,26 @@ jobs:
- "8.6.5" - "8.6.5"
- "8.8.3" - "8.8.3"
- "8.10.7" - "8.10.7"
- "9.6.7"
exclude: exclude:
- os: macos-latest - os: macos-latest
ghc: 8.8.3 ghc: 8.8.3
- os: macos-latest - os: macos-latest
ghc: 8.6.5 ghc: 8.6.5
- os: macos-latest
ghc: 8.10.7
- os: windows-latest - os: windows-latest
ghc: 8.8.3 ghc: 8.8.3
- os: windows-latest - os: windows-latest
ghc: 8.6.5 ghc: 8.6.5
- os: windows-latest
ghc: 8.10.7
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
- uses: haskell/actions/setup@v2 - uses: haskell-actions/setup@v2
id: setup-haskell-cabal id: setup-haskell-cabal
name: Setup Haskell name: Setup Haskell
with: with:
@@ -44,7 +50,7 @@ jobs:
run: | run: |
cabal freeze cabal freeze
- uses: actions/cache@v1 - uses: actions/cache@v4
name: Cache ~/.cabal/store name: Cache ~/.cabal/store
with: with:
path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
@@ -64,16 +70,16 @@ jobs:
name: stack / ghc ${{ matrix.ghc }} name: stack / ghc ${{ matrix.ghc }}
runs-on: ${{ matrix.ghc == '7.10.3' && 'ubuntu-20.04' || 'ubuntu-latest' }} runs-on: ${{ matrix.ghc == '7.10.3' && 'ubuntu-20.04' || 'ubuntu-latest' }}
strategy: strategy:
fail-fast: false
matrix: matrix:
stack: ["latest"] stack: ["latest"]
ghc: ["7.10.3","8.0.2", "8.2.2", "8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2"] ghc: ["8.4.4", "8.6.5", "8.8.4", "8.10.7", "9.0.2", "9.6.7"]
# ghc: ["8.8.3"]
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
- uses: haskell/actions/setup@v2 - uses: haskell-actions/setup@v2
name: Setup Haskell Stack name: Setup Haskell Stack
with: with:
ghc-version: ${{ matrix.ghc }} ghc-version: ${{ matrix.ghc }}
@@ -85,7 +91,7 @@ jobs:
- run: sed -i.bak 's/"C compiler link flags", "/&-no-pie /' /home/runner/.ghcup/ghc/7.10.3/lib/ghc-7.10.3/settings - 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' if: matrix.ghc == '7.10.3'
- uses: actions/cache@v1 - uses: actions/cache@v4
name: Cache ~/.stack name: Cache ~/.stack
with: with:
path: ~/.stack path: ~/.stack

20
.github/workflows/build-python-package.yml vendored
View File

@@ -18,7 +18,7 @@ jobs:
steps: steps:
- uses: actions/checkout@v1 - uses: actions/checkout@v1
- uses: actions/setup-python@v1 - uses: actions/setup-python@v5
name: Install Python name: Install Python
with: with:
python-version: '3.x' python-version: '3.x'
@@ -31,6 +31,7 @@ jobs:
if: startsWith(matrix.os, 'macos') if: startsWith(matrix.os, 'macos')
run: | run: |
brew install automake brew install automake
brew install libtool
- name: Build wheels on Linux - name: Build wheels on Linux
if: startsWith(matrix.os, 'macos') != true if: startsWith(matrix.os, 'macos') != true
@@ -42,12 +43,13 @@ jobs:
- name: Build wheels on OSX - name: Build wheels on OSX
if: startsWith(matrix.os, 'macos') if: startsWith(matrix.os, 'macos')
env: 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: | run: |
python -m cibuildwheel src/runtime/python --output-dir wheelhouse python -m cibuildwheel src/runtime/python --output-dir wheelhouse
- uses: actions/upload-artifact@v2 - uses: actions/upload-artifact@v4
with: with:
name: wheel-${{ matrix.os }}
path: ./wheelhouse path: ./wheelhouse
build_sdist: build_sdist:
@@ -59,13 +61,14 @@ jobs:
- uses: actions/setup-python@v2 - uses: actions/setup-python@v2
name: Install Python name: Install Python
with: with:
python-version: '3.x' python-version: '3.10'
- name: Build sdist - name: Build sdist
run: cd src/runtime/python && python setup.py sdist run: cd src/runtime/python && python setup.py sdist
- uses: actions/upload-artifact@v2 - uses: actions/upload-artifact@v4
with: with:
name: wheel-source
path: ./src/runtime/python/dist/*.tar.gz path: ./src/runtime/python/dist/*.tar.gz
upload_pypi: upload_pypi:
@@ -78,16 +81,17 @@ jobs:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- name: Set up Python - name: Set up Python
uses: actions/setup-python@v2 uses: actions/setup-python@v5
with: with:
python-version: '3.x' python-version: '3.x'
- name: Install twine - name: Install twine
run: pip install twine run: pip install twine
- uses: actions/download-artifact@v2 - uses: actions/download-artifact@v4.1.7
with: with:
name: artifact pattern: wheel-*
merge-multiple: true
path: ./dist path: ./dist
- name: Publish - name: Publish

75
doc/gf-editor-modes.md Normal file
View File

@@ -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)

81
doc/gf-editor-modes.t2t
View File

@@ -1,81 +0,0 @@
Editor modes & IDE integration for GF
We collect GF modes for various editors on this page. Contributions are
welcome!
==Emacs==
[gf.el https://github.com/GrammaticalFramework/gf-emacs-mode] by Johan
Bockgård provides syntax highlighting and automatic indentation and
lets you run the GF Shell in an emacs buffer. See installation
instructions inside.
==Atom==
[language-gf https://atom.io/packages/language-gf], by John J. Camilleri
==Visual Studio Code==
- [Grammatical Framework Language Server https://marketplace.visualstudio.com/items?itemName=anka-213.gf-vscode] by Andreas Källberg.
This provides syntax highlighting and a client for the Grammatical Framework language server. Follow the installation instructions in the link.
- [Grammatical Framework https://marketplace.visualstudio.com/items?itemName=GrammaticalFramework.gf-vscode] is a simpler extension
without any external dependencies which provides only syntax highlighting.
==Eclipse==
[GF Eclipse Plugin https://github.com/GrammaticalFramework/gf-eclipse-plugin/], by John J. Camilleri
==Gedit==
By John J. Camilleri
Copy the file below to
``~/.local/share/gtksourceview-3.0/language-specs/gf.lang`` (under Ubuntu).
- [gf.lang ../src/tools/gf.lang]
Some helpful notes/links:
- The code is based heavily on the ``haskell.lang`` file which I found in
``/usr/share/gtksourceview-2.0/language-specs/haskell.lang``.
- Ruslan Osmanov recommends
[registering your file extension as its own MIME type http://osmanov-dev-notes.blogspot.com/2011/04/how-to-add-new-highlight-mode-in-gedit.html]
(see also [here https://help.ubuntu.com/community/AddingMimeTypes]),
however on my system the ``.gf`` extension was already registered
as a generic font (``application/x-tex-gf``) and I didn't want to risk
messing any of that up.
- This is a quick 5-minute job and might require some tweaking.
[The GtkSourceView language definition tutorial http://developer.gnome.org/gtksourceview/stable/lang-tutorial.html]
is the place to start looking.
- Contributions are welcome!
==Geany==
By John J. Camilleri
[Custom filetype http://www.geany.org/manual/dev/index.html#custom-filetypes]
config files for syntax highlighting in [Geany http://www.geany.org/].
For version 1.36 and above, copy one of the files below to
``/usr/share/geany/filedefs/filetypes.GF.conf`` (under Ubuntu).
If you're using a version older than 1.36, copy the file to ``/usr/share/geany/filetypes.GF.conf``.
You will need to manually create the file.
- [light-filetypes.GF.conf ../src/tools/light-filetypes.GF.conf]
- [dark-filetypes.GF.conf ../src/tools/dark-filetypes.GF.conf]
You will also need to edit the ``filetype_extensions.conf`` file and add the
following line somewhere:
```
GF=*.gf
```
==Vim==
[vim-gf https://github.com/gdetrez/vim-gf]

19
doc/tutorial/gf-tutorial.t2t
View File

@@ -1265,10 +1265,16 @@ Human eye may prefer to see a visualization: ``visualize_tree = vt``:
> parse "this delicious cheese is very Italian" | visualize_tree > parse "this delicious cheese is very Italian" | visualize_tree
``` ```
The tree is generated in postscript (``.ps``) file. The ``-view`` option is used for 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 telling what command to use to view the file.
on Mac OS X. On Ubuntu Linux, one can write
This works on Mac OS X:
``` ```
> parse "this delicious cheese is very Italian" | visualize_tree -view="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 ; 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 Parallel to the abstract syntax, extensions can
be built for concrete syntaxes: be built for concrete syntaxes:
``` ```

2
download/index-3.11.md
View File

@@ -139,6 +139,8 @@ stack install
For more info on working with the GF source code, see the For more info on working with the GF source code, see the
[GF Developers Guide](../doc/gf-developers.html). [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 ## Installing the Python bindings from PyPI
The Python library is available on PyPI as `pgf`, so it can be installed using: The Python library is available on PyPI as `pgf`, so it can be installed using:

2
gf-book/examples/chapter2/FoodIta.gf
View File

@@ -2,7 +2,7 @@ concrete FoodIta of Food = {
lincat lincat
Comment, Item, Kind, Quality = Str ; Comment, Item, Kind, Quality = Str ;
lin lin
Pred item quality = item ++ "è" ++ quality ; Pred item quality = item ++ "è" ++ quality ;
This kind = "questo" ++ kind ; This kind = "questo" ++ kind ;
That kind = "quel" ++ kind ; That kind = "quel" ++ kind ;
Mod quality kind = kind ++ quality ; Mod quality kind = kind ++ quality ;

2
gf-book/examples/chapter3/ResIta.gf
View File

@@ -32,5 +32,5 @@ resource ResIta = open Prelude in {
in in
adjective nero (ner+"a") (ner+"i") (ner+"e") ; adjective nero (ner+"a") (ner+"i") (ner+"e") ;
copula : Number => Str = copula : Number => Str =
table {Sg => "è" ; Pl => "sono"} ; table {Sg => "è" ; Pl => "sono"} ;
} }

12
gf-book/examples/chapter5/LexFoodsFin.gf
View File

@@ -8,13 +8,13 @@ instance LexFoodsFin of LexFoods =
cheese_N = mkN "juusto" ; cheese_N = mkN "juusto" ;
fish_N = mkN "kala" ; fish_N = mkN "kala" ;
fresh_A = mkA "tuore" ; fresh_A = mkA "tuore" ;
warm_A = mkA warm_A = mkA
(mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään" (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään"
"lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin" "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
) )
"lämpimämpi" "lämpimin" ; "lämpimämpi" "lämpimin" ;
italian_A = mkA "italialainen" ; italian_A = mkA "italialainen" ;
expensive_A = mkA "kallis" ; expensive_A = mkA "kallis" ;
delicious_A = mkA "herkullinen" ; delicious_A = mkA "herkullinen" ;
boring_A = mkA "tylsä" ; boring_A = mkA "tylsä" ;
} }

8
gf-book/examples/chapter5/LexFoodsGer.gf
View File

@@ -1,16 +1,16 @@
-- (c) 2009 Aarne Ranta under LGPL -- (c) 2009 Aarne Ranta under LGPL
instance LexFoodsGer of LexFoods = instance LexFoodsGer of LexFoods =
open SyntaxGer, ParadigmsGer in { open SyntaxGer, ParadigmsGer in {
oper oper
wine_N = mkN "Wein" ; wine_N = mkN "Wein" ;
pizza_N = mkN "Pizza" "Pizzen" feminine ; 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" ; fish_N = mkN "Fisch" ;
fresh_A = mkA "frisch" ; fresh_A = mkA "frisch" ;
warm_A = mkA "warm" "wärmer" "wärmste" ; warm_A = mkA "warm" "wärmer" "wärmste" ;
italian_A = mkA "italienisch" ; italian_A = mkA "italienisch" ;
expensive_A = mkA "teuer" ; expensive_A = mkA "teuer" ;
delicious_A = mkA "köstlich" ; delicious_A = mkA "köstlich" ;
boring_A = mkA "langweilig" ; boring_A = mkA "langweilig" ;
} }

6
gf-book/examples/chapter5/LexFoodsSwe.gf
View File

@@ -7,10 +7,10 @@ instance LexFoodsSwe of LexFoods =
pizza_N = mkN "pizza" ; pizza_N = mkN "pizza" ;
cheese_N = mkN "ost" ; cheese_N = mkN "ost" ;
fish_N = mkN "fisk" ; fish_N = mkN "fisk" ;
fresh_A = mkA "färsk" ; fresh_A = mkA "färsk" ;
warm_A = mkA "varm" ; warm_A = mkA "varm" ;
italian_A = mkA "italiensk" ; italian_A = mkA "italiensk" ;
expensive_A = mkA "dyr" ; expensive_A = mkA "dyr" ;
delicious_A = mkA "läcker" ; delicious_A = mkA "läcker" ;
boring_A = mkA "tråkig" ; boring_A = mkA "tråkig" ;
} }

2
gf-book/examples/chapter7/QueryFin.gf
View File

@@ -6,7 +6,7 @@ concrete QueryFin of Query = {
Odd = pred "pariton" ; Odd = pred "pariton" ;
Prime = pred "alkuluku" ; Prime = pred "alkuluku" ;
Number i = i.s ; Number i = i.s ;
Yes = "kyllä" ; Yes = "kyllä" ;
No = "ei" ; No = "ei" ;
oper oper
pred : Str -> Str -> Str = \f,x -> "onko" ++ x ++ f ; pred : Str -> Str -> Str = \f,x -> "onko" ++ x ++ f ;

6
gf-book/examples/chapter9/ResIta.gf
View File

@@ -43,10 +43,10 @@ oper
} ; } ;
auxVerb : Aux -> Verb = \a -> case a of { auxVerb : Aux -> Verb = \a -> case a of {
Avere => Avere =>
mkVerb "avere" "ho" "hai" "ha" "abbiamo" "avete" "hanno" "avuto" Avere ; mkVerb "avere" "ho" "hai" "ha" "abbiamo" "avete" "hanno" "avuto" Avere ;
Essere => Essere =>
mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere mkVerb "essere" "sono" "sei" "è" "siamo" "siete" "sono" "stato" Essere
} ; } ;
agrPart : Verb -> Agr -> ClitAgr -> Str = \v,a,c -> case v.aux of { agrPart : Verb -> Agr -> ClitAgr -> Str = \v,a,c -> case v.aux of {

22
gf.cabal
View File

@@ -73,12 +73,12 @@ library
build-depends: build-depends:
-- GHC 8.0.2 to GHC 8.10.4 -- GHC 8.0.2 to GHC 8.10.4
array >= 0.5.1 && < 0.6, array >= 0.5.1 && < 0.6,
base >= 4.9.1 && < 4.18, base >= 4.9.1 && < 4.22,
bytestring >= 0.10.8 && < 0.12, bytestring >= 0.10.8 && < 0.12,
containers >= 0.5.7 && < 0.7, containers >= 0.5.7 && < 0.7,
exceptions >= 0.8.3 && < 0.11, exceptions >= 0.8.3 && < 0.11,
ghc-prim >= 0.5.0 && < 0.9.0, ghc-prim >= 0.5.0 && <= 0.10.0,
mtl >= 2.2.1 && < 2.3, mtl >= 2.2.1 && <= 2.3.1,
pretty >= 1.1.3 && < 1.2, pretty >= 1.1.3 && < 1.2,
random >= 1.1 && < 1.3, random >= 1.1 && < 1.3,
utf8-string >= 1.0.1.1 && < 1.1 utf8-string >= 1.0.1.1 && < 1.1
@@ -155,10 +155,10 @@ library
directory >= 1.3.0 && < 1.4, directory >= 1.3.0 && < 1.4,
filepath >= 1.4.1 && < 1.5, filepath >= 1.4.1 && < 1.5,
haskeline >= 0.7.3 && < 0.9, haskeline >= 0.7.3 && < 0.9,
json >= 0.9.1 && < 0.11, json >= 0.9.1 && <= 0.11,
parallel >= 3.2.1.1 && < 3.3, parallel >= 3.2.1.1 && < 3.3,
process >= 1.4.3 && < 1.7, process >= 1.4.3 && < 1.7,
time >= 1.6.0 && < 1.10 time >= 1.6.0 && <= 1.12.2
hs-source-dirs: src/compiler hs-source-dirs: src/compiler
exposed-modules: exposed-modules:
@@ -346,8 +346,14 @@ library
Win32 >= 2.3.1.1 && < 2.7 Win32 >= 2.3.1.1 && < 2.7
else else
build-depends: build-depends:
terminfo >=0.4.0 && < 0.5, terminfo >=0.4.0 && < 0.5
unix >= 2.7.2 && < 2.8
if impl(ghc >= 9.6.6)
build-depends: unix >= 2.8
else
build-depends: unix >= 2.7.2 && < 2.8
if impl(ghc>=8.2) if impl(ghc>=8.2)
ghc-options: -fhide-source-paths ghc-options: -fhide-source-paths
@@ -392,7 +398,7 @@ test-suite gf-tests
main-is: run.hs main-is: run.hs
hs-source-dirs: testsuite hs-source-dirs: testsuite
build-depends: build-depends:
base >= 4.9.1 && < 4.16, base >= 4.9.1,
Cabal >= 1.8, Cabal >= 1.8,
directory >= 1.3.0 && < 1.4, directory >= 1.3.0 && < 1.4,
filepath >= 1.4.1 && < 1.5, filepath >= 1.4.1 && < 1.5,

17
index.html
View File

@@ -87,11 +87,6 @@
<h3>Contribute</h3> <h3>Contribute</h3>
<ul class="mb-2"> <ul class="mb-2">
<li> <li>
<a href="https://web.libera.chat/?channels=#gf">
<i class="fas fa-hashtag"></i>
IRC
</a>
/
<a href="https://discord.gg/EvfUsjzmaz"> <a href="https://discord.gg/EvfUsjzmaz">
<i class="fab fa-discord"></i> <i class="fab fa-discord"></i>
Discord Discord
@@ -232,14 +227,10 @@ least one, it may help you to get a first idea of what GF is.
</p> </p>
<p> <p>
We run the IRC channel <strong><code>#gf</code></strong> on the Libera network, where you are welcome to look for help with small questions or just start a general discussion. 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.
You can <a href="https://web.libera.chat/?channels=#gf">open a web chat</a>
or <a href="https://www.grammaticalframework.org/irc/?C=M;O=D">browse the channel logs</a>.
</p>
<p>
There is also a <a href="https://discord.gg/EvfUsjzmaz">GF server on Discord</a>.
</p> </p>
<p> <p>
For bug reports and feature requests, please create an issue in the 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-core/issues">GF Core</a> or
@@ -254,6 +245,10 @@ least one, it may help you to get a first idea of what GF is.
<div class="col-md-6"> <div class="col-md-6">
<h2>News</h2> <h2>News</h2>
<dl class="row"> <dl class="row">
<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> <dt class="col-sm-3 text-center text-nowrap">2023-01-24</dt>
<dd class="col-sm-9"> <dd class="col-sm-9">
<a href="//school.grammaticalframework.org/2023/">8th GF Summer School</a>, in Tampere, Finland, 14 &ndash; 25 August 2023. <a href="//school.grammaticalframework.org/2023/">8th GF Summer School</a>, in Tampere, Finland, 14 &ndash; 25 August 2023.

9
src/compiler/GF/Command/Commands.hs
View File

@@ -218,9 +218,9 @@ pgfCommands = Map.fromList [
exec = getEnv $ \ opts arg (Env pgf mos) -> do exec = getEnv $ \ opts arg (Env pgf mos) -> do
let pgfr = optRestricted opts pgf let pgfr = optRestricted opts pgf
let dp = valIntOpts "depth" 4 opts let dp = valIntOpts "depth" 4 opts
let ts = case mexp (toExprs arg) of let ts = case toExprs arg of
Just ex -> generateFromDepth pgfr ex (Just dp) [] -> generateAllDepth pgfr (optType pgf opts) (Just dp)
Nothing -> generateAllDepth pgfr (optType pgf opts) (Just dp) es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]
returnFromExprs $ take (optNumInf opts) ts returnFromExprs $ take (optNumInf opts) ts
}), }),
("i", emptyCommandInfo { ("i", emptyCommandInfo {
@@ -428,7 +428,8 @@ pgfCommands = Map.fromList [
"are type checking and semantic computation." "are type checking and semantic computation."
], ],
examples = [ 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) -> exec = getEnv $ \ opts arg (Env pgf mos) ->
returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg, returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,

23
src/compiler/GF/Command/TreeOperations.hs
View File

@@ -5,6 +5,8 @@ module GF.Command.TreeOperations (
) where ) where
import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions) import PGF(Expr,PGF,CId,compute,mkApp,unApp,unapply,unMeta,exprSize,exprFunctions)
import PGF.Data(Expr(EApp,EFun))
import PGF.TypeCheck(inferExpr)
import Data.List import Data.List
type TreeOp = [Expr] -> [Expr] type TreeOp = [Expr] -> [Expr]
@@ -16,15 +18,17 @@ allTreeOps :: PGF -> [(String,(String,Either TreeOp (CId -> TreeOp)))]
allTreeOps pgf = [ allTreeOps pgf = [
("compute",("compute by using semantic definitions (def)", ("compute",("compute by using semantic definitions (def)",
Left $ map (compute pgf))), 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", ("largest",("sort trees from largest to smallest, in number of nodes",
Left $ largest)), Left $ largest)),
("nub",("remove duplicate trees", ("nub\t",("remove duplicate trees",
Left $ nub)), Left $ nub)),
("smallest",("sort trees from smallest to largest, in number of nodes", ("smallest",("sort trees from smallest to largest, in number of nodes",
Left $ smallest)), Left $ smallest)),
("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest", ("subtrees",("return all fully applied subtrees (stopping at abstractions), by default sorted from the largest",
Left $ concatMap subtrees)), 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])) Left $ \es -> [mkApp f [] | e <- es, f <- exprFunctions e]))
] ]
@@ -48,3 +52,18 @@ subtrees :: Expr -> [Expr]
subtrees t = t : case unApp t of subtrees t = t : case unApp t of
Just (f,ts) -> concatMap subtrees ts Just (f,ts) -> concatMap subtrees ts
_ -> [] -- don't go under abstractions _ -> [] -- 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)

18
src/compiler/GF/Compile/Compute/Concrete.hs
View File

@@ -172,11 +172,11 @@ value env t0 =
ImplArg t -> (VImplArg.) # value env t ImplArg t -> (VImplArg.) # value env t
Table p res -> liftM2 VTblType # value env p <# value env res Table p res -> liftM2 VTblType # value env p <# value env res
RecType rs -> do lovs <- mapPairsM (value env) rs 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) t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
FV ts -> ((vfv .) # sequence) # mapM (value env) ts FV ts -> ((vfv .) # sequence) # mapM (value env) ts
R as -> do lovs <- mapPairsM (value env.snd) as 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 T i cs -> valueTable env i cs
V ty ts -> do pvs <- paramValues env ty V ty ts -> do pvs <- paramValues env ty
((VV ty pvs .) . sequence) # mapM (value env) ts ((VV ty pvs .) . sequence) # mapM (value env) ts
@@ -376,10 +376,10 @@ valueTable env i cs =
where where
dynamic cs' ty _ = cases cs' # value env ty 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 where
keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $ 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 wild = case i of TWild _ -> True; _ -> False
@@ -392,7 +392,7 @@ valueTable env i cs =
convert' cs' ((pty,vs),pvs) = convert' cs' ((pty,vs),pvs) =
do sts <- mapM (matchPattern cs') vs do sts <- mapM (matchPattern cs') vs
return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env) 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 valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
pvs <- linPattVars p' pvs <- linPattVars p'
@@ -430,19 +430,19 @@ apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
apply' env t [] = value env t apply' env t [] = value env t
apply' env t vs = apply' env t vs =
case t of 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 $ Q x@(m,f) | m==cPredef -> return $
let constr = --trace ("predef "++show x) . let constr = --trace ("predef "++show x) .
VApp x VApp x
in \ svs -> maybe constr id (Map.lookup f predefs) in \ svs -> maybe constr id (Map.lookup f predefs)
$ map ($svs) vs $ map ($ svs) vs
| otherwise -> do r <- resource env x | 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 App t1 t2 -> apply' env t1 . (:vs) =<< value env t2
_ -> do fv <- value env t _ -> 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 :: GLocation -> Value -> [Value] -> Value
vapply loc v [] = v vapply loc v [] = v

4
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -201,11 +201,11 @@ instance Fail.MonadFail CnvMonad where
fail = bug fail = bug
instance Applicative CnvMonad where instance Applicative CnvMonad where
pure = return pure a = CM (\gr c s -> c a s)
(<*>) = ap (<*>) = ap
instance Monad CnvMonad where 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) CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)
instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where

4
src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
View File

@@ -644,7 +644,7 @@ data TcResult a
newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a} newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}
instance Monad TcM where 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 f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of
TcOk x ms msgs -> unTcM (g x) ms msgs TcOk x ms msgs -> unTcM (g x) ms msgs
TcFail msgs -> TcFail msgs) TcFail msgs -> TcFail msgs)
@@ -659,7 +659,7 @@ instance Fail.MonadFail TcM where
instance Applicative TcM where instance Applicative TcM where
pure = return pure x = TcM (\ms msgs -> TcOk x ms msgs)
(<*>) = ap (<*>) = ap
instance Functor TcM where instance Functor TcM where

18
src/compiler/GF/CompileInParallel.hs
View File

@@ -61,11 +61,11 @@ parallelBatchCompile jobs opts rootfiles0 =
usesPresent (_,paths) = take 1 libs==["present"] usesPresent (_,paths) = take 1 libs==["present"]
where where
libs = [p|path<-paths, libs = [p | path<-paths,
let (d,p0) = splitAt n path let (d,p0) = splitAt n path
p = dropSlash p0, p = dropSlash p0,
d==lib_dir,p `elem` all_modes] d==lib_dir, p `elem` all_modes]
n = length lib_dir n = length lib_dir
all_modes = ["alltenses","present"] all_modes = ["alltenses","present"]
@@ -175,7 +175,7 @@ batchCompile1 lib_dir (opts,filepaths) =
" from being compiled." " from being compiled."
else return (maximum ts,(cnc,gr)) 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) 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 instance Functor m => Functor (CollectOutput m) where
fmap f (CO m) = CO (fmap (fmap f) m) fmap f (CO m) = CO (fmap (fmap f) m)
instance (Functor m,Monad m) => Applicative (CollectOutput m) where instance (Functor m,Monad m) => Applicative (CollectOutput m) where
pure = return pure x = CO (return (return (),x))
(<*>) = ap (<*>) = ap
instance Monad m => Monad (CollectOutput m) where instance Monad m => Monad (CollectOutput m) where
return x = CO (return (return (),x)) return = pure
CO m >>= f = CO $ do (o1,x) <- m CO m >>= f = CO $ do (o1,x) <- m
let CO m2 = f x let CO m2 = f x
(o2,y) <- m2 (o2,y) <- m2

4
src/compiler/GF/Data/BacktrackM.hs
View File

@@ -64,11 +64,11 @@ finalStates :: BacktrackM s () -> s -> [s]
finalStates bm = map fst . runBM bm finalStates bm = map fst . runBM bm
instance Applicative (BacktrackM s) where instance Applicative (BacktrackM s) where
pure = return pure a = BM (\c s b -> c a s b)
(<*>) = ap (<*>) = ap
instance Monad (BacktrackM s) where 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) 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

4
src/compiler/GF/Data/ErrM.hs
View File

@@ -34,7 +34,7 @@ fromErr :: a -> Err a -> a
fromErr a = err (const a) id fromErr a = err (const a) id
instance Monad Err where instance Monad Err where
return = Ok return = pure
Ok a >>= f = f a Ok a >>= f = f a
Bad s >>= f = Bad s Bad s >>= f = Bad s
@@ -54,7 +54,7 @@ instance Functor Err where
fmap f (Bad s) = Bad s fmap f (Bad s) = Bad s
instance Applicative Err where instance Applicative Err where
pure = return pure = Ok
(<*>) = ap (<*>) = ap
-- | added by KJ -- | added by KJ

4
src/compiler/GF/Grammar/Lexer.x
View File

@@ -283,11 +283,11 @@ instance Functor P where
fmap = liftA fmap = liftA
instance Applicative P where instance Applicative P where
pure = return pure a = a `seq` (P $ \s -> POk s a)
(<*>) = ap (<*>) = ap
instance Monad P where instance Monad P where
return a = a `seq` (P $ \s -> POk s a) return = pure
(P m) >>= k = P $ \ s -> case m s of (P m) >>= k = P $ \ s -> case m s of
POk s a -> unP (k a) s POk s a -> unP (k a) s
PFailed posn err -> PFailed posn err PFailed posn err -> PFailed posn err

4
src/compiler/GF/Infra/CheckM.hs
View File

@@ -48,7 +48,7 @@ newtype Check a
instance Functor Check where fmap = liftM instance Functor Check where fmap = liftM
instance Monad Check where instance Monad Check where
return x = Check $ \{-ctxt-} ws -> (ws,Success x) return = pure
f >>= g = Check $ \{-ctxt-} ws -> f >>= g = Check $ \{-ctxt-} ws ->
case unCheck f {-ctxt-} ws of case unCheck f {-ctxt-} ws of
(ws,Success x) -> unCheck (g x) {-ctxt-} ws (ws,Success x) -> unCheck (g x) {-ctxt-} ws
@@ -58,7 +58,7 @@ instance Fail.MonadFail Check where
fail = raise fail = raise
instance Applicative Check where instance Applicative Check where
pure = return pure x = Check $ \{-ctxt-} ws -> (ws,Success x)
(<*>) = ap (<*>) = ap
instance ErrorMonad Check where instance ErrorMonad Check where

4
src/compiler/GF/Infra/SIO.hs
View File

@@ -52,11 +52,11 @@ newtype SIO a = SIO {unS::PutStr->IO a}
instance Functor SIO where fmap = liftM instance Functor SIO where fmap = liftM
instance Applicative SIO where instance Applicative SIO where
pure = return pure x = SIO (const (pure x))
(<*>) = ap (<*>) = ap
instance Monad SIO where instance Monad SIO where
return x = SIO (const (return x)) return = pure
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
instance Fail.MonadFail SIO where instance Fail.MonadFail SIO where

1
src/compiler/GF/Interactive.hs
View File

@@ -32,6 +32,7 @@ import qualified Text.ParserCombinators.ReadP as RP
import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory) import System.Directory({-getCurrentDirectory,-}getAppUserDataDirectory)
import Control.Exception(SomeException,fromException,evaluate,try) import Control.Exception(SomeException,fromException,evaluate,try)
import Control.Monad.State hiding (void) import Control.Monad.State hiding (void)
import Control.Monad (join, when, (<=<))
import qualified GF.System.Signal as IO(runInterruptibly) import qualified GF.System.Signal as IO(runInterruptibly)
#ifdef SERVER_MODE #ifdef SERVER_MODE
import GF.Server(server) import GF.Server(server)

1
src/runtime/c/configure.ac
View File

@@ -30,6 +30,7 @@ AM_PROG_CC_C_O
-Wall\ -Wall\
-Wextra\ -Wextra\
-Wno-missing-field-initializers\ -Wno-missing-field-initializers\
-fpermissive\
-Wno-unused-parameter\ -Wno-unused-parameter\
-Wno-unused-value" -Wno-unused-value"
fi] fi]

2
src/runtime/haskell/Data/Binary/Builder.hs
View File

@@ -114,7 +114,7 @@ instance Semigroup Builder where
instance Monoid Builder where instance Monoid Builder where
mempty = empty mempty = empty
{-# INLINE mempty #-} {-# INLINE mempty #-}
mappend = append mappend = (<>)
{-# INLINE mappend #-} {-# INLINE mappend #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------

4
src/runtime/haskell/Data/Binary/Get.hs
View File

@@ -127,11 +127,11 @@ instance Functor Get where
{-# INLINE fmap #-} {-# INLINE fmap #-}
instance Applicative Get where instance Applicative Get where
pure = return pure a = Get (\s -> (a, s))
(<*>) = ap (<*>) = ap
instance Monad Get where instance Monad Get where
return a = Get (\s -> (a, s)) return = pure
{-# INLINE return #-} {-# INLINE return #-}
m >>= k = Get (\s -> case unGet m s of m >>= k = Get (\s -> case unGet m s of

14
src/runtime/haskell/Data/Binary/Put.hs
View File

@@ -77,15 +77,20 @@ instance Functor PutM where
{-# INLINE fmap #-} {-# INLINE fmap #-}
instance Applicative PutM where instance Applicative PutM where
pure = return pure a = Put $ PairS a mempty
m <*> k = Put $ m <*> k = Put $
let PairS f w = unPut m let PairS f w = unPut m
PairS x w' = unPut k PairS x w' = unPut k
in PairS (f x) (w `mappend` w') in PairS (f x) (w `mappend` w')
m *> k = Put $
let PairS _ w = unPut m
PairS b w' = unPut k
in PairS b (w `mappend` w')
{-# INLINE (*>) #-}
-- Standard Writer monad, with aggressive inlining -- Standard Writer monad, with aggressive inlining
instance Monad PutM where instance Monad PutM where
return a = Put $ PairS a mempty return = pure
{-# INLINE return #-} {-# INLINE return #-}
m >>= k = Put $ m >>= k = Put $
@@ -94,10 +99,7 @@ instance Monad PutM where
in PairS b (w `mappend` w') in PairS b (w `mappend` w')
{-# INLINE (>>=) #-} {-# INLINE (>>=) #-}
m >> k = Put $ (>>) = (*>)
let PairS _ w = unPut m
PairS b w' = unPut k
in PairS b (w `mappend` w')
{-# INLINE (>>) #-} {-# INLINE (>>) #-}
tell :: Builder -> Put tell :: Builder -> Put

19
src/runtime/haskell/PGF/Expr.hs
View File

@@ -17,7 +17,8 @@ module PGF.Expr(Tree, BindType(..), Expr(..), Literal(..), Patt(..), Equation(..
MetaId, MetaId,
-- helpers -- helpers
pMeta,pArg,pLit,freshName,ppMeta,ppLit,ppParens pMeta,pArg,pLit,freshName,ppMeta,ppLit,ppParens,
freshBoundVars
) where ) where
import PGF.CId import PGF.CId
@@ -235,10 +236,11 @@ pLit = liftM LStr (RP.readS_to_P reads)
ppExpr :: Int -> [CId] -> Expr -> PP.Doc ppExpr :: Int -> [CId] -> Expr -> PP.Doc
ppExpr d scope (EAbs b x e) = let (bs,xs,e1) = getVars [] [] (EAbs b x e) ppExpr d scope (EAbs b x e) = let (bs,xs,e1) = getVars [] [] (EAbs b x e)
xs' = freshBoundVars scope xs
in ppParens (d > 1) (PP.char '\\' PP.<> in ppParens (d > 1) (PP.char '\\' PP.<>
PP.hsep (PP.punctuate PP.comma (reverse (List.zipWith ppBind bs xs))) PP.<+> PP.hsep (PP.punctuate PP.comma (reverse (List.zipWith ppBind bs xs'))) PP.<+>
PP.text "->" PP.<+> PP.text "->" PP.<+>
ppExpr 1 (xs++scope) e1) ppExpr 1 (xs' ++ scope) e1)
where where
getVars bs xs (EAbs b x e) = getVars (b:bs) ((freshName x xs):xs) e getVars bs xs (EAbs b x e) = getVars (b:bs) ((freshName x xs):xs) e
getVars bs xs e = (bs,xs,e) getVars bs xs e = (bs,xs,e)
@@ -289,6 +291,15 @@ freshName x xs0 = loop 1 x
| elem y xs = loop (i+1) (mkCId (show x++show i)) | elem y xs = loop (i+1) (mkCId (show x++show i))
| otherwise = y | otherwise = y
-- refresh new vars xs in scope if needed. AR 2024-03-01
freshBoundVars :: [CId] -> [CId] -> [CId]
freshBoundVars scope xs = foldr fresh [] xs
where
fresh x xs' = mkCId (freshName (showCId x) xs') : xs'
freshName s xs' =
if elem (mkCId s) (xs' ++ scope)
then freshName (s ++ "'") xs'
else s
----------------------------------------------------- -----------------------------------------------------
-- Computation -- Computation
@@ -397,7 +408,7 @@ match sig f eqs as0 =
tryMatch (p ) (VMeta i envi vs ) env = VSusp i envi vs (\v -> tryMatch p v env) tryMatch (p ) (VMeta i envi vs ) env = VSusp i envi vs (\v -> tryMatch p v env)
tryMatch (p ) (VGen i vs ) env = VConst f as0 tryMatch (p ) (VGen i vs ) env = VConst f as0
tryMatch (p ) (VSusp i envi vs k) env = VSusp i envi vs (\v -> tryMatch p (k v) env) tryMatch (p ) (VSusp i envi vs k) env = VSusp i envi vs (\v -> tryMatch p (k v) env)
tryMatch (p ) v@(VConst _ _ ) env = VConst f as0 tryMatch (p ) v@(VConst _ _ ) env = match sig f eqs as0
tryMatch (PApp f1 ps1) (VApp f2 vs2 ) env | f1 == f2 = tryMatches eqs (ps1++ps) (vs2++as) res env tryMatch (PApp f1 ps1) (VApp f2 vs2 ) env | f1 == f2 = tryMatches eqs (ps1++ps) (vs2++as) res env
tryMatch (PLit l1 ) (VLit l2 ) env | l1 == l2 = tryMatches eqs ps as res env tryMatch (PLit l1 ) (VLit l2 ) env | l1 == l2 = tryMatches eqs ps as res env
tryMatch (PImplArg p ) (VImplArg v ) env = tryMatch p v env tryMatch (PImplArg p ) (VImplArg v ) env = tryMatch p v env

2
src/runtime/haskell/PGF/Linearize.hs
View File

@@ -81,7 +81,7 @@ linTree pgf cnc e = nub (map snd (lin Nothing 0 e [] [] e []))
where where
lp = lproductions cnc lp = lproductions cnc
lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin mb_cty n_fid e0 ys (x:xs) e es lin mb_cty n_fid e0 ys xs (EAbs _ x e) es = lin mb_cty n_fid e0 ys (freshBoundVars (xs ++ ys) [x] ++ xs) e es --fresh: AR 2024
lin mb_cty n_fid e0 ys xs (EApp e1 e2) es = lin mb_cty n_fid e0 ys xs e1 (e2:es) lin mb_cty n_fid e0 ys xs (EApp e1 e2) es = lin mb_cty n_fid e0 ys xs e1 (e2:es)
lin mb_cty n_fid e0 ys xs (EImplArg e) es = lin mb_cty n_fid e0 ys xs e es lin mb_cty n_fid e0 ys xs (EImplArg e) es = lin mb_cty n_fid e0 ys xs e es
lin mb_cty n_fid e0 ys xs (ETyped e _) es = lin mb_cty n_fid e0 ys xs e es lin mb_cty n_fid e0 ys xs (ETyped e _) es = lin mb_cty n_fid e0 ys xs e es

15
src/runtime/haskell/PGF/TypeCheck.hs
View File

@@ -94,11 +94,11 @@ class Selector s where
select :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType) select :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)
instance Applicative (TcM s) where instance Applicative (TcM s) where
pure = return pure x = TcM (\abstr k h -> k x)
(<*>) = ap (<*>) = ap
instance Monad (TcM s) where instance Monad (TcM s) where
return x = TcM (\abstr k h -> k x) return = pure
f >>= g = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h) f >>= g = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)
instance Selector s => Alternative (TcM s) where instance Selector s => Alternative (TcM s) where
@@ -147,9 +147,9 @@ typeGenerators scope cat = fmap normalize (liftM2 (++) x y)
where where
Scope gamma = scope Scope gamma = scope
y | cat == cidInt = return [(1.0,ELit (LInt 999), TTyp [] (DTyp [] cat []))] y | cat == cidInt = return [(0.1, ELit (LInt n), TTyp [] (DTyp [] cat [])) | n <- ints]
| cat == cidFloat = return [(1.0,ELit (LFlt 3.14), TTyp [] (DTyp [] cat []))] | cat == cidFloat = return [(0.1, ELit (LFlt d), TTyp [] (DTyp [] cat [])) | d <- floats]
| cat == cidString = return [(1.0,ELit (LStr "Foo"),TTyp [] (DTyp [] cat []))] | cat == cidString = return [(0.1, ELit (LStr s),TTyp [] (DTyp [] cat [])) | s <- strs]
| otherwise = TcM (\abstr k h ms -> | otherwise = TcM (\abstr k h ms ->
case Map.lookup cat (cats abstr) of case Map.lookup cat (cats abstr) of
Just (_,fns,_) -> unTcM (mapM helper fns) abstr k h ms Just (_,fns,_) -> unTcM (mapM helper fns) abstr k h ms
@@ -163,6 +163,11 @@ typeGenerators scope cat = fmap normalize (liftM2 (++) x y)
where where
s = sum [p | (p,_,_) <- gens] s = sum [p | (p,_,_) <- gens]
-- random elements of predefined types: many instead of one AR 2025-01-17
ints = [1, 2, 3, 14, 42, 123, 999, 2025, 1000000, 1234567890]
floats = [0.0, 1.0, 3.14, 0.999, 0.5772156649, 2.71828, 6.62607015, 19.3, 0.0001, 1.60934]
strs = words "A B X Y b c x y foo bar"
emptyMetaStore :: MetaStore s emptyMetaStore :: MetaStore s
emptyMetaStore = IntMap.empty emptyMetaStore = IntMap.empty

1
src/runtime/haskell/PGF/VisualizeTree.hs
View File

@@ -651,6 +651,7 @@ app macro arg = text "\\" <> text macro <> text "{" <> arg <> text "}"
latexDoc :: Doc -> Doc latexDoc :: Doc -> Doc
latexDoc body = latexDoc body =
vcat [text "\\documentclass{article}", vcat [text "\\documentclass{article}",
text "\\usepackage[a4paper,margin=0.5in,landscape]{geometry}",
text "\\usepackage[utf8]{inputenc}", text "\\usepackage[utf8]{inputenc}",
text "\\begin{document}", text "\\begin{document}",
body, body,

5
src/server/CGIUtils.hs
View File

@@ -34,8 +34,13 @@ stderrToFile :: FilePath -> IO ()
stderrToFile file = stderrToFile file =
do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode
(<>) = unionFileModes (<>) = unionFileModes
#if MIN_VERSION_unix(2,8,0)
flags = defaultFileFlags { append = True, creat = Just mode }
fileFd <- openFd file WriteOnly flags
#else
flags = defaultFileFlags { append = True } flags = defaultFileFlags { append = True }
fileFd <- openFd file WriteOnly (Just mode) flags fileFd <- openFd file WriteOnly (Just mode) flags
#endif
dupTo fileFd stdError dupTo fileFd stdError
return () return ()
#else #else

4
src/server/PGFService.hs
View File

@@ -448,7 +448,7 @@ pgfMain lcs@(alc,clc) path command tpgf@(t,pgf) =
"linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to "linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to
"random" -> o =<< join (doRandom pgf # cat % depth % limit % to) "random" -> o =<< join (doRandom pgf # cat % depth % limit % to)
"generate" -> o =<< doGenerate pgf # cat % depth % limit % to "generate" -> o =<< doGenerate pgf # cat % depth % limit % to
"translate" -> o =<< doTranslate pgf # input % cat %to%limit%treeopts "translate" -> o =<< doTranslate pgf # input % cat % to % limit % treeopts
"translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit "translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit
"lookupmorpho" -> o =<< doLookupMorpho pgf # from1 % textInput "lookupmorpho" -> o =<< doLookupMorpho pgf # from1 % textInput
"grammar" -> join $ doGrammar tpgf "grammar" -> join $ doGrammar tpgf
@@ -1092,7 +1092,7 @@ linearizeTabular pgf (tos,unlex) tree =
[(to,lintab to (transfer to tree)) | to <- langs] [(to,lintab to (transfer to tree)) | to <- langs]
where where
langs = if null tos then PGF.languages pgf else tos langs = if null tos then PGF.languages pgf else tos
lintab to t = [(p,map unlex (nub [t|(p',t)<-vs,p'==p]))|p<-ps] lintab to t = [(p,map unlex (nub [t | (p',t)<-vs,p'==p])) | p<-ps]
where where
ps = nub (map fst vs) ps = nub (map fst vs)
vs = concat (PGF.tabularLinearizes pgf to t) vs = concat (PGF.tabularLinearizes pgf to t)

1
src/www/robots.txt
View File

@@ -1,4 +1,5 @@
User-agent: * User-agent: *
Disallow: /grammars Disallow: /grammars
Disallow: /robust Disallow: /robust
Disallow: /wikidata
Disallow: /*.pgf Disallow: /*.pgf

20
stack-ghc9.6.7.yaml Normal file
View File

@@ -0,0 +1,20 @@
resolver: ghc-9.6.7
extra-deps:
- multipart-0.2.1@sha256:559c04eed5218a9673e9fb6a225287fee1aeb38a45a0caf91a2598967bd75659,1150
- cgi-3001.5.1.0@sha256:408e1f96ac6134965484c891b5fae35c7303fa841b09ce5baea52ddb078eef6b,3442
- alex-3.5.3.0@sha256:f6fde8ff59e7e38f9e95eca8f5154fb611c9789d1d9538aa9745c6c3cd9495b4,4502
- happy-2.1.6@sha256:1e963a137b650e766d1d0433e3404727fd64bebb850aa587702bfe199347f6da,5017
- happy-lib-2.1.6@sha256:552a82e07605d6f8017f513be59b43219425aa0e4be71f9dddb2527f5accbce4,6081
- httpd-shed-0.4.1.2@sha256:ab0fbd57acd32e0d5a5f7402dcc23192a1ffa142d86eeed051f59cf54a74ce38,1838
- json-0.11@sha256:3afa37628415992fe648da6f002672f5a0119aa5d49022bf928d10a927c29318,3250
- network-3.1.4.0@sha256:e152cdb03243afb52bbc740cfbe96905ca298a6f6342f0c47b3f2e227ff19def,5208
- network-bsd-2.8.1.0@sha256:cc7867f81c6eb3f1924bbb1029757af6e3b67a3c224c1faa329be3ea70ad729c,3780
- network-uri-2.6.4.2@sha256:6fffb57373962b5651a2db8b0af732098b3bf029a7ced76a9855615de2026588,3217
- parallel-3.2.2.0@sha256:9d7b34ac537940f67732eca31d48a43bd78fb65a91baebddf63bee4fc3813d81,1961
- random-1.2.1.3@sha256:117541ba0a177397a3333f94870f789ef050dca31b0688a19824b2bc401b8823,6237
- splitmix-0.1.3.1@sha256:d0002f3fb16a2cc5ba8afd47a6657726386edccfe8853d310e3479fe3b45201b,6552
- stringsearch-0.3.6.6@sha256:cd72bb03946006b18a6a374b7dc4a1c783a29df1889861604f95b1de1da98607,4258
- syb-0.7.2.4@sha256:936d5a92084ad9d88c5a9dd2e622deab57ce48ce85be93e6273b3f8eb64c12ca,3872
- th-compat-0.1.6@sha256:e83d97946f84fe492762ceb3b4753b4770c78b0b70e594078700baa91a5106c2,2885
- utf8-string-1.0.2@sha256:79416292186feeaf1f60e49ac5a1ffae9bf1b120e040a74bf0e81ca7f1d31d3f,1538

30
stack.yaml
View File

@@ -1,15 +1,23 @@
# This default stack file is a copy of stack-ghc8.10.7.yaml # This default stack file is a copy of stack-ghc9.6.7.yaml
# But committing a symlink can be problematic on Windows, so it's a real copy. # But committing a symlink can be problematic on Windows, so it's a real copy.
# See: https://github.com/GrammaticalFramework/gf-core/pull/106 # See: https://github.com/GrammaticalFramework/gf-core/pull/106
resolver: lts-18.27 # ghc 8.10.7 resolver: ghc-9.6.7
extra-deps: extra-deps:
- network-2.6.3.6 - multipart-0.2.1@sha256:559c04eed5218a9673e9fb6a225287fee1aeb38a45a0caf91a2598967bd75659,1150
- httpd-shed-0.4.0.3 - cgi-3001.5.1.0@sha256:408e1f96ac6134965484c891b5fae35c7303fa841b09ce5baea52ddb078eef6b,3442
- alex-3.5.3.0@sha256:f6fde8ff59e7e38f9e95eca8f5154fb611c9789d1d9538aa9745c6c3cd9495b4,4502
# flags: - happy-2.1.6@sha256:1e963a137b650e766d1d0433e3404727fd64bebb850aa587702bfe199347f6da,5017
# gf: - happy-lib-2.1.6@sha256:552a82e07605d6f8017f513be59b43219425aa0e4be71f9dddb2527f5accbce4,6081
# server: true - httpd-shed-0.4.1.2@sha256:ab0fbd57acd32e0d5a5f7402dcc23192a1ffa142d86eeed051f59cf54a74ce38,1838
# c-runtime: true - json-0.11@sha256:3afa37628415992fe648da6f002672f5a0119aa5d49022bf928d10a927c29318,3250
# extra-lib-dirs: - network-3.1.4.0@sha256:e152cdb03243afb52bbc740cfbe96905ca298a6f6342f0c47b3f2e227ff19def,5208
# - /usr/local/lib - network-bsd-2.8.1.0@sha256:cc7867f81c6eb3f1924bbb1029757af6e3b67a3c224c1faa329be3ea70ad729c,3780
- network-uri-2.6.4.2@sha256:6fffb57373962b5651a2db8b0af732098b3bf029a7ced76a9855615de2026588,3217
- parallel-3.2.2.0@sha256:9d7b34ac537940f67732eca31d48a43bd78fb65a91baebddf63bee4fc3813d81,1961
- random-1.2.1.3@sha256:117541ba0a177397a3333f94870f789ef050dca31b0688a19824b2bc401b8823,6237
- splitmix-0.1.3.1@sha256:d0002f3fb16a2cc5ba8afd47a6657726386edccfe8853d310e3479fe3b45201b,6552
- stringsearch-0.3.6.6@sha256:cd72bb03946006b18a6a374b7dc4a1c783a29df1889861604f95b1de1da98607,4258
- syb-0.7.2.4@sha256:936d5a92084ad9d88c5a9dd2e622deab57ce48ce85be93e6273b3f8eb64c12ca,3872
- th-compat-0.1.6@sha256:e83d97946f84fe492762ceb3b4753b4770c78b0b70e594078700baa91a5106c2,2885
- utf8-string-1.0.2@sha256:79416292186feeaf1f60e49ac5a1ffae9bf1b120e040a74bf0e81ca7f1d31d3f,1538

8
testsuite/canonical/grammars/LexFoodsFin.gf
View File

@@ -10,12 +10,12 @@ instance LexFoodsFin of LexFoods =
fish_N = mkN "kala" ; fish_N = mkN "kala" ;
fresh_A = mkA "tuore" ; fresh_A = mkA "tuore" ;
warm_A = mkA warm_A = mkA
(mkN "l<EFBFBD>mmin" "l<EFBFBD>mpim<EFBFBD>n" "l<EFBFBD>mmint<EFBFBD>" "l<EFBFBD>mpim<EFBFBD>n<EFBFBD>" "l<EFBFBD>mpim<EFBFBD><EFBFBD>n" (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään"
"l<EFBFBD>mpimin<EFBFBD>" "l<EFBFBD>mpimi<EFBFBD>" "l<EFBFBD>mpimien" "l<EFBFBD>mpimiss<EFBFBD>" "l<EFBFBD>mpimiin" "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
) )
"l<EFBFBD>mpim<EFBFBD>mpi" "l<EFBFBD>mpimin" ; "lämpimämpi" "lämpimin" ;
italian_A = mkA "italialainen" ; italian_A = mkA "italialainen" ;
expensive_A = mkA "kallis" ; expensive_A = mkA "kallis" ;
delicious_A = mkA "herkullinen" ; delicious_A = mkA "herkullinen" ;
boring_A = mkA "tyls<EFBFBD>" ; boring_A = mkA "tylsä" ;
} }

1
testsuite/run.hs
View File

@@ -66,6 +66,7 @@ expectedFailures =
[ "testsuite/runtime/parser/parser.gfs" -- Only parses `z` as `zero` and not also as e.g. `succ zero` as expected [ "testsuite/runtime/parser/parser.gfs" -- Only parses `z` as `zero` and not also as e.g. `succ zero` as expected
, "testsuite/runtime/linearize/brackets.gfs" -- Missing "cannot linearize in the end" , "testsuite/runtime/linearize/brackets.gfs" -- Missing "cannot linearize in the end"
, "testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs" -- Gives a different error than expected , "testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs" -- Gives a different error than expected
, "testsuite/runtime/eval/eval.gfs"
] ]
-- | Produce HTML document with test results -- | Produce HTML document with test results