poke-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[COMMITTED] pkl: support for array constructors


From: Jose E. Marchesi
Subject: [COMMITTED] pkl: support for array constructors
Date: Tue, 17 Nov 2020 22:26:46 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

There were three different ways to create array values in Poke:

1) From an array literal, like `[1,2,3,.[10]=666]'
2) From a mapping, like `int[3] @ 0#B'
3) From the construction of a struct with array fields, like in
   `Packet { } -> Packet { magic = [0UB,0UB], ... }'

However, there was no syntax to construct array values out of the
context of structs, and the array literals are limited, since it is
not possible to express a literal iwth a variable number of elements.

So this patch adds support for array constructors, that use this
syntax:

  ARRAY_TYPE ([INIT_VALUE])

Where ARRAY_TYPE is an array type, or the name of an array type, and
INIT_VALUE is an optional argument that specify the value in the
elements of the array.  If the initial value is not specified, then
default values are used.

Examples:

int[]()               -> []
int[2]()              -> [0,0]
int[2](10)            -> [10,10]
string[3]()           -> ["","",""]
int[][3](int[2](666)) -> [[666,666],[666,666],[666,666]]
Packet[3]()           -> [Packet {...}, Packet {...}, Packet {...}]
---
 ChangeLog                          | 49 +++++++++++++++++++++
 doc/poke.texi                      | 43 ++++++++++++++++++
 etc/poke.rec                       | 32 --------------
 libpoke/pkl-asm.c                  | 15 +++++++
 libpoke/pkl-asm.pks                | 35 +++++++++++++++
 libpoke/pkl-ast.c                  | 30 +++++++++++++
 libpoke/pkl-ast.h                  | 24 ++++++++++
 libpoke/pkl-gen.c                  | 62 ++++++++++++++++++++++++++
 libpoke/pkl-insn.def               |  1 +
 libpoke/pkl-pass.c                 |  6 +++
 libpoke/pkl-promo.c                | 63 ++++++++++++++++++++++++++
 libpoke/pkl-tab.y                  | 71 ++++++++++++++++++++++++++++++
 libpoke/pkl-typify.c               | 50 +++++++++++++++++++++
 testsuite/Makefile.am              | 20 +++++++++
 testsuite/poke.pkl/acons-1.pk      |  4 ++
 testsuite/poke.pkl/acons-10.pk     | 13 ++++++
 testsuite/poke.pkl/acons-11.pk     |  4 ++
 testsuite/poke.pkl/acons-12.pk     |  4 ++
 testsuite/poke.pkl/acons-2.pk      |  4 ++
 testsuite/poke.pkl/acons-3.pk      |  6 +++
 testsuite/poke.pkl/acons-4.pk      |  4 ++
 testsuite/poke.pkl/acons-5.pk      |  6 +++
 testsuite/poke.pkl/acons-6.pk      |  4 ++
 testsuite/poke.pkl/acons-7.pk      |  4 ++
 testsuite/poke.pkl/acons-8.pk      |  4 ++
 testsuite/poke.pkl/acons-9.pk      |  4 ++
 testsuite/poke.pkl/acons-diag-1.pk |  4 ++
 testsuite/poke.pkl/acons-diag-2.pk |  4 ++
 testsuite/poke.pkl/acons-diag-3.pk |  4 ++
 testsuite/poke.pkl/acons-diag-4.pk |  4 ++
 testsuite/poke.pkl/acons-diag-5.pk |  6 +++
 testsuite/poke.pkl/acons-diag-6.pk |  6 +++
 testsuite/poke.pkl/acons-diag-7.pk |  6 +++
 testsuite/poke.pkl/acons-diag-8.pk |  6 +++
 34 files changed, 570 insertions(+), 32 deletions(-)
 create mode 100644 testsuite/poke.pkl/acons-1.pk
 create mode 100644 testsuite/poke.pkl/acons-10.pk
 create mode 100644 testsuite/poke.pkl/acons-11.pk
 create mode 100644 testsuite/poke.pkl/acons-12.pk
 create mode 100644 testsuite/poke.pkl/acons-2.pk
 create mode 100644 testsuite/poke.pkl/acons-3.pk
 create mode 100644 testsuite/poke.pkl/acons-4.pk
 create mode 100644 testsuite/poke.pkl/acons-5.pk
 create mode 100644 testsuite/poke.pkl/acons-6.pk
 create mode 100644 testsuite/poke.pkl/acons-7.pk
 create mode 100644 testsuite/poke.pkl/acons-8.pk
 create mode 100644 testsuite/poke.pkl/acons-9.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-1.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-2.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-3.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-4.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-5.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-6.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-7.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-8.pk

diff --git a/ChangeLog b/ChangeLog
index 9af0ac2d..cfa9aee0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,52 @@
+2020-11-17  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-tab.y (expression): Add rules for array
+       constructors.
+       (resolve_typename): New function.
+       * libpoke/pkl-ast.h (enum pkl_ast_code): New entry PKL_AST_ACONS.
+       (PKL_AST_ACONS_TYPE): Define.
+       (PKL_AST_ACONS_VALUE): Define.
+       (struct pkl_ast_acons): New struct.
+       (union pkl_ast_node): New field acons.
+       * libpoke/pkl-ast.c (pkl_ast_make_acons): New function.
+       (pkl_ast_node_free): Handle array constructors.
+       (pkl_ast_print_1): Likewise.
+       * libpoke/pkl-pass.c (pkl_do_pass_1): Likewise.
+       * libpoke/pkl-typify.c (pkl_typify1_ps_acons): New handler.
+       (pkl_phase_typify1): Register handler.
+       * libpoke/pkl-promo.c (pkl_promo_ps_acons): New handler.
+       (pkl_phase_promo): Install handler.
+       * libpoke/pkl-gen.c (pkl_gen_ps_acons): New handler.
+       (pkl_phase_gen): Install handler.
+       * libpoke/pkl-insn.def: Define macro-instruction PKL_INSN_AFILL.
+       * libpoke/pkl-asm.c (pkl_asm_insn_afill): Define.
+       (pkl_asm_insn): Dispatch PKL_INSN_AFILL.
+       * libpoke/pkl-asm.pks (afill): New macro.
+       * testsuite/poke.pkl/acons-diag-1.pk: New test.
+       * testsuite/poke.pkl/acons-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-3.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-4.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-5.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-6.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-7.pk: Likewise.
+       * testsuite/poke.pkl/acons-diag-8.pk: Likewise.
+       * testsuite/poke.pkl/acons-1.pk: Likewise.
+       * testsuite/poke.pkl/acons-2.pk: Likewise.
+       * testsuite/poke.pkl/acons-3.pk: Likewise.
+       * testsuite/poke.pkl/acons-4.pk: Likewise.
+       * testsuite/poke.pkl/acons-5.pk: Likewise.
+       * testsuite/poke.pkl/acons-6.pk: Likewise.
+       * testsuite/poke.pkl/acons-7.pk: Likewise.
+       * testsuite/poke.pkl/acons-8.pk: Likewise.
+       * testsuite/poke.pkl/acons-9.pk: Likewise.
+       * testsuite/poke.pkl/acons-10.pk: Likewise.
+       * testsuite/poke.pkl/acons-11.pk: Likewise.
+       * testsuite/poke.pkl/acons-12.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+       * doc/poke.texi (Array Constructors): New section.
+       * etc/poke.rec (Provide syntax for array constructors): Remove as
+       done.
+
 2020-11-17  Jose E. Marchesi  <jemarch@gnu.org>
 
        * etc/poke.rec (Document "default values" in the poke manual): New
diff --git a/doc/poke.texi b/doc/poke.texi
index f9b67547..851a6f11 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -6276,6 +6276,7 @@ Arrays are homogeneous collections of values.
 @menu
 * Array Literals::             Writing array values.
 * Array Types::                        Bounded and unbounded arrays.
+* Array Constructors::         Constructing array values.
 * Array Comparison::           Comparing array values.
 * Array Indexing::             Accessing values stored in arrays.
 * Array Trimming::             Working with array pieces.
@@ -6475,6 +6476,48 @@ allows data structures to adjust to the particular data 
they contain,
 so usual in binary formats.  This is an important feature, that gives
 Poke part of its feel and magic.
 
+@node Array Constructors
+@subsection Array Constructors
+@cindex constructing, arrays
+
+Array literals can only specify arrays which a constant number of
+elements.  They also require initial values for their elements, and it
+is also not possible to construct an array literal denoting an empty
+array of some given type.
+
+Array constructors provide a suitable way to build such array values.
+The syntax is:
+
+@example
+@var{array_type} ([@var{value}])
+@end example
+
+@noindent
+Where @var{array_type} is an array type, or the name of an array type,
+and @var{value} is an optional argument that specify the value to
+which the elements of the new array are initialized.  If no value is
+provided in the constructor then default values are calculated (XXX:
+xref to default values.)
+
+Examples:
+
+@example
+(poke) int[]()
+[]
+(poke) int[2]()
+[0,0]
+(poke) int[2](10)
+[10,10]
+(poke) offset<int,#B>[2](16#b)
+[2#B,2#B]
+(poke) string[3]()
+["","",""]
+(poke) int[][3](int[2](666))
+[[666,666],[666,666],[666,666]]
+(poke) Packet[3]()
+[Packet @{...@}, Packet @{...@}, Packet @{...@}]
+@end example
+
 @node Array Comparison
 @subsection Array Comparison
 @cindex comparing, arrays
diff --git a/etc/poke.rec b/etc/poke.rec
index bb43c1d4..4174a755 100644
--- a/etc/poke.rec
+++ b/etc/poke.rec
@@ -511,38 +511,6 @@ Description:
 +
 + Also for optional fields.
 
-Summary: Provide syntax for array constructors
-Component: Language
-Kind: ENH
-Priority: 4
-Description:
-+ Currently there are three different ways to create array values in
-+ Poke:
-+
-+ 1) From an array literal, like [1,2,3,.[10]=666]
-+ 2) From a mapping, like int[3] @ 0#B
-+ 3) From an array constructor, like in:
-+
-+    type Packet = struct { byte[2] magic; ... };
-+    Packet { } -> Packet { magic = [0UB,0UB], ... }
-+
-+ However, there is no syntax to achieve 3) out of the context of
-+ constructing a struct, and 1) is limited, since it is not possible to
-+ express a literal with a variable number of elements.
-+
-+ Therefore we need to add a syntax for 3), something like:
-+
-+  TYPE ([INIT_VALUE])
-+
-+ Examples:
-+
-+  int[2]() -> [0,0]
-+  int[2](10) -> [10,10]
-+
-+ To discuss in the mailing list.
-RFC: yes
-Target: 1.0
-
 Summary: Support a pipe IOS
 Component: Language
 Kind: ENH
diff --git a/libpoke/pkl-asm.c b/libpoke/pkl-asm.c
index e4033777..abffb56b 100644
--- a/libpoke/pkl-asm.c
+++ b/libpoke/pkl-asm.c
@@ -923,6 +923,18 @@ pkl_asm_insn_aconc (pkl_asm pasm)
   RAS_MACRO_ACONC;
 }
 
+/* Macro-instruction: AFILL
+   ( ARR VAL -- ARR VAL )
+
+   Given an array and a value of the right type, set all the
+   elements of the array to the given value.  */
+
+static void
+pkl_asm_insn_afill (pkl_asm pasm)
+{
+  RAS_MACRO_AFILL;
+}
+
 /* Macro-instruction: ATRIM array_type
    ( ARR ULONG ULONG -- ARR ULONG ULONG ARR )
 
@@ -1533,6 +1545,9 @@ pkl_asm_insn (pkl_asm pasm, enum pkl_asm_insn insn, ...)
         case PKL_INSN_ACONC:
           pkl_asm_insn_aconc (pasm);
           break;
+        case PKL_INSN_AFILL:
+          pkl_asm_insn_afill (pasm);
+          break;
         case PKL_INSN_SSETI:
           {
             pkl_ast_node struct_type;
diff --git a/libpoke/pkl-asm.pks b/libpoke/pkl-asm.pks
index 6767d301..1f217b83 100644
--- a/libpoke/pkl-asm.pks
+++ b/libpoke/pkl-asm.pks
@@ -379,6 +379,41 @@
         ;; is on the stack.
         .end
 
+;;; AFILL
+;;; ( ARR VAL -- ARR VAL )
+;;;
+;;; Given ana array and a a value of the right type, set all the
+;;; elements of the array to the given value.
+;;;
+;;; This is the implementation of the `afill' macro instruction.
+
+        .macro afill
+        swap                    ; VAL ARR
+        sel                     ; VAL ARR SEL
+     .while
+        push ulong<64>0         ; VAL ARR IDX 0UL
+        eqlu
+        nip                     ; VAL ARR IDX (IDX==0UL)
+        not
+        nip                     ; VAL ARR IDX !(IDX==0UL)
+     .loop
+        push ulong<64>1         ; VAL ARR IDX 1UL
+        sublu
+        nip2                    ; VAL ARR (IDX-1UL)
+        tor
+        atr                     ; VAL ARR (IDX-1UL) [(IDX-1UL)]
+        rot                     ; ARR (IDX-1UL) VAL [(IDX-1UL)]
+        tor
+        atr                     ; ARR (IDX-1UL) VAL [(IDX-1UL) VAL]
+        aset                    ; ARR [(IDX-1UL) VAL]
+        fromr
+        fromr                   ; ARR VAL (IDX-1UL)
+        quake                   ; VAL ARR (IDX-1UL)
+     .endloop
+        drop                    ; VAL ARR
+        swap                    ; ARR VAL
+        .end
+
 ;;; ACONC array_type
 ;;; ( ARR ARR -- ARR ARR ARR )
 ;;;
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index b64c5503..b32f8e28 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -1475,6 +1475,21 @@ pkl_ast_make_map (pkl_ast ast,
   return map;
 }
 
+/* Build and return an AST node for an array constructor.  */
+
+pkl_ast_node
+pkl_ast_make_acons (pkl_ast ast,
+                    pkl_ast_node type, pkl_ast_node value)
+{
+  pkl_ast_node acons = pkl_ast_make_node (ast, PKL_AST_ACONS);
+
+  assert (type);
+
+  PKL_AST_ACONS_TYPE (acons) = ASTREF (type);
+  PKL_AST_ACONS_VALUE (acons) = ASTREF (value);
+  return acons;
+}
+
 /* Build and return an AST node for a struct constructor.  */
 
 pkl_ast_node
@@ -2066,6 +2081,12 @@ pkl_ast_node_free (pkl_ast_node ast)
       pkl_ast_node_free (PKL_AST_MAP_OFFSET (ast));
       break;
 
+    case PKL_AST_ACONS:
+
+      pkl_ast_node_free (PKL_AST_ACONS_TYPE (ast));
+      pkl_ast_node_free (PKL_AST_ACONS_VALUE (ast));
+      break;
+
     case PKL_AST_SCONS:
 
       pkl_ast_node_free (PKL_AST_SCONS_TYPE (ast));
@@ -2848,6 +2869,15 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
       PRINT_AST_SUBAST (offset, MAP_OFFSET);
       break;
 
+    case PKL_AST_ACONS:
+      IPRINTF ("ACONS::\n");
+
+      PRINT_COMMON_FIELDS;
+      PRINT_AST_SUBAST (type, TYPE);
+      PRINT_AST_SUBAST (acons_type, ACONS_TYPE);
+      PRINT_AST_SUBAST (acons_value, ACONS_VALUE);
+      break;
+
     case PKL_AST_SCONS:
       IPRINTF ("SCONS::\n");
 
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index cdc734c0..9d0173ee 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -51,6 +51,7 @@ enum pkl_ast_code
   PKL_AST_CAST,
   PKL_AST_ISA,
   PKL_AST_MAP,
+  PKL_AST_ACONS,
   PKL_AST_SCONS,
   PKL_AST_FUNCALL,
   PKL_AST_FUNCALL_ARG,
@@ -1170,6 +1171,28 @@ pkl_ast_node pkl_ast_make_map (pkl_ast ast,
                                pkl_ast_node ios,
                                pkl_ast_node offset);
 
+/* PKL_AST_SCONS nodes represent array constructors.
+
+   TYPE is an array type.
+
+   IELEM is either NULL or a value to use to initialize the array
+   contents.  */
+
+#define PKL_AST_ACONS_TYPE(AST) ((AST)->acons.type)
+#define PKL_AST_ACONS_VALUE(AST) ((AST)->acons.value)
+
+struct pkl_ast_acons
+{
+  struct pkl_ast_common common;
+
+  union pkl_ast_node *type;
+  union pkl_ast_node *value;
+};
+
+pkl_ast_node pkl_ast_make_acons (pkl_ast ast,
+                                 pkl_ast_node type,
+                                 pkl_ast_node value);
+
 /* PKL_AST_SCONS nodes represent struct constructors.
 
    TYPE is a struct type.
@@ -1749,6 +1772,7 @@ union pkl_ast_node
   struct pkl_ast_cast cast;
   struct pkl_ast_isa isa;
   struct pkl_ast_map map;
+  struct pkl_ast_acons acons;
   struct pkl_ast_scons scons;
   struct pkl_ast_funcall funcall;
   struct pkl_ast_funcall_arg funcall_arg;
diff --git a/libpoke/pkl-gen.c b/libpoke/pkl-gen.c
index 0c8cd069..ac24ce96 100644
--- a/libpoke/pkl-gen.c
+++ b/libpoke/pkl-gen.c
@@ -1769,6 +1769,67 @@ PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_cast)
 }
 PKL_PHASE_END_HANDLER
 
+/*
+ * | [ACONS_VALUE]
+ * ACONS
+ */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_gen_ps_acons)
+{
+  pkl_ast_node acons = PKL_PASS_NODE;
+  pkl_ast_node acons_type = PKL_AST_ACONS_TYPE (acons);
+
+  /* Build an array with default values.  Note how array constructors
+     do not use their argument.  */
+  pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH, PVM_NULL);
+  PKL_GEN_PAYLOAD->in_constructor = 1;
+  PKL_PASS_SUBPASS (acons_type);
+  PKL_GEN_PAYLOAD->in_constructor = 0;
+
+  /* If an initial value has been provided, set the elements of the
+     array to this value.  */
+  if (PKL_AST_ACONS_VALUE (acons))
+    {
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SWAP);  /* ARR IVAL */
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_AFILL); /* ARR IVAL */
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP);  /* ARR */
+#if 0
+                                                /* IVAL ARR */
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SEL); /* IVAL ARR SEL */
+      pkl_asm_while (PKL_GEN_ASM);
+      {
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+                      pvm_make_ulong (0, 64)); /* IVAL ARR IDX 0UL */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_EQLU); /* IVAL ARR IDX (IDX==0UL) 
*/
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NOT);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP); /* IVAL ARR IDX !(IDX==0UL) 
*/
+      }
+      pkl_asm_while_loop (PKL_GEN_ASM);
+      {
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_PUSH,
+                      pvm_make_ulong (1, 64));    /* IVAL ARR IDX 1UL */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_SUBLU);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP2); /* IVAL ARR (IDX-1UL) */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ATR);  /* IVAL ARR (IDX-1UL) 
[(IDX-1UL)] */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ROT);  /* ARR (IDX-1UL) IVAL 
[(IDX-1UL)] */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_TOR);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ATR);  /* ARR (IDX-1UL) IVAL 
[(IDX-1UL) IVAL] */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_ASET); /* ARR [(IDX-1UL) IVAL] */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR);
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_FROMR); /* ARR IVAL (IDX-1UL) */
+        pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_QUAKE); /* IVAL ARR (IDX-1UL) */
+      }
+      pkl_asm_while_endloop (PKL_GEN_ASM);
+
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_DROP); /* IVAL ARR */
+      pkl_asm_insn (PKL_GEN_ASM, PKL_INSN_NIP);  /* ARR */
+#endif
+    }
+}
+PKL_PHASE_END_HANDLER
+
 /*
  * | SCONS_VALUE
  * SCONS
@@ -3527,6 +3588,7 @@ struct pkl_phase pkl_phase_gen
    PKL_PHASE_PS_HANDLER (PKL_AST_CAST, pkl_gen_ps_cast),
    PKL_PHASE_PS_HANDLER (PKL_AST_ISA, pkl_gen_ps_isa),
    PKL_PHASE_PR_HANDLER (PKL_AST_MAP, pkl_gen_pr_map),
+   PKL_PHASE_PS_HANDLER (PKL_AST_ACONS, pkl_gen_ps_acons),
    PKL_PHASE_PS_HANDLER (PKL_AST_SCONS, pkl_gen_ps_scons),
    PKL_PHASE_PR_HANDLER (PKL_AST_ARRAY, pkl_gen_pr_array),
    PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY, pkl_gen_ps_array),
diff --git a/libpoke/pkl-insn.def b/libpoke/pkl-insn.def
index 0736aa21..1ff34e01 100644
--- a/libpoke/pkl-insn.def
+++ b/libpoke/pkl-insn.def
@@ -472,6 +472,7 @@ PKL_DEF_INSN(PKL_INSN_GCD, "a", "gcd")
 PKL_DEF_INSN(PKL_INSN_ATRIM, "a", "atrim")
 PKL_DEF_INSN(PKL_INSN_AIS, "", "ais")
 PKL_DEF_INSN(PKL_INSN_ACONC, "", "aconc")
+PKL_DEF_INSN(PKL_INSN_AFILL, "", "afill")
 
 /* Struct macro-instructions.  */
 
diff --git a/libpoke/pkl-pass.c b/libpoke/pkl-pass.c
index d5c1c0f7..97a1d7b8 100644
--- a/libpoke/pkl-pass.c
+++ b/libpoke/pkl-pass.c
@@ -421,6 +421,12 @@ pkl_do_pass_1 (pkl_compiler compiler,
       PKL_PASS (PKL_AST_MAP_OFFSET (node));
       PKL_PASS (PKL_AST_MAP_TYPE (node));
 
+      break;
+    case PKL_AST_ACONS:
+      PKL_PASS (PKL_AST_ACONS_TYPE (node));
+      if (PKL_AST_ACONS_VALUE (node))
+        PKL_PASS (PKL_AST_ACONS_VALUE (node));
+
       break;
     case PKL_AST_SCONS:
       PKL_PASS (PKL_AST_SCONS_TYPE (node));
diff --git a/libpoke/pkl-promo.c b/libpoke/pkl-promo.c
index dd21be79..23e25aa9 100644
--- a/libpoke/pkl-promo.c
+++ b/libpoke/pkl-promo.c
@@ -1690,6 +1690,68 @@ PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_op_in)
 }
 PKL_PHASE_END_HANDLER
 
+/* The argument to an array constructor may need promotion.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_promo_ps_acons)
+{
+  pkl_ast_node acons = PKL_PASS_NODE;
+  pkl_ast_node acons_type = PKL_AST_ACONS_TYPE (acons);
+  pkl_ast_node acons_elem_type = PKL_AST_TYPE_A_ETYPE (acons_type);
+  pkl_ast_node acons_value = PKL_AST_ACONS_VALUE (acons);
+  pkl_ast_node acons_value_type;
+  int restart = 0;
+
+  if (!acons_value)
+    PKL_PASS_DONE;
+
+  acons_value_type = PKL_AST_TYPE (acons_value);
+
+  if (!pkl_ast_type_equal_p (acons_elem_type, acons_value_type))
+    {
+      switch (PKL_AST_TYPE_CODE (acons_elem_type))
+        {
+        case PKL_TYPE_INTEGRAL:
+          if (!promote_integral (PKL_PASS_AST,
+                                 PKL_AST_TYPE_I_SIZE (acons_elem_type),
+                                 PKL_AST_TYPE_I_SIGNED_P (acons_elem_type),
+                                 &PKL_AST_ACONS_VALUE (acons),
+                                 &restart))
+            goto error;
+
+
+          PKL_PASS_RESTART = 1;
+          break;
+        case PKL_TYPE_OFFSET:
+          {
+            pkl_ast_node base_type = PKL_AST_TYPE_O_BASE_TYPE 
(acons_elem_type);
+            pkl_ast_node unit = PKL_AST_TYPE_O_UNIT (acons_elem_type);
+
+            size_t size = PKL_AST_TYPE_I_SIZE (base_type);
+            int signed_p = PKL_AST_TYPE_I_SIGNED_P (base_type);
+
+            if (!promote_offset (PKL_PASS_AST,
+                                 size, signed_p, unit,
+                                 &PKL_AST_ACONS_VALUE (acons),
+                                 &restart))
+              goto error;
+
+            PKL_PASS_RESTART = 1;
+          }
+          break;
+        default:
+          assert (0);
+        }
+    }
+
+  PKL_PASS_DONE;
+
+ error:
+  PKL_ICE (PKL_AST_LOC (acons_value),
+           "couldn't promote argument to array constructor");
+  PKL_PASS_ERROR;
+}
+PKL_PHASE_END_HANDLER
+
 /* The fields in struct constructors may have to be promoted to their
    corresponding types.  */
 
@@ -1833,6 +1895,7 @@ struct pkl_phase pkl_phase_promo
    PKL_PHASE_PS_HANDLER (PKL_AST_LOOP_STMT, pkl_promo_ps_loop_stmt),
    PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_TYPE_FIELD, 
pkl_promo_ps_struct_type_field),
    PKL_PHASE_PS_HANDLER (PKL_AST_COND_EXP, pkl_promo_ps_cond_exp),
+   PKL_PHASE_PS_HANDLER (PKL_AST_ACONS, pkl_promo_ps_acons),
    PKL_PHASE_PS_HANDLER (PKL_AST_SCONS, pkl_promo_ps_scons),
    PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_ARRAY, pkl_promo_ps_type_array),
    PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_OFFSET, pkl_promo_ps_type_offset),
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index 910d8a37..177f84c6 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -254,6 +254,30 @@ load_module (struct pkl_parser *parser,
   return 0;
 }
 
+/* Given an AST identifier, lookup for a type with that name in the
+   current lexical environment and return it.  If not such type is
+   found, return NULL.  */
+
+static pkl_ast_node
+resolve_typename (struct pkl_parser *pkl_parser, pkl_ast_node typename)
+{
+  pkl_ast_node decl, type;
+
+  decl = pkl_env_lookup (pkl_parser->env,
+                         PKL_ENV_NS_MAIN,
+                         PKL_AST_IDENTIFIER_POINTER (typename),
+                         NULL, NULL);
+
+  if (decl == NULL
+      || PKL_AST_DECL_KIND (decl) != PKL_AST_DECL_KIND_TYPE)
+    return NULL;
+
+  type = PKL_AST_DECL_INITIAL (decl);
+  assert (type != NULL);
+
+  return type;
+}
+
 %}
 
 %union {
@@ -773,6 +797,53 @@ expression:
                                               $1, $3, $5);
                   PKL_AST_LOC ($$) = @$;
                 }
+        | array_type_specifier '(' ')'
+                {
+                  $$ = pkl_ast_make_acons (pkl_parser->ast, $1, NULL);
+                }
+        | array_type_specifier '(' expression ')'
+                {
+                  $$ = pkl_ast_make_acons (pkl_parser->ast, $1, $3);
+                  PKL_AST_LOC ($$) = @$;
+                }
+        | TYPENAME '(' ')'
+                {
+                  pkl_ast_node type = resolve_typename (pkl_parser, $1);
+
+                  assert (type);
+                  PKL_AST_LOC (type) = @1;
+                  /* XXX not sure this is actually needed: the type
+                     should be already named.  */
+                  if (PKL_AST_TYPE_NAME (type) == NULL)
+                    PKL_AST_TYPE_NAME (type) = ASTREF ($1);
+                  else
+                    {
+                      $1 = ASTREF ($1);
+                      pkl_ast_node_free ($1);
+                    }
+
+                  $$ = pkl_ast_make_acons (pkl_parser->ast, type, NULL);
+                  PKL_AST_LOC ($$) = @$;
+                }
+        | TYPENAME '(' expression ')'
+                {
+                  pkl_ast_node type = resolve_typename (pkl_parser, $1);
+
+                  assert (type);
+                  PKL_AST_LOC (type) = @1;
+                  /* XXX not sure this is actually needed: the type
+                     should be already named.  */
+                 if (PKL_AST_TYPE_NAME (type) == NULL)
+                   PKL_AST_TYPE_NAME (type) = ASTREF ($1);
+                 else
+                   {
+                     $1 = ASTREF ($1);
+                     pkl_ast_node_free ($1);
+                   }
+
+                  $$ = pkl_ast_make_acons (pkl_parser->ast, type, $3);
+                  PKL_AST_LOC ($$) = @$;
+                }
         | TYPENAME '{' struct_field_list opt_comma '}'
                   {
                   pkl_ast_node type;
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 40850f2a..a950548b 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -1902,6 +1902,55 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_map)
 }
 PKL_PHASE_END_HANDLER
 
+/* The type of an array constructor is the type specified in the
+   constructor.  It should be an array type.  Also, if an
+   initialization value is provided its type should match the type of
+   the elements of the array.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_acons)
+{
+  pkl_ast_node acons = PKL_PASS_NODE;
+  pkl_ast_node acons_type = PKL_AST_ACONS_TYPE (acons);
+  pkl_ast_node initval = PKL_AST_ACONS_VALUE (acons);
+
+  if (PKL_AST_TYPE_CODE (acons_type) != PKL_TYPE_ARRAY)
+    {
+      PKL_ERROR (PKL_AST_LOC (acons_type),
+                 "expected array type in constructor");
+      PKL_TYPIFY_PAYLOAD->errors++;
+      PKL_PASS_ERROR;
+    }
+
+  if (initval)
+    {
+      pkl_ast_node initval_type = PKL_AST_TYPE (initval);
+      pkl_ast_node acons_type_elems_type
+        = PKL_AST_TYPE_A_ETYPE (acons_type);
+
+      if (!pkl_ast_type_promoteable_p (initval_type,
+                                       acons_type_elems_type,
+                                       0 /* promote array of any */))
+        {
+          char *expected_type
+            = pkl_type_str (acons_type_elems_type, 1);
+          char *found_type = pkl_type_str (initval_type, 1);
+
+          PKL_ERROR (PKL_AST_LOC (initval),
+                     "wrong initial value for array\n"
+                     "expected %s, got %s",
+                     expected_type, found_type);
+          free (expected_type);
+          free (found_type);
+
+          PKL_TYPIFY_PAYLOAD->errors++;
+          PKL_PASS_ERROR;
+        }
+    }
+
+  PKL_AST_TYPE (acons) = ASTREF (acons_type);
+}
+PKL_PHASE_END_HANDLER
+
 /* The type of a struct constructor is the type specified before the
    struct value.  It should be a struct type.  Also, there are several
    rules the struct must conform to.  */
@@ -2771,6 +2820,7 @@ struct pkl_phase pkl_phase_typify1
    PKL_PHASE_PS_HANDLER (PKL_AST_CAST, pkl_typify1_ps_cast),
    PKL_PHASE_PS_HANDLER (PKL_AST_ISA, pkl_typify1_ps_isa),
    PKL_PHASE_PS_HANDLER (PKL_AST_MAP, pkl_typify1_ps_map),
+   PKL_PHASE_PS_HANDLER (PKL_AST_ACONS, pkl_typify1_ps_acons),
    PKL_PHASE_PS_HANDLER (PKL_AST_SCONS, pkl_typify1_ps_scons),
    PKL_PHASE_PS_HANDLER (PKL_AST_OFFSET, pkl_typify1_ps_offset),
    PKL_PHASE_PS_HANDLER (PKL_AST_ARRAY, pkl_typify1_ps_array),
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 64ed8a51..c60e2246 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -449,6 +449,26 @@ EXTRA_DIST = \
   poke.map/trimmed-map-4.pk \
   poke.map/unmap-1.pk \
   poke.pkl/pkl.exp \
+  poke.pkl/acons-diag-1.pk \
+  poke.pkl/acons-diag-2.pk \
+  poke.pkl/acons-diag-3.pk \
+  poke.pkl/acons-diag-4.pk \
+  poke.pkl/acons-diag-5.pk \
+  poke.pkl/acons-diag-6.pk \
+  poke.pkl/acons-diag-7.pk \
+  poke.pkl/acons-diag-8.pk \
+  poke.pkl/acons-1.pk \
+  poke.pkl/acons-2.pk \
+  poke.pkl/acons-3.pk \
+  poke.pkl/acons-4.pk \
+  poke.pkl/acons-5.pk \
+  poke.pkl/acons-6.pk \
+  poke.pkl/acons-7.pk \
+  poke.pkl/acons-8.pk \
+  poke.pkl/acons-9.pk \
+  poke.pkl/acons-10.pk \
+  poke.pkl/acons-11.pk \
+  poke.pkl/acons-12.pk \
   poke.pkl/add-arrays-1.pk \
   poke.pkl/add-arrays-2.pk \
   poke.pkl/add-arrays-3.pk \
diff --git a/testsuite/poke.pkl/acons-1.pk b/testsuite/poke.pkl/acons-1.pk
new file mode 100644
index 00000000..291d45e8
--- /dev/null
+++ b/testsuite/poke.pkl/acons-1.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int<32>[]()} } */
+/* { dg-output "\\\[\\\]" } */
diff --git a/testsuite/poke.pkl/acons-10.pk b/testsuite/poke.pkl/acons-10.pk
new file mode 100644
index 00000000..ed0ebe92
--- /dev/null
+++ b/testsuite/poke.pkl/acons-10.pk
@@ -0,0 +1,13 @@
+/* { dg-do run } */
+
+var N = 0;
+type Fun = ()int;
+
+/* { dg-command {var a = Fun[3] (lambda int: { N = N + 1; return N; })} } */
+/* { dg-command {a} } */
+/* { dg-output "\\\[#<closure>,#<closure>,#<closure>\\\]" } */
+/* { dg-command {a[1]()} } */
+/* { dg-output "\n1" } */
+/* { dg-command {N = 5} } */
+/* { dg-command {a[2]()} } */
+/* { dg-output "\n6" } */
diff --git a/testsuite/poke.pkl/acons-11.pk b/testsuite/poke.pkl/acons-11.pk
new file mode 100644
index 00000000..e85fa667
--- /dev/null
+++ b/testsuite/poke.pkl/acons-11.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int[2](666UL)} } */
+/* { dg-output "\\\[666,666\\\]" } */
diff --git a/testsuite/poke.pkl/acons-12.pk b/testsuite/poke.pkl/acons-12.pk
new file mode 100644
index 00000000..911a3567
--- /dev/null
+++ b/testsuite/poke.pkl/acons-12.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {offset<uint<64>,B>[2](16#b)} } */
+/* { dg-output "\\\[2UL#B,2UL#B\\\]" } */
diff --git a/testsuite/poke.pkl/acons-2.pk b/testsuite/poke.pkl/acons-2.pk
new file mode 100644
index 00000000..a22d8d85
--- /dev/null
+++ b/testsuite/poke.pkl/acons-2.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int<32>[1 + 2]()} } */
+/* { dg-output "\\\[0,0,0\\\]" } */
diff --git a/testsuite/poke.pkl/acons-3.pk b/testsuite/poke.pkl/acons-3.pk
new file mode 100644
index 00000000..f3cf3f73
--- /dev/null
+++ b/testsuite/poke.pkl/acons-3.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+type Packet = struct { string s; byte b; };
+
+/* { dg-command {Packet[1][1] ()} } */
+/* { dg-output "\\\[\\\[Packet {s=\"\",b=0UB}\\\]\\\]" } */
diff --git a/testsuite/poke.pkl/acons-4.pk b/testsuite/poke.pkl/acons-4.pk
new file mode 100644
index 00000000..f5b3d787
--- /dev/null
+++ b/testsuite/poke.pkl/acons-4.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {byte[3#B]()} } */
+/* { dg-output "\\\[0UB,0UB,0UB\\\]" } */
diff --git a/testsuite/poke.pkl/acons-5.pk b/testsuite/poke.pkl/acons-5.pk
new file mode 100644
index 00000000..590a0428
--- /dev/null
+++ b/testsuite/poke.pkl/acons-5.pk
@@ -0,0 +1,6 @@
+/* { dg-do run } */
+
+var N = 3;
+
+/* { dg-command {int[N]()} } */
+/* { dg-output "\\\[0,0,0\\\]" } */
diff --git a/testsuite/poke.pkl/acons-6.pk b/testsuite/poke.pkl/acons-6.pk
new file mode 100644
index 00000000..0458e239
--- /dev/null
+++ b/testsuite/poke.pkl/acons-6.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int[3](665 + 1)} } */
+/* { dg-output "\\\[666,666,666\\\]" } */
diff --git a/testsuite/poke.pkl/acons-7.pk b/testsuite/poke.pkl/acons-7.pk
new file mode 100644
index 00000000..9dca0c59
--- /dev/null
+++ b/testsuite/poke.pkl/acons-7.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {string[2]("foo")} } */
+/* { dg-output "\\\[\"foo\",\"foo\"\\\]" } */
diff --git a/testsuite/poke.pkl/acons-8.pk b/testsuite/poke.pkl/acons-8.pk
new file mode 100644
index 00000000..0a45f6eb
--- /dev/null
+++ b/testsuite/poke.pkl/acons-8.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int[][3](int[2]())} } */
+/* { dg-output "\\\[\\\[0,0\\\],\\\[0,0\\\],\\\[0,0\\\]\\\]" } */
diff --git a/testsuite/poke.pkl/acons-9.pk b/testsuite/poke.pkl/acons-9.pk
new file mode 100644
index 00000000..b19abe22
--- /dev/null
+++ b/testsuite/poke.pkl/acons-9.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command {int[][3](int[2](666))} } */
+/* { dg-output "\\\[\\\[666,666\\\],\\\[666,666\\\],\\\[666,666\\\]\\\]" } */
diff --git a/testsuite/poke.pkl/acons-diag-1.pk 
b/testsuite/poke.pkl/acons-diag-1.pk
new file mode 100644
index 00000000..7e4e1326
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-1.pk
@@ -0,0 +1,4 @@
+/* { dg-do compile } */
+
+var a
+  = int[] ("foo"); /* { dg-error ".*\n.*" } */
diff --git a/testsuite/poke.pkl/acons-diag-2.pk 
b/testsuite/poke.pkl/acons-diag-2.pk
new file mode 100644
index 00000000..15c3165c
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-2.pk
@@ -0,0 +1,4 @@
+/* { dg-do compile } */
+
+var a
+  = string[] (1 + 2); /* { dg-error ".*\n.*" } */
diff --git a/testsuite/poke.pkl/acons-diag-3.pk 
b/testsuite/poke.pkl/acons-diag-3.pk
new file mode 100644
index 00000000..36b0c31d
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-3.pk
@@ -0,0 +1,4 @@
+/* { dg-do compile } */
+
+var a
+  = int<32> (1 + 2); /* { dg-error "syntax error" } */
diff --git a/testsuite/poke.pkl/acons-diag-4.pk 
b/testsuite/poke.pkl/acons-diag-4.pk
new file mode 100644
index 00000000..b140f40a
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-4.pk
@@ -0,0 +1,4 @@
+/* { dg-do compile } */
+
+var a
+  = int[][] ([[1,2,3]]); /* { dg-error ".*\n.*" } */
diff --git a/testsuite/poke.pkl/acons-diag-5.pk 
b/testsuite/poke.pkl/acons-diag-5.pk
new file mode 100644
index 00000000..6b49ae4b
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-5.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Array = int[];
+
+var a
+  = Array ("foo"); /* { dg-error ".*\n.*" } */
diff --git a/testsuite/poke.pkl/acons-diag-6.pk 
b/testsuite/poke.pkl/acons-diag-6.pk
new file mode 100644
index 00000000..78dc512e
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-6.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Array = struct {};
+
+var a
+  = Array (); /* { dg-error "expected array type" } */
diff --git a/testsuite/poke.pkl/acons-diag-7.pk 
b/testsuite/poke.pkl/acons-diag-7.pk
new file mode 100644
index 00000000..4eb7da0c
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-7.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Array = struct {};
+
+var a
+  = Array (23); /* { dg-error "expected array type" } */
diff --git a/testsuite/poke.pkl/acons-diag-8.pk 
b/testsuite/poke.pkl/acons-diag-8.pk
new file mode 100644
index 00000000..2b7fbb49
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-8.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Array = struct {};
+
+var a
+  = Array (23,3); /* { dg-error "syntax error" } */
-- 
2.25.0.2.g232378479e




reply via email to

[Prev in Thread] Current Thread [Next in Thread]