msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

a script for cloning (Phrasebook) grammars

Browse Source
This commit is contained in:
aarne
2010-04-07 14:59:55 +00:00
parent 50191dac7d
commit db30578e9f
8 changed files with 212 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
examples/phrasebook/Clone.hs Normal file
View File

@@ -0,0 +1,54 @@
module Main where
import Control.Monad
import Data.Maybe
import System.Cmd
import System.Directory
import System.Environment
import System.Exit
-- To clone a project from one language to another:
--
-- 1. for each Module in modules, copy ModuleFROM to ModuleTO
-- 2. in each ModuleTO, replace substrings FROM by TO, if not prefixes of an Ident
-- 3. in each ModuleTO in specifics, comment out every line in the body
--
-- Syntax: runghc Clone FROM TO
-- Example: runhugs Clone Swe Nor
-- The following lines are for the phrasebook project, but can be modified to other projects.
modules = "Phrasebook":"Sentences":specifics
specifics = ["Words","Greetings"]
main = do
from:to:_ <- getArgs
mapM_ (clone from to) modules
clone from to pref = do
s <- readFile (pref ++ from ++ ".gf")
writeFile (pref ++ to ++ ".gf") (commentIf (isSpecific pref) (replaceLang from to s))
isSpecific = flip elem specifics
replaceLang s1 s2 = repl where
repl s = case s of
c:cs -> case splitAt lgs s of
(pre,c:rest) | pre == s1 && elem c " ,:=(){}.-[]" -> s2 ++ [c] ++ repl rest
_ -> c : repl cs
_ -> s
lgs = 3 -- length s1
-- the file name has the form p....pLLL.gf, i.e. 3-letter lang name, suffix .gf
getLangName fi = let (nal,ferp) = splitAt 3 (drop 3 (reverse fi)) in (reverse ferp,reverse nal)
commentIf c = if c then (unlines . commentBody . lines) else id
commentBody ss = header ++ map comment body ++ ["}"] where
(header,body) = break (isJment . words) ss
isJment ws = case ws of
k:_ | elem k ["flags","lin","lincat","oper","param"] -> True
_ -> False
comment l = "-- " ++ l

3
examples/phrasebook/Makefile
View File

@@ -1,7 +1,8 @@
all: pgf missing
pgf:
gf -make PhrasebookEng.gf PhrasebookFin.gf PhrasebookFre.gf PhrasebookIta.gf PhrasebookRon.gf PhrasebookSwe.gf DisambPhrasebookEng.gf DisambPhrasebookRon.gf
gf -make PhrasebookEng.gf PhrasebookFin.gf PhrasebookFre.gf PhrasebookIta.gf PhrasebookRon.gf PhrasebookSwe.gf DisambPhrasebookEng.gf
#DisambPhrasebookRon.gf
koe:
gf -make PhrasebookEng.gf PhrasebookFre.gf DisambPhrasebookEng.gf

111
examples/phrasebook/Words.gf
View File

@@ -1,42 +1,97 @@
-- (c) 2009 Aarne Ranta under LGPL
abstract Words = Sentences ** {
fun
Wine, Beer, Water, Coffee, Tea : Kind ;
Cheese, Fish, Pizza : Kind ;
Fresh, Warm,
Expensive, Delicious, Boring, Good : Property ;
Bar, Restaurant, Toilet,
Museum, Airport, Station, Hospital, Church : PlaceKind ;
-- kinds of items (so far mostly food stuff)
Euro, Dollar, Lei : Currency ;
Apple : Kind ;
Beer : Kind ;
Bread : Kind ;
Cheese : Kind ;
Chicken : Kind ;
Coffee : Kind ;
Fish : Kind ;
Meat : Kind ;
Milk : Kind ;
Pizza : Kind ;
Salt : Kind ;
Tea : Kind ;
Water : Kind ;
Wine : Kind ;
-- properties of kinds (so far mostly of food)
Bad : Property ;
Boring : Property ;
Cheap : Property ;
Cold : Property ;
Delicious : Property ;
Expensive : Property ;
Fresh : Property ;
Good : Property ;
Suspect : Property ;
Warm : Property ;
-- kinds of places
Airport : PlaceKind ;
Bar : PlaceKind ;
Cinema : PlaceKind ;
Church : PlaceKind ;
Hospital : PlaceKind ;
Hotel : PlaceKind ;
Museum : PlaceKind ;
Park : PlaceKind ;
Restaurant : PlaceKind ;
School : PlaceKind ;
Shop : PlaceKind ;
Station : PlaceKind ;
Theatre : PlaceKind ;
Toilet : PlaceKind ;
University : PlaceKind ;
-- currency units
DanishCrown : Currency ;
Dollar : Currency ;
Euro : Currency ;
Lei : Currency ;
SwedishCrown : Currency ;
-- nationalities, countries, languages, citizenships
English, Finnish, French, Italian, Romanian, Swedish : Nationality ;
Belgian : Citizenship ;
Flemish : Language ;
Belgium : Country ;
English : Nationality ;
Finnish : Nationality ;
Flemish : Language ;
French : Nationality ;
Italian : Nationality ;
Romanian : Nationality ;
Swedish : Nationality ;
Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday : Day ;
-- actions (which can be expressed by different structures in different languages)
-- actions can be expressed by different structures in different languages
AWant : Person -> Object -> Action ;
ALike : Person -> Item -> Action ;
ASpeak : Person -> Language -> Action ;
ALove : Person -> Person -> Action ;
AHungry : Person -> Action ;
AThirsty : Person -> Action ;
ATired : Person -> Action ;
AIll : Person -> Action ;
AScared : Person -> Action ;
AHasName : Person -> Name -> Action ;
AHungry : Person -> Action ;
AIll : Person -> Action ;
AKnow : Person -> Action ;
ALike : Person -> Item -> Action ;
ALive : Person -> Country -> Action ;
ALove : Person -> Person -> Action ;
AScared : Person -> Action ;
ASpeak : Person -> Language -> Action ;
AThirsty : Person -> Action ;
ATired : Person -> Action ;
AUnderstand : Person -> Action ;
AKnow : Person -> Action ;
AWantGo : Person -> Place -> Action ;
AHasName : Person -> Name -> Action ;
ALive : Person -> Country -> Action ;
AWant : Person -> Object -> Action ;
AWantGo : Person -> Place -> Action ;
QWhatName : Person -> Question ;
-- miscellaneous phrases
QWhatName : Person -> Question ;
PropOpen : Place -> Proposition ;
PropClosed : Place -> Proposition ;
@@ -48,4 +103,8 @@ abstract Words = Sentences ** {
HowMuchCost : Item -> Question ; -- how much does the pizza cost
ItCost : Item -> Price -> Proposition ; -- the pizza costs five euros
-- week days
Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday : Day ;
}

102
examples/phrasebook/WordsEng.gf
View File

@@ -2,72 +2,92 @@
concrete WordsEng of Words = SentencesEng **
open
SyntaxEng, ParadigmsEng, (P = ParadigmsEng),
SyntaxEng, ParadigmsEng, (L = LexiconEng), (P = ParadigmsEng),
IrregEng, Prelude in {
lin
Wine = mkCN (mkN "wine") ;
Beer = mkCN (mkN "beer") ;
Water = mkCN (mkN "water") ;
Apple = mkCN L.apple_N ;
Beer = mkCN L.beer_N ;
Bread = mkCN L.bread_N ;
Milk = mkCN L.milk_N ;
Salt = mkCN L.salt_N ;
Water = mkCN L.water_N ;
Wine = mkCN L.wine_N ;
Coffee = mkCN (mkN "coffee") ;
Tea = mkCN (mkN "tea") ;
Pizza = mkCN (mkN "pizza") ;
Cheese = mkCN (mkN "cheese") ;
Fish = mkCN (mkN "fish" "fish") ;
Chicken = mkCN (mkN "chicken") ;
Meat = mkCN (mkN "meat") ;
Fish = mkCN L.fish_N ;
Fresh = mkA "fresh" ;
Warm = mkA "warm" ;
Warm = L.warm_A ;
Expensive = mkA "expensive" ;
Delicious = mkA "delicious" ;
Boring = mkA "boring" ;
Good = mkA "good" "better" "best" "well" ;
Good = L.good_A ;
Bad = L.bad_A ;
Cold = L.cold_A ;
Cheap = mkA "cheap" ;
Suspect = mkA "suspect" ;
Fresh = mkA "fresh" ;
Warm = L.warm_A ;
Expensive = mkA "expensive" ;
Delicious = mkA "delicious" ;
Boring = mkA "boring" ;
Good = L.good_A ;
Bad = L.bad_A ;
Cold = L.cold_A ;
Cheap = mkA "cheap" ;
Suspect = mkA "suspect" ;
Restaurant = mkPlace "restaurant" "in" ;
Bar = mkPlace "bar" "in" ;
Toilet = mkPlace "toilet" "in" ;
Museum = mkPlace "museum" "in" ;
Airport = mkPlace "airport" "at" ;
Station = mkPlace "station" "at" ;
Hospital = mkPlace "hospital" "in" ;
Bar = mkPlace "bar" "in" ;
Church = mkPlace "church" "in" ;
Cinema = mkPlace "cinema" "at" ;
Hospital = mkPlace "hospital" "in" ;
Hotel = mkPlace "hotel" "in" ;
Museum = mkPlace "museum" "in" ;
Park = mkPlace "park" "in" ;
Restaurant = mkPlace "restaurant" "in" ;
School = mkPlace "school" "at" ;
Shop = mkPlace "shop" "in" ;
Station = mkPlace "station" "at" ;
Theatre = mkPlace "theatre" "at" ;
Toilet = mkPlace "toilet" "in" ;
University = mkPlace "university" "at" ;
Euro = mkCN (mkN "euro" "euros") ; -- to prevent euroes
DanishCrown = mkCN (mkA "Danish") (mkN "crown") ;
Dollar = mkCN (mkN "dollar") ;
Euro = mkCN (mkN "euro" "euros") ; -- to prevent euroes
Lei = mkCN (mkN "leu" "lei") ;
SwedishCrown = mkCN (mkA "Swedish") (mkN "crown") ;
Belgian = mkA "Belgian" ;
Belgium = mkNP (mkPN "Belgium") ;
English = mkNat "English" "England" ;
Finnish = mkNat "Finnish" "Finland" ;
Flemish = mkNP (mkPN "Flemish") ;
French = mkNat "French" "France" ;
Italian = mkNat "Italian" "Italy" ;
Romanian = mkNat "Romanian" "Romania" ;
Swedish = mkNat "Swedish" "Sweden" ;
Belgian = mkA "Belgian" ;
Flemish = mkNP (mkPN "Flemish") ;
Belgium = mkNP (mkPN "Belgium") ;
Monday = mkDay "Monday" ;
Tuesday = mkDay "Tuesday" ;
Wednesday = mkDay "Wednesday" ;
Thursday = mkDay "Thursday" ;
Friday = mkDay "Friday" ;
Saturday = mkDay "Saturday" ;
Sunday = mkDay "Sunday" ;
AWant p obj = mkCl p.name (mkV2 (mkV "want")) obj ;
ALike p item = mkCl p.name (mkV2 (mkV "like")) item ;
ASpeak p lang = mkCl p.name (mkV2 IrregEng.speak_V) lang ;
ALove p q = mkCl p.name (mkV2 (mkV "love")) q.name ;
AHasName p name = mkCl (nameOf p) name ;
AHungry p = mkCl p.name (mkA "hungry") ;
AIll p = mkCl p.name (mkA "ill") ;
AKnow p = mkCl p.name IrregEng.know_V ;
ALike p item = mkCl p.name (mkV2 (mkV "like")) item ;
ALive p co = mkCl p.name (mkVP (mkVP (mkV "live")) (SyntaxEng.mkAdv in_Prep co)) ;
ALove p q = mkCl p.name (mkV2 (mkV "love")) q.name ;
AScared p = mkCl p.name (mkA "scared") ;
ASpeak p lang = mkCl p.name (mkV2 IrregEng.speak_V) lang ;
AThirsty p = mkCl p.name (mkA "thirsty") ;
ATired p = mkCl p.name (mkA "tired") ;
AScared p = mkCl p.name (mkA "scared") ;
AIll p = mkCl p.name (mkA "ill") ;
AUnderstand p = mkCl p.name IrregEng.understand_V ;
AKnow p = mkCl p.name IrregEng.know_V ;
AWant p obj = mkCl p.name (mkV2 (mkV "want")) obj ;
AWantGo p place = mkCl p.name want_VV (mkVP (mkVP IrregEng.go_V) place.to) ;
AHasName p name = mkCl (nameOf p) name ;
ALive p co =
mkCl p.name (mkVP (mkVP (mkV "live")) (SyntaxEng.mkAdv in_Prep co)) ;
QWhatName p = mkQS (mkQCl whatSg_IP (mkVP (nameOf p))) ;
@@ -80,6 +100,14 @@ concrete WordsEng of Words = SentencesEng **
HowMuchCost item = mkQS (mkQCl how8much_IAdv (mkCl item IrregEng.cost_V)) ;
ItCost item price = mkCl item (mkV2 IrregEng.cost_V) price ;
Monday = mkDay "Monday" ;
Tuesday = mkDay "Tuesday" ;
Wednesday = mkDay "Wednesday" ;
Thursday = mkDay "Thursday" ;
Friday = mkDay "Friday" ;
Saturday = mkDay "Saturday" ;
Sunday = mkDay "Sunday" ;
oper
mkNat : Str -> Str -> {lang : NP ; prop : A ; country : NP} = \nat,co ->

1
examples/phrasebook/missing.txt
View File

@@ -1,5 +1,4 @@
DisambPhrasebookEng :
DisambPhrasebookRon : AHasName AHungry AIll AKnow ALive AScared AThirsty ATired AWantGo Airport Belgian Belgium Church Coffee English Finnish Flemish French Friday GExcusePol GPleaseGivePol GSorryPol Hospital Italian Monday Museum PropClosed PropClosedDate PropClosedDay PropOpen PropOpenDate PropOpenDay QWhatName Romanian Saturday Station Sunday Swedish Tea Thursday Tuesday Wednesday
PhrasebookEng :
PhrasebookFin :
PhrasebookFre :

BIN
examples/phrasebook/pgraph.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 52 KiB

After

Width:  |  Height:  |  Size: 52 KiB

10
examples/phrasebook/phrasebook.txt
View File

@@ -13,6 +13,7 @@ Aarne Ranta
#BSMALL
History
- 7 April. Added the Clone script, applied to the rest of MOLTO languages.
- 6 April. Version 0.4: weekdays, nationalities
- 30 March. Version 0.3: disambiguation grammar for English
- 28 March. Version 0.2: Swe, Ita; cat Action; small phrases.
@@ -56,9 +57,10 @@ The source code resides in
[``code.haskell.org/gf/examples/phrasebook/`` http://code.haskell.org/gf/examples/phrasebook/]
Current status (6 April 2010):
- available in English, Finnish, French, Italian, Romanian, Swedish
Current status (7 April 2010):
- small coverage
- reasonable for English, Finnish, French, Italian, Romanian, Swedish
- almost just cloned for the rest of MOLTO languages
- works on web browsers calling a server
- web service not yet released, but preliminarily available in
[``http://tournesol.cs.chalmers.se/~aarne/phrasebook/phrasebook.html`` http://tournesol.cs.chalmers.se/~aarne/phrasebook/phrasebook.html]
@@ -121,11 +123,11 @@ Improved translation interface
- a nicer way to show disambiguation (smaller font, maybe hidden by default)
The remaining 10 languages
Complete the missing words and phrases
Disambiguation grammars for other languages than English
Extend lexica by hand or (semi)automatically for
Extend the abstract lexicon in ``Words`` by hand or (semi)automatically for
- food stuff
- languages
- places

1
lib/src/abstract/Lexicon.gf
View File

@@ -117,7 +117,6 @@ fun
friend_N : N ;
fruit_N : N ;
full_A : A ;
fun
fun_AV : A ;
garden_N : N ;
girl_N : N ;