suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: avoid unnecessary procedure unnaming in core

Browse Source
This commit is contained in:
Matthew Flatt 2019-12-22 05:52:47 -07:00
parent c8c3647da5
commit 8a4f21c7c8
4 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/cs/convert.rkt
View File

@ -113,7 +113,9 @@
(printf "Schemify...\n")
(define body
(time
(schemify-body bodys/constants-lifted prim-knowns primitives #hasheq() #hasheq() for-cify? unsafe-mode? #t)))
(schemify-body bodys/constants-lifted prim-knowns primitives #hasheq() #hasheq() for-cify? unsafe-mode?
#t ; no-prompt?
#f))) ; explicit-unnamed?
(printf "Lift...\n")
;; Lift functions to avoid closure creation:
(define lifted-body

4
racket/src/racket/src/cify-startup.rkt
View File

@ -83,7 +83,9 @@
;; unsafe mode:
#t
;; no prompts:
#t)))
#t
;; no explicit unnamed:
#f)))
(printf "Lift...\n")
(define lifted-body

8
racket/src/schemify/infer-name.rkt
View File

@ -4,7 +4,7 @@
(provide infer-procedure-name)
(define (infer-procedure-name orig-s new-s)
(define (infer-procedure-name orig-s new-s explicit-unnamed?)
(define inferred-name (wrap-property orig-s 'inferred-name))
(cond
[(symbol? inferred-name)
@ -47,13 +47,15 @@
(string-append (source->string src)
"::"
(number->string pos)))]
[else ; includes `(void? inferred-name)`
[(or explicit-unnamed?
(void? inferred-name))
;; We can't provide a source name, but explicitly
;; suppress any other inferred name:
(wrap-property-set (reannotate orig-s new-s)
'inferred-name
;; Hack: "[" means "no name"
'|[|)])]))
'|[|)]
[else new-s])]))
(define (source->string src)
(define str (if (string? src) src (path->string src)))

18
racket/src/schemify/schemify.rkt
View File

@ -138,7 +138,7 @@
(define-values (new-body defn-info mutated)
(schemify-body* bodys/constants-lifted prim-knowns primitives imports exports
for-interp? allow-set!-undefined? add-import! #f
unsafe-mode? enforce-constant? allow-inline? no-prompt?))
unsafe-mode? enforce-constant? allow-inline? no-prompt? #t))
(define all-grps (append grps (reverse new-grps)))
(values
;; Build `lambda` with schemified body:
@ -186,17 +186,17 @@
;; ----------------------------------------
(define (schemify-body l prim-knowns primitives imports exports for-cify? unsafe-mode? no-prompt?)
(define (schemify-body l prim-knowns primitives imports exports for-cify? unsafe-mode? no-prompt? explicit-unnamed?)
(with-deterministic-gensym
(define-values (new-body defn-info mutated)
(schemify-body* l prim-knowns primitives imports exports
#f #f (lambda (im ext-id index) #f)
for-cify? unsafe-mode? #t #t no-prompt?))
for-cify? unsafe-mode? #t #t no-prompt? explicit-unnamed?))
new-body))
(define (schemify-body* l prim-knowns primitives imports exports
for-interp? allow-set!-undefined? add-import!
for-cify? unsafe-mode? enforce-constant? allow-inline? no-prompt?)
for-cify? unsafe-mode? enforce-constant? allow-inline? no-prompt? explicit-unnamed?)
;; Keep simple checking efficient by caching results
(define simples (make-hasheq))
;; Various conversion steps need information about mutated variables,
@ -254,7 +254,7 @@
allow-set!-undefined?
add-import!
for-cify? for-interp?
unsafe-mode? allow-inline? no-prompt?
unsafe-mode? allow-inline? no-prompt? explicit-unnamed?
(if (and no-prompt? (null? (cdr l)))
'tail
'fresh)))
@ -436,7 +436,7 @@
;; a 'too-early state in `mutated` for a `letrec`-bound variable can be
;; effectively canceled with a mapping in `knowns`.
(define (schemify v prim-knowns primitives knowns mutated imports exports simples allow-set!-undefined? add-import!
for-cify? for-interp? unsafe-mode? allow-inline? no-prompt? wcm-state)
for-cify? for-interp? unsafe-mode? allow-inline? no-prompt? explicit-unnamed? wcm-state)
;; `wcm-state` is one of: 'tail (= unknown), 'fresh (= no marks), or 'marked (= some marks)
(let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [wcm-state wcm-state] [v v])
(define (schemify v wcm-state)
@ -447,13 +447,15 @@
[`(lambda ,formals ,body ...)
(infer-procedure-name
v
`(lambda ,formals ,@(schemify-body body 'tail)))]
`(lambda ,formals ,@(schemify-body body 'tail))
explicit-unnamed?)]
[`(case-lambda [,formalss ,bodys ...] ...)
(infer-procedure-name
v
`(case-lambda ,@(for/list ([formals (in-list formalss)]
[body (in-list bodys)])
`[,formals ,@(schemify-body body 'tail)])))]
`[,formals ,@(schemify-body body 'tail)]))
explicit-unnamed?)]
[`(define-values (,struct:s ,make-s ,s? ,acc/muts ...)
(let-values (((,struct: ,make ,?1 ,-ref ,-set!) ,mk))
(values ,struct:2