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

allow iflags to be constant expressions with typing-strictness==2

Browse source 
* libguile/tags.h (SCM_MAKE_ITAG8_BITS): New helper, produces a
  scm_t_bits instead of a SCM, because SCM_UNPACK is not a constant
  expression with SCM_DEBUG_TYPING_STRICTNESS==2.
  (SCM_MAKIFLAG_BITS): Remove SCM_MAKIFLAG, and replace with this, which
  returns bits.
  (SCM_BOOL_F_BITS, SCM_ELISP_NIL_BITS, SCM_EOL_BITS, SCM_BOOL_T_BITS):
  (SCM_UNSPECIFIED_BITS, SCM_UNDEFINED_BITS, SCM_EOF_VAL_BITS):
  (SCM_UNBOUND_BITS): New definitions.  Defined SCM_BOOL_F, etc in terms
  of them.
  (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0):
  (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1):
  (SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2):
  (SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE): Be bits instead of SCM values.
  (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION):
  (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS): Rename from
  SCM_VALUES_DIFFER_..., and take unpacked bits as the args.

* libguile/boolean.c: Update verify block to use
  SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS et al.

* libguile/debug.c (scm_debug_opts):
* libguile/print.c (scm_print_opts):
* libguile/read.c (scm_read_opts): Use iflags bits for initializers.

* libguile/hash.c (scm_hasher): Use _BITS for iflags as case labels.

* libguile/pairs.c: Nil/null compile-time check uses
  SCM_ELISP_NIL_BITS.
This commit is contained in:
Andy Wingo 2011-05-13 10:19:48 +02:00
parent 544a29de14
commit 210c0325d3
7 changed files with 58 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

26
libguile/boolean.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. /* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -40,18 +40,18 @@
* See the comments preceeding the definitions of SCM_BOOL_F and * See the comments preceeding the definitions of SCM_BOOL_F and
* SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
*/ */
verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
(SCM_BOOL_F, SCM_BOOL_T)); (SCM_BOOL_F_BITS, SCM_BOOL_T_BITS));
verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
(SCM_ELISP_NIL, SCM_BOOL_F)); (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS));
verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
(SCM_ELISP_NIL, SCM_EOL)); (SCM_ELISP_NIL_BITS, SCM_EOL_BITS));
verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \
(SCM_ELISP_NIL, SCM_BOOL_F, SCM_BOOL_T, \ (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_BOOL_T_BITS, \
SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0)); SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0));
verify (SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \ verify (SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS \
(SCM_ELISP_NIL, SCM_BOOL_F, SCM_EOL, \ (SCM_ELISP_NIL_BITS, SCM_BOOL_F_BITS, SCM_EOL_BITS, \
SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE)); SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE));
SCM_DEFINE (scm_not, "not", 1, 0, 0, SCM_DEFINE (scm_not, "not", 1, 0, 0,
(SCM x), (SCM x),

4
libguile/debug.c
View file

@ -1,5 +1,5 @@
/* Debugging extensions for Guile /* Debugging extensions for Guile
* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 Free Software Foundation * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -82,7 +82,7 @@ scm_t_option scm_debug_opts[] = {
for anyone!) or a whoppin' 1280 KB on 64-bit arches. for anyone!) or a whoppin' 1280 KB on 64-bit arches.
*/ */
{ SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." }, { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." },
{ SCM_OPTION_SCM, "show-file-name", (scm_t_bits)SCM_BOOL_T, { SCM_OPTION_SCM, "show-file-name", SCM_BOOL_T_BITS,
"Show file names and line numbers " "Show file names and line numbers "
"in backtraces when not `#f'. A value of `base' " "in backtraces when not `#f'. A value of `base' "
"displays only base names, while `#t' displays full names."}, "displays only base names, while `#t' displays full names."},

10
libguile/hash.c
View file

@ -160,18 +160,16 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
if (SCM_CHARP(obj)) if (SCM_CHARP(obj))
return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n; return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n;
switch (SCM_UNPACK (obj)) { switch (SCM_UNPACK (obj)) {
#ifndef SICP case SCM_EOL_BITS:
case SCM_UNPACK(SCM_EOL):
d = 256; d = 256;
break; break;
#endif case SCM_BOOL_T_BITS:
case SCM_UNPACK(SCM_BOOL_T):
d = 257; d = 257;
break; break;
case SCM_UNPACK(SCM_BOOL_F): case SCM_BOOL_F_BITS:
d = 258; d = 258;
break; break;
case SCM_UNPACK(SCM_EOF_VAL): case SCM_EOF_VAL_BITS:
d = 259; d = 259;
break; break;
default: default:

6
libguile/pairs.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -42,8 +42,8 @@
* See the comments preceeding the definitions of SCM_BOOL_F and * See the comments preceeding the definitions of SCM_BOOL_F and
* SCM_MATCHES_BITS_IN_COMMON in tags.h for more information. * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information.
*/ */
verify (SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \ verify (SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION \
(SCM_ELISP_NIL, SCM_EOL)); (SCM_ELISP_NIL_BITS, SCM_EOL_BITS));
#if (SCM_DEBUG_PAIR_ACCESSES == 1) #if (SCM_DEBUG_PAIR_ACCESSES == 1)

6
libguile/print.c
View file

@ -100,11 +100,11 @@ static const char *iflagnames[] =
SCM_SYMBOL (sym_reader, "reader"); SCM_SYMBOL (sym_reader, "reader");
scm_t_option scm_print_opts[] = { scm_t_option scm_print_opts[] = {
{ SCM_OPTION_SCM, "highlight-prefix", (scm_t_bits)SCM_BOOL_F, { SCM_OPTION_SCM, "highlight-prefix", (scm_t_bits)SCM_BOOL_F_BITS,
"The string to print before highlighted values." }, "The string to print before highlighted values." },
{ SCM_OPTION_SCM, "highlight-suffix", (scm_t_bits)SCM_BOOL_F, { SCM_OPTION_SCM, "highlight-suffix", (scm_t_bits)SCM_BOOL_F_BITS,
"The string to print after highlighted values." }, "The string to print after highlighted values." },
{ SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F, { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F_BITS,
"How to print symbols that have a colon as their first or last character. " "How to print symbols that have a colon as their first or last character. "
"The value '#f' does not quote the colons; '#t' quotes them; " "The value '#f' does not quote the colons; '#t' quotes them; "
"'reader' quotes them when the reader option 'keywords' is not '#f'." "'reader' quotes them when the reader option 'keywords' is not '#f'."

2
libguile/read.c
View file

@ -70,7 +70,7 @@ scm_t_option scm_read_opts[] = {
"Record positions of source code expressions." }, "Record positions of source code expressions." },
{ SCM_OPTION_BOOLEAN, "case-insensitive", 0, { SCM_OPTION_BOOLEAN, "case-insensitive", 0,
"Convert symbols to lower case."}, "Convert symbols to lower case."},
{ SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F, { SCM_OPTION_SCM, "keywords", (scm_t_bits) SCM_BOOL_F_BITS,
"Style of keyword recognition: #f, 'prefix or 'postfix."}, "Style of keyword recognition: #f, 'prefix or 'postfix."},
{ SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0, { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0,
"Use R6RS variable-length character and string hex escapes."}, "Use R6RS variable-length character and string hex escapes."},

52
libguile/tags.h
View file

@ -464,7 +464,8 @@ enum scm_tc8_tags
}; };
#define SCM_ITAG8(X) (SCM_UNPACK (X) & 0xff) #define SCM_ITAG8(X) (SCM_UNPACK (X) & 0xff)
#define SCM_MAKE_ITAG8(X, TAG) SCM_PACK (((X) << 8) + TAG) #define SCM_MAKE_ITAG8_BITS(X, TAG) (((X) << 8) + TAG)
#define SCM_MAKE_ITAG8(X, TAG) (SCM_PACK (SCM_MAKE_ITAG8_BITS (X, TAG)))
#define SCM_ITAG8_DATA(X) (SCM_UNPACK (X) >> 8) #define SCM_ITAG8_DATA(X) (SCM_UNPACK (X) >> 8)
@ -473,7 +474,7 @@ enum scm_tc8_tags
* declarations in print.c: iflagnames. */ * declarations in print.c: iflagnames. */
#define SCM_IFLAGP(n) (SCM_ITAG8 (n) == scm_tc8_flag) #define SCM_IFLAGP(n) (SCM_ITAG8 (n) == scm_tc8_flag)
#define SCM_MAKIFLAG(n) SCM_MAKE_ITAG8 ((n), scm_tc8_flag) #define SCM_MAKIFLAG_BITS(n) (SCM_MAKE_ITAG8_BITS ((n), scm_tc8_flag))
#define SCM_IFLAGNUM(n) (SCM_ITAG8_DATA (n)) #define SCM_IFLAGNUM(n) (SCM_ITAG8_DATA (n))
/* /*
@ -507,25 +508,35 @@ enum scm_tc8_tags
* defined below. The properties are checked at compile-time using * defined below. The properties are checked at compile-time using
* `verify' macros near the top of boolean.c and pairs.c. * `verify' macros near the top of boolean.c and pairs.c.
*/ */
#define SCM_BOOL_F SCM_MAKIFLAG (0) #define SCM_BOOL_F_BITS SCM_MAKIFLAG_BITS (0)
#define SCM_ELISP_NIL SCM_MAKIFLAG (1) #define SCM_ELISP_NIL_BITS SCM_MAKIFLAG_BITS (1)
#define SCM_BOOL_F SCM_PACK (SCM_BOOL_F_BITS)
#define SCM_ELISP_NIL SCM_PACK (SCM_ELISP_NIL_BITS)
#ifdef BUILDING_LIBGUILE #ifdef BUILDING_LIBGUILE
#define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE SCM_MAKIFLAG (2) #define SCM_XXX_ANOTHER_LISP_FALSE_DONT_USE SCM_MAKIFLAG_BITS (2)
#endif #endif
#define SCM_EOL SCM_MAKIFLAG (3) #define SCM_EOL_BITS SCM_MAKIFLAG_BITS (3)
#define SCM_BOOL_T SCM_MAKIFLAG (4) #define SCM_BOOL_T_BITS SCM_MAKIFLAG_BITS (4)
#define SCM_EOL SCM_PACK (SCM_EOL_BITS)
#define SCM_BOOL_T SCM_PACK (SCM_BOOL_T_BITS)
#ifdef BUILDING_LIBGUILE #ifdef BUILDING_LIBGUILE
#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0 SCM_MAKIFLAG (5) #define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_0 SCM_MAKIFLAG_BITS (5)
#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1 SCM_MAKIFLAG (6) #define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_1 SCM_MAKIFLAG_BITS (6)
#define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2 SCM_MAKIFLAG (7) #define SCM_XXX_ANOTHER_BOOLEAN_DONT_USE_2 SCM_MAKIFLAG_BITS (7)
#endif #endif
#define SCM_UNSPECIFIED SCM_MAKIFLAG (8) #define SCM_UNSPECIFIED_BITS SCM_MAKIFLAG_BITS (8)
#define SCM_UNDEFINED SCM_MAKIFLAG (9) #define SCM_UNDEFINED_BITS SCM_MAKIFLAG_BITS (9)
#define SCM_EOF_VAL SCM_MAKIFLAG (10) #define SCM_EOF_VAL_BITS SCM_MAKIFLAG_BITS (10)
#define SCM_UNSPECIFIED SCM_PACK (SCM_UNSPECIFIED_BITS)
#define SCM_UNDEFINED SCM_PACK (SCM_UNDEFINED_BITS)
#define SCM_EOF_VAL SCM_PACK (SCM_EOF_VAL_BITS)
/* When a variable is unbound this is marked by the SCM_UNDEFINED /* When a variable is unbound this is marked by the SCM_UNDEFINED
* value. The following is an unbound value which can be handled on * value. The following is an unbound value which can be handled on
@ -535,7 +546,8 @@ enum scm_tc8_tags
* the code which handles this value in C so that SCM_UNDEFINED can be * the code which handles this value in C so that SCM_UNDEFINED can be
* used instead. It is not ideal to let this kind of unique and * used instead. It is not ideal to let this kind of unique and
* strange values loose on the Scheme level. */ * strange values loose on the Scheme level. */
#define SCM_UNBOUND SCM_MAKIFLAG (11) #define SCM_UNBOUND_BITS SCM_MAKIFLAG_BITS (11)
#define SCM_UNBOUND SCM_PACK (SCM_UNBOUND_BITS)
#define SCM_UNBNDP(x) (scm_is_eq ((x), SCM_UNDEFINED)) #define SCM_UNBNDP(x) (scm_is_eq ((x), SCM_UNDEFINED))
@ -574,12 +586,12 @@ enum scm_tc8_tags
#define SCM_HAS_EXACTLY_TWO_BITS_SET(x) \ #define SCM_HAS_EXACTLY_TWO_BITS_SET(x) \
(SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x))) (SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_WITH_LEAST_SIGNIFICANT_1_BIT_CLEARED (x)))
#define SCM_VALUES_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b) \ #define SCM_BITS_DIFFER_IN_EXACTLY_ONE_BIT_POSITION(a,b) \
(SCM_HAS_EXACTLY_ONE_BIT_SET (SCM_UNPACK(a) ^ SCM_UNPACK(b))) (SCM_HAS_EXACTLY_ONE_BIT_SET ((a) ^ (b)))
#define SCM_VALUES_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d) \ #define SCM_BITS_DIFFER_IN_EXACTLY_TWO_BIT_POSITIONS(a,b,c,d) \
(SCM_HAS_EXACTLY_TWO_BITS_SET ((SCM_UNPACK(a) ^ SCM_UNPACK(b)) | \ (SCM_HAS_EXACTLY_TWO_BITS_SET (((a) ^ (b)) | \
(SCM_UNPACK(b) ^ SCM_UNPACK(c)) | \ ((b) ^ (c)) | \
(SCM_UNPACK(c) ^ SCM_UNPACK(d)))) ((c) ^ (d))))
#endif /* BUILDING_LIBGUILE */ #endif /* BUILDING_LIBGUILE */