From f2c6c1e1c01d94d615411e740d9662a34b217550 Mon Sep 17 00:00:00 2001
From: Ben Greenman <benjaminlgreenman@gmail.com>
Date: Mon, 2 May 2016 22:13:37 -0400
Subject: [PATCH] [list] some tests

---
 test/list-fail.rkt       |  47 +++++++++++
 test/list-pass.rkt       | 166 +++++++++++++++++++++++++++++++++++++++
 trivial/private/list.rkt |  21 +++--
 3 files changed, 228 insertions(+), 6 deletions(-)
 create mode 100644 test/list-fail.rkt
 create mode 100644 test/list-pass.rkt

diff --git a/test/list-fail.rkt b/test/list-fail.rkt
new file mode 100644
index 0000000..4d9a7d0
--- /dev/null
+++ b/test/list-fail.rkt
@@ -0,0 +1,47 @@
+#lang racket/base
+(require trivial/private/test-common)
+
+;; TODO
+;; - fix test (list-ref: (list-ref: ...) ...)
+
+(module+ test (test-compile-error
+  #:require trivial/list trivial/math
+  #:exn #rx"out-of-bounds|Type Checker"
+
+  (car: '())
+  (cdr: '())
+
+  (list-ref: (list 1) 3)
+
+  (let-list: ([v (list 1 2 3)])
+    (list-ref: v 3))
+
+  (let ()
+    (define-list: v (list 3 4))
+    (list-ref: v 9))
+
+  ;; TODO
+  ;(let-list: ([v1  (list 1)])
+  ;  (let-list: ([v2 (list v1)])
+  ;    (list-ref: (list-ref: v2 0) 1)))
+
+  (list-ref: (map: (lambda (x) x) (list #t "ha")) 20)
+
+  (list-ref: (list 0) -5)
+
+  (list-ref:
+    (map: add1 (map: add1 (map: add1 (list 0 0 0))))
+    3)
+
+  (list-ref: (map: symbol->string (list 'a 'b)) 5)
+
+  (list-ref:
+    (map: add1 (map: add1 (map: add1 (list 0 0 0))))
+    3)
+
+  (let-list: ([v (list 0 0 0)]
+                [v2 (list 1 2)])
+    (list-ref: (append: v2 v) 8))
+
+  (list-ref: (list 1 2 1) 3)
+))
diff --git a/test/list-pass.rkt b/test/list-pass.rkt
new file mode 100644
index 0000000..2395102
--- /dev/null
+++ b/test/list-pass.rkt
@@ -0,0 +1,166 @@
+#lang typed/racket/base
+
+(module+ test
+  (require
+    trivial/math
+    trivial/list
+    typed/rackunit)
+
+  ;; -- pair?
+  (check-equal?
+    (ann (pair?: '()) #f)
+    #f)
+  (check-equal?
+    (ann (pair?: '(1 2)) #t)
+    #t)
+
+  ;; -- null?
+  (check-equal?
+    (ann (null?: '()) #t)
+    #t)
+  (check-equal?
+    (ann (null?: '(1 2)) #f)
+    #f)
+
+  ;; -- cons
+  (check-equal?
+    (ann (cons: 1 '(2)) (List Natural Natural))
+    '(1 2))
+  (check-equal?
+    (ann (-: (length: (cons: 1 (cons: 2 (cons: 3 '())))) 3) Zero)
+    0)
+
+  ;; -- car
+  (check-equal?
+    (ann (car: '(a b)) 'a)
+    'a)
+
+  ;; -- cdr
+  (check-equal?
+    (cdr: '(1 2))
+    '(2))
+
+  ;; -- list?
+  (check-equal?
+    (ann (list?: '()) #t)
+    #t)
+  (check-equal?
+    (ann (list?: '(1 2 3)) #t)
+    #t)
+  (check-equal?
+    (list?: 'A)
+    #f)
+
+  ;; -- length:
+  (check-equal?
+    (length: '()) 0)
+  (check-equal?
+    (length: (list 1 2 2)) 3)
+  (check-equal?
+    (ann (-: (length: (list 5 5 5 5 5)) 4)
+         One)
+    1)
+  (let-list: ([v1 (list 2 3 4)]
+                [v2 (list 4 3 2)])
+    (check-equal?
+      (ann (+: 1 (-: (*: 5 (length: v1)) (+: (*: 4 3) (length: v2))))
+           One)
+      1))
+  (let ()
+    (define-list: v1 (list 2 3 4))
+    (define-list: v2 (list 4 3 2))
+    (check-equal?
+      (ann (*: 5 (-: (length: v1) (*: 1 1 (length: v2) 1)))
+           Zero)
+      0))
+
+  ;(test-suite "list-ref:"
+    (test-case "list/length ref"
+      (check-equal? (list-ref: (list 1) 0) 1))
+
+    (test-case "list/length ref, via let"
+      (let-list: ([v (list 2)])
+        (check-equal? (list-ref: v 0) 2)))
+
+    (test-case "list/length ref, via define"
+      (define-list: v (list "a" "bee" "sea"))
+      (check-equal? (list-ref: v 2) "sea"))
+
+    (test-case "plain list ref"
+      (check-equal?
+        ((lambda (v) (list-ref: v 3)) (list 8 2 19 3 0))
+        3))
+
+    (test-case "higher-order list ref"
+      (check-exn exn:fail:contract?
+        (lambda ()
+          ((lambda ([f : (-> (Listof Any) Natural Any)])
+            (f (list 0 1 2) 10)) list-ref:))))
+
+    (test-case "2-level ref"
+      (let-list: ([v1  (list 'X)])
+        (let-list: ([v2 (list v1)])
+          (check-equal? (list-ref: (list-ref: v2 0) 0) 'X))))
+  ;)
+
+ ;(test-suite "map:"
+   (test-case "list/length map"
+     (check-equal? (map: add1 (list 1)) (list 2)))
+
+   (test-case "list/length map via let"
+     (check-equal?
+       (let-list: ([v (list (list 1) (list 2 2)
+                                (list 3 3 3) (list 4 4 4 4))])
+         (map: (lambda ([x : (Listof Any)]) (length: x)) v)) ;; dammit map
+       (list 1 2 3 4)))
+
+   (test-case "map^3"
+     (check-equal?
+       (map: add1 (map: add1 (map: add1 (list 0 0 0))))
+       (list 3 3 3)))
+
+   (test-case "plain map"
+     (check-equal?
+       ((lambda ([v : (Listof (Listof Any))])
+         (map: (lambda ([x : (Listof Any)]) (length: x)) v))
+        (list (list 1) (list 2 2) (list 3 3 3) (list 4 4 4 4)))
+       (list 1 2 3 4)))
+
+   (test-case "large list"
+     (let-list: ([v* (make-list 200 #f)])
+       (check-true (for/and ([v (in-list (map: not v*))]) v))))
+
+   (test-case "higher-order map pass"
+     (check-equal?
+       ((lambda ([f : (-> (-> Symbol String) (Listof Symbol) (Listof String))])
+         (f symbol->string '(x yy z)))
+        map:)
+       (list "x" "yy" "z")))
+
+   (test-case "higher-order map fail"
+     (check-exn exn:fail:contract?
+       (lambda ()
+         ((lambda ([f : (-> (-> Integer Integer) (Listof Integer) (Listof Integer))])
+           (list-ref: (f add1 (list 0 0)) 3))
+          map:))))
+ ;)
+
+  ;(test-suite "append:"
+    (test-case "append"
+      (let-list: ([v (list 0 0 8)]
+                    [v2 (list 1 2)])
+        (check-equal?
+          (list-ref: (append: v2 v) 4)
+          8)))
+  ;)
+
+  ;(test-suite "reverse:"
+    (test-case "reverse"
+      (let-list: ([v (list 0 0 8)]
+                  [v2 (list 1 2)])
+        (let-list: ([v+ (reverse: (append: v2 v))])
+          (check-equal? (car: v+) 8)
+          (check-equal? (ann (-: (length: v+) 5) Zero) 0))))
+  ;)
+
+)
diff --git a/trivial/private/list.rkt b/trivial/private/list.rkt
index 19d4b57..5b27461 100644
--- a/trivial/private/list.rkt
+++ b/trivial/private/list.rkt
@@ -51,12 +51,21 @@
     typed/racket/base
     syntax/parse))
 
+;; Thank you based Asumu
 (unsafe-require/typed racket/unsafe/ops
-  (unsafe-car (All (A) (-> (Listof A) A)))
-  (unsafe-cdr (All (A) (-> (Listof A) (Listof A))))
-  (unsafe-cons-list (All (A) (-> A (Listof A) (Listof A))))
-  (unsafe-list-ref (All (A) (-> (Listof A) Integer A)))
-  (unsafe-list-tail (All (A) (-> (Listof A) Integer (Listof A)))))
+  (unsafe-car (All (A B)
+   (case->
+     (-> (Listof A) A)
+     (-> (Pairof A B) A))))
+  (unsafe-cdr (All (A B)
+   (-> (Pairof A B) B)))
+  (unsafe-cons-list (All (A B)
+   (-> A B (Pairof A B))))
+  (unsafe-list-ref (All (A B)
+   (-> (Listof A) B A)))
+  (unsafe-list-tail (All (A B C)
+   (-> (Pairof A B) C B)))
+)
 
 ;; =============================================================================
 
@@ -154,7 +163,7 @@
     #:with i-stx (stx->num #'e)
     #:when (syntax-e #'i-stx)
     (let ([i (syntax-e #'i-stx)])
-      (unless (< i (syntax-e #'l.evidence))
+      (unless (< -1 i (syntax-e #'l.evidence))
         (bounds-error 'list-ref: #'l i))
       (syntax/loc stx (unsafe-list-ref l.expanded 'i-stx)))]
    [_ #f]))))