unstable: added comments

collects/unstable/byte-counting-port.rkt

@@ -12,6 +12,10 @@
   (make-output-port name always-evt write-out close 
                     #f #f #f
                     get-location))
+;; Ryan: Isn't this just a reimplementation of 'open-output-nowhere'?
+;;   Actually, the 'get-location' method isn't called unless 'port-count-lines!'
+;;   is called first, and on a fresh port (no writes), it errors because it returns
+;;   0 and a positive number is required.
 
 (provide/contract
- [make-byte-counting-port (() (any/c) . ->* . output-port?)])
+ [make-byte-counting-port (() (any/c) . ->* . output-port?)])

collects/unstable/contract.rkt

@@ -13,6 +13,18 @@
          (lambda (s) (not (zero? (string-length s))))))
 ;; Eli: If this gets in, there should also be versions for bytes, lists, and
 ;;   vectors.
+;; Ryan: How about just making these predicates? Predicates are more broadly applicable,
+;;   and when used as a contract we get the descriptive name for free.
+(define (non-empty-string? x)
+  (and (string? x) (not (zero? (string-length x)))))
+(define (non-empty-bytes? x)
+  (and (bytes? x) (not (zero? (bytes-length x)))))
+(define (non-empty-vector? x)
+  (and (vector? x) (not (zero? (vector-length x)))))
+(define (non-empty-list? x)
+  (and (list? x) (pair? x)))
+(define (singleton-list? x)
+  (and (pair? x) (null? (cdr x))))
 
 ;; ryanc added:
 
@@ -52,6 +64,15 @@
            #:first-order
            (lambda (x) (if (predicate x) (then-fo x) (else-fo x))))))))
 
+;; failure-result/c : contract
+;; Describes the optional failure argument passed to hash-ref, for example.
+;; If the argument is a procedure, it must be a thunk, and it is applied. Otherwise
+;; the argument is simply the value to return.
+(define failure-result/c
+  (if/c procedure? (-> any) any/c))
+
+;; rename-contract : contract any/c -> contract
+;; If the argument is a flat contract, so is the result.
 (define (rename-contract ctc name)
   (let ([ctc (coerce-contract 'rename-contract ctc)])
     (if (flat-contract? ctc)
@@ -343,7 +364,15 @@
  [non-empty-string/c contract?]
  [path-element? contract?]
  [port-number? contract?]
+
+ [non-empty-string? predicate/c]
+ [non-empty-bytes? predicate/c]
+ [non-empty-vector? predicate/c]
+ [non-empty-list? predicate/c]
+ [singleton-list? predicate/c]
+
  [if/c (-> procedure? contract? contract? contract?)]
+ [failure-result/c contract?]
  [rename-contract (-> contract? any/c contract?)]
 
  [nat/c flat-contract?]

collects/unstable/dict.rkt

@@ -18,6 +18,7 @@
          (dict-ref dict key (lambda () (return #f)))
          #t)))
     dict-has-key?))
+;; Ryan: Why the with-contract region? Why not provide/contract?
 
 (define dict-ref!
   (let ()

collects/unstable/find.rkt

@@ -70,4 +70,3 @@
     (if (procedure? default)
         (default)
         default)))
-;; Eli: Note that this is documented "Like `find-first'".

collects/unstable/generics.rkt

@@ -157,10 +157,10 @@
                      [(mthd-generic ...)
                       (map (λ (g) (datum->syntax #'mthds (syntax->datum g)))
                            specs)])
+         (syntax-property
          (syntax/loc stx
-           (let ([fake #'generics] ; This is to get the arrow to show up in DrRacket. It is ? arrow, so it isn't that nice.
-                 ; XXX this could be a signal to the guard to error early, but is seems okay to allow
-                 ;     missing methods
+           (let (; XXX this could be a signal to the guard to error early,
+                 ;     but is seems okay to allow missing methods
                  [mthd-generic #f]
                  ...)
              (syntax-parameterize
@@ -179,4 +179,6 @@
                                              stx
                                              #'method-name)]))])
                (local mthds
-                 (vector mthd-generic ...)))))))]))
+                 (vector mthd-generic ...)))))
+         'disappeared-use
+         (list #'generics))))]))

collects/unstable/list.rkt

@@ -3,7 +3,7 @@
          racket/dict
          (for-syntax racket/base))
 
-; list-prefix : list? list? -> boolean?
+; list-prefix? : list? list? -> boolean?
 ; Is l a prefix or r?
 (define (list-prefix? ls rs)
   (or (null? ls)
@@ -24,8 +24,33 @@
 ;;   lists, and return a matching number of values.
 ;; ryanc: changed to use Eli's version
 
+(define (internal-split-common-prefix as bs same? keep-prefix?)
+  (let loop ([as as] [bs bs])
+    (if (and (pair? as) (pair? bs) (same? (car as) (car bs)))
+        (let-values ([(prefix atail btail) (loop (cdr as) (cdr bs))])
+          (values (and keep-prefix? (cons (car as) prefix)) atail btail))
+        (values null as bs))))
+
+(define (split-common-prefix as bs #:same? [same? equal?])
+  (internal-split-common-prefix as bs same? #t))
+
+(define (take-common-prefix as bs #:same? [same? equal?])
+  (let-values ([(prefix atail btail) (internal-split-common-prefix as bs same? #t)])
+    prefix))
+
+(define (drop-common-prefix as bs #:same? [same? equal?])
+  (let-values ([(atail btail) (internal-split-common-prefix as bs same? #f)])
+    (values atail btail)))
+
 (provide/contract
- [list-prefix? (list? list? . -> . boolean?)])
+ [list-prefix? (list? list? . -> . boolean?)]
+ [split-common-prefix
+  (->* (any/c any/c) (#:same? procedure?) (values list? any/c any/c))]
+ [take-common-prefix
+  (->* (any/c any/c) (#:same? procedure?) list?)]
+ [drop-common-prefix
+  (->* (any/c any/c) (#:same? procedure?) (values any/c any/c))])
+
 
 (define (filter-multiple l . fs)
   (apply values

collects/unstable/port.rkt

@@ -1,20 +1,22 @@
 #lang racket
-
 (require unstable/srcloc)
 
-(define buffer (make-bytes 1024))
-
+#|
+Ryan:
+  Shouldn't this be called read-bytes/avail instead? (parallel existing names)
+  Changed to eliminate thread-unsafe buffer.
+|#
 (define (read-available-bytes [port (current-input-port)])
-  (read-available-bytes/offset port 0))
+  (read-available-bytes/offset port (make-bytes 1024) 0))
 
-(define (read-available-bytes/offset port offset)
+(define (read-available-bytes/offset port buffer offset)
   (let* ([result (read-bytes-avail!* buffer port offset)])
     (if (eof-object? result)
         (if (zero? offset) result (subbytes buffer 0 offset))
-        (let* ([new-offset (+ offset result)])
+        (let ([new-offset (+ offset result)])
           (if (= new-offset (bytes-length buffer))
-              (begin (set! buffer (bytes-append buffer buffer))
-                     (read-available-bytes/offset port new-offset))
+              (let ([new-buffer (bytes-append buffer buffer)])
+                (read-available-bytes/offset port new-buffer new-offset))
               (subbytes buffer 0 new-offset))))))
 
 (define (port->srcloc port [source (object-name port)] [span 0])

collects/unstable/regexp.rkt

@@ -2,6 +2,9 @@
 
 (require racket/list racket/contract)
 
+;; Ryan: These functions should also allow regexp objects, use object-name to get strings.
+;;  And use string-join instead of add-between.
+
 ;; regexp-or : String ... -> String
 ;; Produces the regexp disjunction of several regexp-strings.
 (define (regexp-or . strings)

collects/unstable/scribblings/contract.scrbl

@@ -43,6 +43,14 @@ The last contract is the same as @racket[any/c] because
 @racket[or/c] tries flat contracts before higher-order contracts.
 }
 
+@defthing[failure-result/c contract?]{
+
+A contract that describes the failure result arguments of procedures
+such as @racket[hash-ref].
+
+Equivalent to @racket[(if/c procedure? (-> any) any/c)].
+}
+
 @defproc[(rename-contract [contract contract?]
                           [name any/c])
          contract?]{