[PATCH] foo

Jose E. Marchesi jose.marchesi@oracle.com
Mon Jul 1 16:03:51 GMT 2024


---
 ChangeLog                               | 32 +++++++++
 libpoke/Makefile.am                     |  1 +
 libpoke/pkl-anal.c                      | 58 ++++++++++++++++
 libpoke/pkl-ast.c                       | 65 ++++++++++++++++++
 libpoke/pkl-ast.h                       | 43 ++++++++++++
 libpoke/pkl-pass.c                      |  6 ++
 libpoke/pkl-tab.y                       | 25 ++++++-
 libpoke/pkl-type-attrs.def              | 30 ++++++++
 libpoke/pkl-typify.c                    | 91 ++++++++++++++++++++++++-
 testsuite/poke.pkl/type-attrs-diag-1.pk |  6 ++
 testsuite/poke.pkl/type-attrs-diag-2.pk |  6 ++
 testsuite/poke.pkl/type-attrs-diag-3.pk |  8 +++
 12 files changed, 367 insertions(+), 4 deletions(-)
 create mode 100644 libpoke/pkl-type-attrs.def
 create mode 100644 testsuite/poke.pkl/type-attrs-diag-1.pk
 create mode 100644 testsuite/poke.pkl/type-attrs-diag-2.pk
 create mode 100644 testsuite/poke.pkl/type-attrs-diag-3.pk

diff --git a/ChangeLog b/ChangeLog
index a7f61d4e..d0242ae9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,35 @@
+2024-06-29  Jose E. Marchesi  <jemarch@gnu.org>
+
+	* libpoke/pkl-type-attrs.def: New file.
+	* libpoke/Makefile.am (libpoke_la_SOURCES): Add pkl-type-attrs.def.
+	pkl-type-attrs.def.
+	* libpoke/pkl-ast.h (struct pkl_ast_type_attr): New type.
+	(PKL_AST_TYPE_ATTR_NAME): Define.
+	(PKL_AST_TYPE_ATTR_VALUE): Likewise.
+	(union pkl_ast_node): New field sct_type_attr.
+	(PKL_AST_TYPE_S_ATTRS): Define.
+	(enum pkl_ast_type_attr_code): New enumeration.
+	(PKL_AST_TYPE_ATTR_CODE): Define.
+	* libpoke/pkl-ast.c (pkl_ast_make_struct_type): Process type
+	attributes.
+	(pkl_ast_format_1): Likewise.
+	(pkl_ast_make_type_attr): New function.
+	(pkl_ast_node_free_1): Handle struct type attributes.
+	(pkl_ast_search_type_attribute): New function.
+	(pkl_ast_type_attribute_type): Likewise.
+	* libpoke/pkl-pass.c (pkl_do_pass_1): Traverse type attributes.
+	* libpoke/pkl-tab.y (type_attr): New rule.
+	(type_attr_list): Likewise.
+	(struct_type_specifier): Add a list of struct type attributes.
+	* libpoke/pkl-anal.c (pkl_anal1_ps_type_struct_attr): New handler.
+	(pkl_anal2_ps_type_struct_attr): Likewise.
+	* libpoke/pkl-typify.c (pkl_typify1_ps_type_attr):
+	Likewise.
+	* testsuite/poke.pkl/type-attrs-diag-1.pk: New test.
+	* testsuite/poke.pkl/type-attrs-diag-2.pk: Likewise.
+	* testsuite/poke.pkl/type-attrs-diag-3.pk: Likewise.
+	* testsuite/poke.pkl/type-attrs-diag-4.pk: Likewise.
+
 2024-06-30  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
 	* testsuite/poke.pkl/break-while-7.pk: New test.
diff --git a/libpoke/Makefile.am b/libpoke/Makefile.am
index 9e2fd329..039168fb 100644
--- a/libpoke/Makefile.am
+++ b/libpoke/Makefile.am
@@ -50,6 +50,7 @@ libpoke_la_SOURCES = libpoke.h libpoke.c \
                      pkl-gen.pks pkl-asm.pks pkl-gen-attrs.pks \
                      pkl-gen.pkc pkl-asm.pkc pkl-gen-attrs.pkc \
                      pkl-insn.def pkl-ops.def pkl-attrs.def pkl-passes.def \
+                     pkl-type-attrs.def \
                      pvm.h pvm.c \
                      pvm-val.c pvm-val.h \
                      pvm-env.c \
diff --git a/libpoke/pkl-anal.c b/libpoke/pkl-anal.c
index d9a88773..593edd99 100644
--- a/libpoke/pkl-anal.c
+++ b/libpoke/pkl-anal.c
@@ -180,6 +180,36 @@ PKL_PHASE_BEGIN_HANDLER (pkl_anal1_ps_struct)
 }
 PKL_PHASE_END_HANDLER
 
+/* All struct type attributes shall have names.
+   Only a certain set of struct type attributes are recognized.
+   Annotate type attribute codes.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_anal1_ps_type_attr)
+{
+  pkl_ast_node attr = PKL_PASS_NODE;
+  pkl_ast_node name = PKL_AST_TYPE_ATTR_NAME (attr);
+  enum pkl_ast_type_attr_code code;
+
+  if (!name)
+    {
+      PKL_ICE (PKL_AST_LOC (attr),
+               "struct type attributes shall have a name");
+      PKL_PASS_ERROR;
+    }
+
+  code = pkl_ast_search_type_attr (PKL_AST_IDENTIFIER_POINTER (name));
+  if (code == PKL_AST_TYPE_ATTR_NONE)
+    {
+      PKL_ERROR (PKL_AST_LOC (name),
+                 "invalid type attribute '%s'",
+                 PKL_AST_IDENTIFIER_POINTER (name));
+      PKL_PASS_ERROR;
+    }
+
+  PKL_AST_TYPE_ATTR_CODE (attr) = code;
+}
+PKL_PHASE_END_HANDLER
+
 /* Type structs introduce a context.  */
 
 PKL_PHASE_BEGIN_HANDLER (pkl_anal1_pr_type_struct)
@@ -747,6 +777,7 @@ struct pkl_phase pkl_phase_anal1 =
     PKL_PHASE_PS_HANDLER (PKL_AST_VAR, pkl_anal1_ps_var),
     PKL_PHASE_PS_HANDLER (PKL_AST_ASS_STMT, pkl_anal1_ps_ass_stmt),
     PKL_PHASE_PS_HANDLER (PKL_AST_CONS, pkl_anal1_ps_cons),
+    PKL_PHASE_PS_HANDLER (PKL_AST_TYPE_ATTR, pkl_anal1_ps_type_attr),
     PKL_PHASE_PR_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_anal1_pr_type_struct),
     PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_anal1_ps_type_struct),
     PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_FUNCTION, pkl_anal1_ps_type_function),
@@ -1103,6 +1134,32 @@ PKL_PHASE_BEGIN_HANDLER (pkl_anal2_ps_op_apush_apop)
 }
 PKL_PHASE_END_HANDLER
 
+/* Check that type attributes that shall be constant at compile time
+   are indeed given a constant value.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_anal2_ps_type_attr)
+{
+  pkl_ast_node attr = PKL_PASS_NODE;
+  enum pkl_ast_type_attr_code code = PKL_AST_TYPE_ATTR_CODE (attr);
+  pkl_ast_node value = PKL_AST_TYPE_ATTR_VALUE (attr);
+
+  switch (code)
+    {
+    case PKL_TYPE_ATTR_SIZE:
+      if (PKL_AST_CODE (value) != PKL_AST_OFFSET)
+        {
+          PKL_ERROR (PKL_AST_LOC (value),
+                     "the 'size' type attribute shall be constant");
+          PKL_PASS_ERROR;
+        }
+      break;
+    default:
+      PK_UNREACHABLE ();
+      break;
+    }
+}
+PKL_PHASE_END_HANDLER
+
 struct pkl_phase pkl_phase_anal2 =
   {
     .initialize = pkl_anal_initialize,
@@ -1122,6 +1179,7 @@ struct pkl_phase pkl_phase_anal2 =
     PKL_PHASE_PS_HANDLER (PKL_AST_ASM_EXP, pkl_anal2_ps_asm_exp),
     PKL_PHASE_PS_HANDLER (PKL_AST_STRUCT_REF, pkl_anal2_ps_struct_ref),
     PKL_PHASE_PS_HANDLER (PKL_AST_ASS_STMT, pkl_anal2_ps_ass_stmt),
+    PKL_PHASE_PS_HANDLER (PKL_AST_TYPE_ATTR, pkl_anal2_ps_type_attr),
     PKL_PHASE_PS_TYPE_HANDLER (PKL_TYPE_STRUCT, pkl_anal2_ps_type_struct),
     PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_APUSH, pkl_anal2_ps_op_apush_apop),
     PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_APOP, pkl_anal2_ps_op_apush_apop),
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index f016ba20..25b92e7e 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -487,6 +487,7 @@ pkl_ast_make_struct_type (pkl_ast ast,
                           size_t nfield,
                           size_t ndecl,
                           pkl_ast_node itype,
+                          pkl_ast_node attrs,
                           pkl_ast_node struct_type_elems,
                           int pinned_p, int union_p)
 {
@@ -502,6 +503,8 @@ pkl_ast_make_struct_type (pkl_ast ast,
     PKL_AST_TYPE_S_ELEMS (type) = ASTREF (struct_type_elems);
   if (itype)
     PKL_AST_TYPE_S_ITYPE (type) = ASTREF (itype);
+  if (attrs)
+    PKL_AST_TYPE_S_ATTRS (type) = ASTREF (attrs);
   PKL_AST_TYPE_S_PINNED_P (type) = pinned_p;
   PKL_AST_TYPE_S_UNION_P (type) = union_p;
 
@@ -519,6 +522,21 @@ pkl_ast_make_struct_type (pkl_ast ast,
   return type;
 }
 
+pkl_ast_node
+pkl_ast_make_type_attr (pkl_ast ast,
+                               pkl_ast_node name,
+                               pkl_ast_node value)
+{
+  pkl_ast_node type_attr = pkl_ast_make_node (ast,
+                                              PKL_AST_TYPE_ATTR);
+
+  PKL_AST_TYPE_ATTR_CODE (type_attr) = PKL_AST_TYPE_ATTR_NONE;
+  PKL_AST_TYPE_ATTR_NAME (type_attr) = ASTREF (name);
+  PKL_AST_TYPE_ATTR_VALUE (type_attr) = ASTREF (value);
+
+  return type_attr;
+}
+
 pkl_ast_node
 pkl_ast_make_struct_type_field (pkl_ast ast,
                                 pkl_ast_node name,
@@ -2557,6 +2575,12 @@ pkl_ast_node_free_1 (gl_set_t visitations, pkl_ast_node ast)
                   n = PKL_AST_CHAIN (t);
                   PKL_AST_NODE_FREE (t);
                 }
+
+              for (t = PKL_AST_TYPE_S_ATTRS (ast); t; t = n)
+                {
+                  n = PKL_AST_CHAIN (t);
+                  PKL_AST_NODE_FREE (t);
+                }
               break;
             case PKL_TYPE_FUNCTION:
               PKL_AST_NODE_FREE (PKL_AST_TYPE_F_RTYPE (ast));
@@ -2580,6 +2604,12 @@ pkl_ast_node_free_1 (gl_set_t visitations, pkl_ast_node ast)
         }
       break;
 
+    case PKL_AST_TYPE_ATTR:
+
+      PKL_AST_NODE_FREE (PKL_AST_TYPE_ATTR_NAME (ast));
+      PKL_AST_NODE_FREE (PKL_AST_TYPE_ATTR_VALUE (ast));
+      break;
+
     case PKL_AST_STRUCT_TYPE_FIELD:
 
       PKL_AST_NODE_FREE (PKL_AST_STRUCT_TYPE_FIELD_NAME (ast));
@@ -3214,6 +3244,31 @@ pkl_ast_handle_bconc_ass_stmt (pkl_ast ast, pkl_ast_node ass_stmt)
   return comp_stmt;
 }
 
+enum pkl_ast_type_attr_code
+pkl_ast_search_type_attr (const char *attr_name)
+{
+  struct type_attr_id_name
+    {
+      enum pkl_ast_type_attr_code code;
+      const char *name;
+    };
+
+#define PKL_DEF_TYPE_ATTR(ID,NAME) { ID, #NAME },
+  static const struct type_attr_id_name type_attr_names[] =
+    {
+#include "pkl-type-attrs.def"
+      { PKL_AST_TYPE_ATTR_NONE, NULL },
+    };
+#undef PKL_DEF_TYPE_ATTR
+  int i;
+
+  for (i = 0; type_attr_names[i].name != NULL; ++i)
+    if (STREQ (type_attr_names[i].name, attr_name))
+      return type_attr_names[i].code;
+
+  return  PKL_AST_TYPE_ATTR_NONE;
+}
+
 #ifdef PKL_DEBUG
 
 /* The following macros are commodities to be used to keep the
@@ -3376,6 +3431,14 @@ pkl_ast_format_1 (struct string_buffer *buffer,
       PRINT_AST_OPT_SUBAST (elseexp, COND_EXP_ELSEEXP);
       break;
 
+    case PKL_AST_TYPE_ATTR:
+      IPRINTF ("TYPE_ATTR::\n");
+
+      PRINT_COMMON_FIELDS;
+      PRINT_AST_SUBAST (name, TYPE_ATTR_NAME);
+      PRINT_AST_SUBAST (value, TYPE_ATTR_VALUE);
+      break;
+
     case PKL_AST_STRUCT_FIELD:
       IPRINTF ("STRUCT_FIELD::\n");
 
@@ -3477,6 +3540,8 @@ pkl_ast_format_1 (struct string_buffer *buffer,
               PRINT_AST_IMM (nfield, TYPE_S_NCFIELD, "%zu");
               PRINT_AST_IMM (ndecl, TYPE_S_NDECL, "%zu");
               PRINT_AST_SUBAST (itype, TYPE_S_ITYPE);
+              IPRINTF ("attributes:\n");
+              PRINT_AST_SUBAST_CHAIN (TYPE_S_ATTRS);
               IPRINTF ("elems:\n");
               PRINT_AST_SUBAST_CHAIN (TYPE_S_ELEMS);
               break;
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index ea39bf5c..84efc2bd 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -64,6 +64,7 @@ enum pkl_ast_code
   PKL_AST_LAST_EXP = PKL_AST_ASM_EXP,
   /* Types.  */
   PKL_AST_TYPE,
+  PKL_AST_TYPE_ATTR,
   PKL_AST_STRUCT_TYPE_FIELD,
   PKL_AST_FUNC_TYPE_ARG,
   PKL_AST_ENUM,
@@ -131,6 +132,19 @@ enum pkl_ast_attr
 };
 #undef PKL_DEF_ATTR
 
+/* Certain types can have attributes.  The following enumeration
+   defines the type attribute codes.
+
+   The definitions of the type attributes are in pkl-type-attrs.def.  */
+
+#define PKL_DEF_TYPE_ATTR(SYM,NAME) SYM,
+enum pkl_ast_type_attr_code
+{
+#include "pkl-type-attrs.def"
+  PKL_AST_TYPE_ATTR_NONE
+};
+#undef PKL_DEF_TYPE_ATTR
+
 /* Certain AST nodes can be characterized of featuring a byte
    endianness.  The following values are supported:
 
@@ -776,6 +790,31 @@ pkl_ast_node pkl_ast_make_struct_ref (pkl_ast ast,
                                       pkl_ast_node sct,
                                       pkl_ast_node identifier);
 
+/* PKL_AST_TYPE_ATTR nodes represent some particular attribute of a
+   type.
+
+   NAME is an IDENTIFIER that contains the name of the attribute.
+   VALUE is an expression with the value of the attribute.  */
+
+#define PKL_AST_TYPE_ATTR_CODE(AST) ((AST)->sct_type_attr.code)
+#define PKL_AST_TYPE_ATTR_NAME(AST) ((AST)->sct_type_attr.name)
+#define PKL_AST_TYPE_ATTR_VALUE(AST) ((AST)->sct_type_attr.value)
+
+struct pkl_ast_type_attr
+{
+  struct pkl_ast_common common;
+
+  enum pkl_ast_type_attr_code code;
+  union pkl_ast_node *name;
+  union pkl_ast_node *value;
+};
+
+pkl_ast_node pkl_ast_make_type_attr (pkl_ast ast,
+                                            pkl_ast_node name,
+                                            pkl_ast_node value);
+
+enum pkl_ast_type_attr_code pkl_ast_search_type_attr (const char *attr_name);
+
 /* PKL_AST_STRUCT_TYPE_FIELD nodes represent the field part of a
    struct type.
 
@@ -1002,6 +1041,7 @@ pkl_ast_node pkl_ast_make_func_type_arg (pkl_ast ast,
 #define PKL_AST_TYPE_S_DEINTEGRATOR(AST) (pkl_ast_type_resolv (AST)->type.val.sct.closures[5])
 #define PKL_AST_TYPE_S_TYPIFIER(AST) (pkl_ast_type_resolv (AST)->type.val.sct.closures[6])
 #define PKL_AST_TYPE_S_ITYPE(AST) (pkl_ast_type_resolv (AST)->type.val.sct.itype)
+#define PKL_AST_TYPE_S_ATTRS(AST) (pkl_ast_type_resolv (AST)->type.val.sct.attrs)
 #define PKL_AST_TYPE_O_UNIT(AST) (pkl_ast_type_resolv (AST)->type.val.off.unit)
 #define PKL_AST_TYPE_O_BASE_TYPE(AST) (pkl_ast_type_resolv (AST)->type.val.off.base_type)
 #define PKL_AST_TYPE_O_REF_TYPE(AST) (pkl_ast_type_resolv (AST)->type.val.off.ref_type)
@@ -1062,6 +1102,7 @@ struct pkl_ast_type
       size_t ndecl;
       union pkl_ast_node *elems;
       union pkl_ast_node *itype;
+      union pkl_ast_node *attrs;
       int pinned_p;
       int union_p;
       /* Uncollectable array for MAPPER, WRITER, CONSTRUCTOR,
@@ -1106,6 +1147,7 @@ pkl_ast_node pkl_ast_make_array_type (pkl_ast ast, pkl_ast_node etype,
 
 pkl_ast_node pkl_ast_make_struct_type (pkl_ast ast, size_t nelem, size_t nfield,
                                        size_t ndecl, pkl_ast_node itype,
+                                       pkl_ast_node attrs,
                                        pkl_ast_node elems,
                                        int pinned_p, int union_p);
 
@@ -2146,6 +2188,7 @@ union pkl_ast_node
   /* Types.  */
   struct pkl_ast_type type;
   struct pkl_ast_struct_type_field sct_type_elem;
+  struct pkl_ast_type_attr sct_type_attr;
   struct pkl_ast_func_type_arg fun_type_arg;
   struct pkl_ast_enum enumeration;
   struct pkl_ast_enumerator enumerator;
diff --git a/libpoke/pkl-pass.c b/libpoke/pkl-pass.c
index 6c008105..ae028841 100644
--- a/libpoke/pkl-pass.c
+++ b/libpoke/pkl-pass.c
@@ -440,6 +440,8 @@ pkl_do_pass_1 (pkl_compiler compiler,
 
             break;
           case PKL_TYPE_STRUCT:
+            if (PKL_AST_TYPE_S_ATTRS (node))
+              PKL_PASS_CHAIN (PKL_AST_TYPE_S_ATTRS (node));
             if (PKL_AST_TYPE_S_ELEMS (node))
               PKL_PASS_CHAIN (PKL_AST_TYPE_S_ELEMS (node));
             break;
@@ -467,6 +469,10 @@ pkl_do_pass_1 (pkl_compiler compiler,
           }
         break;
       }
+    case PKL_AST_TYPE_ATTR:
+      PKL_PASS (PKL_AST_TYPE_ATTR_NAME (node));
+      PKL_PASS (PKL_AST_TYPE_ATTR_VALUE (node));
+      break;
     case PKL_AST_STRUCT_TYPE_FIELD:
       if (PKL_AST_STRUCT_TYPE_FIELD_NAME (node))
         PKL_PASS (PKL_AST_STRUCT_TYPE_FIELD_NAME (node));
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index 3da4ed24..cb15bd6f 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -567,6 +567,7 @@ load_module (struct pkl_parser *parser,
 %type <ast> struct_type_field_label struct_type_computed_field
 %type <field_const_init> struct_type_field_constraint_and_init
 %type <ast> struct_type_field_optcond_pre struct_type_field_optcond_post
+%type <ast> type_attr type_attr_list
 %type <ast> declaration simple_declaration
 %type <ast> defvar defvar_list deftype deftype_list
 %type <ast> defunit defunit_list
@@ -1735,13 +1736,14 @@ function_type_arg:
 
 struct_type_specifier:
           pushlevel struct_type_pinned struct_or_union
-          integral_struct '{' '}'
+          integral_struct  type_attr_list '{' '}'
                   {
                     $$ = pkl_ast_make_struct_type (pkl_parser->ast,
                                                    0 /* nelem */,
                                                    0 /* nfield */,
                                                    0 /* ndecl */,
                                                    $4,
+                                                   $5,
                                                    NULL /* elems */,
                                                    $2, $3);
                     PKL_AST_LOC ($$) = @$;
@@ -1753,7 +1755,7 @@ struct_type_specifier:
                     pkl_parser->env = pkl_env_pop_frame (pkl_parser->env);
                 }
         | pushlevel struct_type_pinned struct_or_union
-          integral_struct '{'
+          integral_struct type_attr_list '{'
                 {
                   /* Register dummies for the locals used in
                      pkl-gen.pks:struct_mapper (not counting
@@ -1806,7 +1808,8 @@ struct_type_specifier:
                                                    0 /* nfield */,
                                                    0 /* ndecl */,
                                                    $4,
-                                                   $7,
+                                                   $5,
+                                                   $8,
                                                    $2, $3);
                     PKL_AST_LOC ($$) = @$;
 
@@ -2080,6 +2083,22 @@ struct_type_field_optcond_post:
                 }
         ;
 
+type_attr_list:
+          %empty { $$ = NULL; }
+        | type_attr_list type_attr
+                {
+                  $$ = pkl_ast_chainon ($1, $2);
+                }
+
+type_attr:
+         ':' IDENTIFIER expression
+         {
+           $$ = pkl_ast_make_type_attr (pkl_parser->ast, $2, $3);
+           PKL_AST_LOC ($2) = @2;
+           PKL_AST_LOC ($$) = @$;
+         }
+        ;
+
 /*
  * Declarations.
  */
diff --git a/libpoke/pkl-type-attrs.def b/libpoke/pkl-type-attrs.def
new file mode 100644
index 00000000..55f7e76e
--- /dev/null
+++ b/libpoke/pkl-type-attrs.def
@@ -0,0 +1,30 @@
+/* pkl-type-attrs.def - Struct type attributes for Poke.  */
+
+/* Copyright (C) 2024 Jose E. Marchesi */
+
+/* This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+/* The first column is an unique identifier for the attribute.
+
+   The second column is the name of the attribute.  It shall follow
+   the lexical rules of Poke identifiers.  */
+
+PKL_DEF_TYPE_ATTR(PKL_TYPE_ATTR_SIZE,size)
+
+/*
+Local variables:
+mode:c
+End:
+*/
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index f09cf105..0ab916eb 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -1300,6 +1300,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_struct)
                                    PKL_AST_STRUCT_NELEM (node), /* nfield */
                                    0, /* ndecl */
                                    NULL, /* itype */
+                                   NULL, /* attributes */
                                    struct_field_types,
                                    0 /* pinned */,
                                    0 /* union */);
@@ -3336,6 +3337,51 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_asm_stmt)
 }
 PKL_PHASE_END_HANDLER
 
+/* Type-check type attributes.  */
+
+PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_type_attr)
+{
+  pkl_ast_node attr = PKL_PASS_NODE;
+  pkl_ast_node name = PKL_AST_TYPE_ATTR_NAME (attr);
+  pkl_ast_node value = PKL_AST_TYPE_ATTR_VALUE (attr);
+
+  switch (PKL_AST_TYPE_ATTR_CODE (attr))
+    {
+    case PKL_TYPE_ATTR_SIZE:
+      {
+        /* This must be promoteable to offset<uint<64>,1>.  */
+        pkl_ast_node offset_type
+          = pkl_ast_make_offset_type (PKL_PASS_AST,
+                                      pkl_ast_make_integral_type (PKL_PASS_AST, 64, 0),
+                                      pkl_ast_make_integer (PKL_PASS_AST, 1),
+                                      NULL /* ref_type */);
+
+        if (!pkl_ast_type_promoteable_p (PKL_AST_TYPE (value),
+                                         offset_type,
+                                         0 /* promote_array_of_any */))
+          {
+            char *value_type_str = pkl_type_str (PKL_AST_TYPE (value), 1);
+
+            PKL_ERROR (PKL_AST_LOC (value),
+                       "expected offset, got %s", value_type_str);
+            free (value_type_str);
+            offset_type = ASTREF (offset_type); pkl_ast_node_free (offset_type);
+            PKL_PASS_ERROR;
+          }
+
+        offset_type = ASTREF (offset_type); pkl_ast_node_free (offset_type);
+        break;
+      }
+    default:
+      PKL_ICE (PKL_AST_LOC (name),
+               "don't know how to typify type attribute `%s'",
+               PKL_AST_IDENTIFIER_POINTER (name));
+      PKL_PASS_ERROR;
+      break;
+    }
+}
+PKL_PHASE_END_HANDLER
+
 /* The type of an asm expression is the type specified by the user in
    the expression.
 
@@ -3408,6 +3454,7 @@ struct pkl_phase pkl_phase_typify1 =
    PKL_PHASE_PS_HANDLER (PKL_AST_ASS_STMT, pkl_typify1_ps_ass_stmt),
    PKL_PHASE_PS_HANDLER (PKL_AST_ASM_EXP, pkl_typify1_ps_asm_exp),
    PKL_PHASE_PS_HANDLER (PKL_AST_ASM_STMT, pkl_typify1_ps_asm_stmt),
+   PKL_PHASE_PS_HANDLER (PKL_AST_TYPE_ATTR, pkl_typify1_ps_type_attr),
 
    PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_SIZEOF, pkl_typify1_ps_op_sizeof),
    PKL_PHASE_PS_OP_HANDLER (PKL_AST_OP_TYPEOF, pkl_typify1_ps_op_typeof),
@@ -3454,7 +3501,10 @@ struct pkl_phase pkl_phase_typify1 =
 
 
 /* Determine the completeness of a type node and whether the type is
-   fallible.  */
+   fallible.
+
+   If a type is complete and it is annotated by a `size' attribute
+   then it's size shall be the same.  */
 
 PKL_PHASE_BEGIN_HANDLER (pkl_typify2_ps_type)
 {
@@ -3462,6 +3512,45 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify2_ps_type)
 
   PKL_AST_TYPE_COMPLETE (type) = pkl_ast_type_is_complete (type);
   PKL_AST_TYPE_FALLIBLE (type) = pkl_ast_type_is_fallible (type);
+
+  if (PKL_AST_TYPE_COMPLETE (type) == PKL_AST_TYPE_COMPLETE_YES
+      && PKL_AST_TYPE_CODE (type) == PKL_TYPE_STRUCT)
+    {
+      pkl_ast_node attr;
+
+      for (attr = PKL_AST_TYPE_S_ATTRS (type);
+           attr;
+           attr = PKL_AST_CHAIN (attr))
+        {
+          if (PKL_AST_TYPE_ATTR_CODE (attr) == PKL_TYPE_ATTR_SIZE)
+            {
+              pkl_ast_node type_size = pkl_ast_sizeof_type (PKL_PASS_AST, type);
+              pkl_ast_node value = PKL_AST_TYPE_ATTR_VALUE (attr);
+              pkl_ast_node magnitude, unit;
+
+              assert (PKL_AST_CODE (value) == PKL_AST_OFFSET);
+              magnitude = PKL_AST_OFFSET_MAGNITUDE (value);
+              unit = PKL_AST_OFFSET_UNIT (value);
+              assert (PKL_AST_CODE (magnitude) == PKL_AST_INTEGER);
+              assert (PKL_AST_CODE (unit) == PKL_AST_INTEGER);
+              type_size = pkl_constant_fold (PKL_PASS_COMPILER,
+                                             PKL_PASS_AST,
+                                             type_size);
+              assert (PKL_AST_CODE (type_size) == PKL_AST_INTEGER);
+
+              if ((PKL_AST_INTEGER_VALUE (magnitude)* PKL_AST_INTEGER_VALUE (unit))
+                  != PKL_AST_INTEGER_VALUE (type_size))
+                {
+                  PKL_ERROR (PKL_AST_LOC (attr),
+                             "attributed size doesn't match actual size of type");
+                  type_size = ASTREF (type_size); pkl_ast_node_free (type_size);
+                  PKL_PASS_ERROR;
+                }
+
+              type_size = ASTREF (type_size); pkl_ast_node_free (type_size);
+            }
+        }
+    }
 }
 PKL_PHASE_END_HANDLER
 
diff --git a/testsuite/poke.pkl/type-attrs-diag-1.pk b/testsuite/poke.pkl/type-attrs-diag-1.pk
new file mode 100644
index 00000000..88224fdf
--- /dev/null
+++ b/testsuite/poke.pkl/type-attrs-diag-1.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Foo =
+  struct
+    :foo 10 /* { dg-error "invalid type attribute" } */
+  {};
diff --git a/testsuite/poke.pkl/type-attrs-diag-2.pk b/testsuite/poke.pkl/type-attrs-diag-2.pk
new file mode 100644
index 00000000..219146aa
--- /dev/null
+++ b/testsuite/poke.pkl/type-attrs-diag-2.pk
@@ -0,0 +1,6 @@
+/* { dg-do compile } */
+
+type Foo = struct
+:size
+   20 /* { dg-error "expected offset" } */
+   { };
diff --git a/testsuite/poke.pkl/type-attrs-diag-3.pk b/testsuite/poke.pkl/type-attrs-diag-3.pk
new file mode 100644
index 00000000..4d55f54e
--- /dev/null
+++ b/testsuite/poke.pkl/type-attrs-diag-3.pk
@@ -0,0 +1,8 @@
+/* { dg-do compile } */
+
+var o = 10#B;
+
+type Foo = struct
+:size
+   o + 20#B /* { dg-error "shall be constant" } */
+   { };
-- 
2.30.2



More information about the Test-list mailing list