summaryrefslogtreecommitdiff
path: root/chapter-2
diff options
context:
space:
mode:
Diffstat (limited to 'chapter-2')
-rw-r--r--chapter-2/2.2-regular-expressions.scm154
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