diff --git a/racket/src/cify/generate.rkt b/racket/src/cify/generate.rkt index 18877484bf..236e654290 100644 --- a/racket/src/cify/generate.rkt +++ b/racket/src/cify/generate.rkt @@ -286,10 +286,14 @@ (out-open "if (~a_count != 1)" vals-id) (return ret runstack #:can-omit? #t (format "scheme_values(~a_count, (Scheme_Object **)~a)" vals-id (runstack-ref runstack vals-id))) - (out-close+open "else") - (return ret runstack #:can-omit? #t #:can-pre-pop? #t - (runstack-ref runstack vals-id)) - (out-close!) + (cond + [(return-can-omit-single? ret) + (out-close!)] + [else + (out-close+open "else") + (return ret runstack #:can-omit? #t #:can-pre-pop? #t + (runstack-ref runstack vals-id)) + (out-close!)]) (runstack-pop! runstack) (out-close "}")] [`(if ,orig-tst ,thn ,els) @@ -402,7 +406,7 @@ (hash-ref top-names id #f))) "/*needed*/" "")) - (generate (multiple-return values-ret) `(begin . ,body1) env) + (generate (only-multiple-return values-ret) `(begin . ,body1) env) (out-open "{") (define bind-count (for/sum ([id (in-list ids)] @@ -1041,7 +1045,7 @@ (generate (format "~a =" (top-ref #f id)) rhs #f #hasheq() runstack knowns top-names state lambdas prim-names prim-knowns)] [`(define-values (,ids ...) ,rhs) - (generate (multiple-return "/*needed*/") rhs #f #hasheq() + (generate (only-multiple-return "/*needed*/") rhs #f #hasheq() runstack knowns top-names state lambdas prim-names prim-knowns) (generate-multiple-value-binds ids runstack #f state top-names)] [`,_ diff --git a/racket/src/cify/main.rkt b/racket/src/cify/main.rkt index 53e01fdd54..c7bf6ef71c 100644 --- a/racket/src/cify/main.rkt +++ b/racket/src/cify/main.rkt @@ -19,7 +19,8 @@ "union.rkt" "debug.rkt") -(provide (rename-out [main-cify cify])) +(provide (rename-out [main-cify cify]) + re-unique) (define (main-cify out-file exports in-e prim-knowns #:debug? [debug? #f] diff --git a/racket/src/cify/return.rkt b/racket/src/cify/return.rkt index 67ef33fcf1..3114bece3a 100644 --- a/racket/src/cify/return.rkt +++ b/racket/src/cify/return.rkt @@ -3,12 +3,15 @@ (provide (struct-out tail-return) (struct-out multiple-return) + (struct-out only-multiple-return) (struct-out multiple-return/suffix) return - return-can-omit?) + return-can-omit? + return-can-omit-single?) (struct tail-return (function-id lam self-args leaf?)) (struct multiple-return (prefix)) +(struct only-multiple-return multiple-return ()) (struct multiple-return/suffix multiple-return (generate-suffix)) (define (return ret runstack s @@ -41,3 +44,5 @@ (and (multiple-return? ret) (equal? (multiple-return-prefix ret) "")))) +(define (return-can-omit-single? ret) + (only-multiple-return? ret)) diff --git a/racket/src/cify/unique.rkt b/racket/src/cify/unique.rkt index e0ae174cb0..9bc990f75a 100644 --- a/racket/src/cify/unique.rkt +++ b/racket/src/cify/unique.rkt @@ -67,6 +67,9 @@ [`(let . ,_) (re-unique-let e env)] [`(letrec . ,_) (re-unique-let e env)] [`(letrec* . ,_) (re-unique-let e env)] + ;; Recognize `values` form so we can use this on schemify input, too + [`(let-values . ,_) (re-unique-let-values e env)] + [`(letrec-values . ,_) (re-unique-let-values e env)] [`(set! ,id ,rhs) `(set! ,(re-unique id env) ,(re-unique rhs env))] [`(,rator ,rands ...) @@ -92,6 +95,20 @@ `[,id ,(re-unique rhs rhs-env)]) . ,(re-unique-body body body-env))])) + (define (re-unique-let-values e env) + (match e + [`(,let-values-id ([(,idss ...) ,rhss] ...) . ,body) + (define rec? (not (eq? let-values-id 'let-values))) + (define new-idss (map select-unique idss)) + (define body-env (for/fold ([env env]) ([ids (in-list idss)] + [new-ids (in-list new-idss)]) + (env-add env ids new-ids))) + (define rhs-env (if rec? body-env env)) + `(,let-values-id ,(for/list ([ids (in-list new-idss)] + [rhs (in-list rhss)]) + `[,ids ,(re-unique rhs rhs-env)]) + . ,(re-unique-body body body-env))])) + (define (env-add env ids new-ids) (cond [(null? ids) env] diff --git a/racket/src/racket/src/cify-startup.rkt b/racket/src/racket/src/cify-startup.rkt index 0343fd0dbf..86a6eb5cab 100644 --- a/racket/src/racket/src/cify-startup.rkt +++ b/racket/src/racket/src/cify-startup.rkt @@ -66,10 +66,15 @@ (define-values (bodys/constants-lifted lifted-constants) (time (convert-for-serialize l #t))) +;; Startup code reuses names to keep it compact; make +;; te names unique again +(define bodys/re-uniqued + (cdr (re-unique `(begin . ,bodys/constants-lifted)))) + (printf "Schemify...\n") (define body (time - (schemify-body bodys/constants-lifted prim-knowns #hasheq() #hasheq() + (schemify-body bodys/re-uniqued prim-knowns #hasheq() #hasheq() ;; for cify: #t ;; unsafe mode: