[Guile-commits] 59/88: Fold (oop goops util) into (oop goops)

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit ac5185c262c071b726f5245b634aa0434b646a29
Author: Andy Wingo <address@hidden>
Date:   Mon Jan 12 21:43:48 2015 +0100

    Fold (oop goops util) into (oop goops)
    
    * module/oop/goops/util.scm: Removed.  Instead we fold these definitions
      into goops.scm.
    
    * module/oop/goops/save.scm: Remove useless import of util.scm.
    
    * module/oop/goops.scm: Fold in util.scm.  Since we always use
      add-interesting-primitive!, import (language tree-il primitives) in
      the header.  Clean up some early comments, and use of eval-when.
    
    * module/Makefile.am: Adapt.
---
 module/Makefile.am        |    1 -
 module/oop/goops.scm      |   41 +++++++++++++++++++++++++++++------------
 module/oop/goops/save.scm |    3 +--
 module/oop/goops/util.scm |   42 ------------------------------------------
 4 files changed, 30 insertions(+), 57 deletions(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index dc22700..51397ba 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -361,7 +361,6 @@ OOP_SOURCES = \
   oop/goops/internal.scm \
   oop/goops/save.scm \
   oop/goops/stklos.scm \
-  oop/goops/util.scm \
   oop/goops/accessors.scm \
   oop/goops/simple.scm
 
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 64c3d11..e0721f4 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -27,8 +27,9 @@
 (define-module (oop goops)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
-  #:use-module (oop goops util)
   #:use-module (system base target)
+  #: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-extended-generic define-extended-generics
@@ -121,7 +122,6 @@
             goops-error
             min-fixnum max-fixnum
 
-;;; *fixme* Should go into goops.c
             instance?  slot-ref-using-class
             slot-set-using-class! slot-bound-using-class?
             slot-exists-using-class? slot-ref slot-set! slot-bound?
@@ -136,18 +136,10 @@
             slot-exists? make find-method get-keyword)
   #:no-backtrace)
 
-;; XXX FIXME: figure out why the 'eval-when's in this file must use
-;; 'compile' and must avoid 'expand', but only in 2.2, and only when
-;; compiling something that imports goops, e.g. (ice-9 occam-channel),
-;; before (oop goops) itself has been compiled.
-
 ;; First initialize the builtin part of GOOPS
-(eval-when (compile load eval)
+(eval-when (expand load eval)
   (load-extension (string-append "libguile-" (effective-version))
-                  "scm_init_goops_builtins"))
-
-(eval-when (compile load eval)
-  (use-modules ((language tree-il primitives) :select 
(add-interesting-primitive!)))
+                  "scm_init_goops_builtins")
   (add-interesting-primitive! 'class-of))
 
 (define-syntax macro-fold-left
@@ -1698,6 +1690,31 @@ followed by its associated value.  If @var{l} does not 
hold a value for
                    #:procedure procedure)))))))))
 
 ;;;
+;;; {Utilities}
+;;;
+;;; These are useful when dealing with method specializers, which might
+;;; have a rest argument.
+;;;
+
+(define (map* fn . l)          ; A map which accepts dotted lists (arg lists  
+  (cond                        ; must be "isomorph"
+   ((null? (car l)) '())
+   ((pair? (car l)) (cons (apply fn      (map car l))
+                         (apply map* fn (map cdr l))))
+   (else            (apply fn l))))
+
+(define (for-each* fn . l)     ; A for-each which accepts dotted lists (arg 
lists  
+  (cond                        ; must be "isomorph"
+   ((null? (car l)) '())
+   ((pair? (car l)) (apply fn (map car l)) (apply for-each* fn (map cdr l)))
+   (else            (apply fn l))))
+
+(define (length* ls)
+  (do ((n 0 (+ 1 n))
+       (ls ls (cdr ls)))
+      ((not (pair? ls)) n)))
+
+;;;
 ;;; {add-method!}
 ;;;
 
diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index dda2aea..a3492a9 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013, 2015 Free Software 
Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -20,7 +20,6 @@
 
 (define-module (oop goops save)
   :use-module (oop goops internal)
-  :use-module (oop goops util)
   :re-export (make-unbound)
   :export (save-objects load-objects restore
           enumerate! enumerate-component!
diff --git a/module/oop/goops/util.scm b/module/oop/goops/util.scm
deleted file mode 100644
index 8b48f98..0000000
--- a/module/oop/goops/util.scm
+++ /dev/null
@@ -1,42 +0,0 @@
-;;;;   Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008, 2012, 2015 Free 
Software Foundation, Inc.
-;;;; 
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
-;;;; 
-
-
-(define-module (oop goops util)
-  #:export (map* for-each* length*))
-
-;;;
-;;; {Utilities}
-;;;
-
-(define (map* fn . l)          ; A map which accepts dotted lists (arg lists  
-  (cond                        ; must be "isomorph"
-   ((null? (car l)) '())
-   ((pair? (car l)) (cons (apply fn      (map car l))
-                         (apply map* fn (map cdr l))))
-   (else            (apply fn l))))
-
-(define (for-each* fn . l)     ; A for-each which accepts dotted lists (arg 
lists  
-  (cond                        ; must be "isomorph"
-   ((null? (car l)) '())
-   ((pair? (car l)) (apply fn (map car l)) (apply for-each* fn (map cdr l)))
-   (else            (apply fn l))))
-
-(define (length* ls)
-  (do ((n 0 (+ 1 n))
-       (ls ls (cdr ls)))
-      ((not (pair? ls)) n)))