From b6855f795c91da869103452905a8f39910320575 Mon Sep 17 00:00:00 2001 From: TasMania17 Date: Mon, 13 Nov 2017 21:18:04 +1100 Subject: [PATCH] convert lispreader submodule to folder Signed-off-by: TasMania17 --- lispreader/COPYING | 341 +++++++++ lispreader/Makefile | 26 + lispreader/Makefile.dist | 28 + lispreader/NEWS | 45 ++ lispreader/README | 44 ++ lispreader/TODO | 2 + lispreader/allocator.c | 66 ++ lispreader/allocator.h | 47 ++ lispreader/comment-test.c | 72 ++ lispreader/doc/Makefile | 16 + lispreader/doc/lispreader.texi | 762 ++++++++++++++++++++ lispreader/doc/version.texi | 3 + lispreader/docexample.c | 57 ++ lispreader/lispcat.c | 104 +++ lispreader/lispreader.c | 1202 ++++++++++++++++++++++++++++++++ lispreader/lispreader.h | 183 +++++ lispreader/lispscan.h | 162 +++++ lispreader/lisptest.c | 72 ++ lispreader/pools.c | 119 ++++ lispreader/pools.h | 75 ++ 20 files changed, 3426 insertions(+) create mode 100644 lispreader/COPYING create mode 100644 lispreader/Makefile create mode 100644 lispreader/Makefile.dist create mode 100644 lispreader/NEWS create mode 100644 lispreader/README create mode 100644 lispreader/TODO create mode 100644 lispreader/allocator.c create mode 100644 lispreader/allocator.h create mode 100644 lispreader/comment-test.c create mode 100644 lispreader/doc/Makefile create mode 100644 lispreader/doc/lispreader.texi create mode 100644 lispreader/doc/version.texi create mode 100644 lispreader/docexample.c create mode 100644 lispreader/lispcat.c create mode 100644 lispreader/lispreader.c create mode 100644 lispreader/lispreader.h create mode 100644 lispreader/lispscan.h create mode 100644 lispreader/lisptest.c create mode 100644 lispreader/pools.c create mode 100644 lispreader/pools.h diff --git a/lispreader/COPYING b/lispreader/COPYING new file mode 100644 index 0000000..1942c43 --- /dev/null +++ b/lispreader/COPYING @@ -0,0 +1,341 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place - Suite 330 + Boston, MA 02111-1307, USA. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; see the file COPYING. If not, write to + the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/lispreader/Makefile b/lispreader/Makefile new file mode 100644 index 0000000..e1a6a3c --- /dev/null +++ b/lispreader/Makefile @@ -0,0 +1,26 @@ +# $Id: Makefile 933 2007-03-18 14:22:54Z schani $ + +VERSION = 0.5 + +all : liblispreader.a + +liblispreader.a : + $(MAKE) -f Makefile.dist + +dist : + rm -rf lispreader-$(VERSION) + mkdir lispreader-$(VERSION) + mkdir lispreader-$(VERSION)/doc + cp README COPYING NEWS lispreader-$(VERSION)/ + cp -pr lispreader.[ch] lispscan.h allocator.[ch] pools.[ch] docexample.c lispcat.c lispreader-$(VERSION)/ + cp Makefile.dist lispreader-$(VERSION)/Makefile + cp doc/{lispreader,version}.texi lispreader-$(VERSION)/doc/ + cp doc/Makefile lispreader-$(VERSION)/doc/ + make -C lispreader-$(VERSION)/doc/ + tar -zcvf lispreader-$(VERSION).tar.gz lispreader-$(VERSION) + rm -rf lispreader-$(VERSION) + +clean : + rm -f *~ + $(MAKE) -f Makefile.dist clean + $(MAKE) -C doc clean diff --git a/lispreader/Makefile.dist b/lispreader/Makefile.dist new file mode 100644 index 0000000..f594526 --- /dev/null +++ b/lispreader/Makefile.dist @@ -0,0 +1,28 @@ +# -*- makefile -*- +# $Id: Makefile.dist 933 2007-03-18 14:22:54Z schani $ + +CC=gcc +CFLAGS=-Wall -O2 +ALL_CFLAGS=$(CFLAGS) -I. + +LISPREADER_OBJS = lispreader.o allocator.o pools.o + +all : liblispreader.a + +liblispreader.a : $(LISPREADER_OBJS) + ar rcu liblispreader.a $(LISPREADER_OBJS) + +docexample : docexample.o $(LISPREADER_OBJS) + $(CC) -Wall -g -o docexample $(LISPREADER_OBJS) docexample.o `pkg-config --libs glib-2.0` + +lispcat : lispcat.o $(LISPREADER_OBJS) + $(CC) -Wall -g -o lispcat $(LISPREADER_OBJS) lispcat.o `pkg-config --libs glib-2.0` + +#comment-test: comment-test.o $(LISPREADER_OBJS) +# $(CC) -Wall -g -o comment-test $(LISPREADER_OBJS) comment-test.o + +%.o : %.c + $(CC) $(ALL_CFLAGS) `pkg-config --cflags glib-2.0` -c $< + +clean : + rm -f liblispreader.a docexample *.o *~ diff --git a/lispreader/NEWS b/lispreader/NEWS new file mode 100644 index 0000000..bfdea5f --- /dev/null +++ b/lispreader/NEWS @@ -0,0 +1,45 @@ +News +**** + +0.5 +=== + + * #?(number) pattern + + * lisp_free can handly arbitrarily nested lists without + recursion. + + * Memory allocation can now be controlled with the allocator + interface. + + * An allocator is included which is very fast and low-overhead, + but only allows freeing all data at once. + + * A new memory mapping Lisp stream type is implemented, which + about doubles parsing speed. + +0.4 +=== + + * Functions for making expressions (contributed by Masatake Yamato) + + * Type predicates (contributed by Masatake Yamato) + + * lisp_cxr + +0.3 +=== + + * Lisp style comments are ignored (strings starting with + the semicolon, ended by newline, contributed by Masatake Yamato) + + * Used-defined streams (contributed by Masatake Yamato) + +0.2 +=== + + * Added code for handling real numbers (contributed by Masatake + Yamato) + + * The string arguments to lisp_read_from_string and + lisp_match_string are now const diff --git a/lispreader/README b/lispreader/README new file mode 100644 index 0000000..0b860a9 --- /dev/null +++ b/lispreader/README @@ -0,0 +1,44 @@ +lispreader 0.5 +============== + +lispreader is a small library for reading expressions in Lisp +syntax. It has originally been written to facilitate simple exchange +of structured data between processes but its main purpose is now to +provide a framework for reading configuration files. To simplify +interpretation of the read data, lispreader also provides functions +for simple matching of expressions against patterns. + +lispreader is also used in at least one application to read and write +data files. Lisp syntax is very suitable for doing this, especially if +the data is organized hierachically. + + +Documentation +------------- + +A reference manual for lispreader is included in the distribution in +texinfo, info and html formats. + + +Platforms +--------- + +lispreader has been tested on GNU/Linux i386 and MacOS X PPC systems, +but should work on any system with an ANSI C compliant +compiler/library pair. + + +Licence and Availability +------------------------ + +lispreader is distributed under the terms of the GNU General Public +Licence. + +The source of lispreader is available at the lispreader homepage at + + http://www.complang.tuwien.ac.at/schani/lispreader/ + + +--- +Mark Probst +schani@complang.tuwien.ac.at diff --git a/lispreader/TODO b/lispreader/TODO new file mode 100644 index 0000000..7dd20e9 --- /dev/null +++ b/lispreader/TODO @@ -0,0 +1,2 @@ +locale-neutral float conversion via GLib (g_ascii_strtod/dtostr). +change float to double in real. diff --git a/lispreader/allocator.c b/lispreader/allocator.c new file mode 100644 index 0000000..dce5a5e --- /dev/null +++ b/lispreader/allocator.c @@ -0,0 +1,66 @@ +/* + * allocator.c + * + * lispreader + * + * Copyright (C) 2004 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#include + +#include +#include + +static void* +malloc_allocator_alloc (void *allocator_data, size_t size) +{ + return malloc(size); +} + +static void +malloc_allocator_free (void *allocator_data, void *chunk) +{ + free(chunk); +} + +allocator_t malloc_allocator = { malloc_allocator_alloc, malloc_allocator_free, 0 }; + +static void +pools_allocator_free (void *allocator_data, void *chunk) +{ +} + +void +init_pools_allocator (allocator_t *allocator, pools_t *pools) +{ + allocator->alloc = (void* (*) (void*, size_t))pools_alloc; + allocator->free = pools_allocator_free; + allocator->allocator_data = pools; +} + +char* +allocator_strdup (allocator_t *allocator, const char *str) +{ + size_t len = strlen(str) + 1; + char *copy = (char*)allocator_alloc(allocator, len); + + if (copy != 0) + memcpy(copy, str, len); + + return copy; +} diff --git a/lispreader/allocator.h b/lispreader/allocator.h new file mode 100644 index 0000000..62d5db8 --- /dev/null +++ b/lispreader/allocator.h @@ -0,0 +1,47 @@ +/* + * allocator.h + * + * lispreader + * + * Copyright (C) 2004-2007 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#ifndef __ALLOCATOR_H__ +#define __ALLOCATOR_H__ + +#include + +#include "pools.h" + +typedef struct +{ + void* (*alloc) (void *allocator_data, size_t size); + void (*free) (void *allocator_data, void *chunk); + void *allocator_data; +} allocator_t; + +extern allocator_t malloc_allocator; + +void init_pools_allocator (allocator_t *allocator, pools_t *pools); + +#define allocator_alloc(a,s) ((a)->alloc((a)->allocator_data, (s))) +#define allocator_free(a,c) ((a)->free((a)->allocator_data, (c))) + +char* allocator_strdup (allocator_t *allocator, const char *str); + +#endif diff --git a/lispreader/comment-test.c b/lispreader/comment-test.c new file mode 100644 index 0000000..b1eb306 --- /dev/null +++ b/lispreader/comment-test.c @@ -0,0 +1,72 @@ +/* $Id: comment-test.c 187 2000-07-09 21:08:28Z schani $ */ +/* + * comment_test.c + * + * Copyright (C) 2000 Masatake YAMATO + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#include + +int +main (void) +{ + char * script = + "; This is comments(1)\n" + "\"This is script (1)\"\n" + "; This is comments(2)\n" + "\"This is script (2)\"\n" + "; This is comments(3)" ; + + lisp_object_t *obj; + lisp_stream_t stream; + + if (NULL == lisp_stream_init_string(&stream, script)) + { + fprintf(stderr, "Fail in lisp_stream_init_string\n"); + return 1; + } + + while (1) + { + int type; + + obj = lisp_read(&stream); + + type = lisp_type(obj); + + if (type == LISP_TYPE_STRING) + { + fprintf(stderr, "->%s\n", lisp_string(obj)); + lisp_free(obj); + } + else if (type == LISP_TYPE_PARSE_ERROR) + { + printf("parse error\n"); + lisp_free(obj); + } + else if (type == LISP_TYPE_EOF) + { + printf ("eof\n"); + lisp_free(obj); + break; + } + else + printf ("wrong type\n"); + } + return 0; +} diff --git a/lispreader/doc/Makefile b/lispreader/doc/Makefile new file mode 100644 index 0000000..0aeddf5 --- /dev/null +++ b/lispreader/doc/Makefile @@ -0,0 +1,16 @@ +# $Id: Makefile 182 1999-12-21 16:55:25Z schani $ + +all : html info + +html : lispreader_toc.html + +info : lispreader.info + +lispreader_toc.html : lispreader.texi + texi2html -expandinfo lispreader.texi + +lispreader.info : lispreader.texi + makeinfo lispreader.texi + +clean : + rm -f lispreader*.html lispreader.info *~ diff --git a/lispreader/doc/lispreader.texi b/lispreader/doc/lispreader.texi new file mode 100644 index 0000000..15a9f84 --- /dev/null +++ b/lispreader/doc/lispreader.texi @@ -0,0 +1,762 @@ +\input texinfo @c -*- texinfo -*- + +@include version.texi +@c %**start of header +@setfilename lispreader.info +@settitle Reference Manual +@c %**end of header + +@iftex +@afourpaper +@end iftex + +@ifinfo +This file documents the @code{lispreader} library. + +Copyright (C) 1998-2005, Mark Probst + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. +@end ifinfo + +@ifinfo +@direntry +* lispreader:: A library for reading Lisp expressions. +@end direntry +@end ifinfo + +@titlepage +@title @code{lispreader} +@subtitle Reference manual +@subtitle last updated @value{UPDATED} for version @value{VERSION} +@author Mark Probst (schani@@complang.tuwien.ac.at) +@page +@vskip 0pt plus 1filll +Copyright @copyright{} 1998-2005 Mark Probst + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. +@end titlepage + +@node Top, Introduction, (dir), (dir) +@comment node-name, next, previous, up@node Top, , (dir), (dir) + +@menu +* Introduction:: +* Using lispreader:: +* Syntax:: +* Pools:: +* Allocators:: +* Reference:: +* Example:: +* Function Index:: +@end menu + +@node Introduction, Using lispreader, Top, Top +@comment node-name, next, previous, up +@chapter Introduction + +@menu +* What lispreader is:: +* What lispreader is not:: +* Licence:: +* Obtaining lispreader:: +@end menu + +@node What lispreader is, What lispreader is not, Introduction, Introduction +@comment node-name, next, previous, up +@section What is @code{lispreader}? + +@code{lispreader} is a small library for reading expressions in Lisp +syntax. It has originally been written to facilitate simple exchange of +structured data between processes but its main purpose is now to provide +a framework for reading configuration files. To simplify interpretation +of the data read, @code{lispreader} also provides functions for simple +matching of expressions against patterns. + +@code{lispreader} is also used in several application to read and +write data files. Lisp syntax is very suitable for doing this, +especially if the data is organized hierachically. + +@node What lispreader is not, Licence, What lispreader is, Introduction +@comment node-name, next, previous, up +@section What is @code{lispreader} not? + +@code{lispreader} is not a Lisp system in that it cannot, by itself, +interpret Lisp expressions. It only provides a subset of the features of +libraries like Guile of librep (namely the reading of expressions) and +does thus not compete directly with those. If all you need is a simple +way to read Lisp expressions without interpreting them with Lisp +semantics, you will probably be satisfied with @code{lispreader}. + +@node Licence, Obtaining lispreader, What lispreader is not, Introduction +@comment node-name, next, previous, up +@section Licence and Warranty + +@code{lispreader} is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License as published +by the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +@code{lispreader} 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 +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with @code{chpp}; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +@node Obtaining lispreader, , Licence, Introduction +@comment node-name, next, previous, up +@section Obtaining @code{lispreader} + +@code{lispreader} is available for free download on the world-wide-web +at the URL @url{http://www.complang.tuwien.ac.at/schani/lispreader/}. + +@node Using lispreader, Syntax, Introduction, Top +@comment node-name, next, previous, up +@chapter Using @code{lispreader} in your programs + +@code{lispreader} consists of only a few C files, namely +@file{lispreader.c}, @file{lispreader.h}, @file{lispscan.h}, +@file{allocator.c}, @file{allocator.h}, @file{pools.c}, and +@file{pools.h}. To incorporate @code{lispreader} in your own +programs, just add these files to your own program's files. + +@node Syntax, Pools, Using lispreader, Top +@comment node-name, next, previous, up +@chapter Syntax + +@code{lispreader} can read lists consisting of other lists, symbols, +strings, integers, real numbers and booleans. It also provides a syntax +for specifying patterns. + +@menu +* Comments:: +* Lists:: +* Symbols:: +* Integers:: +* Reals:: +* Strings:: +* Booleans:: +* Patterns:: +@end menu + +@node Comments, Lists, Syntax, Syntax +@comment node-name, next, previous, up +@section Comments + +Comments are started by the semicolon (@code{;}) and reach until the end +of the line: + +@example +; this line is completely ignored +@end example + +@node Lists, Symbols, Comments, Syntax +@comment node-name, next, previous, up +@section Lists + +Lists consist of so-called cons-pairs, or conses. A cons is constituted +by its car and cdr. A list is defined as either being the empty list, +which is no cons at all, or as being a cons, the cdr of which is a +list. The cars of these conses are the actual elements of the list. + +An example: The list @code{(a b c)} consists of three conses, the cars +of which are the symbols @code{a}, @code{b} and @code{c}. The structure +can be depicted using a box diagram: + +@example + _ _ _ _ _ _ +|_|_|-->|_|_|-->|_|_|-->nil + | | | + v v v + a b c +@end example + +Each box denotes a cons, with the left half being its car and the right +half being its cdr. @code{nil} denotes the empty list. + +It is also possible to explicitly set the cdr of the last cons using the +dot-notation: @code{(a b . c)} can be illustrated thus: + +@example + _ _ _ _ +|_|_|-->|_|_|-->c + | | + v v + a b +@end example + +Note that this is technically not a list. Since the empty list can be +written as @code{()}, the list @code{(a b c)} can be written using the +dot-notation as @code{(a . (b . (c . ())))}. + +@node Symbols, Integers, Lists, Syntax +@comment node-name, next, previous, up +@section Symbols + +Symbols are pretty much everything that cannot be interpreted as +anything else. They can have arbitrary length. + +@node Integers, Reals, Symbols, Syntax +@comment node-name, next, previous, up +@section Integers + +As integers are internally represented by @code{int} values, their range +is restricted to the range of the @code{int} data type. Bignums are not +supported. + +@node Reals, Strings, Integers, Syntax +@comment node-name, next, previous, up +@section Reals + +Reals are internally represented by values of the @code{float} +datatype. @code{lispreader} cannot yet interpret exponential notation or +reals without digits before the dot. + +@node Strings, Booleans, Reals, Syntax +@comment node-name, next, previous, up +@section Strings + +Strings are delimited on both sides by double quotes (@samp{"}). The +backslash (@samp{\}) is used as escape character. The sequence @samp{\n} +is interpreted as newline, @samp{\t} as tab. All other escape sequences +evaluate to the char after the backslash, e.g. @samp{\\} denotes the +backslash itself and @samp{\"} denotes the double quote. + +@node Booleans, Patterns, Strings, Syntax +@comment node-name, next, previous, up +@section Booleans + +The boolean values true and false are represented by @code{#t} and +@code{#f}, respectively. + +@node Patterns, , Booleans, Syntax +@comment node-name, next, previous, up +@section Patterns + +Patterns are used to represent classes of expressions. They contain no +other value than the types of expressions they match against. + +Patterns are written using a special list syntax where the opening +parenthesis is replaced by @samp{#?(}. There are patterns for matching +all types of simple expressions: + +@table @code +@item #?(symbol) +Any symbol. +@item #?(string) +Any string. +@item #?(integer) +Any integer. +@item #?(real) +Any real. +@item #?(boolean) +@code{#t} of @code{#f}. +@end table + +Two other patterns have a wider scope: + +@table @code +@item #?(list) +Any list. +@item #?(number) +Any number, i.e., any integer or real. +@item #?(any) +Any expression (including lists). +@end table + +It is also possible to construct a pattern matching at least one out of +a given set of expressions, which themselves can contain patterns, using +the @code{or} pattern. For example, the pattern @code{#?(or (a . #?(list)) (b #?(integer)))} +matches the list @code{(a #t 43)} as well as the list @code{(b 1)}, but +not the list @code{(b #f)}. As another example, @code{#?(boolean)} is +equivalent to @code{#?(or #t #f)}. + +@node Pools, Allocators, Syntax, Top +@chapter Pools + +@menu +* Pools Introduction:: +* Pools Reference:: +@end menu + +@node Pools Introduction, Pools Reference, Pools, Pools +@section Introduction + +Most applications of @code{lispreader} use it to quickly read bits of +data from a file, process it, and then read the next bit, until the +end of the file. If the file is big, it is an advantage if reading is +fast. Part of the reading process is allocating memory for the data +read, so fast memory allocation results in better reading performance. + +@code{lispreader} comes with a memory allocator optimized for this +application pattern, called the ``pools'' allocator. It is very fast, +can allocate lots of small chunks of memory with virtually no overhead +apart from the alignment padding, and can free all allocated memory at +once. The downside is that freeing all allocated memory is the only +way of freeing. + +Using pools is not mandatory for using @code{lispreader}, but it +increases performance significantly (by about a factor of 2) compared +to the standard malloc allocator. If you never read files larger than +a few tens of kilobytes, you will probably never notice, though. + +@node Pools Reference, , Pools Introduction, Pools +@section Reference + +@deftypefun int init_pools (pools_t* @var{pools}) +Initializes the pools data structure pointed to by @var{pools}. After +calling this function, the pools can be used to allocate memory via +@code{pools_alloc}. Returns non-zero upon success, zero upon failure. +@end deftypefun + +@deftypefun void reset_pools (pools_t* @var{pools}) +Resets the pools pointed to by @var{pools}. This does not actually +free the memory allocated from this pools, but reuses it for further +allocations, i.e., the data previously allocated from it will be +overwritten. +@end deftypefun + +@deftypefun void free_pools (pools_t* @var{pools}) +Frees all the memory allocated by @var{pools}. +@end deftypefun + +@deftypefun void* pools_alloc (pools_t* @var{pools}, size_t @var{size}) +Allocates a region of memory @var{size} bytes long from the pools +pointed to by @var{pools}. Returns a null pointer if the allocation +failed. +@end deftypefun + +@node Allocators, Reference, Pools, Top +@chapter Allocators + +@menu +* Allocators Introduction:: +* Allocators Reference:: +@end menu + +@node Allocators Introduction, Allocators Reference, Allocators, Allocators +@section Introduction + +The @code{allocator_t} data structure is @code{lispreader}'s interface +to your memory allocator of choice: + +@example +typedef struct +@{ + void* (*alloc) (void *allocator_data, size_t size); + void (*free) (void *allocator_data, void *chunk); + void *allocator_data; +@} allocator_t; +@end example + +An allocator must provide two functions: + +@itemize @bullet +@item +@var{alloc} allocates an aligned chunk of memory at least @var{size} +bytes long. + +@item +@var{free} frees the memory pointed to by @var{chunk}. +@end itemize + +Both functions are always passed the value of @var{allocator_data} as +their first argument. + +All @code{lispreader} functions which allocate or free (non-temporary) +memory come in two versions: The ``normal'' version uses the standard +@code{malloc}/@code{free} memory allocation mechanism. The +@code{*_with_allocator} version takes a pointer to an +@code{allocator_t} as its first argument and allocates and frees +memory via that allocator. + +@node Allocators Reference, , Allocators Introduction, Allocators +@section Reference + +@deftypevr {Global Variable} allocator_t malloc_allocator +This is an allocator which uses the standard @code{malloc} and +@code{free} memory allocation functions. +@end deftypevr + +@deftypefun void init_pools_allocator (allocator_t* @var{allocator}, pools_t* @var{pools}) +Initializes the data structure pointed to by @var{allocator} to use +the pools allocator pointed to by @var{pools}. Note that the +@var{free} function for the pools allocator does not free memory, so +you'll have to free the pools yourself. +@end deftypefun + +@node Reference, Example, Allocators, Top +@comment node-name, next, previous, up +@chapter @code{lispreader} Reference + +@menu +* Reading:: +* Writing:: +* Examining:: +* Creating:: +* Matching:: +* Freeing:: +@end menu + +@node Reading, Writing, Reference, Reference +@comment node-name, next, previous, up +@section Reading expressions + +@deftypefun lisp_stream_t* lisp_stream_init_path (lisp_stream_t* @var{stream}, const char* @var{path}) +Initializes @var{stream} to be a file stream reading from the file +with path @var{path}. Returns a null pointer if the file cannot be +opened. The caller is supposed to use the function +@code{lisp_stream_free_path} to close the file. + +This function should be preferred over @code{lisp_stream_init_file} +because it uses memory mapping if possible, resulting in better +parsing performance. +@end deftypefun + +@deftypefun void lisp_stream_free_path (lisp_stream_t* @var{stream}) +Closes the file associated with the file stream @var{stream}. +@end deftypefun + +@deftypefun lisp_stream_t* lisp_stream_init_file (lisp_stream_t* @var{stream}, FILE* @var{file}) +Initializes @var{stream} to be a file stream reading from +@var{file}. The caller is still responsible to close @var{file} when it +is not needed any more. +@end deftypefun + +@deftypefun lisp_stream_t* lisp_stream_init_string (lisp_stream_t* @var{stream}, char* @var{buf}) +Initializes @var{stream} to be a string stream reading from +@var{buf}. @var{buf} is not copied by this function, hence the effects +of reading from the stream after modifying @var{buf} are undefined. +@end deftypefun + +@deftypefun lisp_stream_t* lisp_stream_init_any (lisp_stream_t* @var{stream}, void* @var{data}, int (*@var{next_char}) (void *data), void (*@var{unget_char}) (char c, void *data)) +Initializes @var{stream} to be a user-defined stream. The function +@var{next_char} is used to read individual characters from the +stream. It must return @code{EOF} upon end-of-file and on all +invocations succeeding the invocation that first returned +@code{EOF}. @var{unget_char} is called to push back a character for +reading it again. The character pushed back is always the character +returned by the last call to @var{next_char}. The next call to +@var{next_char} must return that character. @var{unget_char} is never +called twice without at least a call to @var{next_char} in +between. @var{data} is always passed to @var{next_char} and +@var{unget_char}. No other action whatsoever is performed on @var{data}, +i.e. should it point to a dynamically allocated memory region, the +application is responsible for freeing it after the stream has been +closed. +@end deftypefun + +@deftypefun lisp_object_t* lisp_read (lisp_stream_t* @var{in}) +@deftypefunx lisp_object_t* lisp_read_with_allocator (allocator_t* @var{allocator}, lisp_stream_t* @var{in}) +Reads a Lisp expression from the stream @var{in} and returns it. The +caller is responsible for deallocating its memory using +@code{lisp_free}/@code{lisp_free_with_allocator}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_read_from_string (char* @var{buf}) +@deftypefunx lisp_object_t* lisp_read_from_string_with_allocator (allocator_t* @var{allocator}, const char* @var{buf}) +Reads a Lisp expression from the string @var{buf} and returns it. The +caller is responsible for deallocating its memory using +@code{lisp_free}/@code{lisp_free_with_allocator}. Although @var{buf} may contain more than one +expression, only the first is read. If you need to read more than one +expression from a string, use @code{lisp_read}/@code{lisp_read_with_allocator} on a string stream +created by @code{lisp_stream_init_string}. +@end deftypefun + +@node Writing, Examining, Reading, Reference +@comment node-name, next, previous, up +@section Writing expressions + +@deftypefun int lisp_dump (lisp_object_t* @var{obj}, FILE* @var{out}) +Writes the external representation of @var{obj}, which can be read again +by @code{lisp_read}, to @var{out}. +@end deftypefun + +@node Examining, Creating, Writing, Reference +@comment node-name, next, previous, up +@section Examining expressions + +@deftypefun int lisp_type (lisp_object_t* @var{obj}) +Returns the type of the lisp object @code{obj}. +@end deftypefun + +The returned type can be one of + +@table @code +@item LISP_TYPE_NIL +The empty list. +@item LISP_TYPE_SYMBOL +A symbol. +@item LISP_TYPE_INTEGER +An integer. +@item LISP_TYPE_REAL +A real. +@item LISP_TYPE_STRING +A string. +@item LISP_TYPE_CONS +A cons-pair. +@item LISP_TYPE_BOOLEAN +A boolean. +@item LISP_TYPE_PATTERN_CONS +A cons-pair of a pattern. The interpretation of these should be left to +the function @code{lisp_compile_pattern}. +@item LISP_TYPE_EOF +Indicates that end-of-file occured during reading the expression. +@item LISP_TYPE_PARSE_ERROR +Indicates a malformed expression. +@end table + +@deftypefun int lisp_nil_p (lisp_object_t* @var{obj}) +If @var{obj} is the empty list, returns a non-zero value, otherwise +zero. +@end deftypefun + +@deftypefun int lisp_integer_p (lisp_object_t* @var{obj}) +If @var{obj} is an integer object, returns a non-zero value, otherwise +zero. +@end deftypefun + +@deftypefun int lisp_integer (lisp_object_t* @var{obj}) +Returns the integer value for @var{obj}. This function must not be +called when the type of @var{obj} is not @code{LISP_TYPE_INTEGER}. +@end deftypefun + +@deftypefun int lisp_real_p (lisp_object_t* @var{obj}) +If @var{obj} is a real object, returns a non-zero value, otherwise zero. +@end deftypefun + +@deftypefun float lisp_real (lisp_object_t* @var{obj}) +Returns the real value for @var{obj}. This function must not be called +when the type of @var{obj} is not either @code{LISP_TYPE_REAL} or +@code{LISP_TYPE_INTEGER}. +@end deftypefun + +@deftypefun int lisp_symbol_p (lisp_object_t* @var{obj}) +If @var{obj} is a symbol, returns a non-zero value, otherwise zero. +@end deftypefun + +@deftypefun char* lisp_symbol (lisp_object_t* @var{obj}) +Returns the string for the symbol stored in @var{obj}. This function +must not be called when the type of @var{obj} is not +@code{LISP_TYPE_SYMBOL}. +@end deftypefun + +@deftypefun int lisp_string_p (lisp_object_t* @var{obj}) +If @var{obj} is a string object, returns a non-zero value, otherwise +zero. +@end deftypefun + +@deftypefun char* lisp_string (lisp_object_t* @var{obj}) +Returns the string value for @var{obj}. This function must not be called +when the type of @var{obj} is not @code{LISP_TYPE_STRING}. +@end deftypefun + +@deftypefun int lisp_boolean_p (lisp_object_t* @var{obj}) +If @var{obj} is a boolean object, returns a non-zero value, otherwise +zero. +@end deftypefun + +@deftypefun int lisp_boolean (lisp_object_t* @var{obj}) +Returns the boolean value for @var{obj}. If @var{obj} represents false, +the result is @code{0}, otherwise some integer not equal to +@code{0}. This function must not be called when the type of @var{obj} is +not @code{LISP_TYPE_BOOLEAN}. +@end deftypefun + +@deftypefun int lisp_cons_p (lisp_object_t* @var{obj}) +If @var{obj} is a cons, returns a non-zero value, otherwise zero. +@end deftypefun + +@deftypefun lisp_object_t* lisp_car (lisp_object_t* @var{obj}) +Returns the car of the cons stored in @var{obj}. This function must not +be called when type type of @var{obj} is not @code{LISP_TYPE_CONS}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_cdr (lisp_object_t* @var{obj}) +Returns the cdr of the cons stored in @var{obj}. This function must not +be called when type type of @var{obj} is not @code{LISP_TYPE_CONS}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_cxr (lisp_object_t* @var{obj}, const char* @var{x}) +@var{x} must be a string consisting of the chars @code{a} and +@var{d}. Returns the object resulting from applying @code{lisp_car} and +@code{lisp_cdr} according to @var{x} with @code{a} corresponding to the +former and @code{d} to the latter starting with @var{obj} in reverse +order. As an example, @code{lisp_cxr(o,"ad")} is equivalent to +@code{lisp_car(lisp_cdr(o))}. +@end deftypefun + +@deftypefun int lisp_list_length (lisp_object_t* @var{obj}) +Returns the length of the list stored in @var{obj}. A list is defined as +the empty list, which is represented by a null pointer, or a cons, the +cdr of which is a list. +@end deftypefun + +@deftypefun lisp_object_t* lisp_list_nth_cdr (lisp_object_t* @var{obj}, int @var{n}) +Returns the result of iterating @code{lisp_cdr} @var{n} times on +@var{obj}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_list_nth (lisp_object_t* @var{obj}, int @var{n}) +Returns the car of the result of applying @code{lisp_list_nth_cdr} on +@var{obj} with @var{n}. +@end deftypefun + +@node Creating, Matching, Examining, Reference +@comment node-name, next, previous, up +@section Creating expressions + +@deftypefun lisp_object_t* lisp_nil () +Returns the empty list. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_integer (int @var{value}) +@deftypefunx lisp_object_t* lisp_make_integer_with_allocator (allocator_t* @var{allocator}, int @var{value}) +Returns an integer object with the value @var{value}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_real (float @var{value}) +@deftypefunx lisp_object_t* lisp_make_real_with_allocator (allocator_t* @var{allocator}, float @var{value}) +Returns a real object with the value @var{value}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_symbol (const char* @var{value}) +@deftypefunx lisp_object_t* lisp_make_symbol_with_allocator (allocator_t* @var{allocator}, const char* @var{value}) +Returns a symbol object with the name @var{value}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_string (const char* @var{value}) +@deftypefunx lisp_object_t* lisp_make_string_with_allocator (allocator_t* @var{allocator}, const char* @var{value}) +Returns a string object with the value @var{value}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_cons (lisp_object_t* @var{car}, lisp_object_t* @var{cdr}) +@deftypefunx lisp_object_t* lisp_make_cons_with_allocator (allocator_t* @var{allocator}, lisp_object_t* @var{car}, lisp_object_t* @var{cdr}) +Returns a cons object with car @var{car} and cdr @var{cdr}. +@end deftypefun + +@deftypefun lisp_object_t* lisp_make_boolean (int @var{value}) +@deftypefunx lisp_object_t* lisp_make_boolean_with_allocator (allocator_t* @var{allocator}, int @var{value}) +Returns a boolean. Its value is false if @var{value} is @code{0}, true otherwise. +@end deftypefun + +@node Matching, Freeing, Creating, Reference +@comment node-name, next, previous, up +@section Matching expressions against patterns + +@deftypefun int lisp_compile_pattern (lisp_object_t** @var{obj}, int* @var{num_subs}) +Prepares the expression @code{*}@var{obj} for use as a pattern in the +@code{lisp_match_pattern} function. The expression is modified in the +process. If @var{num_subs} is non-null, the number of pattern +expressions (including all sub-expressions) will be written to +@code{*}@var{num_subs}. + +Returns @code{0} if an error occurred, non-zero on success. Note that +the expression could have been modified even if the function returned +@code{0}. +@end deftypefun + +@deftypefun int lisp_match_pattern (lisp_object_t* @var{pattern}, lisp_object_t* @var{obj}, lisp_object_t** @var{vars}, int @var{num_subs}) +Matches the pattern @var{pattern} (which must have previously been +compiled using @code{lisp_compile_pattern}) against @var{obj}, storing +the resulting subexpressions in @var{vars}, if it is +non-null. @var{num_subs} should be the number of sub-patterns in +@var{pattern}, if @var{vars} is non-null. Otherwise, it is ignored. + +Patterns are counted by their special opening parenthesis (@samp{#?(}) +from left to right, beginning with 0. For example, in the pattern +expression @code{(a #?(or #?(integer) #?(string)) #?(symbol))}, the +@code{or}-pattern has index 0, the @code{integer} index 1, the +@code{string} index 2 and the @code{symbol} index 3. This means than +upon matching this pattern against @code{(a 1 b)}, the integer @code{1} +is stored in @var{vars}@code{[0]} and @var{vars}@code{[1]} and the +symbol @code{b} is stored in @var{vars}@code{[3]}. The values for +unmatched parts, like @var{vars}@code{[2]}, are set to an expression of +type @code{LISP_TYPE_PARSE_ERROR}. + +Returns @code{0} if the match was unsuccessful, non-zero on success. +@end deftypefun + +@deftypefun int lisp_match_string (char* @var{pattern_string}, lisp_object_t* @var{obj}, lisp_object_t** @var{vars}) +Reads an expression from @var{pattern_string}, compiles it using +@code{lisp_compile_pattern} and matches @var{obj} against it using +@code{lisp_match_pattern}, storing the resulting subexpressions in +@var{vars}, if it is non-zero. + +Returns non-zero if reading and matching were successful, @code{0} +otherwise. +@end deftypefun + +@node Freeing, , Matching, Reference +@comment node-name, next, previous, up +@section Freeing expressions + +@deftypefun void lisp_free (lisp_object_t* @var{obj}) +@deftypefunx void lisp_free_with_allocator (allocator_t* @var{allocator}, lisp_object_t* @var{obj}) +Frees all memory occupied by @var{obj}, including all its +subexpressions. +@end deftypefun + +@node Example, Function Index, Reference, Top +@comment node-name, next, previous, up +@chapter An Example + +The following program reads expressions from standard input, prints the +string @samp{parse error} when a parse error occurs, exits on +end-of-file and, if an entered expression is of the form +@code{(+ }@var{number1}@code{ }@var{number2}@code{)}, prints the sum of +@var{number1} and @var{number2}. + +@example +#include + +int +main (void) +@{ + lisp_object_t *obj; + lisp_stream_t stream; + + lisp_stream_init_file(&stream, stdin); + + while (1) + @{ + int type; + + obj = lisp_read(&stream); + type = lisp_type(obj); + if (type != LISP_TYPE_EOF && type != LISP_TYPE_PARSE_ERROR) + @{ + lisp_object_t *vars[2]; + + if (lisp_match_string("(+ #?(number) #?(number))", + obj, vars)) + printf("%f\n", lisp_real(vars[0]) + + lisp_real(vars[1])); + + @} + else if (type == LISP_TYPE_PARSE_ERROR) + printf("parse error\n"); + lisp_free(obj); + + if (type == LISP_TYPE_EOF) + break; + @} + + return 0; +@} +@end example + +@node Function Index, , Example, Top +@comment node-name, next, previous, up +@unnumbered Function Index + +@printindex fn + +@contents +@bye diff --git a/lispreader/doc/version.texi b/lispreader/doc/version.texi new file mode 100644 index 0000000..6ecde16 --- /dev/null +++ b/lispreader/doc/version.texi @@ -0,0 +1,3 @@ +@set UPDATED 2 April 2005 +@set EDITION 0.5 +@set VERSION 0.5 diff --git a/lispreader/docexample.c b/lispreader/docexample.c new file mode 100644 index 0000000..25fc1eb --- /dev/null +++ b/lispreader/docexample.c @@ -0,0 +1,57 @@ +/* $Id: docexample.c 849 2005-04-02 17:35:44Z schani $ */ +/* + * docexample.c + * + * Copyright (C) 1999 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#include + +int +main (void) +{ + lisp_object_t *obj; + lisp_stream_t stream; + + lisp_stream_init_file(&stream, stdin); + + while (1) + { + int type; + + obj = lisp_read(&stream); + type = lisp_type(obj); + if (type != LISP_TYPE_EOF && type != LISP_TYPE_PARSE_ERROR) + { + lisp_object_t *vars[2]; + + if (lisp_match_string("(+ #?(number) #?(number))", + obj, vars)) + printf("%f\n", lisp_real(vars[0]) + + lisp_real(vars[1])); + } + else if (type == LISP_TYPE_PARSE_ERROR) + printf("parse error\n"); + lisp_free(obj); + + if (type == LISP_TYPE_EOF) + break; + } + + return 0; +} diff --git a/lispreader/lispcat.c b/lispreader/lispcat.c new file mode 100644 index 0000000..80e3afb --- /dev/null +++ b/lispreader/lispcat.c @@ -0,0 +1,104 @@ +/* + * lispcat.c + * + * Copyright (C) 2004 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#include +#include +#include + +#include +#include + +int +main (int argc, char *argv[]) +{ + lisp_object_t *obj; + lisp_stream_t stream; + pools_t pools; + allocator_t allocator; + int do_dump = 1; + char *filename = 0; + + assert(argc == 1 || argc == 2 || argc == 3); + + if (argc > 1 && strcmp(argv[1], "--null") == 0) + { + do_dump = 0; + if (argc > 2) + filename = argv[2]; + } + else + { + assert(argc < 3); + if (argc == 2) + filename = argv[1]; + } + + if (filename == 0) + { + if (lisp_stream_init_file(&stream, stdin) == 0) + { + fprintf(stderr, "could not init file stream\n"); + return 1; + } + } + else + { + if (lisp_stream_init_path(&stream, filename) == 0) + { + fprintf(stderr, "could not init path stream\n"); + return 1; + } + } + + init_pools(&pools); + init_pools_allocator(&allocator, &pools); + + for (;;) + { + reset_pools(&pools); + obj = lisp_read_with_allocator(&allocator, &stream); + + switch (lisp_type(obj)) + { + case LISP_TYPE_EOF : + goto done; + + case LISP_TYPE_PARSE_ERROR : + fprintf(stderr, "parse error\n"); + return 1; + + default : + if (do_dump) + { + lisp_dump(obj, stdout); + fputc('\n', stdout); + } + } + } + + done: + free_pools(&pools); + + if (filename != 0) + lisp_stream_free_path(&stream); + + return 0; +} diff --git a/lispreader/lispreader.c b/lispreader/lispreader.c new file mode 100644 index 0000000..033fb3e --- /dev/null +++ b/lispreader/lispreader.c @@ -0,0 +1,1202 @@ +/* + * lispreader.c + * + * Copyright (C) 1998-2008 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#include +#include +#ifndef __MINGW32__ +#include +#endif +#include +#include +#include +#include +#include +#include + +#include + +#include + +#define TOKEN_ERROR -1 +#define TOKEN_EOF 0 +#define TOKEN_OPEN_PAREN 1 +#define TOKEN_CLOSE_PAREN 2 +#define TOKEN_SYMBOL 3 +#define TOKEN_STRING 4 +#define TOKEN_INTEGER 5 +#define TOKEN_REAL 6 +#define TOKEN_PATTERN_OPEN_PAREN 7 +#define TOKEN_DOT 8 +#define TOKEN_TRUE 9 +#define TOKEN_FALSE 10 + +#define MAX_TOKEN_LENGTH 8192 + +static char token_string[MAX_TOKEN_LENGTH + 1] = ""; +static int token_length = 0; + +static char *mmap_token_start, *mmap_token_stop; + +static lisp_object_t end_marker = { LISP_TYPE_EOF }; +static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR }; +static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR }; +static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR }; + +static void +_token_clear (void) +{ + token_string[0] = '\0'; + token_length = 0; +} + +static void +_token_append (char c) +{ + assert(token_length < MAX_TOKEN_LENGTH); + + token_string[token_length++] = c; + token_string[token_length] = '\0'; +} + +static void +copy_mmapped_token (void) +{ + token_length = mmap_token_stop - mmap_token_start; + + assert(token_length < MAX_TOKEN_LENGTH); + + memcpy(token_string, mmap_token_start, token_length); + token_string[token_length] = '\0'; +} + +static int +_next_char (lisp_stream_t *stream) +{ + switch (stream->type) + { + case LISP_STREAM_MMAP_FILE : + case LISP_STREAM_STRING : + assert(0); + return EOF; + + case LISP_STREAM_FILE : + return getc(stream->v.file); + + case LISP_STREAM_ANY: + return stream->v.any.next_char(stream->v.any.data); + } + assert(0); + return EOF; +} + +static void +_unget_char (char c, lisp_stream_t *stream) +{ + switch (stream->type) + { + case LISP_STREAM_MMAP_FILE : + case LISP_STREAM_STRING : + assert(0); + break; + + case LISP_STREAM_FILE : + ungetc(c, stream->v.file); + break; + + case LISP_STREAM_ANY: + stream->v.any.unget_char(c, stream->v.any.data); + break; + + default : + assert(0); + } +} + +static int +my_atoi (const char *start, const char *stop) +{ + int value = 0; + + while (start < stop) + { + value = value * 10 + (*start - '0'); + ++start; + } + + return value; +} + +#define SCAN_FUNC_NAME _scan_mmap +#define SCAN_DECLS char *pos = stream->v.mmap.pos, *end = stream->v.mmap.end; +#define NEXT_CHAR (pos == end ? EOF : *pos++) +#define UNGET_CHAR(c) (--pos) +#define TOKEN_START(o) (mmap_token_start = pos - (o)) +#define TOKEN_APPEND(c) +#define TOKEN_STOP (mmap_token_stop = pos) +#define RETURN(t) ({ stream->v.mmap.pos = pos ; return (t); }) + +#include "lispscan.h" + +#undef SCAN_FUNC_NAME +#undef SCAN_DECLS +#undef NEXT_CHAR +#undef UNGET_CHAR +#undef TOKEN_START +#undef TOKEN_APPEND +#undef TOKEN_STOP +#undef RETURN + +#define SCAN_FUNC_NAME _scan +#define SCAN_DECLS +#define NEXT_CHAR _next_char(stream) +#define UNGET_CHAR(c) _unget_char((c), stream) +#define TOKEN_START(o) _token_clear() +#define TOKEN_APPEND(c) _token_append((c)) +#define TOKEN_STOP +#define RETURN(t) return (t) + +#include "lispscan.h" + +#undef SCAN_FUNC_NAME +#undef SCAN_DECLS +#undef NEXT_CHAR +#undef UNGET_CHAR +#undef TOKEN_START +#undef TOKEN_APPEND +#undef TOKEN_STOP +#undef RETURN + +#define IS_STREAM_MMAPPED(s) ((s)->type <= LISP_LAST_MMAPPED_STREAM) +#define SCAN(s) (IS_STREAM_MMAPPED((s)) ? _scan_mmap((s)) : _scan((s))) + +static lisp_object_t* +lisp_object_alloc (allocator_t *allocator, int type) +{ + lisp_object_t *obj = (lisp_object_t*)allocator_alloc(allocator, sizeof(lisp_object_t)); + + obj->type = type; + + return obj; +} + +lisp_stream_t* +lisp_stream_init_path (lisp_stream_t *stream, const char *path) +{ + int fd; + struct stat sb; + size_t len; + void *buf; + + fd = open(path, O_RDONLY, 0); + + if (fd == -1) + return 0; + + if (fstat(fd, &sb) == -1) + { + close(fd); + return 0; + } + + len = sb.st_size; + +#ifdef __MINGW32__ + buf = (void*)-1; +#else + buf = mmap(0, len, PROT_READ, MAP_SHARED, fd, 0); +#endif + + if (buf == (void*)-1) + { + FILE *file = fdopen(fd, "r"); + + if (file == 0) + { + close(fd); + + return 0; + } + else + return lisp_stream_init_file(stream, file); + } + else + { + close(fd); + + stream->type = LISP_STREAM_MMAP_FILE; + stream->v.mmap.buf = buf; + stream->v.mmap.pos = buf; + stream->v.mmap.end = buf + len; + } + + return stream; +} + +lisp_stream_t* +lisp_stream_init_file (lisp_stream_t *stream, FILE *file) +{ + stream->type = LISP_STREAM_FILE; + stream->v.file = file; + + return stream; +} + +lisp_stream_t* +lisp_stream_init_string (lisp_stream_t *stream, char *buf) +{ + stream->type = LISP_STREAM_STRING; + stream->v.mmap.buf = buf; + stream->v.mmap.end = buf + strlen(buf); + stream->v.mmap.pos = buf; + + return stream; +} + +lisp_stream_t* +lisp_stream_init_any (lisp_stream_t *stream, void *data, + int (*next_char) (void *data), + void (*unget_char) (char c, void *data)) +{ + assert(next_char != 0 && unget_char != 0); + + stream->type = LISP_STREAM_ANY; + stream->v.any.data = data; + stream->v.any.next_char= next_char; + stream->v.any.unget_char = unget_char; + + return stream; +} + +void +lisp_stream_free_path (lisp_stream_t *stream) +{ + assert(stream->type == LISP_STREAM_MMAP_FILE + || stream->type == LISP_STREAM_FILE); + +#ifndef __MINGW32__ + if (stream->type == LISP_STREAM_MMAP_FILE) + munmap(stream->v.mmap.buf, stream->v.mmap.end - stream->v.mmap.buf); + else +#endif + fclose(stream->v.file); +} + +lisp_object_t* +lisp_make_integer_with_allocator (allocator_t *allocator, int value) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_INTEGER); + + obj->v.integer = value; + + return obj; +} + +lisp_object_t* +lisp_make_real_with_allocator (allocator_t *allocator, float value) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_REAL); + + obj->v.real = value; + + return obj; +} + +static lisp_object_t* +lisp_make_symbol_with_allocator_internal (allocator_t *allocator, const char *str, size_t len) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_SYMBOL); + + obj->v.string = allocator_alloc(allocator, len + 1); + memcpy(obj->v.string, str, len + 1); + obj->v.string[len] = '\0'; + + return obj; +} + +lisp_object_t* +lisp_make_symbol_with_allocator (allocator_t *allocator, const char *value) +{ + return lisp_make_symbol_with_allocator_internal(allocator, value, strlen(value)); +} + +lisp_object_t* +lisp_make_string_with_allocator (allocator_t *allocator, const char *value) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_STRING); + + obj->v.string = allocator_strdup(allocator, value); + + return obj; +} + +lisp_object_t* +lisp_make_cons_with_allocator (allocator_t *allocator, lisp_object_t *car, lisp_object_t *cdr) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_CONS); + + obj->v.cons.car = car; + obj->v.cons.cdr = cdr; + + return obj; +} + +lisp_object_t* +lisp_make_boolean_with_allocator (allocator_t *allocator, int value) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_BOOLEAN); + + obj->v.integer = value ? 1 : 0; + + return obj; +} + +lisp_object_t* +lisp_make_integer (int value) +{ + return lisp_make_integer_with_allocator(&malloc_allocator, value); +} + +lisp_object_t* +lisp_make_real (float value) +{ + return lisp_make_real_with_allocator(&malloc_allocator, value); +} + +lisp_object_t* +lisp_make_symbol (const char *value) +{ + return lisp_make_symbol_with_allocator(&malloc_allocator, value); +} + +lisp_object_t* +lisp_make_string (const char *value) +{ + return lisp_make_string_with_allocator(&malloc_allocator, value); +} + +lisp_object_t* +lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr) +{ + return lisp_make_cons_with_allocator(&malloc_allocator, car, cdr); +} + +lisp_object_t* +lisp_make_boolean (int value) +{ + return lisp_make_boolean_with_allocator(&malloc_allocator, value); +} + +static lisp_object_t* +lisp_make_pattern_cons_with_allocator (allocator_t *allocator, lisp_object_t *car, lisp_object_t *cdr) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_PATTERN_CONS); + + obj->v.cons.car = car; + obj->v.cons.cdr = cdr; + + return obj; +} + +static lisp_object_t* +lisp_make_pattern_var_with_allocator (allocator_t *allocator, int type, int index, lisp_object_t *sub) +{ + lisp_object_t *obj = lisp_object_alloc(allocator, LISP_TYPE_PATTERN_VAR); + + obj->v.pattern.type = type; + obj->v.pattern.index = index; + obj->v.pattern.sub = sub; + + return obj; +} + +lisp_object_t* +lisp_read_with_allocator (allocator_t *allocator, lisp_stream_t *in) +{ + int token = SCAN(in); + lisp_object_t *obj = lisp_nil(); + + if (token == TOKEN_EOF) + return &end_marker; + + switch (token) + { + case TOKEN_ERROR : + return &error_object; + + case TOKEN_EOF : + return &end_marker; + + case TOKEN_OPEN_PAREN : + case TOKEN_PATTERN_OPEN_PAREN : + { + lisp_object_t *last = lisp_nil(), *car; + + do + { + car = lisp_read_with_allocator(allocator, in); + if (car == &error_object || car == &end_marker) + { + lisp_free_with_allocator(allocator, obj); + return &error_object; + } + else if (car == &dot_marker) + { + if (lisp_nil_p(last)) + { + lisp_free_with_allocator(allocator, obj); + return &error_object; + } + + car = lisp_read_with_allocator(allocator, in); + if (car == &error_object || car == &end_marker) + { + lisp_free_with_allocator(allocator, obj); + return car; + } + else + { + last->v.cons.cdr = car; + + if (SCAN(in) != TOKEN_CLOSE_PAREN) + { + lisp_free_with_allocator(allocator, obj); + return &error_object; + } + + car = &close_paren_marker; + } + } + else if (car != &close_paren_marker) + { + if (lisp_nil_p(last)) + obj = last = (token == TOKEN_OPEN_PAREN + ? lisp_make_cons_with_allocator(allocator, car, lisp_nil()) + : lisp_make_pattern_cons_with_allocator(allocator, car, lisp_nil())); + else + last = last->v.cons.cdr = lisp_make_cons_with_allocator(allocator, car, lisp_nil()); + } + } while (car != &close_paren_marker); + } + return obj; + + case TOKEN_CLOSE_PAREN : + return &close_paren_marker; + + case TOKEN_SYMBOL : + if (IS_STREAM_MMAPPED(in)) + return lisp_make_symbol_with_allocator_internal(allocator, mmap_token_start, + mmap_token_stop - mmap_token_start); + else + return lisp_make_symbol_with_allocator(allocator, token_string); + + case TOKEN_STRING : + return lisp_make_string_with_allocator(allocator, token_string); + + case TOKEN_INTEGER : + if (IS_STREAM_MMAPPED(in)) + return lisp_make_integer_with_allocator(allocator, my_atoi(mmap_token_start, mmap_token_stop)); + else + return lisp_make_integer_with_allocator(allocator, atoi(token_string)); + + case TOKEN_REAL : + if (IS_STREAM_MMAPPED(in)) + copy_mmapped_token(); + return lisp_make_real_with_allocator(allocator, (float)g_ascii_strtod(token_string, NULL)); + + case TOKEN_DOT : + return &dot_marker; + + case TOKEN_TRUE : + return lisp_make_boolean_with_allocator(allocator, 1); + + case TOKEN_FALSE : + return lisp_make_boolean_with_allocator(allocator, 0); + } + + assert(0); + return &error_object; +} + +lisp_object_t* +lisp_read (lisp_stream_t *in) +{ + return lisp_read_with_allocator(&malloc_allocator, in); +} + +void +lisp_free_with_allocator (allocator_t *allocator, lisp_object_t *obj) +{ + restart: + + if (obj == 0) + return; + + switch (obj->type) + { + case LISP_TYPE_INTERNAL : + case LISP_TYPE_PARSE_ERROR : + case LISP_TYPE_EOF : + return; + + case LISP_TYPE_SYMBOL : + case LISP_TYPE_STRING : + allocator_free(allocator, obj->v.string); + break; + + case LISP_TYPE_CONS : + case LISP_TYPE_PATTERN_CONS : + /* If we just recursively free car and cdr we risk a stack + overflow because lists may be nested arbitrarily deep. + + We can get rid of one recursive call with a tail call, + but there's still one remaining. + + The solution is to flatten a recursive list until we + can free the car without recursion. Then we free the + cdr with a tail call. + + The transformation we perform on the list is this: + + ((a . b) . c) -> (a . (b . c)) + */ + if (!lisp_nil_p(obj->v.cons.car) + && (lisp_type(obj->v.cons.car) == LISP_TYPE_CONS + || lisp_type(obj->v.cons.car) == LISP_TYPE_PATTERN_CONS)) + { + /* this is the transformation */ + + lisp_object_t *car, *cdar; + + car = obj->v.cons.car; + cdar = car->v.cons.cdr; + + car->v.cons.cdr = obj; + + obj->v.cons.car = cdar; + + obj = car; + + goto restart; + } + else + { + /* here we just free the car (which is not recursive), + the cons itself and the cdr via a tail call. */ + + lisp_object_t *tmp; + + lisp_free_with_allocator(allocator, obj->v.cons.car); + + tmp = obj; + obj = obj->v.cons.cdr; + + allocator_free(allocator, tmp); + + goto restart; + } + + case LISP_TYPE_PATTERN_VAR : + lisp_free_with_allocator(allocator, obj->v.pattern.sub); + break; + } + + allocator_free(allocator, obj); +} + +void +lisp_free (lisp_object_t *obj) +{ + lisp_free_with_allocator(&malloc_allocator, obj); +} + +lisp_object_t* +lisp_read_from_string_with_allocator (allocator_t *allocator, const char *buf) +{ + lisp_stream_t stream; + + lisp_stream_init_string(&stream, (char*)buf); + return lisp_read_with_allocator(allocator, &stream); +} + +lisp_object_t* +lisp_read_from_string (const char *buf) +{ + return lisp_read_from_string_with_allocator(&malloc_allocator, buf); +} + +static int +_compile_pattern (lisp_object_t **obj, int *index) +{ + if (*obj == 0) + return 1; + + switch (lisp_type(*obj)) + { + case LISP_TYPE_PATTERN_CONS : + { + struct { char *name; int type; } types[] = + { + { "any", LISP_PATTERN_ANY }, + { "symbol", LISP_PATTERN_SYMBOL }, + { "string", LISP_PATTERN_STRING }, + { "integer", LISP_PATTERN_INTEGER }, + { "real", LISP_PATTERN_REAL }, + { "boolean", LISP_PATTERN_BOOLEAN }, + { "list", LISP_PATTERN_LIST }, + { "or", LISP_PATTERN_OR }, + { "number", LISP_PATTERN_NUMBER }, + { 0, 0 } + }; + char *type_name; + int type = 0; /* makes gcc happy */ + int i; + lisp_object_t *pattern; + + if (lisp_type(lisp_car(*obj)) != LISP_TYPE_SYMBOL) + return 0; + + type_name = lisp_symbol(lisp_car(*obj)); + for (i = 0; types[i].name != 0; ++i) + { + if (strcmp(types[i].name, type_name) == 0) + { + type = types[i].type; + break; + } + } + + if (types[i].name == 0) + return 0; + + if (type != LISP_PATTERN_OR && lisp_cdr(*obj) != 0) + return 0; + + pattern = lisp_make_pattern_var_with_allocator(&malloc_allocator, type, (*index)++, lisp_nil()); + + if (type == LISP_PATTERN_OR) + { + lisp_object_t *cdr = lisp_cdr(*obj); + + if (!_compile_pattern(&cdr, index)) + { + lisp_free(pattern); + return 0; + } + + pattern->v.pattern.sub = cdr; + + (*obj)->v.cons.cdr = lisp_nil(); + } + + lisp_free(*obj); + + *obj = pattern; + } + break; + + case LISP_TYPE_CONS : + if (!_compile_pattern(&(*obj)->v.cons.car, index)) + return 0; + if (!_compile_pattern(&(*obj)->v.cons.cdr, index)) + return 0; + break; + } + + return 1; +} + +int +lisp_compile_pattern (lisp_object_t **obj, int *num_subs) +{ + int index = 0; + int result; + + result = _compile_pattern(obj, &index); + + if (result && num_subs != 0) + *num_subs = index; + + return result; +} + +static int _match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars); + +static int +_match_pattern_var (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars) +{ + assert(lisp_type(pattern) == LISP_TYPE_PATTERN_VAR); + + switch (pattern->v.pattern.type) + { + case LISP_PATTERN_ANY : + break; + + case LISP_PATTERN_SYMBOL : + if (lisp_type(obj) != LISP_TYPE_SYMBOL) + return 0; + break; + + case LISP_PATTERN_STRING : + if (lisp_type(obj) != LISP_TYPE_STRING) + return 0; + break; + + case LISP_PATTERN_INTEGER : + if (lisp_type(obj) != LISP_TYPE_INTEGER) + return 0; + break; + + case LISP_PATTERN_REAL : + if (lisp_type(obj) != LISP_TYPE_REAL) + return 0; + break; + + case LISP_PATTERN_BOOLEAN : + if (lisp_type(obj) != LISP_TYPE_BOOLEAN) + return 0; + break; + + case LISP_PATTERN_LIST : + if (lisp_type(obj) != LISP_TYPE_CONS + && lisp_type(obj) != LISP_TYPE_NIL) + return 0; + break; + + case LISP_PATTERN_OR : + { + lisp_object_t *sub; + int matched = 0; + + for (sub = pattern->v.pattern.sub; sub != 0; sub = lisp_cdr(sub)) + { + assert(lisp_type(sub) == LISP_TYPE_CONS); + + if (_match_pattern(lisp_car(sub), obj, vars)) + matched = 1; + } + + if (!matched) + return 0; + } + break; + + case LISP_PATTERN_NUMBER : + if (lisp_type(obj) != LISP_TYPE_INTEGER + && lisp_type(obj) != LISP_TYPE_REAL) + return 0; + break; + + default : + assert(0); + } + + if (vars != 0) + vars[pattern->v.pattern.index] = obj; + + return 1; +} + +static int +_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars) +{ + if (pattern == 0) + return obj == 0; + + if (lisp_type(pattern) == LISP_TYPE_PATTERN_VAR) + return _match_pattern_var(pattern, obj, vars); + + if (lisp_type(pattern) != lisp_type(obj)) + return 0; + + switch (lisp_type(pattern)) + { + case LISP_TYPE_SYMBOL : + return strcmp(lisp_symbol(pattern), lisp_symbol(obj)) == 0; + + case LISP_TYPE_STRING : + return strcmp(lisp_string(pattern), lisp_string(obj)) == 0; + + case LISP_TYPE_INTEGER : + return lisp_integer(pattern) == lisp_integer(obj); + + case LISP_TYPE_REAL : + return lisp_real(pattern) == lisp_real(obj); + + case LISP_TYPE_CONS : + { + int result1, result2; + + result1 = _match_pattern(lisp_car(pattern), lisp_car(obj), vars); + result2 = _match_pattern(lisp_cdr(pattern), lisp_cdr(obj), vars); + + return result1 && result2; + } + break; + + default : + assert(0); + } + + return 0; +} + +int +lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs) +{ + int i; + + if (vars != 0) + for (i = 0; i < num_subs; ++i) + vars[i] = &error_object; + + return _match_pattern(pattern, obj, vars); +} + +int +lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars) +{ + lisp_object_t *pattern; + int result; + int num_subs; + + pattern = lisp_read_from_string(pattern_string); + + if (pattern != 0 && (lisp_type(pattern) == LISP_TYPE_EOF + || lisp_type(pattern) == LISP_TYPE_PARSE_ERROR)) + return 0; + + if (!lisp_compile_pattern(&pattern, &num_subs)) + { + lisp_free(pattern); + return 0; + } + + result = lisp_match_pattern(pattern, obj, vars, num_subs); + + lisp_free(pattern); + + return result; +} + +int +lisp_type (lisp_object_t *obj) +{ + if (obj == 0) + return LISP_TYPE_NIL; + return obj->type; +} + +int +lisp_integer (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_INTEGER); + + return obj->v.integer; +} + +char* +lisp_symbol (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_SYMBOL); + + return obj->v.string; +} + +char* +lisp_string (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_STRING); + + return obj->v.string; +} + +int +lisp_boolean (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_BOOLEAN); + + return obj->v.integer; +} + +float +lisp_real (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER); + + if (obj->type == LISP_TYPE_INTEGER) + return obj->v.integer; + return obj->v.real; +} + +lisp_object_t* +lisp_car (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + + return obj->v.cons.car; +} + +lisp_object_t* +lisp_cdr (lisp_object_t *obj) +{ + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + + return obj->v.cons.cdr; +} + +lisp_object_t* +lisp_cxr (lisp_object_t *obj, const char *x) +{ + int i; + + for (i = strlen(x) - 1; i >= 0; --i) + if (x[i] == 'a') + obj = lisp_car(obj); + else if (x[i] == 'd') + obj = lisp_cdr(obj); + else + assert(0); + + return obj; +} + +int +lisp_list_length (lisp_object_t *obj) +{ + int length = 0; + + while (obj != 0) + { + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + + ++length; + obj = obj->v.cons.cdr; + } + + return length; +} + +lisp_object_t* +lisp_list_nth_cdr (lisp_object_t *obj, int index) +{ + while (index > 0) + { + assert(obj != 0); + assert(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS); + + --index; + obj = obj->v.cons.cdr; + } + + return obj; +} + +lisp_object_t* +lisp_list_nth (lisp_object_t *obj, int index) +{ + obj = lisp_list_nth_cdr(obj, index); + + assert(obj != 0); + + return obj->v.cons.car; +} + +int +lisp_print_nil (FILE *out) +{ + if (fputs("()", out) == EOF) + return 0; + return 1; +} + +int +lisp_print_open_paren (FILE *out) +{ + if (fputc('(', out) == EOF) + return 0; + return 1; +} + +int +lisp_print_close_paren (FILE *out) +{ + if (fputc(')', out) == EOF) + return 0; + return 1; +} + +int +lisp_print_dot (FILE *out) +{ + if (fputs(". ", out) == EOF) + return 0; + return 1; +} + +int +lisp_print_integer (int integer, FILE *out) +{ + if (fprintf(out, "%d ", integer) < 0) + return 0; + return 1; +} + +int +lisp_print_real (float real, FILE *out) +{ + char buf[G_ASCII_DTOSTR_BUF_SIZE]; + + g_ascii_formatd(buf, G_ASCII_DTOSTR_BUF_SIZE, "%f", real); + + if (fprintf(out, "%s ", buf) < 0) + return 0; + return 1; +} + +int +lisp_print_symbol (const char *symbol, FILE *out) +{ + if (fprintf(out, "%s ", symbol) < 0) + return 0; + return 1; +} + +int +lisp_print_string (const char *string, FILE *out) +{ + const char *p; + + if (fputc('"', out) == EOF) + return 0; + + for (p = string; *p != 0; ++p) + { + if (*p == '"' || *p == '\\') + { + if (fputc('\\', out) == EOF) + return 0; + } + + if (fputc(*p, out) == EOF) + return 0; + } + + if (fputs("\" ", out) == EOF) + return 0; + return 1; +} + +int +lisp_print_boolean (int boolean, FILE *out) +{ + if (fprintf(out, "#%c ", boolean ? 't' : 'f') < 0) + return 0; + return 1; +} + +void +lisp_dump (lisp_object_t *obj, FILE *out) +{ + if (obj == 0) + { + lisp_print_nil(out); + return; + } + + switch (lisp_type(obj)) + { + case LISP_TYPE_EOF : + fputs("#", out); + break; + + case LISP_TYPE_PARSE_ERROR : + fputs("#", out); + break; + + case LISP_TYPE_INTEGER : + lisp_print_integer(lisp_integer(obj), out); + break; + + case LISP_TYPE_REAL : + lisp_print_real(lisp_real(obj), out); + break; + + case LISP_TYPE_SYMBOL : + lisp_print_symbol(lisp_symbol(obj), out); + break; + + case LISP_TYPE_STRING : + lisp_print_string(lisp_string(obj), out); + break; + + case LISP_TYPE_CONS : + case LISP_TYPE_PATTERN_CONS : + if (lisp_type(obj) == LISP_TYPE_CONS) + lisp_print_open_paren(out); + else + fputs("#?(", out); + while (obj != 0) + { + lisp_dump(lisp_car(obj), out); + obj = lisp_cdr(obj); + if (obj != 0) + { + if (lisp_type(obj) != LISP_TYPE_CONS + && lisp_type(obj) != LISP_TYPE_PATTERN_CONS) + { + lisp_print_dot(out); + lisp_dump(obj, out); + break; + } + } + } + lisp_print_close_paren(out); + break; + + case LISP_TYPE_BOOLEAN : + lisp_print_boolean(lisp_boolean(obj), out); + break; + + default : + assert(0); + } +} + +lisp_object_t* +lisp_proplist_lookup_symbol (lisp_object_t *list, const char *key) +{ + while (lisp_cons_p(list)) + { + if (lisp_symbol_p(lisp_car(list)) && strcmp(key, lisp_symbol(lisp_car(list))) == 0) + { + if (lisp_cons_p(lisp_cdr(list))) + return lisp_car(lisp_cdr(list)); + return lisp_nil(); + } + + if (lisp_cons_p(lisp_cdr(list))) + list = lisp_cdr(lisp_cdr(list)); + else + return lisp_nil(); + } + + return lisp_nil(); +} diff --git a/lispreader/lispreader.h b/lispreader/lispreader.h new file mode 100644 index 0000000..f082a66 --- /dev/null +++ b/lispreader/lispreader.h @@ -0,0 +1,183 @@ +/* + * lispreader.h + * + * Copyright (C) 1998-2008 Mark Probst + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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 + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public + * License along with this library; if not, write to the + * Free Software Foundation, Inc., 59 Temple Place - Suite 330, + * Boston, MA 02111-1307, USA. + */ + +#ifndef __LISPREADER_H__ +#define __LISPREADER_H__ + +#include + +#include "allocator.h" + +#define LISP_STREAM_MMAP_FILE 1 +#define LISP_STREAM_STRING 2 +#define LISP_STREAM_FILE 3 +#define LISP_STREAM_ANY 4 + +#define LISP_LAST_MMAPPED_STREAM LISP_STREAM_STRING + +#define LISP_TYPE_INTERNAL -3 +#define LISP_TYPE_PARSE_ERROR -2 +#define LISP_TYPE_EOF -1 +#define LISP_TYPE_NIL 0 +#define LISP_TYPE_SYMBOL 1 +#define LISP_TYPE_INTEGER 2 +#define LISP_TYPE_STRING 3 +#define LISP_TYPE_REAL 4 +#define LISP_TYPE_CONS 5 +#define LISP_TYPE_PATTERN_CONS 6 +#define LISP_TYPE_BOOLEAN 7 +#define LISP_TYPE_PATTERN_VAR 8 + +#define LISP_PATTERN_ANY 1 +#define LISP_PATTERN_SYMBOL 2 +#define LISP_PATTERN_STRING 3 +#define LISP_PATTERN_INTEGER 4 +#define LISP_PATTERN_REAL 5 +#define LISP_PATTERN_BOOLEAN 6 +#define LISP_PATTERN_LIST 7 +#define LISP_PATTERN_OR 8 +#define LISP_PATTERN_NUMBER 9 + +typedef struct +{ + int type; + + union + { + FILE *file; + struct + { + char *buf; + char *end; + char *pos; + } mmap; + struct + { + void *data; + int (*next_char) (void *data); + void (*unget_char) (char c, void *data); + } any; + } v; +} lisp_stream_t; + +typedef struct _lisp_object_t lisp_object_t; +struct _lisp_object_t +{ + int type; + + union + { + struct + { + struct _lisp_object_t *car; + struct _lisp_object_t *cdr; + } cons; + + char *string; + int integer; + float real; + + struct + { + int type; + int index; + struct _lisp_object_t *sub; + } pattern; + } v; +}; + +lisp_stream_t* lisp_stream_init_path (lisp_stream_t *stream, const char *path); +lisp_stream_t* lisp_stream_init_file (lisp_stream_t *stream, FILE *file); +lisp_stream_t* lisp_stream_init_string (lisp_stream_t *stream, char *buf); +lisp_stream_t* lisp_stream_init_any (lisp_stream_t *stream, void *data, + int (*next_char) (void *data), + void (*unget_char) (char c, void *data)); + +void lisp_stream_free_path (lisp_stream_t *stream); + +lisp_object_t* lisp_read_with_allocator (allocator_t *allocator, lisp_stream_t *in); +lisp_object_t* lisp_read (lisp_stream_t *in); + +void lisp_free_with_allocator (allocator_t *allocator, lisp_object_t *obj); +void lisp_free (lisp_object_t *obj); + +lisp_object_t* lisp_read_from_string_with_allocator (allocator_t *allocator, const char *buf); +lisp_object_t* lisp_read_from_string (const char *buf); + +int lisp_compile_pattern (lisp_object_t **obj, int *num_subs); +int lisp_match_pattern (lisp_object_t *pattern, lisp_object_t *obj, lisp_object_t **vars, int num_subs); +int lisp_match_string (const char *pattern_string, lisp_object_t *obj, lisp_object_t **vars); + +int lisp_type (lisp_object_t *obj); +int lisp_integer (lisp_object_t *obj); +float lisp_real (lisp_object_t *obj); +char* lisp_symbol (lisp_object_t *obj); +char* lisp_string (lisp_object_t *obj); +int lisp_boolean (lisp_object_t *obj); +lisp_object_t* lisp_car (lisp_object_t *obj); +lisp_object_t* lisp_cdr (lisp_object_t *obj); + +lisp_object_t* lisp_cxr (lisp_object_t *obj, const char *x); + +lisp_object_t* lisp_make_integer_with_allocator (allocator_t *allocator, int value); +lisp_object_t* lisp_make_real_with_allocator (allocator_t *allocator, float value); +lisp_object_t* lisp_make_symbol_with_allocator (allocator_t *allocator, const char *value); +lisp_object_t* lisp_make_string_with_allocator (allocator_t *allocator, const char *value); +lisp_object_t* lisp_make_cons_with_allocator (allocator_t *allocator, lisp_object_t *car, lisp_object_t *cdr); +lisp_object_t* lisp_make_boolean_with_allocator (allocator_t *allocator, int value); + +lisp_object_t* lisp_make_integer (int value); +lisp_object_t* lisp_make_real (float value); +lisp_object_t* lisp_make_symbol (const char *value); +lisp_object_t* lisp_make_string (const char *value); +lisp_object_t* lisp_make_cons (lisp_object_t *car, lisp_object_t *cdr); +lisp_object_t* lisp_make_boolean (int value); + +int lisp_list_length (lisp_object_t *obj); +lisp_object_t* lisp_list_nth_cdr (lisp_object_t *obj, int index); +lisp_object_t* lisp_list_nth (lisp_object_t *obj, int index); + +int lisp_print_nil (FILE *out); +int lisp_print_open_paren (FILE *out); +int lisp_print_close_paren (FILE *out); +int lisp_print_dot (FILE *out); +int lisp_print_integer (int integer, FILE *out); +int lisp_print_real (float real, FILE *out); +int lisp_print_symbol (const char *symbol, FILE *out); +int lisp_print_string (const char *string, FILE *out); +int lisp_print_boolean (int boolean, FILE *out); + +void lisp_dump (lisp_object_t *obj, FILE *out); + +lisp_object_t* lisp_proplist_lookup_symbol (lisp_object_t *list, const char *key); + +#define lisp_nil() ((lisp_object_t*)0) + +#define lisp_nil_p(obj) (obj == 0) +#define lisp_integer_p(obj) (lisp_type((obj)) == LISP_TYPE_INTEGER) +#define lisp_real_p(obj) (lisp_type((obj)) == LISP_TYPE_REAL) +#define lisp_number_p(obj) (lisp_integer_p((obj)) || lisp_real_p((obj))) +#define lisp_symbol_p(obj) (lisp_type((obj)) == LISP_TYPE_SYMBOL) +#define lisp_string_p(obj) (lisp_type((obj)) == LISP_TYPE_STRING) +#define lisp_cons_p(obj) (lisp_type((obj)) == LISP_TYPE_CONS) +#define lisp_boolean_p(obj) (lisp_type((obj)) == LISP_TYPE_BOOLEAN) + +#endif diff --git a/lispreader/lispscan.h b/lispreader/lispscan.h new file mode 100644 index 0000000..8e5fda8 --- /dev/null +++ b/lispreader/lispscan.h @@ -0,0 +1,162 @@ +static int +SCAN_FUNC_NAME (lisp_stream_t *stream) +{ + static char *delims = "\"();"; + + SCAN_DECLS + + int c; + + do + { + c = NEXT_CHAR; + if (c == EOF) + RETURN(TOKEN_EOF); + else if (c == ';') /* comment start */ + while (1) + { + c = NEXT_CHAR; + if (c == EOF) + RETURN(TOKEN_EOF); + else if (c == '\n') + break; + } + } while (isspace(c)); + + switch (c) + { + case '(' : + RETURN(TOKEN_OPEN_PAREN); + + case ')' : + RETURN(TOKEN_CLOSE_PAREN); + + case '"' : + _token_clear(); + while (1) + { + c = NEXT_CHAR; + if (c == EOF) + RETURN(TOKEN_ERROR); + if (c == '"') + break; + if (c == '\\') + { + c = NEXT_CHAR; + + switch (c) + { + case EOF : + RETURN(TOKEN_ERROR); + + case 'n' : + c = '\n'; + break; + + case 't' : + c = '\t'; + break; + } + } + + _token_append(c); + } + RETURN(TOKEN_STRING); + + case '#' : + c = NEXT_CHAR; + if (c == EOF) + RETURN(TOKEN_ERROR); + + switch (c) + { + case 't' : + RETURN(TOKEN_TRUE); + + case 'f' : + RETURN(TOKEN_FALSE); + + case '?' : + c = NEXT_CHAR; + if (c == EOF) + RETURN(TOKEN_ERROR); + + if (c == '(') + RETURN(TOKEN_PATTERN_OPEN_PAREN); + else + RETURN(TOKEN_ERROR); + } + RETURN(TOKEN_ERROR); + + default : + if (isdigit(c) || c == '-') + { + int have_nondigits = 0; + int have_digits = 0; + int have_floating_point = 0; + + TOKEN_START(1); + + do + { + if (isdigit(c)) + have_digits = 1; + else if (c == '.') + have_floating_point++; + TOKEN_APPEND(c); + + c = NEXT_CHAR; + + if (c != EOF && !isdigit(c) && !isspace(c) && c != '.' && !strchr(delims, c)) + have_nondigits = 1; + } while (c != EOF && !isspace(c) && !strchr(delims, c)); + + if (c != EOF) + UNGET_CHAR(c); + + TOKEN_STOP; + + if (have_nondigits || !have_digits || have_floating_point > 1) + RETURN(TOKEN_SYMBOL); + else if (have_floating_point == 1) + RETURN(TOKEN_REAL); + else + RETURN(TOKEN_INTEGER); + } + else + { + if (c == '.') + { + c = NEXT_CHAR; + if (c != EOF && !isspace(c) && !strchr(delims, c)) + { + TOKEN_START(2); + TOKEN_APPEND('.'); + } + else + { + UNGET_CHAR(c); + RETURN(TOKEN_DOT); + } + } + else + { + TOKEN_START(1); + } + do + { + TOKEN_APPEND(c); + c = NEXT_CHAR; + } while (c != EOF && !isspace(c) && !strchr(delims, c)); + if (c != EOF) + UNGET_CHAR(c); + + TOKEN_STOP; + + RETURN(TOKEN_SYMBOL); + } + } + + assert(0); + RETURN(TOKEN_ERROR); +} diff --git a/lispreader/lisptest.c b/lispreader/lisptest.c new file mode 100644 index 0000000..e089a86 --- /dev/null +++ b/lispreader/lisptest.c @@ -0,0 +1,72 @@ +/* $Id: lisptest.c 191 2004-07-02 21:20:49Z schani $ */ + +#include "lispreader.h" + +static lisp_object_t* +make_fib_tree (int n) +{ + if (n < 2) + return lisp_nil(); + + return lisp_make_cons(make_fib_tree(n - 1), make_fib_tree(n - 2)); +} + +static void +free_test (void) +{ + int i; + + for (i = 0; i < 50; ++i) + { + lisp_object_t *obj = make_fib_tree(25); + + lisp_free(obj); + } +} + +int +main (void) +{ + lisp_object_t *obj; + lisp_stream_t stream; + + lisp_dump(make_fib_tree(5), stdout); + printf("\n"); + + free_test(); + + lisp_stream_init_file(&stream, stdin); + + while (1) + { + obj = lisp_read(&stream); + if (obj == 0 || lisp_type(obj) != LISP_TYPE_EOF) + { + lisp_object_t *vars[5]; + + lisp_dump(obj, stdout); + fprintf(stdout, "\n"); + + if (lisp_match_string("(beidel #?(or (heusl #?(integer)) #?(string)) #?(boolean) . #?(list))", + obj, vars)) + { + lisp_dump(vars[0], stdout); + fprintf(stdout, "\n"); + lisp_dump(vars[1], stdout); + fprintf(stdout, "\n"); + lisp_dump(vars[2], stdout); + fprintf(stdout, "\n"); + lisp_dump(vars[3], stdout); + fprintf(stdout, "\n"); + lisp_dump(vars[4], stdout); + fprintf(stdout, "\n"); + } + + lisp_free(obj); + } + else + break; + } + + return 0; +} diff --git a/lispreader/pools.c b/lispreader/pools.c new file mode 100644 index 0000000..26866de --- /dev/null +++ b/lispreader/pools.c @@ -0,0 +1,119 @@ +/* + * pools.c + * + * lispreader + * + * Copyright (C) 2002-2007 Mark Probst + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +#include +#include +#include + +#include "pools.h" + +int +init_pools (pools_t *pools) +{ + int i; + + pools->active_pool = 0; + pools->fill_ptr = 0; + + for (i = 0; i < NUM_POOLS; ++i) + pools->pools[i] = 0; + + pools->pools[0] = (long*)malloc(GRANULARITY * FIRST_POOL_SIZE); + if (pools->pools[0] == 0) + return 0; + + memset(pools->pools[0], 0, GRANULARITY * FIRST_POOL_SIZE); + + return 1; +} + +#ifndef __GNUC__ +void +reset_pools (pools_t *pools) +{ + pools->active_pool = 0; + pools->fill_ptr = 0; +} +#endif + +void +free_pools (pools_t *pools) +{ + int i; + + /* printf("alloced %d pools\n", active_pool + 1); */ + for (i = 0; i < NUM_POOLS; ++i) + if (pools->pools[i] != 0) + free(pools->pools[i]); +} + +#ifdef __GNUC__ +void* +_pools_alloc (pools_t *pools, size_t byte_size) +#else +void* +pools_alloc (pools_t *pools, size_t byte_size) +#endif +{ + size_t pool_size, size; + void *p; + + pool_size = FIRST_POOL_SIZE << pools->active_pool; + size = (byte_size + GRANULARITY - 1) / GRANULARITY; + + while (pools->fill_ptr + size >= pool_size) + { + size_t new_pool_size; + + ++pools->active_pool; + assert(pools->active_pool < NUM_POOLS); + + pools->fill_ptr = 0; + + new_pool_size = FIRST_POOL_SIZE << pools->active_pool; + /* TODO: if the requested block is too big to fit into the + pool to be allocated, it should simply be skipped, which + would save memory. */ + if (pools->pools[pools->active_pool] == 0) + { + size_t new_pool_byte_size = GRANULARITY * new_pool_size; + + /* printf("allocing pool %d with size %ld\n", pools->active_pool, (long)new_pool_byte_size); */ + + pools->pools[pools->active_pool] = (long*)malloc(new_pool_byte_size); + if (pools->pools[pools->active_pool] == 0) + return 0; + /* FIXME: either remove the memset here or memset the pool + even if it's not newly allocated, because pools can be + reset. */ + memset(pools->pools[pools->active_pool], 0, new_pool_byte_size); + } + pool_size = new_pool_size; + } + + assert(pools->fill_ptr + size < pool_size); + + p = pools->pools[pools->active_pool] + pools->fill_ptr; + pools->fill_ptr += size; + + return p; +} diff --git a/lispreader/pools.h b/lispreader/pools.h new file mode 100644 index 0000000..cb066b7 --- /dev/null +++ b/lispreader/pools.h @@ -0,0 +1,75 @@ +/* + * pools.h + * + * lispreader + * + * Copyright (C) 2002-2007 Mark Probst + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +#ifndef __POOLS_H__ +#define __POOLS_H__ + +#include + +/* these settings allow a pools to grow to up to 16 GB (last pool 8GB) */ +#define GRANULARITY sizeof(long) +#define FIRST_POOL_SIZE ((size_t)2048) +#define NUM_POOLS 20 + +typedef struct +{ + int active_pool; + size_t fill_ptr; + long *pools[NUM_POOLS]; +} pools_t; + +int init_pools (pools_t *pools); +void free_pools (pools_t *pools); + +#ifdef __GNUC__ +void* _pools_alloc (pools_t *pools, size_t size); + +static inline void* +pools_alloc (pools_t *pools, size_t size) +{ + void *p; + size_t padded_size = (size + GRANULARITY - 1) / GRANULARITY; + + if (pools->fill_ptr + padded_size >= (FIRST_POOL_SIZE << pools->active_pool)) + return _pools_alloc(pools, size); + + p = pools->pools[pools->active_pool] + pools->fill_ptr; + pools->fill_ptr += padded_size; + + return p; +} +#else +void* pools_alloc (pools_t *pools, size_t size); +#endif + +#ifdef __GNUC__ +static inline void +reset_pools (pools_t *pools) +{ + pools->active_pool = 0; + pools->fill_ptr = 0; +} +#else +void reset_pools (pools_t *pools); +#endif + +#endif