Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Less verbose CPS debug printing

Browse source
This commit is contained in:
Justin Ethier 2018-05-21 13:31:37 -04:00
parent df0f325c00
commit e705824a6d
2 changed files with 40 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
cyclone.scm
View file

@ -405,23 +405,23 @@
;; No need for call/cc yet
(set! input-program cps))))
(trace:info "---------------- after CPS:")
(trace:info input-program) ;pretty-print
(trace:info (ast:ast->pp-sexp input-program))
(when (> *optimization-level* 0)
(set! input-program
(optimize-cps input-program))
(trace:info "---------------- after cps optimizations (1):")
(trace:info input-program)
(trace:info (ast:ast->pp-sexp input-program))
(set! input-program
(optimize-cps input-program))
(trace:info "---------------- after cps optimizations (2):")
(trace:info input-program)
(trace:info (ast:ast->pp-sexp input-program))
(set! input-program
(optimize-cps input-program))
(trace:info "---------------- after cps optimizations (3):")
(trace:info input-program)
(trace:info (ast:ast->pp-sexp input-program))
)
(set! input-program

36
scheme/cyclone/ast.sld
View file

@ -24,12 +24,15 @@
ast:lambda-has-cont
ast:set-lambda-has-cont!
ast:get-next-lambda-id!
ast:ast->pp-sexp
)
(begin
(define *lambda-id* 0)
(define (ast:get-next-lambda-id!)
(set! *lambda-id* (+ 1 *lambda-id*))
*lambda-id*)
(define-record-type <lambda-ast>
(ast:%make-lambda id args body has-cont)
ast:lambda?
@ -38,8 +41,41 @@
(body ast:lambda-body ast:set-lambda-body!)
(has-cont ast:lambda-has-cont ast:set-lambda-has-cont!)
)
(define (ast:make-lambda args body . opts)
(let ((has-cont (if (pair? opts) (car opts) #f)))
(set! *lambda-id* (+ 1 *lambda-id*))
(ast:%make-lambda *lambda-id* args body has-cont)))
;; Transform a SEXP in AST form to one that prints more cleanly
(define (ast:ast->pp-sexp exp)
(cond
((ast:lambda? exp)
(let* ((id (ast:lambda-id exp))
(has-cont (ast:lambda-has-cont exp))
(sym (string->symbol
(string-append
"lambda-"
(number->string id)
(if has-cont "-cont" ""))))
)
`(,sym ,(ast:lambda-args exp)
,@(map ast:ast->pp-sexp (ast:lambda-body exp))))
)
((quote? exp) exp)
((const? exp) exp)
((ref? exp) exp)
((define? exp)
`(define ,(define->var exp)
,@(ast:ast->pp-sexp (define->exp exp))))
((set!? exp)
`(set! ,(set!->var exp)
,(ast:ast->pp-sexp (set!->exp exp))))
((if? exp)
`(if ,(ast:ast->pp-sexp (if->condition exp))
,(ast:ast->pp-sexp (if->then exp))
,(ast:ast->pp-sexp (if->else exp))))
((app? exp)
(map ast:ast->pp-sexp exp))
(else exp)))
))