home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / glisp / glisp.000 / GLISP.UNIX.TAR / closunix / closyacc.y < prev    next >
Encoding:
Lex Description  |  1995-04-03  |  5.2 KB  |  195 lines
  1. %{
  2. /*                 GRAPHIC LISP            */
  3. /*        Scritto nel 1991-94 da Zoia Andrea Michele     */
  4. /*        Via Pergola #1 Tirano (SO) Tel. 0342-704210    */
  5. /* file closyacc.y */
  6.  
  7.  
  8. #include"clos.h"
  9. #include"closerr.h"
  10.  
  11. #define YYMAXDEPTH     1000    /* Yacc stack depth */
  12. #define PROMPT          { sprintf(buf1,"%s",yacc_prompt);\
  13.                           lisp_print_string(buf1,yacc_fileout);}
  14. #define PROMPTP         { sprintf(buf1,"%u%s",parcount,yacc_prompt);\
  15.                           lisp_print_string(buf1,yacc_fileout);}
  16.  
  17. extern     int     parcount;
  18. int         yywrapcalled;
  19. node         yyret;
  20. char        *yacc_prompt;
  21. FILE        *yacc_filein;
  22. FILE        *yacc_fileout;
  23.  
  24. int yywrap();
  25. int yyerror();
  26.  
  27. node input_func(fin,fout,pr)
  28. FILE *fin;
  29. FILE *fout;
  30. char *pr;
  31. {
  32.  yacc_filein=fin;yacc_fileout=fout;
  33.  parcount=0;yacc_prompt=pr;
  34.  yywrapcalled=FALSE;
  35.  /* 1) */
  36.  PROMPT;
  37.  /******/
  38.  if(yyparse()){ /* error... */
  39.         if(yywrapcalled)
  40.                 error(E_EOF,ERR_MERROR|ERR_PVOID|ERR_TNORM,NULL);
  41.     else{
  42.                 error(E_YACCSTACK,ERR_MERROR|ERR_PVOID|ERR_TNORM,NULL);
  43.                 /* svuota il buffer d'ingresso */
  44.                 while(lisp_get_char(yacc_filein)!='\n');
  45.         }
  46.         PROMPT;
  47.         /* ritorna al main-loop */
  48.         error(E_ZERO,ERR_MNONE|ERR_PVOID|ERR_TBLVL,NULL);
  49.  }
  50.  /*if(yyret==VOID){*/
  51.    /* 2) ho levato questo prompt mentre l'error era gia' stato tolto prima*/
  52.    /* dunque non serve piu' nemmeno l'if */
  53.    /*PROMPT;*/
  54.    /******************************************************************/
  55.    /* ritorna al main-loop */
  56.    /* error(E_ZERO,ERR_MNONE|ERR_PVOID|ERR_TBLVL,NULL); */
  57.  /*}*/
  58.  return yyret;
  59. }
  60.  
  61. int yywrap()
  62. { return yywrapcalled=TRUE; }
  63.  
  64. int yyerror(s)
  65. char *s;
  66. { return TRUE; }
  67.  
  68. %}
  69.  
  70. %union{
  71.     char        *ident;
  72.     double        real;
  73.     long int    integer;
  74.     node        s_expr;
  75. }
  76.  
  77. %token    <ident>        IDENTIFIER_YY
  78. %token    <ident>        STRING_YY
  79. %token    <integer>    INTEGER_YY
  80. %token    <real>        REAL_YY
  81. %token    <integer>    BAD_CHAR_YY
  82. %token  <foo1>             BAD_STRING_YY
  83. %token  <foo2>             BAD_SQB_YY
  84.  
  85. %type    <s_expr>    atom
  86. %type    <s_expr>    list
  87. %type    <s_expr>    macro
  88. %type    <s_expr>    sexpr
  89.  
  90. %start    ass
  91. %%
  92.  
  93. ass    : n sexpr '\n'  
  94.   /* 3) ho messo n alla fine in modo da svuotare il buffer */
  95.                 {yyret=$2;YYACCEPT;}
  96.     | error '\n'            
  97.         { error(E_SYNTAX,ERR_MERROR|ERR_PVOID|ERR_TNORM,NULL);
  98.                   yyret=VOID;YYACCEPT;
  99.         }
  100.     ;
  101.  
  102. sexpr    : atom            {$$=$1;}
  103.     | macro            {$$=$1;}
  104.     | '(' list        {$$=$2;}
  105.     ;
  106.  
  107. atom    : INTEGER_YY        
  108.                 { TYPE($$=node_make())|=NT_IS_VALUE+NT_INTEGER;
  109.                   INTEGER($$)=$1;
  110.                 }
  111.         | REAL_YY
  112.                 { TYPE($$=node_make())|=NT_IS_VALUE+NT_REAL;
  113.                   REAL($$)=$1;
  114.                 }
  115.         | STRING_YY
  116.                 { $$=node_make();STRING($$)=string_put($1,$$);
  117.                   TYPE($$)|=NT_IS_VALUE+NT_STRING;
  118.                 }
  119.         | IDENTIFIER_YY
  120.                 { $$=node_alloc($1);
  121.                 }
  122.         | BAD_CHAR_YY error '\n'
  123.                 { sprintf(buf1,"Char '%c' ascii %i",(char)$1,(int)$1);
  124.                   error(E_BADCH,ERR_MERROR|ERR_TNORM|ERR_PSTRING,buf1);
  125.                   yyret=VOID;YYACCEPT;
  126.                 }
  127.         | BAD_STRING_YY
  128.                 {
  129.                   error(E_BADSTRING,ERR_MERROR|ERR_TNORM|ERR_PVOID,NULL);
  130.                   yyret=VOID;YYACCEPT;
  131.                 }
  132.         | BAD_SQB_YY error '\n'
  133.         {
  134.                   error(E_INVALIDSQB,ERR_MERROR|ERR_TNORM|ERR_PVOID,NULL);
  135.                   yyret=VOID;YYACCEPT;
  136.                 }
  137.     ;
  138.  
  139. macro   : '&' sexpr
  140.                 { TYPE($$=node_make())|=NT_IS_VALUE+NT_ENAME;
  141.                   ENAME($$)=$2;
  142.                 }
  143.         | ':' sexpr
  144.                 { TYPE($$=node_make())|=NT_IS_VALUE+NT_CNAME;
  145.                   ENAME($$)=$2;
  146.                 }
  147.         | '\'' sexpr
  148.                 { $$=node_make();CONSLEFT($$)=node_alloc("QUOTE");
  149.                   CONSRIGHT($$)=node_make();CONSLEFT(CONSRIGHT($$))=$2;
  150.                   CONSRIGHT(CONSRIGHT($$))=NIL;
  151.                   TYPE($$)|=NT_IS_CONS;TYPE(CONSRIGHT($$))|=NT_IS_CONS;
  152.                 }
  153.         | ',' sexpr
  154.                 { $$=node_make();CONSLEFT($$)=node_alloc("COMA");
  155.                   CONSRIGHT($$)=node_make();CONSLEFT(CONSRIGHT($$))=$2;
  156.                   CONSRIGHT(CONSRIGHT($$))=NIL;
  157.                   TYPE($$)|=NT_IS_CONS;TYPE(CONSRIGHT($$))|=NT_IS_CONS;
  158.                 }
  159.     | '~' sexpr
  160.         { $$=node_make();CONSLEFT($$)=node_alloc("BACKQUOTE");
  161.           CONSRIGHT($$)=node_make();CONSLEFT(CONSRIGHT($$))=$2;
  162.           CONSRIGHT(CONSRIGHT($$))=NIL;
  163.           TYPE($$)|=NT_IS_CONS;TYPE(CONSRIGHT($$))|=NT_IS_CONS;
  164.         }
  165.         | '#' '\'' sexpr
  166.                 { $$=node_make();CONSLEFT($$)=node_alloc("FUNCTION");
  167.                   CONSRIGHT($$)=node_make();CONSLEFT(CONSRIGHT($$))=$3;
  168.                   CONSRIGHT(CONSRIGHT($$))=NIL;
  169.                   TYPE($$)|=NT_IS_CONS;TYPE(CONSRIGHT($$))|=NT_IS_CONS;
  170.                 }
  171.     ;
  172.  
  173. list    : n sexpr list
  174.                 { TYPE($$=node_make())|=NT_IS_CONS;
  175.                   CONSLEFT($$)=$2;CONSRIGHT($$)=$3;
  176.                 }
  177.         | n ')' { $$=NIL;}
  178.         | n sexpr n '.' n sexpr n ')'
  179.                 { TYPE($$=node_make())|=NT_IS_CONS;
  180.                   CONSLEFT($$)=$2;CONSRIGHT($$)=$6;
  181.                 }
  182.         ;
  183.  
  184. n    :
  185.         | n '\n'
  186.                 { if(parcount)
  187.                      PROMPTP
  188.                   else
  189.                      PROMPT
  190.                 }
  191.     ;
  192.  
  193. %%
  194.  
  195.