[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 74/88: The GOOPS "unbound" value is a unique pair
From: |
Andy Wingo |
Subject: |
[Guile-commits] 74/88: The GOOPS "unbound" value is a unique pair |
Date: |
Fri, 23 Jan 2015 15:25:57 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 567a6d1ee7efc3982748d3bd894057a76f076706
Author: Andy Wingo <address@hidden>
Date: Fri Jan 16 13:50:21 2015 +0100
The GOOPS "unbound" value is a unique pair
* libguile/goops.c (SCM_GOOPS_UNBOUND, SCM_GOOPS_UNBOUNDP): Remove
internal macros.
(scm_make_unbound, scm_unbound_p): Remove internal functions.
(scm_sys_clear_fields_x): Add "unbound" parameter, for the init
value.
* module/oop/goops.scm (*unbound*): Define in Scheme as a simple
heap-allocated value.
(unbound?): New definition.
(%allocate-instance): Pass *unbound* to %clear-fields!.
(make-class, slot-definition-init-value)
(slot-definition-init-form, make-closure-variable): Use *unbound*
instead of (make-unbound), which is now gone.
* module/oop/goops/active-slot.scm (compute-get-n-set): Use *unbound*
instead of make-unbound. This module uses the GOOPS internals module;
perhaps we should export make-unbound or something...
* module/oop/goops/save.scm (make-unbound): Export our own make-unbound
definition, for use by residualized save code.
* module/language/ecmascript/base.scm (<undefined>, *undefined*): Use a
unique object kind and instance for the undefined value.
* libguile/vm.c (scm_i_vm_mark_stack): Fill the stack with
SCM_UNSPECIFIED instead of SCM_UNBOUND.
---
libguile/goops.c | 34 ++++------------------------------
libguile/vm.c | 4 ++--
module/language/ecmascript/base.scm | 6 ++++--
module/oop/goops.scm | 15 +++++++++------
module/oop/goops/active-slot.scm | 4 ++--
module/oop/goops/save.scm | 6 ++++--
6 files changed, 25 insertions(+), 44 deletions(-)
diff --git a/libguile/goops.c b/libguile/goops.c
index c7e775c..286f3c7 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -55,9 +55,6 @@
#define SCM_OUT_PCLASS_INDEX SCM_I_MAX_PORT_TYPE_COUNT
#define SCM_INOUT_PCLASS_INDEX (2 * SCM_I_MAX_PORT_TYPE_COUNT)
-#define SCM_GOOPS_UNBOUND SCM_UNBOUND
-#define SCM_GOOPS_UNBOUNDP(x) (scm_is_eq (x, SCM_GOOPS_UNBOUND))
-
/* Objects have identity, so references to classes and instances are by
value, not by reference. Redefinition of a class or modification of
an instance causes in-place update; you can think of GOOPS as
@@ -149,11 +146,9 @@ SCM scm_i_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT];
SCM scm_module_goops;
-static SCM scm_make_unbound (void);
-static SCM scm_unbound_p (SCM obj);
static SCM scm_sys_make_vtable_vtable (SCM layout);
static SCM scm_sys_init_layout_x (SCM class, SCM layout);
-static SCM scm_sys_clear_fields_x (SCM obj);
+static SCM scm_sys_clear_fields_x (SCM obj, SCM unbound);
static SCM scm_sys_goops_early_init (void);
static SCM scm_sys_goops_loaded (void);
@@ -428,27 +423,6 @@ scm_method_procedure (SCM obj)
-SCM_DEFINE (scm_make_unbound, "make-unbound", 0, 0, 0,
- (),
- "Return the unbound value.")
-#define FUNC_NAME s_scm_make_unbound
-{
- return SCM_GOOPS_UNBOUND;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_unbound_p, "unbound?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is unbound.")
-#define FUNC_NAME s_scm_unbound_p
-{
- return SCM_GOOPS_UNBOUNDP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
-}
-#undef FUNC_NAME
-
-
-
-
SCM
scm_slot_ref (SCM obj, SCM slot_name)
{
@@ -476,8 +450,8 @@ scm_slot_exists_p (SCM obj, SCM slot_name)
-SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1, 0, 0,
- (SCM obj),
+SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 2, 0, 0,
+ (SCM obj, SCM unbound),
"")
#define FUNC_NAME s_scm_sys_clear_fields_x
{
@@ -493,7 +467,7 @@ SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1, 0,
0,
/* Set all SCM-holding slots to the GOOPS unbound value. */
for (i = 0; i < n; i++)
if (scm_i_symbol_ref (layout, i*2) == 'p')
- SCM_STRUCT_SLOT_SET (obj, i, SCM_GOOPS_UNBOUND);
+ SCM_STRUCT_SLOT_SET (obj, i, unbound);
return SCM_UNSPECIFIED;
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 4516a68..0e59835 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 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
@@ -990,7 +990,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry
*mark_stack_ptr,
{
/* This value may become dead as a result of GC,
so we can't just leave it on the stack. */
- *sp = SCM_UNBOUND;
+ *sp = SCM_UNSPECIFIED;
continue;
}
}
diff --git a/module/language/ecmascript/base.scm
b/module/language/ecmascript/base.scm
index ac8493d..fa6c85a 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -1,6 +1,6 @@
;;; ECMAScript for Guile
-;; Copyright (C) 2009, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 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
@@ -35,7 +35,9 @@
new-object new))
-(define *undefined* ((@@ (oop goops) make-unbound)))
+(define-class <undefined> ())
+
+(define *undefined* (make <undefined>))
(define *this* (make-fluid))
(define-class <js-object> ()
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 220416f..62b5f5a 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -769,9 +769,14 @@ followed by its associated value. If @var{l} does not
hold a value for
(scm-error 'wrong-type-arg #f "Not a keyword: ~S" (list kw) #f))
(if (eq? kw key) arg (lp l))))))
+(define *unbound* (list 'unbound))
+
+(define-inlinable (unbound? x)
+ (eq? x *unbound*))
+
(define (%allocate-instance class)
(let ((obj (allocate-struct class (struct-ref class class-index-nfields))))
- (%clear-fields! obj)
+ (%clear-fields! obj *unbound*)
obj))
(define (make class . args)
@@ -1302,7 +1307,7 @@ followed by its associated value. If @var{l} does not
hold a value for
head
(find-duplicate tail)))))
- (let* ((name (get-keyword #:name options (make-unbound)))
+ (let* ((name (get-keyword #:name options *unbound*))
(supers (if (not (or-map (lambda (class)
(memq <object>
(class-precedence-list class)))
@@ -1947,10 +1952,10 @@ followed by its associated value. If @var{l} does not
hold a value for
(define (slot-definition-init-value s)
;; can be #f, so we can't use #f as non-value
- (get-keyword #:init-value (cdr s) (make-unbound)))
+ (get-keyword #:init-value (cdr s) *unbound*))
(define (slot-definition-init-form s)
- (get-keyword #:init-form (cdr s) (make-unbound)))
+ (get-keyword #:init-form (cdr s) *unbound*))
(define (slot-definition-init-thunk s)
(get-keyword #:init-thunk (cdr s) #f))
@@ -2561,8 +2566,6 @@ followed by its associated value. If @var{l} does not
hold a value for
;;; {Initialize}
;;;
-(define *unbound* (make-unbound))
-
;; FIXME: This could be much more efficient.
(define (%initialize-object obj initargs)
"Initialize the object @var{obj} with the given arguments
diff --git a/module/oop/goops/active-slot.scm b/module/oop/goops/active-slot.scm
index 83517c6..e9f6069 100644
--- a/module/oop/goops/active-slot.scm
+++ b/module/oop/goops/active-slot.scm
@@ -38,7 +38,7 @@
(after-ref (get-keyword #:after-slot-ref s #f))
(before-set! (get-keyword #:before-slot-set! s #f))
(after-set! (get-keyword #:after-slot-set! s #f))
- (unbound (make-unbound)))
+ (unbound *unbound*))
(slot-set! class 'nfields (+ index 1))
(list (lambda (o)
(if before-ref
@@ -46,7 +46,7 @@
(let ((res (struct-ref o index)))
(and after-ref (not (eqv? res unbound)) (after-ref o))
res)
- (make-unbound))
+ *unbound*)
(let ((res (struct-ref o index)))
(and after-ref (not (eqv? res unbound)) (after-ref o))
res)))
diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index a3492a9..a4b15ad 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -20,12 +20,14 @@
(define-module (oop goops save)
:use-module (oop goops internal)
- :re-export (make-unbound)
- :export (save-objects load-objects restore
+ :export (make-unbound save-objects load-objects restore
enumerate! enumerate-component!
write-readably write-component write-component-procedure
literal? readable make-readable))
+(define (make-unbound)
+ *unbound*)
+
;;;
;;; save-objects ALIST PORT [EXCLUDED] [USES]
;;;
- [Guile-commits] 70/88: Manipulate GOOPS vtable flags from Scheme, for speed, (continued)
- [Guile-commits] 70/88: Manipulate GOOPS vtable flags from Scheme, for speed, Andy Wingo, 2015/01/23
- [Guile-commits] 73/88: GOOPS: Deprecate "using-class" procs like slot-ref-using-class, Andy Wingo, 2015/01/23
- [Guile-commits] 65/88: when and unless for one-armed ifs in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 75/88: Beginnings of <slot> slot definition class, Andy Wingo, 2015/01/23
- [Guile-commits] 68/88: `match' refactor in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 78/88: Inline helpers into slot-ref, slot-set!, etc, Andy Wingo, 2015/01/23
- [Guile-commits] 63/88: Commenting in goops.scm, Andy Wingo, 2015/01/23
- [Guile-commits] 82/88: Fix foreign objects for removal of getters-n-setters, Andy Wingo, 2015/01/23
- [Guile-commits] 81/88: Minor GOOPS cleanups, Andy Wingo, 2015/01/23
- [Guile-commits] 79/88: Inline internal slot accessors, Andy Wingo, 2015/01/23
- [Guile-commits] 74/88: The GOOPS "unbound" value is a unique pair,
Andy Wingo <=
- [Guile-commits] 83/88: Update (oop goops save) for <slot> objects, Andy Wingo, 2015/01/23
- [Guile-commits] 77/88: Use a vtable bit to mark <slot> instances, Andy Wingo, 2015/01/23
- [Guile-commits] 86/88: Simplify GOOPS effective method cache format, Andy Wingo, 2015/01/23
- [Guile-commits] 87/88: Export <slot> from GOOPS, Andy Wingo, 2015/01/23
- [Guile-commits] 80/88: Optimize %initialize-object, Andy Wingo, 2015/01/23
- [Guile-commits] 85/88: Fast generic function dispatch without calling `compile' at runtime, Andy Wingo, 2015/01/23
- [Guile-commits] 84/88: GOOPS cosmetics, Andy Wingo, 2015/01/23
- [Guile-commits] 76/88: Introduce <slot> objects in GOOPS, Andy Wingo, 2015/01/23
- [Guile-commits] 88/88: Simplify and optimize slot access, Andy Wingo, 2015/01/23