summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/bundles-containers.adb131
-rw-r--r--src/bundles-containers.ads10
2 files changed, 140 insertions, 1 deletions
diff --git a/src/bundles-containers.adb b/src/bundles-containers.adb
index d1b1130..0550f6d 100644
--- a/src/bundles-containers.adb
+++ b/src/bundles-containers.adb
@@ -2,19 +2,148 @@
with
- Ada.Strings.Unbounded,
+ Ada.Strings.Unbounded.Text_IO,
Ada.Text_IO,
CSV;
+use
+
+ Ada.Strings.Unbounded.Text_IO,
+ Ada.Text_IO;
+
package body Bundles.Containers is
+ package My_CSV is new CSV;
package SU renames Ada.Strings.Unbounded;
+ protected type Preference_Input is
+ procedure Open (Filename : in String);
+ procedure Read_Line
+ (Line : out SU.Unbounded_String;
+ EOF : out Boolean);
+ procedure Close;
+ private
+ Source : File_Type;
+ end Preference_Input;
+
+
+ protected body Preference_Input is
+ procedure Open (Filename : in String) is
+ begin
+ Open (Source, In_File, Filename);
+ end Open;
+ procedure Read_Line
+ (Line : out SU.Unbounded_String;
+ EOF : out Boolean) is
+ begin
+ if End_Of_File (Source) then
+ EOF := True;
+ else
+ EOF := False;
+ Line := Get_Line (Source);
+ end if;
+ end Read_Line;
+ procedure Close is
+ begin
+ Ada.Text_IO.Close (Source);
+ end Close;
+ end Preference_Input;
+
+
+
+
+ type Paper_Array is array (Valid_CandidateID) of Paper_Vectors.Vector;
+ type Paper_Array_Array is array (1 .. Num_Threads) of Paper_Array;
+
+
+ Empty_Paper_Array : Paper_Array :=
+ (others => Paper_Vectors.Empty_Vector);
+
+
+
+
+ task type Parse_Worker
+ (Input : access Preference_Input;
+ Output : access Paper_Array_Array) is
+ entry Start (On : in Positive);
+ end Parse_Worker;
+
+
+ task body Parse_Worker is
+ use type Candidates.CandidateID;
+
+ Work_On : Positive;
+
+ Current_Line : SU.Unbounded_String;
+ Current_Record : My_CSV.CSV_Record;
+ Current_Prefs : Given_Prefs.Preference_Array;
+ Are_We_Done_Yet : Boolean;
+ begin
+ accept Start (On : in Positive) do
+ Work_On := On;
+ end Start;
+ loop
+ Input.Read_Line (Current_Line, Are_We_Done_Yet);
+ exit when Are_We_Done_Yet;
+ Current_Record := My_CSV.Parse_Line (SU.To_String (Current_Line));
+ if Integer (Current_Record.Length) > 0 then
+ Current_Prefs := Given_Prefs.Parse_Preferences
+ (SU.To_String (Current_Record.Last_Element));
+ if Current_Prefs (Given_Prefs.Preference_Range'First) /=
+ Candidates.No_Candidate
+ then
+ Output (Work_On) (Current_Prefs (Given_Prefs.Preference_Range'First)).Append
+ (Current_Prefs);
+ end if;
+ end if;
+ end loop;
+ end Parse_Worker;
+
+
+
+
+ procedure Read_Bundles_Threaded
+ (Filename : in String;
+ Result : out Bundle_Collection)
+ is
+ use type Bundle_Vector;
+
+ Input : aliased Preference_Input;
+ Outputs : aliased Paper_Array_Array :=
+ (others => Empty_Paper_Array);
+ begin
+ Result := (others => Bundle_Vectors.Empty_Vector & Empty_Bundle);
+ Input.Open (Filename);
+
+ declare
+ Workers : array (1 .. Num_Threads) of Parse_Worker
+ (Input'Access, Outputs'Access);
+ begin
+ for I in Workers'Range loop
+ Workers (I).Start (I);
+ end loop;
+ end;
+
+ Input.Close;
+ for CID in Valid_CandidateID loop
+ for O of Outputs loop
+ Result (CID).Reference (1).Papers.Append (O (CID));
+ O (CID) := Paper_Vectors.Empty_Vector;
+ end loop;
+ if Result (CID).Reference (1) = Empty_Bundle then
+ Result (CID).Delete (1);
+ end if;
+ end loop;
+ end Read_Bundles_Threaded;
+
+
+
+
procedure Read_Bundles
(Filename : in String;
Result : out Bundle_Collection)
diff --git a/src/bundles-containers.ads b/src/bundles-containers.ads
index 8caf263..1361026 100644
--- a/src/bundles-containers.ads
+++ b/src/bundles-containers.ads
@@ -8,6 +8,7 @@ with
generic
Min_Valid : Candidates.CandidateID;
Max_Valid : Candidates.CandidateID;
+ Num_Threads : Positive := 2;
package Bundles.Containers is
@@ -26,6 +27,15 @@ package Bundles.Containers is
Result : out Bundle_Collection);
+ -- Current implementation slightly faster, but not worth it.
+ -- Probably needs to be reworked to read in the entire file at once for decent
+ -- increase in speed, but that would involve approx doubling memory usage,
+ -- which is unacceptable.
+ procedure Read_Bundles_Threaded
+ (Filename : in String;
+ Result : out Bundle_Collection);
+
+
end Bundles.Containers;