fixing misquoting of label in compiler output for begin0

compiler.rkt

@@ -466,11 +466,14 @@
 ;; Compiles a sequence of expressions.  The last expression will be compiled in the provided linkage.
 (define (compile-sequence seq cenv target linkage) 
   ;; All but the last will use next-linkage linkage.
-  (if (last-exp? seq)
-      (compile (first-exp seq) cenv target linkage)
-      (append-instruction-sequences 
-       (compile (first-exp seq) cenv target next-linkage/drop-multiple)
-       (compile-sequence (rest-exps seq) cenv target linkage))))
+  (cond [(empty? seq)
+         (end-with-linkage linkage cenv empty-instruction-sequence)]
+        [(empty? (rest seq))
+         (compile (first seq) cenv target linkage)]
+        [else
+         (append-instruction-sequences 
+          (compile (first seq) cenv target next-linkage/drop-multiple)
+          (compile-sequence (rest seq) cenv target linkage))]))
 
 
 
@@ -478,7 +481,9 @@
 ;; Compiles a sequence of expressions.  A continuation prompt wraps around each of the expressions
 ;; to delimit any continuation captures.
 (define (compile-splice seq cenv target linkage) 
-  (cond [(last-exp? seq)
+  (cond [(empty? seq)
+         (end-with-linkage linkage cenv empty-instruction-sequence)]
+        [(empty? (rest seq))
          (let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
                 [on-return (make-LinkedLabel (make-label 'beforePromptPop)
                                                      on-return/multiple)])
@@ -490,7 +495,7 @@
               `(,(make-PushControlFrame/Prompt
                   default-continuation-prompt-tag
                   on-return)))
-             (compile (first-exp seq) cenv target return-linkage/nontail)
+             (compile (first seq) cenv target return-linkage/nontail)
              (emit-values-context-check-on-procedure-return (linkage-context linkage)
                                                             on-return/multiple
                                                             on-return))))]
@@ -503,14 +508,14 @@
              `(,(make-PushControlFrame/Prompt
                  (make-DefaultContinuationPromptTag)
                  on-return)))
-            (compile (first-exp seq) cenv target return-linkage/nontail)
+            (compile (first seq) cenv target return-linkage/nontail)
             on-return/multiple
             (make-instruction-sequence
              `(,(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount)
                                                        (make-Const 1))
                                      (make-Const 0))))
             on-return
-            (compile-splice (rest-exps seq) cenv target linkage)))]))
+            (compile-splice (rest seq) cenv target linkage)))]))
 
 
 (: compile-begin0 ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
@@ -563,7 +568,7 @@
            ,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
            ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
            ,(make-PopEnvironment (make-Const 1) (make-Const 0))
-           after-values-reinstated))
+           ,after-values-reinstated))
         
         (let ([context (linkage-context linkage)])
           (cond
@@ -587,7 +592,7 @@
                                                                 (make-Const context)))
                                                 after-check)
                   ,(make-PerformStatement (make-RaiseContextExpectedValuesError! context))
-                  after-check)))]))
+                  ,after-check)))]))
         
         (make-instruction-sequence
          `(,(make-AssignImmediateStatement target (make-Reg 'val))))

expression-structs.rkt

@@ -148,17 +148,6 @@
 
 
 
-(: last-exp? ((Listof Expression) -> Boolean))
-(define (last-exp? seq) 
-  (null? (cdr seq)))
-
-(: first-exp ((Listof Expression) -> Expression))
-(define (first-exp seq) (car seq))
-
-(: rest-exps ((Listof Expression) -> (Listof Expression)))
-(define (rest-exps seq) (cdr seq))
-
-
 
 
 (: make-label (Symbol -> Symbol))

test-compiler-2.rkt

@@ -5,15 +5,30 @@
          "simulator-helpers.rkt"
          "compiler.rkt"
          "compiler-structs.rkt"
-         "parse.rkt"
+         ;;"parse.rkt"
+         "parse-bytecode-5.1.1.rkt"
          "il-structs.rkt")
 
+(require (prefix-in racket: racket/base))
+
+
+;; Use Racket's compiler, and then parse the resulting bytecode
+;; to our own AST structures.
+(define (parse stx)
+  (parameterize ([current-namespace (make-base-namespace)])
+    (let ([bc (racket:compile stx)]
+          [op (open-output-bytes)])
+      (write bc op)
+      (parse-bytecode 
+       (open-input-bytes (get-output-bytes op))))))
+
 
 (define (run-compiler code)
   (compile (parse code) 'val next-linkage/drop-multiple))
   
 
 
+
 ;; run: machine -> (machine number)
 ;; Run the machine to completion.
 (define (run code
@@ -88,7 +103,7 @@
 
 
 ;; tak test
-(test '(begin (define (tak x y z)
+(test '(let () (define (tak x y z)
                (if (>= y x)
                    z
                    (tak (tak (- x 1) y z)
@@ -101,7 +116,7 @@
 
 
 ;; ctak
-(test '(begin
+(test '(let ()
         (define (ctak x y z)
           (call-with-current-continuation
            (lambda (k)
@@ -139,7 +154,7 @@
 
 
 ;; fibonacci
-(test '(begin (define (fib n)
+(test '(let () (define (fib n)
                (if (= n 0) 0
                    (if (= n 1) 1
                        (+ (fib (- n 1))
@@ -148,7 +163,7 @@
       55)
 
 ;; Fibonacci, iterative.  This should be computable while using at most 10 spots.
-(test '(begin 
+(test '(let () 
         (define (fib n)
           (fib-iter 1 0 n))
         

test-compiler.rkt

@@ -1317,6 +1317,8 @@
       (list (list 3)
             (cons '(5 6) 4)))
 
+(test '(begin) (void))
+
 
 
 #;(test (read (open-input-file "tests/conform/program0.sch"))