PLAI_Chapter 5 Adding Functions

5.1 Defining Data Representations

To keep things simple, let’s just consider functions of one argument.

Here are some Racket examples:

(define (double x) (+ x x))
(define (quadruple x) (double (double x)))
(define (const5 _) 5)

函数体定义

<fundef> ::=
(define-type FunDefC
  [fdC (name : symbol) (arg : symbol) (body : ExprC)])

注意函数体的body部分，其中含有x，这个x目前是标识符(identifier)。而不是变量(variable)。变量特指有值又有地址的东西。以后再介绍。

body部分里还有函数名，这个称之为调用(application)。

ExprC

(define-type ExprC
  [numC (n : number)]
  <idC-def>
  <app-def>
  [plusC (l : ExprC) (r : ExprC)]
  [multC (l : ExprC) (r : ExprC)])

Identifiers are closely related to formal parameters. When we apply a function by giving it a value for its parameter, we are in effect asking it to replace all instances of that formal parameter in the body—i.e., the identifiers with the same name as the formal parameter—with that value.

<idC-def> ::=
  [idC (s : symbol)]

<app-def> ::=
  [appC (fun : symbol) (arg : ExprC)]

identifying which function to apply, and providing its argument.

解释器定义

(define (interp [e : ExprC] [fds : (listof FunDefC)]) : number
  (type-case ExprC e
    [numC (n) n]
    <idC-interp-case>
    <appC-interp-case>
    [plusC (l r) (+ (interp l fds) (interp r fds))]
    [multC (l r) (* (interp l fds) (interp r fds))]))

然后讲了怎么进行替换。想了解到底怎么正确的进行替换(substitute)需要看 lambda calculus

本章完整代码

#lang plai-typed

(define-type ExprS
  [numS (n : number)]
  [plusS (l : ExprS) (r : ExprS)]
  [bminusS (l : ExprS) (r : ExprS)]
  [uminusS (e : ExprS)]
  [multS (l : ExprS) (r : ExprS)]
  [idS (s : symbol)]
  [appS (fun : symbol) (arg : ExprS)])

(define-type ExprC
  [numC (n : number)]
  [idC (s : symbol)]
  [appC (fun : symbol) (arg : ExprC)]
  [plusC (l : ExprC) (r : ExprC)]
  [multC (l : ExprC) (r : ExprC)])

(define-type FunDefC
  [fdC (name : symbol) (arg : symbol) (body : ExprC)])

(define (parse [s : s-expression]) : ExprS
  (cond
    [(s-exp-number? s) (numS (s-exp->number s))]
    [(s-exp-symbol? s) (idS (s-exp->symbol 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 (appS (s-exp->symbol (first sl))
                     (parse (second sl)))]))]
    [else (error 'parse "invalid input")]))

(define (parsedef [s : s-expression]) : FunDefC
  (cond
    [(s-exp-list? s)
     (let ([sl (s-exp->list s)])
       (case (s-exp->symbol (first sl))
         [(define) (fdC (s-exp->symbol (first (s-exp->list (second sl))))
                        (s-exp->symbol (second (s-exp->list (second sl))))
                        (desugar (parse (third sl))))]
         [else (error 'parsedef "invalid list")]))]
    [else (error 'parsedef "invalid input")]))

(define (desugar [as : ExprS]) : ExprC
  (type-case ExprS 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))]
    [idS (s) (idC s)]
    [appS (fun arg) (appC fun (desugar arg))]))

(define (subst [what : ExprC] [for : symbol] [in : ExprC]) : ExprC
  (type-case ExprC in
    [numC (n) in]
    [idC (s) (cond
               [(symbol=? s for) what]
               [else in])]
    [appC (f a) (appC f (subst what for a))]
    [plusC (l r) (plusC (subst what for l)
                        (subst what for r))]
    [multC (l r) (multC (subst what for l)
                        (subst what for r))]))

(define (get-fundef [n : symbol] [fds : (listof FunDefC)]) : FunDefC
  (cond
    [(empty? fds) (error 'get-fundef "reference to undefined function")]
    [(cons? fds) (cond
                   [(equal? n (fdC-name (first fds))) (first fds)]
                   [else (get-fundef n (rest fds))])]))

(define (interp-1 [e : ExprC] [fds : (listof FunDefC)]) : number
  (type-case ExprC e
    [numC (n) n]
    [idC (_) (error 'interp-1 "shouldn't get here")]
    [appC (f a) (local ([define fd (get-fundef f fds)])
                  (interp-1 (subst (numC (interp-1 a fds))
                                 (fdC-arg fd)
                                 (fdC-body fd)) fds))]
    [plusC (l r) (+ (interp-1 l fds) (interp-1 r fds))]
    [multC (l r) (* (interp-1 l fds) (interp-1 r fds))]))

(define (interp [e : ExprC] [fds : (listof FunDefC)]) : number
  (type-case ExprC e
    [numC (n) n]
    [idC (_) (error 'interp "shouldn't get here")]
    [appC (f a) (local ([define fd (get-fundef f fds)])
                  (interp (subst a
                                 (fdC-arg fd)
                                 (fdC-body fd)) fds))]
    [plusC (l r) (+ (interp l fds) (interp r fds))]
    [multC (l r) (* (interp l fds) (interp r fds))]))

(define (driver e fdlist)
  (interp-1 (desugar (parse e)) (map parsedef fdlist)))

(driver `(f 1) (list `(define (f x) (+ x x))))