From dae520ca1275d6d38e12f63ce508065cc0c5471a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20B=C3=BCnzli?= Date: Sun, 9 Jul 2017 01:46:14 +0200 Subject: Add Unicode character escape \u{X+} to OCaml string literals. The syntax of string literals is changed to add the \u{X+} escape sequence which replaces the escape by the UTF-8 encoding of the Unicode scalar value denoted by the hexadecimal number H made of one to six lower or uppercase hexadecimal digits. Unfortunately due to OCaml lax policy about escape sequences this change can break program that trigger warning 14 on compilation. More precisely programs which have literals with "\u" as a substring will now either fail or the string literal will be silently compiled to another representation in case the literal has a subsequence that respects the \u{X+} syntax. --- Changes | 6 ++++ manual/manual/refman/lex.etex | 9 +++++- parsing/lexer.mll | 41 +++++++++++++++++++++++++++ testsuite/tests/lexing/Makefile | 3 ++ testsuite/tests/lexing/uchar_esc.ml | 34 ++++++++++++++++++++++ testsuite/tests/lexing/uchar_esc.ml.reference | 36 +++++++++++++++++++++++ 6 files changed, 128 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/lexing/Makefile create mode 100644 testsuite/tests/lexing/uchar_esc.ml create mode 100644 testsuite/tests/lexing/uchar_esc.ml.reference diff --git a/Changes b/Changes index dca41f935b..b22be38433 100644 --- a/Changes +++ b/Changes @@ -9,6 +9,12 @@ Working version can be used as a placeholder for a polymorphic function. (Stephen Dolan) +* GPR#1232: Support Unicode character escape sequences in string + literals via the \u{X+} syntax. These escapes are substituted by the + UTF-8 encoding of the Unicode character. + (Daniel Bünzli, review by Damien Doligez, Alain Frisch, Xavier + Leroy and Leo White) + ### Code generation and optimizations: - PR#5324, GPR#375: An alternative Linear Scan register allocator for diff --git a/manual/manual/refman/lex.etex b/manual/manual/refman/lex.etex index 9ddce69b4d..fa24d1e468 100644 --- a/manual/manual/refman/lex.etex +++ b/manual/manual/refman/lex.etex @@ -151,13 +151,20 @@ string-literal: string-character: regular-string-char | escape-sequence + | "\u{" ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")+ "}" | '\' newline { space || tab } \end{syntax} String literals are delimited by @'"'@ (double quote) characters. The two double quotes enclose a sequence of either characters different from @'"'@ and @'\'@, or escape sequences from the -table given above for character literals. +table given above for character literals, or a Unicode character +escape sequence. + +A Unicode character escape sequence is substituted by the UTF-8 +encoding of the specified Unicode scalar value. The Unicode scalar +value, an integer in the ranges 0x0000...0xD7FF or 0xE000...0x10FFFF, +is defined using 1 to 6 hexadecimal digits; leading zeros are allowed. To allow splitting long string literals across lines, the sequence "\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line diff --git a/parsing/lexer.mll b/parsing/lexer.mll index 6936c8265d..f2c640d427 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -141,6 +141,16 @@ let print_warnings = ref true let store_escaped_char lexbuf c = if in_comment () then store_lexeme lexbuf else store_string_char c +let store_escaped_uchar = + let uchar_utf_8_enc = Buffer.create 4 in + fun lexbuf u -> + if in_comment () then store_lexeme lexbuf else + begin + Buffer.reset uchar_utf_8_enc; + Buffer.add_utf_8_uchar uchar_utf_8_enc u; + store_string (Buffer.contents uchar_utf_8_enc); + end + let with_comment_buffer comment lexbuf = let start_loc = Location.curr lexbuf in comment_start_loc := [start_loc]; @@ -190,6 +200,32 @@ let char_for_hexadecimal_code lexbuf i = in Char.chr (val1 * 16 + val2) +let uchar_for_uchar_escape lexbuf = + let err e = + raise + (Error (Illegal_escape (Lexing.lexeme lexbuf ^ e), Location.curr lexbuf)) + in + let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in + let spos = 3 (* skip opening \u{ *) in + let epos = len - 2 (* skip closing } *) in + let digit_count = epos - spos + 1 in + if digit_count > 6 + then err ", too many digits, expected 1 to 6 hexadecimal digits" + else + let rec hex_num_value acc i = + if i > epos then acc else + let digit = Char.code (Lexing.lexeme_char lexbuf i) in + let value = + if digit >= 97 then digit - 87 else + if digit >= 65 then digit - 55 else + digit - 48 + in + hex_num_value (16 * acc + value) (i + 1) + in + let cp = hex_num_value 0 spos in + if Uchar.is_valid cp then Uchar.unsafe_of_int cp else + err (", " ^ Printf.sprintf "%X" cp ^ " is not a Unicode scalar value") + (* recover the name from a LABEL or OPTLABEL token *) let get_label_name lexbuf = @@ -290,6 +326,8 @@ let symbolchar = ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] let decimal_literal = ['0'-'9'] ['0'-'9' '_']* +let hex_digit = + ['0'-'9' 'A'-'F' 'a'-'f'] let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']* let oct_literal = @@ -627,6 +665,9 @@ and string = parse | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] { store_escaped_char lexbuf (char_for_hexadecimal_code lexbuf 2); string lexbuf } + | '\\' 'u' '{' hex_digit+ '}' + { store_escaped_uchar lexbuf (uchar_for_uchar_escape lexbuf); + string lexbuf } | '\\' _ { if not (in_comment ()) then begin (* Should be an error, but we are very lax. diff --git a/testsuite/tests/lexing/Makefile b/testsuite/tests/lexing/Makefile new file mode 100644 index 0000000000..9625a3fbc3 --- /dev/null +++ b/testsuite/tests/lexing/Makefile @@ -0,0 +1,3 @@ +BASEDIR=../.. +include $(BASEDIR)/makefiles/Makefile.toplevel +include $(BASEDIR)/makefiles/Makefile.common diff --git a/testsuite/tests/lexing/uchar_esc.ml b/testsuite/tests/lexing/uchar_esc.ml new file mode 100644 index 0000000000..b288ac2561 --- /dev/null +++ b/testsuite/tests/lexing/uchar_esc.ml @@ -0,0 +1,34 @@ + +(* Correct escapes and their encoding *) + +let () = + assert ("\xF0\x9F\x90\xAB" = "\u{1F42B}"); + assert ("\xF0\x9F\x90\xAB" = "\u{01F42B}"); + assert ("\x00" = "\u{0}"); + assert ("\x00" = "\u{00}"); + assert ("\x00" = "\u{000}"); + assert ("\x00" = "\u{0000}"); + assert ("\x00" = "\u{00000}"); + assert ("\x00" = "\u{000000}"); + assert ("\xC3\xA9" = "\u{E9}"); + assert ("\xC3\xA9" = "\u{0E9}"); + assert ("\xC3\xA9" = "\u{00E9}"); + assert ("\xC3\xA9" = "\u{000E9}"); + assert ("\xC3\xA9" = "\u{0000E9}"); + assert ("\xC3\xA9" = "\u{0000E9}"); + assert ("\xF4\x8F\xBF\xBF" = "\u{10FFFF}"); + () +;; + + +(* Errors *) + +let invalid_sv = "\u{0D800}" ;; +let invalid_sv = "\u{D800}" ;; +let invalid_sv = "\u{D900}" ;; +let invalid_sv = "\u{DFFF}" ;; +let invalid_sv = "\u{110000} ;; + +let too_many_digits = "\u{01234567}" ;; +let no_hex_digits = "\u{}" ;; +let illegal_hex_digit = "\u{u}" ;; diff --git a/testsuite/tests/lexing/uchar_esc.ml.reference b/testsuite/tests/lexing/uchar_esc.ml.reference new file mode 100644 index 0000000000..8730059c99 --- /dev/null +++ b/testsuite/tests/lexing/uchar_esc.ml.reference @@ -0,0 +1,36 @@ + +# # Characters 34-43: + let invalid_sv = "\u{0D800}" ;; + ^^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{0D800}, D800 is not a Unicode scalar value) +# Characters 18-26: + let invalid_sv = "\u{D800}" ;; + ^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{D800}, D800 is not a Unicode scalar value) +# Characters 18-26: + let invalid_sv = "\u{D900}" ;; + ^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{D900}, D900 is not a Unicode scalar value) +# Characters 18-26: + let invalid_sv = "\u{DFFF}" ;; + ^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{DFFF}, DFFF is not a Unicode scalar value) +# Characters 18-28: + let invalid_sv = "\u{110000} ;; + ^^^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{110000}, 110000 is not a Unicode scalar value) +# Characters 24-36: + let too_many_digits = "\u{01234567}" ;; + ^^^^^^^^^^^^ +Error: Illegal backslash escape in string or character (\u{01234567}, too many digits, expected 1 to 6 hexadecimal digits) +# Characters 21-23: + let no_hex_digits = "\u{}" ;; + ^^ +Warning 14: illegal backslash escape in string. +val no_hex_digits : string = "\\u{}" +# Characters 25-27: + let illegal_hex_digit = "\u{u}" ;; + ^^ +Warning 14: illegal backslash escape in string. +val illegal_hex_digit : string = "\\u{u}" +# -- cgit v1.2.1 From 201c4f135985c9e90457b32f7565a9bdbbcdceeb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20B=C3=BCnzli?= Date: Mon, 10 Jul 2017 18:54:32 +0200 Subject: Lexer escapes: factorize hex number parsing. --- parsing/lexer.mll | 56 ++++++++++++++++++++++++++----------------------------- 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/parsing/lexer.mll b/parsing/lexer.mll index f2c640d427..b11443fff1 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -163,6 +163,21 @@ let with_comment_buffer comment lexbuf = (* To translate escape sequences *) +let hex_digit_value d = (* assert (d in '0'..'9' 'a'..'f' 'A'..'F') *) + let d = Char.code d in + if d >= 97 then d - 87 else + if d >= 65 then d - 55 else + d - 48 + +let hex_num_value lexbuf ~first ~last = + let rec loop acc i = match i > last with + | true -> acc + | false -> + let value = hex_digit_value (Lexing.lexeme_char lexbuf i) in + loop (16 * acc + value) (i + 1) + in + loop 0 first + let char_for_backslash = function | 'n' -> '\010' | 'r' -> '\013' @@ -188,17 +203,8 @@ let char_for_octal_code lexbuf i = Char.chr c let char_for_hexadecimal_code lexbuf i = - let d1 = Char.code (Lexing.lexeme_char lexbuf i) in - let val1 = if d1 >= 97 then d1 - 87 - else if d1 >= 65 then d1 - 55 - else d1 - 48 - in - let d2 = Char.code (Lexing.lexeme_char lexbuf (i+1)) in - let val2 = if d2 >= 97 then d2 - 87 - else if d2 >= 65 then d2 - 55 - else d2 - 48 - in - Char.chr (val1 * 16 + val2) + let byte = hex_num_value lexbuf ~first:i ~last:(i+1) in + Char.chr byte let uchar_for_uchar_escape lexbuf = let err e = @@ -206,25 +212,15 @@ let uchar_for_uchar_escape lexbuf = (Error (Illegal_escape (Lexing.lexeme lexbuf ^ e), Location.curr lexbuf)) in let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in - let spos = 3 (* skip opening \u{ *) in - let epos = len - 2 (* skip closing } *) in - let digit_count = epos - spos + 1 in - if digit_count > 6 - then err ", too many digits, expected 1 to 6 hexadecimal digits" - else - let rec hex_num_value acc i = - if i > epos then acc else - let digit = Char.code (Lexing.lexeme_char lexbuf i) in - let value = - if digit >= 97 then digit - 87 else - if digit >= 65 then digit - 55 else - digit - 48 - in - hex_num_value (16 * acc + value) (i + 1) - in - let cp = hex_num_value 0 spos in - if Uchar.is_valid cp then Uchar.unsafe_of_int cp else - err (", " ^ Printf.sprintf "%X" cp ^ " is not a Unicode scalar value") + let first = 3 (* skip opening \u{ *) in + let last = len - 2 (* skip closing } *) in + let digit_count = last - first + 1 in + match digit_count > 6 with + | true -> err ", too many digits, expected 1 to 6 hexadecimal digits" + | false -> + let cp = hex_num_value lexbuf ~first ~last in + if Uchar.is_valid cp then Uchar.unsafe_of_int cp else + err (", " ^ Printf.sprintf "%X" cp ^ " is not a Unicode scalar value") (* recover the name from a LABEL or OPTLABEL token *) -- cgit v1.2.1 From 8546522f674137800566fd0060b67503b7856b8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20B=C3=BCnzli?= Date: Thu, 20 Jul 2017 01:20:08 +0200 Subject: Lexer string literals: use Buffer module. Replace the local implementation of a growable string buffer by a Buffer.t value. --- parsing/lexer.mll | 48 ++++++++++-------------------------------------- 1 file changed, 10 insertions(+), 38 deletions(-) diff --git a/parsing/lexer.mll b/parsing/lexer.mll index b11443fff1..178f3be852 100644 --- a/parsing/lexer.mll +++ b/parsing/lexer.mll @@ -99,35 +99,14 @@ let keyword_table = (* To buffer string literals *) -let initial_string_buffer = Bytes.create 256 -let string_buff = ref initial_string_buffer -let string_index = ref 0 - -let reset_string_buffer () = - string_buff := initial_string_buffer; - string_index := 0 - -let store_string_char c = - if !string_index >= Bytes.length !string_buff then begin - let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in - Bytes.blit !string_buff 0 new_buff 0 (Bytes.length !string_buff); - string_buff := new_buff - end; - Bytes.unsafe_set !string_buff !string_index c; - incr string_index - -let store_string s = - for i = 0 to String.length s - 1 do - store_string_char s.[i]; - done - -let store_lexeme lexbuf = - store_string (Lexing.lexeme lexbuf) - -let get_stored_string () = - let s = Bytes.sub_string !string_buff 0 !string_index in - string_buff := initial_string_buffer; - s +let string_buffer = Buffer.create 256 +let reset_string_buffer () = Buffer.reset string_buffer +let get_stored_string () = Buffer.contents string_buffer + +let store_string_char c = Buffer.add_char string_buffer c +let store_string_utf_8_uchar u = Buffer.add_utf_8_uchar string_buffer u +let store_string s = Buffer.add_string string_buffer s +let store_lexeme lexbuf = store_string (Lexing.lexeme lexbuf) (* To store the position of the beginning of a string and comment *) let string_start_loc = ref Location.none;; @@ -141,15 +120,8 @@ let print_warnings = ref true let store_escaped_char lexbuf c = if in_comment () then store_lexeme lexbuf else store_string_char c -let store_escaped_uchar = - let uchar_utf_8_enc = Buffer.create 4 in - fun lexbuf u -> - if in_comment () then store_lexeme lexbuf else - begin - Buffer.reset uchar_utf_8_enc; - Buffer.add_utf_8_uchar uchar_utf_8_enc u; - store_string (Buffer.contents uchar_utf_8_enc); - end +let store_escaped_uchar lexbuf u = + if in_comment () then store_lexeme lexbuf else store_string_utf_8_uchar u let with_comment_buffer comment lexbuf = let start_loc = Location.curr lexbuf in -- cgit v1.2.1