Merge pull request #66 from jolt-lang/unicode-regex
regex: \p{...} property classes; interop: the String method surface (cuerdas green)
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
123c58560a
6 changed files with 173 additions and 19 deletions
|
|
@ -432,6 +432,46 @@
|
|||
{"currentTimeMillis" (fn [] (math/floor (* 1000 (os/clock :realtime))))
|
||||
"nanoTime" (fn [] (math/floor (* 1e9 (os/clock :monotonic))))})
|
||||
|
||||
# Long statics: sentinels portable code compares against. jolt numbers are
|
||||
# doubles, so these are the f64 approximations.
|
||||
(def- long-statics
|
||||
{"MAX_VALUE" 9223372036854775807
|
||||
"MIN_VALUE" -9223372036854775808})
|
||||
|
||||
# java.lang.String method surface for clj-compat interop: (.toLowerCase s),
|
||||
# (.indexOf s x), ... — the methods portable cljc libraries actually call.
|
||||
# Case mapping is ASCII (the whole engine is byte-based); indexOf returns -1
|
||||
# on miss, as on the JVM.
|
||||
(defn- str-needle [x]
|
||||
(if (and (struct? x) (= :jolt/char (get x :jolt/type)))
|
||||
(string/from-bytes (x :ch))
|
||||
(string x)))
|
||||
(def- string-methods
|
||||
{"toString" (fn [s] s)
|
||||
"toLowerCase" (fn [s] (string/ascii-lower s))
|
||||
"toUpperCase" (fn [s] (string/ascii-upper s))
|
||||
"trim" (fn [s] (string/trim s))
|
||||
"length" (fn [s] (length s))
|
||||
"isEmpty" (fn [s] (= 0 (length s)))
|
||||
"charAt" (fn [s i] {:jolt/type :jolt/char :ch (s i)})
|
||||
"codePointAt" (fn [s i] (s i))
|
||||
"indexOf" (fn [s x &opt from] (or (string/find (str-needle x) s (or from 0)) -1))
|
||||
"lastIndexOf" (fn [s x]
|
||||
(let [n (str-needle x)]
|
||||
(var found -1) (var i 0)
|
||||
(while (< i (length s))
|
||||
(let [f (string/find n s i)]
|
||||
(if f (do (set found f) (set i (+ f 1))) (set i (length s)))))
|
||||
found))
|
||||
"substring" (fn [s start &opt end] (string/slice s start end))
|
||||
"startsWith" (fn [s p] (string/has-prefix? p s))
|
||||
"endsWith" (fn [s p] (string/has-suffix? p s))
|
||||
"contains" (fn [s sub] (not (nil? (string/find (str-needle sub) s))))
|
||||
"concat" (fn [s o] (string s o))
|
||||
"replace" (fn [s a b] (string/replace-all (str-needle a) (str-needle b) s))
|
||||
"compareTo" (fn [s o] (cond (< s o) -1 (> s o) 1 0))
|
||||
"equalsIgnoreCase" (fn [s o] (= (string/ascii-lower s) (string/ascii-lower (string o))))})
|
||||
|
||||
(defn- resolve-sym
|
||||
[ctx bindings sym-s]
|
||||
(let [name (sym-s :name) ns (sym-s :ns)]
|
||||
|
|
@ -444,6 +484,9 @@
|
|||
(if (= ns "System")
|
||||
(let [v (get system-statics name)]
|
||||
(if (nil? v) (error (string "Unsupported System member: System/" name)) v))
|
||||
(if (= ns "Long")
|
||||
(let [v (get long-statics name)]
|
||||
(if (nil? v) (error (string "Unsupported Long member: Long/" name)) v))
|
||||
(if (not (nil? ns))
|
||||
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))
|
||||
aliased-ns (or (ns-alias-lookup current-ns ns) (ns-import-lookup current-ns ns))
|
||||
|
|
@ -493,7 +536,7 @@
|
|||
# No implicit Janet fallback (Stage 3): an unresolved
|
||||
# Clojure symbol is an error. Host access is the explicit
|
||||
# janet/ prefix above.
|
||||
(error (string "Unable to resolve symbol: " name))))))))))))))))
|
||||
(error (string "Unable to resolve symbol: " name)))))))))))))))))
|
||||
(defn- parse-arg-names
|
||||
"Parse a parameter vector, handling & rest args.
|
||||
Returns {:fixed [names...] :rest name-or-nil :all [names...]}"
|
||||
|
|
@ -1192,6 +1235,11 @@
|
|||
"java.lang.String" (string? val)
|
||||
"Boolean" (or (= true val) (= false val))
|
||||
"Keyword" (keyword? val)
|
||||
# regex patterns (cuerdas-style (instance? Pattern x) checks)
|
||||
"Pattern" (and (table? val) (= :jolt/regex (val :jolt/type)))
|
||||
"java.util.regex.Pattern" (and (table? val) (= :jolt/regex (val :jolt/type)))
|
||||
"Character" (and (struct? val) (= :jolt/char (get val :jolt/type)))
|
||||
"java.lang.Character" (and (struct? val) (= :jolt/char (get val :jolt/type)))
|
||||
"clojure.lang.Atom" (and (table? val) (= :jolt/atom (val :jolt/type)))
|
||||
"clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type)))
|
||||
"clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type)))
|
||||
|
|
@ -1762,6 +1810,11 @@
|
|||
(if (> (length form) 3)
|
||||
# method call: (. obj method args...)
|
||||
(let [args (map |(eval-form ctx bindings $) (tuple/slice form 3))]
|
||||
(if (or (string? target) (buffer? target))
|
||||
(let [m (get string-methods field-name)]
|
||||
(if m
|
||||
(m (string target) ;args)
|
||||
(error (string "Unsupported String method ." field-name))))
|
||||
(if (target :jolt/deftype)
|
||||
(let [method-key (keyword field-name)]
|
||||
(apply (get target method-key) target ;args))
|
||||
|
|
@ -1777,10 +1830,16 @@
|
|||
(method-fn target ;args)
|
||||
(error (string "Cannot call non-function " field-name " on " (type target)))))
|
||||
(error (string "Cannot call non-function " field-name " on " (type target))))))
|
||||
(error (string "Cannot call method " field-name " on " (type target))))))
|
||||
(error (string "Cannot call method " field-name " on " (type target)))))))
|
||||
# (. obj member) with no extra args: a symbol member naming a
|
||||
# function is a zero-arg method call (receiver passed as self);
|
||||
# a keyword or `-field` member is plain field access.
|
||||
# a keyword or `-field` member is plain field access. Strings get
|
||||
# the java.lang.String surface (clj-compat: (.toLowerCase s) ...).
|
||||
(if (or (string? target) (buffer? target))
|
||||
(let [m (get string-methods field-name)]
|
||||
(if m
|
||||
(m (string target))
|
||||
(error (string "Unsupported String method ." field-name))))
|
||||
(let [v (get target (keyword field-name))]
|
||||
(if (and (struct? member-raw) (= :symbol (member-raw :jolt/type))
|
||||
(not (string/has-prefix? "-" member-name)))
|
||||
|
|
@ -1790,7 +1849,7 @@
|
|||
(array? v) (let [f (eval-form ctx bindings v)]
|
||||
(if (or (function? f) (cfunction? f)) (f target) f))
|
||||
v)
|
||||
v))))
|
||||
v)))))
|
||||
# default: function application — check for macros
|
||||
(if (and (struct? first-form) (= :symbol (first-form :jolt/type)))
|
||||
(let [sym-name (first-form :name)]
|
||||
|
|
@ -1800,6 +1859,18 @@
|
|||
(let [field-name (string/slice sym-name 2)
|
||||
target (eval-form ctx bindings (in form 1))]
|
||||
(get target (keyword field-name)))
|
||||
# (.method obj args...) sugar -> (. obj method args...): desugar and
|
||||
# re-enter the dot special form (which holds the String surface, the
|
||||
# deftype method path, and the map-fn fallback).
|
||||
(if (and (> (length sym-name) 1)
|
||||
(= (string/slice sym-name 0 1) ".")
|
||||
(not= sym-name "..")
|
||||
(> (length form) 1))
|
||||
(eval-form ctx bindings
|
||||
(array/concat @[{:jolt/type :symbol :ns nil :name "."}
|
||||
(in form 1)
|
||||
{:jolt/type :symbol :ns nil :name (string/slice sym-name 1)}]
|
||||
(tuple/slice form 2)))
|
||||
# Handle ClassName. constructor syntax (".." is the member-threading
|
||||
# macro, not a constructor named ".")
|
||||
(if (and (> (length sym-name) 1) (not= sym-name "..")
|
||||
|
|
@ -1821,7 +1892,7 @@
|
|||
(eval-form ctx bindings expanded))))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(jolt-invoke ctx f args)))))))
|
||||
(jolt-invoke ctx f args))))))))
|
||||
(let [f (eval-form ctx bindings first-form)
|
||||
args (map |(eval-form ctx bindings $) (tuple/slice form 1))]
|
||||
(jolt-invoke ctx f args)))))
|
||||
|
|
|
|||
|
|
@ -40,6 +40,40 @@
|
|||
(chr "S") '(if-not (set " \t\n\r\f\v") 1)
|
||||
nil))
|
||||
|
||||
# Unicode property classes \p{...} (jolt-xlp), mapped onto the byte PEGs:
|
||||
# ASCII exactly; any high byte (>= 0x80, i.e. inside a UTF-8 sequence) counts
|
||||
# as a LETTER byte — so ^\p{L}+$ accepts UTF-8 words, while \p{N}/\p{Z}
|
||||
# stay ASCII-only. Lu/Ll are ASCII (case is byte-based throughout this
|
||||
# engine). Unknown property names error at compile.
|
||||
(defn- prop-frag [name]
|
||||
(case name
|
||||
"L" '(choice (range "az" "AZ") (range "\x80\xFF"))
|
||||
"Lu" '(range "AZ")
|
||||
"Ll" '(range "az")
|
||||
"N" '(range "09")
|
||||
"Nd" '(range "09")
|
||||
"Z" '(set " ")
|
||||
"Zs" '(set " ")
|
||||
"P" '(set "!\"#%&'()*,-./:;?@[\\]_{}")
|
||||
"Ps" '(set "([{")
|
||||
"Pe" '(set ")]}")
|
||||
"Alpha" '(choice (range "az" "AZ") (range "\x80\xFF"))
|
||||
"Digit" '(range "09")
|
||||
nil))
|
||||
|
||||
# At s[i] = backslash: if this is \p{Name} / \P{Name}, return [peg-frag end-i]
|
||||
# (end-i past the closing brace), else nil.
|
||||
(defn- parse-prop [s i]
|
||||
(def pc (get s (+ i 1)))
|
||||
(when (and (or (= pc (chr "p")) (= pc (chr "P")))
|
||||
(= (get s (+ i 2)) (chr "{")))
|
||||
(def close (string/find "}" s (+ i 3)))
|
||||
(unless close (error "regex: unterminated \\p{...}"))
|
||||
(def nm (string/slice s (+ i 3) close))
|
||||
(def frag (prop-frag nm))
|
||||
(unless frag (error (string "regex: unsupported property class \\p{" nm "}")))
|
||||
[(if (= pc (chr "P")) ~(if-not ,frag 1) frag) (+ close 1)]))
|
||||
|
||||
(defn- esc-byte [c]
|
||||
(case c
|
||||
(chr "n") 10 (chr "t") 9 (chr "r") 13 (chr "f") 12 (chr "v") 11 (chr "0") 0
|
||||
|
|
@ -66,12 +100,14 @@
|
|||
"lower" '(range "az")
|
||||
'(set "")))
|
||||
(set i (+ close 2)))
|
||||
# escape inside class
|
||||
# escape inside class — \p{...} first (multi-char), then 2-char escapes
|
||||
(= (s i) (chr "\\"))
|
||||
(let [c (s (+ i 1)) p (pred-frag c)]
|
||||
(if p (array/push alts p)
|
||||
(array/push alts ~(set ,(string/from-bytes (esc-byte c)))))
|
||||
(set i (+ i 2)))
|
||||
(if-let [pr (parse-prop s i)]
|
||||
(do (array/push alts (pr 0)) (set i (pr 1)))
|
||||
(let [c (s (+ i 1)) p (pred-frag c)]
|
||||
(if p (array/push alts p)
|
||||
(array/push alts ~(set ,(string/from-bytes (esc-byte c)))))
|
||||
(set i (+ i 2))))
|
||||
# range a-z
|
||||
(and (< (+ i 2) (length s)) (= (s (+ i 1)) (chr "-")) (not= (s (+ i 2)) (chr "]")))
|
||||
(do
|
||||
|
|
@ -139,13 +175,15 @@
|
|||
(= c (chr "."))
|
||||
(do (++ (st :pos)) {:op :any :dotall (st :dotall)})
|
||||
(= c (chr "\\"))
|
||||
(let [nc (s (+ (st :pos) 1)) p (pred-frag nc)]
|
||||
(+= (st :pos) 2)
|
||||
(cond
|
||||
p {:op :pred :peg p}
|
||||
(= nc (chr "b")) {:op :anchor :kind :wordb}
|
||||
(= nc (chr "B")) {:op :anchor :kind :nwordb}
|
||||
{:op :char :b (esc-byte nc) :ci ci}))
|
||||
(if-let [pr (parse-prop s (st :pos))]
|
||||
(do (set (st :pos) (pr 1)) {:op :pred :peg (pr 0)})
|
||||
(let [nc (s (+ (st :pos) 1)) p (pred-frag nc)]
|
||||
(+= (st :pos) 2)
|
||||
(cond
|
||||
p {:op :pred :peg p}
|
||||
(= nc (chr "b")) {:op :anchor :kind :wordb}
|
||||
(= nc (chr "B")) {:op :anchor :kind :nwordb}
|
||||
{:op :char :b (esc-byte nc) :ci ci})))
|
||||
(= c (chr "^")) (do (++ (st :pos)) {:op :anchor :kind :start})
|
||||
(= c (chr "$")) (do (++ (st :pos)) {:op :anchor :kind :end})
|
||||
(do (++ (st :pos)) {:op :char :b c :ci ci})))
|
||||
|
|
|
|||
|
|
@ -7,6 +7,11 @@
|
|||
(use ../../src/jolt/api)
|
||||
(use ../../src/jolt/types)
|
||||
(import ../../src/jolt/deps :as deps)
|
||||
(use ../../src/jolt/reader)
|
||||
# deps are clj/cljc libraries by definition (the jolt-dw4 premise): read them
|
||||
# under clj-compat features so their #?(:clj ...) branches resolve (spec
|
||||
# 02-reader S18 — features are a property of the loading context).
|
||||
(reader-features-set! ["jolt" "clj" "default"])
|
||||
|
||||
(unless (os/getenv "JOLT_CONFORMANCE")
|
||||
(print "deps-conformance: set JOLT_CONFORMANCE=1 to run (needs network) — skipped")
|
||||
|
|
|
|||
|
|
@ -38,3 +38,26 @@
|
|||
["aset returns val" "9" "(aset (object-array [1 2 3]) 1 9)"]
|
||||
["aset mutates" "[7 2 3]" "(let [a (object-array [1 2 3])] (aset a 0 7) (vec a))"]
|
||||
["aget 2d" "4" "(aget (to-array-2d [[1 2] [3 4]]) 1 1)"])
|
||||
|
||||
# java.lang.String surface + .method sugar (clj-compat: what portable cljc
|
||||
# libraries call — landed for the cuerdas acceptance run). ASCII case mapping.
|
||||
(defspec "interop / String methods"
|
||||
[".toLowerCase" "\"hi\"" "(.toLowerCase \"HI\")"]
|
||||
[".toUpperCase" "\"HI\"" "(.toUpperCase \"hi\")"]
|
||||
["dot-form" "\"hi\"" "(. \"HI\" toLowerCase)"]
|
||||
[".trim" "\"x\"" "(.trim \" x \")"]
|
||||
[".length" "3" "(.length \"abc\")"]
|
||||
[".isEmpty" "[true false]" "[(.isEmpty \"\") (.isEmpty \"a\")]"]
|
||||
[".indexOf hit" "1" "(.indexOf \"abc\" \"b\")"]
|
||||
[".indexOf miss is -1" "-1" "(.indexOf \"abc\" \"z\")"]
|
||||
[".lastIndexOf" "3" "(.lastIndexOf \"abab\" \"b\")"]
|
||||
[".substring" "\"bc\"" "(.substring \"abc\" 1)"]
|
||||
[".substring end" "\"b\"" "(.substring \"abc\" 1 2)"]
|
||||
[".startsWith" "true" "(.startsWith \"abc\" \"ab\")"]
|
||||
[".endsWith" "true" "(.endsWith \"abc\" \"bc\")"]
|
||||
[".contains" "true" "(.contains \"abc\" \"b\")"]
|
||||
[".replace" "\"axc\"" "(.replace \"abc\" \"b\" \"x\")"]
|
||||
[".charAt" "\\b" "(.charAt \"abc\" 1)"]
|
||||
[".equalsIgnoreCase" "true" "(.equalsIgnoreCase \"AbC\" \"aBc\")"]
|
||||
["Long/MAX_VALUE" "true" "(pos? Long/MAX_VALUE)"]
|
||||
["unsupported method throws" :throws "(.frobnicate \"abc\")"])
|
||||
|
|
|
|||
|
|
@ -31,3 +31,19 @@
|
|||
["split on regex" "[\"a\" \"b\" \"c\"]" "(do (require '[clojure.string :as s]) (s/split \"a1b2c\" #\"\\d\"))"]
|
||||
["replace regex" "\"X-X\"" "(do (require '[clojure.string :as s]) (s/replace \"a-b\" #\"[a-z]\" \"X\"))"]
|
||||
["replace $1" "\"[a][b]\"" "(do (require '[clojure.string :as s]) (s/replace \"ab\" #\"([a-z])\" \"[$1]\"))"])
|
||||
|
||||
# Unicode property classes (jolt-xlp), byte-PEG approximation: ASCII exact,
|
||||
# any high byte (inside a UTF-8 sequence) counts as a LETTER for \p{L}.
|
||||
# Acceptance target was cuerdas (kebab/snake/capital now pass conformance).
|
||||
(defspec "regex / \\p property classes"
|
||||
["p{L} ascii" "\"hello\"" `(re-matches #"^\p{L}+$" "hello")`]
|
||||
["p{L} utf-8" "true" `(boolean (re-matches #"^\p{L}+$" "héllo"))`]
|
||||
["p{L} rejects digits" "false" `(boolean (re-matches #"^\p{L}+$" "ab1"))`]
|
||||
["p{N}" "(quote (\"12\" \"345\"))" `(re-seq #"\p{N}+" "a12b345")`]
|
||||
["P{N} negation" "\"abc\"" `(re-matches #"^\P{N}+$" "abc")`]
|
||||
["inside class" "\"a-1_b\"" `(re-matches #"^[\p{N}\p{L}_-]+$" "a-1_b")`]
|
||||
["p{Lu}/p{Ll}" "\"aB\"" `(re-matches #"^\p{Ll}\p{Lu}$" "aB")`]
|
||||
["p{Z} space" "\" \"" `(re-matches #"(?u)^[\s\p{Z}]+$" " ")`]
|
||||
["p{Ps}/p{Pe}" "\"(x)\"" `(re-matches #"^\p{Ps}x\p{Pe}$" "(x)")`]
|
||||
["(?u) accepted" "\"hi\"" `(re-matches #"(?u)^hi$" "hi")`]
|
||||
["unknown class throws" :throws `(re-pattern "\p{Greek}")`])
|
||||
|
|
|
|||
|
|
@ -129,8 +129,9 @@
|
|||
["delay? true" "true" "(delay? (delay 1))"]
|
||||
["delay? false" "false" "(delay? 1)"]
|
||||
["future-call" "42" "(deref (future-call (fn [] 42)))"]
|
||||
[". member resolves nil" "nil" "(. \"abc\" count)"]
|
||||
[".. threads members" "nil" "(.. \"abc\" count)"])
|
||||
[". calls String surface" "3" "(. \"abc\" length)"]
|
||||
[".. threads members" "\"ABC\"" "(.. \"abc\" toUpperCase)"]
|
||||
["unknown String member throws" :throws "(. \"abc\" frobnicate)"])
|
||||
|
||||
(defspec "untested / protocols: extend + extends?"
|
||||
["extend registers" ":str"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue