Re: 16 snarf macros

[Dale P. Smith]

On Fri, 08 Mar 2002 11:49:52 -0800
Thien-Thi Nguyen <address@hidden> wrote:

>    From: "Dale P. Smith" <address@hidden>
>    Date: Fri, 8 Mar 2002 07:23:44 -0500
> 
>    I use SCM_PROC, SCM_SYMBOL and SCM_VARIABLE_INIT,
> 
> ok.
> 
>    along with SCM_SNARF_HERE, SCM_SNARF_INIT [...]
> 
> these are used in defining SCM_PROC et al.  i have a feeling they are an
> implementation detail that we might change (for some finicky reason, i
> dunno) in the future.  thus, i will refrain from documenting them at
> this time, unless some guile hacker makes a public gpg-signed blood vow
> that they will not change forever...
> 
> what do you use them for?  could you use SCM_VARIABLE, instead?

I use them in (the soon to be released) mod-guile.  I have created
macros that create functions that access apache data structures.  The
apache api is pretty ugly (pretty ugly! hah!) and is done through these
huge structs instead of nice function calls.  Here are some:


#define TYPE_GET(TYPE, GETTER, C_NAME, S_NAME)                          \
SCM_SNARF_HERE (\
static const char s_##TYPE##_get_##C_NAME [] = S_NAME;                  \
static SCM TYPE##_get_##C_NAME (SCM obj)                                \
{                                                                       \
  TYPE *o;                                                              \
  SCM_ASSERT(SCM_SMOB_PREDICATE(tc_##TYPE, obj), obj, SCM_ARG1, 
s_##TYPE##_get_##C_NAME);\
  o = (TYPE *) SCM_SMOB_DATA(obj);                                      \
  return GETTER;                                                        \
}\
)SCM_SNARF_INIT (\
  scm_c_define_gsubr(s_##TYPE##_get_##C_NAME, 1, 0, 0, TYPE##_get_##C_NAME);\
)


#define TYPE_SET(TYPE, SETTER, PRED, C_NAME, S_NAME)                    \
SCM_SNARF_HERE (\
static const char s_##TYPE##_set_##C_NAME [] = S_NAME;                  \
static SCM TYPE##_set_##C_NAME(SCM obj, SCM val)                        \
{                                                                       \
  TYPE *o;                                                              \
  SCM_ASSERT(SCM_SMOB_PREDICATE(tc_##TYPE, obj), obj, SCM_ARG1, 
s_##TYPE##_set_##C_NAME);\
  SCM_ASSERT(PRED(val), val, SCM_ARG2, s_##TYPE##_set_##C_NAME);        \
  o = (TYPE *) SCM_SMOB_DATA(obj);                                      \
  o->C_NAME = SETTER;                                                   \
  return SCM_UNSPECIFIED;                                               \
}\
)SCM_SNARF_INIT (\
  scm_c_define_gsubr(s_##TYPE##_set_##C_NAME, 2, 0, 0, TYPE##_set_##C_NAME);\
)


An then I have:

#define GET_INT(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, SCM_MAKINUM(o->C_NAME), C_NAME, S_NAME)

#define GET_STRING(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, scm_makfrom0str(o->C_NAME), C_NAME, S_NAME)

#define SET_INT(TYPE, C_NAME, S_NAME) \
TYPE_SET(TYPE, SCM_INUM(val), SCM_INUMP, C_NAME, S_NAME)

#define SET_STRING(TYPE, C_NAME, S_NAME) \
TYPE_SET(TYPE, mgap_pstrndup(o->pool, SCM_STRING_CHARS(val), 
SCM_STRING_LENGTH(val)), SCM_STRINGP, C_NAME, S_NAME)

#define GET_TABLE(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, new_table(o->C_NAME), C_NAME, S_NAME)

#define GET_RR(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, new_request_rec(o->C_NAME), C_NAME, S_NAME)

#define GET_SERVER(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, new_server_rec(o->C_NAME), C_NAME, S_NAME)

#define GET_CONN(TYPE, C_NAME, S_NAME) \
TYPE_GET(TYPE, new_conn_rec(o->C_NAME), C_NAME, S_NAME)


And then, for the request_rec, I have:

/* request rec access routines */
GET_CONN   (request_rec, connection,    "request-rec:connection") /*ro*/
GET_SERVER (request_rec, server,        "request-rec:server") /*ro*/
GET_RR     (request_rec, next,          "request-rec:next") /*ro*/
GET_RR     (request_rec, prev,          "request-rec:prev") /*ro*/
GET_RR     (request_rec, main,          "request-rec:main") /*ro*/
GET_STRING (request_rec, the_request,   "request-rec:the-request") /*ro*/
     /* assbackwards */
GET_INT    (request_rec, header_only,   "request-rec:header-only") /*ro*/
     /* protocol */ /*ro*/
     /* proto_num */ /*ro*/
     /* hostname */ /*ro*/
     /* request_time */ /*ro*/
GET_STRING (request_rec, status_line,   "request-rec:status-line") /*ro*/
GET_INT    (request_rec, status,        "request-rec:status")
GET_STRING (request_rec, method,        "request-rec:method") /*ro*/
GET_INT    (request_rec, method_number, "request-rec:method-number") /*ro*/
GET_INT    (request_rec, allowed,       "request-rec:allowed") /*ro*/
     /* sent_body */
     /* bytes_sent */
     /* mtime */
     /* boundary */
     /* range */
     /* clength */
     /* remaining */
     /* read_length */
     /* read_body */
     /* read_chunked */
GET_TABLE  (request_rec, headers_in,    "request-rec:headers-in")
GET_TABLE  (request_rec, headers_out,   "request-rec:headers-out")
GET_TABLE  (request_rec, err_headers_out, "request-rec:err-headers-out")
GET_TABLE  (request_rec, subprocess_env, "request-rec:subprocess-env")
GET_TABLE  (request_rec, notes,         "request-rec:notes")
SET_STRING (request_rec, content_type,  "request-rec:set-content-type!")
GET_STRING (request_rec, content_type,  "request-rec:content-type")
GET_STRING (request_rec, handler,       "request-rec:handler")
GET_STRING (request_rec, content_encoding,      "request-rec:content-encoding")

GET_STRING (request_rec, content_language,      "request-rec:content-language")
     /* vlist_validator */
     /* no_cache */
     /* no_local_copy */
GET_STRING (request_rec, unparsed_uri,  "request-rec:unparsed-uri") /*ro*/
GET_STRING (request_rec, uri,           "request-rec:uri") /*ro*/
SET_STRING (request_rec, filename,      "request-rec:set-filename!")
GET_STRING (request_rec, filename,      "request-rec:filename") /*ro*/
GET_STRING (request_rec, path_info,     "request-rec:path-info") /*ro*/
GET_STRING (request_rec, args,          "request-rec:args") /*ro*/


-Dale

-- 
Dale P. Smith
Treasurer, Cleveland Linux Users Group http://cleveland.lug.net
Senior Systems Consultant, Altus Technologies Corporation
address@hidden
440-746-9000 x339