MultipleAssignment.diff

   1 From: Tony Balinski <ajbj@free.fr>
   2 Subject: Assign multiple lvalues in one statement
   3
   4 This patch allows you to assign a set of variables in a lvalue list from the
   5 content of an array. This has the appearance of a tuple. The keys used to
   6 retrieve the values from the array expression on the right are numeric values
   7 starting with 1. If a key is missing, your macro will fail.
   8
   9 Given the following (implemented as new built-in functions in this patch):
  10
  11         define args {
  12             return $args
  13         }
  14         define n_args {
  15             i = 0;
  16             while (i in $1)
  17                 ++i
  18             return i
  19         }
  20
  21 You can assign a list of symbols to the content of such an array using a list
  22 assign, thus:
  23
  24         (x, y, z) = args(a, b, c)
  25
  26 This is equivalent to
  27
  28         x = a
  29         y = b
  30         z = c
  31
  32 This technique can be useful for retrieving argument values in your functions:
  33
  34         (str, regex, count) = $args
  35
  36 or for returning "tuples" from them:
  37
  38         define myfunc {
  39             ...
  40             return args(isOk, message)
  41         }
  42         ...
  43         (success, msg) = myfunc()
  44
  45 If you need to count the number of variables that can be assigned in this way,
  46 use the n_args() function:
  47
  48         ...
  49         result = myfunc()       # we expect result is an array
  50         if (n_args(result) >= 2)
  51             (success, msg) = result
  52
  53 ---
  54
  55  source/interpret.c |   23 ++++++++-
  56  source/interpret.h |    3 -
  57  source/macro.c     |   76 ++++++++++++++++++++++++++++++++
  58  source/parse.y     |  125 +++++++++++++++++++++++++++++++++++++++++++++++++++++
  59  4 files changed, 224 insertions(+), 3 deletions(-)
  60
  61 diff --quilt old/source/interpret.c new/source/interpret.c
  62 --- old/source/interpret.c
  63 +++ new/source/interpret.c
  64 @@ -382,9 +382,9 @@ Inst *GetPC(void)
  65  /*
  66  ** Swap the positions of two contiguous blocks of code.  The first block
  67  ** running between locations start and boundary, and the second between
  68 -** boundary and end.
  69 +** boundary and end. Return the moved boundary value.
  70  */
  71 -void SwapCode(Inst *start, Inst *boundary, Inst *end)
  72 +Inst *SwapCode(Inst *start, Inst *boundary, Inst *end)
  73  {
  74  #define reverseCode(L, H) \
  75      do { register Inst t, *l = L, *h = H - 1; \
  76 @@ -394,6 +394,8 @@ void SwapCode(Inst *start, Inst *boundar
  77      reverseCode(start, boundary);   /* 1 */
  78      reverseCode(boundary, end);     /* 2 */
  79      reverseCode(start, end);        /* 3 */
  80 +    /* new pos of boundary is start + length of old top portion */
  81 +    return start + (end - boundary);
  82  }
  83
  84  /*
  85 @@ -729,6 +731,23 @@ void SetMacroFocusWindow(WindowInfo *win
  86  }
  87
  88  /*
  89 +** install a list assign (multi-assign) rvalue expression holder into the local
  90 +** namespace.
  91 +*/
  92 +Symbol *InstallMultiAssignExpr(void)
  93 +{
  94 +    static const char symbolName[] = "list assign expr";
  95 +    Symbol *sym = LookupSymbol(symbolName);
  96 +    DataValue value;
  97 +    value.tag = NO_TAG;
  98 +    value.val.n = 0;
  99 +    if (!sym) {
 100 +        sym = InstallSymbol(symbolName, LOCAL_SYM, value);
 101 +    }
 102 +    return sym;
 103 +}
 104 +
 105 +/*
 106  ** install an array iteration symbol
 107  ** it is tagged as an integer but holds an array node pointer
 108  */
 109 diff --quilt old/source/interpret.h new/source/interpret.h
 110 --- old/source/interpret.h
 111 +++ new/source/interpret.h
 112 @@ -155,8 +155,9 @@ Symbol *LookupStringConstSymbol(const ch
 113  Symbol *InstallStringConstSymbol(const char *str);
 114  Symbol *LookupSymbol(const char *name);
 115  Symbol *InstallSymbol(const char *name, enum symTypes type, DataValue value);
 116 +Symbol *InstallMultiAssignExpr(void);
 117  Program *FinishCreatingProgram(AccumulatorData *acc);
 118 -void SwapCode(Inst *start, Inst *boundary, Inst *end);
 119 +Inst *SwapCode(Inst *start, Inst *boundary, Inst *end);
 120  void StartLoopAddrList(void);
 121  int AddBreakAddr(Inst *addr);
 122  int AddContinueAddr(Inst *addr);
 123 diff --quilt old/source/macro.c new/source/macro.c
 124 --- old/source/macro.c
 125 +++ new/source/macro.c
 126 @@ -166,6 +166,10 @@ static void bannerTimeoutProc(XtPointer
 127  static Boolean continueWorkProc(XtPointer clientData);
 128  static int escapeStringChars(char *fromString, char *toString);
 129  static int escapedStringLength(char *string);
 130 +static int argsMS(WindowInfo *window, DataValue *argList, int nArgs,
 131 +       DataValue *result, char **errMsg);
 132 +static int nArgsMS(WindowInfo *window, DataValue *argList, int nArgs,
 133 +       DataValue *result, char **errMsg);
 134  static int lengthMS(WindowInfo *window, DataValue *argList, int nArgs,
 135         DataValue *result, char **errMsg);
 136  static int minMS(WindowInfo *window, DataValue *argList, int nArgs,
 137 @@ -421,6 +425,8 @@ static int callMS(WindowInfo *window, Da
 138
 139  /* Built-in subroutines and variables for the macro language */
 140  static const BuiltInSubrName MacroSubrs[] = {
 141 +    { "args", argsMS },
 142 +    { "n_args", nArgsMS },
 143      { "length", lengthMS },
 144      { "get_range", getRangeMS },
 145      { "t_print", tPrintMS },
 146 @@ -1813,6 +1819,76 @@ static int escapedStringLength(char *str
 147  }
 148
 149  /*
 150 +** Built-in macro subroutine to generate an args array, eg
 151 +**   array = args(arg1, arg2, ...)
 152 +**   return args(arg1, arg2, ...)
 153 +** This is done by augmenting the $args array value, located at argList[nArgs],
 154 +** then returning that. This function builds an array with non-named arguments
 155 +** start at index 1; it is equivalent to
 156 +**      define args {
 157 +**          return $args
 158 +**      }
 159 +*/
 160 +static int argsMS(WindowInfo *window, DataValue *argList, int nArgs,
 161 +        DataValue *result, char **errMsg)
 162 +{
 163 +    DataValue *argsArray = &argList[nArgs];
 164 +    DataValue *argVal;
 165 +    int argNum;
 166 +
 167 +    if (argsArray->tag != ARRAY_TAG) {
 168 +        argsArray->tag = ARRAY_TAG;
 169 +        argsArray->val.arrayPtr = ArrayNew();
 170 +    }
 171 +
 172 +    for (argNum = 1; argNum <= nArgs; ++argNum) {
 173 +        argVal = &argList[argNum - 1];
 174 +        if (!ArrayInsert(argsArray, AllocStringOfNumber(argNum), argVal)) {
 175 +            M_FAILURE("argument array insertion failure in %s");
 176 +        }
 177 +    }
 178 +
 179 +    *result = *argsArray;
 180 +    return True;
 181 +}
 182 +
 183 +/*
 184 +** Built-in macro subroutine to count the number of args in an args array, eg
 185 +**   n = n_args(argsArray)
 186 +** This is done by counting how many values in the array have consecutive
 187 +** numeric indices starting at 1, copying $n_args relationship with $args.
 188 +** The result is also the last valid index in the sequence.
 189 +** This function is equivalent to
 190 +**      define n_args {
 191 +**          for (i = 0; i in $1; ++i)
 192 +**              dummy = 0
 193 +**          return i
 194 +**      }
 195 +*/
 196 +static int nArgsMS(WindowInfo *window, DataValue *argList, int nArgs,
 197 +        DataValue *result, char **errMsg)
 198 +{
 199 +    DataValue *argsArray = &argList[0];
 200 +    DataValue val;
 201 +
 202 +    if (nArgs != 1 || argsArray->tag != ARRAY_TAG) {
 203 +        M_FAILURE("%n can only take one argument, an array");
 204 +    }
 205 +    else {
 206 +        int argNum = 0;
 207 +        do {
 208 +            ++argNum;
 209 +        } while (ArrayGet(argsArray, longAsStr(argNum), &val));
 210 +
 211 +        /* the above loop terminates with argNum 1 beyond the last index */
 212 +        result->tag = INT_TAG;
 213 +        result->val.n = argNum - 1;
 214 +    }
 215 +
 216 +    return True;
 217 +}
 218 +
 219 +/*
 220  ** Built-in macro subroutine for getting the length of a string
 221  */
 222  static int lengthMS(WindowInfo *window, DataValue *argList, int nArgs,
 223 diff --quilt old/source/parse.y new/source/parse.y
 224 --- old/source/parse.y
 225 +++ new/source/parse.y
 226 @@ -82,6 +82,15 @@ static int nextSymIsField = 0;
 227      /* set to 1 when we don't want a full symbol, just a name (string) for a
 228         field name following a '.' */
 229
 230 +/*
 231 +** Positions holder for instruction reordering of code generated for the
 232 +** left-hand lvalue list in a multi-assignment statement.
 233 +*/
 234 +typedef struct LVinst {
 235 +    Inst *start, *mid, *next;
 236 +    int nArgs;
 237 +} LVinst;
 238 +
 239  %}
 240
 241  %union {
 242 @@ -89,6 +98,7 @@ static int nextSymIsField = 0;
 243      Inst *inst;
 244      int num;
 245      enum operations oper;
 246 +    LVinst lvinst;
 247      struct {
 248          AccumulatorData *acc;
 249          Symbol *sym;
 250 @@ -105,6 +115,7 @@ static int nextSymIsField = 0;
 251  %type <oper> operassign incrdecr
 252  %token <oper> '=' ADDEQ SUBEQ MULEQ DIVEQ MODEQ ANDEQ OREQ
 253  %token <oper> INCR DECR
 254 +%type <lvinst> lvlist lventry
 255
 256  %nonassoc IF_NO_ELSE
 257  %nonassoc ELSE
 258 @@ -328,6 +339,120 @@ simpstmt:   /* simple variable assignmen
 259                  ADD_OP(OP_ARRAY_ASSIGN); ADD_IMMED(1);
 260              }
 261              | funccall
 262 +            | lvlistexpr
 263 +            ;
 264 +
 265 +/*
 266 +** Implementing a multi-assignment to a list of lvalues
 267 +**
 268 +** Each accepting lvalue requires a push phase P and an assign phase A.
 269 +**
 270 +** For arrays, P includes pushing the indices and the destination array value.
 271 +** P always also includes pushing N, the position of the lval in the list, i.e.
 272 +** the index into the r.h.s. array expression supplying values.
 273 +**
 274 +** The assign phase uses N (on the stack) and the stored result E of the source
 275 +** array expression - this gives the indexed r.h.s. value to assign. Then, if
 276 +** the destination is an array element, the destination array and indices are
 277 +** retrieved from the stack and the assignment performed.
 278 +**
 279 +** Given "(a, b, c) = e", we need to end up with the command sequence:
 280 +**     Pc Pb Pa Ee Aa Ab Ac
 281 +** However, we have to generate Px and Ax together in the parse. Hence we
 282 +** must reorder, using PC mark positions Mx. For the example, we generate:
 283 +**     read a: M0[Pa]M1[Aa]Mt              here Mt is the current GetPC() value
 284 +**     read b: M0[Pa]M1[Aa]M2[Pb]M3[Ab]Mt          now swap(M0, M2, M3)
 285 +**             M0[Pb Pa]M1[Aa Ab]Mt
 286 +**     and c:  M0[Pb Pa]M1[Aa Ab]M2[Pc]M3[Ac]Mt    swap(M0, M2, M3)
 287 +**             M0[Pc Pb Pa]M1[Aa Ab Ac]Mt
 288 +**     then e: M0[Pc Pb Pa]M1[Aa Ab Ac]M2[Ee]Mt    swap(M1, M2, Mt)
 289 +**               [Pc Pb Pa][Ee][Aa Ab Ac]
 290 +** which is what we want. At each swap, we must retain intermediate positions.
 291 +** Below for lvlist, M0 is $$.start, M1 is $$.mid, M2 is $$.next. lventry's $$
 292 +** gives the mid value between the P and A phases (M1).
 293 +*/
 294 +lvlistexpr: '(' lvlist ')' blank '=' blank expr {
 295 +                /* store expression value */
 296 +                ADD_OP(OP_ASSIGN); ADD_SYM(InstallMultiAssignExpr());
 297 +                /* swap expression evaluation code into position */
 298 +                SwapCode($2.mid, $2.next, GetPC());
 299 +            }
 300 +            ;
 301 +/*
 302 +** lvlist: code for pushing the expression's index is generated here, after the code
 303 +** for assigning to the lvalue. In other words, the Px portion is split, with
 304 +** the assign code in front of the push index code. This needs to be swapped.
 305 +** Only then do we have the situation described for overall list assignment.
 306 +*/
 307 +lvlist:                        lventry {
 308 +                /* start case */
 309 +                $$.nArgs = $1.nArgs;
 310 +                /* add code to push the rvalue expression index needed */
 311 +                ADD_OP(OP_PUSH_IMMED); ADD_IMMED($$.nArgs);
 312 +                $$.start = $1.start;
 313 +                $$.next = GetPC();
 314 +                /* swap this code in front of the lvalue assignment code */
 315 +                $$.mid = SwapCode($1.mid, $1.next, $$.next);
 316 +            }
 317 +            | lvlist ',' blank lventry {
 318 +                /* recursive step case - starts similarly */
 319 +                $$.nArgs = $1.nArgs + $4.nArgs;
 320 +                /* add code to push the rvalue expression index needed */
 321 +                ADD_OP(OP_PUSH_IMMED); ADD_IMMED($$.nArgs);
 322 +                $$.start = $1.start;
 323 +                $$.next = GetPC();
 324 +                /* swap this code in front of the lvalue assignment code */
 325 +                $4.mid = SwapCode($4.mid, $4.next, $$.next);
 326 +                /*
 327 +                ** now swap Px code to midpoint and change midpoint
 328 +                ** $1.start[P...]$1.mid[A...]$1.next[Px]$4.mid[Ax]$$.next --->
 329 +                ** $1.start[Px][P...]$1.mid[A...]$4.mid[Ax]$$.next
 330 +                */
 331 +                SwapCode($1.start, $1.next, $4.mid);
 332 +                $$.start = $1.start;                    /* keep start point */
 333 +                $$.mid   = $1.mid + ($4.mid - $1.next); /* adjust mid point */
 334 +           }
 335 +           ;
 336 +/* lventry's value is the PC position between the Px and Ax parts */
 337 +lventry:      mark SYMBOL {
 338 +                $$.nArgs = 1;
 339 +                $$.start = $1;
 340 +                /* Push code: null */
 341 +                $$.mid = GetPC();
 342 +                /* Assign code:                        stack: N, ... */
 343 +                ADD_OP(OP_PUSH_SYM); ADD_SYM(InstallMultiAssignExpr());
 344 +                                                    /* stack: E, N, ... */
 345 +                ADD_OP(OP_SWAP_TOP2);               /* stack: N, E, ... */
 346 +                ADD_OP(OP_ARRAY_REF); ADD_IMMED(1); /* stack: E[N] ... */
 347 +                ADD_OP(OP_ASSIGN); ADD_SYM($2);
 348 +                $$.next = GetPC();
 349 +            }
 350 +            | mark initarraylv '[' arglist ']' {
 351 +                $$.nArgs = 1;
 352 +                $$.start = $1;
 353 +                /* Push code dealt with in "initarraylv '[' arglist ']'" */
 354 +                $$.mid = GetPC();
 355 +                /* Assign code:                        stack: N, ... */
 356 +                ADD_OP(OP_PUSH_SYM); ADD_SYM(InstallMultiAssignExpr());
 357 +                                                    /* stack: E, N, ... */
 358 +                ADD_OP(OP_SWAP_TOP2);               /* stack: N, E, ... */
 359 +                ADD_OP(OP_ARRAY_REF); ADD_IMMED(1); /* stack: E[N] ... */
 360 +                ADD_OP(OP_ARRAY_ASSIGN); ADD_IMMED($4);
 361 +                $$.next = GetPC();
 362 +            }
 363 +            | mark initarraylv dot field {
 364 +                $$.nArgs = 1;
 365 +                $$.start = $1;
 366 +                /* Push code dealt with in "initarraylv dot field" */
 367 +                $$.mid = GetPC();
 368 +                /* Assign code:                        stack: N, ... */
 369 +                ADD_OP(OP_PUSH_SYM); ADD_SYM(InstallMultiAssignExpr());
 370 +                                                    /* stack: E, N, ... */
 371 +                ADD_OP(OP_SWAP_TOP2);               /* stack: N, E, ... */
 372 +                ADD_OP(OP_ARRAY_REF); ADD_IMMED(1); /* stack: E[N] ... */
 373 +                ADD_OP(OP_ARRAY_ASSIGN); ADD_IMMED(1);
 374 +                $$.next = GetPC();
 375 +            }
 376              ;
 377
 378  evalsym:    SYMBOL {