From eefe84df1ed3b56dbc07417807c9b0852f2ddeac Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Tue, 3 Oct 2023 06:43:14 +0900 Subject: [PATCH 1/9] normalized strings --- satysfi.opam | 1 + src/dune | 1 + src/frontend/lexer.mll | 30 ++++++++++++++++++++++++++---- src/frontend/normalizeString.ml | 22 ++++++++++++++++++++++ src/frontend/normalizeString.mli | 11 +++++++++++ tools/gencode/vminst.ml | 16 ++++++++++++++-- 6 files changed, 75 insertions(+), 6 deletions(-) create mode 100644 src/frontend/normalizeString.ml create mode 100644 src/frontend/normalizeString.mli diff --git a/satysfi.opam b/satysfi.opam index 0bcabdffe..a8423943b 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -34,6 +34,7 @@ depends: [ "ppx_deriving" "re" {build} "uutf" + "uunf" "yojson-with-position" {= "1.4.2+satysfi"} "omd" {< "2.0.0~"} "ocamlgraph" diff --git a/src/dune b/src/dune index cc4ed7cff..3718ce336 100644 --- a/src/dune +++ b/src/dune @@ -13,6 +13,7 @@ menhirLib otfed uutf + uunf yojson-with-position omd ocamlgraph diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index a07833204..1c4e5b1d7 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -576,7 +576,14 @@ and lex_inline stack = parse report_error lexbuf "unexpected end of input while reading an inline text area" } | str+ - { let tok = Lexing.lexeme lexbuf in CHAR(get_pos lexbuf, tok) } + { + let s = + Lexing.lexeme lexbuf + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 + in + CHAR(get_pos lexbuf, s) + } | _ as c { report_error lexbuf (Printf.sprintf "illegal token '%s' in an inline text area" (String.make 1 c)) } @@ -644,7 +651,14 @@ and lex_math stack = parse | mathascii { MATHCHARS(get_pos lexbuf, Lexing.lexeme lexbuf) } | mathstr+ - { MATHCHARS(get_pos lexbuf, Lexing.lexeme lexbuf) } + { + let s = + Lexing.lexeme lexbuf + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 + in + MATHCHARS(get_pos lexbuf, s) + } | ("#" (((upper ".")* (lower | upper)) as s)) { let pos = get_pos lexbuf in @@ -743,7 +757,11 @@ and literal quote_length buffer = parse end else if len > quote_length then report_error lexbuf "literal area was closed with too many '`'s" else - let s = Buffer.contents buffer in + let s = + Buffer.contents buffer + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 + in let pos_last = get_pos lexbuf in (pos_last, s, true) } @@ -757,7 +775,11 @@ and literal quote_length buffer = parse end else if len > quote_length then report_error lexbuf "literal area was closed with too many '`'s" else - let s = Buffer.contents buffer in + let s = + Buffer.contents buffer + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 + in let pos_last = get_pos lexbuf in (pos_last, s, false) } diff --git a/src/frontend/normalizeString.ml b/src/frontend/normalizeString.ml new file mode 100644 index 000000000..4283338d1 --- /dev/null +++ b/src/frontend/normalizeString.ml @@ -0,0 +1,22 @@ +type t = string + +(* + + +*) +let form = `NFC + +let of_utf8 str = Uunf_string.normalize_utf_8 form str + +let of_utf16be str = + let str_utf8 = str |> InternalText.of_utf16be |> InternalText.to_utf8 in + Uunf_string.normalize_utf_8 form str_utf8 + + +let to_utf8 t = t + +let to_utf16be t = + t |> InternalText.of_utf8 |> InternalText.to_utf16be + +let to_utf16be_hex t = + t |> InternalText.of_utf8 |> InternalText.to_utf16be_hex \ No newline at end of file diff --git a/src/frontend/normalizeString.mli b/src/frontend/normalizeString.mli new file mode 100644 index 000000000..7f9c98bcc --- /dev/null +++ b/src/frontend/normalizeString.mli @@ -0,0 +1,11 @@ +type t + +val of_utf8 : string -> t + +val of_utf16be : string -> t + +val to_utf8 : t -> string + +val to_utf16be_hex : t -> string + +val to_utf16be : t -> string diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index d8e5472a9..39e2e1e9a 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -1618,7 +1618,13 @@ CompiledInlineTextClosure([CompiledImInlineTextText(str)], env) ~is_pdf_mode_primitive:true ~is_text_mode_primitive:true ~code:{| -make_string (HorzBox.extract_string ibs) +let s = + ibs + |> HorzBox.extract_string + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 +in +make_string s |} ; inst "PrimitiveInlineSkip" ~name:"inline-skip" @@ -2019,7 +2025,13 @@ else ~is_text_mode_primitive:true ~code:{| let ilst = get_list get_int valueilst in -let s = (List.map Uchar.of_int ilst) |> InternalText.of_uchar_list |> InternalText.to_utf8 in +let s = + (List.map Uchar.of_int ilst) + |> InternalText.of_uchar_list + |> InternalText.to_utf8 + |> NormalizeString.of_utf8 + |> NormalizeString.to_utf8 +in make_string s |} ; inst "PrimitiveStringExplode" From 9dc28a327916079942fcc007276a5c69f1cad1e9 Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Tue, 3 Oct 2023 12:08:19 +0900 Subject: [PATCH 2/9] add string seg function --- satysfi.opam | 1 + src/dune | 1 + src/frontend/segmentationText.ml | 3 +++ src/frontend/segmentationText.mli | 2 ++ tools/gencode/vminst.ml | 17 +++++++++++++++++ 5 files changed, 24 insertions(+) create mode 100644 src/frontend/segmentationText.ml create mode 100644 src/frontend/segmentationText.mli diff --git a/satysfi.opam b/satysfi.opam index a8423943b..e2a3c0826 100644 --- a/satysfi.opam +++ b/satysfi.opam @@ -35,6 +35,7 @@ depends: [ "re" {build} "uutf" "uunf" + "uuseg" "yojson-with-position" {= "1.4.2+satysfi"} "omd" {< "2.0.0~"} "ocamlgraph" diff --git a/src/dune b/src/dune index 3718ce336..170150b2e 100644 --- a/src/dune +++ b/src/dune @@ -14,6 +14,7 @@ otfed uutf uunf + uuseg yojson-with-position omd ocamlgraph diff --git a/src/frontend/segmentationText.ml b/src/frontend/segmentationText.ml new file mode 100644 index 000000000..1e3d402be --- /dev/null +++ b/src/frontend/segmentationText.ml @@ -0,0 +1,3 @@ + +let split_utf8 str = Uuseg_string.fold_utf_8 `Grapheme_cluster (fun lst s -> s::lst) [] str + diff --git a/src/frontend/segmentationText.mli b/src/frontend/segmentationText.mli new file mode 100644 index 000000000..770566921 --- /dev/null +++ b/src/frontend/segmentationText.mli @@ -0,0 +1,2 @@ + +val split_utf8 : string -> string list diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index 39e2e1e9a..979c2be09 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -2052,6 +2052,23 @@ let ilst = |> List.map Uchar.to_int in make_list make_int ilst +|} + ; inst "PrimitiveStringSeg" + ~name:"string-seg" + ~type_:Type.(tS @-> (tL tS)) + ~fields:[ + ] + ~params:[ + param "str" ~type_:"string"; + ] + ~is_pdf_mode_primitive:true + ~is_text_mode_primitive:true + ~code:{| +let slst = + str + |> SegmentationText.split_utf8 +in +make_list make_string slst |} ; inst "PrimitiveRegexpOfString" ~name:"regexp-of-string" From d10e87300f6c4b234e4f23e0947f41bc02baa6cc Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Wed, 4 Oct 2023 00:56:23 +0900 Subject: [PATCH 3/9] buf fix of segmentation text function --- src/frontend/segmentationText.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/frontend/segmentationText.ml b/src/frontend/segmentationText.ml index 1e3d402be..09590e4ee 100644 --- a/src/frontend/segmentationText.ml +++ b/src/frontend/segmentationText.ml @@ -1,3 +1,6 @@ -let split_utf8 str = Uuseg_string.fold_utf_8 `Grapheme_cluster (fun lst s -> s::lst) [] str +let split_utf8 str = + str + |> Uuseg_string.fold_utf_8 `Grapheme_cluster (fun lst s -> s::lst) [] + |> List.rev From 61c237d045b7c7bcc493e0234f187da7baa285c3 Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Wed, 4 Oct 2023 04:51:34 +0900 Subject: [PATCH 4/9] rename module and add split_utf16be --- src/frontend/graphemeCluster.ml | 11 +++++++++++ src/frontend/graphemeCluster.mli | 4 ++++ src/frontend/segmentationText.ml | 6 ------ src/frontend/segmentationText.mli | 2 -- 4 files changed, 15 insertions(+), 8 deletions(-) create mode 100644 src/frontend/graphemeCluster.ml create mode 100644 src/frontend/graphemeCluster.mli delete mode 100644 src/frontend/segmentationText.ml delete mode 100644 src/frontend/segmentationText.mli diff --git a/src/frontend/graphemeCluster.ml b/src/frontend/graphemeCluster.ml new file mode 100644 index 000000000..cd2ae7512 --- /dev/null +++ b/src/frontend/graphemeCluster.ml @@ -0,0 +1,11 @@ + +let split_utf8 str = + str + |> Uuseg_string.fold_utf_8 `Grapheme_cluster (fun lst s -> s::lst) [] + |> List.rev + + +let split_utf16be str = + str + |> Uuseg_string.fold_utf_16be `Grapheme_cluster (fun lst s -> s::lst) [] + |> List.rev diff --git a/src/frontend/graphemeCluster.mli b/src/frontend/graphemeCluster.mli new file mode 100644 index 000000000..4b09e8381 --- /dev/null +++ b/src/frontend/graphemeCluster.mli @@ -0,0 +1,4 @@ + +val split_utf8 : string -> string list + +val split_utf16be : string -> string list diff --git a/src/frontend/segmentationText.ml b/src/frontend/segmentationText.ml deleted file mode 100644 index 09590e4ee..000000000 --- a/src/frontend/segmentationText.ml +++ /dev/null @@ -1,6 +0,0 @@ - -let split_utf8 str = - str - |> Uuseg_string.fold_utf_8 `Grapheme_cluster (fun lst s -> s::lst) [] - |> List.rev - diff --git a/src/frontend/segmentationText.mli b/src/frontend/segmentationText.mli deleted file mode 100644 index 770566921..000000000 --- a/src/frontend/segmentationText.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val split_utf8 : string -> string list From c9b6c45afa9bca33396755cd8fa4aa515e0fce4b Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Wed, 4 Oct 2023 04:54:51 +0900 Subject: [PATCH 5/9] rename to split-grapheme-cluster --- tools/gencode/vminst.ml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index 979c2be09..4c57f466e 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -2053,8 +2053,8 @@ let ilst = in make_list make_int ilst |} - ; inst "PrimitiveStringSeg" - ~name:"string-seg" + ; inst "PrimitiveSplitGraphemeCluster" + ~name:"split-grapheme-cluster" ~type_:Type.(tS @-> (tL tS)) ~fields:[ ] @@ -2064,10 +2064,7 @@ make_list make_int ilst ~is_pdf_mode_primitive:true ~is_text_mode_primitive:true ~code:{| -let slst = - str - |> SegmentationText.split_utf8 -in +let slst = GraphemeCluster.split_utf8 str in make_list make_string slst |} ; inst "PrimitiveRegexpOfString" From 6c296ef3c2665035ac934f2bec04eca30e5a0632 Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Wed, 4 Oct 2023 04:55:09 +0900 Subject: [PATCH 6/9] add test --- tests/split-grapheme-cluster.saty | 53 +++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 tests/split-grapheme-cluster.saty diff --git a/tests/split-grapheme-cluster.saty b/tests/split-grapheme-cluster.saty new file mode 100644 index 000000000..852970d78 --- /dev/null +++ b/tests/split-grapheme-cluster.saty @@ -0,0 +1,53 @@ +% -*- coding: utf-8 -*- +@import: head +@import: ../lib-satysfi/dist/packages/color +@import: ../lib-satysfi/dist/packages/list + +let open Pervasives in +let open Head in + +let () = + let s1 = + string-unexplode [ + 0x1F1EF, 0x1F1F5, %%% ๐Ÿ‡ฏ๐Ÿ‡ต + 0x30AB, 0x3099, %%% ใ‚ซใ‚™ + 0x30AC, %%% ใ‚ฌ + 0x1F468, 0x200D, 0x1F469, 0x200D, 0x1F466, %%% ๐Ÿ‘จโ€๐Ÿ‘ฉโ€๐Ÿ‘ฆ(family: man, woman, boy) + 0x1F469, 0x200D, 0x1F469, 0x200D, 0x1F467, 0x200D, 0x1F467, %%% ๐Ÿ‘ฉโ€๐Ÿ‘ฉโ€๐Ÿ‘งโ€๐Ÿ‘ง(family: woman, woman, girl, girl) + 0x1F3F4, 0xE0067, 0xE0062, 0xE0077, 0xE006C, 0xE0073, 0xE007F, %%% ๐Ÿด๓ ง๓ ข๓ ท๓ ฌ๓ ณ๓ ฟ(Wales) + 0x1F469, 0x1F3FE, 0x200D, 0x1F393, %%% ๐Ÿ‘ฉโ€๐ŸŽ“(woman student: medium-dark skin tone) + + ] + in + let s2 = + [ + [0x1F1EF, 0x1F1F5], + [0x30AC], + [0x30AC], + [0x1F468, 0x200D, 0x1F469, 0x200D, 0x1F466], + [0x1F469, 0x200D, 0x1F469, 0x200D, 0x1F467, 0x200D, 0x1F467], + [0x1F3F4, 0xE0067, 0xE0062, 0xE0077, 0xE006C, 0xE0073, 0xE007F], + [0x1F469, 0x1F3FE, 0x200D, 0x1F393] + ] + in + let slst = split-grapheme-cluster s1 in + let is-ok = + let rec loop l1 l2 = + match (l1, l2) with + | (s1::xs1, s2::xs2)-> string-same s1 (string-unexplode s2) && (loop xs1 xs2) + | ([], []) -> true + | _ -> false + end + in + loop slst s2 + in + if is-ok then + display-message `ok` + else + abort-with-message `err` +in + +document (| + title = {Normalize string and grapheme cluster}, + author = {\SATySFi; Contributors}, +|) '<> From 163ffd390ff8d9d666b2809d6d961f7280876320 Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Wed, 4 Oct 2023 05:09:42 +0900 Subject: [PATCH 7/9] update dune --- src/dune | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/dune b/src/dune index 170150b2e..c1a6bd824 100644 --- a/src/dune +++ b/src/dune @@ -14,7 +14,9 @@ otfed uutf uunf + uunf.string uuseg + uuseg.string yojson-with-position omd ocamlgraph From d8a14f4154b7cbf14d01d07d41c0f02a0872de0d Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Fri, 13 Oct 2023 13:13:33 +0900 Subject: [PATCH 8/9] add normalize string primitive --- src/frontend/lexer.mll | 34 +++--------------------- src/frontend/normalizeString.ml | 12 +++++---- src/frontend/normalizeString.mli | 8 ++++-- tools/gencode/vminst.ml | 44 +++++++++++++++++++++++++------- 4 files changed, 52 insertions(+), 46 deletions(-) diff --git a/src/frontend/lexer.mll b/src/frontend/lexer.mll index 1c4e5b1d7..1d673b529 100644 --- a/src/frontend/lexer.mll +++ b/src/frontend/lexer.mll @@ -575,15 +575,7 @@ and lex_inline stack = parse else report_error lexbuf "unexpected end of input while reading an inline text area" } - | str+ - { - let s = - Lexing.lexeme lexbuf - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 - in - CHAR(get_pos lexbuf, s) - } + | str+ { CHAR(get_pos lexbuf, Lexing.lexeme lexbuf) } | _ as c { report_error lexbuf (Printf.sprintf "illegal token '%s' in an inline text area" (String.make 1 c)) } @@ -650,15 +642,7 @@ and lex_math stack = parse { MATHCHARS(get_pos lexbuf, Lexing.lexeme lexbuf) } | mathascii { MATHCHARS(get_pos lexbuf, Lexing.lexeme lexbuf) } - | mathstr+ - { - let s = - Lexing.lexeme lexbuf - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 - in - MATHCHARS(get_pos lexbuf, s) - } + | mathstr+ { MATHCHARS(get_pos lexbuf, Lexing.lexeme lexbuf) } | ("#" (((upper ".")* (lower | upper)) as s)) { let pos = get_pos lexbuf in @@ -757,13 +741,8 @@ and literal quote_length buffer = parse end else if len > quote_length then report_error lexbuf "literal area was closed with too many '`'s" else - let s = - Buffer.contents buffer - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 - in let pos_last = get_pos lexbuf in - (pos_last, s, true) + (pos_last, Buffer.contents buffer, true) } | (("`"+ as backticks) "#") { @@ -775,13 +754,8 @@ and literal quote_length buffer = parse end else if len > quote_length then report_error lexbuf "literal area was closed with too many '`'s" else - let s = - Buffer.contents buffer - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 - in let pos_last = get_pos lexbuf in - (pos_last, s, false) + (pos_last, Buffer.contents buffer, false) } | break { diff --git a/src/frontend/normalizeString.ml b/src/frontend/normalizeString.ml index 4283338d1..1276a324a 100644 --- a/src/frontend/normalizeString.ml +++ b/src/frontend/normalizeString.ml @@ -4,14 +4,16 @@ type t = string *) -let form = `NFC +let of_utf8_nfd str = Uunf_string.normalize_utf_8 `NFD str +let of_utf8_nfc str = Uunf_string.normalize_utf_8 `NFC str -let of_utf8 str = Uunf_string.normalize_utf_8 form str - -let of_utf16be str = +let of_utf16be_nfd str = let str_utf8 = str |> InternalText.of_utf16be |> InternalText.to_utf8 in - Uunf_string.normalize_utf_8 form str_utf8 + Uunf_string.normalize_utf_8 `NFD str_utf8 +let of_utf16be_nfc str = + let str_utf8 = str |> InternalText.of_utf16be |> InternalText.to_utf8 in + Uunf_string.normalize_utf_8 `NFC str_utf8 let to_utf8 t = t diff --git a/src/frontend/normalizeString.mli b/src/frontend/normalizeString.mli index 7f9c98bcc..85ef14efa 100644 --- a/src/frontend/normalizeString.mli +++ b/src/frontend/normalizeString.mli @@ -1,8 +1,12 @@ type t -val of_utf8 : string -> t +val of_utf8_nfd : string -> t -val of_utf16be : string -> t +val of_utf8_nfc : string -> t + +val of_utf16be_nfd : string -> t + +val of_utf16be_nfc : string -> t val to_utf8 : t -> string diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index 4c57f466e..745455c17 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -1618,13 +1618,9 @@ CompiledInlineTextClosure([CompiledImInlineTextText(str)], env) ~is_pdf_mode_primitive:true ~is_text_mode_primitive:true ~code:{| -let s = - ibs - |> HorzBox.extract_string - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 -in -make_string s +ibs +|> HorzBox.extract_string +|> make_string |} ; inst "PrimitiveInlineSkip" ~name:"inline-skip" @@ -2029,8 +2025,6 @@ let s = (List.map Uchar.of_int ilst) |> InternalText.of_uchar_list |> InternalText.to_utf8 - |> NormalizeString.of_utf8 - |> NormalizeString.to_utf8 in make_string s |} @@ -2052,6 +2046,38 @@ let ilst = |> List.map Uchar.to_int in make_list make_int ilst +|} + ; inst "PrimitiveNormlizeStringToNfc" + ~name:"normalize-string-to-nfc" + ~type_:Type.(tS @-> tS) + ~fields:[ + ] + ~params:[ + param "str" ~type_:"string"; + ] + ~is_pdf_mode_primitive:true + ~is_text_mode_primitive:true + ~code:{| +str +|> NormalizeString.of_utf8_nfc +|> NormalizeString.to_utf8 +|> make_string +|} + ; inst "PrimitiveNormlizeStringToNfd" + ~name:"normalize-string-to-nfd" + ~type_:Type.(tS @-> tS) + ~fields:[ + ] + ~params:[ + param "str" ~type_:"string"; + ] + ~is_pdf_mode_primitive:true + ~is_text_mode_primitive:true + ~code:{| +str +|> NormalizeString.of_utf8_nfd +|> NormalizeString.to_utf8 +|> make_string |} ; inst "PrimitiveSplitGraphemeCluster" ~name:"split-grapheme-cluster" From 3a45418b5869a6479c15155ee4157d43548427a3 Mon Sep 17 00:00:00 2001 From: puripuri2100 Date: Fri, 13 Oct 2023 13:13:49 +0900 Subject: [PATCH 9/9] update test --- tests/split-grapheme-cluster.saty | 41 ++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/tests/split-grapheme-cluster.saty b/tests/split-grapheme-cluster.saty index 852970d78..2b5cc07a0 100644 --- a/tests/split-grapheme-cluster.saty +++ b/tests/split-grapheme-cluster.saty @@ -30,21 +30,38 @@ let () = [0x1F469, 0x1F3FE, 0x200D, 0x1F393] ] in - let slst = split-grapheme-cluster s1 in - let is-ok = - let rec loop l1 l2 = - match (l1, l2) with - | (s1::xs1, s2::xs2)-> string-same s1 (string-unexplode s2) && (loop xs1 xs2) - | ([], []) -> true - | _ -> false - end - in - loop slst s2 + let s3 = + [ + [0x1F1EF, 0x1F1F5], + [0x30AB, 0x3099], + [0x30AB, 0x3099], + [0x1F468, 0x200D, 0x1F469, 0x200D, 0x1F466], + [0x1F469, 0x200D, 0x1F469, 0x200D, 0x1F467, 0x200D, 0x1F467], + [0x1F3F4, 0xE0067, 0xE0062, 0xE0077, 0xE006C, 0xE0073, 0xE007F], + [0x1F469, 0x1F3FE, 0x200D, 0x1F393] + ] + in + let slst1 = s1 |> normalize-string-to-nfc |> split-grapheme-cluster in + let slst2 = s1 |> normalize-string-to-nfd |> split-grapheme-cluster in + let rec check-loop l1 l2 = + match (l1, l2) with + | (s1::xs1, s2::xs2)-> string-same s1 (string-unexplode s2) && (check-loop xs1 xs2) + | ([], []) -> true + | _ -> false + end in - if is-ok then + let is-ok1 = check-loop slst1 s2 in + let is-ok2 = check-loop slst2 s3 in + if is-ok1 && is-ok2 then display-message `ok` else - abort-with-message `err` + if not is-ok1 && not is-ok2 then + abort-with-message `err1, 2` + else + if not is-ok1 then + abort-with-message `err1` + else + abort-with-message `err2` in document (|