1 /**
2  * @file lispreader.c
3  * @brief Parse configuration file
4  * @created 2007-06-15
5  * @date 2014-08-15
6  * @author Mark Probst
7  * @author Ingo Ruhnke <grumbel@gmx.de>
8  * @author Bruno Ethvignot
9  */
10 /*
11  * copyright (c) 1998-2000 Mark Probst
12  * copyright (c) 2002 Ingo Ruhnke <grumbel@gmx.de>
13  * copyright (c) 2007-2014 TLK Games all rights reserved
14  * $Id: lispreader.cc 21 2014-08-15 20:05:56Z bruno.ethvignot@gmail.com $
15  *
16  * Powermanga is free software; you can redistribute it and/or modify
17  * it under the terms of the GNU General Public License as published by
18  * the Free Software Foundation; either version 3 of the License, or
19  * (at your option) any later version.
20  *
21  * Powermanga is distributed in the hope that it will be useful, but
22  * WITHOUT ANY WARRANTY; without even the implied warranty of
23  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24  * GNU General Public License for more details.
25  *
26  * You should have received a copy of the GNU General Public License
27  * along with this program; if not, write to the Free Software
28  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29  * MA  02110-1301, USA.
30  */
31 #include "../include/lispreader.h"
32 #include "../include/handler_resources.h"
33 #include <assert.h>
34 
35 typedef enum
36 {
37   LISP_PATTERN_ANY = 1,
38   LISP_PATTERN_SYMBOL,
39   LISP_PATTERN_STRING,
40   LISP_PATTERN_INTEGER,
41   LISP_PATTERN_REAL,
42   LISP_PATTERN_BOOLEAN,
43   LISP_PATTERN_LIST,
44   LISP_PATTERN_OR
45 } LISP_PATTERN_ENUM;
46 
47 typedef enum
48 {
49   LISP_STREAM_FILE = 1,
50   LISP_STREAM_STRING,
51   LISP_STREAM_ANY
52 } LISP_STREAM_ENUM;
53 
54 typedef enum
55 {
56   TOKEN_ERROR = -1,
57   TOKEN_EOF = 0,
58   TOKEN_OPEN_PAREN,
59   TOKEN_CLOSE_PAREN,
60   TOKEN_SYMBOL,
61   TOKEN_STRING,
62   TOKEN_INTEGER,
63   TOKEN_REAL,
64   TOKEN_PATTERN_OPEN_PAREN,
65   TOKEN_DOT,
66   TOKEN_TRUE,
67   TOKEN_FALSE
68 } TOKEN_ENUM;
69 
70 #define MAX_TOKEN_LENGTH           1024
71 #define lisp_nil()           ((lisp_object_t*)0)
72 #define lisp_nil_p(obj)      (obj == 0)
73 #define lisp_integer_p(obj)  (lisp_type((obj)) == LISP_TYPE_INTEGER)
74 #define lisp_symbol_p(obj)   (lisp_type((obj)) == LISP_TYPE_SYMBOL)
75 #define lisp_string_p(obj)   (lisp_type((obj)) == LISP_TYPE_STRING)
76 #define lisp_cons_p(obj)     (lisp_type((obj)) == LISP_TYPE_CONS)
77 #define lisp_boolean_p(obj)  (lisp_type((obj)) == LISP_TYPE_BOOLEAN)
78 static char token_string[MAX_TOKEN_LENGTH + 1] = "";
79 static Sint32 token_length = 0;
80 static lisp_object_t end_marker = { LISP_TYPE_EOF, {{0, 0}} };
81 static lisp_object_t error_object = { LISP_TYPE_PARSE_ERROR, {{0, 0}} };
82 static lisp_object_t close_paren_marker = { LISP_TYPE_PARSE_ERROR, {{0, 0}} };
83 static lisp_object_t dot_marker = { LISP_TYPE_PARSE_ERROR, {{0, 0}} };
84 
85 //static char *lisp_string (lisp_object_t * obj);
86 //static Sint32 lisp_integer (lisp_object_t * obj);
87 //static float lisp_real (lisp_object_t * obj);
88 //static Sint32 lisp_type (lisp_object_t * obj);
89 //static void lisp_dump (lisp_object_t * obj, FILE * out);
90 //
91 
92 
93 /**
94  * Create the lispreader object
95  */
lispreader()96 lispreader::lispreader ()
97 {
98   root_obj = NULL;
99   lst = NULL;
100   object_init ();
101 }
102 
103 /**
104  * Create the lispreader object
105  */
~lispreader()106 lispreader::~lispreader ()
107 {
108   if (root_obj != NULL)
109     {
110       lisp_free (root_obj);
111       root_obj = NULL;
112     }
113   object_free ();
114 }
115 
116 /**
117  * Clear the current string
118  */
119 void
_token_clear(void)120 lispreader::_token_clear (void)
121 {
122   token_string[0] = '\0';
123   token_length = 0;
124 }
125 
126 /**
127  *  Copy current string
128  * @param c A character code of string read currently
129  */
130 void
_token_append(char c)131 lispreader::_token_append (char c)
132 {
133   //assert (token_length < MAX_TOKEN_LENGTH);
134   if (token_length >= MAX_TOKEN_LENGTH)
135     {
136       throw std::out_of_range ("token_length < MAX_TOKEN_LENGTH failed");
137     }
138   token_string[token_length++] = c;
139   token_string[token_length] = '\0';
140 }
141 
142 /**
143  * Return the next char of the configuratoin file
144  * @param stream Pointer to a lisp_stream_t
145  * @return Code of the char
146  */
147 Sint32
_next_char(lisp_stream_t * stream)148 lispreader::_next_char (lisp_stream_t * stream)
149 {
150   char c;
151   switch (stream->type)
152     {
153     case LISP_STREAM_FILE:
154       return getc (stream->v.file);
155     case LISP_STREAM_STRING:
156     {
157       c = stream->v.string.buf[stream->v.string.pos];
158       if (c == 0)
159         {
160           return EOF;
161         }
162       ++stream->v.string.pos;
163       return c;
164     }
165     case LISP_STREAM_ANY:
166       return stream->v.any.next_char (stream->v.any.data);
167     }
168   //assert (0);
169   throw std::runtime_error ("Bad value for the variable stream->type");
170   return EOF;
171 }
172 
173 /**
174  *
175  * @param c
176  * @param stream
177  */
178 void
_unget_char(char c,lisp_stream_t * stream)179 lispreader::_unget_char (char c, lisp_stream_t * stream)
180 {
181   switch (stream->type)
182     {
183     case LISP_STREAM_FILE:
184       ungetc (c, stream->v.file);
185       break;
186     case LISP_STREAM_STRING:
187       --stream->v.string.pos;
188       break;
189     case LISP_STREAM_ANY:
190       stream->v.any.unget_char (c, stream->v.any.data);
191       break;
192     default:
193       throw std::runtime_error ("Bad value for the variable stream->type");
194       //assert (0);
195     }
196 }
197 
198 /**
199  * Scan the configuration file
200  * @input stream A pointer to a lisp_stream_t struture
201  * @return A return code
202  */
203 Sint32
_scan(lisp_stream_t * stream)204 lispreader::_scan (lisp_stream_t * stream)
205 {
206   static const char *delims = "\"();";
207   Sint32 c;
208   Sint32 have_nondigits;
209   Sint32 have_digits;
210   Sint32 have_floating_point;
211   bool search = true;
212   _token_clear ();
213   do
214     {
215       c = _next_char (stream);
216       if (c == EOF)
217         {
218           return TOKEN_EOF;
219         }
220       /* comment start : all comments are ignored */
221       else if (c == ';')
222         {
223           while (search)
224             {
225               c = _next_char (stream);
226               if (c == EOF)
227                 {
228                   return TOKEN_EOF;
229                 }
230               else if (c == '\n')
231                 {
232                   break;
233                 }
234             }
235         }
236     }
237   while (isspace (c));
238 
239   switch (c)
240     {
241     case '(':
242       return TOKEN_OPEN_PAREN;
243 
244     case ')':
245       return TOKEN_CLOSE_PAREN;
246 
247     case '"':
248       while (search)
249         {
250           c = _next_char (stream);
251           if (c == EOF)
252             {
253               return TOKEN_ERROR;
254             }
255           if (c == '"')
256             {
257               break;
258             }
259           if (c == '\\')
260             {
261               c = _next_char (stream);
262               switch (c)
263                 {
264                 case EOF:
265                   return TOKEN_ERROR;
266 
267                 case 'n':
268                   c = '\n';
269                   break;
270 
271                 case 't':
272                   c = '\t';
273                   break;
274                 }
275             }
276           _token_append ((char) c);
277         }
278       return TOKEN_STRING;
279 
280     case '#':
281       c = _next_char (stream);
282       if (c == EOF)
283         {
284           return TOKEN_ERROR;
285         }
286       switch (c)
287         {
288         case 't':
289           return TOKEN_TRUE;
290         case 'f':
291           return TOKEN_FALSE;
292         case '?':
293           c = _next_char (stream);
294           if (c == EOF)
295             {
296               return TOKEN_ERROR;
297             }
298           if (c == '(')
299             {
300               return TOKEN_PATTERN_OPEN_PAREN;
301             }
302           else
303             {
304               return TOKEN_ERROR;
305             }
306         }
307       return TOKEN_ERROR;
308 
309     default:
310       if (isdigit (c) || c == '-')
311         {
312           have_nondigits = 0;
313           have_digits = 0;
314           have_floating_point = 0;
315           do
316             {
317               if (isdigit (c))
318                 {
319                   have_digits = 1;
320                 }
321               else if (c == '.')
322                 {
323                   have_floating_point++;
324                 }
325               _token_append ((char) c);
326               c = _next_char (stream);
327               if (c != EOF && !isdigit (c) && !isspace (c) && c != '.'
328                   && !strchr (delims, c))
329                 {
330                   have_nondigits = 1;
331                 }
332             }
333           while (c != EOF && !isspace (c) && !strchr (delims, c));
334           if (c != EOF)
335             {
336               _unget_char ((char) c, stream);
337             }
338           if (have_nondigits || !have_digits || have_floating_point > 1)
339             {
340               return TOKEN_SYMBOL;
341             }
342           else if (have_floating_point == 1)
343             {
344               return TOKEN_REAL;
345             }
346           else
347             {
348               return TOKEN_INTEGER;
349             }
350         }
351       else
352         {
353           if (c == '.')
354             {
355               c = _next_char (stream);
356               if (c != EOF && !isspace (c) && !strchr (delims, c))
357                 {
358                   _token_append ('.');
359                 }
360               else
361                 {
362                   _unget_char ((char) c, stream);
363                   return TOKEN_DOT;
364                 }
365             }
366           do
367             {
368               _token_append ((char) c);
369               c = _next_char (stream);
370             }
371           while (c != EOF && !isspace (c) && !strchr (delims, c));
372           if (c != EOF)
373             {
374               _unget_char ((char) c, stream);
375             }
376           return TOKEN_SYMBOL;
377         }
378     }
379 }
380 
381 /**
382  * Release a object type
383  * @param obj A pointer to a lisp_object_t structure
384  */
385 void
lisp_free(lisp_object_t * obj)386 lispreader::lisp_free (lisp_object_t * obj)
387 {
388   if (obj == NULL)
389     {
390       return;
391     }
392   switch (obj->type)
393     {
394     case LISP_TYPE_INTERNAL:
395     case LISP_TYPE_PARSE_ERROR:
396     case LISP_TYPE_EOF:
397       return;
398     case LISP_TYPE_SYMBOL:
399     case LISP_TYPE_STRING:
400       free ((char *) obj->v.string);
401       //delete [] obj->v.string;
402       break;
403     case LISP_TYPE_CONS:
404     case LISP_TYPE_PATTERN_CONS:
405       lisp_free (obj->v.cons.car);
406       lisp_free (obj->v.cons.cdr);
407       break;
408     case LISP_TYPE_PATTERN_VAR:
409       lisp_free (obj->v.pattern.sub);
410       break;
411     }
412   //free_memory ((char *) obj);
413   delete obj;
414 }
415 
416 /**
417  * Create a lisp_object_t structure
418  * @param type A object type code
419  * @return A pointer to a lisp_object_t
420  */
421 lisp_object_t *
lisp_object_alloc(Sint32 type)422 lispreader::lisp_object_alloc (Sint32 type)
423 {
424   lisp_object_t *obj = new lisp_object_t;
425   //lisp_object_t *obj =
426   //  (lisp_object_t *) memory_allocation (sizeof (lisp_object_t));
427   obj->type = type;
428   return obj;
429 }
430 
431 /**
432  * Initialize string of steam
433  * @param stream A pointer to a lisp_stream_t structure
434  * @param buf Pointer to string
435  * @return A pointer to a lisp_stream_t structure
436  */
437 lisp_stream_t *
lisp_stream_init_string(lisp_stream_t * stream,char * buf)438 lispreader::lisp_stream_init_string (lisp_stream_t * stream, char *buf)
439 {
440   stream->type = LISP_STREAM_STRING;
441   stream->v.string.buf = buf;
442   stream->v.string.pos = 0;
443   return stream;
444 }
445 
446 /**
447  * Create a integer type
448  * @param value A interger value
449  * @return A pointer to a lisp_object_t structure
450  */
451 lisp_object_t *
lisp_make_integer(Sint32 value)452 lispreader::lisp_make_integer (Sint32 value)
453 {
454   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_INTEGER);
455   obj->v.integer = value;
456   return obj;
457 }
458 
459 /**
460  * Create a real type
461  * @param value A real value
462  * @return A pointer to a lisp_object_t structure
463  */
464 lisp_object_t *
lisp_make_real(float value)465 lispreader::lisp_make_real (float value)
466 {
467   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_REAL);
468   obj->v.real = value;
469   return obj;
470 }
471 
472 /**
473  * Create a symbol type
474  * @param value
475  * @return A pointer to a lisp_object_t structure
476  */
477 lisp_object_t *
lisp_make_symbol(const char * value)478 lispreader::lisp_make_symbol (const char *value)
479 {
480   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_SYMBOL);
481   obj->v.string = strdup (value);
482   return obj;
483 }
484 
485 /**
486  * Create a string type
487  * @param value
488  * @return A pointer to a lisp_object_t structure
489  */
490 lisp_object_t *
lisp_make_string(const char * value)491 lispreader::lisp_make_string (const char *value)
492 {
493   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_STRING);
494   obj->v.string = strdup (value);
495   return obj;
496 }
497 
498 /**
499  * Create a "cons" element
500  * @param car Contents of Address register (first element)
501  * @param value cdr (Contents of Decrement register)
502  * @return A pointer to a lisp_object_t structure
503  */
504 lisp_object_t *
lisp_make_cons(lisp_object_t * car,lisp_object_t * cdr)505 lispreader::lisp_make_cons (lisp_object_t * car, lisp_object_t * cdr)
506 {
507   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_CONS);
508   obj->v.cons.car = car;
509   obj->v.cons.cdr = cdr;
510   return obj;
511 }
512 
513 /**
514  * Create a boolean type
515  * @param value
516  * @return A pointer to a lisp_object_t structure
517  */
518 lisp_object_t *
lisp_make_boolean(Sint32 value)519 lispreader::lisp_make_boolean (Sint32 value)
520 {
521   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_BOOLEAN);
522   obj->v.integer = value ? 1 : 0;
523   return obj;
524 }
525 
526 /**
527  * @param car
528  * @param cdr
529  * @return A pointer to a lisp_object_t structure
530  */
531 lisp_object_t *
lisp_make_pattern_cons(lisp_object_t * car,lisp_object_t * cdr)532 lispreader::lisp_make_pattern_cons (lisp_object_t * car, lisp_object_t * cdr)
533 {
534   lisp_object_t *obj = lisp_object_alloc (LISP_TYPE_PATTERN_CONS);
535   obj->v.cons.car = car;
536   obj->v.cons.cdr = cdr;
537   return obj;
538 }
539 
540 /**
541  * Parse the configuration file
542  * @param in A pointer to a lisp_stream_t structure
543  * @return A pointer to a lisp_object_t structure
544  */
545 lisp_object_t *
lisp_read(lisp_stream_t * in)546 lispreader::lisp_read (lisp_stream_t * in)
547 {
548   Sint32 token = _scan (in);
549   lisp_object_t *obj = lisp_nil ();
550   if (token == TOKEN_EOF)
551     {
552       return &end_marker;
553     }
554   switch (token)
555     {
556     case TOKEN_ERROR:
557       return &error_object;
558 
559     case TOKEN_EOF:
560       return &end_marker;
561     case TOKEN_OPEN_PAREN:
562     case TOKEN_PATTERN_OPEN_PAREN:
563     {
564       lisp_object_t *last = lisp_nil (), *car;
565       do
566         {
567           car = lisp_read (in);
568           if (car == &error_object || car == &end_marker)
569             {
570               lisp_free (obj);
571               return &error_object;
572             }
573           else if (car == &dot_marker)
574             {
575               if (lisp_nil_p (last))
576                 {
577                   lisp_free (obj);
578                   return &error_object;
579                 }
580 
581               car = lisp_read (in);
582               if (car == &error_object || car == &end_marker)
583                 {
584                   lisp_free (obj);
585                   return car;
586                 }
587               else
588                 {
589                   last->v.cons.cdr = car;
590 
591                   if (_scan (in) != TOKEN_CLOSE_PAREN)
592                     {
593                       lisp_free (obj);
594                       return &error_object;
595                     }
596 
597                   car = &close_paren_marker;
598                 }
599             }
600           else if (car != &close_paren_marker)
601             {
602               if (lisp_nil_p (last))
603                 {
604                   obj = last =
605                           (token ==
606                            TOKEN_OPEN_PAREN ? lisp_make_cons (car,
607                                lisp_nil ()) :
608                            lisp_make_pattern_cons (car, lisp_nil ()));
609 
610                 }
611               else
612                 {
613                   last = last->v.cons.cdr =
614                            lisp_make_cons (car, lisp_nil ());
615                 }
616             }
617         }
618       while (car != &close_paren_marker);
619     }
620     return obj;
621 
622     case TOKEN_CLOSE_PAREN:
623       return &close_paren_marker;
624 
625     case TOKEN_SYMBOL:
626       return lisp_make_symbol (token_string);
627 
628     case TOKEN_STRING:
629       return lisp_make_string (token_string);
630 
631     case TOKEN_INTEGER:
632       return lisp_make_integer (atoi (token_string));
633 
634     case TOKEN_REAL:
635       return lisp_make_real ((float) atof (token_string));
636 
637     case TOKEN_DOT:
638       return &dot_marker;
639 
640     case TOKEN_TRUE:
641       return lisp_make_boolean (1);
642 
643     case TOKEN_FALSE:
644       return lisp_make_boolean (0);
645     }
646 
647   //assert (0);
648   throw std::runtime_error ("Bad value for the variable tocken");
649   return &error_object;
650 }
651 
652 
653 /**
654  * Return the code of an object type
655  * @param obj A pointer to a lisp_object_t structure
656  * @return An object type code
657  */
658 Sint32
lisp_type(lisp_object_t * obj)659 lispreader::lisp_type (lisp_object_t * obj)
660 {
661   if (obj == NULL)
662     {
663       return LISP_TYPE_NIL;
664     }
665   return obj->type;
666 }
667 
668 /**
669  * Return integer value of an integer type
670  * @param obj A pointer to a lisp_object_t structure
671  * @return A interger value
672  */
673 Sint32
lisp_integer(lisp_object_t * obj)674 lispreader::lisp_integer (lisp_object_t * obj)
675 {
676   //assert (obj->type == LISP_TYPE_INTEGER);
677   if (obj->type != LISP_TYPE_INTEGER)
678     {
679       throw std::runtime_error ("obj->type is not a LISP_TYPE_INTEGER");
680     }
681   return obj->v.integer;
682 }
683 
684 /**
685  * Return string of a symbol type
686  * @param obj A pointer to a lisp_object_t structure
687  * @return A pointer to a string
688  */
689 char *
lisp_symbol(lisp_object_t * obj)690 lispreader::lisp_symbol (lisp_object_t * obj)
691 {
692   //assert (obj->type == LISP_TYPE_SYMBOL);
693   if (obj->type != LISP_TYPE_SYMBOL)
694     {
695       throw std::runtime_error ("obj->type is not a LISP_TYPE_SYMBOL");
696     }
697   return obj->v.string;
698 }
699 
700 /**
701  * Return a string of a string object
702  * @param obj A pointer to a lisp_object_t structure
703  * @return A pointer to a string
704  */
705 char *
lisp_string(lisp_object_t * obj)706 lispreader::lisp_string (lisp_object_t * obj)
707 {
708   //assert (obj->type == LISP_TYPE_STRING);
709   if (obj->type != LISP_TYPE_STRING)
710     {
711       throw std::runtime_error ("obj->type is not a LISP_TYPE_STRING");
712     }
713   return obj->v.string;
714 }
715 
716 /**
717  * Return value of a boolean object
718  * @param obj A pointer to a lisp_object_t structure
719  * @return 0 or 1
720  */
721 Sint32
lisp_boolean(lisp_object_t * obj)722 lispreader::lisp_boolean (lisp_object_t * obj)
723 {
724   //assert (obj->type == LISP_TYPE_BOOLEAN);
725   if (obj->type != LISP_TYPE_BOOLEAN)
726     {
727       throw std::runtime_error ("obj->type is not a LISP_TYPE_BOOLEAN");
728     }
729   return obj->v.integer;
730 }
731 
732 /**
733  * Return float value of a real type
734  * @param obj A pointer to a lisp_object_t structure
735  * @return A float value
736  */
737 float
lisp_real(lisp_object_t * obj)738 lispreader::lisp_real (lisp_object_t * obj)
739 {
740   //assert (obj->type == LISP_TYPE_REAL || obj->type == LISP_TYPE_INTEGER);
741   if (obj->type != LISP_TYPE_REAL && obj->type != LISP_TYPE_INTEGER)
742     {
743       throw std::runtime_error
744       ("obj->type is not a LISP_TYPE_REAL or LISP_TYPE_INTEGER");
745     }
746   if (obj->type == LISP_TYPE_INTEGER)
747     {
748       return (float) (obj->v.integer);
749     }
750   return obj->v.real;
751 }
752 
753 /**
754  *
755  * @param obj A pointer to a lisp_object_t structure
756  * @return
757  */
758 lisp_object_t *
lisp_car(lisp_object_t * obj)759 lispreader::lisp_car (lisp_object_t * obj)
760 {
761   //assert (obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
762   return obj->v.cons.car;
763   if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
764     {
765       throw std::runtime_error
766       ("obj->type is not a LISP_TYPE_CONS or LISP_TYPE_PATTERN_CONS");
767     }
768   return obj->v.cons.car;
769 }
770 
771 /**
772  *
773  * @param obj A pointer to a lisp_object_t structure
774  * @return
775  */
776 lisp_object_t *
lisp_cdr(lisp_object_t * obj)777 lispreader::lisp_cdr (lisp_object_t * obj)
778 {
779   //assert (obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS);
780   if (obj->type != LISP_TYPE_CONS && obj->type != LISP_TYPE_PATTERN_CONS)
781     {
782       throw std::runtime_error
783       ("obj->type is not a LISP_TYPE_CONS or LISP_TYPE_PATTERN_CONS");
784     }
785   return obj->v.cons.cdr;
786 }
787 
788 /**
789  * Dump a lisp_object_t structure
790  * @param obj A pointer to a lisp_object_t structure
791  * @param FILE A output stream
792  */
793 void
lisp_dump(lisp_object_t * obj,FILE * out)794 lispreader::lisp_dump (lisp_object_t * obj, FILE * out)
795 {
796   char *p;
797   if (obj == 0)
798     {
799       fprintf (out, "()");
800       return;
801     }
802 
803   switch (lisp_type (obj))
804     {
805     case LISP_TYPE_EOF:
806       fputs ("#<eof>", out);
807       break;
808 
809     case LISP_TYPE_PARSE_ERROR:
810       fputs ("#<error>", out);
811       break;
812 
813     case LISP_TYPE_INTEGER:
814       fprintf (out, "%d", lisp_integer (obj));
815       break;
816 
817     case LISP_TYPE_REAL:
818       fprintf (out, "%f", lisp_real (obj));
819       break;
820 
821     case LISP_TYPE_SYMBOL:
822       fputs (lisp_symbol (obj), out);
823       break;
824 
825     case LISP_TYPE_STRING:
826     {
827       fputc ('"', out);
828       for (p = lisp_string (obj); *p != 0; ++p)
829         {
830           if (*p == '"' || *p == '\\')
831             fputc ('\\', out);
832           fputc (*p, out);
833         }
834       fputc ('"', out);
835     }
836     break;
837 
838     case LISP_TYPE_CONS:
839     case LISP_TYPE_PATTERN_CONS:
840       fputs (lisp_type (obj) == LISP_TYPE_CONS ? "(" : "#?(", out);
841       while (obj != 0)
842         {
843           lisp_dump (lisp_car (obj), out);
844           obj = lisp_cdr (obj);
845           if (obj != 0)
846             {
847               if (lisp_type (obj) != LISP_TYPE_CONS
848                   && lisp_type (obj) != LISP_TYPE_PATTERN_CONS)
849                 {
850                   fputs (" . ", out);
851                   lisp_dump (obj, out);
852                   break;
853                 }
854               else
855                 fputc (' ', out);
856             }
857         }
858       fputc (')', out);
859       break;
860 
861     case LISP_TYPE_BOOLEAN:
862       if (lisp_boolean (obj))
863         {
864           fputs ("#t", out);
865         }
866       else
867         {
868           fputs ("#f", out);
869         }
870       break;
871     default:
872       //assert (0);
873       throw std::runtime_error ("Bad value for the variable obj->type");
874     }
875 }
876 
877 /**
878  * Search a attribute name
879  * @param lst Pointer to a lisp_object_t
880  * @param name String representing the attribute name
881  * @return Pointer to a lisp_object_t object
882  */
883 lisp_object_t *
search_for(const char * name)884 lispreader::search_for (const char *name)
885 {
886   lisp_object_t *cur;
887   lisp_object_t *cursor = lst;
888   while (!lisp_nil_p (cursor))
889     {
890       cur = lisp_car (cursor);
891       if (!lisp_cons_p (cur) || !lisp_symbol_p (lisp_car (cur)))
892         {
893           lisp_dump (cur, stdout);
894           std::cerr << "(!!!) LispReader: Read error in search!" << std::endl;
895         }
896       else
897         {
898           if (strcmp (lisp_symbol (lisp_car (cur)), name) == 0)
899             {
900               return lisp_cdr (cur);
901             }
902         }
903 
904       cursor = lisp_cdr (cursor);
905     }
906   return NULL;
907 }
908 
909 /**
910  * Read an integer
911  * @param lst Pointer to a lisp_object_t
912  * @param name String representing the attribute name
913  * @param i Pointer to the integer which will contain the value of the
914  *          required attribute
915  * @return true if the attribute were correctly found and read, or false
916  *         otherwise
917  */
918 bool
read_int(const char * name,Sint32 * i)919 lispreader::read_int (const char *name, Sint32 * i)
920 {
921   lisp_object_t *obj = search_for (name);
922   if (obj == NULL)
923     {
924       return false;
925     }
926   if (!lisp_integer_p (lisp_car (obj)))
927     {
928       std::cerr << "(!) LispReader expected type integer at token: " << name
929                 << std::endl;
930       return false;
931     }
932   *i = lisp_integer (lisp_car (obj));
933   return true;
934 }
935 
936 /**
937  * Read a boolean
938  * @param lst Pointer to a lisp_object_t
939  * @param name String representing the attribute name
940  * @param i Pointer to the boolean which will contain the value of the
941  *          required attribute
942  * @return true if the attribute were correctly found and read, or false
943  *         otherwise
944  */
945 bool
read_bool(const char * name,bool * b)946 lispreader::read_bool (const char *name, bool * b)
947 {
948   lisp_object_t *obj = search_for (name);
949   if (obj == NULL)
950     {
951       return false;
952     }
953 
954   if (!lisp_boolean_p (lisp_car (obj)))
955     {
956       std::
957       cerr << "LispReader expected type bool at token: " << name <<
958            std::endl;
959       return false;
960     }
961   *b = lisp_boolean (lisp_car (obj));
962   return true;
963 }
964 
965 /**
966  * Read a string
967  * @param lst Pointer to a lisp_object_t
968  * @param name String representing the attribute name
969  * @param i Pointer to the string which will contain the value of the
970  *          required attribute
971  * @return true if the attribute were correctly found and read, or false
972  *         otherwise
973  */
974 bool
lisp_read_string(const char * name,char ** str)975 lispreader::lisp_read_string (const char *name, char **str)
976 {
977   lisp_object_t *obj = search_for (name);
978   if (obj == NULL)
979     {
980       return false;
981     }
982   if (!lisp_string_p (lisp_car (obj)))
983     {
984       std::cerr << "expected type real at token: " << name << std::endl;
985       return false;
986     }
987   *str = lisp_string (lisp_car (obj));
988   return true;
989 }
990 
991 /**
992  * Read a string
993  * @param lst Pointer to a lisp_object_t
994  * @param name String representing the attribute name
995  * @param i Pointer to the string which will contain the value of the
996  *          required attribute
997  * @return true if the attribute were correctly found and read, or false
998  *         otherwise
999  */
1000 bool
read_string(const char * name,std::string * str)1001 lispreader::read_string (const char *name, std::string * str)
1002 {
1003   lisp_object_t *obj = search_for (name);
1004   if (obj == NULL)
1005     {
1006       return false;
1007     }
1008   if (!lisp_string_p (lisp_car (obj)))
1009     {
1010       std::cerr << "expected type real at token: " << name << std::endl;
1011       return false;
1012     }
1013   *str = lisp_string (lisp_car (obj));
1014   return true;
1015 }
1016 
1017 /**
1018  * Read a configuration file
1019  * @param filename The filename specified by path
1020  * @return A pointer to a lisp_object_t
1021  */
1022 lisp_object_t *
lisp_read_file(std::string filename)1023 lispreader::lisp_read_file (std::string filename)
1024 {
1025   lisp_stream_t *stream;
1026 
1027   /* read filedata */
1028   handler_resources *r = handler_resources::get_instance ();
1029   char *filedata = r->read_complete_file (filename.c_str());
1030   if (filedata == NULL)
1031     {
1032       return NULL;
1033     }
1034   //stream = (lisp_stream_t *) memory_allocation (sizeof (lisp_stream_t));
1035   try
1036     {
1037       stream = new lisp_stream_t;
1038     }
1039   catch (std::bad_alloc &)
1040     {
1041       std::cerr << "not enough memory to allocate 'lisp_stream_t' " << filename
1042                 << std::endl;
1043       delete[]filedata;
1044       return NULL;
1045     }
1046   stream->type = LISP_STREAM_STRING;
1047   stream->v.string.buf = filedata;
1048   stream->v.string.pos = 0;
1049   root_obj = lisp_read (stream);
1050   lst = lisp_cdr (root_obj);
1051   delete stream;
1052   delete[]filedata;
1053   return root_obj;
1054 }
1055