lac : 122a546a03cefbd5361139a40f67f37c6c9f40a0

     1: /*
     2:    lac -- a lisp interpreter library
     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: #include <stdio.h>
    22: #include <string.h>
    23: #include <gc/gc.h>
    24: #include "lac.h"
    25: #include "sexpr_parse.h"
    26: 
    27: int yylex(lreg_t *, void *);
    28: void yyerror (lreg_t *lr, void *scanner, const char *msgp)  /* Called by yyparse on error */
    29: {
    30: }
    31: 
    32: %}
    33: 
    34: %defines
    35: %define api.pure full
    36: %define api.value.type { lreg_t }
    37: %parse-param { lreg_t *result }
    38: %param { void *scan }
    39: 
    40: %token ENDOFFILE
    41: %token NIHIL
    42: %token STRING
    43: %token INTEGER
    44: %token SYMBOL
    45: %token DELIMITER
    46: %token COMMA_AT
    47: 
    48: %%
    49: 
    50: input: | input ENDOFFILE { return -1;}
    51:        | input sexpr     { *result = $2; YYACCEPT;};
    52: 
    53: sexpr: atom ;
    54:        | '\'' sexpr { $$ = cons(sym_quote, cons($2, NIL)); }
    55:        | '`' sexpr { $$ = cons(sym_quasiquote, cons($2, NIL)); }
    56:        | COMMA_AT sexpr { $$ = cons(sym_splice, cons($2, NIL)); }
    57:        | ',' sexpr { $$ = cons(sym_unquote, cons($2, NIL)); }
    58:        | '(' sexpr '.' sexpr ')' { $$ = cons($2,$4); }
    59:        | '(' ')' { $$ = NIL; }
    60:        | list { $$ = $1; }
    61: 
    62: list: '(' sexpr listelem ')' { $$ = cons($2,$3); }
    63: ;
    64: listelem: /*EMPTY*/ { $$ = NIL; }
    65:           | sexpr listelem { $$ = cons($1,$2); }
    66: 
    67: atom: SYMBOL | STRING | INTEGER | NIHIL
    68: 
    69: %%
    70: 
    71: void yylex_init(void **);
    72: void yyset_in(FILE *, void *);
    73: void yylex_destroy(void *);
    74: 
    75: 
    76: /*
    77:  * Read
    78:  */
    79: 
    80: void
    81: sexpr_read_start(FILE *f, void **yyscan)
    82: {
    83: 
    84:     yylex_init(yyscan);
    85:     yyset_in(f, *yyscan);
    86: }
    87: 
    88: int
    89: sexpr_read(lreg_t *res, void *yyscan)
    90: {
    91:     int r;
    92: 
    93:     r = yyparse(res, yyscan);
    94:     switch (r) {
    95:     case 0:
    96: 	return 1;
    97:     case -1:
    98: 	return 0;
    99:     case 1: /* Syntax Error */
   100:     case 2: /* Memory Exhaustion */
   101:     default: /* Unknown */
   102: 	raise_exception("parser error", NIL);
   103: 	/* Not reached. */
   104: 	return 0;
   105:     }
   106: }
   107: 
   108: void
   109: sexpr_read_stop(void *yyscan)
   110: {
   111: 
   112:     yylex_destroy(yyscan);
   113: }
   114: 
   115: 
   116: /*
   117:  * Print
   118:  */
   119: 
   120: static void sexpr_print_cons(FILE *f, lreg_t lr, const char *h)
   121: {
   122:   lreg_t a = car(lr);
   123:   lreg_t d = cdr(lr);
   124: 
   125:   printf(h);
   126:   sexpr_print(f, a);
   127: 
   128:   if (d == NIL) {
   129:     fprintf(f, ")");
   130:     return;
   131:   }
   132: 
   133:   if (lreg_raw_type(d) == LREG_CONS)
   134:     sexpr_print_cons(f, d, " ");
   135:   else
   136:     {
   137:       fprintf(f, " . ");
   138:       sexpr_print(f, cdr(lr));
   139:       fprintf(f, ")");
   140:     }
   141: }
   142: 
   143: void sexpr_print(FILE *f, lreg_t lr)
   144: {
   145:   switch ( lreg_type(lr) )
   146:     {
   147:     case LREG_NIL:
   148:       fprintf(f, "()");
   149:       break;
   150:     case LREG_SYMBOL:
   151:       fprintf(f, "%s", (char *)lreg_raw_ptr(lr));
   152:       break;
   153:     case LREG_STRING:
   154:       fprintf(f, "\"%s\"", (char *)lreg_raw_ptr(lr));
   155:       break;
   156:     case LREG_CONS:
   157:       sexpr_print_cons(f, lr, "(");
   158:       break;
   159:     case LREG_MACRO:
   160:       fprintf(f, "<#MACRO>");
   161:       break;
   162:     case LREG_LAMBDA:
   163:       fprintf(f, "<#LAMBDA>");
   164:       break;
   165:     case LREG_LLPROC:
   166:       fprintf(f, "<#LLPROC>");
   167:       break;
   168:     default:
   169:       if ( !lac_extty_print(f, lr) )
   170: 	fprintf(f, "<??? %d>",(int)lreg_type(lr));
   171:     }
   172:   return;
   173: }