starting to work on debugging the generated il
This commit is contained in:
parent
414f806580
commit
872ea81adc
11
compile.rkt
11
compile.rkt
|
@ -9,8 +9,17 @@
|
||||||
"sets.rkt"
|
"sets.rkt"
|
||||||
racket/list)
|
racket/list)
|
||||||
|
|
||||||
(provide compile-top)
|
(provide (rename-out [-compile compile]))
|
||||||
|
|
||||||
|
;(provide compile-top)
|
||||||
|
|
||||||
|
(: -compile (ExpressionCore Target Linkage -> (Listof Statement)))
|
||||||
|
(define (-compile exp target linkage)
|
||||||
|
(statements
|
||||||
|
(compile exp
|
||||||
|
(list (make-Prefix (find-toplevel-variables exp)))
|
||||||
|
target
|
||||||
|
linkage)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
37
test-compiler.rkt
Normal file
37
test-compiler.rkt
Normal file
|
@ -0,0 +1,37 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require "simulator.rkt"
|
||||||
|
"simulator-structs.rkt"
|
||||||
|
"compile.rkt"
|
||||||
|
"parse.rkt")
|
||||||
|
|
||||||
|
;; 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)))))]))
|
||||||
|
|
||||||
|
;; run: machine -> machine
|
||||||
|
;; Run the machine to completion.
|
||||||
|
(define (run m)
|
||||||
|
(cond
|
||||||
|
[(can-step? m)
|
||||||
|
(run (step m))]
|
||||||
|
[else
|
||||||
|
m]))
|
||||||
|
|
||||||
|
|
||||||
|
(test 42 42)
|
||||||
|
(test '(begin (define x 42)
|
||||||
|
(+ x x))
|
||||||
|
84)
|
||||||
|
|
||||||
|
|
||||||
|
;(simulate (compile (parse '42) 'val 'next))
|
||||||
|
;(compile (parse '(+ 3 4)) 'val 'next)
|
Loading…
Reference in New Issue
Block a user