(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)
  #:export (raise try))

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

(define-method (check (class <class> ) obj l) (is-a? obj class))
(define-method (check (s     <symbol>) obj l) (eq? obj s))
(define-method (check (p  <procedure>) obj l)
  (aif it (procedure-property p 'pyclass)
       (is-a? obj it)
       (p 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 x
       (match x
         ((_ 'python tag . l)
          (handler ecx tag l))
         ((k . x)
          (apply throw x)))))
    
    ((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)
         (begin 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
           (lambda () code)
           (handler (exc ...))))
       (lambda ()
         (if (not (fluid-ref in-yield))
             fin))))

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

(define raise
  (case-lambda
    (() (raise Exception))
    ((x)
     (if (procedure? x)
         (if (procedure-property x 'pyclass)
             (throw 'python (x))
             (throw 'python x))
         (throw 'python x)))))