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

improve compiler recognition of stuct constrcutors

Browse Source 
Allow a `struct` form to be recognized when it provides
a number as the 8th argument to `make-struct-type`. In
particular, that change allows the construction of
optional-keyword functions to be recognized as a
purely functional operation.

Also, allow the optimizer to use information about imports
when deciding whether a module-level form is functional.
It's ok to use that information, because the validator has
it, too.

This combination of changes allows something like

 (define (f #:optional [x #f])
   (later))

 (define (later) ....)

to compile to a reference to `later` wihout a check.
This commit is contained in:
Matthew Flatt 2016-07-28 06:53:33 -06:00
parent 0d0cf535de
commit 3f4e7d90cb
2 changed files with 89 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -4096,6 +4096,24 @@
(define (f v)
(and (c? v) (unsafe-struct-ref v 3)))))
(test-comp '(module m racket/base
(struct a (x y) #:omit-define-syntaxes
#:property prop:procedure 0)
(begin0
(a? (a-x (a 1 2)))
a?
a
a-x
(a? 7)
(a 1 2)
5))
'(module m racket/base
(struct a (x y) #:omit-define-syntaxes
#:property prop:procedure 0)
(begin0
(a? (a-x (a 1 2)))
5)))
(test-comp `(lambda (b)
(let ([v (unbox b)])
(with-continuation-mark 'x 'y (unbox v))))
@ -5489,6 +5507,46 @@
[ts (lam-param-types l)])
(test 'flonum cadr ts)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure the compiler doesn't add a check for whether
;; `later` is defined in the body of `kw-proc`:
(let ()
(define l '(module m racket/base
(define (kw-proc x #:optional [optional 0])
(later))
(define (later) '(1 2 3))))
(define b
(let ([o (open-output-bytes)])
(write (compile l) o)
(parameterize ([read-accept-compiled #t])
(zo-parse (open-input-bytes (get-output-bytes o))))))
(let* ([m (compilation-top-code b)]
[d (car (mod-body m))]
[rhs (def-values-rhs d)]
[b (inline-variant-direct rhs)]
[v (application-rator (lam-body b))])
(test #t toplevel-const? v)))
(let ()
(define l '(module m racket/base
(struct s (x))
(define (kw-proc x #:optional [optional 0])
(later))
(define an-s (s 10))
(define (later) '(1 2 3))))
(define b
(let ([o (open-output-bytes)])
(write (compile l) o)
(parameterize ([read-accept-compiled #t])
(zo-parse (open-input-bytes (get-output-bytes o))))))
(let* ([m (compilation-top-code b)]
[d (cadr (mod-body m))]
[rhs (def-values-rhs d)]
[b (inline-variant-direct rhs)]
[v (application-rator (lam-body b))])
(test #t toplevel-const? v)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The validator should understand that a structure
;; constructor always succeeds:

35
racket/src/racket/src/optimize.c
View File

@ -939,11 +939,16 @@ static int is_inspector_call(Scheme_Object *a)
return 0;
}
static int is_proc_spec_proc(Scheme_Object *p)
static int is_proc_spec_proc(Scheme_Object *p, int init_field_count)
/* Does `p` produce a good `prop:procedure` value? */
{
Scheme_Type vtype;
if (SCHEME_INTP(p)
&& (SCHEME_INT_VAL(p) >= 0)
&& (SCHEME_INT_VAL(p) < init_field_count))
return 1;
if (SCHEME_PROCP(p)) {
p = scheme_get_or_check_arity(p, -1);
if (SCHEME_INTP(p)) {
@ -1280,7 +1285,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *e, int vals, int
&& ((app->num_args < 8)
/* procedure property: */
|| SCHEME_FALSEP(app->args[8])
|| is_proc_spec_proc(app->args[8]))
|| is_proc_spec_proc(app->args[8], SCHEME_INT_VAL(app->args[3])))
&& ((app->num_args < 9)
/* immutables: */
|| is_int_list(app->args[9],
@ -7909,6 +7914,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Hash_Table *originals = NULL;
int cont, next_pos_ready = -1, inline_fuel, is_proc_def;
Comp_Prefix *prev_cp;
Optimize_Info *limited_info;
Optimize_Info_Sequence info_seq;
if (!m->comp_prefix) {
@ -7932,6 +7938,16 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
prev_cp = info->cp;
info->cp = m->comp_prefix;
/* Use `limited_info` for optimization decisions that need to be
rediscovered by the validator. The validator knows shape
information for imported variables, and it know about structure
bindings for later forms. */
limited_info = MALLOC_ONE_RT(Optimize_Info);
#ifdef MZTAG_REQUIRED
limited_info->type = scheme_rt_optimize_info;
#endif
limited_info->cp = info->cp;
cnt = SCHEME_VEC_SIZE(m->bodies[0]);
/* First, flatten `(define-values (x ...) (values e ...))'
@ -8063,11 +8079,12 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
validator won't be able to reconstruct it
in general */
OMITTABLE_IGNORE_APPN_OMIT,
/* similarly, no `info' here, because the decision
/* similarly, use `limited_info` instead of `info'
here, because the decision
of omittable should not depend on
information that's only available at
optimization time: */
NULL,
limited_info,
info);
if (n == 1) {
@ -8131,6 +8148,16 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
}
scheme_hash_set(consts, scheme_make_integer(pos), e2);
if (sstruct) {
/* include in `limited_info` */
Scheme_Hash_Table *limited_consts = limited_info->top_level_consts;
if (!limited_consts) {
limited_consts = scheme_make_hash_table(SCHEME_hash_ptr);
limited_info->top_level_consts = limited_consts;
}
scheme_hash_set(limited_consts, scheme_make_integer(pos), e2);
}
if (sstruct || (SCHEME_TYPE(e2) > _scheme_ir_values_types_)) {
/* No use re-optimizing */
} else {