Merge branch 'prf_size' into 'develop'

Make _size_A_ available to the programmer.

See merge request sac-group/sac2c!334

src/libsac2c/scanparse/prf.def

@@ -120,6 +120,7 @@ KEYWORD_PRF (SEL_VxA, "_sel_VxA_", F_sel_VxA)
 KEYWORD_PRF (IDX_SEL, "_idx_sel_", F_idx_sel)
 KEYWORD_PRF (SEL_VxIA, "_sel_VxIA_", F_sel_VxIA)
 KEYWORD_PRF (SHAPE_A, "_shape_A_", F_shape_A)
+KEYWORD_PRF (SIZE_A, "_size_A_", F_size_A)
 KEYWORD_PRF (SUB_SxS, "_sub_SxS_", F_sub_SxS)
 KEYWORD_PRF (SUB_SxV, "_sub_SxV_", F_sub_SxV)
 KEYWORD_PRF (SUB_VxS, "_sub_VxS_", F_sub_VxS)

src/libsac2c/tree/prf_info.mac

@@ -776,7 +776,7 @@ PRF (tobool_S, (PA_S, PA_x, PA_x), 1, TOBOOL, NTCCTprf_tobool_S, COtobool, COMPp
    * Low-level backend representations
    */
 
-  PRF (size_A, (PA_A, PA_x, PA_x), 1, XXX, NTCCTprf_dummy, NULL, COMPprfSize, NULL, NULL,
+  PRF (size_A, (PA_A, PA_x, PA_x), 1, XXX, NTCCTprf_size_A, NULL, COMPprfSize, NULL, NULL,
        NULL, NULL, NULL, NULL, 0, NULL, NULL, TEone, NULL, NULL),
 
   /*******************************************************************************

src/libsac2c/typecheck/ct_prf.c

@@ -1663,6 +1663,56 @@ NTCCTprf_shape_A (te_info *info, ntype *args)
     DBUG_RETURN (TYmakeProductType (1, res));
 }
 
+/******************************************************************************
+ *
+ * function:
+ *    ntype *NTCCTprf_size_A( te_info *info, ntype *args)
+ *
+ * description:
+ *
+ ******************************************************************************/
+
+ntype *
+NTCCTprf_size_A (te_info *info, ntype *args)
+{
+    ntype *arg;
+    ntype *res = NULL;
+    char *err_msg;
+    int size;
+
+    DBUG_ENTER ();
+    DBUG_ASSERT (TYgetProductSize (args) == 1,
+                 "size called with incorrect number of arguments");
+
+    arg = TYgetProductMember (args, 0);
+
+    err_msg = TEfetchErrors ();
+    if (err_msg != NULL) {
+        res = TYmakeBottomType (err_msg);
+    } else {
+        switch (TYgetConstr (arg)) {
+        case TC_akv:
+            /* fallthrough */
+        case TC_aks:
+            size = SHgetUnrLen (TYgetShape (arg));
+            res  = TYmakeAKV (TYmakeSimpleType (T_int),
+                              COmakeConstantFromInt (size));
+            break;
+        case TC_akd:
+            /* fallthrough */
+        case TC_audgz:
+            /* fallthrough */
+        case TC_aud:
+            res = TYmakeAKS (TYmakeSimpleType (T_int), SHmakeShape (0));
+            break;
+        default:
+            DBUG_UNREACHABLE ("NTCCTprf_size_A applied to non-array type");
+        }
+    }
+
+    DBUG_RETURN (TYmakeProductType (1, res));
+}
+
 /******************************************************************************
  *
  * function:

src/libsac2c/typecheck/ct_prf.h

@@ -30,6 +30,7 @@ extern ntype *NTCCTprf_prod_shape (te_info *info, ntype *args);
 extern ntype *NTCCTprf_nested_shape (te_info *info, ntype *args);
 extern ntype *NTCCTprf_saabind (te_info *info, ntype *args);
 extern ntype *NTCCTprf_dim_A (te_info *info, ntype *args);
+extern ntype *NTCCTprf_size_A (te_info *info, ntype *args);
 extern ntype *NTCCTprf_isDist_A (te_info *info, ntype *args);
 extern ntype *NTCCTprf_firstElems_A (te_info *info, ntype *args);
 extern ntype *NTCCTprf_localFrom_A (te_info *info, ntype *args);