Refactoring

This commit is contained in:
Justin Ethier 2016-01-31 21:45:08 -05:00
parent d93d89a922
commit 8d88f69882
2 changed files with 40 additions and 38 deletions

View file

@ -817,9 +817,10 @@
(letrec ((num-args 0) (letrec ((num-args 0)
(_c-compile-args (_c-compile-args
(lambda (args append-preamble prefix cont) (lambda (args append-preamble prefix cont)
(if (not (pair? args)) (cond
(c-code "") ((not (pair? args))
(begin (c-code ""))
(else
;(trace:debug `(c-compile-args ,(car args))) ;(trace:debug `(c-compile-args ,(car args)))
(set! num-args (+ 1 num-args)) (set! num-args (+ 1 num-args))
(c:append/prefix (c:append/prefix

View file

@ -144,14 +144,13 @@
;; Trace ;; Trace
(define *trace-level* 2) (define *trace-level* 2)
(define (trace level msg pp prefix) (define (trace level msg pp prefix)
(if (>= *trace-level* level) (when (>= *trace-level* level)
(begin
(display "/* ") (display "/* ")
(newline) (newline)
(display prefix) (display prefix)
(pp msg) (pp msg)
(display " */") (display " */")
(newline)))) (newline)))
(define (trace:error msg) (trace 1 msg pretty-print "")) (define (trace:error msg) (trace 1 msg pretty-print ""))
(define (trace:warn msg) (trace 2 msg pretty-print "")) (define (trace:warn msg) (trace 2 msg pretty-print ""))
(define (trace:info msg) (trace 3 msg pretty-print "")) (define (trace:info msg) (trace 3 msg pretty-print ""))
@ -1041,34 +1040,36 @@
((prim? exp) (void)) ((prim? exp) (void))
((ref? exp) (void)) ((ref? exp) (void))
((quote? exp) (void)) ((quote? exp) (void))
((lambda? exp) (begin ((lambda? exp)
(map analyze-mutable-variables (lambda->exp exp)) (map analyze-mutable-variables (lambda->exp exp))
(void))) (void))
((set!? exp) (begin (mark-mutable (set!->var exp)) ((set!? exp)
(analyze-mutable-variables (set!->exp exp)))) (mark-mutable (set!->var exp))
((if? exp) (begin (analyze-mutable-variables (set!->exp exp)))
((if? exp)
(analyze-mutable-variables (if->condition exp)) (analyze-mutable-variables (if->condition exp))
(analyze-mutable-variables (if->then exp)) (analyze-mutable-variables (if->then exp))
(analyze-mutable-variables (if->else exp)))) (analyze-mutable-variables (if->else exp)))
; Sugar: ; Sugar:
((let? exp) (begin ((let? exp)
(map analyze-mutable-variables (map cadr (let->bindings exp))) (map analyze-mutable-variables (map cadr (let->bindings exp)))
(map analyze-mutable-variables (let->exp exp)) (map analyze-mutable-variables (let->exp exp))
(void))) (void))
((letrec? exp) (begin ((letrec? exp)
(map analyze-mutable-variables (map cadr (letrec->bindings exp))) (map analyze-mutable-variables (map cadr (letrec->bindings exp)))
(map analyze-mutable-variables (letrec->exp exp)) (map analyze-mutable-variables (letrec->exp exp))
(void))) (void))
((begin? exp) (begin ((begin? exp)
(map analyze-mutable-variables (begin->exps exp)) (map analyze-mutable-variables (begin->exps exp))
(void))) (void))
; Application: ; Application:
((app? exp) (begin ((app? exp)
(map analyze-mutable-variables exp) (map analyze-mutable-variables exp)
(void))) (void))
(else (error "unknown expression type: " exp)))) (else
(error "unknown expression type: " exp))))
; wrap-mutables : exp -> exp ; wrap-mutables : exp -> exp