forth-benchmark.rkt

#lang racket/base

;; Apparently builds repeated wrappers
;;  when comparing a recursive contract to an "opaque" recursive contract
;;
;; (object/c (-> evaluate ... (object/c (-> evaluation ...
;; vs
;; (recursive-contract g27 #:impersonator)
;;
;; Not sure where the recursive contract came from
;;  or if it's possible to get it collapsed

(module command racket/base
  (provide command*)

  (require racket/class)

  (define command%
    (class object%
      (super-new)
      (define/public (evaluate c* token)
        #f)))

  (define void-command%
    (class command%
      (super-new)
      (define/override (evaluate c* token)
        (if (eq? token 'void)
            c*
            #f))))

  (define command*
    (list (new command%) (new void-command%))))

(module eval typed/racket/base
  (provide main)

  (require racket/class)

  (require/typed (submod ".." command)
    (command* (Listof (Instance Command%))))

  (define-type Command%
    (Class
     (evaluate (-> (Listof (Instance Command%)) Symbol (U #f (Listof (Instance Command%)))))))

  (: main (-> Natural Void))
  (define (main N)
    (for/fold : (Listof (Instance Command%))
              ([c* command*])
              ([i (in-range N)])
      (forth-eval c* 'void))
    (void))

  (: forth-eval (-> (Listof (Instance Command%)) Symbol (Listof (Instance Command%))))
  (define (forth-eval command* token)
    (or
     (for/or : (U #f (Listof (Instance Command%)))([c (in-list command*)])
       (send c evaluate command* token))
     (error 'pr267))))

(require 'eval)
(time (main 60))