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

fix places where a lambda name was fumbled

Browse Source 
original commit: 7fc5a6c5c6ce9f7979ca88e71c79521b5f5ad408
This commit is contained in:
Matthew Flatt 2020-06-03 10:42:34 -06:00
parent b53e6a990c
commit 6d65be6234
2 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
mats/misc.ms
View File

@ -4778,6 +4778,11 @@
(define should-be-named-h (let ([f (let ([h (lambda (x) x)]) h)]) f)) (define should-be-named-h (let ([f (let ([h (lambda (x) x)]) h)]) f))
(define should-be-named-i (letrec ([f (let ([i (lambda (x) x)]) i)]) f)) (define should-be-named-i (letrec ([f (let ([i (lambda (x) x)]) i)]) f))
(define should-be-named-j (let ([f (letrec ([j (lambda (x) x)]) j)]) f)) (define should-be-named-j (let ([f (letrec ([j (lambda (x) x)]) j)]) f))
(define (result-should-be-named-mk-CP)
(let ([struct:CP (make-record-type-descriptor* 'CP #f #f #f #f 1 1)])
(let ([mk-CP (record-constructor (make-record-constructor-descriptor
struct:CP #f #f))])
mk-CP)))
#t) #t)
(ok-name? (procedure-name procedure-name) "procedure-name") (ok-name? (procedure-name procedure-name) "procedure-name")
(ok-name? (procedure-name should-be-named-f) "f") (ok-name? (procedure-name should-be-named-f) "f")
@ -4786,6 +4791,12 @@
(ok-name? (procedure-name should-be-named-i) "i") (ok-name? (procedure-name should-be-named-i) "i")
(ok-name? (procedure-name should-be-named-j) "j") (ok-name? (procedure-name should-be-named-j) "j")
(or (not (enable-cp0))
(let ([gx (make-guardian)])
(ok-name? (procedure-name gx) "gx")))
(or (not (enable-cp0))
(ok-name? (procedure-name (result-should-be-named-mk-CP)) "mk-CP"))
(or (not (enable-cp0)) (or (not (enable-cp0))
(andmap ok-name? (andmap ok-name?
(map (map

6
s/cp0.ss
View File

@ -719,7 +719,7 @@
(if (or new-name (if (or new-name
(not (fx= flags (preinfo-lambda-flags preinfo)))) (not (fx= flags (preinfo-lambda-flags preinfo))))
(make-preinfo-lambda (preinfo-src preinfo) (preinfo-sexpr preinfo) (make-preinfo-lambda (preinfo-src preinfo) (preinfo-sexpr preinfo)
(preinfo-lambda-libspec preinfo) new-name flags) (preinfo-lambda-libspec preinfo) (or new-name (preinfo-lambda-name preinfo)) flags)
preinfo))) preinfo)))
(define preinfo-call->preinfo-lambda (define preinfo-call->preinfo-lambda
@ -4878,8 +4878,8 @@
(build-let (list x) (list (build-primcall 3 'cons (list zero zero))) (build-let (list x) (list (build-primcall 3 'cons (list zero zero)))
(build-primcall 3 'cons (list ref-x ref-x)))))) (build-primcall 3 'cons (list ref-x ref-x))))))
(build-case-lambda (let ([preinfo (preinfo-call->preinfo-lambda (app-preinfo ctxt) (app-name ctxt))]) (build-case-lambda (let ([preinfo (preinfo-call->preinfo-lambda (app-preinfo ctxt) (app-name ctxt))])
(make-preinfo-lambda (preinfo-src preinfo) (preinfo-sexpr preinfo) #f #f (make-preinfo-lambda (preinfo-src preinfo) (preinfo-sexpr preinfo)
(constant code-flag-guardian))) #f (preinfo-lambda-name preinfo) (constant code-flag-guardian)))
(cons (cons
(list '() (list '()
(let* ([x (cp0-make-temp #t)] [ref-x (build-ref x)]) (let* ([x (cp0-make-temp #t)] [ref-x (build-ref x)])