Fix compiler-macro interaction with LOAD-TIME-VALUE and CONSTANTP.

When CONSTANTP is supplied an &environment object from the compiler
macro it can determine forms involving MACROLET to be constant, but
such forms are problematic for LOAD-TIME-VALUE and its null lexical
environment execution requirements.
This commit is contained in:
Stas Boukarev
2016-04-01 12:46:11 +03:00
parent 35c5266061
commit 26aa9b68fb
2 changed files with 39 additions and 29 deletions

View File

@ -277,11 +277,13 @@ internal purposes."))
(values (car match) (cdr match) reg-starts reg-ends)))))) (values (car match) (cdr match) reg-starts reg-ends))))))
#-:cormanlisp #-:cormanlisp
(define-compiler-macro scan (&whole form &environment env regex target-string &rest rest) (define-compiler-macro scan (&whole form regex target-string &rest rest)
"Make sure that constant forms are compiled into scanners at compile time." "Make sure that constant forms are compiled into scanners at compile time."
(cond ((constantp regex env) ;; Don't pass &environment to CONSTANTP, it may not be digestable by
`(scan (load-time-value (create-scanner ,regex)) ;; LOAD-TIME-VALUE, e.g., MACROLETs.
,target-string ,@rest)) (cond ((constantp regex)
`(scan (load-time-value (create-scanner ,regex))
,target-string ,@rest))
(t form))) (t form)))
(defun scan-to-strings (regex target-string &key (start 0) (defun scan-to-strings (regex target-string &key (start 0)
@ -311,11 +313,11 @@ share structure with TARGET-STRING."
#-:cormanlisp #-:cormanlisp
(define-compiler-macro scan-to-strings (define-compiler-macro scan-to-strings
(&whole form &environment env regex target-string &rest rest) (&whole form regex target-string &rest rest)
"Make sure that constant forms are compiled into scanners at compile time." "Make sure that constant forms are compiled into scanners at compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(scan-to-strings (load-time-value (create-scanner ,regex)) `(scan-to-strings (load-time-value (create-scanner ,regex))
,target-string ,@rest)) ,target-string ,@rest))
(t form))) (t form)))
(defmacro register-groups-bind (var-list (regex target-string (defmacro register-groups-bind (var-list (regex target-string
@ -524,12 +526,12 @@ the scan is continued one position behind this match."
(push match-end result-list)))) (push match-end result-list))))
#-:cormanlisp #-:cormanlisp
(define-compiler-macro all-matches (&whole form &environment env regex &rest rest) (define-compiler-macro all-matches (&whole form regex &rest rest)
"Make sure that constant forms are compiled into scanners at "Make sure that constant forms are compiled into scanners at
compile time." compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(all-matches (load-time-value (create-scanner ,regex)) `(all-matches (load-time-value (create-scanner ,regex))
,@rest)) ,@rest))
(t form))) (t form)))
(defun all-matches-as-strings (regex target-string (defun all-matches-as-strings (regex target-string
@ -547,13 +549,13 @@ share structure with TARGET-STRING."
(push match result-list)))) (push match result-list))))
#-:cormanlisp #-:cormanlisp
(define-compiler-macro all-matches-as-strings (&whole form &environment env regex &rest rest) (define-compiler-macro all-matches-as-strings (&whole form regex &rest rest)
"Make sure that constant forms are compiled into scanners at "Make sure that constant forms are compiled into scanners at
compile time." compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(all-matches-as-strings `(all-matches-as-strings
(load-time-value (create-scanner ,regex)) (load-time-value (create-scanner ,regex))
,@rest)) ,@rest))
(t form))) (t form)))
(defun split (regex target-string (defun split (regex target-string
@ -628,11 +630,11 @@ structure with TARGET-STRING."
nil))))) nil)))))
#-:cormanlisp #-:cormanlisp
(define-compiler-macro split (&whole form &environment env regex target-string &rest rest) (define-compiler-macro split (&whole form regex target-string &rest rest)
"Make sure that constant forms are compiled into scanners at compile time." "Make sure that constant forms are compiled into scanners at compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(split (load-time-value (create-scanner ,regex)) `(split (load-time-value (create-scanner ,regex))
,target-string ,@rest)) ,target-string ,@rest))
(t form))) (t form)))
(defun string-case-modifier (str from to start end) (defun string-case-modifier (str from to start end)
@ -996,11 +998,11 @@ match.
#-:cormanlisp #-:cormanlisp
(define-compiler-macro regex-replace (define-compiler-macro regex-replace
(&whole form &environment env regex target-string replacement &rest rest) (&whole form regex target-string replacement &rest rest)
"Make sure that constant forms are compiled into scanners at compile time." "Make sure that constant forms are compiled into scanners at compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(regex-replace (load-time-value (create-scanner ,regex)) `(regex-replace (load-time-value (create-scanner ,regex))
,target-string ,replacement ,@rest)) ,target-string ,replacement ,@rest))
(t form))) (t form)))
(defun regex-replace-all (regex target-string replacement &key (defun regex-replace-all (regex target-string replacement &key
@ -1060,11 +1062,11 @@ match.
#-:cormanlisp #-:cormanlisp
(define-compiler-macro regex-replace-all (define-compiler-macro regex-replace-all
(&whole form &environment env regex target-string replacement &rest rest) (&whole form regex target-string replacement &rest rest)
"Make sure that constant forms are compiled into scanners at compile time." "Make sure that constant forms are compiled into scanners at compile time."
(cond ((constantp regex env) (cond ((constantp regex)
`(regex-replace-all (load-time-value (create-scanner ,regex)) `(regex-replace-all (load-time-value (create-scanner ,regex))
,target-string ,replacement ,@rest)) ,target-string ,replacement ,@rest))
(t form))) (t form)))
#-:cormanlisp #-:cormanlisp

View File

@ -364,3 +364,11 @@ characters if there's a match."
(regex-replace-all (create-scanner "\\p{even}") "abcd" "+") (regex-replace-all (create-scanner "\\p{even}") "abcd" "+")
(regex-replace-all (create-scanner "\\p{true}") "abcd" "+"))) (regex-replace-all (create-scanner "\\p{true}") "abcd" "+")))
'("+b+d" "a+c+" "++++"))) '("+b+d" "a+c+" "++++")))
(macrolet ((z () "(a)*b"))
(equalp (multiple-value-list (scan (z) "xaaabd"))
(list 1 5 #(3) #(4))))
(macrolet ((z () "[^b]*b"))
(equalp (multiple-value-list (scan-to-strings (z) "aaabd"))
(list "aaab" #())))