]>
Commit | Line | Data |
---|---|---|
6c165711 EB |
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; |