1 {
2 }
3 //{$DEFINE mode_inter} //mode_inter->Modo intérprete mode_comp->Modo compilador
4 unit Parser;
5 {$mode objfpc}{$H+}
6
7 interface
8 uses
9 Classes, SysUtils, LCLType, Dialogs, lclProc, Graphics, SynEditHighlighter,
10 SynFacilBasic,
11 XpresTypes, XpresElements, XPresParser, FormOut;
12
13 type
14
15 { TCompiler }
16
17 TCompiler = class(TCompilerBase)
18 private
19 tkStruct : TSynHighlighterAttributes;
20 tkExpDelim : TSynHighlighterAttributes;
21 tkBlkDelim : TSynHighlighterAttributes;
22 tkOthers : TSynHighlighterAttributes;
23 procedure CompilarArc;
24 procedure TipDefecString(var Op: TOperand; tokcad: string); override;
25 public
26 mem : TStringList; //Para almacenar el código de salida del compilador
27 procedure ShowOperand(const Op: TOperand);
28 procedure ShowResult;
29 procedure StartSyntax;
30 procedure Compilar(NombArc: string; LinArc: Tstrings);
31 constructor Create; override;
32 destructor Destroy; override;
33 end;
34
35 //procedure Compilar(NombArc: string; LinArc: Tstrings);
36 var
37 cxp : TCompiler;
38
39 implementation
40
41 //Funciones de acceso al compilador. Facilitan el acceso de forma resumida.
42 procedure Code(cod: string);
43 begin
44 cxp.mem.Add(cod);
45 end;
46 procedure GenError(msg: string);
47 begin
48 cxp.GenError(msg);
49 end;
HayErrornull50 function HayError: boolean;
51 begin
52 Result := cxp.HayError;
53 end;
54 {Incluye el código del compilador. Aquí tendrá acceso a todas las variables públicas
55 de XPresParser}
56 {$I GenCod.pas}
57 //Métodos OVERRIDE
58 procedure TCompiler.TipDefecString(var Op: TOperand; tokcad: string);
59 //Devuelve el tipo de cadena encontrado en un token
60 var
61 i: Integer;
62 x: TType;
63 begin
64 Op.catTyp := t_string; //es cadena
65 Op.size:=length(tokcad);
66 //toma el texto
67 Op.valStr := copy(cIn.tok,2, length(cIn.tok)-2); //quita comillas
68 //////////// Verifica si hay tipos string definidos ////////////
69 if length(Op.valStr)=1 then begin
70 Op.typ := tipChr;
71 end else
72 Op.typ :=nil; //no hay otro tipo
73 end;
74 procedure TCompiler.CompilarArc;
75 //Compila un programa en el contexto actual
76 begin
77 // CompilarAct;
78 Perr.Clear;
79 if cIn.Eof then begin
80 GenError('Se esperaba "begin", "var", "type" o "const".');
81 exit;
82 end;
83 cIn.SkipWhites;
84 //empiezan las declaraciones
85 Cod_StartData; //debe definirse en el "Interprete.pas"
86 if cIn.tokL = 'var' then begin
87 cIn.Next; //lo toma
88 while (cIn.tokL <>'begin') and (cIn.tokL <>'const') and
89 (cIn.tokL <>'type') and (cIn.tokL <>'var') do begin
90 CompileVarDeclar;
91 if pErr.HayError then exit;;
92 end;
93 end;
94 if cIn.tokL = 'begin' then begin
95 Cod_StartProgram;
96 cIn.Next; //coge "begin"
97 //codifica el contenido
98 SkipWhites;
99 while not cIn.Eof and (cIn.tokL<>'end') do begin
100 //se espera una expresión o estructura
101 GetExpression(0);
102 if perr.HayError then exit; //aborta
103 //busca delimitador
104 SkipWhites;
105 if EOExpres then begin //encontró delimitador de expresión
106 cIn.Next; //lo toma
107 SkipWhites; //quita espacios
108 end;
109 end;
110 if cIn.Eof then begin
111 GenError('Inesperado fin de archivo. Se esperaba "end".');
112 exit; //sale
113 end;
114 if cIn.tokL <> 'end' then begin //verifica si termina el programa
115 GenError('Se esperaba "end".');
116 exit; //sale
117 end;
118 cIn.Next; //coge "end"
119 end else begin
120 GenError('Se esperaba "begin", "var", "type" o "const".');
121 exit;
122 end;
123 Cod_EndProgram;
124 end;
125 procedure TCompiler.Compilar(NombArc: string; LinArc: Tstrings);
126 //Compila el contenido de un archivo a ensamblador
127 begin
128 //se pone en un "try" para capturar errores y para tener un punto salida de salida
129 //único
130 if ejecProg then begin
131 GenError('Ya se está compilando un programa actualmente.');
132 exit; //sale directamente
133 end;
134 try
135 ejecProg := true; //marca bandera
136
137 Perr.IniError;
138 ClearVars; //limpia las variables
139 ClearFuncs; //limpia las funciones
140 mem.Clear; //limpia salida
141 cIn.ClearAll; //elimina todos los Contextos de entrada
142 ExprLevel := 0; //inicia
143 //compila el archivo abierto
144
145 // con := PosAct; //Guarda posición y referencia a contenido actual
146 cIn.NewContextFromFile(NombArc,LinArc); //Crea nuevo contenido
147 if PErr.HayError then exit;
148 CompilarArc; //puede dar error
149
150 cIn.QuitaContexEnt; //es necesario por dejar limpio
151 if PErr.HayError then exit; //sale
152 // PosAct := con; //recupera el contenido actual
153
154 // PPro.GenArchivo(ArcSal);
155 ShowResult; //muestra el resultado
156 finally
157 ejecProg := false;
158 //tareas de finalización
159 //como actualizar estado
160 end;
161 end;
162
163 //procedure TCompilerBase.ShowError
164 procedure TCompiler.ShowOperand(const Op: TOperand);
165 //muestra un operando por pantalla
166 var
167 tmp: String;
168 begin
169 tmp := 'Result ' + CategName(Op.typ.cat) + '(' + Op.typ.name + ') = ';
170 case Op.Typ.cat of
171 t_integer: frmOut.puts(tmp + IntToStr(Op.ReadInt));
172 t_float : frmOut.puts(tmp + FloatToStr(Op.ReadFloat));
173 t_string: frmOut.puts(tmp + Op.ReadStr);
174 t_boolean: if Op.ReadBool then frmOut.puts(tmp + 'TRUE')
175 else frmOut.puts(tmp + 'FALSE');
176 end;
177 end;
178 procedure TCompiler.ShowResult;
179 //muestra el resultado de la última exprersión evaluada
180 begin
181 { case res.estOp of
182 NO_STORED : frmOut.puts('Resultado no almacen.');
183 else //se supone que está en un estado válido
184 ShowOperand(res);
185 end;}
186 end;
187
188 constructor TCompiler.Create;
189 begin
190 inherited Create;
191 mem := TStringList.Create; //crea lista para almacenar ensamblador
192
193 ///////////define la sintaxis del compilador
194 //crea y guarda referencia a los atributos
195 tkEol := xLex.tkEol;
196 tkIdentif := xLex.tkIdentif;
197 tkKeyword := xLex.tkKeyword;
198 tkNumber := xLex.tkNumber;
199 tkString := xLex.tkString;
200 //personalizados
201 tkOperator := xLex.NewTokType('Operador'); //personalizado
202 tkBoolean := xLex.NewTokType('Boolean'); //personalizado
203 tkSysFunct := xLex.NewTokType('SysFunct'); //funciones del sistema
204 tkExpDelim := xLex.NewTokType('ExpDelim');//delimitador de expresión ";"
205 tkBlkDelim := xLex.NewTokType('BlkDelim'); //delimitador de bloque
206 tkType := xLex.NewTokType('Types'); //personalizado
207 tkStruct := xLex.NewTokType('Struct'); //personalizado
208 tkOthers := xLex.NewTokType('Others'); //personalizado
209 //Configura atributos
210 tkKeyword.Style := [fsBold]; //en negrita
211 tkBlkDelim.Foreground:=clGreen;
212 tkBlkDelim.Style := [fsBold]; //en negrita
213 tkStruct.Foreground:=clGreen;
214 tkStruct.Style := [fsBold]; //en negrita
215 //inicia la configuración
216 xLex.ClearMethodTables; //limpìa tabla de métodos
217 xLex.ClearSpecials; //para empezar a definir tokens
218 //crea tokens por contenido
219 xLex.DefTokIdentif('[$A-Za-z_]', '[A-Za-z0-9_]*');
220 xLex.DefTokContent('[0-9]', '[0-9.]*', tkNumber);
221 //define palabras claves
222 xLex.AddIdentSpecList('THEN var type', tkKeyword);
223 xLex.AddIdentSpecList('program public private method const', tkKeyword);
224 xLex.AddIdentSpecList('class create destroy sub do begin', tkKeyword);
225 xLex.AddIdentSpecList('END ELSE ELSIF', tkBlkDelim);
226 xLex.AddIdentSpecList('true false', tkBoolean);
227 xLex.AddIdentSpecList('IF FOR', tkStruct);
228 xLex.AddIdentSpecList('and or xor not', tkOperator);
229 xLex.AddIdentSpecList('int float char string bool', tkType);
230 //símbolos especiales
231 xLex.AddSymbSpec('+', tkOperator);
232 xLex.AddSymbSpec('-', tkOperator);
233 xLex.AddSymbSpec('*', tkOperator);
234 xLex.AddSymbSpec('/', tkOperator);
235 xLex.AddSymbSpec('\', tkOperator);
236 xLex.AddSymbSpec('%', tkOperator);
237 xLex.AddSymbSpec('**', tkOperator);
238 xLex.AddSymbSpec('=', tkOperator);
239 xLex.AddSymbSpec('>', tkOperator);
240 xLex.AddSymbSpec('>=', tkOperator);
241 xLex.AddSymbSpec('<;', tkOperator);
242 xLex.AddSymbSpec('<=', tkOperator);
243 xLex.AddSymbSpec('<>', tkOperator);
244 xLex.AddSymbSpec('<=>',tkOperator);
245 xLex.AddSymbSpec(':=', tkOperator);
246 xLex.AddSymbSpec(';', tkExpDelim);
247 xLex.AddSymbSpec('(', tkOthers);
248 xLex.AddSymbSpec(')', tkOthers);
249 xLex.AddSymbSpec(':', tkOthers);
250 xLex.AddSymbSpec(',', tkOthers);
251 //crea tokens delimitados
252 xLex.DefTokDelim('''','''', tkString);
253 xLex.DefTokDelim('"','"', tkString);
254 xLex.DefTokDelim('//','', xLex.tkComment);
255 xLex.DefTokDelim('/\*','\*/', xLex.tkComment, tdMulLin);
256 //define bloques de sintaxis
257 xLex.AddBlock('{','}');
258 xLex.Rebuild; //es necesario para terminar la definición
259
260 StartSyntax; //Debe hacerse solo una vez al inicio
261 end;
262
263 destructor TCompiler.Destroy;
264 begin
265 mem.Free; //libera
266 inherited Destroy;
267 end;
268
269 initialization
270 //Es necesario crear solo una instancia del compilador.
271 cxp := TCompiler.Create; //Crea una instancia del compilador
272
273 finalization
274 cxp.Destroy;
275 end.
276
277