initial commit
This commit is contained in:
commit
2759b0a004
|
@ -0,0 +1,2 @@
|
||||||
|
/_build
|
||||||
|
/result
|
|
@ -0,0 +1,26 @@
|
||||||
|
(lang dune 3.15)
|
||||||
|
|
||||||
|
(name ppx_unicode)
|
||||||
|
|
||||||
|
(generate_opam_files true)
|
||||||
|
|
||||||
|
(source
|
||||||
|
(github username/reponame))
|
||||||
|
|
||||||
|
(authors "Author Name")
|
||||||
|
|
||||||
|
(maintainers "Maintainer Name")
|
||||||
|
|
||||||
|
(license LICENSE)
|
||||||
|
|
||||||
|
(documentation https://url/to/documentation)
|
||||||
|
|
||||||
|
(package
|
||||||
|
(name ppx_unicode)
|
||||||
|
(synopsis "A short synopsis")
|
||||||
|
(description "A longer description")
|
||||||
|
(depends ocaml dune)
|
||||||
|
(tags
|
||||||
|
(topics "to describe" your project)))
|
||||||
|
|
||||||
|
; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project
|
|
@ -0,0 +1,8 @@
|
||||||
|
(library
|
||||||
|
(name ppx_unicode)
|
||||||
|
(public_name ppx_unicode)
|
||||||
|
(synopsis "ppx rewriters for unicode normalization")
|
||||||
|
(preprocess
|
||||||
|
(pps ppxlib.metaquot))
|
||||||
|
(libraries ppxlib uunf)
|
||||||
|
(kind ppx_deriver))
|
|
@ -0,0 +1,61 @@
|
||||||
|
open Ppxlib
|
||||||
|
|
||||||
|
let has_attr name attrs =
|
||||||
|
List.find_opt (fun attr -> attr.attr_name.txt = name) attrs
|
||||||
|
|> Option.is_some
|
||||||
|
|
||||||
|
let decode_single_uchar_opt str =
|
||||||
|
if String.is_valid_utf_8 str then
|
||||||
|
let res = String.get_utf_8_uchar str 0 in
|
||||||
|
if (Uchar.utf_decode_is_valid res) && (Uchar.utf_decode_length res == String.length str) then
|
||||||
|
Some (Uchar.utf_decode_uchar res |> Uchar.to_int)
|
||||||
|
else
|
||||||
|
None
|
||||||
|
else
|
||||||
|
None
|
||||||
|
|
||||||
|
let nfc_mapper = object
|
||||||
|
inherit Ast_traverse.map as super
|
||||||
|
|
||||||
|
method! expression =
|
||||||
|
fun { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } ->
|
||||||
|
if has_attr "uchar" pexp_attributes then
|
||||||
|
let pexp_attributes =
|
||||||
|
List.filter (fun attr -> attr.attr_name.txt <> "uchar") pexp_attributes in
|
||||||
|
match pexp_desc with
|
||||||
|
| Pexp_constant (Pconst_string (value, loc, _)) ->
|
||||||
|
begin match decode_single_uchar_opt value with
|
||||||
|
| Some cp ->
|
||||||
|
let cp = Pconst_integer (Int.to_string cp, None) in
|
||||||
|
let cp = {
|
||||||
|
pexp_desc = Pexp_constant cp;
|
||||||
|
pexp_loc; pexp_loc_stack; pexp_attributes
|
||||||
|
} in
|
||||||
|
[%expr Uchar.of_int [%e cp]]
|
||||||
|
| None ->
|
||||||
|
let err_ext =
|
||||||
|
Pexp_extension begin Location.error_extensionf ~loc:loc
|
||||||
|
"[@uchar] string must consist of a single valid utf-8 codepoint" end
|
||||||
|
in { pexp_desc = err_ext; pexp_loc; pexp_loc_stack; pexp_attributes }
|
||||||
|
end
|
||||||
|
| _ ->
|
||||||
|
let err_ext =
|
||||||
|
Pexp_extension begin Location.error_extensionf ~loc:pexp_loc
|
||||||
|
"[@uchar] attribute must be on a string constant" end
|
||||||
|
in { pexp_desc = err_ext; pexp_loc; pexp_loc_stack; pexp_attributes }
|
||||||
|
else
|
||||||
|
super#expression { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes }
|
||||||
|
|
||||||
|
method! constant = function
|
||||||
|
| Pconst_string (value, loc, delim) ->
|
||||||
|
if String.is_valid_utf_8 value then
|
||||||
|
Pconst_string ((Uunf_string.normalize_utf_8 `NFC value), loc, delim)
|
||||||
|
else
|
||||||
|
Location.raise_errorf ~loc "invalid utf-8 in string literal"
|
||||||
|
| const -> super#constant const
|
||||||
|
end
|
||||||
|
|
||||||
|
let () =
|
||||||
|
Driver.register_transformation
|
||||||
|
~impl:nfc_mapper#structure
|
||||||
|
"ppx_unicode"
|
|
@ -0,0 +1,31 @@
|
||||||
|
# This file is generated by dune, edit dune-project instead
|
||||||
|
opam-version: "2.0"
|
||||||
|
synopsis: "A short synopsis"
|
||||||
|
description: "A longer description"
|
||||||
|
maintainer: ["Maintainer Name"]
|
||||||
|
authors: ["Author Name"]
|
||||||
|
license: "LICENSE"
|
||||||
|
tags: ["topics" "to describe" "your" "project"]
|
||||||
|
homepage: "https://github.com/username/reponame"
|
||||||
|
doc: "https://url/to/documentation"
|
||||||
|
bug-reports: "https://github.com/username/reponame/issues"
|
||||||
|
depends: [
|
||||||
|
"ocaml"
|
||||||
|
"dune" {>= "3.15"}
|
||||||
|
"odoc" {with-doc}
|
||||||
|
]
|
||||||
|
build: [
|
||||||
|
["dune" "subst"] {dev}
|
||||||
|
[
|
||||||
|
"dune"
|
||||||
|
"build"
|
||||||
|
"-p"
|
||||||
|
name
|
||||||
|
"-j"
|
||||||
|
jobs
|
||||||
|
"@install"
|
||||||
|
"@runtest" {with-test}
|
||||||
|
"@doc" {with-doc}
|
||||||
|
]
|
||||||
|
]
|
||||||
|
dev-repo: "git+https://github.com/username/reponame.git"
|
|
@ -0,0 +1,3 @@
|
||||||
|
(test
|
||||||
|
(name test_ppx_unicode)
|
||||||
|
(preprocess (pps ppx_unicode)))
|
|
@ -0,0 +1,3 @@
|
||||||
|
let () =
|
||||||
|
let a = "å"[@uchar] in
|
||||||
|
ignore a
|
Loading…
Reference in New Issue