From 96a225fb5fa24a71e1b76e0369126b3bcfab5f81 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 7 Sep 2021 13:44:54 +0200
Subject: Moved the printer to toplevel
---
src/bin/transcriptor.ml | 9 +++---
src/lib/lexer.mll | 1 -
src/lib/modifiers/e.ml | 33 ++++++++++++--------
src/lib/parser.mly | 2 +-
src/lib/process.ml | 2 +-
src/lib/reader.ml | 82 ++++++++++++++++++++++++-------------------------
src/test/test.ml | 11 ++++---
7 files changed, 75 insertions(+), 65 deletions(-)
(limited to 'src')
diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml
index 6d02e9d..f86852f 100644
--- a/src/bin/transcriptor.ml
+++ b/src/bin/transcriptor.ml
@@ -1,13 +1,14 @@
module T = Translator
-module P = T.Parser
-
-module I = P.MenhirInterpreter
let process (optional_line : string option) =
match optional_line with
| None -> ()
| Some line ->
- match T.Reader.process line with
+
+ let res = Result.map
+ (fun t-> Sounds.repr (module Repr.Default) t)
+ (T.Reader.process line) in
+ match res with
| Ok response -> print_endline response
| Error err -> print_endline err
diff --git a/src/lib/lexer.mll b/src/lib/lexer.mll
index 592b6ed..50c25a7 100644
--- a/src/lib/lexer.mll
+++ b/src/lib/lexer.mll
@@ -50,7 +50,6 @@ rule letter = parse
| "erf" ending { ERF_ }
| "el" ending { EL_ }
| "ent" ending { ENT_ }
-| "ie" ending { IE_ }
| "ient" ending { IENT_ }
| "x" ending { X_ }
diff --git a/src/lib/modifiers/e.ml b/src/lib/modifiers/e.ml
index 5f6e6fe..bd4a940 100644
--- a/src/lib/modifiers/e.ml
+++ b/src/lib/modifiers/e.ml
@@ -1,3 +1,23 @@
+(** Transform the ending e.
+
+ For example "ie$" into "i"
+
+*)
+let ending_e
+ : 'a Sig.modifier
+ = fun init ->
+ let ((v, c) , ending) = init in
+
+ if v = Sounds.diphtongue Sounds.semi_voyel_y Sounds.schwa then
+ ((Sounds.i, c), ending)
+ else if v = Sounds.schwa then (
+ match c, ending with
+ (* If there is no consonant, and just a final e, remove it *)
+ | None, None -> ((Sounds.none, c), ending)
+ | _ -> init
+ ) else
+ init
+
(** Transform the e into eu or E *)
let process
: 'a Sig.modifier
@@ -12,16 +32,5 @@ let process
| Some _ when v = Sounds.schwa ->
(* If there is an ending consonant, change the e into E like essai *)
((Sounds.e `Opened, c) , ending)
- | _ -> init
+ | _ -> ((v, c) , ending)
-(** Transform the final e into E if there is a consonant *)
-let ending_e
- : 'a Sig.modifier
- = fun init ->
- let ((v, c) , ending) = init in
-
- match ending with
- | Some _ when v = Sounds.schwa ->
- (* If there is an ending consonant, change the e into E like essai *)
- ((Sounds.e `Opened, c) , ending)
- | _ -> init
diff --git a/src/lib/parser.mly b/src/lib/parser.mly
index 925ce9f..42623c7 100644
--- a/src/lib/parser.mly
+++ b/src/lib/parser.mly
@@ -80,7 +80,7 @@ semi:
voyels:
| A { Sounds.a }
| A I { Sounds.voyel_ai }
- | E I { Sounds.e `Opened }
+ | E I { Sounds.voyel_ai }
| I { Sounds.i }
| E { Sounds.schwa }
| E_ACUTE E? { Sounds.e `Closed }
diff --git a/src/lib/process.ml b/src/lib/process.ml
index d6ad291..7ab20fe 100644
--- a/src/lib/process.ml
+++ b/src/lib/process.ml
@@ -46,7 +46,7 @@ let rec _rebuild ~(m:modifier list) acc ending_consonant : group list -> Sounds.
Only transform the e into eu / E if there is previous syllabe with
voyel. *)
let modifiers = if voyel = Sounds.none then
- []
+ [Modifiers.ending_e]
else
[Modifiers.e] in
diff --git a/src/lib/reader.ml b/src/lib/reader.ml
index dfb05ce..b816d6d 100644
--- a/src/lib/reader.ml
+++ b/src/lib/reader.ml
@@ -1,43 +1,41 @@
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)
+ : (module Sounds.Sig.REPR) -> Sounds.t list -> string
+ = fun m t ->
+ Sounds.repr m t
let fail (_ : 'a I.checkpoint) =
Error ("Syntax Error")
-let rec loop get_element (checkpoint : Sounds.t list I.checkpoint) =
- match checkpoint with
- | I.InputNeeded _env ->
- (* The parser needs a token. Request one from the lexer,
- and offer it to the parser, which will produce a new
- checkpoint. Then, repeat. *)
- let checkpoint = get_element checkpoint in
- loop get_element checkpoint
- | I.Shifting _
- | I.AboutToReduce _ ->
- let checkpoint = I.resume checkpoint in
- loop get_element checkpoint
- | I.HandlingError _env ->
- fail checkpoint
- | I.Accepted v ->
- (* The parser has succeeded and produced a semantic value. Print it. *)
- succeed v
- | I.Rejected ->
- (* The parser rejects this input. This cannot happen, here, because
- we stop as soon as the parser reports [HandlingError]. *)
- assert false
+type source = Sounds.t list I.checkpoint
+
+let loop
+ : (source -> source) -> source -> (Sounds.t list, string) result
+ = fun get_element checkpoint ->
+
+ let rec loop' checkpoint =
+ match checkpoint with
+ | I.InputNeeded _env ->
+ (* The parser needs a token. Request one from the lexer,
+ and offer it to the parser, which will produce a new
+ checkpoint. Then, repeat. *)
+ let checkpoint = get_element checkpoint in
+ loop' checkpoint
+ | I.Shifting _
+ | I.AboutToReduce _ ->
+ let checkpoint = I.resume checkpoint in
+ loop' checkpoint
+ | I.HandlingError _env ->
+ fail checkpoint
+ | I.Accepted v ->
+ (* The parser has succeeded and produced a semantic value. Print it. *)
+ Ok v
+ | I.Rejected ->
+ (* The parser rejects this input. This cannot happen, here, because
+ we stop as soon as the parser reports [HandlingError]. *)
+ assert false
+ in loop' checkpoint
let build_processor ll =
let l = ref ll in
@@ -48,13 +46,13 @@ let build_processor ll =
l := tl;
I.offer checkpoint (hd, Lexing.dummy_pos, Lexing.dummy_pos)
-let process (line : string) =
- let lexbuf = Lexing.from_string line in
- let content =
- Prononciation.main Lexer.letter lexbuf
- |> build_processor in
- try
- loop content (Parser.Incremental.main lexbuf.lex_curr_p)
- with
- | Lexer.Error msg -> Error msg
+let process
+ : string -> (Sounds.t list, string) result
+ = fun line ->
+ let lexbuf = Lexing.from_string line in
+ let content =
+ Prononciation.main Lexer.letter lexbuf
+ |> build_processor in
+ try loop content (Parser.Incremental.main lexbuf.lex_curr_p)
+ with Lexer.Error msg -> Error msg
diff --git a/src/test/test.ml b/src/test/test.ml
index 49cb9ff..9690a72 100644
--- a/src/test/test.ml
+++ b/src/test/test.ml
@@ -1,13 +1,12 @@
open StdLabels
-module T = Translator
let error = ref 0
let process (optional_line : string option) expected =
match optional_line with
| None -> ()
| Some line ->
- match T.Reader.process line with
+ match Translator.Reader.process line with
| exception _ ->
error := 1;
Printf.fprintf stdout
@@ -20,6 +19,7 @@ let process (optional_line : string option) expected =
line
result
| Ok response ->
+ let response = Sounds.repr (module Repr.Default) response in
if String.equal response expected then
()
(*
@@ -38,7 +38,7 @@ let process (optional_line : string option) expected =
let rec repeat input expected =
(* Attempt to read one line. *)
- let optional_line, continue = T.Lexer.line input in
+ let optional_line, continue = Translator.Lexer.line input in
process optional_line expected;
if continue then
repeat input expected
@@ -91,7 +91,7 @@ let tests =
; "groin", "gR[w5]"
; "hélicoptère", "eLikoptER°"
; "hirondelle", "iR§dEL°"
- ; "joues", "Zu°(s)"
+ ; "joues", "Zu(s)"
; "libellule", "LibELyL°"
; "main", "m5"
; "merci", "mERsi"
@@ -106,8 +106,11 @@ let tests =
; "personne", "pERson°"
; "plan", "pL@"
; "plat", "pLa(t)"
+ ; "plein", "pL5"
; "platte", "pLat°"
+ ; "proie", "pR[wa]"
; "quille", "kij°"
+ ; "reine", "REn°"
; "soin", "sw5"
; "souris", "suRi(s)"
; "toiture", "t[wa]tyR°"
--
cgit v1.2.3