-- Copyright © 2026 Lingenic LLC. All rights reserved.
-- Licensed under the Lingenic Source-Available License v2.3.
-- Production use requires a separate license from Licensor.
-- See LICENSE.md and COPYRIGHT in the project root.
--
-------------------------------------------------------------------------------
-- Lingenic-Text — Properties body
--
-- Stores the file buffer, names array, and flat lookup table for each
-- property. Initialize reads UCD files from disk, extracts value names,
-- and parses data into tables.
--
-- Initialize is SPARK_Mode Off because it calls File_IO.Read_File
-- (which uses Ada.Streams.Stream_IO), string concatenation (heap),
-- and line filtering for ExtPict and InCB.
-- Everything else is proved SPARK.
-------------------------------------------------------------------------------
with Lingenic_Text.File_IO;
package body Lingenic_Text.Properties
with SPARK_Mode,
Refined_State => (Property_State =>
(Is_Init,
Script_Buffer, Script_Length,
Script_Names, Script_Count, Script_Table,
Scx_Buffer, Scx_Length,
Scx_Pool, Scx_Pool_End, Scx_Table,
GBP_Buffer, GBP_Length,
GBP_Names, GBP_Count, GBP_Table,
GBP_Map,
ExtPict_Buffer, ExtPict_Length,
ExtPict_Names, ExtPict_Count, ExtPict_Table,
InCB_Buffer, InCB_Length,
InCB_Names, InCB_Count, InCB_Table,
InCB_Map,
WBP_Buffer, WBP_Length,
WBP_Names, WBP_Count, WBP_Table,
WBP_Map,
SBP_Buffer, SBP_Length,
SBP_Names, SBP_Count, SBP_Table,
SBP_Map,
EAW_Buffer, EAW_Length,
EAW_Names, EAW_Count, EAW_Table,
EAW_Map,
XIDS_Buffer, XIDS_Length,
XIDS_Names, XIDS_Count, XIDS_Table,
XIDC_Buffer, XIDC_Length,
XIDC_Names, XIDC_Count, XIDC_Table,
LBP_Buffer, LBP_Length,
LBP_Names, LBP_Count, LBP_Table,
GC_Buffer, GC_Length,
GC_Names, GC_Count, GC_Table,
Resolved_LBP_Table,
BC_Buffer, BC_Length,
BC_Names, BC_Count, BC_Table,
Resolved_BC_Table,
JT_Buffer, JT_Length,
JT_Names, JT_Count, JT_Table,
Resolved_JT_Table,
Bidi_Mirrored_Table,
Tmp_Buffer, Tmp_Length))
is
Is_Init : Boolean := False;
-- Script property state
Script_Buffer : File_IO.File_Byte_Array := [others => 0];
Script_Length : File_IO.File_Size := 0;
Script_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
Script_Count : UCD_Parser.Property_Index := 0;
Script_Table : UCD_Parser.Property_Table := [others => 0];
-- Script_Extensions property state (UAX #24)
Scx_Buffer : File_IO.File_Byte_Array := [others => 0];
Scx_Length : File_IO.File_Size := 0;
Scx_Pool : Scx_Parser.Scx_Pool_Array :=
[others => (Count => 0, Items => [others => 0])];
Scx_Pool_End : Natural := 0;
Scx_Table : Scx_Parser.Scx_Table_Array := [others => 0];
-- GBP property state
GBP_Buffer : File_IO.File_Byte_Array := [others => 0];
GBP_Length : File_IO.File_Size := 0;
GBP_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
GBP_Count : UCD_Parser.Property_Index := 0;
GBP_Table : UCD_Parser.Property_Table := [others => 0];
-- GBP index -> abstract GBP_Value mapping
type GBP_Map_Type is array (UCD_Parser.Property_Index) of
Graphemes_Spec.GBP_Value;
GBP_Map : GBP_Map_Type := [others => Graphemes_Spec.GBP_Other];
-- ExtPict property state
ExtPict_Buffer : File_IO.File_Byte_Array := [others => 0];
ExtPict_Length : File_IO.File_Size := 0;
ExtPict_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
ExtPict_Count : UCD_Parser.Property_Index := 0;
ExtPict_Table : UCD_Parser.Property_Table := [others => 0];
-- InCB property state
InCB_Buffer : File_IO.File_Byte_Array := [others => 0];
InCB_Length : File_IO.File_Size := 0;
InCB_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
InCB_Count : UCD_Parser.Property_Index := 0;
InCB_Table : UCD_Parser.Property_Table := [others => 0];
-- InCB index -> abstract InCB_Value mapping
type InCB_Map_Type is array (UCD_Parser.Property_Index) of
Graphemes_Spec.InCB_Value;
InCB_Map : InCB_Map_Type := [others => Graphemes_Spec.InCB_None];
-- WBP property state
WBP_Buffer : File_IO.File_Byte_Array := [others => 0];
WBP_Length : File_IO.File_Size := 0;
WBP_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
WBP_Count : UCD_Parser.Property_Index := 0;
WBP_Table : UCD_Parser.Property_Table := [others => 0];
-- WBP index -> abstract WBP_Value mapping
type WBP_Map_Type is array (UCD_Parser.Property_Index) of
Words_Spec.WBP_Value;
WBP_Map : WBP_Map_Type := [others => Words_Spec.WBP_Other];
-- SBP property state
SBP_Buffer : File_IO.File_Byte_Array := [others => 0];
SBP_Length : File_IO.File_Size := 0;
SBP_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
SBP_Count : UCD_Parser.Property_Index := 0;
SBP_Table : UCD_Parser.Property_Table := [others => 0];
-- SBP index -> abstract SBP_Value mapping
type SBP_Map_Type is array (UCD_Parser.Property_Index) of
Sentences_Spec.SBP_Value;
SBP_Map : SBP_Map_Type := [others => Sentences_Spec.SBP_Other];
-- EAW property state
EAW_Buffer : File_IO.File_Byte_Array := [others => 0];
EAW_Length : File_IO.File_Size := 0;
EAW_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
EAW_Count : UCD_Parser.Property_Index := 0;
EAW_Table : UCD_Parser.Property_Table := [others => 0];
-- EAW index -> abstract EAW_Value mapping
type EAW_Map_Type is array (UCD_Parser.Property_Index) of
EAW_Spec.EAW_Value;
EAW_Map : EAW_Map_Type := [others => EAW_Spec.EAW_Neutral];
-- XID_Start property state (boolean, like ExtPict)
XIDS_Buffer : File_IO.File_Byte_Array := [others => 0];
XIDS_Length : File_IO.File_Size := 0;
XIDS_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
XIDS_Count : UCD_Parser.Property_Index := 0;
XIDS_Table : UCD_Parser.Property_Table := [others => 0];
-- XID_Continue property state (boolean, like ExtPict)
XIDC_Buffer : File_IO.File_Byte_Array := [others => 0];
XIDC_Length : File_IO.File_Size := 0;
XIDC_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
XIDC_Count : UCD_Parser.Property_Index := 0;
XIDC_Table : UCD_Parser.Property_Table := [others => 0];
-- Raw Line_Break property state (for init-time resolution)
LBP_Buffer : File_IO.File_Byte_Array := [others => 0];
LBP_Length : File_IO.File_Size := 0;
LBP_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
LBP_Count : UCD_Parser.Property_Index := 0;
LBP_Table : UCD_Parser.Property_Table := [others => 0];
-- General_Category property state
GC_Buffer : File_IO.File_Byte_Array := [others => 0];
GC_Length : File_IO.File_Size := 0;
GC_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
GC_Count : UCD_Parser.Property_Index := 0;
GC_Table : UCD_Parser.Property_Table := [others => 0];
-- BC (Bidi_Class) property state
BC_Buffer : File_IO.File_Byte_Array := [others => 0];
BC_Length : File_IO.File_Size := 0;
BC_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
BC_Count : UCD_Parser.Property_Index := 0;
BC_Table : UCD_Parser.Property_Table := [others => 0];
-- Resolved Bidi_Class table (computed at init from BC + @missing defaults)
type Resolved_BC_Array is array (Codepoint) of Bidi_Spec.BC_Value;
Resolved_BC_Table : Resolved_BC_Array := [others => 0];
-- JT (Joining_Type) property state
JT_Buffer : File_IO.File_Byte_Array := [others => 0];
JT_Length : File_IO.File_Size := 0;
JT_Names : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
JT_Count : UCD_Parser.Property_Index := 0;
JT_Table : UCD_Parser.Property_Table := [others => 0];
-- Resolved Joining_Type table (computed at init from JT names)
type Resolved_JT_Array is array (Codepoint) of Properties_Spec.JT_Value;
Resolved_JT_Table : Resolved_JT_Array := [others => 0];
-- Resolved Line_Break table (computed at init from LBP + GC + EAW)
type Resolved_LBP_Array is array (Codepoint) of Line_Break_Spec.LBP_Value;
Resolved_LBP_Table : Resolved_LBP_Array := [others => 0];
-- Bidi_Mirrored property state (UnicodeData.txt field 9, UAX #9 L4)
type Bidi_Mirror_Array is array (Codepoint) of Boolean;
Bidi_Mirrored_Table : Bidi_Mirror_Array := [others => False];
-- Temporary buffer for file reading before filtering (avoids stack alloc)
Tmp_Buffer : File_IO.File_Byte_Array := [others => 0];
Tmp_Length : File_IO.File_Size := 0;
---------------------------------------------------------------------------
-- Structural invariants
---------------------------------------------------------------------------
function Script_Names_Valid return Boolean is
(Script_Count >= 1
and then Script_Length >= 1
and then (for all I in 1 .. Script_Count =>
Script_Names (I).First <= Script_Length
and then Script_Names (I).Last >= Script_Names (I).First
and then Script_Names (I).Last <= Script_Length));
function GBP_Names_Valid return Boolean is
(GBP_Count >= 1
and then GBP_Length >= 1
and then (for all I in 1 .. GBP_Count =>
GBP_Names (I).First <= GBP_Length
and then GBP_Names (I).Last >= GBP_Names (I).First
and then GBP_Names (I).Last <= GBP_Length));
function InCB_Names_Valid return Boolean is
(InCB_Count >= 1
and then InCB_Length >= 1
and then (for all I in 1 .. InCB_Count =>
InCB_Names (I).First <= InCB_Length
and then InCB_Names (I).Last >= InCB_Names (I).First
and then InCB_Names (I).Last <= InCB_Length));
function WBP_Names_Valid return Boolean is
(WBP_Count >= 1
and then WBP_Length >= 1
and then (for all I in 1 .. WBP_Count =>
WBP_Names (I).First <= WBP_Length
and then WBP_Names (I).Last >= WBP_Names (I).First
and then WBP_Names (I).Last <= WBP_Length));
function SBP_Names_Valid return Boolean is
(SBP_Count >= 1
and then SBP_Length >= 1
and then (for all I in 1 .. SBP_Count =>
SBP_Names (I).First <= SBP_Length
and then SBP_Names (I).Last >= SBP_Names (I).First
and then SBP_Names (I).Last <= SBP_Length));
function EAW_Names_Valid return Boolean is
(EAW_Count >= 1
and then EAW_Length >= 1
and then (for all I in 1 .. EAW_Count =>
EAW_Names (I).First <= EAW_Length
and then EAW_Names (I).Last >= EAW_Names (I).First
and then EAW_Names (I).Last <= EAW_Length));
function GC_Names_Valid return Boolean is
(GC_Count >= 1
and then GC_Length >= 1
and then (for all I in 1 .. GC_Count =>
GC_Names (I).First <= GC_Length
and then GC_Names (I).Last >= GC_Names (I).First
and then GC_Names (I).Last <= GC_Length));
function BC_Names_Valid return Boolean is
(BC_Count >= 1
and then BC_Length >= 1
and then (for all I in 1 .. BC_Count =>
BC_Names (I).First <= BC_Length
and then BC_Names (I).Last >= BC_Names (I).First
and then BC_Names (I).Last <= BC_Length));
function JT_Names_Valid return Boolean is
(JT_Count >= 1
and then JT_Length >= 1
and then (for all I in 1 .. JT_Count =>
JT_Names (I).First <= JT_Length
and then JT_Names (I).Last >= JT_Names (I).First
and then JT_Names (I).Last <= JT_Length));
---------------------------------------------------------------------------
-- Initialized
---------------------------------------------------------------------------
function Initialized return Boolean
is (Is_Init
and then Script_Names_Valid
and then GBP_Names_Valid
and then InCB_Names_Valid
and then WBP_Names_Valid
and then SBP_Names_Valid
and then EAW_Names_Valid
and then GC_Names_Valid
and then BC_Names_Valid
and then JT_Names_Valid);
---------------------------------------------------------------------------
-- Initialize
--
-- SPARK_Mode Off: calls File_IO.Read_File, uses string concatenation,
-- and performs line filtering for ExtPict and InCB.
---------------------------------------------------------------------------
procedure Initialize
(UCD_Dir : String;
Success : out Boolean)
with SPARK_Mode => Off
is
-----------------------------------------------------------------------
-- Reset a buffer element-by-element (avoids stack temporaries)
-----------------------------------------------------------------------
procedure Reset_Buffer (Buf : in out File_IO.File_Byte_Array) is
begin
for I in Buf'Range loop
Buf (I) := 0;
end loop;
end Reset_Buffer;
procedure Reset_Table (T : in out UCD_Parser.Property_Table) is
begin
for CP in T'Range loop
T (CP) := 0;
end loop;
end Reset_Table;
-----------------------------------------------------------------------
-- Load a standard UCD property file through the full pipeline:
-- Read_File -> Extract_Value_Names -> Parse_Property_File
-----------------------------------------------------------------------
procedure Load_Property
(Filename : String;
Buf : in out File_IO.File_Byte_Array;
Len : out File_IO.File_Size;
Names : out UCD_Parser.Value_Name_Array;
Count : out UCD_Parser.Property_Index;
Table : out UCD_Parser.Property_Table;
OK : out Boolean)
is
R_OK, E_OK, P_OK : Boolean;
begin
Reset_Buffer (Buf);
Len := 0;
Names := [others => (First => 1, Last => 0)];
Count := 0;
Reset_Table (Table);
OK := False;
File_IO.Read_File (Filename, Buf, Len, R_OK);
if not R_OK or Len = 0 then return; end if;
UCD_Parser.Extract_Value_Names
(Buf (1 .. Len), Names, Count, E_OK);
if not E_OK or Count = 0 then return; end if;
UCD_Parser.Parse_Property_File
(Buf (1 .. Len), Names, Count, Table, P_OK);
if not P_OK then return; end if;
OK := True;
end Load_Property;
-----------------------------------------------------------------------
-- Filter lines from a source buffer into a destination buffer.
-- Only copies lines whose value field (after the semicolon) matches
-- the given target string. Used for ExtPict.
-----------------------------------------------------------------------
procedure Filter_By_Value
(Src : File_IO.File_Byte_Array;
Src_Len : File_IO.File_Size;
Target : String;
Dst : in out File_IO.File_Byte_Array;
Dst_Len : out File_IO.File_Size)
is
SP : Positive := 1;
DP : Positive := 1;
begin
Reset_Buffer (Dst);
Dst_Len := 0;
if Src_Len = 0 then return; end if;
while SP <= Src_Len loop
-- Find end of current line
declare
Line_End : Positive := SP;
begin
while Line_End <= Src_Len
and then Src (Line_End) /= LF_Byte
and then Src (Line_End) /= CR_Byte
loop
Line_End := Line_End + 1;
end loop;
-- Check if this line contains the target value
declare
Semi_Pos : Natural := 0;
Val_Start : Natural := 0;
Match : Boolean := False;
begin
-- Find semicolon
for J in SP .. Line_End - 1 loop
if Src (J) = Semicolon_Byte then
Semi_Pos := J;
exit;
end if;
end loop;
if Semi_Pos > 0 and Semi_Pos < Line_End - 1 then
-- Skip spaces after semicolon
Val_Start := Semi_Pos + 1;
while Val_Start < Line_End
and then (Src (Val_Start) = Space_Byte
or Src (Val_Start) = Tab_Byte)
loop
Val_Start := Val_Start + 1;
end loop;
-- Compare value field against target
if Val_Start + Target'Length - 1 < Line_End then
Match := True;
for K in 0 .. Target'Length - 1 loop
if Character'Pos (Target (Target'First + K))
/= Src (Val_Start + K)
then
Match := False;
exit;
end if;
end loop;
-- Ensure the match ends at a word boundary
if Match then
declare
After : constant Natural :=
Val_Start + Target'Length;
begin
if After < Line_End
and then Src (After) /= Space_Byte
and then Src (After) /= Tab_Byte
and then Src (After) /= Hash_Byte
and then Src (After) /= LF_Byte
and then Src (After) /= CR_Byte
then
Match := False;
end if;
end;
end if;
end if;
end if;
if Match then
-- Copy this line to destination
if DP + (Line_End - SP) <= File_IO.Max_File_Size then
for J in SP .. Line_End - 1 loop
Dst (DP) := Src (J);
DP := DP + 1;
end loop;
-- Add newline
Dst (DP) := LF_Byte;
DP := DP + 1;
end if;
end if;
end;
-- Advance past line ending
SP := Line_End;
if SP <= Src_Len and then Src (SP) = CR_Byte then
SP := SP + 1;
end if;
if SP <= Src_Len and then Src (SP) = LF_Byte then
SP := SP + 1;
end if;
if SP = Line_End then
-- No line ending found — we're at the end
SP := Src_Len + 1;
end if;
end;
end loop;
if DP > 1 then
Dst_Len := File_IO.File_Size (DP - 1);
end if;
end Filter_By_Value;
-----------------------------------------------------------------------
-- Filter InCB lines from DerivedCoreProperties.txt and reformat
-- from "codepoint ; InCB; Value" to "codepoint ; Value".
-----------------------------------------------------------------------
procedure Filter_InCB
(Src : File_IO.File_Byte_Array;
Src_Len : File_IO.File_Size;
Dst : in out File_IO.File_Byte_Array;
Dst_Len : out File_IO.File_Size)
is
SP : Positive := 1;
DP : Positive := 1;
InCB_Tag : constant String := "; InCB; ";
begin
Reset_Buffer (Dst);
Dst_Len := 0;
if Src_Len = 0 then return; end if;
while SP <= Src_Len loop
-- Find end of current line
declare
Line_End : Positive := SP;
begin
while Line_End <= Src_Len
and then Src (Line_End) /= LF_Byte
and then Src (Line_End) /= CR_Byte
loop
Line_End := Line_End + 1;
end loop;
-- Check if line contains "; InCB; "
declare
Tag_Pos : Natural := 0;
begin
for J in SP .. Line_End - InCB_Tag'Length loop
declare
Match : Boolean := True;
begin
for K in 0 .. InCB_Tag'Length - 1 loop
if Src (J + K) /=
Character'Pos (InCB_Tag (InCB_Tag'First + K))
then
Match := False;
exit;
end if;
end loop;
if Match then
Tag_Pos := J;
exit;
end if;
end;
end loop;
if Tag_Pos > 0 then
-- Reformat: copy "codepoint " then "; " then "Value..."
declare
Prefix_End : constant Positive := Tag_Pos - 1;
Value_Start : constant Positive :=
Tag_Pos + InCB_Tag'Length;
begin
if DP + (Prefix_End - SP) + 2 +
(Line_End - Value_Start) <= File_IO.Max_File_Size
then
-- Copy "codepoint " part
for J in SP .. Prefix_End loop
Dst (DP) := Src (J);
DP := DP + 1;
end loop;
-- Write "; " to replace "; InCB; "
Dst (DP) := Semicolon_Byte;
DP := DP + 1;
Dst (DP) := Space_Byte;
DP := DP + 1;
-- Copy value and rest of line
for J in Value_Start .. Line_End - 1 loop
Dst (DP) := Src (J);
DP := DP + 1;
end loop;
-- Add newline
Dst (DP) := LF_Byte;
DP := DP + 1;
end if;
end;
end if;
end;
-- Advance past line ending
SP := Line_End;
if SP <= Src_Len and then Src (SP) = CR_Byte then
SP := SP + 1;
end if;
if SP <= Src_Len and then Src (SP) = LF_Byte then
SP := SP + 1;
end if;
if SP = Line_End then
SP := Src_Len + 1;
end if;
end;
end loop;
if DP > 1 then
Dst_Len := File_IO.File_Size (DP - 1);
end if;
end Filter_InCB;
-----------------------------------------------------------------------
-- Helper: extract a name string from a buffer+names array
-- (used by Build_GBP_Map and Build_InCB_Map)
-----------------------------------------------------------------------
function Get_Name
(Buf : File_IO.File_Byte_Array;
Names : UCD_Parser.Value_Name_Array;
Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := Names (Idx).First;
NL : constant Positive := Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) := Character'Val (Buf (NF + I));
end loop;
return Result;
end Get_Name;
-----------------------------------------------------------------------
-- Build the GBP index -> abstract value mapping by comparing names
-----------------------------------------------------------------------
procedure Build_GBP_Map_Proc is
use Graphemes_Spec;
begin
GBP_Map := [others => GBP_Other];
for I in 1 .. GBP_Count loop
declare
Got : constant String :=
Get_Name (GBP_Buffer, GBP_Names, I);
begin
if Got = "CR" then GBP_Map (I) := GBP_CR;
elsif Got = "LF" then GBP_Map (I) := GBP_LF;
elsif Got = "Control" then GBP_Map (I) := GBP_Control;
elsif Got = "Extend" then GBP_Map (I) := GBP_Extend;
elsif Got = "ZWJ" then GBP_Map (I) := GBP_ZWJ;
elsif Got = "Regional_Indicator" then GBP_Map (I) := GBP_Regional_Indicator;
elsif Got = "Prepend" then GBP_Map (I) := GBP_Prepend;
elsif Got = "SpacingMark" then GBP_Map (I) := GBP_SpacingMark;
elsif Got = "L" then GBP_Map (I) := GBP_L;
elsif Got = "V" then GBP_Map (I) := GBP_V;
elsif Got = "T" then GBP_Map (I) := GBP_T;
elsif Got = "LV" then GBP_Map (I) := GBP_LV;
elsif Got = "LVT" then GBP_Map (I) := GBP_LVT;
end if;
end;
end loop;
end Build_GBP_Map_Proc;
-----------------------------------------------------------------------
-- Build the InCB index -> abstract value mapping
-----------------------------------------------------------------------
procedure Build_InCB_Map_Proc is
use Graphemes_Spec;
begin
InCB_Map := [others => InCB_None];
for I in 1 .. InCB_Count loop
declare
Got : constant String :=
Get_Name (InCB_Buffer, InCB_Names, I);
begin
if Got = "Consonant" then InCB_Map (I) := InCB_Consonant;
elsif Got = "Linker" then InCB_Map (I) := InCB_Linker;
elsif Got = "Extend" then InCB_Map (I) := InCB_Extend;
end if;
end;
end loop;
end Build_InCB_Map_Proc;
-----------------------------------------------------------------------
-- Build the WBP index -> abstract value mapping
-----------------------------------------------------------------------
procedure Build_WBP_Map_Proc is
use Words_Spec;
begin
WBP_Map := [others => WBP_Other];
for I in 1 .. WBP_Count loop
declare
Got : constant String :=
Get_Name (WBP_Buffer, WBP_Names, I);
begin
if Got = "CR" then WBP_Map (I) := WBP_CR;
elsif Got = "LF" then WBP_Map (I) := WBP_LF;
elsif Got = "Newline" then WBP_Map (I) := WBP_Newline;
elsif Got = "Extend" then WBP_Map (I) := WBP_Extend;
elsif Got = "ZWJ" then WBP_Map (I) := WBP_ZWJ;
elsif Got = "Regional_Indicator" then WBP_Map (I) := WBP_Regional_Indicator;
elsif Got = "Format" then WBP_Map (I) := WBP_Format;
elsif Got = "Katakana" then WBP_Map (I) := WBP_Katakana;
elsif Got = "Hebrew_Letter" then WBP_Map (I) := WBP_Hebrew_Letter;
elsif Got = "ALetter" then WBP_Map (I) := WBP_ALetter;
elsif Got = "Single_Quote" then WBP_Map (I) := WBP_Single_Quote;
elsif Got = "Double_Quote" then WBP_Map (I) := WBP_Double_Quote;
elsif Got = "MidNumLet" then WBP_Map (I) := WBP_MidNumLet;
elsif Got = "MidLetter" then WBP_Map (I) := WBP_MidLetter;
elsif Got = "MidNum" then WBP_Map (I) := WBP_MidNum;
elsif Got = "Numeric" then WBP_Map (I) := WBP_Numeric;
elsif Got = "ExtendNumLet" then WBP_Map (I) := WBP_ExtendNumLet;
elsif Got = "WSegSpace" then WBP_Map (I) := WBP_WSegSpace;
end if;
end;
end loop;
end Build_WBP_Map_Proc;
-----------------------------------------------------------------------
-- Build the SBP index -> abstract value mapping
-----------------------------------------------------------------------
procedure Build_SBP_Map_Proc is
use Sentences_Spec;
begin
SBP_Map := [others => SBP_Other];
for I in 1 .. SBP_Count loop
declare
Got : constant String :=
Get_Name (SBP_Buffer, SBP_Names, I);
begin
if Got = "CR" then SBP_Map (I) := SBP_CR;
elsif Got = "LF" then SBP_Map (I) := SBP_LF;
elsif Got = "Sep" then SBP_Map (I) := SBP_Sep;
elsif Got = "Extend" then SBP_Map (I) := SBP_Extend;
elsif Got = "Format" then SBP_Map (I) := SBP_Format;
elsif Got = "Sp" then SBP_Map (I) := SBP_Sp;
elsif Got = "Lower" then SBP_Map (I) := SBP_Lower;
elsif Got = "Upper" then SBP_Map (I) := SBP_Upper;
elsif Got = "OLetter" then SBP_Map (I) := SBP_OLetter;
elsif Got = "Numeric" then SBP_Map (I) := SBP_Numeric;
elsif Got = "ATerm" then SBP_Map (I) := SBP_ATerm;
elsif Got = "STerm" then SBP_Map (I) := SBP_STerm;
elsif Got = "SContinue" then SBP_Map (I) := SBP_SContinue;
elsif Got = "Close" then SBP_Map (I) := SBP_Close;
end if;
end;
end loop;
end Build_SBP_Map_Proc;
-----------------------------------------------------------------------
-- Build the EAW index -> abstract value mapping
-----------------------------------------------------------------------
procedure Build_EAW_Map_Proc is
use EAW_Spec;
begin
EAW_Map := [others => EAW_Neutral];
for I in 1 .. EAW_Count loop
declare
Got : constant String :=
Get_Name (EAW_Buffer, EAW_Names, I);
begin
if Got = "A" then EAW_Map (I) := EAW_Ambiguous;
elsif Got = "H" then EAW_Map (I) := EAW_Halfwidth;
elsif Got = "W" then EAW_Map (I) := EAW_Wide;
elsif Got = "F" then EAW_Map (I) := EAW_Fullwidth;
elsif Got = "Na" then EAW_Map (I) := EAW_Narrow;
elsif Got = "N" then EAW_Map (I) := EAW_Neutral;
end if;
end;
end loop;
end Build_EAW_Map_Proc;
-----------------------------------------------------------------------
-- Build the resolved Bidi_Class table.
--
-- For each codepoint, read the raw BC name, map to abstract
-- BC_Value, then apply block-specific @missing defaults for
-- codepoints that were not explicitly listed (table index = 0).
--
-- @missing defaults from DerivedBidiClass.txt:
-- Global: Left_To_Right (L)
-- 0590..05FF: Right_To_Left (R)
-- 0600..07BF: Arabic_Letter (AL)
-- 07C0..085F: Right_To_Left (R)
-- 0860..08FF: Arabic_Letter (AL)
-- 20A0..20CF: European_Terminator (ET)
-- FB1D..FB4F: Right_To_Left (R)
-- FB50..FDCF: Arabic_Letter (AL)
-- FDF0..FDFF: Arabic_Letter (AL)
-- FE70..FEFF: Arabic_Letter (AL)
-- 10800..10CFF: Right_To_Left (R)
-- 10D00..10D3F: Arabic_Letter (AL)
-- 10D40..10EBF: Right_To_Left (R)
-- 10EC0..10EFF: Arabic_Letter (AL)
-- 10F00..10F2F: Right_To_Left (R)
-- 10F30..10F6F: Arabic_Letter (AL)
-- 10F70..10FFF: Right_To_Left (R)
-- 1E800..1EC6F: Right_To_Left (R)
-- 1EC70..1ECBF: Arabic_Letter (AL)
-- 1ECC0..1ECFF: Right_To_Left (R)
-- 1ED00..1ED4F: Arabic_Letter (AL)
-- 1ED50..1EDFF: Right_To_Left (R)
-- 1EE00..1EEFF: Arabic_Letter (AL)
-- 1EF00..1EFFF: Right_To_Left (R)
-----------------------------------------------------------------------
procedure Build_Resolved_BC is
use Bidi_Spec;
function Raw_Name_To_BC (N : String) return BC_Value is
begin
if N = "L" then return BC_L;
elsif N = "R" then return BC_R;
elsif N = "AL" then return BC_AL;
elsif N = "EN" then return BC_EN;
elsif N = "ES" then return BC_ES;
elsif N = "ET" then return BC_ET;
elsif N = "AN" then return BC_AN;
elsif N = "CS" then return BC_CS;
elsif N = "NSM" then return BC_NSM;
elsif N = "BN" then return BC_BN;
elsif N = "B" then return BC_B;
elsif N = "S" then return BC_S;
elsif N = "WS" then return BC_WS;
elsif N = "ON" then return BC_ON;
elsif N = "LRE" then return BC_LRE;
elsif N = "LRO" then return BC_LRO;
elsif N = "RLE" then return BC_RLE;
elsif N = "RLO" then return BC_RLO;
elsif N = "PDF" then return BC_PDF;
elsif N = "LRI" then return BC_LRI;
elsif N = "RLI" then return BC_RLI;
elsif N = "FSI" then return BC_FSI;
elsif N = "PDI" then return BC_PDI;
-- Long names (used in @missing defaults when parsing data lines)
elsif N = "Left_To_Right" then return BC_L;
elsif N = "Right_To_Left" then return BC_R;
elsif N = "Arabic_Letter" then return BC_AL;
elsif N = "European_Number" then return BC_EN;
elsif N = "European_Separator" then return BC_ES;
elsif N = "European_Terminator" then return BC_ET;
elsif N = "Arabic_Number" then return BC_AN;
elsif N = "Common_Separator" then return BC_CS;
elsif N = "Nonspacing_Mark" then return BC_NSM;
elsif N = "Boundary_Neutral" then return BC_BN;
elsif N = "Paragraph_Separator" then return BC_B;
elsif N = "Segment_Separator" then return BC_S;
elsif N = "White_Space" then return BC_WS;
elsif N = "Other_Neutral" then return BC_ON;
else return BC_L; -- default
end if;
end Raw_Name_To_BC;
-- Block-specific @missing default for a codepoint
function Missing_Default (CP : Codepoint) return BC_Value is
begin
-- These ranges are from DerivedBidiClass.txt @missing lines
if CP in 16#0590# .. 16#05FF# then return BC_R;
elsif CP in 16#0600# .. 16#07BF# then return BC_AL;
elsif CP in 16#07C0# .. 16#085F# then return BC_R;
elsif CP in 16#0860# .. 16#08FF# then return BC_AL;
elsif CP in 16#20A0# .. 16#20CF# then return BC_ET;
elsif CP in 16#FB1D# .. 16#FB4F# then return BC_R;
elsif CP in 16#FB50# .. 16#FDCF# then return BC_AL;
elsif CP in 16#FDF0# .. 16#FDFF# then return BC_AL;
elsif CP in 16#FE70# .. 16#FEFF# then return BC_AL;
elsif CP in 16#10800# .. 16#10CFF# then return BC_R;
elsif CP in 16#10D00# .. 16#10D3F# then return BC_AL;
elsif CP in 16#10D40# .. 16#10EBF# then return BC_R;
elsif CP in 16#10EC0# .. 16#10EFF# then return BC_AL;
elsif CP in 16#10F00# .. 16#10F2F# then return BC_R;
elsif CP in 16#10F30# .. 16#10F6F# then return BC_AL;
elsif CP in 16#10F70# .. 16#10FFF# then return BC_R;
elsif CP in 16#1E800# .. 16#1EC6F# then return BC_R;
elsif CP in 16#1EC70# .. 16#1ECBF# then return BC_AL;
elsif CP in 16#1ECC0# .. 16#1ECFF# then return BC_R;
elsif CP in 16#1ED00# .. 16#1ED4F# then return BC_AL;
elsif CP in 16#1ED50# .. 16#1EDFF# then return BC_R;
elsif CP in 16#1EE00# .. 16#1EEFF# then return BC_AL;
elsif CP in 16#1EF00# .. 16#1EFFF# then return BC_R;
else return BC_L; -- global default
end if;
end Missing_Default;
Raw_Idx : UCD_Parser.Property_Index;
begin
for CP in Codepoint loop
Raw_Idx := BC_Table (CP);
if Raw_Idx >= 1 and Raw_Idx <= BC_Count then
-- Explicitly assigned: resolve name to abstract value
declare
NF : constant Positive := BC_Names (Raw_Idx).First;
NL : constant Positive := BC_Names (Raw_Idx).Last;
Len : constant Natural := NL - NF + 1;
Name_Str : String (1 .. 20) := [others => ' '];
Name_Len : Natural;
begin
Name_Len := Natural'Min (Len, 20);
for I in 0 .. Name_Len - 1 loop
Name_Str (I + 1) :=
Character'Val (BC_Buffer (NF + I));
end loop;
Resolved_BC_Table (CP) :=
Raw_Name_To_BC (Name_Str (1 .. Name_Len));
end;
else
-- Not explicitly listed: apply @missing block defaults
Resolved_BC_Table (CP) := Missing_Default (CP);
end if;
end loop;
end Build_Resolved_BC;
-----------------------------------------------------------------------
-- Build the resolved JT (Joining_Type) table from raw JT names.
-- Default for unassigned codepoints: JT_U (Non_Joining)
-----------------------------------------------------------------------
procedure Build_Resolved_JT is
use Properties_Spec;
function Raw_Name_To_JT (N : String) return JT_Value is
begin
if N = "U" or N = "Non_Joining" then return JT_U;
elsif N = "L" or N = "Left_Joining" then return JT_L;
elsif N = "R" or N = "Right_Joining" then return JT_R;
elsif N = "D" or N = "Dual_Joining" then return JT_D;
elsif N = "C" or N = "Join_Causing" then return JT_C;
elsif N = "T" or N = "Transparent" then return JT_T;
else return JT_U; -- default
end if;
end Raw_Name_To_JT;
Raw_Idx : UCD_Parser.Property_Index;
begin
for CP in Codepoint loop
Raw_Idx := JT_Table (CP);
if Raw_Idx >= 1 and Raw_Idx <= JT_Count then
declare
NF : constant Positive := JT_Names (Raw_Idx).First;
NL : constant Positive := JT_Names (Raw_Idx).Last;
Len : constant Natural := NL - NF + 1;
Name_Str : String (1 .. 20) := [others => ' '];
Name_Len : Natural;
begin
Name_Len := Natural'Min (Len, 20);
for I in 0 .. Name_Len - 1 loop
Name_Str (I + 1) :=
Character'Val (JT_Buffer (NF + I));
end loop;
Resolved_JT_Table (CP) :=
Raw_Name_To_JT (Name_Str (1 .. Name_Len));
end;
else
Resolved_JT_Table (CP) := JT_U;
end if;
end loop;
end Build_Resolved_JT;
-----------------------------------------------------------------------
-- Build the resolved LBP table.
--
-- For each codepoint, read the raw LB class name and GC name,
-- then apply LB1 resolution and the QU/OP/CP splits.
--
-- LB1 resolution:
-- AI, SG, XX → AL
-- CJ → NS
-- SA + GC ∈ {Mn, Mc} → CM
-- SA + other GC → AL
--
-- Splits:
-- QU + GC = Pi → QU_Pi
-- QU + GC = Pf → QU_Pf
-- OP + EAW ∈ {F, W, H} → OP_EA
-- CP + EAW ∈ {F, W, H} → CP_EA
-----------------------------------------------------------------------
procedure Build_Resolved_LBP is
use Line_Break_Spec;
use EAW_Spec;
-- Map a raw LB class name to its base resolved value.
-- Returns LBP_Other for unrecognized names.
function Raw_Name_To_Base (N : String) return LBP_Value is
begin
if N = "BK" then return LBP_BK;
elsif N = "CR" then return LBP_CR;
elsif N = "LF" then return LBP_LF;
elsif N = "NL" then return LBP_NL;
elsif N = "CM" then return LBP_CM;
elsif N = "WJ" then return LBP_WJ;
elsif N = "ZW" then return LBP_ZW;
elsif N = "GL" then return LBP_GL;
elsif N = "SP" then return LBP_SP;
elsif N = "ZWJ" then return LBP_ZWJ;
elsif N = "B2" then return LBP_B2;
elsif N = "BA" then return LBP_BA;
elsif N = "BB" then return LBP_BB;
elsif N = "HY" then return LBP_HY;
elsif N = "CB" then return LBP_CB;
elsif N = "CL" then return LBP_CL;
elsif N = "CP" then return LBP_CP;
elsif N = "EX" then return LBP_EX;
elsif N = "IN" then return LBP_IN;
elsif N = "NS" then return LBP_NS;
elsif N = "OP" then return LBP_OP;
elsif N = "QU" then return LBP_QU;
elsif N = "IS" then return LBP_IS;
elsif N = "NU" then return LBP_NU;
elsif N = "PO" then return LBP_PO;
elsif N = "PR" then return LBP_PR;
elsif N = "SY" then return LBP_SY;
elsif N = "AL" then return LBP_AL;
elsif N = "HL" then return LBP_HL;
elsif N = "AK" then return LBP_AK;
elsif N = "AP" then return LBP_AP;
elsif N = "AS" then return LBP_AS;
elsif N = "VF" then return LBP_VF;
elsif N = "VI" then return LBP_VI;
elsif N = "EB" then return LBP_EB;
elsif N = "EM" then return LBP_EM;
elsif N = "H2" then return LBP_H2;
elsif N = "H3" then return LBP_H3;
elsif N = "JL" then return LBP_JL;
elsif N = "JV" then return LBP_JV;
elsif N = "JT" then return LBP_JT;
elsif N = "RI" then return LBP_RI;
elsif N = "ID" then return LBP_ID;
elsif N = "HH" then return LBP_HH;
-- LB1 resolution: AI, SG, XX → AL
elsif N = "AI" then return LBP_AL;
elsif N = "SG" then return LBP_AL;
elsif N = "XX" then return LBP_AL;
-- LB1 resolution: CJ → NS
elsif N = "CJ" then return LBP_NS;
-- SA is handled separately (depends on GC)
elsif N = "SA" then return LBP_Other; -- sentinel
else return LBP_AL; -- unknown → AL (LB1 default)
end if;
end Raw_Name_To_Base;
Raw_Idx : UCD_Parser.Property_Index;
Raw_Name_Str : String (1 .. 3);
Raw_Name_Len : Natural;
GC_Idx : UCD_Parser.Property_Index;
GC_Name_Str : String (1 .. 2);
GC_Name_Len : Natural;
Base : LBP_Value;
EAW_Val : EAW_Spec.EAW_Value;
begin
for CP in Codepoint loop
Raw_Idx := LBP_Table (CP);
-- Get raw LB class name
if Raw_Idx >= 1 and Raw_Idx <= LBP_Count then
declare
NF : constant Positive := LBP_Names (Raw_Idx).First;
NL : constant Positive := LBP_Names (Raw_Idx).Last;
Len : constant Natural := NL - NF + 1;
begin
Raw_Name_Len := Natural'Min (Len, 3);
Raw_Name_Str := [others => ' '];
for I in 0 .. Raw_Name_Len - 1 loop
Raw_Name_Str (I + 1) :=
Character'Val (LBP_Buffer (NF + I));
end loop;
end;
else
-- Unlisted codepoints default to XX → AL
Raw_Name_Str := "XX ";
Raw_Name_Len := 2;
end if;
-- Check for SA first (depends on GC)
if Raw_Name_Str (1 .. Raw_Name_Len) = "SA" then
GC_Idx := GC_Table (CP);
if GC_Idx >= 1 and GC_Idx <= GC_Count then
declare
NF : constant Positive := GC_Names (GC_Idx).First;
NL : constant Positive := GC_Names (GC_Idx).Last;
Len : constant Natural := NL - NF + 1;
begin
GC_Name_Len := Natural'Min (Len, 2);
GC_Name_Str := [others => ' '];
for I in 0 .. GC_Name_Len - 1 loop
GC_Name_Str (I + 1) :=
Character'Val (GC_Buffer (NF + I));
end loop;
end;
else
GC_Name_Str := " ";
GC_Name_Len := 0;
end if;
-- SA + Mn or Mc → CM, SA + other → AL
if GC_Name_Str (1 .. GC_Name_Len) = "Mn"
or GC_Name_Str (1 .. GC_Name_Len) = "Mc"
then
Base := LBP_CM;
else
Base := LBP_AL;
end if;
else
Base := Raw_Name_To_Base
(Raw_Name_Str (1 .. Raw_Name_Len));
end if;
-- Apply QU split based on GC
if Base = LBP_QU then
GC_Idx := GC_Table (CP);
if GC_Idx >= 1 and GC_Idx <= GC_Count then
declare
NF : constant Positive := GC_Names (GC_Idx).First;
NL : constant Positive := GC_Names (GC_Idx).Last;
Len : constant Natural := NL - NF + 1;
begin
GC_Name_Len := Natural'Min (Len, 2);
GC_Name_Str := [others => ' '];
for I in 0 .. GC_Name_Len - 1 loop
GC_Name_Str (I + 1) :=
Character'Val (GC_Buffer (NF + I));
end loop;
end;
else
GC_Name_Str := " ";
GC_Name_Len := 0;
end if;
if GC_Name_Str (1 .. GC_Name_Len) = "Pi" then
Base := LBP_QU_Pi;
elsif GC_Name_Str (1 .. GC_Name_Len) = "Pf" then
Base := LBP_QU_Pf;
end if;
end if;
-- Apply OP split based on EAW
if Base = LBP_OP then
EAW_Val := EAW_Map (EAW_Table (CP));
if EAW_Val = EAW_Fullwidth
or EAW_Val = EAW_Wide
or EAW_Val = EAW_Halfwidth
then
Base := LBP_OP_EA;
end if;
end if;
-- Apply CP split based on EAW
if Base = LBP_CP then
EAW_Val := EAW_Map (EAW_Table (CP));
if EAW_Val = EAW_Fullwidth
or EAW_Val = EAW_Wide
or EAW_Val = EAW_Halfwidth
then
Base := LBP_CP_EA;
end if;
end if;
Resolved_LBP_Table (CP) := Base;
end loop;
end Build_Resolved_LBP;
-----------------------------------------------------------------------
-- Parse Bidi_Mirrored from UnicodeData.txt field 9.
--
-- UnicodeData.txt lines have the form
-- CODE;NAME;GC;CCC;BC;Decomp;Dig;Dig;Num;Y/N;...
-- Field 9 (the tenth semicolon-separated field) is the
-- Bidi_Mirrored property: "Y" for mirrored, "N" otherwise.
--
-- Ranges are marked with <Name, First>/<Name, Last> in field 1,
-- but every ranged block in UnicodeData.txt has Bidi_Mirrored=N,
-- so plain per-line parsing is sufficient.
-----------------------------------------------------------------------
procedure Parse_UnicodeData_Bidi_Mirrored is
P : Positive := 1;
Eol : Natural;
HP : Positive;
CP : Natural;
F : Positive;
Semi_Count : Natural;
begin
while P <= Natural (Tmp_Length) loop
-- Find end of current line
Eol := P;
while Eol <= Natural (Tmp_Length)
and then not Is_Line_End (Tmp_Buffer (Eol))
loop
Eol := Eol + 1;
end loop;
-- Eol now points one past the last line byte
if Eol > P and then Tmp_Buffer (P) /= Hash_Byte then
-- Parse leading hex codepoint
HP := P;
CP := 0;
while HP < Eol
and then Is_Hex_Digit (Tmp_Buffer (HP))
loop
CP := CP * 16 + Hex_Value (Tmp_Buffer (HP));
HP := HP + 1;
end loop;
if CP <= Max_Codepoint then
-- Advance to field 9 by counting 9 semicolons
F := P;
Semi_Count := 0;
while F < Eol and then Semi_Count < 9 loop
if Tmp_Buffer (F) = Semicolon_Byte then
Semi_Count := Semi_Count + 1;
end if;
F := F + 1;
end loop;
-- F now points at the first byte of field 9 (or Eol)
if Semi_Count = 9 and then F < Eol
and then Tmp_Buffer (F) = Character'Pos ('Y')
then
Bidi_Mirrored_Table (Codepoint (CP)) := True;
end if;
end if;
end if;
-- Skip to next line, consuming CR and/or LF
P := Eol;
if P <= Natural (Tmp_Length)
and then Tmp_Buffer (P) = CR_Byte
then
P := P + 1;
end if;
if P <= Natural (Tmp_Length)
and then Tmp_Buffer (P) = LF_Byte
then
P := P + 1;
end if;
end loop;
end Parse_UnicodeData_Bidi_Mirrored;
OK : Boolean;
begin
-- Reset all state
Is_Init := False;
Reset_Buffer (Script_Buffer);
Script_Length := 0;
Script_Names := [others => (First => 1, Last => 0)];
Script_Count := 0;
Reset_Table (Script_Table);
Reset_Buffer (Scx_Buffer);
Scx_Length := 0;
Scx_Pool := [others => (Count => 0, Items => [others => 0])];
Scx_Pool_End := 0;
for CP in Codepoint loop
Scx_Table (CP) := 0;
end loop;
Reset_Buffer (GBP_Buffer);
GBP_Length := 0;
GBP_Names := [others => (First => 1, Last => 0)];
GBP_Count := 0;
Reset_Table (GBP_Table);
GBP_Map := [others => Graphemes_Spec.GBP_Other];
Reset_Buffer (ExtPict_Buffer);
ExtPict_Length := 0;
ExtPict_Names := [others => (First => 1, Last => 0)];
ExtPict_Count := 0;
Reset_Table (ExtPict_Table);
Reset_Buffer (InCB_Buffer);
InCB_Length := 0;
InCB_Names := [others => (First => 1, Last => 0)];
InCB_Count := 0;
Reset_Table (InCB_Table);
InCB_Map := [others => Graphemes_Spec.InCB_None];
Reset_Buffer (WBP_Buffer);
WBP_Length := 0;
WBP_Names := [others => (First => 1, Last => 0)];
WBP_Count := 0;
Reset_Table (WBP_Table);
WBP_Map := [others => Words_Spec.WBP_Other];
Reset_Buffer (SBP_Buffer);
SBP_Length := 0;
SBP_Names := [others => (First => 1, Last => 0)];
SBP_Count := 0;
Reset_Table (SBP_Table);
SBP_Map := [others => Sentences_Spec.SBP_Other];
Reset_Buffer (EAW_Buffer);
EAW_Length := 0;
EAW_Names := [others => (First => 1, Last => 0)];
EAW_Count := 0;
Reset_Table (EAW_Table);
EAW_Map := [others => EAW_Spec.EAW_Neutral];
Reset_Buffer (XIDS_Buffer);
XIDS_Length := 0;
XIDS_Names := [others => (First => 1, Last => 0)];
XIDS_Count := 0;
Reset_Table (XIDS_Table);
Reset_Buffer (XIDC_Buffer);
XIDC_Length := 0;
XIDC_Names := [others => (First => 1, Last => 0)];
XIDC_Count := 0;
Reset_Table (XIDC_Table);
Reset_Buffer (LBP_Buffer);
LBP_Length := 0;
LBP_Names := [others => (First => 1, Last => 0)];
LBP_Count := 0;
Reset_Table (LBP_Table);
Reset_Buffer (GC_Buffer);
GC_Length := 0;
GC_Names := [others => (First => 1, Last => 0)];
GC_Count := 0;
Reset_Table (GC_Table);
Reset_Buffer (BC_Buffer);
BC_Length := 0;
BC_Names := [others => (First => 1, Last => 0)];
BC_Count := 0;
Reset_Table (BC_Table);
for CP in Codepoint loop
Resolved_BC_Table (CP) := 0;
end loop;
Reset_Buffer (JT_Buffer);
JT_Length := 0;
JT_Names := [others => (First => 1, Last => 0)];
JT_Count := 0;
Reset_Table (JT_Table);
for CP in Codepoint loop
Resolved_JT_Table (CP) := 0;
end loop;
for CP in Codepoint loop
Resolved_LBP_Table (CP) := 0;
end loop;
for CP in Codepoint loop
Bidi_Mirrored_Table (CP) := False;
end loop;
Reset_Buffer (Tmp_Buffer);
Tmp_Length := 0;
Success := False;
-- 1. Load Script property (standard pipeline)
Load_Property
(UCD_Dir & "/Scripts.txt",
Script_Buffer, Script_Length,
Script_Names, Script_Count, Script_Table, OK);
if not OK then return; end if;
-- 1b. Load Script_Extensions (UAX #24)
--
-- ScriptExtensions.txt uses 4-letter ISO 15924 abbreviations
-- (Latn, Grek, etc.) while Scripts.txt uses full names (Latin,
-- Greek, etc.). Parse_Script_Extensions matches tokens against
-- a Script_Names table, so we need a name table containing the
-- 4-letter codes at the same indices as the full-name table.
--
-- Step 1: read PropertyValueAliases.txt into Tmp_Buffer and build
-- Script_Abbrev_Names(I) pointing to the abbreviation for script I.
--
-- Step 2: read ScriptExtensions.txt into Scx_Buffer.
--
-- Step 3: call Parse_Script_Extensions with Script_Src = Tmp_Buffer
-- and Script_Names = Script_Abbrev_Names.
declare
Script_Abbrev : UCD_Parser.Value_Name_Array :=
[others => (First => 1, Last => 0)];
Abbrev_OK : Boolean := True;
begin
-- Step 1: read PVA and build abbreviation name table.
File_IO.Read_File
(UCD_Dir & "/PropertyValueAliases.txt",
Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
-- Scan PVA for "sc ; Xxxx ; Full_Name" lines.
-- For each, match Full_Name against Script_Names entries in
-- Script_Buffer to find the index, then record the abbreviation
-- byte range at that index in Script_Abbrev.
declare
Pos : Positive := 1;
begin
while Pos <= Tmp_Length loop
-- Find end of current line
declare
Line_End : Positive := Pos;
begin
while Line_End <= Tmp_Length
and then Tmp_Buffer (Line_End) /= LF_Byte
and then Tmp_Buffer (Line_End) /= CR_Byte
loop
Line_End := Line_End + 1;
end loop;
-- Check if line starts with "sc ; " (5 bytes)
if Line_End - Pos >= 5
and then Tmp_Buffer (Pos) =
Character'Pos ('s')
and then Tmp_Buffer (Pos + 1) =
Character'Pos ('c')
and then Tmp_Buffer (Pos + 2) = Space_Byte
and then Tmp_Buffer (Pos + 3) = Semicolon_Byte
and then Tmp_Buffer (Pos + 4) = Space_Byte
then
-- Find field 2 (abbreviation) and field 3 (full name).
-- Format: "sc ; Xxxx ; Full_Name"
-- Field 2 starts at Pos+5, ends before next " ; ".
declare
F2_First : constant Positive := Pos + 5;
Semi2 : Natural := 0;
F2_Last : Natural;
F3_First : Natural;
F3_Last : Natural;
begin
-- Find second semicolon
for J in F2_First .. Line_End - 1 loop
if Tmp_Buffer (J) = Semicolon_Byte then
Semi2 := J;
exit;
end if;
end loop;
if Semi2 > F2_First then
-- Trim trailing spaces from field 2
F2_Last := Semi2 - 1;
while F2_Last >= F2_First
and then Tmp_Buffer (F2_Last) = Space_Byte
loop
F2_Last := F2_Last - 1;
end loop;
-- Field 3 starts after "; "
F3_First := Semi2 + 1;
while F3_First < Line_End
and then Tmp_Buffer (F3_First) = Space_Byte
loop
F3_First := F3_First + 1;
end loop;
-- Trim trailing spaces/comments from field 3
F3_Last := Line_End - 1;
-- Remove trailing comment (# ...) or extra
-- alias field (; Qaai) — stop at first ;/#.
for J in F3_First .. F3_Last loop
if Tmp_Buffer (J) = Hash_Byte
or Tmp_Buffer (J) = Semicolon_Byte
then
F3_Last := J - 1;
exit;
end if;
end loop;
while F3_Last >= F3_First
and then Tmp_Buffer (F3_Last) = Space_Byte
loop
F3_Last := F3_Last - 1;
end loop;
-- Match field 3 (full name) against Script_Names
if F2_Last >= F2_First
and then F3_Last >= F3_First
then
declare
F3_Len : constant Natural :=
F3_Last - F3_First + 1;
begin
for I in 1 .. Script_Count loop
declare
NF : constant Positive :=
Script_Names (I).First;
NL : constant Positive :=
Script_Names (I).Last;
N_Len : constant Natural :=
NL - NF + 1;
Match : Boolean := True;
begin
if N_Len = F3_Len
and then NL <= Script_Length
then
for K in 0 .. N_Len - 1 loop
if Script_Buffer (NF + K)
/= Tmp_Buffer
(F3_First + K)
then
Match := False;
exit;
end if;
end loop;
if Match then
Script_Abbrev (I) :=
(First => F2_First,
Last => F2_Last);
end if;
end if;
end;
end loop;
end;
end if;
end if;
end;
end if;
-- Advance past line ending
Pos := Line_End;
if Pos <= Tmp_Length
and then Tmp_Buffer (Pos) = CR_Byte
then
Pos := Pos + 1;
end if;
if Pos <= Tmp_Length
and then Tmp_Buffer (Pos) = LF_Byte
then
Pos := Pos + 1;
end if;
end;
end loop;
end;
-- Verify every script got an abbreviation mapping.
for I in 1 .. Script_Count loop
if Script_Abbrev (I).Last < Script_Abbrev (I).First then
Abbrev_OK := False;
end if;
end loop;
if not Abbrev_OK then return; end if;
-- Step 2: read ScriptExtensions.txt.
File_IO.Read_File
(UCD_Dir & "/ScriptExtensions.txt",
Scx_Buffer, Scx_Length, OK);
if not OK or Scx_Length = 0 then return; end if;
-- Step 3: parse with abbreviation name table.
-- Script_Src = Tmp_Buffer (PVA content, where abbreviations live).
-- Script_Names = Script_Abbrev (abbreviation byte ranges).
Scx_Parser.Parse_Script_Extensions
(Scx_Src => Scx_Buffer (1 .. Scx_Length),
Script_Src => Tmp_Buffer (1 .. Tmp_Length),
Script_Names => Script_Abbrev,
Script_Count => Script_Count,
Pool => Scx_Pool,
Pool_End => Scx_Pool_End,
Table => Scx_Table,
Success => OK);
if not OK then return; end if;
end;
-- 2. Load GBP property (standard pipeline)
Load_Property
(UCD_Dir & "/GraphemeBreakProperty.txt",
GBP_Buffer, GBP_Length,
GBP_Names, GBP_Count, GBP_Table, OK);
if not OK then return; end if;
-- 3. Load ExtPict property (filter emoji-data.txt)
File_IO.Read_File
(UCD_Dir & "/emoji-data.txt", Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
Filter_By_Value
(Tmp_Buffer, Tmp_Length,
"Extended_Pictographic",
ExtPict_Buffer, ExtPict_Length);
if ExtPict_Length = 0 then return; end if;
UCD_Parser.Extract_Value_Names
(ExtPict_Buffer (1 .. ExtPict_Length),
ExtPict_Names, ExtPict_Count, OK);
if not OK or ExtPict_Count = 0 then return; end if;
UCD_Parser.Parse_Property_File
(ExtPict_Buffer (1 .. ExtPict_Length),
ExtPict_Names, ExtPict_Count,
ExtPict_Table, OK);
if not OK then return; end if;
-- 4. Load InCB property (filter DerivedCoreProperties.txt)
File_IO.Read_File
(UCD_Dir & "/DerivedCoreProperties.txt", Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
Filter_InCB (Tmp_Buffer, Tmp_Length, InCB_Buffer, InCB_Length);
if InCB_Length = 0 then return; end if;
UCD_Parser.Extract_Value_Names
(InCB_Buffer (1 .. InCB_Length),
InCB_Names, InCB_Count, OK);
if not OK or InCB_Count = 0 then return; end if;
UCD_Parser.Parse_Property_File
(InCB_Buffer (1 .. InCB_Length),
InCB_Names, InCB_Count,
InCB_Table, OK);
if not OK then return; end if;
-- 5. Load WBP property (standard pipeline)
Load_Property
(UCD_Dir & "/WordBreakProperty.txt",
WBP_Buffer, WBP_Length,
WBP_Names, WBP_Count, WBP_Table, OK);
if not OK then return; end if;
-- 6. Load SBP property (standard pipeline)
Load_Property
(UCD_Dir & "/SentenceBreakProperty.txt",
SBP_Buffer, SBP_Length,
SBP_Names, SBP_Count, SBP_Table, OK);
if not OK then return; end if;
-- 7. Load EAW property (standard pipeline)
Load_Property
(UCD_Dir & "/EastAsianWidth.txt",
EAW_Buffer, EAW_Length,
EAW_Names, EAW_Count, EAW_Table, OK);
if not OK then return; end if;
-- 8. Load XID_Start property (filter DerivedCoreProperties.txt)
File_IO.Read_File
(UCD_Dir & "/DerivedCoreProperties.txt", Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
Filter_By_Value
(Tmp_Buffer, Tmp_Length,
"XID_Start",
XIDS_Buffer, XIDS_Length);
if XIDS_Length = 0 then return; end if;
UCD_Parser.Extract_Value_Names
(XIDS_Buffer (1 .. XIDS_Length),
XIDS_Names, XIDS_Count, OK);
if not OK or XIDS_Count = 0 then return; end if;
UCD_Parser.Parse_Property_File
(XIDS_Buffer (1 .. XIDS_Length),
XIDS_Names, XIDS_Count,
XIDS_Table, OK);
if not OK then return; end if;
-- 9. Load XID_Continue property (filter DerivedCoreProperties.txt)
-- Re-read the file since Tmp_Buffer may have been overwritten
File_IO.Read_File
(UCD_Dir & "/DerivedCoreProperties.txt", Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
Filter_By_Value
(Tmp_Buffer, Tmp_Length,
"XID_Continue",
XIDC_Buffer, XIDC_Length);
if XIDC_Length = 0 then return; end if;
UCD_Parser.Extract_Value_Names
(XIDC_Buffer (1 .. XIDC_Length),
XIDC_Names, XIDC_Count, OK);
if not OK or XIDC_Count = 0 then return; end if;
UCD_Parser.Parse_Property_File
(XIDC_Buffer (1 .. XIDC_Length),
XIDC_Names, XIDC_Count,
XIDC_Table, OK);
if not OK then return; end if;
-- 10. Load raw Line_Break property (standard pipeline)
Load_Property
(UCD_Dir & "/LineBreak.txt",
LBP_Buffer, LBP_Length,
LBP_Names, LBP_Count, LBP_Table, OK);
if not OK then return; end if;
-- 11. Load General_Category property (standard pipeline)
Load_Property
(UCD_Dir & "/DerivedGeneralCategory.txt",
GC_Buffer, GC_Length,
GC_Names, GC_Count, GC_Table, OK);
if not OK then return; end if;
-- 12. Load BC (Bidi_Class) property (standard pipeline)
Load_Property
(UCD_Dir & "/DerivedBidiClass.txt",
BC_Buffer, BC_Length,
BC_Names, BC_Count, BC_Table, OK);
if not OK then return; end if;
-- 13. Load JT (Joining_Type) property (standard pipeline)
Load_Property
(UCD_Dir & "/DerivedJoiningType.txt",
JT_Buffer, JT_Length,
JT_Names, JT_Count, JT_Table, OK);
if not OK then return; end if;
-- 14. Build abstract value mapping arrays
Build_GBP_Map_Proc;
Build_InCB_Map_Proc;
Build_WBP_Map_Proc;
Build_SBP_Map_Proc;
Build_EAW_Map_Proc;
-- 15. Build resolved BC table from raw BC + @missing defaults
Build_Resolved_BC;
-- 16. Build resolved JT table from raw JT names
Build_Resolved_JT;
-- 17. Build resolved LBP table from raw LBP + GC + EAW
Build_Resolved_LBP;
-- 18. Load UnicodeData.txt and parse Bidi_Mirrored (field 9).
-- Reuses Tmp_Buffer; Bidi_Mirrored_Table was reset above.
File_IO.Read_File
(UCD_Dir & "/UnicodeData.txt", Tmp_Buffer, Tmp_Length, OK);
if not OK or Tmp_Length = 0 then return; end if;
Parse_UnicodeData_Bidi_Mirrored;
Is_Init := True;
Success := True;
end Initialize;
---------------------------------------------------------------------------
-- Script property
---------------------------------------------------------------------------
function Get_Script (CP : Codepoint) return UCD_Parser.Property_Index
is (Script_Table (CP));
function Script_Name_Count return UCD_Parser.Property_Index
is (Script_Count);
function Script_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := Script_Names (Idx).First;
NL : constant Positive := Script_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (Script_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end Script_Name;
---------------------------------------------------------------------------
-- Script_Extensions property (UAX #24)
---------------------------------------------------------------------------
function Is_In_Script_Extensions
(CP : Codepoint;
Script_Idx : UCD_Parser.Property_Index) return Boolean
is
Pool_Id : constant Scx_Parser.Scx_Pool_Id := Scx_Table (CP);
begin
if Pool_Id = 0 then
-- Not covered by ScriptExtensions.txt — fallback to
-- singleton {Get_Script(CP)}.
return Script_Idx = Script_Table (CP);
else
-- Covered: check membership in the pool entry.
declare
S : constant Scx_Parser.Script_Set := Scx_Pool (Pool_Id);
begin
for I in 1 .. S.Count loop
if S.Items (I) = Script_Idx then
return True;
end if;
end loop;
return False;
end;
end if;
end Is_In_Script_Extensions;
function Get_Script_Extension_Count
(CP : Codepoint) return Scx_Parser.Scx_Member_Count
is
Pool_Id : constant Scx_Parser.Scx_Pool_Id := Scx_Table (CP);
begin
if Pool_Id = 0 then
-- Not covered — singleton {Get_Script(CP)}.
-- Count is 1 unless script is 0 (Unknown/unassigned).
if Script_Table (CP) = 0 then
return 0;
else
return 1;
end if;
else
return Scx_Pool (Pool_Id).Count;
end if;
end Get_Script_Extension_Count;
function Get_Script_Extension
(CP : Codepoint;
K : Positive) return UCD_Parser.Property_Index
is
Pool_Id : constant Scx_Parser.Scx_Pool_Id := Scx_Table (CP);
begin
if Pool_Id = 0 then
-- Singleton — K must be 1 (ensured by precondition).
return Script_Table (CP);
else
return Scx_Pool (Pool_Id).Items (K);
end if;
end Get_Script_Extension;
---------------------------------------------------------------------------
-- GBP property
---------------------------------------------------------------------------
function Get_GBP (CP : Codepoint) return UCD_Parser.Property_Index
is (GBP_Table (CP));
function GBP_Name_Count return UCD_Parser.Property_Index
is (GBP_Count);
function GBP_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := GBP_Names (Idx).First;
NL : constant Positive := GBP_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (GBP_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end GBP_Name;
function GBP_To_Abstract
(Idx : UCD_Parser.Property_Index) return Graphemes_Spec.GBP_Value
is (GBP_Map (Idx));
---------------------------------------------------------------------------
-- ExtPict property
---------------------------------------------------------------------------
function Get_ExtPict (CP : Codepoint) return Boolean
is (ExtPict_Table (CP) /= 0);
---------------------------------------------------------------------------
-- InCB property
---------------------------------------------------------------------------
function Get_InCB (CP : Codepoint) return UCD_Parser.Property_Index
is (InCB_Table (CP));
function InCB_Name_Count return UCD_Parser.Property_Index
is (InCB_Count);
function InCB_To_Abstract
(Idx : UCD_Parser.Property_Index) return Graphemes_Spec.InCB_Value
is (InCB_Map (Idx));
---------------------------------------------------------------------------
-- WBP property
---------------------------------------------------------------------------
function Get_WBP (CP : Codepoint) return UCD_Parser.Property_Index
is (WBP_Table (CP));
function WBP_Name_Count return UCD_Parser.Property_Index
is (WBP_Count);
function WBP_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := WBP_Names (Idx).First;
NL : constant Positive := WBP_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (WBP_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end WBP_Name;
function WBP_To_Abstract
(Idx : UCD_Parser.Property_Index) return Words_Spec.WBP_Value
is (WBP_Map (Idx));
---------------------------------------------------------------------------
-- SBP property
---------------------------------------------------------------------------
function Get_SBP (CP : Codepoint) return UCD_Parser.Property_Index
is (SBP_Table (CP));
function SBP_Name_Count return UCD_Parser.Property_Index
is (SBP_Count);
function SBP_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := SBP_Names (Idx).First;
NL : constant Positive := SBP_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (SBP_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end SBP_Name;
function SBP_To_Abstract
(Idx : UCD_Parser.Property_Index) return Sentences_Spec.SBP_Value
is (SBP_Map (Idx));
---------------------------------------------------------------------------
-- EAW property
---------------------------------------------------------------------------
function Get_EAW (CP : Codepoint) return UCD_Parser.Property_Index
is (EAW_Table (CP));
function EAW_Name_Count return UCD_Parser.Property_Index
is (EAW_Count);
function EAW_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := EAW_Names (Idx).First;
NL : constant Positive := EAW_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (EAW_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end EAW_Name;
function EAW_To_Abstract
(Idx : UCD_Parser.Property_Index) return EAW_Spec.EAW_Value
is (EAW_Map (Idx));
---------------------------------------------------------------------------
-- XID_Start / XID_Continue properties
---------------------------------------------------------------------------
function Get_XID_Start (CP : Codepoint) return Boolean
is (XIDS_Table (CP) /= 0);
function Get_XID_Continue (CP : Codepoint) return Boolean
is (XIDC_Table (CP) /= 0);
---------------------------------------------------------------------------
-- Line_Break property (resolved)
---------------------------------------------------------------------------
function Get_LBP (CP : Codepoint) return Line_Break_Spec.LBP_Value
is (Resolved_LBP_Table (CP));
---------------------------------------------------------------------------
-- General_Category property
---------------------------------------------------------------------------
function Get_GC (CP : Codepoint) return UCD_Parser.Property_Index
is (GC_Table (CP));
function GC_Name_Count return UCD_Parser.Property_Index
is (GC_Count);
function GC_Name
(Idx : UCD_Parser.Property_Index) return String
is
NF : constant Positive := GC_Names (Idx).First;
NL : constant Positive := GC_Names (Idx).Last;
Len : constant Positive := NL - NF + 1;
Result : String (1 .. Len) := [others => ' '];
begin
for I in 0 .. Len - 1 loop
Result (I + 1) :=
Character'Val (GC_Buffer (NF + I));
pragma Loop_Variant (Increases => I);
end loop;
return Result;
end GC_Name;
---------------------------------------------------------------------------
-- Bidi_Class property (resolved)
---------------------------------------------------------------------------
function Get_BC (CP : Codepoint) return Bidi_Spec.BC_Value
is (Resolved_BC_Table (CP));
---------------------------------------------------------------------------
-- Joining_Type property (resolved)
---------------------------------------------------------------------------
function Get_JT (CP : Codepoint) return Properties_Spec.JT_Value
is (Resolved_JT_Table (CP));
---------------------------------------------------------------------------
-- Bidi_Mirrored property (UAX #9 L4 / UnicodeData.txt field 9)
---------------------------------------------------------------------------
function Get_Bidi_Mirrored (CP : Codepoint) return Boolean
is (Bidi_Mirrored_Table (CP));
end Lingenic_Text.Properties;