Implement 'VALUE for character arrays

lib/nvc/text_util-body.vhd

@@ -87,6 +87,32 @@ package body text_util is
             severity failure;
     end function;
 
+    function find_quote (s : string) return natural is
+        constant len : integer := s'length;
+        alias ss     : string(1 to len) is s;
+    begin
+        for i in 1 to len loop
+            if ss(i) = '"' then
+                return i;
+            elsif ss(i) /= ' ' then
+                return 0;
+            end if;
+        end loop;
+    end function;
+
+    function find_unquote (s : string; pos : natural) return natural is
+        constant len : integer := s'length;
+        alias ss     : string(1 to len) is s;
+    begin
+        for i in 1 + pos to len loop
+            if ss(i) = '"' and (i = len or ss(i + 1) /= '"') then
+                return i - 1;
+            end if;
+        end loop;
+        report "failed to parse '" & s & "' (missing closing '""')"
+            severity failure;
+    end function;
+
     procedure find_close (s : string; pos : natural) is
         constant len : integer := s'length;
         alias ss     : string(1 to len) is s;
@@ -101,4 +127,10 @@ package body text_util is
         report "failed to parse '" & s & "' (missing closing ')')"
             severity failure;
     end procedure;
+
+    procedure report_bad_char (s : string; c : character) is
+    begin
+        report "invalid character " & character'image(c)
+            & " in string " & s severity failure;
+    end procedure;
 end package body;

lib/nvc/text_util.vhd

@@ -35,5 +35,8 @@ package text_util is
     function next_delimiter (s : string; pos : natural) return string;
     function count_delimiters (s : string) return natural;
     function find_open (s : string) return natural;
+    function find_quote (s : string) return natural;
     procedure find_close (s : string; pos : natural);
+    function find_unquote (s : string; pos : natural) return natural;
+    procedure report_bad_char (s : string; c : character);
 end package;

src/lower.c

@@ -8619,34 +8619,141 @@ static void lower_array_value_helper(lower_unit_t *lu, type_t type,
    vcode_type_t strtype = vtype_uarray(1, ctype, ctype);
    vcode_type_t vnat = vtype_int(0, INT64_MAX);
 
-   vcode_block_t body_bb = emit_block();
-   vcode_block_t exit_bb = emit_block();
-
    vcode_reg_t locus = lower_debug_locus(decl);
 
    vcode_reg_t zero_reg = emit_const(voffset, 0);
    vcode_reg_t one_reg = emit_const(voffset, 1);
 
+   vcode_var_t i_var = lower_temp_var(lu, "i", voffset, voffset);
+   emit_store(zero_reg, i_var);
+
    ident_t next_delim_fn = ident_new("NVC.TEXT_UTIL.NEXT_DELIMITER(SN)S");
    ident_t count_delim_fn = ident_new("NVC.TEXT_UTIL.COUNT_DELIMITERS(S)N");
    ident_t find_open_fn = ident_new("NVC.TEXT_UTIL.FIND_OPEN(S)N");
+   ident_t find_quote_fn = ident_new("NVC.TEXT_UTIL.FIND_QUOTE(S)N");
+   ident_t find_unquote_fn = ident_new("NVC.TEXT_UTIL.FIND_UNQUOTE(SN)N");
    ident_t find_close_fn = ident_new("NVC.TEXT_UTIL.FIND_CLOSE(SN)");
+   ident_t bad_char_fn = ident_new("NVC.TEXT_UTIL.REPORT_BAD_CHAR(SC)");
    vcode_reg_t text_util_reg = lower_context_for_call(lu, next_delim_fn);
 
+   type_t elem = type_base_recur(lower_elem_recur(type));
+   vcode_type_t velem = lower_type(elem);
+   vcode_type_t vbounds = lower_bounds(elem);
+
+   if (type_is_character_array(type)) {
+      vcode_block_t quote_bb = emit_block();
+      vcode_block_t body_bb = emit_block();
+      vcode_block_t bad_bb = emit_block();
+      vcode_block_t good_bb = emit_block();
+      vcode_block_t exit_bb = emit_block();
+      vcode_block_t paren_bb = emit_block();
+
+      vcode_reg_t quote_args[] = { text_util_reg, preg };
+      vcode_reg_t quote_result_reg = emit_fcall(find_quote_fn, vnat, vnat,
+                                                VCODE_CC_VHDL, quote_args, 2);
+      vcode_reg_t quote_pos_reg = emit_cast(voffset, voffset, quote_result_reg);
+
+      vcode_reg_t quoted_reg = emit_cmp(VCODE_CMP_EQ, quote_pos_reg, zero_reg);
+      emit_cond(quoted_reg, paren_bb, quote_bb);
+
+      vcode_select_block(quote_bb);
+
+      vcode_reg_t unquote_args[] = { text_util_reg, preg, quote_result_reg };
+      vcode_reg_t unquote_result_reg = emit_fcall(find_unquote_fn, vnat, vnat,
+                                                  VCODE_CC_VHDL, unquote_args,
+                                                  ARRAY_LEN(unquote_args));
+      vcode_reg_t unquote_pos_reg =
+         emit_cast(voffset, voffset, unquote_result_reg);
+
+      vcode_reg_t count_reg = emit_sub(unquote_pos_reg, quote_pos_reg);
+      vcode_reg_t mem_reg = emit_alloc(velem, vbounds, count_reg);
+
+      vcode_var_t pos_var = lower_temp_var(lu, "pos", voffset, voffset);
+      emit_store(emit_cast(voffset, voffset, quote_pos_reg), pos_var);
+
+      const int nlits = type_enum_literals(elem);
+      vcode_reg_t entry_vtype = vtype_int(0, nlits);
+      vcode_reg_t map[256], def_reg = emit_const(entry_vtype, nlits);
+      for (int i = 0; i < 256; i++)
+         map[i] = def_reg;
+      for (int i = 0; i < nlits; i++) {
+         const ident_t id = tree_ident(type_enum_literal(elem, i));
+         if (ident_char(id, 0) == '\'')
+            map[(uint8_t)ident_char(id, 1)] = emit_const(entry_vtype, i);
+      }
+
+      vcode_type_t map_vtype = vtype_carray(256, entry_vtype, entry_vtype);
+      vcode_reg_t map_array_reg = emit_const_array(map_vtype, map, 256);
+      vcode_reg_t map_reg = emit_address_of(map_array_reg);
+
+      vcode_reg_t data_reg = lower_array_data(preg);
+
+      vcode_reg_t null_reg = emit_cmp(VCODE_CMP_EQ, count_reg, zero_reg);
+      emit_cond(null_reg, exit_bb, body_bb);
+
+      vcode_select_block(body_bb);
+
+      vcode_reg_t i_reg = emit_load(i_var);
+      vcode_reg_t pos_reg = emit_load(pos_var);
+      vcode_reg_t sptr_reg = emit_array_ref(data_reg, pos_reg);
+      vcode_reg_t dptr_reg = emit_array_ref(mem_reg, i_reg);
+      vcode_reg_t char_reg = emit_load_indirect(sptr_reg);
+      vcode_reg_t cast_reg = emit_cast(voffset, ctype, char_reg);
+      vcode_reg_t mptr_reg = emit_array_ref(map_reg, cast_reg);
+      vcode_reg_t entry_reg = emit_load_indirect(mptr_reg);
+
+      vcode_reg_t bad_reg = emit_cmp(VCODE_CMP_EQ, entry_reg, def_reg);
+      emit_cond(bad_reg, bad_bb, good_bb);
+
+      vcode_select_block(good_bb);
+
+      vcode_reg_t good_reg = emit_cast(velem, velem, entry_reg);
+      emit_store_indirect(good_reg, dptr_reg);
+
+      vcode_reg_t next_pos_reg = emit_add(pos_reg, one_reg);
+      emit_store(next_pos_reg, pos_var);
+
+      vcode_reg_t next_i_reg = emit_add(i_reg, one_reg);
+      emit_store(next_i_reg, i_var);
+
+      vcode_reg_t done_reg = emit_cmp(VCODE_CMP_EQ, next_i_reg, count_reg);
+      emit_cond(done_reg, exit_bb, body_bb);
+
+      vcode_select_block(bad_bb);
+
+      vcode_reg_t bad_char_args[] = { text_util_reg, preg, char_reg };
+      emit_fcall(bad_char_fn, VCODE_INVALID_TYPE, VCODE_INVALID_TYPE,
+                 VCODE_CC_VHDL, bad_char_args, ARRAY_LEN(bad_char_args));
+
+      emit_unreachable(locus);
+
+      vcode_select_block(exit_bb);
+
+      vcode_dim_t dims[] = {
+         { .left  = emit_const(vtype_offset(), 1),
+           .right = count_reg,
+           .dir   = emit_const(vtype_bool(), RANGE_TO)
+         }
+      };
+
+      vcode_reg_t wrap_reg = emit_wrap(mem_reg, dims, 1);
+      emit_return(wrap_reg);
+
+      vcode_select_block(paren_bb);
+
+      lower_release_temp(lu, pos_var);
+   }
+
+   vcode_block_t body_bb = emit_block();
+   vcode_block_t exit_bb = emit_block();
+
    vcode_reg_t count_args[] = { text_util_reg, preg };
    vcode_reg_t count_result_reg = emit_fcall(count_delim_fn, vnat, vnat,
                                              VCODE_CC_VHDL, count_args, 2);
    vcode_reg_t count_reg = emit_cast(voffset, voffset, count_result_reg);
 
-   type_t elem = type_base_recur(lower_elem_recur(type));
-   vcode_type_t velem = lower_type(elem);
-   vcode_type_t vbounds = lower_bounds(elem);
-
    vcode_reg_t mem_reg = emit_alloc(velem, vbounds, count_reg);
 
-   vcode_var_t i_var = lower_temp_var(lu, "i", voffset, voffset);
-   emit_store(zero_reg, i_var);
-
    vcode_reg_t open_args[] = { text_util_reg, preg };
    vcode_reg_t open_reg = emit_fcall(find_open_fn, vnat, vnat,
                                      VCODE_CC_VHDL, open_args, 2);

test/regress/gold/value4.txt

@@ -0,0 +1 @@
+0ms+0: Report Failure: invalid character 'X' in string "abX"

test/regress/testlist.txt

@@ -842,4 +842,5 @@ assert11        normal,2019
 assert12        normal
 image2          normal,2019
 value2          normal,2019
-bounds40        fail,2019,gold
+value3          fail,2019,gold
+value4          fail,2019,gold

test/regress/value2.vhd

@@ -16,6 +16,9 @@ architecture test of value2 is
     end record;
 
     type t_pair_pair is array (1 to 2) of t_pair;
+
+    type t_abc is ('a', 'b', 'c');
+    type t_abc_vec is array (natural range <>) of t_abc;
 begin
 
     process is
@@ -25,6 +28,8 @@ begin
         assert t_nested'value("((1, 2), true, 1.5, (5, 6))") = ((1, 2), true, 1.5, (5, 6));
         assert t_int_vec'value("(1,2,3)") = (1, 2, 3);
         assert t_pair_pair'value("((1,2), (3,  4))") = ((1,2), (3,4));
+        assert t_abc_vec'value("('a', 'b', 'c')") = "abc";
+        assert t_abc_vec'value("""abc""") = "abc";
         wait;
     end process;
 

test/regress/bounds40.vhd → test/regress/value3.vhd

@@ -1,7 +1,7 @@
-entity bounds40 is
+entity value3 is
 end entity;
 
-architecture test of bounds40 is
+architecture test of value3 is
     type t_pair is record
         x, y : integer;
     end record;

test/regress/value4.vhd

@@ -0,0 +1,15 @@
+entity value4 is
+end entity;
+
+architecture test of value4 is
+    type t_abc is ('a', 'b', 'c');
+    type t_abc_vec is array (natural range <>) of t_abc;
+begin
+
+    process is
+    begin
+        assert t_abc_vec'value("""abX""") = "abc";  -- Error
+        wait;
+    end process;
+
+end architecture;

www/features.html.in

@@ -190,7 +190,7 @@ table below.
     <td><a href="http://www.eda-twiki.org/cgi-bin/view.cgi/P1076/LCS2016_012">
         LCS2016-012</td>
     <td><code>'IMAGE</code> and <code>TO_STRING</code> for composite types</td>
-    <td class="feature-partial">master</td>
+    <td class="feature-done">master</td>
   </tr>
   <tr>
     <td><a href="http://www.eda-twiki.org/cgi-bin/view.cgi/P1076/LCS2016_014">