From 8a4f21c7c8424071d4a59510b4e44832707d339b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 22 Dec 2019 05:52:47 -0700 Subject: [PATCH] cs: avoid unnecessary procedure unnaming in core --- racket/src/cs/convert.rkt | 4 +++- racket/src/racket/src/cify-startup.rkt | 4 +++- racket/src/schemify/infer-name.rkt | 8 +++++--- racket/src/schemify/schemify.rkt | 18 ++++++++++-------- 4 files changed, 21 insertions(+), 13 deletions(-) diff --git a/racket/src/cs/convert.rkt b/racket/src/cs/convert.rkt index e7a86c6acf..3af5287504 100644 --- a/racket/src/cs/convert.rkt +++ b/racket/src/cs/convert.rkt @@ -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 diff --git a/racket/src/racket/src/cify-startup.rkt b/racket/src/racket/src/cify-startup.rkt index be5b38e633..996c7e9d6a 100644 --- a/racket/src/racket/src/cify-startup.rkt +++ b/racket/src/racket/src/cify-startup.rkt @@ -83,7 +83,9 @@ ;; unsafe mode: #t ;; no prompts: - #t))) + #t + ;; no explicit unnamed: + #f))) (printf "Lift...\n") (define lifted-body diff --git a/racket/src/schemify/infer-name.rkt b/racket/src/schemify/infer-name.rkt index 9a9b5dca50..9519ee4045 100644 --- a/racket/src/schemify/infer-name.rkt +++ b/racket/src/schemify/infer-name.rkt @@ -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))) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 7d24473c4c..bb18829d94 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -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