feat: add (std text aho-corasick) and regex-required-literal
ober
213473f5396e7c8a9d4df9b72c125d7a50c463fa
--- a/lib/std/regex.ss +++ b/lib/std/regex.ss @@ -44,7 +44,9 @@ re-match-full re-match-group re-match-groups re-match-start re-match-end re-match-named ;; Internal accessor used by (std rx) for pattern splicing - re-object-pat-string) + re-object-pat-string + ;; Required-literal extraction (for multi-pattern pre-filtering) + regex-required-literal) (import (chezscheme) (std pregexp) @@ -394,4 +396,238 @@ (let ([entry (assq name (re-match-object-named-groups m))]) (and entry (re-match-group m (cdr entry))))) + ;; ========== Required-literal extraction ========== + ;; + ;; Returns the longest substring guaranteed to appear in every match of + ;; PATTERN, or #f if no such guarantee can be derived. Useful for + ;; pre-filtering: when scanning many haystacks for many regex patterns, + ;; first run a fast multi-pattern literal search (e.g. via + ;; (std text aho-corasick)) and only invoke the regex engine on + ;; haystacks where the literal hit. + ;; + ;; PATTERN is a pattern string (or a compiled re-object — the source + ;; string is recovered via re-object-pat-string). The empty string + ;; result is collapsed to #f since it provides no filtering value. + ;; + ;; Conservative by design: any construct the extractor cannot reason + ;; about cleanly causes it to return #f. Returning #f is always + ;; sound: it just means the caller cannot pre-filter for this pattern. + ;; + ;; Grammar handled (subset of PCRE-ish): + ;; alt := seq ('|' seq)* — multi-branch alternation drops literal + ;; seq := piece* + ;; piece := atom ('?' | '*' | '+' | '{n,m}')? + ;; atom := literal | '\' escape | '.' | '[' class ']' + ;; | '(' alt ')' | '^' | '$' + + (def (regex-required-literal pattern) + (let ([str (cond + [(re-object? pattern) (re-object-pat-string pattern)] + [(string? pattern) pattern] + [else (error 'regex-required-literal + "pattern must be a string or re object" pattern)])]) + (let ([n (string-length str)]) + (cond + [(fxzero? n) #f] + [else + (let-values ([(lit ok? _end) (rl-scan-alt str 0 n)]) + (cond + [(not ok?) #f] + [(fxzero? (string-length lit)) #f] + [else lit]))])))) + + ;; Each rl-scan-* function returns (values literal ok? new-pos). + ;; literal: the longest required substring known for this sub-expr + ;; ok?: #f if we hit something we cannot reason about + ;; new-pos: position after the consumed sub-expr + + (def (rl-scan-alt s i n) + (let-values ([(lit1 ok1 j) (rl-scan-seq s i n)]) + (cond + [(not ok1) (values "" #f j)] + [(and (fx< j n) (char=? (string-ref s j) #\|)) + ;; Multi-branch alternation: we don't compute a longest-common + ;; substring across branches. Walk the rest to validate, then + ;; report no literal. + (let-values ([(_lit ok2 k) (rl-skip-rest-alt s (fx+ j 1) n)]) + (if ok2 (values "" #t k) (values "" #f k)))] + [else (values lit1 ok1 j)]))) + + (def (rl-skip-rest-alt s i n) + (let loop ([i i]) + (let-values ([(_lit ok j) (rl-scan-seq s i n)]) + (cond + [(not ok) (values "" #f j)] + [(and (fx< j n) (char=? (string-ref s j) #\|)) + (loop (fx+ j 1))] + [else (values "" #t j)])))) + + (def (rl-scan-seq s i n) + (let loop ([i i] [best ""] [current ""]) + (cond + [(fx>= i n) + (values (if (fx> (string-length current) (string-length best)) + current best) + #t i)] + [(or (char=? (string-ref s i) #\|) + (char=? (string-ref s i) #\))) + (values (if (fx> (string-length current) (string-length best)) + current best) + #t i)] + [else + (let-values ([(lit ok j) (rl-scan-piece s i n)]) + (cond + [(not ok) (values "" #f j)] + [(fxzero? (string-length lit)) + (loop j + (if (fx> (string-length current) (string-length best)) + current best) + "")] + [else + (loop j best (string-append current lit))]))]))) + + (def (rl-scan-piece s i n) + (let-values ([(atom-lit ok j) (rl-scan-atom s i n)]) + (cond + [(not ok) (values "" #f j)] + [(fx>= j n) (values atom-lit #t j)] + [else + (let ([c (string-ref s j)]) + (cond + [(or (char=? c #\?) (char=? c #\*)) + (values "" #t (fx+ j 1))] + [(char=? c #\+) + (values atom-lit #t (fx+ j 1))] + [(char=? c #\{) + (let-values ([(lo _hi k) (rl-parse-repeat s (fx+ j 1) n)]) + (cond + [(not k) (values "" #f j)] + [(and (number? lo) (fx>= lo 1)) + (values atom-lit #t k)] + [else + (values "" #t k)]))] + [else (values atom-lit #t j)]))]))) + + (def (rl-scan-atom s i n) + (cond + [(fx>= i n) (values "" #t i)] + [else + (let ([c (string-ref s i)]) + (cond + [(or (char=? c #\^) (char=? c #\$)) + (values "" #t (fx+ i 1))] + [(char=? c #\.) + (values "" #t (fx+ i 1))] + [(char=? c #\[) + (let ([k (rl-skip-class s (fx+ i 1) n)]) + (if k (values "" #t k) (values "" #f i)))] + [(char=? c #\() + (let-values ([(k0 ok0) (rl-skip-group-prefix s (fx+ i 1) n)]) + (cond + [(not ok0) (values "" #f i)] + [else + (let-values ([(lit ok j) (rl-scan-alt s k0 n)]) + (cond + [(not ok) (values "" #f j)] + [(and (fx< j n) (char=? (string-ref s j) #\))) + (values lit #t (fx+ j 1))] + [else (values "" #f j)]))]))] + [(char=? c #\\) + (cond + [(fx>= (fx+ i 1) n) (values "" #f i)] + [else + (let ([e (string-ref s (fx+ i 1))]) + (cond + [(memv e '(#\d #\D #\w #\W #\s #\S #\b #\B + #\A #\Z #\z)) + (values "" #t (fx+ i 2))] + [(memv e '(#\n #\r #\t #\f #\v)) + (values (string (rl-escape->char e)) #t (fx+ i 2))] + [(memv e '(#\x #\u #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) + (values "" #f i)] + [else + (values (string e) #t (fx+ i 2))]))])] + [(memv c '(#\) #\| #\? #\* #\+ #\{ #\} #\])) + (values "" #f i)] + [else + (values (string c) #t (fx+ i 1))]))])) + + (def (rl-escape->char e) + (case e + [(#\n) #\newline] + [(#\r) #\return] + [(#\t) #\tab] + [(#\f) #\page] + [(#\v) #\xb] + [else e])) + + (def (rl-skip-class s i n) + (cond + [(fx>= i n) #f] + [else + (let loop ([i i] [first? #t]) + (cond + [(fx>= i n) #f] + [(and (char=? (string-ref s i) #\]) (not first?)) + (fx+ i 1)] + [(char=? (string-ref s i) #\\) + (cond + [(fx>= (fx+ i 1) n) #f] + [else (loop (fx+ i 2) #f)])] + [else (loop (fx+ i 1) #f)]))])) + + (def (rl-skip-group-prefix s i n) + (cond + [(and (fx< (fx+ i 1) n) + (char=? (string-ref s i) #\?)) + (let ([c (string-ref s (fx+ i 1))]) + (cond + [(char=? c #\:) (values (fx+ i 2) #t)] + [(char=? c #\=) (values (fx+ i 2) #t)] + [(char=? c #\!) (values (fx+ i 2) #t)] + [(char=? c #\<) + (cond + [(fx>= (fx+ i 2) n) (values i #f)] + [else + (let ([d (string-ref s (fx+ i 2))]) + (cond + [(char=? d #\=) (values (fx+ i 3) #t)] + [(char=? d #\!) (values (fx+ i 3) #t)] + [else + (let walk ([k (fx+ i 2)]) + (cond + [(fx>= k n) (values i #f)] + [(char=? (string-ref s k) #\>) + (values (fx+ k 1) #t)] + [else (walk (fx+ k 1))]))]))])] + [else (values i #f)]))] + [else (values i #t)])) + + (def (rl-parse-repeat s i n) + (let-values ([(lo j) (rl-read-int s i n)]) + (cond + [(not lo) (values #f #f #f)] + [(and (fx< j n) (char=? (string-ref s j) #\})) + (values lo lo (fx+ j 1))] + [(and (fx< j n) (char=? (string-ref s j) #\,)) + (let-values ([(hi k) (rl-read-int s (fx+ j 1) n)]) + (cond + [(and (fx< k n) (char=? (string-ref s k) #\})) + (values lo (or hi #f) (fx+ k 1))] + [else (values #f #f #f)]))] + [else (values #f #f #f)]))) + + (def (rl-read-int s i n) + (let loop ([k i] [acc #f]) + (cond + [(fx>= k n) (values acc k)] + [else + (let ([c (string-ref s k)]) + (cond + [(and (char<=? #\0 c) (char<=? c #\9)) + (loop (fx+ k 1) + (fx+ (fx* (or acc 0) 10) + (fx- (char->integer c) (char->integer #\0))))] + [else (values acc k)]))]))) + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/text/aho-corasick.ss @@ -0,0 +1,254 @@ +#!chezscheme +;;; (std text aho-corasick) — multi-pattern literal search. +;;; +;;; One linear pass over the haystack finds every occurrence of every +;;; literal pattern in a set of N patterns. Replaces N independent +;;; Boyer-Moore / naive-search passes (O(N * n)) with a single +;;; Aho-Corasick walk (O(n + matches)), independent of N. +;;; +;;; The compiled automaton is immutable: build it once, then share it +;;; across threads with no coordination. +;;; +;;; API: +;;; +;;; (make-ac PATTERNS) +;;; PATTERNS is a list of (id . bytevector) pairs. Pattern IDs +;;; can be any value; they're returned verbatim on each match. +;;; Empty patterns are rejected. +;;; +;;; (ac-search AUT BV [START [END]]) +;;; Return a list of (id offset len) triples, one per match, in +;;; the order the matches END in BV. +;;; +;;; (ac-search-fold AUT PROC INIT BV [START [END]]) +;;; Lower-level fold: PROC is called as (PROC id offset len acc) +;;; for every match; the final accumulator is returned. No +;;; allocation in the no-match path. +;;; +;;; (ac? X), (ac-pattern-count AUT), (ac-state-count AUT) +;;; Predicate and introspection. + +(library (std text aho-corasick) + (export + make-ac + ac? + ac-pattern-count + ac-state-count + ac-search + ac-search-fold) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; --- compiled automaton -------------------------------------------------- + ;; + ;; goto: fxvector of length 256*state-count. + ;; goto[state*256 + byte] = next-state. Pre-computed: every + ;; transition resolves to a concrete state (failure-link + ;; walking is folded in at build time), so the hot loop is + ;; one fxvector-ref per byte. + ;; + ;; output: vector of length state-count. output[state] is the list + ;; of (pattern-id . pattern-len) for every pattern that + ;; matches ending at this state. '() means no match. + + (define-record-type (ac ac-internal-make ac?) + (nongenerative jerboa-std-text-aho-corasick-2026-05-14) + (sealed #t) + (fields (immutable state-count ac-state-count) + (immutable pattern-count ac-pattern-count) + (immutable goto ac-goto) + (immutable output ac-output))) + + ;; --- builder ------------------------------------------------------------- + + (def (make-ac patterns) + (when (null? patterns) + (error 'make-ac "ruleset must contain at least one pattern")) + (let-values ([(nodes num-states) (build-trie patterns)]) + (compute-fail-and-output! nodes num-states) + (let-values ([(goto output) (build-dense-tables nodes num-states)]) + (ac-internal-make num-states (length patterns) goto output)))) + + ;; A trie node is mutable during build only. Layout: #(goto-ht fail term). + ;; goto-ht: eqv-hashtable from byte (0..255) -> state-id (fixnum) + ;; fail: state-id of the failure link (0 == root) + ;; term: list of (pattern-id . pattern-len) + (def (new-node) + (vector (make-eqv-hashtable) 0 '())) + + ;; Phase 1: walk every pattern into the trie, return (values nodes count). + ;; nodes is a vector of trie-nodes indexed by state-id; root is at 0. + (def (build-trie patterns) + (let ([by-id (make-eqv-hashtable)] + [next-id (box 1)]) + (hashtable-set! by-id 0 (new-node)) + (for-each + (lambda (entry) + (let ([id (car entry)] [bv (cdr entry)]) + (unless (bytevector? bv) + (error 'make-ac "pattern must be a bytevector" bv)) + (let ([m (bytevector-length bv)]) + (when (fxzero? m) + (error 'make-ac "empty pattern not allowed" id)) + (let walk ([state 0] [i 0]) + (cond + [(fx= i m) + (let ([n (hashtable-ref by-id state #f)]) + (vector-set! n 2 + (cons (cons id m) (vector-ref n 2))))] + [else + (let* ([b (bytevector-u8-ref bv i)] + [n (hashtable-ref by-id state #f)] + [g (vector-ref n 0)] + [nx (hashtable-ref g b #f)]) + (cond + [nx (walk nx (fx+ i 1))] + [else + (let ([new-state (unbox next-id)]) + (set-box! next-id (fx+ new-state 1)) + (hashtable-set! by-id new-state (new-node)) + (hashtable-set! g b new-state) + (walk new-state (fx+ i 1)))]))]))))) + patterns) + (let* ([n (unbox next-id)] + [v (make-vector n #f)]) + (let loop ([i 0]) + (when (fx< i n) + (vector-set! v i (hashtable-ref by-id i #f)) + (loop (fx+ i 1)))) + (values v n)))) + + ;; Phase 2: BFS from root. For each non-root state t reached via byte + ;; b from parent s, fail(t) = goto*(fail(s), b) where goto* walks the + ;; failure chain. output(t) = output(t) ++ output(fail(t)). + (def (compute-fail-and-output! nodes num-states) + (let ([queue (make-simple-queue)]) + (let-values ([(_keys vals) (hashtable-entries + (vector-ref (vector-ref nodes 0) 0))]) + (let ([n (vector-length vals)]) + (let loop ([i 0]) + (when (fx< i n) + (queue-enqueue! queue (vector-ref vals i)) + (loop (fx+ i 1)))))) + (let bfs () + (unless (queue-empty? queue) + (let* ([s (queue-dequeue! queue)] + [node (vector-ref nodes s)] + [g (vector-ref node 0)]) + (let-values ([(keys vals) (hashtable-entries g)]) + (let ([k (vector-length keys)]) + (let children ([i 0]) + (when (fx< i k) + (let* ([b (vector-ref keys i)] + [t (vector-ref vals i)] + [t-fail (compute-fail s b t nodes)]) + (vector-set! (vector-ref nodes t) 1 t-fail) + (vector-set! (vector-ref nodes t) 2 + (append (vector-ref (vector-ref nodes t) 2) + (vector-ref (vector-ref nodes t-fail) 2))) + (queue-enqueue! queue t)) + (children (fx+ i 1))))))) + (bfs))))) + + ;; Walk the failure chain from parent s looking for a goto on byte b. + ;; Returns the resulting state, or 0 if we exhaust the chain at root. + ;; Guards against self-loop: never return t for fail(t). + (def (compute-fail s b t nodes) + (let walk ([f (vector-ref (vector-ref nodes s) 1)]) + (let* ([f-node (vector-ref nodes f)] + [f-goto (vector-ref f-node 0)] + [m (hashtable-ref f-goto b #f)]) + (cond + [(and m (not (fx= m t))) m] + [(fx= f 0) 0] + [else (walk (vector-ref f-node 1))])))) + + ;; Phase 3: collapse sparse trie + fail links into a dense (state, byte) + ;; -> next-state table. After this point the input trie isn't touched. + (def (build-dense-tables nodes num-states) + (let ([goto (make-fxvector (fx* num-states 256) 0)] + [out (make-vector num-states '())]) + (let states ([s 0]) + (when (fx< s num-states) + (let ([node (vector-ref nodes s)]) + (vector-set! out s (vector-ref node 2)) + (let bytes ([b 0]) + (when (fx< b 256) + (fxvector-set! goto (fx+ (fx* s 256) b) + (resolve-goto s b nodes)) + (bytes (fx+ b 1))))) + (states (fx+ s 1)))) + (values goto out))) + + ;; For (state, byte): explicit goto if present, else recurse through + ;; failure link, terminating at root. + (def (resolve-goto s b nodes) + (let walk ([t s]) + (let* ([t-node (vector-ref nodes t)] + [t-goto (vector-ref t-node 0)] + [m (hashtable-ref t-goto b #f)]) + (cond + [m m] + [(fx= t 0) 0] + [else (walk (vector-ref t-node 1))])))) + + ;; --- BFS queue (head-list . tail-list) ---------------------------------- + + (def (make-simple-queue) (cons '() '())) + (def (queue-empty? q) + (and (null? (car q)) (null? (cdr q)))) + (def (queue-enqueue! q v) + (set-cdr! q (cons v (cdr q)))) + (def (queue-dequeue! q) + (when (null? (car q)) + (set-car! q (reverse (cdr q))) + (set-cdr! q '())) + (let ([v (car (car q))]) + (set-car! q (cdr (car q))) + v)) + + ;; --- search ------------------------------------------------------------- + ;; + ;; ac-search-fold is the primitive: it walks bv[start..end), calling + ;; (proc id offset len acc) for every match (matches from a single + ;; state appear in unspecified order, multiple matches at the same + ;; end-position are reported separately). + ;; + ;; The inner loop is one fxvector-ref + one vector-ref per byte plus + ;; the proc call for matches. No allocation in the no-match path. + + (def (ac-search-fold aut proc init bv (start 0) (end #f)) + (let ([end (or end (bytevector-length bv))] + [goto (ac-goto aut)] + [out (ac-output aut)]) + (let loop ([i start] [state 0] [acc init]) + (cond + [(fx>= i end) acc] + [else + (let* ([b (bytevector-u8-ref bv i)] + [next (fxvector-ref goto (fx+ (fx* state 256) b))] + [outs (vector-ref out next)]) + (cond + [(null? outs) + (loop (fx+ i 1) next acc)] + [else + (let drain ([os outs] [acc acc]) + (cond + [(null? os) + (loop (fx+ i 1) next acc)] + [else + (let* ([entry (car os)] + [id (car entry)] + [len (cdr entry)] + [off (fx+ (fx- i len) 1)]) + (drain (cdr os) (proc id off len acc)))]))]))])))) + + (def (ac-search aut bv (start 0) (end #f)) + (reverse + (ac-search-fold aut + (lambda (id off len acc) (cons (list id off len) acc)) + '() + bv start (or end (bytevector-length bv))))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-aho-corasick.ss @@ -0,0 +1,133 @@ +#!chezscheme +;;; Tests for (std text aho-corasick) and regex-required-literal in (std regex) + +(import (chezscheme) + (std text aho-corasick) + (std regex)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))])) + +(define-syntax test-t (syntax-rules () [(_ name expr) (test name (if expr #t #f) #t)])) + +(define (s->bv s) (string->utf8 s)) + +(printf "--- (std text aho-corasick) ---~%~%") + +;; basic +(let ([ac (make-ac (list (cons 'a (s->bv "abc"))))]) + (test "single/miss" (ac-search ac (s->bv "xyz")) '()) + (test "single/middle" (ac-search ac (s->bv "xxabcyy")) '((a 2 3))) + (test "single/start" (ac-search ac (s->bv "abcxyz")) '((a 0 3))) + (test "single/end" (ac-search ac (s->bv "xyzabc")) '((a 3 3)))) + +;; multi-pattern +(let ([ac (make-ac (list (cons 'a (s->bv "ab")) + (cons 'b (s->bv "cd"))))]) + (test "multi/both" (ac-search ac (s->bv "xabycdz")) '((a 1 2) (b 4 2))) + (test "multi/one" (ac-search ac (s->bv "abxyz")) '((a 0 2)))) + +;; classic AC example: ushers contains she, he, hers +(let ([ac (make-ac (list (cons 'p (s->bv "he")) + (cons 'q (s->bv "she")) + (cons 'r (s->bv "his")) + (cons 's (s->bv "hers"))))]) + (let ([hits (ac-search ac (s->bv "ushers"))]) + (test-t "classic/she" (member '(q 1 3) hits)) + (test-t "classic/he" (member '(p 2 2) hits)) + (test-t "classic/hers" (member '(s 2 4) hits)) + (test-t "classic/no-his" (not (assq 'r hits))))) + +;; duplicate patterns under different ids +(let ([ac (make-ac (list (cons 'a (s->bv "xx")) + (cons 'b (s->bv "xx"))))]) + (let ([hits (ac-search ac (s->bv "xx"))]) + (test-t "dup/a present" (member '(a 0 2) hits)) + (test-t "dup/b present" (member '(b 0 2) hits)))) + +;; shared prefix +(let ([ac (make-ac (list (cons 'a (s->bv "abcdef")) + (cons 'b (s->bv "abcdefxy"))))]) + (let ([hits (ac-search ac (s->bv "qabcdefxyq"))]) + (test-t "prefix/a hit" (member '(a 1 6) hits)) + (test-t "prefix/b hit" (member '(b 1 8) hits)))) + +;; single-byte pattern at multiple positions +(let ([ac (make-ac (list (cons 'x (s->bv "x"))))]) + (test "single-byte" (ac-search ac (s->bv "xaxbx")) + '((x 0 1) (x 2 1) (x 4 1)))) + +;; bounds +(let ([ac (make-ac (list (cons 'a (s->bv "abc"))))]) + (test "range/start past" (ac-search ac (s->bv "abcdef") 1) '()) + (test "range/end before" (ac-search ac (s->bv "xyabc") 0 4) '())) + +;; fold form +(let ([ac (make-ac (list (cons 'a (s->bv "ab")) + (cons 'b (s->bv "cd"))))]) + (test "fold/count" + (ac-search-fold ac (lambda (_id _off _len acc) (+ acc 1)) + 0 (s->bv "ababcd")) + 3)) + +;; introspection +(let ([ac (make-ac (list (cons 'a (s->bv "abc")) + (cons 'b (s->bv "xyz"))))]) + (test "info/pattern-count" (ac-pattern-count ac) 2) + (test-t "info/state-count" (> (ac-state-count ac) 0)) + (test-t "info/predicate" (ac? ac))) + +;; errors +(test-t "err/empty-list" + (guard (e [#t #t]) (make-ac '()) #f)) +(test-t "err/empty-pattern" + (guard (e [#t #t]) (make-ac (list (cons 'a (s->bv "")))) #f)) + +(printf "~%--- regex-required-literal ---~%~%") + +(test "rl/plain" + (regex-required-literal "abcdef") "abcdef") +(test "rl/anchored" + (regex-required-literal "^abcdef") "abcdef") +(test "rl/unescaped-plus" + (regex-required-literal "stratum+tcp://") "stratumtcp://") +(test "rl/escaped-plus" + (regex-required-literal "stratum\\+tcp://") "stratum+tcp://") +(test "rl/pure-class" (regex-required-literal "[A-Z]+") #f) +(test "rl/shorthand-d" (regex-required-literal "\\d+") #f) +(test "rl/alternation" (regex-required-literal "foo|bar") #f) +(test "rl/optional-dropped" + (regex-required-literal "abc?def") "def") +(test "rl/star-dropped" + (regex-required-literal "ab*cdef") "cdef") +(test "rl/plus-kept" + (regex-required-literal "ab+cd") "abcd") +(test-t "rl/dot-breaks" + (let ([r (regex-required-literal "ab.cd")]) + (or (equal? r "ab") (equal? r "cd")))) +(test "rl/empty" (regex-required-literal "") #f) +(test "rl/escape-literal" + (regex-required-literal "stratum\\+tcp") "stratum+tcp") +(test-t "rl/bracket-class" + (let ([r (regex-required-literal "ab[xy]cd")]) + (or (equal? r "ab") (equal? r "cd")))) + +;; works on a compiled re-object too +(test "rl/from-re-object" + (regex-required-literal (re "abcdef")) "abcdef") + +(newline) +(printf "Results: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) (exit 1))