 | cs-pcre2 - Chez Scheme bindings for PCRE2.
git clone https://benconnors.ca/git-repos/cs-pcre2 |
commit 85cabf2c736c595cbad178d14defb178572707c3 Author: Ben Connors <benconnors@outlook.com> Date: Fri, 6 Aug 2021 20:59:45 -0400 Initial commit Diffstat:
| A | README.md | | | 37 | +++++++++++++++++++++++++++++++++++++ |
| A | pcre2.scm | | | 231 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 268 insertions(+), 0 deletions(-)
diff --git a/README.md b/README.md @@ -0,0 +1,37 @@ +# PCRE2 Bindings for Chez Scheme +This library provides Chez Scheme bindings for (a subset of) PCRE2 (UTF-8). + +## Functions + +``` +(pcre2-compile pattern options) +``` +Compile the given string pattern for use with `pcre2-match`. The compiled code allocated by PCRE2 is automatically freed when the returned object becomes inaccessible from Scheme. + +``` +(pcre2-match pattern string offset options) +``` +Match the compiled `pattern` to the passed `string` starting at `offset`. Returns a match data block object that may be manipulated using the following functions, or `#f` if no match was made. + +``` +(pcre2-get-match-count match-data) +``` +Return the number of matches in the match data block. + +``` +(pcre2-get-match-groupcount match-data) +``` +Return the number of groups (possibly null) in the match data block. + +``` +(pcre2-get-match-group match-data n) +``` +Return the `n`-th group in the given match data block. If that group did not match, `#f` is returned. + +``` +(pcre2-get-match-groups match-data) +``` +Return all groups in the given match data block (including null groups) as a list. + +## Requirements +Ensure that PCRE2 is accessible as `libpcre2-8.so`. diff --git a/pcre2.scm b/pcre2.scm @@ -0,0 +1,231 @@ +; Chez Scheme bindings for (a subset of) PCRE2 + +(library (pcre2 (1)) + (export + pcre2-compile + pcre2-match + pcre2-get-match-count + pcre2-get-match-groupcount + pcre2-get-match-group + pcre2-get-match-groups) + (import (chezscheme)) + + (define pcre2-library-load (load-shared-object "libpcre2-8.so")) + + ;;; BEGIN Constants + + (define SIZE_T-SIZE (foreign-sizeof 'size_t)) + (define PCRE2-ZERO-TERMINATED (- (expt 2 (* 8 SIZE_T-SIZE)) 1)) + (define PCRE2-UNSET PCRE2-ZERO-TERMINATED) + + ;;; END Constants + + ;;; BEGIN Memory Management + + ; This guardian handles deallocating PCRE2-allocated foreign pointers when they're no + ; longer accessible from scheme + (define pcre2-guardian (make-guardian)) + + ; Add a pointer to the guardian with the given cleanup function (`pcre2-code-free-base` or + ; `pcre2-match-data-free-base`) + (define (pcre2-guard-pointer ptr cleanup) + (cons ptr cleanup)) + + + ; Get the foreign pointer from a guarded pointer + (define (pcre2-get-pointer-ptr ptr) + (car ptr)) + + ; Get the cleanup function from a guarded pointer + (define (pcre2-get-pointer-cleanup ptr) + (cdr ptr)) + + ; Guard a code pointer + (define (pcre2-guard-code-pointer ptr) + (pcre2-guard-pointer ptr pcre2-code-free-base)) + + ; Guard a match data pointer + (define (pcre2-guard-match-pointer ptr) + (pcre2-guard-pointer ptr pcre2-match-data-free-base)) + + ; Run cleanup; called when new data is allocated + (define (pcre2-cleanup) + (let f () + (let ((x (pcre2-guardian))) + (when x + ((pcre2-get-pointer-cleanup x) (pcre2-get-pointer-ptr x)) + (f))))) + + ;;; END Memory Management + + ;;; BEGIN Compilation Functions + + (define pcre2-compile-base + (foreign-procedure "pcre2_compile_8" + (string size_t unsigned-32 void* void* void*) + void*)) + + (define pcre2-code-free-base + (foreign-procedure "pcre2_code_free_8" + (void*) + void)) + + ; Compile a string pattern for use in match + (define (pcre2-compile pattern options) + (pcre2-cleanup) + (let* ((errorcode (foreign-alloc (foreign-sizeof 'int))) + (erroroffset (foreign-alloc (foreign-sizeof 'size_t))) + (code (pcre2-compile-base pattern PCRE2-ZERO-TERMINATED options errorcode erroroffset 0)) + (errorc (foreign-ref 'int errorcode 0))) + (if (< errorc 0) + (error 'pcre2-compile (pcre2-get-error-message errorc) (foreign-ref 'size_t erroroffset 0)) + (pcre2-guard-code-pointer code)))) + + ;;; END Compilation Functions + + ;;; BEGIN Utility Functions + + (define pcre2-get-error-message-base + (foreign-procedure "pcre2_get_error_message_8" + (int u8* size_t) + int)) + + ; Get the PCRE2 error message corresponding to the given code + (define (pcre2-get-error-message errorcode) + (let* ((buff (make-bytevector 255)) + (len (pcre2-get-error-message-base errorcode buff 255))) + (substring (utf8->string buff) 0 len))) + + ;;; END Utility Functions + + ;;; BEGIN Matching Functions + + ; Note: functions here take either `match-data-ptr` or `match-data`; if they take + ; `match-data-ptr`, they expect a guarded pointer as returned from `pcre2-guard-pointer`. + ; Otherwise, they expect a match data object as returned from `pcre2-match` + + (define pcre2-match-base + (foreign-procedure "pcre2_match_8" + (void* string size_t size_t unsigned-32 void* void*) + int)) + + (define pcre2-match-data-free-base + (foreign-procedure "pcre2_match_data_free_8" + (void*) + void)) + + (define pcre2-match-data-create-from-pattern-base + (foreign-procedure "pcre2_match_data_create_from_pattern_8" + (void* void*) + void*)) + + ; Create a match data block with enough storage to hold the groups in `pattern` + (define (pcre2-match-data-create-from-pattern pattern) + (pcre2-guard-match-pointer (pcre2-match-data-create-from-pattern-base (pcre2-get-pointer-ptr pattern) 0))) + + (define pcre2-get-ovector-count-base + (foreign-procedure "pcre2_get_ovector_count_8" + (void*) + unsigned-32)) + + ; Get the number of groups in a given match data block + (define (pcre2-get-ovector-count match-data-ptr) + (pcre2-get-ovector-count-base (pcre2-get-pointer-ptr match-data-ptr))) + + (define pcre2-get-ovector-pointer-base + (foreign-procedure "pcre2_get_ovector_pointer_8" + (void*) + void*)) + + ; Get the pointer to the first group in the match data block + (define (pcre2-get-ovector-pointer match-data-ptr) + (pcre2-get-ovector-pointer-base (pcre2-get-pointer-ptr match-data-ptr))) + + ; Create a match data object for `match-data-ptr` with the relevant info + (define (pcre2-make-match-data-object count match-data-ptr) + (list match-data-ptr count (pcre2-get-ovector-count match-data-ptr) (pcre2-get-ovector-pointer match-data-ptr))) + + ; Accessor functions for match data objects returned from `pcre2-match` + (define pcre2-get-match-ptr car) + (define pcre2-get-match-ovector-ptr cadddr) + ; These three are the only public ones + (define pcre2-get-match-count cadr) + (define pcre2-get-match-groupcount caddr) + + ; Match `str` against `pattern` starting at `offset`; returns #f if no match + (define (pcre2-match pattern str offset options) + (pcre2-cleanup) + (let* ((match-data (pcre2-match-data-create-from-pattern pattern)) + (errorcode (pcre2-match-base (pcre2-get-pointer-ptr pattern) str PCRE2-ZERO-TERMINATED offset options (pcre2-get-pointer-ptr match-data) 0))) + (display errorcode) + (newline) + (cond ((< errorcode -1) (error 'pcre2-match (pcre2-get-error-message errorcode) errorcode)) + ((< errorcode 2) #f) + (else (pcre2-make-match-data-object (- errorcode 1) match-data))))) + + (define pcre2-substring-length-bynumber-base + (foreign-procedure "pcre2_substring_length_bynumber_8" + (void* unsigned-32 void*) + int)) + + ; Get the length of a substring + (define (pcre2-substring-length-bynumber match-data-ptr num) + (let* ((lenptr (foreign-alloc SIZE_T-SIZE)) + (errorcode (pcre2-substring-length-bynumber-base (pcre2-get-pointer-ptr match-data-ptr) num lenptr)) + (len (foreign-ref 'size_t lenptr 0))) + (if (< errorcode 0) + (error 'pcre2-substring-length-bynumber (pcre2-get-error-message errorcode) match-data-ptr) + len))) + + (define (pcre2-substring-length-bynumber-b match-data num) + (let* ((ovector (pcre2-get-match-ovector-ptr match-data)) + (start (foreign-ref 'size_t ovector (* 2 num SIZE_T-SIZE))) + (end (foreign-ref 'size_t ovector (* (+ 1 (* 2 num)) SIZE_T-SIZE)))) + (if (= start end PCRE2-UNSET) #f + (- end start)))) + + (define pcre2-substring-copy-bynumber-base + (foreign-procedure "pcre2_substring_copy_bynumber_8" + (void* unsigned-32 u8* void*) + int)) + + ; Get a match substring; some gymnastics are needed because PCRE2 operates in code units + ; (bytes) while Chez Scheme operates in UTF-8 characters + (define (pcre2-substring-copy-bynumber match-data num) + (let* ((strlen (pcre2-substring-length-bynumber-b match-data num))) + (if (not strlen) + #f ; This group is unset + (begin + (let* + ((match-data-ptr (pcre2-get-match-ptr match-data)) + (bufflen (+ strlen 1)) + (buff (make-bytevector (+ bufflen 1))) + (bufflenptr (foreign-alloc SIZE_T-SIZE))) + (foreign-set! 'size_t bufflenptr 0 bufflen) + (let* ((errorcode (pcre2-substring-copy-bynumber-base + (pcre2-get-pointer-ptr match-data-ptr) + num + buff + bufflenptr))) + (when (< errorcode 0) + (error 'pcre2-substring-copy-bynumber (pcre2-get-error-message errorcode) match-data-ptr)) + (bytevector-truncate! buff (- bufflen 1)) + (utf8->string buff))))))) + + ; Get a match group for `match-data` + (define (pcre2-get-match-group match-data n) + (when (or (>= n (pcre2-get-match-groupcount match-data)) (< n 0)) + (error 'pcre2-get-match-group "Invalid group number" n)) + (pcre2-substring-copy-bynumber match-data n)) + + ; Get all the substring groups for `match-data` + (define (pcre2-get-match-groups match-data) + (define count (pcre2-get-match-groupcount match-data)) + (define (inner n running) + (if (= n -1) running + (inner (- n 1) (cons (pcre2-get-match-group match-data n) running)))) + (inner (- count 1) '())) + + ;;; END Matching Functions + + )