diff --git a/lab/find.ss b/lab/find.ss new file mode 100755 index 0000000..6816dd2 --- /dev/null +++ b/lab/find.ss @@ -0,0 +1,59 @@ +#!/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 matcher + (lambda (tok) + (let ([n (string-length tok)]) + (lambda (str) + (and (fx>= (string-length str) n) + (string=? (substring str 0 n) tok)))))) + +(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|# 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))))