* libraries now can have a version as part of their names

* import forms still don't understand version names.

scheme/makefile.ss

@@ -150,6 +150,7 @@
     [unsyntax-splicing   (macro . unsyntax-splicing)]
     [trace-lambda        (macro . trace-lambda)]
     [trace-define        (macro . trace-define)]
+    [guard               (macro . guard)]
     [eol-style           (macro . eol-style)]
     [buffer-mode         (macro . buffer-mode)]
     [file-options        (macro . file-options)]
@@ -984,7 +985,7 @@
     [raise                                       i r ex]
     [raise-continuable                           i r ex]
     [with-exception-handler                      i r ex]
-    [guard                                       r ex]
+    [guard                                       i r ex]
     [binary-port?                                r ip]
     [buffer-mode                                 i r ip]
     [buffer-mode?                                i r ip]

scheme/psyntax.expander.ss

@@ -1029,6 +1029,36 @@
                                 "not a procedure" v)))))
              (stx-error stx "invalid formals"))))))
   
+  (define guard-macro
+    (lambda (x)
+      (syntax-match x (else)
+        [(_ (con clause* ... [else e e* ...]) b b* ...)
+         (bless
+           `((call/cc
+               (lambda (outerk)
+                 (lambda ()
+                   (with-exception-handler
+                     (lambda (,con)
+                       (outerk 
+                         (lambda () 
+                           (cond ,@clause* [else ,e ,@e*]))))
+                     (lambda () #f ,b ,@b*)))))))]
+        [(_ (con clause* ...) b b* ...)
+         (bless
+           `((call/cc
+               (lambda (outerk)
+                 (lambda ()
+                   (with-exception-handler
+                     (lambda (,con) 
+                       ((call/cc
+                          (lambda (raisek)
+                            (outerk 
+                              (lambda () 
+                                (cond ,@clause* 
+                                  [else 
+                                   (raisek (lambda () (raise ,con)))])))))))
+                     (lambda () #f ,b ,@b* )))))))])))
+
   (define time-macro
     (lambda (stx)
       (syntax-match stx ()
@@ -2150,6 +2180,7 @@
            ((delay)             delay-macro)
            ((assert)            assert-macro)
            ((endianness)        endianness-macro)
+           ((guard)             guard-macro)
            ((trace-lambda)      trace-lambda-macro)
            ((trace-define)      trace-define-macro)
            ((define-condition-type)      define-condition-type-macro)
@@ -2640,18 +2671,19 @@
   ;;; given a library name, like (foo bar (1 2 3)), 
   ;;; returns the identifiers and the version of the library
   ;;; as (foo bar) (1 2 3).  
-  (define (parse-library-name x)
+  (define (parse-library-name spec)
     (define (parse x)
       (syntax-match x ()
-        ((x* ... (v* ...)) 
+        [((v* ...)) 
-         (and (for-all symbol? x*)
+         (for-all (lambda (x) (and (integer? x) (exact? x))) v*)
-              (for-all (lambda (x) (and (integer? x) (exact? x))) v*))
+         (values '() v*)]
-         (values x* v*))
+        [(x . rest) (symbol? x)
-        ((x* ...) (for-all symbol? x*)
+         (let-values ([(x* v*) (parse rest)])
-         (values x* '()))
+           (values (cons x x*) v*))]
-        (_ (stx-error x "invalid library name"))))
+        [() (values '() '())]
-    (let-values (((name* ver*) (parse x)))
+        [_ (stx-error spec "invalid library name")]))
-      (when (null? name*) (stx-error x "empty library name"))
+    (let-values (((name* ver*) (parse spec)))
+      (when (null? name*) (stx-error spec "empty library name"))
       (values name* ver*)))
 
   ;;; given a library form, returns the name part, the export 
@@ -2862,7 +2894,7 @@
           (let-values (((imp* invoke-req* visit-req* invoke-code
                               visit-code export-subst export-env)
                         (library-body-expander exp* imp* b*)))
-             (values name imp* invoke-req* visit-req* 
+             (values name ver imp* invoke-req* visit-req* 
                      invoke-code visit-code export-subst
                      export-env))))))
   
@@ -2958,11 +2990,11 @@
                   (let ((loc (car x)) (proc (cadr x)))
                     (set-symbol-value! loc proc)))
                 macro*))
-    (let-values (((name imp* inv* vis* invoke-code macro* export-subst export-env)
+    (let-values (((name ver imp* inv* vis* invoke-code macro* export-subst export-env)
                   (core-library-expander x)))
       (let ((id (gensym))
             (name name)
-            (ver '())  ;;; FIXME
+            (ver ver)  ;;; FIXME
             (imp* (map library-spec imp*))
             (vis* (map library-spec vis*))
             (inv* (map library-spec inv*)))

scheme/todo-r6rs.ss

@@ -32,6 +32,7 @@
     [fi (rnrs files (6))]
     [ne (null-environment)]
     [sr (rnrs sorting (6))]
+    [ex (rnrs exceptions (6))]
     [ls (rnrs lists (6))]
     [ri (rnrs records inspection (6))]
     [rp (rnrs records procedural (6))]
@@ -41,7 +42,6 @@
     [ba (rnrs base (6))]
     [bv (rnrs bytevectors (6))]
     [uc (rnrs unicode (6))]
-    [ex (rnrs exceptions (6))]
     [bw (rnrs arithmetic bitwise (6))]
     [fx (rnrs arithmetic fixnums (6))]
     [fl (rnrs arithmetic flonums (6))]
@@ -507,7 +507,7 @@
     [raise                                      C ex]
     [raise-continuable                          C ex]
     [with-exception-handler                     C ex]
-    [guard                                      S ex]
+    [guard                                      C ex]
     ;;;
     [binary-port?                               S ip]
     [buffer-mode                                C ip]