guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 11/25: when and unless for one-armed ifs in goops.scm


From: Andy Wingo
Subject: [Guile-commits] 11/25: when and unless for one-armed ifs in goops.scm
Date: Mon, 19 Jan 2015 10:41:09 +0000

wingo pushed a commit to branch wip-goops-refactor
in repository guile.

commit d4299de7029e9ed70476f9f80c8820360df145ef
Author: Andy Wingo <address@hidden>
Date:   Wed Jan 14 20:06:35 2015 +0100

    when and unless for one-armed ifs in goops.scm
    
    * module/oop/goops.scm: Consistently use when or unless for one-armed
      ifs.
---
 module/oop/goops.scm |  122 ++++++++++++++++++++++++-------------------------
 1 files changed, 60 insertions(+), 62 deletions(-)

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 9f5f789..fcda260 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -364,8 +364,8 @@ subclasses of @var{c}."
                               (and (not (null? l))
                                    (candidate (car l)))))
              (next (any candidate-car inputs)))
-        (if (not next)
-            (goops-error "merge-lists: Inconsistent precedence graph"))
+        (unless next
+          (goops-error "merge-lists: Inconsistent precedence graph"))
         (let ((remove-next (lambda (l)
                              (if (eq? (car l) next)
                                  (cdr l)
@@ -385,7 +385,7 @@ subclasses of @var{c}."
 
 (define (build-slots-list dslots cpl)
   (define (check-cpl slots class-slots)
-    (when (or-map (lambda (slot-def) (assq (car slot-def) slots))
+    (when (or-map (match-lambda ((name . options) (assq name slots)))
                   class-slots)
       (scm-error 'misc-error #f
                  "a predefined <class> inherited field cannot be redefined"
@@ -1225,7 +1225,7 @@ followed by its associated value.  If @var{l} does not 
hold a value for
         ;; a subclass of these.
         (for-each
          (lambda (meta)
-           (if (and (not (member meta all-cpls))
+           (when (and (not (member meta all-cpls))
                       (not (member meta needed-metas)))
              (set! needed-metas (append needed-metas (list meta)))))
          all-metas)
@@ -1333,19 +1333,19 @@ followed by its associated value.  If @var{l} does not 
hold a value for
          ((#:getter #:setter)
           #'(define-class-pre-definition (rest ...)
               out ...
-              (if (or (not (defined? 'arg))
-                      (not (is-a? arg <generic>)))
-                  (toplevel-define!
-                   'arg
-                   (ensure-generic (if (defined? 'arg) arg #f) 'arg)))))
+              (when (or (not (defined? 'arg))
+                        (not (is-a? arg <generic>)))
+                (toplevel-define!
+                 'arg
+                 (ensure-generic (if (defined? 'arg) arg #f) 'arg)))))
          ((#:accessor)
           #'(define-class-pre-definition (rest ...)
               out ...
-              (if (or (not (defined? 'arg))
-                      (not (is-a? arg <accessor>)))
-                  (toplevel-define!
-                   'arg
-                   (ensure-accessor (if (defined? 'arg) arg #f) 'arg)))))
+              (when (or (not (defined? 'arg))
+                        (not (is-a? arg <accessor>)))
+                (toplevel-define!
+                 'arg
+                 (ensure-accessor (if (defined? 'arg) arg #f) 'arg)))))
          (else
           #'(define-class-pre-definition (rest ...) out ...))))
       ((_ () out ...)
@@ -1523,11 +1523,11 @@ followed by its associated value.  If @var{l} does not 
hold a value for
                    #:name (generic-function-name generic)
                    #:extended-by (slot-ref generic 'extended-by)
                    #:setter setter)))
-    (if (is-a? generic <extended-generic>)
-        (let ((gfs (slot-ref generic 'extends)))
-          (not-extended-by! gfs generic)
-          (slot-set! gws 'extends gfs)
-          (extended-by! gfs gws)))
+    (when (is-a? generic <extended-generic>)
+      (let ((gfs (slot-ref generic 'extends)))
+        (not-extended-by! gfs generic)
+        (slot-set! gws 'extends gfs)
+        (extended-by! gfs gws)))
     ;; Steal old methods
     (for-each (lambda (method)
                 (slot-set! method 'generic-function gws))
@@ -1636,11 +1636,11 @@ followed by its associated value.  If @var{l} does not 
hold a value for
   (syntax-rules (setter)
     ((_ ((setter name) . args) body ...)
      (begin
-       (if (or (not (defined? 'name))
-               (not (is-a? name <accessor>)))
-           (toplevel-define! 'name
-                             (ensure-accessor
-                              (if (defined? 'name) name #f) 'name)))
+       (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
@@ -1649,9 +1649,9 @@ followed by its associated value.  If @var{l} does not 
hold a value for
        ;; before (ok), or *was defined to #f*. The latter is crack. But
        ;; there are bootstrap issues about fixing this -- change it to
        ;; (is-a? name <generic>) and see.
-       (if (or (not (defined? 'name))
-               (not name))
-           (toplevel-define! 'name (make <generic> #:name 'name)))
+       (when (or (not (defined? 'name))
+                 (not name))
+         (toplevel-define! 'name (make <generic> #:name 'name)))
        (add-method! name (method args body ...))))))
 
 (define-syntax method
@@ -2106,9 +2106,9 @@ followed by its associated value.  If @var{l} does not 
hold a value for
          (getters-n-setters (struct-ref class class-index-getters-n-setters))
          (g-n-s (cddr (or (assq slot-name getters-n-setters)
                           (slot-missing class slot-name)))))
-    (if (not (memq (slot-definition-allocation this-slot)
-                   '(#:class #:each-subclass)))
-        (slot-missing class slot-name))
+    (unless (memq (slot-definition-allocation this-slot)
+                  '(#:class #:each-subclass))
+      (slot-missing class slot-name))
     g-n-s))
 
 (define (class-slot-ref class slot)
@@ -2160,8 +2160,8 @@ followed by its associated value.  If @var{l} does not 
hold a value for
          (clone (%allocate-instance class))
          (slots (map slot-definition-name (class-slots class))))
     (for-each (lambda (slot)
-                (if (slot-bound? self slot)
-                    (slot-set! clone slot (slot-ref self slot))))
+                (when (slot-bound? self slot)
+                  (slot-set! clone slot (slot-ref self slot))))
               slots)
     clone))
 
@@ -2170,12 +2170,12 @@ followed by its associated value.  If @var{l} does not 
hold a value for
          (clone (%allocate-instance class))
          (slots (map slot-definition-name (class-slots class))))
     (for-each (lambda (slot)
-                (if (slot-bound? self slot)
-                    (slot-set! clone slot
-                               (let ((value (slot-ref self slot)))
-                                 (if (instance? value)
-                                     (deep-clone value)
-                                     value)))))
+                (when (slot-bound? self slot)
+                  (slot-set! clone slot
+                             (let ((value (slot-ref self slot)))
+                               (if (instance? value)
+                                   (deep-clone value)
+                                   value)))))
               slots)
     clone))
 
@@ -2250,14 +2250,14 @@ followed by its associated value.  If @var{l} does not 
hold a value for
 
 (define-method (remove-class-accessors! (c <class>))
   (for-each (lambda (m)
-              (if (is-a? m <accessor-method>)
-                  (let ((gf (slot-ref m 'generic-function)))
-                    ;; remove the method from its GF
-                    (slot-set! gf 'methods
-                               (delq1! m (slot-ref gf 'methods)))
-                    (invalidate-method-cache! gf)
-                    ;; remove the method from its specializers
-                    (remove-method-in-classes! m))))
+              (when (is-a? m <accessor-method>)
+                (let ((gf (slot-ref m 'generic-function)))
+                  ;; remove the method from its GF
+                  (slot-set! gf 'methods
+                             (delq1! m (slot-ref gf 'methods)))
+                  (invalidate-method-cache! gf)
+                  ;; remove the method from its specializers
+                  (remove-method-in-classes! m))))
             (class-direct-methods c)))
 
 ;;;
@@ -2270,11 +2270,10 @@ followed by its associated value.  If @var{l} does not 
hold a value for
   (let loop ((l (method-specializers m)))
     ;; Note: the <top> in dotted list is never used.
     ;; So we can work as if we had only proper lists.
-    (if (pair? l)
-        (begin
-          (if (eqv? (car l) old)
-              (set-car! l new))
-          (loop (cdr l))))))
+    (when (pair? l)
+      (when (eqv? (car l) old)
+        (set-car! l new))
+      (loop (cdr l)))))
 
 ;;;
 ;;; update-direct-subclass!
@@ -2396,12 +2395,12 @@ followed by its associated value.  If @var{l} does not 
hold a value for
           (else
            (let ((get (car l))
                  (set (cadr l)))
-             (if (not (procedure? get))
-                 (goops-error "Bad getter closure for slot `~S' in ~S: ~S"
-                              slot class get))
-             (if (not (procedure? set))
-                 (goops-error "Bad setter closure for slot `~S' in ~S: ~S"
-                              slot class set))))))
+             (unless (procedure? get)
+               (goops-error "Bad getter closure for slot `~S' in ~S: ~S"
+                            slot class get))
+             (unless (procedure? set)
+               (goops-error "Bad setter closure for slot `~S' in ~S: ~S"
+                            slot class set))))))
 
   (map (lambda (s)
          ;; The strange treatment of nfields is due to backward compatibility.
@@ -2473,9 +2472,8 @@ followed by its associated value.  If @var{l} does not 
hold a value for
      ;; slot-ref and slot-set! function must be given by the user
      (let ((get (get-keyword #:slot-ref  (slot-definition-options s) #f))
            (set (get-keyword #:slot-set! (slot-definition-options s) #f)))
-       (if (not (and get set))
-           (goops-error "You must supply a #:slot-ref and a #:slot-set! in ~S"
-                        s))
+       (unless (and get set)
+         (goops-error "You must supply a #:slot-ref and a #:slot-set! in ~S" 
s))
        (list get set)))
     (else    (next-method))))
 
@@ -2697,8 +2695,8 @@ var{initargs}."
 ;;;
 
 (define-method (apply-generic (gf <generic>) args)
-  (if (null? (slot-ref gf 'methods))
-      (no-method gf args))
+  (when (null? (slot-ref gf 'methods))
+    (no-method gf args))
   (let ((methods (compute-applicable-methods gf args)))
     (if methods
         (apply-methods gf (sort-applicable-methods gf methods args) args)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]