diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 8ed68694c..01bf1612e 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -33,9 +33,10 @@
   #:use-module ((language tree-il primitives)
                 :select (add-interesting-primitive!))
   #:export-syntax (define-class class standard-define-class
-                    define-generic define-accessor define-method
+                    define-generic define-accessor
+                    define-method define-method*
                     define-extended-generic define-extended-generics
-                    method)
+                    method method*)
   #:export ( ;; The root of everything.
             <top>
             <class> <object>
@@ -2024,8 +2025,7 @@ function."
            (else
             (and (memq (car specs) (class-precedence-list (car types)))
                  (lp (cdr specs) (cdr types))))))))))
-  (let ((n (length args))
-        (types (map class-of args)))
+  (let ((types (map class-of args)))
     (let lp ((methods (generic-function-methods gf))
              (applicable '()))
       (if (null? methods)
@@ -2042,6 +2042,36 @@ function."
 (define (toplevel-define! name val)
   (module-define! (current-module) name val))
 
+;;;
+;;; The GOOPS API would have been simpler by introducing keyword formals
+;;; in define-method itself, but in order to align with lambda* and
+;;; define*, we introduce method* and define-method* in parallel to
+;;; method and define-method.
+;;;
+;;; There is some code repetition here. The motivation for that is to
+;;; pay some here in order to speed up loading and compilation of larger
+;;; chunks of GOOPS code as well as to make sure that method*:s are as
+;;; efficient as can be.
+;;;
+;;; A more elegant solution would have been to use something akin to
+;;; Mark H. Weavers macro:
+;;;
+;;; (define-syntax define-method*
+;;;   (lambda (x)
+;;;     (syntax-case x ()
+;;;       ((_ (generic arg-spec ... . tail) body ...)
+;;;        (let-values (((required-arg-specs other-arg-specs)
+;;;                      (break (compose keyword? syntax->datum)
+;;;                             #'(arg-spec ...))))
+;;;          #`(define-method (generic #,@required-arg-specs . rest)
+;;;              (apply (lambda* (#,@other-arg-specs . tail)
+;;;                       body ...)
+;;;                     rest)))))))
+;;;
+;;; With the current state of the compiler, this results in slower code
+;;; than the implementation below since the apply call isn't eliminated.
+;;;
+
 (define-syntax define-method
   (syntax-rules (setter)
     ((_ ((setter name) . args) body ...)
@@ -2064,10 +2094,76 @@ function."
          (toplevel-define! 'name (make <generic> #:name 'name)))
        (add-method! name (method args body ...))))))
 
-(define-syntax method
-  (lambda (x)
-    (define (parse-args args)
-      (let lp ((ls args) (formals '()) (specializers '()))
+(define-syntax define-method*
+  (syntax-rules (setter)
+    ((_ ((setter name) . args) body ...)
+     (begin
+       (when (or (not (defined? 'name))
+                 (not (is-a? name <accessor>)))
+         (toplevel-define! 'name
+                           (ensure-accessor
+                            (if (defined? 'name) name #f) 'name)))
+       (add-method! (setter name) (method* args body ...))))
+    ((_ (name . args) body ...)
+     (begin
+       (when (or (not (defined? 'name))
+                 (not name))
+         (toplevel-define! 'name (make <generic> #:name 'name)))
+       (add-method! name (method* args body ...))))))
+
+;;; This section of helpers is used by both the method and method* syntax
+;;;
+(eval-when (expand load eval)
+
+    ;; parse-formals METHOD-FORMALS
+    ;;
+    ;; return (FORMALS SPECIALIZERS KEYWORD-FORMALS)
+    ;;
+    ;; FORMALS is the possibly improper list of specializable formals.
+    ;;
+    ;; SPECIALIZERS is a proper list of the corresponding specializers.
+    ;; Its last element corresponds to the cdr of the last element in
+    ;; METHOD-FORMALS such that the possibly improper list corresponding
+    ;; to FORMALS can be obtained by applying cons* to SPECIALIZERS.
+    ;; The reason for handling it like this is that the specializers are
+    ;; each evaluated to their values and therefore *must* be provided
+    ;; by a cons* in the (make <method> ...) expression.
+    ;;
+    ;; KEYWORD_FORMALS is the part of METHOD-FORMALS which starts with a
+    ;; keyword and corresponds to the keyword-syntax of lambda*. These
+    ;; are not specializable (which also corresponds to CLOS
+    ;; functionality).
+    ;;
+    (define (parse-keyword-formals method-formals)
+      (let lp ((ls method-formals) (formals '()) (specializers '()))
+        (syntax-case ls ()
+          (((f s) . rest)
+           (and (identifier? #'f) (identifier? #'s))
+           (lp #'rest
+               (cons #'f formals)
+               (cons #'s specializers)))
+          ((f . rest)
+           (identifier? #'f)
+           (lp #'rest
+               (cons #'f formals)
+               (cons #'<top> specializers)))
+          ((f . rest)
+           (keyword? (syntax->datum #'f))
+           (list (reverse formals)
+                 (reverse (cons #'<top> specializers)) ;to be cons*:ed
+                 (cons #'f #'rest)))
+          (()
+           (list (reverse formals)
+                 (reverse (cons #''() specializers))
+                 '()))                  ;yes, not #''(); used in tests
+          (tail
+           (identifier? #'tail)
+           (list (append (reverse formals) #'tail)
+                 (reverse (cons #'<top> specializers))
+                 '())))))
+
+    (define (parse-formals method-formals)
+      (let lp ((ls method-formals) (formals '()) (specializers '()))
         (syntax-case ls ()
           (((f s) . rest)
            (and (identifier? #'f) (identifier? #'s))
@@ -2098,43 +2194,87 @@ function."
            (and (free-identifier=? #'x id) id)))
         (_ #f)))
 
-    (define (compute-procedure formals body)
+    (define (compute-procedure formals keyword-formals body)
       (syntax-case body ()
         ((body0 ...)
-         (with-syntax ((formals formals))
-           #'(lambda formals body0 ...)))))
-
-    (define (->proper args)
-      (let lp ((ls args) (out '()))
+         (let ((formals (if (null? keyword-formals)
+                            formals
+                            (append formals keyword-formals))))
+           (with-syntax ((formals formals))
+             #`(lambda* formals body0 ...))))))
+
+    ;; ->formal-ids FORMALS
+    ;;
+    ;; convert FORMALS into formal-ids format, which is a cell where the
+    ;; car is the list of car:s in FORMALS and the cdr is the cdr of the
+    ;; last cell in FORMALS.
+    ;;
+    ;; The motivation for this format is to determine at low cost if
+    ;; FORMALS is improper or not and to easily be able to generate the
+    ;; corresponding next-method call.
+    ;;
+    (define (->formal-ids formals)
+      (let lp ((ls formals) (out '()))
         (syntax-case ls ()
-          ((x . xs)        (lp #'xs (cons #'x out)))
-          (()              (reverse out))
-          (tail            (reverse (cons #'tail out))))))
+          ((x . xs) (lp #'xs (cons #'x out)))
+          (()       (cons (reverse out) '()))
+          (tail     (cons (reverse out) #'tail)))))
+
+    ;; keyword-formal-ids KEYWORD-FORMALS
+    ;;
+    ;; return a form corresponding to KEYWORD-FORMALS but with
+    ;; identifiers only (keywords removed) The value returned has the
+    ;; formals-ids format as described above.
+    ;;
+    ;; The output is used in the next-method application form.
+    ;;
+    (define (->keyword-formal-ids keyword-formals)
+      (let lp ((ls keyword-formals) (out '()))
+        (syntax-case ls ()
+          (((f val) . rest)
+           (lp #'rest out))
+          ((#:rest f)
+           (cons (reverse out) #'f))
+          ((f . rest)
+           (keyword? (syntax->datum #'f))
+           (lp #'rest out))
+          ((f . rest)
+           (lp #'rest (cons #'f out)))
+          (()
+           (cons (reverse out) '()))
+          (tail
+           (cons (reverse out) #'tail)))))
 
-    (define (compute-make-procedure formals body next-method)
+    (define (compute-make-procedure formals keyword-formals body next-method)
       (syntax-case body ()
         ((body ...)
-         (with-syntax ((next-method next-method))
-           (syntax-case formals ()
-             ((formal ...)
-              #'(lambda (real-next-method)
-                  (lambda (formal ...)
-                    (let ((next-method (lambda args
-                                         (if (null? args)
-                                             (real-next-method formal ...)
-                                             (apply real-next-method args)))))
-                      body ...))))
-             (formals
-              (with-syntax (((formal ...) (->proper #'formals)))
-                #'(lambda (real-next-method)
-                    (lambda formals
-                      (let ((next-method (lambda args
-                                           (if (null? args)
-                                               (apply real-next-method formal ...)
-                                               (apply real-next-method args)))))
+         (let ((formals (if (null? keyword-formals)
+                            formals     ;might be improper
+                            (append formals keyword-formals)))
+               (formal-ids
+                (if (null? keyword-formals)
+                    (->formal-ids formals)
+                    (let ((kw-formal-ids (->keyword-formal-ids keyword-formals)))
+                      ;; input and result in formals-ids format
+                      (cons (append formals (car kw-formal-ids))
+                            (cdr kw-formal-ids))))))
+           (with-syntax ((next-method next-method))
+             (syntax-case formals ()
+               (formals
+                #`(lambda (real-next-method)
+                    (lambda* formals
+                      (let ((next-method
+                             (lambda args
+                               (if (null? args)
+                                   #,(if (null? (cdr formal-ids))
+                                         #`(real-next-method #,@(car formal-ids))
+                                         #`(apply real-next-method
+                                                  #,@(car formal-ids)
+                                                  #,(cdr formal-ids)))
+                                   (apply real-next-method args)))))
                         body ...))))))))))
 
-    (define (compute-procedures formals body)
+    (define (compute-procedures formals keyword-formals body)
       ;; So, our use of this is broken, because it operates on the
       ;; pre-expansion source code. It's equivalent to just searching
       ;; for referent in the datums. Ah well.
@@ -2142,23 +2282,55 @@ function."
         (if id
             ;; return a make-procedure
             (values #'#f
-                    (compute-make-procedure formals body id))
-            (values (compute-procedure formals body)
+                    (compute-make-procedure formals keyword-formals body id))
+            (values (compute-procedure formals keyword-formals body)
                     #'#f))))
+    )
+
+(define-syntax method
+  (lambda (x)
+    (syntax-case x ()
+      ((_ formals) #'(method formals (if #f #f)))
+      ((_ formals body0 body1 ...)
+       (with-syntax (((formals (specializer ...))
+                      (parse-formals #'formals)))
+         (call-with-values
+             (lambda ()
+               (compute-procedures #'formals
+                                   '()
+                                   #'(body0 body1 ...)))
+           (lambda (procedure make-procedure)
+             (with-syntax ((procedure procedure)
+                           (make-procedure make-procedure))
+               #`(make <method>
+                   #:specializers (cons* specializer ...) ;yes, this
+                   ;; The cons* is needed to get the value of each
+                   ;; specializer.
+                   #:formals 'formals ;might be improper
+                   #:body '(body0 body1 ...)
+                   #:make-procedure make-procedure
+                   #:procedure procedure)))))))))
 
+(define-syntax method*
+  (lambda (x)
     (syntax-case x ()
-      ((_ args) #'(method args (if #f #f)))
-      ((_ args body0 body1 ...)
-       (with-syntax (((formals (specializer ...)) (parse-args #'args)))
+      ((_ formals) #'(method formals (if #f #f)))
+      ((_ formals body0 body1 ...)
+       (with-syntax (((formals (specializer ...) keyword-formals)
+                      (parse-keyword-formals #'formals)))
          (call-with-values
              (lambda ()
-               (compute-procedures #'formals #'(body0 body1 ...)))
+               (compute-procedures #'formals
+                                   #'keyword-formals
+                                   #'(body0 body1 ...)))
            (lambda (procedure make-procedure)
              (with-syntax ((procedure procedure)
                            (make-procedure make-procedure))
-               #'(make <method>
+               #`(make <method>
                    #:specializers (cons* specializer ...)
-                   #:formals 'formals
+                   #:formals (if (null? 'keyword-formals)
+                                 'formals ;might be improper
+                                 (append 'formals 'keyword-formals))
                    #:body '(body0 body1 ...)
                    #:make-procedure make-procedure
                    #:procedure procedure)))))))))