summaryrefslogtreecommitdiff
path: root/module/oop
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-01-12 21:43:48 +0100
committerAndy Wingo <wingo@pobox.com>2015-01-23 16:16:02 +0100
commitac5185c262c071b726f5245b634aa0434b646a29 (patch)
tree1783d41e2f805b5b6668cb80291dbbfb841ae23a /module/oop
parent06d54b3f700b7da0540a707d6e4c26475622cb74 (diff)
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.
Diffstat (limited to 'module/oop')
-rw-r--r--module/oop/goops.scm41
-rw-r--r--module/oop/goops/save.scm3
-rw-r--r--module/oop/goops/util.scm42
3 files changed, 30 insertions, 56 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 64c3d1182..e0721f47b 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 dda2aea4e..a3492a904 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 8b48f98cc..000000000
--- 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)))