(primitive-set! 'car (lambda (x) (car x)))
(primitive-set! 'cdr (lambda (x) (cdr x)))
(primitive-set! 'cadr (lambda (x) (cadr x)))
(let ([err (lambda (who x)
             (error who "invalid list structure ~s" x))])
  ;(primitive-set!
  ;  'car
  ;  (lambda (orig)
  ;    (if (pair? orig) ($car orig) (err 'car orig))))
  ;(primitive-set!
  ;  'cdr
  ;  (lambda (orig)
  ;    (if (pair? orig) ($cdr orig) (err 'cdr orig))))
  (primitive-set!
    'caar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x) ($car x) (err 'caar orig)))
          (err 'caar orig))))
  ;(primitive-set!
  ;  'cadr
  ;  (lambda (orig)
  ;    (if (pair? orig)
  ;        (let ([x ($cdr orig)])
  ;          (if (pair? x) ($car x) (err 'cadr orig)))
  ;        (err 'cadr orig))))
  (primitive-set!
    'cdar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x) ($cdr x) (err 'cdar orig)))
          (err 'cdar orig))))
  (primitive-set!
    'cddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x) ($cdr x) (err 'cddr orig)))
          (err 'cddr orig))))
  (primitive-set!
    'caaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x) ($car x) (err 'caaar orig)))
                (err 'caaar orig)))
          (err 'caaar orig))))
  (primitive-set!
    'caadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x) ($car x) (err 'caadr orig)))
                (err 'caadr orig)))
          (err 'caadr orig))))
  (primitive-set!
    'cadar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x) ($car x) (err 'cadar orig)))
                (err 'cadar orig)))
          (err 'cadar orig))))
  (primitive-set!
    'caddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x) ($car x) (err 'caddr orig)))
                (err 'caddr orig)))
          (err 'caddr orig))))
  (primitive-set!
    'cdaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x) ($cdr x) (err 'cdaar orig)))
                (err 'cdaar orig)))
          (err 'cdaar orig))))
  (primitive-set!
    'cdadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x) ($cdr x) (err 'cdadr orig)))
                (err 'cdadr orig)))
          (err 'cdadr orig))))
  (primitive-set!
    'cddar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x) ($cdr x) (err 'cddar orig)))
                (err 'cddar orig)))
          (err 'cddar orig))))
  (primitive-set!
    'cdddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x) ($cdr x) (err 'cdddr orig)))
                (err 'cdddr orig)))
          (err 'cdddr orig))))
  (primitive-set!
    'caaaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($car x) (err 'caaaar orig)))
                      (err 'caaaar orig)))
                (err 'caaaar orig)))
          (err 'caaaar orig))))
  (primitive-set!
    'caaadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($car x) (err 'caaadr orig)))
                      (err 'caaadr orig)))
                (err 'caaadr orig)))
          (err 'caaadr orig))))
  (primitive-set!
    'caadar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($car x) (err 'caadar orig)))
                      (err 'caadar orig)))
                (err 'caadar orig)))
          (err 'caadar orig))))
  (primitive-set!
    'caaddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($car x) (err 'caaddr orig)))
                      (err 'caaddr orig)))
                (err 'caaddr orig)))
          (err 'caaddr orig))))
  (primitive-set!
    'cadaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($car x) (err 'cadaar orig)))
                      (err 'cadaar orig)))
                (err 'cadaar orig)))
          (err 'cadaar orig))))
  (primitive-set!
    'cadadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($car x) (err 'cadadr orig)))
                      (err 'cadadr orig)))
                (err 'cadadr orig)))
          (err 'cadadr orig))))
  (primitive-set!
    'caddar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($car x) (err 'caddar orig)))
                      (err 'caddar orig)))
                (err 'caddar orig)))
          (err 'caddar orig))))
  (primitive-set!
    'cadddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($car x) (err 'cadddr orig)))
                      (err 'cadddr orig)))
                (err 'cadddr orig)))
          (err 'cadddr orig))))
  (primitive-set!
    'cdaaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($cdr x) (err 'cdaaar orig)))
                      (err 'cdaaar orig)))
                (err 'cdaaar orig)))
          (err 'cdaaar orig))))
  (primitive-set!
    'cdaadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($cdr x) (err 'cdaadr orig)))
                      (err 'cdaadr orig)))
                (err 'cdaadr orig)))
          (err 'cdaadr orig))))
  (primitive-set!
    'cdadar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($cdr x) (err 'cdadar orig)))
                      (err 'cdadar orig)))
                (err 'cdadar orig)))
          (err 'cdadar orig))))
  (primitive-set!
    'cdaddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($car x)])
                        (if (pair? x) ($cdr x) (err 'cdaddr orig)))
                      (err 'cdaddr orig)))
                (err 'cdaddr orig)))
          (err 'cdaddr orig))))
  (primitive-set!
    'cddaar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($cdr x) (err 'cddaar orig)))
                      (err 'cddaar orig)))
                (err 'cddaar orig)))
          (err 'cddaar orig))))
  (primitive-set!
    'cddadr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($car x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($cdr x) (err 'cddadr orig)))
                      (err 'cddadr orig)))
                (err 'cddadr orig)))
          (err 'cddadr orig))))
  (primitive-set!
    'cdddar
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($car orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($cdr x) (err 'cdddar orig)))
                      (err 'cdddar orig)))
                (err 'cdddar orig)))
          (err 'cdddar orig))))
  (primitive-set!
    'cddddr
    (lambda (orig)
      (if (pair? orig)
          (let ([x ($cdr orig)])
            (if (pair? x)
                (let ([x ($cdr x)])
                  (if (pair? x)
                      (let ([x ($cdr x)])
                        (if (pair? x) ($cdr x) (err 'cddddr orig)))
                      (err 'cddddr orig)))
                (err 'cddddr orig)))
          (err 'cddddr orig)))))