diff --git a/lab/ikarus.interpreter.ss b/lab/ikarus.interpreter.ss
new file mode 100644
index 0000000..c11e9c4
--- /dev/null
+++ b/lab/ikarus.interpreter.ss
@@ -0,0 +1,204 @@
+
+(import (ikarus) (match))
+
+(define (make-annotated-procedure ann proc)
+  (import (ikarus system $codes))
+  ($make-annotated-procedure ann proc))
+
+
+(define (compile-expr expr env)
+  (define who 'compile-expr)
+  (define (do-letrec lhs* rhs* body env)
+    (let-values ([(env n) (extend-env lhs* env)])
+      (let ([rhs* (map (lambda (x) (compile-expr x env)) rhs*)]
+            [body (compile-expr body env)])
+        (lambda (env)
+          (let ([vec (make-vector n)])
+            (let ([env (cons vec env)])
+              (let f ([i 0] [rhs* rhs*])
+                (if (null? rhs*)
+                    (body env)
+                    (begin 
+                      (vector-set! vec i ((car rhs*) env))
+                      (f (+ i 1) (cdr rhs*)))))))))))
+  (define (do-library-letrec lhs* loc* rhs* body env)
+    (let-values ([(env n) (extend-env lhs* env)])
+      (let ([rhs* (map (lambda (x) (compile-expr x env)) rhs*)]
+            [body (compile-expr body env)])
+        (lambda (env)
+          (let ([vec (make-vector n)])
+            (let ([env (cons vec env)])
+              (let f ([i 0] [rhs* rhs*] [loc* loc*])
+                (if (null? rhs*)
+                    (body env)
+                    (let ([v ((car rhs*) env)]) 
+                      (vector-set! vec i v)
+                      (global-set! (car loc*) v)
+                      (f (+ i 1) (cdr rhs*) (cdr loc*)))))))))))
+  (define (lexical-set! env i j v)
+    (vector-set! (list-ref env i) j v))
+  (define (lexical-ref env i j)
+    (vector-ref (list-ref env i) j))
+  (define (global-set! loc v)
+    (set-symbol-value! loc v))
+  (define (global-ref loc)
+    (top-level-value loc))
+  (define (extend-env ls env)
+    (define (properize x)
+      (cond
+        [(null? x) '()]
+        [(pair? x) (cons (car x) (properize (cdr x)))]
+        [else (list x)]))
+    (let ([v (list->vector (properize ls))])
+      (values (cons v env) (vector-length v))))
+  (define (lookup x env)
+    (let f ([i 0] [env env])
+      (cond
+        [(null? env) `(global ,x)]
+        [else
+         (let g ([j 0] [rib (car env)])
+           (cond
+             [(= j (vector-length rib)) 
+              (f (+ i 1) (cdr env))]
+             [(eq? x (vector-ref rib j)) `(lexical ,i ,j)]
+             [else (g (+ j 1) rib)]))])))
+  (define (compile-case-lambda ae fml* expr* env k)
+    (define (compile-clause fmls expr k)
+      (cond
+        [(list? fmls) 
+         (let-values ([(env n) (extend-env fmls env)])
+           (let ([expr (compile-expr expr env)])
+             (lambda (env args argcount)
+               (if (= n argcount) 
+                   (expr (cons (list->vector args) env))
+                   (k env args argcount)))))]
+        [else
+         (let-values ([(env n) (extend-env fmls env)])
+           (let ([expr (compile-expr expr env)])
+             (lambda (env args argcount)
+               (if (>= argcount n)
+                   (let ([vec (make-vector n)])
+                     (let f ([ls args] [i 0])
+                       (cond
+                         [(= i (- n 1)) 
+                          (vector-set! vec i ls)]
+                         [else
+                          (vector-set! vec i (car ls))
+                          (f (cdr ls) (+ i 1))]))
+                     (expr (cons vec env)))
+                   (k env args argcount)))))]))
+    (let ([proc 
+           (let f ([fml* fml*] [expr* expr*])
+             (cond
+               [(null? fml*) k]
+               [else
+                (compile-clause (car fml*) (car expr*)
+                  (f (cdr fml*) (cdr expr*)))]))])
+      (lambda (env)
+        (make-annotated-procedure
+          (cons #f
+               (if (annotation? ae)
+                   (annotation-source ae)
+                   '#f))
+          (lambda args
+            (proc env args (length args)))))))
+  (match expr
+    [(quote ,x) (lambda (env) x)]
+    [,var (guard (gensym? var))
+     (let ([var (lookup var env)])
+       (match var
+         [(lexical ,i ,j)
+          (lambda (env) 
+            (lexical-ref env i j))]
+         [(global ,loc) 
+          (lambda (env)
+            (global-ref loc))]
+         [,_ (die who "invalid variable" var)]))]
+    [(set! ,lhs ,[rhs])
+     (let ([lhs (lookup lhs env)])
+       (match lhs
+         [(lexical ,i ,j) 
+          (lambda (env) 
+            (lexical-set! env i j (rhs env)))]
+         [(global ,loc)
+          (lambda (env)
+            (global-set! loc (rhs env)))]
+         [,_ (die who "invalid set! target" lhs)]))]
+    [(if ,[e0] ,[e1] ,[e2])
+     (lambda (env) 
+       (if (e0 env) (e1 env) (e2 env)))]
+    [(begin ,[e] ,[e*] ...) 
+     (let ([e* (cons e e*)])
+       (lambda (env)
+         (for-each (lambda (e) (e env)) e*)))]
+    [(annotated-case-lambda ,ae [,fml* ,expr*] ...)
+     (compile-case-lambda ae fml* expr* env 
+       (lambda (env args argcount)
+         (assertion-violation 'apply 
+           "incorrect number of arguments" 
+           args)))]
+    [(case-lambda [,fml* ,expr*] ...)
+     (compile-case-lambda #f fml* expr* env 
+       (lambda (env args argcount)
+         (assertion-violation 'apply 
+           "incorrect number of arguments" 
+           args)))] 
+    [(lambda ,fmls ,body) 
+     (compile-expr `(case-lambda [,fmls ,body]) env)]
+    [(letrec ([,lhs* ,rhs*] ...) ,body)
+     (do-letrec lhs* rhs* body env)]
+    [(letrec* ([,lhs* ,rhs*] ...) ,body)
+     (do-letrec lhs* rhs* body env)]
+    [(library-letrec* ([,lhs* ,loc* ,rhs*] ...) ,body)
+     (do-library-letrec lhs* loc* rhs* body env)]
+    [(primitive ,x)
+     (let ([v (system-value x)])
+       (lambda (env) v))]
+    [(,[e] ,[e*] ...)
+     (lambda (env)
+       (apply (e env) (map (lambda (e) (e env)) e*)))]
+    [,x (die who "invalid expression" x)]))
+
+
+(parameterize ([current-core-eval
+                (lambda (expr) 
+                  ;(display "=================\n")
+                  ;(pretty-print expr)
+                  ;(display "=================\n")
+                  (let ([proc (compile-expr expr '())])
+                    (proc '())))])
+  (display "Ikarus Interpreter\n\n")
+  (new-cafe))
+
+
+     
+
+
+#!eof
+
+(define-struct cell (prev next content))
+
+(define (make-ring n f)
+  (cond
+    [(= n 1) 
+     (let ([cell (make-cell #f #f (f))])
+       (set-cell-prev! cell cell)
+       (set-cell-next! cell cell)
+       cell)]
+    [else 
+     (let ([ring (make-ring (- n 1) f)])
+       (let ([prev (cell-prev ring)]
+             [next (cell-next ring)])
+         (let ([cell (make-cell ring next (f))])
+           (set-cell-next! prev cell)
+           (set-cell-prev! ring cell)
+           cell)))]))
+
+(define (make-double-ring n m)
+  (make-ring n (lambda () (make-ring m (lambda () #f)))))
+
+(print-graph #t)
+
+;(write (make-double-rib 5 5))
+(write (make-ring 10 (lambda () #f)))
+(newline)
diff --git a/scheme/last-revision b/scheme/last-revision
index 0d0de0d..adb88b7 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1771
+1772