[racket-dev] Slow contracts

From: Eric Dobson (eric.n.dobson at gmail.com)
Date: Tue Jun 10 00:46:54 EDT 2014

Splitting this out because this is actually a different issue. This is
about us generating slow contracts.

There are two things in play here.

One is that TR doesn't use the new lazy parts of struct/dc. This would
require changing struct contracts from flat contracts to
chaperone-contracts. Given that I think we are going to need to change
struct contracts to sometimes be chaperone contracts anyways for
soundness that might not be a huge loss.

#lang racket


(struct my-cons (fst snd))

(define (list->my-list xs)
  (if (empty? xs) xs (my-cons (first xs) (list->my-list (rest xs)))))

(define (my-first xs)
  (if (empty? xs) (error 'bad) (my-cons-fst xs)))



(define c1
 (recursive-contract
   (struct/dc my-cons [fst () #:flat any/c] [snd () #:flat (or/c null c1)])
   #:flat))
(define c2
 (recursive-contract
   (struct/dc my-cons [fst () #:flat any/c] [snd () #:chaperone #:lazy
(or/c null c2)])
   #:chaperone))



(define/contract (f1 xs)
  (-> c1 any) (my-first xs))
(define/contract (f2 xs)
  (-> c2 any) (my-first xs))


(define lst1 (list->my-list '(1 2)))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (my-first lst1))))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (f1 lst1))))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (f2 lst1))))

(define lst2 (list->my-list '(1 2 3 4 5 6 7 8 9)))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (my-first lst2))))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (f1 lst2))))

(for ([_  (in-range 5)])
  (time (for ([_  (in-range 10000)])
          (f2 lst2))))

f2 is constant where f1 grows.

And the other is that TR cannot follow the logic that you use to show
that just running my-cons? is as strong as checking the entire list.
If we could do that reduction we would get a large speedup.


On Mon, Jun 9, 2014 at 10:01 AM, Neil Toronto <neil.toronto at gmail.com> wrote:
> On 06/09/2014 10:25 AM, Neil Toronto wrote:
>>
>> On 06/09/2014 01:19 AM, Eric Dobson wrote:
>>>
>>>
>>> Does this seem like a reasonable thing to support/do people see issues
>>> with it?
>>
>>
>> I can only speak on reasonableness, and my answer is emphatically YES.
>>
>> Typed Racket is a great language in which to define and use data
>> structures: access is very fast, and many properties are checked
>> statically. But accessor performance suffers badly when the data types
>> are used in untyped Racket. If access uses higher-order functions (e.g.
>> math/array), wrapping the functions slows access by a very high constant
>> factor. If the data structures are first-order, every O(1) access
>> becomes O(n).
>>
>> I recently had to work around this in Plot when I needed an untyped
>> module to be able to operate on typed BSP trees. I ended up making a
>> typed weak hash map from "BSP tree handles" (gensyms) to BSP trees, and
>> writing a new untyped API for operating on trees using handles. It was
>> ugly. If the untyped and typed modules had been too tightly coupled, it
>> would have been impossible.
>>
>> IIUC, your proposal would make untyped use of typed data structures
>> actually feasible for real-world use. So again, YES.
>
>
> Here's a concrete example, using Typed Racket to define a new list type.
>
>
> #lang racket
>
> (module typed-defs typed/racket
>   (provide list->my-list
>            my-first)
>
>   (define-type (My-Listof A) (U Null (my-cons A)))
>   (struct (A) my-cons ([fst : A] [snd : (My-Listof A)]) #:transparent)
>
>   (: list->my-list (All (A) (-> (Listof A) (My-Listof A))))
>   (define (list->my-list xs)
>     (if (empty? xs) xs (my-cons (first xs) (list->my-list (rest xs)))))
>
>   (: my-first (All (A) (-> (My-Listof A) A)))
>   (define (my-first xs)
>     (if (empty? xs) (error 'bad) (my-cons-fst xs)))
>
>   ;; Timing loop speed is very fast and O(1)
>   (define lst (list->my-list '(1)))
>   (for ([_  (in-range 5)])
>     (time (for ([_  (in-range 1000000)])
>             (my-first lst))))
>   )
>
> (require 'typed-defs)
>
> ;; Timing loop speed is very slow and O(n)
> (define lst (list->my-list '(1)))
> (for ([_  (in-range 5)])
>   (time (for ([_  (in-range 1000000)])
>           (my-first lst))))
>
>
> I get 4ms for the timing loop in the typed module, and 620ms for the timing
> loop in the untyped module, so the constant factor is about 150.
>
> When I change the test data from '(1) to '(1 2), the untyped module's timing
> loop takes about 1010ms. The contract boundary has changed the asymptotic
> complexity of `my-first' from O(1) to O(n).
>
>
> Neil ⊥
>
> _________________________
>  Racket Developers list:
>  http://lists.racket-lang.org/dev


Posted on the dev mailing list.