;;; scsh system error interface (part of Guile Facacde)
;;; Copyright (c) 2010 Clinton Ebadi

;;; Implements the scsh/scsh-condition interface, but is a
;;; reimplementation from documentation (none of the scsh code was
;;; really applicable to Guile).

(define-module (scsh system-error)
  #:export (with-errno-handler
	    with-errno-handler*))

(define (with-errno-handler* handler thunk)
  (catch 'system-error
    thunk
    (lambda (key syscall format-string format-args errno)
      (let ((errno (car errno)))
	(handler errno (list (apply format #f format-string format-args)
			     syscall
			     #f)))))) ; does not provide data
				      ; argument... not entirely sure
				      ; what the possible values are
				      ; "...and data is a list of
				      ; information generated by the
				      ; error, which varies from
				      ; syscall to syscall."

;;; docs specify clause syntax as ((errno ...) body ...), but it makes
;;; little sense to allow zero of either and and so at least one is
;;; enforced
(define-syntax with-errno-handler
  (lambda (x)
    (syntax-case x ()
      ((_ ((errno packet) clause ...) body1 body2 ...)
       (with-syntax (((handler-cases ...)
		      (map (lambda (clause)
			     (syntax-case clause (else)
			       (((error1 error2 ...) expr1 expr2 ...)
				(syntax ((memv errno (list error1 error2 ...))
					 expr1 expr2 ...)))
			       ((else expr1 expr2 ...)
				(syntax (else expr1 expr2 ...)))))
			   (syntax (clause ...)))))
	 (syntax (with-errno-handler* (lambda (errno packet)
					(cond handler-cases ...))
				      (lambda ()
					body1 body2 ...))))))))