diff --git a/other-libs/interp-main.ss b/other-libs/interp-main.ss
new file mode 100644
index 0000000..89a1851
--- /dev/null
+++ b/other-libs/interp-main.ss
@@ -0,0 +1,16 @@
+
+(source "r6rs.ss")
+(source "parameters.ss")
+(source "match.ss")
+(source "interp.ss")
+
+(library main
+  (export)
+  (import interp r6rs)
+  (write (ee '(let ((x 5)) 
+                (let ((y (+ x x)))
+                  (+ y x)))))
+  (newline))
+
+(invoke main)
+;(dump main "main.pp")
diff --git a/other-libs/interp.ss b/other-libs/interp.ss
new file mode 100644
index 0000000..2873f54
--- /dev/null
+++ b/other-libs/interp.ss
@@ -0,0 +1,21 @@
+
+
+(library interp
+  (export ee)
+  (import match r6rs)
+  (define (constant? x)
+    (or (number? x) (char? x) (string? x) (boolean? x)))
+  (define (ee x)
+    (define (ee x env)
+      (match x
+        (,c (guard (constant? c)) c)
+        (,x (guard (symbol? x))
+         (cond
+           ((assq x env) => cdr)
+           (else (error 'ee "unbound ~s" x))))
+        ((let ((,x ,v)) ,b)
+         (ee b (cons (cons x (ee v env)) env)))
+        ((+ ,(x) ,(y)) (+ x y))
+        (,others (error 'ee "invalid expr ~s" others))))
+    (ee x '())))
+
diff --git a/other-libs/match.ss b/other-libs/match.ss
new file mode 100644
index 0000000..041ac0c
--- /dev/null
+++ b/other-libs/match.ss
@@ -0,0 +1,855 @@
+;;; match.ss
+
+;;; This program was originally designed and implemented by Dan
+;;; Friedman.  It was redesigned and implemented by Erik Hilsdale;
+;;; some improvements were suggested by Steve Ganz.  Additional
+;;; modifications were made by Kent Dybvig.
+
+;; (Nov 2007)
+;; Aziz Ghuloum added it to ikarus.
+
+;; (Apr 2007)
+;; Aziz Ghuloum ported it to r6rs.
+
+;; (13 March 2002)
+;; rkd added following change by Friedman and Ganz to the main source
+;; code thread and fixed a couple of minor problems.
+
+;; (9 March 2002)
+;; Dan Friedman and Steve Ganz added the ability to use identical pattern
+;; variables.  The patterns represented by the variables are compared
+;; using the value of the parameter match-equality-test, which defaults
+;; to equal?.
+;;
+;; > (match '(1 2 1 2 1)
+;;     ((,a ,b ,a ,b ,a) (guard (number? a) (number? b)) (+ a b)))
+;; 3
+;; ;;
+;; > (match '((1 2 3) 5 (1 2 3))
+;;     (((,a ...) ,b (,a ...)) `(,a ... ,b)))
+;; (1 2 3 5)
+;; ;;
+;; > (parameterize ((match-equality-test (lambda (x y) (equal? x (reverse y)))))
+;;     (match '((1 2 3) (3 2 1))   
+;;       ((,a ,a) 'yes)
+;;       (,oops 'no)))
+;; yes
+
+;; (10 Jan 2002)
+;; eh fixed bug that caused (match '((1 2 3 4)) (((,a ... ,d) . ,x) a)) to
+;; blow up.  The bug was caused by a bug in the sexp-dispatch procedure
+;; where a base value empty list was passed to an accumulator from inside
+;; the recursion, instead of passing the old value of the accumulator.
+
+;; (14 Jan 2001)
+;; rkd added syntax checks to unquote pattern parsing to weed out invalid
+;; patterns like ,#(a) and ,((vector-ref d 1)).
+
+;; (14 Jan 2001)
+;; rkd added ,(Cata -> Id* ...) to allow specification of recursion
+;; function.  ,(Id* ...) recurs to match; ,(Cata -> Id* ...) recurs
+;; to Cata.
+
+;; (14 Jan 2001)
+;; rkd tightened up checks for ellipses and nested quasiquote; was comparing
+;; symbolic names, which, as had been noted in the source, is a possible
+;; hygiene bug.  Replaced error call in guard-body with syntax-error to
+;; allow error to include source line/character information.
+
+;; (13 Jan 2001)
+;; rkd fixed match patterns of the form (stuff* ,(x) ... stuff+), which
+;; had been recurring on subforms of each item rather than on the items
+;; themselves.
+
+;; Previous changelog listings at end of file.
+
+;;; ============================================================
+
+;; Exp    ::= (match              Exp Clause)
+;;         || (trace-match        Exp Clause)
+;;         || (match+       (Id*) Exp Clause*)
+;;         || (trace-match+ (Id*) Exp Clause*)
+;;         || OtherSchemeExp
+
+;; Clause ::= (Pat Exp+) || (Pat (guard Exp*) Exp+)
+
+;; Pat    ::= (Pat ... . Pat)
+;;         || (Pat . Pat)
+;;         || ()
+;;         || #(Pat* Pat ... Pat*)
+;;         || #(Pat*)
+;;         || ,Id
+;;         || ,(Id*)
+;;         || ,(Cata -> Id*)
+;;         || Id
+
+;; Cata   ::= Exp
+
+;; YOU'RE NOT ALLOWED TO REFER TO CATA VARS IN GUARDS. (reasonable!)
+
+
+
+
+(library (match)
+  (export match trace-match guard ... quasiquote unquote
+          unquote-splicing)
+  (import (ikarus))
+
+(define-syntax rec
+  (syntax-rules ()
+    [(_ name val) 
+     (letrec ([name val]) name)]))
+
+(define match-equality-test
+  (make-parameter
+    equal?
+    (lambda (x)
+      (unless (procedure? x)
+        (error 'match-equality-test "~s is not a procedure" x))
+      x)))
+
+(define-syntax match+
+  (lambda (x)
+    (syntax-case x ()
+      ((ctxt (ThreadedId ...) Exp Clause ...)
+       #'(let f ((ThreadedId ThreadedId) ... (x Exp))
+           (match-help ctxt f x (ThreadedId ...) Clause ...))))))
+
+(define-syntax match
+  (lambda (x)
+    (syntax-case x ()
+      ((ctxt Exp Clause ...)
+       #'(let f ((x Exp))
+           (match-help ctxt f x () Clause ...))))))
+
+(define-syntax trace-match+
+  (lambda (x)
+    (syntax-case x ()
+      ((ctxt (ThreadedId ...) Name Exp Clause ...)
+       #'(letrec ((f (trace-lambda Name (ThreadedId ... x)
+                       (match-help ctxt f x (ThreadedId ...) Clause ...))))
+           (f ThreadedId ... x))))))
+
+(define-syntax trace-match
+  (lambda (x)
+    (syntax-case x ()
+      ((ctxt Name Exp Clause ...)
+       #'(letrec ((f (trace-lambda Name (x)
+                       (match-help ctxt f x () Clause ...))))
+           (f Exp))))))
+
+;;; ------------------------------
+
+(define-syntax let-values**
+  (syntax-rules ()
+    ((_ () B0 B ...) (begin B0 B ...))
+    ((_ ((Formals Exp) Rest ...) B0 B ...)
+     (let-values** (Rest ...) 
+       (call-with-values (lambda () Exp)
+         (lambda Formals B0 B ...))))))
+
+(define-syntax match-help
+  (lambda (x)
+    (syntax-case x ()
+      ((_ Template Cata Obj ThreadedIds)
+       #'(error 'match "Unmatched datum" Obj))
+      ((_ Template Cata Obj ThreadedIds (Pat B0 B ...) Rest ...)
+       #'(convert-pat Pat
+           (match-help1 Template Cata Obj ThreadedIds 
+             (B0 B ...)
+             Rest ...))))))
+
+(define-syntax match-help1
+  (lambda (x)
+    (syntax-case x (guard)
+      ((_ PatLit Vars () Cdecls Template Cata Obj ThreadedIds
+         ((guard) B0 B ...) Rest ...)
+       #'(let ((ls/false (sexp-dispatch Obj PatLit)))
+           (if ls/false
+               (apply (lambda Vars
+                        (clause-body Cata Cdecls ThreadedIds
+                          (extend-backquote Template B0 B ...)))
+                 ls/false)
+               (match-help Template Cata Obj ThreadedIds Rest ...))))
+      ((_ PatLit Vars (PG ...) Cdecls Template Cata Obj ThreadedIds
+         ((guard G ...) B0 B ...) Rest ...)
+       #'(let ((ls/false (sexp-dispatch Obj PatLit)))
+           (if (and ls/false (apply (lambda Vars
+                                      (guard-body Cdecls
+                                        (extend-backquote Template
+                                          (and PG ... G ...))))
+                               ls/false))
+               (apply (lambda Vars
+                        (clause-body Cata Cdecls ThreadedIds
+                          (extend-backquote Template B0 B ...)))
+                 ls/false)
+               (match-help Template Cata Obj ThreadedIds Rest ...))))
+      ((_ PatLit Vars (PG ...) Cdecls Template Cata Obj ThreadedIds
+         (B0 B ...) Rest ...)
+       #'(match-help1 PatLit Vars (PG ...) Cdecls Template Cata Obj ThreadedIds
+           ((guard) B0 B ...) Rest ...)))))
+
+(define-syntax clause-body
+  (lambda (x)
+    (define build-mapper
+      (lambda (vars depth cata tIds)
+        (if (zero? depth)
+            cata
+            (with-syntax ((rest (build-mapper vars (- depth 1) cata tIds))
+                          (vars vars)
+                          (tIds tIds))
+              #'(mapper rest vars tIds)))))
+    (syntax-case x ()
+      ((_ Cata ((CVar CDepth CMyCata CFormal ...) ...) (ThreadedId ...) B)
+       (with-syntax (((Mapper ...)
+                      (map (lambda (mycata formals depth)
+                             (build-mapper formals
+                               (syntax->datum depth)
+                               (syntax-case mycata ()
+                                 (#f #'Cata)
+                                 (exp #'exp))
+                               #'(ThreadedId ...)))
+                        #'(CMyCata ...)
+                        #'((CFormal ...) ...)
+                        #'(CDepth ...))))
+         #'(let-values** (((ThreadedId ... CFormal ...)
+                           (Mapper ThreadedId ... CVar))
+                          ...)
+             B))))))
+
+(define-syntax guard-body
+  (lambda (x)
+    (syntax-case x ()
+      ((_ ((Cvar Cdepth MyCata Cformal ...) ...) B)
+       (with-syntax (((CF ...) (apply append #'((Cformal ...) ...))))
+         #'(let-syntax
+               ((CF
+                  (lambda (x)
+                    (syntax-case x ()
+                      (Name
+                        (syntax-error #'Name
+                          "guard cannot refer to return-value variable")))))
+                ...)
+             B))))))
+
+(define-syntax convert-pat
+  ;; returns sexp-pat x vars x guards x cdecls
+  (let ()
+    (define ellipsis?
+      (lambda (x)
+        (and (identifier? x) (free-identifier=? x #'(... ...)))))
+    (define Var?
+      (lambda (x)
+        (syntax-case x (->)
+          (-> #f)
+          (id (identifier? #'id)))))
+    (define fVar
+      (lambda (var vars guards)
+        (let loop ((ls vars))
+          (if (null? ls)
+              (values (cons var vars) guards)
+              (if (bound-identifier=? var (car ls))
+                  (with-syntax (((tmp) (generate-temporaries (list var)))
+                                (var (car ls)))
+                    (values (cons #'tmp vars)
+                            (cons #'((match-equality-test) tmp var) guards)))
+                  (loop (cdr ls)))))))
+    (define (f syn vars guards cdecls depth)
+      (define (andmap f ls)
+        (cond
+          ((null? ls) #f)
+          ((null? (cdr ls)) (f (car ls)))
+          (else (and (f (car ls)) (andmap f (cdr ls))))))
+      (syntax-case syn (unquote)
+        ((unquote . stuff) ; separate for better error detection
+         (syntax-case syn (unquote ->)
+           ((unquote (MyCata -> Var ...))
+            (andmap Var? #'(Var ...))
+            (with-syntax (((Temp) (generate-temporaries '(x)))
+                          (Depth depth))
+              (values #'any
+                      (cons #'Temp vars)
+                      guards
+                      (cons #'(Temp Depth MyCata Var ...) cdecls))))
+           ((unquote (Var ...))
+            (andmap Var? #'(Var ...))
+            (with-syntax (((Temp) (generate-temporaries '(x)))
+                          (Depth depth))
+              (values #'any
+                      (cons #'Temp vars)
+                      guards
+                      (cons #'(Temp Depth #f Var ...) cdecls))))
+           ((unquote Var)
+            (Var? #'Var)
+            (let-values* (((vars guards) (fVar #'Var vars guards)))
+              (values #'any vars guards cdecls)))))
+        (((unquote . stuff) Dots)
+         (ellipsis? #'Dots)
+         (syntax-case syn (unquote ->)
+           (((unquote (MyCata -> Var ...)) Dots)
+            (andmap Var? #'(Var ...))
+            (with-syntax (((Temp) (generate-temporaries '(x)))
+                          (Depth+1 (add1 depth)))
+              (values #'each-any
+                      (cons #'Temp vars)
+                      guards
+                      (cons #'(Temp Depth+1 MyCata Var ...) cdecls))))
+           (((unquote (Var ...)) Dots)
+            (andmap Var? #'(Var ...))
+            (with-syntax (((Temp) (generate-temporaries '(x)))
+                          (Depth+1 (add1 depth)))
+              (values #'each-any
+                      (cons #'Temp vars)
+                      guards
+                      (cons #'(Temp Depth+1 #f Var ...) cdecls))))
+           (((unquote Var) Dots)
+            (Var? #'Var)
+            (let-values* (((vars guards) (fVar #'Var vars guards)))
+              (values #'each-any vars guards cdecls)))
+           ((expr Dots) (syntax-error #'expr "match-pattern unquote syntax"))))
+        ((Pat Dots)
+         (ellipsis? #'Dots)
+         (let-values* (((Dpat Dvars Dguards Dcdecls)
+                        (f #'Pat vars guards cdecls (add1 depth))))
+           (with-syntax ((Size (- (length Dvars) (length vars)))
+                         (Dpat Dpat))
+             (values #'#(each Dpat Size) Dvars Dguards Dcdecls))))
+        ((Pat Dots . Rest)
+         (ellipsis? #'Dots)
+         (let-values* (((Rpat Rvars Rguards Rcdecls)
+                        (f #'Rest vars guards cdecls depth))
+                       ((Dpat Dvars Dguards Dcdecls)
+                        (f #'(Pat (... ...)) Rvars Rguards Rcdecls depth)))
+           (with-syntax ((Size (- (length Dvars) (length Rvars)))
+                         ((RevRestTl . RevRest) (reverseX Rpat '()))
+                         (Dpat Dpat))
+             (values #'#(tail-each Dpat Size RevRest RevRestTl)
+                     Dvars Dguards Dcdecls))))
+        ((X . Y)
+         (let-values* (((Ypat Yvars Yguards Ycdecls)
+                        (f #'Y vars guards cdecls depth))
+                       ((Xpat Xvars Xguards Xcdecls)
+                        (f #'X Yvars Yguards Ycdecls depth)))
+           (with-syntax ((Xpat Xpat) (Ypat Ypat))
+             (values #'(Xpat . Ypat) Xvars Xguards Xcdecls))))
+        (() (values #'() vars guards cdecls))
+        (#(X ...)
+         (let-values* (((Pat Vars Eqvars Cdecls)
+                        (f #'(X ...) vars guards cdecls depth)))
+           (with-syntax ((Pat Pat))
+             (values #'#(vector Pat) Vars Eqvars Cdecls))))
+        (Thing (values #'#(atom Thing) vars guards cdecls))))
+    (define reverseX
+      (lambda (ls acc)
+        (if (pair? ls)
+            (reverseX (cdr ls) (cons (car ls) acc))
+            (cons ls acc))))
+    (define-syntax let-values*
+      (syntax-rules ()
+        ((_ () B0 B ...) (begin B0 B ...))
+        ((_ (((Formal ...) Exp) Decl ...) B0 B ...)
+         (call-with-values (lambda () Exp)
+           (lambda (Formal ...)
+             (let-values* (Decl ...) B0 B ...))))))
+    (define-syntax let-synvalues*
+      (syntax-rules ()
+        ((_ () B0 B ...) (begin B0 B ...))
+        ((_ (((Formal ...) Exp) Decl ...) B0 B ...)
+         (call-with-values (lambda () Exp)
+           (lambda (Formal ...)
+             (with-syntax ((Formal Formal) ...)
+               (let-synvalues* (Decl ...) B0 B ...)))))))
+    (lambda (syn) 
+      (syntax-case syn ()
+        ((_ syn (kh . kt))
+         (let-synvalues* (((Pat Vars Guards Cdecls) (f #'syn '() '() '() 0)))
+           #'(kh 'Pat Vars Guards Cdecls . kt)))))))
+
+(define-syntax mapper
+  (lambda (x)
+    (syntax-case x ()
+      ((_ F (RetId ...) (ThreadId ...))
+       (with-syntax (((t ...) (generate-temporaries #'(RetId ...)))
+                     ((ts ...) (generate-temporaries #'(RetId ...)))
+                     ((null ...) (map (lambda (x) #''()) #'(RetId ...))))
+         #'(let ((fun F))
+             (rec g
+               (lambda (ThreadId ... ls)
+                 (if (null? ls)
+                     (values ThreadId ... null ...)
+                     (call-with-values
+                         (lambda () (g ThreadId ... (cdr ls)))
+                       (lambda (ThreadId ... ts ...)
+                         (call-with-values
+                             (lambda () (fun ThreadId ... (car ls)))
+                           (lambda (ThreadId ... t ...)
+                             (values ThreadId ... (cons t ts) ...))))))))))))))
+
+;;; ------------------------------
+
+(define-syntax my-backquote
+  (lambda (x)
+    (define ellipsis?
+      (lambda (x)
+        (and (identifier? x) (free-identifier=? x #'(... ...)))))
+    (define-syntax with-values
+      (syntax-rules ()
+        ((_ P C) (call-with-values (lambda () P) C))))
+    (define-syntax syntax-lambda
+      (lambda (x)
+        (syntax-case x ()
+          ((_ (Pat ...) Body0 Body ...)
+           (with-syntax (((X ...) (generate-temporaries #'(Pat ...))))
+             #'(lambda (X ...)
+                 (with-syntax ((Pat X) ...)
+                   Body0 Body ...)))))))
+    (define-syntax with-temp
+      (syntax-rules ()
+        ((_ V Body0 Body ...)
+         (with-syntax (((V) (generate-temporaries '(x))))
+           Body0 Body ...))))
+    (define-syntax with-temps
+      (syntax-rules ()
+        ((_ (V ...) (Exp ...) Body0 Body ...)
+         (with-syntax (((V ...) (generate-temporaries #'(Exp ...))))
+           Body0 Body ...))))
+    (define destruct
+      (lambda (Orig x depth)
+        (syntax-case x (quasiquote unquote unquote-splicing)
+          ;; inner quasiquote
+          ((quasiquote Exp)
+           (with-values (destruct Orig #'Exp (add1 depth))
+             (syntax-lambda (Builder Vars Exps)
+               (if (null? #'Vars)
+                   (values #''(quasiquote Exp) '() '())
+                   (values #'(list 'quasiquote Builder) #'Vars #'Exps)))))
+          ;; unquote
+          ((unquote Exp)
+           (zero? depth)
+           (with-temp X
+             (values #'X (list #'X) (list #'Exp))))
+          ((unquote Exp)
+           (with-values (destruct Orig #'Exp (sub1 depth))
+             (syntax-lambda (Builder Vars Exps)
+               (if (null? #'Vars)
+                   (values #''(unquote Exp) '() '())
+                   (values #'(list 'unquote Builder) #'Vars #'Exps)))))
+          ;; splicing
+          (((unquote-splicing Exp))
+           (zero? depth)
+           (with-temp X
+             (values #'X (list #'X) (list #'Exp))))
+          (((unquote-splicing Exp ...))
+           (zero? depth)
+           (with-temps (X ...) (Exp ...)
+             (values #'(append X ...) #'(X ...) #'(Exp ...))))
+          (((unquote-splicing Exp ...) . Rest)
+           (zero? depth)
+           (with-values (destruct Orig #'Rest depth)
+             (syntax-lambda (Builder Vars Exps)
+               (with-temps (X ...) (Exp ...)
+                 (if (null? #'Vars)
+                     (values #'(append X ... 'Rest)
+                             #'(X ...) #'(Exp ...))
+                     (values #'(append X ... Builder)
+                             #'(X ... . Vars) #'(Exp ... . Exps)))))))
+          ((unquote-splicing Exp ...)
+           (with-values (destruct Orig #'(Exp ...) (sub1 depth))
+             (syntax-lambda (Builder Vars Exps)
+               (if (null? #'Vars)
+                   (values #''(unquote-splicing Exp ...) '() '())
+                   (values #'(cons 'unquote-splicing Builder)
+                           #'Vars #'Exps)))))
+          ;; dots
+          (((unquote Exp) Dots)
+           (and (zero? depth) (ellipsis? #'Dots))
+           (with-temp X
+             (values #'X (list #'X) (list #'Exp))))
+          (((unquote Exp) Dots . Rest)
+           (and (zero? depth) (ellipsis? #'Dots))
+           (with-values (destruct Orig #'Rest depth)
+             (syntax-lambda (RestBuilder RestVars RestExps)
+               (with-syntax ((TailExp
+                               (if (null? #'RestVars)
+                                   #''Rest
+                                   #'RestBuilder)))
+                 (with-temp X
+                   (values #'(append X TailExp)
+                           (cons #'X #'RestVars)
+                           (cons #'Exp #'RestExps)))))))
+          ((Exp Dots . Rest)
+           (and (zero? depth) (ellipsis? #'Dots))
+           (with-values (destruct Orig #'Exp depth)
+             (syntax-lambda (ExpBuilder (ExpVar ...) (ExpExp ...))
+               (if (null? #'(ExpVar ...))
+                   (syntax-error Orig "Bad ellipsis")
+                   (with-values (destruct Orig #'Rest depth)
+                     (syntax-lambda (RestBuilder RestVars RestExps)
+                       (with-syntax ((TailExp
+                                       (if (null? #'RestVars)
+                                           #''Rest
+                                           #'RestBuilder))
+                                     (Orig Orig))
+                         (values #'(let f ((ExpVar ExpVar) ...)
+                                     (if (and (pair? ExpVar) ...)
+                                         (cons
+                                           (let ((ExpVar (car ExpVar)) ...)
+                                             ExpBuilder)
+                                           (f (cdr ExpVar) ...))
+                                         (if (and (null? ExpVar) ...)
+                                             TailExp
+                                             (error 'unquote
+                                               "Mismatched lists in ~s"
+                                               Orig))))
+                                 (append #'(ExpVar ...) #'RestVars)
+                                 (append #'(ExpExp ...) #'RestExps)))))))))
+          ;; Vectors
+          (#(X ...)
+           (with-values (destruct Orig #'(X ...) depth)
+             (syntax-lambda (LsBuilder LsVars LsExps)
+               (values #'(list->vector LsBuilder) #'LsVars #'LsExps))))
+          ;; random stuff
+          ((Hd . Tl)
+           (with-values (destruct Orig #'Hd depth)
+             (syntax-lambda (HdBuilder HdVars HdExps)
+               (with-values (destruct Orig #'Tl depth)
+                 (syntax-lambda (TlBuilder TlVars TlExps)
+                   (with-syntax ((Hd (if (null? #'HdVars)
+                                         #''Hd
+                                         #'HdBuilder))
+                                 (Tl (if (null? #'TlVars)
+                                         #''Tl
+                                         #'TlBuilder)))
+                     (values #'(cons Hd Tl)
+                             (append #'HdVars #'TlVars)
+                             (append #'HdExps #'TlExps))))))))
+          (OtherThing
+            (values #''OtherThing '() '())))))
+    ;; macro begins
+    (syntax-case x ()
+      ((_ Datum)
+       (with-values (destruct #'(quasiquote Datum) #'Datum 0)
+         (syntax-lambda (Builder (Var ...) (Exp ...))
+           (if (null? #'(Var ...))
+               #''Datum
+               #'(let ((Var Exp) ...)
+                   Builder))))))))
+
+(define-syntax extend-backquote
+  (lambda (x)
+    (syntax-case x ()
+      ((_ Template Exp ...)
+       (with-syntax ((quasiquote
+                       (datum->syntax #'Template 'quasiquote)))
+         #'(let-syntax ((quasiquote
+                          (lambda (x)
+                            (syntax-case x ()
+                              ((_ Foo) #'(my-backquote Foo))))))
+             Exp ...))))))
+
+;;; ------------------------------
+
+(define-syntax with-values
+  (syntax-rules ()
+    ((_ P C) (call-with-values (lambda () P) C))))
+
+(define-syntax letcc
+  (syntax-rules ()
+    ((_ V B0 B ...) (call/cc (lambda (V) B0 B ...)))))
+
+(define classify-list
+  (lambda (ls)
+    (cond
+      ((null? ls) 'proper)
+      ((not (pair? ls)) 'improper)
+      (else
+        (let f ((tortoise ls) (hare (cdr ls)))
+          (cond
+            ((eq? tortoise hare) 'infinite)
+            ((null? hare) 'proper)
+            ((not (pair? hare)) 'improper)
+            (else
+              (let ((hare (cdr hare)))
+                (cond
+                  ((null? hare) 'proper)
+                  ((not (pair? hare)) 'improper)
+                  (else (f (cdr ls) (cdr hare))))))))))))
+
+(define ilist-copy-flat
+  (lambda (ils)
+    (let f ((tortoise ils) (hare (cdr ils)))
+      (if (eq? tortoise hare)
+          (list (car tortoise))
+          (cons (car tortoise) (f (cdr tortoise) (cddr hare)))))))
+
+(define sexp-dispatch
+  (lambda (obj pat);; #f or list of vars
+    (letcc escape
+      (let ((fail (lambda () (escape #f))))
+        (let f ((pat pat) (obj obj) (vals '()))
+          (cond
+            ((eq? pat 'any)
+             (cons obj vals))
+            ((eq? pat 'each-any)
+             ;; handle infinities
+             (case (classify-list obj)
+               ((proper infinite) (cons obj vals))
+               ((improper) (fail))))
+            ((pair? pat)
+             (if (pair? obj)
+                 (f (car pat) (car obj) (f (cdr pat) (cdr obj) vals))
+                 (fail)))
+            ((vector? pat)
+             (case (vector-ref pat 0)
+               ((atom)
+                (let ((a (vector-ref pat 1)))
+                  (if (eqv? obj a)
+                      vals
+                      (fail))))
+               ((vector)
+                (if (vector? obj)
+                    (let ((vec-pat (vector-ref pat 1)))
+                      (f vec-pat (vector->list obj) vals))
+                    (fail)))
+               ((each)
+                ;; if infinite, copy the list as flat, then do the matching,
+                ;; then do some set-cdrs. 
+                (let ((each-pat (vector-ref pat 1))
+                      (each-size (vector-ref pat 2)))
+                  (case (classify-list obj)
+                    ((improper) (fail))
+                    ((infinite)
+                     (let ((each-vals (f pat (ilist-copy-flat obj) '())))
+                       (for-each (lambda (x) (set-cdr! (last-pair x) x))
+                         each-vals)
+                       (append each-vals vals)))
+                    ((proper)
+                     (append
+                       (let g ((obj obj))
+                         (if (null? obj)
+                             (make-list each-size '())
+                             (let ((hd-vals (f each-pat (car obj) '()))
+                                   (tl-vals (g (cdr obj))))
+                               (map cons hd-vals tl-vals))))
+                       vals)))))
+               ((tail-each)
+                (let ((each-pat (vector-ref pat 1))
+                      (each-size (vector-ref pat 2))
+                      (revtail-pat (vector-ref pat 3))
+                      (revtail-tail-pat (vector-ref pat 4)))
+                  (when (eq? (classify-list obj) 'infinite) (fail))
+                  (with-values
+                      (let g ((obj obj))
+                        ;; in-tail?, vals, revtail-left/ls
+                        (cond
+                          ((pair? obj)
+                           (with-values (g (cdr obj))
+                             (lambda (in-tail? vals tail-left/ls)
+                               (if in-tail?
+                                   (if (null? tail-left/ls)
+                                       (values #f vals (list (car obj)))
+                                       (values #t (f (car tail-left/ls)
+                                                    (car obj)
+                                                    vals)
+                                               (cdr tail-left/ls)))
+                                   (values #f vals
+                                           (cons (car obj) tail-left/ls))))))
+                          (else
+                            (values #t
+                                    (f revtail-tail-pat obj vals)
+                                    revtail-pat))))
+                    (lambda (in-tail? vals tail-left/ls)
+                      (if in-tail?
+                          (if (null? tail-left/ls)
+                              (append (make-list each-size '())
+                                vals)
+                              (fail))
+                          (f each-pat tail-left/ls vals))))))))
+            (else
+              (if (eqv? obj pat)
+                  vals
+                  (fail)))))))))
+)
+
+
+;;; examples of passing along threaded information.
+
+;;; Try (collect-symbols '(if (x y 'a 'c zz) 'b 'c))
+;;; Note that it commonizes the reference to c. 
+
+;; (define-syntax with-values
+;;   (syntax-rules ()
+;;     ((_ P C) (call-with-values (lambda () P) C))))
+;; (define collect-symbols
+;;   (lambda (exp)
+;;     (with-values (collect-symbols-help exp)
+;;       (lambda (symbol-decls exp)
+;;         (match symbol-decls
+;;           (((,symbol-name . ,symbol-var) ...)
+;;            `(let ((,symbol-var (quote ,symbol-name)) ...) ,exp)))))))
+;; (define collect-symbols-help
+;;   (lambda (exp)
+;;     (let ((symbol-env '()))
+;;       (match+ (symbol-env) exp
+;;         (,x
+;;           (guard (symbol? x))
+;;           (values symbol-env x))
+;;         ((quote ,x)
+;;          (guard (symbol? x))
+;;          (let ((pair/false (assq x symbol-env)))
+;;            (if pair/false
+;;                (values symbol-env (cdr pair/false))
+;;                (let ((v (gensym)))
+;;                  (values (cons (cons x v) symbol-env)
+;;                          v)))))
+;;         ((quote ,x)
+;;          (values symbol-env `(quote ,x)))
+;;         ((if ,(t) ,(c) ,(a))
+;;          (values symbol-env `(if ,t ,c ,a)))
+;;         ((,(op) ,(arg) ...)
+;;          (values symbol-env `(,op ,arg ...)))))))
+;; 
+;; ;;; the grammar for this one is just if-exprs and everything else
+;; 
+;; (define collect-leaves
+;;   (lambda (exp acc)
+;;     (match+ (acc) exp
+;;       ((if ,() ,() ,())
+;;        acc)
+;;       ((,() ,() ...)
+;;        acc)
+;;       (,x
+;;         (cons x acc)))))
+;; 
+;; ;; here's something that takes apart quoted stuff. 
+;; 
+;; (define destruct
+;;   (lambda (datum)
+;;     (match datum
+;;       (() `'())
+;;       ((,(X) . ,(Y))`(cons ,X ,Y))
+;;       (#(,(X) ...) `(vector ,X ...))
+;;       (,thing
+;;         (guard (symbol? thing))
+;;         `',thing)
+;;       (,thing
+;;         thing))))
+;; 
+;; ;; examples using explicit Catas
+;; 
+;; (define sumsquares
+;;   (lambda (ls)
+;;     (define square 
+;;       (lambda (x)
+;;         (* x x)))
+;;     (match ls 
+;;       ((,(a*) ...) (apply + a*))
+;;       (,(square -> n) n))))
+;; 
+;; (define sumsquares
+;;   (lambda (ls)
+;;     (define square 
+;;       (lambda (x)
+;;         (* x x)))
+;;     (let ((acc 0))
+;;       (match+ (acc) ls 
+;;         ((,() ...) acc)
+;;         (,((lambda (acc x) (+ acc (square x))) ->) acc)))))
+;; 
+;; ;;; The following uses explicit Catas to parse programs in the
+;; ;;; simple language defined by the grammar below
+;; 
+;; ;;; <Prog> -> (program <Stmt>* <Expr>)
+;; ;;; <Stmt> -> (if <Expr> <Stmt> <Stmt>)
+;; ;;;         | (set! <var> <Expr>)
+;; ;;; <Expr> -> <var>
+;; ;;;         | <integer>
+;; ;;;         | (if <Expr> <Expr> <Expr>)
+;; ;;;         | (<Expr> <Expr*>)
+;; 
+;; (define parse
+;;   (lambda (x)
+;;     (define Prog
+;;       (lambda (x)
+;;         (match x
+;;           ((program ,(Stmt -> s*) ... ,(Expr -> e))
+;;            `(begin ,s* ... ,e))
+;;           (,other (error 'parse "invalid program ~s" other)))))
+;;     (define Stmt
+;;       (lambda (x)
+;;         (match x
+;;           ((if ,(Expr -> e) ,(Stmt -> s1) ,(Stmt -> s2))
+;;            `(if ,e ,s1 ,s2))
+;;           ((set! ,v ,(Expr -> e))
+;;            (guard (symbol? v))
+;;            `(set! ,v ,e))
+;;           (,other (error 'parse "invalid statement ~s" other)))))
+;;     (define Expr
+;;       (lambda (x)
+;;         (match x
+;;           (,v (guard (symbol? v)) v)
+;;           (,n (guard (integer? n)) n)
+;;           ((if ,(e1) ,(e2) ,(e3))
+;;            `(if ,e1 ,e2 ,e3))
+;;           ((,(rator) ,(rand*) ...) `(,rator ,rand* ...))
+;;           (,other (error 'parse "invalid expression ~s" other)))))
+;;     (Prog x)))
+;;; (parse '(program (set! x 3) (+ x 4)))) => (begin (set! x 3) (+ x 4))
+
+;; CHANGELOG (most recent changes are logged at the top of this file)
+
+;; (29 Feb 2000)
+;; Fixed a case sensitivity bug.
+
+;; (24 Feb 2000)
+;; Matcher now handles vector patterns.  Quasiquote also handles
+;; vector patterns, but does NOT do the csv6.2 optimization of
+;; `#(a 1 ,(+ 3 4) x y) ==> (vector 'a 1 (+ 3 4) 'x 'y).
+;; Also fixed bug in (P ... . P) matching code. 
+
+;; (23 Feb 2000)
+;; KSM fixed bug in unquote-splicing inside quasiquote.
+
+;; (10 Feb 2000)
+;; New forms match+ and trace-match+ thread arguments right-to-left.
+;; The pattern (P ... . P) now works the way you might expect.
+;; Infinite lists are now properly matched (and not matched).
+;; Removed the @ pattern.
+;; Internal: No longer converting into syntax-case. 
+
+;; (6 Feb 2000)
+;; Added expansion-time error message for referring to cata variable
+;; in a guard.
+
+;; (4 Feb 2000)
+;; Fixed backquote so it can handle nested backquote (oops).
+;; Double-backquoted elipses are neutralized just as double-backquoted
+;; unquotes are.  So:
+;;   `(a ,'(1 2 3) ... b)    =eval=> (a 1 2 3 b)
+;;   ``(a ,'(1 2 3) ... b)   =eval=> `(a ,'(1 2 3) ... b)
+;;   ``(a ,(,(1 2 3) ...) b) =eval=> `(a ,(1 2 3) b)
+;; Added support for
+;;   `((unquote-splicing x y z) b) =expand==> (append x y z (list 'b))
+
+;; (1 Feb 2000)
+;; Fixed a bug involving forgetting to quote stuff in the revised backquote.
+;; Recognized unquote-splicing and signalled errors in the appropriate places.
+;; Added support for deep elipses in backquote.
+;; Rewrote backquote so it does the rebuilding directly instead of
+;; expanding into Chez's backquote. 
+
+;; (31 Jan 2000)
+;; Kent Dybvig fixed template bug.
+
+;; (31 Jan 2000)
+;; Added the trace-match form, and made guards contain
+;; an explicit and expression:
+;;    (guard E ...) ==> (guard (and E ...))
+
+;; (26 Jan 2000)
+;; Inside the clauses of match expressions, the following
+;; transformation is performed inside backquote expressions:
+;;    ,v ...      ==> ,@v
+;;    (,v ,w) ... ==> ,@(map list v w)
+;;    etc.
+
diff --git a/other-libs/test-match.ss b/other-libs/test-match.ss
new file mode 100755
index 0000000..b8dbaf2
--- /dev/null
+++ b/other-libs/test-match.ss
@@ -0,0 +1,28 @@
+#!/usr/bin/env scheme-script
+
+(import (ikarus) (match))
+
+(define (constant? x)
+  (or (number? x) (char? x) (string? x) (boolean? x)))
+
+(define (ee x)
+  (define (ee x env)
+    (trace-match foo x
+      [,c (guard (constant? c)) c]
+      [,x (guard (symbol? x))
+       (cond
+         ((assq x env) => cdr)
+         (else (error 'ee "unbound variable" x)))]
+      ;[(let ([,x* ,v*] ...) ,b)
+      ; (ee b (append (map cons x* (map (lambda (x) (ee x env)) v*)) env))]
+      [(let ([,x* ,[v*]] ...) ,b)
+       (ee b (append (map cons x* v*) env))]
+      [(+ ,[x] ,[y]) (+ x y)]
+      [,others (error 'ee "invalid expression" others)]))
+  (ee x '()))
+
+(pretty-print 
+  (ee '(let ((x 5)) (let ((y (+ x x))) (+ y x)))))
+
+;(new-cafe ee)
+
diff --git a/scheme/ikarus.boot.prebuilt b/scheme/ikarus.boot.prebuilt
index 576f900..f977004 100644
Binary files a/scheme/ikarus.boot.prebuilt and b/scheme/ikarus.boot.prebuilt differ
diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss
index b8969c0..91a907f 100644
--- a/scheme/ikarus.io.ss
+++ b/scheme/ikarus.io.ss
@@ -417,7 +417,7 @@
     (unless (string? str) 
       (error 'open-string-input-port str))
     ($make-port 0 (string-length str) str 0 
-       #t 
+       #t ;;; transcoder
        #f ;;; closed?
        (fxior fast-get-tag fast-get-char-tag)
        "*string-input-port*" 
diff --git a/scheme/ikarus.trace.ss b/scheme/ikarus.trace.ss
index 1441a6a..d7f19f0 100644
--- a/scheme/ikarus.trace.ss
+++ b/scheme/ikarus.trace.ss
@@ -33,40 +33,43 @@
       (newline)))
 
   (define make-traced-procedure
-    (lambda (name proc)
-      (lambda args
-        (call/cf
-          (lambda (f)
-            (cond
-              [(memq f k*) => 
-               (lambda (ls)
-                 (display-trace ls (cons name args))
-                 (apply proc args))]
-              [else
-               (display-trace (cons 1 k*) (cons name args))
-               (dynamic-wind
-                 (lambda () (set! k* (cons f k*)))
-                 (lambda () 
-                   (call-with-values
-                     (lambda ()
-                       (call/cf
-                         (lambda (nf)
-                           (set! f nf)
-                           (set-car! k* nf)
-                           (apply proc args))))
-                     (lambda v*
-                       (display-prefix k* #t)
-                       (unless (null? v*)
-                         (write (car v*))
-                         (let f ([v* (cdr v*)])
-                           (cond
-                             [(null? v*) (newline)]
-                             [else
-                              (write-char #\space)
-                              (write (car v*))
-                              (f (cdr v*))])))
-                       (apply values v*))))
-                 (lambda () (set! k* (cdr k*))))])))))))
+    (case-lambda
+      [(name proc) (make-traced-procedure name proc (lambda (x) x))]
+      [(name proc filter)
+       (lambda args
+         (call/cf
+           (lambda (f)
+             (cond
+               [(memq f k*) => 
+                (lambda (ls)
+                  (display-trace ls (filter (cons name args)))
+                  (apply proc args))]
+               [else
+                (display-trace (cons 1 k*) (filter (cons name args)))
+                (dynamic-wind
+                  (lambda () (set! k* (cons f k*)))
+                  (lambda () 
+                    (call-with-values
+                      (lambda ()
+                        (call/cf
+                          (lambda (nf)
+                            (set! f nf)
+                            (set-car! k* nf)
+                            (apply proc args))))
+                      (lambda v*
+                        (display-prefix k* #t)
+                        (unless (null? v*)
+                          (let ([v* (filter v*)])
+                            (write (car v*))
+                            (let f ([v* (cdr v*)])
+                              (cond
+                                [(null? v*) (newline)]
+                                [else
+                                 (write-char #\space)
+                                 (write (car v*))
+                                 (f (cdr v*))]))))
+                        (apply values v*))))
+                  (lambda () (set! k* (cdr k*))))]))))])))
 
 
 #!eof
diff --git a/scheme/last-revision b/scheme/last-revision
index 9d63033..d97ddee 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1222
+1223
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index dd57baf..68656c2 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -151,6 +151,7 @@
     [unsyntax-splicing   (macro . unsyntax-splicing)]
     [trace-lambda        (macro . trace-lambda)]
     [trace-define        (macro . trace-define)]
+    [trace-define-syntax (macro . trace-define-syntax)]
     [guard               (macro . guard)]
     [eol-style           (macro . eol-style)]
     [buffer-mode         (macro . buffer-mode)]
@@ -270,6 +271,7 @@
     [time                                        i]
     [trace-lambda                                i]
     [trace-define                                i]
+    [trace-define-syntax                         i]
     [make-list                                   i]
     [last-pair                                   i]
     [bwp-object?                                 i]
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 29b9f8c..0308c32 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -1115,6 +1115,19 @@
                                 "not a procedure" v)))))
              (stx-error stx "invalid name"))))))
   
+  (define trace-define-syntax-macro
+    (lambda (stx)
+      (syntax-match stx ()
+        ((_ who expr)
+         (if (id? who)
+             (bless `(define-syntax ,who
+                       (let ((v ,expr))
+                         (if (procedure? v)
+                             (make-traced-procedure ',who v syntax->datum)
+                             (error 'trace-define-syntax
+                                "not a procedure" v)))))
+             (stx-error stx "invalid name"))))))
+
   (define guard-macro
     (lambda (x)
       (define (gen-clauses con outerk clause*) 
@@ -2367,6 +2380,7 @@
            ((define-enumeration)    define-enumeration-macro)
            ((trace-lambda)          trace-lambda-macro)
            ((trace-define)          trace-define-macro)
+           ((trace-define-syntax)   trace-define-syntax-macro)
            ((define-condition-type) define-condition-type-macro)
            ((include-into)          include-into-macro)
            ((eol-style)