diff options
Diffstat (limited to 'csc/codegen-test.csc')
| -rw-r--r-- | csc/codegen-test.csc | 234 |
1 files changed, 118 insertions, 116 deletions
diff --git a/csc/codegen-test.csc b/csc/codegen-test.csc index 03f6b11..ef1c88b 100644 --- a/csc/codegen-test.csc +++ b/csc/codegen-test.csc @@ -1,130 +1,132 @@ -(import (scheme base) - (only (csc gensym) - gensym) - (only (csc ir2) - *globals* - make-apply - make-branch - make-closure - make-constant - make-fix - make-label - make-library-ref - make-primitive - make-variable) - (only (csc loop) - loop - return) - (only (csc match) - match) - (only (csc testing) - assert-equal - test) - (csc codegen)) +(define-library (csc codegen-test) + (import (scheme base) + (only (csc gensym) + gensym) + (only (csc ir2) + *globals* + make-apply + make-branch + make-closure + make-constant + make-fix + make-label + make-library-ref + make-primitive + make-variable) + (only (csc loop) + loop + return) + (only (csc match) + match) + (only (csc testing) + assert-equal + test) + (csc codegen)) + (begin -(define (test-var) - (make-variable (gensym))) + (define (test-var) + (make-variable (gensym))) -(define (test-label) - (make-label (gensym))) + (define (test-label) + (make-label (gensym))) -(test codegen-apply - (define p (test-var)) - (assert-equal - '((label init) - (peek (local 1) (local 0) (const 5)) - (mov (local 2) (local 1)) - (mov (local 1) (const 10)) - (jmp (local 2))) - (ir2->ir3 - (make-fix '() - (make-primitive 'peek (list *globals* (make-constant 5)) (list p) - (make-apply p (list (make-constant 10)))))))) + (test codegen-apply + (define p (test-var)) + (assert-equal + '((label init) + (peek (local 1) (local 0) (const 5)) + (mov (local 2) (local 1)) + (mov (local 1) (const 10)) + (jmp (local 2))) + (ir2->ir3 + (make-fix '() + (make-primitive 'peek (list *globals* (make-constant 5)) (list p) + (make-apply p (list (make-constant 10)))))))) -(test codegen-call-global - (define p (test-var)) - (assert-equal - '((label init) - (peek (local 1) (local 0) (global cons (csc based))) - (mov (local 3) (local 1)) - (mov (local 1) (const 5)) - (mov (local 2) (const ())) - (jmp (local 3))) - (ir2->ir3 - (make-fix '() - (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p) - (make-apply p (list (make-constant 5) (make-constant '())))))))) + (test codegen-call-global + (define p (test-var)) + (assert-equal + '((label init) + (peek (local 1) (local 0) (global cons (csc based))) + (mov (local 3) (local 1)) + (mov (local 1) (const 5)) + (mov (local 2) (const ())) + (jmp (local 3))) + (ir2->ir3 + (make-fix '() + (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p) + (make-apply p (list (make-constant 5) (make-constant '())))))))) -(test codegen-call-known - (define f (test-label)) - (define ret (test-var)) - (assert-equal - '((label 0) - (mov (local 2) (local 1)) - (jmp (local 2)) - (label init) - (mov (local 1) (label 0)) - (jmp (label 0))) - (ir2->ir3 - (make-fix - (list (make-closure f (list ret) - (make-apply ret (list ret)))) - (make-apply f (list f)))))) + (test codegen-call-known + (define f (test-label)) + (define ret (test-var)) + (assert-equal + '((label 0) + (mov (local 2) (local 1)) + (jmp (local 2)) + (label init) + (mov (local 1) (label 0)) + (jmp (label 0))) + (ir2->ir3 + (make-fix + (list (make-closure f (list ret) + (make-apply ret (list ret)))) + (make-apply f (list f)))))) -(test codegen-permute - (define f (test-label)) - (define g (test-label)) - (define f1 (test-var)) - (define f2 (test-var)) - (define g1 (test-var)) - (define g2 (test-var)) - (define g3 (test-var)) - (assert-equal - '((label 0) - (mov (local 127) (local 1)) - (mov (local 1) (local 2)) - (mov (local 2) (local 127)) - (mov (local 3) (const 0)) - (jmp (label 1)) - (label 1) - (mov (local 2) (local 1)) - (mov (local 1) (local 3)) - (jmp (label 0)) - (label init) - (mov (local 1) (const 0)) - (mov (local 2) (const 1)) - (jmp (label 0))) - (ir2->ir3 - (make-fix - (list (make-closure f (list f1 f2) - (make-apply g (list f2 f1 (make-constant 0)))) - (make-closure g (list g1 g2 g3) - (make-apply f (list g3 g1)))) - (make-apply f (list (make-constant 0) (make-constant 1))))))) + (test codegen-permute + (define f (test-label)) + (define g (test-label)) + (define f1 (test-var)) + (define f2 (test-var)) + (define g1 (test-var)) + (define g2 (test-var)) + (define g3 (test-var)) + (assert-equal + '((label 0) + (mov (local 127) (local 1)) + (mov (local 1) (local 2)) + (mov (local 2) (local 127)) + (mov (local 3) (const 0)) + (jmp (label 1)) + (label 1) + (mov (local 2) (local 1)) + (mov (local 1) (local 3)) + (jmp (label 0)) + (label init) + (mov (local 1) (const 0)) + (mov (local 2) (const 1)) + (jmp (label 0))) + (ir2->ir3 + (make-fix + (list (make-closure f (list f1 f2) + (make-apply g (list f2 f1 (make-constant 0)))) + (make-closure g (list g1 g2 g3) + (make-apply f (list g3 g1)))) + (make-apply f (list (make-constant 0) (make-constant 1))))))) -(test codegen-branch - (define p (test-var)) - (assert-equal - '((label init) - (peek (local 1) (local 0) (const 1)) - (jmpif (const #t) (label 0)) - (mov (local 2) (local 1)) - (mov (local 1) (const 10)) - (jmp (local 2)) - (label 0) - (mov (local 2) (local 1)) - (mov (local 1) (const 5)) - (jmp (local 2))) - (ir2->ir3 - (make-fix '() - (make-primitive 'peek (list *globals* (make-constant 1)) (list p) - (make-branch (make-constant #t) - (make-apply p (list (make-constant 5))) - (make-apply p (list (make-constant 10))))))))) + (test codegen-branch + (define p (test-var)) + (assert-equal + '((label init) + (peek (local 1) (local 0) (const 1)) + (jmpif (const #t) (label 0)) + (mov (local 2) (local 1)) + (mov (local 1) (const 10)) + (jmp (local 2)) + (label 0) + (mov (local 2) (local 1)) + (mov (local 1) (const 5)) + (jmp (local 2))) + (ir2->ir3 + (make-fix '() + (make-primitive 'peek (list *globals* (make-constant 1)) (list p) + (make-branch (make-constant #t) + (make-apply p (list (make-constant 5))) + (make-apply p (list (make-constant 10))))))))))) |