From 3b8c136ebdba7f4b5b4d6baad08d0a75c3b2dc86 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sat, 28 Aug 2021 20:01:54 +0200
Subject: Update

---
 src/lib/modifiers/nasal.ml    |  24 ++++--
 src/lib/modifiers/sig.ml      |   4 +-
 src/lib/modifiers/vocalize.ml |   5 +-
 src/lib/parser.mly            |  58 +++++++++-----
 src/lib/prononciation.mly     |  22 +++---
 src/lib/sounds/sounds.ml      | 172 +++++++++++++++++++++++++++---------------
 src/lib/tokens.mly            |   8 --
 src/test/test.ml              |   6 +-
 8 files changed, 191 insertions(+), 108 deletions(-)

(limited to 'src')

diff --git a/src/lib/modifiers/nasal.ml b/src/lib/modifiers/nasal.ml
index b9874c9..fbaa35d 100644
--- a/src/lib/modifiers/nasal.ml
+++ b/src/lib/modifiers/nasal.ml
@@ -1,3 +1,17 @@
+let transform
+  : (module Sounds.T with type t = 'a) ->  'a Sig.consonants option -> 'a Sig.t -> 'a Sig.t
+  = fun (type el) m c init ->
+    let module T = (val m:Sounds.T with type t = el) in
+    let (((v1, v2), _) , _) = init in
+
+    begin match T.nasal v1, T.nasal v2 with
+      | Some t1, Some t2 ->
+        ( ( (t1, t2)
+          , c )
+        , None )
+      | _ -> init
+    end
+
 (** The Nasal modifier transform a voyel followed by N and a consonant
     into a nasal voyel.
 
@@ -13,11 +27,9 @@ let process
     let is_voyel = T.is_voyel v1 && T.is_voyel v2 in
     match ending, is_voyel, opening with
     | Some ending, _, _ when T.is_nasal ending ->
-      (* Remove the ending consonant, and transform the voyel into
-         the nasal form  *)
-      ( ( (T.nasal v1, T.nasal v2)
-        , c )
-      , None )
+      transform m c init
+    (* Remove the ending consonant, and transform the voyel into
+       the nasal form  *)
     | None, false, Some (opening::tl) when T.is_nasal opening ->
       (* If there is no voyel here, transform the opening consonant as an
          ending consonant for the next syllabus *)
@@ -27,7 +39,7 @@ let process
                Sig.opening = tl
              ; Sig.ending = (Some (Some opening))
              }) c in
-      ( ( (T.nasal v1, T.nasal v2)
+      ( ( (v1, v2)
         , c )
       , None )
     | _ ->
diff --git a/src/lib/modifiers/sig.ml b/src/lib/modifiers/sig.ml
index 938c50e..1485247 100644
--- a/src/lib/modifiers/sig.ml
+++ b/src/lib/modifiers/sig.ml
@@ -7,6 +7,6 @@ type 'a consonants =
 
 type 'a group = 'a voyel * 'a consonants option
 
-type 'a modifier = (module Sounds.T with type t = 'a) -> ('a group * 'a option option)  -> ('a group * 'a option option)
-
+type 'a t = 'a group * 'a option option
 
+type 'a modifier = (module Sounds.T with type t = 'a) -> 'a t  -> 'a t
diff --git a/src/lib/modifiers/vocalize.ml b/src/lib/modifiers/vocalize.ml
index 86a0502..6857718 100644
--- a/src/lib/modifiers/vocalize.ml
+++ b/src/lib/modifiers/vocalize.ml
@@ -13,8 +13,7 @@ let process
          not trnasform the S into Z *)
       let is_voyel = T.is_voyel v1 && T.is_voyel v2 in
       match is_voyel, op.Sig.opening, op.Sig.ending with
-      | true, hd::[], None when T.code hd = T.SZ ->
-        let c = Some { op with opening = [T.z ()] } in
+      | true, hd::[], None when hd = T.sz ->
+        let c = Some { op with opening = [T.z] } in
         (((v1, v2), c) , ending)
       | _ -> init
-
diff --git a/src/lib/parser.mly b/src/lib/parser.mly
index f12e2cc..68809fc 100644
--- a/src/lib/parser.mly
+++ b/src/lib/parser.mly
@@ -31,21 +31,22 @@ occlusiv:
   | G               { T.g }
 
 fricativ:
-  | S               { T.s () }
-  | SZ              { T.sz () }
-  | Z               { T.z () }
+  | S               { T.s }
+  | SZ              { T.sz }
+  | Z               { T.z }
 
   | F               { T.f }
+  | V               { T.v }
 
-  | X               { T.ch () }
+  | X               { T.ch }
 
 obstruent:
   | occlusiv        { $1 }
   | fricativ        { $1 }
 
 liquid:
-  | L               { T.l () }
-  | R               { T.r () }
+  | L               { T.l }
+  | R               { T.r }
 
 nasal:
   | N               { T.n }
@@ -58,7 +59,7 @@ consonant:
   | nasal           { $1 }
 
 semi_voyel: 
-  | Y               { T.none }
+  | Y               { T.semi_voyel_y }
   | W               { T.semi_voyel_w }
 
 opening_consonant:
@@ -83,10 +84,11 @@ voyels:
   | E_AGRAVE        { T.e  `Opened , T.e  `Opened }
   | E U             { T.eu `Opened , T.eu `Opened }
   | O               { T.o  `Opened , T.o  `Opened }
-  | U               { T.u          , T.u          }
-  | OU              { T.u'         , T.u'         }
+  | U               { T.voyel_y     , T.voyel_y   }
+  | OU              { T.voyel_u     , T.voyel_u   }
   | W A             { T.diphtongue T.semi_voyel_w T.a, T.diphtongue T.semi_voyel_w T.a}
   | W I             { T.diphtongue T.semi_voyel_w T.i, T.diphtongue T.semi_voyel_w T.a}
+  | I E             { T.diphtongue T.i (T.e `Opened), T.diphtongue T.i (T.e `Opened)}
 
 nasal_voyels:
   | A N             { T.a' ()      , T.a' ()      }
@@ -94,24 +96,40 @@ nasal_voyels:
 
 ending_consonant: 
   | B               { Some (T.b ) }
-  | S               { Some (T.s ()) }
   | T               { None }
-  | R               { Some (T.r ()) }
+  | liquid          { Some $1 }
   | nasal           { Some $1 }
 
 consonant_group:
-  | opening_consonant 
+  | f = fricativ
+    o = opening_consonant 
     { 
         { ending = None 
-        ; opening = [ fst $1 ]
-        ; following = snd $1  }
+        ; opening = f::(fst o)::[]
+        ; following = snd o  }
     }
-  | ending_consonant
-    opening_consonant 
+  | o = opening_consonant 
     { 
-        { ending = Some $1 
-        ; opening = [ fst $2 ]
-        ; following = snd $2  }
+        { ending = None 
+        ; opening = [ fst o ]
+        ; following = snd o  }
+    }
+  | e = ending_consonant
+    Sep?
+    o = opening_consonant 
+    { 
+        { ending = Some e
+        ; opening = [ fst o ]
+        ; following = snd o  }
+    }
+  | e = ending_consonant
+    Sep?
+    f = fricativ
+    o = opening_consonant 
+    { 
+        { ending = Some e
+        ; opening = f::[ fst o ]
+        ; following = snd o }
     }
 
 syllable:
@@ -128,7 +146,7 @@ syllables:
     
 
 word:
-  | syllables consonant_group? EOL { P.rebuild $2 $1 }
+  | Sep? syllables consonant_group? EOL { P.rebuild $3 $2 }
 
 main: 
   | word { $1 }
diff --git a/src/lib/prononciation.mly b/src/lib/prononciation.mly
index 5dbf153..6fe0d5f 100644
--- a/src/lib/prononciation.mly
+++ b/src/lib/prononciation.mly
@@ -13,20 +13,18 @@
 %start<Tokens.token list> main
 %%
 
-initial_voyel:
+voyel:
   | A           { A }
-  | A U         { O }
   | E           { E }
   | I           { I }
   | O           { O }
+  | A U         { O }
+  | E A U       { O }
   | O U         { OU }
   | U           { U }
   | E_ACUTE     { E_ACUTE }
   | E_AGRAVE    { E_AGRAVE }
 
-voyel: 
-  | initial_voyel { $1 }
-  
 
 letters:
   |                 { [] }
@@ -35,23 +33,28 @@ letters:
   | letters Sep     { Sep :: $1 }
 
   | letters B       { B :: $1 }
-  | letters C  %prec Low     { K :: $1 }
+  | letters C       { K :: $1 }
   | letters C H     { X :: $1 }
   | letters C I     { I :: S :: $1 }
   | letters C E     { E :: S :: $1 }
   | letters C U I   { I :: K :: $1 }
   | letters C U E   { E :: K :: $1 }
   | letters D       { D :: $1 }
+  | letters D D     { D :: $1 }
   | letters F       { F :: $1 }
-  | letters G %prec Low      { G :: $1 }
+  | letters G       { G :: $1 }
   | letters G I     { I :: J :: $1 }
   | letters G E     { E :: J :: $1 }
   | letters G U I   { I :: G :: $1 }
   | letters G U E   { E :: G :: $1 }
+  | letters H       { Sep :: $1 }
 
-  | letters I L L   { Y :: $1 }
   | letters J       { J :: $1 }
   | letters K       { K :: $1 }
+  | letters E L L   { L :: E_AGRAVE :: $1 }
+  | letters E L     { L :: E :: $1 }
+  | letters I L L   { Y :: I :: $1 }
+  | letters I L     { L :: I :: $1 }
   | letters L       { L :: $1 }
   | letters M       { M :: $1 }
   | letters M M     { M :: $1 }
@@ -68,6 +71,7 @@ letters:
 
   | letters R       { R :: $1 }
   | letters S S     { S :: $1 }
+  | letters S H     { X :: $1 }
   | letters S       { SZ :: $1 }
   | letters T       { T :: $1 }
 
@@ -79,4 +83,4 @@ letters:
   | letters Z       { Z :: $1 }
 
 main: 
-    letters EOL { EOL::$1 }
+  | letters EOL     { EOL::$1 }
diff --git a/src/lib/sounds/sounds.ml b/src/lib/sounds/sounds.ml
index 6126dd4..6c3cad9 100644
--- a/src/lib/sounds/sounds.ml
+++ b/src/lib/sounds/sounds.ml
@@ -10,13 +10,13 @@ module type T = sig
   val o : [`Closed | `Opened] -> t
   val schwa : unit -> t
   val i : t
-  val u : t
-  val u' : t
+  val voyel_u : t
+  val voyel_y : t
 
   (** Create a diphtongue from a semi-voyel and a voyel *)
   val diphtongue: t -> t -> t
 
-  val nasal: t -> t
+  val nasal: t -> t option
 
   val none: t
 
@@ -27,33 +27,24 @@ module type T = sig
   val k: t
   val g: t
   val f: t
-  val s: unit -> t
-  val sz: unit -> t
-  val ch: unit -> t
-  val z: unit -> t
+  val v: t
+  val s: t
+  val sz: t
+  val ch: t
+  val z: t
 
   val n: t
   val m: t
 
-  val r: unit -> t
-  val l: unit -> t
+  val r: t
+  val l: t
 
   val semi_voyel_w: t
+  val semi_voyel_y: t
 
   val is_voyel : t -> bool
   val is_nasal : t -> bool
 
-  type code =
-    | None
-    | SZ
-    | Voyel_A
-    | Voyel_I
-    | Voyel_O
-    | SemiVoyel_W
-    | Diphtonge of code * code
-
-  val code : t -> code
-
 end
 
 module T = struct
@@ -65,15 +56,19 @@ module T = struct
     | None
     | SZ
     | Voyel_A
+    | Voyel_E
     | Voyel_I
     | Voyel_O
+    | Voyel_U (* OU like in Ouvrir *)
+    | Voyel_Y (* U like in Unique *)
     | SemiVoyel_W
-    | Diphtonge of code * code
+    | SemiVoyel_Y
+    | Diphtonge of t * t
 
-  type t =
+  and t =
     { code : code
     ; repr : string
-    ; muted : bool
+    ; mutable_: bool (* Can the sound be muted ? *)
     ; kind : kind
     ; nasal : bool
     }
@@ -82,6 +77,8 @@ end
 
 module Repr = struct
 
+  type t = string
+
   let a = "a"
   and a_nasal = "@"
 
@@ -90,8 +87,10 @@ module Repr = struct
 
   and i = "i"
   and i_nasal = "5"
-  and u = "y"
-  and u' = "u"
+  and y = "y"
+  and y_nasal = "1"
+
+  and u = "u"
 
   and p = "p"
   and b = "b"
@@ -102,6 +101,7 @@ module Repr = struct
   and g = "g"
 
   and f = "f"
+  and v = "v"
 
   and ch = "S"
 
@@ -114,7 +114,8 @@ module Repr = struct
   and l = "L"
   and r = "R"
 
-  and w = "w"
+  and semi_voyel_w = "w"
+  and semi_voyel_y = "j"
 end
 
 module S = struct
@@ -127,7 +128,7 @@ module S = struct
 
   let none =
     { repr = ""
-    ; muted = false
+    ; mutable_ = true
     ; kind = None
     ; nasal = false
     ; code = None }
@@ -139,18 +140,17 @@ module S = struct
   let diphtongue v1 v2 =
     { voyel with
       repr = (v1.repr) ^ (v2.repr)
-    ; code = Diphtonge (v1.code, v2.code)
+    ; code = Diphtonge (v1, v2)
     }
 
-
   let code t = t.code
 
   let a =
     { voyel with repr = Repr.a ; code = Voyel_A }
 
   let e = function
-    | `Closed -> { voyel with repr = "e" }
-    | `Opened -> { voyel with repr = "E" }
+    | `Closed -> { voyel with repr = "e" ; code = Voyel_E }
+    | `Opened -> { voyel with repr = "E" ; code = Voyel_E }
 
   let eu = function
     | `Closed -> { voyel with repr = "2" }
@@ -166,17 +166,17 @@ module S = struct
   let i =
     { voyel with repr = Repr.i ; code = Voyel_I }
 
-  let u =
-    { voyel with repr = Repr.u }
+  let voyel_y =
+    { voyel with repr = Repr.y ; code = Voyel_Y }
 
-  let u' =
-    { voyel with repr = Repr.u' }
+  let voyel_u =
+    { voyel with repr = Repr.u ; code = Voyel_U }
 
   let p =
-    { none with repr = Repr.p }
+    { none with repr = Repr.p ; mutable_ = false }
 
   let b =
-    { none with repr = Repr.b }
+    { none with repr = Repr.b ; mutable_ = false }
 
   let t =
     { none with repr = Repr.t }
@@ -185,7 +185,7 @@ module S = struct
     { none with repr = Repr.d }
 
   let k =
-    { none with repr = Repr.k }
+    { none with repr = Repr.k ; mutable_ = false }
 
   let g =
     { none with repr = Repr.g }
@@ -193,16 +193,21 @@ module S = struct
   let f =
     { none with repr = Repr.f }
 
-  let s () =
+  let v =
+    { none with repr = Repr.v }
+
+  let s =
     { none with repr = Repr.s }
 
-  let sz () =
-    { (s()) with code = SZ }
+  let sz =
+    { s with code = SZ }
 
-  let ch () =
-    { none with repr = Repr.ch }
+  let ch =
+    { none with
+      repr = Repr.ch
+    ; mutable_ = false }
 
-  let z () =
+  let z =
     { none with repr = Repr.z }
 
   let n =
@@ -211,33 +216,82 @@ module S = struct
   let m =
     { none with repr = Repr.m ; nasal = true }
 
-  let l () =
+  let l =
     { none with repr = Repr.l }
 
-  let r () =
+  let r =
     { none with repr = Repr.r }
 
   let semi_voyel_w =
     { none with
-      repr = Repr.w
+      repr = Repr.semi_voyel_w
     ; code = SemiVoyel_W}
 
+  let semi_voyel_y =
+    { none with
+      repr = Repr.semi_voyel_y
+    ; code = SemiVoyel_Y}
+
   let nasal t =
     match t.code with
-    | Voyel_A -> { t with repr = Repr.a_nasal ; nasal = true }
-    | Voyel_O -> { t with repr = Repr.o_nasal ; nasal = true }
-    | Voyel_I -> { t with repr = Repr.i_nasal ; nasal = true }
-    | Diphtonge (SemiVoyel_W, Voyel_A) ->
-      diphtongue
-        semi_voyel_w
-        { t with repr = Repr.i_nasal ; nasal = true }
-    | _ -> t
+    | Voyel_A -> Some { t with repr = Repr.a_nasal ; nasal = true }
+    | Voyel_O -> Some { t with repr = Repr.o_nasal ; nasal = true }
+    | Voyel_I -> Some { t with repr = Repr.i_nasal ; nasal = true }
+    | Voyel_Y -> Some { t with repr = Repr.y_nasal ; nasal = true }
+    | Diphtonge (s1, s2) ->
+      begin match s1.code, s2.code with
+        | (SemiVoyel_W, Voyel_I) ->
+          (* The only case we could have the nasalisation of such diphtongue, is
+             the case O I, N -> wich is transformed into O, I N *)
+          Some (
+            diphtongue
+              semi_voyel_w
+              { t with repr = Repr.i_nasal ; nasal = true } )
+        | (SemiVoyel_W, Voyel_A) ->
+          (* The only case we could have the nasalisation of such diphtongue, is
+             the case O I, N -> wich is transformed into O, I N *)
+          Some (
+            diphtongue
+              semi_voyel_w
+              { t with repr = Repr.i_nasal ; nasal = true } )
+        | (Voyel_I, Voyel_E) ->
+          (* The only case we could have the nasalisation of such diphtongue, is
+             the case O I, N -> wich is transformed into O, I N *)
+          Some (
+            diphtongue
+              i
+              { t with repr = Repr.i_nasal ; nasal = true } )
+        | _ -> None
+      end
+    | _ -> None
 
   let muted f =
-    { none with
-      repr = "(" ^ f.repr ^ ")"
-    ; muted = true }
-
+    match f.mutable_ with
+    | false -> f
+    | true ->
+      { none with
+        repr = "(" ^ f.repr ^ ")" }
+
+  let rec repr
+    : t -> Repr.t
+    = fun letter ->
+      match letter.code, letter.nasal with
+      | None, _ -> ""
+      | SZ, _ -> ""
+      | Voyel_A, false -> Repr.a
+      | Voyel_A, true  -> Repr.a_nasal
+      | Voyel_E, _ -> ""
+      | Voyel_I, false -> Repr.i
+      | Voyel_I, true -> Repr.i_nasal
+      | Voyel_O, true -> Repr.o_nasal
+      | Voyel_O, false -> Repr.o
+      | Voyel_U, _  -> Repr.u
+      | Voyel_Y, false -> Repr.y
+      | Voyel_Y, true -> Repr.y_nasal
+      | SemiVoyel_W, _ -> Repr.semi_voyel_w
+      | SemiVoyel_Y, _ -> Repr.semi_voyel_y
+      | Diphtonge (l1, l2), _ ->
+        (repr l1) ^ (repr l2)
 end
 
 include S
diff --git a/src/lib/tokens.mly b/src/lib/tokens.mly
index 0bceeac..d70781a 100644
--- a/src/lib/tokens.mly
+++ b/src/lib/tokens.mly
@@ -35,14 +35,6 @@
 
 %nonassoc Low
 
-%right A E E_ACUTE I O U OU
-
-%right C H J Q V W X Y Z
-%right P B T D K G
-%right S F
-
-%right N M
-%right L R
 %right High
 
 %%
diff --git a/src/test/test.ml b/src/test/test.ml
index 852349d..4c763f4 100644
--- a/src/test/test.ml
+++ b/src/test/test.ml
@@ -61,17 +61,21 @@ let tests =
   ; "co|incidant",  "ko5sid@(t)"
   ; "croire",       "kRwaR°"
   ; "ébrouas",      "ebRua(s)"
+  ; "famille",      "famij°"
   ; "loin",         "Lw5"
   ; "groin",        "gRw5"
+  ; "hirondelle",   "iR§dEL°"
   ; "pacha",        "paSa"
   ; "péché",        "peSe"
   ; "persai",       "pERsE"
   ; "plan",         "pL@"
   ; "plat",         "pLa(t)"
   ; "platte",       "pLat°"
+  ; "soin",         "sw5"
   ; "toiture",      "twatyR°"
   ; "trois",        "tRwa(s)"
-  ; "wèb",          "wE(b)"
+  ; "vil|le",       "viLL°"
+  ; "wèb",          "wEb"
   ]
 
 let () =
-- 
cgit v1.2.3