This Text file is old! In a 🏛️Museum, an unsorted archive of (user-)pages. (Saved from Geocities in Oct-2009. The archival story: oocities.org)
--------------------------------------- (To 🚫report any bad content: archivehelp @ gmail.com)

; findall1.scm - find all regex matches in a string (not just one)

(load "pregexp.scm")

;---------------------------------------------------------------------------
; plain regexes only get the first match in the string
(define match-once 
   (pregexp-match-positions 
    "needle" 
    "his hay needle stack --    my hay needle stack --    her hay needle stack") )
(display (format "~%~A" match-once))
;---------------------------------------------------------------------------
; Global defintion of findall:

(define pattern "needle")
(define str "his hay needle stack --    my hay needle stack --    her hay needle stack")
(define last (- (string-length str) 1))
(display (format "~%string positions: [0,~A]" last))

(define (finished? str start)
  ;(display (format "~%start:~A, last:~A" start (string-length str)))
  (= start (string-length str)))

(define (add-match match matches)
   (cond 
     ((pair? match) (cons (car match) matches))
     (else matches)))

(define (next-start match)
   (cond 
     ((pair? match) (cdar match))
     (else last)))

(define (findall-2 pattern start str matches)
   ;(display (format "~%start:~A" start))
   (cond 
      ((finished? str start) matches)
      (else 
         (let ((match (pregexp-match-positions pattern str start))) 
            (if (pair? match)
                (let ((matches (add-match match matches))
		      (start (next-start match)))	 
                         (findall-2 pattern start str matches) )
                matches)) )))

(define (findall-positions pattern str)
   (reverse (findall-2 pattern 0 str '())))

(define (extract-position-matches-2 str positions extract)
   (cond 
     ((null? positions) extract)
     (else 
        (let* ((start (caar positions))
               (end (cdar positions))
               (substr (substring str start end)))
          (extract-position-matches-2 str (cdr positions) (cons substr extract)) ))))

(define (findall pattern str) 
   (extract-position-matches-2 str (findall-positions pattern str) '()))

;------------------------------------------------------------------------------------
; test data:

(define (do-test n pattern str)
  (display (format "~%TEST: ~A" n))
  (let ((positions (findall-positions pattern str)))
       (display (format "~%positions: ~A" positions)) )
  (let ((extract (findall pattern str)))
       (display (format "~%extract: ~A" extract)) ) )


(display "TESTS:")(newline)

(display (format "~%~A" 
  "(findall 
   \"needle\" 
   \"his hay needle stack --    my hay needle stack --    her hay needle stack\")"))

(define positions (findall-positions pattern str))
(display (format "~%positions: ~A" positions))
(define extract (findall pattern str))
(display (format "~%extract: ~A" extract))

(newline)
(do-test 1 "a" "ababababa")
(do-test 2 "a" "aaaa")
(do-test 3 "a" "a")
(do-test 4 "a" "bbbb")