1 Extension: Binary Subtraction

it’s easy to define subtraction: a − b = a + −1 × b.

(define-type ArithS
  [numS (n : number)]
  [plusS (l : ArithS) (r : ArithS)]
  [bminusS (l : ArithS) (r : ArithS)]
  [multS (l : ArithS) (r : ArithS)])

(define (desugar [as : ArithS]) : ArithC
  (type-case ArithS as
    [numS (n) (numC n)]
    [plusS (l r) (plusC (desugar l)
                        (desugar r))]
    [multS (l r) (multC (desugar l)
                        (desugar r))]
    [bminusS (l r) (plusC (desugar l)
                          (multC (numC -1) (desugar r)))]))

2 Extension: Unary Negation

−b = −1 × b
-b = 0 - b
怎么选？

ArithS中的定义

[uminusS (e : ArithS)]

desugar中的写法

[uminusS (e) (desugar (bminusS (numS 0) e))]

注意这里的e没有desugar
这种把输入项直接放到另一个输入项里传给desugar处理的方法叫做宏(macro :D)。
这个例子中的宏就是uminusS的定义

然而有两个问题

1递归是generative recursion，需要留点神。
（关于啥是generative recursion：
a:Many well-known recursive algorithms generate an entirely new piece of data from the given data and recur on it. HtDP (How To Design Programs) refers to this kind as generative recursion.
b:http://www.ccs.neu.edu/home/matthias/HtDP2e/part_five.html
）
2,这种写法依赖于bminusS的定义。

所以，写成这样可能比较好

[uminusS (e) (multC (numC -1)
                    (desugar e))]

完整栗子

#lang plai-typed

(define-type ArithS
  [numS (n : number)]
  [plusS (l : ArithS) (r : ArithS)]
  [bminusS (l : ArithS) (r : ArithS)]
  [uminusS (e : ArithS)]
  [multS (l : ArithS) (r : ArithS)])

(define-type ArithC
  [numC (n : number)]
  [plusC (l : ArithC) (r : ArithC)]
  [multC (l : ArithC) (r : ArithC)])

(define (parse [s : s-expression]) : ArithS
  (cond
    [(s-exp-number? s) (numS (s-exp->number s))]
    [(s-exp-list? s)
     (let ([sl (s-exp->list s)])
       (case (s-exp->symbol (first sl))
         [(+) (plusS (parse (second sl)) (parse (third sl)))]
         [(*) (multS (parse (second sl)) (parse (third sl)))]
         [(-) (bminusS (parse (second sl)) (parse (third sl)))]
         [(u-) (uminusS (parse (second sl)))]
         [else (error 'parse "invalid list input")]))]
    [else (error 'parse "invalid input")]))

(define (desugar [as : ArithS]) : ArithC
  (type-case ArithS as
    [numS (n) (numC n)]
    [plusS (l r) (plusC (desugar l)
                        (desugar r))]
    [multS (l r) (multC (desugar l)
                        (desugar r))]
    [bminusS (l r) (plusC (desugar l)
                          (multC (numC -1) (desugar r)))]
    [uminusS (e) (multC (numC -1)
                        (desugar e))]))

(define (interp [a : ArithC]) : number
  (type-case ArithC a
    [numC (n) n]
    [plusC (l r) (+ (interp l) (interp r))]
    [multC (l r) (* (interp l) (interp r))]))

(define (driver [s : s-expression]) : number  
  (interp (desugar (parse s))))

(driver '(- 2 1))
(driver '(u- 1))