1 /* $Id: lispreader.cxx,v 1.2 2003/01/08 23:30:43 grumbel Exp $ */
5 * Copyright (C) 1998-2000 Mark Probst
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Library General Public
9 * License as published by the Free Software Foundation; either
10 * version 2 of the License, or (at your option) any later version.
12 * This library is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 * Library General Public License for more details.
17 * You should have received a copy of the GNU Library General Public
18 * License along with this library; if not, write to the
19 * Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 * Boston, MA 02111-1307, USA.
28 #include "construo_error.hxx"
29 #include <lispreader.hxx>
31 #define TOKEN_ERROR -1
33 #define TOKEN_OPEN_PAREN 1
34 #define TOKEN_CLOSE_PAREN 2
35 #define TOKEN_SYMBOL 3
36 #define TOKEN_STRING 4
37 #define TOKEN_INTEGER 5
39 #define TOKEN_PATTERN_OPEN_PAREN 7
42 #define TOKEN_FALSE 10
45 #define MAX_TOKEN_LENGTH 1024
47 static char token_string
[MAX_TOKEN_LENGTH
+ 1] = "";
48 static int token_length
= 0;
50 static lisp_object_t end_marker
= { LISP_TYPE_EOF
};
51 static lisp_object_t error_object
= { LISP_TYPE_PARSE_ERROR
};
52 static lisp_object_t close_paren_marker
= { LISP_TYPE_PARSE_ERROR
};
53 static lisp_object_t dot_marker
= { LISP_TYPE_PARSE_ERROR
};
58 token_string
[0] = '\0';
63 _token_append (char c
)
65 assert(token_length
< MAX_TOKEN_LENGTH
);
67 token_string
[token_length
++] = c
;
68 token_string
[token_length
] = '\0';
72 _next_char (lisp_stream_t
*stream
)
76 case LISP_STREAM_FILE
:
77 return getc(stream
->v
.file
);
79 case LISP_STREAM_STRING
:
81 char c
= stream
->v
.string
.buf
[stream
->v
.string
.pos
];
86 ++stream
->v
.string
.pos
;
92 return stream
->v
.any
.next_char(stream
->v
.any
.data
);
99 _unget_char (char c
, lisp_stream_t
*stream
)
101 switch (stream
->type
)
103 case LISP_STREAM_FILE
:
104 ungetc(c
, stream
->v
.file
);
107 case LISP_STREAM_STRING
:
108 --stream
->v
.string
.pos
;
111 case LISP_STREAM_ANY
:
112 stream
->v
.any
.unget_char(c
, stream
->v
.any
.data
);
121 _scan (lisp_stream_t
*stream
)
123 static char *delims
= "\"();";
131 c
= _next_char(stream
);
134 else if (c
== ';') /* comment start */
137 c
= _next_char(stream
);
143 } while (isspace(c
));
148 return TOKEN_OPEN_PAREN
;
151 return TOKEN_CLOSE_PAREN
;
156 c
= _next_char(stream
);
163 c
= _next_char(stream
);
185 c
= _next_char(stream
);
198 c
= _next_char(stream
);
203 return TOKEN_PATTERN_OPEN_PAREN
;
210 if (isdigit(c
) || c
== '-')
212 int have_nondigits
= 0;
214 int have_floating_point
= 0;
221 have_floating_point
++;
224 c
= _next_char(stream
);
226 if (c
!= EOF
&& !isdigit(c
) && !isspace(c
) && c
!= '.' && !strchr(delims
, c
))
228 } while (c
!= EOF
&& !isspace(c
) && !strchr(delims
, c
));
231 _unget_char(c
, stream
);
233 if (have_nondigits
|| !have_digits
|| have_floating_point
> 1)
235 else if (have_floating_point
== 1)
238 return TOKEN_INTEGER
;
244 c
= _next_char(stream
);
245 if (c
!= EOF
&& !isspace(c
) && !strchr(delims
, c
))
249 _unget_char(c
, stream
);
256 c
= _next_char(stream
);
257 } while (c
!= EOF
&& !isspace(c
) && !strchr(delims
, c
));
259 _unget_char(c
, stream
);
269 static lisp_object_t
*
270 lisp_object_alloc (int type
)
272 lisp_object_t
*obj
= (lisp_object_t
*)malloc(sizeof(lisp_object_t
));
280 lisp_stream_init_file (lisp_stream_t
*stream
, FILE *file
)
282 stream
->type
= LISP_STREAM_FILE
;
283 stream
->v
.file
= file
;
289 lisp_stream_init_string (lisp_stream_t
*stream
, char *buf
)
291 stream
->type
= LISP_STREAM_STRING
;
292 stream
->v
.string
.buf
= buf
;
293 stream
->v
.string
.pos
= 0;
299 lisp_stream_init_any (lisp_stream_t
*stream
, void *data
,
300 int (*next_char
) (void *data
),
301 void (*unget_char
) (char c
, void *data
))
303 assert(next_char
!= 0 && unget_char
!= 0);
305 stream
->type
= LISP_STREAM_ANY
;
306 stream
->v
.any
.data
= data
;
307 stream
->v
.any
.next_char
= next_char
;
308 stream
->v
.any
.unget_char
= unget_char
;
314 lisp_make_integer (int value
)
316 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_INTEGER
);
318 obj
->v
.integer
= value
;
324 lisp_make_real (float value
)
326 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_REAL
);
334 lisp_make_symbol (const char *value
)
336 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_SYMBOL
);
338 obj
->v
.string
= strdup(value
);
344 lisp_make_string (const char *value
)
346 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_STRING
);
348 obj
->v
.string
= strdup(value
);
354 lisp_make_cons (lisp_object_t
*car
, lisp_object_t
*cdr
)
356 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_CONS
);
358 obj
->v
.cons
.car
= car
;
359 obj
->v
.cons
.cdr
= cdr
;
365 lisp_make_boolean (int value
)
367 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_BOOLEAN
);
369 obj
->v
.integer
= value
? 1 : 0;
374 static lisp_object_t
*
375 lisp_make_pattern_cons (lisp_object_t
*car
, lisp_object_t
*cdr
)
377 lisp_object_t
*obj
= lisp_object_alloc(LISP_TYPE_PATTERN_CONS
);
379 obj
->v
.cons
.car
= car
;
380 obj
->v
.cons
.cdr
= cdr
;
386 lisp_read (lisp_stream_t
*in
)
388 int token
= _scan(in
);
389 lisp_object_t
*obj
= lisp_nil();
391 if (token
== TOKEN_EOF
)
397 return &error_object
;
402 case TOKEN_OPEN_PAREN
:
403 case TOKEN_PATTERN_OPEN_PAREN
:
405 lisp_object_t
*last
= lisp_nil(), *car
;
410 if (car
== &error_object
|| car
== &end_marker
)
413 return &error_object
;
415 else if (car
== &dot_marker
)
417 if (lisp_nil_p(last
))
420 return &error_object
;
424 if (car
== &error_object
|| car
== &end_marker
)
431 last
->v
.cons
.cdr
= car
;
433 if (_scan(in
) != TOKEN_CLOSE_PAREN
)
436 return &error_object
;
439 car
= &close_paren_marker
;
442 else if (car
!= &close_paren_marker
)
444 if (lisp_nil_p(last
))
445 obj
= last
= (token
== TOKEN_OPEN_PAREN
? lisp_make_cons(car
, lisp_nil()) : lisp_make_pattern_cons(car
, lisp_nil()));
447 last
= last
->v
.cons
.cdr
= lisp_make_cons(car
, lisp_nil());
449 } while (car
!= &close_paren_marker
);
453 case TOKEN_CLOSE_PAREN
:
454 return &close_paren_marker
;
457 return lisp_make_symbol(token_string
);
460 return lisp_make_string(token_string
);
463 return lisp_make_integer(atoi(token_string
));
466 return lisp_make_real((float)atof(token_string
));
472 return lisp_make_boolean(1);
475 return lisp_make_boolean(0);
479 return &error_object
;
483 lisp_free (lisp_object_t
*obj
)
490 case LISP_TYPE_INTERNAL
:
491 case LISP_TYPE_PARSE_ERROR
:
495 case LISP_TYPE_SYMBOL
:
496 case LISP_TYPE_STRING
:
500 case LISP_TYPE_CONS
:
501 case LISP_TYPE_PATTERN_CONS
:
502 lisp_free(obj
->v
.cons
.car
);
503 lisp_free(obj
->v
.cons
.cdr
);
506 case LISP_TYPE_PATTERN_VAR
:
507 lisp_free(obj
->v
.pattern
.sub
);
515 lisp_read_from_string (const char *buf
)
517 lisp_stream_t stream
;
519 lisp_stream_init_string(&stream
, (char*)buf
);
520 return lisp_read(&stream
);
524 lisp_type (lisp_object_t
*obj
)
527 return LISP_TYPE_NIL
;
532 lisp_integer (lisp_object_t
*obj
)
534 assert(obj
->type
== LISP_TYPE_INTEGER
);
536 return obj
->v
.integer
;
540 lisp_symbol (lisp_object_t
*obj
)
542 assert(obj
->type
== LISP_TYPE_SYMBOL
);
544 return obj
->v
.string
;
548 lisp_string (lisp_object_t
*obj
)
550 if (obj
->type
!= LISP_TYPE_STRING
)
551 ConstruoError::raise("lispreader Error: obj->type != LISP_TYPE_STRING");
553 return obj
->v
.string
;
557 lisp_boolean (lisp_object_t
*obj
)
559 assert(obj
->type
== LISP_TYPE_BOOLEAN
);
561 return obj
->v
.integer
;
565 lisp_real (lisp_object_t
*obj
)
567 assert(obj
->type
== LISP_TYPE_REAL
|| obj
->type
== LISP_TYPE_INTEGER
);
569 if (obj
->type
== LISP_TYPE_INTEGER
)
570 return obj
->v
.integer
;
575 lisp_car (lisp_object_t
*obj
)
577 if (!(obj
->type
== LISP_TYPE_CONS
|| obj
->type
== LISP_TYPE_PATTERN_CONS
))
578 ConstruoError::raise("lispreader Error: !(obj->type == LISP_TYPE_CONS || obj->type == LISP_TYPE_PATTERN_CONS)");
580 return obj
->v
.cons
.car
;
584 lisp_cdr (lisp_object_t
*obj
)
586 assert(obj
->type
== LISP_TYPE_CONS
|| obj
->type
== LISP_TYPE_PATTERN_CONS
);
588 return obj
->v
.cons
.cdr
;
592 lisp_cxr (lisp_object_t
*obj
, const char *x
)
596 for (i
= strlen(x
) - 1; i
>= 0; --i
)
599 else if (x
[i
] == 'd')
608 lisp_list_length (lisp_object_t
*obj
)
614 assert(obj
->type
== LISP_TYPE_CONS
|| obj
->type
== LISP_TYPE_PATTERN_CONS
);
617 obj
= obj
->v
.cons
.cdr
;
624 lisp_list_nth_cdr (lisp_object_t
*obj
, int index
)
629 assert(obj
->type
== LISP_TYPE_CONS
|| obj
->type
== LISP_TYPE_PATTERN_CONS
);
632 obj
= obj
->v
.cons
.cdr
;
639 lisp_list_nth (lisp_object_t
*obj
, int index
)
641 obj
= lisp_list_nth_cdr(obj
, index
);
645 return obj
->v
.cons
.car
;
649 lisp_dump (lisp_object_t
*obj
, FILE *out
)
657 switch (lisp_type(obj
))
660 fputs("#<eof>", out
);
663 case LISP_TYPE_PARSE_ERROR
:
664 fputs("#<error>", out
);
667 case LISP_TYPE_INTEGER
:
668 fprintf(out
, "%d", lisp_integer(obj
));
671 case LISP_TYPE_REAL
:
672 fprintf(out
, "%f", lisp_real(obj
));
675 case LISP_TYPE_SYMBOL
:
676 fputs(lisp_symbol(obj
), out
);
679 case LISP_TYPE_STRING
:
684 for (p
= lisp_string(obj
); *p
!= 0; ++p
)
686 if (*p
== '"' || *p
== '\\')
694 case LISP_TYPE_CONS
:
695 case LISP_TYPE_PATTERN_CONS
:
696 fputs(lisp_type(obj
) == LISP_TYPE_CONS
? "(" : "#?(", out
);
699 lisp_dump(lisp_car(obj
), out
);
703 if (lisp_type(obj
) != LISP_TYPE_CONS
704 && lisp_type(obj
) != LISP_TYPE_PATTERN_CONS
)
717 case LISP_TYPE_BOOLEAN
:
718 if (lisp_boolean(obj
))