deleted lsp
This commit is contained in:
@ -1,2 +1,2 @@
|
||||
SUBDIRS = cmn sed awk cut utl
|
||||
SUBDIRS = cmn sed awk cut scm utl
|
||||
DIST_SUBDIRS = $(SUBDIRS)
|
||||
|
||||
@ -228,7 +228,7 @@ target_alias = @target_alias@
|
||||
top_build_prefix = @top_build_prefix@
|
||||
top_builddir = @top_builddir@
|
||||
top_srcdir = @top_srcdir@
|
||||
SUBDIRS = cmn sed awk cut utl
|
||||
SUBDIRS = cmn sed awk cut scm utl
|
||||
DIST_SUBDIRS = $(SUBDIRS)
|
||||
all: all-recursive
|
||||
|
||||
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
AUTOMAKE_OPTIONS = nostdinc
|
||||
|
||||
AM_CPPFLAGS = -I$(top_srcdir)/include
|
||||
|
||||
lib_LTLIBRARIES = libqselsp.la
|
||||
|
||||
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h obj.h
|
||||
libqselsp_la_LDFLAGS = -L../cmn -version-info 1:0:0 -no-undefined
|
||||
libqselsp_la_LIBADD = -lqsecmn
|
||||
@ -1,564 +0,0 @@
|
||||
# Makefile.in generated by automake 1.11.1 from Makefile.am.
|
||||
# @configure_input@
|
||||
|
||||
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||
# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
|
||||
# Inc.
|
||||
# This Makefile.in is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
|
||||
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
||||
# PARTICULAR PURPOSE.
|
||||
|
||||
@SET_MAKE@
|
||||
|
||||
VPATH = @srcdir@
|
||||
pkgdatadir = $(datadir)/@PACKAGE@
|
||||
pkgincludedir = $(includedir)/@PACKAGE@
|
||||
pkglibdir = $(libdir)/@PACKAGE@
|
||||
pkglibexecdir = $(libexecdir)/@PACKAGE@
|
||||
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
|
||||
install_sh_DATA = $(install_sh) -c -m 644
|
||||
install_sh_PROGRAM = $(install_sh) -c
|
||||
install_sh_SCRIPT = $(install_sh) -c
|
||||
INSTALL_HEADER = $(INSTALL_DATA)
|
||||
transform = $(program_transform_name)
|
||||
NORMAL_INSTALL = :
|
||||
PRE_INSTALL = :
|
||||
POST_INSTALL = :
|
||||
NORMAL_UNINSTALL = :
|
||||
PRE_UNINSTALL = :
|
||||
POST_UNINSTALL = :
|
||||
build_triplet = @build@
|
||||
host_triplet = @host@
|
||||
subdir = lib/lsp
|
||||
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in
|
||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||
am__aclocal_m4_deps = $(top_srcdir)/ac/m4/libtool.m4 \
|
||||
$(top_srcdir)/ac/m4/ltoptions.m4 \
|
||||
$(top_srcdir)/ac/m4/ltsugar.m4 \
|
||||
$(top_srcdir)/ac/m4/ltversion.m4 \
|
||||
$(top_srcdir)/ac/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
|
||||
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
|
||||
$(ACLOCAL_M4)
|
||||
mkinstalldirs = $(install_sh) -d
|
||||
CONFIG_HEADER = $(top_builddir)/include/qse/config.h
|
||||
CONFIG_CLEAN_FILES =
|
||||
CONFIG_CLEAN_VPATH_FILES =
|
||||
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
|
||||
am__vpath_adj = case $$p in \
|
||||
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
|
||||
*) f=$$p;; \
|
||||
esac;
|
||||
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
|
||||
am__install_max = 40
|
||||
am__nobase_strip_setup = \
|
||||
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
|
||||
am__nobase_strip = \
|
||||
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
|
||||
am__nobase_list = $(am__nobase_strip_setup); \
|
||||
for p in $$list; do echo "$$p $$p"; done | \
|
||||
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
|
||||
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
|
||||
if (++n[$$2] == $(am__install_max)) \
|
||||
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
|
||||
END { for (dir in files) print dir, files[dir] }'
|
||||
am__base_list = \
|
||||
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
|
||||
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
|
||||
am__installdirs = "$(DESTDIR)$(libdir)"
|
||||
LTLIBRARIES = $(lib_LTLIBRARIES)
|
||||
libqselsp_la_DEPENDENCIES =
|
||||
am_libqselsp_la_OBJECTS = lsp.lo err.lo env.lo eval.lo mem.lo misc.lo \
|
||||
prim.lo prim_compar.lo prim_let.lo prim_math.lo prim_prog.lo \
|
||||
print.lo read.lo
|
||||
libqselsp_la_OBJECTS = $(am_libqselsp_la_OBJECTS)
|
||||
libqselsp_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
|
||||
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
|
||||
$(libqselsp_la_LDFLAGS) $(LDFLAGS) -o $@
|
||||
DEFAULT_INCLUDES =
|
||||
depcomp = $(SHELL) $(top_srcdir)/ac/au/depcomp
|
||||
am__depfiles_maybe = depfiles
|
||||
am__mv = mv -f
|
||||
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
|
||||
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
|
||||
LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
|
||||
--mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
|
||||
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
|
||||
CCLD = $(CC)
|
||||
LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
|
||||
--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \
|
||||
$(LDFLAGS) -o $@
|
||||
SOURCES = $(libqselsp_la_SOURCES)
|
||||
DIST_SOURCES = $(libqselsp_la_SOURCES)
|
||||
ETAGS = etags
|
||||
CTAGS = ctags
|
||||
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
|
||||
ACLOCAL = @ACLOCAL@
|
||||
AMTAR = @AMTAR@
|
||||
AR = @AR@
|
||||
AUTOCONF = @AUTOCONF@
|
||||
AUTOHEADER = @AUTOHEADER@
|
||||
AUTOMAKE = @AUTOMAKE@
|
||||
AWK = @AWK@
|
||||
BUILD_MODE = @BUILD_MODE@
|
||||
CC = @CC@
|
||||
CCDEPMODE = @CCDEPMODE@
|
||||
CFLAGS = @CFLAGS@
|
||||
CHAR_MODE = @CHAR_MODE@
|
||||
CPP = @CPP@
|
||||
CPPFLAGS = @CPPFLAGS@
|
||||
CXX = @CXX@
|
||||
CXXCPP = @CXXCPP@
|
||||
CXXDEPMODE = @CXXDEPMODE@
|
||||
CXXFLAGS = @CXXFLAGS@
|
||||
CYGPATH_W = @CYGPATH_W@
|
||||
DEFS = @DEFS@
|
||||
DEPDIR = @DEPDIR@
|
||||
DSYMUTIL = @DSYMUTIL@
|
||||
DUMPBIN = @DUMPBIN@
|
||||
ECHO_C = @ECHO_C@
|
||||
ECHO_N = @ECHO_N@
|
||||
ECHO_T = @ECHO_T@
|
||||
EGREP = @EGREP@
|
||||
EXEEXT = @EXEEXT@
|
||||
FGREP = @FGREP@
|
||||
GREP = @GREP@
|
||||
HAVE_CXX = @HAVE_CXX@
|
||||
HAVE_OBJC = @HAVE_OBJC@
|
||||
INSTALL = @INSTALL@
|
||||
INSTALL_DATA = @INSTALL_DATA@
|
||||
INSTALL_PROGRAM = @INSTALL_PROGRAM@
|
||||
INSTALL_SCRIPT = @INSTALL_SCRIPT@
|
||||
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
|
||||
LD = @LD@
|
||||
LDFLAGS = @LDFLAGS@
|
||||
LIBM = @LIBM@
|
||||
LIBOBJS = @LIBOBJS@
|
||||
LIBS = @LIBS@
|
||||
LIBTOOL = @LIBTOOL@
|
||||
LIBTOOL_DEPS = @LIBTOOL_DEPS@
|
||||
LIPO = @LIPO@
|
||||
LN_S = @LN_S@
|
||||
LTLIBOBJS = @LTLIBOBJS@
|
||||
MAKEINFO = @MAKEINFO@
|
||||
MKDIR_P = @MKDIR_P@
|
||||
NM = @NM@
|
||||
NMEDIT = @NMEDIT@
|
||||
OBJC = @OBJC@
|
||||
OBJCDEPMODE = @OBJCDEPMODE@
|
||||
OBJCFLAGS = @OBJCFLAGS@
|
||||
OBJDUMP = @OBJDUMP@
|
||||
OBJEXT = @OBJEXT@
|
||||
OTOOL = @OTOOL@
|
||||
OTOOL64 = @OTOOL64@
|
||||
PACKAGE = @PACKAGE@
|
||||
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
|
||||
PACKAGE_NAME = @PACKAGE_NAME@
|
||||
PACKAGE_STRING = @PACKAGE_STRING@
|
||||
PACKAGE_TARNAME = @PACKAGE_TARNAME@
|
||||
PACKAGE_URL = @PACKAGE_URL@
|
||||
PACKAGE_VERSION = @PACKAGE_VERSION@
|
||||
PATH_SEPARATOR = @PATH_SEPARATOR@
|
||||
QSE_PROJECT_AUTHOR = @QSE_PROJECT_AUTHOR@
|
||||
QSE_PROJECT_URL = @QSE_PROJECT_URL@
|
||||
QSE_SIZEOF_CHAR = @QSE_SIZEOF_CHAR@
|
||||
QSE_SIZEOF_DOUBLE = @QSE_SIZEOF_DOUBLE@
|
||||
QSE_SIZEOF_FLOAT = @QSE_SIZEOF_FLOAT@
|
||||
QSE_SIZEOF_INT = @QSE_SIZEOF_INT@
|
||||
QSE_SIZEOF_LONG = @QSE_SIZEOF_LONG@
|
||||
QSE_SIZEOF_LONG_DOUBLE = @QSE_SIZEOF_LONG_DOUBLE@
|
||||
QSE_SIZEOF_LONG_LONG = @QSE_SIZEOF_LONG_LONG@
|
||||
QSE_SIZEOF_SHORT = @QSE_SIZEOF_SHORT@
|
||||
QSE_SIZEOF_VOID_P = @QSE_SIZEOF_VOID_P@
|
||||
QSE_SIZEOF_WCHAR_T = @QSE_SIZEOF_WCHAR_T@
|
||||
RANLIB = @RANLIB@
|
||||
RM = @RM@
|
||||
SED = @SED@
|
||||
SET_MAKE = @SET_MAKE@
|
||||
SHELL = @SHELL@
|
||||
STRIP = @STRIP@
|
||||
VERSION = @VERSION@
|
||||
abs_builddir = @abs_builddir@
|
||||
abs_srcdir = @abs_srcdir@
|
||||
abs_top_builddir = @abs_top_builddir@
|
||||
abs_top_srcdir = @abs_top_srcdir@
|
||||
ac_ct_CC = @ac_ct_CC@
|
||||
ac_ct_CXX = @ac_ct_CXX@
|
||||
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
|
||||
ac_ct_OBJC = @ac_ct_OBJC@
|
||||
am__include = @am__include@
|
||||
am__leading_dot = @am__leading_dot@
|
||||
am__quote = @am__quote@
|
||||
am__tar = @am__tar@
|
||||
am__untar = @am__untar@
|
||||
bindir = @bindir@
|
||||
build = @build@
|
||||
build_alias = @build_alias@
|
||||
build_cpu = @build_cpu@
|
||||
build_os = @build_os@
|
||||
build_vendor = @build_vendor@
|
||||
builddir = @builddir@
|
||||
datadir = @datadir@
|
||||
datarootdir = @datarootdir@
|
||||
docdir = @docdir@
|
||||
dvidir = @dvidir@
|
||||
exec_prefix = @exec_prefix@
|
||||
host = @host@
|
||||
host_alias = @host_alias@
|
||||
host_cpu = @host_cpu@
|
||||
host_os = @host_os@
|
||||
host_vendor = @host_vendor@
|
||||
htmldir = @htmldir@
|
||||
includedir = @includedir@
|
||||
infodir = @infodir@
|
||||
install_sh = @install_sh@
|
||||
libdir = @libdir@
|
||||
libexecdir = @libexecdir@
|
||||
localedir = @localedir@
|
||||
localstatedir = @localstatedir@
|
||||
lt_ECHO = @lt_ECHO@
|
||||
mandir = @mandir@
|
||||
mkdir_p = @mkdir_p@
|
||||
oldincludedir = @oldincludedir@
|
||||
pdfdir = @pdfdir@
|
||||
prefix = @prefix@
|
||||
program_transform_name = @program_transform_name@
|
||||
psdir = @psdir@
|
||||
sbindir = @sbindir@
|
||||
sharedstatedir = @sharedstatedir@
|
||||
srcdir = @srcdir@
|
||||
sysconfdir = @sysconfdir@
|
||||
target_alias = @target_alias@
|
||||
top_build_prefix = @top_build_prefix@
|
||||
top_builddir = @top_builddir@
|
||||
top_srcdir = @top_srcdir@
|
||||
AUTOMAKE_OPTIONS = nostdinc
|
||||
AM_CPPFLAGS = -I$(top_srcdir)/include
|
||||
lib_LTLIBRARIES = libqselsp.la
|
||||
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h obj.h
|
||||
libqselsp_la_LDFLAGS = -L../cmn -version-info 1:0:0 -no-undefined
|
||||
libqselsp_la_LIBADD = -lqsecmn
|
||||
all: all-am
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .c .lo .o .obj
|
||||
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
|
||||
@for dep in $?; do \
|
||||
case '$(am__configure_deps)' in \
|
||||
*$$dep*) \
|
||||
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
|
||||
&& { if test -f $@; then exit 0; else break; fi; }; \
|
||||
exit 1;; \
|
||||
esac; \
|
||||
done; \
|
||||
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign lib/lsp/Makefile'; \
|
||||
$(am__cd) $(top_srcdir) && \
|
||||
$(AUTOMAKE) --foreign lib/lsp/Makefile
|
||||
.PRECIOUS: Makefile
|
||||
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
|
||||
@case '$?' in \
|
||||
*config.status*) \
|
||||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
|
||||
*) \
|
||||
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
|
||||
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
|
||||
esac;
|
||||
|
||||
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
|
||||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||
|
||||
$(top_srcdir)/configure: $(am__configure_deps)
|
||||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
|
||||
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
|
||||
$(am__aclocal_m4_deps):
|
||||
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
|
||||
@$(NORMAL_INSTALL)
|
||||
test -z "$(libdir)" || $(MKDIR_P) "$(DESTDIR)$(libdir)"
|
||||
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
|
||||
list2=; for p in $$list; do \
|
||||
if test -f $$p; then \
|
||||
list2="$$list2 $$p"; \
|
||||
else :; fi; \
|
||||
done; \
|
||||
test -z "$$list2" || { \
|
||||
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
|
||||
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
|
||||
}
|
||||
|
||||
uninstall-libLTLIBRARIES:
|
||||
@$(NORMAL_UNINSTALL)
|
||||
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
|
||||
for p in $$list; do \
|
||||
$(am__strip_dir) \
|
||||
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
|
||||
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
|
||||
done
|
||||
|
||||
clean-libLTLIBRARIES:
|
||||
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
|
||||
@list='$(lib_LTLIBRARIES)'; for p in $$list; do \
|
||||
dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
|
||||
test "$$dir" != "$$p" || dir=.; \
|
||||
echo "rm -f \"$${dir}/so_locations\""; \
|
||||
rm -f "$${dir}/so_locations"; \
|
||||
done
|
||||
libqselsp.la: $(libqselsp_la_OBJECTS) $(libqselsp_la_DEPENDENCIES)
|
||||
$(libqselsp_la_LINK) -rpath $(libdir) $(libqselsp_la_OBJECTS) $(libqselsp_la_LIBADD) $(LIBS)
|
||||
|
||||
mostlyclean-compile:
|
||||
-rm -f *.$(OBJEXT)
|
||||
|
||||
distclean-compile:
|
||||
-rm -f *.tab.c
|
||||
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/env.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eval.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lsp.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mem.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/misc.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_compar.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_let.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_math.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_prog.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/print.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/read.Plo@am__quote@
|
||||
|
||||
.c.o:
|
||||
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
|
||||
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
|
||||
@am__fastdepCC_FALSE@ $(COMPILE) -c $<
|
||||
|
||||
.c.obj:
|
||||
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
|
||||
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
|
||||
@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'`
|
||||
|
||||
.c.lo:
|
||||
@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
|
||||
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
|
||||
@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
|
||||
|
||||
mostlyclean-libtool:
|
||||
-rm -f *.lo
|
||||
|
||||
clean-libtool:
|
||||
-rm -rf .libs _libs
|
||||
|
||||
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
|
||||
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
|
||||
unique=`for i in $$list; do \
|
||||
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
|
||||
done | \
|
||||
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
|
||||
END { if (nonempty) { for (i in files) print i; }; }'`; \
|
||||
mkid -fID $$unique
|
||||
tags: TAGS
|
||||
|
||||
TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
|
||||
$(TAGS_FILES) $(LISP)
|
||||
set x; \
|
||||
here=`pwd`; \
|
||||
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
|
||||
unique=`for i in $$list; do \
|
||||
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
|
||||
done | \
|
||||
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
|
||||
END { if (nonempty) { for (i in files) print i; }; }'`; \
|
||||
shift; \
|
||||
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
|
||||
test -n "$$unique" || unique=$$empty_fix; \
|
||||
if test $$# -gt 0; then \
|
||||
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
|
||||
"$$@" $$unique; \
|
||||
else \
|
||||
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
|
||||
$$unique; \
|
||||
fi; \
|
||||
fi
|
||||
ctags: CTAGS
|
||||
CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
|
||||
$(TAGS_FILES) $(LISP)
|
||||
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
|
||||
unique=`for i in $$list; do \
|
||||
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
|
||||
done | \
|
||||
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
|
||||
END { if (nonempty) { for (i in files) print i; }; }'`; \
|
||||
test -z "$(CTAGS_ARGS)$$unique" \
|
||||
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
|
||||
$$unique
|
||||
|
||||
GTAGS:
|
||||
here=`$(am__cd) $(top_builddir) && pwd` \
|
||||
&& $(am__cd) $(top_srcdir) \
|
||||
&& gtags -i $(GTAGS_ARGS) "$$here"
|
||||
|
||||
distclean-tags:
|
||||
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
|
||||
|
||||
distdir: $(DISTFILES)
|
||||
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
|
||||
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
|
||||
list='$(DISTFILES)'; \
|
||||
dist_files=`for file in $$list; do echo $$file; done | \
|
||||
sed -e "s|^$$srcdirstrip/||;t" \
|
||||
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
|
||||
case $$dist_files in \
|
||||
*/*) $(MKDIR_P) `echo "$$dist_files" | \
|
||||
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
|
||||
sort -u` ;; \
|
||||
esac; \
|
||||
for file in $$dist_files; do \
|
||||
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
|
||||
if test -d $$d/$$file; then \
|
||||
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
|
||||
if test -d "$(distdir)/$$file"; then \
|
||||
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
|
||||
fi; \
|
||||
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
|
||||
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
|
||||
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
|
||||
fi; \
|
||||
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
|
||||
else \
|
||||
test -f "$(distdir)/$$file" \
|
||||
|| cp -p $$d/$$file "$(distdir)/$$file" \
|
||||
|| exit 1; \
|
||||
fi; \
|
||||
done
|
||||
check-am: all-am
|
||||
check: check-am
|
||||
all-am: Makefile $(LTLIBRARIES)
|
||||
installdirs:
|
||||
for dir in "$(DESTDIR)$(libdir)"; do \
|
||||
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
|
||||
done
|
||||
install: install-am
|
||||
install-exec: install-exec-am
|
||||
install-data: install-data-am
|
||||
uninstall: uninstall-am
|
||||
|
||||
install-am: all-am
|
||||
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
|
||||
|
||||
installcheck: installcheck-am
|
||||
install-strip:
|
||||
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
|
||||
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
|
||||
`test -z '$(STRIP)' || \
|
||||
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
|
||||
mostlyclean-generic:
|
||||
|
||||
clean-generic:
|
||||
|
||||
distclean-generic:
|
||||
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
|
||||
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
|
||||
|
||||
maintainer-clean-generic:
|
||||
@echo "This command is intended for maintainers to use"
|
||||
@echo "it deletes files that may require special tools to rebuild."
|
||||
clean: clean-am
|
||||
|
||||
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
|
||||
mostlyclean-am
|
||||
|
||||
distclean: distclean-am
|
||||
-rm -rf ./$(DEPDIR)
|
||||
-rm -f Makefile
|
||||
distclean-am: clean-am distclean-compile distclean-generic \
|
||||
distclean-tags
|
||||
|
||||
dvi: dvi-am
|
||||
|
||||
dvi-am:
|
||||
|
||||
html: html-am
|
||||
|
||||
html-am:
|
||||
|
||||
info: info-am
|
||||
|
||||
info-am:
|
||||
|
||||
install-data-am:
|
||||
|
||||
install-dvi: install-dvi-am
|
||||
|
||||
install-dvi-am:
|
||||
|
||||
install-exec-am: install-libLTLIBRARIES
|
||||
|
||||
install-html: install-html-am
|
||||
|
||||
install-html-am:
|
||||
|
||||
install-info: install-info-am
|
||||
|
||||
install-info-am:
|
||||
|
||||
install-man:
|
||||
|
||||
install-pdf: install-pdf-am
|
||||
|
||||
install-pdf-am:
|
||||
|
||||
install-ps: install-ps-am
|
||||
|
||||
install-ps-am:
|
||||
|
||||
installcheck-am:
|
||||
|
||||
maintainer-clean: maintainer-clean-am
|
||||
-rm -rf ./$(DEPDIR)
|
||||
-rm -f Makefile
|
||||
maintainer-clean-am: distclean-am maintainer-clean-generic
|
||||
|
||||
mostlyclean: mostlyclean-am
|
||||
|
||||
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
|
||||
mostlyclean-libtool
|
||||
|
||||
pdf: pdf-am
|
||||
|
||||
pdf-am:
|
||||
|
||||
ps: ps-am
|
||||
|
||||
ps-am:
|
||||
|
||||
uninstall-am: uninstall-libLTLIBRARIES
|
||||
|
||||
.MAKE: install-am install-strip
|
||||
|
||||
.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \
|
||||
clean-libLTLIBRARIES clean-libtool ctags distclean \
|
||||
distclean-compile distclean-generic distclean-libtool \
|
||||
distclean-tags distdir dvi dvi-am html html-am info info-am \
|
||||
install install-am install-data install-data-am install-dvi \
|
||||
install-dvi-am install-exec install-exec-am install-html \
|
||||
install-html-am install-info install-info-am \
|
||||
install-libLTLIBRARIES install-man install-pdf install-pdf-am \
|
||||
install-ps install-ps-am install-strip installcheck \
|
||||
installcheck-am installdirs maintainer-clean \
|
||||
maintainer-clean-generic mostlyclean mostlyclean-compile \
|
||||
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
|
||||
tags uninstall uninstall-am uninstall-libLTLIBRARIES
|
||||
|
||||
|
||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||
# Otherwise a system limit (for SysV at least) may be exceeded.
|
||||
.NOEXPORT:
|
||||
@ -1,160 +0,0 @@
|
||||
/*
|
||||
* $Id: env.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
/* TODO: make the frame hash accessible */
|
||||
|
||||
static qse_lsp_assoc_t* __new_assoc (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* name,
|
||||
qse_lsp_obj_t* value, qse_lsp_obj_t* func)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
assoc = (qse_lsp_assoc_t*)
|
||||
QSE_LSP_ALLOC (lsp, sizeof(qse_lsp_assoc_t));
|
||||
if (assoc == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
assoc->name = name;
|
||||
assoc->value = value;
|
||||
assoc->func = func;
|
||||
assoc->link = QSE_NULL;
|
||||
|
||||
return assoc;
|
||||
}
|
||||
|
||||
qse_lsp_frame_t* qse_lsp_newframe (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_lsp_frame_t* frame;
|
||||
|
||||
frame = (qse_lsp_frame_t*)
|
||||
QSE_LSP_ALLOC (lsp, sizeof(qse_lsp_frame_t));
|
||||
if (frame == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
frame->assoc = QSE_NULL;
|
||||
frame->link = QSE_NULL;
|
||||
|
||||
return frame;
|
||||
}
|
||||
|
||||
void qse_lsp_freeframe (qse_lsp_t* lsp, qse_lsp_frame_t* frame)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc, * link;
|
||||
|
||||
/* destroy the associations */
|
||||
assoc = frame->assoc;
|
||||
while (assoc != QSE_NULL)
|
||||
{
|
||||
link = assoc->link;
|
||||
QSE_LSP_FREE (lsp, assoc);
|
||||
assoc = link;
|
||||
}
|
||||
|
||||
QSE_LSP_FREE (lsp, frame);
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_lookupinframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame, qse_lsp_obj_t* name)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(name) == QSE_LSP_OBJ_SYM);
|
||||
|
||||
assoc = frame->assoc;
|
||||
while (assoc != QSE_NULL)
|
||||
{
|
||||
if (name == assoc->name) return assoc;
|
||||
assoc = assoc->link;
|
||||
}
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_insvalueintoframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame,
|
||||
qse_lsp_obj_t* name, qse_lsp_obj_t* value)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(name) == QSE_LSP_OBJ_SYM);
|
||||
|
||||
assoc = __new_assoc (lsp, name, value, QSE_NULL);
|
||||
if (assoc == QSE_NULL) return QSE_NULL;
|
||||
|
||||
assoc->link = frame->assoc;
|
||||
frame->assoc = assoc;
|
||||
return assoc;
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_insfuncintoframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame,
|
||||
qse_lsp_obj_t* name, qse_lsp_obj_t* func)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(name) == QSE_LSP_OBJ_SYM);
|
||||
|
||||
assoc = __new_assoc (lsp, name, QSE_NULL, func);
|
||||
if (assoc == QSE_NULL) return QSE_NULL;
|
||||
|
||||
assoc->link = frame->assoc;
|
||||
frame->assoc = assoc;
|
||||
return assoc;
|
||||
}
|
||||
|
||||
qse_lsp_tlink_t* qse_lsp_pushtmp (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
qse_lsp_tlink_t* tlink;
|
||||
|
||||
tlink = (qse_lsp_tlink_t*)
|
||||
QSE_LSP_ALLOC (lsp, sizeof(qse_lsp_tlink_t));
|
||||
if (tlink == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
tlink->obj = obj;
|
||||
tlink->link = lsp->mem->tlink;
|
||||
lsp->mem->tlink = tlink;
|
||||
lsp->mem->tlink_count++;
|
||||
|
||||
return tlink;
|
||||
}
|
||||
|
||||
void qse_lsp_poptmp (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_lsp_tlink_t* top;
|
||||
|
||||
QSE_ASSERT (lsp->mem->tlink != QSE_NULL);
|
||||
|
||||
top = lsp->mem->tlink;
|
||||
lsp->mem->tlink = top->link;
|
||||
lsp->mem->tlink_count--;
|
||||
|
||||
QSE_LSP_FREE (lsp, top);
|
||||
}
|
||||
@ -1,77 +0,0 @@
|
||||
/*
|
||||
* $Id: env.h 117 2008-03-03 11:20:05Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_ENV_H_
|
||||
#define _QSE_LIB_LSP_ENV_H_
|
||||
|
||||
#ifndef _QSE_LSP_LSP_H_
|
||||
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
|
||||
#endif
|
||||
|
||||
typedef struct qse_lsp_assoc_t qse_lsp_assoc_t;
|
||||
typedef struct qse_lsp_frame_t qse_lsp_frame_t;
|
||||
typedef struct qse_lsp_tlink_t qse_lsp_tlink_t;
|
||||
|
||||
struct qse_lsp_assoc_t
|
||||
{
|
||||
qse_lsp_obj_t* name; /* qse_lsp_obj_sym_t */
|
||||
qse_lsp_obj_t* value; /* value as a variable */
|
||||
qse_lsp_obj_t* func; /* function definition */
|
||||
|
||||
qse_lsp_assoc_t* link;
|
||||
};
|
||||
|
||||
struct qse_lsp_frame_t
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
qse_lsp_frame_t* link;
|
||||
};
|
||||
|
||||
struct qse_lsp_tlink_t
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
qse_lsp_tlink_t* link;
|
||||
};
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
qse_lsp_frame_t* qse_lsp_newframe (qse_lsp_t* lsp);
|
||||
void qse_lsp_freeframe (qse_lsp_t* lsp, qse_lsp_frame_t* frame);
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_lookupinframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame, qse_lsp_obj_t* name);
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_insvalueintoframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame,
|
||||
qse_lsp_obj_t* name, qse_lsp_obj_t* value);
|
||||
qse_lsp_assoc_t* qse_lsp_insfuncintoframe (
|
||||
qse_lsp_t* lsp, qse_lsp_frame_t* frame,
|
||||
qse_lsp_obj_t* name, qse_lsp_obj_t* func);
|
||||
|
||||
qse_lsp_tlink_t* qse_lsp_pushtmp (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
|
||||
void qse_lsp_poptmp (qse_lsp_t* lsp);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -1,129 +0,0 @@
|
||||
/*
|
||||
* $Id: err.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
const qse_char_t* qse_lsp_dflerrstr (qse_lsp_t* lsp, qse_lsp_errnum_t errnum)
|
||||
{
|
||||
static const qse_char_t* errstr[] =
|
||||
{
|
||||
QSE_T("no error"),
|
||||
QSE_T("out of memory"),
|
||||
QSE_T("exit"),
|
||||
QSE_T("end of source"),
|
||||
QSE_T("unexpected end of string"),
|
||||
QSE_T("input not attached"),
|
||||
QSE_T("input"),
|
||||
QSE_T("output not attached"),
|
||||
QSE_T("output"),
|
||||
|
||||
QSE_T("internal error"),
|
||||
QSE_T("syntax"),
|
||||
QSE_T("list too deep"),
|
||||
QSE_T("right parenthesis expected"),
|
||||
QSE_T("bad arguments"),
|
||||
QSE_T("too few arguments"),
|
||||
QSE_T("too many arguments"),
|
||||
QSE_T("undefined function '${0}'"),
|
||||
QSE_T("bad function"),
|
||||
QSE_T("duplicate formal"),
|
||||
QSE_T("bad symbol"),
|
||||
QSE_T("undefined symbol '${0}'"),
|
||||
QSE_T("empty body"),
|
||||
QSE_T("bad value"),
|
||||
QSE_T("divide by zero")
|
||||
};
|
||||
|
||||
return (errnum >= 0 && errnum < QSE_COUNTOF(errstr))?
|
||||
errstr[errnum]: QSE_T("unknown error");
|
||||
}
|
||||
|
||||
qse_lsp_errstr_t qse_lsp_geterrstr (qse_lsp_t* lsp)
|
||||
{
|
||||
return lsp->errstr;
|
||||
}
|
||||
|
||||
void qse_lsp_seterrstr (qse_lsp_t* lsp, qse_lsp_errstr_t errstr)
|
||||
{
|
||||
lsp->errstr = errstr;
|
||||
}
|
||||
|
||||
qse_lsp_errnum_t qse_lsp_geterrnum (qse_lsp_t* lsp)
|
||||
{
|
||||
return lsp->errnum;
|
||||
}
|
||||
|
||||
const qse_lsp_loc_t* qse_lsp_geterrloc (qse_lsp_t* lsp)
|
||||
{
|
||||
return &lsp->errloc;
|
||||
}
|
||||
|
||||
const qse_char_t* qse_lsp_geterrmsg (qse_lsp_t* lsp)
|
||||
{
|
||||
return (lsp->errmsg[0] == QSE_T('\0'))?
|
||||
qse_lsp_geterrstr(lsp)(lsp,lsp->errnum): lsp->errmsg;
|
||||
}
|
||||
|
||||
void qse_lsp_geterror (
|
||||
qse_lsp_t* lsp, qse_lsp_errnum_t* errnum,
|
||||
const qse_char_t** errmsg, qse_lsp_loc_t* errloc)
|
||||
{
|
||||
if (errnum != QSE_NULL) *errnum = lsp->errnum;
|
||||
if (errmsg != QSE_NULL)
|
||||
{
|
||||
*errmsg = (lsp->errmsg[0] == QSE_T('\0'))?
|
||||
qse_lsp_geterrstr(lsp)(lsp,lsp->errnum):
|
||||
lsp->errmsg;
|
||||
}
|
||||
if (errloc != QSE_NULL) *errloc = lsp->errloc;
|
||||
}
|
||||
|
||||
void qse_lsp_seterrnum (
|
||||
qse_lsp_t* lsp, qse_lsp_errnum_t errnum, const qse_cstr_t* errarg)
|
||||
{
|
||||
qse_lsp_seterror (lsp, errnum, errarg, QSE_NULL);
|
||||
}
|
||||
|
||||
void qse_lsp_seterrmsg (
|
||||
qse_lsp_t* lsp, qse_lsp_errnum_t errnum,
|
||||
const qse_char_t* errmsg, const qse_lsp_loc_t* errloc)
|
||||
{
|
||||
lsp->errnum = errnum;
|
||||
qse_strxcpy (lsp->errmsg, QSE_COUNTOF(lsp->errmsg), errmsg);
|
||||
if (errloc != QSE_NULL) lsp->errloc = *errloc;
|
||||
else QSE_MEMSET (&lsp->errloc, 0, QSE_SIZEOF(lsp->errloc));
|
||||
}
|
||||
|
||||
void qse_lsp_seterror (
|
||||
qse_lsp_t* lsp, qse_lsp_errnum_t errnum,
|
||||
const qse_cstr_t* errarg, const qse_lsp_loc_t* errloc)
|
||||
{
|
||||
const qse_char_t* errfmt;
|
||||
|
||||
lsp->errnum = errnum;
|
||||
|
||||
errfmt = qse_lsp_geterrstr(lsp)(lsp,lsp->errnum);
|
||||
QSE_ASSERT (errfmt != QSE_NULL);
|
||||
qse_strxfncpy (lsp->errmsg, QSE_COUNTOF(lsp->errmsg), errfmt, errarg);
|
||||
|
||||
if (errloc != QSE_NULL) lsp->errloc = *errloc;
|
||||
else QSE_MEMSET (&lsp->errloc, 0, QSE_SIZEOF(lsp->errloc));
|
||||
}
|
||||
|
||||
@ -1,389 +0,0 @@
|
||||
/*
|
||||
* $Id: eval.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
static qse_lsp_obj_t* makefn (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro);
|
||||
static qse_lsp_obj_t* eval_cons (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* cons);
|
||||
static qse_lsp_obj_t* apply (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual);
|
||||
static qse_lsp_obj_t* apply_to_prim (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_eval (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
return eval_cons (lsp, obj);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
/*
|
||||
if (obj == lsp->mem->lambda || obj == lsp->mem->macro) {
|
||||
qse_char_t* arg[1];
|
||||
|
||||
arg[0] = QSE_LSP_SYMPTR(obj);
|
||||
|
||||
printf ("lambda or macro can't be used as a normal symbol\n");
|
||||
qse_lsp_seterror (
|
||||
lsp, QSE_LSP_EBADSYM,
|
||||
arg, QSE_COUNTOF(arg));
|
||||
return QSE_NULL;
|
||||
}
|
||||
*/
|
||||
|
||||
assoc = qse_lsp_lookup(lsp->mem, obj);
|
||||
if (assoc == QSE_NULL || assoc->value == QSE_NULL)
|
||||
{
|
||||
if (lsp->opt_undef_symbol)
|
||||
{
|
||||
qse_cstr_t errarg;
|
||||
|
||||
errarg.len = QSE_LSP_SYMLEN(obj);
|
||||
errarg.ptr = QSE_LSP_SYMPTR(obj);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFSYM, &errarg, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
return lsp->mem->nil;
|
||||
}
|
||||
|
||||
obj = assoc->value;
|
||||
}
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* makefn (qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro)
|
||||
{
|
||||
qse_lsp_obj_t* func, * formal, * body, * p;
|
||||
|
||||
if (cdr == lsp->mem->nil)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (QSE_LSP_TYPE(cdr) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
formal = QSE_LSP_CAR(cdr);
|
||||
body = QSE_LSP_CDR(cdr);
|
||||
|
||||
if (body == lsp->mem->nil)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EEMPBDY, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
/* TODO: more lambda expression syntax checks required???. */
|
||||
|
||||
/* check if the lambda express has non-nil value
|
||||
* at the terminating cdr */
|
||||
for (p = body; QSE_LSP_TYPE(p) == QSE_LSP_OBJ_CONS; p = QSE_LSP_CDR(p));
|
||||
if (p != lsp->mem->nil)
|
||||
{
|
||||
/* like in (lambda (x) (+ x 10) . 4) */
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
func = (is_macro)?
|
||||
qse_lsp_makemacro (lsp->mem, formal, body):
|
||||
qse_lsp_makefunc (lsp->mem, formal, body);
|
||||
if (func == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return func;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* eval_cons (qse_lsp_t* lsp, qse_lsp_obj_t* cons)
|
||||
{
|
||||
qse_lsp_obj_t* car, * cdr;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(cons) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
car = QSE_LSP_CAR(cons);
|
||||
cdr = QSE_LSP_CDR(cons);
|
||||
|
||||
if (car == lsp->mem->lambda)
|
||||
{
|
||||
/* (lambda (x) (+ x 20)) */
|
||||
return makefn (lsp, cdr, 0);
|
||||
}
|
||||
else if (car == lsp->mem->macro)
|
||||
{
|
||||
/* (macro (x) (+ x 20)) */
|
||||
return makefn (lsp, cdr, 1);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
if ((assoc = qse_lsp_lookup(lsp->mem, car)) != QSE_NULL)
|
||||
{
|
||||
/*qse_lsp_obj_t* func = assoc->value;*/
|
||||
qse_lsp_obj_t* func = assoc->func;
|
||||
if (func == QSE_NULL)
|
||||
{
|
||||
/* the symbol's function definition is void */
|
||||
qse_cstr_t errarg;
|
||||
|
||||
errarg.len = QSE_LSP_SYMLEN(car);
|
||||
errarg.ptr = QSE_LSP_SYMPTR(car);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_FUNC ||
|
||||
QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_PRIM)
|
||||
{
|
||||
/* primitive function */
|
||||
return apply_to_prim (lsp, func, cdr);
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_cstr_t errarg;
|
||||
|
||||
errarg.len = QSE_LSP_SYMLEN(car);
|
||||
errarg.ptr = QSE_LSP_SYMPTR(car);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_cstr_t errarg;
|
||||
|
||||
errarg.len = QSE_LSP_SYMLEN(car);
|
||||
errarg.ptr = QSE_LSP_SYMPTR(car);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_FUNC ||
|
||||
QSE_LSP_TYPE(car) == QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
return apply (lsp, car, cdr);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(car) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
/* anonymous function or macros
|
||||
* ((lambda (x) (+ x 10)) 50) */
|
||||
if (QSE_LSP_CAR(car) == lsp->mem->lambda)
|
||||
{
|
||||
qse_lsp_obj_t* func = makefn (lsp, QSE_LSP_CDR(car), 0);
|
||||
if (func == QSE_NULL) return QSE_NULL;
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
else if (QSE_LSP_CAR(car) == lsp->mem->macro)
|
||||
{
|
||||
qse_lsp_obj_t* func = makefn (lsp, QSE_LSP_CDR(car), 1);
|
||||
if (func == QSE_NULL) return QSE_NULL;
|
||||
return apply (lsp, func, cdr);
|
||||
}
|
||||
}
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EBADFN, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* apply (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual)
|
||||
{
|
||||
qse_lsp_frame_t* frame;
|
||||
qse_lsp_obj_t* formal;
|
||||
qse_lsp_obj_t* body;
|
||||
qse_lsp_obj_t* value;
|
||||
qse_lsp_mem_t* mem;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_FUNC ||
|
||||
QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO);
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(QSE_LSP_CDR(func)) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
mem = lsp->mem;
|
||||
|
||||
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
formal = QSE_LSP_MFORMAL (func);
|
||||
body = QSE_LSP_MBODY (func);
|
||||
}
|
||||
else
|
||||
{
|
||||
formal = QSE_LSP_FFORMAL (func);
|
||||
body = QSE_LSP_FBODY (func);
|
||||
}
|
||||
|
||||
/* make a new frame. */
|
||||
frame = qse_lsp_newframe (lsp);
|
||||
if (frame == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* attach it to the brooding frame list to
|
||||
* prevent them from being garbage-collected. */
|
||||
frame->link = mem->brooding_frame;
|
||||
mem->brooding_frame = frame;
|
||||
|
||||
/* evaluate arguments and push them into the frame. */
|
||||
while (formal != mem->nil)
|
||||
{
|
||||
if (actual == mem->nil)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
value = QSE_LSP_CAR(actual);
|
||||
if (QSE_LSP_TYPE(func) != QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
/* macro doesn't evaluate actual arguments. */
|
||||
value = qse_lsp_eval (lsp, value);
|
||||
if (value == QSE_NULL)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if (qse_lsp_lookupinframe (
|
||||
lsp, frame, QSE_LSP_CAR(formal)) != QSE_NULL)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (qse_lsp_insvalueintoframe (
|
||||
lsp, frame, QSE_LSP_CAR(formal), value) == QSE_NULL)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
actual = QSE_LSP_CDR(actual);
|
||||
formal = QSE_LSP_CDR(formal);
|
||||
}
|
||||
|
||||
if (QSE_LSP_TYPE(actual) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
else if (actual != mem->nil)
|
||||
{
|
||||
mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
/* push the frame */
|
||||
mem->brooding_frame = frame->link;
|
||||
frame->link = mem->frame;
|
||||
mem->frame = frame;
|
||||
|
||||
/* do the evaluation of the body */
|
||||
value = mem->nil;
|
||||
while (body != mem->nil)
|
||||
{
|
||||
value = qse_lsp_eval(lsp, QSE_LSP_CAR(body));
|
||||
if (value == QSE_NULL)
|
||||
{
|
||||
mem->frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
/* pop the frame. */
|
||||
mem->frame = frame->link;
|
||||
|
||||
/* destroy the frame. */
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
/*if (QSE_LSP_CAR(func) == mem->macro) {*/
|
||||
if (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
value = qse_lsp_eval (lsp, value);
|
||||
if (value == QSE_NULL) return QSE_NULL;
|
||||
}
|
||||
|
||||
return value;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* apply_to_prim (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* func, qse_lsp_obj_t* actual)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
qse_size_t count = 0;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(func) == QSE_LSP_OBJ_PRIM);
|
||||
|
||||
obj = actual;
|
||||
while (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
count++;
|
||||
obj = QSE_LSP_CDR(obj);
|
||||
}
|
||||
if (obj != lsp->mem->nil)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (count < QSE_LSP_PMINARGS(func))
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (count > QSE_LSP_PMAXARGS(func))
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
return QSE_LSP_PIMPL(func) (lsp, actual);
|
||||
}
|
||||
@ -1,207 +0,0 @@
|
||||
/*
|
||||
* $Id: lsp.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
QSE_IMPLEMENT_COMMON_FUNCTIONS (lsp)
|
||||
|
||||
static qse_lsp_t* qse_lsp_init (
|
||||
qse_lsp_t* lsp, qse_mmgr_t* mmgr, const qse_lsp_prm_t* prm,
|
||||
qse_size_t mem_ubound, qse_size_t mem_ubound_inc);
|
||||
static void qse_lsp_fini (qse_lsp_t* lsp);
|
||||
|
||||
static int __add_builtin_prims (qse_lsp_t* lsp);
|
||||
|
||||
qse_lsp_t* qse_lsp_open (
|
||||
qse_mmgr_t* mmgr, qse_size_t xtnsize, const qse_lsp_prm_t* prm,
|
||||
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
|
||||
{
|
||||
qse_lsp_t* lsp;
|
||||
|
||||
if (mmgr == QSE_NULL)
|
||||
{
|
||||
mmgr = QSE_MMGR_GETDFL();
|
||||
|
||||
QSE_ASSERTX (mmgr != QSE_NULL,
|
||||
"Set the memory manager with QSE_MMGR_SETDFL()");
|
||||
|
||||
if (mmgr == QSE_NULL) return QSE_NULL;
|
||||
}
|
||||
|
||||
lsp = (qse_lsp_t*) QSE_MMGR_ALLOC (mmgr, QSE_SIZEOF(qse_lsp_t) + xtnsize);
|
||||
if (lsp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_init (lsp, mmgr, prm, mem_ubound, mem_ubound_inc) == QSE_NULL)
|
||||
{
|
||||
QSE_MMGR_FREE (lsp->mmgr, lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
return lsp;
|
||||
}
|
||||
|
||||
void qse_lsp_close (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_lsp_fini (lsp);
|
||||
QSE_LSP_FREE (lsp, lsp);
|
||||
}
|
||||
|
||||
static qse_lsp_t* qse_lsp_init (
|
||||
qse_lsp_t* lsp, qse_mmgr_t* mmgr, const qse_lsp_prm_t* prm,
|
||||
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
|
||||
{
|
||||
QSE_MEMSET (lsp, 0, QSE_SIZEOF(*lsp));
|
||||
|
||||
lsp->mmgr = mmgr;
|
||||
lsp->errstr = qse_lsp_dflerrstr;
|
||||
lsp->prm = *prm;
|
||||
|
||||
if (qse_str_init(&lsp->token.name, mmgr, 256) == QSE_NULL)
|
||||
{
|
||||
QSE_LSP_FREE (lsp, lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
lsp->errnum = QSE_LSP_ENOERR;
|
||||
lsp->errmsg[0] = QSE_T('\0');
|
||||
lsp->opt_undef_symbol = 1;
|
||||
/*lsp->opt_undef_symbol = 0;*/
|
||||
|
||||
lsp->curc = QSE_CHAR_EOF;
|
||||
lsp->curloc.line = 1;
|
||||
lsp->curloc.colm = 0;
|
||||
|
||||
lsp->mem = qse_lsp_openmem (lsp, mem_ubound, mem_ubound_inc);
|
||||
if (lsp->mem == QSE_NULL)
|
||||
{
|
||||
qse_str_fini (&lsp->token.name);
|
||||
QSE_LSP_FREE (lsp, lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (__add_builtin_prims(lsp) == -1)
|
||||
{
|
||||
qse_lsp_closemem (lsp->mem);
|
||||
qse_str_fini (&lsp->token.name);
|
||||
QSE_LSP_FREE (lsp, lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
lsp->max_eval_depth = 0; /* TODO: put restriction here.... */
|
||||
lsp->cur_eval_depth = 0;
|
||||
|
||||
return lsp;
|
||||
}
|
||||
|
||||
static void qse_lsp_fini (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_lsp_closemem (lsp->mem);
|
||||
qse_str_fini (&lsp->token.name);
|
||||
}
|
||||
|
||||
void qse_lsp_detachio (qse_lsp_t* lsp)
|
||||
{
|
||||
if (lsp->io.fns.out)
|
||||
{
|
||||
lsp->io.fns.out (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.out, QSE_NULL, 0);
|
||||
lsp->io.fns.out = QSE_NULL;
|
||||
}
|
||||
if (lsp->io.fns.in)
|
||||
{
|
||||
lsp->io.fns.in (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.in, QSE_NULL, 0);
|
||||
lsp->io.fns.in = QSE_NULL;
|
||||
lsp->curc = QSE_CHAR_EOF; /* TODO: needed??? */
|
||||
}
|
||||
}
|
||||
|
||||
int qse_lsp_attachio (qse_lsp_t* lsp, qse_lsp_io_t* io)
|
||||
{
|
||||
qse_lsp_detachio(lsp);
|
||||
|
||||
QSE_ASSERT (lsp->io.fns.in == QSE_NULL);
|
||||
QSE_ASSERT (lsp->io.fns.out == QSE_NULL);
|
||||
|
||||
if (io->in (lsp, QSE_LSP_IO_OPEN, &lsp->io.arg.in, QSE_NULL, 0) <= -1)
|
||||
{
|
||||
/* TODO: error code if error not set... */
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (io->out (lsp, QSE_LSP_IO_OPEN, &lsp->io.arg.out, QSE_NULL, 0) <= -1)
|
||||
{
|
||||
/* TODO: error code if error not set... */
|
||||
io->in (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.in, QSE_NULL, 0);
|
||||
return -1;
|
||||
}
|
||||
|
||||
lsp->io.fns = *io;
|
||||
lsp->curc = QSE_CHAR_EOF;
|
||||
lsp->curloc.line = 1;
|
||||
lsp->curloc.colm = 0;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int __add_builtin_prims (qse_lsp_t* lsp)
|
||||
{
|
||||
|
||||
#define ADD_PRIM(mem,name,name_len,pimpl,min_args,max_args) \
|
||||
if (qse_lsp_addprim(mem,name,name_len,pimpl,min_args,max_args) == -1) return -1;
|
||||
#define MAX_ARGS QSE_TYPE_MAX(qse_size_t)
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("exit"), 4, qse_lsp_prim_exit, 0, 0);
|
||||
ADD_PRIM (lsp, QSE_T("eval"), 4, qse_lsp_prim_eval, 1, 1);
|
||||
ADD_PRIM (lsp, QSE_T("prog1"), 5, qse_lsp_prim_prog1, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("progn"), 5, qse_lsp_prim_progn, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("gc"), 2, qse_lsp_prim_gc, 0, 0);
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("cond"), 4, qse_lsp_prim_cond, 0, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("if"), 2, qse_lsp_prim_if, 2, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("while"), 5, qse_lsp_prim_while, 1, MAX_ARGS);
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("car"), 3, qse_lsp_prim_car, 1, 1);
|
||||
ADD_PRIM (lsp, QSE_T("cdr"), 3, qse_lsp_prim_cdr, 1, 1);
|
||||
ADD_PRIM (lsp, QSE_T("cons"), 4, qse_lsp_prim_cons, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T("length"), 6, qse_lsp_prim_length, 1, 1);
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("set"), 3, qse_lsp_prim_set, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T("setq"), 4, qse_lsp_prim_setq, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("quote"), 5, qse_lsp_prim_quote, 1, 1);
|
||||
ADD_PRIM (lsp, QSE_T("defun"), 5, qse_lsp_prim_defun, 3, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("macro"), 5, qse_lsp_prim_demac, 3, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("let"), 3, qse_lsp_prim_let, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("let*"), 4, qse_lsp_prim_letx, 1, MAX_ARGS);
|
||||
/*ADD_PRIM (lsp, QSE_T("or"), 2, qse_lsp_prim_or, 2, MAX_ARGS);*/
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("="), 1, qse_lsp_prim_eq, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T("/="), 2, qse_lsp_prim_ne, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T(">"), 1, qse_lsp_prim_gt, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T("<"), 1, qse_lsp_prim_lt, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T(">="), 2, qse_lsp_prim_ge, 2, 2);
|
||||
ADD_PRIM (lsp, QSE_T("<="), 2, qse_lsp_prim_le, 2, 2);
|
||||
|
||||
ADD_PRIM (lsp, QSE_T("+"), 1, qse_lsp_prim_plus, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("-"), 1, qse_lsp_prim_minus, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("*"), 1, qse_lsp_prim_mul, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("/"), 1, qse_lsp_prim_div, 1, MAX_ARGS);
|
||||
ADD_PRIM (lsp, QSE_T("%"), 1, qse_lsp_prim_mod , 1, MAX_ARGS);
|
||||
|
||||
return 0;
|
||||
}
|
||||
@ -1,113 +0,0 @@
|
||||
/*
|
||||
* $Id: lsp.h 332 2008-08-18 11:21:48Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_LSP_H_
|
||||
#define _QSE_LIB_LSP_LSP_H_
|
||||
|
||||
#include "../cmn/mem.h"
|
||||
#include <qse/cmn/chr.h>
|
||||
#include <qse/cmn/str.h>
|
||||
|
||||
#include <qse/lsp/lsp.h>
|
||||
#include "env.h"
|
||||
#include "obj.h"
|
||||
#include "mem.h"
|
||||
#include "misc.h"
|
||||
#include "prim.h"
|
||||
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning (disable: 4996)
|
||||
#endif
|
||||
|
||||
#define QSE_LSP_ALLOC(lsp,size) QSE_MMGR_ALLOC((lsp)->mmgr,size)
|
||||
#define QSE_LSP_REALLOC(lsp,ptr,size) QSE_MMGR_REALLOC((lsp)->mmgr,ptr,size)
|
||||
#define QSE_LSP_FREE(lsp,ptr) QSE_MMGR_FREE((lsp)->mmgr,ptr)
|
||||
|
||||
#define QSE_LSP_ISUPPER(lsp,c) QSE_ISUPPER(c)
|
||||
#define QSE_LSP_ISLOWER(lsp,c) QSE_ISLOWER(c)
|
||||
#define QSE_LSP_ISALPHA(lsp,c) QSE_ISALPHA(c)
|
||||
#define QSE_LSP_ISDIGIT(lsp,c) QSE_ISDIGIT(c)
|
||||
#define QSE_LSP_ISXDIGIT(lsp,c) QSE_ISXDIGIT(c)
|
||||
#define QSE_LSP_ISALNUM(lsp,c) QSE_ISALNUM(c)
|
||||
#define QSE_LSP_ISSPACE(lsp,c) QSE_ISSPACE(c)
|
||||
#define QSE_LSP_ISPRINT(lsp,c) QSE_ISPRINT(c)
|
||||
#define QSE_LSP_ISGRAPH(lsp,c) QSE_ISGRAPH(c)
|
||||
#define QSE_LSP_ISCNTRL(lsp,c) QSE_ISCNTRL(c)
|
||||
#define QSE_LSP_ISPUNCT(lsp,c) QSE_ISPUNCT(c)
|
||||
#define QSE_LSP_TOUPPER(lsp,c) QSE_TOUPPER(c)
|
||||
#define QSE_LSP_TOLOWER(lsp,c) QSE_TOLOWER(c)
|
||||
|
||||
struct qse_lsp_t
|
||||
{
|
||||
QSE_DEFINE_COMMON_FIELDS (lsp)
|
||||
|
||||
qse_lsp_prm_t prm;
|
||||
|
||||
qse_lsp_errstr_t errstr; /**< error string getter */
|
||||
qse_lsp_errnum_t errnum; /**< stores an error number */
|
||||
qse_char_t errmsg[128]; /**< error message holder */
|
||||
qse_lsp_loc_t errloc; /**< location of the last error */
|
||||
|
||||
/* options */
|
||||
int opt_undef_symbol;
|
||||
|
||||
/* for read */
|
||||
qse_cint_t curc;
|
||||
qse_lsp_loc_t curloc;
|
||||
|
||||
struct
|
||||
{
|
||||
int type;
|
||||
qse_lsp_loc_t loc;
|
||||
qse_long_t ival;
|
||||
qse_real_t rval;
|
||||
qse_str_t name;
|
||||
} token;
|
||||
|
||||
/* io function */
|
||||
struct
|
||||
{
|
||||
qse_lsp_io_t fns;
|
||||
|
||||
struct
|
||||
{
|
||||
qse_lsp_io_arg_t in;
|
||||
qse_lsp_io_arg_t out;
|
||||
} arg;
|
||||
} io;
|
||||
|
||||
/* security options */
|
||||
qse_size_t max_eval_depth;
|
||||
qse_size_t cur_eval_depth;
|
||||
|
||||
/* memory manager */
|
||||
qse_lsp_mem_t* mem;
|
||||
};
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
const qse_char_t* qse_lsp_dflerrstr (qse_lsp_t* lsp, qse_lsp_errnum_t errnum);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
@ -1,611 +0,0 @@
|
||||
/*
|
||||
* $Id: mem.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
static qse_lsp_obj_t* makeint (qse_lsp_mem_t* mem, qse_long_t value);
|
||||
static QSE_INLINE_ALWAYS void collect_garbage (qse_lsp_mem_t* mem);
|
||||
static void dispose_all (qse_lsp_mem_t* mem);
|
||||
|
||||
qse_lsp_mem_t* qse_lsp_openmem (
|
||||
qse_lsp_t* lsp, qse_size_t ubound, qse_size_t ubound_inc)
|
||||
{
|
||||
qse_lsp_mem_t* mem;
|
||||
qse_size_t i;
|
||||
int fail = 0;
|
||||
|
||||
/* allocate memory */
|
||||
mem = (qse_lsp_mem_t*) QSE_LSP_ALLOC (lsp, QSE_SIZEOF(qse_lsp_mem_t));
|
||||
if (mem == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_MEMSET (mem, 0, QSE_SIZEOF(qse_lsp_mem_t));
|
||||
mem->lsp = lsp;
|
||||
|
||||
/* create a new root environment frame */
|
||||
mem->frame = qse_lsp_newframe (lsp);
|
||||
if (mem->frame == QSE_NULL)
|
||||
{
|
||||
QSE_LSP_FREE (lsp, mem);
|
||||
return QSE_NULL;
|
||||
}
|
||||
mem->root_frame = mem->frame;
|
||||
mem->brooding_frame = QSE_NULL;
|
||||
mem->tlink = QSE_NULL;
|
||||
mem->tlink_count = 0;
|
||||
|
||||
/* initialize object allocation list */
|
||||
mem->ubound = ubound;
|
||||
mem->ubound_inc = ubound_inc;
|
||||
mem->count = 0;
|
||||
for (i = 0; i < QSE_LSP_TYPE_COUNT; i++)
|
||||
{
|
||||
mem->used[i] = QSE_NULL;
|
||||
mem->free[i] = QSE_NULL;
|
||||
}
|
||||
|
||||
/* initialize read registers */
|
||||
mem->r.obj = QSE_NULL;
|
||||
mem->r.tmp = QSE_NULL;
|
||||
mem->r.stack = QSE_NULL;
|
||||
|
||||
/* when "ubound" is too small, the garbage collection can
|
||||
* be performed while making the common objects. */
|
||||
mem->nil = QSE_NULL;
|
||||
mem->t = QSE_NULL;
|
||||
mem->quote = QSE_NULL;
|
||||
mem->lambda = QSE_NULL;
|
||||
mem->macro = QSE_NULL;
|
||||
for (i = 0; i < QSE_COUNTOF(mem->num); i++) mem->num[i] = QSE_NULL;
|
||||
|
||||
/* initialize common object pointers */
|
||||
mem->nil = qse_lsp_makenil (mem);
|
||||
mem->t = qse_lsp_maketrue (mem);
|
||||
mem->quote = qse_lsp_makesym (mem, QSE_T("quote"), 5);
|
||||
mem->lambda = qse_lsp_makesym (mem, QSE_T("lambda"), 6);
|
||||
mem->macro = qse_lsp_makesym (mem, QSE_T("macro"), 5);
|
||||
|
||||
if (mem->nil == QSE_NULL ||
|
||||
mem->t == QSE_NULL ||
|
||||
mem->quote == QSE_NULL ||
|
||||
mem->lambda == QSE_NULL ||
|
||||
mem->macro == QSE_NULL)
|
||||
{
|
||||
fail = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
|
||||
{
|
||||
mem->num[i] = makeint (mem, i);
|
||||
if (mem->num[i] == QSE_NULL) { fail = 1; break; }
|
||||
}
|
||||
}
|
||||
|
||||
if (fail)
|
||||
{
|
||||
dispose_all (mem);
|
||||
qse_lsp_freeframe (lsp, mem->frame);
|
||||
QSE_LSP_FREE (lsp, mem);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
QSE_LSP_PERM(mem->nil) = 1;
|
||||
QSE_LSP_PERM(mem->t) = 1;
|
||||
QSE_LSP_PERM(mem->quote) = 1;
|
||||
QSE_LSP_PERM(mem->lambda) = 1;
|
||||
QSE_LSP_PERM(mem->macro) = 1;
|
||||
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
|
||||
{
|
||||
QSE_LSP_PERM(mem->num[i]) = 1;
|
||||
}
|
||||
|
||||
/* let the read stack point to nil */
|
||||
mem->r.stack = mem->nil;
|
||||
|
||||
return mem;
|
||||
}
|
||||
|
||||
void qse_lsp_closemem (qse_lsp_mem_t* mem)
|
||||
{
|
||||
/* dispose of the allocated objects */
|
||||
dispose_all (mem);
|
||||
|
||||
/* dispose of environment frames */
|
||||
qse_lsp_freeframe (mem->lsp, mem->frame);
|
||||
|
||||
/* free the memory */
|
||||
QSE_LSP_FREE (mem->lsp, mem);
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* allocate (qse_lsp_mem_t* mem, int type, qse_size_t size)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
if (mem->count >= mem->ubound) collect_garbage (mem);
|
||||
if (mem->count >= mem->ubound)
|
||||
{
|
||||
mem->ubound += mem->ubound_inc;
|
||||
if (mem->count >= mem->ubound) return QSE_NULL;
|
||||
}
|
||||
|
||||
obj = (qse_lsp_obj_t*) QSE_LSP_ALLOC (mem->lsp, size);
|
||||
if (obj == QSE_NULL)
|
||||
{
|
||||
collect_garbage (mem);
|
||||
|
||||
obj = (qse_lsp_obj_t*) QSE_LSP_ALLOC (mem->lsp, size);
|
||||
if (obj == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (mem->lsp, QSE_LSP_ENOMEM, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
|
||||
QSE_LSP_TYPE(obj) = type;
|
||||
QSE_LSP_SIZE(obj) = size;
|
||||
QSE_LSP_MARK(obj) = 0;
|
||||
QSE_LSP_PERM(obj) = 0;
|
||||
|
||||
/* insert the object at the head of the used list */
|
||||
QSE_LSP_LINK(obj) = mem->used[type];
|
||||
mem->used[type] = obj;
|
||||
mem->count++;
|
||||
|
||||
#if 0
|
||||
qse_dprint1 (QSE_T("mem->count: %u\n"), mem->count);
|
||||
#endif
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
static void dispose (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* prev, qse_lsp_obj_t* obj)
|
||||
{
|
||||
QSE_ASSERT (obj != QSE_NULL);
|
||||
QSE_ASSERT (mem->count > 0);
|
||||
|
||||
/* TODO: push the object to the free list for more
|
||||
* efficient memory management */
|
||||
|
||||
if (prev == QSE_NULL)
|
||||
mem->used[QSE_LSP_TYPE(obj)] = QSE_LSP_LINK(obj);
|
||||
else QSE_LSP_LINK(prev) = QSE_LSP_LINK(obj);
|
||||
|
||||
mem->count--;
|
||||
#if 0
|
||||
qse_dprint1 (QSE_T("mem->count: %u\n"), mem->count);
|
||||
#endif
|
||||
|
||||
QSE_LSP_FREE (mem->lsp, obj);
|
||||
}
|
||||
|
||||
static void dispose_all (qse_lsp_mem_t* mem)
|
||||
{
|
||||
qse_lsp_obj_t* obj, * next;
|
||||
qse_size_t i;
|
||||
|
||||
for (i = 0; i < QSE_LSP_TYPE_COUNT; i++)
|
||||
{
|
||||
obj = mem->used[i];
|
||||
|
||||
while (obj != QSE_NULL)
|
||||
{
|
||||
next = QSE_LSP_LINK(obj);
|
||||
dispose (mem, QSE_NULL, obj);
|
||||
obj = next;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void mark_obj (qse_lsp_mem_t* mem, qse_lsp_obj_t* obj)
|
||||
{
|
||||
QSE_ASSERT (obj != QSE_NULL);
|
||||
|
||||
/* TODO: can it be non-recursive? */
|
||||
if (QSE_LSP_MARK(obj) != 0) return;
|
||||
|
||||
QSE_LSP_MARK(obj) = 1;
|
||||
|
||||
if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
mark_obj (mem, QSE_LSP_CAR(obj));
|
||||
mark_obj (mem, QSE_LSP_CDR(obj));
|
||||
}
|
||||
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_FUNC)
|
||||
{
|
||||
mark_obj (mem, QSE_LSP_FFORMAL(obj));
|
||||
mark_obj (mem, QSE_LSP_FBODY(obj));
|
||||
}
|
||||
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_MACRO)
|
||||
{
|
||||
mark_obj (mem, QSE_LSP_MFORMAL(obj));
|
||||
mark_obj (mem, QSE_LSP_MBODY(obj));
|
||||
}
|
||||
}
|
||||
|
||||
static void mark_objs_in_use (qse_lsp_mem_t* mem)
|
||||
{
|
||||
qse_lsp_frame_t* frame;
|
||||
qse_lsp_assoc_t* assoc;
|
||||
qse_lsp_tlink_t* tlink;
|
||||
/*qse_lsp_arr_t* arr;*/
|
||||
qse_size_t i;
|
||||
|
||||
#if 0
|
||||
qse_dprint0 (QSE_T("marking environment frames\n"));
|
||||
#endif
|
||||
/* mark objects in the environment frames */
|
||||
frame = mem->frame;
|
||||
while (frame != QSE_NULL)
|
||||
{
|
||||
assoc = frame->assoc;
|
||||
while (assoc != QSE_NULL)
|
||||
{
|
||||
mark_obj (mem, assoc->name);
|
||||
|
||||
if (assoc->value != QSE_NULL)
|
||||
mark_obj (mem, assoc->value);
|
||||
if (assoc->func != QSE_NULL)
|
||||
mark_obj (mem, assoc->func);
|
||||
|
||||
assoc = assoc->link;
|
||||
}
|
||||
|
||||
frame = frame->link;
|
||||
}
|
||||
|
||||
#if 0
|
||||
qse_dprint0 (QSE_T("marking interim frames\n"));
|
||||
#endif
|
||||
|
||||
/* mark objects in the interim frames */
|
||||
frame = mem->brooding_frame;
|
||||
while (frame != QSE_NULL)
|
||||
{
|
||||
assoc = frame->assoc;
|
||||
while (assoc != QSE_NULL)
|
||||
{
|
||||
mark_obj (mem, assoc->name);
|
||||
|
||||
if (assoc->value != QSE_NULL)
|
||||
mark_obj (mem, assoc->value);
|
||||
if (assoc->func != QSE_NULL)
|
||||
mark_obj (mem, assoc->func);
|
||||
|
||||
assoc = assoc->link;
|
||||
}
|
||||
|
||||
frame = frame->link;
|
||||
}
|
||||
|
||||
/*qse_dprint0 (QSE_T("marking the read object\n"));*/
|
||||
if (mem->r.obj) mark_obj (mem, mem->r.obj);
|
||||
if (mem->r.tmp) mark_obj (mem, mem->r.tmp);
|
||||
if (mem->r.stack) mark_obj (mem, mem->r.stack);
|
||||
|
||||
/* qse_dprint0 (QSE_T("marking the temporary objects\n"));*/
|
||||
for (tlink = mem->tlink; tlink != QSE_NULL; tlink = tlink->link)
|
||||
{
|
||||
mark_obj (mem, tlink->obj);
|
||||
}
|
||||
|
||||
#if 0
|
||||
qse_dprint0 (QSE_T("marking builtin objects\n"));
|
||||
#endif
|
||||
/* mark common objects */
|
||||
if (mem->t) mark_obj (mem, mem->t);
|
||||
if (mem->nil) mark_obj (mem, mem->nil);
|
||||
if (mem->quote) mark_obj (mem, mem->quote);
|
||||
if (mem->lambda) mark_obj (mem, mem->lambda);
|
||||
if (mem->macro) mark_obj (mem, mem->macro);
|
||||
|
||||
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
|
||||
{
|
||||
if (mem->num[i]) mark_obj (mem, mem->num[i]);
|
||||
}
|
||||
}
|
||||
|
||||
//#include <qse/cmn/stdio.h>
|
||||
static void sweep_unmarked_objs (qse_lsp_mem_t* mem)
|
||||
{
|
||||
qse_lsp_obj_t* obj, * prev, * next;
|
||||
qse_size_t i;
|
||||
|
||||
/* scan all the allocated objects and get rid of unused objects */
|
||||
for (i = 0; i < QSE_LSP_TYPE_COUNT; i++)
|
||||
{
|
||||
prev = QSE_NULL;
|
||||
obj = mem->used[i];
|
||||
|
||||
#if 0
|
||||
qse_dprint1 (QSE_T("sweeping objects of type: %u\n"), i);
|
||||
#endif
|
||||
while (obj != QSE_NULL)
|
||||
{
|
||||
next = QSE_LSP_LINK(obj);
|
||||
|
||||
if (QSE_LSP_MARK(obj) == 0 &&
|
||||
QSE_LSP_PERM(obj) == 0)
|
||||
{
|
||||
/* dispose of unused objects */
|
||||
/*
|
||||
if (i == QSE_LSP_OBJ_INT)
|
||||
qse_printf (QSE_T("disposing....%d [%d]\n"), i, (int)QSE_LSP_IVAL(obj));
|
||||
if (i == QSE_LSP_OBJ_REAL)
|
||||
qse_printf (QSE_T("disposing....%d [%Lf]\n"), i, (double)QSE_LSP_RVAL(obj));
|
||||
else if (i == QSE_LSP_OBJ_SYM)
|
||||
qse_printf (QSE_T("disposing....%d [%s]\n"), i, QSE_LSP_SYMPTR(obj));
|
||||
else if (i == QSE_LSP_OBJ_STR)
|
||||
qse_printf (QSE_T("disposing....%d [%s]\n"), i, QSE_LSP_STRPTR(obj));
|
||||
else
|
||||
qse_printf (QSE_T("disposing....%d\n"), i);
|
||||
*/
|
||||
dispose (mem, prev, obj);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* unmark the object in use */
|
||||
QSE_LSP_MARK(obj) = 0;
|
||||
prev = obj;
|
||||
}
|
||||
|
||||
obj = next;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS void collect_garbage (qse_lsp_mem_t* mem)
|
||||
{
|
||||
mark_objs_in_use (mem);
|
||||
sweep_unmarked_objs (mem);
|
||||
}
|
||||
|
||||
void qse_lsp_gc (qse_lsp_t* lsp)
|
||||
{
|
||||
collect_garbage (lsp->mem);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem)
|
||||
{
|
||||
if (mem->nil != QSE_NULL) return mem->nil;
|
||||
mem->nil = allocate (
|
||||
mem, QSE_LSP_OBJ_NIL, QSE_SIZEOF(qse_lsp_obj_nil_t));
|
||||
return mem->nil;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_maketrue (qse_lsp_mem_t* mem)
|
||||
{
|
||||
if (mem->t != QSE_NULL) return mem->t;
|
||||
mem->t = allocate (
|
||||
mem, QSE_LSP_OBJ_TRUE, QSE_SIZEOF(qse_lsp_obj_true_t));
|
||||
return mem->t;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* makeint (qse_lsp_mem_t* mem, qse_long_t value)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (mem,
|
||||
QSE_LSP_OBJ_INT, QSE_SIZEOF(qse_lsp_obj_int_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_IVAL(obj) = value;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makeint (qse_lsp_mem_t* mem, qse_long_t value)
|
||||
{
|
||||
if (value >= 0 && value < QSE_COUNTOF(mem->num)) return mem->num[value];
|
||||
return makeint (mem, value);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makereal (qse_lsp_mem_t* mem, qse_real_t value)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (mem,
|
||||
QSE_LSP_OBJ_REAL, QSE_SIZEOF(qse_lsp_obj_real_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_RVAL(obj) = value;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makesym (
|
||||
qse_lsp_mem_t* mem, const qse_char_t* str, qse_size_t len)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
/* TODO: use rbt or htb ... */
|
||||
|
||||
/* look for a sysmbol with the given name */
|
||||
obj = mem->used[QSE_LSP_OBJ_SYM];
|
||||
while (obj != QSE_NULL)
|
||||
{
|
||||
/* if there is a symbol with the same name, it is just used. */
|
||||
if (qse_strxncmp (
|
||||
QSE_LSP_SYMPTR(obj),
|
||||
QSE_LSP_SYMLEN(obj),
|
||||
str, len) == 0) return obj;
|
||||
obj = QSE_LSP_LINK(obj);
|
||||
}
|
||||
|
||||
/* no such symbol found. create a new one */
|
||||
obj = allocate (mem, QSE_LSP_OBJ_SYM,
|
||||
QSE_SIZEOF(qse_lsp_obj_sym_t)+(len + 1)*QSE_SIZEOF(qse_char_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* fill in the symbol buffer */
|
||||
qse_strncpy (QSE_LSP_SYMPTR(obj), str, len);
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makestr (
|
||||
qse_lsp_mem_t* mem, const qse_char_t* str, qse_size_t len)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
/* allocate memory for the string */
|
||||
obj = allocate (mem, QSE_LSP_OBJ_STR,
|
||||
QSE_SIZEOF(qse_lsp_obj_str_t)+(len + 1)*QSE_SIZEOF(qse_char_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* fill in the string buffer */
|
||||
qse_strncpy (QSE_LSP_STRPTR(obj), str, len);
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makecons (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* car, qse_lsp_obj_t* cdr)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (mem,
|
||||
QSE_LSP_OBJ_CONS, QSE_SIZEOF(qse_lsp_obj_cons_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_CAR(obj) = car;
|
||||
QSE_LSP_CDR(obj) = cdr;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makefunc (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* formal, qse_lsp_obj_t* body)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (mem,
|
||||
QSE_LSP_OBJ_FUNC, QSE_SIZEOF(qse_lsp_obj_func_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_FFORMAL(obj) = formal;
|
||||
QSE_LSP_FBODY(obj) = body;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makemacro (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* formal, qse_lsp_obj_t* body)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (mem,
|
||||
QSE_LSP_OBJ_MACRO, QSE_SIZEOF(qse_lsp_obj_macro_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_MFORMAL(obj) = formal;
|
||||
QSE_LSP_MBODY(obj) = body;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makeprim (qse_lsp_mem_t* mem,
|
||||
qse_lsp_prim_t impl, qse_size_t min_args, qse_size_t max_args)
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
obj = allocate (
|
||||
mem, QSE_LSP_OBJ_PRIM, QSE_SIZEOF(qse_lsp_obj_prim_t));
|
||||
if (obj == QSE_NULL) return QSE_NULL;
|
||||
|
||||
QSE_LSP_PIMPL(obj) = impl;
|
||||
QSE_LSP_PMINARGS(obj) = min_args;
|
||||
QSE_LSP_PMAXARGS(obj) = max_args;
|
||||
return obj;
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_lookup (qse_lsp_mem_t* mem, qse_lsp_obj_t* name)
|
||||
{
|
||||
qse_lsp_frame_t* frame;
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(name) == QSE_LSP_OBJ_SYM);
|
||||
|
||||
frame = mem->frame;
|
||||
|
||||
while (frame != QSE_NULL)
|
||||
{
|
||||
assoc = qse_lsp_lookupinframe (mem->lsp, frame, name);
|
||||
if (assoc != QSE_NULL) return assoc;
|
||||
frame = frame->link;
|
||||
}
|
||||
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_setvalue (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* name, qse_lsp_obj_t* value)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
assoc = qse_lsp_lookup (mem, name);
|
||||
if (assoc == QSE_NULL)
|
||||
{
|
||||
assoc = qse_lsp_insvalueintoframe (
|
||||
mem->lsp, mem->root_frame, name, value);
|
||||
if (assoc == QSE_NULL) return QSE_NULL;
|
||||
}
|
||||
else assoc->value = value;
|
||||
|
||||
return assoc;
|
||||
}
|
||||
|
||||
qse_lsp_assoc_t* qse_lsp_setfunc (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* name, qse_lsp_obj_t* func)
|
||||
{
|
||||
qse_lsp_assoc_t* assoc;
|
||||
|
||||
assoc = qse_lsp_lookup (mem, name);
|
||||
if (assoc == QSE_NULL)
|
||||
{
|
||||
assoc = qse_lsp_insfuncintoframe (
|
||||
mem->lsp, mem->root_frame, name, func);
|
||||
if (assoc == QSE_NULL) return QSE_NULL;
|
||||
}
|
||||
else assoc->func = func;
|
||||
|
||||
return assoc;
|
||||
}
|
||||
|
||||
qse_size_t qse_lsp_conslen (qse_lsp_mem_t* mem, qse_lsp_obj_t* obj)
|
||||
{
|
||||
qse_size_t count;
|
||||
|
||||
QSE_ASSERT (
|
||||
obj == mem->nil || QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
count = 0;
|
||||
/*while (obj != mem->nil) {*/
|
||||
while (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
count++;
|
||||
obj = QSE_LSP_CDR(obj);
|
||||
}
|
||||
|
||||
return count;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,111 +0,0 @@
|
||||
/*
|
||||
* $Id: mem.h 117 2008-03-03 11:20:05Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_MEM_H_
|
||||
#define _QSE_LIB_LSP_MEM_H_
|
||||
|
||||
#ifndef _QSE_LSP_LSP_H_
|
||||
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
|
||||
#endif
|
||||
|
||||
typedef struct qse_lsp_mem_t qse_lsp_mem_t;
|
||||
|
||||
struct qse_lsp_mem_t
|
||||
{
|
||||
qse_lsp_t* lsp;
|
||||
|
||||
/* object allocation list */
|
||||
qse_size_t ubound; /* upper bounds of the maximum number of objects */
|
||||
qse_size_t ubound_inc; /* increment of the upper bounds */
|
||||
qse_size_t count; /* the number of objects currently allocated */
|
||||
qse_lsp_obj_t* used[QSE_LSP_TYPE_COUNT];
|
||||
qse_lsp_obj_t* free[QSE_LSP_TYPE_COUNT];
|
||||
|
||||
struct
|
||||
{
|
||||
qse_lsp_obj_t* obj;
|
||||
qse_lsp_obj_t* tmp; /* temporary object to protect from gc in read() */
|
||||
qse_lsp_obj_t* stack;
|
||||
} r;
|
||||
|
||||
/* commonly accessed objects */
|
||||
qse_lsp_obj_t* nil; /* qse_lsp_obj_nil_t */
|
||||
qse_lsp_obj_t* t; /* qse_lsp_obj_true_t */
|
||||
qse_lsp_obj_t* quote; /* qse_lsp_obj_sym_t */
|
||||
qse_lsp_obj_t* lambda; /* qse_lsp_obj_sym_t */
|
||||
qse_lsp_obj_t* macro; /* qse_lsp_obj_sym_t */
|
||||
qse_lsp_obj_t* num[10]; /* qse_lsp_obj_int_t */
|
||||
|
||||
/* run-time environment frame */
|
||||
qse_lsp_frame_t* frame;
|
||||
/* pointer to a global-level frame */
|
||||
qse_lsp_frame_t* root_frame;
|
||||
/* pointer to an interim frame not yet added to "frame" */
|
||||
qse_lsp_frame_t* brooding_frame;
|
||||
|
||||
/* links for temporary objects */
|
||||
qse_lsp_tlink_t* tlink;
|
||||
qse_size_t tlink_count;
|
||||
};
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
qse_lsp_mem_t* qse_lsp_openmem (
|
||||
qse_lsp_t* lsp, qse_size_t ubound, qse_size_t ubound_inc);
|
||||
void qse_lsp_closemem (qse_lsp_mem_t* mem);
|
||||
|
||||
/* object creation of standard types */
|
||||
qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem);
|
||||
qse_lsp_obj_t* qse_lsp_maketrue (qse_lsp_mem_t* mem);
|
||||
qse_lsp_obj_t* qse_lsp_makeint (qse_lsp_mem_t* mem, qse_long_t value);
|
||||
qse_lsp_obj_t* qse_lsp_makereal (qse_lsp_mem_t* mem, qse_real_t value);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makesym (
|
||||
qse_lsp_mem_t* mem, const qse_char_t* str, qse_size_t len);
|
||||
qse_lsp_obj_t* qse_lsp_makestr (
|
||||
qse_lsp_mem_t* mem, const qse_char_t* str, qse_size_t len);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makecons (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* car, qse_lsp_obj_t* cdr);
|
||||
qse_lsp_obj_t* qse_lsp_makefunc (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* formal, qse_lsp_obj_t* body);
|
||||
qse_lsp_obj_t* qse_lsp_makemacro (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* formal, qse_lsp_obj_t* body);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_makeprim (qse_lsp_mem_t* mem,
|
||||
qse_lsp_prim_t impl, qse_size_t min_args, qse_size_t max_args);
|
||||
|
||||
/* frame lookup */
|
||||
qse_lsp_assoc_t* qse_lsp_lookup (qse_lsp_mem_t* mem, qse_lsp_obj_t* name);
|
||||
qse_lsp_assoc_t* qse_lsp_setvalue (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* name, qse_lsp_obj_t* value);
|
||||
qse_lsp_assoc_t* qse_lsp_setfunc (
|
||||
qse_lsp_mem_t* mem, qse_lsp_obj_t* name, qse_lsp_obj_t* func);
|
||||
|
||||
/* cons operations */
|
||||
qse_size_t qse_lsp_conslen (qse_lsp_mem_t* mem, qse_lsp_obj_t* obj);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -1,589 +0,0 @@
|
||||
/*
|
||||
* $Id: misc.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
qse_long_t qse_lsp_strxtolong (
|
||||
qse_lsp_t* lsp, const qse_char_t* str, qse_size_t len,
|
||||
int base, const qse_char_t** endptr)
|
||||
{
|
||||
qse_long_t n = 0;
|
||||
const qse_char_t* p;
|
||||
const qse_char_t* end;
|
||||
qse_size_t rem;
|
||||
int digit, negative = 0;
|
||||
|
||||
QSE_ASSERT (base < 37);
|
||||
|
||||
p = str;
|
||||
end = str + len;
|
||||
|
||||
/* strip off leading spaces */
|
||||
/*while (QSE_LSP_ISSPACE(lsp,*p)) p++;*/
|
||||
|
||||
/* check for a sign */
|
||||
/*while (*p != QSE_T('\0')) */
|
||||
while (p < end)
|
||||
{
|
||||
if (*p == QSE_T('-'))
|
||||
{
|
||||
negative = ~negative;
|
||||
p++;
|
||||
}
|
||||
else if (*p == QSE_T('+')) p++;
|
||||
else break;
|
||||
}
|
||||
|
||||
/* check for a binary/octal/hexadecimal notation */
|
||||
rem = end - p;
|
||||
if (base == 0)
|
||||
{
|
||||
if (rem >= 1 && *p == QSE_T('0'))
|
||||
{
|
||||
p++;
|
||||
|
||||
if (rem == 1) base = 8;
|
||||
else if (*p == QSE_T('x') || *p == QSE_T('X'))
|
||||
{
|
||||
p++; base = 16;
|
||||
}
|
||||
else if (*p == QSE_T('b') || *p == QSE_T('B'))
|
||||
{
|
||||
p++; base = 2;
|
||||
}
|
||||
else base = 8;
|
||||
}
|
||||
else base = 10;
|
||||
}
|
||||
else if (rem >= 2 && base == 16)
|
||||
{
|
||||
if (*p == QSE_T('0') &&
|
||||
(*(p+1) == QSE_T('x') || *(p+1) == QSE_T('X'))) p += 2;
|
||||
}
|
||||
else if (rem >= 2 && base == 2)
|
||||
{
|
||||
if (*p == QSE_T('0') &&
|
||||
(*(p+1) == QSE_T('b') || *(p+1) == QSE_T('B'))) p += 2;
|
||||
}
|
||||
|
||||
/* process the digits */
|
||||
/*while (*p != QSE_T('\0'))*/
|
||||
while (p < end)
|
||||
{
|
||||
if (*p >= QSE_T('0') && *p <= QSE_T('9'))
|
||||
digit = *p - QSE_T('0');
|
||||
else if (*p >= QSE_T('A') && *p <= QSE_T('Z'))
|
||||
digit = *p - QSE_T('A') + 10;
|
||||
else if (*p >= QSE_T('a') && *p <= QSE_T('z'))
|
||||
digit = *p - QSE_T('a') + 10;
|
||||
else break;
|
||||
|
||||
if (digit >= base) break;
|
||||
n = n * base + digit;
|
||||
|
||||
p++;
|
||||
}
|
||||
|
||||
if (endptr != QSE_NULL) *endptr = p;
|
||||
return (negative)? -n: n;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* qse_lsp_strtoreal is almost a replica of strtod.
|
||||
*
|
||||
* strtod.c --
|
||||
*
|
||||
* Source code for the "strtod" library procedure.
|
||||
*
|
||||
* Copyright (c) 1988-1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this
|
||||
* software and its documentation for any purpose and without
|
||||
* fee is hereby granted, provided that the above copyright
|
||||
* notice appear in all copies. The University of California
|
||||
* makes no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without
|
||||
* express or implied warranty.
|
||||
*/
|
||||
|
||||
#define MAX_EXPONENT 511
|
||||
|
||||
qse_real_t qse_lsp_strtoreal (qse_lsp_t* lsp, const qse_char_t* str)
|
||||
{
|
||||
/*
|
||||
* Table giving binary powers of 10. Entry is 10^2^i.
|
||||
* Used to convert decimal exponents into floating-point numbers.
|
||||
*/
|
||||
static qse_real_t powers_of_10[] =
|
||||
{
|
||||
10., 100., 1.0e4, 1.0e8, 1.0e16,
|
||||
1.0e32, 1.0e64, 1.0e128, 1.0e256
|
||||
};
|
||||
|
||||
qse_real_t fraction, dbl_exp, * d;
|
||||
const qse_char_t* p;
|
||||
qse_cint_t c;
|
||||
int exp = 0; /* Esseonent read from "EX" field */
|
||||
|
||||
/*
|
||||
* Esseonent that derives from the fractional part. Under normal
|
||||
* circumstatnces, it is the negative of the number of digits in F.
|
||||
* However, if I is very long, the last digits of I get dropped
|
||||
* (otherwise a long I with a large negative exponent could cause an
|
||||
* unnecessary overflow on I alone). In this case, frac_exp is
|
||||
* incremented one for each dropped digit.
|
||||
*/
|
||||
|
||||
int frac_exp;
|
||||
int mant_size; /* Number of digits in mantissa. */
|
||||
int dec_pt; /* Number of mantissa digits BEFORE decimal point */
|
||||
const qse_char_t *pexp; /* Temporarily holds location of exponent in string */
|
||||
int negative = 0, exp_negative = 0;
|
||||
|
||||
p = str;
|
||||
|
||||
/* strip off leading blanks */
|
||||
/*while (QSE_LSP_ISSPACE(lsp,*p)) p++;*/
|
||||
|
||||
/* check for a sign */
|
||||
while (*p != QSE_T('\0'))
|
||||
{
|
||||
if (*p == QSE_T('-'))
|
||||
{
|
||||
negative = ~negative;
|
||||
p++;
|
||||
}
|
||||
else if (*p == QSE_T('+')) p++;
|
||||
else break;
|
||||
}
|
||||
|
||||
/* Count the number of digits in the mantissa (including the decimal
|
||||
* point), and also locate the decimal point. */
|
||||
dec_pt = -1;
|
||||
for (mant_size = 0; ; mant_size++)
|
||||
{
|
||||
c = *p;
|
||||
if (!QSE_LSP_ISDIGIT (lsp, c))
|
||||
{
|
||||
if ((c != QSE_T('.')) || (dec_pt >= 0)) break;
|
||||
dec_pt = mant_size;
|
||||
}
|
||||
p++;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now suck up the digits in the mantissa. Use two integers to
|
||||
* collect 9 digits each (this is faster than using floating-point).
|
||||
* If the mantissa has more than 18 digits, ignore the extras, since
|
||||
* they can't affect the value anyway.
|
||||
*/
|
||||
pexp = p;
|
||||
p -= mant_size;
|
||||
if (dec_pt < 0)
|
||||
{
|
||||
dec_pt = mant_size;
|
||||
}
|
||||
else
|
||||
{
|
||||
mant_size--; /* One of the digits was the point */
|
||||
}
|
||||
|
||||
if (mant_size > 18)
|
||||
{
|
||||
frac_exp = dec_pt - 18;
|
||||
mant_size = 18;
|
||||
}
|
||||
else
|
||||
{
|
||||
frac_exp = dec_pt - mant_size;
|
||||
}
|
||||
|
||||
if (mant_size == 0)
|
||||
{
|
||||
fraction = 0.0;
|
||||
/*p = str;*/
|
||||
p = pexp;
|
||||
goto done;
|
||||
}
|
||||
else
|
||||
{
|
||||
int frac1, frac2;
|
||||
frac1 = 0;
|
||||
for ( ; mant_size > 9; mant_size--)
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
if (c == QSE_T('.'))
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
}
|
||||
frac1 = 10 * frac1 + (c - QSE_T('0'));
|
||||
}
|
||||
frac2 = 0;
|
||||
for (; mant_size > 0; mant_size--) {
|
||||
c = *p;
|
||||
p++;
|
||||
if (c == QSE_T('.'))
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
}
|
||||
frac2 = 10*frac2 + (c - QSE_T('0'));
|
||||
}
|
||||
fraction = (1.0e9 * frac1) + frac2;
|
||||
}
|
||||
|
||||
/* Skim off the exponent */
|
||||
p = pexp;
|
||||
if ((*p == QSE_T('E')) || (*p == QSE_T('e')))
|
||||
{
|
||||
p++;
|
||||
if (*p == QSE_T('-'))
|
||||
{
|
||||
exp_negative = 1;
|
||||
p++;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (*p == QSE_T('+')) p++;
|
||||
exp_negative = 0;
|
||||
}
|
||||
if (!QSE_LSP_ISDIGIT (lsp, *p))
|
||||
{
|
||||
/* p = pexp; */
|
||||
/* goto done; */
|
||||
goto no_exp;
|
||||
}
|
||||
while (QSE_LSP_ISDIGIT (lsp, *p))
|
||||
{
|
||||
exp = exp * 10 + (*p - QSE_T('0'));
|
||||
p++;
|
||||
}
|
||||
}
|
||||
|
||||
no_exp:
|
||||
if (exp_negative) exp = frac_exp - exp;
|
||||
else exp = frac_exp + exp;
|
||||
|
||||
/*
|
||||
* Generate a floating-point number that represents the exponent.
|
||||
* Do this by processing the exponent one bit at a time to combine
|
||||
* many powers of 2 of 10. Then combine the exponent with the
|
||||
* fraction.
|
||||
*/
|
||||
if (exp < 0)
|
||||
{
|
||||
exp_negative = 1;
|
||||
exp = -exp;
|
||||
}
|
||||
else exp_negative = 0;
|
||||
|
||||
if (exp > MAX_EXPONENT) exp = MAX_EXPONENT;
|
||||
|
||||
dbl_exp = 1.0;
|
||||
|
||||
for (d = powers_of_10; exp != 0; exp >>= 1, d++)
|
||||
{
|
||||
if (exp & 01) dbl_exp *= *d;
|
||||
}
|
||||
|
||||
if (exp_negative) fraction /= dbl_exp;
|
||||
else fraction *= dbl_exp;
|
||||
|
||||
done:
|
||||
return (negative)? -fraction: fraction;
|
||||
}
|
||||
|
||||
qse_real_t qse_lsp_strxtoreal (
|
||||
qse_lsp_t* lsp, const qse_char_t* str, qse_size_t len,
|
||||
const qse_char_t** endptr)
|
||||
{
|
||||
/*
|
||||
* Table giving binary powers of 10. Entry is 10^2^i.
|
||||
* Used to convert decimal exponents into floating-point numbers.
|
||||
*/
|
||||
static qse_real_t powers_of_10[] =
|
||||
{
|
||||
10., 100., 1.0e4, 1.0e8, 1.0e16,
|
||||
1.0e32, 1.0e64, 1.0e128, 1.0e256
|
||||
};
|
||||
|
||||
qse_real_t fraction, dbl_exp, * d;
|
||||
const qse_char_t* p, * end;
|
||||
qse_cint_t c;
|
||||
int exp = 0; /* Esseonent read from "EX" field */
|
||||
|
||||
/*
|
||||
* Esseonent that derives from the fractional part. Under normal
|
||||
* circumstatnces, it is the negative of the number of digits in F.
|
||||
* However, if I is very long, the last digits of I get dropped
|
||||
* (otherwise a long I with a large negative exponent could cause an
|
||||
* unnecessary overflow on I alone). In this case, frac_exp is
|
||||
* incremented one for each dropped digit.
|
||||
*/
|
||||
|
||||
int frac_exp;
|
||||
int mant_size; /* Number of digits in mantissa. */
|
||||
int dec_pt; /* Number of mantissa digits BEFORE decimal point */
|
||||
const qse_char_t *pexp; /* Temporarily holds location of exponent in string */
|
||||
int negative = 0, exp_negative = 0;
|
||||
|
||||
p = str;
|
||||
end = str + len;
|
||||
|
||||
/* Strip off leading blanks and check for a sign */
|
||||
/*while (QSE_LSP_ISSPACE(lsp,*p)) p++;*/
|
||||
|
||||
/*while (*p != QSE_T('\0')) */
|
||||
while (p < end)
|
||||
{
|
||||
if (*p == QSE_T('-'))
|
||||
{
|
||||
negative = ~negative;
|
||||
p++;
|
||||
}
|
||||
else if (*p == QSE_T('+')) p++;
|
||||
else break;
|
||||
}
|
||||
|
||||
/* Count the number of digits in the mantissa (including the decimal
|
||||
* point), and also locate the decimal point. */
|
||||
dec_pt = -1;
|
||||
/*for (mant_size = 0; ; mant_size++) */
|
||||
for (mant_size = 0; p < end; mant_size++)
|
||||
{
|
||||
c = *p;
|
||||
if (!QSE_LSP_ISDIGIT (lsp, c))
|
||||
{
|
||||
if (c != QSE_T('.') || dec_pt >= 0) break;
|
||||
dec_pt = mant_size;
|
||||
}
|
||||
p++;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now suck up the digits in the mantissa. Use two integers to
|
||||
* collect 9 digits each (this is faster than using floating-point).
|
||||
* If the mantissa has more than 18 digits, ignore the extras, since
|
||||
* they can't affect the value anyway.
|
||||
*/
|
||||
pexp = p;
|
||||
p -= mant_size;
|
||||
if (dec_pt < 0)
|
||||
{
|
||||
dec_pt = mant_size;
|
||||
}
|
||||
else
|
||||
{
|
||||
mant_size--; /* One of the digits was the point */
|
||||
}
|
||||
|
||||
if (mant_size > 18) /* TODO: is 18 correct for qse_real_t??? */
|
||||
{
|
||||
frac_exp = dec_pt - 18;
|
||||
mant_size = 18;
|
||||
}
|
||||
else
|
||||
{
|
||||
frac_exp = dec_pt - mant_size;
|
||||
}
|
||||
|
||||
if (mant_size == 0)
|
||||
{
|
||||
fraction = 0.0;
|
||||
/*p = str;*/
|
||||
p = pexp;
|
||||
goto done;
|
||||
}
|
||||
else
|
||||
{
|
||||
int frac1, frac2;
|
||||
|
||||
frac1 = 0;
|
||||
for ( ; mant_size > 9; mant_size--)
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
if (c == QSE_T('.'))
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
}
|
||||
frac1 = 10 * frac1 + (c - QSE_T('0'));
|
||||
}
|
||||
|
||||
frac2 = 0;
|
||||
for (; mant_size > 0; mant_size--) {
|
||||
c = *p++;
|
||||
if (c == QSE_T('.'))
|
||||
{
|
||||
c = *p;
|
||||
p++;
|
||||
}
|
||||
frac2 = 10 * frac2 + (c - QSE_T('0'));
|
||||
}
|
||||
fraction = (1.0e9 * frac1) + frac2;
|
||||
}
|
||||
|
||||
/* Skim off the exponent */
|
||||
p = pexp;
|
||||
if (p < end && (*p == QSE_T('E') || *p == QSE_T('e')))
|
||||
{
|
||||
p++;
|
||||
|
||||
if (p < end)
|
||||
{
|
||||
if (*p == QSE_T('-'))
|
||||
{
|
||||
exp_negative = 1;
|
||||
p++;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (*p == QSE_T('+')) p++;
|
||||
exp_negative = 0;
|
||||
}
|
||||
}
|
||||
else exp_negative = 0;
|
||||
|
||||
if (!(p < end && QSE_LSP_ISDIGIT (lsp, *p)))
|
||||
{
|
||||
/*p = pexp;*/
|
||||
/*goto done;*/
|
||||
goto no_exp;
|
||||
}
|
||||
|
||||
while (p < end && QSE_LSP_ISDIGIT (lsp, *p))
|
||||
{
|
||||
exp = exp * 10 + (*p - QSE_T('0'));
|
||||
p++;
|
||||
}
|
||||
}
|
||||
|
||||
no_exp:
|
||||
if (exp_negative) exp = frac_exp - exp;
|
||||
else exp = frac_exp + exp;
|
||||
|
||||
/*
|
||||
* Generate a floating-point number that represents the exponent.
|
||||
* Do this by processing the exponent one bit at a time to combine
|
||||
* many powers of 2 of 10. Then combine the exponent with the
|
||||
* fraction.
|
||||
*/
|
||||
if (exp < 0)
|
||||
{
|
||||
exp_negative = 1;
|
||||
exp = -exp;
|
||||
}
|
||||
else exp_negative = 0;
|
||||
|
||||
if (exp > MAX_EXPONENT) exp = MAX_EXPONENT;
|
||||
|
||||
dbl_exp = 1.0;
|
||||
|
||||
for (d = powers_of_10; exp != 0; exp >>= 1, d++)
|
||||
{
|
||||
if (exp & 01) dbl_exp *= *d;
|
||||
}
|
||||
|
||||
if (exp_negative) fraction /= dbl_exp;
|
||||
else fraction *= dbl_exp;
|
||||
|
||||
done:
|
||||
if (endptr != QSE_NULL) *endptr = p;
|
||||
return (negative)? -fraction: fraction;
|
||||
}
|
||||
|
||||
qse_size_t qse_lsp_longtostr (
|
||||
qse_long_t value, int radix, const qse_char_t* prefix,
|
||||
qse_char_t* buf, qse_size_t size)
|
||||
{
|
||||
qse_long_t t, rem;
|
||||
qse_size_t len, ret, i;
|
||||
qse_size_t prefix_len;
|
||||
|
||||
prefix_len = (prefix != QSE_NULL)? qse_strlen(prefix): 0;
|
||||
|
||||
t = value;
|
||||
if (t == 0)
|
||||
{
|
||||
/* zero */
|
||||
if (buf == QSE_NULL) return prefix_len + 1;
|
||||
|
||||
if (size < prefix_len+1)
|
||||
{
|
||||
/* buffer too small */
|
||||
return (qse_size_t)-1;
|
||||
}
|
||||
|
||||
for (i = 0; i < prefix_len; i++) buf[i] = prefix[i];
|
||||
buf[prefix_len] = QSE_T('0');
|
||||
if (size > prefix_len+1) buf[prefix_len+1] = QSE_T('\0');
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* non-zero values */
|
||||
len = prefix_len;
|
||||
if (t < 0) { t = -t; len++; }
|
||||
while (t > 0) { len++; t /= radix; }
|
||||
|
||||
if (buf == QSE_NULL)
|
||||
{
|
||||
/* if buf is not given, return the number of bytes required */
|
||||
return len;
|
||||
}
|
||||
|
||||
if (size < len) return (qse_size_t)-1; /* buffer too small */
|
||||
if (size > len) buf[len] = QSE_T('\0');
|
||||
ret = len;
|
||||
|
||||
t = value;
|
||||
if (t < 0) t = -t;
|
||||
|
||||
while (t > 0)
|
||||
{
|
||||
rem = t % radix;
|
||||
if (rem >= 10)
|
||||
buf[--len] = (qse_char_t)rem + QSE_T('a') - 10;
|
||||
else
|
||||
buf[--len] = (qse_char_t)rem + QSE_T('0');
|
||||
t /= radix;
|
||||
}
|
||||
|
||||
if (value < 0)
|
||||
{
|
||||
for (i = 1; i <= prefix_len; i++)
|
||||
{
|
||||
buf[i] = prefix[i-1];
|
||||
len--;
|
||||
}
|
||||
buf[--len] = QSE_T('-');
|
||||
}
|
||||
else
|
||||
{
|
||||
for (i = 0; i < prefix_len; i++) buf[i] = prefix[i];
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
@ -1,40 +0,0 @@
|
||||
/*
|
||||
* $Id: misc.h 117 2008-03-03 11:20:05Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_MISC_H_
|
||||
#define _QSE_LIB_LSP_MISC_H_
|
||||
|
||||
#ifndef _QSE_LSP_LSP_H_
|
||||
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
void* qse_lsp_memcpy (void* dst, const void* src, qse_size_t n);
|
||||
void* qse_lsp_memset (void* dst, int val, qse_size_t n);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@ -1,173 +0,0 @@
|
||||
/*
|
||||
* $Id: obj.h 117 2008-03-03 11:20:05Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_OBJ_H_
|
||||
#define _QSE_LIB_LSP_OBJ_H_
|
||||
|
||||
#ifndef _QSE_LSP_LSP_H_
|
||||
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
|
||||
#endif
|
||||
|
||||
/* object types */
|
||||
enum
|
||||
{
|
||||
QSE_LSP_OBJ_NIL = 0,
|
||||
QSE_LSP_OBJ_TRUE,
|
||||
QSE_LSP_OBJ_INT,
|
||||
QSE_LSP_OBJ_REAL,
|
||||
QSE_LSP_OBJ_SYM,
|
||||
QSE_LSP_OBJ_STR,
|
||||
QSE_LSP_OBJ_CONS,
|
||||
QSE_LSP_OBJ_FUNC,
|
||||
QSE_LSP_OBJ_MACRO,
|
||||
QSE_LSP_OBJ_PRIM,
|
||||
|
||||
QSE_LSP_TYPE_COUNT /* the number of lsp object types */
|
||||
};
|
||||
|
||||
typedef struct qse_lsp_objhdr_t qse_lsp_objhdr_t;
|
||||
typedef struct qse_lsp_obj_nil_t qse_lsp_obj_nil_t;
|
||||
typedef struct qse_lsp_obj_true_t qse_lsp_obj_true_t;
|
||||
typedef struct qse_lsp_obj_int_t qse_lsp_obj_int_t;
|
||||
typedef struct qse_lsp_obj_real_t qse_lsp_obj_real_t;
|
||||
typedef struct qse_lsp_obj_sym_t qse_lsp_obj_sym_t;
|
||||
typedef struct qse_lsp_obj_str_t qse_lsp_obj_str_t;
|
||||
typedef struct qse_lsp_obj_cons_t qse_lsp_obj_cons_t;
|
||||
typedef struct qse_lsp_obj_func_t qse_lsp_obj_func_t;
|
||||
typedef struct qse_lsp_obj_macro_t qse_lsp_obj_macro_t;
|
||||
typedef struct qse_lsp_obj_prim_t qse_lsp_obj_prim_t;
|
||||
|
||||
struct qse_lsp_objhdr_t
|
||||
{
|
||||
qse_uint16_t type: 8;
|
||||
qse_uint16_t mark: 4;
|
||||
qse_uint16_t perm: 4;
|
||||
qse_size_t size;
|
||||
qse_lsp_obj_t* link;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_nil_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_true_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_int_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_long_t value;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_real_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_real_t value;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_sym_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
#if defined(__GNUC__)
|
||||
qse_char_t buffer[0];
|
||||
#endif
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_str_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
#if defined(__GNUC__)
|
||||
qse_char_t buffer[0];
|
||||
#endif
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_cons_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_lsp_obj_t* car;
|
||||
qse_lsp_obj_t* cdr;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_func_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_lsp_obj_t* formal;
|
||||
qse_lsp_obj_t* body;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_macro_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_lsp_obj_t* formal;
|
||||
qse_lsp_obj_t* body;
|
||||
};
|
||||
|
||||
struct qse_lsp_obj_prim_t
|
||||
{
|
||||
qse_lsp_objhdr_t hdr;
|
||||
qse_lsp_prim_t impl;
|
||||
qse_size_t min_args;
|
||||
qse_size_t max_args;
|
||||
};
|
||||
|
||||
/* header access */
|
||||
#define QSE_LSP_TYPE(x) (((qse_lsp_obj_t*)x)->hdr.type)
|
||||
#define QSE_LSP_SIZE(x) (((qse_lsp_obj_t*)x)->hdr.size)
|
||||
#define QSE_LSP_MARK(x) (((qse_lsp_obj_t*)x)->hdr.mark)
|
||||
#define QSE_LSP_PERM(x) (((qse_lsp_obj_t*)x)->hdr.perm)
|
||||
#define QSE_LSP_LINK(x) (((qse_lsp_obj_t*)x)->hdr.link)
|
||||
|
||||
/* value access */
|
||||
#define QSE_LSP_IVAL(x) (((qse_lsp_obj_int_t*)x)->value)
|
||||
#define QSE_LSP_RVAL(x) (((qse_lsp_obj_real_t*)x)->value)
|
||||
|
||||
#if defined(__GNUC__)
|
||||
#define QSE_LSP_SYMPTR(x) (((qse_lsp_obj_sym_t*)x)->buffer)
|
||||
#else
|
||||
#define QSE_LSP_SYMPTR(x) ((qse_char_t*)(((qse_lsp_obj_sym_t*)x) + 1))
|
||||
#endif
|
||||
#define QSE_LSP_SYMLEN(x) ((((qse_lsp_obj_sym_t*)x)->hdr.size - sizeof(qse_lsp_obj_t)) / sizeof(qse_char_t) - 1)
|
||||
|
||||
#if defined(__GNUC__)
|
||||
#define QSE_LSP_STRPTR(x) (((qse_lsp_obj_str_t*)x)->buffer)
|
||||
#else
|
||||
#define QSE_LSP_STRPTR(x) ((qse_char_t*)(((qse_lsp_obj_str_t*)x) + 1))
|
||||
#endif
|
||||
#define QSE_LSP_STRLEN(x) ((((qse_lsp_obj_str_t*)x)->hdr.size - sizeof(qse_lsp_obj_t)) / sizeof(qse_char_t) - 1)
|
||||
|
||||
#define QSE_LSP_CAR(x) (((qse_lsp_obj_cons_t*)x)->car)
|
||||
#define QSE_LSP_CDR(x) (((qse_lsp_obj_cons_t*)x)->cdr)
|
||||
#define QSE_LSP_FFORMAL(x) (((qse_lsp_obj_func_t*)x)->formal)
|
||||
#define QSE_LSP_FBODY(x) (((qse_lsp_obj_func_t*)x)->body)
|
||||
#define QSE_LSP_MFORMAL(x) (((qse_lsp_obj_macro_t*)x)->formal)
|
||||
#define QSE_LSP_MBODY(x) (((qse_lsp_obj_macro_t*)x)->body)
|
||||
#define QSE_LSP_PIMPL(x) (((qse_lsp_obj_prim_t*)x)->impl)
|
||||
#define QSE_LSP_PMINARGS(x) (((qse_lsp_obj_prim_t*)x)->min_args)
|
||||
#define QSE_LSP_PMAXARGS(x) (((qse_lsp_obj_prim_t*)x)->max_args)
|
||||
|
||||
#endif
|
||||
@ -1,621 +0,0 @@
|
||||
/*
|
||||
* $Id: prim.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
static int __add_prim (qse_lsp_mem_t* mem,
|
||||
const qse_char_t* name, qse_size_t len,
|
||||
qse_lsp_prim_t pimpl, qse_size_t min_args, qse_size_t max_args);
|
||||
|
||||
int qse_lsp_addprim (
|
||||
qse_lsp_t* lsp, const qse_char_t* name, qse_size_t name_len,
|
||||
qse_lsp_prim_t prim, qse_size_t min_args, qse_size_t max_args)
|
||||
{
|
||||
return __add_prim (lsp->mem, name, name_len, prim, min_args, max_args);
|
||||
}
|
||||
|
||||
int qse_lsp_removeprim (qse_lsp_t* lsp, const qse_char_t* name)
|
||||
{
|
||||
/* TODO: */
|
||||
return -1;
|
||||
}
|
||||
|
||||
static int __add_prim (qse_lsp_mem_t* mem,
|
||||
const qse_char_t* name, qse_size_t name_len,
|
||||
qse_lsp_prim_t pimpl, qse_size_t min_args, qse_size_t max_args)
|
||||
{
|
||||
qse_lsp_obj_t* n, * p;
|
||||
|
||||
n = qse_lsp_makesym (mem, name, name_len);
|
||||
if (n == QSE_NULL) return -1;
|
||||
|
||||
if (qse_lsp_pushtmp (mem->lsp, n) == QSE_NULL) return -1;
|
||||
|
||||
p = qse_lsp_makeprim (mem, pimpl, min_args, max_args);
|
||||
if (p == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (qse_lsp_pushtmp (mem->lsp, p) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (qse_lsp_setfunc(mem, n, p) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
return -1;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
qse_lsp_poptmp (mem->lsp);
|
||||
return 0;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_exit (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
lsp->errnum = QSE_LSP_EEXIT;
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_eval (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* tmp1, * tmp2;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
tmp1 = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp1 == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, tmp1) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
tmp2 = qse_lsp_eval (lsp, tmp1);
|
||||
if (tmp2 == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp);
|
||||
return tmp2;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_gc (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_gc (lsp->mem);
|
||||
return lsp->mem->nil;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_cond (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (cond
|
||||
* (condition1 result1)
|
||||
* (consition2 result2)
|
||||
* ...
|
||||
* (t resultN))
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* tmp, * ret;
|
||||
|
||||
while (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
if (QSE_LSP_TYPE(QSE_LSP_CAR(args)) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CAR(args)));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, tmp) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (tmp != lsp->mem->nil)
|
||||
{
|
||||
int f = 0;
|
||||
|
||||
tmp = QSE_LSP_CDR(QSE_LSP_CAR(args));
|
||||
ret = lsp->mem->nil;
|
||||
|
||||
while (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
ret = qse_lsp_eval (lsp, QSE_LSP_CAR(tmp));
|
||||
if (ret == QSE_NULL)
|
||||
{
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
if (qse_lsp_pushtmp (lsp, ret) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
f = 1;
|
||||
tmp = QSE_LSP_CDR(tmp);
|
||||
}
|
||||
if (tmp != lsp->mem->nil)
|
||||
{
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return ret;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
args = QSE_LSP_CDR(args);
|
||||
}
|
||||
|
||||
return lsp->mem->nil;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_if (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* tmp;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, tmp) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (tmp != lsp->mem->nil)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CDR(args)));
|
||||
if (tmp == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return tmp;
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_obj_t* res = lsp->mem->nil;
|
||||
int f = 0;
|
||||
|
||||
tmp = QSE_LSP_CDR(QSE_LSP_CDR(args));
|
||||
|
||||
while (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
res = qse_lsp_eval (lsp, QSE_LSP_CAR(tmp));
|
||||
if (res == QSE_NULL)
|
||||
{
|
||||
if (!f) qse_lsp_poptmp (lsp); /* res */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (!f) qse_lsp_poptmp (lsp); /* res */
|
||||
if (qse_lsp_pushtmp (lsp, res) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
f = 1;
|
||||
tmp = QSE_LSP_CDR(tmp);
|
||||
}
|
||||
|
||||
if (tmp != lsp->mem->nil)
|
||||
{
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (!f) qse_lsp_poptmp (lsp); /* ret */
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return res;
|
||||
}
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_while (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (setq a 1)
|
||||
* (while (< a 100) (setq a (+ a 1)))
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* tmp;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
while (1)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
if (tmp == lsp->mem->nil) break;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, tmp) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
tmp = QSE_LSP_CDR(args);
|
||||
while (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
if (qse_lsp_eval(lsp, QSE_LSP_CAR(tmp)) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
tmp = QSE_LSP_CDR(tmp);
|
||||
}
|
||||
|
||||
if (tmp != lsp->mem->nil)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp); /* tmp */
|
||||
}
|
||||
|
||||
return lsp->mem->nil;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_car (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (car '(10 20 30))
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* tmp;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
if (tmp == lsp->mem->nil) return lsp->mem->nil;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
return QSE_LSP_CAR(tmp);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_cdr (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (cdr '(10 20 30))
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* tmp;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
if (tmp == lsp->mem->nil) return lsp->mem->nil;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
return QSE_LSP_CDR(tmp);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_cons (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (cons 10 20)
|
||||
* (cons '(10 20) 30)
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* car, * cdr, * cons;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
car = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (car == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, car) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
cdr = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CDR(args)));
|
||||
if (cdr == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* car */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, cdr) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* car */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
cons = qse_lsp_makecons (lsp->mem, car, cdr);
|
||||
if (cons == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* cdr */
|
||||
qse_lsp_poptmp (lsp); /* car */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp); /* cdr */
|
||||
qse_lsp_poptmp (lsp); /* car */
|
||||
return cons;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_length (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t len = 0;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_NIL)
|
||||
{
|
||||
len = 0;
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_STR)
|
||||
{
|
||||
len = QSE_LSP_STRLEN(tmp);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
len = QSE_LSP_SYMLEN(tmp);
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
len = 0;
|
||||
do
|
||||
{
|
||||
len++;
|
||||
tmp = QSE_LSP_CDR(tmp);
|
||||
}
|
||||
while (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
/* TODO: more flexible without the check below?
|
||||
* both of the following expression evalute
|
||||
* to 3 without it.
|
||||
* (length '(9 9 9 . 9))
|
||||
* (length '(9 9 9))
|
||||
*/
|
||||
if (QSE_LSP_TYPE(tmp) != QSE_LSP_OBJ_NIL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
return qse_lsp_makeint (lsp->mem, len);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_set (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (set 'flowers 'rose)
|
||||
* (set flowers 20)
|
||||
* rose
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* p1, * p2;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
p1 = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (p1 == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, p1) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(p1) != QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* p1 */
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
p2 = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CDR(args)));
|
||||
if (p2 == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* p1 */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, p2) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* p1 */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (qse_lsp_setvalue (lsp->mem, p1, p2) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp); /* p2 */
|
||||
qse_lsp_poptmp (lsp); /* p1 */
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp); /* p2 */
|
||||
qse_lsp_poptmp (lsp); /* p1 */
|
||||
return p2;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_setq (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (setq x 10)
|
||||
* (setq x "string")
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* p = args, * p1, * p2 = lsp->mem->nil;
|
||||
|
||||
while (p != lsp->mem->nil)
|
||||
{
|
||||
QSE_ASSERT (QSE_LSP_TYPE(p) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
p1 = QSE_LSP_CAR(p);
|
||||
if (QSE_LSP_TYPE(p1) != QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (QSE_LSP_TYPE(QSE_LSP_CDR(p)) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
lsp->errnum = QSE_LSP_EARGFEW;
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
p2 = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CDR(p)));
|
||||
if (p2 == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, p2) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_setvalue (lsp->mem, p1, p2) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp);
|
||||
p = QSE_LSP_CDR(QSE_LSP_CDR(p));
|
||||
}
|
||||
|
||||
return p2;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_quote (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (quote (10 20 30 50))
|
||||
*/
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
return QSE_LSP_CAR(args);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_defun (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (defun x (a b) (+ a b 100))
|
||||
* (x 40 50)
|
||||
*
|
||||
* (setq x (lambda (x y) (setq temp 10) (+ x y temp)))
|
||||
* (x 40 50)
|
||||
* temp
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* name, * fun;
|
||||
|
||||
name = QSE_LSP_CAR(args);
|
||||
if (QSE_LSP_TYPE(name) != QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
fun = qse_lsp_makefunc (lsp->mem,
|
||||
QSE_LSP_CAR(QSE_LSP_CDR(args)), QSE_LSP_CDR(QSE_LSP_CDR(args)));
|
||||
if (fun == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, fun) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_setfunc (lsp->mem, QSE_LSP_CAR(args), fun) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp);
|
||||
return fun;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_demac (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (demac x (abc) x y z)
|
||||
* (setq x (macro (abc) x y z))
|
||||
*/
|
||||
|
||||
qse_lsp_obj_t* name, * mac;
|
||||
|
||||
name = QSE_LSP_CAR(args);
|
||||
if (QSE_LSP_TYPE(name) != QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
mac = qse_lsp_makemacro (lsp->mem,
|
||||
QSE_LSP_CAR(QSE_LSP_CDR(args)), QSE_LSP_CDR(QSE_LSP_CDR(args)));
|
||||
if (mac == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_pushtmp (lsp, mac) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (qse_lsp_setfunc (lsp->mem, QSE_LSP_CAR(args), mac) == QSE_NULL)
|
||||
{
|
||||
qse_lsp_poptmp (lsp);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_poptmp (lsp);
|
||||
return mac;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_or (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (or 10 20 30 40)
|
||||
* (or (= n 20) (= n 30))
|
||||
*/
|
||||
qse_lsp_obj_t* tmp;
|
||||
|
||||
/* TODO: this is wrong. redo the work */
|
||||
while (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_INT)
|
||||
if (tmp != lsp->mem->nil) return lsp->mem->t;
|
||||
args = QSE_LSP_CDR(args);
|
||||
}
|
||||
|
||||
return lsp->mem->nil;
|
||||
}
|
||||
|
||||
@ -1,83 +0,0 @@
|
||||
/*
|
||||
* $Id: prim.h 117 2008-03-03 11:20:05Z baconevi $
|
||||
*
|
||||
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/>.
|
||||
*/
|
||||
|
||||
#ifndef _QSE_LIB_LSP_PRIM_H_
|
||||
#define _QSE_LIB_LSP_PRIM_H_
|
||||
|
||||
#ifndef _QSE_LSP_LSP_H_
|
||||
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_exit (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_eval (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_prog1 (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_progn (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_gc (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_cond (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_if (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_while (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_car (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_cdr (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_cons (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_length (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_set (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_setq (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_quote (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_defun (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_demac (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_let (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_letx (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_or (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
/*---------------------
|
||||
prim_compar.c
|
||||
---------------------*/
|
||||
qse_lsp_obj_t* qse_lsp_prim_eq (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_ne (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_gt (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_lt (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_ge (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_le (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
/*---------------------
|
||||
prim_math.c
|
||||
---------------------*/
|
||||
qse_lsp_obj_t* qse_lsp_prim_plus (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_minus (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_mul (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_div (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
qse_lsp_obj_t* qse_lsp_prim_mod (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
/*---------------------
|
||||
prim_fact.c
|
||||
---------------------*/
|
||||
qse_lsp_obj_t* qse_lsp_prim_fact (qse_lsp_t* lsp, qse_lsp_obj_t* args);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -1,141 +0,0 @@
|
||||
/*
|
||||
* $Id: prim_compar.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
#define PRIM_COMPAR(lsp,args,op) \
|
||||
{ \
|
||||
qse_lsp_obj_t* p1, * p2; \
|
||||
int res; \
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS); \
|
||||
\
|
||||
p1 = qse_lsp_eval (lsp, QSE_LSP_CAR(args)); \
|
||||
if (p1 == QSE_NULL) return QSE_NULL; \
|
||||
if (qse_lsp_pushtmp (lsp, p1) == QSE_NULL) return QSE_NULL; \
|
||||
\
|
||||
p2 = qse_lsp_eval (lsp, QSE_LSP_CAR(QSE_LSP_CDR(args))); \
|
||||
if (p2 == QSE_NULL) \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
\
|
||||
if (qse_lsp_pushtmp (lsp, p2) == QSE_NULL) \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
\
|
||||
if (QSE_LSP_TYPE(p1) == QSE_LSP_OBJ_INT) \
|
||||
{ \
|
||||
if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_INT) \
|
||||
{ \
|
||||
res = QSE_LSP_IVAL(p1) op QSE_LSP_IVAL(p2); \
|
||||
} \
|
||||
else if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_REAL) \
|
||||
{ \
|
||||
res = QSE_LSP_IVAL(p1) op QSE_LSP_RVAL(p2); \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
} \
|
||||
else if (QSE_LSP_TYPE(p1) == QSE_LSP_OBJ_REAL) \
|
||||
{ \
|
||||
if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_INT) \
|
||||
{ \
|
||||
res = QSE_LSP_RVAL(p1) op QSE_LSP_IVAL(p2); \
|
||||
} \
|
||||
else if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_REAL) \
|
||||
{ \
|
||||
res = QSE_LSP_RVAL(p1) op QSE_LSP_RVAL(p2); \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
} \
|
||||
else if (QSE_LSP_TYPE(p1) == QSE_LSP_OBJ_SYM) \
|
||||
{ \
|
||||
if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_SYM) \
|
||||
{ \
|
||||
res = qse_strxncmp ( \
|
||||
QSE_LSP_SYMPTR(p1), QSE_LSP_SYMLEN(p1), \
|
||||
QSE_LSP_SYMPTR(p2), QSE_LSP_SYMLEN(p2)) op 0; \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
} \
|
||||
else if (QSE_LSP_TYPE(p1) == QSE_LSP_OBJ_STR) \
|
||||
{ \
|
||||
if (QSE_LSP_TYPE(p2) == QSE_LSP_OBJ_STR) \
|
||||
{ \
|
||||
res = qse_strxncmp ( \
|
||||
QSE_LSP_STRPTR(p1), QSE_LSP_STRLEN(p1), \
|
||||
QSE_LSP_STRPTR(p2), QSE_LSP_STRLEN(p2)) op 0; \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
} \
|
||||
else \
|
||||
{ \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0); \
|
||||
return QSE_NULL; \
|
||||
} \
|
||||
\
|
||||
qse_lsp_poptmp (lsp); \
|
||||
qse_lsp_poptmp (lsp); \
|
||||
return (res)? lsp->mem->t: lsp->mem->nil; \
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_eq (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, ==);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_ne (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, !=);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_gt (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, >);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_lt (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, <);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_ge (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, >=);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_le (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
PRIM_COMPAR (lsp, args, <=);
|
||||
}
|
||||
@ -1,186 +0,0 @@
|
||||
/*
|
||||
* $Id: prim_let.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
/*
|
||||
* (let ((variable value)
|
||||
* (variable value)
|
||||
* ...)
|
||||
* body...)
|
||||
*/
|
||||
|
||||
static qse_lsp_obj_t* __prim_let (
|
||||
qse_lsp_t* lsp, qse_lsp_obj_t* args, int sequential)
|
||||
{
|
||||
qse_lsp_frame_t* frame;
|
||||
qse_lsp_obj_t* assoc;
|
||||
qse_lsp_obj_t* body;
|
||||
qse_lsp_obj_t* value;
|
||||
|
||||
/* create a new frameq */
|
||||
frame = qse_lsp_newframe (lsp);
|
||||
if (frame == QSE_NULL) return QSE_NULL;
|
||||
/*frame->link = lsp->mem->frame;*/
|
||||
|
||||
if (sequential)
|
||||
{
|
||||
frame->link = lsp->mem->frame;
|
||||
lsp->mem->frame = frame;
|
||||
}
|
||||
else
|
||||
{
|
||||
frame->link = lsp->mem->brooding_frame;
|
||||
lsp->mem->brooding_frame = frame;
|
||||
}
|
||||
|
||||
assoc = QSE_LSP_CAR(args);
|
||||
|
||||
/*while (assoc != lsp->mem->nil) {*/
|
||||
while (QSE_LSP_TYPE(assoc) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_obj_t* ass = QSE_LSP_CAR(assoc);
|
||||
if (QSE_LSP_TYPE(ass) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
qse_lsp_obj_t* n = QSE_LSP_CAR(ass);
|
||||
qse_lsp_obj_t* v = QSE_LSP_CDR(ass);
|
||||
|
||||
if (QSE_LSP_TYPE(n) != QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
if (v != lsp->mem->nil)
|
||||
{
|
||||
if (QSE_LSP_CDR(v) != lsp->mem->nil)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
if ((v = qse_lsp_eval(lsp, QSE_LSP_CAR(v))) == QSE_NULL)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if (qse_lsp_lookupinframe (lsp, frame, n) != QSE_NULL)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
if (qse_lsp_insvalueintoframe (lsp, frame, n, v) == QSE_NULL)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(ass) == QSE_LSP_OBJ_SYM)
|
||||
{
|
||||
if (qse_lsp_lookupinframe (lsp, frame, ass) != QSE_NULL)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
if (qse_lsp_insvalueintoframe (lsp, frame, ass, lsp->mem->nil) == QSE_NULL)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
assoc = QSE_LSP_CDR(assoc);
|
||||
}
|
||||
|
||||
if (assoc != lsp->mem->nil)
|
||||
{
|
||||
if (sequential) lsp->mem->frame = frame->link;
|
||||
else lsp->mem->brooding_frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
/* push the frame */
|
||||
if (!sequential)
|
||||
{
|
||||
lsp->mem->brooding_frame = frame->link;
|
||||
frame->link = lsp->mem->frame;
|
||||
lsp->mem->frame = frame;
|
||||
}
|
||||
|
||||
/* evaluate forms in the body */
|
||||
value = lsp->mem->nil;
|
||||
body = QSE_LSP_CDR(args);
|
||||
while (body != lsp->mem->nil)
|
||||
{
|
||||
value = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (value == QSE_NULL)
|
||||
{
|
||||
lsp->mem->frame = frame->link;
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return QSE_NULL;
|
||||
}
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
/* pop the frame */
|
||||
lsp->mem->frame = frame->link;
|
||||
|
||||
/* destroy the frame */
|
||||
qse_lsp_freeframe (lsp, frame);
|
||||
return value;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_let (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/*
|
||||
* (defun x (x y)
|
||||
* (let ((temp1 10) (temp2 20))
|
||||
* (+ x y temp1 temp2)))
|
||||
* (x 40 50)
|
||||
* temp1
|
||||
*/
|
||||
return __prim_let (lsp, args, 0);
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_letx (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
return __prim_let (lsp, args, 1);
|
||||
}
|
||||
@ -1,351 +0,0 @@
|
||||
/*
|
||||
* $Id: prim_math.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_plus (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t ival = 0;
|
||||
qse_real_t rval = .0;
|
||||
qse_bool_t realnum = QSE_FALSE;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_INT)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
ival = QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
ival = ival + QSE_LSP_IVAL(tmp);
|
||||
else
|
||||
rval = rval + QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_REAL)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
realnum = QSE_TRUE;
|
||||
rval = QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
{
|
||||
realnum = QSE_TRUE;
|
||||
rval = (qse_real_t)ival;
|
||||
}
|
||||
rval = rval + QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
|
||||
tmp = (realnum)?
|
||||
qse_lsp_makereal (lsp->mem, rval):
|
||||
qse_lsp_makeint (lsp->mem, ival);
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return tmp;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_minus (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t ival = 0;
|
||||
qse_real_t rval = .0;
|
||||
qse_bool_t realnum = QSE_FALSE;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_INT)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
ival = QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
ival = ival - QSE_LSP_IVAL(tmp);
|
||||
else
|
||||
rval = rval - QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_REAL)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
realnum = QSE_TRUE;
|
||||
rval = QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
{
|
||||
realnum = QSE_TRUE;
|
||||
rval = (qse_real_t)ival;
|
||||
}
|
||||
rval = rval - QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
|
||||
tmp = (realnum)?
|
||||
qse_lsp_makereal (lsp->mem, rval):
|
||||
qse_lsp_makeint (lsp->mem, ival);
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return tmp;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_mul (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t ival = 0;
|
||||
qse_real_t rval = .0;
|
||||
qse_bool_t realnum = QSE_FALSE;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_INT)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
ival = QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
ival = ival * QSE_LSP_IVAL(tmp);
|
||||
else
|
||||
rval = rval * QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_REAL)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
realnum = QSE_TRUE;
|
||||
rval = QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
{
|
||||
realnum = QSE_TRUE;
|
||||
rval = (qse_real_t)ival;
|
||||
}
|
||||
rval = rval * QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
|
||||
tmp = (realnum)?
|
||||
qse_lsp_makereal (lsp->mem, rval):
|
||||
qse_lsp_makeint (lsp->mem, ival);
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return tmp;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_div (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t ival = 0;
|
||||
qse_real_t rval = .0;
|
||||
qse_bool_t realnum = QSE_FALSE;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_INT)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
ival = QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
{
|
||||
if (QSE_LSP_IVAL(tmp) == 0)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDIVBY0, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
ival = ival / QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
rval = rval / QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_REAL)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
QSE_ASSERT (realnum == QSE_FALSE);
|
||||
realnum = QSE_TRUE;
|
||||
rval = QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (!realnum)
|
||||
{
|
||||
realnum = QSE_TRUE;
|
||||
rval = (qse_real_t)ival;
|
||||
}
|
||||
rval = rval / QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
|
||||
tmp = (realnum)?
|
||||
qse_lsp_makereal (lsp->mem, rval):
|
||||
qse_lsp_makeint (lsp->mem, ival);
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return tmp;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_mod (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
qse_lsp_obj_t* body, * tmp;
|
||||
qse_long_t ival = 0;
|
||||
|
||||
QSE_ASSERT (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS);
|
||||
|
||||
body = args;
|
||||
while (QSE_LSP_TYPE(body) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(body));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_INT)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
ival = QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
if (QSE_LSP_IVAL(tmp) == 0)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDIVBY0, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
ival = ival % QSE_LSP_IVAL(tmp);
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_TYPE(tmp) == QSE_LSP_OBJ_REAL)
|
||||
{
|
||||
if (body == args)
|
||||
{
|
||||
ival = (qse_long_t)QSE_LSP_RVAL(tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_long_t tmpi = (qse_long_t)QSE_LSP_RVAL(tmp);
|
||||
if (tmpi == 0)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EDIVBY0, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
ival = ival % tmpi;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EVALBAD, QSE_NULL, 0);
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
|
||||
body = QSE_LSP_CDR(body);
|
||||
}
|
||||
|
||||
QSE_ASSERT (body == lsp->mem->nil);
|
||||
|
||||
tmp = qse_lsp_makeint (lsp->mem, ival);
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
return tmp;
|
||||
}
|
||||
@ -1,53 +0,0 @@
|
||||
/*
|
||||
* $Id: prim_prog.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_prog1 (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/* (prog1 1 2 3) returns 1 */
|
||||
qse_lsp_obj_t* res = QSE_NULL, * tmp;
|
||||
|
||||
/*while (args != lsp->mem->nil) {*/
|
||||
while (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (res == QSE_NULL)
|
||||
{
|
||||
res = tmp;
|
||||
if (qse_lsp_pushtmp (lsp, res) == QSE_NULL)
|
||||
{
|
||||
return QSE_NULL;
|
||||
}
|
||||
}
|
||||
args = QSE_LSP_CDR(args);
|
||||
}
|
||||
|
||||
if (res != QSE_NULL) qse_lsp_poptmp (lsp);
|
||||
return res;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_prim_progn (qse_lsp_t* lsp, qse_lsp_obj_t* args)
|
||||
{
|
||||
/* (progn 1 2 3) returns 3 */
|
||||
|
||||
qse_lsp_obj_t* res, * tmp;
|
||||
|
||||
res = lsp->mem->nil;
|
||||
/*while (args != lsp->mem->nil) {*/
|
||||
while (QSE_LSP_TYPE(args) == QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
tmp = qse_lsp_eval (lsp, QSE_LSP_CAR(args));
|
||||
if (tmp == QSE_NULL) return QSE_NULL;
|
||||
|
||||
res = tmp;
|
||||
args = QSE_LSP_CDR(args);
|
||||
}
|
||||
|
||||
return res;
|
||||
}
|
||||
@ -1,156 +0,0 @@
|
||||
/*
|
||||
* $Id: print.c 467 2008-12-09 09:55:51Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
*/
|
||||
|
||||
#include "lsp.h"
|
||||
|
||||
#define OUTPUT_STR(lsp,str) \
|
||||
do { \
|
||||
if (lsp->io.fns.out(lsp, QSE_LSP_IO_WRITE, &lsp->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) { \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EOUTPUT, QSE_NULL, 0); \
|
||||
return -1; \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define OUTPUT_STRX(lsp,str,len) \
|
||||
do { \
|
||||
if (lsp->io.fns.out(lsp, QSE_LSP_IO_WRITE, &lsp->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) { \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EOUTPUT, QSE_NULL, 0); \
|
||||
return -1; \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
static int __print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj, qse_bool_t prt_cons_par)
|
||||
{
|
||||
qse_char_t buf[256];
|
||||
|
||||
if (lsp->io.fns.out == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOOUTP, QSE_NULL, 0);
|
||||
return -1;
|
||||
}
|
||||
|
||||
switch (QSE_LSP_TYPE(obj))
|
||||
{
|
||||
case QSE_LSP_OBJ_NIL:
|
||||
OUTPUT_STR (lsp, QSE_T("nil"));
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_TRUE:
|
||||
OUTPUT_STR (lsp, QSE_T("t"));
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_INT:
|
||||
#if QSE_SIZEOF_LONG_LONG > 0
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("%lld"), (long long)QSE_LSP_IVAL(obj));
|
||||
#elif QSE_SIZEOF___INT64 > 0
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("%I64d"), (__int64)QSE_LSP_IVAL(obj));
|
||||
#elif QSE_SIZEOF_LONG > 0
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("%ld"), (long)QSE_LSP_IVAL(obj));
|
||||
#elif QSE_SIZEOF_INT > 0
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("%d"), (int)QSE_LSP_IVAL(obj));
|
||||
#else
|
||||
#error unsupported size
|
||||
#endif
|
||||
OUTPUT_STR (lsp, buf);
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_REAL:
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("%Lf"),
|
||||
#ifdef __MINGW32__
|
||||
(double)QSE_LSP_RVAL(obj)
|
||||
#else
|
||||
(long double)QSE_LSP_RVAL(obj)
|
||||
#endif
|
||||
);
|
||||
|
||||
OUTPUT_STR (lsp, buf);
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_SYM:
|
||||
OUTPUT_STRX (lsp, QSE_LSP_SYMPTR(obj), QSE_LSP_SYMLEN(obj));
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_STR:
|
||||
OUTPUT_STR (lsp, QSE_T("\""));
|
||||
/* TODO: deescaping */
|
||||
OUTPUT_STRX (lsp, QSE_LSP_STRPTR(obj), QSE_LSP_STRLEN(obj));
|
||||
OUTPUT_STR (lsp, QSE_T("\""));
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_CONS:
|
||||
{
|
||||
const qse_lsp_obj_t* p = obj;
|
||||
if (prt_cons_par) OUTPUT_STR (lsp, QSE_T("("));
|
||||
do
|
||||
{
|
||||
qse_lsp_print (lsp, QSE_LSP_CAR(p));
|
||||
p = QSE_LSP_CDR(p);
|
||||
if (p != lsp->mem->nil)
|
||||
{
|
||||
OUTPUT_STR (lsp, QSE_T(" "));
|
||||
if (QSE_LSP_TYPE(p) != QSE_LSP_OBJ_CONS)
|
||||
{
|
||||
OUTPUT_STR (lsp, QSE_T(". "));
|
||||
qse_lsp_print (lsp, p);
|
||||
}
|
||||
}
|
||||
}
|
||||
while (p != lsp->mem->nil && QSE_LSP_TYPE(p) == QSE_LSP_OBJ_CONS);
|
||||
if (prt_cons_par) OUTPUT_STR (lsp, QSE_T(")"));
|
||||
|
||||
break;
|
||||
}
|
||||
|
||||
case QSE_LSP_OBJ_FUNC:
|
||||
/*OUTPUT_STR (lsp, QSE_T("func"));*/
|
||||
OUTPUT_STR (lsp, QSE_T("(lambda "));
|
||||
if (__print (lsp, QSE_LSP_FFORMAL(obj), QSE_TRUE) == -1) return -1;
|
||||
OUTPUT_STR (lsp, QSE_T(" "));
|
||||
if (__print (lsp, QSE_LSP_FBODY(obj), QSE_FALSE) == -1) return -1;
|
||||
OUTPUT_STR (lsp, QSE_T(")"));
|
||||
break;
|
||||
|
||||
case QSE_LSP_OBJ_MACRO:
|
||||
OUTPUT_STR (lsp, QSE_T("(macro "));
|
||||
if (__print (lsp, QSE_LSP_FFORMAL(obj), QSE_TRUE) == -1) return -1;
|
||||
OUTPUT_STR (lsp, QSE_T(" "));
|
||||
if (__print (lsp, QSE_LSP_FBODY(obj), QSE_FALSE) == -1) return -1;
|
||||
OUTPUT_STR (lsp, QSE_T(")"));
|
||||
break;
|
||||
case QSE_LSP_OBJ_PRIM:
|
||||
OUTPUT_STR (lsp, QSE_T("prim"));
|
||||
break;
|
||||
|
||||
default:
|
||||
lsp->prm.sprintf (
|
||||
lsp->prm.udd,
|
||||
buf, QSE_COUNTOF(buf),
|
||||
QSE_T("unknown object type: %d"), QSE_LSP_TYPE(obj));
|
||||
OUTPUT_STR (lsp, buf);
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int qse_lsp_print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj)
|
||||
{
|
||||
return __print (lsp, obj, QSE_TRUE);
|
||||
}
|
||||
@ -1,781 +0,0 @@
|
||||
/*
|
||||
* $Id: read.c 337 2008-08-20 09:17:25Z baconevi $
|
||||
*
|
||||
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 "lsp.h"
|
||||
|
||||
enum list_flag_t
|
||||
{
|
||||
QUOTED = (1 << 0),
|
||||
DOTTED = (1 << 1),
|
||||
CLOSED = (1 << 2)
|
||||
};
|
||||
|
||||
enum token_type_t
|
||||
{
|
||||
TOKEN_END = 0,
|
||||
TOKEN_INT = 1,
|
||||
TOKEN_REAL = 2,
|
||||
TOKEN_STRING = 3,
|
||||
TOKEN_LPAREN = 4,
|
||||
TOKEN_RPAREN = 5,
|
||||
TOKEN_IDENT = 6,
|
||||
TOKEN_QUOTE = 7,
|
||||
TOKEN_DOT = 8,
|
||||
TOKEN_INVALID = 50
|
||||
};
|
||||
|
||||
#define IS_SPECIAL_CHAR(c) \
|
||||
((c) == QSE_T('(') || (c) == QSE_T(')') || \
|
||||
(c) == QSE_T('.') || (c) == QSE_T('\'') || (c) == QSE_T('\"'))
|
||||
|
||||
#define IS_IDENT_CHAR(lsp,c) \
|
||||
(c != QSE_T('\0') && !IS_SPECIAL_CHAR(c) && !QSE_LSP_ISSPACE(lsp, c))
|
||||
|
||||
#define TOKEN_CLEAR(lsp) qse_str_clear (&(lsp)->token.name)
|
||||
#define TOKEN_TYPE(lsp) (lsp)->token.type
|
||||
#define TOKEN_IVAL(lsp) (lsp)->token.ival
|
||||
#define TOKEN_RVAL(lsp) (lsp)->token.rval
|
||||
#define TOKEN_STR(lsp) (lsp)->token.name
|
||||
#define TOKEN_SPTR(lsp) (lsp)->token.name.ptr
|
||||
#define TOKEN_SLEN(lsp) (lsp)->token.name.len
|
||||
#define TOKEN_LOC(lsp) (lsp)->token.loc
|
||||
|
||||
#define TOKEN_ADD_CHAR(lsp,ch) \
|
||||
do { \
|
||||
if (qse_str_ccat(&(lsp)->token.name, ch) == -1) { \
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, &lsp->curloc); \
|
||||
return -1; \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define NEXT_CHAR(lsp) \
|
||||
do { if (read_char(lsp) == -1) return -1;} while (0)
|
||||
|
||||
#define NEXT_CHAR_TO(lsp,c) \
|
||||
do { \
|
||||
if (read_char(lsp) == -1) return -1;\
|
||||
c = (lsp)->curc; \
|
||||
} while (0)
|
||||
|
||||
#define NEXT_TOKEN(lsp) \
|
||||
do { if (read_token(lsp) == -1) return QSE_NULL; } while (0)
|
||||
|
||||
static qse_lsp_obj_t* read_obj (qse_lsp_t* lsp);
|
||||
|
||||
static int read_char (qse_lsp_t* lsp);
|
||||
static int read_token (qse_lsp_t* lsp);
|
||||
static int read_number (qse_lsp_t* lsp, int negative);
|
||||
static int read_ident (qse_lsp_t* lsp);
|
||||
static int read_string (qse_lsp_t* lsp);
|
||||
|
||||
static QSE_INLINE_ALWAYS void protect (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
/* remember an object for temporary GC protection */
|
||||
QSE_ASSERT (lsp->mem->r.tmp == QSE_NULL);
|
||||
lsp->mem->r.tmp = obj;
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS void unprotect (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
/* release an object from temporary GC protection */
|
||||
QSE_ASSERT (lsp->mem->r.tmp == obj);
|
||||
lsp->mem->r.tmp = QSE_NULL;
|
||||
}
|
||||
|
||||
qse_lsp_obj_t* qse_lsp_read (qse_lsp_t* lsp)
|
||||
{
|
||||
if (lsp->curc == QSE_CHAR_EOF &&
|
||||
read_char(lsp) <= -1) return QSE_NULL;
|
||||
NEXT_TOKEN (lsp);
|
||||
|
||||
lsp->mem->r.obj = read_obj (lsp);
|
||||
|
||||
/* clear the stack.
|
||||
* TODO: better to clear stack elements instead of counting on GC?
|
||||
*/
|
||||
lsp->mem->r.stack = lsp->mem->nil;
|
||||
|
||||
return lsp->mem->r.obj;
|
||||
}
|
||||
|
||||
static QSE_INLINE qse_lsp_obj_t* makesym (qse_lsp_t* lsp, const qse_str_t* name)
|
||||
{
|
||||
QSE_ASSERT (lsp->mem->nil != QSE_NULL && lsp->mem->t != QSE_NULL);
|
||||
|
||||
if (qse_strxcmp (name->ptr, name->len, QSE_T("t")) == 0)
|
||||
return lsp->mem->t;
|
||||
if (qse_strxcmp (name->ptr, name->len, QSE_T("nil")) == 0)
|
||||
return lsp->mem->nil;
|
||||
|
||||
return qse_lsp_makesym (lsp->mem, name->ptr, name->len);
|
||||
}
|
||||
|
||||
static QSE_INLINE qse_lsp_obj_t* push (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
qse_lsp_obj_t* cell;
|
||||
|
||||
protect (lsp, obj); /* temporary protection */
|
||||
cell = qse_lsp_makecons (lsp->mem, obj, lsp->mem->r.stack);
|
||||
unprotect (lsp, obj); /* ok to unprotected as it is already chained to the stack... */
|
||||
if (cell == QSE_NULL) return QSE_NULL;
|
||||
|
||||
lsp->mem->r.stack = cell;
|
||||
return cell; /* return the containing cell */
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS void pop (qse_lsp_t* lsp)
|
||||
{
|
||||
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
|
||||
lsp->mem->r.stack = QSE_LSP_CDR(lsp->mem->r.stack);
|
||||
}
|
||||
|
||||
static QSE_INLINE qse_lsp_obj_t* enter_list (qse_lsp_t* lsp, int flagv)
|
||||
{
|
||||
/* upon entering a list, it pushes three cells into a stack.
|
||||
*
|
||||
* r.stack -------+
|
||||
* V
|
||||
* +---cons--+
|
||||
* +------ | -------+
|
||||
* car| +---------+ |cdr
|
||||
* V |
|
||||
* nil#1 V
|
||||
* +---cons--+
|
||||
* +------ | --------+
|
||||
* car| +---------+ |cdr
|
||||
* v |
|
||||
* nil#2 V
|
||||
* +---cons--+
|
||||
* +------ | --------+
|
||||
* car| +---------+ |cdr
|
||||
* V |
|
||||
* flag number V
|
||||
* previous stack top
|
||||
*
|
||||
* nil#1 to store the first element in the list.
|
||||
* nil#2 to store the last element in the list.
|
||||
* both to be updated in chain_to_list() as items are added.
|
||||
*/
|
||||
return (push (lsp, lsp->mem->num[flagv]) == QSE_NULL ||
|
||||
push (lsp, lsp->mem->nil) == QSE_NULL ||
|
||||
push (lsp, lsp->mem->nil) == QSE_NULL)? QSE_NULL: lsp->mem->r.stack;
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS qse_lsp_obj_t* leave_list (qse_lsp_t* lsp, int* flagv)
|
||||
{
|
||||
qse_lsp_obj_t* head;
|
||||
|
||||
/* the stack must not be empty */
|
||||
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
|
||||
|
||||
/* remember the current list head */
|
||||
head = QSE_LSP_CAR(QSE_LSP_CDR(lsp->mem->r.stack));
|
||||
|
||||
/* upon leaving a list, it pops the three cells off the stack */
|
||||
pop (lsp);
|
||||
pop (lsp);
|
||||
pop (lsp);
|
||||
|
||||
if (lsp->mem->r.stack == lsp->mem->nil)
|
||||
{
|
||||
/* the stack is empty after popping.
|
||||
* it is back to the top level.
|
||||
* the top level can never be quoted. */
|
||||
*flagv = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* restore the flag for the outer returning level */
|
||||
qse_lsp_obj_t* flag = QSE_LSP_CDR(QSE_LSP_CDR(lsp->mem->r.stack));
|
||||
QSE_ASSERT (QSE_LSP_TYPE(QSE_LSP_CAR(flag)) == QSE_LSP_OBJ_INT);
|
||||
*flagv = QSE_LSP_IVAL(QSE_LSP_CAR(flag));
|
||||
}
|
||||
|
||||
/* return the head of the list being left */
|
||||
return head;
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS void dot_list (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_lsp_obj_t* cell;
|
||||
|
||||
/* mark the state that a dot has appeared in the list */
|
||||
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
|
||||
cell = QSE_LSP_CDR(QSE_LSP_CDR(lsp->mem->r.stack));
|
||||
QSE_LSP_CAR(cell) = lsp->mem->num[QSE_LSP_IVAL(QSE_LSP_CAR(cell)) | DOTTED];
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* chain_to_list (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
|
||||
{
|
||||
qse_lsp_obj_t* cell, * head, * tail, *flag;
|
||||
int flagv;
|
||||
|
||||
/* the stack top is the cons cell pointing to the list tail */
|
||||
tail = lsp->mem->r.stack;
|
||||
QSE_ASSERT (tail != lsp->mem->nil);
|
||||
|
||||
/* the cons cell pointing to the list head is below the tail cell
|
||||
* connected via cdr. */
|
||||
head = QSE_LSP_CDR(tail);
|
||||
QSE_ASSERT (head != lsp->mem->nil);
|
||||
|
||||
/* the cons cell pointing to the flag is below the head cell
|
||||
* connected via cdr */
|
||||
flag = QSE_LSP_CDR(head);
|
||||
|
||||
/* retrieve the numeric flag value */
|
||||
QSE_ASSERT(QSE_LSP_TYPE(QSE_LSP_CAR(flag)) == QSE_LSP_OBJ_INT);
|
||||
flagv = (int)QSE_LSP_IVAL(QSE_LSP_CAR(flag));
|
||||
|
||||
if (flagv & CLOSED)
|
||||
{
|
||||
/* the list has already been closed. cannot add more items. */
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ERPAREN, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
}
|
||||
else if (flagv & DOTTED)
|
||||
{
|
||||
/* the list must not be empty to have reached the dotted state */
|
||||
QSE_ASSERT (QSE_LSP_CAR(tail) != lsp->mem->nil);
|
||||
|
||||
/* chain the object via 'cdr' of the tail cell */
|
||||
QSE_LSP_CDR(QSE_LSP_CAR(tail)) = obj;
|
||||
|
||||
/* update the flag to CLOSED */
|
||||
QSE_LSP_CAR(flag) = lsp->mem->num[flagv | CLOSED];
|
||||
}
|
||||
else
|
||||
{
|
||||
protect (lsp, obj); /* in case makecons() fails */
|
||||
cell = qse_lsp_makecons (lsp->mem, obj, lsp->mem->nil);
|
||||
unprotect (lsp, obj);
|
||||
|
||||
if (cell == QSE_NULL) return QSE_NULL;
|
||||
|
||||
if (QSE_LSP_CAR(head) == lsp->mem->nil)
|
||||
{
|
||||
/* the list head is not set yet. it is the first
|
||||
* element added to the list. let both head and tail
|
||||
* point to the new cons cell */
|
||||
QSE_ASSERT (QSE_LSP_CAR(tail) == lsp->mem->nil);
|
||||
QSE_LSP_CAR(head) = cell;
|
||||
QSE_LSP_CAR(tail) = cell;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* the new cons cell is not the first element.
|
||||
* append it to the list */
|
||||
QSE_LSP_CDR(QSE_LSP_CAR(tail)) = cell;
|
||||
QSE_LSP_CAR(tail) = cell;
|
||||
}
|
||||
}
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
static QSE_INLINE_ALWAYS int is_list_empty (qse_lsp_t* lsp)
|
||||
{
|
||||
/* the stack must not be empty */
|
||||
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
|
||||
|
||||
/* if the tail pointer is pointing to nil, the list is empty */
|
||||
return QSE_LSP_CAR(lsp->mem->r.stack) == lsp->mem->nil;
|
||||
}
|
||||
|
||||
static qse_lsp_obj_t* read_obj (qse_lsp_t* lsp)
|
||||
{
|
||||
/* this function read an s-expression non-recursively
|
||||
* by manipulating its own stack. */
|
||||
|
||||
int level = 0, flag = 0;
|
||||
qse_lsp_obj_t* obj;
|
||||
|
||||
while (1)
|
||||
{
|
||||
redo:
|
||||
switch (TOKEN_TYPE(lsp))
|
||||
{
|
||||
default:
|
||||
QSE_ASSERT (!"should never happen - invalid token type");
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EINTERN, QSE_NULL, QSE_NULL);
|
||||
return QSE_NULL;
|
||||
|
||||
case TOKEN_INVALID:
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
|
||||
case TOKEN_END:
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EEND, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
|
||||
case TOKEN_QUOTE:
|
||||
if (level >= QSE_TYPE_MAX(int))
|
||||
{
|
||||
/* the nesting level has become too deep */
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ELSTDEEP, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
/* enter a quoted string */
|
||||
flag |= QUOTED;
|
||||
if (enter_list (lsp, flag) == QSE_NULL) return QSE_NULL;
|
||||
level++;
|
||||
|
||||
/* force-chain the quote symbol to the new list entered */
|
||||
if (chain_to_list (lsp, lsp->mem->quote) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* read the next token */
|
||||
NEXT_TOKEN (lsp);
|
||||
goto redo;
|
||||
|
||||
case TOKEN_LPAREN:
|
||||
if (level >= QSE_TYPE_MAX(int))
|
||||
{
|
||||
/* the nesting level has become too deep */
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ELSTDEEP, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
/* enter a normal string */
|
||||
flag = 0;
|
||||
if (enter_list (lsp, flag) == QSE_NULL) return QSE_NULL;
|
||||
level++;
|
||||
|
||||
/* read the next token */
|
||||
NEXT_TOKEN (lsp);
|
||||
goto redo;
|
||||
|
||||
case TOKEN_DOT:
|
||||
if (level <= 0 || is_list_empty (lsp))
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
dot_list (lsp);
|
||||
NEXT_TOKEN (lsp);
|
||||
goto redo;
|
||||
|
||||
case TOKEN_RPAREN:
|
||||
if ((flag & QUOTED) || level <= 0)
|
||||
{
|
||||
/* the right parenthesis can never appear while
|
||||
* 'quoted' is true. 'quoted' is set to false when
|
||||
* entering a normal list. 'quoted' is set to true
|
||||
* when entering a quoted list. a quoted list does
|
||||
* not have an explicit right parenthesis.
|
||||
* so the right parenthesis can only pair up with
|
||||
* the left parenthesis for the normal list.
|
||||
*
|
||||
* For example, '(1 2 3 ') 5 6)
|
||||
*
|
||||
* this condition is triggerred when the first ) is
|
||||
* met after the second quote.
|
||||
*
|
||||
* also it is illegal to have the right parenthesis
|
||||
* with no opening(left) parenthesis, which is
|
||||
* indicated by level<=0.
|
||||
*/
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
|
||||
return QSE_NULL;
|
||||
}
|
||||
|
||||
obj = leave_list (lsp, &flag);
|
||||
|
||||
level--;
|
||||
break;
|
||||
|
||||
case TOKEN_INT:
|
||||
obj = qse_lsp_makeint (lsp->mem, TOKEN_IVAL(lsp));
|
||||
break;
|
||||
|
||||
case TOKEN_REAL:
|
||||
obj = qse_lsp_makereal (lsp->mem, TOKEN_RVAL(lsp));
|
||||
break;
|
||||
|
||||
case TOKEN_STRING:
|
||||
obj = qse_lsp_makestr (
|
||||
lsp->mem, TOKEN_SPTR(lsp), TOKEN_SLEN(lsp));
|
||||
break;
|
||||
|
||||
case TOKEN_IDENT:
|
||||
obj = makesym (lsp, &TOKEN_STR(lsp));
|
||||
break;
|
||||
}
|
||||
|
||||
/* check if the element is read for a quoted list */
|
||||
while (flag & QUOTED)
|
||||
{
|
||||
QSE_ASSERT (level > 0);
|
||||
|
||||
/* if so, append the element read into the quote list */
|
||||
if (chain_to_list (lsp, obj) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* exit out of the quoted list. the quoted list can have
|
||||
* one element only. */
|
||||
obj = leave_list (lsp, &flag);
|
||||
|
||||
/* one level up toward the top */
|
||||
level--;
|
||||
}
|
||||
|
||||
/* check if we are at the top level */
|
||||
if (level <= 0) break; /* yes */
|
||||
|
||||
/* if not, append the element read into the current list.
|
||||
* if we are not at the top level, we must be in a list */
|
||||
if (chain_to_list (lsp, obj) == QSE_NULL) return QSE_NULL;
|
||||
|
||||
/* read the next token */
|
||||
NEXT_TOKEN (lsp);
|
||||
}
|
||||
|
||||
/* upon exit, we must be at the top level */
|
||||
QSE_ASSERT (level == 0);
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
static int read_char (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_ssize_t n;
|
||||
qse_char_t c;
|
||||
|
||||
if (lsp->io.fns.in == QSE_NULL)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_ENOINP, QSE_NULL, QSE_NULL);
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* TODO: do some bufferring.... */
|
||||
n = lsp->io.fns.in (lsp, QSE_LSP_IO_READ, &lsp->io.arg.in, &c, 1);
|
||||
if (n == -1)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EINPUT, QSE_NULL, QSE_NULL);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (n == 0) lsp->curc = QSE_CHAR_EOF;
|
||||
else
|
||||
{
|
||||
lsp->curc = c;
|
||||
|
||||
if (c == QSE_T('\n'))
|
||||
{
|
||||
lsp->curloc.colm = 0;
|
||||
lsp->curloc.line++;
|
||||
}
|
||||
else lsp->curloc.colm++;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int read_token (qse_lsp_t* lsp)
|
||||
{
|
||||
QSE_ASSERT (lsp->io.fns.in != QSE_NULL);
|
||||
|
||||
TOKEN_CLEAR (lsp);
|
||||
|
||||
while (1)
|
||||
{
|
||||
/* skip white spaces */
|
||||
while (QSE_LSP_ISSPACE(lsp, lsp->curc)) NEXT_CHAR (lsp);
|
||||
|
||||
if (lsp->curc != QSE_T(';')) break;
|
||||
|
||||
/* skip a comment - ignore all the following text */
|
||||
do { NEXT_CHAR (lsp); }
|
||||
while (lsp->curc != QSE_T('\n') &&
|
||||
lsp->curc != QSE_CHAR_EOF);
|
||||
}
|
||||
|
||||
TOKEN_LOC(lsp) = lsp->curloc;
|
||||
if (lsp->curc == QSE_CHAR_EOF)
|
||||
{
|
||||
TOKEN_TYPE(lsp) = TOKEN_END;
|
||||
return 0;
|
||||
}
|
||||
else if (lsp->curc == QSE_T('('))
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
TOKEN_TYPE(lsp) = TOKEN_LPAREN;
|
||||
NEXT_CHAR (lsp);
|
||||
return 0;
|
||||
}
|
||||
else if (lsp->curc == QSE_T(')'))
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
TOKEN_TYPE(lsp) = TOKEN_RPAREN;
|
||||
NEXT_CHAR (lsp);
|
||||
return 0;
|
||||
}
|
||||
else if (lsp->curc == QSE_T('\''))
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
TOKEN_TYPE(lsp) = TOKEN_QUOTE;
|
||||
NEXT_CHAR (lsp);
|
||||
return 0;
|
||||
}
|
||||
else if (lsp->curc == QSE_T('.'))
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
TOKEN_TYPE(lsp) = TOKEN_DOT;
|
||||
NEXT_CHAR (lsp);
|
||||
return 0;
|
||||
}
|
||||
else if (lsp->curc == QSE_T('-'))
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
NEXT_CHAR (lsp);
|
||||
if (QSE_LSP_ISDIGIT(lsp,lsp->curc))
|
||||
{
|
||||
return read_number (lsp, 1);
|
||||
}
|
||||
else if (IS_IDENT_CHAR(lsp,lsp->curc))
|
||||
{
|
||||
return read_ident (lsp);
|
||||
}
|
||||
else
|
||||
{
|
||||
TOKEN_TYPE(lsp) = TOKEN_IDENT;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
else if (QSE_LSP_ISDIGIT(lsp,lsp->curc))
|
||||
{
|
||||
return read_number (lsp, 0);
|
||||
}
|
||||
else if (IS_IDENT_CHAR(lsp,lsp->curc))
|
||||
{
|
||||
return read_ident (lsp);
|
||||
}
|
||||
else if (lsp->curc == QSE_T('\"'))
|
||||
{
|
||||
return read_string (lsp);
|
||||
}
|
||||
|
||||
TOKEN_TYPE(lsp) = TOKEN_INVALID;
|
||||
NEXT_CHAR (lsp); /* consume */
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int read_number (qse_lsp_t* lsp, int negative)
|
||||
{
|
||||
qse_long_t ival = 0;
|
||||
qse_real_t rval = .0;
|
||||
|
||||
do
|
||||
{
|
||||
ival = ival * 10 + (lsp->curc - QSE_T('0'));
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
NEXT_CHAR (lsp);
|
||||
}
|
||||
while (QSE_LSP_ISDIGIT(lsp, lsp->curc));
|
||||
|
||||
/* TODO: extend parsing floating point number */
|
||||
if (lsp->curc == QSE_T('.'))
|
||||
{
|
||||
qse_real_t fraction = 0.1;
|
||||
|
||||
NEXT_CHAR (lsp);
|
||||
rval = (qse_real_t)ival;
|
||||
|
||||
while (QSE_LSP_ISDIGIT(lsp, lsp->curc))
|
||||
{
|
||||
rval += (qse_real_t)(lsp->curc - QSE_T('0')) * fraction;
|
||||
fraction *= 0.1;
|
||||
NEXT_CHAR (lsp);
|
||||
}
|
||||
|
||||
TOKEN_RVAL(lsp) = rval;
|
||||
TOKEN_TYPE(lsp) = TOKEN_REAL;
|
||||
if (negative) rval *= -1;
|
||||
}
|
||||
else
|
||||
{
|
||||
TOKEN_IVAL(lsp) = ival;
|
||||
TOKEN_TYPE(lsp) = TOKEN_INT;
|
||||
if (negative) ival *= -1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int read_ident (qse_lsp_t* lsp)
|
||||
{
|
||||
do
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, lsp->curc);
|
||||
NEXT_CHAR (lsp);
|
||||
}
|
||||
while (IS_IDENT_CHAR(lsp,lsp->curc));
|
||||
TOKEN_TYPE(lsp) = TOKEN_IDENT;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int read_string (qse_lsp_t* lsp)
|
||||
{
|
||||
qse_cint_t c;
|
||||
int escaped = 0;
|
||||
int digit_count = 0;
|
||||
qse_cint_t c_acc = 0;
|
||||
|
||||
while (1)
|
||||
{
|
||||
NEXT_CHAR_TO (lsp, c);
|
||||
|
||||
if (c == QSE_CHAR_EOF)
|
||||
{
|
||||
qse_lsp_seterror (lsp, QSE_LSP_EENDSTR, QSE_NULL, &lsp->curloc);
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (escaped == 3)
|
||||
{
|
||||
if (c >= QSE_T('0') && c <= QSE_T('7'))
|
||||
{
|
||||
c_acc = c_acc * 8 + c - QSE_T('0');
|
||||
digit_count++;
|
||||
if (digit_count >= escaped)
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
escaped = 0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
else
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
escaped = 0;
|
||||
}
|
||||
}
|
||||
else if (escaped == 2 || escaped == 4 || escaped == 8)
|
||||
{
|
||||
if (c >= QSE_T('0') && c <= QSE_T('9'))
|
||||
{
|
||||
c_acc = c_acc * 16 + c - QSE_T('0');
|
||||
digit_count++;
|
||||
if (digit_count >= escaped)
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
escaped = 0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
else if (c >= QSE_T('A') && c <= QSE_T('F'))
|
||||
{
|
||||
c_acc = c_acc * 16 + c - QSE_T('A') + 10;
|
||||
digit_count++;
|
||||
if (digit_count >= escaped)
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
escaped = 0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
else if (c >= QSE_T('a') && c <= QSE_T('f'))
|
||||
{
|
||||
c_acc = c_acc * 16 + c - QSE_T('a') + 10;
|
||||
digit_count++;
|
||||
if (digit_count >= escaped)
|
||||
{
|
||||
TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
escaped = 0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
else
|
||||
{
|
||||
qse_char_t rc;
|
||||
|
||||
rc = (escaped == 2)? QSE_T('x'):
|
||||
(escaped == 4)? QSE_T('u'): QSE_T('U');
|
||||
|
||||
if (digit_count == 0) TOKEN_ADD_CHAR (lsp, rc);
|
||||
else TOKEN_ADD_CHAR (lsp, c_acc);
|
||||
|
||||
escaped = 0;
|
||||
}
|
||||
}
|
||||
|
||||
if (escaped == 0 && c == QSE_T('\"'))
|
||||
{
|
||||
/* terminating quote */
|
||||
/*NEXT_CHAR_TO (lsp, c);*/
|
||||
NEXT_CHAR (lsp);
|
||||
break;
|
||||
}
|
||||
|
||||
if (escaped == 0 && c == QSE_T('\\'))
|
||||
{
|
||||
escaped = 1;
|
||||
continue;
|
||||
}
|
||||
|
||||
if (escaped == 1)
|
||||
{
|
||||
if (c == QSE_T('n')) c = QSE_T('\n');
|
||||
else if (c == QSE_T('r')) c = QSE_T('\r');
|
||||
else if (c == QSE_T('t')) c = QSE_T('\t');
|
||||
else if (c == QSE_T('f')) c = QSE_T('\f');
|
||||
else if (c == QSE_T('b')) c = QSE_T('\b');
|
||||
else if (c == QSE_T('v')) c = QSE_T('\v');
|
||||
else if (c == QSE_T('a')) c = QSE_T('\a');
|
||||
else if (c >= QSE_T('0') && c <= QSE_T('7'))
|
||||
{
|
||||
escaped = 3;
|
||||
digit_count = 1;
|
||||
c_acc = c - QSE_T('0');
|
||||
continue;
|
||||
}
|
||||
else if (c == QSE_T('x'))
|
||||
{
|
||||
escaped = 2;
|
||||
digit_count = 0;
|
||||
c_acc = 0;
|
||||
continue;
|
||||
}
|
||||
#ifdef QSE_CHAR_IS_WCHAR
|
||||
else if (c == QSE_T('u') && QSE_SIZEOF(qse_char_t) >= 2)
|
||||
{
|
||||
escaped = 4;
|
||||
digit_count = 0;
|
||||
c_acc = 0;
|
||||
continue;
|
||||
}
|
||||
else if (c == QSE_T('U') && QSE_SIZEOF(qse_char_t) >= 4)
|
||||
{
|
||||
escaped = 8;
|
||||
digit_count = 0;
|
||||
c_acc = 0;
|
||||
continue;
|
||||
}
|
||||
#endif
|
||||
|
||||
escaped = 0;
|
||||
}
|
||||
|
||||
TOKEN_ADD_CHAR (lsp, c);
|
||||
}
|
||||
|
||||
TOKEN_TYPE(lsp) = TOKEN_STRING;
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -1,7 +1,21 @@
|
||||
/*
|
||||
* $Id: http.c 341 2008-08-20 10:58:19Z baconevi $
|
||||
*
|
||||
* {License}
|
||||
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 <qse/utl/http.h>
|
||||
|
||||
Reference in New Issue
Block a user