Index: src/natools-static_hash_maps-s_expressions-command_maps.adb ================================================================== --- src/natools-static_hash_maps-s_expressions-command_maps.adb +++ src/natools-static_hash_maps-s_expressions-command_maps.adb @@ -1,6 +1,6 @@ --- Generated at 2014-05-26 20:24:08 +0000 by Natools.Static_Hash_Maps +-- Generated at 2014-05-28 17:27:24 +0000 by Natools.Static_Hash_Maps -- from natools-static_hash_maps-s_expressions-hash_maps.sx with Natools.Static_Hash_Maps.S_Expressions.Command_Pkg; with Natools.Static_Hash_Maps.S_Expressions.Command_Map; Index: src/natools-static_hash_maps-s_expressions-command_maps.ads ================================================================== --- src/natools-static_hash_maps-s_expressions-command_maps.ads +++ src/natools-static_hash_maps-s_expressions-command_maps.ads @@ -1,23 +1,32 @@ --- Generated at 2014-05-26 20:24:08 +0000 by Natools.Static_Hash_Maps +-- Generated at 2014-05-28 17:27:24 +0000 by Natools.Static_Hash_Maps -- from natools-static_hash_maps-s_expressions-hash_maps.sx private package Natools.Static_Hash_Maps.S_Expressions.Command_Maps is function To_Package_Command (Key : String) return Package_Command; function To_Map_Command (Key : String) return Map_Command; private - Map_1_Key_0 : aliased constant String := "private"; - Map_1_Key_1 : aliased constant String := "public"; - Map_1_Keys : constant array (0 .. 1) of access constant String + Map_1_Key_0 : aliased constant String := "extra-declarations"; + Map_1_Key_1 : aliased constant String := "extra-decl"; + Map_1_Key_2 : aliased constant String := "private"; + Map_1_Key_3 : aliased constant String := "public"; + Map_1_Key_4 : aliased constant String := "test-function"; + Map_1_Keys : constant array (0 .. 4) of access constant String := (Map_1_Key_0'Access, - Map_1_Key_1'Access); - Map_1_Elements : constant array (0 .. 1) of Package_Command - := (Private_Child, - Public_Child); + Map_1_Key_1'Access, + Map_1_Key_2'Access, + Map_1_Key_3'Access, + Map_1_Key_4'Access); + Map_1_Elements : constant array (0 .. 4) of Package_Command + := (Extra_Declarations, + Extra_Declarations, + Private_Child, + Public_Child, + Test_Function); Map_2_Key_0 : aliased constant String := "hash-package"; Map_2_Key_1 : aliased constant String := "nodes"; Map_2_Key_2 : aliased constant String := "function"; Map_2_Key_3 : aliased constant String := "not-found"; Index: src/natools-static_hash_maps-s_expressions-command_pkg.adb ================================================================== --- src/natools-static_hash_maps-s_expressions-command_pkg.adb +++ src/natools-static_hash_maps-s_expressions-command_pkg.adb @@ -1,20 +1,20 @@ with Interfaces; use Interfaces; package body Natools.Static_Hash_Maps.S_Expressions.Command_Pkg is - P : constant array (0 .. 0) of Natural := - (0 .. 0 => 2); - - T1 : constant array (0 .. 0) of Unsigned_8 := - (0 .. 0 => 4); - - T2 : constant array (0 .. 0) of Unsigned_8 := - (0 .. 0 => 3); - - G : constant array (0 .. 4) of Unsigned_8 := - (0, 0, 0, 1, 0); + P : constant array (0 .. 1) of Natural := + (2, 11); + + T1 : constant array (0 .. 1) of Unsigned_8 := + (8, 10); + + T2 : constant array (0 .. 1) of Unsigned_8 := + (5, 2); + + G : constant array (0 .. 10) of Unsigned_8 := + (2, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2); function Hash (S : String) return Natural is F : constant Natural := S'First - 1; L : constant Natural := S'Length; F1, F2 : Natural := 0; @@ -21,12 +21,12 @@ J : Natural; begin for K in P'Range loop exit when L < P (K); J := Character'Pos (S (P (K) + F)); - F1 := (F1 + Natural (T1 (K)) * J) mod 5; - F2 := (F2 + Natural (T2 (K)) * J) mod 5; + F1 := (F1 + Natural (T1 (K)) * J) mod 11; + F2 := (F2 + Natural (T2 (K)) * J) mod 11; end loop; - return (Natural (G (F1)) + Natural (G (F2))) mod 2; + return (Natural (G (F1)) + Natural (G (F2))) mod 5; end Hash; end Natools.Static_Hash_Maps.S_Expressions.Command_Pkg; Index: src/natools-static_hash_maps-s_expressions-hash_maps.sx ================================================================== --- src/natools-static_hash_maps-s_expressions-hash_maps.sx +++ src/natools-static_hash_maps-s_expressions-hash_maps.sx @@ -3,16 +3,18 @@ (Package_Command (hash-package Natools.Static_Hash_Maps.S_Expressions.Command_Pkg) (function To_Package_Command) (not-found Extra_Declarations) (nodes + (Extra_Declarations extra-declarations extra-decl) (Private_Child private) - (Public_Child public))) + (Public_Child public) + (Test_Function test-function))) (Map_Command (hash-package Natools.Static_Hash_Maps.S_Expressions.Command_Map) (function To_Map_Command) (nodes (Hash_Package hash-package) (Nodes nodes) (Function_Name function) (Not_Found not-found)))) Index: src/natools-static_hash_maps-s_expressions.adb ================================================================== --- src/natools-static_hash_maps-s_expressions.adb +++ src/natools-static_hash_maps-s_expressions.adb @@ -49,10 +49,16 @@ Arguments : in out Sx.Lockable.Descriptor'Class); procedure Update_Package (Pkg : in out Map_Package; Context : in Meaningless_Type; + Name : in Sx.Atom; + Arguments : in out Sx.Lockable.Descriptor'Class); + + procedure Update_Package + (Pkg : in out Map_Package; + Context : in Meaningless_Type; Name : in Sx.Atom); procedure Map_Interpreter is new Sx.Interpreter_Loop @@ -63,11 +69,11 @@ procedure Package_Generator is new Sx.Interpreter_Loop (Map_Package, String, Generate_Package); procedure Package_Interpreter is new Sx.Interpreter_Loop - (Map_Package, Meaningless_Type, Add_Map, Update_Package); + (Map_Package, Meaningless_Type, Update_Package, Update_Package); procedure Value_Interpreter is new Sx.Interpreter_Loop (Map_Description, String, Dispatch_Without_Argument => Add_Value); @@ -166,10 +172,69 @@ procedure Update_Package (Pkg : in out Map_Package; Context : in Meaningless_Type; + Name : in Sx.Atom; + Arguments : in out Sx.Lockable.Descriptor'Class) + is + pragma Unreferenced (Context); + use type Sx.Events.Event; + use type Sx.Octet; + Is_Command : Boolean := False; + begin + for I in Name'Range loop + if Name (I) = Character'Pos ('-') then + Is_Command := True; + exit; + end if; + end loop; + + if not Is_Command then + Add_Map (Pkg, Meaningless_Value, Name, Arguments); + return; + end if; + + case Command_Maps.To_Package_Command (Sx.To_String (Name)) is + when Private_Child => + Set_Private_Child (Pkg, True); + when Public_Child => + Set_Private_Child (Pkg, False); + when Extra_Declarations => + if Arguments.Current_Event = Sx.Events.Add_Atom then + Set_Extra_Declarations + (Pkg, Sx.To_String (Arguments.Current_Atom)); + end if; + when Test_Function => + if Arguments.Current_Event = Sx.Events.Add_Atom then + declare + Child_Name : constant String + := Sx.To_String (Arguments.Current_Atom); + Parent_Name : constant String := To_String (Pkg.Name); + begin + if Child_Name'Length > Parent_Name'Length + and then Child_Name (Child_Name'First + .. Child_Name'First + Parent_Name'Length - 1) + = Parent_Name + then + Set_Test_Child (Pkg, Child_Name + (Child_Name'First + Parent_Name'Length + .. Child_Name'Last)); + else + Set_Test_Child (Pkg, Child_Name); + end if; + end; + else + Set_Test_Child (Pkg, ""); + end if; + end case; + end Update_Package; + + + procedure Update_Package + (Pkg : in out Map_Package; + Context : in Meaningless_Type; Name : in Sx.Atom) is pragma Unreferenced (Context); begin case Command_Maps.To_Package_Command (Sx.To_String (Name)) is @@ -177,10 +242,12 @@ Set_Private_Child (Pkg, True); when Public_Child => Set_Private_Child (Pkg, False); when Extra_Declarations => Set_Extra_Declarations (Pkg, Sx.To_String (Name)); + when Test_Function => + null; end case; end Update_Package; Index: src/natools-static_hash_maps-s_expressions.ads ================================================================== --- src/natools-static_hash_maps-s_expressions.ads +++ src/natools-static_hash_maps-s_expressions.ads @@ -39,14 +39,15 @@ private type Package_Command is (Private_Child, Public_Child, + Test_Function, Extra_Declarations); type Map_Command is (Hash_Package, Nodes, Function_Name, Not_Found); end Natools.Static_Hash_Maps.S_Expressions;