|
p align="left">Term_tab: array [1. MaxNum] of TTerm; // Таблица терминальныз символов Id_tab: array [1. MaxNum] of TId; // Таблица идентификаторов Const_tab: array [1. .50] of TConst; // Таблица констант Lexem,s,typel: string; // Лексема, Текст ошибки, Строка программы, Тип лексемы i,j,k,l,m,n,y,String_counter,constyes,termyes,hesh, // счетчики циклов и строк NumLex,{Число лексем}NumId,{Число идентификаторов}NumTerm,{Число терминальных символов}NumConst,{Число различных констант} NumErr{Число ошибочных лексем}: integer; Error,Found,Flag,Scobka: boolean; // Флаги str16: string; k1,kod: integer; implementation uses lex2; {$R *. dfm} procedure TForm1. N2Click (Sender: TObject); var i: integer; begin OpenDialog1. Filter: ='*. txt'; if opendialog1. Execute and fileExists (openDialog1. FileName) then begin Assignfile (FA, OpenDialog1. FileName); Reset (FA); Memo1. Lines. clear; i: =1; while not EOF (FA) do begin readln (Fa,SA [i]); Memo1. Lines. Add (SA [i]); i: =i+1; end; Closefile (FA); end; end; // процедура перевода констант в десятичную форму procedure perevod (SS: string; var Str16: string); var ch3,ch4,ch, i: integer; zn: string; begin ch: =0; // для римских констант if (SS [2] ='X') or (SS [2] ='V') or (SS [2] ='I') then begin zn: =SS [1] ; delete (SS,1,1); while Length (SS) <>0 do begin if SS [1] ='X' then begin ch: =ch+10; delete (SS,1,1); end else begin if SS [1] ='V'then begin ch: =ch+5; delete (SS,1,1); end else begin if ( (SS [1] ='I') and (SS [2] ='I')) or ( (SS [1] ='I') and (SS [2] ='')) then begin ch: =ch+1; delete (SS,1,1); end else begin if (SS [1] ='I') and (SS [2] ='X') then begin ch: =ch+9; delete (SS,1,2); end else begin if (SS [1] ='I') and (SS [2] ='V') then begin ch: =ch+4; delete (SS,1,2); end; end; end; end; end; end; str16: =zn+IntToStr (ch); exit; end; // для 16-рич. констант If SS [3] in ['0'. '9'] then ch3: =StrToInt (SS [3]) *16 else if SS [3] in ['A'. 'F'] then begin ch3: =ord (SS [3]); case ch3 of 65: ch3: =10*16; 66: ch3: =11*16; 67: ch3: =12*16; 68: ch3: =13*16; 69: ch3: =14*16; 70: ch3: =15*16; end; end; If SS [4] in ['0'. '9'] then ch4: =StrToInt (SS [4]) else if SS [4] in ['A'. 'F'] then begin ch4: =ord (SS [4]); case ch4 of 65: ch4: =10; 66: ch4: =11; 67: ch4: =12; 68: ch4: =13; 69: ch4: =14; 70: ch4: =15; end; end; ch: =ch3+ch4; If (SS [3] ='0') and (SS [4] ='0') then Str16: =IntToStr (ch) else Str16: =SS [2] +IntToStr (ch); end; procedure TForm1. N3Click (Sender: TObject); begin close; end; function Select_Lex (S: string; {исх. строка} var Rez: string; {лексема}N: integer {текущая позиция}): integer; label 1; begin // функция выбора слов из строки k: = Length (S); Rez: =''; i: =N; // точка продолжения в строке while (S [i] =' ') and (i<= k) do i: =i+1; // пропуск ' ' while not (S [i] in deleter) and (i<= k) do // накопление лексемы begin if s [i] ='$' then begin Rez: =s [i] +s [i+1] ; i: =i+2; end else begin 1: Rez: =Rez+s [i] ; i: =i+1; end; end; if Rez='' then begin if (s [i] =': ') then begin if (s [i+1] ='=') then // в случае операции из двух символов begin Rez: =s [i] +s [i+1] ; Select_Lex: =i+2; end else begin Rez: =s [i] ; Select_Lex: =i+1; end; end else begin if ( (s [i] ='+') or (s [i] ='-')) and (s [i-1] =' (') then begin Rez: =s [i] +s [i+1] ; i: =i+2; goto 1; end else begin Rez: =s [i] ; Select_Lex: =i+1; end; end; end else Select_Lex: =i; end; procedure Add_Const (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево begin if NumConst=1 then // Если корень дерева еще не создан, то создаем его. begin perevod (str_lex,str16); Const_tab [NumConst]. value: =str_lex; Const_tab [NumConst]. nomer: =NumConst; Const_tab [NumConst]. Val10: =str16; Const_tab [NumConst]. Left: =0; Const_tab [NumConst]. Right: =0; Const_tab [NumConst]. Way: ='V'; Exit; end; if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого if Const_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то begin perevod (str_lex,str16); Const_tab [Curr_term]. Left: =NumConst; // Создание левого элемента. Const_tab [NumConst]. value: =str_lex; Const_tab [NumConst]. nomer: =NumConst; Const_tab [NumConst]. Val10: =str16; Const_tab [NumConst]. Left: =0; Const_tab [NumConst]. Right: =0; Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L'; end else begin Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'L'; Add_Const (Const_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя. end; if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то if Const_tab [Curr_term]. Right=0 then begin perevod (str_lex,str16); Const_tab [Curr_term]. Right: =NumConst; // Создаем правый элемент. Const_tab [NumConst]. value: =str_lex; Const_tab [NumConst]. nomer: =NumConst; Const_tab [NumConst]. Val10: =str16; Const_tab [NumConst]. Left: =0; Const_tab [NumConst]. Right: =0; Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R'; end else begin Const_tab [NumConst]. Way: =Const_tab [NumConst]. Way+'R'; Add_Const (Const_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя. end; end; procedure Add_Term (Curr_term: integer; str_lex: string); // Процедура добавления идентификаторов в дерево begin if NumTerm=1 then // Если корень дерева еще не создан, то создаем его. begin Term_tab [NumTerm]. lex: =str_lex; Term_tab [NumTerm]. nomer: =NumTerm; Term_tab [NumTerm]. Left: =0; Term_tab [NumTerm]. Right: =0; Term_tab [NumTerm]. Way: ='V'; Exit; end; if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) then // Если значение текущего узла дерева больше добавляемого if Term_tab [Curr_term]. Left=0 then // если у этого элемента дерева нет левого указателя, то begin Term_tab [Curr_term]. Left: =NumTerm; // Создание левого элемента. Term_tab [NumTerm]. lex: =str_lex; Term_tab [NumTerm]. nomer: =NumTerm; Term_tab [NumTerm]. Left: =0; Term_tab [NumTerm]. Right: =0; Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L'; end else begin Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'L'; Add_Term (Term_tab [Curr_term]. Left,str_lex); // Если левый указатель существует, то вызываем уже функцию для левого указателя. end; if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) then // если у этого элемента дерева нет правого указателя, то if Term_tab [Curr_term]. Right=0 then begin Term_tab [Curr_term]. Right: =NumTerm; // Создаем правый элемент. Term_tab [NumTerm]. lex: =str_lex; Term_tab [NumTerm]. nomer: =NumTerm; Term_tab [NumTerm]. Left: =0; Term_tab [NumTerm]. Right: =0; Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R'; end else begin Term_tab [NumTerm]. Way: =Term_tab [NumTerm]. Way+'R'; Add_Term (Term_tab [Curr_term]. Right,str_lex); // Если правый указатель существует, то вызываем уже функцию для правого указателя. end; end; procedure Add_Ident (str: string); // процедура добавления константы var i: integer; begin kod: =Length (str) +2; hesh: =0; for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш hesh: =round (hesh/kod); // метод деления while (Id_tab [hesh]. lex<>'') and (hesh<maxnum) do // пока ячейка занята begin Id_tab [hesh]. ssylka: =hesh+1; hesh: =hesh+1; end; Id_tab [hesh]. nomer: =Numid; // запись данных Id_tab [hesh]. lex: =str; end; function Search_Ident (str: string): integer; // функция поиска терминала var i: integer; label 1; begin kod: =Length (str) +2; hesh: =0; for i: =1 to Length (str) do hesh: =hesh+ord (str [i]); // вычисление хэш hesh: =round (hesh/kod); 1: if str=Id_tab [hesh]. lex then Search_Ident: =Id_tab [hesh]. nomer else // поиск идентификатора begin if Id_tab [hesh]. ssylka=0 then Search_Ident: =0 else begin hesh: =Id_tab [hesh]. ssylka; goto 1; end; end; end; procedure Search_Const (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов begin Constyes: =0; // флаг: найдена ли лексема if (NumConst<>0) and (str_lex<>'') then begin if (CompareStr (Const_tab [Curr_term]. value,str_lex) >0) and (Const_tab [Curr_term]. Left<>0) then Search_Const (Const_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву" if (CompareStr (Const_tab [Curr_term]. value,str_lex) <0) and (Const_tab [Curr_term]. Right<>0) then Search_Const (Const_tab [Curr_term]. Right,str_lex); if Const_tab [Curr_term]. value=str_lex then Constyes: =Const_tab [Curr_term]. nomer; end; end; procedure Search_Term (Curr_term: integer; str_lex: string); // Процедура поиска лексем в дереве идентификаторов begin Termyes: =0; // флаг: найдена ли лексема if (NumTerm<>0) and (str_lex<>'') then
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
| 
