mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
parent
06d54b3f70
commit
ac5185c262
4 changed files with 30 additions and 57 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
@ -1697,6 +1689,31 @@ followed by its associated value. If @var{l} does not hold a value for
|
|||
#:make-procedure make-procedure
|
||||
#: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!}
|
||||
;;;
|
||||
|
|
|
@ -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!
|
||||
|
|
|
@ -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)))
|
Loading…
Add table
Add a link
Reference in a new issue