adrianwong programmer · retired coal miner

A (brief...?) detour into PLAI

I’ve had the second edition of Programming Languages: Application and Interpretation on my to-read list for a while now, and a recent conversation on the interwebs prompted me to finally take a peek.

Here are a few initial observations:

Let’s do a brief run-through of chapters 2, 3 and 4:

We start off by implementing a parser and interpreter for a bare-bones arithmetic language which (initially) only supports two operations - addition and multiplication. These operations can be arbitrarily nested.

We provide an internal representation for this language, like so:

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

…then define a function parse that converts an s-expression into this representation:

(define (parse [s : s-expression]) : ArithC
  (cond
    [(s-exp-number? s) (numC (s-exp->number s))]
    [(s-exp-list? s)
     (let ([sl (s-exp->list s)])
       (case (s-exp->symbol (first sl))
         [(+) (plusC (parse (second sl)) (parse (third sl)))]
         [(*) (multC (parse (second sl)) (parse (third sl)))]
         [else (error 'parse "invalid list input")]))]
    [else (error 'parse "invalid input")]))

; parser tests
(test (parse '1) (numC 1))
(test (parse '(+ 2 3)) (plusC (numC 2) (numC 3)))
(test (parse '(* 1 2)) (multC (numC 1) (numC 2)))
(test (parse '(+ (* 1 2) (+ 2 3)))
      (plusC (multC (numC 1) (numC 2)) (plusC (numC 2) (numC 3))))

…then define a function interp that converts this representation into its corresponding value:

(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))]))

; interpreter tests
(test (interp (numC 1)) 1)
(test (interp (plusC (numC 2) (numC 3))) 5)
(test (interp (multC (numC 1) (numC 2))) 2)
(test (interp (plusC (multC (numC 1) (numC 2)) (plusC (numC 2) (numC 3)))) 7)

Note: the semantics of addition and multiplication in our little language are identical to the semantics of addition and multiplication in Racket, as applied to numbers. This is because we map our + to Racket’s +, and our * to Racket’s *.

We then extend our language to support binary subtraction, but want to express it in terms of existing operations. We also do not want to modify what we now consider our “core” language, so we extend it by layering on a “surface” language that supports all the operations of the core language, plus (har har) binary subtraction.

To this end, we provide a representation of the surface language, which is translated into the representation of the core language via a desugar function:

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

(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)))]
         [(-) (bminusS (parse (second sl)) (parse (third sl)))]
         [(*) (multS (parse (second sl)) (parse (third 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))]
    [bminusS (l r) (plusC (desugar l)
                          (multC (numC -1) (desugar r)))]
    [multS (l r) (multC (desugar l)
                        (desugar r))]))

; parser tests
(test (parse '1) (numS 1))
(test (parse '(+ 2 3)) (plusS (numS 2) (numS 3)))
(test (parse '(- 3 2)) (bminusS (numS 3) (numS 2)))
(test (parse '(* 1 2)) (multS (numS 1) (numS 2)))
(test (parse '(+ (* 1 2) (+ 2 3)))
      (plusS (multS (numS 1) (numS 2)) (plusS (numS 2) (numS 3))))

; desugarer tests
(test (desugar (numS 1)) (numC 1))
(test (desugar (plusS (numS 2) (numS 3)))
      (plusC (numC 2) (numC 3)))
(test (desugar (bminusS (numS 3) (numS 2)))
      (plusC (numC 3) (multC (numC -1) (numC 2))))
(test (desugar (multS (numS 1) (numS 2)))
      (multC (numC 1) (numC 2)))
(test (desugar (plusS (multS (numS 1) (numS 2)) (plusS (numS 2) (numS 3))))
      (plusC (multC (numC 1) (numC 2)) (plusC (numC 2) (numC 3))))

We further extend the surface language to also support unary negation:

(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 (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)))]
         [(-) (if (> (length sl) 2)
                  (bminusS (parse (second sl)) (parse (third sl)))
                  (uminusS (parse (second sl))))]
         [(*) (multS (parse (second sl)) (parse (third 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))]
    [bminusS (l r) (plusC (desugar l)
                          (multC (numC -1) (desugar r)))]
    [uminusS (e) (multC (numC -1) (desugar e))]
    [multS (l r) (multC (desugar l)
                        (desugar r))]))

; + parser test
(test (parse '(- (- 3 2))) (uminusS (bminusS (numS 3) (numS 2))))

; + desugarer test
(test (desugar (uminusS (bminusS (numS 3) (numS 2))))
      (multC (numC -1) (plusC (numC 3) (multC (numC -1) (numC 2)))))

The content covered in these chapters is somewhat familiar to me by now, but it was still enjoyable to work through, particularly the “Do Now!” exercises. This is a short text, so I’m tempted to keep going…