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

Use ast lambda ID's in C code

Browse source
This commit is contained in:
Justin Ethier 2018-09-25 18:43:18 -04:00
parent 62145ea95a
commit ea7f401e77
1 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
scheme/cyclone/cgen.sld
View file

@ -903,9 +903,9 @@
(trace:error `(JAE found well-known lambda in closure-ref call (trace:error `(JAE found well-known lambda in closure-ref call
,(car args) ,(car args)
,wkf ,wkf
TODO: this is not going to work, we are going to need to use ast:lambda-id instead of ;TODO: this is not going to work, we are going to need to use ast:lambda-id instead of
an allocation ID. make that change in allocate-lambda, disable all WKL code, and make ;an allocation ID. make that change in allocate-lambda, disable all WKL code, and make
sure it is stable before proceeding... ;sure it is stable before proceeding...
cgen id ,(adbf:cgen-id fnc) cgen id ,(adbf:cgen-id fnc)
))) )))
) )
@ -943,7 +943,7 @@ sure it is stable before proceeding...
;need to use (well-known-lambda) to check the ref to see if it is a WKL. ;need to use (well-known-lambda) to check the ref to see if it is a WKL.
;if so, lookup ast and use cgen-id to map back to emit the lambda_gc_ret there ;if so, lookup ast and use cgen-id to map back to emit the lambda_gc_ret there
(with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc) (with-fnc (ast:lambda-id (closure->lam fun)) (lambda (fnc)
(if (and ;#f (if (and #f
(adbf:well-known fnc) (adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
(let* ((lid (adbf:cgen-id fnc)) (let* ((lid (adbf:cgen-id fnc))
@ -1159,13 +1159,17 @@ sure it is stable before proceeding...
;; Create/store/return a unique lambda-id for the given function. ;; Create/store/return a unique lambda-id for the given function.
(define (allocate-lambda ast:lam lam . cps?) (define (allocate-lambda ast:lam lam . cps?)
(let ((id num-lambdas)) (let ((id num-lambdas))
(set! num-lambdas (+ 1 num-lambdas)) (cond
((and ast:lam (equal? cps? '(#f)))
(set! id (ast:lambda-id ast:lam)))
(else
(set! num-lambdas (+ 1 num-lambdas))))
(set! lambdas (cons (list id lam ast:lam) lambdas)) (set! lambdas (cons (list id lam ast:lam) lambdas))
(if (equal? cps? '(#f)) (if (equal? cps? '(#f))
(set! inline-lambdas (cons id inline-lambdas))) (set! inline-lambdas (cons id inline-lambdas)))
(when ast:lam ;(when ast:lam
(with-fnc! (ast:lambda-id ast:lam) (lambda (fnc) ; (with-fnc! (ast:lambda-id ast:lam) (lambda (fnc)
(adbf:set-cgen-id! fnc id)))) ; (adbf:set-cgen-id! fnc id))))
id)) id))
; get-lambda : lambda-id -> (symbol -> string) ; get-lambda : lambda-id -> (symbol -> string)
@ -1245,7 +1249,7 @@ sure it is stable before proceeding...
(with-fnc ast-id (lambda (fnc) (with-fnc ast-id (lambda (fnc)
(trace:info `(c-compile-closure-element-ref ,ast-id ,var ,idx ,fnc)) (trace:info `(c-compile-closure-element-ref ,ast-id ,var ,idx ,fnc))
(cond (cond
((and ;#f ((and #f
(adbf:well-known fnc) (adbf:well-known fnc)
;(pair? (adbf:all-params fnc)) ;(pair? (adbf:all-params fnc))
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
@ -1287,7 +1291,7 @@ sure it is stable before proceeding...
(lid (allocate-lambda lam (c-compile-lambda lam trace cps?) cps?)) (lid (allocate-lambda lam (c-compile-lambda lam trace cps?) cps?))
(use-obj-instead-of-closure? (use-obj-instead-of-closure?
(with-fnc (ast:lambda-id lam) (lambda (fnc) (with-fnc (ast:lambda-id lam) (lambda (fnc)
(and ;#f (and #f
(adbf:well-known fnc) ;; Only optimize well-known functions (adbf:well-known fnc) ;; Only optimize well-known functions
;(equal? (length free-vars) 1) ;; Sanity check ;(equal? (length free-vars) 1) ;; Sanity check
(equal? (adbf:closure-size fnc) 1) ;; From closure conv (equal? (adbf:closure-size fnc) 1) ;; From closure conv
@ -1515,6 +1519,7 @@ sure it is stable before proceeding...
required-libs required-libs
src-file) src-file)
(set! *global-syms* (append globals (lib:idb:ids import-db))) (set! *global-syms* (append globals (lib:idb:ids import-db)))
(set! num-lambdas (+ (adb:max-lambda-id) 1))
(set! cgen:mangle-global (set! cgen:mangle-global
(lambda (ident) (lambda (ident)
(cond (cond
@ -1652,7 +1657,7 @@ sure it is stable before proceeding...
;; (equal? (adbf:closure-size fnc) 1)) ;; (equal? (adbf:closure-size fnc) 1))
;; (trace:error `(JAE ,(car l) ,l ,fnc))) ;; (trace:error `(JAE ,(car l) ,l ,fnc)))
(when (and ;#f (when (and #f
(adbf:well-known fnc) (adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
;(trace:error `(JAE ,(car l) ,l ,fnc)) ;(trace:error `(JAE ,(car l) ,l ,fnc))