myclass.scm

(use simply)
(uses file.util srfi-1)

(define *get-class-name* '__get-class-name)
(define *set-value* '__set-value)
(define *set-function* '__set-function)
(define *ref-function* '__)
(define *receive-number* '_num)
(define *receive-symbol* '_sym)
(define *receive-string* '_str)
(define *receive-list*   '_lst)
(define *receive-lambda* '_lmd)

(define (get-class-name obj)
  (guard (e (else #f))
    (receive (flag name) (obj *get-class-name*)
      (if flag name #f)
      )
    )
  )

(define (myclass classname . initial-value)
  (let ((value (if (null? initial-value) '() (car initial-value)))
        (funcs (make-hash-table-wrap))
        )
    (lambda args
      (case (length args)
        [(0) value ]
        [else
          (let1 cmd (car args)
            (cond
              [(symbol? cmd)
               (cond
                 [(eq? cmd *get-class-name*) (values #t classname)]
                 [(eq? cmd *set-value*) (set! value (cadr args))]
                 [(eq? cmd *get-class-name*) classname]
                 [(eq? cmd *set-function*)
                  (let ((target (second args)) (body (third args)))
                    (funcs target body)
                    )
                  ]
                 [else (apply (funcs *receive-symbol*) (cons value args))]
                 )
               ]
              [(number? cmd) (apply (funcs *receive-number*) (cons value args))]
              [(string? cmd) (apply (funcs *receive-string*) (cons value args))]
              [(list? cmd) (apply (funcs *receive-list*) (cons value args))]
              [(procedure? cmd) (apply (funcs *receive-lambda*) (cons value args))]
              )
            )
          ]
        )
      )
    )
  )



(define (main args)
  (let1 str (myclass "string" "helloworld")
    ;((str *ref-functions*) *receive-number* (lambda (v n) (string-ref v n)))
    (str *set-function* *receive-number* (lambda (v n) (string-ref v n)))

    (print (str))
    (print (str 0))
    (print (get-class-name str))
    )
  )