|
p align="left">begin if (CompareStr (Term_tab [Curr_term]. lex,str_lex) >0) and (Term_tab [Curr_term]. Left<>0) then Search_Term (Term_tab [Curr_term]. Left,str_lex); // рекурсивный "спуск по дереву" if (CompareStr (Term_tab [Curr_term]. lex,str_lex) <0) and (Term_tab [Curr_term]. Right<>0) then Search_Term (Term_tab [Curr_term]. Right,str_lex); if Term_tab [Curr_term]. lex=str_lex then Termyes: =Term_tab [Curr_term]. nomer; end; end; // функция распознавания 16-рич. констант function FConst (str: string): integer; var sost: byte; begin sost: =0; if str [1] ='$' then // распознаём символ '$' begin sost: =1; delete (str,1,1); end else exit; if (str [1] ='+') or (str [1] ='-') then // распознаём знак begin sost: =2; delete (str,1,1) end else begin sost: =4; exit; end; if str='' then exit; while length (str) >0 do begin if (str [1] in cifra) or (str [1] in bukva) then sost: =2 // распознаём буквы или цифры else begin sost: =4; exit; end; delete (str,1,1); end; sost: =3; if sost=3 then FConst: =1 else FConst: =-1; end; function termin: integer; // распознаватель терминальных символов begin termin: =-1; for k: =1 to 14 do if Words [k] =Lexem then termin: =3; for k: =1 to 8 do if Razdel [k] =Lexem then termin: =1; for k: =1 to 11 do if Operacii [k] =Lexem then termin: =2; end; function Rome (str: string): integer; // распознаватель римских констант var sost: byte; begin sost: =0; if (str [1] ='-') or (str [1] ='+') then begin sost: =12; delete (str,1,1); end; if str='' then exit; if str [1] ='X' then begin sost: =1; delete (str,1,1) end else begin if str [1] ='V' then begin sost: =2; delete (str,1,1) end else begin if str [1] ='I' then begin sost: =3; delete (str,1,1) end else begin sost: =4; exit; end; end; end; while Length (str) <>0 do begin case sost of 1: if str [1] ='X' then begin sost: =5; delete (str,1,1) end else begin if str [1] ='V' then begin sost: =2; delete (str,1,1) end else begin if str [1] ='I' then begin sost: =3; delete (str,1,1) end else begin sost: =4; exit; end; end; end; 2: if str [1] ='I' then begin sost: =7; delete (str,1,1) end else begin sost: =4; exit; end; 3: if str [1] ='X' then begin sost: =8; delete (str,1,1) end else begin if str [1] ='V' then begin sost: =9; delete (str,1,1) end else begin if str [1] ='I' then begin sost: =10; delete (str,1,1) end else begin sost: =4; exit; end; end; end; 4: exit; 5: if str [1] ='X' then begin sost: =6; delete (str,1,1) end else begin if str [1] ='V' then begin sost: =2; delete (str,1,1) end else begin if str [1] ='I' then begin sost: =3; delete (str,1,1) end else begin sost: =4; exit; end; end; end; 6: if str [1] ='V' then begin sost: =2; delete (str,1,1) end else begin if str [1] ='I' then begin sost: =3; delete (str,1,1) end else begin sost: =4; exit; end; end; 7: if str [1] ='I' then begin sost: =10; delete (str,1,1) end else begin sost: =4; exit; end; 8: begin sost: =4; exit; end; 9: begin sost: =4; exit; end; 10: if str [1] ='I' then begin sost: =11; delete (str,1,1) end else begin sost: =4; exit; end; 11: begin sost: =4; exit; end; end; end; if (sost=4) or (sost=12) then Rome: =-1 else Rome: =1; end; // функция распознавания идентификаторов function Ident (str: string): integer; var sost: byte; begin sost: =0; // реализация конечного автомата if str [1] in ['a'. 'z'] then begin sost: =1; delete (str,1,1) end else exit; while length (str) >0 do begin if str [1] in ['a'. 'z','0'. '9','_'] then begin sost: =1; delete (str,1,1); end else begin sost: =3; exit; end; end; sost: =2; if sost=2 then ident: =1 else ident: =-1; end; procedure WriteCode (nomer: integer; lex: string; typ: char; num: integer); // запись в таблицу кодов лексем begin Code_Tab [NumLex]. nomer: =nomer; Code_Tab [NumLex]. Lex: =lex; Code_Tab [NumLex]. typ: =typ; Code_Tab [NumLex]. Num: =num; Code_Tab [NumLex]. numstr: =string_counter+1; end; procedure WriteLex (typelex: char); // запись лексем в таблицы begin case typelex of 'C': begin // если лексема-16-рич. константа NumLex: =NumLex+1; Search_Const (1,Lexem); if Constyes=0 then // если лексема не найдена begin NumConst: =NumConst+1; Add_Const (1,Lexem); Const_tab [NumConst]. Typ: ='16-рич. '; Const_tab [Numconst]. Width: ='2 байта'; WriteCode (NumLex,Lexem,'C',NumConst); end else // если лексема найдена begin WriteCode (NumLex,Lexem,'C',Constyes); end; end; 'M': begin // если лексема-римская константа NumLex: =NumLex+1; Search_Const (1,Lexem); if Constyes=0 then // если лексема не найдена begin NumConst: =NumConst+1; Add_Const (1,Lexem); Const_tab [NumConst]. Typ: ='римск. '; Const_tab [Numconst]. Width: ='2 байта'; WriteCode (NumLex,Lexem,'C',NumConst); end else // если лексема найдена begin WriteCode (NumLex,Lexem,'C',Constyes); end; end; 'I': begin // если лексема-идентификатор NumLex: =NumLex+1; y: =Search_Ident ({1,}Lexem); if y=0 then // если лексема не найдена begin NumId: =NumId+1; WriteCode (NumLex,Lexem,'I',NumId); Add_Ident (Lexem); end else WriteCode (NumLex,Lexem,'I',y); // если лексема найдена end; 'K': begin // если лексема-служебное слово NumLex: =NumLex+1; Search_Term (1,Lexem); if Termyes=0 then // если лексема не найдена begin NumTerm: =NumTerm+1; Add_Term (1,Lexem); Term_tab [Numterm]. razd: =0; Term_tab [Numterm]. oper: =0; Term_tab [Numterm]. slug: =1; WriteCode (NumLex,Lexem,'T',NumTerm); end else WriteCode (NumLex,Lexem,'T',Termyes); // если лексема найдена end; 'R': begin // если лексема-разделитель NumLex: =NumLex+1; Search_Term (1,Lexem); if Termyes=0 then // если лексема не найдена begin NumTerm: =NumTerm+1; Add_Term (1,Lexem); Term_tab [NumTerm]. razd: =1; Term_tab [NumTerm]. oper: =0; Term_tab [NumTerm]. slug: =0; WriteCode (NumLex,Lexem,'T',NumTerm) end else WriteCode (NumLex,Lexem,'T',Termyes) // если лексема найдена end; 'O': begin // если лексема-знак операция NumLex: =NumLex+1; Search_Term (1,Lexem); if Termyes=0 then // если лексема не найдена begin NumTerm: =NumTerm+1; Add_Term (1,Lexem); Term_tab [Numterm]. razd: =0; Term_tab [Numterm]. oper: =1; Term_tab [Numterm]. slug: =0; WriteCode (NumLex,Lexem,'T',NumTerm) end else WriteCode (NumLex,Lexem,'T',Termyes) // есди лексема найдена end; end; end; procedure TForm1. N5Click (Sender: TObject); var i,pip: integer; begin for k: =1 to numid do // обнуление таблицы идентификаторов begin id_tab [k]. lex: ='0'; id_tab [k]. nomer: =0; id_tab [i]. ssylka: =0; end; for i: =1 to numlex do // обнуление выходной таблицы begin Code_Tab [i]. Lex: =''; Code_Tab [i]. typ: =#0; Code_Tab [i]. Num: =0; Code_Tab [i]. nomer: =0; end; for i: =0 to numconst do // обнуление таблицы констант begin Const_tab [i]. nomer: =0; Const_tab [i]. value: =''; Const_tab [i]. Typ: =''; Const_tab [i]. Width: =''; Const_tab [i]. Val10: =''; Const_tab [k]. Left: =0; Const_tab [k]. Right: =0; Const_tab [k]. Way: =''; end; for i: =1 to numterm do begin Term_tab [i]. nomer: =0; Term_tab [i]. Lex: =''; Term_tab [i]. razd: =0; Term_tab [i]. oper: =0; Term_tab [i]. slug: =0; Term_tab [k]. Left: =0; Term_tab [k]. Right: =0; Term_tab [k]. Way: =''; end; // инициализация NumLex: =0; NumId: =0; NumConst: =0; NumErr: =0; NumTerm: =0; Error: =false; Found: =false; i: =0; j: =0; k: =0; y: =0; String_counter: =0; Memo2. Lines. Clear; N6. Enabled: =true; while string_counter<=Memo1. Lines. Count do // цикл по строкам файла begin n: =1; m: =1; s: =Form1. Memo1. Lines. Strings [string_counter] ; for l: =1 to 2 do while m<=Length (s) do // цикл по строке begin n: =m; m: =Select_Lex (s,Lexem,n); if (Lexem<>'') and not (Lexem [1] in [#0. #32]) then begin if FConst (Lexem) =1 then WriteLex ('C') else // вызов процедуры записи if Termin=3 then WriteLex ('K') else if Rome (Lexem) =1 then WriteLex ('M') else if Ident (Lexem) =1 then WriteLex ('I') else if Termin=1 then WriteLex ('R') else if Termin=2 then WriteLex ('O') else Err_lex; end; end; string_counter: =string_counter+1; end; vyvod; // вызов процедуры вывода end; procedure TForm1. vyvod; // Вывод результатов var f: textfile; // выходной файл begin StringGrid1. RowCount: =NumConst+1; // определение числа строк в таблицах StringGrid2. RowCount: =NumId+1; StringGrid3. RowCount: =NumTerm+1; StringGrid4. RowCount: =NumLex+1; StringGrid1. Cells [0,0]: ='№'; StringGrid1. Cells [1,0]: ='Константа'; StringGrid1. Cells [2,0]: ='Тип'; StringGrid1. Cells [3,0]: ='Ширина'; StringGrid1. Cells [4,0]: ='10-тичный формат'; StringGrid1. Cells [5,0]: ='L'; StringGrid1. Cells [6,0]: ='R';
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
| 
