From 567a6d1ee7efc3982748d3bd894057a76f076706 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 16 Jan 2015 13:50:21 +0100 Subject: [PATCH] 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*): 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 c7e775c86..286f3c7dc 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 4516a68dc..0e5983575 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 ac8493dd0..fa6c85a33 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 ()) + +(define *undefined* (make )) (define *this* (make-fluid)) (define-class () diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 220416f6f..62b5f5a67 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 (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 83517c694..e9f606947 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 a3492a904..a4b15ad20 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] ;;; -- 2.20.1