Generic interface for Racket lists

generic-list.rkt

#lang racket/base


(require racket/generic
         (prefix-in racket/list. racket/list)
         racket/match
         racket/stream
         racket/struct
         racket/unsafe/ops
         (prefix-in racket/vector. racket/vector)
         rebellion/private/static-name)


(define-generics list
  (list-size list)
  (list-get list index))


(define (in-list list)
  (for/stream ([i (in-range 0 (list-size list))])
    (list-get list i)))


(define (list-index-of list element)
  (for/first ([i (in-range 0 (list-size list))]
              #:when (equal? (list-get list i) element))
    i))


(define-generics immutable-list
  (list-set immutable-list index element)
  (list-add immutable-list element)
  (list-insert immutable-list index element)
  (list-remove immutable-list element)
  (list-delete immutable-list index))


(define-generics mutable-list
  (list-set! mutable-list index element)
  (list-add! mutable-list element)
  (list-insert! mutable-list index element)
  (list-remove! mutable-list element)
  (list-delete! mutable-list index)
  (list-clear! mutable-list))


(struct abstract-list ()

  #:property prop:sequence (λ (this) (in-list this))

  #:methods gen:custom-write

  [(define write-proc
     (make-constructor-style-printer
      (λ (this) (if (immutable-list? this) 'immutable-list 'mutable-list)) values))])


(struct abstract-immutable-list abstract-list ()
  
  #:methods gen:equal+hash

  [(define (equal-proc this other recur)
     (define size (list-size this))
     (and (equal? size (list-size other))
          (for/and ([i (in-range 0 size)])
            (recur (list-get this i) (list-get other i)))))

   (define (hash-proc this recur)
     42)

   (define (hash2-proc this recur)
     125)])


(define (raise-empty-list-index-error who index)
  (raise-arguments-error who "index is out of bounds, list is empty" "index" index))


(struct empty-list abstract-immutable-list ()

  #:methods gen:list

  [(define (list-size this)
     0)

   (define (list-get this index)
     (raise-empty-list-index-error (name list-get) index))]
  
  #:methods gen:immutable-list

  [(define (list-set this index element)
     (raise-empty-list-index-error (name list-get) index))
     
   (define (list-add this element)
     (nonempty-immutable-linked-list element this))

   (define (list-insert this index element)
     (nonempty-immutable-linked-list element this))

   (define (list-remove this element)
     this)

   (define (list-delete this index)
     (raise-empty-list-index-error (name list-get) index))])


(struct nonempty-immutable-linked-list abstract-immutable-list (head tail)

  #:methods gen:list
  
  [(define (list-size this)
     (add1 (list-size (nonempty-immutable-linked-list-tail this))))

   (define (list-get this index)
     (if (zero? index)
         (nonempty-immutable-linked-list-head this)
         (list-get (nonempty-immutable-linked-list-tail this) (sub1 index))))]

  #:methods gen:immutable-list

  [(define (list-set this index element)
     (match-define (nonempty-immutable-linked-list head tail) this)
     (if (zero? index)
         (nonempty-immutable-linked-list element tail)
         (nonempty-immutable-linked-list head (list-set tail (sub1 index) element))))

   (define (list-add this element)
     (match-define (nonempty-immutable-linked-list head tail) this)
     (nonempty-immutable-linked-list head (list-add tail element)))

   (define (list-insert this index element)
     (match-define (nonempty-immutable-linked-list head tail) this)
     (if (zero? index)
         (nonempty-immutable-linked-list element this)
         (nonempty-immutable-linked-list head (list-insert tail (sub1 index) element))))

   (define (list-remove this element)
     (match-define (nonempty-immutable-linked-list head tail) this)
     (if (equal? element head)
         tail
         (nonempty-immutable-linked-list head (list-remove tail element))))

   (define (list-delete this index)
     (raise-empty-list-index-error (name list-get) index))])


(struct primitive-list abstract-immutable-list (delegate)

  #:methods gen:list

  [(define (list-size this)
     (length (primitive-list-delegate this)))

   (define (list-get this position)
     (list-ref (primitive-list-delegate this) position))]

  #:methods gen:immutable-list

  [(define (list-set this index element)
     (primitive-list (racket/list.list-set (primitive-list-delegate this) index element)))

   (define (list-add this element)
     (primitive-list (append (primitive-list-delegate this) (list element))))

   (define (list-insert this index element)
     (define-values (before after) (racket/list.split-at (primitive-list-delegate this) index))
     (primitive-list (append before (list element) after)))

   (define (list-remove this element)
     (primitive-list (remove element (primitive-list-delegate this))))

   (define (list-delete this index)
     (define-values (before after) (racket/list.split-at (primitive-list-delegate this) index))
     (primitive-list (append before (racket/list.rest after))))])


(struct immutable-primitive-vector-list abstract-immutable-list (delegate)

  #:methods gen:list

  [(define (list-size this)
     (vector-length (immutable-primitive-vector-list-delegate this)))

   (define (list-get this position)
     (vector-ref (immutable-primitive-vector-list-delegate this) position))]

  #:methods gen:immutable-list

  [(define (list-set this index element)
     (define original (immutable-primitive-vector-list-delegate this))
     (define modified (racket/vector.vector-copy original))
     (vector-set! modified index element)
     (immutable-primitive-vector-list (unsafe-vector*->immutable-vector! modified)))

   (define (list-add this element)
     (define original (immutable-primitive-vector-list-delegate this))
     (define size (vector-length original))
     (define modified (make-vector (add1 (vector-length original))))
     (vector-copy! modified 0 original)
     (vector-set! modified size element)
     (immutable-primitive-vector-list (unsafe-vector*->immutable-vector! modified)))

   (define (list-insert this index element)
     (define original (immutable-primitive-vector-list-delegate this))
     (define size (vector-length original))
     (define modified (make-vector (add1 (vector-length original))))
     (vector-copy! modified 0 original 0 index)
     (vector-set! modified index element)
     (vector-copy! modified (add1 index) original index)
     (immutable-primitive-vector-list (unsafe-vector*->immutable-vector! modified)))

   (define (list-remove this element)
     (list-delete this (list-index-of this element)))

   (define (list-delete this index)
     (define original (immutable-primitive-vector-list-delegate this))
     (define size (vector-length original))
     (define modified (make-vector (sub1 (vector-length original))))
     (vector-copy! modified 0 original 0 index)
     (vector-copy! modified index original (add1 index))
     (immutable-primitive-vector-list (unsafe-vector*->immutable-vector! modified)))])


(define e1 (empty-list))
(define e2 (primitive-list (list)))
(define e3 (immutable-primitive-vector-list (vector-immutable)))


(equal? e1 e1)
(equal? e2 e2)
(equal? e3 e3)
(equal? e1 e2)
(equal? e1 e3)
(equal? e2 e3)