-- 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
-- Formally Verified Unicode Text Processing Library
--
-- C language binding (body).
--
-- Every exported function:
-- 1. validates its arguments against the precondition of the SPARK
-- subprogram it calls (returning LT_ERR = -1 on violation),
-- 2. copies input bytes from C memory into a Byte_Array,
-- 3. calls the proved core,
-- 4. copies results back to C memory.
--
-- This unit is compiled WITH runtime checks (no -gnatp) as defense in
-- depth; any unexpected exception is caught and reported as LT_ERR.
-------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with System.Storage_Elements;
with Lingenic_Text; use Lingenic_Text;
with Lingenic_Text.UTF8;
with Lingenic_Text.Graphemes;
with Lingenic_Text.Words;
with Lingenic_Text.Sentences;
with Lingenic_Text.Line_Break;
with Lingenic_Text.Normalization;
with Lingenic_Text.Normalization_Spec;
with Lingenic_Text.Case_Mapping;
with Lingenic_Text.Collation;
with Lingenic_Text.Collation_Spec;
with Lingenic_Text.Bidi;
with Lingenic_Text.Bidi_Spec;
with Lingenic_Text.EAW;
with Lingenic_Text.Emoji;
with Lingenic_Text.Emoji_Spec;
with Lingenic_Text.Identifiers;
with Lingenic_Text.IDNA;
with Lingenic_Text.IDNA_Spec;
with Lingenic_Text.Properties;
with Lingenic_Text.UCD_Parser;
package body Lingenic_Text_C
with SPARK_Mode => Off
is
use Interfaces.C;
use System.Storage_Elements;
use type Interfaces.C.Strings.chars_ptr;
use type System.Address;
use type Interfaces.Unsigned_8;
use type Interfaces.Unsigned_32;
use type Normalization.Norm_Status;
use type Case_Mapping.Case_Status;
use type IDNA.IDNA_Result;
LT_ERR : constant int := -1;
-- Largest byte buffer the Ada core accepts: with 'First = 1 the
-- precondition 'Last < Positive'Last bounds the length.
Max_Buf : constant := Positive'Last - 1;
-- Accumulator cap shared by Normalization.Max_Norm_Acc and
-- Case_Mapping.Max_Out_Acc (both Natural'Last / 2).
Max_Acc : constant := Natural'Last / 2;
Max_CP : constant u32 := 16#10_FFFF#;
type Byte_Array_Access is access Byte_Array;
procedure Free is
new Ada.Unchecked_Deallocation (Byte_Array, Byte_Array_Access);
---------------------------------------------------------------------------
-- Buffer helpers
---------------------------------------------------------------------------
-- Copy Len bytes of C memory at Buf into a fresh Byte_Array (1 .. Len).
function Copy_In
(Buf : System.Address;
Len : Positive) return Byte_Array_Access
is
Src : array (1 .. Len) of u8 with Import, Address => Buf;
A : constant Byte_Array_Access := new Byte_Array (1 .. Len);
begin
for I in 1 .. Len loop
A (I) := Natural (Src (I));
end loop;
return A;
end Copy_In;
-- Copy B (B'First .. Last) into C memory at Buf.
procedure Copy_Out
(B : Byte_Array;
Last : Natural;
Buf : System.Address)
is
begin
if Last >= B'First then
declare
N : constant Positive := Last - B'First + 1;
Dst : array (1 .. N) of u8 with Import, Address => Buf;
begin
for I in 1 .. N loop
Dst (I) := u8 (B (B'First + I - 1));
end loop;
end;
end if;
end Copy_Out;
-- Common validation for a (pointer, length) input buffer.
function Valid_Buf (Buf : System.Address; Len : size_t) return Boolean
is (Buf /= System.Null_Address
and then Len >= 1
and then Len <= size_t (Max_Buf));
-- Copy a name string into a C char buffer with NUL termination.
-- Returns the name length, or LT_ERR if the buffer is too small.
function Name_Out
(S : String;
Buf : System.Address;
Cap : size_t) return int
is
begin
if Buf = System.Null_Address
or else Cap < size_t (S'Length) + 1
then
return LT_ERR;
end if;
declare
Dst : array (1 .. S'Length + 1) of u8
with Import, Address => Buf;
begin
for I in 1 .. S'Length loop
Dst (I) := u8 (Character'Pos (S (S'First + I - 1)));
end loop;
Dst (S'Length + 1) := 0;
end;
return int (S'Length);
end Name_Out;
---------------------------------------------------------------------------
-- Initialization
---------------------------------------------------------------------------
function LT_Init
(UCD_Dir : Interfaces.C.Strings.chars_ptr) return int
is
OK : Boolean;
begin
if UCD_Dir = Interfaces.C.Strings.Null_Ptr then
return LT_ERR;
end if;
declare
Dir : constant String := Interfaces.C.Strings.Value (UCD_Dir);
begin
Properties.Initialize (Dir, OK);
if not OK then
return 1;
end if;
Normalization.Initialize (Dir, OK);
if not OK then
return 2;
end if;
Emoji.Initialize (Dir, OK);
if not OK then
return 3;
end if;
IDNA.Initialize (Dir, OK);
if not OK then
return 4;
end if;
Bidi.Initialize (Dir, OK);
if not OK then
return 5;
end if;
Case_Mapping.Initialize (Dir, OK);
if not OK then
return 6;
end if;
Collation.Initialize (Dir, OK);
if not OK then
return 7;
end if;
end;
return 0;
exception
when others =>
return LT_ERR;
end LT_Init;
function LT_Initialized return int is
begin
if Properties.Initialized
and then Normalization.Initialized
and then Emoji.Initialized
and then IDNA.Initialized
and then Bidi.Initialized
and then Case_Mapping.Initialized
and then Collation.Initialized
then
return 1;
end if;
return 0;
exception
when others =>
return LT_ERR;
end LT_Initialized;
---------------------------------------------------------------------------
-- UTF-8
---------------------------------------------------------------------------
function LT_UTF8_Decode
(Buf : System.Address;
Len : size_t;
Pos : size_t;
CP : U32_Ptr;
Seq_Len : Size_Ptr) return int
is
begin
if not Valid_Buf (Buf, Len)
or else Pos >= Len
or else CP = null
or else Seq_Len = null
then
return LT_ERR;
end if;
-- Decode only needs the (at most 4) bytes starting at Pos; copy
-- a window instead of the whole buffer.
declare
Win : constant Positive :=
Natural'Min (4, Natural (Len - Pos));
Src : array (1 .. Win) of u8
with Import,
Address => Buf + Storage_Offset (Pos);
B : Byte_Array (1 .. Win);
C : Codepoint;
L : Positive;
Valid : Boolean;
begin
for I in 1 .. Win loop
B (I) := Natural (Src (I));
end loop;
UTF8.Decode (B, 1, C, L, Valid);
CP.all := u32 (C);
Seq_Len.all := size_t (L);
return (if Valid then 1 else 0);
end;
exception
when others =>
return LT_ERR;
end LT_UTF8_Decode;
function LT_UTF8_Encode
(CP : u32;
Buf : System.Address;
Cap : size_t;
Len : Size_Ptr) return int
is
B : Byte_Array (1 .. 4) := [others => 0];
L : Positive;
begin
if Buf = System.Null_Address
or else Len = null
or else CP > Max_CP
or else not Is_Scalar_Value (Codepoint (CP))
then
return LT_ERR;
end if;
UTF8.Encode (Codepoint (CP), B, 1, L);
if size_t (L) > Cap then
return LT_ERR;
end if;
Copy_Out (B, L, Buf);
Len.all := size_t (L);
return 0;
exception
when others =>
return LT_ERR;
end LT_UTF8_Encode;
---------------------------------------------------------------------------
-- Segmentation
---------------------------------------------------------------------------
generic
with procedure Next_Break
(Text : Byte_Array;
Pos : Positive;
Next_Pos : out Positive);
function Seg_Shim
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int;
function Seg_Shim
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int
is
A : Byte_Array_Access := null;
begin
if not Valid_Buf (Text, Len)
or else Pos >= Len
or else Next_Pos = null
or else not Properties.Initialized
then
return LT_ERR;
end if;
A := Copy_In (Text, Natural (Len));
declare
NP : Positive;
begin
Next_Break (A.all, Natural (Pos) + 1, NP);
Next_Pos.all := size_t (NP - 1);
end;
Free (A);
return 0;
exception
when others =>
Free (A);
return LT_ERR;
end Seg_Shim;
function Grapheme_Impl is
new Seg_Shim (Graphemes.Next_Grapheme_Cluster_Break);
function Word_Impl is new Seg_Shim (Words.Next_Word_Break);
function Sentence_Impl is new Seg_Shim (Sentences.Next_Sentence_Break);
function Line_Impl is new Seg_Shim (Line_Break.Next_Line_Break);
function LT_Next_Grapheme_Break
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int
is (Grapheme_Impl (Text, Len, Pos, Next_Pos));
function LT_Next_Word_Break
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int
is (Word_Impl (Text, Len, Pos, Next_Pos));
function LT_Next_Sentence_Break
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int
is (Sentence_Impl (Text, Len, Pos, Next_Pos));
function LT_Next_Line_Break
(Text : System.Address;
Len : size_t;
Pos : size_t;
Next_Pos : Size_Ptr) return int
is (Line_Impl (Text, Len, Pos, Next_Pos));
---------------------------------------------------------------------------
-- Normalization
---------------------------------------------------------------------------
function LT_Normalize
(Form : int;
In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is
In_A, Out_A : Byte_Array_Access := null;
R : int;
begin
if Form not in 0 .. 3
or else not Valid_Buf (In_Buf, In_Len)
or else Out_Buf = System.Null_Address
or else Out_Cap < 1
or else Out_Cap > size_t (Max_Acc)
or else Out_Len = null
or else not Normalization.Initialized
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
Out_A := new Byte_Array'(1 .. Natural (Out_Cap) => 0);
declare
Last : Natural;
Status : Normalization.Norm_Status;
begin
Normalization.Normalize
(In_A.all,
Normalization_Spec.Normalization_Form'Val (Form),
Out_A.all, Last, Status);
if Status = Normalization.Success then
Copy_Out (Out_A.all, Last, Out_Buf);
Out_Len.all := size_t (Last);
end if;
R := int (Normalization.Norm_Status'Pos (Status));
end;
Free (In_A);
Free (Out_A);
return R;
exception
when others =>
Free (In_A);
Free (Out_A);
return LT_ERR;
end LT_Normalize;
function LT_Quick_Check
(Form : int;
In_Buf : System.Address;
In_Len : size_t) return int
is
In_A : Byte_Array_Access := null;
R : int;
begin
if Form not in 0 .. 3
or else not Valid_Buf (In_Buf, In_Len)
or else not Normalization.Initialized
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
R := int (Normalization_Spec.QC_Value'Pos
(Normalization.Quick_Check
(In_A.all,
Normalization_Spec.Normalization_Form'Val (Form))));
Free (In_A);
return R;
exception
when others =>
Free (In_A);
return LT_ERR;
end LT_Quick_Check;
function LT_Is_Normalized
(Form : int;
In_Buf : System.Address;
In_Len : size_t) return int
is
In_A : Byte_Array_Access := null;
R : int;
begin
if Form not in 0 .. 3
or else not Valid_Buf (In_Buf, In_Len)
or else not Normalization.Initialized
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
R := (if Normalization.Is_Normalized
(In_A.all,
Normalization_Spec.Normalization_Form'Val (Form))
then 1 else 0);
Free (In_A);
return R;
exception
when others =>
Free (In_A);
return LT_ERR;
end LT_Is_Normalized;
function LT_CCC (CP : u32) return int is
begin
if CP > Max_CP or else not Normalization.Initialized then
return LT_ERR;
end if;
return int (Normalization.Get_CCC (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_CCC;
---------------------------------------------------------------------------
-- Case mapping
---------------------------------------------------------------------------
generic
with procedure Transform
(Input : Byte_Array;
Output : in out Byte_Array;
Last : out Natural;
Status : out Case_Mapping.Case_Status);
Needs_Properties : Boolean := False;
function Case_Shim
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int;
function Case_Shim
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is
In_A, Out_A : Byte_Array_Access := null;
R : int;
begin
if not Valid_Buf (In_Buf, In_Len)
or else Out_Buf = System.Null_Address
or else Out_Cap < 1
or else Out_Cap > size_t (Max_Acc)
or else Out_Len = null
or else not Case_Mapping.Initialized
or else (Needs_Properties and then not Properties.Initialized)
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
Out_A := new Byte_Array'(1 .. Natural (Out_Cap) => 0);
declare
Last : Natural;
Status : Case_Mapping.Case_Status;
begin
Transform (In_A.all, Out_A.all, Last, Status);
if Status = Case_Mapping.Success then
Copy_Out (Out_A.all, Last, Out_Buf);
Out_Len.all := size_t (Last);
end if;
R := int (Case_Mapping.Case_Status'Pos (Status));
end;
Free (In_A);
Free (Out_A);
return R;
exception
when others =>
Free (In_A);
Free (Out_A);
return LT_ERR;
end Case_Shim;
function Upper_Impl is new Case_Shim (Case_Mapping.Uppercase);
function Lower_Impl is new Case_Shim (Case_Mapping.Lowercase);
function Title_Impl is
new Case_Shim (Case_Mapping.Titlecase, Needs_Properties => True);
function Fold_Impl is new Case_Shim (Case_Mapping.Casefold);
function LT_Uppercase
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (Upper_Impl (In_Buf, In_Len, Out_Buf, Out_Cap, Out_Len));
function LT_Lowercase
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (Lower_Impl (In_Buf, In_Len, Out_Buf, Out_Cap, Out_Len));
function LT_Titlecase
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (Title_Impl (In_Buf, In_Len, Out_Buf, Out_Cap, Out_Len));
function LT_Casefold
(In_Buf : System.Address;
In_Len : size_t;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (Fold_Impl (In_Buf, In_Len, Out_Buf, Out_Cap, Out_Len));
function LT_Is_Cased (CP : u32) return int is
begin
if CP > Max_CP or else not Case_Mapping.Initialized then
return LT_ERR;
end if;
return (if Case_Mapping.Is_Cased (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Is_Cased;
function LT_Is_Case_Ignorable (CP : u32) return int is
begin
if CP > Max_CP or else not Case_Mapping.Initialized then
return LT_ERR;
end if;
return
(if Case_Mapping.Is_Case_Ignorable (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Is_Case_Ignorable;
---------------------------------------------------------------------------
-- Collation
---------------------------------------------------------------------------
function LT_Collate
(A : System.Address;
A_Len : size_t;
B : System.Address;
B_Len : size_t;
Option : int;
Result : Int_Ptr) return int
is
LA, LB : Byte_Array_Access := null;
R : int;
begin
if not Valid_Buf (A, A_Len)
or else not Valid_Buf (B, B_Len)
or else Option not in 0 .. 1
or else Result = null
or else not Collation.Initialized
or else not Normalization.Initialized
then
return LT_ERR;
end if;
LA := Copy_In (A, Natural (A_Len));
LB := Copy_In (B, Natural (B_Len));
declare
Res : Collation_Spec.Comparison_Result;
OK : Boolean;
begin
Collation.Compare
(LA.all, LB.all,
Collation_Spec.Variable_Weight_Option'Val (Option),
Res, OK);
if OK then
Result.all :=
(case Res is
when Collation_Spec.Less => -1,
when Collation_Spec.Equal => 0,
when Collation_Spec.Greater => 1);
R := 0;
else
R := 1;
end if;
end;
Free (LA);
Free (LB);
return R;
exception
when others =>
Free (LA);
Free (LB);
return LT_ERR;
end LT_Collate;
function LT_Sort_Key
(In_Buf : System.Address;
In_Len : size_t;
Option : int;
Key : System.Address;
Key_Cap : size_t;
Key_Len : Size_Ptr) return int
is
In_A, Key_A : Byte_Array_Access := null;
R : int;
begin
if not Valid_Buf (In_Buf, In_Len)
or else Option not in 0 .. 1
or else Key = System.Null_Address
or else Key_Cap < 1
or else Key_Cap > size_t (Max_Buf)
or else Key_Len = null
or else not Collation.Initialized
or else not Normalization.Initialized
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
Key_A := new Byte_Array'(1 .. Natural (Key_Cap) => 0);
declare
Last : Natural;
OK : Boolean;
begin
Collation.Sort_Key
(In_A.all,
Collation_Spec.Variable_Weight_Option'Val (Option),
Key_A.all, Last, OK);
if OK then
Copy_Out (Key_A.all, Last, Key);
Key_Len.all := size_t (Last);
R := 0;
else
R := 1;
end if;
end;
Free (In_A);
Free (Key_A);
return R;
exception
when others =>
Free (In_A);
Free (Key_A);
return LT_ERR;
end LT_Sort_Key;
---------------------------------------------------------------------------
-- Bidi
---------------------------------------------------------------------------
function LT_Bidi_Resolve
(Text : System.Address;
Len : size_t;
Direction : int;
Levels : System.Address;
Levels_Cap : size_t;
Num_CPs : Size_Ptr;
Para_Level : U8_Ptr) return int
is
A : Byte_Array_Access := null;
R : int;
begin
if not Valid_Buf (Text, Len)
or else Direction not in 0 .. 2
or else Levels = System.Null_Address
or else Num_CPs = null
or else Para_Level = null
or else not Bidi.Initialized
or else not Properties.Initialized
then
return LT_ERR;
end if;
A := Copy_In (Text, Natural (Len));
declare
Levs : Bidi.Level_Array;
N : Bidi.Paragraph_Length;
PL : Bidi_Spec.Embedding_Level;
OK : Boolean;
begin
Bidi.Resolve_Levels
(A.all, Bidi.Paragraph_Direction'Val (Direction),
Levs, N, PL, OK);
if not OK then
R := 1;
elsif Levels_Cap < size_t (N) then
R := LT_ERR;
else
declare
Dst : array (1 .. N) of u8
with Import, Address => Levels;
begin
for I in 1 .. N loop
Dst (I) := u8 (Levs (I));
end loop;
end;
Num_CPs.all := size_t (N);
Para_Level.all := u8 (PL);
R := 0;
end if;
end;
Free (A);
return R;
exception
when others =>
Free (A);
return LT_ERR;
end LT_Bidi_Resolve;
function LT_Bidi_Reorder
(Levels : System.Address;
Num_CPs : size_t;
Para_Level : u8;
Order : System.Address;
Order_Cap : size_t) return int
is
begin
if Levels = System.Null_Address
or else Order = System.Null_Address
or else Num_CPs < 1
or else Num_CPs > size_t (Bidi_Spec.Max_Paragraph_CPs)
or else Order_Cap < Num_CPs
or else Para_Level > 1
then
return LT_ERR;
end if;
declare
N : constant Positive := Natural (Num_CPs);
Src : array (1 .. N) of u8 with Import, Address => Levels;
Levs : Bidi.Level_Array := [others => 0];
Ord : Bidi.Index_Array;
OK : Boolean;
begin
for I in 1 .. N loop
if Natural (Src (I)) > Bidi_Spec.Max_Depth + 1 then
return LT_ERR;
end if;
Levs (I) := Natural (Src (I));
end loop;
Bidi.Reorder (Levs, N, Natural (Para_Level), Ord, OK);
if not OK then
return 1;
end if;
declare
Dst : array (1 .. N) of u32 with Import, Address => Order;
begin
for I in 1 .. N loop
Dst (I) := u32 (Ord (I) - 1);
end loop;
end;
end;
return 0;
exception
when others =>
return LT_ERR;
end LT_Bidi_Reorder;
function LT_Bidi_Needs_Mirror (CP : u32; Level : u8) return int is
begin
if CP > Max_CP
or else Natural (Level) > Bidi_Spec.Max_Depth + 1
or else not Properties.Initialized
then
return LT_ERR;
end if;
return
(if Bidi.Needs_Mirror (Codepoint (CP), Natural (Level))
then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Bidi_Needs_Mirror;
---------------------------------------------------------------------------
-- East Asian Width
---------------------------------------------------------------------------
function LT_Display_Width (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (EAW.Display_Width (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Display_Width;
---------------------------------------------------------------------------
-- Emoji
---------------------------------------------------------------------------
generic
with function Lookup (CP : Codepoint) return Boolean;
function Emoji_Flag_Shim (CP : u32) return int;
function Emoji_Flag_Shim (CP : u32) return int is
begin
if CP > Max_CP or else not Emoji.Initialized then
return LT_ERR;
end if;
return (if Lookup (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end Emoji_Flag_Shim;
function Is_Emoji_Impl is new Emoji_Flag_Shim (Emoji.Is_Emoji);
function Is_Emoji_Pres_Impl is
new Emoji_Flag_Shim (Emoji.Is_Emoji_Presentation);
function Is_Emoji_Mod_Impl is
new Emoji_Flag_Shim (Emoji.Is_Emoji_Modifier);
function Is_Emoji_Mod_Base_Impl is
new Emoji_Flag_Shim (Emoji.Is_Emoji_Modifier_Base);
function Is_Emoji_Comp_Impl is
new Emoji_Flag_Shim (Emoji.Is_Emoji_Component);
function LT_Is_Emoji (CP : u32) return int
is (Is_Emoji_Impl (CP));
function LT_Is_Emoji_Presentation (CP : u32) return int
is (Is_Emoji_Pres_Impl (CP));
function LT_Is_Emoji_Modifier (CP : u32) return int
is (Is_Emoji_Mod_Impl (CP));
function LT_Is_Emoji_Modifier_Base (CP : u32) return int
is (Is_Emoji_Mod_Base_Impl (CP));
function LT_Is_Emoji_Component (CP : u32) return int
is (Is_Emoji_Comp_Impl (CP));
function LT_Emoji_Classify
(In_Buf : System.Address;
In_Len : size_t) return int
is
A : Byte_Array_Access := null;
R : int;
begin
if In_Buf = System.Null_Address
or else In_Len < 1
or else In_Len > size_t (Emoji_Spec.Max_Sequence_Bytes)
or else not Emoji.Initialized
then
return LT_ERR;
end if;
A := Copy_In (In_Buf, Natural (In_Len));
R := int (Emoji_Spec.Emoji_Sequence_Type'Pos
(Emoji.Classify_Sequence (A.all)));
Free (A);
return R;
exception
when others =>
Free (A);
return LT_ERR;
end LT_Emoji_Classify;
---------------------------------------------------------------------------
-- Identifiers
---------------------------------------------------------------------------
function LT_Is_Identifier_Start (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return
(if Identifiers.Is_Identifier_Start (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Is_Identifier_Start;
function LT_Is_Identifier_Part (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return
(if Identifiers.Is_Identifier_Part (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Is_Identifier_Part;
---------------------------------------------------------------------------
-- IDNA
---------------------------------------------------------------------------
function To_Options (Bits : u32) return IDNA_Spec.IDNA_Options
is (IDNA_Spec.IDNA_Options'
(Check_Hyphens => (Bits and 1) /= 0,
Check_Bidi => (Bits and 2) /= 0,
Check_Joiners => (Bits and 4) /= 0,
Use_STD3_Rules => (Bits and 8) /= 0,
Verify_DNS_Length => (Bits and 16) /= 0));
generic
with procedure Convert
(Input : Byte_Array;
Options : IDNA_Spec.IDNA_Options;
Output : in out Byte_Array;
Last : out Natural;
Status : out IDNA.IDNA_Result);
function IDNA_Shim
(In_Buf : System.Address;
In_Len : size_t;
Options : u32;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int;
function IDNA_Shim
(In_Buf : System.Address;
In_Len : size_t;
Options : u32;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is
In_A, Out_A : Byte_Array_Access := null;
R : int;
begin
if not Valid_Buf (In_Buf, In_Len)
or else Out_Buf = System.Null_Address
or else Out_Cap < 1
or else Out_Cap > size_t (Max_Buf)
or else Out_Len = null
or else not IDNA.Initialized
or else not Properties.Initialized
or else not Normalization.Initialized
then
return LT_ERR;
end if;
In_A := Copy_In (In_Buf, Natural (In_Len));
Out_A := new Byte_Array'(1 .. Natural (Out_Cap) => 0);
declare
Last : Natural;
Status : IDNA.IDNA_Result;
begin
Convert (In_A.all, To_Options (Options), Out_A.all, Last, Status);
if Status = IDNA.Success then
Copy_Out (Out_A.all, Last, Out_Buf);
Out_Len.all := size_t (Last);
end if;
R := int (IDNA.IDNA_Result'Pos (Status));
end;
Free (In_A);
Free (Out_A);
return R;
exception
when others =>
Free (In_A);
Free (Out_A);
return LT_ERR;
end IDNA_Shim;
function To_ASCII_Impl is new IDNA_Shim (IDNA.To_ASCII);
function To_Unicode_Impl is new IDNA_Shim (IDNA.To_Unicode);
function LT_IDNA_To_ASCII
(In_Buf : System.Address;
In_Len : size_t;
Options : u32;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (To_ASCII_Impl (In_Buf, In_Len, Options, Out_Buf, Out_Cap, Out_Len));
function LT_IDNA_To_Unicode
(In_Buf : System.Address;
In_Len : size_t;
Options : u32;
Out_Buf : System.Address;
Out_Cap : size_t;
Out_Len : Size_Ptr) return int
is (To_Unicode_Impl (In_Buf, In_Len, Options, Out_Buf, Out_Cap, Out_Len));
---------------------------------------------------------------------------
-- Character properties
---------------------------------------------------------------------------
function LT_Script (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_Script (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Script;
function LT_Script_Count return int is
begin
if not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Script_Name_Count);
exception
when others =>
return LT_ERR;
end LT_Script_Count;
function LT_Script_Name
(Idx : int;
Buf : System.Address;
Cap : size_t) return int
is
begin
if not Properties.Initialized
or else Idx < 1
or else Idx > int (Properties.Script_Name_Count)
then
return LT_ERR;
end if;
return Name_Out
(Properties.Script_Name (UCD_Parser.Property_Index (Idx)), Buf, Cap);
exception
when others =>
return LT_ERR;
end LT_Script_Name;
function LT_Script_Extension_Count (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_Script_Extension_Count (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Script_Extension_Count;
function LT_Script_Extension (CP : u32; K : int) return int is
begin
if CP > Max_CP
or else not Properties.Initialized
or else K < 0
or else K >= int (Properties.Get_Script_Extension_Count
(Codepoint (CP)))
then
return LT_ERR;
end if;
return int (Properties.Get_Script_Extension
(Codepoint (CP), Natural (K) + 1));
exception
when others =>
return LT_ERR;
end LT_Script_Extension;
function LT_In_Script_Extensions (CP : u32; Script_Idx : int) return int
is
begin
if CP > Max_CP
or else not Properties.Initialized
or else Script_Idx < 1
or else Script_Idx > int (Properties.Script_Name_Count)
then
return LT_ERR;
end if;
return
(if Properties.Is_In_Script_Extensions
(Codepoint (CP), UCD_Parser.Property_Index (Script_Idx))
then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_In_Script_Extensions;
function LT_General_Category (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_GC (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_General_Category;
function LT_General_Category_Count return int is
begin
if not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.GC_Name_Count);
exception
when others =>
return LT_ERR;
end LT_General_Category_Count;
function LT_General_Category_Name
(Idx : int;
Buf : System.Address;
Cap : size_t) return int
is
begin
if not Properties.Initialized
or else Idx < 1
or else Idx > int (Properties.GC_Name_Count)
then
return LT_ERR;
end if;
return Name_Out
(Properties.GC_Name (UCD_Parser.Property_Index (Idx)), Buf, Cap);
exception
when others =>
return LT_ERR;
end LT_General_Category_Name;
function LT_Grapheme_Break_Property (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.GBP_To_Abstract
(Properties.Get_GBP (Codepoint (CP))));
exception
when others =>
return LT_ERR;
end LT_Grapheme_Break_Property;
function LT_Word_Break_Property (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.WBP_To_Abstract
(Properties.Get_WBP (Codepoint (CP))));
exception
when others =>
return LT_ERR;
end LT_Word_Break_Property;
function LT_Sentence_Break_Property (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.SBP_To_Abstract
(Properties.Get_SBP (Codepoint (CP))));
exception
when others =>
return LT_ERR;
end LT_Sentence_Break_Property;
function LT_Line_Break_Property (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_LBP (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Line_Break_Property;
function LT_East_Asian_Width (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.EAW_To_Abstract
(Properties.Get_EAW (Codepoint (CP))));
exception
when others =>
return LT_ERR;
end LT_East_Asian_Width;
function LT_Bidi_Class (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_BC (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Bidi_Class;
function LT_Joining_Type (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.Get_JT (Codepoint (CP)));
exception
when others =>
return LT_ERR;
end LT_Joining_Type;
function LT_Indic_Conjunct_Break (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return int (Properties.InCB_To_Abstract
(Properties.Get_InCB (Codepoint (CP))));
exception
when others =>
return LT_ERR;
end LT_Indic_Conjunct_Break;
function LT_Extended_Pictographic (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return (if Properties.Get_ExtPict (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Extended_Pictographic;
function LT_Bidi_Mirrored (CP : u32) return int is
begin
if CP > Max_CP or else not Properties.Initialized then
return LT_ERR;
end if;
return
(if Properties.Get_Bidi_Mirrored (Codepoint (CP)) then 1 else 0);
exception
when others =>
return LT_ERR;
end LT_Bidi_Mirrored;
end Lingenic_Text_C;