|
145
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- R E P I N F O - I N P U T --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 2018-2019, Free Software Foundation, Inc. --
|
|
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Alloc;
|
|
|
33 with Csets; use Csets;
|
|
|
34 with Hostparm; use Hostparm;
|
|
|
35 with Namet; use Namet;
|
|
|
36 with Output; use Output;
|
|
|
37 with Snames; use Snames;
|
|
|
38 with Table;
|
|
|
39
|
|
|
40 package body Repinfo.Input is
|
|
|
41
|
|
|
42 SSU : constant := 8;
|
|
|
43 -- Value for Storage_Unit, we do not want to get this from TTypes, since
|
|
|
44 -- this introduces problematic dependencies in ASIS, and in any case this
|
|
|
45 -- value is assumed to be 8 for the implementation of the DDA.
|
|
|
46
|
|
|
47 type JSON_Entity_Kind is (JE_Record_Type, JE_Array_Type, JE_Other);
|
|
|
48 -- Kind of an entiy
|
|
|
49
|
|
|
50 type JSON_Entity_Node (Kind : JSON_Entity_Kind := JE_Other) is record
|
|
|
51 Esize : Node_Ref_Or_Val;
|
|
|
52 RM_Size : Node_Ref_Or_Val;
|
|
|
53 case Kind is
|
|
|
54 when JE_Record_Type => Variant : Nat;
|
|
|
55 when JE_Array_Type => Component_Size : Node_Ref_Or_Val;
|
|
|
56 when JE_Other => Dummy : Boolean;
|
|
|
57 end case;
|
|
|
58 end record;
|
|
|
59 pragma Unchecked_Union (JSON_Entity_Node);
|
|
|
60 -- Record to represent an entity
|
|
|
61
|
|
|
62 package JSON_Entity_Table is new Table.Table (
|
|
|
63 Table_Component_Type => JSON_Entity_Node,
|
|
|
64 Table_Index_Type => Nat,
|
|
|
65 Table_Low_Bound => 1,
|
|
|
66 Table_Initial => Alloc.Rep_JSON_Table_Initial,
|
|
|
67 Table_Increment => Alloc.Rep_JSON_Table_Increment,
|
|
|
68 Table_Name => "JSON_Entity_Table");
|
|
|
69 -- Table of entities
|
|
|
70
|
|
|
71 type JSON_Component_Node is record
|
|
|
72 Bit_Offset : Node_Ref_Or_Val;
|
|
|
73 Esize : Node_Ref_Or_Val;
|
|
|
74 end record;
|
|
|
75 -- Record to represent a component
|
|
|
76
|
|
|
77 package JSON_Component_Table is new Table.Table (
|
|
|
78 Table_Component_Type => JSON_Component_Node,
|
|
|
79 Table_Index_Type => Nat,
|
|
|
80 Table_Low_Bound => 1,
|
|
|
81 Table_Initial => Alloc.Rep_JSON_Table_Initial,
|
|
|
82 Table_Increment => Alloc.Rep_JSON_Table_Increment,
|
|
|
83 Table_Name => "JSON_Component_Table");
|
|
|
84 -- Table of components
|
|
|
85
|
|
|
86 type JSON_Variant_Node is record
|
|
|
87 Present : Node_Ref_Or_Val;
|
|
|
88 Variant : Nat;
|
|
|
89 Next : Nat;
|
|
|
90 end record;
|
|
|
91 -- Record to represent a variant
|
|
|
92
|
|
|
93 package JSON_Variant_Table is new Table.Table (
|
|
|
94 Table_Component_Type => JSON_Variant_Node,
|
|
|
95 Table_Index_Type => Nat,
|
|
|
96 Table_Low_Bound => 1,
|
|
|
97 Table_Initial => Alloc.Rep_JSON_Table_Initial,
|
|
|
98 Table_Increment => Alloc.Rep_JSON_Table_Increment,
|
|
|
99 Table_Name => "JSON_Variant_Table");
|
|
|
100 -- Table of variants
|
|
|
101
|
|
|
102 -------------------------------------
|
|
|
103 -- Get_JSON_Component_Bit_Offset --
|
|
|
104 -------------------------------------
|
|
|
105
|
|
|
106 function Get_JSON_Component_Bit_Offset
|
|
|
107 (Name : String;
|
|
|
108 Record_Name : String) return Node_Ref_Or_Val
|
|
|
109 is
|
|
|
110 Namid : constant Valid_Name_Id := Name_Find (Record_Name & '.' & Name);
|
|
|
111 Index : constant Int := Get_Name_Table_Int (Namid);
|
|
|
112
|
|
|
113 begin
|
|
|
114 -- Return No_Uint if no information is available for the component
|
|
|
115
|
|
|
116 if Index = 0 then
|
|
|
117 return No_Uint;
|
|
|
118 end if;
|
|
|
119
|
|
|
120 return JSON_Component_Table.Table (Index).Bit_Offset;
|
|
|
121 end Get_JSON_Component_Bit_Offset;
|
|
|
122
|
|
|
123 -------------------------------
|
|
|
124 -- Get_JSON_Component_Size --
|
|
|
125 -------------------------------
|
|
|
126
|
|
|
127 function Get_JSON_Component_Size (Name : String) return Node_Ref_Or_Val is
|
|
|
128 Namid : constant Valid_Name_Id := Name_Find (Name);
|
|
|
129 Index : constant Int := Get_Name_Table_Int (Namid);
|
|
|
130
|
|
|
131 begin
|
|
|
132 -- Return No_Uint if no information is available for the component
|
|
|
133
|
|
|
134 if Index = 0 then
|
|
|
135 return No_Uint;
|
|
|
136 end if;
|
|
|
137
|
|
|
138 return JSON_Entity_Table.Table (Index).Component_Size;
|
|
|
139 end Get_JSON_Component_Size;
|
|
|
140
|
|
|
141 ----------------------
|
|
|
142 -- Get_JSON_Esize --
|
|
|
143 ----------------------
|
|
|
144
|
|
|
145 function Get_JSON_Esize (Name : String) return Node_Ref_Or_Val is
|
|
|
146 Namid : constant Valid_Name_Id := Name_Find (Name);
|
|
|
147 Index : constant Int := Get_Name_Table_Int (Namid);
|
|
|
148
|
|
|
149 begin
|
|
|
150 -- Return No_Uint if no information is available for the entity
|
|
|
151
|
|
|
152 if Index = 0 then
|
|
|
153 return No_Uint;
|
|
|
154 end if;
|
|
|
155
|
|
|
156 return JSON_Entity_Table.Table (Index).Esize;
|
|
|
157 end Get_JSON_Esize;
|
|
|
158
|
|
|
159 ----------------------
|
|
|
160 -- Get_JSON_Esize --
|
|
|
161 ----------------------
|
|
|
162
|
|
|
163 function Get_JSON_Esize
|
|
|
164 (Name : String;
|
|
|
165 Record_Name : String) return Node_Ref_Or_Val
|
|
|
166 is
|
|
|
167 Namid : constant Valid_Name_Id := Name_Find (Record_Name & '.' & Name);
|
|
|
168 Index : constant Int := Get_Name_Table_Int (Namid);
|
|
|
169
|
|
|
170 begin
|
|
|
171 -- Return No_Uint if no information is available for the entity
|
|
|
172
|
|
|
173 if Index = 0 then
|
|
|
174 return No_Uint;
|
|
|
175 end if;
|
|
|
176
|
|
|
177 return JSON_Component_Table.Table (Index).Esize;
|
|
|
178 end Get_JSON_Esize;
|
|
|
179
|
|
|
180 ------------------------
|
|
|
181 -- Get_JSON_RM_Size --
|
|
|
182 ------------------------
|
|
|
183
|
|
|
184 function Get_JSON_RM_Size (Name : String) return Node_Ref_Or_Val is
|
|
|
185 Namid : constant Valid_Name_Id := Name_Find (Name);
|
|
|
186 Index : constant Int := Get_Name_Table_Int (Namid);
|
|
|
187
|
|
|
188 begin
|
|
|
189 -- Return No_Uint if no information is available for the entity
|
|
|
190
|
|
|
191 if Index = 0 then
|
|
|
192 return No_Uint;
|
|
|
193 end if;
|
|
|
194
|
|
|
195 return JSON_Entity_Table.Table (Index).RM_Size;
|
|
|
196 end Get_JSON_RM_Size;
|
|
|
197
|
|
|
198 -----------------------
|
|
|
199 -- Read_JSON_Stream --
|
|
|
200 -----------------------
|
|
|
201
|
|
|
202 procedure Read_JSON_Stream (Text : Text_Buffer; File_Name : String) is
|
|
|
203
|
|
|
204 type Text_Position is record
|
|
|
205 Index : Text_Ptr := 0;
|
|
|
206 Line : Natural := 0;
|
|
|
207 Column : Natural := 0;
|
|
|
208 end record;
|
|
|
209 -- Record to represent position in the text
|
|
|
210
|
|
|
211 type Token_Kind is
|
|
|
212 (J_NULL,
|
|
|
213 J_TRUE,
|
|
|
214 J_FALSE,
|
|
|
215 J_NUMBER,
|
|
|
216 J_INTEGER,
|
|
|
217 J_STRING,
|
|
|
218 J_ARRAY,
|
|
|
219 J_OBJECT,
|
|
|
220 J_ARRAY_END,
|
|
|
221 J_OBJECT_END,
|
|
|
222 J_COMMA,
|
|
|
223 J_COLON,
|
|
|
224 J_EOF);
|
|
|
225 -- JSON Token kind. Note that in ECMA 404 there is no notion of integer.
|
|
|
226 -- Only numbers are supported. In our implementation we return J_INTEGER
|
|
|
227 -- if there is no decimal part in the number. The semantic is that this
|
|
|
228 -- is a J_NUMBER token that might be represented as an integer. Special
|
|
|
229 -- token J_EOF means that end of stream has been reached.
|
|
|
230
|
|
|
231 function Decode_Integer (Lo, Hi : Text_Ptr) return Uint;
|
|
|
232 -- Decode and return the integer in Text (Lo .. Hi)
|
|
|
233
|
|
|
234 function Decode_Name (Lo, Hi : Text_Ptr) return Valid_Name_Id;
|
|
|
235 -- Decode and return the name in Text (Lo .. Hi)
|
|
|
236
|
|
|
237 function Decode_Symbol (Lo, Hi : Text_Ptr) return TCode;
|
|
|
238 -- Decode and return the expression symbol in Text (Lo .. Hi)
|
|
|
239
|
|
|
240 procedure Error (Msg : String);
|
|
|
241 pragma No_Return (Error);
|
|
|
242 -- Print an error message and raise an exception
|
|
|
243
|
|
|
244 procedure Read_Entity;
|
|
|
245 -- Read an entity
|
|
|
246
|
|
|
247 function Read_Name return Valid_Name_Id;
|
|
|
248 -- Read a name
|
|
|
249
|
|
|
250 function Read_Name_With_Prefix return Valid_Name_Id;
|
|
|
251 -- Read a name and prepend a prefix
|
|
|
252
|
|
|
253 function Read_Number return Uint;
|
|
|
254 -- Read a number
|
|
|
255
|
|
|
256 function Read_Numerical_Expr return Node_Ref_Or_Val;
|
|
|
257 -- Read a numerical expression
|
|
|
258
|
|
|
259 procedure Read_Record;
|
|
|
260 -- Read a record
|
|
|
261
|
|
|
262 function Read_String return Valid_Name_Id;
|
|
|
263 -- Read a string
|
|
|
264
|
|
|
265 procedure Read_Token
|
|
|
266 (Kind : out Token_Kind;
|
|
|
267 Token_Start : out Text_Position;
|
|
|
268 Token_End : out Text_Position);
|
|
|
269 -- Read a token and return it (this is a standard JSON lexer)
|
|
|
270
|
|
|
271 procedure Read_Token_And_Error
|
|
|
272 (TK : Token_Kind;
|
|
|
273 Token_Start : out Text_Position;
|
|
|
274 Token_End : out Text_Position);
|
|
|
275 pragma Inline (Read_Token_And_Error);
|
|
|
276 -- Read a specified token and error out on failure
|
|
|
277
|
|
|
278 function Read_Variant_Part return Nat;
|
|
|
279 -- Read a variant part
|
|
|
280
|
|
|
281 procedure Skip_Value;
|
|
|
282 -- Skip a value
|
|
|
283
|
|
|
284 Pos : Text_Position := (Text'First, 1, 1);
|
|
|
285 -- The current position in the text buffer
|
|
|
286
|
|
|
287 Name_Buffer : Bounded_String (4 * Max_Name_Length);
|
|
|
288 -- The buffer used to build full qualifed names
|
|
|
289
|
|
|
290 Prefix_Len : Natural := 0;
|
|
|
291 -- The length of the prefix present in Name_Buffer
|
|
|
292
|
|
|
293 ----------------------
|
|
|
294 -- Decode_Integer --
|
|
|
295 ----------------------
|
|
|
296
|
|
|
297 function Decode_Integer (Lo, Hi : Text_Ptr) return Uint is
|
|
|
298 Len : constant Nat := Int (Hi) - Int (Lo) + 1;
|
|
|
299
|
|
|
300 begin
|
|
|
301 -- Decode up to 9 characters manually, otherwise call into Uint
|
|
|
302
|
|
|
303 if Len < 10 then
|
|
|
304 declare
|
|
|
305 Val : Int := 0;
|
|
|
306
|
|
|
307 begin
|
|
|
308 for J in Lo .. Hi loop
|
|
|
309 Val := Val * 10
|
|
|
310 + Character'Pos (Text (J)) - Character'Pos ('0');
|
|
|
311 end loop;
|
|
|
312 return UI_From_Int (Val);
|
|
|
313 end;
|
|
|
314
|
|
|
315 else
|
|
|
316 declare
|
|
|
317 Val : Uint := Uint_0;
|
|
|
318
|
|
|
319 begin
|
|
|
320 for J in Lo .. Hi loop
|
|
|
321 Val := Val * 10
|
|
|
322 + Character'Pos (Text (J)) - Character'Pos ('0');
|
|
|
323 end loop;
|
|
|
324 return Val;
|
|
|
325 end;
|
|
|
326 end if;
|
|
|
327 end Decode_Integer;
|
|
|
328
|
|
|
329 -------------------
|
|
|
330 -- Decode_Name --
|
|
|
331 -------------------
|
|
|
332
|
|
|
333 function Decode_Name (Lo, Hi : Text_Ptr) return Valid_Name_Id is
|
|
|
334 begin
|
|
|
335 -- Names are stored in lower case so fold them if need be
|
|
|
336
|
|
|
337 if Is_Upper_Case_Letter (Text (Lo)) then
|
|
|
338 declare
|
|
|
339 S : String (Integer (Lo) .. Integer (Hi));
|
|
|
340
|
|
|
341 begin
|
|
|
342 for J in Lo .. Hi loop
|
|
|
343 S (Integer (J)) := Fold_Lower (Text (J));
|
|
|
344 end loop;
|
|
|
345
|
|
|
346 return Name_Find (S);
|
|
|
347 end;
|
|
|
348
|
|
|
349 else
|
|
|
350 declare
|
|
|
351 S : String (Integer (Lo) .. Integer (Hi));
|
|
|
352 for S'Address use Text (Lo)'Address;
|
|
|
353
|
|
|
354 begin
|
|
|
355 return Name_Find (S);
|
|
|
356 end;
|
|
|
357 end if;
|
|
|
358 end Decode_Name;
|
|
|
359
|
|
|
360 ---------------------
|
|
|
361 -- Decode_Symbol --
|
|
|
362 ---------------------
|
|
|
363
|
|
|
364 function Decode_Symbol (Lo, Hi : Text_Ptr) return TCode is
|
|
|
365
|
|
|
366 function Cmp12 (A, B : Character) return Boolean;
|
|
|
367 pragma Inline (Cmp12);
|
|
|
368 -- Compare Text (Lo + 1 .. Lo + 2) with A & B.
|
|
|
369
|
|
|
370 -------------
|
|
|
371 -- Cmp12 --
|
|
|
372 -------------
|
|
|
373
|
|
|
374 function Cmp12 (A, B : Character) return Boolean is
|
|
|
375 begin
|
|
|
376 return Text (Lo + 1) = A and then Text (Lo + 2) = B;
|
|
|
377 end Cmp12;
|
|
|
378
|
|
|
379 Len : constant Nat := Int (Hi) - Int (Lo) + 1;
|
|
|
380
|
|
|
381 -- Start of processing for Decode_Symbol
|
|
|
382
|
|
|
383 begin
|
|
|
384 case Len is
|
|
|
385 when 1 =>
|
|
|
386 case Text (Lo) is
|
|
|
387 when '+' =>
|
|
|
388 return Plus_Expr;
|
|
|
389 when '-' =>
|
|
|
390 return Minus_Expr; -- or Negate_Expr
|
|
|
391 when '*' =>
|
|
|
392 return Mult_Expr;
|
|
|
393 when '<' =>
|
|
|
394 return Lt_Expr;
|
|
|
395 when '>' =>
|
|
|
396 return Gt_Expr;
|
|
|
397 when '&' =>
|
|
|
398 return Bit_And_Expr;
|
|
|
399 when '#' =>
|
|
|
400 return Discrim_Val;
|
|
|
401 when others =>
|
|
|
402 null;
|
|
|
403 end case;
|
|
|
404 when 2 =>
|
|
|
405 if Text (Lo) = '/' then
|
|
|
406 case Text (Lo + 1) is
|
|
|
407 when 't' =>
|
|
|
408 return Trunc_Div_Expr;
|
|
|
409 when 'c' =>
|
|
|
410 return Ceil_Div_Expr;
|
|
|
411 when 'f' =>
|
|
|
412 return Floor_Div_Expr;
|
|
|
413 when 'e' =>
|
|
|
414 return Exact_Div_Expr;
|
|
|
415 when others =>
|
|
|
416 null;
|
|
|
417 end case;
|
|
|
418 elsif Text (Lo + 1) = '=' then
|
|
|
419 case Text (Lo) is
|
|
|
420 when '<' =>
|
|
|
421 return Le_Expr;
|
|
|
422 when '>' =>
|
|
|
423 return Ge_Expr;
|
|
|
424 when '=' =>
|
|
|
425 return Eq_Expr;
|
|
|
426 when '!' =>
|
|
|
427 return Ne_Expr;
|
|
|
428 when others =>
|
|
|
429 null;
|
|
|
430 end case;
|
|
|
431 elsif Text (Lo) = 'o' and then Text (Lo + 1) = 'r' then
|
|
|
432 return Truth_Or_Expr;
|
|
|
433 end if;
|
|
|
434 when 3 =>
|
|
|
435 case Text (Lo) is
|
|
|
436 when '?' =>
|
|
|
437 if Cmp12 ('<', '>') then
|
|
|
438 return Cond_Expr;
|
|
|
439 end if;
|
|
|
440 when 'a' =>
|
|
|
441 if Cmp12 ('b', 's') then
|
|
|
442 return Abs_Expr;
|
|
|
443 elsif Cmp12 ('n', 'd') then
|
|
|
444 return Truth_And_Expr;
|
|
|
445 end if;
|
|
|
446 when 'm' =>
|
|
|
447 if Cmp12 ('a', 'x') then
|
|
|
448 return Max_Expr;
|
|
|
449 elsif Cmp12 ('i', 'n') then
|
|
|
450 return Min_Expr;
|
|
|
451 end if;
|
|
|
452 when 'n' =>
|
|
|
453 if Cmp12 ('o', 't') then
|
|
|
454 return Truth_Not_Expr;
|
|
|
455 end if;
|
|
|
456 when 'x' =>
|
|
|
457 if Cmp12 ('o', 'r') then
|
|
|
458 return Truth_Xor_Expr;
|
|
|
459 end if;
|
|
|
460 when 'v' =>
|
|
|
461 if Cmp12 ('a', 'r') then
|
|
|
462 return Dynamic_Val;
|
|
|
463 end if;
|
|
|
464 when others =>
|
|
|
465 null;
|
|
|
466 end case;
|
|
|
467 when 4 =>
|
|
|
468 if Text (Lo) = 'm'
|
|
|
469 and then Text (Lo + 1) = 'o'
|
|
|
470 and then Text (Lo + 2) = 'd'
|
|
|
471 then
|
|
|
472 case Text (Lo + 3) is
|
|
|
473 when 't' =>
|
|
|
474 return Trunc_Mod_Expr;
|
|
|
475 when 'c' =>
|
|
|
476 return Ceil_Mod_Expr;
|
|
|
477 when 'f' =>
|
|
|
478 return Floor_Mod_Expr;
|
|
|
479 when others =>
|
|
|
480 null;
|
|
|
481 end case;
|
|
|
482 end if;
|
|
|
483
|
|
|
484 pragma Annotate
|
|
|
485 (CodePeer, Intentional,
|
|
|
486 "condition predetermined", "Error called as defensive code");
|
|
|
487
|
|
|
488 when others =>
|
|
|
489 null;
|
|
|
490 end case;
|
|
|
491
|
|
|
492 Error ("unknown symbol");
|
|
|
493 end Decode_Symbol;
|
|
|
494
|
|
|
495 -----------
|
|
|
496 -- Error --
|
|
|
497 -----------
|
|
|
498
|
|
|
499 procedure Error (Msg : String) is
|
|
|
500 L : constant String := Pos.Line'Img;
|
|
|
501 C : constant String := Pos.Column'Img;
|
|
|
502
|
|
|
503 begin
|
|
|
504 Set_Standard_Error;
|
|
|
505 Write_Eol;
|
|
|
506 Write_Str (File_Name);
|
|
|
507 Write_Char (':');
|
|
|
508 Write_Str (L (L'First + 1 .. L'Last));
|
|
|
509 Write_Char (':');
|
|
|
510 Write_Str (C (C'First + 1 .. C'Last));
|
|
|
511 Write_Char (':');
|
|
|
512 Write_Line (Msg);
|
|
|
513 raise Invalid_JSON_Stream;
|
|
|
514 end Error;
|
|
|
515
|
|
|
516 ------------------
|
|
|
517 -- Read_Entity --
|
|
|
518 ------------------
|
|
|
519
|
|
|
520 procedure Read_Entity is
|
|
|
521 Ent : JSON_Entity_Node;
|
|
|
522 Nam : Name_Id := No_Name;
|
|
|
523 Siz : Node_Ref_Or_Val;
|
|
|
524 Token_Start : Text_Position;
|
|
|
525 Token_End : Text_Position;
|
|
|
526 TK : Token_Kind;
|
|
|
527
|
|
|
528 begin
|
|
|
529 Ent.Esize := No_Uint;
|
|
|
530 Ent.RM_Size := No_Uint;
|
|
|
531 Ent.Component_Size := No_Uint;
|
|
|
532
|
|
|
533 -- Read the members as string : value pairs
|
|
|
534
|
|
|
535 loop
|
|
|
536 case Read_String is
|
|
|
537 when Name_Name =>
|
|
|
538 Nam := Read_Name;
|
|
|
539 when Name_Record =>
|
|
|
540 if Nam = No_Name then
|
|
|
541 Error ("name expected");
|
|
|
542 end if;
|
|
|
543 Ent.Variant := 0;
|
|
|
544 Prefix_Len := Natural (Length_Of_Name (Nam));
|
|
|
545 Name_Buffer.Chars (1 .. Prefix_Len) := Get_Name_String (Nam);
|
|
|
546 Read_Record;
|
|
|
547 when Name_Variant =>
|
|
|
548 Ent.Variant := Read_Variant_Part;
|
|
|
549 when Name_Size =>
|
|
|
550 Siz := Read_Numerical_Expr;
|
|
|
551 Ent.Esize := Siz;
|
|
|
552 Ent.RM_Size := Siz;
|
|
|
553 when Name_Object_Size =>
|
|
|
554 Ent.Esize := Read_Numerical_Expr;
|
|
|
555 when Name_Value_Size =>
|
|
|
556 Ent.RM_Size := Read_Numerical_Expr;
|
|
|
557 when Name_Component_Size =>
|
|
|
558 Ent.Component_Size := Read_Numerical_Expr;
|
|
|
559 when others =>
|
|
|
560 Skip_Value;
|
|
|
561 end case;
|
|
|
562
|
|
|
563 Read_Token (TK, Token_Start, Token_End);
|
|
|
564 if TK = J_OBJECT_END then
|
|
|
565 exit;
|
|
|
566 elsif TK /= J_COMMA then
|
|
|
567 Error ("comma expected");
|
|
|
568 end if;
|
|
|
569 end loop;
|
|
|
570
|
|
|
571 -- Store the entity into the table
|
|
|
572
|
|
|
573 JSON_Entity_Table.Append (Ent);
|
|
|
574
|
|
|
575 -- Associate the name with the entity
|
|
|
576
|
|
|
577 if Nam = No_Name then
|
|
|
578 Error ("name expected");
|
|
|
579 end if;
|
|
|
580
|
|
|
581 Set_Name_Table_Int (Nam, JSON_Entity_Table.Last);
|
|
|
582 end Read_Entity;
|
|
|
583
|
|
|
584 -----------------
|
|
|
585 -- Read_Name --
|
|
|
586 -----------------
|
|
|
587
|
|
|
588 function Read_Name return Valid_Name_Id is
|
|
|
589 Token_Start : Text_Position;
|
|
|
590 Token_End : Text_Position;
|
|
|
591
|
|
|
592 begin
|
|
|
593 -- Read a single string
|
|
|
594
|
|
|
595 Read_Token_And_Error (J_STRING, Token_Start, Token_End);
|
|
|
596
|
|
|
597 return Decode_Name (Token_Start.Index + 1, Token_End.Index - 1);
|
|
|
598 end Read_Name;
|
|
|
599
|
|
|
600 -----------------------------
|
|
|
601 -- Read_Name_With_Prefix --
|
|
|
602 -----------------------------
|
|
|
603
|
|
|
604 function Read_Name_With_Prefix return Valid_Name_Id is
|
|
|
605 Len : Natural;
|
|
|
606 Lo, Hi : Text_Ptr;
|
|
|
607 Token_Start : Text_Position;
|
|
|
608 Token_End : Text_Position;
|
|
|
609
|
|
|
610 begin
|
|
|
611 -- Read a single string
|
|
|
612
|
|
|
613 Read_Token_And_Error (J_STRING, Token_Start, Token_End);
|
|
|
614 Lo := Token_Start.Index + 1;
|
|
|
615 Hi := Token_End.Index - 1;
|
|
|
616
|
|
|
617 -- Prepare for the concatenation with the prefix
|
|
|
618
|
|
|
619 Len := Integer (Hi) - Integer (Lo) + 1;
|
|
|
620 if Prefix_Len + 1 + Len > Name_Buffer.Max_Length then
|
|
|
621 Error ("Name buffer too small");
|
|
|
622 end if;
|
|
|
623
|
|
|
624 Name_Buffer.Length := Prefix_Len + 1 + Len;
|
|
|
625 Name_Buffer.Chars (Prefix_Len + 1) := '.';
|
|
|
626
|
|
|
627 -- Names are stored in lower case so fold them if need be
|
|
|
628
|
|
|
629 if Is_Upper_Case_Letter (Text (Lo)) then
|
|
|
630 for J in Lo .. Hi loop
|
|
|
631 Name_Buffer.Chars (Prefix_Len + 2 + Integer (J - Lo)) :=
|
|
|
632 Fold_Lower (Text (J));
|
|
|
633 end loop;
|
|
|
634
|
|
|
635 else
|
|
|
636 declare
|
|
|
637 S : String (Integer (Lo) .. Integer (Hi));
|
|
|
638 for S'Address use Text (Lo)'Address;
|
|
|
639
|
|
|
640 begin
|
|
|
641 Name_Buffer.Chars (Prefix_Len + 2 .. Prefix_Len + 1 + Len) := S;
|
|
|
642 end;
|
|
|
643 end if;
|
|
|
644
|
|
|
645 return Name_Find (Name_Buffer);
|
|
|
646 end Read_Name_With_Prefix;
|
|
|
647
|
|
|
648 ------------------
|
|
|
649 -- Read_Number --
|
|
|
650 ------------------
|
|
|
651
|
|
|
652 function Read_Number return Uint is
|
|
|
653 Token_Start : Text_Position;
|
|
|
654 Token_End : Text_Position;
|
|
|
655
|
|
|
656 begin
|
|
|
657 -- Only integers are to be expected here
|
|
|
658
|
|
|
659 Read_Token_And_Error (J_INTEGER, Token_Start, Token_End);
|
|
|
660
|
|
|
661 return Decode_Integer (Token_Start.Index, Token_End.Index);
|
|
|
662 end Read_Number;
|
|
|
663
|
|
|
664 --------------------------
|
|
|
665 -- Read_Numerical_Expr --
|
|
|
666 --------------------------
|
|
|
667
|
|
|
668 function Read_Numerical_Expr return Node_Ref_Or_Val is
|
|
|
669 Code : TCode;
|
|
|
670 Nop : Integer;
|
|
|
671 Ops : array (1 .. 3) of Node_Ref_Or_Val;
|
|
|
672 TK : Token_Kind;
|
|
|
673 Token_Start : Text_Position;
|
|
|
674 Token_End : Text_Position;
|
|
|
675
|
|
|
676 begin
|
|
|
677 -- Read either an integer or an expression
|
|
|
678
|
|
|
679 Read_Token (TK, Token_Start, Token_End);
|
|
|
680 if TK = J_INTEGER then
|
|
|
681 return Decode_Integer (Token_Start.Index, Token_End.Index);
|
|
|
682
|
|
|
683 elsif TK = J_OBJECT then
|
|
|
684 -- Read the code of the expression and decode it
|
|
|
685
|
|
|
686 if Read_String /= Name_Code then
|
|
|
687 Error ("name expected");
|
|
|
688 end if;
|
|
|
689
|
|
|
690 Read_Token_And_Error (J_STRING, Token_Start, Token_End);
|
|
|
691 Code := Decode_Symbol (Token_Start.Index + 1, Token_End.Index - 1);
|
|
|
692 Read_Token_And_Error (J_COMMA, Token_Start, Token_End);
|
|
|
693
|
|
|
694 -- Read the array of operands
|
|
|
695
|
|
|
696 if Read_String /= Name_Operands then
|
|
|
697 Error ("operands expected");
|
|
|
698 end if;
|
|
|
699
|
|
|
700 Read_Token_And_Error (J_ARRAY, Token_Start, Token_End);
|
|
|
701
|
|
|
702 Nop := 0;
|
|
|
703 Ops := (others => No_Uint);
|
|
|
704 loop
|
|
|
705 Nop := Nop + 1;
|
|
|
706 Ops (Nop) := Read_Numerical_Expr;
|
|
|
707 Read_Token (TK, Token_Start, Token_End);
|
|
|
708 if TK = J_ARRAY_END then
|
|
|
709 exit;
|
|
|
710 elsif TK /= J_COMMA then
|
|
|
711 Error ("comma expected");
|
|
|
712 end if;
|
|
|
713 end loop;
|
|
|
714
|
|
|
715 Read_Token_And_Error (J_OBJECT_END, Token_Start, Token_End);
|
|
|
716
|
|
|
717 -- Resolve the ambiguity for '-' now
|
|
|
718
|
|
|
719 if Code = Minus_Expr and then Nop = 1 then
|
|
|
720 Code := Negate_Expr;
|
|
|
721 end if;
|
|
|
722
|
|
|
723 return Create_Node (Code, Ops (1), Ops (2), Ops (3));
|
|
|
724
|
|
|
725 else
|
|
|
726 Error ("numerical expression expected");
|
|
|
727 end if;
|
|
|
728 end Read_Numerical_Expr;
|
|
|
729
|
|
|
730 -------------------
|
|
|
731 -- Read_Record --
|
|
|
732 -------------------
|
|
|
733
|
|
|
734 procedure Read_Record is
|
|
|
735 Comp : JSON_Component_Node;
|
|
|
736 First_Bit : Node_Ref_Or_Val := No_Uint;
|
|
|
737 Is_First : Boolean := True;
|
|
|
738 Nam : Name_Id := No_Name;
|
|
|
739 Position : Node_Ref_Or_Val := No_Uint;
|
|
|
740 TK : Token_Kind;
|
|
|
741 Token_Start : Text_Position;
|
|
|
742 Token_End : Text_Position;
|
|
|
743
|
|
|
744 begin
|
|
|
745 -- Read a possibly empty array of components
|
|
|
746
|
|
|
747 Read_Token_And_Error (J_ARRAY, Token_Start, Token_End);
|
|
|
748
|
|
|
749 loop
|
|
|
750 Read_Token (TK, Token_Start, Token_End);
|
|
|
751 if Is_First and then TK = J_ARRAY_END then
|
|
|
752 exit;
|
|
|
753 elsif TK /= J_OBJECT then
|
|
|
754 Error ("object expected");
|
|
|
755 end if;
|
|
|
756
|
|
|
757 -- Read the members as string : value pairs
|
|
|
758
|
|
|
759 loop
|
|
|
760 case Read_String is
|
|
|
761 when Name_Name =>
|
|
|
762 Nam := Read_Name_With_Prefix;
|
|
|
763 when Name_Discriminant =>
|
|
|
764 Skip_Value;
|
|
|
765 when Name_Position =>
|
|
|
766 Position := Read_Numerical_Expr;
|
|
|
767 when Name_First_Bit =>
|
|
|
768 First_Bit := Read_Number;
|
|
|
769 when Name_Size =>
|
|
|
770 Comp.Esize := Read_Numerical_Expr;
|
|
|
771 when others =>
|
|
|
772 Error ("invalid component");
|
|
|
773 end case;
|
|
|
774
|
|
|
775 Read_Token (TK, Token_Start, Token_End);
|
|
|
776 if TK = J_OBJECT_END then
|
|
|
777 exit;
|
|
|
778 elsif TK /= J_COMMA then
|
|
|
779 Error ("comma expected");
|
|
|
780 end if;
|
|
|
781 end loop;
|
|
|
782
|
|
|
783 -- Compute Component_Bit_Offset from Position and First_Bit,
|
|
|
784 -- either symbolically or literally depending on Position.
|
|
|
785
|
|
|
786 if Position = No_Uint or else First_Bit = No_Uint then
|
|
|
787 Error ("bit offset expected");
|
|
|
788 end if;
|
|
|
789
|
|
|
790 if Position < Uint_0 then
|
|
|
791 declare
|
|
|
792 Bit_Position : constant Node_Ref_Or_Val :=
|
|
|
793 Create_Node (Mult_Expr, Position, UI_From_Int (SSU));
|
|
|
794 begin
|
|
|
795 if First_Bit = Uint_0 then
|
|
|
796 Comp.Bit_Offset := Bit_Position;
|
|
|
797 else
|
|
|
798 Comp.Bit_Offset :=
|
|
|
799 Create_Node (Plus_Expr, Bit_Position, First_Bit);
|
|
|
800 end if;
|
|
|
801 end;
|
|
|
802 else
|
|
|
803 Comp.Bit_Offset := Position * SSU + First_Bit;
|
|
|
804 end if;
|
|
|
805
|
|
|
806 -- Store the component into the table
|
|
|
807
|
|
|
808 JSON_Component_Table.Append (Comp);
|
|
|
809
|
|
|
810 -- Associate the name with the component
|
|
|
811
|
|
|
812 if Nam = No_Name then
|
|
|
813 Error ("name expected");
|
|
|
814 end if;
|
|
|
815
|
|
|
816 Set_Name_Table_Int (Nam, JSON_Component_Table.Last);
|
|
|
817
|
|
|
818 Read_Token (TK, Token_Start, Token_End);
|
|
|
819 if TK = J_ARRAY_END then
|
|
|
820 exit;
|
|
|
821 elsif TK /= J_COMMA then
|
|
|
822 Error ("comma expected");
|
|
|
823 end if;
|
|
|
824
|
|
|
825 Is_First := False;
|
|
|
826 end loop;
|
|
|
827 end Read_Record;
|
|
|
828
|
|
|
829 ------------------
|
|
|
830 -- Read_String --
|
|
|
831 ------------------
|
|
|
832
|
|
|
833 function Read_String return Valid_Name_Id is
|
|
|
834 Token_Start : Text_Position;
|
|
|
835 Token_End : Text_Position;
|
|
|
836 Nam : Valid_Name_Id;
|
|
|
837
|
|
|
838 begin
|
|
|
839 -- Read the string and the following colon
|
|
|
840
|
|
|
841 Read_Token_And_Error (J_STRING, Token_Start, Token_End);
|
|
|
842 Nam := Decode_Name (Token_Start.Index + 1, Token_End.Index - 1);
|
|
|
843 Read_Token_And_Error (J_COLON, Token_Start, Token_End);
|
|
|
844
|
|
|
845 return Nam;
|
|
|
846 end Read_String;
|
|
|
847
|
|
|
848 ------------------
|
|
|
849 -- Read_Token --
|
|
|
850 ------------------
|
|
|
851
|
|
|
852 procedure Read_Token
|
|
|
853 (Kind : out Token_Kind;
|
|
|
854 Token_Start : out Text_Position;
|
|
|
855 Token_End : out Text_Position)
|
|
|
856 is
|
|
|
857 procedure Next_Char;
|
|
|
858 -- Update Pos to point to next char
|
|
|
859
|
|
|
860 function Is_Whitespace return Boolean;
|
|
|
861 pragma Inline (Is_Whitespace);
|
|
|
862 -- Return True of current character is a whitespace
|
|
|
863
|
|
|
864 function Is_Structural_Token return Boolean;
|
|
|
865 pragma Inline (Is_Structural_Token);
|
|
|
866 -- Return True if current character is one of the structural tokens
|
|
|
867
|
|
|
868 function Is_Token_Sep return Boolean;
|
|
|
869 pragma Inline (Is_Token_Sep);
|
|
|
870 -- Return True if current character is a token separator
|
|
|
871
|
|
|
872 procedure Delimit_Keyword (Kw : String);
|
|
|
873 -- Helper function to parse tokens such as null, false and true
|
|
|
874
|
|
|
875 ---------------
|
|
|
876 -- Next_Char --
|
|
|
877 ---------------
|
|
|
878
|
|
|
879 procedure Next_Char is
|
|
|
880 begin
|
|
|
881 if Pos.Index > Text'Last then
|
|
|
882 Pos.Column := Pos.Column + 1;
|
|
|
883 elsif Text (Pos.Index) = ASCII.LF then
|
|
|
884 Pos.Column := 1;
|
|
|
885 Pos.Line := Pos.Line + 1;
|
|
|
886 else
|
|
|
887 Pos.Column := Pos.Column + 1;
|
|
|
888 end if;
|
|
|
889 Pos.Index := Pos.Index + 1;
|
|
|
890 end Next_Char;
|
|
|
891
|
|
|
892 -------------------
|
|
|
893 -- Is_Whitespace --
|
|
|
894 -------------------
|
|
|
895
|
|
|
896 function Is_Whitespace return Boolean is
|
|
|
897 begin
|
|
|
898 return
|
|
|
899 Pos.Index <= Text'Last
|
|
|
900 and then
|
|
|
901 (Text (Pos.Index) = ASCII.LF
|
|
|
902 or else
|
|
|
903 Text (Pos.Index) = ASCII.CR
|
|
|
904 or else
|
|
|
905 Text (Pos.Index) = ASCII.HT
|
|
|
906 or else
|
|
|
907 Text (Pos.Index) = ' ');
|
|
|
908 end Is_Whitespace;
|
|
|
909
|
|
|
910 -------------------------
|
|
|
911 -- Is_Structural_Token --
|
|
|
912 -------------------------
|
|
|
913
|
|
|
914 function Is_Structural_Token return Boolean is
|
|
|
915 begin
|
|
|
916 return
|
|
|
917 Pos.Index <= Text'Last
|
|
|
918 and then
|
|
|
919 (Text (Pos.Index) = '['
|
|
|
920 or else
|
|
|
921 Text (Pos.Index) = ']'
|
|
|
922 or else
|
|
|
923 Text (Pos.Index) = '{'
|
|
|
924 or else
|
|
|
925 Text (Pos.Index) = '}'
|
|
|
926 or else
|
|
|
927 Text (Pos.Index) = ','
|
|
|
928 or else
|
|
|
929 Text (Pos.Index) = ':');
|
|
|
930 end Is_Structural_Token;
|
|
|
931
|
|
|
932 ------------------
|
|
|
933 -- Is_Token_Sep --
|
|
|
934 ------------------
|
|
|
935
|
|
|
936 function Is_Token_Sep return Boolean is
|
|
|
937 begin
|
|
|
938 return
|
|
|
939 Pos.Index > Text'Last
|
|
|
940 or else
|
|
|
941 Is_Whitespace
|
|
|
942 or else
|
|
|
943 Is_Structural_Token;
|
|
|
944 end Is_Token_Sep;
|
|
|
945
|
|
|
946 ---------------------
|
|
|
947 -- Delimit_Keyword --
|
|
|
948 ---------------------
|
|
|
949
|
|
|
950 procedure Delimit_Keyword (Kw : String) is
|
|
|
951 pragma Unreferenced (Kw);
|
|
|
952 begin
|
|
|
953 while not Is_Token_Sep loop
|
|
|
954 Token_End := Pos;
|
|
|
955 Next_Char;
|
|
|
956 end loop;
|
|
|
957 end Delimit_Keyword;
|
|
|
958
|
|
|
959 CC : Character;
|
|
|
960 Can_Be_Integer : Boolean := True;
|
|
|
961
|
|
|
962 -- Start of processing for Read_Token
|
|
|
963
|
|
|
964 begin
|
|
|
965 -- Skip leading whitespaces
|
|
|
966
|
|
|
967 while Is_Whitespace loop
|
|
|
968 Next_Char;
|
|
|
969 end loop;
|
|
|
970
|
|
|
971 -- Initialize token delimiters
|
|
|
972
|
|
|
973 Token_Start := Pos;
|
|
|
974 Token_End := Pos;
|
|
|
975
|
|
|
976 -- End of stream reached
|
|
|
977
|
|
|
978 if Pos.Index > Text'Last then
|
|
|
979 Kind := J_EOF;
|
|
|
980 return;
|
|
|
981 end if;
|
|
|
982
|
|
|
983 CC := Text (Pos.Index);
|
|
|
984
|
|
|
985 if CC = '[' then
|
|
|
986 Next_Char;
|
|
|
987 Kind := J_ARRAY;
|
|
|
988 return;
|
|
|
989 elsif CC = ']' then
|
|
|
990 Next_Char;
|
|
|
991 Kind := J_ARRAY_END;
|
|
|
992 return;
|
|
|
993 elsif CC = '{' then
|
|
|
994 Next_Char;
|
|
|
995 Kind := J_OBJECT;
|
|
|
996 return;
|
|
|
997 elsif CC = '}' then
|
|
|
998 Next_Char;
|
|
|
999 Kind := J_OBJECT_END;
|
|
|
1000 return;
|
|
|
1001 elsif CC = ',' then
|
|
|
1002 Next_Char;
|
|
|
1003 Kind := J_COMMA;
|
|
|
1004 return;
|
|
|
1005 elsif CC = ':' then
|
|
|
1006 Next_Char;
|
|
|
1007 Kind := J_COLON;
|
|
|
1008 return;
|
|
|
1009 elsif CC = 'n' then
|
|
|
1010 Delimit_Keyword ("null");
|
|
|
1011 Kind := J_NULL;
|
|
|
1012 return;
|
|
|
1013 elsif CC = 'f' then
|
|
|
1014 Delimit_Keyword ("false");
|
|
|
1015 Kind := J_FALSE;
|
|
|
1016 return;
|
|
|
1017 elsif CC = 't' then
|
|
|
1018 Delimit_Keyword ("true");
|
|
|
1019 Kind := J_TRUE;
|
|
|
1020 return;
|
|
|
1021 elsif CC = '"' then
|
|
|
1022 -- We expect a string
|
|
|
1023 -- Just scan till the end the of the string but do not attempt
|
|
|
1024 -- to decode it. This means that even if we get a string token
|
|
|
1025 -- it might not be a valid string from the ECMA 404 point of
|
|
|
1026 -- view.
|
|
|
1027
|
|
|
1028 Next_Char;
|
|
|
1029 while Pos.Index <= Text'Last and then Text (Pos.Index) /= '"' loop
|
|
|
1030 if Text (Pos.Index) in ASCII.NUL .. ASCII.US then
|
|
|
1031 Error ("control character not allowed in string");
|
|
|
1032 end if;
|
|
|
1033
|
|
|
1034 if Text (Pos.Index) = '\' then
|
|
|
1035 Next_Char;
|
|
|
1036 if Pos.Index > Text'Last then
|
|
|
1037 Error ("non terminated string token");
|
|
|
1038 end if;
|
|
|
1039
|
|
|
1040 case Text (Pos.Index) is
|
|
|
1041 when 'u' =>
|
|
|
1042 for Idx in 1 .. 4 loop
|
|
|
1043 Next_Char;
|
|
|
1044 if Pos.Index > Text'Last
|
|
|
1045 or else (Text (Pos.Index) not in 'a' .. 'f'
|
|
|
1046 and then
|
|
|
1047 Text (Pos.Index) not in 'A' .. 'F'
|
|
|
1048 and then
|
|
|
1049 Text (Pos.Index) not in '0' .. '9')
|
|
|
1050 then
|
|
|
1051 Error ("invalid unicode escape sequence");
|
|
|
1052 end if;
|
|
|
1053 end loop;
|
|
|
1054 when '\' | '/' | '"' | 'b' | 'f' | 'n' | 'r' | 't' =>
|
|
|
1055 null;
|
|
|
1056 when others =>
|
|
|
1057 Error ("invalid escape sequence");
|
|
|
1058 end case;
|
|
|
1059 end if;
|
|
|
1060 Next_Char;
|
|
|
1061 end loop;
|
|
|
1062
|
|
|
1063 -- No quote found report and error
|
|
|
1064
|
|
|
1065 if Pos.Index > Text'Last then
|
|
|
1066 Error ("non terminated string token");
|
|
|
1067 end if;
|
|
|
1068
|
|
|
1069 Token_End := Pos;
|
|
|
1070
|
|
|
1071 -- Go to next char and ensure that this is separator. Indeed
|
|
|
1072 -- construction such as "string1""string2" are not allowed
|
|
|
1073
|
|
|
1074 Next_Char;
|
|
|
1075 if not Is_Token_Sep then
|
|
|
1076 Error ("invalid syntax");
|
|
|
1077 end if;
|
|
|
1078 Kind := J_STRING;
|
|
|
1079 return;
|
|
|
1080 elsif CC = '-' or else CC in '0' .. '9' then
|
|
|
1081 -- We expect a number
|
|
|
1082 if CC = '-' then
|
|
|
1083 Next_Char;
|
|
|
1084 end if;
|
|
|
1085
|
|
|
1086 if Pos.Index > Text'Last then
|
|
|
1087 Error ("invalid number");
|
|
|
1088 end if;
|
|
|
1089
|
|
|
1090 -- Parse integer part of a number. Superfluous leading zeros are
|
|
|
1091 -- not allowed.
|
|
|
1092
|
|
|
1093 if Text (Pos.Index) = '0' then
|
|
|
1094 Token_End := Pos;
|
|
|
1095 Next_Char;
|
|
|
1096 elsif Text (Pos.Index) in '1' .. '9' then
|
|
|
1097 Token_End := Pos;
|
|
|
1098 Next_Char;
|
|
|
1099 while Pos.Index <= Text'Last
|
|
|
1100 and then Text (Pos.Index) in '0' .. '9'
|
|
|
1101 loop
|
|
|
1102 Token_End := Pos;
|
|
|
1103 Next_Char;
|
|
|
1104 end loop;
|
|
|
1105 else
|
|
|
1106 Error ("invalid number");
|
|
|
1107 end if;
|
|
|
1108
|
|
|
1109 if Is_Token_Sep then
|
|
|
1110 -- Valid integer number
|
|
|
1111
|
|
|
1112 Kind := J_INTEGER;
|
|
|
1113 return;
|
|
|
1114 elsif Text (Pos.Index) /= '.'
|
|
|
1115 and then Text (Pos.Index) /= 'e'
|
|
|
1116 and then Text (Pos.Index) /= 'E'
|
|
|
1117 then
|
|
|
1118 Error ("invalid number");
|
|
|
1119 end if;
|
|
|
1120
|
|
|
1121 -- Check for a fractional part
|
|
|
1122
|
|
|
1123 if Text (Pos.Index) = '.' then
|
|
|
1124 Can_Be_Integer := False;
|
|
|
1125 Token_End := Pos;
|
|
|
1126 Next_Char;
|
|
|
1127 if Pos.Index > Text'Last
|
|
|
1128 or else Text (Pos.Index) not in '0' .. '9'
|
|
|
1129 then
|
|
|
1130 Error ("invalid number");
|
|
|
1131 end if;
|
|
|
1132
|
|
|
1133 while Pos.Index <= Text'Last
|
|
|
1134 and then Text (Pos.Index) in '0' .. '9'
|
|
|
1135 loop
|
|
|
1136 Token_End := Pos;
|
|
|
1137 Next_Char;
|
|
|
1138 end loop;
|
|
|
1139
|
|
|
1140 end if;
|
|
|
1141
|
|
|
1142 -- Check for exponent part
|
|
|
1143
|
|
|
1144 if Pos.Index <= Text'Last
|
|
|
1145 and then (Text (Pos.Index) = 'e' or else Text (Pos.Index) = 'E')
|
|
|
1146 then
|
|
|
1147 Token_End := Pos;
|
|
|
1148 Next_Char;
|
|
|
1149 if Pos.Index > Text'Last then
|
|
|
1150 Error ("invalid number");
|
|
|
1151 end if;
|
|
|
1152
|
|
|
1153 if Text (Pos.Index) = '-' then
|
|
|
1154 -- Also a few corner cases can lead to an integer, assume
|
|
|
1155 -- that the number is not an integer.
|
|
|
1156
|
|
|
1157 Can_Be_Integer := False;
|
|
|
1158 end if;
|
|
|
1159
|
|
|
1160 if Text (Pos.Index) = '-' or else Text (Pos.Index) = '+' then
|
|
|
1161 Next_Char;
|
|
|
1162 end if;
|
|
|
1163
|
|
|
1164 if Pos.Index > Text'Last
|
|
|
1165 or else Text (Pos.Index) not in '0' .. '9'
|
|
|
1166 then
|
|
|
1167 Error ("invalid number");
|
|
|
1168 end if;
|
|
|
1169
|
|
|
1170 while Pos.Index <= Text'Last
|
|
|
1171 and then Text (Pos.Index) in '0' .. '9'
|
|
|
1172 loop
|
|
|
1173 Token_End := Pos;
|
|
|
1174 Next_Char;
|
|
|
1175 end loop;
|
|
|
1176 end if;
|
|
|
1177
|
|
|
1178 if Is_Token_Sep then
|
|
|
1179 -- Valid decimal number
|
|
|
1180
|
|
|
1181 if Can_Be_Integer then
|
|
|
1182 Kind := J_INTEGER;
|
|
|
1183 else
|
|
|
1184 Kind := J_NUMBER;
|
|
|
1185 end if;
|
|
|
1186 return;
|
|
|
1187 else
|
|
|
1188 Error ("invalid number");
|
|
|
1189 end if;
|
|
|
1190 elsif CC = EOF then
|
|
|
1191 Kind := J_EOF;
|
|
|
1192 else
|
|
|
1193 Error ("Unexpected character");
|
|
|
1194 end if;
|
|
|
1195 end Read_Token;
|
|
|
1196
|
|
|
1197 ----------------------------
|
|
|
1198 -- Read_Token_And_Error --
|
|
|
1199 ----------------------------
|
|
|
1200
|
|
|
1201 procedure Read_Token_And_Error
|
|
|
1202 (TK : Token_Kind;
|
|
|
1203 Token_Start : out Text_Position;
|
|
|
1204 Token_End : out Text_Position)
|
|
|
1205 is
|
|
|
1206 Kind : Token_Kind;
|
|
|
1207
|
|
|
1208 begin
|
|
|
1209 -- Read a token and errout out if not of the expected kind
|
|
|
1210
|
|
|
1211 Read_Token (Kind, Token_Start, Token_End);
|
|
|
1212 if Kind /= TK then
|
|
|
1213 Error ("specific token expected");
|
|
|
1214 end if;
|
|
|
1215 end Read_Token_And_Error;
|
|
|
1216
|
|
|
1217 -------------------------
|
|
|
1218 -- Read_Variant_Part --
|
|
|
1219 -------------------------
|
|
|
1220
|
|
|
1221 function Read_Variant_Part return Nat is
|
|
|
1222 Next : Nat := 0;
|
|
|
1223 TK : Token_Kind;
|
|
|
1224 Token_Start : Text_Position;
|
|
|
1225 Token_End : Text_Position;
|
|
|
1226 Var : JSON_Variant_Node;
|
|
|
1227
|
|
|
1228 begin
|
|
|
1229 -- Read a non-empty array of components
|
|
|
1230
|
|
|
1231 Read_Token_And_Error (J_ARRAY, Token_Start, Token_End);
|
|
|
1232
|
|
|
1233 loop
|
|
|
1234 Read_Token_And_Error (J_OBJECT, Token_Start, Token_End);
|
|
|
1235
|
|
|
1236 Var.Variant := 0;
|
|
|
1237
|
|
|
1238 -- Read the members as string : value pairs
|
|
|
1239
|
|
|
1240 loop
|
|
|
1241 case Read_String is
|
|
|
1242 when Name_Present =>
|
|
|
1243 Var.Present := Read_Numerical_Expr;
|
|
|
1244 when Name_Record =>
|
|
|
1245 Read_Record;
|
|
|
1246 when Name_Variant =>
|
|
|
1247 Var.Variant := Read_Variant_Part;
|
|
|
1248 when others =>
|
|
|
1249 Error ("invalid variant");
|
|
|
1250 end case;
|
|
|
1251
|
|
|
1252 Read_Token (TK, Token_Start, Token_End);
|
|
|
1253 if TK = J_OBJECT_END then
|
|
|
1254 exit;
|
|
|
1255 elsif TK /= J_COMMA then
|
|
|
1256 Error ("comma expected");
|
|
|
1257 end if;
|
|
|
1258 end loop;
|
|
|
1259
|
|
|
1260 -- Chain the variant and store it into the table
|
|
|
1261
|
|
|
1262 Var.Next := Next;
|
|
|
1263 JSON_Variant_Table.Append (Var);
|
|
|
1264 Next := JSON_Variant_Table.Last;
|
|
|
1265
|
|
|
1266 Read_Token (TK, Token_Start, Token_End);
|
|
|
1267 if TK = J_ARRAY_END then
|
|
|
1268 exit;
|
|
|
1269 elsif TK /= J_COMMA then
|
|
|
1270 Error ("comma expected");
|
|
|
1271 end if;
|
|
|
1272 end loop;
|
|
|
1273
|
|
|
1274 return Next;
|
|
|
1275 end Read_Variant_Part;
|
|
|
1276
|
|
|
1277 ------------------
|
|
|
1278 -- Skip_Value --
|
|
|
1279 ------------------
|
|
|
1280
|
|
|
1281 procedure Skip_Value is
|
|
|
1282 Array_Depth : Natural := 0;
|
|
|
1283 Object_Depth : Natural := 0;
|
|
|
1284 TK : Token_Kind;
|
|
|
1285 Token_Start : Text_Position;
|
|
|
1286 Token_End : Text_Position;
|
|
|
1287
|
|
|
1288 begin
|
|
|
1289 -- Read a value without recursing
|
|
|
1290
|
|
|
1291 loop
|
|
|
1292 Read_Token (TK, Token_Start, Token_End);
|
|
|
1293
|
|
|
1294 case TK is
|
|
|
1295 when J_STRING | J_INTEGER | J_NUMBER =>
|
|
|
1296 null;
|
|
|
1297 when J_ARRAY =>
|
|
|
1298 Array_Depth := Array_Depth + 1;
|
|
|
1299 when J_ARRAY_END =>
|
|
|
1300 Array_Depth := Array_Depth - 1;
|
|
|
1301 when J_OBJECT =>
|
|
|
1302 Object_Depth := Object_Depth + 1;
|
|
|
1303 when J_OBJECT_END =>
|
|
|
1304 Object_Depth := Object_Depth - 1;
|
|
|
1305 when J_COLON | J_COMMA =>
|
|
|
1306 if Array_Depth = 0 and then Object_Depth = 0 then
|
|
|
1307 Error ("value expected");
|
|
|
1308 end if;
|
|
|
1309 when others =>
|
|
|
1310 Error ("value expected");
|
|
|
1311 end case;
|
|
|
1312
|
|
|
1313 exit when Array_Depth = 0 and then Object_Depth = 0;
|
|
|
1314 end loop;
|
|
|
1315 end Skip_Value;
|
|
|
1316
|
|
|
1317 Token_Start : Text_Position;
|
|
|
1318 Token_End : Text_Position;
|
|
|
1319 TK : Token_Kind;
|
|
|
1320 Is_First : Boolean := True;
|
|
|
1321
|
|
|
1322 -- Start of processing for Read_JSON_Stream
|
|
|
1323
|
|
|
1324 begin
|
|
|
1325 -- Read a possibly empty array of entities
|
|
|
1326
|
|
|
1327 Read_Token_And_Error (J_ARRAY, Token_Start, Token_End);
|
|
|
1328
|
|
|
1329 loop
|
|
|
1330 Read_Token (TK, Token_Start, Token_End);
|
|
|
1331 if Is_First and then TK = J_ARRAY_END then
|
|
|
1332 exit;
|
|
|
1333 elsif TK /= J_OBJECT then
|
|
|
1334 Error ("object expected");
|
|
|
1335 end if;
|
|
|
1336
|
|
|
1337 Read_Entity;
|
|
|
1338
|
|
|
1339 Read_Token (TK, Token_Start, Token_End);
|
|
|
1340 if TK = J_ARRAY_END then
|
|
|
1341 exit;
|
|
|
1342 elsif TK /= J_COMMA then
|
|
|
1343 Error ("comma expected");
|
|
|
1344 end if;
|
|
|
1345
|
|
|
1346 Is_First := False;
|
|
|
1347 end loop;
|
|
|
1348 end Read_JSON_Stream;
|
|
|
1349
|
|
|
1350 end Repinfo.Input;
|
