hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* fixed a problem of not printing the closing parenthesis if the last CDR is not nil in qse_scm_print().

Browse Source 
* separated the syntax bit for a symbol from the type bits
This commit is contained in:
hyung-hwan
2011-03-04 01:55:37 +00:00
parent 5703d4c58a
commit 5b60fd18f6
5 changed files with 101 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
qse/lib/scm/mem.c
View File

@ -458,13 +458,7 @@ qse_scm_ent_t* qse_scm_makesyntent (
v = qse_scm_makesyment (scm, name); v = qse_scm_makesyment (scm, name);
if (v == QSE_NULL) return QSE_NULL; if (v == QSE_NULL) return QSE_NULL;
/* We piggy-back the syntax code to a symbol name. SYNT(v) = 1;
* The syntax entity is basically a symbol except that the
* code field of its label entity is set to non-zero.
* Read the comment in qse_scm_makeprocent() for difference between
* the syntax entity and the procedure entity.
*/
TYPE(v) |= QSE_SCM_ENT_SYNT;
SYNT_CODE(v) = code; SYNT_CODE(v) = code;
return v; return v;

136
qse/lib/scm/print.c
View File

@ -114,7 +114,7 @@ static qse_size_t long_to_str (
return ret; return ret;
} }
static QSE_INLINE push (qse_scm_t* scm, qse_scm_ent_t* obj) static QSE_INLINE int push (qse_scm_t* scm, qse_scm_ent_t* obj)
{ {
qse_scm_ent_t* top; qse_scm_ent_t* top;
@ -132,16 +132,25 @@ static QSE_INLINE qse_scm_ent_t* pop (qse_scm_t* scm)
return PAIR_CAR(top); return PAIR_CAR(top);
} }
static int print_entity ( static QSE_INLINE print_num (qse_scm_t* scm, qse_long_t nval)
qse_scm_t* scm, const qse_scm_ent_t* obj, int prt_cons_par)
{ {
qse_long_t nval; qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2];
qse_size_t len;
retry: len = long_to_str (nval, 10, QSE_NULL, tmp, QSE_COUNTOF(tmp));
OUTPUT_STRX (scm, tmp, len);
return 0;
}
static int print_entity (qse_scm_t* scm, const qse_scm_ent_t* obj)
{
const qse_scm_ent_t* cur;
next:
if (IS_SMALLINT(scm,obj)) if (IS_SMALLINT(scm,obj))
{ {
nval = FROM_SMALLINT(scm,obj); if (print_num (scm, FROM_SMALLINT(scm,obj)) <= -1) return -1;
goto printnum; goto done;
} }
switch (TYPE(obj)) switch (TYPE(obj))
@ -160,14 +169,7 @@ retry:
case QSE_SCM_ENT_NUM: case QSE_SCM_ENT_NUM:
{ {
qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2]; if (print_num (scm, NUM_VALUE(obj)) <= -1) return -1;
qse_size_t len;
nval = NUM_VALUE(obj);
printnum:
len = long_to_str (nval, 10, QSE_NULL, tmp, QSE_COUNTOF(tmp));
OUTPUT_STRX (scm, tmp, len);
break; break;
} }
@ -192,6 +194,9 @@ retry:
#endif #endif
case QSE_SCM_ENT_SYM: case QSE_SCM_ENT_SYM:
/* Any needs for special action if SYNT(obj) is true?
* I simply treat the syntax symbol as a normal symbol
* for printing currently. */
OUTPUT_STR (scm, LAB_PTR(SYM_NAME(obj))); OUTPUT_STR (scm, LAB_PTR(SYM_NAME(obj)));
break; break;
@ -204,55 +209,52 @@ retry:
case QSE_SCM_ENT_PAIR: case QSE_SCM_ENT_PAIR:
{ {
const qse_scm_ent_t* p = obj;
if (prt_cons_par) OUTPUT_STR (scm, QSE_T("(")); OUTPUT_STR (scm, QSE_T("("));
cur = obj;
do do
{ {
if (push (scm, PAIR_CDR(p)) <= -1) return -1; /* Push what to print next on to the stack
obj = PAIR_CAR(p); * the variable p is */
goto retry; if (push (scm, PAIR_CDR(cur)) <= -1) return -1;
obj = PAIR_CAR(cur);
/* Jump to the 'next' label so that the entity
* pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label
* is made at the at of this function. */
goto next;
resume: resume:
p = pop (scm); cur = pop (scm); /* Get back the CDR pushed */
if (!IS_NIL(scm,p)) if (IS_NIL(scm,cur))
{ {
OUTPUT_STR (scm, QSE_T(" ")); /* The CDR part points to a NIL entity, which
if (IS_SMALLINT(scm,p) || TYPE(p) != QSE_SCM_ENT_PAIR) * indicates the end of a list. break the loop */
{ break;
OUTPUT_STR (scm, QSE_T(". ")); }
if (IS_SMALLINT(scm,cur) || TYPE(cur) != QSE_SCM_ENT_PAIR)
{
/* The CDR part does not point to a pair. */
OUTPUT_STR (scm, QSE_T(" . "));
// push resume location /* Push NIL so that the IS_NIL(scm,p) test in
// push .... * the 'if' statement above breaks the loop
if (push (scm, 1) <= -1) return -1; * after the jump is maded back to the 'resume'
obj = p; * label. */
goto retry; if (push (scm, scm->nil) <= -1) return -1;
//qse_scm_print (scm, p);
} /* Make a jump to 'next' to print the CDR part */
obj = cur;
goto next;
} }
/* The CDR part points to a pair. proceed to it */
OUTPUT_STR (scm, QSE_T(" "));
} }
while (!IS_NIL(scm,p) && !IS_SMALLINT(scm,p) && TYPE(p) == QSE_SCM_ENT_PAIR); while (1);
if (prt_cons_par) OUTPUT_STR (scm, QSE_T(")")); OUTPUT_STR (scm, QSE_T(")"));
#if 0
do
{
qse_scm_print (scm, PAIR_CAR(p));
p = PAIR_CDR(p);
if (!IS_NIL(scm,p))
{
OUTPUT_STR (scm, QSE_T(" "));
if (TYPE(p) != QSE_SCM_ENT_PAIR)
{
OUTPUT_STR (scm, QSE_T(". "));
qse_scm_print (scm, p);
}
}
}
while (p != scm->nil && TYPE(p) == QSE_SCM_ENT_PAIR);
if (prt_cons_par) OUTPUT_STR (scm, QSE_T(")"));
#endif
break; break;
} }
@ -262,13 +264,16 @@ retry:
#endif #endif
default: default:
QSE_ASSERT (!"should never happen - unknown entity type"); QSE_ASSERTX (
0,
"Unknown entity type - buggy!!"
);
qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL); qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
return -1; return -1;
} }
done:
/* if the print stack is not empty, we still got more to print */ /* if the printing stack is not empty, we still got more to print */
if (!IS_NIL(scm,scm->p.s)) goto resume; if (!IS_NIL(scm,scm->p.s)) goto resume;
return 0; return 0;
@ -276,10 +281,23 @@ retry:
int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj) int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj)
{ {
int n;
QSE_ASSERTX ( QSE_ASSERTX (
scm->io.fns.out != QSE_NULL, scm->io.fns.out != QSE_NULL,
"Specify output function before calling qse_scm_print()" "Specify output function before calling qse_scm_print()"
); );
return print_entity (scm, obj, 1); n = print_entity (scm, obj);
/* clear the printing stack if an error has occurred for GC not to keep
* the entities in the stack */
if (n <= -1) scm->p.s = scm->nil;
QSE_ASSERTX (
IS_NIL(scm,scm->p.s),
"The printing stack is not empty after printing - buggy!!"
);
return n;
} }

2
qse/lib/scm/read.c
View File

@ -107,7 +107,7 @@ static int read_char (qse_scm_t* scm)
else scm->r.curloc.colm++; else scm->r.curloc.colm++;
} }
qse_printf (QSE_T("[%c]\n"), scm->r.curc); /*qse_printf (QSE_T("[%c]\n"), scm->r.curc);*/
return 0; return 0;
} }

12
qse/lib/scm/scm.c
View File

@ -157,14 +157,14 @@ static qse_scm_t* qse_scm_init (
{ {
static qse_scm_ent_t static_values[3] = static qse_scm_ent_t static_values[3] =
{ {
/* dswcount, mark, atom, type */ /* dswcount, mark, atom, synt, type */
/* nil */ /* nil */
{ 0, 1, 1, QSE_SCM_ENT_NIL }, { 0, 1, 1, 0, QSE_SCM_ENT_NIL },
/* f */ /* f */
{ 0, 1, 1, QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL }, { 0, 1, 1, 0, QSE_SCM_ENT_T },
/* t */ /* t */
{ 0, 1, 1, QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL } { 0, 1, 1, 0, QSE_SCM_ENT_F }
}; };
if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL(); if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL();
@ -188,8 +188,8 @@ static qse_scm_t* qse_scm_init (
/* initialize common values */ /* initialize common values */
scm->nil = &static_values[0]; scm->nil = &static_values[0];
scm->f = &static_values[1]; scm->t = &static_values[1];
scm->t = &static_values[2]; scm->f = &static_values[2];
scm->lambda = scm->nil; scm->lambda = scm->nil;
scm->quote = scm->nil; scm->quote = scm->nil;

31
qse/lib/scm/scm.h
View File

@ -29,24 +29,22 @@
/* Note that not all these values can be ORed with each other. /* Note that not all these values can be ORed with each other.
* each value represents its own type except the following combinations. * each value represents its own type except the following combinations.
* *
* QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL * QSE_SCM_ENT_T
* QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL * QSE_SCM_ENT_F
* QSE_SCM_ENT_SYM | QSE_SCM_ENT_SYNT * QSE_SCM_ENT_SYM
*/ */
enum qse_scm_ent_type_t enum qse_scm_ent_type_t
{ {
QSE_SCM_ENT_NIL = (1 << 0), QSE_SCM_ENT_NIL = (1 << 0),
QSE_SCM_ENT_T = (1 << 1), QSE_SCM_ENT_T = (1 << 1),
QSE_SCM_ENT_F = (1 << 2), QSE_SCM_ENT_F = (1 << 2),
QSE_SCM_ENT_BOOL = (1 << 3), QSE_SCM_ENT_NUM = (1 << 3),
QSE_SCM_ENT_NUM = (1 << 4), QSE_SCM_ENT_REAL = (1 << 4),
QSE_SCM_ENT_REAL = (1 << 5), QSE_SCM_ENT_STR = (1 << 5),
QSE_SCM_ENT_STR = (1 << 6), QSE_SCM_ENT_NAM = (1 << 6),
QSE_SCM_ENT_NAM = (1 << 7), QSE_SCM_ENT_SYM = (1 << 7),
QSE_SCM_ENT_SYM = (1 << 8), QSE_SCM_ENT_PAIR = (1 << 8),
QSE_SCM_ENT_PAIR = (1 << 9), QSE_SCM_ENT_PROC = (1 << 9)
QSE_SCM_ENT_PROC = (1 << 10),
QSE_SCM_ENT_SYNT = (1 << 11)
}; };
@ -66,7 +64,8 @@ struct qse_scm_ent_t
qse_uint32_t dswcount: 2; qse_uint32_t dswcount: 2;
qse_uint32_t mark: 1; qse_uint32_t mark: 1;
qse_uint32_t atom: 1; qse_uint32_t atom: 1;
qse_uint32_t type: 28; qse_uint32_t synt: 1;
qse_uint32_t type: 27;
union union
{ {
@ -108,8 +107,10 @@ struct qse_scm_ent_t
#define DSWCOUNT(v) ((v)->dswcount) #define DSWCOUNT(v) ((v)->dswcount)
#define MARK(v) ((v)->mark) #define MARK(v) ((v)->mark)
#define TYPE(v) ((v)->type)
#define ATOM(v) ((v)->atom) #define ATOM(v) ((v)->atom)
#define SYNT(v) ((v)->synt)
#define TYPE(v) ((v)->type)
#define NUM_VALUE(v) ((v)->u.num.val) #define NUM_VALUE(v) ((v)->u.num.val)
#define REAL_VALUE(v) ((v)->u.real.val) #define REAL_VALUE(v) ((v)->u.real.val)
#define STR_PTR(v) ((v)->u.str.ptr) #define STR_PTR(v) ((v)->u.str.ptr)
@ -118,10 +119,10 @@ struct qse_scm_ent_t
#define LAB_CODE(v) ((v)->u.lab.code) #define LAB_CODE(v) ((v)->u.lab.code)
#define SYM_NAME(v) ((v)->u.ref.ent[0]) #define SYM_NAME(v) ((v)->u.ref.ent[0])
#define SYM_PROP(v) ((v)->u.ref.ent[1]) #define SYM_PROP(v) ((v)->u.ref.ent[1])
#define SYNT_CODE(v) LAB_CODE(SYM_NAME(v))
#define PAIR_CAR(v) ((v)->u.ref.ent[0]) #define PAIR_CAR(v) ((v)->u.ref.ent[0])
#define PAIR_CDR(v) ((v)->u.ref.ent[1]) #define PAIR_CDR(v) ((v)->u.ref.ent[1])
#define PROC_CODE(v) ((v)->u.proc.code) #define PROC_CODE(v) ((v)->u.proc.code)
#define SYNT_CODE(v) LAB_CODE(SYM_NAME(v))
/** /**
* The qse_scm_enb_t type defines a value block. A value block is allocated * The qse_scm_enb_t type defines a value block. A value block is allocated