diff --git a/lib/check.ml b/lib/check.ml index 3df117fe..9b99ea93 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8927,8 +8927,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms = if p >= 17 || float_of_string t = x then t else go (p + 1) in go 1 - | Ast.Byte b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b) - | Ast.Byte b -> string_of_int b + | Ast.Byte b -> Form.byte_repr b | Ast.Str t -> Printf.sprintf "%S" t | Ast.Kw k -> ":" ^ k | Ast.Var b -> b diff --git a/lib/form.ml b/lib/form.ml index e93caecc..f85d0665 100644 --- a/lib/form.ml +++ b/lib/form.ml @@ -34,6 +34,23 @@ let utf8 b = Buffer.add_utf_8_uchar buf (Uchar.of_int b); Buffer.contents buf +(* A char's spelling, the one [Reader.read_byte] reads back as the same code + point: a name where the reader has one, Clojure's \uXXXX for every other + control character and DEL, and the character itself otherwise. + runtime/flan_dyn.c's [char_spell] writes the same table. *) +let byte_repr b = + match b with + | 32 -> "\\space" + | 9 -> "\\tab" + | 10 -> "\\newline" + | 13 -> "\\return" + | 0 -> "\\nul" + | 8 -> "\\backspace" + | 12 -> "\\formfeed" + | b when b < 32 || b = 127 -> Printf.sprintf "\\u%04X" b + | b when b < 127 -> Printf.sprintf "\\%c" (Char.chr b) + | b -> "\\" ^ utf8 b + let rec to_string f = let seq l = String.concat " " (List.map to_string l) in match f.v with @@ -43,13 +60,7 @@ let rec to_string f = | UInt (_, s) -> s | Float x -> Printf.sprintf "%g" x | Str s -> Printf.sprintf "%S" s - | Byte b when b > 127 -> "\\" ^ utf8 b - | Byte b -> - (match Char.chr b with - | ' ' -> "\\space" - | '\t' -> "\\tab" - | '\n' -> "\\newline" - | c -> Printf.sprintf "\\%c" c) + | Byte b -> byte_repr b | List l -> "(" ^ seq l ^ ")" | Vec l -> "[" ^ seq l ^ "]" | Map l -> "{" ^ seq l ^ "}" @@ -77,9 +88,8 @@ let rec to_string f = - [%S] is OCaml's escaping. The reader takes exactly six escapes — newline, tab, return, backslash, quote and nul — and every other byte literally, so the three-digit decimal escape [%S] writes would not read back. - - [Byte] falls through to \, which spells 0 and 13 as a NUL and a - carriage return sitting in the middle of the source. The reader has names - for those and this uses them. *) + - A control character written as itself is a raw byte in the middle of + the source. [byte_repr] names it, or writes \uXXXX. *) let escape s = let b = Buffer.create (String.length s + 2) in @@ -117,22 +127,6 @@ let float_repr x = in if plain then s ^ ".0" else s -let byte_repr b = - match b with - | 32 -> "\\space" - | 9 -> "\\tab" - | 10 -> "\\newline" - | 13 -> "\\return" - | 0 -> "\\nul" - (* Printable ASCII, and any code point past ASCII, is written as itself. A - control character has no spelling in the reader at all — [read_byte] - takes a name or a single character — so it is written as the decimal the - reader would have to grow, rather than as a byte that would corrupt the - line it is on. *) - | b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b) - | b when b > 127 -> "\\" ^ utf8 b - | b -> Printf.sprintf "\\%d" b - (** One line, and a reader reads it back. *) let rec to_source f = let seq l = String.concat " " (List.map to_source l) in diff --git a/lib/reader.ml b/lib/reader.ml index e32fe22d..07516ceb 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -113,7 +113,8 @@ let read_string st = go (); spanned st loc (Form.Str (Buffer.contents buf)) -(* \space \tab \newline \return \nul, or \ *) +(* \space \tab \newline \return \nul \backspace \formfeed, Clojure's \uXXXX + (four hex digits), or \ *) let read_byte st = let loc = here st in advance st; (* backslash *) @@ -128,7 +129,18 @@ let read_byte st = | "newline" -> 10 | "return" -> 13 | "nul" -> 0 + | "backspace" -> 8 + | "formfeed" -> 12 | n when String.length n = 1 -> Char.code n.[0] + | n when String.length n = 5 && n.[0] = 'u' + && String.for_all + (function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false) + (String.sub n 1 4) -> + let c = int_of_string ("0x" ^ String.sub n 1 4) in + if not (Uchar.is_valid c) then + Loc.failk "reader/unknown-character" loc + "\\%s is a surrogate, which is not a character" n; + c (* One code point written as itself, UTF-8 in the source: \é \日. *) | n when (let d = String.get_utf_8_uchar n 0 in Uchar.utf_decode_is_valid d diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 9f9294f0..342d8866 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -739,10 +739,10 @@ static int is_scalar(int64_t cp) { return cp >= 0 && cp <= 0x10FFFF && !(cp >= 0xD800 && cp <= 0xDFFF); } -/* A char's spelling, as lib/reader.ml's [read_byte] reads it and - * lib/form.ml's [byte_repr] writes it: the five names, the character itself - * after the backslash, and the decimal for a control character, which has - * no spelling the reader takes. */ +/* A char's spelling, as lib/reader.ml's [read_byte] reads it back and + * lib/form.ml's [byte_repr] writes it: a name where there is one, \uXXXX + * for every other control character and DEL, the character itself after the + * backslash otherwise. */ static void char_spell(uint32_t cp, char buf[16]) { uint8_t u[4]; int n, i; @@ -752,9 +752,11 @@ static void char_spell(uint32_t cp, char buf[16]) { case 10: strcpy(buf, "\\newline"); return; case 13: strcpy(buf, "\\return"); return; case 0: strcpy(buf, "\\nul"); return; + case 8: strcpy(buf, "\\backspace"); return; + case 12: strcpy(buf, "\\formfeed"); return; default: break; } - if (cp < 32 || cp == 127) { snprintf(buf, 16, "\\%u", (unsigned)cp); return; } + if (cp < 32 || cp == 127) { snprintf(buf, 16, "\\u%04X", (unsigned)cp); return; } n = utf8_encode(cp, u); buf[0] = '\\'; for (i = 0; i < n; i++) buf[1 + i] = (char)u[i]; diff --git a/test/programs/dyn-char-spell.flan b/test/programs/dyn-char-spell.flan new file mode 100644 index 00000000..a4c26dca --- /dev/null +++ b/test/programs/dyn-char-spell.flan @@ -0,0 +1,13 @@ +;;;; Every ASCII code point, and a few past it, as dyn chars printed one per +;;;; line. The test reads each line back with the reader and wants the same +;;;; code point, so what a char prints as is what reads as it. + +(defn main [] i32 + (let [v (vec-new u8)] + (dotimes [i 128] (push v (u8 i))) + (let [t (the dyn (str (slice v)))] + (dotimes [i (length t)] (println (at t i)))) + (let [u (the dyn "é日😀")] + (dotimes [i (length u)] (println (at u i)))) + (free v)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 4bc0fd6d..8d3f0f3b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5360,6 +5360,39 @@ level "1" outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out; outputs ~opt:"-O0" "dyn: chars, -O0" "programs/dyn-char.flan" dyn_char_out; outputs ~x86:true "dyn: chars, --x86" "programs/dyn-char.flan" dyn_char_out; + (* Print, then read: each char dyn-char-spell.flan prints — every ASCII + code point, then three past it — reads back as the code point it was, + and so does the compiler's own spelling of the same literal, which is + what flan convert writes. *) + let spelled = List.init 128 Fun.id @ [ 0xE9; 0x65E5; 0x1F600 ] in + let read_char s = + match Reader.read_all ~file:"" s with + | [ { Form.v = Form.Byte b; _ } ] -> Some b + | _ | (exception Loc.Error _) -> None + in + List.iter + (fun cp -> + let s = Form.byte_repr cp in + if read_char s <> Some cp then begin + incr failures; + Printf.printf "FAIL char %d is written %S, which does not read \ + back as it\n" cp s + end) + spelled; + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/dyn-char-spell.flan" in + let code, text = run exe None in + let lines = String.split_on_char '\n' text in + let lines = List.filteri (fun i _ -> i < List.length spelled) lines in + let got = List.map read_char lines in + if code <> 0 || got <> List.map Option.some spelled then begin + incr failures; + Printf.printf "FAIL dyn chars read back as printed%s\n \ + got: %S (exit %d)\n" + (if x86 then ", --x86" else "") text code + end) + [ false; true ]; List.iter (fun x86 -> let exe = compile ~x86 "programs/dyn-char.flan" in diff --git a/test/test_flan.ml b/test/test_flan.ml index 6b853e5f..6407735e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -113,6 +113,10 @@ let () = reads "byte named" "\\space" "\\space"; reads "byte digit" "\\0" "\\0"; reads "byte paren" "\\(" "\\("; + reads "char by \\uXXXX" "\\u0041" "\\A"; + reads "control char" "\\u0007" "\\u0007"; + reads "char named" "\\backspace" "\\backspace"; + reads "non-ASCII char" "\\日" "\\日"; reads "byte dot" "\\." "\\."; (* ── Sequences ─────────────────────────────────────────────────── *) diff --git a/test/test_syntax.ml b/test/test_syntax.ml index fc970edb..400ab5e4 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -474,6 +474,9 @@ let () = (* Characters, lexed before brackets and separators. *) reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])"; reads "character arguments" "f(\\,, \\))" "(f \\, \\))"; + reads "character spellings" + "x = [\\u0041 \\u0007 \\backspace \\formfeed \\日]" + "(set x [\\A \\u0007 \\backspace \\formfeed \\日])"; (* Keywords and annotations. *) reads "keyword" "let k = :else" "(def k dyn :else)"; reads "annotation" "once grid: [4 [8 u32]]" "(defonce grid [4 [8 u32]])";