diff options
| -rw-r--r-- | chapter-2/2.2-regular-expressions.scm | 154 |
1 files changed, 154 insertions, 0 deletions
diff --git a/chapter-2/2.2-regular-expressions.scm b/chapter-2/2.2-regular-expressions.scm new file mode 100644 index 0000000..fa92120 --- /dev/null +++ b/chapter-2/2.2-regular-expressions.scm @@ -0,0 +1,154 @@ +;;; Copyright © 2021 Gerald Sussman and Chris Hanson +;;; Copyright © 2021 David Thompson <dthompson2@worcester.edu> +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(use-modules (ice-9 popen) + (srfi srfi-1)) + + +;; 2.2.2 Implementation of the translator + +(define-syntax-rule (assert cond) + (unless cond + (error "assertion failed" 'cond))) + +;; I am excluding the write-bourne-shell-grep-command and +;; bourne-shell-command-string procedures in the book in favor of +;; using Guile's pipe API. open-pipe* does not open a shell but runs +;; grep directly, eliminating the need to do shell quoting. The book +;; asks "Are we having fun yet?" to which I say "yes, but I draw the +;; line at shell quoting." +(define (grep regexp string) + (let ((pipe (open-pipe* OPEN_WRITE "grep" "-e" regexp))) + (display string pipe) + (newline pipe) + (zero? (status:exit-val (close-pipe pipe))))) + +(define (grep-test regexp . specs) + (for-each (lambda (spec) + (assert + (if (and (pair? spec) (eq? (car spec) 'not)) + (not (grep regexp (list-ref spec 1))) + (grep regexp spec)))) + specs)) + +(define (r:dot) ".") +(define (r:bol) "^") +(define (r:eol) "$") + +(define (r:seq . exprs) + (string-append "\\(" (apply string-append exprs) "\\)")) + +(define chars-needing-quoting + '(#\. #\[ #\\ #\^ #\$ #\*)) + +(define (r:quote string) + (r:seq + (list->string + (append-map (lambda (char) + (if (memv char chars-needing-quoting) + (list #\\ char) + (list char))) + (string->list string))))) + +(grep-test (r:seq (r:quote "a") (r:dot) (r:quote "c")) + "abc") + +(define (r:alt . exprs) + (if (pair? exprs) + (apply r:seq + (cons (car exprs) + (append-map (lambda (expr) + (list "\\|" expr)) + (cdr exprs)))) + (r:seq))) + +(grep-test (r:alt (r:quote "foo") (r:quote "bar") (r:quote "baz")) + "foo" "bar" "baz" '(not "frob")) + +(define (r:repeat min max expr) + (apply r:seq + (append (make-list min expr) + (cond + ((not max) + (list expr "*")) + ((= max min) + '()) + (else + (make-list (- max min) (r:alt expr ""))))))) + +(grep-test (r:repeat 3 5 (r:alt (r:quote "cat") (r:quote "dog"))) + "catdogcat" + "catcatdogdog" + "dogdogcatdogdog" + '(not "catdogfrog")) + +(define (bracket string procedure) + (list->string + (append '(#\[) + (procedure (string->list string)) + '(#\])))) + +(define chars-needing-quoting-in-brackets + '(#\] #\^ #\-)) + +(define (quote-bracketed-contents members) + (define (optional char) + (if (memv char members) + (list char) + '())) + (append (optional #\]) + (remove (lambda (c) + (memv c chars-needing-quoting-in-brackets)) + members) + (optional #\^) + (optional #\-))) + +(define (r:char-from string) + (case (string-length string) + ((0) (r:seq)) + ((1) (r:quote string)) + (else + (bracket string + (lambda (members) + (if (lset= eq? '(#\- #\^) members) + '(#\- #\^) + (quote-bracketed-contents members))))))) + +(define (r:char-not-from string) + (bracket string + (lambda (members) + (cons #\^ (quote-bracketed-contents members))))) + + +;; Exercise 2.6: Adding * and + to regular expressions + +(define (r:* expr) + (r:repeat 0 #f expr)) + +(define (r:+ expr) + (r:repeat 1 #f expr)) + +(grep-test (r:* (r:quote "foo")) + "" "foo" "bar") +(grep-test (r:seq (r:quote "foo") (r:* (r:quote "bar"))) + "foo" "foobar" '(not "")) +(grep-test (r:+ (r:quote "foo")) + '(not "") "foo" "foofoo") +(grep-test (r:seq (r:quote "foo") (r:+ (r:quote "bar"))) + '(not "foo") "foobar" "foobarbar") + +;; Exercise 2.7: A bug, one bad joke, two tweaks, and a revelation |