From afe5e6baa76796b1467890fd55416a7f304bed5c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 20 Aug 2009 14:33:38 +0200
Subject: [PATCH] eval is actually compile

* module/ice-9/boot-9.scm (eval): Here at the tail of boot-9, replace
  the root definition of `eval' with a procedure that will call
  `compile'.

* test-suite/tests/syntax.test ("top-level define"):
  ("internal define"): Run unmemoization tests in the interpreter, using
  primitive-eval.
---
 module/ice-9/boot-9.scm      |  8 +++++++
 test-suite/tests/syntax.test | 46 +++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a3a1e0384..ead175d0d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3492,6 +3492,14 @@ module '(ice-9 q) '(make-q q-length))}."
 
 
 
+;;; Replace the C evaluator with the compiler.
+;;;
+
+(define (eval x env)
+  ((@ (system base compile) compile) x #:from 'scheme #:to 'value #:env env))
+
+
+
 ;;; Place the user in the guile-user module.
 ;;;
 
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 0593ea6a6..282072b5b 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -1,6 +1,6 @@
 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001,2003,2004, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001,2003,2004, 2005, 2006, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -807,21 +807,20 @@
   (with-test-prefix "unmemoization"
 
     (pass-if "definition unmemoized without prior execution"
-      (eval '(begin 
-               (define (blub) (cons ('(1 . 2)) 2))
-               (equal?
-                 (procedure-source blub)
-                 '(lambda () (cons ('(1 . 2)) 2))))
-            (interaction-environment)))
+      (primitive-eval '(begin 
+                         (define (blub) (cons ('(1 . 2)) 2))
+                         (equal?
+                          (procedure-source blub)
+                          '(lambda () (cons ('(1 . 2)) 2))))))
+    
 
     (pass-if "definition with documentation unmemoized without prior execution"
-      (eval '(begin 
-               (define (blub) "Comment" (cons ('(1 . 2)) 2))
-               (equal?
-                 (procedure-source blub)
-                 '(lambda () "Comment" (cons ('(1 . 2)) 2))))
-            (interaction-environment))))
-
+      (primitive-eval '(begin 
+                         (define (blub) "Comment" (cons ('(1 . 2)) 2))
+                         (equal?
+                          (procedure-source blub)
+                          '(lambda () "Comment" (cons ('(1 . 2)) 2)))))))
+  
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
@@ -896,16 +895,15 @@
           (interaction-environment)))
 
   (pass-if "unmemoization"
-    (eval '(begin
-             (define (foo) 
-               (define (bar)
-                 'ok)
-               (bar))
-             (foo)
-             (matches?
-              (procedure-source foo)
-              (lambda () (letrec ((_ (lambda () (quote ok)))) (_)))))
-          (current-module))))
+    (primitive-eval '(begin
+                       (define (foo) 
+                         (define (bar)
+                           'ok)
+                         (bar))
+                       (foo)
+                       (matches?
+                        (procedure-source foo)
+                        (lambda () (letrec ((_ (lambda () (quote ok)))) (_))))))))
 
 (with-test-prefix "set!"
 
-- 
2.20.1