36 lines
1.0 KiB
Racket
36 lines
1.0 KiB
Racket
#lang racket/base
|
|
(require "typecheck.rkt")
|
|
(require (prefix-in stlc: (only-in "stlc+cons.rkt" #%app λ))
|
|
(except-in "stlc+cons.rkt" #%app λ))
|
|
(provide (rename-out [stlc:#%app #%app] [stlc:λ λ]))
|
|
(provide (except-out (all-from-out "stlc+cons.rkt") stlc:#%app stlc:λ))
|
|
(provide ref deref :=)
|
|
|
|
;; Simply-Typed Lambda Calculus, plus mutable references
|
|
;; Types:
|
|
;; - types from stlc+cons.rkt
|
|
;; - Ref constructor
|
|
;; Terms:
|
|
;; - terms from stlc+cons.rkt
|
|
|
|
(define-type-constructor Ref #:arity 1)
|
|
|
|
(define-syntax (ref stx)
|
|
(syntax-parse stx
|
|
[(_ e)
|
|
#:with (e- τ) (infer+erase #'e)
|
|
(⊢ #'(box e-) #'(Ref τ))]))
|
|
(define-syntax (deref stx)
|
|
(syntax-parse stx
|
|
[(_ e)
|
|
#:with (e- ref-τ) (infer+erase #'e)
|
|
#:with (τ) (Ref-args #'ref-τ)
|
|
(⊢ #'(unbox e-) #'τ)]))
|
|
(define-syntax (:= stx)
|
|
(syntax-parse stx
|
|
[(_ e_ref e)
|
|
#:with (e_ref- ref-τ) (infer+erase #'e_ref)
|
|
#:with (τ1) (Ref-args #'ref-τ)
|
|
#:with (e- τ2) (infer+erase #'e)
|
|
#:when (typecheck? #'τ1 #'τ2)
|
|
(⊢ #'(set-box! e_ref- e-) #'Unit)])) |