source: trunk/ada-2012/src/asis/asis-extensions-static_expressions.adb@ 374

Last change on this file since 374 was 374, checked in by Maxim Reznik, 6 years ago

Add Is_String function for check static values

File size: 2.6 KB
Line 
1with Gela.Compilations;
2with Gela.Element_Visiters;
3with Gela.Elements.Auxiliary_Applies;
4with Gela.Elements.String_Literals;
5with Gela.Semantic_Types;
6
7package body Asis.Extensions.Static_Expressions is
8
9 ---------------
10 -- Is_Static --
11 ---------------
12
13 function Is_Static (Self : Value) return Boolean is
14 begin
15 return Self.Is_Static;
16 end Is_Static;
17
18 ---------------
19 -- Is_String --
20 ---------------
21
22 function Is_String (Self : Value) return Boolean is
23 begin
24 return Self.Is_String;
25 end Is_String;
26
27 ------------------
28 -- Static_Value --
29 ------------------
30
31 function Static_Value (Expression : Asis.Expression) return Value is
32 package Get is
33 type Visiter is new Gela.Element_Visiters.Visiter with record
34 Result : Gela.Semantic_Types.Value_Index := 0;
35 end record;
36
37 overriding procedure Auxiliary_Apply
38 (Self : in out Visiter;
39 Node : not null Gela.Elements.Auxiliary_Applies.
40 Auxiliary_Apply_Access);
41
42 overriding procedure String_Literal
43 (Self : in out Visiter;
44 Node : not null Gela.Elements.String_Literals.
45 String_Literal_Access);
46
47 end Get;
48
49 package body Get is
50
51 overriding procedure Auxiliary_Apply
52 (Self : in out Visiter;
53 Node : not null Gela.Elements.Auxiliary_Applies.
54 Auxiliary_Apply_Access)
55 is
56 begin
57 Self.Result := Node.Static_Value;
58 end Auxiliary_Apply;
59
60 overriding procedure String_Literal
61 (Self : in out Visiter;
62 Node : not null Gela.Elements.String_Literals.
63 String_Literal_Access) is
64 begin
65 Self.Result := Node.Static_Value;
66 end String_Literal;
67
68 end Get;
69
70 use type Gela.Semantic_Types.Value_Index;
71 V : Get.Visiter;
72 begin
73 Check_Nil_Element (Expression, "Static_Value");
74 Expression.Data.Visit (V);
75
76 if V.Result = 0 then
77 return (others => <>);
78 else
79 declare
80 Comp : constant Gela.Compilations.Compilation_Access :=
81 Expression.Data.Enclosing_Compilation;
82 begin
83 return (Is_Static => True,
84 Is_String => Comp.Context.Values.Is_String (V.Result),
85 Image => Comp.Context.Values.Image (V.Result));
86 end;
87 end if;
88 end Static_Value;
89
90 -----------------
91 -- Value_Image --
92 -----------------
93
94 function Value_Image (Self : Value) return Asis.Program_Text is
95 begin
96 return Self.Image.To_UTF_16_Wide_String;
97 end Value_Image;
98
99end Asis.Extensions.Static_Expressions;
Note: See TracBrowser for help on using the repository browser.