revised FoodsHeb

contrib/summerschool/foods/FoodsHeb.gf

@@ -1,85 +1,108 @@
 --# -path=alltenses
 
--- (c) 2009 Dana Dannells under LGPL
+--(c) 2009 Dana Dannells
+-- Licensed under LGPL
 
 concrete FoodsHeb of Foods = open Prelude in {
   
-	flags coding=utf8 ;
+  flags coding=utf8 ;
 
     lincat
       Comment = SS ;
-      Quality = {s: Gender => Number => Str} ;  
+      Quality = {s: Number => Species => Gender =>  Str} ;  
-      Kind = {s : Number => Str ; g : Gender} ; 
+      Kind = {s : Number => Species => Str ; g : Gender ; mod : Modified} ; 
-      Item = {s : Str ; g : Gender ; n : Number} ; 
+      Item = {s : Str ; g : Gender ; n : Number ; sp : Species ; mod : Modified} ; 
   
+ 
     lin
-      Pred item quality = ss (item.s ++ quality.s ! item.g ! item.n) ; 
+      Pred item quality = ss (item.s ++ quality.s ! item.n ! Indef ! item.g ) ; 
-      This  = det Sg "זה" "זאת"; 
+      This  = det Sg Def "הזה" "הזאת"; 
-      That  = det Sg "הוא" "היא" ; 
+      That  = det Sg Def "ההוא" "ההיא" ; 
-      These = det Pl  "אלה" "אלה" ; 
+      These = det Pl Def "האלה" "האלה" ; 
-      Those = det Pl "הם" "הן" ; 
+      Those = det Pl Def "ההם" "ההן" ; 
       Mod quality kind = {
-	s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;
+	s = \\n,sp => kind.s ! n ! sp ++ quality.s ! n ! sp ! kind.g;
-	g = kind.g 
+	g = kind.g ;
+	mod = T
 	} ;     
-      Wine = regNoun "יין" "יינות"Fem ; 
+      Wine = regNoun "יין" "יינות" Masc ; 
       Cheese = regNoun "גבינה" "גבינות" Fem ;  
       Fish = regNoun "דג" "דגים" Masc ; 
-      Pizza = regNoun "פיצה" "פיצוי" Fem ; 
+      Pizza = regNoun "פיצה" "פיצות" Fem ; 
-      Very qual = {s = \\g,n => "מאוד" ++  qual.s ! g ! n} ;
+      Very qual = {s = \\g,n,sp => "מאוד" ++  qual.s ! g ! n ! sp} ;
       Fresh = regAdj "טרי" ; 
       Warm = regAdj "חם" ;
-      Italian = irregAdj "איטלקי" ;
+      Italian = regAdj2 "איטלקי" ;
       Expensive = regAdj "יקר" ; 
-      Delicious = irregAdj "נהדר" ; 
+      Delicious = regAdj "טעים" ; 
-      Boring = regAdj "משעמם"; 
+      Boring = regAdj2 "משעמם"; 
 
     param 
       Number = Sg | Pl ;
       Gender = Masc | Fem ;
- 
+      Species = Def | Indef ;  
+      Modified = T | F ;
+
     oper
-      det : Number -> Str -> Str -> {s : Number => Str ; g :Gender} -> 
+	Noun : Type = {s : Number => Species => Str ; g : Gender ; mod : Modified } ;
-	{s : Str ; g :Gender ; n : Number} = 
+  	Adj : Type = {s : Number => Species => Gender => Str} ;
-        \n,m,f,cn -> {
+
-          s =  cn.s ! n ++ case cn.g of {Masc => m ; Fem => f} ;
+      det : Number -> Species -> Str -> Str -> Noun -> 
+	{s : Str ; g :Gender ; n : Number ; sp : Species ; mod : Modified} = 
+        \n,sp,m,f,cn -> {
+	  s = case cn.mod of { _ => cn.s ! n ! sp ++ case cn.g of {Masc => m ; Fem  => f} };
 	  g = cn.g ; 
-          n = n
+          n = n ;
+	  sp = sp ;
+	  mod = cn.mod
         } ;
       
-     regNoun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = 
+	noun : (gvina,hagvina,gvinot,hagvinot : Str) ->  Gender -> Noun =  
-        \gvina,gvinot,g -> {s = table {
+      		\gvina,hagvina,gvinot,hagvinot,g -> {
-          Sg => gvina ;
+        	s = table {
-          Pl => gvinot 
+          		Sg  => table {
-          };
+             			Indef => gvina ;
-       	g=g
+             			Def =>  hagvina 
-        } ;
+            		} ;
+          		Pl => table {
+             			Indef => gvinot ;
+             			Def => hagvinot  
+            		} 
+       	  	} ;
+        	g = g ;
+		mod = F 
+      } ;
 
-      replaceLastLetter : Str -> Str = \s -> 
+	regNoun : Str -> Str -> Gender -> Noun = 
-	init s + case last s of  {
+	        \gvina,gvinot, g -> 
-          "מ" => "ם" ; "ן" => "נ" ; "פ" => "ף" ; "ץ" => "צ" ; "כ" => "ך" ; c => c
+		noun gvina (defH gvina) gvinot (defH gvinot) g ; 
-          } ;
+
+      defH : Str -> Str = \cn ->
+	case cn of {_ => "ה" + cn};	
+
+      replaceLastLetter : Str -> Str = \c ->
+	 case c of {"ף" => "פ" ; "ם" => "מ" ; "ן" => "נ" ; "ץ" => "צ" ; "ך" => "כ"; _ => c} ;
 	      
-      adjective : (_,_,_,_ : Str) -> {s : Gender => Number => Str} = 
+      adjective : (_,_,_,_ : Str) -> Adj = 
        \tov,tova,tovim,tovot -> {
         s = table {
-          Masc => table {
+          Sg => table { 
-            Sg => tov ;
+			Indef => table { Masc => tov ; Fem => tova } ; 
-            Pl => tovim
+			Def => table { Masc => defH tov ; Fem => defH tova }  
-            } ; 
+            		} ; 
-          Fem => table {
+          Pl => table { 
-            Sg => tova ;
+			Indef => table {Masc => tovim ; Fem  => tovot } ; 
-            Pl => tovot
+			Def => table { Masc => defH tovim ; Fem  => defH tovot }  
-            }
+            		}
-          }
+	}
       } ;
     
-    regAdj : Str -> {s : Gender => Number => Str} = \tov ->
+      regAdj : Str -> Adj = \tov ->
 	case tov of { to + c@? =>
- 	adjective tov (replaceLastLetter (to + c + "ה" )) (replaceLastLetter (to + c +"ים" )) (replaceLastLetter (to + c + "ות" ))};	 
+	adjective tov (to + replaceLastLetter (c) + "ה" ) (to + replaceLastLetter (c) +"ים" ) (to + replaceLastLetter (c) + "ות" )};	 
      
-    irregAdj : Str -> {s : Gender => Number => Str} = \italki ->
+     regAdj2 : Str -> Adj = \italki ->
  	case italki of { italk+ c@? => 
- 	adjective italki (replaceLastLetter (italk + c +"ת" ))  (replaceLastLetter (italk + c+ "ים" )) (replaceLastLetter (italk + c+ "ות" ))};
+    adjective italki (italk + replaceLastLetter (c)  +"ת" )  (italk + replaceLastLetter (c)+ "ים" ) (italk + replaceLastLetter (c)  + "ות" )};
-    
+
 }  -- FoodsHeb