l)
  (%variable-set! (module-ensure-local-variable! mod sym) val))

(define-primitive-expander! 'eof-object?
  (match-lambda*
   ((src obj)
    (make-primcall src 'eq? (list obj (make-const #f the-eof-object))))
   (_ #f)))

(define-primitive-expander zero? (x)
  (= x 0))

(define-primitive-expander positive? (x)
  (> x 0))

(define-primitive-expander negative? (x)
  (< x 0))

;; FIXME: All the code that uses `const?' is redundant with `peval'.

(define-primitive-expander 1+ (x)
  (+ x 1))

(define-primitive-expander 1- (x)
  (- x 1))

(define-primitive-expander +
  () 0
  (x) (values x)
  (x y) (+ x y)
  (x y z ... last) (+ (+ x y . z) last))

(define-primitive-expander *
  () 1
  (x) (values x)
  (x y z ... last) (* (* x y . z) last))
  
(define-primitive-expander -
  (x) (- 0 x)
  (x y) (- x y)
  (x y z ... last) (- (- x y . z) last))
  
(define-primitive-expander /
  (x) (/ 1 x)
  (x y z ... last) (/ (/ x y . z) last))
  
(define-primitive-expander atan
  (x) (atan x)
  (x y) (atan2 x y))

(define-primitive-expander logior
  () 0
  (x) (logior x 0)
  (x y) (logior x y)
  (x y z ... last) (logior (logior x y . z) last))

(define-primitive-expander logand
  () -1
  (x) (logand x -1)
  (x y) (logand x y)
  (x y z ... last) (logand (logand x y . z) last))

(define-primitive-expander! 'make-vector
  (match-lambda*
   ((src len)
    (make-primcall src 'make-vector (list len (make-const src *unspecified*))))
   ((src len init)
    (make-primcall src 'make-vector (list len init)))
   ((src . args)                              ;wrong number of arguments
    #f)))

(define-primitive-expander caar (x) (car (car x)))
(define-primitive-expander cadr (x) (car (cdr x)))
(define-primitive-expander cdar (x) (cdr (car x)))
(define-primitive-expander cddr (x) (cdr (cdr x)))
(define-primitive-expander caaar (x) (car (car (car x))))
(define-primitive-expander caadr (x) (car (car (cdr x))))
(define-primitive-expander cadar (x) (car (cdr (car x))))
(define-primitive-expander caddr (x) (car (cdr (cdr x))))
(define-primitive-expander cdaar (x) (cdr (car (car x))))
(define-primitive-expander cdadr (x) (cdr (car (cdr x))))
(define-primitive-expander cddar (x) (cdr (cdr (car x))))
(define-primitive-expander cdddr (x) (cdr (cdr (cdr x))))
(define-primitive-expander caaaar (x) (car (car (car (car x)))))
(define-primitive-expander caaadr (x) (car (car (car (cdr x)))))
(define-primitive-expander caadar (x) (car (car (cdr (car x)))))
(define-primitive-expander caaddr (x) (car (car (cdr (cdr x)))))
(define-primitive-expander cadaar (x) (car (cdr (car (car x)))))
(define-primitive-expander cadadr (x) (car (cdr (car (cdr x)))))
(define-primitive-expander caddar (x) (car (cdr (cdr (car x)))))
(define-primitive-expander cadddr (x) (car (cdr (cdr (cdr x)))))
(define-primitive-expander cdaaar (x) (cdr (car (car (car x)))))
(define-primitive-expander cdaadr (x) (cdr (car (car (cdr x)))))
(define-primitive-expander cdadar (x) (cdr (car (cdr (car x)))))
(define-primitive-expander cdaddr (x) (cdr (car (cdr (cdr x)))))
(define-primitive-expander cddaar (x) (cdr (cdr (car (car x)))))
(define-primitive-expander cddadr (x) (cdr (cdr (car (cdr x)))))
(define-primitive-expander cdddar (x) (cdr (cdr (cdr (car x)))))
(define-primitive-expander cddddr (x) (cdr (cdr (cdr (cdr x)))))

(define-primitive-expander cons*
  (x) (values x)
  (x y) (cons x y)
  (x y . rest) (cons x (cons* y . rest)))

(define-primitive-expander append
  () '()
  (x) (values x)
  (x y) (append x y)
  (x y . rest) (append x (append y . rest)))

(define-primitive-expander acons (x y z)
  (cons (cons x y) z))

(define-primitive-expander call/cc (proc)
  (call-with-current-continuation proc))

(define-primitive-expander u8vector-ref (vec i)
  (bytevector-u8-ref vec i))
(define-primitive-expander u8vector-set! (vec i x)
  (bytevector-u8-set! vec i x))
(define-primitive-expander s8vector-ref (vec i)
  (bytevector-s8-ref vec i))
(define-primitive-expander s8vector-set! (vec i x)
  (bytevector-s8-set! vec i x))

(define-primitive-expander u16vector-ref (vec i)
  (bytevector-u16-native-ref vec (* i 2)))
(define-primitive-expander u16vector-set! (vec i x)
  (bytevector-u16-native-set! vec (* i 2) x))
(define-primitive-expander s16vector-ref (vec i)
  (bytevector-s16-native-ref vec (* i 2)))
(define-primitive-expander s16vector-set! (vec i x)
  (bytevector-s16-native-set! vec (* i 2) x))

(define-primitive-expander u32vector-ref (vec i)
  (bytevector-u32-native-ref vec (* i 4)))
(define-primitive-expander u32vector-set! (vec i x)
  (bytevector-u32-native-set! vec (* i 4) x))
(define-primitive-expander s32vector-ref (vec i)
  (bytevector-s32-native-ref vec (* i 4)))
(define-primitive-expander s32vector-set! (vec i x)
  (bytevector-s32-native-set! vec (* i 4) x))

(define-primitive-expander u64vector-ref (vec i)
  (bytevector-u64-native-ref vec (* i 8)))
(define-primitive-expander u64vector-set! (vec i x)
  (bytevector-u64-native-set! vec (* i 8) x))
(define-primitive-expander s64vector-ref (vec i)
  (bytevector-s64-native-ref vec (* i 8)))
(define-primitive-expander s64vector-set! (vec i x)
  (bytevector-s64-native-set! vec (* i 8) x))

(define-primitive-expander f32vector-ref (vec i)
  (bytevector-ieee-single-native-ref vec (* i 4)))
(define-primitive-expander f32vector-set! (vec i x)
  (bytevector-ieee-single-native-set! vec (* i 4) x))
(define-primitive-expander f32vector-ref (vec i)
  (bytevector-ieee-single-native-ref vec (* i 4)))
(define-primitive-expander f32vector-set! (vec i x)
  (bytevector-ieee-single-native-set! vec (* i 4) x))

(define-primitive-expander f64vector-ref (vec i)
  (bytevector-ieee-double-native-ref vec (* i 8)))
(define-primitive-expander f64vector-set! (vec i x)
  (bytevector-ieee-double-native-set! vec (* i 8) x))
(define-primitive-expander f64vector-ref (vec i)
  (bytevector-ieee-double-native-ref vec (* i 8)))
(define-primitive-expander f64vector-set! (vec i x)
  (bytevector-ieee-double-native-set! vec (* i 8) x))

(define (bind-lexicals src exps k)
  (match exps
    (() (k '()))
    ((exp . exps)
     (with-lexicals src (exp)
       (bind-lexicals src exps (lambda (exps) (k (cons exp exps))))))))

(define (expand-eq prim)
  (case-lambda
    ((src) (make-const src #t))
    ((src a) (make-const src #t))
    ((src a b) #f)
    ((src . args)
     (bind-lexicals
      src args
      (lambda (args)
        (match args
          ((a . args)
           (let lp ((args args))
             (match args
               ((b)
                (make-primcall src prim (list a b)))
               ((b . args)
                (make-conditional src (make-primcall src prim (list a b))
                                  (lp args)
                                  (make-const src #f))))))))))))

(define-primitive-expander! 'eq?    (expand-eq 'eq?))
(define-primitive-expander! 'eqv?   (expand-eq 'eqv?))
(define-primitive-expander! 'equal? (expand-eq 'equal?))

(define (expand-chained-comparisons prim)
  (case-lambda
    ((src) (make-const src #t))
    ((src a)
     ;; (< x) -> (begin (< x 0) #t).  Residualizes side-effects from x
     ;; and, for numeric comparisons, checks that x is a number.
     (make-seq src
               (make-primcall src prim (list a (make-const src 0)))
               (make-const src #t)))
    ((src a b) #f)
    ((src . args)
     (bind-lexicals
      src args
      (lambda (args)
        (let lp ((args args))
          (match args
            ((a b)
             (make-primcall src prim (list a b)))
            ((a b . args)
             (make-conditional src (make-primcall src prim (list a b))
                               (lp (cons b args))
                               (make-const src #f))))))))
    (else #f)))

(for-each (lambda (prim)
            (define-primitive-expander! prim
              (expand-chained-comparisons prim)))
 '(< <= = >= > eq?))

(define (character-comparison-expander char< <)
  (lambda (src . args)
    (expand-primcall
     (make-primcall src <
                    (map (lambda (arg)
                           (make-primcall src 'char->integer (list arg)))
                         args)))))

(for-each (match-lambda
            ((char< . <)
             (define-primitive-expander! char<
               (character-comparison-expander char< <))))
          '((char<? . <)
            (char>? . >)
            (char<=? . <=)
            (char>=? . >=)
            (char=? . =)))

(define-primitive-expander! 'call-with-prompt
  (case-lambda
   ((src tag thunk handler)
    (match handler
      (($ <lambda> _ _ ($ <lambda-case> _ _ #f _ #f () _ _ #f))
       (make-prompt src #f tag thunk handler))
      (_
       ;; Eta-convert prompts without inline handlers.
       (let ((h (gensym "h "))
             (args (gensym "args ")))
         (define-syntax-rule (primcall name . args)
           (make-primcall src 'name (list . args)))
         (define-syntax-rule (const val)
           (make-const src val))
         (with-lexicals src (handler)
           (make-conditional
            src
            (primcall procedure? handler)
            (make-prompt
             src #f tag thunk
             (make-lambda
              src '()
              (make-lambda-case
               src '() #f 'args #f '() (list args)
               (primcall apply handler (make-lexical-ref #f 'args args))
               #f)))
            (primcall raise-type-error
                      (const #("call-with-prompt" 3 "procedure"))
                      handler)))))))
   (else #f)))

(define-primitive-expander! 'abort-to-prompt*
  (case-lambda
   ((src tag tail-args)
    (make-abort src tag '() tail-args))
   (else #f)))
(define-primitive-expander! 'abort-to-prompt
  (case-lambda
   ((src tag . args)
    (make-abort src tag args (make-const #f '())))
   (else #f)))