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

disambiguation in Phrasebook grammars, PGF server, and the GUI

Browse Source
This commit is contained in:
aarne
2010-03-30 15:39:11 +00:00
parent 4bae49c634
commit de909a4e44
23 changed files with 151 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
examples/phrasebook/DisambPhrasebookEng.gf Normal file
View File

@@ -0,0 +1,10 @@
--# -path=.:present
concrete DisambPhrasebookEng of Phrasebook = PhrasebookEng - [Polite,Familiar] **
open
(R = Roles) in {
lin
Polite = {s = "(polite)" ; p = R.PPolite} ;
Familiar = {s = "(familiar)" ; p = R.PFamiliar} ;
}

8
examples/phrasebook/GreetingsSwe.gf
View File

@@ -1,7 +1,7 @@
concrete GreetingsSwe of Greetings = open Prelude in {
concrete GreetingsSwe of Greetings = open Roles, Prelude in {
lincat
Greeting, Politeness = SS ;
Greeting = SS ;
lin
GHello = ss "hej" ;
@@ -12,7 +12,6 @@ lin
GSorry = ss "förlåt" ;
GGoodbye = ss "hej då" ;
GBye = ss "hej då" ;
GWhatsYourName = ss "vad heter du" ;
GNiceToMeetYou = ss "trevligt att träffas" ;
GSeeYouSoon = ss "vi ses snart" ;
GHelp = ss "hjälp" ;
@@ -21,11 +20,14 @@ lin
GGoodDay = ss "god dag" ;
GGoodEvening = ss "god afton" ;
GGoodNight = ss "god natt" ;
GWhatsYourName = ss "vad heter du" ;
GImHungry = ss "jag är hungrig" ;
GImThirsty = ss "jag är törstig" ;
GImTired = ss "jag är trött" ;
GImScared = ss "jag är rädd" ;
GIdontUnderstand = ss "jag förstår inte" ;
GTheCheck = ss "notan" ;
GYes = ss "ja" ;

2
examples/phrasebook/Makefile
View File

@@ -1,7 +1,7 @@
all: pgf missing
pgf:
gf -make PhrasebookEng.gf PhrasebookFin.gf PhrasebookFre.gf PhrasebookIta.gf PhrasebookRon.gf PhrasebookSwe.gf
gf -make PhrasebookEng.gf PhrasebookFin.gf PhrasebookFre.gf PhrasebookIta.gf PhrasebookRon.gf PhrasebookSwe.gf DisambPhrasebookEng.gf
missing:
echo "pg -missing | wf -file=missing.txt" | gf Phrasebook.pgf

9
examples/phrasebook/Phrasebook.gf
View File

@@ -5,18 +5,11 @@ abstract Phrasebook =
flags startcat = Phrase ;
cat
Politeness ; Gender ; -- abstract parameters
fun
-- here rather than Sentences, because not functorial
PSentence : Sentence -> Phrase ;
PQuestion : Question -> Phrase ;
PGreeting : Greeting -> Phrase ;
PGreeting : Politeness -> Greeting -> Phrase ;
---- PGreeting : Politeness -> Gender -> Gender -> Greeting -> Phrase ;
-- politeness level, speaker, hearer
Polite, Familiar : Politeness ;
Male, Female : Gender ;
}

10
examples/phrasebook/PhrasebookEng.gf
View File

@@ -8,14 +8,6 @@ concrete PhrasebookEng of Phrasebook =
Prelude in {
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = lin Text (ss g.s) ;
---- PGreeting p s h g = mkPhrase (g.s ++ p.s ++ s.s ++ h.s) ;
Male = {s = [] ; g = R.Male} ;
Female = {s = [] ; g = R.Female} ;
Polite = {s = [] ; p = R.Polite} ;
Familiar = {s = [] ; p = R.Familiar} ;
PGreeting p g = mkText (lin Text g) (lin Text (ss p.s)) ;
}

4
examples/phrasebook/PhrasebookFin.gf
View File

@@ -7,8 +7,6 @@ concrete PhrasebookFin of Phrasebook =
Prelude in {
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = mkPhrase g ;
PGreeting p g = mkText (lin Text (ss g.s)) (lin Text (ss p.s)) ;
}

14
examples/phrasebook/PhrasebookFre.gf
View File

@@ -6,22 +6,10 @@ concrete PhrasebookFre of Phrasebook =
** open
(R = Roles),
SyntaxFre,
ParadigmsFre,
Prelude in {
lincat
Gender = {s : Str ; g : R.Gender} ;
Politeness = {s : Str ; p : R.Politeness} ;
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = lin Text (ss (g.s ! R.Polite ! R.Male ! R.Male)) ;
PGreeting p g = mkText (lin Text (ss (g.s ! p.p ! R.Male ! R.Male))) (lin Text (ss p.s)) ;
---- PGreeting p s h g = mkPhrase (g.s ! p.p ! s.g ! h.g ++ p.s ++ s.s ++ h.s) ;
Male = {s = [] ; g = R.Male} ;
Female = {s = [] ; g = R.Female} ;
Polite = {s = [] ; p = R.Polite} ;
Familiar = {s = [] ; p = R.Familiar} ;
}

15
examples/phrasebook/PhrasebookIta.gf
View File

@@ -9,19 +9,8 @@ concrete PhrasebookIta of Phrasebook =
ParadigmsIta,
Prelude in {
lincat
Gender = {s : Str ; g : R.Gender} ;
Politeness = {s : Str ; p : R.Politeness} ;
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = lin Text (ss (g.s ! R.Polite ! R.Male ! R.Male)) ;
---- PGreeting p s h g = mkPhrase (g.s ! p.p ! s.g ! h.g ++ p.s ++ s.s ++ h.s) ;
PGreeting p g = mkText (lin Text (ss (g.s ! p.p ! R.Male ! R.Male))) (lin Text (ss p.s)) ;
Male = {s = [] ; g = R.Male} ;
Female = {s = [] ; g = R.Female} ;
Polite = {s = [] ; p = R.Polite} ;
Familiar = {s = [] ; p = R.Familiar} ;
}

4
examples/phrasebook/PhrasebookRon.gf
View File

@@ -8,8 +8,6 @@ concrete PhrasebookRon of Phrasebook =
Prelude in {
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = lin Text g ;
PGreeting p g = mkText (lin Text (ss g.s)) (lin Text (ss p.s)) ;
}

4
examples/phrasebook/PhrasebookSwe.gf
View File

@@ -7,8 +7,6 @@ concrete PhrasebookSwe of Phrasebook =
Prelude in {
lin
PSentence s = mkText s | lin Text (mkUtt s) ; -- optional .
PQuestion s = mkText s | lin Text (mkUtt s) ; -- optional ?
PGreeting g = mkPhrase g ;
PGreeting p g = mkText (lin Text (ss g.s)) (lin Text (ss p.s)) ;
}

6
examples/phrasebook/Roles.gf
View File

@@ -2,15 +2,15 @@ resource Roles = {
param
Gender = Male | Female ;
Politeness = Polite | Familiar ;
Politeness = PPolite | PFamiliar ;
oper
RolePhrase : Type = {s : Politeness => Gender => Gender => Str} ;
politeDistinct : (_,_ : Str) -> RolePhrase = \pol,fam -> {
s = table {
Polite => \\_,_ => pol ;
Familiar => \\_,_ => fam
PPolite => \\_,_ => pol ;
PFamiliar => \\_,_ => fam
}
} ;

14
examples/phrasebook/Sentences.gf
View File

@@ -7,8 +7,15 @@ abstract Sentences = Numeral ** {
Place ; PlaceKind ; Currency ; Price ; Language ;
Person ; Action ;
-- abstract parameters
Politeness ;
-- Gender ;
fun
-- these phrases are formed here, not in Phrasebook, as they are functorial
PSentence : Politeness -> Sentence -> Phrase ;
PQuestion : Politeness -> Question -> Phrase ;
PObject : Object -> Phrase ;
PKind : Kind -> Phrase ;
PQuality : Quality -> Phrase ;
@@ -41,8 +48,11 @@ abstract Sentences = Numeral ** {
Very : Quality -> Quality ;
Too : Quality -> Quality ;
I, You : Person ;
ThePlace : PlaceKind -> Place ;
I, You : Person ;
Polite, Familiar : Politeness ;
-- Male, Female : Gender ;
}

9
examples/phrasebook/SentencesFre.gf
View File

@@ -1,9 +1,12 @@
concrete SentencesFre of Sentences = NumeralFre ** SentencesI - [WhetherIs]
concrete SentencesFre of Sentences = NumeralFre ** SentencesI - [WhetherIs, QAction]
with
(DiffPhrasebook = DiffPhrasebookFre),
(Syntax = SyntaxFre) ** open SyntaxFre, ExtraFre in {
lin WhetherIs item quality =
lin QS {s = \\_ => (EstcequeS (mkS (mkCl item quality))).s} ;
lin
WhetherIs item quality =
{s = \\_ => lin QS {s = \\_ => (EstcequeS (mkS (mkCl item quality))).s}} ;
QAction a =
{s = \\r => lin QS {s = \\_ => (EstcequeS (mkS (a.s ! r))).s}} ;
}

55
examples/phrasebook/SentencesI.gf
View File

@@ -1,12 +1,15 @@
incomplete concrete SentencesI of Sentences = Numeral **
open
DiffPhrasebook,
Syntax
Syntax,
(R = Roles),
Prelude
in {
lincat
Phrase = Text ;
Sentence = S ;
Question = QS ;
Politeness = {s : Str ; p : R.Politeness} ;
Sentence = {s : R.Politeness => S} ;
Question = {s : R.Politeness => QS} ;
Item = NP ;
Kind = CN ;
Quality = AP ;
@@ -15,10 +18,16 @@ incomplete concrete SentencesI of Sentences = Numeral **
PlaceKind = CN ;
Currency = CN ;
Price = NP ;
Action = Cl ;
Person = NP ;
Action = {s : R.Politeness => Cl} ;
Person = {s : R.Politeness => NP} ;
Language = NP ;
lin
--- todo: add speaker and hearer genders
PSentence p g = let s = g.s ! p.p in
mkText (mkText s | lin Text (mkUtt s)) (lin Text (ss p.s)) ; -- optional '.'
PQuestion p g = let s = g.s ! p.p in
mkText (mkText s | lin Text (mkUtt s)) (lin Text (ss p.s)) ; -- optional '?'
PObject x = mkPhrase (mkUtt x) ;
PKind x = mkPhrase (mkUtt x) ;
PQuality x = mkPhrase (mkUtt x) ;
@@ -29,17 +38,18 @@ incomplete concrete SentencesI of Sentences = Numeral **
PPrice x = mkPhrase (mkUtt x) ;
PLanguage x = mkPhrase (mkUtt x) ;
Is item quality = mkS (mkCl item quality) ;
IsNot item quality = mkS negativePol (mkCl item quality) ;
WhetherIs item quality = mkQS (mkQCl (mkCl item quality)) ;
WhereIs place = mkQS (mkQCl where_IAdv place) ;
Is item quality = neutralS (mkS (mkCl item quality)) ;
IsNot item quality = neutralS (mkS negativePol (mkCl item quality)) ;
WhetherIs item quality = neutralQS (mkQS (mkQCl (mkCl item quality))) ;
WhereIs place = neutralQS (mkQS (mkQCl where_IAdv place)) ;
SAction = mkS ;
SNotAction = mkS negativePol ;
QAction a = mkQS (mkQCl a) ;
SAction a = {s = \\p => mkS (a.s ! p)} ;
SNotAction a = {s = \\p => mkS negativePol (a.s ! p)} ;
QAction a = {s = \\p => mkQS (mkQCl (a.s ! p))} ;
HowMuchCost item = mkQS (mkQCl how8much_IAdv (mkCl item cost_V)) ;
ItCost item price = mkS (mkCl item cost_V2 price) ;
HowMuchCost item = neutralQS (mkQS (mkQCl how8much_IAdv (mkCl item cost_V))) ;
ItCost item price = neutralS (mkS (mkCl item cost_V2 price)) ;
AmountCurrency num curr = mkNP <lin Numeral num : Numeral> curr ;
ObjItem i = i ;
@@ -57,10 +67,23 @@ incomplete concrete SentencesI of Sentences = Numeral **
Too quality = mkAP too_AdA quality ;
ThePlace kind = mkNP the_Quant kind ;
I = mkNP i_Pron ;
You = mkNP youPol_Pron ;
I = {s = \\_ => mkNP i_Pron} ;
You = {s = table {R.PPolite => mkNP youPol_Pron ; R.PFamiliar => mkNP youSg_Pron}} ;
Polite = {s = [] ; p = R.PPolite} ;
Familiar = {s = [] ; p = R.PFamiliar} ;
-- Male = {s = [] ; g = R.Male} ;
-- Female = {s = [] ; g = R.Female} ;
oper
mkPhrase : Utt -> Text = \u -> lin Text u ; -- no punctuation
politeS : S -> S -> {s : R.Politeness => S} = \pol,fam ->
{s = table {R.PPolite => pol ; R.PFamiliar => fam}} ;
neutralS : S -> {s : R.Politeness => S} = \pol -> politeS pol pol ;
politeQS : QS -> QS -> {s : R.Politeness => QS} = \pol,fam ->
{s = table {R.PPolite => pol ; R.PFamiliar => fam}} ;
neutralQS : QS -> {s : R.Politeness => QS} = \pol -> politeQS pol pol ;
---- it would be greate to use overloading here
}

16
examples/phrasebook/WordsEng.gf
View File

@@ -1,7 +1,7 @@
-- (c) 2009 Aarne Ranta under LGPL
concrete WordsEng of Words = SentencesEng **
open SyntaxEng, ParadigmsEng, IrregEng in {
open SyntaxEng, ParadigmsEng, IrregEng, (R = Roles) in {
lin
Wine = mkCN (mkN "wine") ;
Beer = mkCN (mkN "beer") ;
@@ -33,11 +33,13 @@ concrete WordsEng of Words = SentencesEng **
Romanian = mkNP (mkPN "Romanian") ;
Swedish = mkNP (mkPN "Swedish") ;
AWant p obj = mkCl p (mkV2 (mkV "want")) obj ;
ALike p item = mkCl p (mkV2 (mkV "like")) item ;
AHave p kind = mkCl p have_V2 (mkNP kind) ;
ASpeak p lang = mkCl p (mkV2 IrregEng.speak_V) lang ;
ALove p q = mkCl p (mkV2 (mkV "love")) q ;
AWant p obj = neutralA (mkCl (np p) (mkV2 (mkV "want")) obj) ;
ALike p item = neutralA (mkCl (np p) (mkV2 (mkV "like")) item) ;
AHave p kind = neutralA (mkCl (np p) have_V2 (mkNP kind)) ;
ASpeak p lang = neutralA (mkCl (np p) (mkV2 IrregEng.speak_V) lang) ;
ALove p q = neutralA (mkCl (np p) (mkV2 (mkV "love")) (np q)) ;
oper
neutralA : Cl -> {s : R.Politeness => Cl} = \pol -> {s = \\_ => pol} ;
np : {s : R.Politeness => NP} -> NP = \p -> p.s ! R.PPolite ;
}

13
examples/phrasebook/WordsFin.gf
View File

@@ -31,15 +31,16 @@ concrete WordsFin of Words = SentencesFin **
Dollar = mkCN (mkN "dollari") ;
Lei = mkCN (mkN "lei") ;
AWant p obj = mkCl p want_V2 obj ;
ALike p item = mkCl p like_V2 item ;
AHave p kind = mkCl p have_V2 (mkNP kind) ;
ASpeak p lang = mkCl p (mkV2 (mkV "puhua") partitive) lang ;
ALove p q = mkCl p (mkV2 (mkV "rakastaa") partitive) q ;
English = mkNP (mkPN "englanti") ;
Finnish = mkNP (mkPN (mkN "suomi" "suomia")) ;
French = mkNP (mkPN "ranska") ;
Romanian = mkNP (mkPN "romania") ;
Swedish = mkNP (mkPN "ruotsi") ;
AWant p obj = {s = \\r => mkCl (p.s ! r) want_V2 obj} ;
ALike p item = {s = \\r => mkCl (p.s ! r) like_V2 item} ;
AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (mkNP kind)} ;
ASpeak p lang = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "puhua") partitive) lang} ;
ALove p q = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "rakastaa") partitive) (q.s ! r)} ;
}

18
examples/phrasebook/WordsFre.gf
View File

@@ -35,19 +35,21 @@ Boring = mkAPA "ennuyeux" ;
Dollar = mkCN (mkN "dollar") ;
Lei = mkCN (mkN "lei") ; ---- ?
AWant p obj = mkCl p want_V2 obj ;
ALike p item = mkCl item plaire_V2 p ;
AHave p kind = mkCl p have_V2 (mkNP kind) ;
ASpeak p lang = mkCl p (mkV2 (mkV "parler")) lang ;
ALove p q = mkCl p (mkV2 (mkV "aimer")) q ;
English = mkNP (mkPN "anglais") ;
Finnish = mkNP (mkPN "finnois") ;
French = mkNP (mkPN "français") ;
Romanian = mkNP (mkPN "roumain") ;
Swedish = mkNP (mkPN "suédois") ;
oper
mkAPA : (_ : Str) -> AP = \x -> mkAP (mkA x) ;
AWant p obj = {s = \\r => mkCl (p.s ! r) want_V2 obj} ;
ALike p item = {s = \\r => mkCl item plaire_V2 (p.s ! r)} ;
AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (mkNP kind)} ;
ASpeak p lang = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "parler")) lang} ;
ALove p q = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "aimer")) (q.s ! r)} ;
oper
mkAPA : (_ : Str) -> AP = \x -> mkAP (mkA x) ;
}

12
examples/phrasebook/WordsIta.gf
View File

@@ -33,18 +33,18 @@ Boring = mkAPA "noioso" ;
Dollar = mkCN (mkN "dollar") ;
Lei = mkCN (mkN "lei") ; ---- ?
AWant p obj = mkCl p want_V2 obj ;
ALike p item = mkCl item (mkV2 (mkV (piacere_64 "piacere")) dative) p ;
AHave p kind = mkCl p have_V2 (mkNP kind) ;
ASpeak p lang = mkCl p (mkV2 (mkV "parlare")) lang ;
ALove p q = mkCl p (mkV2 (mkV "amare")) q ;
English = mkNP (mkPN "inglese") ;
Finnish = mkNP (mkPN "finnico") ;
Itanch = mkNP (mkPN "francese") ;
Romanian = mkNP (mkPN "romano") ;
Swedish = mkNP (mkPN "svedese") ;
AWant p obj = {s = \\r => mkCl (p.s ! r) want_V2 obj} ;
ALike p item = {s = \\r => mkCl item (mkV2 (mkV (piacere_64 "piacere")) dative) (p.s ! r)} ;
AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (mkNP kind)} ;
ASpeak p lang = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "parlare")) lang} ;
ALove p q = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "amare")) (q.s ! r)} ;
oper
mkAPA : (_ : Str) -> AP = \x -> mkAP (mkA x) ;

15
examples/phrasebook/WordsRon.gf
View File

@@ -3,7 +3,8 @@
concrete WordsRon of Words = SentencesRon ** open
SyntaxRon,
ParadigmsRon,
DiffPhrasebookRon in
DiffPhrasebookRon,
(R = Roles) in
{
flags coding=utf8 ;
@@ -34,18 +35,18 @@ Boring = mkAPA "plictisitor" "plictisitoare" "plictisitori" "plictisitoare" ;
Dollar = mkCN (mkN "dolar" masculine) ;
Lei = mkCN (mkN "leu" "lei") ;
AWant p obj = mkCl p want_V2 obj ;
ALike p item = mkCl p like_V2 item ;
AHave p kind = mkCl p have_V2 (SyntaxRon.mkNP kind) ;
ASpeak p lang = mkCl p (dirV2 (mkV "vorbi")) lang ;
ALove p q = mkCl p (dirV2 (mkV "iubi")) q ;
English = SyntaxRon.mkNP (mkPN "engleză") ; ---- ?
-- Finnish = mkNP (mkPN "finnois") ;
-- French = mkNP (mkPN "français") ;
Romanian = SyntaxRon.mkNP (mkPN "română") ; ---- ?
-- Swedish = mkNP (mkPN "suédois") ;
AWant p obj = {s = \\r => mkCl (p.s ! r) want_V2 obj} ;
ALike p item = {s = \\r => mkCl (p.s ! r) like_V2 item} ;
AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (SyntaxRon.mkNP kind)} ;
ASpeak p lang = {s = \\r => mkCl (p.s ! r) (dirV2 (mkV "vorbi")) lang} ;
ALove p q = {s = \\r => mkCl (p.s ! R.PPolite) (dirV2 (mkV "iubi")) (q.s ! r)} ; ---- linking slow
oper
mkAPA : (_,_,_,_ : Str) -> AP = \x,y,z,u -> mkAP (mkA x y z u) ;

10
examples/phrasebook/WordsSwe.gf
View File

@@ -33,11 +33,11 @@ concrete WordsSwe of Words = SentencesSwe **
Romanian = mkNP (mkPN "rumänska") ;
Swedish = mkNP (mkPN "svenska") ;
AWant p obj = mkCl p want_VV (mkVP have_V2 obj) ;
ALike p item = mkCl p (mkV2 (mkV "tycker") (mkPrep "om")) item ;
AHave p kind = mkCl p have_V2 (mkNP kind) ;
ASpeak p lang = mkCl p (mkV2 (mkV "tala")) lang ;
ALove p q = mkCl p (mkV2 (mkV "älska")) q ;
AWant p obj = {s = \\r => mkCl (p.s ! r) want_VV (mkVP have_V2 obj)} ;
ALike p item = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "tycker") (mkPrep "om")) item} ;
AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (mkNP kind)} ;
ASpeak p lang = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "tala")) lang} ;
ALove p q = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "älska")) (q.s ! r)} ;
}

7
examples/phrasebook/missing.txt
View File

@@ -1,6 +1,7 @@
DisambPhrasebookEng :
PhrasebookEng :
PhrasebookFin : Familiar Female Male Polite
PhrasebookFin :
PhrasebookFre :
PhrasebookIta : French Fresh GNiceToMeetYou GSeeYouSoon Tea
PhrasebookRon : Coffee Familiar Female Finnish French Male Polite Swedish Tea
PhrasebookSwe : Familiar Female Male Polite
PhrasebookRon : Coffee Finnish French Swedish Tea
PhrasebookSwe :

6
examples/phrasebook/www/phrasebook.js
View File

@@ -53,7 +53,7 @@ function show_languages(grammar) {
menu.setAttribute("onchange","new_language(this)");
menu.grammar=grammar;
menu.innerHTML="";
for(var i=0; i<lang.length; i++) {
for(var i=1; i<lang.length; i++) { // 1, to hide Disamb...
if(lang[i].canParse) {
var opt=empty("option");
opt.setAttribute("value",""+i);
@@ -188,8 +188,10 @@ function show_translations(translations) {
var lin=t.linearizations;
var tbody=empty("tbody");
tbody.appendChild(tr([th(text(t.to+":"))]));
for(var i=0;i<lin.length;i++)
for(var i=0;i<lin.length;i++) {
tbody.appendChild(tr([(text(lin[i].text))]));
if (lin.length > 1) tbody.appendChild(tr([(text(lin[i].tree))]));
}
trans.appendChild(wrap("table",tbody));
}
}

19
src/server/PGFService.hs
View File

@@ -129,18 +129,20 @@ doTranslateGroup pgf input mcat mfrom mto =
[toJSObject [("from", showJSON (langOnly (PGF.showLanguage from))),
("to", showJSON (langOnly (PGF.showLanguage to))),
("linearizations",showJSON
[toJSObject [("text", doText (doBind alt))] | alt <- output])
[toJSObject (("text", doText (doBind alt)) : disamb lg from t) |
(t,alt) <- output, let lg = length output])
]
|
(from,trees) <- parse' pgf input mcat mfrom,
(to,output) <- groupResults (map (linearize' pgf mto) trees)
(to,output) <- groupResults [(t, linearize' pgf mto t) | t <- trees]
]
where
groupResults = Map.toList . foldr more Map.empty . start . concat
groupResults = Map.toList . foldr more Map.empty . start . collect
where
start ls = [(l,[s]) | (l,s) <- ls]
collect tls = [(t,(l,s)) | (t,ls) <- tls, (l,s) <- ls, notDisamb l]
start ls = [(l,[(t,s)]) | (t,(l,s)) <- ls]
more (l,s) =
Map.insertWith (\ [x] xs -> if elem x xs then xs else (x : xs)) l s
Map.insertWith (\ [(t,x)] xs -> if elem x (map snd xs) then xs else ((t,x) : xs)) l s
doBind = unwords . bind . words
doText s = case s of
c:cs | elem (last s) ".?!" -> toUpper c : init (init cs) ++ [last s]
@@ -152,6 +154,13 @@ doTranslateGroup pgf input mcat mfrom mto =
_ -> ws
langOnly = reverse . take 3 . reverse
disamb lg from t =
if lg < 2
then []
else [("tree", "-- " ++ doText (doBind PGF.linearize pgf (disambLang from)) t)]
disambLang f = maybe f id $ PGF.readLanguage $ "Disamb" ++ PGF.showLanguage f
notDisamb = (/="Disamb") . take 6 . PGF.showLanguage
doParse :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> JSValue
doParse pgf input mcat mfrom = showJSON $ map toJSObject