编译原理的一个简单的枚举算法

核心提示： 模仿C能判断#include<>;main();int;char;for;PRintf;scanf;{}; private //在str中找第一个单词 如果 找到则返回第一个单词的地址（phrase）和下一个要分析单词的入口（nextptr） //如果str是空串则返回false function p

 

模仿C

能判断#include<>;main();int;char;for;PRintf;scanf;{};

 private
  //在str中找第一个单词 如果 找到则返回第一个单词的地址（phrase）和下一个要分析单词的入口（nextptr）
　 //如果str是空串则返回false
　  function phrase(str:string;phrase,nextptr:pchar):bool; //
　  //括号匹配函数
　  //p；判断字符的地址，char：什么括号（包括：<>;()2种)，deep:允许嵌套么？匹配成功返回true;
　  function brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
　  function corbeil(r:trichedit;line,col:pinteger):bool; //line 返回出错的行,col返回出错的列;
　  function semicolon(p,next:pchar):bool;//p:入口地址  next:下一个字符的地址
　　 //semicolon　 如果没找到 返回false next=nil 找到其他字符 返回false且 next便指向他的下一个
　  function analys(sour,dest:trichedit):bool;

  public
　  { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function tform1.corbeil(r:trichedit;line,col:pinteger):bool;
var
n,l,i,c:integer;
temp:pchar;
ptr:pchar;
begin
i:=0;
c:=r.Lines.Count;
n:=0;
  while c>1 do
  begin
  getmem(temp,length(r.Lines.Strings[i])+1);
  strcopy(temp,pchar(r.Lines.Strings[i]));
  ptr:=temp;
  l:=length(r.Lines.Strings[i]);
　  while  l>1 do
　  begin
　　  if ptr^='{' then
　　  begin
　　  n:=n+1;
　　  end
　　  else
　　　  if ptr^='}'then
　　　  if n>0 then
　　　  n:=n-1
　　　  else
　　　　  begin
　　　　  result:=false;
　　　　  break;
　　　　  line^:=r.Lines.Count-c+1;
　　　　  col^:=length(r.Lines.Strings[i])-l+1;
　　　　  end;
　　　 l:=l-1;
　  end;// while  l>1 do
  freemem(temp);
  i:=i+1;
  c:=c-1;
  end;//while  line less than  linecount
if n=0 then
result:=true
else
result:=false;
end;

function tform1.phrase(str:string;phrase,nextptr:pchar):bool;
var
phr:pchar;
n:pchar;
temp:pchar;
ptr:pchar; //指向下一个要分析的单词的地址

begin
n:=' ';
str:=trim(str);
if length(str)<>0 then
begin
getmem(temp,length(str)+1);
strcopy(temp,pchar(str));
ptr:=strpos(temp,n);
getmem(phr,integer(ptr-temp)+1);
strlcopy(phr,temp,integer(ptr-temp));
phrase:=phr;
nextptr:=ptr;//是空格
result:=true;
end
else
result:=false;
freemem(temp);
end;
function tform1.brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
var
n,len:integer;
begin
len:=strlen(p)-1;
if deep=true then
  begin
  if p^='('then
　　  begin
　　　  n:=1;
　　　  while len>0 do
　　　　  begin
　　　　  p:=p+1;
　　　　  if p^='(' then
　　　　　　  n:=n+1
　　　　　  else
　　　　　　　 if p^=')' then
　　　　　　　 if n>0  then
　　　　　　　　　  n:=n-1
　　　　　　　 else
　　　　　　　 begin
　　　　　　　　 result:=false;
　　　　　　　　 next:=p+1;　 //不成功 flase next不为空表示)多余
　　　　　　　　 break;
　　　　　　　 end;

　　  end;  //while over;
　　　  if n>0 then
　　　  begin
　　　　  result:=false;
　　　　  next:=nil;//result=false且next为空表示(多余
　　　  end
　　　  else
　　　　  begin
　　　　  result:=true;　 //如果'('匹配成功则 true next 为 null
　　　　  next:=nil;
　　　　  end;//else
　　  end; //if p^='('then over

  end //if deep=true then over
else
if deep=false then
begin
  if  p^='<'  then
  begin
　  while len>0 do
　  begin
　　  len:=len-1;
　　  p:=p+1;
　　  if p^='>'then
　　  begin
　　　  result:=true;
　　　  break;
　　　  next:=p+1;　  //如果是'<'匹配成功,true且next指向下一个要分析的字符
　　  end;  //　  if p^='>'then
　  end;//while len>0 do
　  if len=0 then
　  begin
　  result:=false;
　  next:=nil;
　  end;//len=0 over
　  end// if
  else　 //如果第一个字符不是‘<’ 则返回错误 并带回下一个 指针
  begin
　  result:=false;
　  next:=p+1;

  end; //

end; //if deep=false then ovser

end;　 //function over;
function tform1.semicolon(p,next:pchar):bool;//p:入口地址
var
temp,ptr:pchar;
i:integer;
begin
i:=strlen(p);
while i>1 do
begin
if p^=';'then
begin
result:=true;
next:=p+1;
break;
end;//if p^=';'then
if  p^=' 'then
begin
i:=i-1;
p:=p+1;

end;// if  p^=' '
if ((p^<>' ')or (p^<>';'))then
begin
result:=false;
next:=p+1;
break;
end;
end;//while
if i=1  then
begin
result:=false;
next:=nil;
end;
end;//function semicolon(p:pchar)over;
function analys(sour,dest:trichedit):bool;
var
able,unable:bool;
lcount,lWords,i :integer;
phr,nextp:pchar;
phr2,nextp2,temp21,temp22:pchar;
phr3,nextp3:pchar;
braket:char;
s:string;
begin
temp21:=nil;
temp22:=nil;
able:=true;
unable:=false;
lcount:=sour.Lines.Count;
i:=0;
while lcount >1 do
  begin
  s:=sour.Lines.Strings[i];  //将行赋给 s
  if trim(pchar(s))<>nil then　  //非空串
　  begin

　  if phrase(s;phr;nextp)=true then //如果还有字符
　  //以下开始处理标志符识别和简单的语法分析
　　　  begin
　　　  if phr^='#' then
　　　　　  begin　　 //判断下一个字符是不是include
　　　　　  if phrase(nextp,phr2,nextp2)=true then
　　　　　　　  begin
　　　　　　　  if phr2='include' then　 //找下一个非空字符
　　　　　　　　　  begin
　　　　　　　　　  while ((nextp2^=' ')and (strlen(nextp2)<>0))do
　　　　　　　　　　　　  begin
　　　　　　　　　　　　  temp22:= nextp2;
　　　　　　　　　　　　  nextp2:=nextp2+1;
　　　　　　　　　　　　  end; //　 while nextp2^<>' 'over
　　　　　　　　　　 if nextp2^<>' 'then ////调用尖括号识别函数
　　　　　　　　　　　  begin
　　　　　　　　　　　  braket:='<';
　　　　　　　　　　　  if brakmatch(nextp2,braket,unabel)=true then
　　　　　　　　　　　  begin

　　　　　　　　　  end;

　　　　　　　　　  end;
　　　　　　　　　  end;//  if phr2='include' then over
　　　　　　　  end;

　　　  end;
　　　  end;
　  end;
  end;//while  lcount >1
end;