Merge branch 'main' into feat_one_indexed

README.org

@@ -349,7 +349,7 @@ You should now be in a directory called =~/src/gf-rgl=
 In the =gf-rgl= directory, run:
 
 #+begin_example
-./Setup.sh --gf=$mygf
+runghc Setup.hs install --gf=$mygf
 #+end_example
 
 You should see:

Setup.hs

@@ -57,6 +57,7 @@ gfPP bi lbi clbi = PreProcessor {
                 , "--haskell=gadt" ]
                 ++ lexical
                 ++ ["--output-dir=" ++ outDir
+                , "--gfo-dir=" ++ outDir
                 , inDir </> inFile
                 ] ++ concrete
 
@@ -71,10 +72,10 @@ gfProgram :: Program
 gfProgram = simpleProgram "gf"
 
 getLexCategories fname = case fname of
-    "Prop.gf"
-        -> lexPrefix "Noun,Noun2,Adj,Adj2,Verb,Verb2"
     "Atoms.gf"
         -> lexPrefix "Atom"
+    "Prop.gf"
+        -> getLexCategories "Atoms.gf"
     "Answer.gf"
         -> getLexCategories "Atoms.gf"
     "Questions.gf"

baby-l4.cabal

@@ -20,6 +20,7 @@ extra-source-files:  README.org
                    , grammars/ParsePredicates.gf
 data-files:          l4/Prelude.l4
                    , grammars/Prop.gf
+                   , grammars/PropI.gf
                    , grammars/PropEng.gf
                    , grammars/Atoms.gf
                    , grammars/AtomsEng.gf
@@ -154,13 +155,17 @@ test-suite unit-tests
     Test.hs
   other-modules:       ToGF.Disambiguate
                      , DisambiguateTest
+                     , ToGFTest
                      , Paths_baby_l4
   build-depends:
       base >= 4 && < 5
     , baby-l4
     , containers
+    , extra
     , gf
+    , gf-ud
     , l4-generated
+    , prettyprinter
     , split
     , safe
     , tasty

exe/Main.hs

@@ -61,8 +61,8 @@ process args input = do
 
           case format args of
             Fast                     ->  pPrint tpAst
-            (Fgf GFOpts { gflang = gfl, showast = True } ) -> GF.nlgAST gfl tpAstNoSrc
-            (Fgf GFOpts { gflang = gfl, showast = False} ) -> GF.nlg    gfl tpAstNoSrc
+            (Fgf GFOpts { gflang = gfl, showast = True } ) -> GF.nlgAST gfl fpath normalAst
+            (Fgf GFOpts { gflang = gfl, showast = False} ) -> GF.nlg    gfl fpath normalAst
             Fsmt -> proveProgram tpAst
             Fscasp -> createSCasp normalAst
             Fyaml -> do createDSyaml tpAstNoSrc

grammars/AtomsEng.gf

@@ -17,8 +17,8 @@ concrete AtomsEng of Atoms = open Prelude, SyntaxEng, ExtendEng, (S=SyntaxEng),
     LinAtom : Type = {
       n2 : N2 ;
       cn : CN ;
-      v  : VPS ; -- intransitive verb
-      v2 : VPS2 ;
+      v  : PolVPS ; -- intransitive verb
+      v2 : PolVPS2 ;
       atype : AType
       } ;
 
@@ -36,36 +36,59 @@ concrete AtomsEng of Atoms = open Prelude, SyntaxEng, ExtendEng, (S=SyntaxEng),
       mkAtom : S.V -> LinAtom = \v  -> dummyAtom ** {v  = v2vps v ; atype = AV} ;
       mkAtom : V2  -> LinAtom = \v2 -> dummyAtom ** {v2 = v2vps2 v2 ; atype = AV2} ;
       mkAtom : N2  -> LinAtom = \n2 -> dummyAtom ** {n2 = n2 ; atype = AN2} ;
-      mkAtom : VPS -> LinAtom = \v  -> dummyAtom ** {v  = v ; atype = AV} ;
-      mkAtom : VPS2  -> LinAtom = \v2 -> dummyAtom ** {v2 = v2 ; atype = AV2} ;
+      mkAtom : PolVPS -> LinAtom = \v  -> dummyAtom ** {v = v ; atype = AV} ;
+      mkAtom : PolVPS2  -> LinAtom = \v2 -> dummyAtom ** {v2 = v2 ; atype = AV2} ;
+      mkAtom : (pos, neg : VPS) -> LinAtom = \pos,neg -> dummyAtom ** {
+        v  = table {MyPos => pos ; MyNeg => neg} ;
+        atype = AV} ;
+      mkAtom : (pos, neg : VPS2) -> LinAtom = \pos,neg -> dummyAtom ** {
+        v2 = table {MyPos => pos ; MyNeg => neg} ;
+        atype = AV2} ;
     } ;
 
   oper
+    PolVPS : Type = MyPol => VPS ;
+    PolVPS2 : Type = MyPol => VPS2 ;
+
     LinPred : Type = {atom : LinAtom ; arg : NP } ;
 
-    mkPred : LinPred -> VPS = \pred ->
+    mkPred : LinPred -> PolVPS = \pred ->
       case isTransitive pred.atom of {
         True => pred2 pred.atom pred.arg ;
-        _ => pred1 pred.atom } ; -- TODO: arity 0 ??
+        _    => pred1 pred.atom } ; -- TODO: arity 0 ??
 
-    pred1 : LinAtom -> VPS = \atom -> case atom.atype of {
+    pred1 : LinAtom -> PolVPS = \atom -> case atom.atype of {
       AV  => atom.v ;
       ACN => myVPS (mkVP atom.cn) ;
       AN2 => myVPS (mkVP (mkCN atom.n2)) ;
-      AV2 => ComplVPS2 atom.v2 something_NP } ; -- or <atom.v2 : VPS>
+      AV2 => \\pol => ComplVPS2 (atom.v2 ! pol) something_NP } ; -- or <atom.v2 : VPS>
 
-    pred2 : LinAtom -> NP -> VPS = \atom,obj ->
-      let addC2 : VPS -> VPS2 = \vps -> vps ** {c2 = ""} ;
-          vps2 : VPS2 = case atom.atype of {
+    pred2 : LinAtom -> NP -> PolVPS = \atom,obj ->
+      let vps2 : PolVPS2 = case atom.atype of {
             AV  => addC2 atom.v ;
             ACN => addC2 (myVPS (mkVP atom.cn)) ;
             AN2 => myVPS2 (N2VPSlash atom.n2) ;
             AV2 => atom.v2 } ; -- throws rock
-        in ComplVPS2 vps2 obj ;
+        in \\pol => ComplVPS2 (vps2 ! pol) obj ;
+
+    v2vps : S.V -> PolVPS = \v -> myVPS (mkVP v) ;
+    v2vps2 : V2 -> PolVPS2 = \v2 -> myVPS2 (mkVPSlash v2) ;
 
-    v2vps : S.V -> VPS = \v -> myVPS (mkVP v) ;
-    v2vps2 : V2 -> VPS2 = \v2 -> myVPS2 (mkVPSlash v2) ;
+--    myVPS : VP -> VPS = \vp -> MkVPS (mkTemp presentTense simultaneousAnt) positivePol vp ;
+--    myVPS2 : VPSlash -> VPS2 = \v2 -> MkVPS2 (mkTemp presentTense simultaneousAnt) positivePol v2 ;
 
-    myVPS : VP -> VPS = \vp -> MkVPS (mkTemp presentTense simultaneousAnt) positivePol vp ;
-    myVPS2 : VPSlash -> VPS2 = \v2 -> MkVPS2 (mkTemp presentTense simultaneousAnt) positivePol v2 ;
+    myVPS : VP -> MyPol => VPS = \vp ->
+      let vps : Pol -> VPS = \pol -> ExtendEng.MkVPS (mkTemp presentTense simultaneousAnt) pol vp ;
+       in table { MyPos => vps positivePol ;
+                  MyNeg => vps negativePol } ;
+    myVPS2 : VPSlash -> MyPol => VPS2 = \vp ->
+      let vps2 : Pol -> VPS2 = \pol -> ExtendEng.MkVPS2 (mkTemp presentTense simultaneousAnt) pol vp ;
+       in table { MyPos => vps2 positivePol ;
+                  MyNeg => vps2 negativePol } ;
+
+    addC2 : PolVPS -> PolVPS2 = \pvps ->
+      \\p => let vps : VPS = pvps ! p
+              in lin VPS2 (vps ** {c2 = ""}) ;
+  param
+    MyPol = MyPos | MyNeg ;
 }

grammars/PredicatesEng.gf

@@ -29,7 +29,7 @@ flags
 
 lin
   PPos = {s = [] ; p = CPos} ;
-  PNeg = {s = [] ; p = CNeg (variants {True; False})} ; -- contracted: don't
+  PNeg = {s = [] ; p = CNeg True} | {s = [] ; p = CNeg False} ; -- contracted: don't
 
   UseCl = variants {SentenceEng.UseCl; ExtraEng.ContractedUseCl} ;
 
@@ -125,8 +125,8 @@ lin
       } ;
 
     headlessVP = overload {
-      headlessVP : AP -> LinGenPred = \np -> {subj = dummyNP ; pred = myVPS (mkVP np)} ;
-      headlessVP : NP -> LinGenPred = \np -> {subj = dummyNP ; pred = myVPS (mkVP np)} ;
+      headlessVP : AP -> LinGenPred = \ap -> {subj = dummyNP ; pred = myVPS (mkVP ap) ! MyPos} ;
+      headlessVP : NP -> LinGenPred = \np -> {subj = dummyNP ; pred = myVPS (mkVP np) ! MyPos} ;
       headlessVP : VPS -> LinGenPred = \vp -> {subj = dummyNP ; pred = vp}
       } ;
     headlessVP2 = overload {
@@ -141,8 +141,8 @@ lin
       } ;
 
     vpSlash = overload {
-      vpSlash : NP -> Prep -> VPS2 = \np,prep -> myVPS2 (VE.VPSlashPrep (mkVP np) prep) ;
-      vpSlash : AP -> Prep -> VPS2 = \ap,prep -> myVPS2 (VE.VPSlashPrep (mkVP ap) prep) ;
+      vpSlash : NP -> Prep -> VPS2 = \np,prep -> myVPS2 (VE.VPSlashPrep (mkVP np) prep) ! MyPos ;
+      vpSlash : AP -> Prep -> VPS2 = \ap,prep -> myVPS2 (VE.VPSlashPrep (mkVP ap) prep) ! MyPos ;
       vpSlash : VPS -> Prep -> VPS2 = \vps,prep -> vps ** {c2 = prep.s} ;
       } ;
 

grammars/Prop.gf

@@ -1,23 +1,23 @@
-abstract Prop = {
+abstract Prop = Atoms ** {
 
 flags startcat = Prop ;
 
 cat
   Prop ;
-  Atom ;
+  PropAtom ;
   Pred1 ;
   Pred2 ;
   Ind ;
   Var ;
   Fun1 ;
   Fun2 ;
   Conj ;
-  -- For lexicon
 
-  Noun ; Noun2 ; Adj ; Adj2 ; Verb ; Verb2 ; PassVerb2 ;
+  -- For lexicon
+  Noun ;
 
 fun
-  PAtom  : Atom  -> Prop ;
+  PAtom  : PropAtom  -> Prop ;
   PNeg   : Prop  -> Prop ;
   PConj  : Conj  -> Prop -> Prop -> Prop ;
   PImpl  : Prop  -> Prop -> Prop ;
@@ -31,8 +31,8 @@ fun
   IVarN  : Noun -> Ind ;
   -- IVarA  : Adj -> Ind ;
 
-  APred1 : Pred1 -> Ind -> Atom ;
-  APred2 : Pred2 -> Ind -> Ind -> Atom ;
+  APred1 : Pred1 -> Ind -> PropAtom ;
+  APred2 : Pred2 -> Ind -> Ind -> PropAtom ;
 
   IFun1  : Fun1 -> Ind -> Ind ;
   IFun2  : Fun2 -> Ind -> Ind -> Ind ;
@@ -56,17 +56,17 @@ fun
   PExists : [Var] -> Kind -> Prop -> Prop ;
   PNotExists : [Var] -> Kind -> Prop -> Prop ;
 
-  PNegAtom  : Atom -> Prop ;
+  PNegAtom  : PropAtom -> Prop ;
 
   ConjPred1 : Conj -> [Pred1] -> Pred1 ;
 
-  APredColl : Pred2 -> [Ind] -> Atom ;
+  APredColl : Pred2 -> [Ind] -> PropAtom ;
 
-  APredRefl : Pred2 -> Ind -> Atom ;
+  APredRefl : Pred2 -> Ind -> PropAtom ;
 
   IFunC  : Fun2 -> [Ind] -> Ind ;
 
-  AKind  : Kind  -> Ind -> Atom ;
+  AKind  : Kind  -> Ind -> PropAtom ;
 
   IUniv  : Kind -> Ind ;
   IExist : Kind -> Ind ;
@@ -83,15 +83,15 @@ fun
   Vertical, Horizontal : Pred1 ;
   Parallel, Equal : Pred2 ;
   Centre : Fun1 ;
-  Intersection : Fun2 ;  
+  Intersection : Fun2 ;
 
   Set : Kind -> Kind ;
 
 -- test lexicon: arithmetic
 
   Even, Odd    : Pred1 ;
   Nat          : Kind ;
-  Boolean      : Kind ;    
+  Boolean      : Kind ;
 
   Square       : Fun1 ;
   Sum, Product : Fun2 ;
@@ -102,34 +102,17 @@ fun
   -- Not part of the original
 
   -- Overgenerating, but we're using this grammar only to linearise
+  AtomPred2 : Atom -> Pred2 ;
+  AtomPred1 : Atom -> Pred1 ;
+  AtomKind  : Atom -> Kind ;
+  AtomNoun  : Atom -> Noun ;
+
   KNoun        : Quantifier -> Noun -> Kind ;
   KInd         : Ind -> Kind ;
   KFun         : Kind -> Kind -> Kind ;
 
   INoun : Quantifier -> Noun -> Ind ;
 
-  PAdj1 : Adj -> Pred1 ;
-  PAdj2 : Adj2 -> Pred2 ;
-  PAdj12 : Adj -> Pred2 ; -- force A to A2
-  PNoun1 : Noun -> Pred1 ;
-  PNoun2 : Noun2 -> Pred2 ;
-  PVerb1 : Verb -> Pred1 ;
-  PVerb2 : Verb2 -> Pred2 ;
-  PPassV2 : PassVerb2 -> Pred1 ;
-  Passive : Verb2 -> PassVerb2 ;
-
-  -- Fallback: if word not in lexicon, make it into var
-  PVar1 : Var -> Pred1 ;
-  PVar2 : Var -> Pred2 ;
-
-
--- dummy instance of noun so that generated Prop.hs doesn't complain
-  DummyN : Noun ;
-  DummyN2 : Noun2 ;
-  DummyA : Adj ;
-  DummyA2 : Adj2 ;
-  DummyV : Verb ;
-  DummyV2 : Verb2 ;
 
 -- Quantifiers, to handle "a buyer / other buyer", or "first, second and third buyer"
 -- instead of "buyers A, B and C"

grammars/PropEng.gf

@@ -1,20 +1,19 @@
 --# -path=.:present
 
-concrete PropEng of Prop = PropI - [PNeg] with 
-  (Syntax = SyntaxEng), 
+concrete PropEng of Prop = AtomsEng ** PropI - [PNeg] with
+  (Syntax = SyntaxEng),
   (Symbolic = SymbolicEng),
   (Sentence = SentenceEng),
   (Extend = ExtendEng),
-  (WordNet = WordNetEng),
   (Verb = VerbEng)
-   ** open (P = ParadigmsEng), ExtraEng, Prelude in {
+   ** open (P = ParadigmsEng), (ExtraEng=ExtraEng), Prelude in {
 
 -- exceptions
 
 lin
-  PNeg p = { 
-    s = mkS ExtraEng.UncNeg (mkCl 
-          (mkVP (mkNP the_Quant (mkCN case_N (mkAdv that_Subj p.s))))) ; 
+  PNeg p = {
+    s = mkS ExtraEng.UncNeg (mkCl
+          (mkVP (mkNP the_Quant (mkCN case_N (mkAdv that_Subj p.s))))) ;
     c = False ---- ?
     } ;
 
@@ -40,8 +39,8 @@ lin
   Centre = mkFun1 "centre" ;
   Intersection = mkFun2 "intersection" ;
 
-  Set k = k ** {s = mkCN set_N2 (mkNP a_Art plNum k.s)} ; 
-  KFun = funType (P.mkN3 function_1_N from_Prep to_Prep) ;
+  Set k = k ** {s = mkCN set_N2 (mkNP a_Art plNum k.s)} ;
+  KFun = funType (P.mkN3 function_N from_Prep to_Prep) ;
 
   -- Even = mkAP (P.mkA "even") ;
   -- Odd = mkAP (P.mkA "odd") ;
@@ -52,7 +51,12 @@ lin
   Boolean = mkKind (mkCN (P.mkA "Boolean") (P.mkN "value")) ;
 
 oper
-  mkFun1, mkFun2 : Str -> {s : Symb ; v : N2} = \s -> 
+
+  function_N : N = P.mkN "function" ;
+  other_A : A = P.mkA "other" ;
+  type_N : N = P.mkN "type" ;
+
+  mkFun1, mkFun2 : Str -> {s : Symb ; v : N2} = \s ->
     {s = mkSymb  ("\\" + s) ; v = P.mkN2 (P.mkN s)} ;
 
 }