From f635d5da4204da17b48e310b5f3bcf0a6a29a6f5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 19 Nov 2018 19:53:22 -0700 Subject: [PATCH] make `procedure-arity-mask` reliable for record constructors 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 --- s/record.ss | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/s/record.ss b/s/record.ss index 477bf316f8..c8866b4f85 100644 --- a/s/record.ss +++ b/s/record.ss @@ -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)])