fix: make convert-to-jamo hook buffer-local

.dir-locals.el

@@ -0,0 +1,6 @@
+((nil
+  . ((eval
+      . (progn (add-to-list 'load-path (project-root (project-current)))
+               (require 'helpers)
+               (add-hook 'before-save-hook
+                         #'hangul-convert-buffer-to-jamo t))))))

helpers.el

@@ -0,0 +1,56 @@
+(defun hangul-syllables-to-jamo (str)
+  "Convert HANGUL SYLLABLES characters in STR to their HANGUL JAMO
+equivalents."
+  (let ((result "")
+	(i 0))
+    (while (< i (length str))
+      (let ((char (aref str i)))
+	(if (and (>= char #xAC00) (<= char #xD7A3))
+	    ;; Hangul syllable
+	    (let* ((code (- char #xAC00))
+		   (lead (/ code (* 21 28)))
+		   (medial (/ (% code (* 21 28)) 28))
+		   (final (% code 28))
+		   (lead-jamo (+ #x1100 lead))
+		   (medial-jamo (+ #x1161 medial))
+		   (final-jamo (if (> final 0) (+ #x11A7 final) nil)))
+	      (setq result
+		    (concat result (char-to-string lead-jamo)
+			    (char-to-string medial-jamo)
+			    (if final-jamo (char-to-string final-jamo) ""))))
+	  ;; Not a Hangul syllable
+	  (setq result (concat result (char-to-string char)))))
+      (setq i (1+ i)))
+    result))
+
+(defun hangul-convert-region-to-jamo (beg end)
+  (interactive "r")
+  (replace-region-contents
+   beg end (lambda ()
+	     (hangul-syllables-to-jamo (buffer-substring (point-min)
+							 (point-max))))))
+
+(defun hangul-convert-buffer-to-jamo ()
+  (interactive)
+  (hangul-convert-region-to-jamo (point-min) (point-max))
+  (message "Converted Hangul Syllables in buffer to Jamo."))
+
+(require 'dash)
+
+(defconst gf-hangul/choseong
+  (cl-loop for i from #x1100 to #x1112 collect i))
+
+(defconst gf-hangul/jungseong
+  (cl-loop for i from #x1161 to #x1175 collect i))
+
+(defconst gf-hangul/batchim
+  (cl-loop for i from #x11a8 to #x11c2 collect i))
+
+(defun gf-hangul/make-pattern (name seq)
+  (format "'%s' : pattern Str = #(%s) ;"
+	  name (->> seq
+		    (--map (concat "\"" it "\""))
+		    (-interpose " | ")
+		    (apply #'concat))))
+
+(provide 'helpers)

lab1/grammar/korean/HangulCoding.gf

@@ -1,6 +0,0 @@
-resource HangulCoding = open HangulCodingRes in {
-  flags coding=utf8 ;
-  oper
-    this_uses_syllables : Str = coding "가" ;
-    this_uses_jamo : Str = coding "가" ;
-}

lab1/grammar/korean/HangulCodingRes.gf

@@ -1,9 +0,0 @@
-resource HangulCodingRes = {
-  flags coding=utf8 ;
-  oper
-    coding : Str -> Str
-      = \s -> case s of {
-        "가" => "SYLLABLES" ;
-        "가" => "JAMO"
-      } ;
-}

lab1/grammar/korean/HangulJamo.gf

@@ -9,13 +9,21 @@ resource HangulJamo = open Prelude in {
 
     infinitive : (stem : Str) -> Str
       = \stem -> case stem of {
-        _ + #a_o + #batchim => stem + "아" ;
+	-- 하다 ⇒ 해
-        _ + (#a | #eo) => stem ;
-        init + #o => init + "ᅪ" ;
-        init + #eu => init + "ᅥ" ;
-        init + #i => init + "ㅕ" ;
-        init + #u => init + "ᅯ" ;
 	init + #ha => init + "해" ;
+	-- 찾다 ⇒ 찾아, 좁다 ⇒ 좁아
+        _ + #a_o + #batchim => stem + "아" ;
+	-- 가다 ⇒ 가, 
+        _ + (#a | #eo) => stem ;
+	-- 오다 ⇒ 와
+        init + #o => init + "ᅪ" ;
+	-- 따르다 ⇒ 따러
+        init + #eu => init + "ᅥ" ;
+	-- 기다리다 ⇒ 기다려
+        init + #i => init + "ᅧ" ;
+	--
+        init + #u => init + "ᅯ" ;
+	-- 맛있다 ⇒ 맛있어
         _ => stem + "어"
       } ;
 
@@ -25,6 +33,12 @@ resource HangulJamo = open Prelude in {
     past_haeyo : (stem : Str) -> Str
       = \stem -> infinitive stem + "ᆻ어요" ;
 
+    vc_allomorph : (s,vowel,consonant : Str) -> Str
+      = \s,v,c -> case s of {
+	_ + #vowel => v ;
+	_ => c
+      } ;
+
   oper
     a_o : pattern Str = #("ᅡ" | "ᅩ") ;
     a : pattern Str = #"ᅡ" ;

lab1/grammar/korean/MicroLangKor.gf

@@ -26,9 +26,9 @@ concrete MicroLangKor of MicroLang = open MicroResKor, Prelude in {
     Adv = {s : Str} ;
 
   lin
-    UttS s = s ;
+    UttS s = {s = s.s} ;
     UttNP np = {s = np.s} ;
-    -- PredVPS np vp = {s = np.s ++ vp.compl ++ vp.verb.s} ;
+    PredVPS np vp = {s = np.s ++ vp.compl ++ vp.verb.s ! VPresent} ;
     UseV v = {verb = v ; compl = []} ;
     ComplV2 v2 np = {verb = v2 ; compl = np.s};
     UseN n = n ;
@@ -41,6 +41,8 @@ concrete MicroLangKor of MicroLang = open MicroResKor, Prelude in {
     thisPl_Det = {s = "이"} ;
     that_Det = {s = "그"} ;
     thatPl_Det = {s = "그"} ;
+    PositA a = a ;
+    AdjCN ap cn = {s = ap.s ! VAdnomial ++ cn.s} ;
 
 -----------------------------------------------------
 ---------------- Lexicon part -----------------------
@@ -50,9 +52,9 @@ concrete MicroLangKor of MicroLang = open MicroResKor, Prelude in {
 lin animal_N = mkN "동물" ;
 lin apple_N = mkN "사과" ;
 lin baby_N = mkN "아기" ;
--- lin bad_A = mkA "나쁜" ;
+lin bad_A = mkA "나쁘다" ;
 -- lin beer_N = mkN "beer" ;
--- lin big_A = mkA "큰" ;
+lin big_A = mkA "크다" ;
 -- lin bike_N = mkN "bike" ;
 -- lin bird_N = mkN "bird" ;
 -- lin black_A = mkA "black" ;
@@ -63,31 +65,30 @@ lin book_N = mkN "책" ;
 lin boy_N = mkN "소녁" ;
 lin bread_N = mkN "빵" ;
 -- lin break_V2 = mkV2 (mkV "break" "broke" "broken") ;
--- lin buy_V2 = mkV2 (mkV "buy" "bought" "bought") ;
+lin buy_V2 = mkV2 "사다" ;
 lin car_N = mkN "자동차" ;
 lin cat_N = mkN "고양이" ;
 lin child_N = mkN "어린이" ;
 -- lin city_N = mkN "city" ;
--- lin clean_A = mkA "정소한" ;
+lin clean_A = mkA "정소하다" ;
--- lin clever_A = mkA "똑똑한" ;
+lin clever_A = mkA "똑똑하다" ;
 -- lin cloud_N = mkN "cloud" ;
 -- lin cold_A = mkA "차가운" ;
--- lin come_V = regVerb "오다" ; -- JAMO
+lin come_V = mkV "오다" ;
-lin come_V = regVerb "오다" ; -- SYLLABLES
 lin computer_N = mkN "컴퓨터" ;
 -- lin cow_N = mkN "cow" ;
 -- lin dirty_A = mkA "더러운" ;
 lin dog_N = mkN "개" ;
--- lin drink_V2 = mkV2 (mkV "drink" "drank" "drunk") ;
+lin drink_V2 = mkV2 "마시다" ;
--- lin eat_V2 = mkV2 (mkV "eat" "ate" "eaten") ;
+lin eat_V2 = mkV2 "먹다" ;
--- lin find_V2 = mkV2 (mkV "find" "found" "found") ;
+lin find_V2 = mkV2 "찾다" ;
 -- lin fire_N = mkN "fire" ;
 lin fish_N = mkN "생선" ;
 -- lin flower_N = mkN "flower" ;
 lin friend_N = mkN "진구" ;
 lin girl_N = mkN "소녀" ;
 -- lin good_A = mkA "좋은" ;
--- lin go_V = mkV "go" "went" "gone" ;
+lin go_V = mkV "가다" ;
 -- lin grammar_N = mkN "grammar" ;
 -- lin green_A = mkA "green" ;
 -- lin heavy_A = mkA "heavy" ;
@@ -96,8 +97,8 @@ lin girl_N = mkN "소녀" ;
 lin house_N = mkN "집" ;
 -- lin john_PN = mkPN "John" ;
 -- lin jump_V = mkV "jump" ;
--- lin kill_V2 = mkV2 "kill" ;
+lin kill_V2 = mkV2 "죽다" ;
--- lin know_VS = mkVS (mkV "know" "knew" "known") ;
+-- lin know_V2 = mkV "알다" ;
 lin language_N = mkN "언어" ;
 -- lin live_V = mkV "live" ;
 -- lin love_V2 = mkV2 (mkV "love") ;
@@ -105,29 +106,29 @@ lin man_N = mkN "남자" ;
 lin milk_N = mkN "우유" ;
 lin music_N = mkN "음악" ;
 -- lin new_A = mkA "new" ;
--- lin now_Adv = mkAdv "지금" ;
+lin now_Adv = mkAdv "지금" ;
 -- lin old_A = mkA "낡안" ;
 -- lin paris_PN = mkPN "Paris" ;
--- lin play_V = mkV "놀" ;
+lin play_V = mkV "놀다" ;
--- lin read_V2 = mkV2 (mkV "read" "read" "read") ;
+lin read_V2 = mkV2 "읽다" ;
 -- lin ready_A = mkA "ready" ;
 -- lin red_A = mkA "red" ;
-lin river_N = mkN "river" ;
+lin river_N = mkN "강" ;
 -- lin run_V = mkV "run" "ran" "run" ;
 lin sea_N = mkN "바다" ;
--- lin see_V2 = mkV2 (mkV "see" "saw" "seen") ;
+lin see_V2 = mkV2 "보다" ;
 -- lin ship_N = mkN "ship" ;
--- lin sleep_V = regVerb "자다" ;
+lin sleep_V = mkV "자다" ;
 -- lin small_A = mkA "작은" ;
 lin star_N = mkN "별" ;
--- lin swim_V = mkV "swim" "swam" "swum" ;
+lin swim_V = mkV "수영하다" ;
--- lin teach_V2 = mkV2 (mkV "teach" "taught" "taught") ;
+lin teach_V2 = mkV2 "가르치다" ;
 -- lin train_N = mkN "train" ;
 -- lin travel_V = mkV "travel" ;
 -- lin tree_N = mkN "tree" ;
 -- lin understand_V2 = mkV2 (mkV "understand" "understood" "understood") ;
--- lin wait_V2 = mkV2 "wait" "for" ;
+lin wait_V2 = mkV2 "기다리다" ;
--- lin walk_V = mkV "walk" ;
+lin walk_V = mkV "걷다" ;
 -- lin warm_A = mkA "따뜻한" ;
 lin water_N = mkN "물" ;
 -- lin white_A = mkA "하얗은" ;
@@ -144,12 +145,21 @@ oper
   mkN : Str -> Noun
     = \s -> lin N {s = s} ;
 
-  -- mkA : Str -> A
+  mkV : Str -> V = \lemma -> lin V (regVerb lemma) ;
-  --   = \stem -> lin A (mkV stem) ;
+
+  mkV2 = overload {
+    mkV2 : Str -> V2
+      = \lemma -> lin V2 (mkV lemma) ;
+    mkV2 : V -> V2
+      = \v -> lin V2 v ;
+    } ;
 
   mkAdv : Str -> Adv
     = \s -> lin Adv {s = s} ;
 
   mkPrep : Str -> Prep
     = \s -> lin Prep {s = s} ;
+
+  mkA : Str -> A
+    = \lemma -> lin A (regAdjective lemma) ;
 }

lab1/grammar/korean/MicroResKor.gf

@@ -1,6 +1,6 @@
 resource MicroResKor = open Prelude, HangulJamo in {
   param
-    VForm = Lemma | VPresent | VPast ;
+    VForm = VLemma | VPresent | VPast | VAdnomial ;
 
   oper
     Noun : Type = {s : Str} ;
@@ -14,14 +14,21 @@ resource MicroResKor = open Prelude, HangulJamo in {
 	_ => Predef.error ("lemmaToStem was applied to a non-lemma," ++ lemma)
       } ;
 
-    regVerb : (lemma : Str) -> Verb
+    reg : (descriptive : Bool) -> (lemma : Str) -> Verb
-      = \lemma ->
+      = \descriptive,lemma ->
       let stem = lemmaToStem lemma ;
       in {
 	s = table {
-	  Lemma => lemma ;
+	  VLemma => lemma ;
 	  VPresent => present_haeyo stem ;
-	  VPast => past_haeyo stem
+	  VPast => past_haeyo stem ;
+	  VAdnomial =>
+	    if_then_else Str descriptive
+	      (stem + vc_allomorph stem "ᆫ" "은")
+	      (stem + "는")
 	  }
       } ;
+
+    regVerb : (lemma : Str) -> Verb = reg False ;
+    regAdjective : (lemma : Str) -> Adjective = reg True ;
 }