some code clean-up
This commit is contained in:
parent
ef734a5bc1
commit
2625942e08
@ -84,9 +84,9 @@ package body H3.CC is
|
|||||||
return Item_Type'Val(UC.UTF_32_To_Upper_Case(Item_Type'Pos(V)));
|
return Item_Type'Val(UC.UTF_32_To_Upper_Case(Item_Type'Pos(V)));
|
||||||
end To_Upper;
|
end To_Upper;
|
||||||
|
|
||||||
function Is_Class (V: in Item_Type; Cls: in Class) return Boolean is
|
function Is_Class (V: in Item_Type; Class: in Item_Class) return Boolean is
|
||||||
begin
|
begin
|
||||||
case Cls is
|
case Class is
|
||||||
when ALPHA => return Is_Alpha(V);
|
when ALPHA => return Is_Alpha(V);
|
||||||
when ALNUM => return Is_Alnum(V);
|
when ALNUM => return Is_Alnum(V);
|
||||||
when BLANK => return Is_Blank(V);
|
when BLANK => return Is_Blank(V);
|
||||||
|
@ -7,15 +7,15 @@ package H3.CC is
|
|||||||
subtype Item_Code is H3.Natural;
|
subtype Item_Code is H3.Natural;
|
||||||
|
|
||||||
Colon: constant Item_Code := System_Character'Pos(':');
|
Colon: constant Item_Code := System_Character'Pos(':');
|
||||||
SemicoloN: constant Item_Code := System_Character'Pos(';');
|
Semicolon: constant Item_Code := System_Character'Pos(';');
|
||||||
Tilde: constant Item_Code := System_Character'Pos('~');
|
Tilde: constant Item_Code := System_Character'Pos('~');
|
||||||
Underline: constant Item_Code := System_Character'Pos('_');
|
Underline: constant Item_Code := System_Character'Pos('_');
|
||||||
Equal: constant Item_Code := System_Character'Pos('=');
|
Equal: constant Item_Code := System_Character'Pos('=');
|
||||||
L_Arrow: constant Item_Code := System_Character'Pos('<');
|
L_Arrow: constant Item_Code := System_Character'Pos('<');
|
||||||
R_Arrow: constant Item_Code := System_Character'Pos('>');
|
R_Arrow: constant Item_Code := System_Character'Pos('>');
|
||||||
|
|
||||||
type Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT);
|
type Item_Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT);
|
||||||
function Is_Class (V: in Item_Type; Cls: in Class) return Boolean;
|
function Is_Class (V: in Item_Type; Class: in Item_Class) return Boolean;
|
||||||
|
|
||||||
function Is_Alpha (V: in Item_Type) return Boolean;
|
function Is_Alpha (V: in Item_Type) return Boolean;
|
||||||
function Is_Alnum (V: in Item_Type) return Boolean;
|
function Is_Alnum (V: in Item_Type) return Boolean;
|
||||||
|
@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion;
|
|||||||
with Ada.Unchecked_Deallocation;
|
with Ada.Unchecked_Deallocation;
|
||||||
|
|
||||||
package body H3.Limited_Pool is
|
package body H3.Limited_Pool is
|
||||||
|
|
||||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||||
P: Storage_Pool_Pointer;
|
P: Storage_Pool_Pointer;
|
||||||
|
|
||||||
@ -24,7 +24,7 @@ package body H3.Limited_Pool is
|
|||||||
begin
|
begin
|
||||||
Tmp := new Normal_Type;
|
Tmp := new Normal_Type;
|
||||||
return To_Pointer_Type(Tmp);
|
return To_Pointer_Type(Tmp);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
end Allocate;
|
end Allocate;
|
||||||
|
|
||||||
@ -53,7 +53,7 @@ package body H3.Limited_Pool is
|
|||||||
Tmp: Pooled_Pointer := To_Pooled_Pointer(Target);
|
Tmp: Pooled_Pointer := To_Pooled_Pointer(Target);
|
||||||
begin
|
begin
|
||||||
Dealloc (Tmp);
|
Dealloc (Tmp);
|
||||||
Target := null;
|
Target := null;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
end Deallocate;
|
end Deallocate;
|
||||||
|
@ -8,7 +8,7 @@ package body H3.MM is
|
|||||||
R.Data.Refs := 1;
|
R.Data.Refs := 1;
|
||||||
--System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1
|
--System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1
|
||||||
end Create;
|
end Create;
|
||||||
|
|
||||||
procedure Create (R: in out Ref_Counted; V: in Item_Type) is
|
procedure Create (R: in out Ref_Counted; V: in Item_Type) is
|
||||||
begin
|
begin
|
||||||
Create (R);
|
Create (R);
|
||||||
@ -46,14 +46,14 @@ package body H3.MM is
|
|||||||
procedure Finalize (R: in out Ref_Counted) is
|
procedure Finalize (R: in out Ref_Counted) is
|
||||||
procedure Dealloc is new Ada.Unchecked_Deallocation(Ref_Counted_Record, Ref_Counted_Pointer);
|
procedure Dealloc is new Ada.Unchecked_Deallocation(Ref_Counted_Record, Ref_Counted_Pointer);
|
||||||
begin
|
begin
|
||||||
if R.Data /= null then
|
if R.Data /= null then
|
||||||
--if System.Atomic_Counters.Decrement(R.Data.Ref_Count) then
|
--if System.Atomic_Counters.Decrement(R.Data.Ref_Count) then
|
||||||
-- -- The reference count reached 0
|
-- -- The reference count reached 0
|
||||||
-- Dealloc (R.Data);
|
-- Dealloc (R.Data);
|
||||||
-- -- R.DAta must be null here
|
-- -- R.DAta must be null here
|
||||||
--end if;
|
--end if;
|
||||||
if R.Data.Refs = 1 then
|
if R.Data.Refs = 1 then
|
||||||
Dealloc (R.Data);
|
Dealloc (R.Data);
|
||||||
else
|
else
|
||||||
R.Data.Refs := R.Data.Refs - 1;
|
R.Data.Refs := R.Data.Refs - 1;
|
||||||
end if;
|
end if;
|
||||||
|
@ -30,5 +30,5 @@ package H3.MM is
|
|||||||
overriding procedure Initialize (R: in out Ref_Counted);
|
overriding procedure Initialize (R: in out Ref_Counted);
|
||||||
overriding procedure Adjust (R: in out Ref_Counted);
|
overriding procedure Adjust (R: in out Ref_Counted);
|
||||||
overriding procedure Finalize (R: in out Ref_Counted);
|
overriding procedure Finalize (R: in out Ref_Counted);
|
||||||
|
|
||||||
end H3.MM;
|
end H3.MM;
|
||||||
|
@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion;
|
|||||||
with Ada.Unchecked_Deallocation;
|
with Ada.Unchecked_Deallocation;
|
||||||
|
|
||||||
package body H3.Pool is
|
package body H3.Pool is
|
||||||
|
|
||||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||||
P: Storage_Pool_Pointer;
|
P: Storage_Pool_Pointer;
|
||||||
|
|
||||||
@ -24,11 +24,11 @@ package body H3.Pool is
|
|||||||
begin
|
begin
|
||||||
Tmp := new Normal_Type;
|
Tmp := new Normal_Type;
|
||||||
return To_Pointer_Type(Tmp);
|
return To_Pointer_Type(Tmp);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
end Allocate;
|
end Allocate;
|
||||||
|
|
||||||
-- function Allocate (Source: in Normal_Type;
|
-- function Allocate (Source: in Normal_Type;
|
||||||
-- Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
-- Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||||
-- V: Pointer_Type;
|
-- V: Pointer_Type;
|
||||||
-- begin
|
-- begin
|
||||||
@ -37,7 +37,7 @@ package body H3.Pool is
|
|||||||
-- return V;
|
-- return V;
|
||||||
-- end Allocate;
|
-- end Allocate;
|
||||||
|
|
||||||
function Allocate (Source: in Normal_Type;
|
function Allocate (Source: in Normal_Type;
|
||||||
Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
|
||||||
P: Storage_Pool_Pointer;
|
P: Storage_Pool_Pointer;
|
||||||
begin
|
begin
|
||||||
@ -58,7 +58,7 @@ package body H3.Pool is
|
|||||||
begin
|
begin
|
||||||
Tmp := new Normal_Type'(Source);
|
Tmp := new Normal_Type'(Source);
|
||||||
return To_Pointer_Type(Tmp);
|
return To_Pointer_Type(Tmp);
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
end Allocate;
|
end Allocate;
|
||||||
|
|
||||||
|
@ -18,7 +18,7 @@ package H3.Pool is
|
|||||||
|
|
||||||
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
||||||
|
|
||||||
function Allocate (Source: in Normal_Type;
|
function Allocate (Source: in Normal_Type;
|
||||||
Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
Pool: in Storage_Pool_Pointer := null) return Pointer_Type;
|
||||||
|
|
||||||
procedure Deallocate (Target: in out Pointer_Type;
|
procedure Deallocate (Target: in out Pointer_Type;
|
||||||
|
@ -29,9 +29,7 @@ procedure hello2 is
|
|||||||
procedure setlocale(a: C.int; b: System.Address);
|
procedure setlocale(a: C.int; b: System.Address);
|
||||||
pragma Import (C, setlocale, "setlocale");
|
pragma Import (C, setlocale, "setlocale");
|
||||||
|
|
||||||
function is_class (V: Standard.Wide_Character; Cls: CC.Class) return Standard.Boolean is
|
function is_class (V: Standard.Wide_Character; Class: CC.Item_Class) return Standard.Boolean is
|
||||||
|
|
||||||
|
|
||||||
function iswalpha(a: C.int) return C.int;
|
function iswalpha(a: C.int) return C.int;
|
||||||
pragma Import (C, iswalpha, "iswalpha");
|
pragma Import (C, iswalpha, "iswalpha");
|
||||||
function iswalnum(a: C.int) return C.int;
|
function iswalnum(a: C.int) return C.int;
|
||||||
@ -60,7 +58,7 @@ procedure hello2 is
|
|||||||
use type C.int;
|
use type C.int;
|
||||||
X: C.int := Standard.Wide_Character'Pos(V);
|
X: C.int := Standard.Wide_Character'Pos(V);
|
||||||
begin
|
begin
|
||||||
case Cls is
|
case Class is
|
||||||
when CC.ALPHA => return IswAlpha(X) /= 0;
|
when CC.ALPHA => return IswAlpha(X) /= 0;
|
||||||
when CC.ALNUM => return IswAlnum(X) /= 0;
|
when CC.ALNUM => return IswAlnum(X) /= 0;
|
||||||
when CC.BLANK => return IswBlank(X) /= 0;
|
when CC.BLANK => return IswBlank(X) /= 0;
|
||||||
@ -122,7 +120,7 @@ begin
|
|||||||
ch := Standard.Wide_Character'Val(i);
|
ch := Standard.Wide_Character'Val(i);
|
||||||
Ada.Text_IO.Put (I'img & "[" & ch'Img & "]");
|
Ada.Text_IO.Put (I'img & "[" & ch'Img & "]");
|
||||||
|
|
||||||
for j in CC.Class'Range loop
|
for j in CC.Item_Class'Range loop
|
||||||
Ada.Text_IO.Put (" " & J'Img & ":" & CC.Is_Class(ch, j)'Img);
|
Ada.Text_IO.Put (" " & J'Img & ":" & CC.Is_Class(ch, j)'Img);
|
||||||
if CC.Is_Class(ch, j) /= Is_Class(ch, j) then
|
if CC.Is_Class(ch, j) /= Is_Class(ch, j) then
|
||||||
Ada.Text_IO.Put ("[X]");
|
Ada.Text_IO.Put ("[X]");
|
||||||
|
Loading…
x
Reference in New Issue
Block a user