summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/bin/dune2
-rw-r--r--src/bin/transcriptor.ml2
-rw-r--r--src/lib/dune2
-rw-r--r--src/lib/modifiers/dune3
-rw-r--r--src/lib/modifiers/modifiers.ml5
-rw-r--r--src/lib/modifiers/mute.ml18
-rw-r--r--src/lib/modifiers/nasal.ml23
-rw-r--r--src/lib/modifiers/sig.ml12
-rw-r--r--src/lib/modifiers/vocalize.ml20
-rw-r--r--src/lib/process.ml77
-rw-r--r--src/lib/sounds/dune6
-rw-r--r--src/lib/sounds/sounds.ml (renamed from src/lib/sounds.ml)0
12 files changed, 98 insertions, 72 deletions
diff --git a/src/bin/dune b/src/bin/dune
index 5d49b1d..6598ae1 100644
--- a/src/bin/dune
+++ b/src/bin/dune
@@ -2,5 +2,5 @@
(names
transcriptor
)
- (libraries translator)
+ (libraries sounds translator)
)
diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml
index 2378c5d..d8cc6db 100644
--- a/src/bin/transcriptor.ml
+++ b/src/bin/transcriptor.ml
@@ -1,7 +1,7 @@
module T = Translator
module P = T.Parser
-module Parser = P.Make(T.Sounds)
+module Parser = P.Make(Sounds)
module I = Parser.MenhirInterpreter
let process (optional_line : string option) =
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/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.ml b/src/lib/sounds/sounds.ml
index a2035b7..a2035b7 100644
--- a/src/lib/sounds.ml
+++ b/src/lib/sounds/sounds.ml