Merge branch 'develop' into 'develop'

improved support for multi-operator Was

See merge request !90

src/libsac2c/concurrent/cost_model.c

@@ -284,6 +284,7 @@ MTCMlet (node *arg_node, info *arg_info)
 node *
 MTCMwith2 (node *arg_node, info *arg_info)
 {
+    node *old_letids;
     DBUG_ENTER ();
 
     INFO_MAYPAR (arg_info) = TRUE;
@@ -294,7 +295,17 @@ MTCMwith2 (node *arg_node, info *arg_info)
 
     DBUG_PRINT ("considering with2 in line %zu ...", NODE_LINE (arg_node));
 
+    /*
+     * we need to preserve INFO_LETIDS here.
+     * If we deal with a multi-operator WL, the operators
+     * follow the letids chain. However, the code after the
+     * operator traversal requires the full INFO_LETIDS chain
+     * to be present as, otherwise, the sequential branch will
+     * be mis-constructed!
+     */
+    old_letids = INFO_LETIDS (arg_info);
     WITH2_WITHOP (arg_node) = TRAVdo (WITH2_WITHOP (arg_node), arg_info);
+    INFO_LETIDS (arg_info) = old_letids;
 
     if (INFO_MAYPAR (arg_info)) {
         if (INFO_ISWORTH (arg_info)) {

src/libsac2c/precompile/markmemvals.c

@@ -256,12 +256,14 @@ MMVfundef (node *arg_node, info *arg_info)
      */
     INFO_FUNDEF (arg_info) = arg_node;
 
+    DBUG_PRINT ("traversing body of function \"%s\":\n", FUNDEF_NAME (arg_node));
     FUNDEF_BODY (arg_node) = TRAVopt (FUNDEF_BODY (arg_node), arg_info);
 
     /*
      * Ensure all lhss have been changed.
      * In some cases the lhs in one side of ifs may be missed.
      */
+    DBUG_PRINT ("traversing body of function \"%s\": fixing missing LHS adjustments\n", FUNDEF_NAME (arg_node));
     TRAVpushAnonymous (anon, &TRAVsons);
     FUNDEF_BODY (arg_node) = TRAVopt (FUNDEF_BODY (arg_node), arg_info);
     TRAVpop ();
@@ -275,8 +277,10 @@ MMVfundef (node *arg_node, info *arg_info)
 
         FUNDEF_NEXT (arg_node) = TRAVopt (FUNDEF_NEXT (arg_node), arg_info);
     } else {
+        DBUG_PRINT ("traversing body of function \"%s\": fixing returns\n", FUNDEF_NAME (arg_node));
         FUNDEF_RETS (arg_node) = TRAVopt (FUNDEF_RETS (arg_node), arg_info);
     }
+    DBUG_PRINT ("traversing body of function \"%s\": done\n", FUNDEF_NAME (arg_node));
 
     DBUG_RETURN (arg_node);
 }
@@ -382,13 +386,16 @@ MMVid (node *arg_node, info *arg_info)
      * need to keep renaming until we reach a fixpoint.
      */
 
+    DBUG_PRINT ("Looking for replacement of id \"%s\"\n", ID_NAME (arg_node));
     newavis = (node *)LUTsearchInLutPp (INFO_LUT (arg_info), ID_AVIS (arg_node));
 
     while (newavis != ID_AVIS (arg_node)) {
+        DBUG_PRINT ("Found \"%s\" now looking for further replacements\n", AVIS_NAME (newavis));
         ID_AVIS (arg_node) = newavis;
 
         newavis = (node *)LUTsearchInLutPp (INFO_LUT (arg_info), ID_AVIS (arg_node));
     }
+    DBUG_PRINT ("No (further) replacements\n");
 
     DBUG_RETURN (arg_node);
 }
@@ -1198,6 +1205,8 @@ MMVgenarray (node *arg_node, info *arg_info)
                        ID_AVIS (GENARRAY_MEM (arg_node)));
 
     if (GENARRAY_NEXT (arg_node) != NULL) {
+        DBUG_ASSERT (IDS_NEXT (INFO_LHS (arg_info))!=NULL,
+                     "with-loop has more operators than LHS variables\n");
         INFO_LHS (arg_info) = IDS_NEXT (INFO_LHS (arg_info));
         GENARRAY_NEXT (arg_node) = TRAVdo (GENARRAY_NEXT (arg_node), arg_info);
     }

src/libsac2c/scanparse/handle_with_loop_operators.c

@@ -5,6 +5,7 @@
 #include "traverse.h"
 #include "tree_basic.h"
 #include "tree_compound.h"
+#include "compare_tree.h"
 #include "str.h"
 #include "memory.h"
 #include "DupTree.h"
@@ -23,6 +24,13 @@
  * (At the time being 10.10.2006, we require Multi-Operator With-Loops in the
  * back-end to have identical overall ranges....)
  *
+ * As of 21.11.2018, we still do not support Multi-Operator With-Loops with
+ * arbitrary ranges in the back-end. However, as WLFS is not effective enough
+ * we want to avoid splitting multi-operator WLs that have only generators with
+ * identical range or propagate operators.
+ * We implement a check in the local function IsLegitimateMoWl (node *withop, info*)
+ * which is being used in HWLOwith to prevent splitting.
+ *
  * To understand the basic principle, let us consider Multi-Operator With-Loops
  * that contain standard operators only, i.e., they do NOT contain propagates.
  * In these cases, we can split the operators into individual ones by simply
@@ -192,6 +200,8 @@ struct INFO {
     node *lhs;
     node *nlhs;
     node *withops;
+    bool legal;
+    node *range;
 };
 
 /**
@@ -204,6 +214,8 @@ struct INFO {
 #define INFO_HWLO_CEXPRS(n) (n->cexprs)
 #define INFO_HWLO_NEW_CEXPRS(n) (n->ncexprs)
 #define INFO_HWLO_NEW_WITHOPS(n) (n->withops)
+#define INFO_HWLO_LEGAL_MOWL(n) (n->legal)
+#define INFO_HWLO_RANGE(n) (n->range)
 
 /**
  * INFO functions
@@ -225,6 +237,9 @@ MakeInfo (void)
     INFO_HWLO_NEW_LHS (result) = NULL;
     INFO_HWLO_NEW_WITHOPS (result) = NULL;
 
+    INFO_HWLO_LEGAL_MOWL (result) = TRUE;
+    INFO_HWLO_RANGE (result) = NULL;
+
     DBUG_RETURN (result);
 }
 
@@ -238,6 +253,72 @@ FreeInfo (info *info)
     DBUG_RETURN (info);
 }
 
+static node *
+ATravILMOWLgenarray (node *genarray, info *arg_info)
+{
+    DBUG_ENTER ();
+
+    // We know that (INFO_HWLO_LEGAL_MOWL (arg_info) == TRUE)!
+    if (INFO_HWLO_RANGE (arg_info) == NULL) {
+        // We see the first N_genarray!
+        INFO_HWLO_RANGE (arg_info) = GENARRAY_SHAPE (genarray);
+        GENARRAY_NEXT (genarray) = TRAVopt (GENARRAY_NEXT (genarray), arg_info);
+    } else {
+        if ( CMPTdoCompareTree (INFO_HWLO_RANGE (arg_info),
+                                GENARRAY_SHAPE (genarray)) == CMPT_EQ) {
+            GENARRAY_NEXT (genarray) = TRAVopt (GENARRAY_NEXT (genarray), arg_info);
+        } else {
+            INFO_HWLO_LEGAL_MOWL (arg_info) = FALSE;
+        }
+    }
+
+    DBUG_RETURN (genarray);
+}
+
+static node *
+ATravILMOWLpropagate (node *propagate, info *arg_info)
+{
+    DBUG_ENTER ();
+    PROPAGATE_NEXT (propagate) = TRAVopt (PROPAGATE_NEXT (propagate), arg_info);
+    DBUG_RETURN (propagate);
+}
+
+static node *
+ATravILMOWLother (node *operator, info *arg_info)
+{
+    DBUG_ENTER ();
+    INFO_HWLO_LEGAL_MOWL (arg_info) = FALSE;
+    DBUG_RETURN (operator);
+}
+
+static bool
+IsLegitimateMoWl (node *withop, info *arg_info)
+{
+    anontrav_t ilmowl_trav[5]
+      = {{N_genarray, &ATravILMOWLgenarray},
+         {N_modarray, &ATravILMOWLother},
+         {N_spfold, &ATravILMOWLother},
+         {N_propagate, &ATravILMOWLpropagate},
+         {(nodetype)0, NULL}};
+
+    DBUG_ENTER ();
+
+    DBUG_PRINT ("checking multi-operator WL for splitting...\n");
+
+    TRAVpushAnonymous (ilmowl_trav, &TRAVsons);
+
+    INFO_HWLO_LEGAL_MOWL (arg_info) = TRUE;
+    INFO_HWLO_RANGE (arg_info) = NULL;
+
+    withop = TRAVopt (withop, arg_info);
+
+    TRAVpop ();
+
+    DBUG_PRINT ("... splitting is %s required\n",
+                (INFO_HWLO_LEGAL_MOWL (arg_info) ?  "not" : "")); 
+    DBUG_RETURN (INFO_HWLO_LEGAL_MOWL (arg_info));
+}
+
 /** <!--**********************************************************************
  *
  * @fn node *HWLOdoHandleWithLoops( node *syntax_tree)
@@ -376,7 +457,8 @@ HWLOwith (node *arg_node, info *arg_info)
     INFO_HWLO_CEXPRS (arg_info)
       = (WITH_CODE (arg_node) == NULL) ? NULL : CODE_CEXPRS (WITH_CODE (arg_node));
 
-    if (TCcountExprs (INFO_HWLO_CEXPRS (arg_info)) > 1) {
+    if ( (TCcountExprs (INFO_HWLO_CEXPRS (arg_info)) > 1)
+         && !IsLegitimateMoWl (WITH_WITHOP (arg_node), arg_info)) {
         if (INFO_HWLO_LHS (arg_info) == NULL) {
             CTIerrorLine (global.linenum,
                           "Multi-Operator With-Loop used in expression position");

src/libsac2c/support/str_buffer.c

@@ -96,7 +96,7 @@ SBUFvprintf (str_buf *s, const char *format, va_list arg_list)
 {
     va_list arg_list_copy;
     int len = 0;
-    size_t rem, len_p;
+    size_t rem, len_p = 0;
     bool ok;
 
     DBUG_ENTER ();

src/libsac2c/tree/compare_tree.c

@@ -17,6 +17,7 @@
 #include "new_types.h"
 #include "str.h"
 #include "memory.h"
+#include "namespaces.h"
 
 #define DBUG_PREFIX "CMPT"
 #include "debug.h"
@@ -542,6 +543,28 @@ CMPTid (node *arg_node, info *arg_info)
     DBUG_RETURN (arg_node);
 }
 
+/******************************************************************************
+ *
+ * function:
+ *   node* CMPTspid(node *arg_node, info *arg_info)
+ *
+ * description:
+ *   compares string of spid node
+ *
+ ******************************************************************************/
+node *
+CMPTspid (node *arg_node, info *arg_info)
+{
+    DBUG_ENTER ();
+
+    INFO_EQFLAG (arg_info)
+      = CMPT_TEST (INFO_EQFLAG (arg_info),
+                   STReq (SPID_NAME (arg_node), SPID_NAME (INFO_TREE (arg_info)))
+                   && NSequals (SPID_NS (arg_node), SPID_NS (INFO_TREE (arg_info))));
+
+    DBUG_RETURN (arg_node);
+}
+
 /******************************************************************************
  *
  * function:

src/libsac2c/tree/compare_tree.h

@@ -44,6 +44,7 @@ extern node *CMPTdouble (node *arg_node, info *arg_info);
 extern node *CMPTtype (node *arg_node, info *arg_info);
 extern node *CMPTstr (node *arg_node, info *arg_info);
 extern node *CMPTid (node *arg_node, info *arg_info);
+extern node *CMPTspid (node *arg_node, info *arg_info);
 extern node *CMPTids (node *arg_node, info *arg_info);
 extern node *CMPTarray (node *arg_node, info *arg_info);
 extern node *CMPTprf (node *arg_node, info *arg_info);

src/libsac2c/xml/ast.xml

@@ -1076,6 +1076,7 @@
     		  <node name="Type" />
 		      <node name="Str" />
     		  <node name="Id" />
+    		  <node name="SPId" />
 		      <node name="Ids" />
     		  <node name="Array" />
 		      <node name="Prf" />