Add some notes on potential further validation

Likely needs more library support: dbuenzli/uucp#25

Author: WardBrian

src/common/Unicode.ml

@@ -33,3 +33,69 @@ let iter_uchars s f =
       ICE.internal_compiler_error
         [%message
           "Failed to round-trip unicode string!" (s : 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 out = Buffer.create (String.length x) in
+    let f _ c =
+      if Uucp.Gen.is_default_ignorable c then ()
+      else
+        (* TODO!! replace with prototype - need data? *)
+        Buffer.add_utf_8_uchar out c in
+    iter_uchars x f;
+    let x = Buffer.contents out 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 soss = ref [] in
+  let f _ c =
+    let scripts =
+      Uucp.Script.script_extensions c |> ScriptSet.of_list |> extended in
+    soss := scripts :: !soss;
+    () in
+  iter_uchars x f;
+  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)

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 Г;
+}

test/integration/good/unicode/pretty.expected

@@ -14,6 +14,16 @@ model {
   y ~ normal(θ, σ);
 }
 
+[exit 0]
+  $ ../../../../../install/default/bin/stanc --auto-format --allow-unicode mixed-scripts.stan
+data {
+  // https://www.unicode.org/reports/tr39/#Confusable_Detection
+  // greek
+  real Γ;
+  // cyrillic
+  real Г;
+}
+
 [exit 0]
   $ ../../../../../install/default/bin/stanc --auto-format --allow-unicode unicode_special_funs.stan
 functions {