unbreak cify on "startup.inc"
Commit7cbeebbb89
broke the input to cify, andeb73837baf
uncovered a different problem.
This commit is contained in:
parent
a25efeb8a9
commit
facba8a6ab
|
@ -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)]
|
||||
[`,_
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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:
|
||||
|
|
Loading…
Reference in New Issue
Block a user