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 } type group = voyel * consonants option type modifier = (group * T.t option option) -> (group * T.t option option) (** Apply all the modifiers to the syllabic group in order to correct the relation between the elements This is just a fold_left list, and the order matter : for example nasalisation shall be applied after the S vocalisation *) let apply_modifiers : group * T.t option option -> modifier list -> group * T.t option option = 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 ) let vocalize_s : modifier = fun init -> let (((v1, v2), c) , ending) = init in match c with | None -> init | Some op -> match op.opening, op.ending with | hd::[], None when hd = T.s () -> let c = Some { op with opening = [T.z ()] } in (((v1, v2), c) , ending) | _ -> init 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 (voyel, consonants), ending_consonant = apply_modifiers (hd, ending_consonant) modifier_ in (* Add the last consonant and the voyel *) let m, acc = match ending_consonant with | None -> modifier_, (snd voyel)::acc | Some s -> let default = modifier_, (fst voyel) :: acc in match s with | None -> default | Some s -> modifier_, (fst voyel) :: s::acc in match consonants with | None -> _rebuild ~m acc None tl | Some {ending; opening; following} -> let acc = match following with | None -> acc | Some s -> s::acc in match opening with | [] ->_rebuild ~m acc ending tl | opening -> _rebuild ~m (opening @ acc) ending tl (** Rebuild the list in the normal order The voyels have to be choosen, depending either they are followed by a consonant or not Some consonants may be changed depending of the following voyel The list has to be reversed and so one *) let rebuild : T.t option option -> group list -> T.t list = fun ending elems -> _rebuild ~m:[] [] ending elems end