mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 08:10:31 +02:00
Code Activity

Syntax uses scm_allocate_tagged

Browse source 
* libguile/syntax.c: Define a "struct scm_syntax".  Use it instead of
scm_words and SCM_CELL_OBJECT.
This commit is contained in:
Andy Wingo 2025-06-23 21:06:31 +02:00
parent a5f9d0da6a
commit 61af4d201a
1 changed files with 32 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/syntax.c
View file

@ -40,14 +40,13 @@
enum struct scm_syntax
{ {
TAG_WORD, scm_t_bits tag;
EXPR_WORD, SCM expr;
WRAP_WORD, SCM wrap;
MODULE_WORD, SCM module;
SOURCE_WORD, SCM source;
WORD_COUNT
}; };
static int static int
@ -56,6 +55,20 @@ scm_is_syntax (SCM x)
return SCM_HAS_TYP7 (x, scm_tc7_syntax); return SCM_HAS_TYP7 (x, scm_tc7_syntax);
} }
static inline struct scm_syntax *
scm_to_syntax (SCM x)
{
if (!scm_is_syntax (x))
abort ();
return (struct scm_syntax *) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_from_syntax (struct scm_syntax *stx)
{
return SCM_PACK_POINTER (stx);
}
#define SCM_VALIDATE_SYNTAX(pos, scm) \ #define SCM_VALIDATE_SYNTAX(pos, scm) \
SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_syntax, "syntax object") SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_syntax, "syntax object")
@ -79,13 +92,15 @@ SCM_DEFINE (scm_make_syntax, "make-syntax", 3, 1, 0,
else if (!scm_is_eq (source, SCM_BOOL_F)) else if (!scm_is_eq (source, SCM_BOOL_F))
SCM_VALIDATE_VECTOR (1, source); SCM_VALIDATE_VECTOR (1, source);
SCM ret = scm_words (scm_tc7_syntax, WORD_COUNT); struct scm_syntax *ret = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
SCM_SET_CELL_OBJECT (ret, EXPR_WORD, exp); sizeof (*ret));
SCM_SET_CELL_OBJECT (ret, WRAP_WORD, wrap); ret->tag = scm_tc7_syntax;
SCM_SET_CELL_OBJECT (ret, MODULE_WORD, module); ret->expr = exp;
SCM_SET_CELL_OBJECT (ret, SOURCE_WORD, source); ret->wrap = wrap;
ret->module = module;
ret->source = source;
return ret; return scm_from_syntax (ret);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -95,7 +110,7 @@ SCM_DEFINE (scm_syntax_expression, "syntax-expression", 1, 0, 0,
#define FUNC_NAME s_scm_syntax_expression #define FUNC_NAME s_scm_syntax_expression
{ {
SCM_VALIDATE_SYNTAX (1, obj); SCM_VALIDATE_SYNTAX (1, obj);
return SCM_CELL_OBJECT (obj, EXPR_WORD); return scm_to_syntax (obj)->expr;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -105,7 +120,7 @@ SCM_DEFINE (scm_syntax_wrap, "syntax-wrap", 1, 0, 0,
#define FUNC_NAME s_scm_syntax_wrap #define FUNC_NAME s_scm_syntax_wrap
{ {
SCM_VALIDATE_SYNTAX (1, obj); SCM_VALIDATE_SYNTAX (1, obj);
return SCM_CELL_OBJECT (obj, WRAP_WORD); return scm_to_syntax (obj)->wrap;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -115,7 +130,7 @@ SCM_DEFINE (scm_syntax_module, "syntax-module", 1, 0, 0,
#define FUNC_NAME s_scm_syntax_module #define FUNC_NAME s_scm_syntax_module
{ {
SCM_VALIDATE_SYNTAX (1, obj); SCM_VALIDATE_SYNTAX (1, obj);
return SCM_CELL_OBJECT (obj, MODULE_WORD); return scm_to_syntax (obj)->module;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -128,7 +143,7 @@ SCM_DEFINE (scm_syntax_source, "syntax-source", 1, 0, 0,
#define FUNC_NAME s_scm_syntax_source #define FUNC_NAME s_scm_syntax_source
{ {
SCM_VALIDATE_SYNTAX (1, obj); SCM_VALIDATE_SYNTAX (1, obj);
return SCM_CELL_OBJECT (obj, SOURCE_WORD); return scm_to_syntax (obj)->source;
} }
#undef FUNC_NAME #undef FUNC_NAME