113 lines
3.8 KiB
Racket
113 lines
3.8 KiB
Racket
#lang racket
|
|
|
|
(require redex/pict
|
|
redex/reduction-semantics)
|
|
|
|
|
|
;
|
|
;
|
|
; ;;; ; ; ;
|
|
; ; ; ; ;
|
|
; ; ; ;;; ;;;;; ;;; ;; ;; ;;; ;;;;; ;;; ;;; ;; ;;
|
|
; ; ; ; ; ; ; ;; ; ; ; ; ; ; ;; ;
|
|
; ; ; ;;;;; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ;;;; ;;;; ;;;;; ;;;;; ;;; ;;; ;;;;; ;;; ;;;;; ;;; ;;; ;;;
|
|
;
|
|
;
|
|
;
|
|
;
|
|
|
|
|
|
(define-language STLC
|
|
(e (λ (x τ) e)
|
|
(e e)
|
|
x
|
|
i
|
|
add1)
|
|
(τ int
|
|
(τ → τ))
|
|
(Γ ([x τ] ...))
|
|
(i integer)
|
|
(x variable-not-otherwise-mentioned))
|
|
|
|
(define-judgment-form STLC
|
|
#:mode (typeof I I O)
|
|
#:contract (typeof Γ e τ)
|
|
[(typeof Γ (λ (x τ_1) e) (τ_1 → τ_2))
|
|
(typeof (extend Γ x τ_1) e τ_2)]
|
|
[(typeof Γ (e_1 e_2) τ)
|
|
(typeof Γ e_1 (τ_2 → τ))
|
|
(typeof Γ e_2 τ_2)]
|
|
[(typeof Γ x τ)
|
|
(where τ (lookup Γ x))]
|
|
[(typeof Γ i int)]
|
|
[(typeof Γ add1 (int → int))])
|
|
|
|
(define-metafunction STLC
|
|
extend : Γ x τ -> Γ
|
|
[(extend ([x_0 τ_0] ... [x_i τ_i] [x_i+1 τ_i+1] ...) x_i τ)
|
|
([x_0 τ_0] ... [x_i τ] [x_i+1 τ_i+1] ...)]
|
|
[(extend ([x_1 τ_1] ...) x_0 τ_0)
|
|
([x_0 τ_0] [x_1 τ_1] ...)])
|
|
|
|
(define-metafunction STLC
|
|
lookup : Γ x -> τ
|
|
[(lookup ([x_0 τ_0] ... [x_i τ_i] [x_i+1 τ_i+1] ...) x_i)
|
|
τ_i])
|
|
|
|
(test-equal
|
|
(judgment-holds
|
|
(typeof ()
|
|
(λ (x int)
|
|
(λ (x (int → int))
|
|
(x (add1 7))))
|
|
τ)
|
|
τ)
|
|
(list (term (int → ((int → int) → int)))))
|
|
(test-equal
|
|
(judgment-holds
|
|
(typeof ()
|
|
(λ (x int)
|
|
(λ (x (int → int))
|
|
(add1 x)))
|
|
τ))
|
|
#f)
|
|
|
|
|
|
;
|
|
;
|
|
; ;
|
|
; ; ; ; ; ;
|
|
; ; ;;; ;;;;; ;; ;;; ;;;; ;;; ;;;;; ;;;;; ;;; ;; ;; ;; ;;
|
|
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ;; ; ; ;;
|
|
; ; ; ; ; ; ;;;;; ;;; ;;;;; ; ; ; ; ; ; ;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ;;; ; ;;;; ;;;; ;;;; ;;;; ;;; ;;; ;;;;; ;;; ;;; ;;;;
|
|
; ; ; ;
|
|
; ;;;; ;;; ;;;
|
|
;
|
|
;
|
|
|
|
|
|
(define rewrite-typeof
|
|
(match-lambda
|
|
[(list _ _ Γ e τ _)
|
|
(list "" Γ " ⊢ " e " : " τ)]))
|
|
(define rewrite-extend
|
|
(match-lambda
|
|
[(list _ _ Γ x τ _)
|
|
(list "" Γ ", " x ":" τ)]))
|
|
(define rewrite-lookup
|
|
(match-lambda
|
|
[(list _ _ Γ x _)
|
|
(list "" Γ "(" x ")")]))
|
|
|
|
(with-compound-rewriters
|
|
(['typeof rewrite-typeof]
|
|
['extend rewrite-extend]
|
|
['lookup rewrite-lookup])
|
|
(render-judgment-form typeof))
|