added code to handle temporary object pointers

This commit is contained in:
2014-01-15 09:21:26 +00:00
parent 967f70fd34
commit 7a80455258
6 changed files with 125 additions and 60 deletions

View File

@ -1,6 +1,6 @@
with ada.text_io;
package body H2.UTF8 is
package body H2.Utf8 is
type Uint8 is mod 2 ** 8;
type Uint32 is mod 2 ** 32;
@ -25,8 +25,8 @@ package body H2.UTF8 is
(16#0400_0000#, 16#7FFF_FFFF#, 16#FC#, 16#FE#, 16#01#, 6)
);
function Get_UTF8_Slot (UV: in Uint32) return System_Size is
pragma Inline (Get_UTF8_Slot);
function Get_Utf8_Slot (UV: in Uint32) return System_Size is
pragma Inline (Get_Utf8_Slot);
begin
for I in Conv_Table'Range loop
if UV >= Conv_Table(I).Lower and then UV <= Conv_Table(I).Upper then
@ -34,37 +34,36 @@ package body H2.UTF8 is
end if;
end loop;
return System_Size'First;
end Get_UTF8_Slot;
end Get_Utf8_Slot;
function Unicode_To_UTF8 (UC: in Unicode_Character) return UTF8_String is
function Unicode_To_Utf8 (UC: in Unicode_Character) return Utf8_String is
UV: Uint32;
I: System_Size;
begin
UV := Unicode_Character'Pos(UC);
I := Get_UTF8_Slot(UV);
I := Get_Utf8_Slot(UV);
if I not in System_Index'Range then
raise Invalid_Unicode_Character;
end if;
declare
subtype Result_String is UTF8_String(1 .. System_Index(Conv_Table(I).Length));
Result: Result_String;
Result: Utf8_String (1 .. System_Index(Conv_Table(I).Length));
begin
for J in reverse Result_String'First + 1 .. Result_String'Last loop
for J in reverse Result'First + 1 .. Result'Last loop
-- 2#0011_1111#: 16#3F#
-- 2#1000_0000#: 16#80#
Result(J) := UTF8_Character'Val((UV and 2#0011_1111#) or 2#1000_0000#);
Result(J) := Utf8_Character'Val((UV and 2#0011_1111#) or 2#1000_0000#);
UV := UV / (2 ** 6); --UV := UV >> 6;
end loop;
Result(Result_String'First) := UTF8_Character'Val(UV or Uint32(Conv_Table(I).Fbyte));
Result(Result'First) := Utf8_Character'Val(UV or Uint32(Conv_Table(I).Fbyte));
return Result;
end;
end Unicode_To_UTF8;
end Unicode_To_Utf8;
function Unicode_To_UTF8 (US: in Unicode_String) return UTF8_String is
function Unicode_To_Utf8 (US: in Unicode_String) return Utf8_String is
-- this function has high stack pressur if the input string is too long
-- TODO: create a procedure to overcome this problem.
Tmp: System_Size;
@ -72,39 +71,38 @@ package body H2.UTF8 is
Tmp := 0;
for I in US'Range loop
declare
UTF8: UTF8_String := Unicode_To_UTF8(US(I));
Utf8: Utf8_String := Unicode_To_Utf8(US(I));
begin
Tmp := Tmp + UTF8'Length;
Tmp := Tmp + Utf8'Length;
end;
end loop;
declare
subtype Result_String is UTF8_String(1 .. Tmp);
Result: Result_String;
Result: Utf8_String (1 .. Tmp);
begin
Tmp := Result'First;
for I in US'Range loop
declare
UTF8: UTF8_String := Unicode_To_UTF8(US(I));
Utf8: Utf8_String := Unicode_To_Utf8(US(I));
begin
Result(Tmp .. Tmp + UTF8'Length - 1) := UTF8;
Tmp := Tmp + UTF8'Length;
Result(Tmp .. Tmp + Utf8'Length - 1) := Utf8;
Tmp := Tmp + Utf8'Length;
end;
end loop;
return Result;
end;
end Unicode_To_UTF8;
end Unicode_To_Utf8;
procedure UTF8_To_Unicode (UTF8: in UTF8_String;
procedure Utf8_To_Unicode (Utf8: in Utf8_String;
UC: out Unicode_Character) is
begin
null;
end UTF8_To_Unicode;
end Utf8_To_Unicode;
procedure UTF8_To_Unicode (UTF8: in UTF8_String;
procedure Utf8_To_Unicode (Utf8: in Utf8_String;
US: in out Unicode_String) is
begin
null;
end UTF8_To_Unicode;
end Utf8_To_Unicode;
end H2.UTF8;
end H2.Utf8;