safe-for-space repairs for functions with rest args

original commit: 0754ad0114
This commit is contained in:
Matthew Flatt 2011-04-22 14:42:57 -06:00
parent b3fd71415d
commit 9f2fba9625
4 changed files with 7 additions and 1 deletions

View File

@ -307,6 +307,7 @@
,@(if (and name (not (null? name))) ,@(if (and name (not (null? name)))
`(',name) `(',name)
null) null)
,@(if (null? flags) null `('(flags: ,@flags)))
,@(if (null? captures) ,@(if (null? captures)
null null
`('(captures: ,@(map (lambda (c t) `('(captures: ,@(map (lambda (c t)

View File

@ -257,6 +257,7 @@
(define CLOS_HAS_REST 1) (define CLOS_HAS_REST 1)
(define CLOS_HAS_REF_ARGS 2) (define CLOS_HAS_REF_ARGS 2)
(define CLOS_PRESERVES_MARKS 4) (define CLOS_PRESERVES_MARKS 4)
(define CLOS_NEED_REST_CLEAR 8)
(define CLOS_IS_METHOD 16) (define CLOS_IS_METHOD 16)
(define CLOS_SINGLE_RESULT 32) (define CLOS_SINGLE_RESULT 32)
@ -1006,6 +1007,7 @@
(+ (if rest? CLOS_HAS_REST 0) (+ (if rest? CLOS_HAS_REST 0)
(if any-refs? CLOS_HAS_REF_ARGS 0) (if any-refs? CLOS_HAS_REF_ARGS 0)
(if (memq 'preserves-marks flags) CLOS_PRESERVES_MARKS 0) (if (memq 'preserves-marks flags) CLOS_PRESERVES_MARKS 0)
(if (memq 'sfs-clear-rest-args flags) CLOS_NEED_REST_CLEAR 0)
(if (memq 'is-method flags) CLOS_IS_METHOD 0) (if (memq 'is-method flags) CLOS_IS_METHOD 0)
(if (memq 'single-result flags) CLOS_SINGLE_RESULT 0)) (if (memq 'single-result flags) CLOS_SINGLE_RESULT 0))
num-all-params num-all-params

View File

@ -81,6 +81,7 @@
(define CLOS_HAS_REST 1) (define CLOS_HAS_REST 1)
(define CLOS_HAS_REF_ARGS 2) (define CLOS_HAS_REF_ARGS 2)
(define CLOS_PRESERVES_MARKS 4) (define CLOS_PRESERVES_MARKS 4)
(define CLOS_NEED_REST_CLEAR 8)
(define CLOS_IS_METHOD 16) (define CLOS_IS_METHOD 16)
(define CLOS_SINGLE_RESULT 32) (define CLOS_SINGLE_RESULT 32)
(define BITS_PER_MZSHORT 32) (define BITS_PER_MZSHORT 32)
@ -118,6 +119,7 @@
(if (zero? (bitwise-and flags flags CLOS_PRESERVES_MARKS)) null '(preserves-marks)) (if (zero? (bitwise-and flags flags CLOS_PRESERVES_MARKS)) null '(preserves-marks))
(if (zero? (bitwise-and flags flags CLOS_IS_METHOD)) null '(is-method)) (if (zero? (bitwise-and flags flags CLOS_IS_METHOD)) null '(is-method))
(if (zero? (bitwise-and flags flags CLOS_SINGLE_RESULT)) null '(single-result)) (if (zero? (bitwise-and flags flags CLOS_SINGLE_RESULT)) null '(single-result))
(if (zero? (bitwise-and flags flags CLOS_NEED_REST_CLEAR)) null '(sfs-clear-rest-args))
(if (and rest? (zero? num-params)) '(only-rest-arg-not-used) null)) (if (and rest? (zero? num-params)) '(only-rest-arg-not-used) null))
(if (and rest? (num-params . > . 0)) (if (and rest? (num-params . > . 0))
(sub1 num-params) (sub1 num-params)

View File

@ -131,7 +131,8 @@
[internal-context (or/c #f #t stx?)])) [internal-context (or/c #f #t stx?)]))
(define-form-struct (lam expr) ([name (or/c symbol? vector? empty?)] (define-form-struct (lam expr) ([name (or/c symbol? vector? empty?)]
[flags (listof (or/c 'preserves-marks 'is-method 'single-result 'only-rest-arg-not-used))] [flags (listof (or/c 'preserves-marks 'is-method 'single-result
'only-rest-arg-not-used 'sfs-clear-rest-args))]
[num-params exact-nonnegative-integer?] [num-params exact-nonnegative-integer?]
[param-types (listof (or/c 'val 'ref 'flonum))] [param-types (listof (or/c 'val 'ref 'flonum))]
[rest? boolean?] [rest? boolean?]