(module rpc-function-definer mzscheme
        (require "rpc-log.scm")
        (provide rpc-define
                 rpc-check
                 rpc-fcall
                 rpc-get-sym)
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Internal data structures
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define rpc-functions (make-hash-table))
        (define rpc-f-symbols (make-hash-table))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Exported functions/macros
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        ;;;; rpc-define
        (define-syntax rpc-define
          (syntax-rules ()
            ((_ (f client-obj) definition ...)
             (begin
               (define (f client-obj) definition ...)
               (hash-table-put! rpc-functions 'f (list f))
               (hash-table-put! rpc-f-symbols  f 'f)))
            ((_ (f client-obj (arg1 type1) ...) definition ...)
             (begin
               (define (f client-obj arg1 ...) definition ...)
               (hash-table-put! rpc-functions 'f (list f type1 ...))
               (hash-table-put! rpc-f-symbols f 'f)))
            ))

        ;;;; rpc-check
        (define (rpc-check f-symbol de-marshalled-arguments)
          (letrec ((check (lambda (L A)
                            (if (and (null? L) (null? A))
                                #t
                                (if (null? L)
                                    "More arguments given than function takes"
                                    (if (null? A)
                                        "Not enough arguments given to the function"
                                        (let ((typer (car L))
                                              (arg   (car A)))
                                          (if (typer arg)
                                              (check (cdr L) (cdr A))
                                              (format "Argument with value ~s is not of typer ~s" arg typer)))))))))
            (let ((F (hash-table-get rpc-functions f-symbol (lambda () #f))))
              (if (eq? F #f)
                  (format "Cannot find function ~s" f-symbol)
                  (check (cdr F) de-marshalled-arguments)))))
        
        ;;;; rpc-fcall
        (define (rpc-fcall client-id f-symbol de-marshalled-arguments)
          (let ((F (hash-table-get rpc-functions f-symbol)))
            (apply (car F) (cons client-id de-marshalled-arguments))))
        
        ;;;; rpc-get-sym
        (define (rpc-get-sym f)
          (hash-table-get rpc-f-symbols f (lambda () #f)))
        
        ;;;; Default registrations
        (rpc-define (rpc-gc client-obj)                        (collect-garbage) #t)
        (rpc-define (rpc-connected client-obj)                 "internal server function")
        (rpc-define (rpc-shutdown client-obj)                  'shutdown)
        (rpc-define (rpc-force-shutdown client-obj)            'forced-shutdown)
        (rpc-define (rpc-end client-obj)                       'disconnected)
        (rpc-define (rpc-login client-obj (name string?) (pass string?)) "internal server function")
        (rpc-define (rpc-chalenge client-obj)                  "rpc client handler chalenge function")
        
        );;;; module-end