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

【 tulaoshi.com - 编程语言 】

　　模仿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 c1 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  l1 do
　　    begin
　　      if ptr^='{' then
　　      begin
　　      n:=n+1;
　　      end
　　      else
　　        if ptr^='}'then
　　        if n0 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  l1 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 len0 do
　　          begin
　　          p:=p+1;
　　          if p^='(' then
　　              n:=n+1
　　            else
　　               if p^=')' then
　　               if n0  then
　　                    n:=n-1
　　               else
　　               begin
　　                 result:=false;
　　                 next:=p+1;   //不成功 flase next不为空表示)多余
　　                 break;
　　               end;

　　          end;  //while over;
　　        if n0 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 len0 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 len0 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 i1 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;