forked from GitHub/gf-core
Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core into release-3.12
This commit is contained in:
18
.github/workflows/build-all-versions.yml
vendored
18
.github/workflows/build-all-versions.yml
vendored
@@ -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
|
||||||
|
|||||||
75
doc/gf-editor-modes.md
Normal file
75
doc/gf-editor-modes.md
Normal 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)
|
||||||
@@ -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]
|
|
||||||
@@ -46,7 +46,7 @@
|
|||||||
#TINY
|
#TINY
|
||||||
|
|
||||||
The command has one argument which is either function, expression or
|
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 the argument is a function then ?its type is printed out.
|
||||||
If it is a category then the category definition is printed.
|
If it is a category then the category definition is printed.
|
||||||
If a whole expression is given it prints the expression with refined
|
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
|
#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
|
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,
|
all metavariables in the tree. The generation can be biased by probabilities,
|
||||||
given in a file in the -probs flag.
|
given in a file in the -probs flag.
|
||||||
@@ -315,13 +315,14 @@ given in a file in the -probs flag.
|
|||||||
| ``-cat`` | generation category
|
| ``-cat`` | generation category
|
||||||
| ``-lang`` | uses only functions that have linearizations in all these languages
|
| ``-lang`` | uses only functions that have linearizations in all these languages
|
||||||
| ``-number`` | number of trees generated
|
| ``-number`` | number of trees generated
|
||||||
| ``-depth`` | the maximum generation depth
|
| ``-depth`` | the maximum generation depth (default: 5)
|
||||||
| ``-probs`` | file with biased probabilities (format 'f 0.4' one by line)
|
| ``-probs`` | file with biased probabilities (format 'f 0.4' one by line)
|
||||||
|
|
||||||
- Examples:
|
- Examples:
|
||||||
|
|
||||||
| ``gr`` | one tree in the startcat of the current grammar
|
| ``gr`` | one tree in the startcat of the current grammar
|
||||||
| ``gr -cat=NP -number=16`` | 16 trees in the category NP
|
| ``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 -lang=LangHin,LangTha -cat=Cl`` | Cl, both in LangHin and LangTha
|
||||||
| ``gr -probs=FILE`` | generate with bias
|
| ``gr -probs=FILE`` | generate with bias
|
||||||
| ``gr (AdjCN ? (UseN ?))`` | generate trees of form (AdjCN ? (UseN ?))
|
| ``gr (AdjCN ? (UseN ?))`` | generate trees of form (AdjCN ? (UseN ?))
|
||||||
@@ -338,8 +339,8 @@ given in a file in the -probs flag.
|
|||||||
|
|
||||||
#TINY
|
#TINY
|
||||||
|
|
||||||
Generates all trees of a given category. By default,
|
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 5, but this can be changed by a flag.
|
||||||
If a Tree argument is given, the command completes the Tree with values
|
If a Tree argument is given, the command completes the Tree with values
|
||||||
to all metavariables in the tree.
|
to all metavariables in the tree.
|
||||||
|
|
||||||
@@ -353,7 +354,7 @@ to all metavariables in the tree.
|
|||||||
|
|
||||||
- Examples:
|
- 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 -number=16`` | 16 trees in the category NP
|
||||||
| ``gt -cat=NP -depth=2`` | trees in the category NP to depth 2
|
| ``gt -cat=NP -depth=2`` | trees in the category NP to depth 2
|
||||||
| ``gt (AdjCN ? (UseN ?))`` | trees of form (AdjCN ? (UseN ?))
|
| ``gt (AdjCN ? (UseN ?))`` | trees of form (AdjCN ? (UseN ?))
|
||||||
@@ -582,7 +583,7 @@ trees where a function node is a metavariable.
|
|||||||
|
|
||||||
- Examples:
|
- Examples:
|
||||||
|
|
||||||
| ``l -lang=LangSwe,LangNor -chunks ? a b (? c d)`` |
|
| ``l -lang=LangSwe,LangNor -chunks ? a b (? c d)`` |
|
||||||
|
|
||||||
|
|
||||||
#NORMAL
|
#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.
|
The default start category can be overridden by the -cat flag.
|
||||||
See also the ps command for lexing and character encoding.
|
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
|
the parser. For example if -openclass="A,N,V" is given, the parser
|
||||||
will accept unknown adjectives, nouns and verbs with the resource grammar.
|
will accept unknown adjectives, nouns and verbs with the resource grammar.
|
||||||
|
|
||||||
|
|||||||
@@ -1188,7 +1188,7 @@ use ``generate_trees = gt``.
|
|||||||
this wine is fresh
|
this wine is fresh
|
||||||
this wine is warm
|
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:
|
set by using the ``depth`` flag:
|
||||||
```
|
```
|
||||||
> generate_trees -depth=2 | l
|
> generate_trees -depth=2 | l
|
||||||
@@ -1739,9 +1739,9 @@ A new module can **extend** an old one:
|
|||||||
Pizza : Kind ;
|
Pizza : Kind ;
|
||||||
}
|
}
|
||||||
```
|
```
|
||||||
Note that the extended grammar doesn't inherit the start
|
Note that the extended grammar doesn't inherit the start
|
||||||
category from the grammar it extends, so if you want to
|
category from the grammar it extends, so if you want to
|
||||||
generate sentences with this grammar, you'll have to either
|
generate sentences with this grammar, you'll have to either
|
||||||
add a startcat (e.g. ``flags startcat = Question ;``),
|
add a startcat (e.g. ``flags startcat = Question ;``),
|
||||||
or in the GF shell, specify the category to ``generate_random`` or ``geneate_trees``
|
or in the GF shell, specify the category to ``generate_random`` or ``geneate_trees``
|
||||||
(e.g. ``gr -cat=Comment`` or ``gt -cat=Question``).
|
(e.g. ``gr -cat=Comment`` or ``gt -cat=Question``).
|
||||||
@@ -3746,7 +3746,7 @@ However, type-incorrect commands are rejected by the typecheck:
|
|||||||
The parsing is successful but the type checking failed with error(s):
|
The parsing is successful but the type checking failed with error(s):
|
||||||
Couldn't match expected type Device light
|
Couldn't match expected type Device light
|
||||||
against the interred type Device fan
|
against the interred type Device fan
|
||||||
In the expression: DKindOne fan
|
In the expression: DKindOne fan
|
||||||
```
|
```
|
||||||
|
|
||||||
#NEW
|
#NEW
|
||||||
@@ -4184,7 +4184,7 @@ division of integers.
|
|||||||
```
|
```
|
||||||
abstract Calculator = {
|
abstract Calculator = {
|
||||||
flags startcat = Exp ;
|
flags startcat = Exp ;
|
||||||
|
|
||||||
cat Exp ;
|
cat Exp ;
|
||||||
|
|
||||||
fun
|
fun
|
||||||
|
|||||||
@@ -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 ;
|
||||||
|
|||||||
@@ -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"} ;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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ä" ;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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" ;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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" ;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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 ;
|
||||||
|
|||||||
@@ -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
22
gf.cabal
@@ -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.17,
|
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,
|
||||||
|
|||||||
@@ -22,6 +22,7 @@ import GF.Infra.SIO
|
|||||||
import GF.Command.Abstract
|
import GF.Command.Abstract
|
||||||
import GF.Command.CommandInfo
|
import GF.Command.CommandInfo
|
||||||
import GF.Command.CommonCommands
|
import GF.Command.CommonCommands
|
||||||
|
import qualified GF.Command.CommonCommands as Common
|
||||||
import GF.Text.Clitics
|
import GF.Text.Clitics
|
||||||
import GF.Quiz
|
import GF.Quiz
|
||||||
|
|
||||||
@@ -166,14 +167,15 @@ pgfCommands = Map.fromList [
|
|||||||
synopsis = "generate random trees in the current abstract syntax",
|
synopsis = "generate random trees in the current abstract syntax",
|
||||||
syntax = "gr [-cat=CAT] [-number=INT]",
|
syntax = "gr [-cat=CAT] [-number=INT]",
|
||||||
examples = [
|
examples = [
|
||||||
mkEx "gr -- one tree in the startcat of the current grammar",
|
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 -number=16 -- 16 trees in the category NP",
|
||||||
mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",
|
mkEx "gr -cat=NP -depth=2 -- one tree in the category NP, up to depth 2",
|
||||||
mkEx "gr -probs=FILE -- generate with bias",
|
mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",
|
||||||
mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"
|
mkEx "gr -probs=FILE -- generate with bias",
|
||||||
|
mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"
|
||||||
],
|
],
|
||||||
explanation = unlines [
|
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",
|
"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,",
|
"all metavariables in the tree. The generation can be biased by probabilities,",
|
||||||
"given in a file in the -probs flag."
|
"given in a file in the -probs flag."
|
||||||
@@ -182,13 +184,13 @@ pgfCommands = Map.fromList [
|
|||||||
("cat","generation category"),
|
("cat","generation category"),
|
||||||
("lang","uses only functions that have linearizations in all these languages"),
|
("lang","uses only functions that have linearizations in all these languages"),
|
||||||
("number","number of trees generated"),
|
("number","number of trees generated"),
|
||||||
("depth","the maximum generation depth"),
|
("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
|
||||||
("probs", "file with biased probabilities (format 'f 0.4' one by line)")
|
("probs", "file with biased probabilities (format 'f 0.4' one by line)")
|
||||||
],
|
],
|
||||||
exec = getEnv $ \ opts arg (Env pgf mos) -> do
|
exec = getEnv $ \ opts arg (Env pgf mos) -> do
|
||||||
pgf <- optProbs opts (optRestricted opts pgf)
|
pgf <- optProbs opts (optRestricted opts pgf)
|
||||||
gen <- newStdGen
|
gen <- newStdGen
|
||||||
let dp = valIntOpts "depth" 4 opts
|
let dp = valIntOpts "depth" Common.default_depth opts
|
||||||
let ts = case mexp (toExprs arg) of
|
let ts = case mexp (toExprs arg) of
|
||||||
Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
|
Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
|
||||||
Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp)
|
Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp)
|
||||||
@@ -199,25 +201,25 @@ pgfCommands = Map.fromList [
|
|||||||
synopsis = "generates a list of trees, by default exhaustive",
|
synopsis = "generates a list of trees, by default exhaustive",
|
||||||
explanation = unlines [
|
explanation = unlines [
|
||||||
"Generates all trees of a given category. By default, ",
|
"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",
|
"If a Tree argument is given, the command completes the Tree with values",
|
||||||
"to all metavariables in the tree."
|
"to all metavariables in the tree."
|
||||||
],
|
],
|
||||||
flags = [
|
flags = [
|
||||||
("cat","the generation category"),
|
("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"),
|
("lang","excludes functions that have no linearization in this language"),
|
||||||
("number","the number of trees generated")
|
("number","the number of trees generated")
|
||||||
],
|
],
|
||||||
examples = [
|
examples = [
|
||||||
mkEx "gt -- all trees in the startcat, to depth 4",
|
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 -number=16 -- 16 trees in the category NP",
|
||||||
mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",
|
mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",
|
||||||
mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"
|
mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"
|
||||||
],
|
],
|
||||||
exec = getEnv $ \ opts arg (Env pgf mos) -> do
|
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" Common.default_depth opts
|
||||||
let ts = case toExprs arg of
|
let ts = case toExprs arg of
|
||||||
[] -> generateAllDepth pgfr (optType pgf opts) (Just dp)
|
[] -> generateAllDepth pgfr (optType pgf opts) (Just dp)
|
||||||
es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]
|
es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]
|
||||||
@@ -428,7 +430,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,
|
||||||
@@ -546,7 +549,7 @@ pgfCommands = Map.fromList [
|
|||||||
"which is processed by dot (graphviz) and displayed by the program indicated",
|
"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",
|
"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).",
|
"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
|
exec = getEnv $ \ opts arg (Env pgf mos) -> do
|
||||||
let absname = abstractName pgf
|
let absname = abstractName pgf
|
||||||
@@ -759,7 +762,7 @@ pgfCommands = Map.fromList [
|
|||||||
[] -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
|
[] -> [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]
|
open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
|
||||||
where
|
where
|
||||||
dp = valIntOpts "depth" 4 opts
|
dp = valIntOpts "depth" Common.default_depth opts
|
||||||
|
|
||||||
fromParse opts = foldr (joinPiped . fromParse1 opts) void
|
fromParse opts = foldr (joinPiped . fromParse1 opts) void
|
||||||
|
|
||||||
@@ -799,9 +802,9 @@ pgfCommands = Map.fromList [
|
|||||||
_ | isOpt "tabtreebank" opts ->
|
_ | isOpt "tabtreebank" opts ->
|
||||||
return $ concat $ intersperse "\t" $ (showExpr [] t) :
|
return $ concat $ intersperse "\t" $ (showExpr [] t) :
|
||||||
[s | lang <- optLangs pgf opts, s <- linear pgf opts lang 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]
|
_ -> [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]
|
[(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts]
|
||||||
|
|
||||||
linear :: PGF -> [Option] -> CId -> Expr -> [String]
|
linear :: PGF -> [Option] -> CId -> Expr -> [String]
|
||||||
@@ -1005,13 +1008,13 @@ viewLatex view name grphs = do
|
|||||||
restrictedSystem $ "pdflatex " ++ texfile
|
restrictedSystem $ "pdflatex " ++ texfile
|
||||||
restrictedSystem $ view ++ " " ++ pdffile
|
restrictedSystem $ view ++ " " ++ pdffile
|
||||||
return void
|
return void
|
||||||
|
|
||||||
---- copied from VisualizeTree ; not sure about proper place AR Nov 2015
|
---- copied from VisualizeTree ; not sure about proper place AR Nov 2015
|
||||||
latexDoc :: [String] -> String
|
latexDoc :: [String] -> String
|
||||||
latexDoc body = unlines $
|
latexDoc body = unlines $
|
||||||
"\\batchmode"
|
"\\batchmode"
|
||||||
: "\\documentclass{article}"
|
: "\\documentclass{article}"
|
||||||
: "\\usepackage[utf8]{inputenc}"
|
: "\\usepackage[utf8]{inputenc}"
|
||||||
: "\\begin{document}"
|
: "\\begin{document}"
|
||||||
: spaces body
|
: spaces body
|
||||||
++ ["\\end{document}"]
|
++ ["\\end{document}"]
|
||||||
|
|||||||
@@ -19,6 +19,12 @@ import Data.Char (isSpace)
|
|||||||
|
|
||||||
import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
|
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
|
extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased
|
||||||
|
|
||||||
commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)
|
commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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]
|
||||||
|
|||||||
@@ -12,17 +12,17 @@ typedef void (*GuFn2)(GuFn* clo, void* arg1, void* arg2);
|
|||||||
|
|
||||||
static inline void
|
static inline void
|
||||||
gu_apply0(GuFn* fn) {
|
gu_apply0(GuFn* fn) {
|
||||||
(*fn)(fn);
|
((GuFn0)(*fn))(fn);
|
||||||
}
|
}
|
||||||
|
|
||||||
static inline void
|
static inline void
|
||||||
gu_apply1(GuFn* fn, void* arg1) {
|
gu_apply1(GuFn* fn, void* arg1) {
|
||||||
(*fn)(fn, arg1);
|
((GuFn1)(*fn))(fn, arg1);
|
||||||
}
|
}
|
||||||
|
|
||||||
static inline void
|
static inline void
|
||||||
gu_apply2(GuFn* fn, void* arg1, void* arg2) {
|
gu_apply2(GuFn* fn, void* arg1, void* arg2) {
|
||||||
(*fn)(fn, arg1, arg2);
|
((GuFn2)(*fn))(fn, arg1, arg2);
|
||||||
}
|
}
|
||||||
|
|
||||||
#define gu_apply(fn_, ...) \
|
#define gu_apply(fn_, ...) \
|
||||||
|
|||||||
@@ -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 #-}
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -408,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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -571,6 +571,8 @@ limit, depth :: CGI (Maybe Int)
|
|||||||
limit = readInput "limit"
|
limit = readInput "limit"
|
||||||
depth = readInput "depth"
|
depth = readInput "depth"
|
||||||
|
|
||||||
|
default_depth_server = 4
|
||||||
|
|
||||||
start :: CGI Int
|
start :: CGI Int
|
||||||
start = maybe 0 id # readInput "start"
|
start = maybe 0 id # readInput "start"
|
||||||
|
|
||||||
@@ -781,7 +783,7 @@ doRandom pgf mcat mdepth mlimit to =
|
|||||||
| tree <- limit trees]
|
| tree <- limit trees]
|
||||||
where cat = fromMaybe (PGF.startCat pgf) mcat
|
where cat = fromMaybe (PGF.startCat pgf) mcat
|
||||||
limit = take (fromMaybe 1 mlimit)
|
limit = take (fromMaybe 1 mlimit)
|
||||||
depth = fromMaybe 4 mdepth
|
depth = fromMaybe default_depth_server mdepth
|
||||||
|
|
||||||
doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue
|
doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue
|
||||||
doGenerate pgf mcat mdepth mlimit tos =
|
doGenerate pgf mcat mdepth mlimit tos =
|
||||||
@@ -794,7 +796,7 @@ doGenerate pgf mcat mdepth mlimit tos =
|
|||||||
trees = PGF.generateAllDepth pgf cat (Just depth)
|
trees = PGF.generateAllDepth pgf cat (Just depth)
|
||||||
cat = fromMaybe (PGF.startCat pgf) mcat
|
cat = fromMaybe (PGF.startCat pgf) mcat
|
||||||
limit = take (fromMaybe 1 mlimit)
|
limit = take (fromMaybe 1 mlimit)
|
||||||
depth = fromMaybe 4 mdepth
|
depth = fromMaybe default_depth_server mdepth
|
||||||
|
|
||||||
doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult
|
doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult
|
||||||
doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj
|
doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj
|
||||||
@@ -1092,7 +1094,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)
|
||||||
|
|||||||
20
stack-ghc9.6.7.yaml
Normal file
20
stack-ghc9.6.7.yaml
Normal 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
30
stack.yaml
@@ -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
|
||||||
|
|||||||
@@ -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ä" ;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user