(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*

|#