www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

speed-many-poly2.rkt (1727B)


      1 #lang type-expander
      2 
      3 (require (for-syntax racket))
      4 
      5 ;; This seems to be a slow-starting exponential, with a factor of ×2.5
      6 ;; each time n is increased by 100.
      7 ;; n=500 takes nearly 3 minutes, n=1000 should, by projection, take 4.5 hours.
      8 (define-for-syntax n 200)
      9 
     10 (: kons (∀ (A B) (→ A B (Pairof A B))))
     11 (define kons cons)
     12 
     13 (: f ((Λ (_)
     14         (with-syntax ([(T ...)
     15                        (map (λ (i) (gensym 'τ)) (range n))]
     16                       [(T₂ ...)
     17                        (map (λ (i) (gensym 'τ)) (range n))]
     18                       [(T₃ ...)
     19                        (map (λ (i) (gensym 'τ)) (range n))])
     20           #'(∀ (A B T ...)
     21                (→ (List A T ...)
     22                   B
     23                   (∀ (A₂ T₂ ...)
     24                      (→ (List A₂ T₂ ...)
     25                         (∀ (A₃ T₃ ...)
     26                            (→ (List (List A T ...)
     27                                     (List A₂ T₂ ...)
     28                                     (List A₃ T₃ ...))
     29                               (List (List B T ...)
     30                                     (List B T₂ ...)
     31                                     (List B T₃ ...))))))))))))
     32 (define (((f l v) ll) alll)
     33   (list (kons v (cdr (car alll)))
     34         (kons v (cdr (cadr alll)))
     35         (kons v (cdr (caddr alll)))))
     36 
     37 (define-syntax (callf stx)
     38   (with-syntax ([(v ...) (range n)]
     39                 [(v₂ ...) (map number->string (range n))]
     40                 [(v₃ ...) (map string->symbol (map number->string (range n)))])
     41     #'(((f
     42          (list "a" v ...)
     43          'x)
     44         (list "aa" v₂ ...))
     45        (list (list "a" v ...)
     46              (list "aa" v₂ ...)
     47              (list 'aaa 'v₃ ...)))))
     48 
     49 (define cf (callf))