vhdl: ignore duplicate map keys

Author: asarhaddon

impls/vhdl/core.vhdl

@@ -260,9 +260,11 @@ package body core is
   end procedure fn_vector_q;
 
   procedure fn_hash_map(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
+    variable new_map: mal_val_ptr;
   begin
-    args.val_type := mal_hashmap;
-    result := args;
+    new_empty_hashmap(new_map);
+    hashmap_extend(new_map, args.seq_val.all);
+    result := m;
   end procedure fn_hash_map;
 
   procedure fn_map_q(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
@@ -272,14 +274,9 @@ package body core is
 
   procedure fn_assoc(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
     variable new_hashmap: mal_val_ptr;
-    variable i: integer;
   begin
     hashmap_copy(args.seq_val(0), new_hashmap);
-    i := 1;
-    while i < args.seq_val'length loop
-      hashmap_put(new_hashmap, args.seq_val(i), args.seq_val(i + 1));
-      i := i + 2;
-    end loop;
+    hashmap_extend(new_hashmap, args.seq_val.all(1 to args.seq_val'last));
     result := new_hashmap;
   end procedure fn_assoc;
 

impls/vhdl/reader.vhdl

@@ -246,7 +246,7 @@ package body reader is
     end if;
   end procedure read_atom;
 
-  procedure read_sequence(list_type: in mal_type_tag; end_ch: in string; r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is
+  procedure read_sequence(end_ch: in string; r: inout reader_class; result: out mal_seq_ptr; err: out mal_val_ptr) is
     variable token: line;
     variable element, sub_err: mal_val_ptr;
     variable seq: mal_seq_ptr;
@@ -270,9 +270,50 @@ package body reader is
       return;
     end if;
     reader_next(r, token); -- Consume the close paren
-    new_seq_obj(list_type, seq, result);
+    result := seq;
   end procedure read_sequence;
 
+  procedure read_list(r: inout reader_class; result: out mal_seq_ptr; err: out mal_val_ptr) is
+    variable seq: mal_seq_ptr;
+    variable sub_err: mal_val_ptr;
+  begin
+    read_sequence(")", r, seq, sub_err);
+    if sub_err = null then
+      new_seq_obj(mal_list, seq, result);
+    else
+      err := sub_err;
+      result := null;
+    end if;
+  end procedure read_list;
+
+  procedure read_vector(r: inout reader_class; result: out mal_seq_ptr; err: out mal_val_ptr) is
+    variable seq: mal_seq_ptr;
+    variable sub_err: mal_val_ptr;
+  begin
+    read_sequence("]", r, seq, sub_err);
+    if sub_err = null then
+      new_seq_obj(mal_vector, seq, result);
+    else
+      err := sub_err;
+      result := null;
+    end if;
+  end procedure read_vector;
+
+  procedure read_map(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr) is
+    variable seq: mal_seq_ptr;
+    variable sub_err, new_map: mal_val_ptr;
+  begin
+    read_sequence("}", r, seq, sub_err);
+    if sub_err = null then
+      new_empty_hashmap(new_map);
+      hashmap_extend(new_map, seq.all);
+      result := new_map;
+    else
+      err := sub_err;
+      result := null;
+    end if;
+  end procedure read_map;
+
   procedure reader_macro(r: inout reader_class; result: out mal_val_ptr; err: out mal_val_ptr; sym_name: in string) is
     variable token, sym_line: line;
     variable seq: mal_seq_ptr;
@@ -339,11 +380,11 @@ package body reader is
         end if;
       when '^' => with_meta_reader_macro(r, result, err);
       when '@' => reader_macro(r, result, err, "deref");
-      when '(' => read_sequence(mal_list, ")", r, result, err);
+      when '(' => read_list(r, result, err);
       when ')' => new_string("unexcepted ')'", err);
-      when '[' => read_sequence(mal_vector, "]", r, result, err);
+      when '[' => read_vector(r, result, err);
       when ']' => new_string("unexcepted ']'", err);
-      when '{' => read_sequence(mal_hashmap, "}", r, result, err);
+      when '{' => read_map(r, result, err);
       when '}' => new_string("unexcepted '}'", err);
       when others => read_atom(r, result, err);
     end case;

impls/vhdl/types.vhdl

@@ -66,6 +66,7 @@ package types is
   procedure new_atom(val: inout mal_val_ptr; obj: out mal_val_ptr);
 
   procedure hashmap_copy(hashmap: inout mal_val_ptr; obj: out mal_val_ptr);
+  procedure hashmap_extend(hm: inout mal_val_ptr; kvs: in mal_seq);
   procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr);
   procedure hashmap_contains(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; ok: out boolean);
   procedure hashmap_put(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: inout mal_val_ptr);
@@ -213,6 +214,16 @@ package body types is
     new_seq_obj(mal_hashmap, new_seq, obj);
   end procedure hashmap_copy;
 
+  procedure hashmap_extend(hm: inout mal_val_ptr; kvs: in mal_seq) is
+    variable i: natural;
+  begin
+    i := 0;
+    while i < kvs'length loop
+      hashmap_put(hm, kvs(i), kvs(i + 1));
+      i := i + 2;
+    end loop;
+  end hashmap_extend;
+
   procedure hashmap_get(hashmap: inout mal_val_ptr; key: inout mal_val_ptr; val: out mal_val_ptr) is
     variable i: natural;
     variable curr_key: mal_val_ptr;