www

commit 513c94b991782d6ed2ddfb0d6c1fb9d33fc589e4
parent 741c89f5fdbd886930a3d09257febf4f7284004d
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Sun,  8 Jan 2017 00:04:00 +0100

Failed attempt at disguising a vector as struct using make-struct-info, struct/c (which TR uses internally in make-predicate) seems to ignore the predicate supplied to make-struct-info.

Diffstat:
M
main.rkt
 | 
11
+++++++++--
M
private/unsafe.rkt
 | 
31
+++++++++++++++++++++++++++++--
M
test/test-vector.rkt
 | 
3
+--

3 files changed, 39 insertions(+), 6 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -3,11 +3,18 @@
 (require typed/racket/unsafe)
 
 (provide IVectorof
-         (rename-out [new-ivector ivector]))
+         IVectorof2
+         (rename-out [new-ivector ivector])
+         (rename-out [new-ivector2 ivector2])
+         ivector2-v)
 
 (unsafe-require/typed tr-immutable/private/unsafe
                       [#:struct (A) ivector ([v : (Listof A)])
-                       #:type-name IVectorof])
+                       #:type-name IVectorof]
+                      [#:struct (A) ivector2 ([v : (Listof A)])
+                       #:constructor-name make-ivector2
+                       #:type-name IVectorof2]
+                      [new-ivector2 (∀ (A) (→ A * (IVectorof2 A)))])
 
 (: new-ivector (∀ (A) (→ A * (IVectorof A))))
 (define (new-ivector . vs)
diff --git a/private/unsafe.rkt b/private/unsafe.rkt
@@ -2,5 +2,31 @@
 
 ;; 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 (struct-out ivector)
+         ;(struct-out ivector2)
+         ivector2
+         ivector2?
+         struct:ivector2
+         (rename-out [vector->list ivector2-v])
+         (rename-out [list->vector make-ivector2])
+         (rename-out [vector new-ivector2]))
+(define insp (make-inspector))
+(struct ivector (v) #:mutable
+  #:inspector insp)
+
+;;;;;;;;;;;;;
+(require (for-syntax racket/base
+                     racket/struct-info))
+
+(define (ivector2? v) (and (vector? v) (immutable? v)))
+
+(define struct:ivector2 #f)
+(define-syntax ivector2
+  (make-struct-info
+   (λ ()
+     (list #f
+           #'list->vector
+           #'ivector2?
+           (list #'vector->list)
+           (list #f)
+           #t))))
+\ No newline at end of file
diff --git a/test/test-vector.rkt b/test/test-vector.rkt
@@ -2,4 +2,4 @@
 
 (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))