More expansion-time-only definitions in assembler.scm

* module/system/vm/assembler.scm (define-inline): Change so that the
  defined macro is only defined at expansion-time.
  (u32-ref, u32-set!, s32-ref, s32-set!, pack-arity-flags): Use
  define-inline.
  (pack-flags, assert-match, *block-size*, id-append, assembler)
  (define-assembler, visit-opcodes, define-macro-assembler): Wrap in
  eval-when expand.

module/system/vm/assembler.scm

@@ -65,14 +65,16 @@
 
 ;; Like define-inlinable, but only for first-order uses of the defined
 ;; routine.  Should residualize less code.
-(define-syntax define-inline
+(eval-when (expand)
+  (define-syntax define-inline
     (lambda (x)
       (syntax-case x ()
         ((_ (name arg ...) body ...)
          (with-syntax (((temp ...) (generate-temporaries #'(arg ...))))
-         #`(define-syntax-rule (name temp ...)
+           #`(eval-when (expand)
+               (define-syntax-rule (name temp ...)
                  (let ((arg temp) ...)
-               body ...)))))))
+                   body ...)))))))))
 
 ;;; Bytecode consists of 32-bit units, often subdivided in some way.
 ;;; These helpers create one 32-bit unit from multiple components.
@@ -123,24 +125,25 @@
     (error "out of range" z))
   (logior x (ash y 8) (ash z 16) (ash w 24)))
 
-(define-syntax pack-flags
+(eval-when (expand)
+  (define-syntax pack-flags
     (syntax-rules ()
       ;; Add clauses as needed.
       ((pack-flags f1 f2) (logior (if f1 (ash 1 0) 0)
-                                (if f2 (ash 2 0) 0)))))
+                                  (if f2 (ash 2 0) 0))))))
 
 ;;; Helpers to read and write 32-bit units in a buffer.
 
-(define-syntax-rule (u32-ref buf n)
+(define-inline (u32-ref buf n)
   (bytevector-u32-native-ref buf (* n 4)))
 
-(define-syntax-rule (u32-set! buf n val)
+(define-inline (u32-set! buf n val)
   (bytevector-u32-native-set! buf (* n 4) val))
 
-(define-syntax-rule (s32-ref buf n)
+(define-inline (s32-ref buf n)
   (bytevector-s32-native-ref buf (* n 4)))
 
-(define-syntax-rule (s32-set! buf n val)
+(define-inline (s32-set! buf n val)
   (bytevector-s32-native-set! buf (* n 4) val))
 
 
@@ -149,10 +152,11 @@
 ;;; A <meta> entry collects metadata for one procedure.  Procedures are
 ;;; written as contiguous ranges of bytecode.
 ;;;
-(define-syntax-rule (assert-match arg pattern kind)
+(eval-when (expand)
+  (define-syntax-rule (assert-match arg pattern kind)
     (let ((x arg))
       (unless (match x (pattern #t) (_ #f))
-      (error (string-append "expected " kind) x))))
+        (error (string-append "expected " kind) x)))))
 
 (define-record-type <meta>
   (%make-meta label properties low-pc high-pc arities)
@@ -185,7 +189,8 @@
   (high-pc arity-high-pc set-arity-high-pc!)
   (definitions arity-definitions set-arity-definitions!))
 
-(define-syntax *block-size* (identifier-syntax 32))
+(eval-when (expand)
+  (define-syntax *block-size* (identifier-syntax 32)))
 
 ;;; An assembler collects all of the words emitted during assembly, and
 ;;; also maintains ancillary information such as the constant table, a
@@ -365,11 +370,11 @@ later by the linker."
 ;;; opcode in `(instruction-list)'.
 ;;;
 
-(eval-when (expand compile load eval)
+(eval-when (expand)
   (define (id-append ctx a b)
-    (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b)))))
+    (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b))))
 
-(define-syntax assembler
+  (define-syntax assembler
     (lambda (x)
       (define-syntax op-case
         (lambda (x)
@@ -466,11 +471,12 @@ later by the linker."
                (unless (asm? asm) (error "not an asm"))
                code0 ...
                code* ... ...
-             (reset-asm-start! asm)))))))
+               (reset-asm-start! asm))))))))
 
 (define assemblers (make-hash-table))
 
-(define-syntax define-assembler
+(eval-when (expand)
+  (define-syntax define-assembler
     (lambda (x)
       (syntax-case x ()
         ((_ name opcode kind arg ...)
@@ -482,7 +488,7 @@ later by the linker."
                    emit))
                (export emit)))))))
 
-(define-syntax visit-opcodes
+  (define-syntax visit-opcodes
     (lambda (x)
       (syntax-case x ()
         ((visit-opcodes macro arg ...)
@@ -491,7 +497,7 @@ later by the linker."
                              (instruction-list))))
            #'(begin
                (macro arg ... . inst)
-             ...))))))
+               ...)))))))
 
 (visit-opcodes define-assembler)
 
@@ -662,7 +668,8 @@ returned instead."
 ;;; some higher-level operations.
 ;;;
 
-(define-syntax define-macro-assembler
+(eval-when (expand)
+  (define-syntax define-macro-assembler
     (lambda (x)
       (syntax-case x ()
         ((_ (name arg ...) body body* ...)
@@ -672,7 +679,7 @@ returned instead."
                  (let ((emit (lambda (arg ...) body body* ...)))
                    (hashq-set! assemblers 'name emit)
                    emit))
-             (export emit)))))))
+               (export emit))))))))
 
 (define-macro-assembler (load-constant asm dst obj)
   (cond
@@ -1473,7 +1480,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
 (define (port-position port)
   (seek port 0 SEEK_CUR))
 
-(define-syntax-rule (pack-arity-flags has-rest? allow-other-keys?
+(define-inline (pack-arity-flags has-rest? allow-other-keys?
                                  has-keyword-args? is-case-lambda?
                                  is-in-case-lambda?)
   (logior (if has-rest? (ash 1 0) 0)