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
Show Stats 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);
if (v == QSE_NULL) return QSE_NULL;
/* We piggy-back the syntax code to a symbol name.
* 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(v) = 1;
SYNT_CODE(v) = code;
return v;

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

@ -114,7 +114,7 @@ static qse_size_t long_to_str (
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;
@ -132,16 +132,25 @@ static QSE_INLINE qse_scm_ent_t* pop (qse_scm_t* scm)
return PAIR_CAR(top);
}
static int print_entity (
qse_scm_t* scm, const qse_scm_ent_t* obj, int prt_cons_par)
static QSE_INLINE print_num (qse_scm_t* scm, qse_long_t nval)
{
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))
{
nval = FROM_SMALLINT(scm,obj);
goto printnum;
if (print_num (scm, FROM_SMALLINT(scm,obj)) <= -1) return -1;
goto done;
}
switch (TYPE(obj))
@ -160,14 +169,7 @@ retry:
case QSE_SCM_ENT_NUM:
{
qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2];
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);
if (print_num (scm, NUM_VALUE(obj)) <= -1) return -1;
break;
}
@ -192,6 +194,9 @@ retry:
#endif
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)));
break;
@ -204,55 +209,52 @@ retry:
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
{
if (push (scm, PAIR_CDR(p)) <= -1) return -1;
obj = PAIR_CAR(p);
goto retry;
/* Push what to print next on to the stack
* the variable p is */
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:
p = pop (scm);
if (!IS_NIL(scm,p))
cur = pop (scm); /* Get back the CDR pushed */
if (IS_NIL(scm,cur))
{
/* The CDR part points to a NIL entity, which
* indicates the end of a list. break the loop */
break;
}
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 NIL so that the IS_NIL(scm,p) test in
* the 'if' statement above breaks the loop
* after the jump is maded back to the 'resume'
* label. */
if (push (scm, scm->nil) <= -1) return -1;
/* 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(" "));
if (IS_SMALLINT(scm,p) || TYPE(p) != QSE_SCM_ENT_PAIR)
{
OUTPUT_STR (scm, QSE_T(". "));
// push resume location
// push ....
if (push (scm, 1) <= -1) return -1;
obj = p;
goto retry;
//qse_scm_print (scm, p);
}
}
}
while (!IS_NIL(scm,p) && !IS_SMALLINT(scm,p) && TYPE(p) == QSE_SCM_ENT_PAIR);
if (prt_cons_par) 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
while (1);
OUTPUT_STR (scm, QSE_T(")"));
break;
}
@ -262,13 +264,16 @@ retry:
#endif
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);
return -1;
}
/* if the print stack is not empty, we still got more to print */
done:
/* if the printing stack is not empty, we still got more to print */
if (!IS_NIL(scm,scm->p.s)) goto resume;
return 0;
@ -276,10 +281,23 @@ retry:
int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj)
{
int n;
QSE_ASSERTX (
scm->io.fns.out != QSE_NULL,
"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++;
}
qse_printf (QSE_T("[%c]\n"), scm->r.curc);
/*qse_printf (QSE_T("[%c]\n"), scm->r.curc);*/
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] =
{
/* dswcount, mark, atom, type */
/* dswcount, mark, atom, synt, type */
/* nil */
{ 0, 1, 1, QSE_SCM_ENT_NIL },
{ 0, 1, 1, 0, QSE_SCM_ENT_NIL },
/* f */
{ 0, 1, 1, QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL },
{ 0, 1, 1, 0, QSE_SCM_ENT_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();
@ -188,8 +188,8 @@ static qse_scm_t* qse_scm_init (
/* initialize common values */
scm->nil = &static_values[0];
scm->f = &static_values[1];
scm->t = &static_values[2];
scm->t = &static_values[1];
scm->f = &static_values[2];
scm->lambda = 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.
* each value represents its own type except the following combinations.
*
* QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL
* QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL
* QSE_SCM_ENT_SYM | QSE_SCM_ENT_SYNT
* QSE_SCM_ENT_T
* QSE_SCM_ENT_F
* QSE_SCM_ENT_SYM
*/
enum qse_scm_ent_type_t
{
QSE_SCM_ENT_NIL = (1 << 0),
QSE_SCM_ENT_T = (1 << 1),
QSE_SCM_ENT_F = (1 << 2),
QSE_SCM_ENT_BOOL = (1 << 3),
QSE_SCM_ENT_NUM = (1 << 4),
QSE_SCM_ENT_REAL = (1 << 5),
QSE_SCM_ENT_STR = (1 << 6),
QSE_SCM_ENT_NAM = (1 << 7),
QSE_SCM_ENT_SYM = (1 << 8),
QSE_SCM_ENT_PAIR = (1 << 9),
QSE_SCM_ENT_PROC = (1 << 10),
QSE_SCM_ENT_SYNT = (1 << 11)
QSE_SCM_ENT_NUM = (1 << 3),
QSE_SCM_ENT_REAL = (1 << 4),
QSE_SCM_ENT_STR = (1 << 5),
QSE_SCM_ENT_NAM = (1 << 6),
QSE_SCM_ENT_SYM = (1 << 7),
QSE_SCM_ENT_PAIR = (1 << 8),
QSE_SCM_ENT_PROC = (1 << 9)
};
@ -66,7 +64,8 @@ struct qse_scm_ent_t
qse_uint32_t dswcount: 2;
qse_uint32_t mark: 1;
qse_uint32_t atom: 1;
qse_uint32_t type: 28;
qse_uint32_t synt: 1;
qse_uint32_t type: 27;
union
{
@ -108,8 +107,10 @@ struct qse_scm_ent_t
#define DSWCOUNT(v) ((v)->dswcount)
#define MARK(v) ((v)->mark)
#define TYPE(v) ((v)->type)
#define ATOM(v) ((v)->atom)
#define SYNT(v) ((v)->synt)
#define TYPE(v) ((v)->type)
#define NUM_VALUE(v) ((v)->u.num.val)
#define REAL_VALUE(v) ((v)->u.real.val)
#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 SYM_NAME(v) ((v)->u.ref.ent[0])
#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_CDR(v) ((v)->u.ref.ent[1])
#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