support source-level annotations in syncase

* module/ice-9/annotate.scm (<annotation>): Slightly more concise
  printing.
  (annotate): Don't create annotations if we have no source info.

* module/ice-9/psyntax.scm (annotation?): Remove this definition, as we
  now provide annotation support.

* module/ice-9/psyntax-pp.scm: Regenerated.

* module/ice-9/syncase.scm: Use (ice-9 annotate).

* module/language/scheme/expand.scm (eval-when): Define the eval-when
  transformer.

module/ice-9/annotate.scm

@@ -24,7 +24,7 @@
 (define <annotation>          
   (make-vtable "prprpw"
                (lambda (struct port)
-                 (display "#<annotation of " port)
+                 (display "#<annotated " port)
                  (display (struct-ref struct 0) port)
                  (display ">" port))))
 
@@ -46,12 +46,15 @@
   (struct-set! a 2 #t))
 
 (define (annotate e)
-  (cond ((and (list? e) (not (null? e)))
+  (let ((p (if (pair? e) (source-properties e) #f))
-         (make-annotation (map annotate e) (source-properties e) #f))
+        (out (cond ((and (list? e) (not (null? e)))
-        ((pair? e)
+                    (map annotate e))
-         (make-annotation (cons (annotate (car e)) (annotate (cdr e)))
+                   ((pair? e)
-                          (source-properties e) #f))
+                    (cons (annotate (car e)) (annotate (cdr e))))
-        (else e)))
+                   (else e))))
+    (if (pair? p)
+        (make-annotation out p #f)
+        out)))
                           
 (define (deannotate e)
   (cond ((list? e)

module/ice-9/psyntax.scm

@@ -318,8 +318,6 @@
 (define fx= =)
 (define fx< <)
 
-(define annotation? (lambda (x) #f))
-
 (define top-level-eval-hook
   (lambda (x)
     (eval `(,noexpand ,x) (interaction-environment))))

module/ice-9/syncase.scm

@@ -19,6 +19,7 @@
 (define-module (ice-9 syncase)
   :use-module (ice-9 debug)
   :use-module (ice-9 threads)
+  :use-module (ice-9 annotate)
   :export-syntax (sc-macro define-syntax define-syntax-public 
                   eval-when fluid-let-syntax
 		  identifier-syntax let-syntax

module/language/scheme/expand.scm

@@ -284,11 +284,13 @@
   ((,modname ,sym)
    x))
 
-(define-scheme-expander eval-case
+(define-scheme-expander eval-when
-  (,clauses
+  ((,when . ,body) (guard (list? when) (and-map symbol? when))
-   (-> `(eval-case . ,(map (lambda (x)
+   (if (memq 'compile when)
-                             (-> `(,(acar x) . ,(map re-expand (acdr x)))))
+       (primitive-eval `(begin . ,body)))
-                           clauses)))))
+   (if (memq 'load when)
+       (-> `(begin . ,body))
+       (-> `(begin)))))
 
 ;;; Hum, I don't think this takes imported modifications to `define'
 ;;; properly into account. (Lexical bindings are OK because of alpha