(require (lib "reduction-semantics.ss" "reduction-semantics")
         (lib "gui.ss" "reduction-semantics"))

(define grammar
  (language
   (B t
      f
      (B * B))))

(define r
  (list
   (reduction grammar (f * (name b1 B)) b1)   ; [a]
   (reduction grammar (t * (name b1 B)) 't))) ; [b]

(reduce r '((f * f) * (f * t)))


(define (compatible-closure-wrt-B a-reduction)
  (compatible-closure a-reduction grammar 'B))


(define ->r (map compatible-closure-wrt-B r))

(reduce ->r '((f * f) * (f * t)))

(gui grammar ->r '((f * f) * (f * t)))