ikarus/lab/ikarusdoc

#!/Users/aghuloum/.opt/bin/ikarus --script
(define get-comments
  (lambda (file-name)
    (define comments '())
    (parameterize ([comment-handler
                    (lambda (str)
                      (set! comments (cons str comments)))])
      (load file-name (lambda (x) (void))))
    (reverse comments)))

(define filter
  (lambda (f ls)
    (cond
      [(null? ls) '()]
      [(f (car ls)) (cons (car ls) (filter f (cdr ls)))]
      [else (filter f (cdr ls))])))

(define find-end
  (lambda (str i)
    (cond
      [(fx= i (string-length str)) i]
      [(memv (string-ref str i) '(#\newline #\space #\tab)) i]
      [(char=? (string-ref str i) #\:) i]
      [else (find-end str (fxadd1 i))])))

(define matcher
  (lambda (tok)
    (let ([n (string-length tok)])
      (lambda (str)
        (let f ([i 0]) 
          (let ([j (find-end str i)])
            (or (string=? tok (substring str i j))
                (and (fx< j (string-length str))
                     (char=? (string-ref str j) #\:)
                     (f (fxadd1 j))))))))))

(define get-matching
  (lambda (token file-name)
    (filter (matcher token) (get-comments file-name))))

#|Usage:
    find.ss token files ...
  Prints all the comments matching Hash-Bar-token that are found 
  in the files.
|#
(define usage
  (lambda (me?)
    (printf "Usage: ~a token files ...\n" (or me? "find"))
    (printf " Prints all multiline comments matching #|token<comment>|# from the files\n")
    (exit 0)))

(define print-comments
  (lambda (file ls)
    (unless (null? ls)
      (printf "From ~a:\n" file)
      (for-each 
        (lambda (x)
          (display x)
          (newline))
        ls))))

(let ([args (command-line-arguments)])
  (when (null? args) (usage #f))
  (let ([me (car args)] [args (cdr args)])
    (when (null? args) (usage me))
    (let ([tok (car args)] [files (cdr args)])
      (for-each
        (lambda (file)
          (print-comments file (get-matching tok file)))
        files))))