Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 09:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Refactoring

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

23
scheme/cyclone/cgen.sld
View file

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

55
scheme/cyclone/transforms.sld
View file

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