From c8b49eed4cf92e7d2dd01dce779ef84ccae733eb Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 27 Aug 2021 14:37:24 +0200 Subject: Splitted modifiers in own library --- src/lib/dune | 2 +- src/lib/modifiers/dune | 3 + src/lib/modifiers/modifiers.ml | 5 + src/lib/modifiers/mute.ml | 18 ++++ src/lib/modifiers/nasal.ml | 23 +++++ src/lib/modifiers/sig.ml | 12 +++ src/lib/modifiers/vocalize.ml | 20 ++++ src/lib/process.ml | 77 ++------------- src/lib/sounds.ml | 208 ----------------------------------------- src/lib/sounds/dune | 6 ++ src/lib/sounds/sounds.ml | 208 +++++++++++++++++++++++++++++++++++++++++ 11 files changed, 304 insertions(+), 278 deletions(-) create mode 100644 src/lib/modifiers/dune create mode 100644 src/lib/modifiers/modifiers.ml create mode 100644 src/lib/modifiers/mute.ml create mode 100644 src/lib/modifiers/nasal.ml create mode 100644 src/lib/modifiers/sig.ml create mode 100644 src/lib/modifiers/vocalize.ml delete mode 100644 src/lib/sounds.ml create mode 100644 src/lib/sounds/dune create mode 100644 src/lib/sounds/sounds.ml (limited to 'src/lib') diff --git a/src/lib/dune b/src/lib/dune index 29b0668..ac2a45f 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -2,7 +2,7 @@ (name translator ) - (libraries menhirLib) + (libraries menhirLib sounds modifiers) ) (menhir diff --git a/src/lib/modifiers/dune b/src/lib/modifiers/dune new file mode 100644 index 0000000..c1fb66c --- /dev/null +++ b/src/lib/modifiers/dune @@ -0,0 +1,3 @@ +(library + (name modifiers) + (libraries sounds) ) diff --git a/src/lib/modifiers/modifiers.ml b/src/lib/modifiers/modifiers.ml new file mode 100644 index 0000000..89e9485 --- /dev/null +++ b/src/lib/modifiers/modifiers.ml @@ -0,0 +1,5 @@ +module Sig = Sig + +let nasal = Nasal.process +let vocalize_s = Vocalize.process +let mute_consonant = Mute.process diff --git a/src/lib/modifiers/mute.ml b/src/lib/modifiers/mute.ml new file mode 100644 index 0000000..253df21 --- /dev/null +++ b/src/lib/modifiers/mute.ml @@ -0,0 +1,18 @@ +open StdLabels + +(** 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 process + : 'a Sig.modifier + = fun (type el) m init -> + let module T = (val m:Sounds.T with type t = el) in + 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 Sig.opening = List.map ~f:T.muted c.Sig.opening } in + (((v1, v2), Some c) , ending) + | _ -> init + + diff --git a/src/lib/modifiers/nasal.ml b/src/lib/modifiers/nasal.ml new file mode 100644 index 0000000..da24863 --- /dev/null +++ b/src/lib/modifiers/nasal.ml @@ -0,0 +1,23 @@ +(** The Nasal modifier transform a voyel followed by N and a consonant + into a nasal voyel. + + Does this min that nasal voyel are not a distinct element, but just a + merge from two distinct elements ? *) +let process + : 'a Sig.modifier + = fun (type el) m init -> + let module T = (val m:Sounds.T with type t = el) in + let (((v1, v2), c) , ending) = init in + let ending = Option.bind ending (fun x -> x) in + match ending with + | None -> init + | Some ending -> + match T.is_nasal ending with + | false -> init + | true -> + (* Remove the ending consonant, and transform the voyel into + the nasal form *) + ( ( (T.nasal v1, T.nasal v2) + , c ) + , None ) + diff --git a/src/lib/modifiers/sig.ml b/src/lib/modifiers/sig.ml new file mode 100644 index 0000000..938c50e --- /dev/null +++ b/src/lib/modifiers/sig.ml @@ -0,0 +1,12 @@ +type 'a voyel = ('a * 'a) + +type 'a consonants = + { ending : 'a option option + ; opening : 'a list + ; following : 'a option } + +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) + + diff --git a/src/lib/modifiers/vocalize.ml b/src/lib/modifiers/vocalize.ml new file mode 100644 index 0000000..86a0502 --- /dev/null +++ b/src/lib/modifiers/vocalize.ml @@ -0,0 +1,20 @@ +(** Transform the S into Z if the S is the opening consonant and + there is no ending consonant before *) +let process + : 'a Sig.modifier + = fun (type el) m init -> + let module T = (val m:Sounds.T with type t = el) in + let (((v1, v2), c) , ending) = init in + + match c with + | None -> init + | 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.Sig.opening, op.Sig.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 + diff --git a/src/lib/process.ml b/src/lib/process.ml index 01c6d4a..a74c44b 100644 --- a/src/lib/process.ml +++ b/src/lib/process.ml @@ -1,16 +1,11 @@ open StdLabels -module M(T:Sounds.T) = struct - - type voyel = (T.t * T.t ) - type consonants = - { ending : T.t option option - ; opening : T.t list - ; following : T.t option } +module M(T:Sounds.T) = struct - type group = voyel * consonants option + type voyel = T.t Modifiers.Sig.voyel - type modifier = (group * T.t option option) -> (group * T.t option option) + type group = voyel * T.t Modifiers.Sig.consonants option + type modifier = T.t Modifiers.Sig.modifier (** Apply all the modifiers to the syllabic group in order to correct the relation between the elements @@ -24,63 +19,7 @@ module M(T:Sounds.T) = struct = fun e m -> List.fold_left m ~init:e - ~f:(fun e f -> f e) - - (** The Nasal modifier transform a voyel followed by N and a consonant - into a nasal voyel. - - Does this min that nasal voyel are not a distinct element, but just a - merge from two distinct elements ? *) - let nasal - : modifier - = fun init -> - let (((v1, v2), c) , ending) = init in - let ending = Option.bind ending (fun x -> x) in - match ending with - | None -> init - | Some ending -> - match T.is_nasal ending with - | false -> init - | true -> - (* Remove the ending consonant, and transform the voyel into - the nasal form *) - ( ( (T.nasal v1, T.nasal v2) - , 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 -> - let (((v1, v2), c) , ending) = init in - - match c with - | None -> init - | 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 + ~f:(fun e f -> f (module T:Sounds.T with type t = T.t) e) let change_voyel = fun init -> @@ -94,7 +33,7 @@ module M(T:Sounds.T) = struct | [] -> acc | hd::tl -> - let modifier = vocalize_s :: nasal :: m in + let modifier = (Modifiers.vocalize_s) :: (Modifiers.nasal) :: m in let (voyel, consonants), ending_consonant = apply_modifiers (hd, ending_consonant) @@ -137,11 +76,11 @@ module M(T:Sounds.T) = struct *) let rebuild - : consonants option -> group list -> T.t list + : T.t Modifiers.Sig.consonants option -> group list -> T.t list = fun ending elems -> let elems' = match ending with | None -> elems | Some _ -> ((T.none, T.none), ending)::elems in - _rebuild ~m:[mute_consonant] [] None elems' + _rebuild ~m:[Modifiers.mute_consonant] [] None elems' end diff --git a/src/lib/sounds.ml b/src/lib/sounds.ml deleted file mode 100644 index a2035b7..0000000 --- a/src/lib/sounds.ml +++ /dev/null @@ -1,208 +0,0 @@ -module type T = sig - - type t - val muted : t -> t - - val a : [`Closed | `Opened] -> t - val e : [`Closed | `Opened] -> t - val eu : [`Closed | `Opened] -> t - - val o : [`Closed | `Opened] -> t - val schwa : unit -> t - val i : [`Closed | `Opened] -> t - val u : t - - - val nasal: t -> t - - val none: t - - val p: t - val b: t - val t: t - val d: t - val k: t - val f: t - val s: unit -> t - val sz: unit -> t - val ch: unit -> t - val z: 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 - -end - -module T = struct - type kind = - | None - | Voyel - - type code = - | None - | SZ - | Voyel_A - | Voyel_O - - type t = - { code : code - ; repr : string - ; muted : bool - ; kind : kind - ; nasal : bool - } - -end - -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 - - include T - - let is_voyel t = t.kind = Voyel - let is_nasal t = t.nasal - - let none = - { 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.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 = - { none with - repr = "(" ^ f.repr ^ ")" - ; muted = true } - - let a _ = - { voyel with repr = Repr.a ; code = Voyel_A } - - let e = function - | `Closed -> { voyel with repr = "e" } - | `Opened -> { voyel with repr = "E" } - - let eu = function - | `Closed -> { voyel with repr = "2" } - | `Opened -> { voyel with repr = "9" } - - - let schwa () = - { voyel with repr = "°" } - - let o _ = - { voyel with repr = Repr.o ; code = Voyel_O } - - let i _ = - { voyel with repr = Repr.i } - - let u = - { voyel with repr = Repr.u } - - let p = - { none with repr = Repr.p } - - let b = - { none with repr = Repr.b } - - let t = - { none with repr = Repr.t } - - let d = - { none with repr = Repr.d } - - let k = - { none with repr = Repr.k } - - let f = - { none with repr = Repr.f } - - let s () = - { none with repr = Repr.s } - - let sz () = - { (s()) with code = SZ } - - let ch () = - { none with repr = Repr.ch } - - let z () = - { none with repr = Repr.z } - - let n = - { none with repr = Repr.n ; nasal = true } - - let m = - { none with repr = Repr.m ; nasal = true } - - let l () = - { none with repr = Repr.l } - - let r () = - { none with repr = Repr.r } - - let semi_voyel_w = - { none with repr = Repr.w } -end - -include S diff --git a/src/lib/sounds/dune b/src/lib/sounds/dune new file mode 100644 index 0000000..56c6909 --- /dev/null +++ b/src/lib/sounds/dune @@ -0,0 +1,6 @@ +(library + (name + sounds + ) + + ) diff --git a/src/lib/sounds/sounds.ml b/src/lib/sounds/sounds.ml new file mode 100644 index 0000000..a2035b7 --- /dev/null +++ b/src/lib/sounds/sounds.ml @@ -0,0 +1,208 @@ +module type T = sig + + type t + val muted : t -> t + + val a : [`Closed | `Opened] -> t + val e : [`Closed | `Opened] -> t + val eu : [`Closed | `Opened] -> t + + val o : [`Closed | `Opened] -> t + val schwa : unit -> t + val i : [`Closed | `Opened] -> t + val u : t + + + val nasal: t -> t + + val none: t + + val p: t + val b: t + val t: t + val d: t + val k: t + val f: t + val s: unit -> t + val sz: unit -> t + val ch: unit -> t + val z: 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 + +end + +module T = struct + type kind = + | None + | Voyel + + type code = + | None + | SZ + | Voyel_A + | Voyel_O + + type t = + { code : code + ; repr : string + ; muted : bool + ; kind : kind + ; nasal : bool + } + +end + +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 + + include T + + let is_voyel t = t.kind = Voyel + let is_nasal t = t.nasal + + let none = + { 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.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 = + { none with + repr = "(" ^ f.repr ^ ")" + ; muted = true } + + let a _ = + { voyel with repr = Repr.a ; code = Voyel_A } + + let e = function + | `Closed -> { voyel with repr = "e" } + | `Opened -> { voyel with repr = "E" } + + let eu = function + | `Closed -> { voyel with repr = "2" } + | `Opened -> { voyel with repr = "9" } + + + let schwa () = + { voyel with repr = "°" } + + let o _ = + { voyel with repr = Repr.o ; code = Voyel_O } + + let i _ = + { voyel with repr = Repr.i } + + let u = + { voyel with repr = Repr.u } + + let p = + { none with repr = Repr.p } + + let b = + { none with repr = Repr.b } + + let t = + { none with repr = Repr.t } + + let d = + { none with repr = Repr.d } + + let k = + { none with repr = Repr.k } + + let f = + { none with repr = Repr.f } + + let s () = + { none with repr = Repr.s } + + let sz () = + { (s()) with code = SZ } + + let ch () = + { none with repr = Repr.ch } + + let z () = + { none with repr = Repr.z } + + let n = + { none with repr = Repr.n ; nasal = true } + + let m = + { none with repr = Repr.m ; nasal = true } + + let l () = + { none with repr = Repr.l } + + let r () = + { none with repr = Repr.r } + + let semi_voyel_w = + { none with repr = Repr.w } +end + +include S -- cgit v1.2.3