85 lines
1.6 KiB
Racket
85 lines
1.6 KiB
Racket
#lang racket
|
|
|
|
(require "common.rkt" redex)
|
|
(provide (all-defined-out))
|
|
|
|
(define (num n)
|
|
(if (zero? n)
|
|
`("0")
|
|
`("S" ,(num (sub1 n)))))
|
|
|
|
(define (lst l)
|
|
(if (empty? l)
|
|
`("nil")
|
|
`("cons" ,(first l) ,(lst (rest l)))))
|
|
|
|
(define (:let name named-expr body)
|
|
`((λ (,name) ,body)
|
|
,named-expr))
|
|
|
|
(define =-impl
|
|
`(λ (x y)
|
|
(match x
|
|
[("0")
|
|
(match y
|
|
[("0") ("#t")]
|
|
[("S" yn) ("#f")])]
|
|
[("S" xn)
|
|
(match y
|
|
[("0") ("#f")]
|
|
[("S" yn) ((ref =) xn yn)])])))
|
|
|
|
(define +-impl
|
|
`(λ (x y)
|
|
(match x
|
|
[("0") y]
|
|
[("S" xn)
|
|
,(:let 'in '((ref +) xn y)
|
|
'("S" in))])))
|
|
|
|
(define --impl
|
|
`(λ (n m)
|
|
(match n
|
|
[("0") n]
|
|
[("S" k)
|
|
(match m
|
|
[("0") n]
|
|
[("S" l) ((ref -) k l)])])))
|
|
|
|
(define *-impl
|
|
`(λ (n m)
|
|
(match n
|
|
[("0") ("0")]
|
|
[("S" p) ,(:let 'tmp '((ref *) p m)
|
|
'((ref +) m tmp))])))
|
|
|
|
(define if-impl
|
|
`(λ (cond true false)
|
|
(match cond
|
|
[("#t") (true)]
|
|
[("#f") (false)])))
|
|
|
|
(define (with-arith e)
|
|
`(letrec
|
|
([(ref =) ,=-impl]
|
|
[(ref +) ,+-impl]
|
|
[(ref -) ,--impl]
|
|
[(ref *) ,*-impl]
|
|
[(ref if) ,if-impl])
|
|
,e))
|
|
|
|
(define arith-store
|
|
(term
|
|
(make-store [= ,=-impl]
|
|
[+ ,+-impl]
|
|
[- ,--impl]
|
|
[* ,*-impl]
|
|
[if ,if-impl])))
|
|
|
|
(define (:if cond true false)
|
|
(:let 'cond-val cond
|
|
`((ref if)
|
|
cond-val
|
|
(λ () ,true)
|
|
(λ () ,false))))
|