diff --git a/scsh/rx/re-low.scm b/scsh/rx/re-low.scm index 6fdcc3a..5f7c780 100644 --- a/scsh/rx/re-low.scm +++ b/scsh/rx/re-low.scm @@ -44,13 +44,31 @@ ;;; We compile the string two ways, on demand -- one for cre-search, and ;;; one for cre-search?. -(define-record cre ; A compiled regular expression - string ; The Posix string form of the regexp or #F. - max-paren ; Max paren in STRING needed for submatches. - (bytes #f) ; Pointer to the compiled form, in the C heap, or #F. - (bytes/nm #f) ; Same as BYTES, but compiled with no-submatch. - tvec ; Translation vector for the submatches - ((disclose self) (list "cre" (cre:string self)))) +;(define-record cre ; A compiled regular expression +; string ; The Posix string form of the regexp or #F. +; max-paren ; Max paren in STRING needed for submatches. +; (bytes #f) ; Pointer to the compiled form, in the C heap, or #F. +; (bytes/nm #f) ; Same as BYTES, but compiled with no-submatch. +; tvec ; Translation vector for the submatches +; ((disclose self) (list "cre" (cre:string self)))) + +(define-record-type cre :cre + (really-make-cre string max-paren bytes bytes/nm tvec debug) + cre? + (string cre:string set-cre:string) + (max-paren cre:max-paren set-cre:max-paren) + (bytes cre:bytes set-cre:bytes) + (bytes/nm cre:bytes/nm set-cre:bytes/nm) + (tvec cre:tvec set-cre:tvec) + (debug cre:debug set-cre:debug)) + +(define-record-discloser :cre + (lambda (self) (list "cre" (cre:string self)))) + + +(define (make-cre str max-paren tvec) + (really-make-cre str max-paren #f #f tvec #f)) + (define (new-cre str tvec) (make-cre str (max-live-posix-submatch tvec) tvec)) @@ -78,7 +96,7 @@ (let* ((C-bytes (or (cre:bytes cre) (let ((C-bytes (compile-posix-re->c-struct re-str #t))) (set-cre:bytes cre C-bytes) - (register-re-c-struct cre C-bytes) + (register-re-c-struct:bytes cre) C-bytes))) (retcode (%cre-search C-bytes str start (cre:tvec cre) @@ -95,7 +113,7 @@ (let* ((C-bytes (or (cre:bytes/nm cre) (let ((C-bytes (compile-posix-re->c-struct re-str #f))) (set-cre:bytes/nm cre C-bytes) - (register-re-c-struct cre C-bytes) + (register-re-c-struct:bytes/nm cre) C-bytes))) (retcode (%cre-search C-bytes str start '#() -1 '#() '#()))) (if (integer? retcode) @@ -121,34 +139,31 @@ ;;; Reclaiming compiled regexp storage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Avert your eyes from the unsightly crock. -;;; -;;; S48 0.36 doesn't have finalizers, so we don't have a way to free -;;; the C regexp_t structure when its CRE record is gc'd. So our current -;;; lame approximation is to keep track of all the CRE's with a list of -;;; (cre-weak-pointer . regex_t*) -;;; pairs. From time to time, we should walk the list. If we deref the -;;; weak pointer and discover the CRE's been GC'd, we free the regex_t -;;; struct. -;;; -;;; Note this code is completely thread unsafe. - -;;; Free the space used by a compiled regexp. (define-foreign %free-re (free_re ((C regex_t*) re)) ignore) -(define *master-cre-list* '()) -;;; Whenever we make a new CRE, use this proc to add it to the master list. +;;; Whenever we make a new CRE, add the appropriate finalizer, +;;; so the C regex_t structure can be freeed + +(define (free-bytes the-cre) + (if (cre:bytes the-cre) + (%free-re (cre:bytes the-cre)) + (error "free-bytes called on #f"))) + +(define (free-bytes/nm the-cre) + (if (cre:bytes the-cre) + (%free-re (cre:bytes/nm the-cre)) + (error "free-bytes called on #f"))) + +(define (register-re-c-struct:bytes cre) + (add-finalizer! cre free-bytes)) + +(define (register-re-c-struct:bytes/nm cre) + (add-finalizer! cre free-bytes/nm)) + + (define (register-re-c-struct cre c-bytes) - (set! *master-cre-list* (cons (cons (make-weak-pointer cre) c-bytes) - *master-cre-list*))) + (error "function register-re-c-struct no longer supported")) (define (clean-up-cres) - (set! *master-cre-list* - (fold (lambda (elt lis) - (if (weak-pointer-ref (car elt)) ; Still alive - (cons elt lis) - (begin (%free-re (cdr elt)) - lis))) - '() - *master-cre-list*))) + (warn "function clean-up-cres no longer supported"))