lac : 13c48a7eee5366cace40f51a44e8f6d66390421a

     1: /*
     2:    lac -- a lisp interpreter
     3:    Copyright (C) 2010 Gianluca Guida
     4: 
     5:    This program is free software; you can redistribute it and/or modify
     6:    it under the terms of the GNU General Public License as published by
     7:    the Free Software Foundation; either version 2 of the License, or
     8:    (at your option) any later version.
     9: 
    10:    This program is distributed in the hope that it will be useful,
    11:    but WITHOUT ANY WARRANTY; without even the implied warranty of
    12:    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    13:    GNU General Public License for more details.
    14: 
    15:    You should have received a copy of the GNU General Public License along
    16:    with this program; if not, write to the Free Software Foundation, Inc.,
    17:    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    18: */
    19: 
    20: %{
    21: #define YYSTYPE lreg_t
    22: #define YY_DECL int yylex(YYSTYPE *lvalp, void *yyscanner)
    23: #define YY_NO_INPUT
    24: #include <ctype.h>
    25: #include <strings.h>
    26: 
    27: #include "config.h"
    28: #include "lac.h"
    29: #include "sexpr_parse.h"
    30: 
    31: 
    32: #ifdef HAVE_READLINE
    33: #ifdef HAVE_READLINE_READLINE_H
    34: #include <readline/readline.h>
    35: #else
    36: #include <readline.h>
    37: #endif
    38: #ifdef HAVE_READLINE_HISTORY_H
    39: #include <readline/history.h>
    40: #else
    41: #include <history.h>
    42: #endif
    43: 
    44: static int readline_getc(void)
    45: {
    46:   static int curchar = 0;
    47:   static char *buf = NULL;
    48: 
    49:   /* First run */
    50:   if ( buf == NULL ) {
    51:     buf = readline("LAC>");
    52:     if ( buf != NULL && *buf != '\0' )
    53: 	add_history(buf);
    54:     curchar = 0;
    55:   }
    56: 
    57:   if ( buf == NULL )
    58:     return EOF;
    59:   if ( buf[curchar] == '\0' ) {
    60:     free(buf);
    61:     buf = NULL;
    62:     return '\n';  
    63:   }
    64: 
    65:   return buf[curchar++];
    66: }
    67: 
    68: #else
    69: #define readline_getc() getchar()
    70: #endif
    71: 
    72: #define YY_INPUT(buf,result,max_size) \
    73: 	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
    74: 		{ \
    75: 		int c = '*'; \
    76: 		size_t n; \
    77: 		for ( n = 0; n < max_size && \
    78: 			     (c = readline_getc())!=EOF && c!='\n'; ++n ) \
    79: 			buf[n] = (char) c; \
    80: 		if ( c == '\n' ) \
    81: 			buf[n++] = (char) c; \
    82: 		if ( c == EOF && ferror( yyin ) ) \
    83: 			YY_FATAL_ERROR( "input in flex scanner failed" ); \
    84: 		result = n; \
    85: 		} \
    86: 	else \
    87: 		{ \
    88: 		errno=0; \
    89: 		while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
    90: 			{ \
    91: 			if( errno != EINTR) \
    92: 				{ \
    93: 				YY_FATAL_ERROR( "input in flex scanner failed" ); \
    94: 				break; \
    95: 				} \
    96: 			errno=0; \
    97: 			clearerr(yyin); \
    98: 			} \
    99: 		}\
   100: 
   101: %}
   102: 
   103: %option noyywrap
   104: %option reentrant
   105: 
   106: WHITESPACE [\ \t\n]
   107: DIGIT [0-9]
   108: HEXDIGIT [0-9a-fA-F]
   109: ALPHA [A-Za-z]
   110: SP_INIT [#\*/:<=>?^_~!$%&+-]
   111: SPECIAL [\*/:<=>?^_~!$%&+-.] 
   112: SIGN [+|-]
   113: 
   114: %%
   115: 
   116: ;(.)*
   117: {WHITESPACE}
   118: 
   119: {SIGN}?{DIGIT}+ {
   120: 	intptr_t n;
   121: 
   122: 	errno = 0;
   123: 	n = strtol(yytext, (char **)NULL, 10);
   124: 	if ( errno == ERANGE )
   125: 		raise_exception("Integer overflow in input", NIL);
   126:         *lvalp = lac_extty_box(LREG_INTEGER, (void *)n, 0);
   127: 	return INTEGER;
   128: }
   129: 
   130: (#x|0x){HEXDIGIT}+ {
   131: 	intptr_t n;
   132: 
   133: 	errno = 0;
   134: 	n = strtol(yytext+2, (char **)NULL, 16);
   135: 	if ( errno == ERANGE )
   136: 		raise_exception("Integer overflow in input", NIL);
   137: 	*lvalp = lac_extty_box(LREG_INTEGER, (void *)n, 0);
   138: 	return INTEGER;
   139: }
   140: 
   141: (NIL|nil) {
   142: 	*lvalp = NIL;
   143: 	return NIHIL;
   144: }
   145: 
   146: \"[^\"]*\" {
   147: 	size_t len = strlen(yytext);
   148: 	char *s = lac_alloc(len - 1);
   149: 	memcpy(s, yytext+1, len - 2);
   150: 	*lvalp = lreg_raw(s, LREG_STRING);
   151: 	return STRING;
   152: }
   153: 
   154: (({DIGIT}+({SPECIAL}|{ALPHA}))|{ALPHA}|{SP_INIT})({SPECIAL}|{ALPHA}|{DIGIT})* {
   155: 	int i;
   156: 	size_t len = strlen(yytext);
   157: 	char *s = lac_alloc(len + 1);
   158: 	for (i = 0; i < len; i++)
   159: 		*(s+i) = toupper((int)*(yytext+i));
   160: 	*lvalp = intern_symbol(s);
   161: 	return SYMBOL;
   162: };
   163: 
   164: ,@ { return COMMA_AT; }
   165: 
   166: <<EOF>> { return ENDOFFILE; }
   167: 
   168: . { return *yytext; }
   169: 
   170: 
   171: %%