► |  | Redex: Practical Semantics Engineering

1 | Amb: A Redex Tutorial
2 | Long Tutorial
3 | Extended Exercises
4 | The Redex Reference
5 | Automated Testing Benchmark
| Bibliography
| Index

▼ | 3 | Extended Exercises

3.1 | Objects: Problem
3.2 | Objects: Solution
3.3 | Problem: Types
3.4 | Solution: Types
3.5 | Problem: Missionaries and Cannibals
3.6 | Solution: Missionaries and Cannibals
3.7 | Problem: Towers of Hanoi
3.8 | Solution: Towers of Hanoi
3.9 | Problem: GC
3.10 | Solution: GC
3.11 | Problem: Finite State Machines
3.12 | Solution: Finite State Machines
3.13 | Problem: Threads
3.14 | Solution: Threads
3.15 | Problem: Contracts
3.16 | Solution: Contracts
3.17 | Problem: Binary Addition
3.18 | Solution: Binary Addition

top ← prev up next →

#### 3.10`` Solution: GC

#lang racket
;; a model of garbage collection for binary trees in a store
(require redex)
;; -----------------------------------------------------------------------------
;; syntax
(define-language L
[V number
(cons σ σ)]
[σ variable-not-otherwise-mentioned]
[Σ ([σ V] ...)]
[σs (σ ...)])
;; -----------------------------------------------------------------------------
;; set constraints
(define-judgment-form L
#:mode (∈ I I)
#:contract (∈ any (any ...))
[-----------------
(∈ any_1 (_ ... any_1 _ ...))])
(define-judgment-form L
#:mode (∉ I I)
#:contract (∉ any (any ...))
[-----------------
(∉ any_!_ (any_!_ ...))])
;; -----------------------------------------------------------------------------
;; the reduction system
(module+ test
(test-->> -->gc
(term [([a 1] [b (cons a b)] [c (cons c c)]) (a) ()])
(term [([a 1] [b (cons a b)] [c (cons c c)]) () (a)]))
(test-->> -->gc
(term [([a 1] [b (cons a b)] [c (cons c c)]) (b) ()])
(term [([a 1] [b (cons a b)] [c (cons c c)]) () (b a)]))
(test-->> -->gc
(term [([a 1] [b (cons a b)] [c (cons c c)]) (c) ()])
(term [([a 1] [b (cons a b)] [c (cons c c)]) () (c)])))
(define -->gc
(reduction-relation
L
#:domain [Σ σs σs]
(--> [Σ (σ_g σ_g2 ...) σs_b]
[Σ (σ_g2 ...) σs_b]
(judgment-holds (∈ σ_g σs_b))
"already black")
(--> [Σ (σ_g σ_g2 ...) (name σs_b (σ_b ...))]
[Σ (σ_g2 ...) (σ_b ... σ_g)]
(where (_ ... [σ_g number_g] _ ...) Σ)
(judgment-holds (∉ σ_g σs_b))
"number cell")
(--> [Σ (σ_g σ_g2 ...) (name σs_b (σ_b ...))]
[Σ (σ_ga σ_gd σ_g2 ...) (σ_b ... σ_g)]
(where (_ ... [σ_g (cons σ_ga σ_gd)] _ ...) Σ)
(judgment-holds (∉ σ_g σs_b))
"pair cell")))
(module+ test
(test-results))

top ← prev up next →