[library dependency reorganization
atsmyles@earthlink.net**20081230030240
 
 Part I
 
 Re-organized dependences. They are now
 
 core (r5r) (core *)
 gambit (gambit *)
 r6s (rnrs *)
 srfi (srfi *)
 
 Each set of libraries can depend on the upper set being available.
 
] hunk ./compile 22
-(define standard-libraries-base (cons "libs/gambit/records.scm" (path-expand* "libs/rnrs/" "core.scm" "exceptions.scm" "conditions.scm" "base.scm")))
+(define core-libraries (path-expand* "libs/" "core.scm" "r5rs.scm"))
hunk ./compile 25
-   (path-expand* "libs/gambit/" "io.readtable.scm" "io.scm" "threads.scm" "time.scm" "will.scm" "exceptions.scm" "files.scm" "programs.scm" "extensions.scm" "bytevectors.scm" "debug.scm"))
+   (path-expand* "libs/gambit/" "records.scm" "io.readtable.scm" "io.scm" "threads.scm" "time.scm" "hashing.scm" "will.scm" "table.scm" "exceptions.scm" "files.scm" "programs.scm" "extensions.scm" "bytevectors.scm" "debug.scm"))
hunk ./compile 32
-  (path-expand* "libs/rnrs/" "records.scm" "syntax-case.scm" "control.scm" "lists.scm" "enumerations.scm" "arithmetic.scm" "bytevectors.scm" "io.scm" "unicode.scm" "files.scm" "sorting.scm" "programs.scm" "rnrs.scm" "mutable.scm" "eval.scm" "r5rs.scm" "load.scm"))
+  (path-expand* "libs/rnrs/" "exceptions.scm" "conditions.scm" "base.scm" "records.scm" "syntax-case.scm" "hashtables.scm" "control.scm" "lists.scm" "enumerations.scm" "arithmetic.scm" "bytevectors.scm" "io.scm" "unicode.scm" "files.scm" "sorting.scm" "programs.scm" "rnrs.scm" "mutable.scm" "eval.scm" "r5rs.scm" "load.scm"))
hunk ./compile 34
-(define misc-libraries (path-expand* "libs/" "r5rs.scm" "ieee.scm" "renaming.scm"))
+(define misc-libraries (path-expand* "libs/" "ieee.scm" "renaming.scm"))
hunk ./compile 72
-      (base-file (path-expand "base.scm" tmp-dir))
+      (core-file (path-expand "core.exp" tmp-dir))
hunk ./compile 77
-  (display* "expanding base")
-  (apply ex:expand-file* base-file standard-libraries-base) 
+  (display* "expanding core libraries")
+  (apply ex:expand-file* core-file core-libraries)
+
+(display* "compiling libraries")
+   (for-each (lambda (filename)
+      (display* "compiling " filename)
+      (ex:compile-file filename options: '(debug)))
+     (append gambit-libraries standard-libraries srfi-libraries misc-libraries))
+
+
+
hunk ./compile 89
-  (ex:expand-r5rs-file "expander.scm" expander-file (ex:environment '(rnrs base)))
+  ;TODO expand expander.scm with r5rs library instead of rnrs base
+  (ex:expand-r5rs-file "expander.scm" expander-file (ex:environment '(except (r5rs) eval)))
hunk ./compile 92
-  (display* "cat all these files together")
hunk ./compile 99
-   base-file 
-   expander-file 
+    core-file 
+    expander-file
hunk ./compile 103
-;  (shell-command (string-append "cat " 
-;				(path-expand "err5rs-records-inspection.scm") " "
-;  				(path-expand "err5rs-records-procedural.scm") " "
-;				(path-expand "error.scm") " "
-;				(path-expand "compat-gambit.scm") " "
-;				(path-expand "runtime.scm") " "
-;				base-file " "
-;				expander-file " "
-;				(path-expand "primitives.scm") " "
-;				"> " result-file))
-;
-;  (display* "compiling core")
-;  (compile-file result-file options: '(debug) output: (path-expand (string-append core-library-name ".o1") result-path))
-   (for-each (lambda (filename)
-      (display* "compiling " filename)
-      (ex:compile-file filename options: '(debug)))
-     (append gambit-libraries standard-libraries srfi-libraries misc-libraries))
-
-
hunk ./libs/r5rs.scm 51
-   load
+   ;load
hunk ./libs/r5rs.scm 93
-  (import (only (core primitives) set!)
-          (except (rnrs base)
-            set! ; because should not be exported for expand
-            _ letrec* let-values let*-values identifier-syntax
-            real-valued? rational-valued? integer-valued? exact inexact finite? infinite?
-            nan? div mod div-and-mod div0 mod0 div0-and-mod0 exact-integer-sqrt boolean=?
-            symbol=? string-for-each vector-map vector-for-each error assertion-violation
-            call/cc)
-          (only (rnrs eval) eval)
-          (only (rnrs load) load)
-          (only (rnrs control) do)
-	  (only (rnrs io ports) input-port? output-port?)
-          (only (rnrs io simple)
+  (import (for (except (core primitives) _ ...) expand run)
+          (core let)
+	  (core derived)
+	  (core quasiquote)
+	  (for (core with-syntax) expand)
+	  (for (core syntax-rules)	expand)
+          (for (only (core primitives) _ ... set!) expand)
+	  (for (primitives map) expand run)
+	  (primitives 
+           
+           ;; R5RS primitives:
+           
+           * + - / < <= = > >= abs acos append apply asin atan angle 
+           boolean? call-with-current-continuation 
+           call-with-values car cdr caar cadr cdar cddr
+           caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar
+           cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+           ceiling char? char->integer char=? char<? char>? char<=? char>=?
+           complex? cons cos 
+           denominator dynamic-wind 
+           eq? equal? eqv? even? exact? exp expt floor for-each
+           gcd imag-part inexact? integer->char integer?
+           lcm length list list->string
+           list->vector list-ref list-tail list? log magnitude make-polar
+           make-rectangular make-string make-vector 
+	   max min negative? not null? number->string number? numerator
+           odd? pair? 
+           positive? procedure? rational? rationalize
+           real-part real? reverse round
+           sin sqrt string string->list string->number string->symbol
+           string-append 
+           string-copy string-length string-ref string<=? string<?
+           string=? string>=? string>? string? substring symbol->string symbol? tan
+           truncate values vector vector->list
+           vector-fill! vector-length vector-ref vector-set! vector? zero?
+
+	   ;error messages (used internally only)
+	   assertion-violation	   
+	   ;io
+	    input-port? output-port?
hunk ./libs/r5rs.scm 136
-            read read-char with-input-from-file with-output-to-file write write-char)
-          (only (rnrs unicode)
+            read read-char with-input-from-file with-output-to-file write write-char
+	;characters
hunk ./libs/r5rs.scm 141
-            string-ci<=? string-ci>=?)
-          (only (rnrs mutable-pairs) set-car! set-cdr!)
-          (only (rnrs lists) assoc assv assq member memv memq)
-          (only (rnrs mutable-strings) string-set! string-fill!)
-          (rnrs r5rs))
-  )
+            string-ci<=? string-ci>=?
+        ;mutable pairs
+          set-car! set-cdr!
+	;other lists
+          assoc assv assq member memv memq
+          string-set! string-fill!
+          
+	;misc
+         exact->inexact inexact->exact quotient remainder modulo
+
+  ))
+
+(define (scheme-report-environment n)
+    (if (= n 5) (environment '(r5rs))
+      (assertion-violation 'scheme-report-environment "Argument should be 5" n))
+    )
+
+ (define null-environment
+    (let ((null-env #f))
+      (lambda (n)
+	(if null-env #f (set! null-env (environment '(only (r5rs)
+                           begin if lambda quote set! and or
+                           define define-syntax let-syntax letrec-syntax 
+                           let let* letrec
+                           case cond else =>
+                           quasiquote unquote unquote-splicing
+                           syntax-rules ... do)
+                        )))
+        (if (= n 5) null-env
+          (assertion-violation 'null-environment "Argument should be 5" n))
+        )))
+  
+(define force
+    (lambda (object)
+      (object)))
+  
+(define-syntax delay
+    (syntax-rules ()
+      ((delay expression)
+       (make-promise (lambda () expression)))))
hunk ./libs/r5rs.scm 182
+ (define make-promise
+    (lambda (proc)
+      (let ((result-ready? #f)
+            (result #f))
+        (lambda ()
+          (if result-ready?
+              result
+              (let ((x (proc)))
+                (if result-ready?
+                    result
+                    (begin (set! result-ready? #t)
+                           (set! result x)
+                           result))))))))
+  (define-syntax do
+    (lambda (orig-x)
+      (syntax-case orig-x ()
+        ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+         (with-syntax (((step ...)
+                        (map (lambda (v s)
+                               (syntax-case s ()
+                                 (()  v)
+                                 ((e) (syntax e))
+                                 (_   (syntax-violation 'do "Invalid step" orig-x s))))
+                             (syntax (var ...))
+                             (syntax (step ...)))))
+           (syntax-case (syntax (e1 ...)) ()
+             (()          (syntax (let do ((var init) ...)
+                                    (if (not e0)
+                                        (begin c ... (do step ...))))))
+             ((e1 e2 ...) (syntax (let do ((var init) ...)
+                                    (if e0
+                                        (begin e1 e2 ...)
+                                        (begin c ... (do step ...))))))))))))                     
+)
hunk ./libs/rnrs/control.scm 4
-	  (for (rnrs syntax-case) expand run))
-	  ;(for (core primitives)   expand run)
-          ;(for (core let)          expand run)
-          ;(for (core with-syntax)  expand)
-          ;(for (core syntax-rules) expand)
-          ;(for (primitives not map length assertion-violation = >= apply)
-          ;  expand run) )
+	  (for (rnrs syntax-case) expand run)
+	  (only (r5rs) do))
hunk ./libs/rnrs/control.scm 19
-  (define-syntax do
-    (lambda (orig-x)
-      (syntax-case orig-x ()
-        ((_ ((var init . step) ...) (e0 e1 ...) c ...)
-         (with-syntax (((step ...)
-                        (map (lambda (v s)
-                               (syntax-case s ()
-                                 (()  v)
-                                 ((e) (syntax e))
-                                 (_   (syntax-violation 'do "Invalid step" orig-x s))))
-                             (syntax (var ...))
-                             (syntax (step ...)))))
-           (syntax-case (syntax (e1 ...)) ()
-             (()          (syntax (let do ((var init) ...)
-                                    (if (not e0)
-                                        (begin c ... (do step ...))))))
-             ((e1 e2 ...) (syntax (let do ((var init) ...)
-                                    (if e0
-                                        (begin e1 e2 ...)
-                                        (begin c ... (do step ...))))))))))))                         
+;  (define-syntax do
+;    (lambda (orig-x)
+;      (syntax-case orig-x ()
+;        ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+;         (with-syntax (((step ...)
+;                        (map (lambda (v s)
+;                               (syntax-case s ()
+;                                 (()  v)
+;                                 ((e) (syntax e))
+;                                 (_   (syntax-violation 'do "Invalid step" orig-x s))))
+;                             (syntax (var ...))
+;                             (syntax (step ...)))))
+;           (syntax-case (syntax (e1 ...)) ()
+;             (()          (syntax (let do ((var init) ...)
+;                                    (if (not e0)
+;                                        (begin c ... (do step ...))))))
+;             ((e1 e2 ...) (syntax (let do ((var init) ...)
+;                                    (if e0
+;                                        (begin e1 e2 ...)
+;                                        (begin c ... (do step ...))))))))))))                         
hunk ./libs/rnrs/core.scm 1
-;;;=====================================================================
-;;;
-;;; Derived forms:
-;;;
-;;;   Copyright (c) 2006 Andre van Tonder
-;;;
-;;;   Copyright statement at http://srfi.schemers.org/srfi-process.html
-;;;
-;;;=====================================================================  
-
-;;;=====================================================================
-;;;
-;;; This file builds r6rs up using a sequence of libraries.
-;;; It constitutes a nontrivial example, tutorial and test
-;;; of the library system.  
-;;;
-;;; It is meant to be expanded by expander.scm and compiled 
-;;; together with the latter before using in a production system.
-;;;
-;;; Various of the standard macros were copied from
-;;; SRFI-93 reference implementation.
-;;;
-;;; An explicit renaming library is included for easier 
-;;; porting of legacy macros in some implementations.
-;;;
-;;;=====================================================================
-
-(library (core primitives)
-  
-  (export
-   
-   ;; Macros defined in core expander:
-   
-   begin if lambda quote set! and or
-   define define-syntax let-syntax letrec-syntax
-   _ ... syntax syntax-case
-      
-   ;; Procedures and values defined in core expander:
-   
-   (rename (ex:make-variable-transformer make-variable-transformer)
-           (ex:identifier?               identifier?)
-           (ex:bound-identifier=?        bound-identifier=?)
-           (ex:free-identifier=?         free-identifier=?)
-           (ex:generate-temporaries      generate-temporaries) 
-           (ex:datum->syntax             datum->syntax)
-           (ex:syntax->datum             syntax->datum)
-           (ex:syntax-violation          syntax-violation)
-           (ex:environment               environment)
-           (ex:environment-bindings      environment-bindings)
-           (ex:eval                      eval)
-           (ex:undefined                 undefined)))
-  
-  (import
-   
-   (only (core primitive-macros)
-     
-     begin if set! and or lambda quote
-     define define-syntax let-syntax letrec-syntax 
-     syntax syntax-case _ ...)
-   
-   ;; An extension to the r6rs import syntax, used here to make  
-   ;; available variable bindings provided natively.
-   ;; This will not work for macros, which have to be defined
-   ;; within the context of this expander.  
-   
-   (primitives
-   
-    ;; Procedures and values defined in the core expander:
-    
-    ex:make-variable-transformer ex:identifier? ex:bound-identifier=?
-    ex:free-identifier=? ex:generate-temporaries ex:datum->syntax ex:syntax->datum 
-    ex:syntax-violation ex:environment ex:environment-bindings ex:eval
-    ex:undefined
-    ))
-  
-  ) ;; core primitives
-
-(library (core with-syntax)
-  (export with-syntax)
-  (import (for (core primitives) run expand)
-          (primitives list)) 
-  
-  (define-syntax with-syntax
-    (lambda (x)
-      (syntax-case x ()
-        ((_ () e1 e2 ...)             (syntax (begin e1 e2 ...)))
-        ((_ ((out in)) e1 e2 ...)     (syntax (syntax-case in ()
-                                                (out (begin e1 e2 ...)))))
-        ((_ ((out in) ...) e1 e2 ...) (syntax (syntax-case (list in ...) ()
-                                                ((out ...) (begin e1 e2 ...))))))))
-  )
-
-(library (core syntax-rules)
-  (export syntax-rules)
-  (import (for (core primitives)        expand run)
-          (for (core with-syntax)       expand)
-          (for (primitives for-all map) expand))
-  
-  (define-syntax syntax-rules
-    (lambda (x)
-      (define clause
-        (lambda (y)
-          (syntax-case y ()
-            (((keyword . pattern) template)
-             (syntax ((dummy . pattern) (syntax template))))
-            (_
-             (syntax-violation 'syntax-rules "Invalid expression" x)))))
-      (syntax-case x ()
-        ((_ (k ...) cl ...)
-         (for-all identifier? (syntax (k ...)))
-         (with-syntax (((cl ...) (map clause (syntax (cl ...)))))
-           (syntax
-            (lambda (x) (syntax-case x (k ...) cl ...))))))))
-  )
-
-(library (core let)
-  (export let letrec letrec*)
-  (import (for (core primitives)        expand run)
-          (for (core with-syntax)       expand)
-          (for (primitives for-all)     expand))
-  
-  (define-syntax let
-    (lambda (x)
-      (syntax-case x ()
-        ((_ ((x v) ...) e1 e2 ...)
-         (for-all identifier? (syntax (x ...)))
-         (syntax ((lambda (x ...) e1 e2 ...) v ...)))
-        ((_ f ((x v) ...) e1 e2 ...)
-         (for-all identifier? (syntax (f x ...)))
-         (syntax ((letrec ((f (lambda (x ...) e1 e2 ...))) f) v ...))))))
-  
-  (define-syntax letrec
-    (lambda (x)
-      (syntax-case x ()
-        ((_ ((i v) ...) e1 e2 ...)
-         (with-syntax (((t ...) (generate-temporaries (syntax (i ...)))))
-           (syntax (let ((i undefined) ...)
-                     (let ((t v) ...)
-                       (set! i t) ...
-                       (let () e1 e2 ...)))))))))
-  
-  (define-syntax letrec*
-    (lambda (x)
-      (syntax-case x ()
-        ((_ ((i v) ...) e1 e2 ...)
-         (syntax (let ()
-                   (define i v) ...
-                   (let () e1 e2 ...)))))))
-  
-  ) ; let
-
-(library (core derived)
-  (export let* cond case else =>)   
-  (import (for (core primitives)       expand run)
-          (for (core let)              expand run)
-          (for (core with-syntax)      expand)
-          (for (core syntax-rules)     expand)
-          (for (primitives for-all null? memv car cdr) expand run))
-  
-  (define-syntax let*
-    (lambda (x)
-      (syntax-case x ()
-        ((_ () e1 e2 ...)
-         (syntax (let () e1 e2 ...)))
-        ((_ ((x v) ...) e1 e2 ...)
-         (for-all identifier? (syntax (x ...)))
-         (let f ((bindings (syntax ((x v) ...))))
-           (syntax-case bindings ()
-             (((x v))        (syntax (let ((x v)) e1 e2 ...)))
-             (((x v) . rest) (with-syntax ((body (f (syntax rest))))
-                               (syntax (let ((x v)) body))))))))))
-  
-  (define-syntax cond
-    (lambda (x)
-      (syntax-case x ()
-        ((_ c1 c2 ...)
-         (let f ((c1  (syntax c1))
-                 (c2* (syntax (c2 ...))))
-           (syntax-case c2* ()
-             (()
-              (syntax-case c1 (else =>)
-                ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
-                ((e0)             (syntax (let ((t e0)) (if t t))))
-                ((e0 => e1)       (syntax (let ((t e0)) (if t (e1 t)))))
-                ((e0 e1 e2 ...)   (syntax (if e0 (begin e1 e2 ...))))
-                (_                (syntax-violation 'cond "Invalid expression" x))))
-             ((c2 c3 ...)
-              (with-syntax ((rest (f (syntax c2)
-                                     (syntax (c3 ...)))))
-                (syntax-case c1 (else =>)
-                  ((e0)           (syntax (let ((t e0)) (if t t rest))))
-                  ((e0 => e1)     (syntax (let ((t e0)) (if t (e1 t) rest))))
-                  ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...) rest)))
-                  (_              (syntax-violation 'cond "Invalid expression" x)))))))))))
-  
-  (define-syntax case
-    (lambda (x)
-      (syntax-case x ()
-        ((_ e c1 c2 ...)
-         (with-syntax ((body
-                        (let f ((c1 (syntax c1))
-                                (cmore (syntax (c2 ...))))
-                          (if (null? cmore)
-                              (syntax-case c1 (else)
-                                ((else e1 e2 ...)    (syntax (begin e1 e2 ...)))
-                                (((k ...) e1 e2 ...) (syntax (if (memv t '(k ...))
-                                                                 (begin e1 e2 ...)))))
-                              (with-syntax ((rest (f (car cmore) (cdr cmore))))
-                                (syntax-case c1 ()
-                                  (((k ...) e1 e2 ...)
-                                   (syntax (if (memv t '(k ...))
-                                               (begin e1 e2 ...)
-                                               rest)))))))))
-           (syntax (let ((t e)) body)))))))
-  
-  (define-syntax =>
-    (lambda (x)
-      (syntax-violation '=> "Invalid expression" x)))
-  
-  (define-syntax else
-    (lambda (x)
-      (syntax-violation 'else "Invalid expression" x)))
-  
-  ) ; derived
-
-(library (core identifier-syntax)
-  (export identifier-syntax)
-  (import (for (core primitives) 
-            expand 
-            run
-            ;; since generated macro contains (syntax set!) at level 0
-            (meta -1))) 
-  
-  (define-syntax identifier-syntax
-    (lambda (x)
-      (syntax-case x (set!)
-        ((_ e)
-         (syntax (lambda (x)
-                   (syntax-case x ()
-                     (id (identifier? (syntax id)) (syntax e))
-                     ((_ x (... ...))              (syntax (e x (... ...))))))))
-        ((_ (id exp1) 
-            ((set! var val) exp2))
-         (and (identifier? (syntax id)) 
-              (identifier? (syntax var)))
-         (syntax 
-          (make-variable-transformer
-           (lambda (x)
-             (syntax-case x (set!)
-               ((set! var val)               (syntax exp2))
-               ((id x (... ...))             (syntax (exp1 x (... ...))))
-               (id (identifier? (syntax id)) (syntax exp1))))))))))
-  )
-
-;;;=========================================================
-;;;
-;;; Quasisyntax in terms of syntax-case.
-;;;
-;;;=========================================================
-;;;
-;;; To make nested unquote-splicing behave in a useful way,
-;;; the R5RS-compatible extension of quasiquote in appendix B
-;;; of the following paper is here ported to quasisyntax:
-;;;
-;;; Alan Bawden - Quasiquotation in Lisp
-;;; http://citeseer.ist.psu.edu/bawden99quasiquotation.html
-;;;
-;;; The algorithm converts a quasisyntax expression to an
-;;; equivalent with-syntax expression.
-;;; For example:
-;;;
-;;; (quasisyntax (set! #,a #,b))
-;;;   ==> (with-syntax ((t0 a)
-;;;                     (t1 b))
-;;;         (syntax (set! t0 t1)))
-;;;
-;;; (quasisyntax (list #,@args))
-;;;   ==> (with-syntax (((t ...) args))
-;;;         (syntax (list t ...)))
-;;;
-;;; Note that quasisyntax is expanded first, before any
-;;; ellipses act.  For example:
-;;;
-;;; (quasisyntax (f ((b #,a) ...))
-;;;   ==> (with-syntax ((t a))
-;;;         (syntax (f ((b t) ...))))
-;;;
-;;; so that
-;;;
-;;; (let-syntax ((test-ellipses-over-unsyntax
-;;;               (lambda (e)
-;;;                 (let ((a (syntax a)))
-;;;                   (with-syntax (((b ...) (syntax (1 2 3))))
-;;;                     (quasisyntax
-;;;                      (quote ((b #,a) ...))))))))
-;;;   (test-ellipses-over-unsyntax))
-;;;
-;;;     ==> ((1 a) (2 a) (3 a))
-
-(library (core quasisyntax)
-  (export quasisyntax unsyntax unsyntax-splicing) 
-  (import (for (core primitives)  run expand)
-          (for (core let)         run expand) 
-          (for (core derived)     run expand)
-          (for (core with-syntax) run expand)
-          (for (primitives = > + - vector->list) run expand)) 
-  
-  (define-syntax quasisyntax
-    (lambda (e)
-      
-      ;; Expand returns a list of the form
-      ;;    [template[t/e, ...] (replacement ...)]
-      ;; Here template[t/e ...] denotes the original template
-      ;; with unquoted expressions e replaced by fresh
-      ;; variables t, followed by the appropriate ellipses
-      ;; if e is also spliced.
-      ;; The second part of the return value is the list of
-      ;; replacements, each of the form (t e) if e is just
-      ;; unquoted, or ((t ...) e) if e is also spliced.
-      ;; This will be the list of bindings of the resulting
-      ;; with-syntax expression.
-      
-      (define (expand x level)
-        (syntax-case x (quasisyntax unsyntax unsyntax-splicing)
-          ((quasisyntax e)
-           (with-syntax (((k _)     x) ;; original identifier must be copied
-                         ((e* reps) (expand (syntax e) (+ level 1))))
-             (syntax ((k e*) reps))))                                  
-          ((unsyntax e)
-           (= level 0)
-           (with-syntax (((t) (generate-temporaries '(t))))
-             (syntax (t ((t e))))))
-          (((unsyntax e ...) . r)
-           (= level 0)
-           (with-syntax (((r* (rep ...)) (expand (syntax r) 0))
-                         ((t ...)        (generate-temporaries (syntax (e ...)))))
-             (syntax ((t ... . r*)
-                      ((t e) ... rep ...)))))
-          (((unsyntax-splicing e ...) . r)
-           (= level 0)
-           (with-syntax (((r* (rep ...)) (expand (syntax r) 0))
-                         ((t ...)        (generate-temporaries (syntax (e ...)))))
-             (with-syntax ((((t ...) ...) (syntax ((t (... ...)) ...))))
-               (syntax ((t ... ... . r*)
-                        (((t ...) e) ... rep ...))))))
-          ((k . r)
-           (and (> level 0)
-                (identifier? (syntax k))
-                (or (free-identifier=? (syntax k) (syntax unsyntax))
-                    (free-identifier=? (syntax k) (syntax unsyntax-splicing))))
-           (with-syntax (((r* reps) (expand (syntax r) (- level 1))))
-             (syntax ((k . r*) reps))))
-          ((h . t)
-           (with-syntax (((h* (rep1 ...)) (expand (syntax h) level))
-                         ((t* (rep2 ...)) (expand (syntax t) level)))
-             (syntax ((h* . t*)
-                      (rep1 ... rep2 ...)))))
-          (#(e ...)                                                               
-           (with-syntax ((((e* ...) reps)
-                          (expand (vector->list (syntax #(e ...))) level)))
-             (syntax (#(e* ...) reps))))
-          (other
-           (syntax (other ())))))
-      
-      (syntax-case e ()
-        ((_ template)
-         (with-syntax (((template* replacements) (expand (syntax template) 0)))
-           (syntax
-            (with-syntax replacements (syntax template*))))))))
-  
-  (define-syntax unsyntax
-    (lambda (e)
-      (syntax-violation 'unsyntax "Invalid expression" e)))
-  
-  (define-syntax unsyntax-splicing
-    (lambda (e)
-      (syntax-violation 'unsyntax "Invalid expression" e)))
-  )
-
-(library (core quasiquote)
-  (export quasiquote unquote unquote-splicing)
-  (import (for (core primitives)  run expand)
-          (for (core let)         run expand) 
-          (for (core derived)     run expand)
-          (for (core with-syntax) expand)
-          (for (core quasisyntax) expand)
-          (for (primitives = + - null? cons car cdr append map list vector list->vector) 
-            run expand)) 
-  
-  ;; Optimised version copied from portable syntax-case (Dybvig)
-  
-  (define-syntax quasiquote
-    (let ()
-      (define (quasi p lev)
-        (syntax-case p (unquote quasiquote)
-          ((unquote p)
-           (if (= lev 0)
-               (syntax ("value" p))
-               (quasicons (syntax ("quote" unquote)) (quasi (syntax (p)) (- lev 1)))))
-          ((quasiquote p) (quasicons (syntax ("quote" quasiquote)) (quasi (syntax (p)) (+ lev 1))))
-          ((p . q)
-           (syntax-case (syntax p) (unquote unquote-splicing)
-             ((unquote p ...)
-              (if (= lev 0)
-                  (quasilist* (syntax (("value" p) ...)) (quasi (syntax q) lev))
-                  (quasicons
-                   (quasicons (syntax ("quote" unquote)) (quasi (syntax (p ...)) (- lev 1)))
-                   (quasi (syntax q) lev))))
-             ((unquote-splicing p ...)
-              (if (= lev 0)
-                  (quasiappend (syntax (("value" p) ...)) (quasi (syntax q) lev))
-                  (quasicons
-                   (quasicons (syntax ("quote" unquote-splicing)) (quasi (syntax (p ...)) (- lev 1)))
-                   (quasi (syntax q) lev))))
-             (_ (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev)))))
-          (#(x ...) (quasivector (vquasi (syntax (x ...)) lev)))
-          (p (syntax ("quote" p)))))
-      (define (vquasi p lev)
-        (syntax-case p ()
-          ((p . q)
-           (syntax-case (syntax p) (unquote unquote-splicing)
-             ((unquote p ...)
-              (if (= lev 0)
-                  (quasilist* (syntax (("value" p) ...)) (vquasi (syntax q) lev))
-                  (quasicons
-                   (quasicons (syntax ("quote" unquote)) (quasi (syntax (p ...)) (- lev 1)))
-                   (vquasi (syntax q) lev))))
-             ((unquote-splicing p ...)
-              (if (= lev 0)
-                  (quasiappend (syntax (("value" p) ...)) (vquasi (syntax q) lev))
-                  (quasicons
-                   (quasicons
-                    (syntax ("quote" unquote-splicing))
-                    (quasi (syntax (p ...)) (- lev 1)))
-                   (vquasi (syntax q) lev))))
-             (_ (quasicons (quasi (syntax p) lev) (vquasi (syntax q) lev)))))
-          (() (syntax ("quote" ())))))
-      (define (quasicons x y)
-        (with-syntax ((x x) (y y))
-          (syntax-case (syntax y) ()
-            (("quote" dy)
-             (syntax-case (syntax x) ()
-               (("quote" dx) (syntax ("quote" (dx . dy))))
-               (_ (if (null? (syntax dy)) (syntax ("list" x)) (syntax ("list*" x y))))))
-            (("list" . stuff) (syntax ("list" x . stuff)))
-            (("list*" . stuff) (syntax ("list*" x . stuff)))
-            (_ (syntax ("list*" x y))))))
-      (define (quasiappend x y)
-        (syntax-case y ()
-          (("quote" ())
-           (cond
-             ((null? x) (syntax ("quote" ())))
-             ((null? (cdr x)) (car x))
-             (else (with-syntax (((p ...) x)) (syntax ("append" p ...))))))
-          (_
-           (cond
-             ((null? x) y)
-             (else (with-syntax (((p ...) x) (y y)) (syntax ("append" p ... y))))))))
-      (define (quasilist* x y)
-        (let f ((x x))
-          (if (null? x)
-              y
-              (quasicons (car x) (f (cdr x))))))
-      (define (quasivector x)
-        (syntax-case x ()
-          (("quote" (x ...)) (syntax ("quote" #(x ...))))
-          (_
-           (let f ((y x) (k (lambda (ls) (quasisyntax ("vector" (unsyntax-splicing ls))))))
-             (syntax-case y ()
-               (("quote" (y ...)) (k (syntax (("quote" y) ...))))
-               (("list" y ...) (k (syntax (y ...))))
-               (("list*" y ... z) (f (syntax z) (lambda (ls) (k (append (syntax (y ...)) ls)))))
-               (else (quasisyntax ("list->vector" (unsyntax x)))))))))
-      (define (emit x)
-        (syntax-case x ()
-          (("quote" x) (syntax 'x))
-          (("list" x ...) (quasisyntax (list (unsyntax-splicing (map emit (syntax (x ...)))))))
-          ;; could emit list* for 3+ arguments if implementation supports list*
-          (("list*" x ... y)
-           (let f ((x* (syntax (x ...))))
-             (if (null? x*)
-                 (emit (syntax y))
-                 (quasisyntax (cons (unsyntax (emit (car x*))) (unsyntax (f (cdr x*))))))))
-          (("append" x ...) (quasisyntax (append (unsyntax-splicing (map emit (syntax (x ...)))))))
-          (("vector" x ...) (quasisyntax (vector (unsyntax-splicing (map emit (syntax (x ...)))))))
-          (("list->vector" x) (quasisyntax (list->vector (unsyntax (emit (syntax x))))))
-          (("value" x) (syntax x))))
-      (lambda (x)
-        (syntax-case x ()
-          ;; convert to intermediate language, combining introduced (but not
-          ;; unquoted source) quote expressions where possible and choosing
-          ;; optimal construction code otherwise, then emit Scheme code
-          ;; corresponding to the intermediate language forms.
-          ((_ e) (emit (quasi (syntax e) 0)))))))
-  
-  (define-syntax unquote
-    (lambda (e)
-      (syntax-violation 'unquote "Invalid expression" e)))
-  
-  (define-syntax unquote-splicing
-    (lambda (e)
-      (syntax-violation 'unquote-splicing "Invalid expression" e)))
-  )
-
-(library (core let-values)
-  (export let-values let*-values)
-  (import (for (core primitives)   expand run)
-          (for (core syntax-rules) expand)
-          (core let)
-          (primitives call-with-values))
-  
-  (define-syntax let-values
-    (syntax-rules ()
-      ((let-values (?binding ...) ?body0 ?body1 ...)
-       (let-values "bind" (?binding ...) () (begin ?body0 ?body1 ...)))
-      ((let-values "bind" () ?tmps ?body)
-       (let ?tmps ?body))
-      ((let-values "bind" ((?b0 ?e0) ?binding ...) ?tmps ?body)
-       (let-values "mktmp" ?b0 ?e0 () (?binding ...) ?tmps ?body))
-      ((let-values "mktmp" () ?e0 ?args ?bindings ?tmps ?body)
-       (call-with-values 
-        (lambda () ?e0)
-        (lambda ?args
-          (let-values "bind" ?bindings ?tmps ?body))))
-      ((let-values "mktmp" (?a . ?b) ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
-       (let-values "mktmp" ?b ?e0 (?arg ... x) ?bindings (?tmp ... (?a x)) ?body))
-      ((let-values "mktmp" ?a ?e0 (?arg ...) ?bindings (?tmp ...) ?body)
-       (call-with-values
-        (lambda () ?e0)
-        (lambda (?arg ... . x)
-          (let-values "bind" ?bindings (?tmp ... (?a x)) ?body))))))
-  
-  (define-syntax let*-values
-    (syntax-rules ()
-      ((let*-values () ?body0 ?body1 ...)
-       (begin ?body0 ?body1 ...))
-      ((let*-values (?binding0 ?binding1 ...) ?body0 ?body1 ...)
-       (let-values (?binding0)
-         (let*-values (?binding1 ...) ?body0 ?body1 ...)))))
-  
-  ) ; core let-values
-
rmfile ./libs/rnrs/core.scm