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

make procedure-arity-mask reliable for record constructors

Browse Source 
When a record-type constructor is formed dynamically,
and when it had more than 6 arguments, use a wrapper
to explicitly set the constructor's arity.

Relevant to racket/racket#2390

original commit: 0a8d335b4f479681dc6dcb5e67126aa3a97357c3
This commit is contained in:
Matthew Flatt 2018-11-19 19:53:22 -07:00
parent 31b7c8fd7a
commit f635d5da42
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
s/record.ss
View File

@ -826,10 +826,12 @@
[(5) (nlambda 5)]
[(6) (nlambda 6)]
[else (rec constructor
(lambda xr
(unless (fx= (length xr) nflds)
($oops #f "incorrect number of arguments to ~s" constructor))
(apply $record rtd xr)))]))
($make-arity-wrapper-procedure
(lambda xr
(unless (fx= (length xr) nflds)
($oops #f "incorrect number of arguments to ~s" constructor))
(apply $record rtd xr))
(ash 1 nflds)))]))
(let* ([args (make-record-call-args flds (rtd-size rtd)
(map (lambda (x) 0) flds))]
[nargs (length args)]
@ -923,12 +925,14 @@
[else #f])]
[else #f])])
(rec constructor
(lambda xr
(unless (fx= (length xr) nflds)
($oops #f "incorrect number of arguments to ~s" constructor))
(let ([x (apply $record rtd args)])
(for-each (lambda (setter v) (setter x v)) setters xr)
x)))))))))
($make-arity-wrapper-procedure
(lambda xr
(unless (fx= (length xr) nflds)
($oops #f "incorrect number of arguments to ~s" constructor))
(let ([x (apply $record rtd args)])
(for-each (lambda (setter v) (setter x v)) setters xr)
x))
(ash 1 nflds)))))))))
(define ($rcd->record-constructor rcd)
(let ([rtd (rcd-rtd rcd)] [protocol (rcd-protocol rcd)])