meow.rkt

#lang racket
(require (for-syntax racket/syntax))

#|
1,000 fvars; let-syntax implementation
cpu time: 1162 real time: 1165 gc time: 156

10,000 fvars; let-syntax implementation
cpu time: 10928 real time: 10964 gc time: 1374

1,000 fvars; let implementation
cpu time: 20 real time: 20 gc time: 3

10,000 fvars; let implementation
cpu time: 225 real time: 225 gc time: 54
|#

(begin-for-syntax
  (define current-fvars (make-parameter 10000))

  (define (bind-fvars s n tail)
    #`(let-syntax
          #,(for/list ([i (in-range 0 n)])
              (with-syntax ([fvar (syntax-local-introduce (format-id #f "fv~a" i))]
                            [offset i]
                            [stack s])
                #`[fvar (make-set!-transformer
                         (lambda (stx)
                           (syntax-case stx ()
                             [(set! id v)
                              #`(vector-set! stack offset v)]
                             [id (identifier? #'id)
                                 #`(vector-ref stack offset)])))]))
        #,tail)))

(define-syntax (my-module stx)
  (syntax-case stx ()
    [(_ e ...)
     (with-syntax ([s #'stack])
       #`(let ([s (make-vector #,(current-fvars) (void))])
           #,(bind-fvars #'s (current-fvars) #`(begin e ...))))]))

(define-namespace-anchor a)

(displayln "1,000 fvars; let-syntax implementation")

(time
 (eval
  '(begin
     (begin-for-syntax
       (current-fvars 1000))
     (my-module
      (set! fv0 8)
      (set! fv1 8)
      (+ fv0 fv1)))
  (namespace-anchor->namespace a)))

(displayln "10,000 fvars; let-syntax implementation")

(time
 (eval
  '(begin
     (begin-for-syntax
       (current-fvars 10000))
     (my-module
      (set! fv0 8)
      (set! fv1 8)
      (+ fv0 fv1)))
  (namespace-anchor->namespace a)))

(define-for-syntax (bind-fvars2 n tail)
  #`(let #,(for/list ([i (in-range 0 n)])
             (with-syntax ([fvar (syntax-local-introduce (format-id #f "fv~a" i))])
               #`[fvar (void)]))
      #,tail))

(define-syntax (my-module2 stx)
  (syntax-case stx ()
    [(_ e ...)
     (bind-fvars2 (current-fvars) #`(begin e ...))]))

;; expansion time increases with the number of let bindings, but not nearly as bad
;; expansion time seems to be 1ms per fvar, i.e., per let-syntax?

(displayln "1,000 fvars; let implementation")

(time
 (eval
  '(begin
     (begin-for-syntax
       (current-fvars 1000))
     (my-module2
      (set! fv0 8)
      (set! fv1 8)
      (+ fv0 fv1)))
  (namespace-anchor->namespace a)))

(displayln "10,000 fvars; let implementation")
(time
 (eval
  '(begin
     (begin-for-syntax
       (current-fvars 10000))
     (my-module2
      (set! fv0 8)
      (set! fv1 8)
      (+ fv0 fv1)))
  (namespace-anchor->namespace a)))