disambiguation in Phrasebook grammars, PGF server, and the GUI

examples/phrasebook/DisambPhrasebookEng.gf

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

examples/phrasebook/GreetingsSwe.gf

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

examples/phrasebook/Makefile

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

examples/phrasebook/Phrasebook.gf

@@ -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 ;
+  PGreeting : Politeness -> Greeting -> Phrase ;
-  PQuestion : Question -> Phrase ;
-  PGreeting : Greeting -> Phrase ;
 ----  PGreeting : Politeness -> Gender -> Gender -> Greeting -> Phrase ;
               -- politeness level, speaker, hearer
 
-  Polite, Familiar : Politeness ;
-  Male, Female : Gender ;
-
 }

examples/phrasebook/PhrasebookEng.gf

@@ -8,14 +8,6 @@ concrete PhrasebookEng of Phrasebook =
     Prelude in {
 
 lin
-  PSentence s = mkText s | lin Text (mkUtt s) ;  -- optional .
+  PGreeting p g = mkText (lin Text g) (lin Text (ss p.s)) ;
-  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} ;
 
 }

examples/phrasebook/PhrasebookFin.gf

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

examples/phrasebook/PhrasebookFre.gf

@@ -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 .
+  PGreeting p g = mkText (lin Text (ss (g.s ! p.p ! R.Male ! R.Male))) (lin Text (ss p.s)) ;
-  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) ;
-
-  Male = {s = [] ; g = R.Male} ;
-  Female = {s = [] ; g = R.Female} ;
-  Polite = {s = [] ; p = R.Polite} ;
-  Familiar = {s = [] ; p = R.Familiar} ;
   
 }

examples/phrasebook/PhrasebookIta.gf

@@ -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 .
+  PGreeting p g = mkText (lin Text (ss (g.s ! p.p ! R.Male ! R.Male))) (lin Text (ss p.s)) ;
-  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) ;
 
-  Male = {s = [] ; g = R.Male} ;
-  Female = {s = [] ; g = R.Female} ;
-  Polite = {s = [] ; p = R.Polite} ;
-  Familiar = {s = [] ; p = R.Familiar} ;
-  
 }
+

examples/phrasebook/PhrasebookRon.gf

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

examples/phrasebook/PhrasebookSwe.gf

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

examples/phrasebook/Roles.gf

@@ -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 ;
+      PPolite   => \\_,_ => pol ;
-      Familiar => \\_,_ => fam
+      PFamiliar => \\_,_ => fam
       }
     } ;
 

examples/phrasebook/Sentences.gf

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

examples/phrasebook/SentencesFre.gf

@@ -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 
-      lin QS {s = \\_ => (EstcequeS (mkS (mkCl item quality))).s} ;
+      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}} ;
 
 }

examples/phrasebook/SentencesI.gf

@@ -1,12 +1,15 @@
 incomplete concrete SentencesI of Sentences = Numeral ** 
   open
     DiffPhrasebook, 
-    Syntax 
+    Syntax,
+    (R = Roles),
+    Prelude
   in {
   lincat
     Phrase = Text ;
-    Sentence = S ; 
+    Politeness = {s : Str ; p : R.Politeness} ;
-    Question = QS ; 
+    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 ;
+    Action = {s : R.Politeness => Cl} ;
-    Person = NP ;
+    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) ;
+    Is item quality = neutralS (mkS (mkCl item quality)) ;
-    IsNot item quality = mkS negativePol (mkCl item quality) ;
+    IsNot item quality = neutralS (mkS negativePol (mkCl item quality)) ;
-    WhetherIs item quality = mkQS (mkQCl (mkCl item quality)) ;
+    WhetherIs item quality = neutralQS (mkQS (mkQCl (mkCl item quality))) ;
-    WhereIs place = mkQS (mkQCl where_IAdv place) ;
+    WhereIs place = neutralQS (mkQS (mkQCl where_IAdv place)) ;
 
-    SAction = mkS ;
+    SAction a = {s = \\p => mkS (a.s ! p)} ;
-    SNotAction = mkS negativePol ;
+    SNotAction a = {s = \\p => mkS negativePol (a.s ! p)} ;
-    QAction a = mkQS (mkQCl a) ;
+    QAction a = {s = \\p => mkQS (mkQCl (a.s ! p))} ;
 
-    HowMuchCost item = mkQS (mkQCl how8much_IAdv (mkCl item cost_V)) ; 
+    HowMuchCost item = neutralQS (mkQS (mkQCl how8much_IAdv (mkCl item cost_V))) ; 
-    ItCost item price = mkS (mkCl item cost_V2 price) ; 
+    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 ;
+    I   = {s = \\_ => mkNP i_Pron} ;
-    You = mkNP youPol_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
+
 }

examples/phrasebook/WordsEng.gf

@@ -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 ;
+    AWant p obj = neutralA (mkCl (np p) (mkV2 (mkV "want")) obj) ;
-    ALike p item = mkCl p (mkV2 (mkV "like")) item ;
+    ALike p item = neutralA (mkCl (np p) (mkV2 (mkV "like")) item) ;
-    AHave p kind = mkCl p have_V2 (mkNP kind) ;
+    AHave p kind = neutralA (mkCl (np p) have_V2 (mkNP kind)) ;
-    ASpeak p lang = mkCl p  (mkV2 IrregEng.speak_V) lang ;
+    ASpeak p lang = neutralA (mkCl (np p)  (mkV2 IrregEng.speak_V) lang) ;
-    ALove p q = mkCl p (mkV2 (mkV "love")) q ;
+    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 ;
 }

examples/phrasebook/WordsFin.gf

@@ -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)} ;
+
 }

examples/phrasebook/WordsFre.gf

@@ -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
+    AWant p obj = {s = \\r => mkCl (p.s ! r) want_V2 obj} ;
-mkAPA : (_ : Str) -> AP = \x -> mkAP (mkA x) ;
+    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) ;
+
 
 }

examples/phrasebook/WordsIta.gf

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

examples/phrasebook/WordsRon.gf

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

examples/phrasebook/WordsSwe.gf

@@ -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) ;
+    AWant p obj = {s = \\r => mkCl (p.s ! r) want_VV (mkVP have_V2 obj)} ;
-    ALike p item = mkCl p (mkV2 (mkV "tycker") (mkPrep "om")) item ;
+    ALike p item = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "tycker") (mkPrep "om")) item} ;
-    AHave p kind = mkCl p have_V2 (mkNP kind) ;
+    AHave p kind = {s = \\r => mkCl (p.s ! r) have_V2 (mkNP kind)} ;
-    ASpeak p lang = mkCl p  (mkV2 (mkV "tala")) lang ;
+    ASpeak p lang = {s = \\r => mkCl (p.s ! r)  (mkV2 (mkV "tala")) lang} ;
-    ALove p q = mkCl p (mkV2 (mkV "älska")) q ;
+    ALove p q = {s = \\r => mkCl (p.s ! r) (mkV2 (mkV "älska")) (q.s ! r)} ;
 
 
 }

examples/phrasebook/missing.txt

@@ -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
+PhrasebookRon : Coffee Finnish French Swedish Tea
-PhrasebookSwe : Familiar Female Male Polite
+PhrasebookSwe :

examples/phrasebook/www/phrasebook.js

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

src/server/PGFService.hs

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