From 10e1d446e2c2a29a16aa715a17b78b5da40e5b43 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Mon, 7 Mar 2011 18:46:11 -0500
Subject: [PATCH] continuing to work on test-compiler.rkt

---
 compile.rkt       |  5 +++--
 parse.rkt         |  3 ++-
 test-compiler.rkt | 53 +++++++++++++++++++++++++++++++++++------------
 3 files changed, 45 insertions(+), 16 deletions(-)

diff --git a/compile.rkt b/compile.rkt
index 8780fdf..f4e5378 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -16,8 +16,9 @@
 (: -compile (ExpressionCore Target Linkage -> (Listof Statement)))
 (define (-compile exp target linkage)
   (statements
-   (compile exp 
-            (list (make-Prefix (find-toplevel-variables exp)))
+   (compile (make-Top (make-Prefix (find-toplevel-variables exp))
+                      exp)
+            (list)
             target 
             linkage)))
 
diff --git a/parse.rkt b/parse.rkt
index 05ff75d..ffab5e5 100644
--- a/parse.rkt
+++ b/parse.rkt
@@ -9,7 +9,7 @@
     [(quoted? exp)
      (make-Constant (text-of-quotation exp))]
     [(variable? exp)
-     (make-Var exp)]      
+     (make-Var exp)] 
     [(definition? exp)
      (make-Def (definition-variable exp)
                (parse (definition-value exp)))]
@@ -38,6 +38,7 @@
   (cond
     [(number? exp) #t]
     [(string? exp) #t]
+    [(boolean? exp) #t]
     [else #f]))
 
 (define (variable? exp) (symbol? exp))
diff --git a/test-compiler.rkt b/test-compiler.rkt
index 4772b9b..384be6f 100644
--- a/test-compiler.rkt
+++ b/test-compiler.rkt
@@ -5,33 +5,60 @@
          "compile.rkt"
          "parse.rkt")
 
+
+(define (run-compiler code)
+  (compile (parse code) 'val 'next))
+  
+
 ;; Test out the compiler, using the simulator.
 (define-syntax (test stx)
   (syntax-case stx ()
     [(_ code exp)
      (with-syntax ([stx stx])
        (syntax/loc #'stx
-         (let* ([a-machine (run (new-machine (compile (parse code) 'val 'next)))]
-                [actual (machine-val a-machine)])
-           (unless (equal? actual exp)
-             (raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
-                                 #'stx)))))]))
+         (begin
+           (printf "Running ~s...\n" 'code)
+           (let*-values([(a-machine num-steps) 
+                         (run (new-machine (run-compiler 'code)))]
+                        [(actual) (machine-val a-machine)])
+             (unless (equal? actual exp)
+               (raise-syntax-error #f (format "Expected ~s, got ~s" exp actual)
+                                   #'stx))
+             (printf "ok. ~s steps\n\n" num-steps)))))]))
 
-;; run: machine -> machine
+;; run: machine -> (machine number)
 ;; Run the machine to completion.
 (define (run m)
-  (cond
-    [(can-step? m)
-     (run (step m))]
-    [else
-     m]))
+  (let loop ([m m]
+             [steps 0])
+    (cond
+      [(can-step? m)
+       (loop (step m) (add1 steps))]
+      [else
+       (values m steps)])))
 
 
+;; Atomic expressions
 (test 42 42)
-(test '(begin (define x 42)
-              (+ x x))
+(test "hello world" "hello world")
+(test #t true)
+(test #f false)
+
+;; quoted 
+(test '(+ 3 4)
+      '(+ 3 4))
+
+;; Simple definitions
+(test (begin (define x 42)
+             (+ x x))
       84)
 
+(test (begin (define x 6)
+             (define y 7)
+             (define z 8)
+             (* x y z))
+      (* 6 7 8))
+
 
 ;(simulate (compile (parse '42) 'val 'next))
 ;(compile (parse '(+ 3 4)) 'val 'next)
\ No newline at end of file