1 /* Copyright (C) 1992-1998 The Geometry Center
2 * Copyright (C) 1998-2000 Stuart Levy, Tamara Munzner, Mark Phillips
3 *
4 * This file is part of Geomview.
5 *
6 * Geomview is free software; you can redistribute it and/or modify it
7 * under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; either version 2, or (at your option)
9 * any later version.
10 *
11 * Geomview is distributed in the hope that it will be useful, but
12 * WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 * Lesser General Public License for more details.
15 *
16 * You should have received a copy of the GNU Lesser General Public
17 * License along with Geomview; see the file COPYING. If not, write
18 * to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
19 * USA, or visit http://www.gnu.org.
20 */
21
22
23 /* Authors: Stuart Levy, Tamara Munzner, Mark Phillips */
24
25 #ifndef LISP_H
26 #define LISP_H
27
28 #include <stdarg.h>
29 #include "ooglutil.h"
30 #include "fsa.h"
31
32 #include "streampool.h"
33
34 typedef struct LType LType;
35 typedef struct LObject LObject;
36
37
38 typedef union {
39 void *p;
40 int i;
41 unsigned long l;
42 float f;
43 double d;
44 } LCell;
45
46 struct LType
47 {
48 /* name of type */
49 const char *name;
50
51 /* size of corresponding C type */
52 int size;
53
54 /* extract cell value from obj */
55 bool (*fromobj)(/* LObject *obj, void *x */);
56
57 /* create a new LObject of this type */
58 LObject *(*toobj)(/* void *x */);
59
60 /* free a cell of this type */
61 void (*free)(/* void *x */);
62
63 /* write a cell value to a stream */
64 void (*write)(/* FILE *fp, void *x */);
65
66 /* test equality of two cells of this type */
67 bool (*match)(/* void *a, void *b */);
68
69 /* pull a cell value from a va_list */
70 void (*pull)(/* va_list *a_list, void *x */);
71
72 /* parse an object of this type */
73 LObject *(*parse)(/* Lake *lake */);
74
75 /* magic number; always set to LTypeMagic */
76 int magic;
77 };
78
79 #define LTypeMagic 314159
80
81 #define LNAME(type) (type->name)
82 #define LSIZE(type) (type->size)
83 #define LFROMOBJ(type) (*(type->fromobj))
84 #define LTOOBJ(type) (*(type->toobj))
85 #define LFREE(type) (*(type->free))
86 #define LMATCH(type) (*(type->match))
87 #define LWRITE(type) (*(type->write))
88 #define LPULL(type) (*(type->pull))
89 #define LPARSE(type) (*(type->parse))
90
91 struct LObject {
92 LType *type;
93 int ref;
94 LCell cell;
95 };
96
97 typedef struct Lake {
98 IOBFILE *streamin;
99 FILE *streamout;
100 Pool *river;
101 int timing_interests; /* Are we time-stamping interest reports? */
102 float deltatime; /* delta time between timestamps */
103 float nexttime; /* Pool time when next timestamp'll be needed */
104 const char *initial, *prefix, *suffix; /* printf format strings */
105 } Lake;
106
107 #define POOL(lake) ((lake)->river)
108
109 /* Return true if the next character starts a new S-expr, i.e. if the
110 * next character is an opening parenthesis.
111 */
LakeNewSexpr(Lake * lake)112 static inline bool LakeNewSexpr(Lake *lake)
113 {
114 return (iobfnextc(lake->streamin, 0) == '(');
115 }
116
117 /* Return true if the next token is NOT a closing parenthesis. */
LakeMore(Lake * lake)118 static inline bool LakeMore(Lake *lake)
119 {
120 int c;
121
122 return (c = iobfnextc(lake->streamin,0)) != ')' && c != EOF;
123 }
124
125 /* Return the next token from LAKE or NULL. If the token was quoted
126 * then store the quote character in *QUOTE.
127 */
LakeNextToken(Lake * lake,int * quote)128 static inline const char *LakeNextToken(Lake *lake, int *quote)
129 {
130 return iobfquotedelimtok("()", lake->streamin, 0, quote);
131 }
132
133 /************************ end of lake stuff ***********************************/
134
135 typedef struct LList {
136 LObject * car;
137 struct LList *cdr;
138 } LList;
139
140 typedef LObject *(*LObjectFunc)();
141
142 typedef struct LInterest {
143 Lake *lake;
144 LList *filter;
145 struct LInterest *next;
146 } LInterest;
147
148 typedef struct {
149 enum { ANY, /* match anything */
150 VAL, /* match only our value */
151 NIL /* match anything but report nil */
152 } flag;
153 LObject *value;
154 } LFilter;
155
156 #define LFILTERVAL(lobject) ((LFilter *)(lobject->cell.p))
157 extern LType LFilterp;
158 #define LFILTER (&LFilterp)
159
160 /*
161 * Built-in objects: Lnil and Lt:
162 */
163 extern LObject *Lnil, *Lt;
164
165 /*
166 * Built-in object types: string, list, and function. Function type
167 * is only used internally. See lisp.c for the code that initializes
168 * these type pointers.
169 */
170
171 /* A symbol is just a string which can be bound to a value in a lambda
172 * expression. Symbols can be parsed into strings.
173 */
174 extern LType LSymbolp;
175 #define LSYMBOL (&LSymbolp)
176 #define LSYMBOLVAL(obj) ((char*)((obj)->cell.p))
177
178 /* A string is just a symbol which cannot be bound to a value in a
179 * lambda expression. Strings can be parsed into symbols, however.
180 */
181 extern LType LStringp;
182 #define LSTRING (&LStringp)
183 #define LSTRINGVAL(obj) ((char*)((obj)->cell.p))
184
185 extern LType LIntp;
186 #define LINT (&LIntp)
187 #define LINTVAL(obj) ((obj)->cell.i)
188
189 extern LType LLongp;
190 #define LLONG (&LLongp)
191 #define LLONGVAL(obj) ((obj)->cell.l)
192
193 extern LType LFloatp;
194 #define LFLOAT (&LFloatp)
195 #define LFLOATVAL(obj) ((obj)->cell.f)
196
197 extern LType LDoublep;
198 #define LDOUBLE (&LDoublep)
199 #define LDOUBLEVAL(obj) ((obj)->cell.d)
200
201 extern LType LListp;
202 #define LLIST (&LListp)
203 #define LLISTVAL(obj) ((LList*)((obj)->cell.p))
204
205 #define LLAKEVAL(obj) ((Lake*)(obj->cell.p))
206 extern LType LLakep;
207 #define LLAKE (&LLakep)
208
209 extern LType LObjectp;
210 #define LLOBJECT (&LObjectp)
211
212 /* Convenience functions for generating objects */
LLISTTOOBJ(LList * list)213 static inline LObject *LLISTTOOBJ(LList *list)
214 {
215 return LTOOBJ(LLIST)(&list);
216 }
LSYMBOLTOOBJ(const char * string)217 static inline LObject *LSYMBOLTOOBJ(const char *string)
218 {
219 return LTOOBJ(LSYMBOL)(&string);
220 }
LSTRINGTOOBJ(const char * string)221 static inline LObject *LSTRINGTOOBJ(const char *string)
222 {
223 return LTOOBJ(LSTRING)(&string);
224 }
LINTTOOBJ(int value)225 static inline LObject *LINTTOOBJ(int value)
226 {
227 return LTOOBJ(LINT)(&value);
228 }
LLONGTOOBJ(long value)229 static inline LObject *LLONGTOOBJ(long value)
230 {
231 return LTOOBJ(LLONG)(&value);
232 }
LFLOATTOOBJ(float value)233 static inline LObject *LFLOATTOOBJ(float value)
234 {
235 return LTOOBJ(LFLOAT)(&value);
236 }
LDOUBLETOOBJ(double value)237 static inline LObject *LDOUBLETOOBJ(double value)
238 {
239 return LTOOBJ(LDOUBLE)(&value);
240 }
241
LSTRINGFROMOBJ(LObject * obj,char ** str)242 static inline bool LSTRINGFROMOBJ(LObject *obj, char **str)
243 {
244 if (obj->type == LSTRING || obj->type == LSYMBOL) {
245 *str = LSTRINGVAL(obj);
246 return true;
247 }
248 return false;
249 }
250
251 /*
252 * Function definition stuff:
253 */
254
255 enum lparseresult {
256 LASSIGN_GOOD,
257 LASSIGN_BAD,
258 LPARSE_GOOD,
259 LPARSE_BAD
260 };
261
262 typedef enum lparseresult LParseResult;
263
264 #define LPARSEMODE (lake != NULL)
265 #define LEVALMODE (!LPARSEMODE)
266
267 #define LDECLARE(stuff) \
268 switch (LParseArgs stuff) { \
269 case LASSIGN_BAD: case LPARSE_BAD: return Lnil; \
270 case LPARSE_GOOD: return Lt; \
271 default: case LASSIGN_GOOD: break; \
272 }
273
274 extern LType Larray;
275 #define LARRAY (&Larray)
276
277 extern LType Lvararray;
278 #define LVARARRAY (&Lvararray)
279
280 extern LType Lend;
281 #define LEND (&Lend)
282
283 extern LType Lhold;
284 #define LHOLD (&Lhold)
285
286 extern LType Lliteral;
287 #define LLITERAL (&Lliteral)
288
289 extern LType Loptional;
290 #define LOPTIONAL (&Loptional)
291
292 extern LType Lrest;
293 #define LREST (&Lrest)
294
295 /*
296 * Function prototypes:
297 */
298
299 void RemoveLakeInterests(Lake *lake);
300 void LInit();
301 Lake * LakeDefine(IOBFILE *streamin, FILE *streamout, void *river);
302 void LakeFree(Lake *lake);
303 LObject * LNew(LType *type, void *cell);
304 /* LObject * LRefIncr(LObject *obj); */
305 /* void LRefDecr(LObject *obj); */
306 void LWrite(FILE *fp, LObject *obj);
307 /* void LFree(LObject *obj); */
308 /* LObject *LCopy(LObject *obj); */
309 LObject * LSexpr(Lake *lake);
310 LObject * LLiteral(Lake *lake);
311 LObject * LEvalSexpr(Lake *lake);
312 LObject * LEval(LObject *obj);
313 LList * LListNew();
314 LList * LListAppend(LList *list, LObject *obj);
315 void LListFree(LList *list);
316 LList * LListCopy(LList *list);
317 LObject * LListEntry(LList *list, int n);
318 int LListLength(LList *list);
319 LParseResult LParseArgs(const char *name, Lake *lake, LList *args, ...);
320 bool LDefun(const char *name, LObjectFunc func, const char *help);
321 void LListWrite(FILE *fp, LList *list);
322 LInterest * LInterestList(const char *funcname);
323 LObject * LEvalFunc(const char *name, ...);
324 bool LArgClassValid(LType *type);
325 void LHelpDef(const char *key, const char *message);
326 const char * LakeName(Lake *lake);
327 const char * LSummarize(LObject *obj);
328 const char * LListSummarize(LList *list);
329 LObject * LMakeArray(LType *basetype, char *data, int count);
330
LRefIncr(LObject * obj)331 static inline LObject *LRefIncr(LObject *obj)
332 {
333 ++(obj->ref);
334 return obj;
335 }
336
LRefDecr(LObject * obj)337 static inline int LRefDecr(LObject *obj)
338 {
339 return --(obj->ref);
340 }
341
LFree(LObject * obj)342 static inline void LFree(LObject *obj)
343 {
344 extern void _LFree(LObject *);
345 if (obj == NULL || obj == Lnil || obj == Lt) return;
346 if (LRefDecr(obj) == 0) {
347 _LFree(obj);
348 }
349 }
350
LCopy(LObject * obj)351 static inline LObject *LCopy(LObject *obj)
352 {
353 if (obj == Lnil) return Lnil;
354 if (obj == Lt) return Lt;
355 return LTOOBJ(obj->type)(&(obj->cell));
356 }
357
358 void LShow(LObject *obj); /* for debugging; writes obj to stderr */
359 void LListShow(LList *list);
360 void LWriteFile(const char *fname, LObject *obj);
361
362 #include "clisp.h"
363
364 /*
365 LDEFINE(name, ltype, doc) is the header used to declare a lisp
366 function. It should be followed by the body of a function
367 (beginning with '{' and ending with '}'). LDEFINE delcares the
368 function's name to be "Lname" (the "name" argument with "L"
369 prepended to it). It also defines a string named "Hname"
370 initialized to "doc". The "ltype" argument gives the lisp object
371 type returned by the function (all functions defined via DEFILE
372 *must* return a lisp object.) LDEFINE actually ignores this but
373 read the next paragraph.
374
375 LDEFINE is intended for use in conjunction with the "lisp2c" shell
376 script which searches for calls to LDEFINE and builds a C language
377 interface to the functions so defined. This script makes use of all
378 3 arguments to LDEFINE, plus the use of the LDECLARE macro in the
379 function body that follows, to build the files clang.c and clang.h.
380 It makes certain assumptions about the way LDEFINE and LDECLARE
381 are used. See the comments at the top of lisp2c for details.
382 (I don't want to write the assumptions down here because if they
383 change I'll forget to update this comment!).
384 */
385
386 #if defined(__STDC__) || defined(__ANSI_CPP__)
387 #define LDEFINE( name, ltype, doc ) \
388 char H##name[] = doc ; LObject *L##name(Lake *lake, LList *args)
389 #else
390 #define LDEFINE( name, ltype, doc ) \
391 char H/**/name[] = doc ; LObject *L/**/name(Lake *lake, LList *args)
392 #endif
393
394 #define LBEGIN lake, args
395
396 #endif /* ! LISP_H */
397
398 /*
399 * Local Variables: ***
400 * mode: c ***
401 * c-basic-offset: 2 ***
402 * End: ***
403 */
404