[racket] non-terminating type check for typed racket

On Mon, Apr 18, 2011 at 1:38 PM, Danny Yoo <dyoo at cs.wpi.edu> wrote:
> Hi Sam,
>
> Ok, I've reduced the example to a smaller, self-contained 188-line
> program, with a bunch of type declarations followed by a trivial
> function definition:

Ok, reduced further to 87 line example.  It's short enough that I'll
just embed it here:


#lang typed/racket/base

(require racket/list)

(define-struct: CheckToplevelBound! ()
  #:transparent)
(define-struct: CheckClosureArity! ()
  #:transparent)
(define-struct: CheckPrimitiveArity! ()
  #:transparent)
(define-struct: ExtendEnvironment/Prefix! ()
  #:transparent)
(define-struct: InstallClosureValues! ()
  #:transparent)
(define-struct: SetFrameCallee! ()
  #:transparent)
(define-struct: SpliceListIntoStack! ()
  #:transparent)
(define-struct: UnspliceRestFromStack! ()
  #:transparent)
(define-struct: FixClosureShellMap! ()
  #:transparent)
(define-struct: RaiseContextExpectedValuesError! ()
  #:transparent)
(define-struct: RaiseArityMismatchError! ()
  #:transparent)
(define-struct: RaiseOperatorApplicationError! ()
  #:transparent)
(define-struct: RestoreControl! ()
  #:transparent)
(define-struct: RestoreEnvironment! ()
  #:transparent)
(define-struct: InstallContinuationMarkEntry! ()
  #:transparent)

(define-type PrimitiveCommand (U
                               CheckToplevelBound!
                               CheckClosureArity!
                               CheckPrimitiveArity!
                               ExtendEnvironment/Prefix!
                               InstallClosureValues!
                               FixClosureShellMap!
                               InstallContinuationMarkEntry!
                               SetFrameCallee!
			       SpliceListIntoStack!
			       UnspliceRestFromStack!
			       RaiseContextExpectedValuesError!
			       RaiseArityMismatchError!
 			       RaiseOperatorApplicationError!
			       RestoreEnvironment!
			       RestoreControl!))


(: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))
(define (collect-primitive-command op)
  (cond
   [(CheckToplevelBound!? op)
    empty]
   [(CheckClosureArity!? op)
    empty]
   [(CheckPrimitiveArity!? op)
    empty]
   [(ExtendEnvironment/Prefix!? op)
    empty]
   [(InstallClosureValues!? op)
    empty]
   [(RestoreEnvironment!? op)
    empty]
   [(RestoreControl!? op)
    empty]
   [(SetFrameCallee!? op)
    empty]
   [(SpliceListIntoStack!? op)
    empty]
   [(UnspliceRestFromStack!? op)
    empty]
   [(FixClosureShellMap!? op)
    empty]
   [(InstallContinuationMarkEntry!? op)
    empty]
   [(RaiseContextExpectedValuesError!? op)
    empty]
   [(RaiseArityMismatchError!? op)
    empty]
   [(RaiseOperatorApplicationError!? op)
    empty]))