<commit_before>(define (analyzed-answer program)
  (let ((candidate
	 (assoc (macroexpand program)
		(analysis-bindings (analyze program)))))
    (if (not candidate)
	(error "Analysis makes no binding for the original program"
	       program)
	(caddr candidate))))

(define (determined-form-breakage value form)
  (cond ((not (equal? (macroexpand form) (macroexpand (macroexpand form))))
	 `(not (equal? ,(macroexpand form) ,(macroexpand (macroexpand form)))))
	((not (equal? value (vl-eval form)))
	 `(not (equal? ,value (interpreted ,(vl-eval form)))))
	((not (equal? value (analyzed-answer form)))
	 `(not (equal? ,value (analyzed ,(analyzed-answer form)))))
	((not (equal? `(begin ,value) (compile-to-scheme form)))
	 `(not (equal? ,value (compiled ,(compile-to-scheme form)))))
	(else #f)))

(define (%eval-through-scheme program)
  (eval (compile-to-scheme program) (nearest-repl/environment)))

(define (eval-through-scheme program)
  (let ((interpreted-answer (vl-eval program))
	(compiled-answer (%eval-through-scheme program)))
    (if (equal? interpreted-answer compiled-answer)
	compiled-answer
	(error "VL compiler disagreed with VL interpreter"
	       `((interpreted: ,interpreted-answer)
		 (compiled: ,compiled-answer))))))

(in-test-group
 vl

 (define-each-check
   (equal? '((lambda (x) 1) 3)
	   (macroexpand '((lambda (x) 1) 3)))
   (equal? '(lambda ((cons x y)) x)
	   (macroexpand '(lambda ((cons x y)) x)))

   (equal? '((lambda ((cons x y)) x) (cons 1 2))
	   (macroexpand '((lambda (x y) x) (cons 1 2))))
   (not (determined-form-breakage 1 '((lambda (x y) x) (cons 1 2))))
   (not (determined-form-breakage 2 '((lambda (x y) y) (cons 1 2))))

   (equal? '((lambda ((cons x y)) x) (cons 1 2))
	   (macroexpand '((lambda (x y) x) 1 2)))
   (not (determined-form-breakage 1 '((lambda (x y) x) 1 2)))
   (not (determined-form-breakage 2 '((lambda (x y) y) 1 2)))

   (equal? '((lambda ((cons x (cons y z))) x) (cons 1 (cons 2 3)))
	   (macroexpand '((lambda (x y z) x) 1 2 3)))
   (not (determined-form-breakage 1 '((lambda (x y z) x) 1 2 3)))
   (not (determined-form-breakage 2 '((lambda (x y z) y) 1 2 3)))
   (not (determined-form-breakage 3 '((lambda (x y z) z) 1 2 3)))

   (equal? '((lambda ((cons (cons x y) z)) x) (cons (cons 1 2) 3))
	   (macroexpand '((lambda ((cons x y) z) x) (cons 1 2) 3)))
   (not (determined-form-breakage 1 '((lambda ((cons x y) z) x) (cons 1 2) 3)))
   (not (determined-form-breakage 2 '((lambda ((cons x y) z) y) (cons 1 2) 3)))
   (not (determined-form-breakage 3 '((lambda ((cons x y) z) z) (cons 1 2) 3)))

   (equal? '((lambda ((cons (cons x (cons y ())) z)) x)
	     (cons (cons 1 (cons 2 ())) 3))
	   (macroexpand '((lambda ((x y) z) x)
			  (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 1
         '((lambda ((x y) z) x)
	   (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 2
         '((lambda ((x y) z) y)
	   (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 3
         '((lambda ((x y) z) z)
	   (cons 1 (cons 2 ())) 3)))

   (equal? '((lambda (()) 1) ())
	   (macroexpand '((lambda () 1))))
   (not (determined-form-breakage 1 '((lambda () 1))))

   (equal? 3 (vl-eval 3))
   (equal? 1 (vl-eval '((lambda (x) 1) 3)))
   (equal? 3 (vl-eval '((lambda (x y) 3) 1 2)))
   (equal? 3 (vl-eval '((lambda ((cons x y)) 3) (cons 1 2))))
   (equal? 2 (vl-eval '((lambda ((cons x y)) y) (cons 1 2))))
   (equal? '(1 . 3) (vl-eval '((lambda (x (y . z) w)
				 (cons x z))
			       1 (cons 2 3) 4)))
   (equal? 4 (vl-eval '(+ 1 3)))
   (equal? 3 (vl-eval '(let ((x 3)) x)))
   (equal? '(8 . 16)
	   (vl-eval '(let ((double (lambda (x)
				     (+ x x)))
			   (square (lambda (x)
				     (* x x)))
			   (compose (lambda (f g)
				      (lambda (x) (f (g x))))))
		       (cons ((compose double square) 2)
			     ((compose square double) 2)))))

   (equal? '(3 . 2) (analyzed-answer '(cons 3 2)))
   (equal? 2 (analyzed-answer '((lambda (x) 2) 3)))
   (equal? 2 (analyzed-answer '((lambda (x y) 2) 3 4)))
   (equal? 3 (analyzed-answer '((lambda (x y) x) 3 4)))
   (equal? 4 (analyzed-answer '((lambda (x y) y) 3 4)))
   (equal? '(8 . 16)
	   (analyzed-answer
	    '(let ((double (lambda (x)
			     (+ x x)))
		   (square (lambda (x)
			     (* x x)))
		   (compose (lambda (f g)
			      (lambda (x) (f (g x))))))
	       (cons ((compose double square) 2)
		     ((compose square double) 2)))))
   (equal? '((abstract-real) . (abstract-real))
    (analyzed-answer
     '(let ((double (lambda (x)
		      (+ x x)))
	    (square (lambda (x)
		      (* x x)))
	    (compose (lambda (f g)
		       (lambda (x) (f (g x))))))
	(cons ((compose double square) (real 2))
	      ((compose square double) (real 2))))))
   (equal? '(8 . 16) 
    (eval-through-scheme
     '(let ((double (lambda (x)
		      (+ x x)))
	    (square (lambda (x)
		      (* x x)))
	    (compose (lambda (f g)
		       (lambda (x) (f (g x))))))
	(cons ((compose double square) (real 2))
	      ((compose square double) (real 2))))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn (real 5))))
	  (add5 (real 3))))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn (real 5))))
	  (add5 3)))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn 5)))
	  (add5 (real 3))))))
   (equal? 27
    (eval-through-scheme
     '(let ((cube (lambda (x)
		    (* x (* x x)))))
	(let ((enlarge-upto (lambda (bound)
			      (lambda (x)
				(if (< x bound)
				    (cube x)
				    x)))))
	  ((enlarge-upto (real 20)) (real 3))))))
   (equal? 1
    (eval-through-scheme
     '(letrec ((fact (lambda (n)
		       (if (= n 1)
			   1
			   (* n (fact (- n 1)))))))
	(fact 1))))
   (equal? 120
    (eval-through-scheme
     '(letrec ((fact (lambda (n)
		       (if (= n 1)
			   1
			   (* n (fact (- n 1)))))))
	(fact (real 5)))))
   (equal? 10
    (eval-through-scheme
     '(let loop ((count (real 0)))
	(if (< count 10)
	    (loop (+ count 1))
	    count))))
   )

 (define-test (example-sanity)
   (with-input-from-file "examples.scm"
    (lambda ()
      (let loop ((program (read)))
	(if (not (eof-object? program))
	    ;; Check that vl-eval and compile-to-scheme agree
	    (begin (eval-through-scheme program)
		   (loop (read))))))))
 )<commit_msg>Ha!  It turns out that I can read the examples file at test definition time rather than test execution time, and define a separate test for each example!<commit_after>(define (analyzed-answer program)
  (let ((candidate
	 (assoc (macroexpand program)
		(analysis-bindings (analyze program)))))
    (if (not candidate)
	(error "Analysis makes no binding for the original program"
	       program)
	(caddr candidate))))

(define (determined-form-breakage value form)
  (cond ((not (equal? (macroexpand form) (macroexpand (macroexpand form))))
	 `(not (equal? ,(macroexpand form) ,(macroexpand (macroexpand form)))))
	((not (equal? value (vl-eval form)))
	 `(not (equal? ,value (interpreted ,(vl-eval form)))))
	((not (equal? value (analyzed-answer form)))
	 `(not (equal? ,value (analyzed ,(analyzed-answer form)))))
	((not (equal? `(begin ,value) (compile-to-scheme form)))
	 `(not (equal? ,value (compiled ,(compile-to-scheme form)))))
	(else #f)))

(define (%eval-through-scheme program)
  (eval (compile-to-scheme program) (nearest-repl/environment)))

(define (eval-through-scheme program)
  (let ((interpreted-answer (vl-eval program))
	(compiled-answer (%eval-through-scheme program)))
    (if (equal? interpreted-answer compiled-answer)
	compiled-answer
	(error "VL compiler disagreed with VL interpreter"
	       `((interpreted: ,interpreted-answer)
		 (compiled: ,compiled-answer))))))

(in-test-group
 vl

 (define-each-check
   (equal? '((lambda (x) 1) 3)
	   (macroexpand '((lambda (x) 1) 3)))
   (equal? '(lambda ((cons x y)) x)
	   (macroexpand '(lambda ((cons x y)) x)))

   (equal? '((lambda ((cons x y)) x) (cons 1 2))
	   (macroexpand '((lambda (x y) x) (cons 1 2))))
   (not (determined-form-breakage 1 '((lambda (x y) x) (cons 1 2))))
   (not (determined-form-breakage 2 '((lambda (x y) y) (cons 1 2))))

   (equal? '((lambda ((cons x y)) x) (cons 1 2))
	   (macroexpand '((lambda (x y) x) 1 2)))
   (not (determined-form-breakage 1 '((lambda (x y) x) 1 2)))
   (not (determined-form-breakage 2 '((lambda (x y) y) 1 2)))

   (equal? '((lambda ((cons x (cons y z))) x) (cons 1 (cons 2 3)))
	   (macroexpand '((lambda (x y z) x) 1 2 3)))
   (not (determined-form-breakage 1 '((lambda (x y z) x) 1 2 3)))
   (not (determined-form-breakage 2 '((lambda (x y z) y) 1 2 3)))
   (not (determined-form-breakage 3 '((lambda (x y z) z) 1 2 3)))

   (equal? '((lambda ((cons (cons x y) z)) x) (cons (cons 1 2) 3))
	   (macroexpand '((lambda ((cons x y) z) x) (cons 1 2) 3)))
   (not (determined-form-breakage 1 '((lambda ((cons x y) z) x) (cons 1 2) 3)))
   (not (determined-form-breakage 2 '((lambda ((cons x y) z) y) (cons 1 2) 3)))
   (not (determined-form-breakage 3 '((lambda ((cons x y) z) z) (cons 1 2) 3)))

   (equal? '((lambda ((cons (cons x (cons y ())) z)) x)
	     (cons (cons 1 (cons 2 ())) 3))
	   (macroexpand '((lambda ((x y) z) x)
			  (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 1
         '((lambda ((x y) z) x)
	   (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 2
         '((lambda ((x y) z) y)
	   (cons 1 (cons 2 ())) 3)))
   (not (determined-form-breakage 3
         '((lambda ((x y) z) z)
	   (cons 1 (cons 2 ())) 3)))

   (equal? '((lambda (()) 1) ())
	   (macroexpand '((lambda () 1))))
   (not (determined-form-breakage 1 '((lambda () 1))))

   (equal? 3 (vl-eval 3))
   (equal? 1 (vl-eval '((lambda (x) 1) 3)))
   (equal? 3 (vl-eval '((lambda (x y) 3) 1 2)))
   (equal? 3 (vl-eval '((lambda ((cons x y)) 3) (cons 1 2))))
   (equal? 2 (vl-eval '((lambda ((cons x y)) y) (cons 1 2))))
   (equal? '(1 . 3) (vl-eval '((lambda (x (y . z) w)
				 (cons x z))
			       1 (cons 2 3) 4)))
   (equal? 4 (vl-eval '(+ 1 3)))
   (equal? 3 (vl-eval '(let ((x 3)) x)))
   (equal? '(8 . 16)
	   (vl-eval '(let ((double (lambda (x)
				     (+ x x)))
			   (square (lambda (x)
				     (* x x)))
			   (compose (lambda (f g)
				      (lambda (x) (f (g x))))))
		       (cons ((compose double square) 2)
			     ((compose square double) 2)))))

   (equal? '(3 . 2) (analyzed-answer '(cons 3 2)))
   (equal? 2 (analyzed-answer '((lambda (x) 2) 3)))
   (equal? 2 (analyzed-answer '((lambda (x y) 2) 3 4)))
   (equal? 3 (analyzed-answer '((lambda (x y) x) 3 4)))
   (equal? 4 (analyzed-answer '((lambda (x y) y) 3 4)))
   (equal? '(8 . 16)
	   (analyzed-answer
	    '(let ((double (lambda (x)
			     (+ x x)))
		   (square (lambda (x)
			     (* x x)))
		   (compose (lambda (f g)
			      (lambda (x) (f (g x))))))
	       (cons ((compose double square) 2)
		     ((compose square double) 2)))))
   (equal? '((abstract-real) . (abstract-real))
    (analyzed-answer
     '(let ((double (lambda (x)
		      (+ x x)))
	    (square (lambda (x)
		      (* x x)))
	    (compose (lambda (f g)
		       (lambda (x) (f (g x))))))
	(cons ((compose double square) (real 2))
	      ((compose square double) (real 2))))))
   (equal? '(8 . 16) 
    (eval-through-scheme
     '(let ((double (lambda (x)
		      (+ x x)))
	    (square (lambda (x)
		      (* x x)))
	    (compose (lambda (f g)
		       (lambda (x) (f (g x))))))
	(cons ((compose double square) (real 2))
	      ((compose square double) (real 2))))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn (real 5))))
	  (add5 (real 3))))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn (real 5))))
	  (add5 3)))))
   (equal? 8
    (eval-through-scheme
     '(let ((addn (lambda (n) (lambda (x) (+ n x)))))
	(let ((add5 (addn 5)))
	  (add5 (real 3))))))
   (equal? 27
    (eval-through-scheme
     '(let ((cube (lambda (x)
		    (* x (* x x)))))
	(let ((enlarge-upto (lambda (bound)
			      (lambda (x)
				(if (< x bound)
				    (cube x)
				    x)))))
	  ((enlarge-upto (real 20)) (real 3))))))
   (equal? 1
    (eval-through-scheme
     '(letrec ((fact (lambda (n)
		       (if (= n 1)
			   1
			   (* n (fact (- n 1)))))))
	(fact 1))))
   (equal? 120
    (eval-through-scheme
     '(letrec ((fact (lambda (n)
		       (if (= n 1)
			   1
			   (* n (fact (- n 1)))))))
	(fact (real 5)))))
   (equal? 10
    (eval-through-scheme
     '(let loop ((count (real 0)))
	(if (< count 10)
	    (loop (+ count 1))
	    count))))
   )

 (with-input-from-file "../examples.scm"
   (lambda ()
     (let loop ((program (read)))
       (if (not (eof-object? program))
	   (begin (define-test ()
		    ;; Check that vl-eval and compile-to-scheme agree
		    (eval-through-scheme program))
		  (loop (read)))))))
 )
{'fraction_non_alphanumeric': 0.21471157568718544, 'fraction_numerical': 0.028029423151374373, 'mean_word_length': 2.7470263997679143, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3582710', 'n_tokens_mistral': 5480, 'n_tokens_neox': 4716, 'n_words': 1642}