ada/types-hash_map.adb

   1 with Ada.Strings.Unbounded.Hash;
   2 with Smart_Pointers;
   3
   4 package body Types.Hash_Map is
   5
   6    function "=" (A, B : Hash_Map_Mal_Type) return Boolean is
   7       A_Key, A_Elem, B_Elem : Mal_Handle;
   8       use Mal_Mal_Hash;
   9       C : Cursor;
  10    begin
  11       if A.Length /= B.Length then
  12          return False;
  13       end if;
  14       C := A.Hash.First;
  15       while Has_Element (C) loop
  16          A_Key := Key (C);
  17          A_Elem := Element (C);
  18          B_Elem := Mal_Mal_Hash.Element (B.Hash, A_Key);
  19          if A_Elem /= B_Elem then
  20             return False;
  21          end if;
  22          Next (C);
  23       end loop;
  24       return True;
  25    end "=";
  26
  27    function New_Hash_Map_Mal_Type
  28    return Mal_Handle is
  29    begin
  30       return Smart_Pointers.New_Ptr
  31         (new Hash_Map_Mal_Type'
  32            (Mal_Type with
  33               List_Type => Hashed_List,
  34               The_List => Smart_Pointers.Null_Smart_Pointer,
  35               Last_Elem => Smart_Pointers.Null_Smart_Pointer,
  36               Is_Key_Expected => True,
  37               Next_Key => Smart_Pointers.Null_Smart_Pointer,
  38               Hash => Mal_Mal_Hash.Empty_Map));
  39    end New_Hash_Map_Mal_Type;
  40
  41    overriding function Prepend (Op : Mal_Handle; To_Vector : Hash_Map_Mal_Type)
  42    return Mal_Handle is
  43    begin
  44       raise Not_Appropriate;
  45       return Smart_Pointers.Null_Smart_Pointer;
  46    end Prepend;
  47
  48    overriding procedure Append (V : in out Hash_Map_Mal_Type; E : Mal_Handle) is
  49    begin
  50       if V.Is_Key_Expected then
  51          V.Next_Key := E;
  52       else
  53          Mal_Mal_Hash.Include
  54            (Container => V.Hash,
  55             Key => V.Next_Key,
  56             New_Item => E);
  57       end if;
  58       V.Is_Key_Expected := not V.Is_Key_Expected;
  59    end Append;
  60
  61    overriding function Length (L : Hash_Map_Mal_Type) return Natural is
  62    begin
  63       return Natural (L.Hash.Length);
  64    end Length;
  65
  66    overriding function Is_Null (L : Hash_Map_Mal_Type) return Boolean is
  67    begin
  68       return L.Hash.Is_Empty;
  69    end Is_Null;
  70
  71    overriding function Null_List (L : List_Types) return Hash_Map_Mal_Type is
  72    begin
  73       return
  74         Hash_Map_Mal_Type'
  75            (Mal_Type with
  76               List_Type => Hashed_List,
  77               The_List => Smart_Pointers.Null_Smart_Pointer,
  78               Last_Elem => Smart_Pointers.Null_Smart_Pointer,
  79               Is_Key_Expected => False,
  80               Next_Key => Smart_Pointers.Null_Smart_Pointer,
  81               Hash => Mal_Mal_Hash.Empty_Map);
  82    end Null_List;
  83
  84    -- Duplicate copies the list (logically).  This is to allow concatenation,
  85    -- The result is always a List_List.
  86    overriding function Duplicate (The_List : Hash_Map_Mal_Type) return Mal_Handle is
  87    begin
  88       raise Not_Appropriate;
  89       return Smart_Pointers.Null_Smart_Pointer;
  90    end Duplicate;
  91
  92    overriding function Nth (L :Hash_Map_Mal_Type; N : Natural) return Mal_Handle is
  93    begin
  94       raise Not_Appropriate;
  95       return Smart_Pointers.Null_Smart_Pointer;
  96    end Nth;
  97
  98    overriding procedure Add_Defs (Defs : Hash_Map_Mal_Type; Env : Envs.Env_Handle) is
  99    begin
 100       raise Not_Appropriate;
 101    end Add_Defs;
 102
 103    -- Get the first item in the list:
 104    overriding function Car (L : Hash_Map_Mal_Type) return Mal_Handle is
 105    begin
 106       raise Not_Appropriate;
 107       return Smart_Pointers.Null_Smart_Pointer;
 108    end Car;
 109
 110    -- Get the rest of the list (second item onwards)
 111    overriding function Cdr (L : Hash_Map_Mal_Type) return Mal_Handle is
 112    begin
 113       raise Not_Appropriate;
 114       return Smart_Pointers.Null_Smart_Pointer;
 115    end Cdr;
 116
 117
 118    overriding function Map
 119      (Func_Ptr : Func_Access;
 120       L : Hash_Map_Mal_Type)
 121    return Mal_Handle is
 122       Res : Mal_Handle;
 123       use Mal_Mal_Hash;
 124       C : Cursor;
 125    begin
 126       Res := New_Hash_Map_Mal_Type;
 127       C := L.Hash.First;
 128       while Has_Element (C) loop
 129          -- Assuming we're not applying the func to the keys too.
 130          Deref_Hash (Res).Hash.Include
 131            (Key => Key (C),
 132             New_Item => Func_Ptr (Element (C)));
 133          Next (C);
 134       end loop;
 135       return Res;
 136    end Map;
 137
 138    function Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is
 139       Res : Mal_Handle;
 140       Rest_List : List_Mal_Type;
 141       use Mal_Mal_Hash;
 142       C : Cursor;
 143    begin
 144       Res := New_Hash_Map_Mal_Type;
 145       Rest_List := Deref_List (List).all;
 146
 147       -- Copy arg into result.
 148       Deref_Hash (Res).Hash := H.Hash;
 149
 150       while not Is_Null (Rest_List) loop
 151          Deref_Hash (Res).Append (Car (Rest_List));
 152          Rest_List := Deref_List (Cdr (Rest_List)).all;
 153       end loop;
 154       return Res;
 155    end Assoc;
 156
 157
 158    function Dis_Assoc (H : Hash_Map_Mal_Type; List : Mal_Handle) return Mal_Handle is
 159       Res : Mal_Handle;
 160       Rest_List : List_Mal_Type;
 161       use Mal_Mal_Hash;
 162       C : Cursor;
 163    begin
 164       Res := New_Hash_Map_Mal_Type;
 165       Rest_List := Deref_List (List).all;
 166
 167       -- Copy arg into result.
 168       Deref_Hash (Res).Hash := H.Hash;
 169
 170       while not Is_Null (Rest_List) loop
 171          Mal_Mal_Hash.Exclude (Deref_Hash (Res).Hash, Car (Rest_List));
 172          Rest_List := Deref_List (Cdr (Rest_List)).all;
 173       end loop;
 174       return Res;
 175    end Dis_Assoc;
 176
 177
 178    function Get (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Mal_Handle is
 179       use Mal_Mal_Hash;
 180       C : Cursor;
 181    begin
 182       C := Mal_Mal_Hash.Find (H.Hash, Key);
 183       if Has_Element (C) then
 184          return Element (C);
 185       else
 186          return New_Nil_Mal_Type;
 187       end if;
 188    end Get;
 189
 190
 191    function All_Keys (H : Hash_Map_Mal_Type) return Mal_Handle is
 192       Res, Map_Key : Mal_Handle;
 193       use Mal_Mal_Hash;
 194       C : Cursor;
 195    begin
 196       Res := New_List_Mal_Type (List_List);
 197       C := H.Hash.First;
 198       while Has_Element (C) loop
 199          Map_Key := Key (C);
 200          Deref_List (Res).Append (Map_Key);
 201          Next (C);
 202       end loop;
 203       return Res;
 204    end All_Keys;
 205
 206
 207    function All_Values (H : Hash_Map_Mal_Type) return Mal_Handle is
 208       Res, Map_Val : Mal_Handle;
 209       use Mal_Mal_Hash;
 210       C : Cursor;
 211    begin
 212       Res := New_List_Mal_Type (List_List);
 213       C := H.Hash.First;
 214       while Has_Element (C) loop
 215          Map_Val := Element (C);
 216          Deref_List (Res).Append (Map_Val);
 217          Next (C);
 218       end loop;
 219       return Res;
 220    end All_Values;
 221
 222
 223    function Contains (H : Hash_Map_Mal_Type; Key : Mal_Handle) return Boolean is
 224    begin
 225       return Mal_Mal_Hash.Contains (H.Hash, Key);
 226    end Contains;
 227
 228    function Deref_Hash (SP : Mal_Handle) return Hash_Ptr is
 229    begin
 230       return Hash_Ptr (Deref (SP));
 231    end Deref_Hash;
 232
 233    function Hash (M : Mal_Handle) return Ada.Containers.Hash_Type is
 234    begin
 235       return Ada.Strings.Unbounded.Hash
 236                (Ada.Strings.Unbounded.To_Unbounded_String
 237                  (Deref (M).To_String));
 238    end Hash;
 239
 240    overriding function To_Str
 241      (T : Hash_Map_Mal_Type; Print_Readably : Boolean := True)
 242    return Mal_String is
 243      use Ada.Containers;
 244    begin
 245       if (T.Hash.Length = 0) then
 246          return Opening (T.List_Type) &
 247                 Closing (T.List_Type);
 248       else
 249          declare
 250             Res : Ada.Strings.Unbounded.Unbounded_String;
 251             use Mal_Mal_Hash;
 252             C : Cursor;
 253          begin
 254             C := First (T.Hash);
 255
 256             Res := Ada.Strings.Unbounded."&"
 257                      (Opening (T.List_Type),
 258                       Ada.Strings.Unbounded.To_Unbounded_String
 259                         (To_String (Deref (Key (C)).all, Print_Readably)));
 260             Res := Ada.Strings.Unbounded."&" (Res, " ");
 261             Res := Ada.Strings.Unbounded."&"
 262                      (Res,
 263                       Ada.Strings.Unbounded.To_Unbounded_String
 264                         (To_String (Deref (Element (C)).all, Print_Readably)));
 265             Next (C);
 266             while Has_Element (C) loop
 267                Res := Ada.Strings.Unbounded."&" (Res, " ");
 268                Res := Ada.Strings.Unbounded."&"
 269                         (Res,
 270                          Ada.Strings.Unbounded.To_Unbounded_String
 271                            (To_String (Deref (Key (C)).all, Print_Readably)));
 272                Res := Ada.Strings.Unbounded."&" (Res, " ");
 273                Res := Ada.Strings.Unbounded."&"
 274                  (Res,
 275                   Ada.Strings.Unbounded.To_Unbounded_String
 276                     (To_String (Deref (Element (C)).all, Print_Readably)));
 277                Next (C);
 278             end loop;
 279             Res := Ada.Strings.Unbounded."&" (Res, Closing (T.List_Type));
 280             return Ada.Strings.Unbounded.To_String (Res);
 281          end;
 282       end if;
 283    end To_Str;
 284
 285 end Types.Hash_Map;