diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 096501e..bec9081 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -591,7 +591,11 @@ "StringReader" "java.io.StringReader" "StringWriter" "java.io.StringWriter" "StringBuilder" "java.lang.StringBuilder" "StringTokenizer" "java.util.StringTokenizer" - "Charset" "java.nio.charset.Charset" "Base64" "java.util.Base64"}) + "Charset" "java.nio.charset.Charset" "Base64" "java.util.Base64" + "Exception" "java.lang.Exception" + "IllegalArgumentException" "java.lang.IllegalArgumentException" + "InterruptedException" "java.lang.InterruptedException" + "Throwable" "java.lang.Throwable"}) (defn- class-value-for "The value a class-name symbol evaluates to: its canonical name string." [nm] @@ -678,7 +682,10 @@ "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)) + "replace" (fn [s a b] (string/replace-all (str-needle a) (str-needle b) s)) + "replaceAll" (fn [s regex replacement] (re-replace-all (re-pattern regex) s replacement)) + "replaceFirst" (fn [s regex replacement] (re-replace-first (re-pattern regex) s replacement)) + "matches" (fn [s regex] (not (nil? (re-matches (re-pattern regex) 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))))}) @@ -765,7 +772,9 @@ # 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 " in this context")))))))))))))))))) + (if (or (in class-ctors name) (get class-canonical-names name)) + (class-value-for name) + (error (string "Unable to resolve symbol: " name " in this context"))))))))))))))))))) (defn- parse-arg-names "Parse a parameter vector, handling & rest args. Returns {:fixed [names...] :rest name-or-nil :all [names...]}" diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 20f652f..175b3e1 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -6,6 +6,7 @@ # install call — adding another java.* shim follows the same shape. (use ./evaluator) +(use ./regex) (import ./phm) (defn- chr [s] (get s 0)) @@ -442,7 +443,45 @@ (or (scan-number (string/trim (string v))) (error (string "NumberFormatException: For input string: \"" v "\"")))))) (each nm ["Locale" "java.util.Locale"] - (register-class-ctor! nm (fn [id &opt _country] @{:jolt/type :jolt/locale :id (string id)})))) + (register-class-ctor! nm (fn [id &opt _country] @{:jolt/type :jolt/locale :id (string id)}))) + # java.util.regex.Pattern statics: Pattern/compile, Pattern/quote, Pattern/MULTILINE. + # Pattern/compile returns jolt's native :jolt/regex compiled value so that + # str/replace, re-matches, .split etc accept it transparently. + (defn- pattern-quote [s] + (def meta "\\.[]{}()*+-?^$|&") + (def buf @"") + (var i 0) + (while (< i (length s)) + (def c (s i)) + (if (string/find (string/from-bytes c) meta) + (buffer/push buf (chr "\\"))) + (buffer/push buf (string/from-bytes c)) + (++ i)) + (string buf)) + (def pattern-multiline 8) + (each nm ["Pattern" "java.util.regex.Pattern"] + (register-class-statics! nm + @{"compile" (fn [s &opt flags] + (if (and flags (= (band flags pattern-multiline) pattern-multiline)) + (re-pattern (string "(?m)" s)) + (re-pattern s))) + "quote" (fn [s] (pattern-quote s)) + "MULTILINE" pattern-multiline})) + # .split on compiled regex values: delegates to re-split, drops trailing empties + (register-tagged-methods! :jolt/regex + @{"split" (fn [self s &opt limit] + (def parts (re-split self s)) + (while (and (> (length parts) 0) (= "" (last parts))) + (array/pop parts)) + parts)}) + # JVM exception constructors: (Exception. msg), (IllegalArgumentException. msg), + # (InterruptedException. msg). Return the message string so getMessage works. + (each nm ["Exception" "java.lang.Exception"] + (register-class-ctor! nm (fn [msg] (string msg)))) + (each nm ["IllegalArgumentException" "java.lang.IllegalArgumentException"] + (register-class-ctor! nm (fn [msg] (string msg)))) + (each nm ["InterruptedException" "java.lang.InterruptedException"] + (register-class-ctor! nm (fn [msg] (string msg))))) (install!) (install-io!) diff --git a/src/jolt/regex.janet b/src/jolt/regex.janet index 7180c14..f7e4862 100644 --- a/src/jolt/regex.janet +++ b/src/jolt/regex.janet @@ -144,23 +144,29 @@ (let [inner (parse-alt st)] (+= (st :pos) 1) {:op :look :neg false :item inner})) (= k (chr "!")) (do (+= (st :pos) 3) (let [inner (parse-alt st)] (+= (st :pos) 1) {:op :look :neg true :item inner})) - # inline flags (?i) / (?i:...) — set case-insensitive + # inline flags (?i) / (?m) / (?im:...) etc. (do (var j (+ (st :pos) 2)) (var seti false) + (var setm false) (while (and (< j (length s)) (not= (s j) (chr ")")) (not= (s j) (chr ":"))) (when (= (s j) (chr "i")) (set seti true)) + (when (= (s j) (chr "m")) (set setm true)) (++ j)) (if (= (s j) (chr ":")) (do (set (st :pos) (+ j 1)) - (def saved (st :ci)) + (def savedci (st :ci)) + (def savedml (st :ml)) (when seti (set (st :ci) true)) + (when setm (set (st :ml) true)) (def inner (parse-alt st)) - (set (st :ci) saved) + (set (st :ci) savedci) + (set (st :ml) savedml) (+= (st :pos) 1) {:op :ncgroup :item inner}) - (do (set (st :pos) (+ j 1)) # (?i) — flag for rest of pattern + (do (set (st :pos) (+ j 1)) # (?i) / (?m) — flag for rest of pattern (when seti (set (st :ci) true)) + (when setm (set (st :ml) true)) {:op :seq :items @[]}))))) # capturing group (let [n (++ (st :ngroup))] @@ -235,9 +241,9 @@ (if (= 1 (length branches)) (branches 0) {:op :alt :items branches}))) (defn- parse [source] - (def st @{:s source :pos 0 :ngroup 0 :ci false :dotall false}) + (def st @{:s source :pos 0 :ngroup 0 :ci false :ml false :dotall false}) (def ast (parse-alt st)) - [ast (st :ngroup)]) + [ast (st :ngroup) (st :ml)]) # ============================================================ # Emit: AST -> PEG grammar (continuation passing) @@ -250,7 +256,7 @@ ~(set ,(string/from-bytes (lower-b b) (upper-b b))) ~(set ,(string/from-bytes b)))) -(defn- make-emitter [grammar] +(defn- make-emitter [grammar ml] (var ctr 0) (defn fresh [] (++ ctr) (keyword (string "r" ctr))) (var emit nil) @@ -304,8 +310,12 @@ ~(sequence (not ,(emit (ast :item) 0)) ,k) ~(sequence (not (not ,(emit (ast :item) 0))) ,k)) :anchor (case (ast :kind) - :start ~(sequence (not (look -1 1)) ,k) - :end ~(sequence (not 1) ,k) + :start (if ml + ~(sequence (choice (not (look -1 1)) (look -1 "\n")) ,k) + ~(sequence (not (look -1 1)) ,k)) + :end (if ml + ~(sequence (choice (not 1) (not (not "\n"))) ,k) + ~(sequence (not 1) ,k)) :wordb ~(sequence (choice (sequence (look -1 ,word-frag) (not ,word-frag)) (sequence (not (look -1 ,word-frag)) (not (not ,word-frag)))) ,k) @@ -317,9 +327,9 @@ emit) (defn compile-regex [source] - (def [ast ngroups] (parse source)) + (def [ast ngroups ml] (parse source)) (def grammar @{}) - (def emit (make-emitter grammar)) + (def emit (make-emitter grammar ml)) # group 0 = whole match: mark start, body, mark end (def body (emit ast ~(sequence (/ (position) ,(fn [p] [0 :e p])) 0))) (put grammar :main ~(sequence (/ (position) ,(fn [p] [0 :s p])) ,body))