hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

some code clean-up

Browse Source
This commit is contained in:
hyung-hwan 2021-10-27 16:16:36 +00:00
parent ef734a5bc1
commit 2625942e08
8 changed files with 22 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lib2/h3-cc.adb
View File

@ -84,9 +84,9 @@ package body H3.CC is
return Item_Type'Val(UC.UTF_32_To_Upper_Case(Item_Type'Pos(V)));
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
case Cls is
case Class is
when ALPHA => return Is_Alpha(V);
when ALNUM => return Is_Alnum(V);
when BLANK => return Is_Blank(V);

6
lib2/h3-cc.ads
View File

@ -7,15 +7,15 @@ package H3.CC is
subtype Item_Code is H3.Natural;
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('~');
Underline: constant Item_Code := System_Character'Pos('_');
Equal: constant Item_Code := System_Character'Pos('=');
L_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);
function Is_Class (V: in Item_Type; Cls: in Class) return Boolean;
type Item_Class is (ALPHA, ALNUM, BLANK, CNTRL, DIGIT, GRAPH, LOWER, PRINT, PUNCT, SPACE, UPPER, XDIGIT);
function Is_Class (V: in Item_Type; Class: in Item_Class) return Boolean;
function Is_Alpha (V: in Item_Type) return Boolean;
function Is_Alnum (V: in Item_Type) return Boolean;

6
lib2/h3-limited_pool.adb
View File

@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body H3.Limited_Pool is
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
P: Storage_Pool_Pointer;
@ -24,7 +24,7 @@ package body H3.Limited_Pool is
begin
Tmp := new Normal_Type;
return To_Pointer_Type(Tmp);
end;
end;
end if;
end Allocate;
@ -53,7 +53,7 @@ package body H3.Limited_Pool is
Tmp: Pooled_Pointer := To_Pooled_Pointer(Target);
begin
Dealloc (Tmp);
Target := null;
Target := null;
end;
end if;
end Deallocate;

8
lib2/h3-mm.adb
View File

@ -8,7 +8,7 @@ package body H3.MM is
R.Data.Refs := 1;
--System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1
end Create;
procedure Create (R: in out Ref_Counted; V: in Item_Type) is
begin
Create (R);
@ -46,14 +46,14 @@ package body H3.MM is
procedure Finalize (R: in out Ref_Counted) is
procedure Dealloc is new Ada.Unchecked_Deallocation(Ref_Counted_Record, Ref_Counted_Pointer);
begin
if R.Data /= null then
if R.Data /= null then
--if System.Atomic_Counters.Decrement(R.Data.Ref_Count) then
-- -- The reference count reached 0
-- Dealloc (R.Data);
-- Dealloc (R.Data);
-- -- R.DAta must be null here
--end if;
if R.Data.Refs = 1 then
Dealloc (R.Data);
Dealloc (R.Data);
else
R.Data.Refs := R.Data.Refs - 1;
end if;

2
lib2/h3-mm.ads
View File

@ -30,5 +30,5 @@ package H3.MM is
overriding procedure Initialize (R: in out Ref_Counted);
overriding procedure Adjust (R: in out Ref_Counted);
overriding procedure Finalize (R: in out Ref_Counted);
end H3.MM;

10
lib2/h3-pool.adb
View File

@ -2,7 +2,7 @@ with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
package body H3.Pool is
function Allocate (Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
P: Storage_Pool_Pointer;
@ -24,11 +24,11 @@ package body H3.Pool is
begin
Tmp := new Normal_Type;
return To_Pointer_Type(Tmp);
end;
end;
end if;
end Allocate;
-- function Allocate (Source: in Normal_Type;
-- function Allocate (Source: in Normal_Type;
-- Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
-- V: Pointer_Type;
-- begin
@ -37,7 +37,7 @@ package body H3.Pool is
-- return V;
-- end Allocate;
function Allocate (Source: in Normal_Type;
function Allocate (Source: in Normal_Type;
Pool: in Storage_Pool_Pointer := null) return Pointer_Type is
P: Storage_Pool_Pointer;
begin
@ -58,7 +58,7 @@ package body H3.Pool is
begin
Tmp := new Normal_Type'(Source);
return To_Pointer_Type(Tmp);
end;
end;
end if;
end Allocate;

2
lib2/h3-pool.ads
View File

@ -18,7 +18,7 @@ package H3.Pool is
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;
procedure Deallocate (Target: in out Pointer_Type;

8
lib2/hello2.adb
View File

@ -29,9 +29,7 @@ procedure hello2 is
procedure setlocale(a: C.int; b: System.Address);
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;
pragma Import (C, iswalpha, "iswalpha");
function iswalnum(a: C.int) return C.int;
@ -60,7 +58,7 @@ procedure hello2 is
use type C.int;
X: C.int := Standard.Wide_Character'Pos(V);
begin
case Cls is
case Class is
when CC.ALPHA => return IswAlpha(X) /= 0;
when CC.ALNUM => return IswAlnum(X) /= 0;
when CC.BLANK => return IswBlank(X) /= 0;
@ -122,7 +120,7 @@ begin
ch := Standard.Wide_Character'Val(i);
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);
if CC.Is_Class(ch, j) /= Is_Class(ch, j) then
Ada.Text_IO.Put ("[X]");