1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139 | with Ada.Unchecked_Conversion;
package body Lua.Ada_Types is
function Img2Addr is new Ada.Unchecked_Conversion
(Image_Function, System.Address);
function Addr2Img is new Ada.Unchecked_Conversion
(System.Address, Image_Function);
function Image_Lua_Wrapper (State : Lua_State) return Integer;
pragma Convention (C, Image_Lua_Wrapper);
-- Lua function registered as __tostring metamethod. The function is used
-- to implement Register_Image_Function
function Equal_To (State : Lua_State) return Integer;
pragma Convention (C, Equal_To);
-- Lua function used to implement the __eq metamethod
procedure Create_Metatable (State : Lua_State);
-- Initialize the metatable associated with Ada_Type object in Lua
----------------------
-- Create_Metatable --
----------------------
procedure Create_Metatable (State : Lua_State) is
begin
-- We assume that the metatable is the top of the stack at the beginning
-- of the procedure.
Push (State, "__eq");
Push_Closure (State, Equal_To'Unrestricted_Access);
Set_Table (State, -3);
end Create_Metatable;
--------------
-- Equal_To --
--------------
function Equal_To (State : Lua_State) return Integer is
Left : constant Ada_Type := To_Ada (State, 1);
Right : constant Ada_Type := To_Ada (State, 2);
begin
Push (State, Left = Right);
return 1;
end Equal_To;
-----------------------
-- Image_Lua_Wrapper --
-----------------------
function Image_Lua_Wrapper (State : Lua_State) return Integer is
-- Get the argument
Arg : constant Ada_Type := To_Ada (State, 1);
User_Data : constant Lua_User_Data := To_Ada (State, Upvalue_Index (1));
Fun : Image_Function;
begin
-- The Ada image function is an upvalue in the closure of our wrapper.
Fun := Addr2Img (System.Address (User_Data));
Push (State, Fun (Arg));
return 1;
end Image_Lua_Wrapper;
----------
-- Push --
----------
procedure Push (State : Lua_State; Data : Ada_Type)
is
Result_Addr : constant System.Address :=
New_User_Data (State, Data'Size);
Result : Ada_Type;
pragma Import (C, Result);
for Result'Address use Result_Addr;
Ada_Type_Exists : constant Boolean := New_Metatable (State, Name);
begin
if not Ada_Type_Exists then
Create_Metatable (State);
end if;
Result := Data;
Set_Metatable (State, -2);
end Push;
--------------------
-- Register_Image --
--------------------
procedure Register_Image (State : Lua_State; Fun : Image_Function) is
Ada_Type_Exists : constant Boolean := New_Metatable (State, Name);
begin
if not Ada_Type_Exists then
Create_Metatable (State);
end if;
Push (State, "__tostring");
Push (State, Lua_Light_User_Data (Img2Addr (Fun)));
Push_Closure (State, Image_Lua_Wrapper'Unrestricted_Access, 1);
Set_Table (State, -3);
Pop (State);
end Register_Image;
---------------------
-- Register_Object --
---------------------
procedure Register_Object
(State : Lua_State; Name : String; Obj : Ada_Type)
is
begin
Push (State, Obj);
Register_Object (State, Name);
end Register_Object;
------------
-- To_Ada --
------------
function To_Ada
(State : Lua_State; Index : Lua_Index)
return Ada_Type
is
User_Data : constant Lua_User_Data :=
Test_User_Data (State, Index, Name);
begin
if User_Data = Lua_User_Data (System.Null_Address) then
raise Lua_Type_Error
with "expect type " & Name;
end if;
declare
Result : Ada_Type;
for Result'Address use System.Address (User_Data);
pragma Import (C, Result);
begin
return Result;
end;
end To_Ada;
end Lua.Ada_Types;
|