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

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-11-13 18:02:12 -05:00
parent d40dc538d9
commit 67071a1761
2 changed files with 19 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
scheme/cyclone/cgen.sld
View file

@ -1181,6 +1181,13 @@
(c-code "") (c-code "")
args))) args)))
exps)) exps))
((equal? 'Cyc-local-set! fun)
(let ((val-exp (c-compile-exp (caddr exp) append-preamble cont ast-id trace cps?)))
(c-code/vars
(string-append (mangle (cadr exp) " = " (c:body val-exp) ";"))
(c:allocs val-exp)))
;(c-code (string-append (mangle (cadr exp)) " = " (mangle (caddr exp)) ";"))
)
((equal? 'let fun) ((equal? 'let fun)
(let* ((vars/vals (cadr exp)) (let* ((vars/vals (cadr exp))
(body (caddr exp)) (body (caddr exp))
@ -1192,13 +1199,16 @@
(c-code/vars (c-code/vars
(let ((cp1-body (c:body cp1))) (let ((cp1-body (c:body cp1)))
(string-append cp1-body ";" (c:body cp2))) (string-append cp1-body ";" (c:body cp2)))
(append (list (mangle (car var/val))) (c:allocs cp1) (c:allocs cp2))))) (append
(list (string-append "object " (mangle (car var/val)) ";"))
(c:allocs cp1)
(c:allocs cp2)))))
(c-code "") (c-code "")
vars/vals)) vars/vals))
(body-exp (c-compile-exp (body-exp (c-compile-exp
body append-preamble cont ast-id trace cps?)) body append-preamble cont ast-id trace cps?))
) )
(trace:error `(JAE DEBUG body ,body ,vars/vals ,exp)) ;;(trace:error `(JAE DEBUG body ,body ,vars/vals ,exp))
(c:append vexps body-exp) (c:append vexps body-exp)
) )
) )

12
scheme/cyclone/cps-opt-local-var-redux.scm
View file

@ -59,11 +59,13 @@
;; (car (ast:lambda-body (car exp))) ;; (car (ast:lambda-body (car exp)))
;; (car (ast:lambda-args (car exp)))))) ;; (car (ast:lambda-args (car exp))))))
;;(newline) ;;(newline)
TODO: need to revisit this, may need to replace values with assignments to the "let" variable. ;TODO: need to revisit this, may need to replace values with assignments to the "let" variable.
would need to be able to carry that through to cgen and assign properly over there... ;would need to be able to carry that through to cgen and assign properly over there...
(let ((value (lvr:tail-calls->values (let ((value (lvr:tail-calls->values
(car (ast:lambda-body (car exp))) (car (ast:lambda-body (car exp)))
(car (ast:lambda-args (car exp))))) (car (ast:lambda-args (car exp)))
(car (ast:lambda-args (cadr exp)))
))
(var (car (ast:lambda-args (cadr exp)))) (var (car (ast:lambda-args (cadr exp))))
(body (ast:lambda-body (cadr exp)))) (body (ast:lambda-body (cadr exp))))
`(let ((,var ,value)) `(let ((,var ,value))
@ -110,7 +112,7 @@ would need to be able to carry that through to cgen and assign properly over the
;; Local variable reduction helper: ;; Local variable reduction helper:
;; Transform all tail calls of sym in the sexp to just the value passed ;; Transform all tail calls of sym in the sexp to just the value passed
(define (lvr:tail-calls->values sexp sym) (define (lvr:tail-calls->values sexp sym assign-sym)
(call/cc (call/cc
(lambda (return) (lambda (return)
(define (scan exp) (define (scan exp)
@ -134,7 +136,7 @@ would need to be able to carry that through to cgen and assign properly over the
((and (equal? (car exp) sym) ((and (equal? (car exp) sym)
(= (length exp) 2) (= (length exp) 2)
) )
(cadr exp)) `(Cyc-local-set! ,assign-sym ,(cadr exp)))
(else (else
(return #f)))) (return #f))))
(else exp))) (else exp)))