mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 23:30:28 +02:00
Code Activity

Fix GOOPS for <regexp>

Browse source 
* module/oop/goops.scm (<regexp>):
* libguile/goops.c: (scm_class_of): Give regexps their own class; it
doesn't come from smobs.
This commit is contained in:
Andy Wingo 2025-06-18 10:58:08 +02:00
parent 2a015937ca
commit 6ba6fbdf64
2 changed files with 6 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/goops.c
View file

@ -144,6 +144,7 @@ static SCM class_continuation;
static SCM class_directory; static SCM class_directory;
static SCM class_macro; static SCM class_macro;
static SCM class_random_state; static SCM class_random_state;
static SCM class_regexp;
static struct scm_ephemeron_table *vtable_class_map; static struct scm_ephemeron_table *vtable_class_map;
static SCM pre_goops_vtables = SCM_EOL; static SCM pre_goops_vtables = SCM_EOL;
@ -357,6 +358,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return class_macro; return class_macro;
case scm_tc16_random_state: case scm_tc16_random_state:
return class_random_state; return class_random_state;
case scm_tc16_regexp:
return class_regexp;
default: default:
abort (); abort ();
} }
@ -998,6 +1001,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
class_directory = scm_variable_ref (scm_c_lookup ("<directory>")); class_directory = scm_variable_ref (scm_c_lookup ("<directory>"));
class_macro = scm_variable_ref (scm_c_lookup ("<macro>")); class_macro = scm_variable_ref (scm_c_lookup ("<macro>"));
class_random_state = scm_variable_ref (scm_c_lookup ("<random-state>")); class_random_state = scm_variable_ref (scm_c_lookup ("<random-state>"));
class_regexp = scm_variable_ref (scm_c_lookup ("<regexp>"));
create_smob_classes (); create_smob_classes ();
create_struct_classes (); create_struct_classes ();

10
module/oop/goops.scm
View file

@ -72,7 +72,7 @@
<keyword> <syntax> <atomic-box> <thread> <bitvector> <keyword> <syntax> <atomic-box> <thread> <bitvector>
<finalizer> <ephemeron> <ephemeron-table> <character-set> <finalizer> <ephemeron> <ephemeron-table> <character-set>
<mutex> <condition-variable> <continuation> <directory> <mutex> <condition-variable> <continuation> <directory>
<array> <random-state> <array> <random-state> <regexp>
;; Numbers. ;; Numbers.
<number> <complex> <real> <integer> <fraction> <number> <complex> <real> <integer> <fraction>
@ -84,7 +84,6 @@
;; have corresponding classes, which may be obtained via ;; have corresponding classes, which may be obtained via
;; class-of, once you have an instance. Perhaps FIXME to ;; class-of, once you have an instance. Perhaps FIXME to
;; provide a smob-type-name->class procedure. ;; provide a smob-type-name->class procedure.
<regexp>
<dynamic-object> <dynamic-object>
;; Modules. ;; Modules.
@ -1089,6 +1088,7 @@ slots as we go."
(define-standard-class <directory> (<top>)) (define-standard-class <directory> (<top>))
(define-standard-class <macro> (<top>)) (define-standard-class <macro> (<top>))
(define-standard-class <random-state> (<top>)) (define-standard-class <random-state> (<top>))
(define-standard-class <regexp> (<top>))
(define-standard-class <thread> (<top>)) (define-standard-class <thread> (<top>))
(define-standard-class <number> (<top>)) (define-standard-class <number> (<top>))
(define-standard-class <complex> (<number>)) (define-standard-class <complex> (<number>))
@ -3532,12 +3532,6 @@ var{initargs}."
;;;
;;; {SMOB and port classes}
;;;
(define <regexp> (find-subclass <top> '<regexp>))
;; <dynamic-object> used to be a SMOB type, albeit not exported even to ;; <dynamic-object> used to be a SMOB type, albeit not exported even to
;; C. However now it's a record type, though still private. Cross our ;; C. However now it's a record type, though still private. Cross our
;; fingers that nobody is using it in anger! ;; fingers that nobody is using it in anger!