diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-09-04 09:42:31 +0200 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-09-04 09:42:31 +0200 |
commit | 0b2e63791a073000b70b4463db5d8bce88ab4d23 (patch) | |
tree | 4d9a029f45b510913845cb55f0b856e069d91a61 /src/lib | |
parent | 66cb521749672586fd5b1182b14e3c5d44829616 (diff) |
Update
Diffstat (limited to 'src/lib')
-rw-r--r-- | src/lib/reader.ml | 5 | ||||
-rw-r--r-- | src/lib/repr/default.ml | 10 | ||||
-rw-r--r-- | src/lib/sounds/sig.ml | 2 | ||||
-rw-r--r-- | src/lib/sounds/sounds.ml | 107 | ||||
-rw-r--r-- | src/lib/sounds/sounds.mli | 10 |
5 files changed, 80 insertions, 54 deletions
diff --git a/src/lib/reader.ml b/src/lib/reader.ml index 9a8e840..dfb05ce 100644 --- a/src/lib/reader.ml +++ b/src/lib/reader.ml @@ -1,14 +1,15 @@ -open StdLabels - module I = Parser.MenhirInterpreter let sound_to_string : Sounds.t list -> string = fun t -> + (* let buff = Buffer.create 16 in List.iter t ~f:(fun f -> Buffer.add_string buff (Sounds.repr (module Repr.Default) f)); Buffer.contents buff + *) + Sounds.repr (module Repr.Default) t let succeed (res : Sounds.t list) = Ok (sound_to_string res) diff --git a/src/lib/repr/default.ml b/src/lib/repr/default.ml index 72cf95d..e8cc091 100644 --- a/src/lib/repr/default.ml +++ b/src/lib/repr/default.ml @@ -1,3 +1,5 @@ +open StdLabels + type t = string let none = "" @@ -56,3 +58,11 @@ let diphtongue : t -> t -> t = fun t1 t2 -> Printf.sprintf "[%s%s]" t1 t2 + +let fold + : t list -> string + = fun elems -> + let buff = Buffer.create 16 in + List.iter elems + ~f:(fun f -> Buffer.add_string buff f); + Buffer.contents buff diff --git a/src/lib/sounds/sig.ml b/src/lib/sounds/sig.ml index e84866e..512abdc 100644 --- a/src/lib/sounds/sig.ml +++ b/src/lib/sounds/sig.ml @@ -46,4 +46,6 @@ module type REPR = sig val muted : t -> t val diphtongue : t -> t -> t + + val fold : t list -> string end diff --git a/src/lib/sounds/sounds.ml b/src/lib/sounds/sounds.ml index 088485a..a8c9ce9 100644 --- a/src/lib/sounds/sounds.ml +++ b/src/lib/sounds/sounds.ml @@ -180,7 +180,8 @@ let m = let l = { none with - code = Consonant_L } + code = Consonant_L + ; mutable_ = false } let r = { none with @@ -238,51 +239,59 @@ let muted f = { none with code = Muted f } -let rec repr - : type a. (module Sig.REPR with type t = a) -> t -> a - = fun m letter -> - let module Repr = (val m:Sig.REPR with type t = a) in - match letter.code, letter.nasal with - - | None, _ -> Repr.none - | Voyel_A, false -> Repr.a - | Voyel_A, true -> Repr.a_nasal - | Voyel_AI, false -> Repr.e_opened - | Voyel_AI, true -> Repr.i_nasal - | E_Closed, _ -> Repr.e_closed - | E_Opened, true | Voyel_E, true -> Repr.a_nasal - | Voyel_E , _ -> Repr.schwa - | E_Opened, _ -> Repr.e_opened - | 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 - | Voyel_EU, _ -> Repr.eu - - | SemiVoyel_W, _ -> Repr.semi_voyel_w - | SemiVoyel_Y, _ -> Repr.semi_voyel_y - - | Consonant_P, _ -> Repr.p - | Consonant_B, _ -> Repr.b - | Consonant_T, _ -> Repr.t - | Consonant_D, _ -> Repr.d - | Consonant_K, _ -> Repr.k - | Consonant_G, _ -> Repr.g - | Consonant_F, _ -> Repr.f - | Consonant_V, _ -> Repr.v - | SZ, _ - | Consonant_S, _ -> Repr.s - | Consonant_Z, _ -> Repr.z - - | Consonant_X, _ -> Repr.ch - | Consonant_J, _ -> Repr.j - - | Consonant_M, _ -> Repr.m - | Consonant_N, _ -> Repr.n - | Consonant_L, _ -> Repr.l - | Consonant_R, _ -> Repr.r - | Diphtonge (l1, l2), _ -> Repr.diphtongue (repr m l1) (repr m l2) - | Muted t, _ -> Repr.muted (repr m t) +let repr + : (module Sig.REPR) -> t list -> string + = fun m letters -> + let module Repr = (val m:Sig.REPR) in + + let rec _repr letter = + + match letter.code, letter.nasal with + + | None, _ -> Repr.none + | Voyel_A, false -> Repr.a + | Voyel_A, true -> Repr.a_nasal + | Voyel_AI, false -> Repr.e_opened + | Voyel_AI, true -> Repr.i_nasal + | E_Closed, _ -> Repr.e_closed + | E_Opened, true | Voyel_E, true -> Repr.a_nasal + | Voyel_E , false -> Repr.schwa + | E_Opened, false -> Repr.e_opened + | 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 + | Voyel_EU, _ -> Repr.eu + + | SemiVoyel_W, _ -> Repr.semi_voyel_w + | SemiVoyel_Y, _ -> Repr.semi_voyel_y + + | Consonant_P, _ -> Repr.p + | Consonant_B, _ -> Repr.b + | Consonant_T, _ -> Repr.t + | Consonant_D, _ -> Repr.d + | Consonant_K, _ -> Repr.k + | Consonant_G, _ -> Repr.g + | Consonant_F, _ -> Repr.f + | Consonant_V, _ -> Repr.v + | SZ, _ + | Consonant_S, _ -> Repr.s + | Consonant_Z, _ -> Repr.z + + | Consonant_X, _ -> Repr.ch + | Consonant_J, _ -> Repr.j + + | Consonant_M, _ -> Repr.m + | Consonant_N, _ -> Repr.n + | Consonant_L, _ -> Repr.l + | Consonant_R, _ -> Repr.r + | Diphtonge (l1, l2), _ -> Repr.diphtongue (_repr l1) (_repr l2) + | Muted t, _ -> Repr.muted (_repr t) + + in + + List.map _repr letters + |> Repr.fold diff --git a/src/lib/sounds/sounds.mli b/src/lib/sounds/sounds.mli index 8c11488..dcb5e8d 100644 --- a/src/lib/sounds/sounds.mli +++ b/src/lib/sounds/sounds.mli @@ -36,8 +36,12 @@ val voyel_u : t When nazalized, the voyel become [un] like in "brun" *) val voyel_y : t -(** Create a diphtongue from a semi-voyel and a voyel *) -val diphtongue: t -> t -> t +(** Create a diphtongue from a semi-voyel and a voyel. + + Note that there is no control here that the two elements follows the + expected type. *) +val diphtongue + : t -> t -> t val nasal: t -> t option @@ -68,4 +72,4 @@ val is_voyel : t -> bool val is_nasal : t -> bool val repr - : (module Sig.REPR with type t = 'a) -> t -> 'a + : (module Sig.REPR) -> t list -> string |