all of guile compiles now, expanded with syncase

* libguile/eval.c (scm_m_eval_when): Whoops, eval-when has an implicit
  begin. Fix.

* module/oop/goops.scm: Syncase doesn't like definitions in expression
  context, and grudgingly I have decided to go along with that. But that
  doesn't mean we can't keep the old semantics, via accessing the module
  system directly. So do so. I took the opportunity to rewrite some
  macros with syntax-rules and syntax-case -- the former is nicer than
  the latter, of course.

* module/oop/goops/save.scm: Don't define within an expression.

* module/oop/goops/simple.scm (define-class): Use define-syntax.

* module/oop/goops/stklos.scm (define-class): Use define-syntax.

module/oop/goops/save.scm

@@ -110,9 +110,7 @@
 ;;; Readables
 ;;;
 
-(if (or (not (defined? 'readables))
-	(not readables))
-    (define readables (make-weak-key-hash-table 61)))
+(define readables (make-weak-key-hash-table 61))
 
 (define-macro (readable exp)
   `(make-readable ,exp ',(copy-tree exp)))

module/oop/goops/simple.scm

@@ -23,6 +23,9 @@
   :export (define-class)
   :no-backtrace)
 
-(define define-class define-class-with-accessors-keywords)
+(define-syntax define-class
+  (syntax-rules ()
+    ((_ arg ...)
+     (define-class-with-accessors-keywords arg ...))))
 
 (module-use! %module-public-interface (resolve-interface '(oop goops)))

module/oop/goops/stklos.scm

@@ -47,51 +47,30 @@
 ;;; Enable keyword support (*fixme*---currently this has global effect)
 (read-set! keywords 'prefix)
 
-(define standard-define-class-transformer
-  (macro-transformer standard-define-class))
+(define-syntax define-class
+  (syntax-rules ()
+    ((_ name supers (slot ...) rest ...)
+     (standard-define-class name supers slot ... rest ...))))
 
-(define define-class
-  ;; Syntax
-  (let ((name cadr)
-	(supers caddr)
-	(slots cadddr)
-	(rest cddddr))
-    (procedure->memoizing-macro
-      (lambda (exp env)
-	(standard-define-class-transformer
-	 `(define-class ,(name exp) ,(supers exp) ,@(slots exp)
-	    ,@(rest exp))
-	 env)))))
+(define (toplevel-define! name val)
+  (module-define! (current-module) name val))
 
-(define define-method
-  (procedure->memoizing-macro
-    (lambda (exp env)
-      (let ((name (cadr exp)))
-	(if (and (pair? name)
-		 (eq? (car name) 'setter)
-		 (pair? (cdr name))
-		 (null? (cddr name)))
-	    (let ((name (cadr name)))
-	      (cond ((not (symbol? name))
-		     (goops-error "bad method name: ~S" name))
-		    ((defined? name env)
-		     `(begin
-			(if (not (is-a? ,name <generic-with-setter>))
-			    (define-accessor ,name))
-			(add-method! (setter ,name) (method ,@(cddr exp)))))
-		    (else
-		     `(begin
-			(define-accessor ,name)
-			(add-method! (setter ,name) (method ,@(cddr exp)))))))
-	    (cond ((not (symbol? name))
-		   (goops-error "bad method name: ~S" name))
-		  ((defined? name env)
-		   `(begin
-		      (if (not (or (is-a? ,name <generic>)
-				   (is-a? ,name <primitive-generic>)))
-			  (define-generic ,name))
-		      (add-method! ,name (method ,@(cddr exp)))))
-		  (else
-		   `(begin
-		      (define-generic ,name)
-		      (add-method! ,name (method ,@(cddr exp)))))))))))
+(define-syntax define-method
+  (syntax-rules (setter)
+    ((_ (setter name) rest ...)
+     (begin
+       (if (or (not (defined? 'name))
+               (not (is-a? name <generic-with-setter>)))
+           (toplevel-define! 'name
+                             (ensure-accessor
+                              (if (defined? 'name) name #f) 'name)))
+       (add-method! (setter name) (method rest ...))))
+    ((_ name rest ...)
+     (begin
+       (if (or (not (defined? 'name))
+               (not (or (is-a? name <generic>)
+                        (is-a? name <primitive-generic>))))
+           (toplevel-define! 'name
+                             (ensure-generic
+                              (if (defined? 'name) name #f) 'name)))
+       (add-method! name (method rest ...))))))