Dynamic constraint checking. Hooray.

src/libsac2c/codegen/compile.c

@@ -4791,30 +4791,209 @@ COMPprfRunMtFold (node *arg_node, info *arg_info)
     DBUG_RETURN (ret_node);
 }
 
-#if 0
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfGuard( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+static node *
+COMPprfGuard (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+
+    DBUG_ENTER ("COMPprfGuard");
+
+    ret_node = TCmakeAssignIcm1 ("ND_PRF_GUARD",
+                                 DupExpr_NT_AddReadIcms (PRF_ARG1 (arg_node)), NULL);
+
+    DBUG_RETURN (ret_node);
+}
 
 /** <!--********************************************************************-->
  *
- * @fn  node *COMPprfAccu( node *arg_node, info *arg_info)
+ * @fn node *COMPprfTypeConstraint( node *arg_node, info *arg_info)
  *
- * @brief  Compiles N_prf node of type F_accu into Noop.
- *   The return value is a N_assign chain of ICMs.
- *   Note, that the old 'arg_node' is removed by COMPLet.
+ *****************************************************************************/
+node *
+COMPprfTypeConstraint (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+    ntype *arg_type;
+
+    DBUG_ENTER ("COMPprfTypeConstraint");
+
+    let_ids = INFO_LASTIDS (arg_info);
+    arg_type = TYPE_TYPE (PRF_ARG1 (arg_node));
+
+    if (TYisAKV (arg_type)) {
+        DBUG_ASSERT (FALSE, "Type constraint with AKV type not implemented");
+    } else if (TYisAKS (arg_type)) {
+        ret_node = SHshape2Array (TYgetShape (arg_type));
+        ret_node
+          = TCmakeAssignIcm4 ("ND_PRF_TYPE_CONSTRAINT_AKS", DUPdupIdsIdNt (let_ids),
+                              DUPdupIdNt (PRF_ARG2 (arg_node)),
+                              MakeSizeArg (ret_node, TRUE), ARRAY_AELEMS (ret_node),
+                              NULL);
+    } else if (TYisAKD (arg_type)) {
+        ret_node
+          = TCmakeAssignIcm3 ("ND_PRF_TYPE_CONSTRAINT_AKD", DUPdupIdsIdNt (let_ids),
+                              DUPdupIdNt (PRF_ARG2 (arg_node)),
+                              TBmakeNum (TYgetDim (arg_type)), NULL);
+    } else if (TYisAUDGZ (arg_type)) {
+        ret_node
+          = TCmakeAssignIcm2 ("ND_PRF_TYPE_CONSTRAINT_AUDGZ", DUPdupIdsIdNt (let_ids),
+                              DUPdupIdNt (PRF_ARG2 (arg_node)), NULL);
+
+    } else {
+        /* TYisAUD is always true */
+        ret_node = TCmakeAssignIcm2 ("ND_CREATE__SCALAR", DUPdupIdsIdNt (let_ids),
+                                     TBmakeBool (TRUE), NULL);
+    }
+
+    DBUG_RETURN (ret_node);
+}
+
+/** <!--********************************************************************-->
  *
- * Remarks:
+ * @fn node *COMPprfSameShape( node *arg_node, info *arg_info)
  *
- ******************************************************************************/
+ *****************************************************************************/
+node *
+COMPprfSameShape (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+
+    DBUG_ENTER ("COMPprfSameShape");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node
+      = TCmakeAssignIcm5 ("ND_PRF_SAME_SHAPE", DUPdupIdsIdNt (let_ids),
+                          DUPdupIdNt (PRF_ARG1 (arg_node)),
+                          TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG1 (arg_node)))),
+                          DUPdupIdNt (PRF_ARG2 (arg_node)),
+                          TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))),
+                          NULL);
+
+    DBUG_RETURN (ret_node);
+}
 
-static
-node *COMPprfAccu( node *arg_node, info *arg_info, char *icm_name)
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfShapeMatchesDim( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+node *
+COMPprfShapeMatchesDim (node *arg_node, info *arg_info)
 {
-  DBUG_ENTER( "COMPprfAccu");
-  
-  ret_node = TCmakeAssignIcm0( "NOOP", NULL);
+    node *ret_node;
+    node *let_ids;
 
-  DBUG_RETURN( ret_node);
+    DBUG_ENTER ("COMPprfShapeMatchesDim");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node = TCmakeAssignIcm3 ("ND_PRF_SHAPE_MATCHES_DIM", DUPdupIdsIdNt (let_ids),
+                                 DUPdupIdNt (PRF_ARG1 (arg_node)),
+                                 DUPdupIdNt (PRF_ARG2 (arg_node)), NULL);
+
+    DBUG_RETURN (ret_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfNonNegVal( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+node *
+COMPprfNonNegVal (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+
+    DBUG_ENTER ("COMPprfNonNegVal");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node = TCmakeAssignIcm2 ("ND_PRF_NON_NEG_VAL", DUPdupIdsIdNt (let_ids),
+                                 DUPdupIdNt (PRF_ARG1 (arg_node)), NULL);
+
+    DBUG_RETURN (ret_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfValLtShape( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+node *
+COMPprfValLtShape (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+
+    DBUG_ENTER ("COMPprfValLtShape");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node
+      = TCmakeAssignIcm4 ("ND_PRF_VAL_LT_SHAPE", DUPdupIdsIdNt (let_ids),
+                          DUPdupIdNt (PRF_ARG1 (arg_node)),
+                          DUPdupIdNt (PRF_ARG2 (arg_node)),
+                          TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))),
+                          NULL);
+
+    DBUG_RETURN (ret_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfValLeVal( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+node *
+COMPprfValLeVal (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+
+    DBUG_ENTER ("COMPprfValLeVal");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node = TCmakeAssignIcm3 ("ND_PRF_VAL_LT_VAL", DUPdupIdsIdNt (let_ids),
+                                 DUPdupIdNt (PRF_ARG1 (arg_node)),
+                                 DUPdupIdNt (PRF_ARG2 (arg_node)), NULL);
+
+    DBUG_RETURN (ret_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *COMPprfProdMatchesShape( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+node *
+COMPprfProdMatchesProdShape (node *arg_node, info *arg_info)
+{
+    node *ret_node;
+    node *let_ids;
+
+    DBUG_ENTER ("COMPprfProdMatchesProdShape");
+
+    let_ids = INFO_LASTIDS (arg_info);
+
+    ret_node
+      = TCmakeAssignIcm4 ("ND_PRF_PROD_MATCHES_PROD_SHAPE", DUPdupIdsIdNt (let_ids),
+                          DUPdupIdNt (PRF_ARG1 (arg_node)),
+                          DUPdupIdNt (PRF_ARG2 (arg_node)),
+                          TBmakeNum (TCgetShapeDim (ID_TYPE (PRF_ARG2 (arg_node)))),
+                          NULL);
+
+    DBUG_RETURN (ret_node);
 }
-#endif
 
 /******************************************************************************
  *

src/libsac2c/codegen/icm.data

@@ -493,6 +493,43 @@ ICM_END( ND_PRF_CAT_VxV__SHAPE, (to_NT, to_sdim,
                                    from1_NT, from1_sdim, from2_NT, from2_sdim))
 #endif
 
+#if defined(ND_PRF_TYPE_CONSTRAINT_AKS) || defined(ICM_ALL)
+ICM_DEF( ND_PRF_TYPE_CONSTRAINT_AKS, ICM_TRACE_NONE)
+  ICM_NT( to_NT)
+  ICM_NT( from_NT)
+  ICM_INT( dim)
+  ICM_VARINT( dim, shp)  
+ICM_END( ND_PRF_TYPE_CONSTRAINT_AKS, (to_NT, from_NT, dim, shp))
+#endif
+
+#if defined(ND_PRF_SAME_SHAPE) || defined(ICM_ALL)
+ICM_DEF( ND_PRF_SAME_SHAPE, ICM_TRACE_NONE)
+  ICM_NT( to_NT)
+  ICM_NT( from_NT)
+  ICM_INT( from_sdim)
+  ICM_NT( from2_NT)
+  ICM_INT( from2_sdim)
+ICM_END( ND_PRF_SAME_SHAPE, (to_NT, from_NT, from_sdim, from2_NT, from2_sdim))
+#endif
+
+#if defined(ND_PRF_VAL_LT_SHAPE) || defined(ICM_ALL)
+ICM_DEF( ND_PRF_VAL_LT_SHAPE, ICM_TRACE_NONE)
+  ICM_NT( to_NT)
+  ICM_NT( from_NT)
+  ICM_NT( from2_NT)
+  ICM_INT( from2_sdim)
+ICM_END( ND_PRF_VAL_LT_SHAPE, (to_NT, from_NT, from2_NT, from2_sdim))
+#endif
+
+#if defined(ND_PRF_PROD_MATCHES_PROD_SHAPE) || defined(ICM_ALL)
+ICM_DEF( ND_PRF_PROD_MATCHES_PROD_SHAPE, ICM_TRACE_NONE)
+  ICM_NT( to_NT)
+  ICM_NT( from_NT)
+  ICM_NT( from2_NT)
+  ICM_INT( from2_sdim)
+ICM_END( ND_PRF_PROD_MATCHES_PROD_SHAPE, (to_NT, from_NT, from2_NT, from2_sdim))
+#endif
+
 
 #if defined(ND_VECT2OFFSET_arr) || defined(ICM_ALL)
 ICM_DEF( ND_VECT2OFFSET_arr, ICM_TRACE(prf))

src/libsac2c/codegen/icm2c_prf.c

@@ -1612,3 +1612,217 @@ ICMCompileND_PRF_PROP_OBJ_OUT (int vararg_cnt, char **vararg)
 
     DBUG_VOID_RETURN;
 }
+
+/** <!--********************************************************************-->
+ *
+ * @fn void ICMCompileND_PRF_TYPE_CONSTRAINT_AKS
+ *
+ *****************************************************************************/
+void
+ICMCompileND_PRF_TYPE_CONSTRAINT_AKS (char *to_NT, char *from_NT, int dim, int *shp)
+{
+    int i;
+
+    DBUG_ENTER ("ICMCompileND_PRF_TYPE_CONSTRAINT_AKS");
+
+    COND1 (
+      fprintf (global.outfile, "(SAC_ND_A_DIM(%s) != %d)", from_NT, dim);
+      for (i = 0; i < dim; i++) {
+          fprintf (global.outfile, "|| (SAC_ND_A_SHAPE(%s,%d) != %d)", from_NT, i,
+                   shp[i]);
+      },
+      fprintf (global.outfile, "SAC_RuntimeError(\"Array does not adhere "
+                               "to type constraint\");\n"););
+
+    INDENT;
+    fprintf (global.outfile, "SAC_ND_A_FIELD( %s) = 1;\n", to_NT);
+
+    DBUG_VOID_RETURN;
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn void ICMCompileND_PRF_SAME_SHAPE
+ *
+ *****************************************************************************/
+void
+ICMCompileND_PRF_SAME_SHAPE (char *to_NT, char *from_NT, int from_sdim, char *from2_NT,
+                             int from2_sdim)
+{
+    int i;
+    int dim = ARRAY_OR_SCALAR;
+
+    DBUG_ENTER ("ICMCompileND_PRF_SAME_SHAPE");
+
+    if (KNOWN_DIMENSION (from_sdim)) {
+        dim = DIM_NO_OFFSET (from_sdim);
+    } else if (KNOWN_DIMENSION (from2_sdim)) {
+        dim = DIM_NO_OFFSET (from2_sdim);
+    }
+
+    if (dim != ARRAY_OR_SCALAR) {
+        /*
+         * At least one array has a known number of axes:
+         * access shape vectors using compile-time constants, thereby
+         * potentially accessing mirrors
+         */
+        COND1 (
+          fprintf (global.outfile, "(SAC_ND_A_DIM(%s) != SAC_ND_A_DIM(%s))", from_NT,
+                   from2_NT);
+          for (i = 0; i < dim; i++) {
+              fprintf (global.outfile,
+                       "|| (SAC_ND_A_SHAPE(%s,%d) != SAC_ND_A_SHAPE(%s,%d))", from_NT, i,
+                       from2_NT, i);
+          },
+          fprintf (global.outfile, "SAC_RuntimeError(\"Arrays do not adhere "
+                                   "to same shape constraint\");\n"););
+    } else {
+        /*
+         * Both arrays are AUD:
+         * Compare descriptor contents using a run-time for-loop
+         */
+        COND1 (fprintf (global.outfile, "SAC_ND_A_DIM(%s) != SAC_ND_A_DIM(%s)", from_NT,
+                        from2_NT);
+               , fprintf (global.outfile, "SAC_RuntimeError(\"Arrays do not adhere "
+                                          "to same shape constraint\");\n"););
+        FOR_LOOP_INC_VARDEC (fprintf (global.outfile, "SAC_i");
+                             , fprintf (global.outfile, "0");
+                             , fprintf (global.outfile, "SAC_ND_A_DIM(%s)", from_NT);
+                             ,
+                             COND1 (fprintf (global.outfile,
+                                             "SAC_ND_A_SHAPE(%s,SAC_i) != "
+                                             "SAC_ND_A_SHAPE(%s,SAC_i)",
+                                             from_NT, from2_NT);
+                                    , fprintf (global.outfile,
+                                               "SAC_RuntimeError(\"Arrays do not adhere "
+                                               "to same shape constraint\");\n");););
+    }
+
+    INDENT;
+    fprintf (global.outfile, "SAC_ND_A_FIELD( %s) = 1;\n", to_NT);
+
+    DBUG_VOID_RETURN;
+}
+
+#if 0
+/** <!--********************************************************************-->
+ *
+ * @fn void ICMCompileND_PRF_SHAPE_MATCHES_DIM
+ *
+ *****************************************************************************/
+void ICMCompileND_PRF_SHAPE_MATCHES_DIM( char *to_NT, char *from_NT, 
+                                         char *from2_NT)
+{
+  DBUG_ENTER( "ICMCompileND_PRF_SHAPE_MATCHES_DIM");
+
+  COND1(
+    fprintf( global.outfile,
+             "(SAC_ND_A_DIM(%s) != 1) || "
+             "(SAC_ND_A_SHAPE(%s,0) != SAC_ND_A_DIM(%s))",
+             from_NT, from_NT, from2_NT);
+  ,
+    fprintf( global.outfile, 
+             "SAC_RuntimeError(\"Arrays do not adhere "
+             "to shape matches dim constraint\");\n");
+  );
+
+  INDENT;
+  fprintf( global.outfile, "SAC_ND_A_FIELD( %s) = 1;\n", to_NT);
+
+  DBUG_VOID_RETURN;
+}
+#endif
+
+/** <!--********************************************************************-->
+ *
+ * @fn void ICMCompileND_PRF_VAL_LT_SHAPE
+ *
+ *****************************************************************************/
+void
+ICMCompileND_PRF_VAL_LT_SHAPE (char *to_NT, char *from_NT, char *from2_NT, int from2_sdim)
+{
+    int i;
+
+    DBUG_ENTER ("ICMCompileND_PRF_VAL_LT_SHAPE");
+
+    COND1 (fprintf (global.outfile,
+                    "(SAC_ND_A_DIM(%s) != 1) &&"
+                    "(SAC_ND_A_SHAPE(%s,0) != SAC_ND_A_DIM(%s))",
+                    from_NT, from_NT, from2_NT);
+           , fprintf (global.outfile, "SAC_RuntimeError(\"Arrays do not adhere "
+                                      "to val less than shape constraint\");\n"););
+
+    if (KNOWN_DIMENSION (from2_sdim)) {
+        COND1 (
+          fprintf (global.outfile, "(0)");
+          for (i = 0; i < DIM_NO_OFFSET (from2_sdim); i++) {
+              fprintf (global.outfile, "|| (SAC_ND_READ(%s,%d) >= SAC_ND_A_SHAPE(%s,%d))",
+                       from_NT, i, from2_NT, i);
+          },
+          fprintf (global.outfile, "SAC_RuntimeError(\"Arrays do not adhere "
+                                   "to val less than shape constraint\");\n"););
+    } else {
+        FOR_LOOP_INC_VARDEC (fprintf (global.outfile, "SAC_i");
+                             , fprintf (global.outfile, "0");
+                             , fprintf (global.outfile, "SAC_ND_A_DIM(%s)", from2_NT);
+                             ,
+                             COND1 (fprintf (global.outfile,
+                                             "SAC_ND_READ(%s,SAC_i) >= "
+                                             "SAC_ND_A_SHAPE(%s,SAC_i)",
+                                             from_NT, from2_NT);
+                                    , fprintf (global.outfile,
+                                               "SAC_RuntimeError(\"Arrays do not adhere "
+                                               "to val less than shape "
+                                               "constraint\");\n");););
+    }
+
+    INDENT;
+    fprintf (global.outfile, "SAC_ND_A_FIELD( %s) = 1;\n", to_NT);
+
+    DBUG_VOID_RETURN;
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn void ICMCompileND_PRF_PROD_MATCHES_PROD_SHAPE
+ *
+ *****************************************************************************/
+void
+ICMCompileND_PRF_PROD_MATCHES_PROD_SHAPE (char *to_NT, char *from_NT, char *from2_NT,
+                                          int from2_sdim)
+{
+    DBUG_ENTER ("ICMCompileND_PRF_PROD_MATCHES_PROD_SHAPE");
+
+    BLOCK_VARDECS (
+      fprintf (global.outfile, "int SAC_p1 = 1; int SAC_p2 = 1;");
+      , FOR_LOOP_INC_VARDEC (fprintf (global.outfile, "SAC_i");
+                             , fprintf (global.outfile, "0");
+                             , fprintf (global.outfile, "SAC_ND_A_SHAPE(%s,0)", from_NT);
+                             , fprintf (global.outfile,
+                                        "SAC_p1 *= SAC_ND_READ(%s,SAC_i);", from_NT););
+
+      if (KNOWN_DIMENSION (from2_sdim)) {
+          int i;
+          for (i = 0; i < DIM_NO_OFFSET (from2_sdim); i++) {
+              fprintf (global.outfile, "SAC_p2 *= SAC_ND_A_SHAPE(%s,%d);\n", from2_NT, i);
+              INDENT;
+          }
+      } else {
+          FOR_LOOP_INC_VARDEC (fprintf (global.outfile, "SAC_i");
+                               , fprintf (global.outfile, "0");
+                               , fprintf (global.outfile, "SAC_ND_A_DIM(%s)", from2_NT);
+                               , fprintf (global.outfile,
+                                          "SAC_p2 *= SAC_ND_A_SHAPE(%s,SAC_i);",
+                                          from2_NT););
+      }
+
+      COND1 (fprintf (global.outfile, "SAC_p1 != SAC_p2");
+             , fprintf (global.outfile, "SAC_RuntimeError(\"Arrays do not adhere "
+                                        "to prod matches prod shape constraint\");\n");
+
+      ););
+    INDENT;
+    fprintf (global.outfile, "SAC_ND_A_FIELD( %s) = 1;\n", to_NT);
+
+    DBUG_VOID_RETURN;
+}

src/libsac2c/codegen/icm2c_prf.h

 /*
  *
- * $Id:$
+ * $Id$
  *
  */
 
@@ -93,4 +93,16 @@ extern void ICMCompileND_PRF_PROP_OBJ_IN (int vararg_cnt, char **vararg);
 
 extern void ICMCompileND_PRF_PROP_OBJ_OUT (int vararg_cnt, char **vararg);
 
+extern void ICMCompileND_PRF_TYPE_CONSTRAINT_AKS (char *to_NT, char *from_NT, int dim,
+                                                  int *shp);
+
+extern void ICMCompileND_PRF_SAME_SHAPE (char *to_NT, char *from_NT, int from_sdim,
+                                         char *from2_NT, int from2_sdim);
+
+extern void ICMCompileND_PRF_VAL_LT_SHAPE (char *to_NT, char *from_NT, char *from2_NT,
+                                           int from2_sdim);
+
+extern void ICMCompileND_PRF_PROD_MATCHES_PROD_SHAPE (char *to_NT, char *from_NT,
+                                                      char *from2_NT, int from2_sdim);
+
 #endif /* _SAC_ICM2C_PRF_H_ */

src/libsac2c/precompile/markmemvals.c

@@ -699,6 +699,69 @@ MMVprfPropObjOut (node *arg_node, info *arg_info)
     DBUG_RETURN (arg_node);
 }
 
+/** <!--********************************************************************-->
+ *
+ * @fn node *MMVprfGuard( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+static node *
+MMVprfGuard (node *arg_node, info *arg_info)
+{
+    node *v;
+    node *as;
+
+    DBUG_ENTER ("MMVprfGuard");
+
+    /*
+     * v1,...,vn = guard(p,a1,..an);
+     *
+     * 1. rename p,a1,..,an
+     * 2. Insert (vi,ai) into LUT
+     */
+    PRF_ARGS (arg_node) = TRAVdo (PRF_ARGS (arg_node), arg_info);
+
+    v = INFO_LHS (arg_info);
+    as = EXPRS_EXPRS2 (PRF_ARGS (arg_node));
+    while (as != NULL) {
+        node *a = EXPRS_EXPR (as);
+        LUTinsertIntoLutS (INFO_LUT (arg_info), IDS_NAME (v), ID_NAME (a));
+        LUTinsertIntoLutP (INFO_LUT (arg_info), IDS_AVIS (v), ID_AVIS (a));
+        v = IDS_NEXT (v);
+        as = EXPRS_NEXT (as);
+    }
+
+    DBUG_RETURN (arg_node);
+}
+
+/** <!--********************************************************************-->
+ *
+ * @fn node *MMVprfAfterGuard( node *arg_node, info *arg_info)
+ *
+ *****************************************************************************/
+static node *
+MMVprfAfterGuard (node *arg_node, info *arg_info)
+{
+    node *v;
+    node *a;
+
+    DBUG_ENTER ("MMVprfAfterGuard");
+
+    /*
+     * v = guard(a,p1,..pn);
+     *
+     * 1. rename a,p1,..,pn
+     * 2. Insert (v,a) into LUT
+     */
+    PRF_ARGS (arg_node) = TRAVdo (PRF_ARGS (arg_node), arg_info);
+
+    v = INFO_LHS (arg_info);
+    a = PRF_ARG1 (arg_node);
+    LUTinsertIntoLutS (INFO_LUT (arg_info), IDS_NAME (v), ID_NAME (a));
+    LUTinsertIntoLutP (INFO_LUT (arg_info), IDS_AVIS (v), ID_AVIS (a));
+
+    DBUG_RETURN (arg_node);
+}
+
 /** <!--******************************************************************-->
  *
  * @fn MMVprf
@@ -744,6 +807,14 @@ MMVprf (node *arg_node, info *arg_info)
         arg_node = MMVprfPropObjOut (arg_node, arg_info);
         break;
 
+    case F_guard:
+        arg_node = MMVprfGuard (arg_node, arg_info);
+        break;
+
+    case F_afterguard:
+        arg_node = MMVprfAfterGuard (arg_node, arg_info);
+        break;
+
     default:
         if (PRF_ARGS (arg_node) != NULL) {
             PRF_ARGS (arg_node) = TRAVdo (PRF_ARGS (arg_node), arg_info);

src/libsac2c/tree/prf_info.mac

@@ -657,41 +657,43 @@ PRF (tob_S, (PA_S, PA_x, PA_x), 1, TOB, NOSIMD, NTCCTprf_tob_S, NULL, COMPprfOp_
    * Functions for implementing conformability constraints:
    */
 
-  PRF (guard, (PA_x, PA_x, PA_x), 0, XXX, NOSIMD, NTCCTprf_guard, NULL, NULL,
+  PRF (guard, (PA_x, PA_x, PA_x), 0, XXX, NOSIMD, NTCCTprf_guard, NULL, COMPprfGuard,
        SCSprf_guard, NULL, NULL, SAAdim_guard, SAAshp_guard, NULL, 0, NULL, NULL,
        TEnMinusOne, NULL, NULL),
 
-  PRF (afterguard, (PA_x, PA_x, PA_x), 0, XXX, NOSIMD, NTCCTprf_afterguard, NULL, NULL,
-       SCSprf_afterguard, NULL, NULL, SAAdim_of_arg1, SAAshp_of_arg1, NULL, 0, NULL, NULL,
-       TEone, NULL, NULL),
+  PRF (afterguard, (PA_x, PA_x, PA_x), 0, XXX, NOSIMD, NTCCTprf_afterguard, NULL,
+       COMPprfNoop, SCSprf_afterguard, NULL, NULL, SAAdim_of_arg1, SAAshp_of_arg1, NULL,
+       0, NULL, NULL, TEone, NULL, NULL),
 
   PRF (type_constraint, (PA_x, PA_x, PA_x), 2, XXX, NOSIMD, NTCCTprf_type_constraint,
-       NULL, NULL, NULL, NULL, NULL, SAAdim_type_constraint, SAAshp_type_constraint, NULL,
-       1, NULL, NULL, TEtwo, NULL, NULL),
+       NULL, COMPprfTypeConstraint, NULL, NULL, NULL, SAAdim_type_constraint,
+       SAAshp_type_constraint, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
 
   PRF (same_shape_AxA, (PA_A, PA_A, PA_x), 2, XXX, NOSIMD, NTCCTprf_same_shape, NULL,
-       NULL, SCSprf_same_shape_AxA, NULL, NULL, SAAdim_same_shape_AxA,
+       COMPprfSameShape, SCSprf_same_shape_AxA, NULL, NULL, SAAdim_same_shape_AxA,
        SAAshp_same_shape_AxA, NULL, 2, NULL, NULL, TEthree, NULL, NULL),
 
   PRF (shape_matches_dim_VxA, (PA_V, PA_A, PA_x), 2, XXX, NOSIMD, NTCCTprf_shape_dim,
-       NULL, NULL, SCSprf_shape_matches_dim_VxA, NULL, NULL, SAAdim_shape_matches_dim_VxA,
-       SAAshp_shape_matches_dim_VxA, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
+       NULL, COMPprfShapeMatchesDim, SCSprf_shape_matches_dim_VxA, NULL, NULL,
+       SAAdim_shape_matches_dim_VxA, SAAshp_shape_matches_dim_VxA, NULL, 1, NULL, NULL,
+       TEtwo, NULL, NULL),
 
-  PRF (non_neg_val_V, (PA_V, PA_x, PA_x), 1, XXX, NOSIMD, NTCCTprf_non_neg, NULL, NULL,
-       SCSprf_non_neg_val_V, NULL, NULL, SAAdim_cc_inherit, SAAshp_cc_inherit, NULL, 1,
-       NULL, NULL, TEtwo, NULL, NULL),
+  PRF (non_neg_val_V, (PA_V, PA_x, PA_x), 1, XXX, NOSIMD, NTCCTprf_non_neg, NULL,
+       COMPprfNonNegVal, SCSprf_non_neg_val_V, NULL, NULL, SAAdim_cc_inherit,
+       SAAshp_cc_inherit, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
 
   PRF (val_lt_shape_VxA, (PA_V, PA_A, PA_x), 2, XXX, NOSIMD, NTCCTprf_val_shape, NULL,
-       NULL, SCSprf_val_lt_shape_VxA, NULL, NULL, SAAdim_cc_inherit, SAAshp_cc_inherit,
-       NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
+       COMPprfValLtShape, SCSprf_val_lt_shape_VxA, NULL, NULL, SAAdim_cc_inherit,
+       SAAshp_cc_inherit, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
 
-  PRF (val_le_val_VxV, (PA_V, PA_V, PA_x), 2, XXX, NOSIMD, NTCCTprf_val_val, NULL, NULL,
-       SCSprf_val_le_val_VxV, NULL, NULL, SAAdim_cc_inherit, SAAshp_cc_inherit, NULL, 1,
-       NULL, NULL, TEtwo, NULL, NULL),
+  PRF (val_le_val_VxV, (PA_V, PA_V, PA_x), 2, XXX, NOSIMD, NTCCTprf_val_val, NULL,
+       COMPprfValLeVal, SCSprf_val_le_val_VxV, NULL, NULL, SAAdim_cc_inherit,
+       SAAshp_cc_inherit, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
 
   PRF (prod_matches_prod_shape_VxA, (PA_V, PA_A, PA_x), 2, XXX, NOSIMD,
-       NTCCTprf_prod_shape, NULL, NULL, SCSprf_prod_matches_prod_shape_VxA, NULL, NULL,
-       SAAdim_cc_inherit, SAAshp_cc_inherit, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
+       NTCCTprf_prod_shape, NULL, COMPprfProdMatchesProdShape,
+       SCSprf_prod_matches_prod_shape_VxA, NULL, NULL, SAAdim_cc_inherit,
+       SAAshp_cc_inherit, NULL, 1, NULL, NULL, TEtwo, NULL, NULL),
 
   /*******************************************************************************
    * Functions to definine generic functions on udts

src/runtime/essentials_h/prf.h

@@ -226,4 +226,45 @@
     SAC_TR_PRF_PRINT (("ND_PRF_SINGLETHREAD__...( %s, %d)\n", NT_STR (to_NT), to_sdim)); \
     SAC_ND_CREATE__SCALAR__DATA (to_NT, SAC_MT_not_yet_parallel)
 
+#define SAC_ND_PRF_GUARD(scl)                                                            \
+    if (!scl)                                                                            \
+        SAC_RuntimeError ("Conditions not met at guard");
+
+#define SAC_ND_PRF_TYPE_CONSTRAINT_AKD(to_NT, from_NT, scl)                              \
+    if (SAC_ND_A_DIM (from_NT) != scl)                                                   \
+        SAC_RuntimeError ("Array does not adhere to type constraint");                   \
+    SAC_ND_A_FIELD (to_NT) = 1;
+
+#define SAC_ND_PRF_TYPE_CONSTRAINT_AUDGZ(to_NT, from_NT)                                 \
+    if (SAC_ND_A_DIM (from_NT) == 0)                                                     \
+        SAC_Runtime_Error ("Array does not adhere to type constraint");                  \
+    SAC_ND_A_FIELD (to_NT) = 1;
+
+#define SAC_ND_PRF_SHAPE_MATCHES_DIM(to_NT, from_NT, from2_NT)                           \
+    if ((SAC_ND_A_DIM (from_NT) != 1)                                                    \
+        || (SAC_ND_A_SHAPE (from_NT, 0) != SAC_ND_A_DIM (from2_NT))) {                   \
+        SAC_RuntimeError ("Arrays do not adhere to shape matches "                       \
+                          "dim constraint.");                                            \
+    }
+
+#define SAC_ND_PRF_NON_NEG_VAL(to_NT, from_NT)                                           \
+    {                                                                                    \
+        int SAC_i;                                                                       \
+        for (SAC_i = 0; SAC_i < SAC_ND_A_SIZE (from_NT); SAC_i++) {                      \
+            if (SAC_ND_READ (from_NT, SAC_i) < 0)                                        \
+                SAC_RuntimeError ("Non-negativity constraint violated");                 \
+        }                                                                                \
+        SAC_ND_A_FIELD (to_NT) = 1;                                                      \
+    }
+
+#define SAC_ND_PRF_VAL_LE_VAL(to_NT, from_NT, from2_NT)                                  \
+    {                                                                                    \
+        int SAC_i;                                                                       \
+        for (SAC_i = 0; SAC_i < SAC_ND_A_SIZE (from_NT); SAC_i++) {                      \
+            if (SAC_ND_READ (from_NT, SAC_i) > SAC_ND_READ (from2_NT, SAC_i))            \
+                SAC_RuntimeError ("Constraint violated");                                \
+        }                                                                                \
+        SAC_ND_A_FIELD (to_NT) = 1;                                                      \
+    }
+
 #endif /* _SAC_PRF_H_ */