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

* evalext.c, evalext.h (scm_self_evaluating_p): New function.

Browse source 
* psyntax.ss (self-evaluating?): Removed.  Guile now provides this
operator as a primitive procedure.
(build-data): Quote vectors (psyntax.ss requires this).
This commit is contained in:
Mikael Djurfeldt 2003-01-20 10:12:39 +00:00
parent 9889e923c6
commit 93f26b7bcc
6 changed files with 81 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

11
ice-9/ChangeLog
View file

@ -1,3 +1,14 @@
2003-01-20 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* psyntax.ss (self-evaluating?): Removed. Guile now provides this
operator as a primitive procedure.
(build-data): Quote vectors (psyntax.ss requires this).
2003-01-19 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* psyntax.ss (self-evaluating?): Allow procedures implanted in
source. (Guile uses this internally.)
2003-01-16 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* psyntax.ss (build-data): Don't quote self-evaluating expressions

22
ice-9/psyntax.pp
View file

File diff suppressed because one or more lines are too long

10
ice-9/psyntax.ss
View file

@ -419,7 +419,8 @@
((_ src level name) name)))
(define (build-data src exp)
(if (self-evaluating? exp)
(if (and (self-evaluating? exp)
(not (vector? exp)))
exp
(list 'quote exp)))
@ -450,13 +451,6 @@
(define-syntax build-lexical-var
(syntax-rules ()
((_ src id) (gensym (symbol->string id)))))
(define-syntax self-evaluating?
(syntax-rules ()
((_ e)
(let ((x e))
(or (boolean? x) (number? x) (string? x) (char? x) (keyword? x)
(procedure? x))))))
)
(define-structure (syntax-object expression wrap))

4
libguile/ChangeLog
View file

@ -1,3 +1,7 @@
2003-01-20 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* evalext.c, evalext.h (scm_self_evaluating_p): New function.
2003-01-10 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* threads.c (scm_timed_wait_condition_variable): Support timed

52
libguile/evalext.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1998,1999,2000,2001,2002 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -146,6 +146,56 @@ scm_m_undefine (SCM x, SCM env)
SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
(SCM obj),
"Return #t for objects which Guile considers self-evaluating")
#define FUNC_NAME s_scm_self_evaluating_p
{
switch (SCM_ITAG3 (obj))
{
case scm_tc3_int_1:
case scm_tc3_int_2:
/* inum */
return SCM_BOOL_T;
case scm_tc3_imm24:
/* characters, booleans, other immediates */
return SCM_BOOL (!SCM_NULLP (obj));
case scm_tc3_cons:
switch (SCM_TYP7 (obj))
{
case scm_tcs_closures:
case scm_tc7_vector:
case scm_tc7_wvect:
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
case scm_tc7_byvect:
case scm_tc7_svect:
case scm_tc7_ivect:
case scm_tc7_uvect:
case scm_tc7_fvect:
case scm_tc7_dvect:
case scm_tc7_cvect:
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
#endif
#endif
case scm_tc7_string:
case scm_tc7_smob:
case scm_tc7_cclo:
case scm_tc7_pws:
case scm_tcs_subrs:
case scm_tcs_struct:
return SCM_BOOL_T;
default:
return SCM_BOOL_F;
}
}
SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
scm_list_1 (obj));
return SCM_UNSPECIFIED; /* never reached */
}
#undef FUNC_NAME
void
scm_init_evalext ()
{

3
libguile/evalext.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EVALEXT_H
#define SCM_EVALEXT_H
/* Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000, 2003 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -52,6 +52,7 @@
SCM_API SCM scm_m_generalized_set_x (SCM xorig, SCM env);
SCM_API SCM scm_defined_p (SCM sym, SCM env);
SCM_API SCM scm_self_evaluating_p (SCM obj);
SCM_API void scm_init_evalext (void);
#if (SCM_ENABLE_DEPRECATED == 1)