From 65d5990607e9542aa847ec7cb684afd3ffdedb8f Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 27 Aug 2021 13:15:35 +0200
Subject: Update

---
 src/lib/parser.mly        |  33 +++++++++------
 src/lib/process.ml        |  50 ++++++++++++++++++-----
 src/lib/prononciation.mly |  21 ++++++----
 src/lib/sounds.ml         | 101 +++++++++++++++++++++++++++++++++-------------
 src/lib/tokens.mly        |  10 ++---
 src/test/test.ml          |  12 ++++--
 6 files changed, 161 insertions(+), 66 deletions(-)

(limited to 'src')

diff --git a/src/lib/parser.mly b/src/lib/parser.mly
index b4b7817..2a94839 100644
--- a/src/lib/parser.mly
+++ b/src/lib/parser.mly
@@ -25,7 +25,7 @@ occlusiv:
   | B               { T.b }
 
   | T               { T.t }
-  | D               { T.none }
+  | D               { T.d }
 
   | K               { T.k }
   | G               { T.none }
@@ -48,7 +48,18 @@ liquid:
   | R               { T.r () }
 
 nasal:
-  | N               { T.n () }
+  | N               { T.n }
+  | M               { T.m }
+
+consonant: 
+  | occlusiv        { $1 }
+  | fricativ        { $1 }
+  | liquid          { $1 }
+  | nasal           { $1 }
+
+semi_voyel: 
+  | Y               { T.none }
+  | W               { T.semi_voyel_w }
 
 opening_consonant:
   | occlusiv            { $1, None }
@@ -57,35 +68,33 @@ opening_consonant:
   | liquid              { $1, None }
   | obstruent liquid    { $1, Some $2 }
   | occlusiv fricativ   { $1, Some $2 }
+  | consonant semi_voyel{ $1, Some $2 }
+  | semi_voyel          { $1, None }
+
 
 (* Each voyel as two associated sounds, depending there is a followng sound or
    not *)
 voyels:
   | A               { T.a  `Opened , T.a  `Opened }
-  | A I             { T.e  `Opened,  T.e  `Opened }
+  | A I             { T.e  `Opened , T.e  `Opened }
   | I               { T.i  `Opened , T.i  `Opened }
-  | E               { T.schwa ()   , T.schwa () }
+  | E               { T.e  `Opened , T.schwa () }
   | E_ACUTE E?      { T.e  `Closed , T.e  `Closed }
   | E U             { T.eu `Opened , T.eu `Opened }
   | O               { T.o  `Opened , T.o  `Opened }
-  | A_NASAL         { T.nasal (T.a  `Opened), T.nasal (T.a  `Opened) }
+  | U               { T.u          , T.u          }
 
 nasal_voyels:
   | A N             { T.a' ()      , T.a' ()      }
   %prec Low
 
 ending_consonant: 
+  | B               { Some (T.b ) }
   | S               { Some (T.s ()) }
   | T               { None }
   | R               { Some (T.r ()) }
   | nasal           { Some $1 }
 
-ending_word: 
-  | X               { Some (T.muted (T.s ())) }
-  | S               { Some (T.muted (T.s ())) }
-  | R               { Some (T.muted (T.r ())) }
-  | T               { Some (T.muted T.t) }
-
 consonant_group:
   | opening_consonant 
     { 
@@ -113,7 +122,7 @@ syllables:
     
 
 word:
-  | syllables ending_word? EOL { P.rebuild $2 $1 }
+  | syllables consonant_group? EOL { P.rebuild $2 $1 }
 
 main: 
   | word { $1 }
diff --git a/src/lib/process.ml b/src/lib/process.ml
index 10b2945..01c6d4a 100644
--- a/src/lib/process.ml
+++ b/src/lib/process.ml
@@ -48,6 +48,8 @@ module M(T:Sounds.T) = struct
             , c )
           , None )
 
+  (** Transform the S into Z if the S is the opening consonant and
+      there is no ending consonant before *)
   let vocalize_s
     : modifier
     = fun init ->
@@ -55,33 +57,60 @@ module M(T:Sounds.T) = struct
 
       match c with
       | None -> init
-      | Some op -> match op.opening, op.ending with
-        | hd::[], None when T.code hd = T.SZ ->
+      | Some op ->
+        (* The voyel may be none in case of ending word. In such case, we shall
+           not trnasform the S into Z *)
+        let is_voyel = T.is_voyel v1 && T.is_voyel v2 in
+        match is_voyel, op.opening, op.ending with
+        | true, hd::[], None when T.code hd = T.SZ ->
           let c = Some { op with opening = [T.z ()] } in
           (((v1, v2), c) , ending)
         | _ -> init
 
+  (** Mute the last consonant if there is no voyel in the syllabus.
+
+      This modifier is only applied in the first step, and not repeated anymore.
+  *)
+  let mute_consonant
+    : modifier
+    = fun init ->
+      let (((v1, v2), c) , ending) = init in
+      let is_voyel = T.is_voyel v1 && T.is_voyel v2 in
+      match is_voyel, c with
+      | false, Some c ->
+        let c = { c with opening = List.map ~f:T.muted c.opening } in
+        (((v1, v2), Some c) , ending)
+      | _ -> init
+
+  let change_voyel
+    = fun init ->
+      let (((v1, v2), _) , ending) = init in
+      match ending with
+      | None -> v2
+      | Some _ -> v1
+
   let rec _rebuild ~(m:modifier list) acc ending_consonant : group list -> T.t list
     = function
       | [] -> acc
       | hd::tl ->
 
-        let modifier_ = vocalize_s :: nasal :: m in
+        let modifier = vocalize_s :: nasal :: m in
         let (voyel, consonants), ending_consonant =
           apply_modifiers
             (hd, ending_consonant)
-            modifier_  in
+            modifier  in
+        let voyel = change_voyel ((voyel, consonants), ending_consonant) in
 
         (* Add the last consonant and the voyel *)
         let m, acc = match ending_consonant with
-          | None -> modifier_, (snd voyel)::acc
+          | None -> modifier, voyel::acc
           | Some s ->
-            let default = modifier_, (fst voyel) :: acc in
+            let default = modifier, voyel :: acc in
             match s with
             | None -> default
             | Some s ->
 
-              modifier_, (fst voyel) :: s::acc  in
+              modifier, voyel :: s::acc  in
 
         match consonants with
         | None -> _rebuild ~m acc None tl
@@ -108,8 +137,11 @@ module M(T:Sounds.T) = struct
 
   *)
   let rebuild
-    : T.t option option -> group list -> T.t list
+    : consonants option -> group list -> T.t list
     = fun  ending elems ->
-      _rebuild ~m:[] [] ending elems
+      let elems' = match ending with
+        | None -> elems
+        | Some _ -> ((T.none, T.none), ending)::elems in
+      _rebuild ~m:[mute_consonant] [] None elems'
 
 end
diff --git a/src/lib/prononciation.mly b/src/lib/prononciation.mly
index f865abd..3195078 100644
--- a/src/lib/prononciation.mly
+++ b/src/lib/prononciation.mly
@@ -14,11 +14,13 @@
 %%
 
 initial_voyel:
-  | A { A }
-  | E { E }
-  | I { I }
-  | O { O }
-  | U { U }
+  | A   { A }
+  | A U { O }
+  | E   { E }
+  | I   { I }
+  | O   { O }
+  | U   { U }
+  | U I { UI }
   | E_ACUTE { E_ACUTE }
 
 voyel: 
@@ -46,11 +48,16 @@ letters:
   | letters G U I   { I :: G :: $1 }
   | letters G U E   { E :: G :: $1 }
 
+  | letters I L L   { Y :: $1 }
   | letters J       { J :: $1 }
   | letters K       { K :: $1 }
   | letters L       { L :: $1 }
   | letters M       { M :: $1 }
+  | letters M M     { M :: $1 }
   | letters N       { N :: $1 }
+  | letters N N     { N :: $1 }
+
+
   | letters P       { P :: $1 }
   | letters P H     { F :: $1 }
 
@@ -62,9 +69,9 @@ letters:
   | letters T       { T :: $1 }
 
   | letters V       { V :: $1 }
-  | letters W       { V :: $1 }
+  | letters W       { W :: $1 }
   | letters X       { S :: K :: $1 }
-  | letters Y       { I :: $1 }
+  | letters Y       { Y :: $1 }
 
   | letters Z       { Z :: $1 }
 
diff --git a/src/lib/sounds.ml b/src/lib/sounds.ml
index 0ee9f5c..a2035b7 100644
--- a/src/lib/sounds.ml
+++ b/src/lib/sounds.ml
@@ -10,6 +10,7 @@ module type T = sig
   val o : [`Closed | `Opened] -> t
   val schwa : unit -> t
   val i : [`Closed | `Opened] -> t
+  val u : t
 
 
   val nasal: t -> t
@@ -19,6 +20,7 @@ module type T = sig
   val p: t
   val b: t
   val t: t
+  val d: t
   val k: t
   val f: t
   val s: unit -> t
@@ -26,17 +28,22 @@ module type T = sig
   val ch: unit -> t
   val z: unit -> t
 
-  val n: unit -> t
+  val n: t
+  val m: t
 
   val r: unit -> t
   val l: unit -> t
 
+  val semi_voyel_w: t
+
   val is_voyel : t -> bool
   val is_nasal : t -> bool
 
   type code =
     | None
     | SZ
+    | Voyel_A
+    | Voyel_O
 
   val code : t -> code
 
@@ -50,6 +57,8 @@ module T = struct
   type code =
     | None
     | SZ
+    | Voyel_A
+    | Voyel_O
 
   type t =
     { code : code
@@ -66,8 +75,34 @@ module Repr = struct
   let a = "a"
   and a_nasal = "@"
 
+  and o = "o"
   and o_nasal = "§"
 
+  and i = "i"
+  and u = "y"
+
+  and p = "p"
+  and b = "b"
+  and t = "t"
+  and d = "d"
+
+  and k = "k"
+  and g = "g"
+
+  and f = "f"
+
+  and ch = "S"
+
+  and s = "s"
+  and z = "z"
+
+  and m = "m"
+  and n = "n"
+
+  and l = "L"
+  and r = "R"
+
+  and w = "w"
 end
 
 module S = struct
@@ -78,18 +113,21 @@ module S = struct
   let is_nasal t = t.nasal
 
   let none =
-    { repr = "."
+    { repr = ""
     ; muted = false
     ; kind = None
     ; nasal = false
     ; code = None }
 
+  let voyel =
+    { none with kind = Voyel }
+
   let code t = t.code
 
   let nasal t =
-    match t.repr with
-    | "a" -> { t with repr = Repr.a_nasal ; nasal = true }
-    | "o" -> { t with repr = Repr.o_nasal ; nasal = true }
+    match t.code with
+    | Voyel_A -> { t with repr = Repr.a_nasal ; nasal = true }
+    | Voyel_O -> { t with repr = Repr.o_nasal ; nasal = true }
     | _ -> t
 
   let muted f =
@@ -98,64 +136,73 @@ module S = struct
     ; muted = true }
 
   let a _ =
-    { none with repr = Repr.a }
+    { voyel with repr = Repr.a ; code = Voyel_A }
 
   let e = function
-    | `Closed -> { none with repr = "e" }
-    | `Opened -> { none with repr = "E" }
+    | `Closed -> { voyel with repr = "e" }
+    | `Opened -> { voyel with repr = "E" }
 
   let eu = function
-    | `Closed -> { none with repr = "2" }
-    | `Opened -> { none with repr = "9" }
+    | `Closed -> { voyel with repr = "2" }
+    | `Opened -> { voyel with repr = "9" }
 
 
   let schwa () =
-    { none with repr = "°" }
+    { voyel with repr = "°" }
 
   let o _ =
-    { none with repr = "o" }
+    { voyel with repr = Repr.o ; code = Voyel_O }
 
   let i _ =
-    { none with repr = "i" }
+    { voyel with repr = Repr.i }
+
+  let u =
+    { voyel with repr = Repr.u }
 
   let p =
-    { none with repr = "p" }
+    { none with repr = Repr.p }
 
   let b =
-    { none with repr = "b" }
+    { none with repr = Repr.b }
 
   let t =
-    { none with repr = "t" }
+    { none with repr = Repr.t }
+
+  let d =
+    { none with repr = Repr.d }
 
   let k =
-    { none with repr = "k" }
+    { none with repr = Repr.k }
 
   let f =
-    { none with repr = "f" }
+    { none with repr = Repr.f }
 
   let s () =
-    { none with repr = "s" }
+    { none with repr = Repr.s }
 
   let sz () =
     { (s()) with code = SZ }
 
   let ch () =
-    { none with repr = "S" }
+    { none with repr = Repr.ch }
 
   let z () =
-    { none with repr = "z" }
+    { none with repr = Repr.z }
 
-  let n () =
-    { none with
-      repr = "n"
-    ; nasal = true }
+  let n =
+    { none with repr = Repr.n ; nasal = true }
+
+  let m =
+    { none with repr = Repr.m ; nasal = true }
 
   let l () =
-    { none with repr = "L" }
+    { none with repr = Repr.l }
 
   let r () =
-    { none with repr = "R" }
+    { none with repr = Repr.r }
 
+  let semi_voyel_w =
+    { none with repr = Repr.w }
 end
 
 include S
diff --git a/src/lib/tokens.mly b/src/lib/tokens.mly
index 5346005..5466e90 100644
--- a/src/lib/tokens.mly
+++ b/src/lib/tokens.mly
@@ -1,10 +1,5 @@
 %token Sep
 
-%token A_NASAL
-%token O_NASAL
-%token I_NASAL
-
-
 %token A
 %token B
 %token C
@@ -28,10 +23,11 @@
 %token SZ
 %token T
 %token U
+%token UI
 %token V
-%token W
+%token W (* semi voyel w *)
 %token X
-%token Y
+%token Y (* semi voyel j *)
 %token Z
 %token Space
 %token EOL
diff --git a/src/test/test.ml b/src/test/test.ml
index 5d1d09c..a8ac890 100644
--- a/src/test/test.ml
+++ b/src/test/test.ml
@@ -46,8 +46,13 @@ let tests =
   ; "abaissées",    "abEse(s)"
   ; "abaissera",    "abEs°Ra"
   ; "achat",        "aSa(t)"
+  ; "ani",          "ani"
+  ; "anta",         "@ta"
+  ; "arachide",     "aRaSid°"
   ; "as",           "a(s)"
+  ; "asia",         "azia"
   ; "astiqué",      "astike"
+  ; "autruche",     "otRyS°"
   ; "casait",       "kazE(t)"
   ; "cassait",      "kasE(t)"
   ; "chanci",       "S@si"
@@ -55,11 +60,10 @@ let tests =
   ; "chipant",      "Sip@(t)"
   ; "pacha",        "paSa"
   ; "péché",        "peSe"
-  ; "persai",       "pERse"
-  ; "asia",         "azia"
-  ; "ani",          "ani"
-  ; "anta",         "@ta"
+  ; "persai",       "pERsE"
   ; "plat",         "pLa(t)"
+  ; "platte",       "pLat°"
+  ; "web",          "wEb"
   ]
 
 let () =
-- 
cgit v1.2.3