DynBadBlames.rkt

#lang racket

(module DynCtc racket
  ;; the blames of dyn1/c and dyn2/c are different
  (provide dyn1/c
           dyn2/c
           (struct-out RuntimeError))
  (struct RuntimeError (message) #:transparent)

  (define dyn1/c
    (or/c boolean?
          exact-integer?
          (-> (recursive-contract dyn1/c) (recursive-contract dyn1/c))
          RuntimeError?))

  (define dyn2/c
    (recursive-contract
     (or/c boolean?
           exact-integer?
           (-> dyn2/c dyn2/c)
           RuntimeError?))))

(module Dyn racket
  (require (submod ".." DynCtc))

  (provide
   (contract-out
    [interp1 (-> (hash/c symbol? dyn1/c) any/c dyn1/c)]
    [interp2 (-> (hash/c symbol? dyn2/c) any/c dyn2/c)]))

  (define (interp env expr)
    (match expr
      [(? symbol? x)
       (hash-ref env x)]
      [(or (? boolean? v) (? exact-integer? v))
       v]
      [`(λ ,x ,e)
       (λ (v)
         (interp (hash-set env x v) e))]
      [`(,f-expr ,arg)
       (define f (interp env f-expr))
       (define x (interp env arg))
       (if (procedure? f)
           (f x)
           (RuntimeError (format "applying a non-function ~s to value ~s\n in: ~s"
                                 f
                                 x
                                 `(,f-expr ,arg))))]))

  (define interp1 interp)
  (define interp2 interp))

(module Example1 racket
  (require (submod ".." Dyn))

  (define h
    (interp2 (hash 'add1 add1 'sub1 sub1)
             '(λ z (add1 (add1 (add1 z))))))

  (h 13)

  ;; booom
  (h interp1))

(module Example2 racket
  (require (submod ".." Dyn))

  (define fact-env
    (hash 'ifz (λ (n)
                 (λ (th)
                   (λ (el)
                     (if (zero? n) th (el #f)))))
          '* (λ (n) (λ (m) (* n m)))
          'sub1 sub1))

  (define fact-recur
    '(λ self
       (λ n
         (((ifz n) 1)
          (λ ff
            ((* n) ((self self) (sub1 n))))))))

  (interp1 fact-env
           `(((λ x (x x)) ,fact-recur)
             5))

  (define f (interp1 (hash) '(λ x (x x))))
  (define g (interp2 (hash) '(λ x (x x))))

  f
  g

  (f (interp1 (hash) '(λ self 999)))
  (g (interp1 (hash) '(λ self 999)))
  ((f (interp1 fact-env fact-recur)) 5)
  ((g (interp1 fact-env fact-recur)) 5)

  ; (f f) ;; ω = Ω Ω = infinite loop
  (f 0)
  (g 0)
  (f #f)
  (g #f)

  (with-handlers ([exn:fail? (λ (e)
                               ((error-display-handler) (exn-message e) e))])
    (f 'bad))

  (with-handlers ([exn:fail? (λ (e)
                               ((error-display-handler) (exn-message e) e))])
    (g 'bad)))

(require 'Example2)

Fixed: racket/racket@ca84036ab