Support for a "forindex(idx; list) {...}" construct analagous to

foreach, except that the variable gets the index instead of the list
element.  Should be useful, and took almost no code to implement.

Support for operator/assignment syntax: +=, -=, *=, /= and ~= now do
what you think they should.

Library support for a bind() function (see the docs Andy is still
writing), allowing runtime modifications to function lexical
environments.

simgear/nasal/code.c

@@ -357,7 +357,7 @@ static int getMember(struct Context* ctx, naRef obj, naRef fld,
 // OP_EACH works like a vector get, except that it leaves the vector
 // and index on the stack, increments the index after use, and pops
 // the arguments and pushes a nil if the index is beyond the end.
-static void evalEach(struct Context* ctx)
+static void evalEach(struct Context* ctx, int useIndex)
 {
     int idx = (int)(ctx->opStack[ctx->opTop-1].num);
     naRef vec = ctx->opStack[ctx->opTop-2];
@@ -368,7 +368,7 @@ static void evalEach(struct Context* ctx)
         return;
     }
     ctx->opStack[ctx->opTop-1].num = idx+1; // modify in place
-    PUSH(naVec_get(vec, idx));
+    PUSH(useIndex ? naNum(idx) : naVec_get(vec, idx));
 }
 
 #define ARG() cd->byteCode[f->ip++]
@@ -397,6 +397,10 @@ static naRef run(struct Context* ctx)
         case OP_DUP:
             PUSH(ctx->opStack[ctx->opTop-1]);
             break;
+        case OP_DUP2:
+            PUSH(ctx->opStack[ctx->opTop-2]);
+            PUSH(ctx->opStack[ctx->opTop-2]);
+            break;
         case OP_XCHG:
             a = STK(1); STK(1) = STK(2); STK(2) = a;
             break;
@@ -551,7 +555,10 @@ static naRef run(struct Context* ctx)
             FIXFRAME();
             break;
         case OP_EACH:
-            evalEach(ctx);
+            evalEach(ctx, 0);
+            break;
+        case OP_INDEX:
+            evalEach(ctx, 1);
             break;
         case OP_MARK: // save stack state (e.g. "setjmp")
             if(ctx->markTop >= MAX_MARK_DEPTH)

simgear/nasal/code.h

@@ -21,7 +21,8 @@ enum {
     OP_PUSHCONST, OP_PUSHONE, OP_PUSHZERO, OP_PUSHNIL, OP_POP,
     OP_DUP, OP_XCHG, OP_INSERT, OP_EXTRACT, OP_MEMBER, OP_SETMEMBER,
     OP_LOCAL, OP_SETLOCAL, OP_NEWVEC, OP_VAPPEND, OP_NEWHASH, OP_HAPPEND,
-    OP_MARK, OP_UNMARK, OP_BREAK, OP_FTAIL, OP_MTAIL, OP_SETSYM
+    OP_MARK, OP_UNMARK, OP_BREAK, OP_FTAIL, OP_MTAIL, OP_SETSYM, OP_DUP2,
+    OP_INDEX
 };
 
 struct Frame {

simgear/nasal/codegen.c

@@ -125,7 +125,7 @@ static int tailContext(struct Token* t)
     return 0;
 }
 
-static void genScalarConstant(struct Parser* p, struct Token* t)
+static int genScalarConstant(struct Parser* p, struct Token* t)
 {
     // These opcodes are for special-case use in other constructs, but
     // we might as well use them here to save a few bytes in the
@@ -137,26 +137,28 @@ static void genScalarConstant(struct Parser* p, struct Token* t)
     } else {
         int idx = findConstantIndex(p, t);
         emitImmediate(p, OP_PUSHCONST, idx);
+        return idx;
     }
+    return 0;
 }
 
-static int genLValue(struct Parser* p, struct Token* t)
+static int genLValue(struct Parser* p, struct Token* t, int* cidx)
 {
     if(t->type == TOK_LPAR) {
-        return genLValue(p, LEFT(t)); // Handle stuff like "(a) = 1"
+        return genLValue(p, LEFT(t), cidx); // Handle stuff like "(a) = 1"
     } else if(t->type == TOK_SYMBOL) {
-        genScalarConstant(p, t);
+        *cidx = genScalarConstant(p, t);
         return OP_SETSYM;
     } else if(t->type == TOK_DOT && RIGHT(t) && RIGHT(t)->type == TOK_SYMBOL) {
         genExpr(p, LEFT(t));
-        genScalarConstant(p, RIGHT(t));
+        *cidx = genScalarConstant(p, RIGHT(t));
         return OP_SETMEMBER;
     } else if(t->type == TOK_LBRA) {
         genExpr(p, LEFT(t));
         genExpr(p, RIGHT(t));
         return OP_INSERT;
     } else if(t->type == TOK_VAR && RIGHT(t) && RIGHT(t)->type == TOK_SYMBOL) {
-        genScalarConstant(p, RIGHT(t));
+        *cidx = genScalarConstant(p, RIGHT(t));
         return OP_SETLOCAL;
     } else {
         naParseError(p, "bad lvalue", t->line);
@@ -164,6 +166,23 @@ static int genLValue(struct Parser* p, struct Token* t)
     }
 }
 
+static void genEqOp(int op, struct Parser* p, struct Token* t)
+{
+    int cidx, setop = genLValue(p, LEFT(t), &cidx);
+    if(setop == OP_SETMEMBER) {
+        emit(p, OP_DUP2);
+        emit(p, OP_POP);
+        emitImmediate(p, OP_MEMBER, cidx);
+    } else if(setop == OP_INSERT) {
+        emit(p, OP_DUP2);
+        emit(p, OP_EXTRACT);
+    } else // OP_SETSYM, OP_SETLOCAL
+        emitImmediate(p, OP_LOCAL, cidx);
+    genExpr(p, RIGHT(t));
+    emit(p, op);
+    emit(p, setop);
+}
+
 static int defArg(struct Parser* p, struct Token* t)
 {
     if(t->type == TOK_LPAR) return defArg(p, RIGHT(t));
@@ -444,7 +463,7 @@ static void genFor(struct Parser* p, struct Token* t)
 
 static void genForEach(struct Parser* p, struct Token* t)
 {
-    int loopTop, jumpEnd, assignOp;
+    int loopTop, jumpEnd, assignOp, dummy;
     struct Token *elem, *body, *vec, *label=0;
     struct Token *h = LEFT(LEFT(t));
     int semis = countSemis(h);
@@ -464,9 +483,9 @@ static void genForEach(struct Parser* p, struct Token* t)
     genExpr(p, vec);
     emit(p, OP_PUSHZERO);
     loopTop = p->cg->codesz;
-    emit(p, OP_EACH);
+    emit(p, t->type == TOK_FOREACH ? OP_EACH : OP_INDEX);
     jumpEnd = emitJump(p, OP_JIFNIL);
-    assignOp = genLValue(p, elem);
+    assignOp = genLValue(p, elem, &dummy);
     emit(p, OP_XCHG);
     emit(p, assignOp);
     emit(p, OP_POP);
@@ -521,7 +540,7 @@ static void newLineEntry(struct Parser* p, int line)
 
 static void genExpr(struct Parser* p, struct Token* t)
 {
-    int i;
+    int i, dummy;
     if(t->line != p->cg->lastLine)
         newLineEntry(p, t->line);
     p->cg->lastLine = t->line;
@@ -539,6 +558,7 @@ static void genExpr(struct Parser* p, struct Token* t)
         genFor(p, t);
         break;
     case TOK_FOREACH:
+    case TOK_FORINDEX:
         genForEach(p, t);
         break;
     case TOK_BREAK: case TOK_CONTINUE:
@@ -567,7 +587,7 @@ static void genExpr(struct Parser* p, struct Token* t)
         genHash(p, LEFT(t));
         break;
     case TOK_ASSIGN:
-        i = genLValue(p, LEFT(t));
+        i = genLValue(p, LEFT(t), &dummy);
         genExpr(p, RIGHT(t));
         emit(p, i); // use the op appropriate to the lvalue
         break;
@@ -623,6 +643,11 @@ static void genExpr(struct Parser* p, struct Token* t)
     case TOK_NEQ:   genBinOp(OP_NEQ,    p, t); break;
     case TOK_GT:    genBinOp(OP_GT,     p, t); break;
     case TOK_GTE:   genBinOp(OP_GTE,    p, t); break;
+    case TOK_PLUSEQ:  genEqOp(OP_PLUS, p, t);  break;
+    case TOK_MINUSEQ: genEqOp(OP_MINUS, p, t); break;
+    case TOK_MULEQ:   genEqOp(OP_MUL, p, t);   break;
+    case TOK_DIVEQ:   genEqOp(OP_DIV, p, t);   break;
+    case TOK_CATEQ:   genEqOp(OP_CAT, p, t);   break;
     default:
         naParseError(p, "parse error", t->line);
     };

simgear/nasal/lex.c

@@ -44,6 +44,12 @@ struct Lexeme {
     {"...", TOK_ELLIPSIS},
     {"?", TOK_QUESTION},
     {"var", TOK_VAR},
+    {"+=", TOK_PLUSEQ},
+    {"-=", TOK_MINUSEQ},
+    {"*=", TOK_MULEQ},
+    {"/=", TOK_DIVEQ},
+    {"~=", TOK_CATEQ},
+    {"forindex", TOK_FORINDEX},
 };
 
 // Build a table of where each line ending is

simgear/nasal/lib.c

@@ -321,7 +321,7 @@ static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
 {
     int fidx;
     struct Frame* frame;
-    naRef result, fr = argc ? naNumValue(args[0]) : naNil();
+    naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
     if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
     fidx = (int)fr.num;
     if(fidx > ctx->fTop - 1) return naNil();
@@ -419,6 +419,19 @@ static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
     return naNum(r);
 }
 
+static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
+{
+    naRef func = argc > 0 ? args[0] : naNil();
+    naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
+    naRef next = argc > 2 ? args[2] : naNil();
+    if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
+        naRuntimeError(ctx, "bad argument to bind");
+    func = naNewFunc(ctx, func.ref.ptr.func->code);
+    func.ref.ptr.func->namespace = hash;
+    func.ref.ptr.func->next = next;
+    return func;
+}
+
 struct func { char* name; naCFunction func; };
 static struct func funcs[] = {
     { "size", size },
@@ -445,6 +458,7 @@ static struct func funcs[] = {
     { "find", f_find },
     { "split", f_split },
     { "rand", f_rand },
+    { "bind", f_bind },
 };
 
 naRef naStdLib(naContext c)

simgear/nasal/parse.c

@@ -6,7 +6,7 @@
 // (tight binding, do last).
 enum { PREC_BINARY, PREC_REVERSE, PREC_PREFIX, PREC_SUFFIX };
 
-#define MAX_PREC_TOKS 5
+#define MAX_PREC_TOKS 6
 struct precedence {
     int toks[MAX_PREC_TOKS];
     int rule;
@@ -14,7 +14,8 @@ struct precedence {
     { { TOK_SEMI, TOK_COMMA },                 PREC_REVERSE },
     { { TOK_ELLIPSIS },                        PREC_SUFFIX  },
     { { TOK_RETURN, TOK_BREAK, TOK_CONTINUE }, PREC_PREFIX  },
-    { { TOK_ASSIGN },                          PREC_REVERSE },
+    { { TOK_ASSIGN, TOK_PLUSEQ, TOK_MINUSEQ,
+        TOK_MULEQ, TOK_DIVEQ, TOK_CATEQ     }, PREC_REVERSE },
     { { TOK_COLON, TOK_QUESTION },             PREC_REVERSE },
     { { TOK_VAR },                             PREC_PREFIX  },
     { { TOK_OR },                              PREC_BINARY  },
@@ -227,7 +228,7 @@ static void fixBlockStructure(struct Parser* p, struct Token* start)
             addNewChild(t, c);
             fixBlockStructure(p, c);
             break;
-        case TOK_FOR: case TOK_FOREACH: case TOK_WHILE:
+        case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
         case TOK_IF: case TOK_ELSIF:
             // Expect a paren and then a curly
             if(!t->next || t->next->type != TOK_LPAR) oops(p, t);
@@ -278,7 +279,7 @@ static void fixBlockStructure(struct Parser* p, struct Token* start)
                || t->prev->type == TOK_LCURL)
                 addSemi = 1;
             break;
-        case TOK_FOR: case TOK_FOREACH: case TOK_WHILE:
+        case TOK_FOR: case TOK_FOREACH: case TOK_FORINDEX: case TOK_WHILE:
             addSemi = 1;
             break;
         case TOK_FUNC:
@@ -323,7 +324,7 @@ static int isBlock(int t)
 {
     return t == TOK_IF  || t == TOK_ELSIF   || t == TOK_ELSE
         || t == TOK_FOR || t == TOK_FOREACH || t == TOK_WHILE
-        || t == TOK_FUNC;
+        || t == TOK_FUNC || t == TOK_FORINDEX;
 }
 
 static void precChildren(struct Parser* p, struct Token* t);

simgear/nasal/parse.h

@@ -14,7 +14,9 @@ enum {
     TOK_ASSIGN, TOK_LT, TOK_LTE, TOK_EQ, TOK_NEQ, TOK_GT, TOK_GTE,
     TOK_IF, TOK_ELSIF, TOK_ELSE, TOK_FOR, TOK_FOREACH, TOK_WHILE,
     TOK_RETURN, TOK_BREAK, TOK_CONTINUE, TOK_FUNC, TOK_SYMBOL,
-    TOK_LITERAL, TOK_EMPTY, TOK_NIL, TOK_ELLIPSIS, TOK_QUESTION, TOK_VAR
+    TOK_LITERAL, TOK_EMPTY, TOK_NIL, TOK_ELLIPSIS, TOK_QUESTION, TOK_VAR,
+    TOK_PLUSEQ, TOK_MINUSEQ, TOK_MULEQ, TOK_DIVEQ, TOK_CATEQ,
+    TOK_FORINDEX
 };
 
 struct Token {