Merge pull request #331 from inariksit/korean

Korean: Adv + politeness

src/korean/CatKor.gf

@@ -8,7 +8,7 @@ concrete CatKor of Cat = CommonX ** open ResKor, Prelude in {
 -- Constructed in SentenceKor, and also in IdiomKor
 
     S  = ResKor.Sentence ;
-    QS = SS ; -- Questions not implemented yet
+    QS = {s : Style => Str}; -- Questions not implemented yet
     RS = ResKor.Sentence ;
     -- relative sentence. Tense and polarity fixed,
     -- but agreement may depend on the CN/NP it modifies.
@@ -65,8 +65,7 @@ concrete CatKor of Cat = CommonX ** open ResKor, Prelude in {
     Predet = {s : Phono => Str ; p : Phono} ;
     Quant = ResKor.Quant ;
     Num = ResKor.Num ;
-    Ord = {
+    Ord = ResKor.Adjective ** { -- Ord can come from AP and become AP again
-      s : VForm => Str ; -- Ord can come from AP and become AP again
       n : Number -- Ord can come from Num, which has inherent number
       } ;
     DAP = ResKor.Determiner ;
@@ -119,5 +118,7 @@ concrete CatKor of Cat = CommonX ** open ResKor, Prelude in {
     PN = ResKor.NounPhrase ;
 
 linref
-  V, V2, V3, VP = linVerb ;
+  V, V2, V3 = linVerb ;
+  VP = linVP linVF ;
+  AP = linAP ;
 }

src/korean/ConjunctionKor.gf

@@ -39,11 +39,11 @@ oper
   ConjSS : Type = {s : ConjType => Str} ;
 
   baseSS : SS -> SS -> ConjSS = \s1,s2 -> {
-    s = \\conj => glue s1.s (conjTable ! NStar ! conj) ++ s2.s ;
+    s = \\conj => glue s1.s (conjTable ! NStar ! conj ! Vowel) ++ s2.s ; -- TODO check phono
     } ;
 
   consSS : SS -> ConjSS -> ConjSS = \s,ss -> ss ** {
-    s = \\conj => glue s.s (conjTable ! NStar ! conj) ++ ss.s ! conj ;
+    s = \\conj => glue s.s (conjTable ! NStar ! conj ! Vowel) ++ ss.s ! conj ;
     } ;
 
   conjSS : Conj -> ConjSS -> SS = \co,ss -> {
@@ -79,7 +79,7 @@ lin
 
 oper
   mkFirstS : ResKor.Sentence -> ConjType => Str = \s ->
-    \\conj => glue (s.s ! WithConj) (conjTable ! VStar ! conj) ;
+    \\conj => glue (s.s ! WithConj) (conjTable ! VStar ! conj ! s.p) ;
 
 lincat
   [AP] = ResKor.AdjPhrase ** {firstAP : VForm => ConjType => Str} ;
@@ -101,7 +101,8 @@ lin
 
 oper
   mkFirstAP : ResKor.AdjPhrase -> VForm => ConjType => Str = \ap ->
-    \\af,conj => ap.compar ++ glue (ap.s ! VStem Pos) (conjTable ! VStar ! conj) ;
+    \\af,conj => ap.compar
+              ++ glue (ap.s ! VStem Pos) (conjTable ! VStar ! conj ! ap.p) ;
 
 {-
 lincat
@@ -137,7 +138,7 @@ lin
 
 oper
   mkFirstNP : ResKor.NounPhrase -> ConjType => Str = \np ->
-    \\conj => glue (np.s ! Bare) (conjTable ! NStar ! conj) ;
+    \\conj => glue (np.s ! Bare) (conjTable ! NStar ! conj ! np.p) ;
     -- Versions with commas, no repeated conjunctions
 
   baseNPcomma : NP -> NP -> ListNP = \x,y -> y ** {

src/korean/NounKor.gf

@@ -123,7 +123,7 @@ concrete NounKor of Noun = CatKor ** open ResKor, Prelude in {
   --   } ;
 
   -- : A       -> Ord ;
-  OrdSuperl a = {
+  OrdSuperl a = a ** {
     s = \\vf => "가장" ++ a.s ! vf ;
     n = Sg -- ?? is this meaningful?
     } ;
@@ -171,7 +171,7 @@ concrete NounKor of Noun = CatKor ** open ResKor, Prelude in {
 
   -- : CN -> Adv -> CN ;
   AdvCN cn adv = cn ** {
-    rs = cn.rs ++ adv.s
+    rs = adv.s ++ cn.rs
     } ;
 
 -- Nouns can also be modified by embedded sentences and questions.

src/korean/ParadigmsKor.gf

@@ -149,7 +149,7 @@ oper
     mkA : (plain,polite,formal,attr : Str) -> A
       = \x1,x2,x3,x4 -> lin A (mkAdjReg x1 x2 x3 x4) ;
     mkA : (jaemi : Str) -> (itda : V) -> A
-      = \jaemi,itda -> lin A ({s = \\vf => jaemi ++ itda.s ! vf}) ;
+      = \jaemi,itda -> lin A (itda ** {s = \\vf => jaemi ++ itda.s ! vf}) ;
     } ;
 
   mkA2 = overload {

src/korean/PhraseKor.gf

@@ -3,8 +3,8 @@ concrete PhraseKor of Phrase = CatKor ** open Prelude, ResKor in {
   lin
     PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ;
 
-    UttS s = {s = s.s ! Statement} ;
+    UttS s = {s = s.s ! Statement linStyle} ;
-    UttQS qs = qs ;
+    UttQS qs = {s = qs.s ! linStyle} ;
     UttIAdv iadv = iadv ;
     UttAdv adv = adv ;
     UttInterj i = i ;
@@ -16,7 +16,7 @@ concrete PhraseKor of Phrase = CatKor ** open Prelude, ResKor in {
     UttIP ip = {s = ip.s ! Bare} ;
 
     UttNP np = {s = np.s ! Bare} ;
-    UttVP vp = {s = linVP vp} ;
+    UttVP vp = {s = linVP linVF vp} ;
     UttCN cn = {s = cn.rs ++ cn.s ! Bare} ;
     UttCard n = {s = n.s ! NK ! Indep} ;
     UttAP ap = {s = ap.compar ++ ap.s ! VF Plain Pos} ;

src/korean/RelativeKor.gf

@@ -6,7 +6,7 @@ lin
   RelCl = relSlash (ss "") ;
 
   -- : RP -> VP -> RCl ;
-  RelVP rp vp = { -- TODO no tenses yet in the grammar
+  RelVP rp vp = vp ** { -- TODO no tenses yet in the grammar
     s = \\t,a,p,cltyp =>
            rp.s ++ vp.adv ++ vp.nObj ++
            case cltyp of {
@@ -25,7 +25,7 @@ lin
   --FunRP prep np rp = {} ;
 
 oper
-  relSlash : SS -> ClSlash -> ResKor.RClause = \rp,cls -> {
+  relSlash : SS -> ClSlash -> ResKor.RClause = \rp,cls -> cls ** {
     s = \\t,a,p,cltyp => rp.s ++
           case cltyp of {
             WithConj => cls.s ! t ! a ! p ! WithConj ;

src/korean/ResKor.gf

@@ -142,10 +142,13 @@ oper
 --------------------------------------------------------------------------------
 -- Adjectives
 
-  Adjective : Type = {s : VForm => Str} ; -- Adjectives are verbs
+  Adjective : Type = {
+    s : VForm => Str ; -- Adjectives are verbs
+    p, pNeg : Phono ; -- needed for attaching conjunction
+    } ;
   Adjective2 : Type = Adjective ** {c2 : NForm ; p2 : Postposition} ;
 
-  v2a : (attrpos : Str) -> Verb -> Adjective = \attrpos,v -> {
+  v2a : (attrpos : Str) -> Verb -> Adjective = \attrpos,v -> v ** {
     s = table {
           VAttr Pos => attrpos ; -- Positive Attr is different in
           vf => v.s ! vf } -- adjectives, otherwise adj forms == verb forms.
@@ -168,6 +171,7 @@ oper
 
   BaseVerb : Type = {
     sc : NForm ; -- subject case
+    p, pNeg : Phono ; -- needed for attaching conjunction
     } ;
   Verb : Type = BaseVerb ** {
     s : VForm => Str ;
@@ -208,7 +212,7 @@ oper
     \stem,attrpos,attrneg,plain,polite,formal,planeg,polneg,formneg -> {
       s = table {
         VStem Pos => stem ;
-        VStem Neg => stem + "지" ++ "않" ;
+        VStem Neg => init planeg ;
         VAttr Pos => attrpos ;
         VAttr Neg => attrneg ;
         VF Plain Pos => plain ;
@@ -218,7 +222,9 @@ oper
         VF Formal Pos => formal ;
         VF Formal Neg => formneg
       } ;
-      sc = Subject
+      sc   = Subject ;
+      p    = if_then_else Phono (vowFinal stem)          Vowel Consonant ;
+      pNeg = if_then_else Phono (vowFinal (init planeg)) Vowel Consonant ;
     } ;
 
   copula : Verb = mkVerbFull
@@ -335,12 +341,14 @@ oper
     nObj = np.s ! v2.c2 ++ v2.p2.s ! np.p
   } ;
 
-  insertAdv : VerbPhrase -> SS -> VerbPhrase = \vp,adv -> vp ** {adv = adv.s} ;
+  insertAdv : VerbPhrase -> SS -> VerbPhrase = \vp,adv -> vp ** {adv = adv.s ++ vp.adv} ;
   insertAdvSlash : VPSlash -> SS -> VPSlash = \v,a -> v ** insertAdv v a ;
 --------------------------------------------------------------------------------
 -- Cl, S
 
-  Clause : Type = {s : Tense => Anteriority => Polarity => ClType => Str} ;
+  Clause : Type = {
+    s : Tense => Anteriority => Polarity => ClType => Str ;
+    p, pNeg : Phono} ;
 
   {- After PredVP, we might still want to add more adverbs (QuestIAdv),
      but we're done with verb inflection.
@@ -351,7 +359,10 @@ oper
 
   RClause : Type = Clause ;
 
-  Sentence : Type = {s : ClType => Str} ;
+  Sentence : Type = {
+    s : ClType => Str ;
+    p : Phono -- Needed for attaching conjunction
+    } ;
 
   predVP : NounPhrase -> VerbPhrase -> ClSlash = \np,vp ->
     let npstr : Str = np.s ! vp.sc in predVP' npstr vp ;
@@ -361,7 +372,7 @@ oper
            let vf = case cltyp of {
                       Subord   => VAttr p ;
                       WithConj => VStem p ;
-                      _        => VF Polite p } -- TODO: more tenses, politeness
+                      Statement st => VF st p } -- TODO: more tenses
             in np
             ++ vp.nObj -- an object, not copula complement
             ++ vp.adv
@@ -372,6 +383,6 @@ oper
 -- linrefs
 
 linVerb : Verb -> Str = \v -> v.s ! linVF ;
-linVP : VerbPhrase -> Str = \vp -> vp.nObj ++ vp.adv ++ vp.s ! linVF ;
+linVP : VForm -> VerbPhrase -> Str = \vf,vp -> vp.nObj ++ vp.adv ++ vp.s ! vf ;
-
+linAP : AdjPhrase -> Str = \ap -> ap.compar ++ ap.s ! linVF ;
 }

src/korean/SentenceKor.gf

@@ -43,20 +43,29 @@ lin
   -- EmbedQS qs = { } ;
 
   -- : VP -> SC ;
-  EmbedVP vp = {s = vp.s ! VAttr Pos ++ "것이"} ;
+  EmbedVP vp = {s = linVP (VAttr Pos) vp ++ "것이"} ;
 
 --2 Sentences
 
   -- : Temp -> Pol -> Cl -> S ;
   UseCl t p cl = {
-    s = \\c => t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! c
+    s = \\c => t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! c ;
+    p = case p.p of { -- Phono of VStem
+          Pos => cl.p ;
+          Neg => cl.pNeg } ;
     } ;
 
   -- : Temp -> Pol -> QCl -> QS ;
-  UseQCl t p cl = {s = t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! Statement} ;
+  UseQCl t p cl = {
+    s = \\st => t.s ++ p.s ++ cl.s ! t.t ! t.a ! p.p ! Statement st} ;
 
   -- : Temp -> Pol -> RCl -> RS ;
-  UseRCl t p rcl = {s = \\c => t.s ++ p.s ++ rcl.s ! t.t ! t.a ! p.p ! c} ;
+  UseRCl t p rcl = {
+    s = \\c => t.s ++ p.s ++ rcl.s ! t.t ! t.a ! p.p ! c ;
+    p = case p.p of { -- Phono of VStem
+          Pos => rcl.p ;
+          Neg => rcl.pNeg } ;
+    } ;
 
   -- AdvS : Adv -> S  -> S ;            -- then I will go home
   AdvS = advS "" ;

src/korean/StructuralKor.gf

@@ -21,9 +21,9 @@ lin how8much_IAdv = ss "" ;
 lin when_IAdv = ss "" ;
 lin where_IAdv = ss "" :
 lin why_IAdv = ss "" :
-
+-}
-lin always_AdV = ss "" ;
+lin always_AdV = ss "항상" ;
-
+{-
 lin everywhere_Adv = ss "" ;
 lin here7from_Adv = ss "" ;
 lin here7to_Adv = ss "" ;

src/korean/SymbolKor.gf

@@ -39,7 +39,7 @@ lin
     s = \\nf => cn.s ! nf ++ i.s ! cn.c.origin ! Indep}) ;
 
   -- : Symb -> S ;
-  SymbS sy = {s = \\_ => sy.s} ;
+  SymbS sy = {s = \\_ => sy.s ; p = Vowel} ;
 
   -- : Symb -> Card ;
   SymbNum sy = baseNum ** {s = \\_,_ => sy.s} ;
@@ -47,7 +47,7 @@ lin
   -- : Symb -> Ord ;
   SymbOrd sy =
     let comp : Comp = VK.CompAdv (lin Adv sy)
-     in {s = comp.s ; n=Pl} ;
+     in {s = comp.s ; n = Pl ; p,pNeg = Vowel} ;
 
 lincat
   Symb, [Symb] = SS ;

src/korean/VerbKor.gf

@@ -89,17 +89,16 @@ lin
   -- : VPSlash -> Adv -> VPSlash ;  -- use (it) here
   AdvVPSlash = insertAdvSlash ;
 
-{-
+
   -- : VP -> Adv -> VP ;  -- sleep , even though ...
-  ExtAdvVP vp adv =  ;
+  -- ExtAdvVP vp adv =  ;
 
   -- : AdV -> VP -> VP ;  -- always sleep
-  AdVVP adv vp = vp ** {adv = adv} ;
+  AdVVP adv vp = vp ** {adv = vp.adv ++ adv.s} ;
-
 
   -- : AdV -> VPSlash -> VPSlash ;  -- always use (it)
-  AdVVPSlash adv vps = vps ** { adv = adv.s ++ vps.adv } ;
+  AdVVPSlash adv vps = vps ** { adv = vps.adv ++ adv.s} ;
--}
+
   -- : VP -> Prep -> VPSlash ;  -- live in (it)
   -- VPSlashPrep vp prep =
   --   let adv = prepNP prep emptyNP