cs: force inline of applicable-struct support

When the schemify pass cannot determine that a call is to a primitive
procedure, it generates an `#%app` form that expands to

  ((extract-procedure rator) rand ...)

Force `extract-procedure` to be inlined (by making it a macro), so the
expansion is

  (let ([tmp rator])
    ((if (#%procedure? tmp) tmp (slow-extract-procedure tmp)) rand ...))

which is usefully faster in the common case that `rator` turns out to
be a primitive procedure.

racket/src/cs/expander.sls

@@ -177,6 +177,11 @@
                [(_ rator rand ...)
                 (with-syntax ([n-args (length #'(rand ...))])
                   #'((extract-procedure rator n-args) rand ...))])))
+    (eval '(define-syntax-rule (extract-procedure f n-args)
+             (let ([tmp f])
+               (if (#%procedure? tmp)
+                   tmp
+                   (slow-extract-procedure tmp n-args)))))
     (eval '(define-syntax (|#%name| stx)
              (syntax-case stx ()
                [(_ name val) #`(let ([name val]) name)])))

racket/src/cs/primitive/internal.ss

@@ -3,7 +3,6 @@
 ;; can be used in a linklet:
 
 (define-primitive-table internal-table
-  [extract-procedure (known-constant)]
   [set-ctl-c-handler! (known-constant)]
   [impersonator-val (known-constant)]
   [impersonate-ref (known-constant)]

racket/src/cs/rumble/procedure.ss

@@ -72,10 +72,11 @@
            receiver
            (lambda args (apply receiver args)))))))
 
-(define (extract-procedure f n-args)
+(define-syntax-rule (extract-procedure f n-args)
-  (cond
+  (let ([tmp f])
-   [(#%procedure? f) f]
+    (if (#%procedure? tmp)
-   [else (slow-extract-procedure f n-args)]))
+        tmp
+        (slow-extract-procedure tmp n-args))))
 
 (define (slow-extract-procedure f n-args)
   (pariah ; => don't inline enclosing procedure

racket/src/schemify/constructed-procedure.rkt

@@ -0,0 +1,15 @@
+#lang racket/base
+(require "match.rkt")
+
+;; Recognize functions whose result is always a core procedure of a
+;; known arity
+
+(provide constructed-procedure-arity-mask)
+
+(define (constructed-procedure-arity-mask v)
+  (match v
+    [`(make-struct-field-accessor . ,_)
+     1]
+    [`(make-struct-field-mutator . ,_)
+     2]
+    [`,_ #f]))

racket/src/schemify/infer-known.rkt

@@ -5,6 +5,7 @@
          "import.rkt"
          "simple.rkt"
          "pthread-parameter.rkt"
+         "constructed-procedure.rkt"
          "literal.rkt"
          "inline.rkt"
          "mutated-state.rkt"
@@ -61,6 +62,8 @@
        [else (known-copy rhs)])]
     [(pthread-parameter? rhs prim-knowns knowns mutated)
      (known-procedure 3)]
+    [(constructed-procedure-arity-mask rhs)
+     => (lambda (m) (known-procedure m))]
     [(and defn
           (simple? rhs prim-knowns knowns imports mutated simples))
      a-known-constant]