fix places where a lambda name was fumbled
original commit: 7fc5a6c5c6ce9f7979ca88e71c79521b5f5ad408
This commit is contained in:
parent
b53e6a990c
commit
6d65be6234
11
mats/misc.ms
11
mats/misc.ms
|
@ -4778,6 +4778,11 @@
|
|||
(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-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)
|
||||
(ok-name? (procedure-name procedure-name) "procedure-name")
|
||||
(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-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))
|
||||
(andmap ok-name?
|
||||
(map
|
||||
|
|
6
s/cp0.ss
6
s/cp0.ss
|
@ -719,7 +719,7 @@
|
|||
(if (or new-name
|
||||
(not (fx= flags (preinfo-lambda-flags 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)))
|
||||
|
||||
(define preinfo-call->preinfo-lambda
|
||||
|
@ -4878,8 +4878,8 @@
|
|||
(build-let (list x) (list (build-primcall 3 'cons (list zero zero)))
|
||||
(build-primcall 3 'cons (list ref-x ref-x))))))
|
||||
(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
|
||||
(constant code-flag-guardian)))
|
||||
(make-preinfo-lambda (preinfo-src preinfo) (preinfo-sexpr preinfo)
|
||||
#f (preinfo-lambda-name preinfo) (constant code-flag-guardian)))
|
||||
(cons
|
||||
(list '()
|
||||
(let* ([x (cp0-make-temp #t)] [ref-x (build-ref x)])
|
||||
|
|
Loading…
Reference in New Issue
Block a user