Трансляция. Сканер, сам сканер
Самиздат:
[Регистрация]
[Найти]
[Рейтинги]
[Обсуждения]
[Новинки]
[Обзоры]
[Помощь|Техвопросы]
Продолжение текста "Трансляция языков программирования".
Размещаю здесь исходник живого сканера
для экспериментального обьектно-ориентированного яз. программирования.
По моему глубокому убеждению, программирование тоже вид (художественной) литературы,
как и физика и математика.
И программы предназначены для чтения их именно людьми.
Только в этом случае они имеют шанс правильно работать на машине.
Впр, два последних утверждения придумал не я:).
Сканер годится для любого языка построчной буквенной записи, он инвариантен. Итак:
/* 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Ќ"''????'"Љ'?-"??"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( 'Љ' , &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
Связаться с программистом сайта.