diff options
| -rw-r--r-- | ps05_pattern_matching/bnewbold_ps05.txt | 49 | ||||
| -rw-r--r-- | ps05_pattern_matching/bnewbold_ps05_code.scm | 208 |
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* + +|# + |