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

writing reading and printing functions

Browse Source
This commit is contained in:
hyung-hwan
2011-02-26 09:26:16 +00:00
parent 5b1a61f4c8
commit 31ae7440a5
12 changed files with 866 additions and 280 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
qse/lib/scm/Makefile.am
View File

@ -8,6 +8,6 @@ AM_CPPFLAGS = \
lib_LTLIBRARIES = libqsescm.la
libqsescm_la_SOURCES = scm.h scm.c err.c
libqsescm_la_SOURCES = scm.h scm.c print.c err.c
libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
libqsescm_la_LIBADD = -lqsecmn

5
qse/lib/scm/Makefile.in
View File

@ -71,7 +71,7 @@ am__base_list = \
am__installdirs = "$(DESTDIR)$(libdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libqsescm_la_DEPENDENCIES =
am_libqsescm_la_OBJECTS = scm.lo err.lo
am_libqsescm_la_OBJECTS = scm.lo print.lo err.lo
libqsescm_la_OBJECTS = $(am_libqsescm_la_OBJECTS)
libqsescm_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
@ -238,7 +238,7 @@ AM_CPPFLAGS = \
-I$(includedir)
lib_LTLIBRARIES = libqsescm.la
libqsescm_la_SOURCES = scm.h scm.c err.c
libqsescm_la_SOURCES = scm.h scm.c print.c err.c
libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
libqsescm_la_LIBADD = -lqsecmn
all: all-am
@ -316,6 +316,7 @@ distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/print.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scm.Plo@am__quote@
.c.o:

4
qse/lib/scm/err.c
View File

@ -32,10 +32,12 @@ const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum)
QSE_T("I/O error"),
QSE_T("unexpected end of string"),
QSE_T("bad sharp expression"),
QSE_T("wrong use of dot"),
QSE_T("internal error"),
QSE_T("syntax"),
QSE_T("list too deep"),
QSE_T("left parenthesis expected"),
QSE_T("right parenthesis expected"),
QSE_T("bad arguments"),
QSE_T("too few arguments"),

180
qse/lib/scm/print.c Normal file
View File

@ -0,0 +1,180 @@
/*
* $Id$
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "scm.h"
#define OUTPUT_STR(scm,str) QSE_BLOCK (\
if (scm->io.fns.out(scm, QSE_SCM_IO_WRITE, &scm->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) \
{ \
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, 0); \
return -1; \
} \
)
#define OUTPUT_STRX(scm,str,len) QSE_BLOCK ( \
if (scm->io.fns.out(scm, QSE_SCM_IO_WRITE, &scm->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) \
{ \
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, 0); \
return -1; \
} \
)
static int print_entity (
qse_scm_t* scm, const qse_scm_ent_t* obj, int prt_cons_par)
{
qse_char_t buf[256];
if (IS_SMALLINT(obj))
{
}
switch (TYPE(obj))
{
case QSE_SCM_ENT_NIL:
OUTPUT_STR (scm, QSE_T("()"));
break;
case QSE_SCM_ENT_T:
OUTPUT_STR (scm, QSE_T("#t"));
break;
case QSE_SCM_ENT_F:
OUTPUT_STR (scm, QSE_T("#f"));
break;
case QSE_SCM_ENT_NUM:
#if QSE_SIZEOF_LONG_LONG > 0
scm->prm.sprintf (
scm->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%lld"), (long long)NUM_VALUE(obj));
#elif QSE_SIZEOF___INT64 > 0
scm->prm.sprintf (
scm->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%I64d"), (__int64)NUM_VALUE(obj));
#elif QSE_SIZEOF_LONG > 0
scm->prm.sprintf (
scm->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%ld"), (long)NUM_VALUE(obj));
#elif QSE_SIZEOF_INT > 0
scm->prm.sprintf (
scm->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%d"), (int)NUM_VALUE(obj));
#else
#error unsupported size
#endif
OUTPUT_STR (scm, buf);
break;
#if 0
case QSE_SCM_ENT_REAL:
scm->prm.sprintf (
scm->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%Lf"),
#ifdef __MINGW32__
(double)QSE_SCM_RVAL(obj)
#else
(long double)QSE_SCM_RVAL(obj)
#endif
);
OUTPUT_STR (scm, buf);
break;
#endif
case QSE_SCM_ENT_SYM:
OUTPUT_STR (scm, LAB_PTR(SYM_NAME(obj)));
break;
case QSE_SCM_ENT_STR:
OUTPUT_STR (scm, QSE_T("\""));
/* TODO: deescaping */
OUTPUT_STRX (scm, STR_PTR(obj), STR_LEN(obj));
OUTPUT_STR (scm, QSE_T("\""));
break;
case QSE_SCM_ENT_PAIR:
{
const qse_scm_ent_t* p = obj;
if (prt_cons_par) OUTPUT_STR (scm, QSE_T("("));
do
{
qse_scm_print (scm, PAIR_CAR(p));
p = PAIR_CDR(p);
if (!IS_NIL(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(")"));
break;
}
#if 0
case QSE_SCM_ENT_FUNC:
/*OUTPUT_STR (scm, QSE_T("func"));*/
OUTPUT_STR (scm, QSE_T("(lambda "));
if (print_entity (scm, QSE_SCM_FFORMAL(obj), 1) == -1) return -1;
OUTPUT_STR (scm, QSE_T(" "));
if (print_entity (scm, QSE_SCM_FBODY(obj), 0) == -1) return -1;
OUTPUT_STR (scm, QSE_T(")"));
break;
case QSE_SCM_ENT_MACRO:
OUTPUT_STR (scm, QSE_T("(macro "));
if (print_entity (scm, QSE_SCM_FFORMAL(obj), 1) == -1) return -1;
OUTPUT_STR (scm, QSE_T(" "));
if (print_entity (scm, QSE_SCM_FBODY(obj), 0) == -1) return -1;
OUTPUT_STR (scm, QSE_T(")"));
break;
case QSE_SCM_ENT_PRIM:
OUTPUT_STR (scm, QSE_T("prim"));
break;
#endif
default:
QSE_ASSERT (!"should never happen - unknown entity type");
qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
return -1;
}
return 0;
}
int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj)
{
QSE_ASSERTX (
scm->io.fns.out != QSE_NULL,
"Specify output function before calling qse_scm_print()"
);
return print_entity (scm, obj, 1);
}

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

File diff suppressed because it is too large Load Diff

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

@ -26,36 +26,27 @@
#include <qse/cmn/str.h>
#include <qse/scm/scm.h>
#define QSE_SCM_ISUPPER(scm,c) QSE_ISUPPER(c)
#define QSE_SCM_ISLOWER(scm,c) QSE_ISLOWER(c)
#define QSE_SCM_ISALPHA(scm,c) QSE_ISALPHA(c)
#define QSE_SCM_ISDIGIT(scm,c) QSE_ISDIGIT(c)
#define QSE_SCM_ISXDIGIT(scm,c) QSE_ISXDIGIT(c)
#define QSE_SCM_ISALNUM(scm,c) QSE_ISALNUM(c)
#define QSE_SCM_ISSPACE(scm,c) QSE_ISSPACE(c)
#define QSE_SCM_ISPRINT(scm,c) QSE_ISPRINT(c)
#define QSE_SCM_ISGRAPH(scm,c) QSE_ISGRAPH(c)
#define QSE_SCM_ISCNTRL(scm,c) QSE_ISCNTRL(c)
#define QSE_SCM_ISPUNCT(scm,c) QSE_ISPUNCT(c)
#define QSE_SCM_TOUPPER(scm,c) QSE_TOUPPER(c)
#define QSE_SCM_TOLOWER(scm,c) QSE_TOLOWER(c)
/* Note that not all these values can be ORed with each other.
* each value represents its own type except that QSE_SCM_ENT_SYNT
* can be ORed with QSE_SCM_ENT_SYM.
* 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
*/
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_NUM = (1 << 3),
QSE_SCM_ENT_STR = (1 << 4),
QSE_SCM_ENT_NAM = (1 << 5),
QSE_SCM_ENT_SYM = (1 << 6),
QSE_SCM_ENT_PAIR = (1 << 7),
QSE_SCM_ENT_PROC = (1 << 8),
QSE_SCM_ENT_SYNT = (1 << 9)
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)
};
@ -72,10 +63,10 @@ enum qse_scm_ent_type_t
*/
struct qse_scm_ent_t
{
qse_uint16_t dswcount: 2;
qse_uint16_t mark: 1;
qse_uint16_t atom: 1;
qse_uint16_t type: 12;
qse_uint32_t dswcount: 2;
qse_uint32_t mark: 1;
qse_uint32_t atom: 1;
qse_uint32_t type: 28;
union
{
@ -84,6 +75,11 @@ struct qse_scm_ent_t
qse_long_t val;
} num; /* number */
struct
{
qse_real_t val;
} real;
struct
{
/* a string doesn't need to be null-terminated
@ -115,6 +111,7 @@ struct qse_scm_ent_t
#define TYPE(v) ((v)->type)
#define ATOM(v) ((v)->atom)
#define NUM_VALUE(v) ((v)->u.num.val)
#define REAL_VALUE(v) ((v)->u.real.val)
#define STR_PTR(v) ((v)->u.str.ptr)
#define STR_LEN(v) ((v)->u.str.len)
#define LAB_PTR(v) ((v)->u.lab.ptr)
@ -178,6 +175,9 @@ struct qse_scm_t
qse_real_t rval;
qse_str_t name;
} t;
qse_scm_ent_t* s; /* stack for reading */
qse_scm_ent_t* e; /* last entity read */
} r;
/* common values */
@ -189,7 +189,6 @@ struct qse_scm_t
qse_scm_ent_t* gloenv; /* global environment */
qse_scm_ent_t* symtab; /* symbol table */
qse_scm_ent_t* rstack; /* stack for reading */
/* registers */
struct