(define-syntax lookup-shared-value
  (syntax-rules ()
    ((lookup-shared-valued str)
     (shared-binding-ref (lookup-imported-binding str)))))

(define-finite-type yp-result-code :yp-result-code
  (id)
  yp-result-code?
  yp-result-code-elements
  yp-result-code-name
  yp-result-code-index
  (id yp-result-code-id)
  ((success		0)
   (bad-args		(lookup-shared-value "yp-error-badargs"))
   (bad-database	(lookup-shared-value "yp-error-baddb"))
   (bad-domain		(lookup-shared-value "yp-error-domain"))
   (unknown-key		(lookup-shared-value "yp-error-key"))
   (unknown-map		(lookup-shared-value "yp-error-map"))
   (no-domain		(lookup-shared-value "yp-error-nodom"))
   (no-more-records	(lookup-shared-value "yp-error-nomore"))
   (portmap-failure	(lookup-shared-value "yp-error-pmap"))
   (allocation-failure	(lookup-shared-value "yp-error-resrc"))
   (rpc-failure		(lookup-shared-value "yp-error-rpc"))
   (bind-failure	(lookup-shared-value "yp-error-bind"))
   (internal-error	(lookup-shared-value "yp-error-yperr"))
   (server-error	(lookup-shared-value "yp-error-ypserv"))))

(define (yp-success? code)
  (equal? (yp-result-code success) code))

(define (yp-error-no-more? code)
  (equal? (yp-result-code no-more-records) code))

(define (make-finite-type-alist elements id-proc)
  (map (lambda (e) 
	 (cons (id-proc e) e))
       (vector->list elements)))

(define translate-result-code
  (let ((alist (make-finite-type-alist 
		yp-result-code-elements yp-result-code-id)))
    (lambda (id)
      (cond 
       ((assoc id alist) => cdr)
       (else
	(error "yp: internal error. Could not map YP result code to finite type" id))))))

(define (yp-get-default-domain)
  (receive (code domain)
      (apply values (yp-get-default-domain-int))
    (let ((code (translate-result-code code)))
      (if (yp-success? code)
	  domain
	  (error "yp: Could not get default domain."
		 (yp-error-string (yp-result-code-id code)))))))

(define (yp-bind . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (translate-result-code (yp-bind-int domain))))

(define (yp-unbind . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (translate-result-code (yp-unbind-int domain))))

(define (yp-match map key . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code val) 
	(apply values (yp-match-int domain map key))
      (values (translate-result-code code) val))))

(define (yp-order map . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code val)
	(apply values (yp-order-int domain map))
      (values (translate-result-code code) val))))

(define (yp-master map . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code val)
	(apply values (yp-master-int domain map))
      (values (translate-result-code code) val))))

(define (yp-first map . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code key val)
	(apply values (yp-first-int domain map))
      (values (translate-result-code code) key val))))

(define (yp-next map key . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code key val)
	(apply values (yp-next-int domain map key))
      (values (translate-result-code code) key val))))

(define (yp-map->list map . domain)
  (let-optionals domain
      ((domain (yp-get-default-domain)))
    (receive (code key val) (yp-first map domain)
      (if (yp-success? code)
	  (let loop ((key key) (res (cons (cons key val) '())))
	    (receive (code key val) 
		(yp-next map key domain)
	      (cond
	       ((yp-error-no-more? code) res)
	       ((yp-success? code)
		(loop key (cons (cons key val) res)))
	       (else
		(error (yp-error-string code))))))
	  (error (yp-error-string code))))))

(define (yp-error-string yp-result)
  (yp-error-string-int (yp-result-code-id yp-result)))

(import-lambda-definition yp-get-default-domain-int
			  ()
			  "scsh_yp_getdefaultdomain")

(import-lambda-definition yp-bind-int
			  (domain)
			  "scsh_yp_bind")

(import-lambda-definition yp-unbind-int
			  (domain)
			  "scsh_yp_unbind")

(import-lambda-definition yp-error-string-int
			  (code)
			  "scsh_yp_errstring")

(import-lambda-definition yp-protocol-error
			  (code)
			  "scsh_yp_proterr")

(import-lambda-definition yp-match-int
			  (domain map key)
			  "scsh_yp_match")

(import-lambda-definition yp-order-int
			  (domain map)
			  "scsh_yp_order")

(import-lambda-definition yp-master-int
			  (domain map)
			  "scsh_yp_master")

(import-lambda-definition yp-first-int
			  (domain map)
			  "scsh_yp_first")

(import-lambda-definition yp-next-int
			  (domain map key)
			  "scsh_yp_next")