#lang racket/base
(require racket/unsafe/ops)

(provide assq2 
         assq-via-assf
         assq-via-library-assf
         assoc2
         assoc2/opt
         assoc-via-assf
         assoc-via-library-assf)

(define (local-assf f list)
  (unless (and (procedure? f) (procedure-arity-includes? f 1))
    (raise-type-error 'assf "procedure (arity 1)" f))
  (let loop ([l list])
    (cond
     [(null? l) #f]
     [(not (pair? l))
      (raise-mismatch-error 'assf
                            "not a proper list: "
                            list)]
     [else (let ([a (car l)])
             (if (pair? a)
                 (if (f (car a)) 
                     a
                     (loop (cdr l)))
                 (raise-mismatch-error 'assf
                                       "found a non-pair in the list: "
                                       a)))])))

(define (assq-via-assf x l)
  (local-assf (lambda (y) (eq? x y)) l))
(define (assoc-via-assf x l [is-equal? equal?])
  (local-assf (lambda (y) (equal? x y)) l))

(define (assq-via-library-assf x l)
  (assf (lambda (y) (eq? x y)) l))
(define (assoc-via-library-assf x l [is-equal? equal?])
  (assf (lambda (y) (equal? x y)) l))
  
(define-values (assq2 assoc2 assoc2/opt)
  (let ()
    (define-syntax-rule (assoc-loop x l is-equal?)
      (let loop ([l l][t #f])
        (cond
         [(eq? l t) (error "bad")]
         [(null? l) #f]
         [(pair? l)
          (let ([a (unsafe-car l)])
            (if (pair? a)
                (if (is-equal? x (unsafe-car a))
                    (unsafe-cdr a)
                    (let ([l (unsafe-cdr l)])
                      (cond
                       [(eq? l t) (error "bad")]
                       [(null? l) #f]
                       [(pair? l)
                        (let ([a (unsafe-car l)])
                          (if (pair? a)
                              (if (is-equal? x (unsafe-car a))
                                  (unsafe-cdr a)
                                  (loop (unsafe-cdr l) 
                                        (if t 
                                            (unsafe-cdr t)
                                            l)))
                              (error "bad")))]
                       [else (error "bad")])))
                (error "bad")))]
         [else (error "bad")])))
    (values
     (lambda (x l)
       (assoc-loop x l eq?))
     (lambda (x l)
       (assoc-loop x l equal?))
     (lambda (x l [is-equal? equal?])
       (assoc-loop x l is-equal?)))))