From 8041448c474742228b6cd45ca3e468a1cdcd559c Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 12 May 2011 16:42:08 -0400 Subject: [PATCH] fixing misquoting of label in compiler output for begin0 --- compiler.rkt | 27 ++++++++++++++++----------- expression-structs.rkt | 11 ----------- test-compiler-2.rkt | 25 ++++++++++++++++++++----- test-compiler.rkt | 2 ++ 4 files changed, 38 insertions(+), 27 deletions(-) diff --git a/compiler.rkt b/compiler.rkt index 721cd24..b307258 100644 --- a/compiler.rkt +++ b/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)))) diff --git a/expression-structs.rkt b/expression-structs.rkt index e9de74f..5b0b1b9 100644 --- a/expression-structs.rkt +++ b/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)) diff --git a/test-compiler-2.rkt b/test-compiler-2.rkt index faa569a..4599b5d 100644 --- a/test-compiler-2.rkt +++ b/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)) diff --git a/test-compiler.rkt b/test-compiler.rkt index 535cd86..2a938ec 100644 --- a/test-compiler.rkt +++ b/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"))