bind-method   macro

(define-macro (bind-method class method def)
  (let* ((method_ (regex:split (symbol->string method) ":"))
         (methodname (car method_))
         (classname (symbol->string class))
         (methodtype (if (null? (cdr method_))
                         (log-error 'Compiler 'Error: 'you 'must 'give 'the 'method 'a 'type)
                         (impc:ir:get-type-from-pretty-str (cadr method_))))
         (adjusttypea (cons (car methodtype)
                              (cons (cadr methodtype)
                                    (cons (string->symbol (string-append "xobject_t*"))
                                          (cddr methodtype)))))
         (adjusttype (cons (car methodtype)
                              (cons (cadr methodtype)
                                    (cons (string->symbol (string-append "xobj_" classname "_t*"))
                                          (cddr methodtype)))))
         (f1 `(bind-func ,(string->symbol
                           (string-append "xobj_" classname "_" methodname ":"
                                          (impc:ir:pretty-print-type adjusttypea)))
                ,(cons (car def)
                       (cons (cons 'obj (cadr def))
                             ;;(append `(let ((self (cast obj ,(string->symbol (string-append "xobj_" classname "_t*")))))
                             (append `(let ((,(string->symbol (string-append "self:xobj_" classname "_t*")) (cast obj)))
                                        ,@(cddr def)))))))
         (f2 `(bind-func ,(string->symbol
                           (string-append "xobj_global_" methodname ":"
                                          (impc:ir:pretty-print-type
                                           (cons (car methodtype)
                                                 (cons (cadr methodtype)
                                                       (cons 'xobject_t*
                                                             (cddr methodtype)))))))
                (lambda ,(cons 'obj (cadr def))
                  (let ((class:i8* (tref obj 0))
                        ;(self (cast obj ,(string->symbol (string-append "xobj_" classname "_t*"))))
                        ;;(f:[i64,i64,i64]* (xobj_get_method class ,methodname)))
                        (,(string->symbol (string-append "f:" (impc:ir:pretty-print-type adjusttypea)))
                         (cast (xobj_get_method class ,methodname))))
                    (if (null? f)
                        (begin (printf
                                ,(string-append "Runtime Error: no method '" methodname "' for class '%s'\\n")
                                class)
                               ,(if (= -1 (cadr methodtype))
                                    'void
                                    '(convert null)))
                        ,(cons 'f (cons 'obj (cadr def))))))))
         (f3 `(bind-func ,(string->symbol
                           (string-append "xobj_" classname "_" methodname "_poly:"
                                          (impc:ir:pretty-print-type
                                           (cons (car methodtype)
                                                 (cons (cadr methodtype)
                                                       (cons (string->symbol (string-append "xobj_" classname "_t*"))
                                                             (cddr methodtype)))))))
                (lambda ,(cons 'obj (cadr def))
                  (let ((class:i8* (tref obj 0))
                        ;(self (cast obj ,(string->symbol (string-append "xobj_" classname "_t*"))))
                        (,(string->symbol (string-append "f:" (impc:ir:pretty-print-type adjusttypea)))
                         (cast (xobj_get_method class ,methodname))))
                        ;;(f:[i64,i64,i64]* (xobj_get_method class ,methodname)))
                    (if (null? f)
                        (begin (printf
                                ,(string-append "Runtime Error: no method '" methodname "' for class '%s'\\n")
                                class)
                               ,(if (= -1 (cadr methodtype))
                                    'void
                                    '(convert null)))
                        ,(cons 'f (cons '(cast obj) (cadr def)))))))))