[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/06: Keywords have a tc7
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/06: Keywords have a tc7 |
Date: |
Wed, 21 Jan 2015 14:23:00 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit d3c5e9b34eb9257d6268adcd30fedd202b58bd90
Author: Andy Wingo <address@hidden>
Date: Mon Jan 19 16:57:42 2015 +0100
Keywords have a tc7
* libguile/tags.h (scm_tc7_keyword): Allocate a tc7, so that the VM can
have cheap keyword? tests.
* libguile/keywords.c:
* libguile/keywords.h: Adapt.
* libguile/goops.c (scm_class_of, scm_sys_goops_early_init): Capture
<keyword>.
* libguile/print.c (iprin1): Inline keyword printer.
* libguile/evalext.c (scm_self_evaluating_p): Add keywords here.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_tc16_keyword): Deprecate.
* module/language/cps/compile-bytecode.scm (compile-fun): Add keyword?
case, and bitvector? case while we're at it.
* module/language/cps/effects-analysis.scm (define-primitive-effects):
Add bytevector?, keyword?, and bitvector? cases.
* module/language/cps/primitives.scm (*branching-primcall-arities*): Add
keyword?.
* module/language/cps/types.scm (bitvector?, keyword?, bytevector?): Add
branch inferrers.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
(*effect-free-primitives*):
(*effect+exception-free-primitives*): Add bytevector?, keyword?, and
bitvector?.
* module/oop/goops.scm (<keyword>): New class.
* module/system/base/types.scm (%tc7-keyword, cell->object): Add cases.
* module/system/vm/assembler.scm (br-if-keyword): New definition.
* module/system/vm/disassembler.scm (code-annotation): Add br-if-tc7
case for keywords.
* test-suite/tests/types.test ("clonable objects"): Update now that
keywords are cloneable.
---
libguile/deprecated.c | 7 ++++-
libguile/deprecated.h | 4 +++
libguile/evalext.c | 3 +-
libguile/goops.c | 4 +++
libguile/keywords.c | 33 ++++++++------------------
libguile/keywords.h | 6 +----
libguile/print.c | 6 ++++-
libguile/tags.h | 4 +-
module/language/cps/compile-bytecode.scm | 2 +
module/language/cps/effects-analysis.scm | 5 +++-
module/language/cps/primitives.scm | 3 +-
module/language/cps/specialize-primcalls.scm | 10 +------
module/language/cps/types.scm | 5 +++-
module/language/tree-il/compile-cps.scm | 18 +++++++++++++-
module/language/tree-il/primitives.scm | 5 +++-
module/oop/goops.scm | 1 +
module/system/base/types.scm | 5 +++-
module/system/vm/assembler.scm | 1 +
module/system/vm/disassembler.scm | 3 +-
test-suite/tests/types.test | 5 +--
20 files changed, 79 insertions(+), 51 deletions(-)
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index e6a2871..cbd415d 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -193,7 +193,7 @@ scm_init_deprecated_goops (void)
scm_class_real = scm_variable_ref (scm_c_lookup ("<real>"));
scm_class_integer = scm_variable_ref (scm_c_lookup ("<integer>"));
scm_class_fraction = scm_variable_ref (scm_c_lookup ("<fraction>"));
- scm_class_keyword = scm_i_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)];
+ scm_class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
scm_class_unknown = scm_variable_ref (scm_c_lookup ("<unknown>"));
scm_class_procedure = scm_variable_ref (scm_c_lookup ("<procedure>"));
scm_class_primitive_generic = scm_variable_ref (scm_c_lookup
("<primitive-generic>"));
@@ -488,6 +488,11 @@ scm_slot_exists_using_class_p (SCM class, SCM obj, SCM
slot_name)
+scm_t_bits scm_tc16_keyword = scm_tc7_keyword;
+
+
+
+
void
scm_i_init_deprecated ()
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 1f13bde..cfbc764 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -219,6 +219,10 @@ SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls,
SCM obj, SCM slot_nam
+SCM_DEPRECATED scm_t_bits scm_tc16_keyword;
+
+
+
void scm_i_init_deprecated (void);
#endif
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 48a9eff..48d9a17 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011,
2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011,
2012, 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 License
@@ -81,6 +81,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0,
0,
case scm_tc7_fluid:
case scm_tc7_dynamic_state:
case scm_tc7_frame:
+ case scm_tc7_keyword:
case scm_tc7_vm_cont:
case scm_tc7_number:
case scm_tc7_string:
diff --git a/libguile/goops.c b/libguile/goops.c
index d3561e8..b7218ff 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -127,6 +127,7 @@ static SCM class_hashtable;
static SCM class_fluid;
static SCM class_dynamic_state;
static SCM class_frame;
+static SCM class_keyword;
static SCM class_vm_cont;
static SCM class_bytevector;
static SCM class_uvec;
@@ -232,6 +233,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return class_dynamic_state;
case scm_tc7_frame:
return class_frame;
+ case scm_tc7_keyword:
+ return class_keyword;
case scm_tc7_vm_cont:
return class_vm_cont;
case scm_tc7_bytevector:
@@ -970,6 +973,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init",
0, 0, 0,
class_fluid = scm_variable_ref (scm_c_lookup ("<fluid>"));
class_dynamic_state = scm_variable_ref (scm_c_lookup ("<dynamic-state>"));
class_frame = scm_variable_ref (scm_c_lookup ("<frame>"));
+ class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
class_vm_cont = scm_variable_ref (scm_c_lookup ("<vm-continuation>"));
class_bytevector = scm_variable_ref (scm_c_lookup ("<bytevector>"));
class_uvec = scm_variable_ref (scm_c_lookup ("<uvec>"));
diff --git a/libguile/keywords.c b/libguile/keywords.c
index f630259..49cccd5 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- * 2006, 2008, 2009, 2011, 2013 Free Software Foundation, Inc.
+ * 2006, 2008, 2009, 2011, 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 License
@@ -41,18 +41,8 @@
static SCM keyword_obarray;
-scm_t_bits scm_tc16_keyword;
-
-#define KEYWORDP(X) (SCM_SMOB_PREDICATE (scm_tc16_keyword, (X)))
-#define KEYWORDSYM(X) (SCM_SMOB_OBJECT (X))
-
-static int
-keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
- scm_puts_unlocked ("#:", port);
- scm_display (KEYWORDSYM (exp), port);
- return 1;
-}
+#define SCM_KEYWORDP(x) (SCM_HAS_TYP7 (x, scm_tc7_keyword))
+#define SCM_KEYWORD_SYMBOL(x) (SCM_CELL_OBJECT_1 (x))
SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
(SCM obj),
@@ -60,7 +50,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
"@code{#f}.")
#define FUNC_NAME s_scm_keyword_p
{
- return scm_from_bool (KEYWORDP (obj));
+ return scm_from_bool (SCM_KEYWORDP (obj));
}
#undef FUNC_NAME
@@ -74,11 +64,12 @@ SCM_DEFINE (scm_symbol_to_keyword, "symbol->keyword", 1, 0,
0,
SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, 0, NULL, "symbol");
SCM_CRITICAL_SECTION_START;
- /* njrev: NEWSMOB and hashq_set_x can raise errors */
+ /* Note: `scm_cell' and `scm_hashq_set_x' can raise an out-of-memory
+ error. */
keyword = scm_hashq_ref (keyword_obarray, symbol, SCM_BOOL_F);
if (scm_is_false (keyword))
{
- SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
+ keyword = scm_cell (scm_tc7_keyword, SCM_UNPACK (symbol));
scm_hashq_set_x (keyword_obarray, symbol, keyword);
}
SCM_CRITICAL_SECTION_END;
@@ -91,15 +82,15 @@ SCM_DEFINE (scm_keyword_to_symbol, "keyword->symbol", 1, 0,
0,
"Return the symbol with the same name as @var{keyword}.")
#define FUNC_NAME s_scm_keyword_to_symbol
{
- scm_assert_smob_type (scm_tc16_keyword, keyword);
- return KEYWORDSYM (keyword);
+ SCM_VALIDATE_KEYWORD (1, keyword);
+ return SCM_KEYWORD_SYMBOL (keyword);
}
#undef FUNC_NAME
int
scm_is_keyword (SCM val)
{
- return KEYWORDP (val);
+ return SCM_KEYWORDP (val);
}
SCM
@@ -195,13 +186,9 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
}
}
-/* njrev: critical sections reviewed so far up to here */
void
scm_init_keywords ()
{
- scm_tc16_keyword = scm_make_smob_type ("keyword", 0);
- scm_set_smob_print (scm_tc16_keyword, keyword_print);
-
keyword_obarray = scm_c_make_hash_table (0);
#include "libguile/keywords.x"
}
diff --git a/libguile/keywords.h b/libguile/keywords.h
index 3cdb0ec..32311dd 100644
--- a/libguile/keywords.h
+++ b/libguile/keywords.h
@@ -3,7 +3,7 @@
#ifndef SCM_KEYWORDS_H
#define SCM_KEYWORDS_H
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 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
@@ -27,10 +27,6 @@
-SCM_API scm_t_bits scm_tc16_keyword;
-
-
-
SCM_API SCM scm_keyword_p (SCM obj);
SCM_API SCM scm_symbol_to_keyword (SCM symbol);
SCM_API SCM scm_keyword_to_symbol (SCM keyword);
diff --git a/libguile/print.c b/libguile/print.c
index 684b3d4..0a2067f 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- * 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ * 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
@@ -776,6 +776,10 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_frame:
scm_i_frame_print (exp, port, pstate);
break;
+ case scm_tc7_keyword:
+ scm_puts_unlocked ("#:", port);
+ scm_iprin1 (scm_keyword_to_symbol (exp), port, pstate);
+ break;
case scm_tc7_vm_cont:
scm_i_vm_cont_print (exp, port, pstate);
break;
diff --git a/libguile/tags.h b/libguile/tags.h
index 53d40d8..a5082f8 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -3,7 +3,7 @@
#ifndef SCM_TAGS_H
#define SCM_TAGS_H
-/* Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
+/* Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014,2015
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -416,7 +416,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_dynamic_state 45
#define scm_tc7_frame 47
-#define scm_tc7_unused_53 53
+#define scm_tc7_keyword 53
#define scm_tc7_unused_55 55
#define scm_tc7_vm_cont 71
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index e6dfaad..9537e9c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -434,6 +434,8 @@
(($ $primcall 'vector? (a)) (unary emit-br-if-vector a))
(($ $primcall 'string? (a)) (unary emit-br-if-string a))
(($ $primcall 'bytevector? (a)) (unary emit-br-if-bytevector a))
+ (($ $primcall 'bitvector? (a)) (unary emit-br-if-bitvector a))
+ (($ $primcall 'keyword? (a)) (unary emit-br-if-keyword a))
;; Add more TC7 tests here. Keep in sync with
;; *branching-primcall-arities* in (language cps primitives) and
;; the set of macro-instructions in assembly.scm.
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 246b22e..8951b40 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
;;; Effects analysis on CPS
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -273,6 +273,9 @@ is or might be a read or a write to the same location as A."
((string? arg))
((number? arg))
((char? arg))
+ ((bytevector? arg))
+ ((keyword? arg))
+ ((bitvector? arg))
((procedure? arg))
((thunk? arg)))
diff --git a/module/language/cps/primitives.scm
b/module/language/cps/primitives.scm
index a095fce..5f7f474 100644
--- a/module/language/cps/primitives.scm
+++ b/module/language/cps/primitives.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -75,6 +75,7 @@
(string? . (1 . 1))
(vector? . (1 . 1))
(symbol? . (1 . 1))
+ (keyword? . (1 . 1))
(variable? . (1 . 1))
(bitvector? . (1 . 1))
(bytevector? . (1 . 1))
diff --git a/module/language/cps/specialize-primcalls.scm
b/module/language/cps/specialize-primcalls.scm
index e03eb62..0502fe6 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -95,14 +95,8 @@
(('struct-ref s (? immediate-u8? n))
(adapt-val ($primcall 'struct-ref/immediate (s n))))
(('struct-set! s (? immediate-u8? n) x)
- ;; Unhappily, and undocumentedly, struct-set! returns the value
- ;; that was set. There is code that relies on this. Hackety
- ;; hack...
- (let-fresh (k*) ()
- (build-cps-term
- ($letk ((k* ($kargs () ()
- ($continue k src ($primcall 'values (x))))))
- ($continue k* src ($primcall 'struct-set!/immediate (s n
x)))))))
+ (build-cps-term
+ ($continue k src ($primcall 'struct-set!/immediate (s n x)))))
(_
(build-cps-term ($continue k src ($primcall name args))))))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index ca90f50..934fa11 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1,5 +1,5 @@
;;; Type analysis on CPS
-;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 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 as
@@ -480,6 +480,9 @@ minimum, and maximum."
(define-simple-predicate-inferrer vector? &vector)
(define-simple-predicate-inferrer struct? &struct)
(define-simple-predicate-inferrer string? &string)
+(define-simple-predicate-inferrer bytevector? &bytevector)
+(define-simple-predicate-inferrer bitvector? &bitvector)
+(define-simple-predicate-inferrer keyword? &keyword)
(define-simple-predicate-inferrer number? &number)
(define-simple-predicate-inferrer char? &char)
(define-simple-predicate-inferrer procedure? &procedure)
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 3822316..a5afa7a 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -682,6 +682,22 @@ integer."
(make-lexical-ref src 'v v)
(reverse args) (reverse (iota len))))))
+ (($ <primcall> src 'struct-set! (struct index value))
+ ;; Unhappily, and undocumentedly, struct-set! returns the value
+ ;; that was set. There is code that relies on this. Hackety
+ ;; hack...
+ (let ((v (gensym "v ")))
+ (make-let src
+ (list 'v)
+ (list v)
+ (list value)
+ (make-seq src
+ (make-primcall src 'struct-set!
+ (list struct
+ index
+ (make-lexical-ref src 'v
v)))
+ (make-lexical-ref src 'v v)))))
+
(($ <prompt> src escape-only? tag body
($ <lambda> hsrc hmeta
($ <lambda-case> _ hreq #f hrest #f () hsyms hbody #f)))
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index e4e6104..7bed783 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
;;; open-coding primitive procedures
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation,
Inc.
+;; Copyright (C) 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
@@ -51,6 +51,7 @@
sqrt abs
not
pair? null? list? symbol? vector? string? struct? number? char? nil?
+ bytevector? keyword? bitvector?
procedure? thunk?
@@ -170,6 +171,7 @@
not
pair? null? nil? list?
symbol? variable? vector? struct? string? number? char?
+ bytevector? keyword? bitvector?
complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
char<? char<=? char>=? char>?
integer->char char->integer number->string string->number
@@ -191,6 +193,7 @@
not
pair? null? nil? list?
symbol? variable? vector? struct? string? number? char?
+ bytevector? keyword? bitvector?
procedure? thunk?
acons cons cons* list vector))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 374c214..8f36f8d 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -932,6 +932,7 @@ slots as we go."
(define-standard-class <fluid> (<top>))
(define-standard-class <dynamic-state> (<top>))
(define-standard-class <frame> (<top>))
+(define-standard-class <keyword> (<top>))
(define-standard-class <vm-continuation> (<top>))
(define-standard-class <bytevector> (<top>))
(define-standard-class <uvec> (<bytevector>))
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 6c1d40d..c051b31 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -1,5 +1,5 @@
;;; 'SCM' type tag decoding.
-;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 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 as published by
@@ -251,6 +251,7 @@ the matching bits, possibly with bitwise operations to
extract it from BITS."
(define %tc7-stringbuf 39)
(define %tc7-dynamic-state 45)
(define %tc7-frame 47)
+(define %tc7-keyword 53)
(define %tc7-program 69)
(define %tc7-vm-continuation 71)
(define %tc7-bytevector 77)
@@ -472,6 +473,8 @@ using BACKEND."
(inferior-object 'hash-table address))
(((_ & #x7f = %tc7-pointer) address)
(make-pointer address))
+ (((_ & #x7f = %tc7-keyword) symbol)
+ (symbol->keyword (cell->object symbol backend)))
(((_ & #x7f = %tc7-vm-continuation))
(inferior-object 'vm-continuation address))
(((_ & #x7f = %tc7-weak-set))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8b9a70e..19f8120 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1002,6 +1002,7 @@ returned instead."
;(define-tc7-macro-assembler br-if-fluid 37)
;(define-tc7-macro-assembler br-if-dynamic-state 45)
;(define-tc7-macro-assembler br-if-frame 47)
+(define-tc7-macro-assembler br-if-keyword 53)
;(define-tc7-macro-assembler br-if-vm 55)
;(define-tc7-macro-assembler br-if-vm-cont 71)
;(define-tc7-macro-assembler br-if-rtl-program 69)
diff --git a/module/system/vm/disassembler.scm
b/module/system/vm/disassembler.scm
index adacf1b..08aa057 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -1,6 +1,6 @@
;;; Guile bytecode disassembler
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014 Free Software Foundation,
Inc.
+;;; Copyright (C) 2001, 2009, 2010, 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
@@ -215,6 +215,7 @@ address of that offset."
((7) "variable?")
((13) "vector?")
((15) "string?")
+ ((53) "keyword?")
((77) "bytevector?")
((95) "bitvector?")
(else (number->string tc7)))))
diff --git a/test-suite/tests/types.test b/test-suite/tests/types.test
index ea71d3c..c68262b 100644
--- a/test-suite/tests/types.test
+++ b/test-suite/tests/types.test
@@ -1,6 +1,6 @@
;;;; types.test --- Type tag decoding. -*- mode: scheme; coding: utf-8;
-*-
;;;;
-;;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
;;;;
;;;; This file is part of GNU Guile.
;;;;
@@ -48,7 +48,7 @@
42 (expt 2 28) 3.14
"narrow string" "wide στρινγ"
'symbol 'λ
- ;; NB: keywords are SMOBs.
+ #:keyword #:λ
'(2 . 3) (iota 123) '(1 (two ("three")))
#(1 2 3) #(foo bar baz)
#vu8(255 254 253)
@@ -98,7 +98,6 @@
(with-test-prefix "opaque objects"
(test-inferior-objects
((make-guardian) smob (? integer?))
- (#:keyword smob (? integer?))
((%make-void-port "w") port (? integer?))
((open-input-string "hello") port (? integer?))
((lambda () #t) program _)
- [Guile-commits] branch wip-goops-refactor updated (9eac2c6 -> 39f3232), Andy Wingo, 2015/01/21
- [Guile-commits] 01/06: Minor GOOPS cleanups, Andy Wingo, 2015/01/21
- [Guile-commits] 06/06: Fast generic function dispatch without calling `compile' at runtime, Andy Wingo, 2015/01/21
- [Guile-commits] 03/06: Fix foreign objects for removal of getters-n-setters, Andy Wingo, 2015/01/21
- [Guile-commits] 05/06: GOOPS cosmetics, Andy Wingo, 2015/01/21
- [Guile-commits] 04/06: Update (oop goops save) for <slot> objects, Andy Wingo, 2015/01/21
- [Guile-commits] 02/06: Keywords have a tc7,
Andy Wingo <=