Титов Александр Алексеевич : другие произведения.

Трансляция. Сканер, сам сканер

Самиздат: [Регистрация] [Найти] [Рейтинги] [Обсуждения] [Новинки] [Обзоры] [Помощь|Техвопросы]
Ссылки:
Школа кожевенного мастерства: сумки, ремни своими руками
 Ваша оценка:

Продолжение текста "Трансляция языков программирования". 
Размещаю здесь исходник живого сканера 
для экспериментального обьектно-ориентированного яз. программирования. 
По моему глубокому убеждению, программирование тоже вид (художественной) литературы, 
как и физика и математика. 
И программы предназначены для чтения их именно людьми. 
Только в этом случае они имеют шанс правильно работать на машине. 
Впр, два последних утверждения придумал не я:).

 Сканер годится для любого языка построчной буквенной записи, он инвариантен. Итак:

/*                    SCANNER PROGRAMS                        */
/*                    ----------------                        */
#include 
#include 
#include 
#include 
#include 

#include "d_scncnst.h"    /* Scanner consts            */

/* LIST BUILDER IMPORT */
#include "d_blddefs.h"
#include "d_bldexts.h"

/* MEMORY MANAGEMENT IMPORT */
#include "d_memdefs.h"

/* BUILT-IN FUNCT IMPORT */
#include "d_bfnexts.h"    /* functs extrn definition   */

/* OWN DEFS */
#include "d_scnvars.h"    /* Vars                      */

int ineof()
{
 return(feof(instream)||inend||ferror(instream));
};

void nextchr()
{
 void flushstr(),testchr(),skipcomment(),regchr();

 curchr=fgetc(instream);
 regchr();
 testchr();
};

void regchr()
{
 if ((curchr==eofchr)||feof(instream)||ferror(instream))
 {
     chartype=eoftyp;
     inend=YES;
     CL=EofL;
     if (instrlen!=0)
     {  /* for files without any terminators */
        instring[instrlen]='\000';
        flushstr();
        instrlen=0;
        curpos=-1;
     };
 };
 if (curchr==eolnchr)
 {
    instring[instrlen]='\000';
    flushstr();
    instrlen=0;
    curpos=-1;
 }
 else
 {
    instring[instrlen]=curchr;
    instrlen++;
    curpos++;
 };
};

void skipblancs()
{
 void flushstr(),testchr(),regchr();

 nxtchr=fgetc(instream);
 ungetc(nxtchr,instream);
 do
 {
   if ( (curchr=='-')&&(nxtchr=='-') )
   {
         while ( (curchr!=eolnchr) && (!ineof()) )
         {
                  curchr=fgetc(instream);
                  regchr();
         };
   };
   while ( (curchr==eolnchr)||(curchr==' ')||(curchr==tabchr) )
   {
      curchr=fgetc(instream);
      regchr();
   };
   nxtchr=fgetc(instream);
   ungetc(nxtchr,instream);
 } while ((curchr=='-')&&(nxtchr=='-'));
 testchr();
 nxtchr=curchr; /* for name using */
};

void testchr()
{
 int ic;

 if (!ineof())
 {
      if (instr(curchr,letters))
      {
          chartype=alfa;
          /* Transl lowers to uppers english only    */
          /* Do not translate inside of strings      */
          if (!InsideString)
          {
             ic=(int)(curchr);
             if ((ic>=97)&&(ic<=122)) curchr=(char)(ic-(97-65));
          };
      }
      else
          if (instr(curchr,Sdecs)) {chartype=Sdec;}
          else
             if (instr(curchr,Sbins)) {chartype=Sbin;}
             else
                if ( (curchr=='"') || (curchr=='\'') ) {chartype=quote;}
                else
                   chartype=untest;
 }  /* if not ineof */
 else {CL=EofL;};
};

void getstring()
{
 void getchr(),err();
 char sterm;

 instringlen=0;
 InsideString=YES;
 sterm=curchr;
 nextchr();
 while ( (curchr!=sterm)&&(!ineof())&&(curchr!=eolnchr) )
 {
       if (instringlenmaxvaluel)
 {
    err(34);
 }
 else
 {
    coldigit++;
    digit[coldigit]=curchr;
 };
};

int isint_OK(digit,flag)
long int digit;
int *flag;
{
 if(*flag==NO)
    if(digit > MAX_INT)
      {
        err(34);
        *flag=YES;
        return YES;
      }
    else
      return NO;
 return YES;
};

void calculate()
{
 void err();
 int isint_OK();

 int i,flerror;
 long int numi,step;
 float pointstep;
 float numr;

 flerror=NO;
 switch(valtype)
  {
    case binary:
                numi=0;
                step=1;
                for(i=coldigit-1;i>=0;i--)
                   {
                     if(isint_OK(numi,&flerror)==YES) break;
                     if(isint_OK(step,&flerror)==YES) break;
                     numi+=(int)(digit[i]-'0')*step;
                     step*=2;
                   };
                if(isint_OK(numi,&flerror)==NO)
                  {
                    curtype=integer;
                    curint=(int)(numi);
                  };
                break;
    case integer:
                 numi=0;
                 curtype=integer;
                 if(posmant==-1)
                    for(i=0;i<=coldigit;i++)
                     {
                        if(isint_OK(numi,&flerror)==YES) break;
                        numi=numi*10+(int)(digit[i]-'0');
                     }
                 else
                 {
                    for(i=0;i=0;i--)
                  {
                   if(digit[i]!='H')
                   {
                    if((int)(digit[i]-'0')<=9)
                     {
                       if(isint_OK(numi,&flerror)==YES) break;
                       numi+=(int)(digit[i]-'0')*step;
                     }
                    else
                     {
                       if(isint_OK(numi,&flerror)==YES) break;
                       numi+=((int)(digit[i]-'A')+10)*step;
                     };
                    if(isint_OK(step,&flerror)==YES) break;
                    step*=16;
                   };
                  };
                 if(isint_OK(numi,&flerror)==NO)
                  {
                   curtype=integer;
                   curint=(int)(numi);
                  };
                break;
    default:
             break;
  };
 /*chk
 switch (curtype) {
 case integer:
              printf("Integer = %i\n",curint);
    break;
 case real:
              printf("Real = %f\n",curfloat);
    break;
 default:
    break;
 };   endswitch *chk*/
};

void err(errcode)
int errcode;
{
 int cp;

 comperr=YES;
 errset[errcount]=errcode;
 cp=curpos;
 if (cp<0) cp=0;
 errmark[cp]=errsign;
 if (errcount0)
 {
    for (i=0;i1) fprintf(outstream,"s");
    fprintf(outstream,":\n");
    for (i=0;i rus blocked
 letters=(char*)&("@$_qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM?жгЄҐґєий?едл? Їаў"?їнпзб?Ёвм?о%-"?...??NoTЌ"''????'"No'?-"??"R?"");
 */
 digits=(char*)&("0123456789");
 Sbins =(char*)&("01");
 Sdecs =(char*)&("23456789");
 Shexs =(char*)&("ABCDEF");
 hexs  =(char*)&("0123456789ABCDEF");
        /* Diring lexs chgs REMEMBER for d_scncnst.h maxlexs,maxpairs chg ! */
 BadL=      (int)('@');
 EofL=      (int)('B');
 SidL=      (int)('I');
 StringL=   (int)('A');
 /*                                                                       */
 /*       Lexema's     His        Lexema's  & his          Corresponding  */
 /*       code         mnemonic   uppercase   Gen-List     built-in       */
 /*                                           uppercase    function       */
 /*-----------------------------------------------------------------------*/
 mlexs=0;
 setlex(     'D'   ,   &UseL       ,   "USE"    ,"USE"    , known            );
 setlex(     'E'   ,   &DoL        ,   "DO"     ,"REPEAT" , repeatF          );
 setlex(     'E'   ,   &DoL        ,   "REPEAT" ,"REPEAT" , repeatF          );
 setlex(     'E'   ,   &DoL        ,   "USE"    ,"REPEAT" , repeatF          );
 /* "BREAK" not supported
 setlex(     'F'   ,   &BreakL     ,   "BREAK"  ,"BREAK"  , breakF           );
 */
 setlex(     'G'   ,   &ForallL    ,   "FORALL" ,"FORALL" , (fsubr)NULL      );
 setlex(     'H'   ,   &IfL        ,   "IF"     ,"WHEN"   , when             );
 setlex(     'H'   ,   &IfL        ,   "WHEN"   ,"WHEN"   , when             );
 /* "ON" not supported
 setlex(     'C'   ,   &OnL        ,   "ON"     ,"ON"     , on               );
 */
       /*     J    */
 setlex(     'K'   ,   &SwitchL    ,   "CASES"  ,"CASES"  , CASES            );
 setlex(     'L'   ,   &AllknownL  ,   "ALLKNOWN","ALLKNOWN", KnownInNom     );
       lextype[AllknownL]=Multiname;
 setlex(     '?'   ,   &ShowL      ,   "DISPLAY","DISPLAY", display          );
 setlex(     'N'   ,   &YesL       ,   "YES"    ,"YESCHECK",YESCHECK         );
       lextype[YesL ]=YNN;
 setlex(     'O'   ,   &NoL        ,   "NO"     ,"NOCHECK", NOCHECK          );
       lextype[NoL  ]=YNN;
 setlex(     'P'   ,   &NilL       ,   "NIL"    ,"NILCHECK",NILCHECK         );
       lextype[NilL ]=YNN;
 setlex(     'Q'   ,   &WhileL     ,   "WHILE"  ,"WHILE"  , (fsubr)NULL      );
 setlex(     'R'   ,   &UntilL     ,   "UNTIL"  ,"UNTIL"  , (fsubr)NULL      );
 setlex(     'E'   ,   &RepeatL    ,   "REPEAT" ,"REPEAT" , repeatF          );
 setlex(     'S'   ,   &ArgL       ,   "ARG"    ,"ARG"    , arg              );
 setlex(     'T'   ,   &AllL       ,   "ALL"    ,"ALL"    , AllInNom         );
       lextype[AllL   ]=Multiname;
 setlex(     'U'   ,   &SubtreeL   ,   "SUBTREE","SUBTREE", subtree           );
       lextype[SubtreeL]=Multiname;
 ValueL =   (int)('V');
 StringL=   (int)('W');
 setlex(     'X'   ,   &AsL        ,   "AS"     ,"AS"     , as                );
       lextype[AsL  ]=Relation;
 setlex(     'Y'   ,   &InL        ,   "IN"     ,"IN"     , in                );
       lextype[InL  ]=Relation;
 setlex(     'Z'   ,   &OrL        ,   "OR"     ,"OR"     , or                );
       lextype[OrL  ]=AddOp;
 setlex(     '&'   ,   &AndL       ,   "AND"    ,"AND"    , and               );
 AndL    =  (int)('&');   lextype[AndL  ]=MulOp;
 setlex(     'H'   ,   &IfL        ,   "WHERE"  ,"WHEN"   , when              );
 setlex(     '~'   ,   &NotL       ,   "NOT"    ,"NOT"    , not               );
 setlex(     '?'   ,   &OwnersL    ,   "OWNERS" ,"OWNERS" , owners            );
       lextype[OwnersL]=Multiname;
 setlex(     '?'   ,   &WithL      ,   "WITH"   ,"WITH"   , with              );
 setlex(     '''   ,   &ExistL     ,   "EXIST"  ,"EXIST"  , EXIST             );
 setlex(     '?'   ,   &CaseL      ,   "CASE"   ,"CASE"   , CASEF             );
 setlex(     '"'   ,   &ForL       ,   "FOR"    ,"FOR"    , (fsubr)NULL       );
 setlex(     '...'   ,   &OtherL     ,   "OTHER"  ,"OTHER"  , (fsubr)NULL       );
 setlex(     '...'   ,   &OtherL     ,   "OTHERS" ,"OTHER"  , (fsubr)NULL       );
 setlex(     'No'   ,   &ToL        ,   "TO"     ,"TO"     , (fsubr)NULL       );
 setlex(     'Ќ'   ,   &ByL        ,   "BY"     ,"BY"     , (fsubr)NULL       );
 setlex(     'Ќ'   ,   &ByL        ,   "STEP"   ,"BY"     , (fsubr)NULL       );
 setlex(     '?'   ,   &IncL       ,   "INC"    ,"INC"    , inc               );
 setlex(     '?'   ,   &DecL       ,   "DEC"    ,"DEC"    , dec               );
 setlex(     '''   ,   &ThenL      ,   "THEN"   ,"THEN"   , (fsubr)NULL       );
 setlex(     '?'   ,   &ElseL      ,   "ELSE"   ,"ELSE"   , (fsubr)NULL       );
 setlex(     '?'   ,   &ThisL      ,   "THIS"   ,"THIS"   , THISF             );
 setlex(     '?'   ,   &KnowninL   ,   "KNOWNIN","KNOWNIN", knownin           );
       lextype[KnowninL]=Relation;
 setlex(     '?'   ,   &KnownL     ,   "KNOWN"  ,"KNOWN"  , namef             );
 setlex(     '"'   ,   &ChangeL    ,   "CHANGE" ,"CHANGE" , changef           );
 setlex(     '"'   ,   &AddL       ,   "ADD"    ,"ADDSET" , addf              );
 setlex(     '"'   ,   &FromL      ,   "FROM"   ,"FROM"   , (fsubr)NULL       );
 setlex(     '"'   ,   &DeleteL    ,   "DELETE" ,"DELETE" , deletef           );
 setlex(     ''   ,   &KillL      ,   "KILL"   ,"KILL"   , killf             );

 mpairs=0;
 setpair(     'a'   ,       &GeL        ,   ">=" ,"GE"    , ge                );
        lextype[GeL  ]=Relation;
 setpair(     'b'   ,       &LeL        ,   "<=" ,"LE"    , le                );
        lextype[LeL  ]=Relation;
 setpair(     'c'   ,       &NeL        ,   "~=" ,"NE"    , ne                );
 setpair(     'c'   ,       &NeL        ,   "<>" ,"NE"    , ne                );
        lextype[NeL  ]=Relation;
 setpair(     'd'   ,       &ShowdL     ,   "?!" ,"Ddisplay"  , ddisplay      );
 setpair(     'e'   ,       &ShowcL     ,   "??" ,"CONSOLE"   , CONSOLE       );
 setpair(     'f'   ,       &Equ2L      ,   "==" ,"SAMEAS"    , SAMEAS        );

 LbracL  =  (int)('[');
 RbracL  =  (int)(']');
 MinusL  =  (int)('-');   lextype[MinusL]=AddOp;   setfunct(MinusL,"SUB",sub);
 PlusL   =  (int)('+');   lextype[PlusL ]=AddOp;   setfunct(PlusL ,"ADD",add);
 Dot2L   =  (int)(':');
 EquL    =  (int)('=');   lextype[EquL  ]=Relation;setfunct(EquL  ,"EQU",equ);
 LparL   =  (int)('(');
 RparL   =  (int)(')');
 LsparL  =  (int)('{');
 RsparL  =  (int)('}');
 SemiL   =  (int)(';');
 CommaL  =  (int)(',');
 NumL    =  (int)('#');                         setfunct(NumL  ,"NUM",NUM);
 DotL    =  (int)('.');
 PrevL   =  (int)('^');   lextype[PrevL ]=UpOp; setfunct(PrevL ,"PREV",prev);
 BslaL   =  (int)('\\');  lextype[BslaL ]=UpOp; setfunct(BslaL ,"GLBL",glbl);
 OnlyoneL=  (int)('!');   setfunct(OnlyoneL,"EXISTONE",EXISTONE);
 StarL   =  (int)('*');   lextype[StarL ]=MulOp;setfunct(StarL, "MUL",mul);
 SlashL  =  (int)('/');   lextype[SlashL]=MulOp;setfunct(SlashL,"DIV",divF);
 GtL     =  (int)('>');   lextype[GtL   ]=Relation;setfunct(GtL,   "GT" ,gt );
 LtL     =  (int)('<');   lextype[LtL   ]=Relation;setfunct(LtL,   "LT" ,lt );

/* Syntax analyzer errors */
outmsgerr[1]=(" ')' expected");
outmsgerr[2]=(" '[' expected");
outmsgerr[3]=(" ']' expected");
outmsgerr[4]=(" Simple name expected");
outmsgerr[5]=(" 'THIS' duplicated");
outmsgerr[6]=(" Syntax error");
outmsgerr[7]=(" 'OTHER' duplicated");
outmsgerr[8]=(" 'NIL' duplicated");
outmsgerr[9]=(" 'CASE' or 'NIL' or 'OTHER' expected");
outmsgerr[10]=(" 'CASE'or 'NIL'  expected");
outmsgerr[12]=(" 'YES' or 'NO' or 'NIL' duplicated");
outmsgerr[11]=(" ':' expected");
outmsgerr[13]=(" 'DO' or 'USE' expected");
outmsgerr[14]=(" '}' expected");
outmsgerr[15]=(" 'UNTIL' duplicated");
outmsgerr[16]=(" 'FOR' duplicated");
outmsgerr[17]=(" '=' expected");
outmsgerr[18]=(" 'TO' or 'BY' expected ");
outmsgerr[19]=(" 'WHILE' duplicated");
outmsgerr[20]=(" 'DO' expected");
/* chk outmsgerr[21]=(" Empty cycle");  */
outmsgerr[22]=(" 'DO' without conditions");
outmsgerr[23]=(" '(' expected");
outmsgerr[24]=(" '\\' or '^' duplicated");
outmsgerr[25]=(" Named object in the unnamed (simple block)");
outmsgerr[26]=(" Name defined in left part is not reassignable");
outmsgerr[27]=(" Empty file refering string specified");
outmsgerr[28]=(" Sorry, only string must be used now");
outmsgerr[29]=(" Missing list of designations");
outmsgerr[80]=(" Internal error 80");

/* Scanner errors */
outmsgerr[30]=(" Line too long");
outmsgerr[31]=(" End of string expected before the end of file or before the next string ");
outmsgerr[32]=(" Unknown constant qualifier");
outmsgerr[33]=(" Must be digit after 'E' ");
outmsgerr[34]=(" Value too big");
outmsgerr[35]=(" Source file not found");
outmsgerr[36]=(" Misplaced constant qualifier");
outmsgerr[37]=(" 'B' constant qualifier after constant which is not binary");
outmsgerr[38]=(" 1st relation operand is empty");
outmsgerr[39]=(" 2nd relation operand is empty");

outmsgerr[81]=(" Empty 'CASE'");
outmsgerr[82]=(" 'AS' or 'IN' expected");
outmsgerr[83]=(" 'AS' expected");
outmsgerr[84]=(" 'TO' expected");

/* Runtine errors */
outmsgerr[40]=("Not enough memory to run PL/D");
outmsgerr[41]=("Attempt to remove not used undefined-type value");
outmsgerr[42]=("Attempt to remove undefined-type value");
outmsgerr[43]=("Attempt to duplicate undefined-type value");
outmsgerr[44]=("Exemplar creating failure");

/* Externals linker errors */
outmsgerr[60]=(" Source file not found");

           /* Remember 'maxerrors' in D_SCNCNST.H; usually 127'th last */
           /* -------------------------------------------------------- */
};

void partiniscan()
/* Partial initialization goes before each file translating */
{
 int i;
 void nextchr();

 comperr=NO;
 errcount=0;
 instrlen=0;
 inend=NO;
 curpos=-1;
 chartype=eoftyp;
 InsideString=NO;
 nextchr();
 for (i=0;i



 Ваша оценка:

Связаться с программистом сайта.

Новые книги авторов СИ, вышедшие из печати:
О.Болдырева "Крадуш. Чужие души" М.Николаев "Вторжение на Землю"

Как попасть в этoт список