www

commit b6ac74692d05589129b2abfbda63bab8cde79396
parent f77e3dcdcf8ff481dec33fa00bff8b320c0336f1
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Sun,  8 Jan 2017 01:33:51 +0100

Implemented ivector, with gen:custom-write so that they display like vectors. Store the elements inside a vector, and use an impersonator to make it appear as a list.

Diffstat:
M
main.rkt
 | 
8
++++++--
M
private/unsafe.rkt
 | 
32
++++++++++++++++++++++++++++++--
M
test/test-vector.rkt
 | 
32
++++++++++++++++++++++++++++++--

3 files changed, 66 insertions(+), 6 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -7,8 +7,12 @@
 
 (unsafe-require/typed tr-immutable/private/unsafe
                       [#:struct (A) ivector ([v : (Listof A)])
+                       #:constructor-name make-ivector
                        #:type-name IVectorof])
 
 (: new-ivector (∀ (A) (→ A * (IVectorof A))))
 (define (new-ivector . vs)
-  (ivector vs))
-\ No newline at end of file
+  (make-ivector vs))
+
+;TODO: do a (with-sexp (var) body) which transforms to isexp on input, and back
+; to sexp on output, to prevent any obvious leaks?
+\ No newline at end of file
diff --git a/private/unsafe.rkt b/private/unsafe.rkt
@@ -1,6 +1,33 @@
 #lang racket/base
 
+(require (for-syntax racket/base
+                     racket/contract))
 ;; TODO: make this a vector in the implementation, but make TR think it's a
 ;; list (via a contract?)
-(provide (struct-out ivector))
-(struct ivector (v) #:mutable)
+(provide (except-out (struct-out ivector) make-ivector*)
+         make-ivector)
+(struct ivector (v) #:mutable
+  #:constructor-name make-ivector*
+  #:transparent
+  #:methods gen:custom-write
+  [(define (write-proc iv port mode)
+     (case mode
+       [(#t) (write (raw-ivector-v iv) port)]
+       [(#f) (display (raw-ivector-v iv) port)]
+       [else (print (raw-ivector-v iv) port mode)]))])
+
+(define raw-ivector-v? (make-parameter #f))
+(define (raw-ivector-v iv)
+  (parameterize ([raw-ivector-v? #t])
+    (ivector-v iv)))
+
+(define (make-ivector v)
+  (impersonate-struct (make-ivector* (apply vector-immutable v))
+                      ivector-v
+                      (λ (self val)
+                        (if (raw-ivector-v?)
+                            val
+                            (vector->list val)))
+                      set-ivector-v!
+                      (λ (self val)
+                        (error "vector is immutable!"))))
+\ No newline at end of file
diff --git a/test/test-vector.rkt b/test/test-vector.rkt
@@ -2,4 +2,32 @@
 
 (require tr-immutable
          typed/rackunit)
-(check-pred (make-predicate (IVectorof Positive-Byte)) (ivector 1 2 3))
-\ No newline at end of file
+(check-pred (make-predicate (IVectorof Positive-Byte)) (ivector 1 2 3))
+
+(check-equal? (with-output-to-string
+               (λ ()
+                 (display (ivector 1 2 3))))
+              (with-output-to-string
+               (λ ()
+                 (display #(1 2 3)))))
+
+(check-equal? (with-output-to-string
+               (λ ()
+                 (write (ivector 1 2 3))))
+              (with-output-to-string
+               (λ ()
+                 (write #(1 2 3)))))
+
+(check-equal? (with-output-to-string
+               (λ ()
+                 (print (ivector 1 2 3) (current-output-port) 0)))
+              (with-output-to-string
+               (λ ()
+                 (print #(1 2 3) (current-output-port) 0))))
+
+(check-equal? (with-output-to-string
+               (λ ()
+                 (print (ivector 1 2 3) (current-output-port) 1)))
+              (with-output-to-string
+               (λ ()
+                 (print #(1 2 3) (current-output-port) 1))))
+\ No newline at end of file