Added regexp-substitute and regexp-substitute/global.
This commit is contained in:
		
							parent
							
								
									73844bc6ee
								
							
						
					
					
						commit
						1a2d8690ce
					
				
							
								
								
									
										58
									
								
								scsh/re.scm
								
								
								
								
							
							
						
						
									
										58
									
								
								scsh/re.scm
								
								
								
								
							|  | @ -148,6 +148,64 @@ | |||
| 		  0 items) | ||||
| 	  ans)))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (regexp-substitute/global port str re . items) | ||||
|   (let ((range (lambda (start item)		; Return start & end of | ||||
| 		 (cond ((integer? item)		; ITEM's range in STR. | ||||
| 			(values (vector-ref sv item) | ||||
| 				(vector-ref ev item))) | ||||
| 		       ((eq? 'pre item) (values start (vector-ref sv 0))) | ||||
| 		       (else (error "Illegal substitution item." | ||||
| 				    item | ||||
| 				    regexp-substitute))))) | ||||
| 	(num-posts (reduce (lambda (count item) | ||||
| 			     (+ count (if (eq? item 'post) 1 0))) | ||||
| 			   0 items))) | ||||
|   (if (and port (< num-posts 2)) | ||||
| 
 | ||||
|       ;; Output port case, with zero or one POST items. | ||||
|       (let recur ((start 0)) | ||||
| 	(let ((match (string-match re str start))) | ||||
| 	  (and match | ||||
| 	       (let* ((sv (regexp-match:start match)) | ||||
| 		      (ev (regexp-match:end match))) | ||||
| 		 (for-each (lambda (item) | ||||
| 			     (cond ((string? item) (write-string item port)) | ||||
| 				   ((eq? 'post item) | ||||
| 				    (let ((post-start (vector-ref ev 0))) | ||||
| 				      (or (recur post-start) | ||||
| 					  (write-string item port post-start)))) | ||||
| 				   (else (receive (si ei) (range start item) | ||||
| 					   (write-string str port si ei))))) | ||||
| 			   items) | ||||
| 		 #t)))) | ||||
| 
 | ||||
|       (let ((pieces (let recur ((start 0)) | ||||
| 		      (let ((match (string-match re str start)) | ||||
| 			    (cached-post #f)) | ||||
| 			(and match | ||||
| 			     (let* ((sv (regexp-match:start match)) | ||||
| 				    (ev (regexp-match:end match))) | ||||
| 			       (reduce (lambda (pieces item) | ||||
| 					 (cond ((string? item) (cons item pieces)) | ||||
| 					       ((eq? 'post item) | ||||
| 						(append (or cached-post | ||||
| 							    (begin (set! cached-post | ||||
| 									 (recur (vector-ref ev 0))) | ||||
| 								   cached-post)) | ||||
| 							pieces)) | ||||
| 					       (else (receive (si ei) (range start item) | ||||
| 						       (cons (substring str si e1) | ||||
| 							     pieces))))) | ||||
| 				       0 items))))))) | ||||
| 	(and pieces | ||||
| 	     (let ((pieces (reverse pieces))) | ||||
| 	       (if port (for-each (lambda (p) (write-string p port)) pieces) | ||||
| 		   (apply string-append pieces)))))))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| ;;; Miscellaneous | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
|  |  | |||
|  | @ -427,6 +427,7 @@ | |||
| 	  regexp? | ||||
| 	  regexp-exec | ||||
| 	  regexp-substitute | ||||
| 	  regexp-substitute/global | ||||
| 	  regexp-quote)) | ||||
| 
 | ||||
| 
 | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 shivers
						shivers