Swedish functor implementation of Base

9 files changed, 53 insertions, 26 deletions

diff --git a/examples/tutorial/semantics/AnswerBase.hs b/examples/tutorial/semantics/AnswerBase.hs
index 28c73a384..56e2b5451 100644
--- a/examples/tutorial/semantics/AnswerBase.hs
+++ b/examples/tutorial/semantics/AnswerBase.hs
@@ -11,13 +11,12 @@ domain = [0 .. 100]
 iS :: GS -> Prop
 iS s = case s of
   GPredAP np ap -> iNP np (iAP ap)
-  GConjS c s t  -> iConj c (iS s) (iS t)
 
 iNP :: GNP -> (Ent -> Prop) -> Prop
 iNP np p = case np of
   GEvery cn -> all (\x -> not (iCN cn x) || p x) domain
   GSome  cn -> any (\x ->      iCN cn x  && p x) domain
-  GNone  cn -> not (any (\x -> iCN cn x  && p x) domain)
+  GNone     -> not (any (\x -> p x) domain)
   GMany pns -> and (map p (iListPN pns))
   GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p)
   GUsePN a -> p (iPN a)
@@ -74,7 +73,7 @@ question2answer :: GQuestion -> GAnswer
 question2answer q = case iQuestion q of
   Left True  -> GYes
   Left False -> GNo
-  Right []   -> GValue (GNone GNumber)
+  Right []   -> GValue GNone
   Right [v]  -> GValue (GUsePN (ent2pn v))
   Right vs   -> GValue (GMany (GListPN (map ent2pn vs)))
 
diff --git a/examples/tutorial/semantics/Base.gf b/examples/tutorial/semantics/Base.gf
index 74528d31d..4586c3106 100644
--- a/examples/tutorial/semantics/Base.gf
+++ b/examples/tutorial/semantics/Base.gf
@@ -19,14 +19,12 @@ fun
 
   ModCN   : AP -> CN -> CN ;
 
-  ConjS   : Conj -> S -> S -> S ;
   ConjAP  : Conj -> AP -> AP -> AP ;
   ConjNP  : Conj -> NP -> NP -> NP ;
 
   UsePN   : PN -> NP ;
   Every   : CN -> NP ;
   Some    : CN -> NP ;
-  None    : CN -> NP ;
 
   And, Or : Conj ;  
 
@@ -55,6 +53,7 @@ fun
   No    : Answer ;
   Value : NP -> Answer ;
 
+  None  : NP ;
   Many  : ListPN -> NP ;
   BasePN : PN -> PN -> ListPN ;
   ConsPN : PN -> ListPN -> ListPN ; 
diff --git a/examples/tutorial/semantics/BaseEng.gf b/examples/tutorial/semantics/BaseEng.gf
index 582c2e279..bd79bc98c 100644
--- a/examples/tutorial/semantics/BaseEng.gf
+++ b/examples/tutorial/semantics/BaseEng.gf
@@ -13,14 +13,12 @@ lin
 
   ModCN   = cc2 ;
 
-  ConjS  c = infixSS c.s ;
   ConjAP c = infixSS c.s ;
   ConjNP c = infixSS c.s ;
 
   UsePN a = a ;
   Every = prefixSS "every" ;
   Some  = prefixSS "some" ;
-  None  = prefixSS "no" ;
 
   And = ss "and" ;
   Or  = ss "or" ;
@@ -49,6 +47,7 @@ lin
   No = ss "no" ;
 
   Value np = np ;
+  None = ss "none" ;
   Many list = list ;
 
   BasePN = infixSS "and" ;
diff --git a/examples/tutorial/semantics/BaseI.gf b/examples/tutorial/semantics/BaseI.gf
index 04fb0018c..ec967e443 100644
--- a/examples/tutorial/semantics/BaseI.gf
+++ b/examples/tutorial/semantics/BaseI.gf
@@ -6,7 +6,7 @@ flags lexer=literals ; unlexer=text ;
 lincat
   Question = G.Phr ;
   Answer = G.Phr ;
-  S  = Cl ;
+  S  = G.Cl ;
   NP = G.NP ;
   PN = G.NP ;
   CN = G.CN ;
@@ -22,14 +22,12 @@ lin
 
   ModCN   = mkCN ;
 
----  ConjS  = mkS ;
   ConjAP = mkAP ;
   ConjNP = mkNP ;
 
   UsePN p = p ;
   Every = mkNP every_Det ;
   Some  = mkNP someSg_Det ;
----  None  = mkNP noSg_Det ; ---
 
   And = and_Conj ;
   Or  = or_Conj ;
@@ -48,7 +46,8 @@ lin
  
   Sum     = prefix sum_N2 ;
   Product = prefix product_N2 ;
----  GCD     = prefixSS ["the greatest common divisor of"] ;
+  GCD nps = mkNP (mkDet (mkQuantSg defQuant) (mkOrd great_A)) 
+              (mkCN common_A (mkCN divisor_N2 (mkNP and_Conj nps))) ;
 
   WhatIs np = mkPhr (mkQS (mkQCl whatSg_IP (mkVP np))) ;
   WhichAre cn ap = mkPhr (mkQS (mkQCl (mkIP whichPl_IDet cn) (mkVP ap))) ;
@@ -59,6 +58,7 @@ lin
 
   Value np = mkPhr (mkUtt np) ;
   Many list = mkNP and_Conj list ;
+  None  = none_NP ;
 
   BasePN = G.BaseNP ;
   ConsPN = G.ConsNP ;
diff --git a/examples/tutorial/semantics/BaseSwe.gf b/examples/tutorial/semantics/BaseSwe.gf
new file mode 100644
index 000000000..6329c1c9c
--- /dev/null
+++ b/examples/tutorial/semantics/BaseSwe.gf
@@ -0,0 +1,8 @@
+--# -path=.:prelude:present:api:mathematical
+
+concrete BaseSwe of Base = BaseI with
+  (Syntax = SyntaxSwe), 
+  (Grammar = GrammarSwe), 
+  (G = GrammarSwe), 
+  (Symbolic = SymbolicSwe), 
+  (LexBase = LexBaseSwe) ;
diff --git a/examples/tutorial/semantics/GSyntax.hs b/examples/tutorial/semantics/GSyntax.hs
index 48634d2e9..6c67e40aa 100644
--- a/examples/tutorial/semantics/GSyntax.hs
+++ b/examples/tutorial/semantics/GSyntax.hs
@@ -83,7 +83,7 @@ data GNP =
    GConjNP GConj GNP GNP 
  | GEvery GCN 
  | GMany GListPN 
- | GNone GCN 
+ | GNone 
  | GSome GCN 
  | GUsePN GPN 
   deriving Show
@@ -101,9 +101,7 @@ data GQuestion =
  | GWhichAre GCN GAP 
   deriving Show
 
-data GS =
-   GConjS GConj GS GS 
- | GPredAP GNP GAP 
+data GS = GPredAP GNP GAP 
   deriving Show
 
 
@@ -141,7 +139,7 @@ instance Gf GNP where
  gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3]
  gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1]
  gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1]
- gf (GNone x1) = DTr [] (AC (CId "None")) [gf x1]
+ gf GNone = DTr [] (AC (CId "None")) []
  gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1]
  gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1]
 
@@ -156,9 +154,7 @@ instance Gf GQuestion where
  gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1]
  gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2]
 
-instance Gf GS where
- gf (GConjS x1 x2 x3) = DTr [] (AC (CId "ConjS")) [gf x1, gf x2, gf x3]
- gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2]
+instance Gf GS where gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2]
 
 
 instance Fg GA2 where
@@ -215,7 +211,7 @@ instance Fg GNP where
     DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3)
     DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1)
     DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1)
-    DTr [] (AC (CId "None")) [x1] -> GNone (fg x1)
+    DTr [] (AC (CId "None")) [] -> GNone 
     DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1)
     DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1)
     _ -> error ("no NP " ++ show t)
@@ -240,7 +236,6 @@ instance Fg GQuestion where
 instance Fg GS where
  fg t =
   case t of
-    DTr [] (AC (CId "ConjS")) [x1,x2,x3] -> GConjS (fg x1) (fg x2) (fg x3)
     DTr [] (AC (CId "PredAP")) [x1,x2] -> GPredAP (fg x1) (fg x2)
     _ -> error ("no S " ++ show t)
 
diff --git a/examples/tutorial/semantics/LexBase.gf b/examples/tutorial/semantics/LexBase.gf
index 74c491b9f..83713a35f 100644
--- a/examples/tutorial/semantics/LexBase.gf
+++ b/examples/tutorial/semantics/LexBase.gf
@@ -4,6 +4,8 @@ oper
   even_A : A ;
   odd_A : A ;
   prime_A : A ;
+  common_A : A ;
+  great_A : A ;
   equal_A2 : A2 ;
   greater_A2 : A2 ;
   smaller_A2 : A2 ;
@@ -11,7 +13,7 @@ oper
   number_N : N ;
   sum_N2 : N2 ;
   product_N2 : N2 ;
-  gcd_N2 : N2 ;
+  divisor_N2 : N2 ;
 
-  noSg_Det : Det ;
+  none_NP : NP ; ---
 }
diff --git a/examples/tutorial/semantics/LexBaseEng.gf b/examples/tutorial/semantics/LexBaseEng.gf
index d0f3baa1e..aea3a838b 100644
--- a/examples/tutorial/semantics/LexBaseEng.gf
+++ b/examples/tutorial/semantics/LexBaseEng.gf
@@ -4,14 +4,17 @@ oper
   even_A = mkA "even" ;
   odd_A = mkA "odd" ;
   prime_A = mkA "prime" ;
+  great_A = mkA "great" ;
+  common_A = mkA "common" ;
   equal_A2 = mkA2 (mkA "equal") (mkPrep "to") ;
   greater_A2 = mkA2 (mkA "greater") (mkPrep "than") ; ---
   smaller_A2 = mkA2 (mkA "smaller") (mkPrep "than") ; ---
   divisible_A2 = mkA2 (mkA "divisible") (mkPrep "by") ;
   number_N = mkN "number" ;
   sum_N2 = mkN2 (mkN "sum") (mkPrep "of") ;
---  product_N2 : N2 ;
---  gcd_N2 : N2 ;
+  product_N2 = mkN2 (mkN "product") (mkPrep "of") ;
+  divisor_N2 = mkN2 (mkN "divisor") (mkPrep "of") ;
+
+  none_NP = mkNP (mkPN "none") ; ---
 
---  noSg_Det : Det ;
 }
diff --git a/examples/tutorial/semantics/LexBaseSwe.gf b/examples/tutorial/semantics/LexBaseSwe.gf
new file mode 100644
index 000000000..6ac1904aa
--- /dev/null
+++ b/examples/tutorial/semantics/LexBaseSwe.gf
@@ -0,0 +1,22 @@
+instance LexBaseSwe of LexBase = open SyntaxSwe, ParadigmsSwe in {
+
+oper
+  even_A = mkA "jämn" ;
+  odd_A = invarA "udda" ;
+  prime_A = mkA "prim" ;
+  great_A = mkA "stor" "större" "störst" ;
+  common_A = mkA "gemensam" ;
+  equal_A2 = mkA2 (invarA "lika") (mkPrep "med") ;
+  greater_A2 = mkA2 (invarA "större") (mkPrep "än") ; ---
+  smaller_A2 = mkA2 (invarA "mindre") (mkPrep "än") ; ---
+  divisible_A2 = mkA2 (mkA "delbar") (mkPrep "med") ;
+  number_N = mkN "tal" "tal" ;
+  sum_N2 = mkN2 (mkN "summa") (mkPrep "av") ;
+  product_N2 = mkN2 (mkN "produkt") (mkPrep "av") ;
+  divisor_N2 = mkN2 (mkN "delare") (mkPrep "av") ;
+
+  none_NP = mkNP (mkPN "inget" neutrum) ; ---
+
+  invarA : Str -> A = \x -> mkA x x x x x ; ---
+ 
+}