two-hash-table--with-oo.rkt

(define hash-table-preparation-interface
  (interface ()
    hash-table:get-size

    in-cicada-key->key
    create-in-cicada-key
    key->finite-sum
    key-equal?

    hash))

(define hash-table-interface
  (interface ()
    hash-table:get-address

    index->address
    index:occured?

    index->key
    index:set-key

    index:get-orbit-length
    index:set-orbit-length

    index:get-orbiton
    index:set-orbiton

    index:no-collision?

    index:get-type
    index:set-type

    index:get-data
    index:set-data

    index:used?

    key:search
    key:insert
    key->index
    key:find-data

    report))

(define hash-table-mixin
  (mixin (hash-table-preparation-interface) (hash-table-interface)

    (super-new)

    (define field-offset:key-address  0)
    (define field-offset:key-length   1)

    (define field-offset:orbit-length 2)
    (define field-offset:orbiton      3)

    (define field-offset:type         4)
    (define field-offset:data         5)

    (define hash-table:unit 6)
    (define hash-table:address
      (allocate-memory (* (:: hash-table:get-size)
                          hash-table:unit)))
    (define hash-table:counter 0)

    (define/public hash-table:get-address
      (lambda ()
        hash-table:address))

    (define/public index->address
      (lambda (index)
        (+ (* index hash-table:unit cell)
           hash-table:address)))

    (define/public index:occured?
      (lambda (index)
        (not (eq? 0 (memory:get
                     (+ (index->address index)
                        (* cell field-offset:key-address)))))))

    (define/public index->key
      (lambda (index)
        (let ([address (index->address index)])
          (:: in-cicada-key->key
            (cons (memory:get
                   (+ address
                      (* cell field-offset:key-address)))
                  (memory:get
                   (+ address
                      (* cell field-offset:key-length))))))))

    (define/public index:set-key
      (lambda (index key)
        (let* ([address (index->address index)]
               [in-cicada-key (:: create-in-cicada-key key)]
               [key-address (car in-cicada-key)]
               [key-len (cdr in-cicada-key)])
          (memory:set (+ address
                         (* cell field-offset:key-address))
                      key-address)
          (memory:set (+ address
                         (* cell field-offset:key-length))
                      key-len))))

    (define/public index:get-orbit-length
      (lambda (index)
        (memory:get
         (+ (index->address index)
            (* cell field-offset:orbit-length)))))

    (define/public index:set-orbit-length
      (lambda (index orbit-length)
        (memory:set (+ (index->address index)
                       (* cell field-offset:orbit-length))
                    orbit-length)))

    (define/public index:get-orbiton
      (lambda (index)
        (memory:get
         (+ (index->address index)
            (* cell field-offset:orbiton)))))

    (define/public index:set-orbiton
      (lambda (index orbiton)
        (memory:set (+ (index->address index)
                       (* cell field-offset:orbiton))
                    orbiton)))

    (define/public index:no-collision?
      (lambda (index)
        (eq? index
             (index:get-orbiton index))))

    (define/public index:get-type
      (lambda (index)
        (memory:get
         (+ (index->address index)
            (* cell field-offset:type)))))

    (define/public index:set-type
      (lambda (index type)
        (memory:set (+ (index->address index)
                       (* cell field-offset:type))
                    type)))

    (define/public index:get-data
      (lambda (index)
        (memory:get
         (+ (index->address index)
            (* cell field-offset:data)))))

    (define/public index:set-data
      (lambda (index data)
        (memory:set (+ (index->address index)
                       (* cell field-offset:data))
                    data)))

    (define/public index:used?
      (lambda (index)
        (not (eq? 0
                  (index:get-type index)))))

    (define/public key:search
      ;; (key -> index
      ;;      -> #f)
      (lambda (key)
        (let* ([number (:: key->finite-sum key)]
               [orbit (:: hash number 0)])
          (letrec ([loop
                    (lambda (counter)
                      (let ([index (:: hash number counter)])
                        (cond [(not (index:occured? index))
                               #f]
                              [(:: key-equal? (index->key index) key)
                               index]
                              [(eq? (index:get-orbit-length index)
                                    counter)
                               ;; this is why
                               ;; there is a orbit-length field
                               #f]
                              [else
                               (loop (add1 counter))])))])
            (loop 0)))))

    (define/public key:insert
      ;; (key -> index
      ;;      -> #f)
      (lambda (key)
        (let* ([number (:: key->finite-sum key)]
               [orbit (:: hash number 0)])
          (letrec ([loop
                    (lambda (counter)
                      (let ([index (:: hash number counter)])
                        (cond [(not (index:occured? index))
                               (index:set-key index key)
                               (index:set-orbiton index orbit)
                               (index:set-orbit-length orbit (add1 counter))
                               (set! hash-table:counter
                                     (add1 hash-table:counter))
                               index]
                              [(:: key-equal? (index->key index) key)
                               index]
                              [(eq? (:: hash-table:get-size)
                                    counter)
                               ;; #f denotes that
                               ;; the hash-table is filled
                               #f]
                              [else
                               (loop (add1 counter))])))])
            (loop 0)))))

    (define/public key->index
      (lambda (key)
        (let ([index (key:insert key)])
          (if (not (eq? index #f))
            index
            (orz ("\n")
                 ("* (key->index)\n")
                 ("  hash-table is full\n")
                 ("  can not convert string to index anymore\n")
                 ("  the size of the hash-table is : ~a\n" (:: hash-table:get-size))
                 ("  the following key is not inserted :\n")
                 ("    ~a\n" key)
                 ("\n"))))))

    (define/public key:find-data
      (lambda (key)
        ;; (key -> (type . data)
        ;;      -> #f)
        (let ([index (key:search key)])
          (cond [(eq? #f index)
                 #f]
                [(not (index:used? index))
                 #f]
                [else
                 (cons (index:get-type index)
                       (index:get-data index))]))))

    (define report:orbit
      (lambda (index counter)
        (if (>= counter (index:get-orbit-length index))
          (void)
          (let* ([next-index
                  (:: hash
                    (:: key->finite-sum (index->key index))
                    counter)]
                 [next-orbiton
                  (index:get-orbiton next-index)])
            (when (eq? index next-orbiton)
              (display
               (cat ("  {~a} ~a\n"
                     next-index
                     (index->key next-index)))))
            (report:orbit index (add1 counter))))))

    (define report:loop
      (lambda (index)
        (cond [(eq? index (:: hash-table:get-size))
               (void)]
              [else
               (when (and (index:occured? index)
                          (index:no-collision? index))
                 (display
                  ;; * {index} key # orbit-lenght
                  (cat ("- {~a} ~a # ~a\n"
                        index
                        (index->key index)
                        (index:get-orbit-length index))))
                 (report:orbit index 1))
               (report:loop (add1 index))])))

    (define/public report
      ;; - report point [orbit by orbit]
      ;;   in the following format
      ;; - {index} key # orbit-lenght
      ;;   {index} key
      ;;   {index} key
      ;;   {index} key
      (lambda ()
        (display (cat ("\n")))
        (report:loop 0)
        (display (cat ("\n")
                      ("- totally : ~a\n" hash-table:counter)
                      ("\n")))))))

(define tag-class
  (hash-table-mixin
   (class* object-class (hash-table-preparation-interface)

     (init :size)

     (super-new)

     (define hash-table:size :size)

     (define/public hash-table:get-size
       (lambda ()
         hash-table:size))

     (define/public in-cicada-key->key
       (lambda (in-cicada-key)
         (in-cicada-string->string in-cicada-key)))

     (define/public create-in-cicada-key
       (lambda (key)
         (create-in-cicada-string key)))

     (define max-carry-position 16)

     (define string->finite-carry-sum
       ;; (string -> carry-sum)
       (lambda (str)
         (letrec ([loop
                   (lambda (l sum counter)
                     (cond [(null? l)
                            sum]
                           [(> counter
                               max-carry-position)
                            (loop l sum 0)]
                           [else
                            (loop (cdr l)
                                  (+ sum (* (char->integer (car l))
                                            (expt 2 counter)))
                                  (add1 counter))]))])
           (loop (string->list str) 0 0))))

     (define/public key->finite-sum
       (lambda (key)
         (string->finite-carry-sum key)))

     (define/public key-equal?
       (lambda (key1 key2)
         (string=? key1 key2)))

     (define/public hash
       ;; prime table size
       ;; linear probing
       ;; (number counter -> index)
       (lambda (number counter)
         (modulo (+ number counter)
                 hash-table:size))))))

(define tag
  (new tag-class
    [:size 1000333]))

(define tag-hash-table:size
  (: tag hash-table:get-size))
(define tag-hash-table:address
  (: tag hash-table:get-address))

(define tag-group-class
  (hash-table-mixin
   (class* object-class (hash-table-preparation-interface)

     (init :size)

     (super-new)

     (define hash-table:size :size)

     (define/public hash-table:get-size
       (lambda ()
         hash-table:size))

     (define/public in-cicada-key->key
       (lambda (in-cicada-key)
         (in-cicada-vector->list in-cicada-key)))

     (define/public create-in-cicada-key
       (lambda (key)
         (create-in-cicada-vector (remove-duplicates key))))

     (define tag-list->finite-sum
       ;; (tag-list -> carry-sum)
       (lambda (tag-list)
         (apply + (remove-duplicates tag-list))))

     (define/public key->finite-sum
       (lambda (key)
         (tag-list->finite-sum key)))

     (define/public key-equal?
       (lambda (key1 key2)
         (equal? (remove-duplicates key1)
                 (remove-duplicates key2))))

     (define/public hash
       ;; prime table size
       ;; linear probing
       ;; (number counter -> index)
       (lambda (number counter)
         (modulo (+ number counter)
                 hash-table:size))))))

(define tag-group
  (new tag-group-class
    [:size 1000333]))

(define tag-group-hash-table:size
  (: tag-group hash-table:get-size))
(define tag-group-hash-table:address
  (: tag-group hash-table:get-address))

two-hash-table--without-oo.rkt

(define tag-entry-offset:string-address 0)
(define tag-entry-offset:string-length  1)
(define tag-entry-offset:orbit-length   2)
(define tag-entry-offset:orbiton        3)
(define tag-entry-offset:jo             4)
(define tag-entry:size                  5)

(define tag-hash-table:size 100333)
(define tag-hash-table:unit tag-entry:size)
(define tag-hash-table:address
  (allocate-memory (* tag-hash-table:size
                      tag-hash-table:unit)))
(define tag-hash-table:counter 0)

(define tag->address
  ;; (tag -> address)
  (lambda (tag)
    (+ (* tag tag-hash-table:unit)
       tag-hash-table:address)))

(define tag:occured?
  ;; (tag -> bool)
  (lambda (tag)
    (not (= 0 (memory:get
               (+ (tag->address tag)
                  (* cell tag-entry-offset:string-address)))))))

(define tag:used?
  ;; (tag -> bool)
  (lambda (tag)
    (not (= 0 (memory:get
               (+ (tag->address tag)
                  (* cell tag-entry-offset:jo)))))))

(define tag->string
  ;; (tag -> string)
  (lambda (tag)
    (let ([address (tag->address tag)])
      (cicada-string->string
       (memory:get
        (+ address
           (* cell tag-entry-offset:string-address)))
       (memory:get
        (+ address
           (* cell tag-entry-offset:string-length)))))))

(define tag:get-orbit-length
  ;; (tag -> orbit-length)
  (lambda (tag)
    (memory:get
     (+ (tag->address tag)
        (* cell tag-entry-offset:orbit-length)))))

(define tag:get-orbiton
  ;; (tag -> orbiton)
  (lambda (tag)
    (memory:get
     (+ (tag->address tag)
        (* cell tag-entry-offset:orbiton)))))

(define tag:get-jo
  ;; (tag -> jo)
  (lambda (tag)
    (memory:get
     (+ (tag->address tag)
        (* cell tag-entry-offset:jo)))))

(define tag:set-string
  (lambda (tag str)
    (let ([address (tag->address tag)]
          [str-address (create-string str)]
          [str-length (string-length str)])
      (memory:set (+ address
                     (* cell tag-entry-offset:string-address))
                  str-address)
      (memory:set (+ address
                     (* cell tag-entry-offset:string-length))
                  str-length))))

(define tag:set-orbit-length
  (lambda (tag orbit-length)
    (memory:set (+ (tag->address tag)
                   (* cell tag-entry-offset:orbit-length))
                orbit-length)))

(define tag:set-orbiton
  (lambda (tag orbiton)
    (memory:set (+ (tag->address tag)
                   (* cell tag-entry-offset:orbiton))
                orbiton)))

(define tag:set-jo
  (lambda (tag jo)
    (memory:set (+ (tag->address tag)
                   (* cell tag-entry-offset:jo))
                jo)))

(define tag:no-collision?
  ;; (tag -> bool)
  (lambda (tag)
    (equal? tag
            (tag:get-orbiton tag))))

(define tag-hash-table:hash
  ;; (number counter -> index)
  (lambda (number counter)
    (modulo (+ number counter)
            tag-hash-table:size)))

(define max-carry-position 16)

(define string->finite-carry-sum
  ;; (string -> carry-sum)
  (lambda (str)
    (letrec ([loop (lambda (l sum counter)
                     (cond [(null? l)
                            sum]
                           [(> counter max-carry-position)
                            (loop l sum 0)]
                           [else
                            (loop (cdr l)
                                  (+ sum (* (char->integer (car l))
                                            (expt 2 counter)))
                                  (add1 counter))]))])
      (loop (string->list str) 0 0))))

(define tag-hash-table:search
  ;; (string -> tag
  ;;         -> #f)
  (lambda (str)
    (letrec ([loop (lambda (str number counter)
                     (let* ([tag (tag-hash-table:hash number counter)]
                            [orbit (tag-hash-table:hash number 0)])
                       (cond [(not (tag:occured? tag))
                              #f]
                             [(string=? (tag->string tag)
                                        str)
                              tag]
                             [(= (tag:get-orbit-length tag)
                                 counter)
                              ;; this is way
                              ;; tag-entry has a orbit-length field
                              #f]
                             [else
                              (loop str
                                    number
                                    (add1 counter))])))])
      (loop str
            (string->finite-carry-sum str)
            0))))

(define tag-hash-table:insert
  ;; (string -> tag
  ;;         -> #f)
  (lambda (str)
    (letrec ([loop (lambda (str number counter)
                     (let* ([tag (tag-hash-table:hash number counter)]
                            [orbit (tag-hash-table:hash number 0)])
                       (cond [(not (tag:occured? tag))
                              (tag:set-string tag str)
                              (tag:set-orbiton tag orbit)
                              (tag:set-orbit-length orbit counter)
                              (set! tag-hash-table:counter
                                    (add1 tag-hash-table:counter))
                              tag]
                             [(string=? (tag->string tag)
                                        str)
                              tag]
                             [(= tag-hash-table:size
                                 counter)
                              #f]
                             [else
                              (loop str
                                    number
                                    (add1 counter))])))])
      (loop str
            (string->finite-carry-sum str)
            0))))

(define string->tag
    (lambda (str)
      (let ([tag (tag-hash-table:insert str)])
        (if (eq? tag #f)
          (orz ("\n")
               ("* (string->tag)\n")
               ("  tag-hash-table is full\n")
               ("  can not convert string to tag anymore\n")
               ("\n"))
          tag))))

(check-expect
    "a-000"
    (tag->string (string->tag "a-000")))

(define tag-hash-table:report:orbit
  (lambda (tag counter)
    (if (< (tag:get-orbit-length tag) counter)
      'finish
      (let* ([next-tag (tag-hash-table:hash
                         (string->finite-carry-sum (tag->string tag))
                         counter)]
             [next-orbiton (tag:get-orbiton next-tag)])
        (when (eq? tag next-orbiton)
          (display (format "  {~a} ~a\n"
                           next-tag
                           (tag->string next-tag))))
        (tag-hash-table:report:orbit tag (add1 counter))))))

(define tag-hash-table:report:loop
  (lambda (tag)
    (cond [(= tag tag-hash-table:size)
           'finish]
          [(and (tag:occured? tag)
                (tag:no-collision? tag))
           ;; * {index} string # orbit-lenght
           (display (format "* {~a} ~a # ~a\n"
                            tag
                            (tag->string tag)
                            (tag:get-orbit-length tag)))
           (tag-hash-table:report:orbit tag 1)]
          [else
           (tag-hash-table:report:loop (add1 tag))])))

(define tag-hash-table:report
  (lambda ()
    (tag-hash-table:report:loop 0)
    (display "* totally : ")
    (display tag-hash-table:counter)
    (newline)))

(define tag-hash-table:find-jo
  ;; (string -> jo)
  (lambda (str)
    (let ([tag (tag-hash-table:search str)])
      (cond [(eq? tag #f)
             #f]
            [(tag:used? tag)
             tag]
            [else
             #f]))))

(define cicada-vector->list
  ;; (address len -> list)
  (lambda (address len)
    (cond [(= 0 len)
           '()]
          [else
           (cons (memory:get address)
                 (cicada-vector->list
                  (+ address cell)
                  (sub1 len)))])))

(define tag-group-entry-offset:vector-address 0)
(define tag-group-entry-offset:vector-length  1)
(define tag-group-entry-offset:orbit-length   2)
(define tag-group-entry-offset:orbiton        3)
(define tag-group-entry-offset:data           4)
(define tag-group-entry-offset:type           5)
(define tag-group-entry:size                  6)

(define tag-group-hash-table:size 100333)
(define tag-group-hash-table:unit tag-group-entry:size)
(define tag-group-hash-table:address
  (allocate-memory (* tag-group-hash-table:size
                      tag-group-hash-table:unit)))
(define tag-group-hash-table:counter 0)

(define tag-group->address
  ;; (tag-group -> address)
  (lambda (tag-group)
    (+ (* tag-group tag-group-hash-table:unit)
       tag-group-hash-table:address)))

(define tag-group:occured?
  ;; (tag-group -> bool)
  (lambda (tag-group)
    (not (= 0 (memory:get
               (+ (tag-group->address tag-group)
                  (* cell tag-group-entry-offset:vector-address)))))))

(define tag-group:used?
  ;; (tag-group -> bool)
  (lambda (tag-group)
    (not (= 0 (memory:get
               (+ (tag-group->address tag-group)
                  (* cell tag-group-entry-offset:data)))))))

(define tag-group->tag-list
  (lambda (tag-group)
    (let ([address (tag-group->address tag-group)])
      (cicada-vector->list
       (memory:get
        (+ address
           (* cell tag-group-entry-offset:vector-address)))
       (memory:get
        (+ address
           (* cell tag-group-entry-offset:vector-length)))))))

(define tag-group:get-orbit-length
  ;; (tag-group -> orbit-length)
  (lambda (tag-group)
    (memory:get
     (+ (tag-group->address tag-group)
        (* cell tag-group-entry-offset:orbit-length)))))

(define tag-group:get-orbiton
  ;; (tag-group -> orbiton)
  (lambda (tag-group)
    (memory:get
     (+ (tag-group->address tag-group)
        (* cell tag-group-entry-offset:orbiton)))))

(define tag-group:get-data
  ;; (tag-group -> data)
  (lambda (tag-group)
    (memory:get
     (+ (tag-group->address tag-group)
        (* cell tag-group-entry-offset:data)))))

(define tag-group:set-tag-list
  (lambda (tag-group tag-list)
    (let ([address (tag-group->address tag-group)]
          [vec-address (create-vector tag-list)]
          [vec-length (vector-length tag-list)])
      (memory:set (+ address
                     (* cell tag-group-entry-offset:vector-address))
                  vec-address)
      (memory:set (+ address
                     (* cell tag-group-entry-offset:vector-length))
                  vec-length))))

(define tag-group:set-orbit-length
  (lambda (tag-group orbit-length)
    (memory:set (+ (tag-group->address tag-group)
                   (* cell tag-group-entry-offset:orbit-length))
                orbit-length)))

(define tag-group:set-orbiton
  (lambda (tag-group orbiton)
    (memory:set (+ (tag-group->address tag-group)
                   (* cell tag-group-entry-offset:orbiton))
                orbiton)))

(define tag-group:set-data
  (lambda (tag-group data)
    (memory:set (+ (tag-group->address tag-group)
                   (* cell tag-group-entry-offset:data))
                data)))

(define tag-group:no-collision?
  ;; (tag-group -> bool)
  (lambda (tag-group)
    (equal? tag-group
            (tag-group:get-orbiton tag-group))))

(define tag-group-hash-table:search
  ;; (in-host-tag-group -> tag-group
  ;;                    -> #f)
  (lambda ()
    ()))

(define tag-group-hash-table:insert
  ;; (in-host-tag-group -> tag-group
  ;;                    -> #f)
  (lambda ()
    ()))