diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm
index 0113610a..ae0e6aff 100644
--- a/contrib/20.r7rs/scheme/base.scm
+++ b/contrib/20.r7rs/scheme/base.scm
@@ -69,58 +69,6 @@
 
   ;; 4.2.7. Exception handling
 
-  (define-syntax (guard-aux reraise . clauses)
-    (letrec
-        ((else?
-          (lambda (clause)
-            (and (list? clause) (equal? #'else (car clause)))))
-         (=>?
-          (lambda (clause)
-            (and (list? clause) (= (length clause) 3) (equal? #'=> (list-ref clause 1))))))
-      (if (null? clauses)
-          reraise
-          (let ((clause (car clauses))
-                (rest (cdr clauses)))
-            (cond
-             ((else? clause)
-              #`(begin #,@(cdr clause)))
-             ((=>? clause)
-              #`(let ((tmp #,(list-ref clause 0)))
-                  (if tmp
-                      (#,(list-ref clause 2) tmp)
-                      (guard-aux #,reraise #,@rest))))
-             ((= (length clause) 1)
-              #`(or #,(car clause) (guard-aux #,reraise #,@rest)))
-             (else
-              #`(if #,(car clause)
-                    (begin #,@(cdr clause))
-                    (guard-aux #,reraise #,@rest))))))))
-
-  (define-syntax (guard formal . body)
-    (let ((var (car formal))
-          (clauses (cdr formal)))
-      #`((call/cc
-          (lambda (guard-k)
-            (with-exception-handler
-             (lambda (condition)
-               ((call/cc
-                 (lambda (handler-k)
-                   (guard-k
-                    (lambda ()
-                      (let ((#,var condition))
-                        (guard-aux
-                         (handler-k
-                          (lambda ()
-                            (raise-continuable condition)))
-                         #,@clauses))))))))
-             (lambda ()
-               (call-with-values
-                   (lambda () #,@body)
-                 (lambda args
-                   (guard-k
-                    (lambda ()
-                      (apply values args))))))))))))
-
   (export guard)
 
   ;; 4.2.8. Quasiquotation
@@ -136,251 +84,12 @@
 
   ;; 4.3.2 Pattern language
 
-  (define (succ n)
-    (+ n 1))
-
-  (define (pred n)
-    (if (= n 0)
-        0
-        (- n 1)))
-
-  (define (every? args)
-    (if (null? args)
-        #t
-        (if (car args)
-            (every? (cdr args))
-            #f)))
-
-  (define (filter f list)
-    (if (null? list)
-        '()
-        (if (f (car list))
-            (cons (car list)
-                  (filter f (cdr list)))
-            (filter f (cdr list)))))
-
-  (define (take-tail n list)
-    (let drop ((n (- (length list) n)) (list list))
-      (if (= n 0)
-          list
-          (drop (- n 1) (cdr list)))))
-
-  (define (drop-tail n list)
-    (let take ((n (- (length list) n)) (list list))
-      (if (= n 0)
-          '()
-          (cons (car list) (take (- n 1) (cdr list))))))
-
-  (define (map-keys f assoc)
-    (map (lambda (s) `(,(f (car s)) . ,(cdr s))) assoc))
-
-  (define (map-values f assoc)
-    (map (lambda (s) `(,(car s) . ,(f (cdr s)))) assoc))
-
-  ;; TODO
-  ;; - placeholder
-  ;; - vector
-  ;; - (... template) pattern
-
-  ;; p ::= constant
-  ;;     | var
-  ;;     | (p ... . p)      (in input pattern, tail p should be a proper list)
-  ;;     | (p . p)
-
-  (define (compile ellipsis literals rules)
-
-    (define (constant? obj)
-      (and (not (pair? obj))
-           (not (identifier? obj))))
-
-    (define (literal? obj)
-      (and (identifier? obj)
-           (memq obj literals)))
-
-    (define (many? pat)
-      (and (pair? pat)
-           (pair? (cdr pat))
-           (identifier? (cadr pat))
-           (identifier=? (cadr pat) ellipsis)))
-
-    (define (pattern-validator pat)      ; pattern -> validator
-      (letrec
-          ((pattern-validator
-            (lambda (pat form)
-              (cond
-               ((constant? pat)
-                #`(equal? '#,pat #,form))
-               ((literal? pat)
-                #`(and (identifier? #,form) (identifier=? #'#,pat #,form)))
-               ((identifier? pat)
-                #t)
-               ((many? pat)
-                (let ((head #`(drop-tail #,(length (cddr pat)) #,form))
-                      (tail #`(take-tail #,(length (cddr pat)) #,form)))
-                  #`(and (list? #,form)
-                         (>= (length #,form) #,(length (cddr pat)))
-                         (every? (map (lambda (#,'it) #,(pattern-validator (car pat) 'it)) #,head))
-                         #,(pattern-validator (cddr pat) tail))))
-               ((pair? pat)
-                #`(and (pair? #,form)
-                       #,(pattern-validator (car pat) #`(car #,form))
-                       #,(pattern-validator (cdr pat) #`(cdr #,form))))
-               (else
-                #f)))))
-        (pattern-validator pat 'it)))
-
-    (define (pattern-variables pat)       ; pattern -> (freevar)
-      (cond
-       ((constant? pat)
-        '())
-       ((literal? pat)
-        '())
-       ((identifier? pat)
-        `(,pat))
-       ((many? pat)
-        (append (pattern-variables (car pat))
-                (pattern-variables (cddr pat))))
-       ((pair? pat)
-        (append (pattern-variables (car pat))
-                (pattern-variables (cdr pat))))))
-
-    (define (pattern-levels pat)          ; pattern -> ((var * int))
-      (cond
-       ((constant? pat)
-        '())
-       ((literal? pat)
-        '())
-       ((identifier? pat)
-        `((,pat . 0)))
-       ((many? pat)
-        (append (map-values succ (pattern-levels (car pat)))
-                (pattern-levels (cddr pat))))
-       ((pair? pat)
-        (append (pattern-levels (car pat))
-                (pattern-levels (cdr pat))))))
-
-    (define (pattern-selectors pat)       ; pattern -> ((var * selector))
-      (letrec
-          ((pattern-selectors
-            (lambda (pat form)
-              (cond
-               ((constant? pat)
-                '())
-               ((literal? pat)
-                '())
-               ((identifier? pat)
-                `((,pat . ,form)))
-               ((many? pat)
-                (let ((head #`(drop-tail #,(length (cddr pat)) #,form))
-                      (tail #`(take-tail #,(length (cddr pat)) #,form)))
-                  (let ((envs (pattern-selectors (car pat) 'it)))
-                    (append
-                     (map-values (lambda (s) #`(map (lambda (#,'it) #,s) #,head)) envs)
-                     (pattern-selectors (cddr pat) tail)))))
-               ((pair? pat)
-                (append (pattern-selectors (car pat) #`(car #,form))
-                        (pattern-selectors (cdr pat) #`(cdr #,form))))))))
-        (pattern-selectors pat 'it)))
-
-    (define (template-representation pat levels selectors)
-      (cond
-       ((constant? pat)
-        pat)
-       ((identifier? pat)
-        (let ((it (assq pat levels)))
-          (if it
-              (if (= 0 (cdr it))
-                  (cdr (assq pat selectors))
-                  (error "unmatched pattern variable level" pat))
-              #`(#,'rename '#,pat))))
-       ((many? pat)
-        (letrec*
-            ((inner-pat
-              (car pat))
-             (inner-levels
-              (map (lambda (s) `(,(car s) . ,(pred (cdr s)))) levels))
-             (inner-freevars
-              (filter (lambda (v) (assq v levels)) (pattern-variables inner-pat)))
-             (inner-vars
-              ;; select only vars declared with ellipsis
-              (filter (lambda (v) (> (cdr (assq v levels)) 0)) inner-freevars))
-             (inner-tmps
-              (map (lambda (v) #'it) inner-vars))
-             (inner-selectors
-              ;; first env '(map cons ...)' shadows second env 'selectors'
-              (append (map cons inner-vars inner-tmps) selectors))
-             (inner-rep
-              (template-representation inner-pat inner-levels inner-selectors))
-             (sorted-selectors
-              (map (lambda (v) (assq v selectors)) inner-vars))
-             (list-of-selectors
-              ;; ((a . xs) (b . ys) (c . zs)) -> (xs ys zs)
-              (map cdr sorted-selectors)))
-          (let ((rep1 #`(map (lambda #,inner-tmps #,inner-rep) #,@list-of-selectors))
-                (rep2 (template-representation (cddr pat) levels selectors)))
-            #`(append #,rep1 #,rep2))))
-       ((pair? pat)
-        #`(cons #,(template-representation (car pat) levels selectors)
-                #,(template-representation (cdr pat) levels selectors)))))
-
-    (define (compile-rule pattern template)
-      (let ((levels
-             (pattern-levels pattern))
-            (selectors
-             (pattern-selectors pattern)))
-        (template-representation template levels selectors)))
-
-    (define (compile-rules rules)
-      (if (null? rules)
-          #`(error "unmatch")
-          (let ((pattern (car (car rules)))
-                (template (cadr (car rules))))
-            #`(if #,(pattern-validator pattern)
-                  #,(compile-rule pattern template)
-                  #,(compile-rules (cdr rules))))))
-
-    (define (compile rules)
-      #`(call-with-current-environment
-         (lambda (env)
-           (letrec
-               ((#,'rename (let ((wm (make-attribute)))
-                             (lambda (x)
-                               (or (wm x)
-                                   (let ((id (make-identifier x env)))
-                                     (wm x id)
-                                     id))))))
-             (lambda #,'it
-               #,(compile-rules rules))))))
-
-    (let ((rules (map-keys cdr rules))) ; TODO: check pattern head is a variable
-      (compile rules)))
-
-  (define-syntax (syntax-rules . args)
-    (if (list? (car args))
-        #`(syntax-rules ... #,@args)
-        (let ((ellipsis (car args))
-              (literals (car (cdr args)))
-              (rules    (cdr (cdr args))))
-          (compile ellipsis literals rules))))
-
-  (define-syntax (define-auxiliary-syntax var)
-    #`(define-macro #,var
-        (lambda _
-          (error "invalid use of auxiliary syntax" '#,var))))
-
-  (define-auxiliary-syntax _)
-  (define-auxiliary-syntax ...)
-
   (export syntax-rules
           _
           ...)
 
   ;; 4.3.3. Signaling errors in macro transformers
 
-  (define-macro syntax-error
-    (lambda (form _)
-      (apply error (cdr form))))
-
   (export syntax-error)
 
   ;; 5.3. Variable definitions
@@ -407,100 +116,6 @@
 
   ;; 6.2. Numbers
 
-  (define complex? number?)
-  (define real? number?)
-  (define rational? number?)
-  (define (integer? o)
-    (or (exact? o)
-        (and (inexact? o)
-             (not (nan? o))
-             (not (infinite? o))
-             (= o (floor o)))))
-
-  (define (exact-integer? x)
-    (and (exact? x)
-         (integer? x)))
-
-  (define (zero? x)
-    (= x 0))
-
-  (define (positive? x)
-    (> x 0))
-
-  (define (negative? x)
-    (< x 0))
-
-  (define (even? x)
-    (= x (* (exact (floor (/ x 2))) 2)))
-
-  (define (odd? x)
-    (not (even? x)))
-
-  (define (min . args)
-    (define (min a b)
-      (if (< a b) a b))
-    (let loop ((args args) (acc +inf.0) (exactp #t))
-      (if (null? args)
-          (if exactp acc (inexact acc))
-          (loop (cdr args) (min (car args) acc) (and (exact? (car args)) exactp)))))
-
-  (define (max . args)
-    (define (max a b)
-      (if (> a b) a b))
-    (let loop ((args args) (acc -inf.0) (exactp #t))
-      (if (null? args)
-          (if exactp acc (inexact acc))
-          (loop (cdr args) (max (car args) acc) (and (exact? (car args)) exactp)))))
-
-  (define (floor-quotient i j)
-    (call-with-values (lambda () (floor/ i j))
-      (lambda (q r)
-        q)))
-
-  (define (floor-remainder i j)
-    (call-with-values (lambda () (floor/ i j))
-      (lambda (q r)
-        r)))
-
-  (define (truncate-quotient i j)
-    (call-with-values (lambda () (truncate/ i j))
-      (lambda (q r)
-        q)))
-
-  (define (truncate-remainder i j)
-    (call-with-values (lambda () (truncate/ i j))
-      (lambda (q r)
-        r)))
-
-  (define (gcd . args)
-    (define (gcd i j)
-      (cond
-       ((> i j) (gcd j i))
-       ((< i 0) (gcd (- i) j))
-       ((> i 0) (gcd (truncate-remainder j i) i))
-       (else j)))
-    (let loop ((args args) (acc 0))
-      (if (null? args)
-          acc
-          (loop (cdr args)
-                (gcd acc (car args))))))
-
-  (define (lcm . args)
-    (define (lcm i j)
-      (/ (abs (* i j)) (gcd i j)))
-    (let loop ((args args) (acc 1))
-      (if (null? args)
-          acc
-          (loop (cdr args)
-                (lcm acc (car args))))))
-
-  (define (square x)
-    (* x x))
-
-  (define (exact-integer-sqrt k)
-    (let ((s (exact (floor (sqrt k)))))
-      (values s (- k (square s)))))
-
   (export number?
           complex?
           real?
@@ -643,20 +258,6 @@
 
   ;; 6.9. Bytevectors
 
-  (define (utf8->string v . opts)
-    (let ((start (if (pair? opts) (car opts) 0))
-          (end (if (>= (length opts) 2)
-                   (cadr opts)
-                   (bytevector-length v))))
-      (list->string (map integer->char (bytevector->list v start end)))))
-
-  (define (string->utf8 s . opts)
-    (let ((start (if (pair? opts) (car opts) 0))
-          (end (if (>= (length opts) 2)
-                   (cadr opts)
-                   (string-length s))))
-      (list->bytevector (map char->integer (string->list s start end)))))
-
   (export bytevector?
           bytevector
           make-bytevector
@@ -673,40 +274,6 @@
 
   ;; 6.10. Control features
 
-  (define checkpoints '((0 #f . #f)))
-
-  (define (dynamic-wind in thunk out)
-    (in)
-    (set! checkpoints `((,(+ 1 (caar checkpoints)) ,in . ,out) . ,checkpoints))
-    (let ((ans (thunk)))
-      (set! checkpoints (cdr checkpoints))
-      (out)
-      ans))
-
-  (define (do-wind here there)
-    (unless (eq? here there)
-      (if (< (caar here) (caar there))
-          (begin
-            (do-wind here (cdr there))
-            ((cadr (car there))))
-          (begin
-            ((cddr (car here)))
-            (do-wind (cdr here) there)))))
-
-  (define scheme:call/cc
-    (let ((c call/cc))
-      (lambda (f)
-        (c (lambda (k)
-             (f (let ((save checkpoints))
-                  (lambda args
-                    (do-wind checkpoints save)
-                    (set! checkpoints save)
-                    (apply k args)))))))))
-
-  ;; call/cc and scheme:call/cc cannot coincide, so overwrite them
-  (set! call/cc scheme:call/cc)
-  (set! call-with-current-continuation scheme:call/cc)
-
   (export procedure?
           apply
           map
@@ -723,14 +290,6 @@
 
   ;; 6.11. Exceptions
 
-  (define (read-error? obj)
-    (and (error-object? obj)
-         (eq? (error-object-type obj) 'read)))
-
-  (define (file-error? obj)
-    (and (error-object? obj)
-         (eq? (error-object-type obj) 'file)))
-
   (export with-exception-handler
           raise
           raise-continuable
@@ -743,79 +302,6 @@
 
   ;; 6.13. Input and output
 
-  (define (input-port-open? port)
-    (and (input-port? port) (port-open? port)))
-
-  (define (output-port-open? port)
-    (and (output-port? port) (port-open? port)))
-
-  (define (call-with-port port handler)
-    (let ((res (handler port)))
-      (close-port port)
-      res))
-
-  (define (open-input-string str)
-    (open-input-bytevector (list->bytevector (map char->integer (string->list str)))))
-
-  (define (open-output-string)
-    (open-output-bytevector))
-
-  (define (get-output-string port)
-    (list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
-
-  (define (read-char . opt)
-    (let ((b (apply read-u8 opt)))
-      (if (eof-object? b)
-          b
-          (integer->char b))))
-
-  (define (peek-char . opt)
-    (let ((b (apply peek-u8 opt)))
-      (if (eof-object? b)
-          b
-          (integer->char b))))
-
-  (define (u8-ready? . opt)
-    #t)
-
-  (define (read-bytevector k . opt)
-    (let ((port (if (null? opt) (current-input-port) (car opt))))
-      (let ((buf (make-bytevector k)))
-        (let ((n (read-bytevector! buf port 0 k)))
-          (if (eof-object? n)
-              (eof-object)
-              (bytevector-copy buf 0 n))))))
-
-  (define (char-ready? . opt)
-    #t)
-
-  (define (newline . opt)
-    (apply write-u8 (char->integer #\newline) opt))
-
-  (define (write-char c . opt)
-    (apply write-u8 (char->integer c) opt))
-
-  (define (write-string s . opt)
-    (apply write-bytevector (list->bytevector (map char->integer (string->list s))) opt))
-
-  (define (read-line . opt)
-    (if (eof-object? (apply peek-char opt))
-        (eof-object)
-        (let loop ((str "") (c (apply read-char opt)))
-          (if (or (eof-object? c)
-                  (char=? c #\newline))
-              str
-              (loop (string-append str (string c)) (apply read-char opt))))))
-
-  (define (read-string k . opt)
-    (if (eof-object? (apply peek-char opt))
-        (eof-object)
-        (let loop ((k k) (str "") (c (apply read-char opt)))
-          (if (or (eof-object? c)
-                  (zero? k))
-              str
-              (loop (- k 1) (string-append str (string c)) (apply read-char opt))))))
-
   (export current-input-port
           current-output-port
           current-error-port
@@ -863,4 +349,464 @@
           write-bytevector
           flush-output-port)
 
-  (export features))
+  (export features)
+
+  (begin
+
+    (define-syntax (guard-aux reraise . clauses)
+      (letrec
+          ((else?
+            (lambda (clause)
+              (and (list? clause) (equal? #'else (car clause)))))
+           (=>?
+            (lambda (clause)
+              (and (list? clause) (= (length clause) 3) (equal? #'=> (list-ref clause 1))))))
+        (if (null? clauses)
+            reraise
+            (let ((clause (car clauses))
+                  (rest (cdr clauses)))
+              (cond
+               ((else? clause)
+                #`(begin #,@(cdr clause)))
+               ((=>? clause)
+                #`(let ((tmp #,(list-ref clause 0)))
+                    (if tmp
+                        (#,(list-ref clause 2) tmp)
+                        (guard-aux #,reraise #,@rest))))
+               ((= (length clause) 1)
+                #`(or #,(car clause) (guard-aux #,reraise #,@rest)))
+               (else
+                #`(if #,(car clause)
+                      (begin #,@(cdr clause))
+                      (guard-aux #,reraise #,@rest))))))))
+
+    (define-syntax (guard formal . body)
+      (let ((var (car formal))
+            (clauses (cdr formal)))
+        #`((call/cc
+            (lambda (guard-k)
+              (with-exception-handler
+               (lambda (condition)
+                 ((call/cc
+                   (lambda (handler-k)
+                     (guard-k
+                      (lambda ()
+                        (let ((#,var condition))
+                          (guard-aux
+                           (handler-k
+                            (lambda ()
+                              (raise-continuable condition)))
+                           #,@clauses))))))))
+               (lambda ()
+                 (call-with-values
+                     (lambda () #,@body)
+                   (lambda args
+                     (guard-k
+                      (lambda ()
+                        (apply values args))))))))))))
+
+    (define (succ n)
+      (+ n 1))
+
+    (define (pred n)
+      (if (= n 0)
+          0
+          (- n 1)))
+
+    (define (every? args)
+      (if (null? args)
+          #t
+          (if (car args)
+              (every? (cdr args))
+              #f)))
+
+    (define (filter f list)
+      (if (null? list)
+          '()
+          (if (f (car list))
+              (cons (car list)
+                    (filter f (cdr list)))
+              (filter f (cdr list)))))
+
+    (define (take-tail n list)
+      (let drop ((n (- (length list) n)) (list list))
+        (if (= n 0)
+            list
+            (drop (- n 1) (cdr list)))))
+
+    (define (drop-tail n list)
+      (let take ((n (- (length list) n)) (list list))
+        (if (= n 0)
+            '()
+            (cons (car list) (take (- n 1) (cdr list))))))
+
+    (define (map-keys f assoc)
+      (map (lambda (s) `(,(f (car s)) . ,(cdr s))) assoc))
+
+    (define (map-values f assoc)
+      (map (lambda (s) `(,(car s) . ,(f (cdr s)))) assoc))
+
+    ;; TODO
+    ;; - placeholder
+    ;; - vector
+    ;; - (... template) pattern
+
+    ;; p ::= constant
+    ;;     | var
+    ;;     | (p ... . p)      (in input pattern, tail p should be a proper list)
+    ;;     | (p . p)
+
+    (define (compile ellipsis literals rules)
+
+      (define (constant? obj)
+        (and (not (pair? obj))
+             (not (identifier? obj))))
+
+      (define (literal? obj)
+        (and (identifier? obj)
+             (memq obj literals)))
+
+      (define (many? pat)
+        (and (pair? pat)
+             (pair? (cdr pat))
+             (identifier? (cadr pat))
+             (identifier=? (cadr pat) ellipsis)))
+
+      (define (pattern-validator pat)      ; pattern -> validator
+        (letrec
+            ((pattern-validator
+              (lambda (pat form)
+                (cond
+                 ((constant? pat)
+                  #`(equal? '#,pat #,form))
+                 ((literal? pat)
+                  #`(and (identifier? #,form) (identifier=? #'#,pat #,form)))
+                 ((identifier? pat)
+                  #t)
+                 ((many? pat)
+                  (let ((head #`(drop-tail #,(length (cddr pat)) #,form))
+                        (tail #`(take-tail #,(length (cddr pat)) #,form)))
+                    #`(and (list? #,form)
+                           (>= (length #,form) #,(length (cddr pat)))
+                           (every? (map (lambda (#,'it) #,(pattern-validator (car pat) 'it)) #,head))
+                           #,(pattern-validator (cddr pat) tail))))
+                 ((pair? pat)
+                  #`(and (pair? #,form)
+                         #,(pattern-validator (car pat) #`(car #,form))
+                         #,(pattern-validator (cdr pat) #`(cdr #,form))))
+                 (else
+                  #f)))))
+          (pattern-validator pat 'it)))
+
+      (define (pattern-variables pat)       ; pattern -> (freevar)
+        (cond
+         ((constant? pat)
+          '())
+         ((literal? pat)
+          '())
+         ((identifier? pat)
+          `(,pat))
+         ((many? pat)
+          (append (pattern-variables (car pat))
+                  (pattern-variables (cddr pat))))
+         ((pair? pat)
+          (append (pattern-variables (car pat))
+                  (pattern-variables (cdr pat))))))
+
+      (define (pattern-levels pat)          ; pattern -> ((var * int))
+        (cond
+         ((constant? pat)
+          '())
+         ((literal? pat)
+          '())
+         ((identifier? pat)
+          `((,pat . 0)))
+         ((many? pat)
+          (append (map-values succ (pattern-levels (car pat)))
+                  (pattern-levels (cddr pat))))
+         ((pair? pat)
+          (append (pattern-levels (car pat))
+                  (pattern-levels (cdr pat))))))
+
+      (define (pattern-selectors pat)       ; pattern -> ((var * selector))
+        (letrec
+            ((pattern-selectors
+              (lambda (pat form)
+                (cond
+                 ((constant? pat)
+                  '())
+                 ((literal? pat)
+                  '())
+                 ((identifier? pat)
+                  `((,pat . ,form)))
+                 ((many? pat)
+                  (let ((head #`(drop-tail #,(length (cddr pat)) #,form))
+                        (tail #`(take-tail #,(length (cddr pat)) #,form)))
+                    (let ((envs (pattern-selectors (car pat) 'it)))
+                      (append
+                       (map-values (lambda (s) #`(map (lambda (#,'it) #,s) #,head)) envs)
+                       (pattern-selectors (cddr pat) tail)))))
+                 ((pair? pat)
+                  (append (pattern-selectors (car pat) #`(car #,form))
+                          (pattern-selectors (cdr pat) #`(cdr #,form))))))))
+          (pattern-selectors pat 'it)))
+
+      (define (template-representation pat levels selectors)
+        (cond
+         ((constant? pat)
+          pat)
+         ((identifier? pat)
+          (let ((it (assq pat levels)))
+            (if it
+                (if (= 0 (cdr it))
+                    (cdr (assq pat selectors))
+                    (error "unmatched pattern variable level" pat))
+                #`(#,'rename '#,pat))))
+         ((many? pat)
+          (letrec*
+              ((inner-pat
+                (car pat))
+               (inner-levels
+                (map (lambda (s) `(,(car s) . ,(pred (cdr s)))) levels))
+               (inner-freevars
+                (filter (lambda (v) (assq v levels)) (pattern-variables inner-pat)))
+               (inner-vars
+                ;; select only vars declared with ellipsis
+                (filter (lambda (v) (> (cdr (assq v levels)) 0)) inner-freevars))
+               (inner-tmps
+                (map (lambda (v) #'it) inner-vars))
+               (inner-selectors
+                ;; first env '(map cons ...)' shadows second env 'selectors'
+                (append (map cons inner-vars inner-tmps) selectors))
+               (inner-rep
+                (template-representation inner-pat inner-levels inner-selectors))
+               (sorted-selectors
+                (map (lambda (v) (assq v selectors)) inner-vars))
+               (list-of-selectors
+                ;; ((a . xs) (b . ys) (c . zs)) -> (xs ys zs)
+                (map cdr sorted-selectors)))
+            (let ((rep1 #`(map (lambda #,inner-tmps #,inner-rep) #,@list-of-selectors))
+                  (rep2 (template-representation (cddr pat) levels selectors)))
+              #`(append #,rep1 #,rep2))))
+         ((pair? pat)
+          #`(cons #,(template-representation (car pat) levels selectors)
+                  #,(template-representation (cdr pat) levels selectors)))))
+
+      (define (compile-rule pattern template)
+        (let ((levels
+               (pattern-levels pattern))
+              (selectors
+               (pattern-selectors pattern)))
+          (template-representation template levels selectors)))
+
+      (define (compile-rules rules)
+        (if (null? rules)
+            #`(error "unmatch")
+            (let ((pattern (car (car rules)))
+                  (template (cadr (car rules))))
+              #`(if #,(pattern-validator pattern)
+                    #,(compile-rule pattern template)
+                    #,(compile-rules (cdr rules))))))
+
+      (define (compile rules)
+        #`(call-with-current-environment
+           (lambda (env)
+             (letrec
+                 ((#,'rename (let ((wm (make-attribute)))
+                               (lambda (x)
+                                 (or (wm x)
+                                     (let ((id (make-identifier x env)))
+                                       (wm x id)
+                                       id))))))
+               (lambda #,'it
+                 #,(compile-rules rules))))))
+
+      (let ((rules (map-keys cdr rules))) ; TODO: check pattern head is a variable
+        (compile rules)))
+
+    (define-syntax (syntax-rules . args)
+      (if (list? (car args))
+          #`(syntax-rules ... #,@args)
+          (let ((ellipsis (car args))
+                (literals (car (cdr args)))
+                (rules    (cdr (cdr args))))
+            (compile ellipsis literals rules))))
+
+    (define-syntax (define-auxiliary-syntax var)
+      #`(define-macro #,var
+          (lambda _
+            (error "invalid use of auxiliary syntax" '#,var))))
+
+    (define-auxiliary-syntax _)
+    (define-auxiliary-syntax ...)
+
+    (define-macro syntax-error
+      (lambda (form _)
+        (apply error (cdr form))))
+
+    (define complex? number?)
+    (define real? number?)
+    (define rational? number?)
+    (define (integer? o)
+      (or (exact? o)
+          (and (inexact? o)
+               (not (nan? o))
+               (not (infinite? o))
+               (= o (floor o)))))
+
+    (define (exact-integer? x)
+      (and (exact? x)
+           (integer? x)))
+
+    (define (zero? x)
+      (= x 0))
+
+    (define (positive? x)
+      (> x 0))
+
+    (define (negative? x)
+      (< x 0))
+
+    (define (even? x)
+      (= x (* (exact (floor (/ x 2))) 2)))
+
+    (define (odd? x)
+      (not (even? x)))
+
+    (define (min . args)
+      (define (min a b)
+        (if (< a b) a b))
+      (let loop ((args args) (acc +inf.0) (exactp #t))
+        (if (null? args)
+            (if exactp acc (inexact acc))
+            (loop (cdr args) (min (car args) acc) (and (exact? (car args)) exactp)))))
+
+    (define (max . args)
+      (define (max a b)
+        (if (> a b) a b))
+      (let loop ((args args) (acc -inf.0) (exactp #t))
+        (if (null? args)
+            (if exactp acc (inexact acc))
+            (loop (cdr args) (max (car args) acc) (and (exact? (car args)) exactp)))))
+
+    (define (floor-quotient i j)
+      (call-with-values (lambda () (floor/ i j))
+        (lambda (q r)
+          q)))
+
+    (define (floor-remainder i j)
+      (call-with-values (lambda () (floor/ i j))
+        (lambda (q r)
+          r)))
+
+    (define (truncate-quotient i j)
+      (call-with-values (lambda () (truncate/ i j))
+        (lambda (q r)
+          q)))
+
+    (define (truncate-remainder i j)
+      (call-with-values (lambda () (truncate/ i j))
+        (lambda (q r)
+          r)))
+
+    (define (gcd . args)
+      (define (gcd i j)
+        (cond
+         ((> i j) (gcd j i))
+         ((< i 0) (gcd (- i) j))
+         ((> i 0) (gcd (truncate-remainder j i) i))
+         (else j)))
+      (let loop ((args args) (acc 0))
+        (if (null? args)
+            acc
+            (loop (cdr args)
+                  (gcd acc (car args))))))
+
+    (define (lcm . args)
+      (define (lcm i j)
+        (/ (abs (* i j)) (gcd i j)))
+      (let loop ((args args) (acc 1))
+        (if (null? args)
+            acc
+            (loop (cdr args)
+                  (lcm acc (car args))))))
+
+    (define (square x)
+      (* x x))
+
+    (define (exact-integer-sqrt k)
+      (let ((s (exact (floor (sqrt k)))))
+        (values s (- k (square s)))))
+
+    (define (utf8->string v . opts)
+      (let ((start (if (pair? opts) (car opts) 0))
+            (end (if (>= (length opts) 2)
+                     (cadr opts)
+                     (bytevector-length v))))
+        (list->string (map integer->char (bytevector->list v start end)))))
+
+    (define (string->utf8 s . opts)
+      (let ((start (if (pair? opts) (car opts) 0))
+            (end (if (>= (length opts) 2)
+                     (cadr opts)
+                     (string-length s))))
+        (list->bytevector (map char->integer (string->list s start end)))))
+
+    (define checkpoints '((0 #f . #f)))
+
+    (define (dynamic-wind in thunk out)
+      (in)
+      (set! checkpoints `((,(+ 1 (caar checkpoints)) ,in . ,out) . ,checkpoints))
+      (let ((ans (thunk)))
+        (set! checkpoints (cdr checkpoints))
+        (out)
+        ans))
+
+    (define (do-wind here there)
+      (unless (eq? here there)
+        (if (< (caar here) (caar there))
+            (begin
+              (do-wind here (cdr there))
+              ((cadr (car there))))
+            (begin
+              ((cddr (car here)))
+              (do-wind (cdr here) there)))))
+
+    (define scheme:call/cc
+      (let ((c call/cc))
+        (lambda (f)
+          (c (lambda (k)
+               (f (let ((save checkpoints))
+                    (lambda args
+                      (do-wind checkpoints save)
+                      (set! checkpoints save)
+                      (apply k args)))))))))
+
+    ;; call/cc and scheme:call/cc cannot coincide, so overwrite them
+    (set! call/cc scheme:call/cc)
+    (set! call-with-current-continuation scheme:call/cc)
+
+    (define (read-error? obj)
+      (and (error-object? obj)
+           (eq? (error-object-type obj) 'read)))
+
+    (define (file-error? obj)
+      (and (error-object? obj)
+           (eq? (error-object-type obj) 'file)))
+
+    (define (input-port-open? port)
+      (and (input-port? port) (port-open? port)))
+
+    (define (output-port-open? port)
+      (and (output-port? port) (port-open? port)))
+
+    (define (call-with-port port handler)
+      (let ((res (handler port)))
+        (close-port port)
+        res))
+
+    (define (u8-ready? . opt)
+      #t)
+
+    (define (char-ready? . opt)
+      #t)))
diff --git a/lib/ext/port.c b/lib/ext/port.c
index 544e24d2..6b22b1e7 100644
--- a/lib/ext/port.c
+++ b/lib/ext/port.c
@@ -655,6 +655,45 @@ pic_port_get_output_bytevector(pic_state *pic)
   return pic_blob_value(pic, (unsigned char *)buf, len);
 }
 
+static pic_value
+pic_port_open_input_string(pic_state *pic)
+{
+  pic_value str;
+  const char *buf;
+  int len;
+
+  pic_get_args(pic, "s", &str);
+
+  buf = pic_str(pic, str, &len);
+
+  return pic_fmemopen(pic, buf, len, "r");
+}
+
+static pic_value
+pic_port_open_output_string(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_fmemopen(pic, NULL, 0, "w");
+}
+
+static pic_value
+pic_port_get_output_string(pic_state *pic)
+{
+  pic_value port = pic_stdout(pic);
+  const char *buf;
+  int len;
+
+  pic_get_args(pic, "|o", &port);
+
+  check_port_type(pic, port, FILE_WRITE);
+
+  if (pic_fgetbuf(pic, port, &buf, &len) < 0) {
+    pic_error(pic, "port was not created by open-output-string", 0);
+  }
+  return pic_str_value(pic, buf, len);
+}
+
 static pic_value
 pic_port_read_u8(pic_state *pic)
 {
@@ -689,6 +728,40 @@ pic_port_peek_u8(pic_state *pic)
   return pic_int_value(pic, c);
 }
 
+static pic_value
+pic_port_read_char(pic_state *pic)
+{
+  pic_value port = pic_stdin(pic);
+  int c;
+
+  pic_get_args(pic, "|o", &port);
+
+  check_port_type(pic, port, FILE_READ);
+
+  if ((c = pic_fgetc(pic, port)) == EOF) {
+    return pic_eof_object(pic);
+  }
+  return pic_char_value(pic, c);
+}
+
+static pic_value
+pic_port_peek_char(pic_state *pic)
+{
+  int c;
+  pic_value port = pic_stdin(pic);
+
+  pic_get_args(pic, "|o", &port);
+
+  check_port_type(pic, port, FILE_READ);
+
+  c = pic_fgetc(pic, port);
+  if (c == EOF) {
+    return pic_eof_object(pic);
+  }
+  pic_ungetc(pic, c, port);
+  return pic_char_value(pic, c);
+}
+
 static pic_value
 pic_port_read_bytevector_ip(pic_state *pic)
 {
@@ -718,6 +791,78 @@ pic_port_read_bytevector_ip(pic_state *pic)
   return pic_int_value(pic, i);
 }
 
+static pic_value
+pic_port_read_bytevector(pic_state *pic)
+{
+  pic_value port = pic_stdin(pic), blob;
+  int n, k, i;
+  unsigned char *buf;
+
+  n = pic_get_args(pic, "i|o", &k, &port);
+
+  check_port_type(pic, port, FILE_READ);
+
+  buf = pic_malloc(pic, k);
+
+  i = pic_fread(pic, buf, 1, k, port);
+  if (i == 0) {
+    pic_free(pic, buf);
+    return pic_eof_object(pic);
+  }
+  blob = pic_blob_value(pic, buf, i);
+  pic_free(pic, buf);
+  return blob;
+}
+
+static pic_value
+pic_port_read_string(pic_state *pic)
+{
+  pic_value port = pic_stdin(pic), blob;
+  int n, k, i;
+  char *buf;
+
+  n = pic_get_args(pic, "i|o", &k, &port);
+
+  check_port_type(pic, port, FILE_READ);
+
+  buf = pic_malloc(pic, k);
+
+  i = pic_fread(pic, buf, 1, k, port);
+  if (i == 0) {
+    pic_free(pic, buf);
+    return pic_eof_object(pic);
+  }
+  blob = pic_str_value(pic, buf, i);
+  pic_free(pic, buf);
+  return blob;
+}
+
+static pic_value
+pic_port_read_line(pic_state *pic)
+{
+  pic_value port = pic_stdin(pic), str;
+  int c;
+  char s[1];
+
+  pic_get_args(pic, "|o", &port);
+
+  check_port_type(pic, port, FILE_READ);
+
+  if ((c = pic_fgetc(pic, port)) == EOF) {
+    return pic_eof_object(pic);
+  }
+  s[0] = c;
+  str = pic_str_value(pic, s, 1);
+
+  while ((c = pic_fgetc(pic, port)) != EOF) {
+    if (c == '\n')
+      break;
+    s[0] = c;
+    str = pic_str_cat(pic, str, pic_str_value(pic, s, 1));
+  }
+  return str;
+}
+
 static pic_value
 pic_port_write_u8(pic_state *pic)
 {
@@ -732,6 +877,33 @@ pic_port_write_u8(pic_state *pic)
   return pic_undef_value(pic);
 }
 
+static pic_value
+pic_port_write_char(pic_state *pic)
+{
+  char c;
+  pic_value port = pic_stdout(pic);
+
+  pic_get_args(pic, "c|o", &c, &port);
+
+  check_port_type(pic, port, FILE_WRITE);
+
+  pic_fputc(pic, c, port);
+  return pic_undef_value(pic);
+}
+
+static pic_value
+pic_port_newline(pic_state *pic)
+{
+  pic_value port = pic_stdout(pic);
+
+  pic_get_args(pic, "|o", &port);
+
+  check_port_type(pic, port, FILE_WRITE);
+
+  pic_fputc(pic, '\n', port);
+  return pic_undef_value(pic);
+}
+
 static pic_value
 pic_port_write_bytevector(pic_state *pic)
 {
@@ -762,6 +934,38 @@ pic_port_write_bytevector(pic_state *pic)
   return pic_undef_value(pic);
 }
 
+static pic_value
+pic_port_write_string(pic_state *pic)
+{
+  pic_value str, port;
+  int n, start, end, len, done;
+  const char *buf;
+
+  n = pic_get_args(pic, "s|oii", &str, &port, &start, &end);
+
+  buf = pic_str(pic, str, &len);
+
+  switch (n) {
+  case 1:
+    port = pic_stdout(pic);
+  case 2:
+    start = 0;
+  case 3:
+    end = len;
+  }
+
+  VALID_RANGE(pic, len, start, end);
+
+  check_port_type(pic, port, FILE_WRITE);
+
+  done = 0;
+  while (done < end - start) {
+    done += pic_fwrite(pic, buf + start + done, 1, end - start - done, port);
+    /* FIXME: error check... */
+  }
+  return pic_undef_value(pic);
+}
+
 static pic_value
 pic_port_flush(pic_state *pic)
 {
@@ -796,17 +1000,28 @@ pic_init_port(pic_state *pic)
   /* input */
   pic_defun(pic, "read-u8", pic_port_read_u8);
   pic_defun(pic, "peek-u8", pic_port_peek_u8);
+  pic_defun(pic, "read-char", pic_port_read_char);
+  pic_defun(pic, "peek-char", pic_port_peek_char);
   pic_defun(pic, "read-bytevector!", pic_port_read_bytevector_ip);
+  pic_defun(pic, "read-bytevector", pic_port_read_bytevector);
+  pic_defun(pic, "read-string", pic_port_read_string);
+  pic_defun(pic, "read-line", pic_port_read_line);
 
   /* output */
   pic_defun(pic, "write-u8", pic_port_write_u8);
+  pic_defun(pic, "write-char", pic_port_write_char);
+  pic_defun(pic, "newline", pic_port_newline);
   pic_defun(pic, "write-bytevector", pic_port_write_bytevector);
+  pic_defun(pic, "write-string", pic_port_write_string);
   pic_defun(pic, "flush-output-port", pic_port_flush);
 
   /* string I/O */
   pic_defun(pic, "open-input-bytevector", pic_port_open_input_bytevector);
   pic_defun(pic, "open-output-bytevector", pic_port_open_output_bytevector);
   pic_defun(pic, "get-output-bytevector", pic_port_get_output_bytevector);
+  pic_defun(pic, "open-input-string", pic_port_open_input_string);
+  pic_defun(pic, "open-output-string", pic_port_open_output_string);
+  pic_defun(pic, "get-output-string", pic_port_get_output_string);
 }
 
 #endif