summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ps05_pattern_matching/bnewbold_ps05.txt49
-rw-r--r--ps05_pattern_matching/bnewbold_ps05_code.scm208
2 files changed, 257 insertions, 0 deletions
diff --git a/ps05_pattern_matching/bnewbold_ps05.txt b/ps05_pattern_matching/bnewbold_ps05.txt
new file mode 100644
index 0000000..64908a3
--- /dev/null
+++ b/ps05_pattern_matching/bnewbold_ps05.txt
@@ -0,0 +1,49 @@
+;;; 6.945 Problem Set #5 Comments
+;;; 03/11/2009
+;;; Bryan Newbold <bnewbold@mit.edu>
+
+Note: Problem numbers were totally off! Jeez! ;)
+
+Problem 5.1: Multiple Matches
+--------------------------------
+The multiple suceeds are due to the looping let expression ("lp") in
+match:segment. The first segement match attempt is with n=0, which is why the
+first succeed statement has x null. This is a valid match with y equaling
+(b b b b b b), so the success procedure is called and this match printed, but
+then the failure causes evaluation to drop back to "lp", with n now incremented
+to 1, and the process continutes until n=4, which has no matches at all and
+the #f thunks all the way down to the floor.
+
+Problem 5.2: Multiple Matches
+--------------------------------
+I allowed match:element declarations to have an optional predicate; the
+procedure corresponding to the predicate symbol is pulled from the nearest repl
+environment. A problem with my implementation is that the predicate is only
+checked for the first reference to the variable; if the predicate is different
+or only specified in one of the later references, the right thing doesn't
+happen. Eg,
+
+((matcher '(a (? b) (? b integer?) c))
+ '(a t t c))
+; ((b t))
+; should be #f?
+
+Also the predicate has to be a simple symbol existing in the environmnet,
+instead of a lambda expression, maybe I should have used apply?
+
+[see code in bnewbold_ps05_work.scm]
+
+Problem 5.3: Multiple Match Implementation
+--------------------------------
+Ugh, I should really read these problem sets through the whole way first. See
+implementation above, a somewhat ugly method.
+
+Problem 5.4: ?:choice
+--------------------------------
+[see code in bnewbold_ps05_work.scm]
+
+Problem 5.5: ?:pletrec, ?:ref
+--------------------------------
+
+Problem 5.5: restrict
+--------------------------------
diff --git a/ps05_pattern_matching/bnewbold_ps05_code.scm b/ps05_pattern_matching/bnewbold_ps05_code.scm
new file mode 100644
index 0000000..371d7d2
--- /dev/null
+++ b/ps05_pattern_matching/bnewbold_ps05_code.scm
@@ -0,0 +1,208 @@
+
+
+(load "load")
+
+;;; Problem 5.2 and 5.3
+; I redefined match:element to take an optional additional parameter
+
+; ugly style here, haha!
+(define (match:element variable . predicate)
+ (let ((pred (if (eq? (length predicate) 1)
+ (environment-lookup (nearest-repl/environment) (car predicate))
+ (lambda (q) #t))))
+ (define (element-match data dictionary succeed)
+ (and (pair? data)
+ (let ((vcell (match:lookup variable dictionary)))
+ (if vcell
+ (and (equal? (match:value vcell) (car data))
+ (succeed dictionary 1))
+ (if (pred (car data))
+ (succeed (match:bind variable (car data) dictionary)
+ 1)
+ #f)))))
+ element-match))
+
+(define (match:variable-predicate pattern)
+ (caddr pattern))
+
+(defhandler match:->combinators
+ (lambda (pattern) (if (eq? (length pattern) 3)
+ (match:element (match:variable-name pattern)
+ (match:variable-predicate pattern))
+ (match:element (match:variable-name pattern))))
+ match:element?)
+
+(define (matcher pattern)
+ (let ((match-combinator (match:->combinators pattern)))
+ (lambda (datum)
+ (match-combinator
+ (list datum)
+ '()
+ (lambda (dictionary number-of-items-eaten)
+ (and (= number-of-items-eaten 1)
+ dictionary))))))
+
+#| Test it!
+((matcher '(a (?? t) c))
+ '(a 4 4 4 4 4 c))
+;Value: ((t (4 4 4 4 4)))
+
+((matcher '(a (? b integer?) c))
+ '(a 4 c))
+;Value: ((b 4))
+
+((matcher '(a (? b integer?) c))
+ '(a thing c))
+; #f
+
+((matcher '(a (? b integer? 4) (? b integer?) c))
+ '(a 3 3 c))
+; ((b c))
+
+; hmmmm.... i'm just going to call this user error
+((matcher '(a (? b) (? b integer?) c))
+ '(a t t c))
+; ((b t))
+
+|#
+
+;;; Problem 5.4
+
+(define (match:choice? pattern)
+ (and (pair? pattern)
+ (eq? (car pattern) '?:choice)))
+
+(define (match:choice match-choices)
+ (define (choice-match data dictionary succeed)
+ (let lp ((m-c match-choices))
+ (if (pair? m-c)
+ (let ((try ((match:->combinators (car m-c))
+ data
+ dictionary
+ succeed)))
+ (if try
+ try
+ (lp (cdr m-c))))
+ #f)))
+ choice-match)
+
+(defhandler match:->combinators
+ (lambda (x) (match:choice (cdr x)))
+ match:choice?)
+
+#| TEST TIME!
+
+((matcher '(a (?:choice 2 4 6 8) c))
+ '(a 8 c))
+; ()
+
+((matcher '((?? b) 4 (?:choice (? a) (? b) 'other) 8))
+ '(t t t t t t 4 t 8))
+;Value: ((a t) (b (t t t t t t)))
+
+((matcher '((?? b) 4 (?:choice (? b) other) 8))
+ '(t t t t t t 4 other 8))
+;Value: ((b (t t t t t t)))
+
+|#
+
+;;; Problem 5.5
+
+(define *pattern-table* '())
+
+(define (pattern-lookup name)
+ (let lp ((table *pattern-table*))
+ (cond ((null? table) #f)
+ ((eq? name (caar table))
+ (begin
+ (display "FOUND!")
+ (car (cdr (car table)))))
+ (else (lp (cdr table))))))
+
+(define (matcher pattern)
+ (let ((match-combinator (match:->combinators pattern)))
+ (lambda (datum)
+ (set! *pattern-table* '())
+ (match-combinator
+ (list datum)
+ '()
+ (lambda (dictionary number-of-items-eaten)
+ (and (= number-of-items-eaten 1)
+ dictionary))))))
+
+(define (match:pletrec? pattern)
+ (and (pair? pattern)
+ (eq? (length pattern) 2)
+ (eq? (car pattern) '?:pletrec)))
+
+(define (match:pletrec bindings body)
+ (display "made a letrec")
+ (define (pletrec-match data dictionary succeed)
+ (display "trying a letrec")
+ (for-each
+ (set! *pattern-table* (cons (list (car x) (cadr x))
+ *pattern-table*))
+ bindings)
+ ((match:->combinator body)
+ data
+ dictionary
+ succeed))
+ pletrec-match)
+
+(defhandler match:->combinators
+ (lambda (bindings body)
+ (display bindings)
+ (display body)
+ (match:pletrec bindings body))
+ match:pletrec?)
+
+(define (match:ref? pattern)
+ (and (pair? pattern)
+ (eq? (car pattern) '?:ref)))
+
+(define (match:ref name)
+ (let ((pattern (pattern-lookup name)))
+ (define (ref-match data dictionary succeed)
+ ((match:->combinator pattern)
+ data
+ dictionary
+ succeed))
+ ref-match))
+
+(defhandler match:->combinators
+ match:ref
+ match:ref?)
+
+(define (match:list? pattern)
+ (and (list? pattern)
+ (not (memq (car pattern) '(? ?? ?:ref ?:pletrec ?:choice)))))
+
+#| Test Round, GO!
+
+(match:pletrec? '(?:pletrec ((odd (?:choice () (1 ?:ref even)))
+ (even (?:choice () (2 ?:ref odd))))))
+; #t
+(match:list? '(?:pletrec ((odd (?:choice () (1 ?:ref even)))
+ (even (?:choice () (2 ?:ref odd))))))
+; #f
+
+((match:->combinators '(?:pletrec ((odd (?:choice () (1 ?:ref even)))
+ (even (?:choice () (2 ?:ref odd))))
+ (?:ref odd)))
+ '(a b c)
+ '()
+ (lambda
+
+((matcher '(?:pletrec ((fancy (1 2 3)))
+ (?:ref fancy)))
+ '(1 2 3 4 6 7 ))
+
+((matcher '(?:pletrec ((odd (?:choice () (1 ?:ref even)))
+ (even (?:choice () (2 ?:ref odd))))
+ (?:ref odd)))
+ '(1 (2 (1 ()))))
+
+*pattern-table*
+
+|#
+