Add some notes on potential further validation

Likely needs more library support: dbuenzli/uucp#25

Author: WardBrian

Jenkinsfile

@@ -115,7 +115,7 @@ pipeline {
     }
     environment {
         CXX = 'clang++-6.0'
-        MACOS_SWITCH = 'stanc3-4.14'
+        MACOS_SWITCH = 'stanc3-4.14-unicode'
         PARALLEL = 4
         GIT_AUTHOR_NAME = 'Stan Jenkins'
         GIT_AUTHOR_EMAIL = '[email protected]'

scripts/install_build_deps.sh

@@ -7,6 +7,7 @@ eval $(opam env)
 
 opam pin -y core v0.16.0 --no-action
 
-opam install -y dune core.v0.16.0 menhir.20230608 ppx_deriving.5.2.1 fmt.0.9.0 yojson.2.1.0 cmdliner.1.3.0
+opam install -y dune core.v0.16.0 menhir.20230608 ppx_deriving.5.2.1 fmt.0.9.0 yojson.2.1.0\
+ cmdliner.1.3.0 uucp.16.0.0 uunf.16.0.0
 
 eval $(opam env)

scripts/install_build_deps_windows.sh

@@ -17,6 +17,7 @@ opam install -y "ocaml-windows64=4.14.1"
 
 # Install dependencies
 opam install -y core.v0.16.1 core-windows.v0.16.1 menhir.20230608 menhir-windows.20230608 ppx_deriving.5.2.1 ppx_deriving-windows.5.2.1\
- fmt.0.9.0 fmt-windows.0.9.0 yojson.2.1.0 yojson-windows.2.1.0 cmdliner.1.3.0 cmdliner-windows.1.3.0
+ fmt.0.9.0 fmt-windows.0.9.0 yojson.2.1.0 yojson-windows.2.1.0 cmdliner.1.3.0 cmdliner-windows.1.3.0 uucp.16.0.0 uucp-windows.16.0.0\
+ uunf.16.0.0 uunf-windows.16.0.0
 
 eval $(opam env)

src/common/Unicode.ml

@@ -13,23 +13,95 @@ let is_ascii s =
 
 let normalize = Uunf_string.normalize_utf_8 `NFKC
 
-let iter_uchars s f =
-  let len = String.length s in
-  let out = Buffer.create len in
-  let pos = ref 0 in
-  (* move through code point by code point *)
-  while !pos != len do
-    let decode = String.get_utf_8_uchar s !pos in
-    let char_length = Uchar.utf_decode_length decode in
-    let uchar = Uchar.utf_decode_uchar decode in
-    Buffer.add_utf_8_uchar out uchar;
-    f !pos uchar;
-    pos := !pos + char_length
-  done;
+let foldi_uchars ~f acc str =
+  let len = String.length str in
+  let rec loop pos acc =
+    if pos == len then acc
+    else
+      let decode = String.get_utf_8_uchar str pos in
+      let char_length = Uchar.utf_decode_length decode in
+      let uchar = Uchar.utf_decode_uchar decode in
+      let acc = f acc pos uchar in
+      loop (pos + char_length) acc in
+  loop 0 acc
+
+let iteri_uchars ~f str =
+  let f' buf pos c =
+    f pos c;
+    Buffer.add_utf_8_uchar buf c;
+    buf in
+  let s_after =
+    Buffer.contents
+    @@ foldi_uchars ~f:f' (Buffer.create (String.length str)) str in
   (* another sanity check *)
-  let s_after = Buffer.contents out in
-  if not (String.equal s s_after) then
+  if not (String.equal str s_after) then
     Core.(
       ICE.internal_compiler_error
         [%message
-          "Failed to round-trip unicode string!" (s : string) (s_after : string)])
+          "Failed to round-trip unicode string!"
+            (str : string)
+            (s_after : string)])
+
+(* WIP:
+
+   While not strictly necessary, there are some additional restrictions which
+   are good to implement for validation and preventing strings that are visually
+   identical from being distinct identifiers.
+   A good summary can be found here: https://perl11.org/blog/unicode-identifiers.html
+
+   Most of these are only a problem if you assume maliciousness of the user,
+   so they may not be important for an initial version in Stan.
+*)
+
+(* Defined in https://www.unicode.org/reports/tr39/#Confusable_Detection *)
+let confusable x y =
+  let skeleton x =
+    let x = Uunf_string.normalize_utf_8 `NFD x in
+    let f acc _ c =
+      if Uucp.Gen.is_default_ignorable c then ()
+      else
+        (* TODO!! replace with prototype - need data? *)
+        Buffer.add_utf_8_uchar acc c;
+      acc in
+    let buf = foldi_uchars ~f (Buffer.create (String.length x)) x in
+    let x = Buffer.contents buf in
+    let x = Uunf_string.normalize_utf_8 `NFD x in
+    x in
+  String.compare (skeleton x) (skeleton y)
+
+module ScriptSet = Set.Make (Uucp.Script)
+
+(** copied from UUCP's definition of [Uucp.Script.t] *)
+let all =
+  ScriptSet.of_list
+    [ `Adlm; `Aghb; `Ahom; `Arab; `Armi; `Armn; `Avst; `Bali; `Bamu; `Bass; `Batk
+    ; `Beng; `Bhks; `Bopo; `Brah; `Brai; `Bugi; `Buhd; `Cakm; `Cans; `Cari
+    ; `Cham; `Cher; `Chrs; `Copt; `Cpmn; `Cprt; `Cyrl; `Deva; `Diak; `Dogr
+    ; `Dsrt; `Dupl; `Egyp; `Elba; `Elym; `Ethi; `Geor; `Glag; `Gong; `Gonm
+    ; `Goth; `Gran; `Grek; `Gujr; `Guru; `Hang; `Hani; `Hano; `Hatr; `Hebr
+    ; `Hira; `Hluw; `Hmng; `Hmnp; `Hrkt; `Hung; `Ital; `Java; `Kali; `Kana
+    ; `Kawi; `Khar; `Khmr; `Khoj; `Knda; `Kthi; `Kits; `Lana; `Laoo; `Latn
+    ; `Lepc; `Limb; `Lina; `Linb; `Lisu; `Lyci; `Lydi; `Mahj; `Maka; `Mand
+    ; `Mani; `Marc; `Medf; `Mend; `Merc; `Mero; `Mlym; `Modi; `Mong; `Mroo
+    ; `Mtei; `Mult; `Mymr; `Nagm; `Nand; `Narb; `Nbat; `Newa; `Nkoo; `Nshu
+    ; `Ogam; `Olck; `Orkh; `Orya; `Osge; `Osma; `Ougr; `Palm; `Pauc; `Perm
+    ; `Phag; `Phli; `Phlp; `Phnx; `Plrd; `Prti; `Qaai; `Rjng; `Rohg; `Runr
+    ; `Samr; `Sarb; `Saur; `Sgnw; `Shaw; `Shrd; `Sidd; `Sind; `Sinh; `Sogd
+    ; `Sogo; `Sora; `Soyo; `Sund; `Sylo; `Syrc; `Tagb; `Takr; `Tale; `Talu
+    ; `Taml; `Tang; `Tavt; `Telu; `Tfng; `Tglg; `Thaa; `Thai; `Tibt; `Tirh
+    ; `Tnsa; `Toto; `Ugar; `Vaii; `Vith; `Wara; `Wcho; `Xpeo; `Xsux; `Yezi
+    ; `Yiii; `Zanb; `Zinh; `Zyyy; `Zzzz ]
+
+let extended s =
+  if ScriptSet.mem `Zyyy s || ScriptSet.mem `Zinh s then all else s
+
+(* Defined in https://www.unicode.org/reports/tr39/#Restriction_Level_Detection *)
+let restriction_level x =
+  let f acc _ c =
+    let scripts =
+      Uucp.Script.script_extensions c |> ScriptSet.of_list |> extended in
+    scripts :: acc in
+  let soss = foldi_uchars ~f [] x in
+  let resolved = List.fold_right ScriptSet.inter soss all in
+  if not @@ ScriptSet.is_empty resolved then `Single
+  else `Unrestricted (* TODO implement levels 3-5 *)

src/common/dune

@@ -1,7 +1,7 @@
 (library
  (name common)
  (public_name stanc.common)
- (libraries core fmt uunf)
+ (libraries core fmt uunf uucp)
  (instrumentation
   (backend bisect_ppx))
  (inline_tests)

src/frontend/Identifiers.ml

@@ -38,7 +38,7 @@ let validate_utf8_id ~loc id =
       error ~loc
         (Fmt.str "Invalid character in identifier at offset %d: '%a'" pos
            pp_uchar uchar) in
-  iter_uchars id f;
+  iteri_uchars ~f id;
   id
 
 let validate loc id =

src/stan_math_backend/Cpp.ml

@@ -395,8 +395,11 @@ module Printing = struct
     else
       (* so called "Universal character names" - not required on newer compilers
          but hopefully more backward-compatible *)
-      let f _ c = Fmt.pf ppf "\\u%04X" (Uchar.to_scalar c) in
-      Common.Unicode.iter_uchars s f
+      let f _ c =
+        let uchar_int = Uchar.to_scalar c in
+        if uchar_int < 128 then Fmt.char ppf (Char.of_int_exn uchar_int)
+        else Fmt.pf ppf "\\u%04X" (Uchar.to_scalar c) in
+      Common.Unicode.iteri_uchars ~f s
 
   let rec pp_type_ ppf t =
     match t with

test/integration/bad/unicode/invalid-character.stan

@@ -0,0 +1,4 @@
+data {
+  // not in XID data
+  real ℧;
+}

test/integration/bad/unicode/stanc.expected

@@ -1,3 +1,15 @@
+  $ ../../../../../install/default/bin/stanc --allow-unicode invalid-character.stan
+Syntax error in 'invalid-character.stan', line 3, column 6, lexing error:
+   -------------------------------------------------
+     1:  data {
+     2:    // not in XID data
+     3:    real ℧;
+                ^
+     4:  }
+   -------------------------------------------------
+
+Invalid character: 'U+2127'
+[exit 1]
   $ ../../../../../install/default/bin/stanc --allow-unicode invalid-utf8-1.stan
 Syntax error in 'invalid-utf8-1.stan', line 2, column 5, lexing error:
    -------------------------------------------------

test/integration/good/unicode/mixed-scripts.stan

@@ -0,0 +1,8 @@
+
+data {
+  // https://www.unicode.org/reports/tr39/#Confusable_Detection
+  // greek
+  real Γ;
+  // cyrillic
+  real Г;
+}