Merge pull request #113 from nvt/fix/begin-tail-flag

expr: evaluate begin sequentially, tail-flag only the last expression

Author: nvt

core/expr-primitives.c

@@ -444,12 +444,37 @@ VM_FUNCTION(return)
 
 VM_FUNCTION(begin)
 {
-  /* Defer the evaluation of the arguments in order to set
-     the tail call flag when executing the last argument. */
-  VM_EVAL_SET_REQUESTED_RANGE(thread, 1, thread->expr->argc);
-  VM_SET_FLAG(thread->expr->flags, VM_EXPR_TAIL_CALL);
-  if(VM_EVAL_COMPLETED(thread, argc - 1)) {
+  int last_eval_arg;
+
+  if(argc == 0) {
+    /* (begin) evaluates to an unspecified value. */
+    VM_EVAL_STOP(thread);
+    return;
+  }
+
+  /* Evaluate the expressions one at a time, in order, using the same
+     sequential pattern as `and`/`or`. Only the FINAL expression is in tail
+     position; the leading ones run for effect, so the tail-call flag must
+     stay clear while they evaluate. Setting it for all of them (as a single
+     up-front request did) wrongly marks a non-last recursive call, such as
+     the first (f x) in (begin (f x) (g x)), as a tail call, so it gets
+     tail-folded and never returns. The value of `begin` is its last
+     expression. */
+  last_eval_arg = highest_bit_set(thread->expr->eval_completed);
+  if(last_eval_arg == argc - 1) {
     VM_PUSH(&argv[argc - 1]);
+    VM_EVAL_STOP(thread);
+  } else if(last_eval_arg == -1) {
+    if(argc == 1) {
+      VM_SET_FLAG(thread->expr->flags, VM_EXPR_TAIL_CALL);
+    }
+    VM_EVAL_ARG(thread, 0);
+  } else {
+    if(last_eval_arg + 2 == argc) {
+      /* About to evaluate the last expression, which is in tail position. */
+      VM_SET_FLAG(thread->expr->flags, VM_EXPR_TAIL_CALL);
+    }
+    VM_EVAL_ARG(thread, last_eval_arg + 1);
   }
 }
 

tests/unit-tests/r5rs/test-begin-tail.scm

@@ -0,0 +1,48 @@
+;;; VeloxVM Unit Tests - begin tail-position semantics (R5RS 4.2.3 / 3.5)
+;;;
+;;; Regression for the begin tail-flag bug in core/expr-primitives.c: begin
+;;; used to mark ALL of its sub-expressions as tail calls, not just the
+;;; last. A non-last recursive call inside a begin was therefore wrongly
+;;; tail-folded (its frame reused) and never actually recursed, so the
+;;; expressions after it ran far too few times. Only the FINAL expression
+;;; of a begin is in tail position; the leading ones run for effect.
+;;;
+;;; Depths are kept small so the genuine (non-tail) recursion fits the
+;;; VM context stack; the point is correctness, not depth.
+
+(include "../unit-test-framework.scm")
+
+(test-suite "begin: only the last expression is in tail position")
+
+;; In (begin (recurse) (bump!)) the recursion must run to completion, so
+;; bump! fires once per level on the way back up. Before the fix the
+;; recursive call was tail-folded and bump! fired exactly once.
+(define counter (make-vector 1 0))
+(define (descend n)
+  (when (> n 0)
+    (begin (descend (- n 1))                                  ; non-tail
+           (vector-set! counter 0 (+ 1 (vector-ref counter 0)))))) ; tail
+(descend 12)
+(assert-equal 12 (vector-ref counter 0)
+              "leading recursive call in begin runs to completion")
+
+;; Three expressions: the first is a non-tail recursive call, the middle
+;; and last run for effect. Each level adds 2, so g(10) yields 20.
+(define c2 (make-vector 1 0))
+(define (g n)
+  (when (> n 0)
+    (begin (g (- n 1))
+           (vector-set! c2 0 (+ 1 (vector-ref c2 0)))
+           (vector-set! c2 0 (+ 1 (vector-ref c2 0))))))
+(g 10)
+(assert-equal 20 (vector-ref c2 0)
+              "all leading expressions of a begin run, not just the last")
+
+;; Tail recursion through begin's LAST expression must still fold (no
+;; overflow at depth far beyond the context stack).
+(define (countdown n)
+  (when (> n 0) (begin 1 (countdown (- n 1)))))
+(countdown 200000)
+(assert-true #t "tail call in begin's last expression still folds (no overflow)")
+
+(test-summary)