diff options
author | Andy Wingo <wingo@pobox.com> | 2015-01-12 21:43:48 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-01-23 16:16:02 +0100 |
commit | ac5185c262c071b726f5245b634aa0434b646a29 (patch) | |
tree | 1783d41e2f805b5b6668cb80291dbbfb841ae23a /module/oop | |
parent | 06d54b3f700b7da0540a707d6e4c26475622cb74 (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.scm | 41 | ||||
-rw-r--r-- | module/oop/goops/save.scm | 3 | ||||
-rw-r--r-- | module/oop/goops/util.scm | 42 |
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))) |