[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 05/25: Scheme GOOPS cleanups
From: |
Andy Wingo |
Subject: |
[Guile-commits] 05/25: Scheme GOOPS cleanups |
Date: |
Mon, 19 Jan 2015 10:41:06 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit 8b455ab0b7ceb607f9f86fa32baa386cc062240c
Author: Andy Wingo <address@hidden>
Date: Mon Jan 12 21:58:16 2015 +0100
Scheme GOOPS cleanups
* module/oop/goops.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/oop/goops.scm | 65 ++++++++++++++++++++++---------------------------
1 files changed, 29 insertions(+), 36 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 11bc5df..5507cf7 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -28,6 +28,8 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#: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
@@ -119,7 +121,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?
@@ -134,18 +135,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
@@ -1689,6 +1682,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!}
;;;
@@ -1762,31 +1780,6 @@ followed by its associated value. If @var{l} does not
hold a value for
(goops-error "~S is not a valid generic function" obj))
;;;
-;;; {Utilities}
-;;;
-;;; These are useful when dealing with specializers lists, 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)))
-
-;;;
;;; {Access to meta objects}
;;;
- [Guile-commits] branch wip-goops-refactor updated (b623b66 -> 2941be2), Andy Wingo, 2015/01/19
- [Guile-commits] 01/25: GOOPS cleanup to use SRFI-1 better, Andy Wingo, 2015/01/19
- [Guile-commits] 02/25: append-map rather than mapappend, Andy Wingo, 2015/01/19
- [Guile-commits] 03/25: GOOPS utils module cleanups, Andy Wingo, 2015/01/19
- [Guile-commits] 04/25: Fold (oop goops util) into (oop goops), Andy Wingo, 2015/01/19
- [Guile-commits] 05/25: Scheme GOOPS cleanups,
Andy Wingo <=
- [Guile-commits] 07/25: scm_make cleanup, Andy Wingo, 2015/01/19
- [Guile-commits] 06/25: Add compute-cpl tests, Andy Wingo, 2015/01/19
- [Guile-commits] 09/25: Commenting in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 08/25: Narrative reordering in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 11/25: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 13/25: Convert emit-linear-dispatch to use match, Andy Wingo, 2015/01/19
- [Guile-commits] 14/25: `match' refactor in goops.scm, Andy Wingo, 2015/01/19
- [Guile-commits] 15/25: GOOPS class slot indices defined as inline values, Andy Wingo, 2015/01/19
- [Guile-commits] 10/25: More GOOPS comments, Andy Wingo, 2015/01/19
- [Guile-commits] 17/25: slot-ref, slot-set! et al bypass "using-class" variants, Andy Wingo, 2015/01/19