Move testsuite/compiler/canonical on level up, update test script

1 files changed, 302 insertions, 0 deletions

diff --git a/testsuite/canonical/grammars/SentencesI.gf b/testsuite/canonical/grammars/SentencesI.gf
new file mode 100644
index 000000000..913aa11ad
--- /dev/null
+++ b/testsuite/canonical/grammars/SentencesI.gf
@@ -0,0 +1,302 @@
+--1 Implementation of MOLTO Phrasebook
+
+--2 The functor for (mostly) common structures
+
+incomplete concrete SentencesI of Sentences = Numeral ** 
+  open
+    Syntax,
+    Lexicon,
+    Symbolic,  -- for names as strings
+    Prelude
+  in {
+  lincat
+    Phrase = Text ;
+    Word = Text ;
+    Message = Text ;
+    Greeting = Text ;
+    Sentence = S ;
+    Question = QS ;
+    Proposition = Cl ;
+    Item = NP ;
+    Kind = CN ;
+    MassKind = CN ;
+    MassKind = CN ;
+    PlurKind = CN ;
+    DrinkKind = CN ;
+    Quality = AP ;
+    Property = A ;
+    Object = NP ;
+    PrimObject = NP ;
+    Place = NPPlace ; -- {name : NP ; at : Syntax.Adv ; to : Syntax.Adv} ;
+    PlaceKind = CNPlace ; -- {name : CN ; at : Prep ; to : Prep} ;
+    Currency = CN ;
+    Price = NP ;
+    Action = Cl ;
+    Person = NPPerson ; -- {name : NP ; isPron : Bool ; poss : Quant} ;
+    Nationality = NPNationality ; -- {lang : NP ; country : NP ; prop : A} ; 
+    LAnguage = NP ;
+    Citizenship = A ;
+    Country = NP ;
+    Day = NPDay ; -- {name : NP ; point : Syntax.Adv ; habitual : Syntax.Adv} ;
+    Date = Syntax.Adv ;
+    Name = NP ;
+    Number = Card ;
+    ByTransport = Syntax.Adv ;
+    Transport = {name : CN ; by : Syntax.Adv} ;
+    Superlative = Det ;
+  lin
+    MPhrase p = p ;
+    MContinue p m = mkText p m ;
+
+    PSentence s = mkText s | lin Text (mkUtt s) ;  -- optional '.'
+    PQuestion s = mkText s | lin Text (mkUtt s) ;  -- optional '?'
+
+    PGreetingMale, PGreetingFemale = \g -> mkText (lin Phr (ss g.s)) exclMarkPunct | g ;
+
+    -- PWord w = w ;
+
+    PNumber x = mkSentence (mkUtt x) ;
+    PPrice x = mkSentence (mkUtt x) ;
+
+    PObject x = mkPhrase (mkUtt x) ;
+    PKind x = mkPhrase (mkUtt x) ;
+    PMassKind x = mkPhrase (mkUtt x) ;
+    PQuality x = mkPhrase (mkUtt x) ;
+    PPlace x = mkPhrase (mkUtt x.name) ;
+    PPlaceKind x = mkPhrase (mkUtt x.name) ;
+    PCurrency x = mkPhrase (mkUtt x) ;
+    PLanguage x = mkPhrase (mkUtt x) ;
+    PCountry x = mkPhrase (mkUtt x) ;
+    PCitizenship x = mkPhrase (mkUtt (mkAP x)) ;
+    PDay d = mkPhrase (mkUtt d.name) ;
+    PTransport t = mkPhrase (mkUtt t.name) ;
+    PByTransport t = mkPhrase (mkUtt t) ;
+
+    PYes = mkPhrase yes_Utt ;
+    PNo = mkPhrase no_Utt ;
+    PYesToNo = mkPhrase yes_Utt ;
+
+    GObjectPlease o = lin Text (mkPhr noPConj (mkUtt o) please_Voc) | lin Text (mkUtt o) ;
+
+    Is = mkCl ;
+    IsMass m q = mkCl (mkNP m) q ;
+
+    SProp = mkS ;
+    SPropNot = mkS negativePol ;
+    QProp p = mkQS (mkQCl p) ;
+
+    WherePlace place = mkQS (mkQCl where_IAdv place.name) ;
+    WherePerson person = mkQS (mkQCl where_IAdv person.name) ;
+
+    PropAction a = a ;
+
+    AmountCurrency num curr = mkNP num curr ;
+
+    ObjItem i = i ;
+    ObjNumber n k = mkNP n k ;
+    ObjIndef k = mkNP a_Quant k ;
+    ObjPlural k = mkNP aPl_Det k ;
+    ObjPlur k = mkNP aPl_Det k ;
+    ObjMass k = mkNP k ;
+    ObjAndObj = mkNP and_Conj ;
+    OneObj o = o ; 
+
+    MassDrink d = d ;
+    DrinkNumber n k = mkNP n k ;
+
+    This kind = mkNP this_Quant kind ;
+    That kind = mkNP that_Quant kind ;
+    These kind = mkNP this_Quant plNum kind ;
+    Those kind = mkNP that_Quant plNum kind ;
+    The kind = mkNP the_Quant kind ;
+    Thes kind = mkNP the_Quant plNum kind ;
+    ThisMass kind = mkNP this_Quant kind ;
+    ThatMass kind = mkNP that_Quant kind ;
+    TheMass kind = mkNP the_Quant kind ;
+    ThesePlur kind = mkNP this_Quant plNum kind ;
+    ThosePlur kind = mkNP that_Quant plNum kind ;
+    ThesPlur kind = mkNP the_Quant plNum kind ;
+
+    SuchKind quality kind = mkCN quality kind ;
+    SuchMassKind quality kind = mkCN quality kind ;
+    Very property = mkAP very_AdA (mkAP property) ;
+    Too property = mkAP too_AdA (mkAP property) ;
+    PropQuality property = mkAP property ;
+
+    ThePlace kind = let dd : Det = if_then_else Det kind.isPl thePl_Det theSg_Det 
+                     in placeNP dd kind ;
+    APlace kind = let dd : Det = if_then_else Det kind.isPl aPl_Det aSg_Det 
+                     in placeNP dd kind ;
+
+    IMale, IFemale = mkPerson i_Pron ;
+    YouFamMale, YouFamFemale = mkPerson youSg_Pron ;
+    YouPolMale, YouPolFemale = mkPerson youPol_Pron ;
+
+    LangNat n = n.lang ;
+    CitiNat n = n.prop ;
+    CountryNat n = n.country ;
+    PropCit c = c ;
+
+    OnDay d = d.point ;
+    Today = today_Adv ;
+
+    PersonName n = 
+      {name = n ; isPron = False ; poss = mkQuant he_Pron} ; -- poss not used
+----    NameString s = symb s ; --%
+    NameNN = symb "NN" ;
+
+    NNumeral n = mkCard <lin Numeral n : Numeral>  ;
+
+    SHave   p obj = mkS (mkCl p.name have_V2 obj) ;
+    SHaveNo p k = mkS negativePol (mkCl p.name have_V2 (mkNP aPl_Det k)) ;
+    SHaveNoMass p m = mkS negativePol (mkCl p.name have_V2 (mkNP m)) ;
+    QDoHave p obj = mkQS (mkQCl (mkCl p.name have_V2 obj)) ;
+
+    AHaveCurr p curr = mkCl p.name have_V2 (mkNP aPl_Det curr) ;
+    ACitizen p n = mkCl p.name n ;
+    ABePlace p place = mkCl p.name place.at ;
+    ByTransp t = t.by ;
+
+    AKnowSentence p s = mkCl p.name Lexicon.know_VS s ;
+    AKnowQuestion p s = mkCl p.name Lexicon.know_VQ s ;
+    AKnowPerson p q = mkCl p.name Lexicon.know_V2 q.name ;
+
+oper 
+
+-- These operations are used internally in Sentences.
+
+  mkPhrase : Utt -> Text = \u -> lin Text u ; -- no punctuation
+  mkGreeting : Str -> Text = \s -> lin Text (ss s) ; -- no punctuation
+  mkSentence : Utt -> Text = \t -> lin Text (postfixSS "." t | t) ; -- optional .
+
+  mkPerson : Pron -> {name : NP ; isPron : Bool ; poss : Quant} = \p -> 
+    {name = mkNP p ; isPron = True ; poss = mkQuant p} ;
+
+-- These are used in Words for each language.
+
+  NPNationality : Type = {lang : NP ; country : NP ; prop : A} ;
+
+  mkNPNationality : NP -> NP -> A -> NPNationality = \la,co,pro ->
+        {lang = la ; 
+         country = co ;
+         prop = pro
+        } ;
+
+  NPDay : Type = {name : NP ; point : Syntax.Adv ; habitual : Syntax.Adv} ;
+
+  mkNPDay : NP -> Syntax.Adv -> Syntax.Adv -> NPDay = \d,p,h ->
+      {name = d ; 
+       point = p ;
+       habitual = h
+      } ;
+
+  NPPlace : Type = {name : NP ; at : Syntax.Adv ; to : Syntax.Adv} ;
+  CNPlace : Type = {name : CN ; at : Prep ; to : Prep; isPl : Bool} ;
+
+  mkCNPlace : CN -> Prep -> Prep -> CNPlace = \p,i,t -> {
+    name = p ;
+    at = i ;
+    to = t ;
+    isPl = False
+    } ;
+
+ mkCNPlacePl : CN -> Prep -> Prep -> CNPlace = \p,i,t -> {
+    name = p ;
+    at = i ;
+    to = t ;
+    isPl = True
+    } ;
+
+  placeNP : Det -> CNPlace -> NPPlace = \det,kind ->
+    let name : NP = mkNP det kind.name in {
+      name = name ;
+      at = Syntax.mkAdv kind.at name ;
+      to = Syntax.mkAdv kind.to name
+    } ;
+
+  NPPerson : Type = {name : NP ; isPron : Bool ; poss : Quant} ;
+
+  relativePerson : GNumber -> CN -> (Num -> NP -> CN -> NP) -> NPPerson -> NPPerson = 
+    \n,x,f,p -> 
+      let num = if_then_else Num n plNum sgNum in {
+      name = case p.isPron of {
+        True => mkNP p.poss num x ;
+        _    => f num p.name x
+        } ;
+      isPron = False ;
+      poss = mkQuant he_Pron -- not used because not pron
+      } ;
+
+  GNumber : PType = Bool ;
+  sing = False ; plur = True ;
+
+-- for languages without GenNP, use "the wife of p"
+  mkRelative : Bool -> CN -> NPPerson -> NPPerson = \n,x,p ->
+    relativePerson n x 
+      (\a,b,c -> mkNP (mkNP the_Quant a c) (Syntax.mkAdv possess_Prep b)) p ;
+
+-- for languages with GenNP, use "p's wife"
+--   relativePerson n x (\a,b,c -> mkNP (GenNP b) a c) p ;
+
+  phrasePlease : Utt -> Text = \u -> --- lin Text (mkPhr noPConj u please_Voc) | 
+                                     lin Text u ;
+
+------------------------------------------------------------------------------------------
+-- New things added 30/11/2011 by AR
+------------------------------------------------------------------------------------------
+
+  lincat
+    VerbPhrase  = VP ;
+    Modality = VV ;
+  lin
+    ADoVerbPhrase p vp = mkCl p.name vp ;
+    AModVerbPhrase m p vp = mkCl p.name (mkVP m vp) ;
+    ADoVerbPhrasePlace p vp x = mkCl p.name (mkVP vp x.at) ;
+    AModVerbPhrasePlace m p vp x = mkCl p.name (mkVP m (mkVP vp x.at)) ;
+
+    QWhereDoVerbPhrase p vp = mkQS (mkQCl where_IAdv (mkCl p.name vp)) ;
+    QWhereModVerbPhrase m p vp = mkQS (mkQCl where_IAdv (mkCl p.name (mkVP m vp))) ;
+
+    MWant = want_VV ;
+    MCan = can_VV ;
+    MKnow = can8know_VV ;
+    MMust = must_VV ;
+
+    VPlay = mkVP play_V ;
+    VRun = mkVP run_V ;
+    VSit = mkVP sit_V ;
+    VSleep = mkVP sleep_V ;
+    VSwim = mkVP swim_V ; 
+    VWalk = mkVP walk_V ;
+    VSit = mkVP sit_V ;
+    VStop = mkVP stop_V ;
+    VDrink = mkVP <lin V drink_V2 : V> ; 
+    VEat = mkVP <lin V eat_V2 : V> ; 
+    VRead = mkVP <lin V read_V2 : V> ; 
+    VWait = mkVP <lin V wait_V2 : V> ; 
+    VWrite = mkVP <lin V write_V2 : V> ; 
+
+    V2Buy o = mkVP buy_V2 o ;
+    V2Drink o = mkVP drink_V2 o ;
+    V2Eat o = mkVP eat_V2 o ;
+    V2Wait o = mkVP wait_V2 o.name ;
+
+    PImperativeFamPos  v = phrasePlease (mkUtt (mkImp v)) ;
+    PImperativeFamNeg  v = phrasePlease (mkUtt negativePol (mkImp v)) ;
+    PImperativePolPos  v = phrasePlease (mkUtt politeImpForm (mkImp v)) ;
+    PImperativePolNeg  v = phrasePlease (mkUtt politeImpForm negativePol (mkImp v)) ;
+    PImperativePlurPos v = phrasePlease (mkUtt pluralImpForm (mkImp v)) ;
+    PImperativePlurNeg v = phrasePlease (mkUtt pluralImpForm negativePol (mkImp v)) ;
+
+-- other new things allowed by the resource
+
+---    PBecause a b = SSubjS a because_Subj b ;
+
+    He = mkPerson he_Pron ;
+    She = mkPerson she_Pron ;
+    WeMale, WeFemale = mkPerson we_Pron ;
+    YouPlurFamMale, YouPlurFamFemale = mkPerson youPl_Pron ;
+    YouPlurPolMale, YouPlurPolFemale = mkPerson youPl_Pron ;
+    TheyMale, TheyFemale = mkPerson they_Pron ;
+
+}