(define-module (language python try)
  #:use-module (language python exceptions)
  #:use-module (language python yield)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (ice-9 control)
  #:use-module (ice-9 match)
  #:replace (raise)
  #:export (try))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))

(define-inlinable (standard-check class obj l)
  (cond
   ((eq? class #t)
    #t)
   ((struct? obj)
    (if (is-a? obj <p>)
	(if (is-a? class <p>)
	    (is-a? obj (ref class '__goops__))
	    (is-a? obj class))
	(if (is-a? obj <object>)
	    (is-a? obj class)
	    (eq? obj class))))
    ((and (procedure? class) (not (pyclass? class)))
     (apply class obj l))
    (else
     (eq? class obj))))
          
      
(define (check class obj l)
  (standard-check class obj l))

(define-syntax compile-error
  (lambda (x)
    (syntax-case x ()
      ((_ x)
       (error (syntax->datum #'x))))))

(define-syntax check-exception
  (syntax-rules (and or not)
    ((_ (or E ...) tag l)
     (or (check-exception E tag l) ...))
    ((_ (and E ...) tag l)
     (and (check-exception E tag l) ...))
    ((_ (not E) tag l)
     (not (check-exception E tag l)))
    ((_ E tag l)
     (check E tag l))))

(define-syntax handler
  (syntax-rules (=>)

    ((handler ecx)
     (lambda (k tag . l)
       (handler ecx tag l)))
    
    ((handler ((#:except E => lam) . ecx) tag l)
     (if (check-exception E tag l)
         (lam tag l)
         (handler ecx tag l)))

    ((handler ((#:except E code ...) . ecx) tag l)
     (if (check-exception E tag l)
         (nbegin code ...)
         (handler ecx tag l)))

    ((handler ((#:else code ...)) tag l)
     (begin code ...))

    ((handler () tag l)
     (apply throw 'python tag l))

    ((a ...)
     (compile-error "not a proper python macro try block"))))

    
    
(define-syntax try
  (syntax-rules ()
    ((try  code exc ... #:finally fin)
     (dynamic-wind
       (lambda () #f)
       (lambda ()
         (catch #t
           code
           (handler (exc ...))))
       (lambda ()
         (if (not (fluid-ref in-yield))
             (fin)))))

    ((try  code exc ...)
     (catch #t
       code
       (handler (exc ...))))))
  

(define raise
  (case-lambda
    ((x . l)
     (if (pyclass? x)
         (throw 'python (apply x l))
         (apply throw 'python x l)))

    (() (raise Exception))))