; Try: (for i 1 10 (write i))

(exec-at-metalevel
  (define (eval-for var init final body env cont)
    (let ((ext-env (extend env var init)))
	(eval-for-helper var final body ext-env cont))))

(exec-at-metalevel
 (define (eval-for-helper var final body env cont)
  (base-eval
    body
    env
    (lambda (x) 
      (eval-var 
	var 
	env
	(lambda (val)
	  (if (= val final)
	    (cont x)
	    (eval-set!
	      (list 'set! var (+ val 1)) 
	      env 
	      (lambda (y) 
		(eval-for-helper
		  var
		  final
		  body
		  env
		  cont))))))))))

(exec-at-metalevel
  (let ((old-eval base-eval))
    (set!
      base-eval
      (lambda (exp env cont)
	(if (and (pair? exp) (eq? (car exp) 'for))
	  (eval-for
	    (car (cdr exp))
	    (car (cdr (cdr exp)))
	    (car (cdr (cdr (cdr exp))))
	    (car (cdr (cdr (cdr (cdr exp)))))
	    env
	    cont)
	  (old-eval exp env cont))))))