►CMSC 430:   Design and Implementation of Programming Languages
▼Notes
►19 Mountebank:   quote and compound static data
On this page:
19.1 Quote
19.2 Quotes are constants
19.3 Interpreting quote
19.4 Compiling quote
19.5 Getting Meta
8.6
    contents  ← prev  up  next → 

19 Mountebank: quote and compound static data

image Source code.

    19.1 Quote

    19.2 Quotes are constants

    19.3 Interpreting quote

    19.4 Compiling quote

    19.5 Getting Meta

19.1 Quote

One of the distinguishing features of the Lisp family of languages is the quote form, abbreviated ’, which is a notation for writing down literal s-expressions.

Recall that an S-Expression is:

; type S-Expr =
;             | Boolean
;             | Number
;             | Character
;             | String
;             | Symbol
;             | Empty
;             | (Boxof S-Expr)
;             | (Pairof S-Expr S-Expr)
;             | (Vectorof S-Expr)

Using quotes, we can write down a literal s-expression such as:

Examples

> '#t

#t

> '#f

#f

> '9

9

> '#\f

#\f

> 'f

'f

> '()

'()

> '#&7

'#&7

> '(1 . 2)

'(1 . 2)

> '#(1 2 3)

'#(1 2 3)

> '(a b ((c) #(d)))

'(a b ((c) #(d)))

The grammar of things that can be written down inside of a quote are:

; Datum d ::= #t
;          |  #f
;          |  n     where n is a Number literal
;          |  c     where c is a Character literal
;          |  s     where s is a String literal
;          |  s     where s is a Symbol literal
;          |  ()
;          |  #&d
;          |  (d . d)
;          | #(d ...)

At a first level of understanding, it’s possible to understand quote by rewriting to “push” the quote in as far as possible.

Some things are “self-quoting,” e.g. booleans, characters, strings, numbers, boxes, and vectors; thus #t and '#t are the same. When we have a quote around a self-quoting datum, we can delete it.

Other datums like symbols and the empty list cannot push the quote in further, so we have '() and 'fred as literals for the empty list and the symbol fred, respectively.

Pairs, boxes, and vectors are compound datums. We can understand #&d as (box 'd) and '(d1 . d2) as (cons 'd1 'd2) and #(d ...) as (vector 'd ...).

We’ve been using the quote-notation from the beginning of the course so it should be familiar by now.

One of the key things about quote is that we can go from the concrete syntax of an expression as a piece of code, e.g. (if (zero? x) 0 (+ x (tri (sub1 x)))), to a representation of that expression as a piece of data by prepending a single character; ’, e.g. '(if (zero? x) 0 (+ x (tri (sub1 x)))).

We’ve relied on this in the front-end of our compiler and interpreter to parse programs by first calling read, which reads a single datum:

Examples

> (with-input-from-string
    "(if (zero? x) 0 (+ x (tri (sub1 x))))"
    read)

'(if (zero? x) 0 (+ x (tri (sub1 x))))

Let us now add fully support for quote to our language. Let’s call it Mountebank.

We will change the AST definition for Mountebank to add a Quote constructor, which contains a datum. Since (Str s) and (Quote s) where s is a string are redundant, we remove all of the literal constructors.

Here is the new AST definition:

mountebank/ast.rkt

#lang racket
(provide (all-defined-out))
 
;; type Prog = (Prog (Listof Defn) Expr)
(struct Prog (ds e) #:prefab)
 
;; type Defn = (Defn Id (Listof Id) Expr)
(struct Defn (f xs e) #:prefab)
 
;; type Expr  = (Eof)
;;            | (Quote Datum)
;;            | (Prim0 Op0)
;;            | (Prim1 Op1 Expr)
;;            | (Prim2 Op2 Expr Expr)
;;            | (Prim3 Op3 Expr Expr Expr)
;;            | (If Expr Expr Expr)
;;            | (Begin Expr Expr)
;;            | (Let Id Expr Expr)
;;            | (Var Id)
;;            | (Match Expr (Listof Pat) (Listof Expr))
;;            | (App Expr (Listof Expr))
;;            | (Lam Id (Listof Id) Expr)
;; type Datum = Integer
;;            | Char
;;            | Boolean
;;            | String
;;            | Symbol
;;            | (Boxof Datum)
;;            | (Listof Datum)
;;            | (Vectorof Datum)
;; type Id    = Symbol
;; type Op0   = 'read-byte
;; type Op1   = 'add1 | 'sub1 | 'zero?
;;            | 'char? | 'integer->char | 'char->integer
;;            | 'write-byte | 'eof-object?
;;            | 'box | 'car | 'cdr | 'unbox
;;            | 'empty? | 'cons? | 'box?
;;            | 'vector? | 'vector-length
;;            | 'string? | 'string-length
;;            | 'symbol? | 'string->symbol
;;            | 'string->symbol | 'string->uninterned-symbol
;; type Op2   = '+ | '- | '< | '=
;;            | 'cons | 'eq?
;;            | 'make-vector | 'vector-ref
;;            | 'make-string | 'string-ref
;; type Op3   = 'vector-set!
;; type Pat  = (PVar Id)
;;           | (PWild)
;;           | (PLit Lit)
;;           | (PBox Pat)
;;           | (PCons Pat Pat)
;;           | (PAnd Pat Pat)
;;           | (PSymb Symbol)
;;           | (PStr String)
;; type Lit  = Boolean
;;           | Character
;;           | Integer
;;           | '()
 
(struct Eof   ()           #:prefab)
(struct Prim0 (p)          #:prefab)
(struct Prim1 (p e)        #:prefab)
(struct Prim2 (p e1 e2)    #:prefab)
(struct Prim3 (p e1 e2 e3) #:prefab)
(struct If    (e1 e2 e3)   #:prefab)
(struct Begin (e1 e2)      #:prefab)
(struct Let   (x e1 e2)    #:prefab)
(struct Var   (x)          #:prefab)
(struct App   (e es)       #:prefab)
(struct Lam   (f xs e)     #:prefab)
(struct Quote (d)          #:prefab)
(struct Match (e ps es)    #:prefab)
 
(struct PVar  (x)          #:prefab)
(struct PWild ()           #:prefab)
(struct PLit  (x)          #:prefab)
(struct PBox  (p)          #:prefab)
(struct PCons (p1 p2)      #:prefab)
(struct PAnd  (p1 p2)      #:prefab)
(struct PSymb (s)          #:prefab)
(struct PStr (s)           #:prefab)
 

The parser is updated to parse things like booleans, numbers, etc. as Quote nodes now and also to support the ability to write arbitrary datum value under a quote:

mountebank/parse.rkt

#lang racket
(provide parse parse-define parse-e)
(require "ast.rkt")
 
;; [Listof S-Expr] -> Prog
(define (parse s)
  (match s
    [(cons (and (cons 'define _) d) s)
     (match (parse s)
       [(Prog ds e)
        (Prog (cons (parse-define d) ds) e)])]
    [(cons e '()) (Prog '() (parse-e e))]
    [_ (error "program parse error")]))
 
;; S-Expr -> Defn
(define (parse-define s)
  (match s
    [(list 'define (list-rest (? symbol? f) xs) e)
     (if (andmap symbol? xs)
         (Defn f xs (parse-e e))
         (error "parse definition error"))]
    [_ (error "Parse defn error" s)]))
 
;; S-Expr -> Expr
(define (parse-e s)
  (match s
    [(? self-quoting?)             (Quote s)]
    [(list 'quote d)               (Quote d)]
    ['eof                          (Eof)]
    [(? symbol?)                   (Var s)]
    [(list (? (op? op0) p0))       (Prim0 p0)]
    [(list (? (op? op1) p1) e)     (Prim1 p1 (parse-e e))]
    [(list (? (op? op2) p2) e1 e2) (Prim2 p2 (parse-e e1) (parse-e e2))]
    [(list (? (op? op3) p3) e1 e2 e3)
     (Prim3 p3 (parse-e e1) (parse-e e2) (parse-e e3))]
    [(list 'begin e1 e2)
     (Begin (parse-e e1) (parse-e e2))]
    [(list 'if e1 e2 e3)
     (If (parse-e e1) (parse-e e2) (parse-e e3))]
    [(list 'let (list (list (? symbol? x) e1)) e2)
     (Let x (parse-e e1) (parse-e e2))]
    [(cons 'match (cons e ms))
     (parse-match (parse-e e) ms)]    
    [(list (or 'lambda 'λ) xs e)
     (if (and (list? xs)
              (andmap symbol? xs))
         (Lam (gensym 'lambda) xs (parse-e e))
         (error "parse lambda error"))]
    [(cons e es)
     (App (parse-e e) (map parse-e es))]    
    [_ (error "Parse error" s)]))
 
(define (parse-match e ms)
  (match ms
    ['() (Match e '() '())]
    [(cons (list p r) ms)
     (match (parse-match e ms)
       [(Match e ps es)
        (Match e
               (cons (parse-pat p) ps)
               (cons (parse-e r) es))])]))
 
(define (parse-pat p)
  (match p
    [(? boolean?) (PLit p)]
    [(? exact-integer?) (PLit p)]
    [(? char?)    (PLit p)]
    ['_           (PWild)]
    [(? symbol?)  (PVar p)]
    [(? string?)  (PStr p)]
    [(list 'quote (? symbol? s))
     (PSymb s)]
    [(list 'quote (list))
     (PLit '())]
    [(list 'box p)
     (PBox (parse-pat p))]
    [(list 'cons p1 p2)
     (PCons (parse-pat p1) (parse-pat p2))]
    [(list 'and p1 p2)
     (PAnd (parse-pat p1) (parse-pat p2))]
    [(cons 'list '())
     (PLit '())]
    [(cons 'list (cons p1 ps))
     (PCons (parse-pat p1)
            (parse-pat (cons 'list ps)))]))
 
(define (self-quoting? x)
  (or (integer? x)
      (boolean? x)
      (char? x)
      (string? x)
      (box? x)
      (vector? x)))
 
(define op0
  '(read-byte peek-byte void))
 
(define op1
  '(add1 sub1 zero? char? write-byte eof-object?
         integer->char char->integer
         box unbox empty? cons? box? car cdr
         vector? vector-length string? string-length
         symbol? symbol->string string->symbol string->uninterned-symbol))
(define op2
  '(+ - < = cons eq? make-vector vector-ref make-string string-ref))
(define op3
  '(vector-set!))
 
(define (op? ops)
  (λ (x)
    (and (symbol? x)
         (memq x ops))))
 
19.2 Quotes are constants

One thing that the “pushing quote” in understanding of quote misses is that a quote expression produces a constant, unlike the use of operations to construct an equivalent value.

Using eq? we can observe the difference. Recall that '(1 . 2) produces a value equivalent to (cons 1 2); however '(1 . 2) is a constant, whereas (cons 1 2) dynamically allocates memory to represent the pair.

We can see difference here:

Examples

> (define (f) '(1 . 2))
> (define (g) (cons 1 2))
> (eq? (f) (f))

#t

> (eq? (g) (g))

#f

Note, this does not mean that all quotes are interned (although some members of the Lisp and Scheme family do this):

Examples

> (define (f) '(1 . 2))
> (define (g) '(1 . 2))
> (eq? (f) (g))

#f

On the other hand, it’s important to note that strings and symbols that appear in quoted datums are interned as usual:

Examples

> (define (f) '("first" . second))
> (define (g) '("first" . second))
> (eq? (car (f)) (car (g)))

#t

> (eq? (cdr (f)) (cdr (g)))

#t

> (eq? (f) (g))

#f

19.3 Interpreting quote

Interpreting a quoted datum is trivial—it evaluates to the datum itself:

mountebank/interp.rkt

#lang racket
(provide interp interp-env)
(require "ast.rkt"
         "env.rkt"
         "interp-prims.rkt")
 
;; type Answer = Value | 'err
 
;; type Value =
;; | Datum
;; | Eof
;; | Void
;; | (cons Value Value)
;; | (box Value)
;; | (vector Value ...)
;; | (string Char ...)
;; | (Value ... -> Answer)
 
;; type REnv = (Listof (List Id Value))
;; type Defns = (Listof Defn)
 
;; Prog -> Answer
(define (interp p)
  (match p
    [(Prog ds e)
     (interp-env e '() ds)]))
 
;; Expr Env Defns -> Answer
(define (interp-env e r ds)
  (match e
    [(Quote d) d]
    [(Eof)    eof]
    [(Var x)  (interp-var x r ds)]
    [(Prim0 'void) (void)]
    [(Prim0 'read-byte) (read-byte)]
    [(Prim0 'peek-byte) (peek-byte)]
    [(Prim1 p e)
     (match (interp-env e r ds)
       ['err 'err]
       [v (interp-prim1 p v)])]
    [(Prim2 p e1 e2)
     (match (interp-env e1 r ds)
       ['err 'err]
       [v1 (match (interp-env e2 r ds)
             ['err 'err]
             [v2 (interp-prim2 p v1 v2)])])]
    [(Prim3 p e1 e2 e3)
     (match (interp-env e1 r ds)
       ['err 'err]
       [v1 (match (interp-env e2 r ds)
             ['err 'err]
             [v2 (match (interp-env e3 r ds)
                   ['err 'err]
                   [v3 (interp-prim3 p v1 v2 v3)])])])]
    [(If p e1 e2)
     (match (interp-env p r ds)
       ['err 'err]
       [v
        (if v
            (interp-env e1 r ds)
            (interp-env e2 r ds))])]
    [(Begin e1 e2)
     (match (interp-env e1 r ds)
       ['err 'err]
       [_    (interp-env e2 r ds)])]
    [(Let x e1 e2)
     (match (interp-env e1 r ds)
       ['err 'err]
       [v (interp-env e2 (ext r x v) ds)])]
    [(Lam _ xs e)
     (λ vs
       ; check arity matches
       (if (= (length xs) (length vs))
           (interp-env e (append (zip xs vs) r) ds)
           'err))]
    [(App e es)
     (match (interp-env e r ds)
       ['err 'err]
       [f
        (match (interp-env* es r ds)
          ['err 'err]
          [vs
           (if (procedure? f)
               (apply f vs)
               'err)])])]
    [(Match e ps es)
     (match (interp-env e r ds)
       ['err 'err]
       [v
        (interp-match v ps es r ds)])]))
 
;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer
(define (interp-match v ps es r ds)
  (match* (ps es)
    [('() '()) 'err]
    [((cons p ps) (cons e es))
     (match (interp-match-pat p v r)
       [#f (interp-match v ps es r ds)]
       [r  (interp-env e r ds)])]))
 
;; Pat Value Env -> [Maybe Env]
(define (interp-match-pat p v r)
  (match p
    [(PWild) r]
    [(PVar x) (ext r x v)]
    [(PSymb s) (and (eq? s v) r)]
    [(PStr s) (and (string? v) (string=? s v) r)]
    [(PLit l) (and (eqv? l v) r)]
    [(PBox p)
     (match v
       [(box v)
        (interp-match-pat p v r)]
       [_ #f])]
    [(PCons p1 p2)
     (match v
       [(cons v1 v2)
        (match (interp-match-pat p1 v1 r)
          [#f #f]
          [r1 (interp-match-pat p2 v2 r1)])]
       [_ #f])]
    [(PAnd p1 p2)
     (match (interp-match-pat p1 v r)
       [#f #f]
       [r1 (interp-match-pat p2 v r1)])]))
 
;; Id Env [Listof Defn] -> Answer
(define (interp-var x r ds)
  (match (lookup r x)
    ['err (match (defns-lookup ds x)
            [(Defn f xs e) (interp-env (Lam f xs e) '() ds)]
            [#f 'err])]
    [v v]))
 
;; (Listof Expr) REnv Defns -> (Listof Value) | 'err
(define (interp-env* es r ds)
  (match es
    ['() '()]
    [(cons e es)
     (match (interp-env e r ds)
       ['err 'err]
       [v (match (interp-env* es r ds)
            ['err 'err]
            [vs (cons v vs)])])]))
 
;; Defns Symbol -> [Maybe Defn]
(define (defns-lookup ds f)
  (findf (match-lambda [(Defn g _ _) (eq? f g)])
         ds))
 
(define (zip xs ys)
  (match* (xs ys)
    [('() '()) '()]
    [((cons x xs) (cons y ys))
     (cons (list x y)
           (zip xs ys))]))
 

The proper treatment of datums as constants is inherited from Racket, so our interpreter does the right thing on these examples:

Examples

> (define (run . p)
    (interp (parse p)))
> (run '(define (f) (cons 1 2))
       '(eq? (f) (f)))

#f

> (run '(define (f) '(1 . 2))
       '(eq? (f) (f)))

#t

19.4 Compiling quote

Compiling quote is not difficult. We’ve seen all the necessary pieces already. The key things to observe are:

The latter is achieved by extending the literals function from Mug to traverse the datum in a quote to extract any string or symbol occurrences.

mountebank/compile-literals.rkt

#lang racket
(provide compile-literals init-symbol-table literals)
(require "ast.rkt"
         "utils.rkt"
         a86/ast)
 
(define rdi 'rdi)
 
;; Prog -> Asm
(define (compile-literals p)
  (append-map compile-literal (literals p)))
 
;; Symbol -> Asm
(define (compile-literal s)
  (let ((str (symbol->string s)))
    (seq (Label (symbol->data-label s))
         (Dq (string-length str))
         (compile-string-chars (string->list str))
         (if (odd? (string-length str))
             (seq (Dd 0))
             (seq)))))
 
;; Prog -> Asm
;; Call intern_symbol on every symbol in the program
(define (init-symbol-table p)
  (match (symbols p)
    ['() (seq)]
    [ss  (seq (Sub 'rsp 8)
              (append-map init-symbol ss)
              (Add 'rsp 8))]))
 
;; Symbol -> Asm
(define (init-symbol s)
  (seq (Lea rdi (symbol->data-label s))
       (Call 'intern_symbol)))
 
;; Prog -> [Listof Symbol]
(define (literals p)
  (remove-duplicates
   (map to-symbol (literals* p))))
 
;; Prog -> [Listof Symbol]
(define (symbols p)
  (remove-duplicates (filter symbol? (literals* p))))
 
;; (U String Symbol) -> Symbol
(define (to-symbol s)
  (if (string? s)
      (string->symbol s)
      s))
 
;; Prog -> [Listof (U Symbol String)]
(define (literals* p)
  (match p
    [(Prog ds e)
     (append (append-map literals-d ds) (literals-e e))]))
 
;; Defn -> [Listof (U Symbol String)]
(define (literals-d d)
  (match d
    [(Defn f xs e)
     (literals-e e)]))
 
;; Expr -> [Listof (U Symbol String)]
(define (literals-e e)
  (match e
    [(Quote d) (literals-datum d)]
    [(Prim1 p e)
     (literals-e e)]
    [(Prim2 p e1 e2)
     (append (literals-e e1) (literals-e e2))]
    [(Prim3 p e1 e2 e3)
     (append (literals-e e1) (literals-e e2) (literals-e e3))]
    [(If e1 e2 e3)
     (append (literals-e e1) (literals-e e2) (literals-e e3))]
    [(Begin e1 e2)
     (append (literals-e e1) (literals-e e2))]
    [(Let x e1 e2)
     (append (literals-e e1) (literals-e e2))]
    [(App e1 es)
     (append (literals-e e1) (append-map literals-e es))]
    [(Lam f xs e)
     (literals-e e)]
    [(Match e ps es)
     (append (literals-e e) (append-map literals-match-clause ps es))]
    [_ '()]))
 
;; Pat Expr -> [Listof Symbol]
(define (literals-match-clause p e)
  (append (literals-pat p) (literals-e e)))
 
;; Pat -> [Listof (U Symbol String)]
(define (literals-pat p)
  (match p
    [(PSymb s) (list s)]
    [(PStr s) (list s)]
    [(PBox p) (literals-pat p)]
    [(PCons p1 p2) (append (literals-pat p1) (literals-pat p2))]
    [(PAnd p1 p2) (append (literals-pat p1) (literals-pat p2))]
    [_ '()]))
 
;; Datum -> [Listof (U Symbol String)]
(define (literals-datum d)
  (cond
    [(string? d) (list d)]
    [(symbol? d) (list d)]
    [(cons? d)
     (append (literals-datum (car d))
             (literals-datum (cdr d)))]
    [(box? d)
     (literals-datum (unbox d))]
    [(vector? d)
     (append-map literals-datum (vector->list d))]
    [else '()]))
 
;; [Listof Char] -> Asm
(define (compile-string-chars cs)
  (match cs
    ['() (seq)]
    [(cons c cs)
     (seq (Dd (char->integer c))
          (compile-string-chars cs))]))
 

The static allocation of compound datums is achieved use the same static memory allocation mechanism we saw when allocating the string data of strings and symbols.

Here’s how datums are compiled:

Let’s see some examples:

Examples

> (compile-datum 0)

(list (Mov 'rax 0))

> (compile-datum #f)

(list (Mov 'rax 56))

> (compile-datum 'fred)

(list

 (Lea 'rax (Plus 'data_fred_87134bd880f0d43 6)))

> (compile-datum "fred")

(list

 (Lea 'rax (Plus 'data_fred_87134bd880f0d43 4)))

> (compile-datum '(1 . 2))

(list

 (Data)

 (Label 'cons170891)

 (Dq 32)

 (Dq 16)

 (Text)

 (Lea 'rax (Plus 'cons170891 2)))

In the last example, you’ll notice we get a (Data) section that includes 2 words of memory; the first contains the bit representation of 2, i.e. the cdr of the pair, and the second contains the bit representation of 1, i.e. the car of the pair. After the (Data) section, we switch back to (Text) mode with an instruction to load the address of the statically allocated pair, appropriately tagged.

Datums can be built up arbitrarily large, so in order to compound datums, we need to recursive traverse their structure to emit the static data section of their construction. Here’s a larger example:

Examples

> (compile-datum '((3) fred #(x y z) (("wilma"))))

(list

 (Data)

 (Label 'cons170899)

 (Dq (Plus 'cons170898 2))

 (Dq (Plus 'cons170892 2))

 (Label 'cons170892)

 (Dq 152)

 (Dq 48)

 (Label 'cons170898)

 (Dq (Plus 'cons170897 2))

 (Dq (Plus 'data_fred_87134bd880f0d43 6))

 (Label 'cons170897)

 (Dq (Plus 'cons170896 2))

 (Dq (Plus 'vector170893 3))

 (Label 'vector170893)

 (Dq 3)

 (Dq (Plus 'data_x_5e969cd03b 6))

 (Dq (Plus 'data_y_5e969cd42a 6))

 (Dq (Plus 'data_z_5e969cd819 6))

 (Label 'cons170896)

 (Dq 152)

 (Dq (Plus 'cons170895 2))

 (Label 'cons170895)

 (Dq 152)

 (Dq (Plus 'cons170894 2))

 (Label 'cons170894)

 (Dq 152)

 (Dq (Plus 'data_wilma_787687308b728c1 4))

 (Text)

 (Lea 'rax (Plus 'cons170899 2)))

Notice that every compound datum has its own label and when they are contained within other compound datums, we get references, appropriately tagged, to those labels.

Here is a simple example of a nested datum: a box containing a box containing zero.

Examples

> (compile-datum '#&#&0)

(list

 (Data)

 (Label 'box170901)

 (Dq (Plus 'box170900 1))

 (Label 'box170900)

 (Dq 0)

 (Text)

 (Lea 'rax (Plus 'box170901 1)))

The data section starts with a label and word for the outer box. The word contains a tagged reference to the inner box, which is defined immediately below as a label and word. That word contains 0. In the text section there is a single instruction to load the tagged address of the outer box into 'rax.

Here is the complete code for compile-datum:

mountebank/compile-datum.rkt

#lang racket
(provide compile-datum)
(require "types.rkt"
         "utils.rkt"
         a86/ast)
 
;; Registers used
(define rax 'rax) ; return
 
;; Datum -> Asm
(define (compile-datum d)
  (cond
    [(string? d)   (seq (Lea rax (load-string d)))]
    [(symbol? d)   (seq (Lea rax (load-symbol d)))]
    [(compound? d) (compile-compound-datum d)]
    [else          (compile-atom d)]))
 
(define (load-symbol s)
  (Plus (symbol->data-label s) type-symb))
 
(define (load-string s)
  (Plus (symbol->data-label (string->symbol s)) type-str))
 
;; Value -> Asm
(define (compile-atom v)
  (seq (Mov rax (imm->bits v))))
 
;; Datum -> Boolean
(define (compound? d)
  (or (box? d)
      (cons? d)
      (vector? d)))
 
;; Datum -> Asm
(define (compile-compound-datum d)
  (match (compile-quoted d)
    [(cons l is)
     (seq (Data)
          is
          (Text)
          (Lea rax l))]))
 
;; Datum -> (cons AsmExpr Asm)
(define (compile-quoted c)
  (cond
    [(vector? c) (compile-datum-vector (vector->list c))]
    [(box? c)    (compile-datum-box (unbox c))]
    [(cons? c)   (compile-datum-cons (car c) (cdr c))]
    [(symbol? c) (cons (load-symbol c) '())]
    [(string? c) (cons (load-string c) '())]
    [else        (cons (imm->bits c) '())]))
 
;; Datum -> (cons AsmExpr Asm)
(define (compile-datum-box c)
  (match (compile-quoted c)
    [(cons l1 is1)
     (let ((l (gensym 'box)))
       (cons (Plus l type-box)
             (seq (Label l)
                  (Dq l1)
                  is1)))]))
 
;; Datum Datum -> (cons AsmExpr Asm)
(define (compile-datum-cons c1 c2)
  (match (compile-quoted c1)
    [(cons l1 is1)
     (match (compile-quoted c2)
       [(cons l2 is2)
        (let ((l (gensym 'cons)))
          (cons (Plus l type-cons)
                (seq (Label l)
                     (Dq l2)
                     (Dq l1)
                     is1
                     is2)))])]))
 
;; [Listof Datum] -> (cons AsmExpr Asm)
(define (compile-datum-vector ds)
  (match ds
    ['() (cons type-vect '())]
    [_
     (let ((l (gensym 'vector))
           (cds (map compile-quoted ds)))
       (cons (Plus l type-vect)
             (seq (Label l)
                  (Dq (length ds))
                  (map (λ (cd) (Dq (car cd))) cds)
                  (append-map cdr cds))))]))
 

Now we’ve succsefully implemented quote and can confirm are examples behave as expected:

Examples

> (current-objs '("runtime.o"))
> (define (run . p)
    (unload/free (asm-interp (compile (parse p)))))
> (run '#t)

#t

> (run ''#t)

#t

> (run ''(1 . 2))

'(1 . 2)

> (run ''(1 fred #("wilma")))

'(1 fred #("wilma"))

> (run '(define (f) '(1 . 2))
       '(eq? (f) (f)))

#t

> (run '(define (f) '("fred" . wilma))
       '(define (g) '("fred" . wilma))
       '(eq? (car (f)) (car (g))))

#t

> (run '(define (f) '("fred" . wilma))
       '(define (g) '("fred" . wilma))
       '(eq? (cdr (f)) (cdr (g))))

#t

19.5 Getting Meta

It’s worth taking stock of the kind of programs we can now write. Since quote let’s us write down data that looks an awful lot like programs, we can start to write programs that operate over this kind of data in a way that may seem familiar.

For example, here’s a program that interprets a little language that has elements of the ones we’ve been building:

mountebank/simple-interp.rkt

#lang racket
 
;; type Expr = Number
;;           | Boolean
;;           | (list Op1 Expr)
;;           | (list Op2 Expr)
;;           | (list 'if Expr Expr Expr)
;;           | (list Expr Expr)
;;           | (list 'λ (list Id) Expr)
;;           | Id
 
;; type Id = Symbol
;; type Op1 = 'sub1 | 'zero?
;; type Op2 = '+
 
;; type Value = Number
;;            | Boolean
;;            | (Value -> Value)
 
;; Expr Env -> Value
(define (interp e r)
  (match e
    [(list '+ e1 e2)
     (+ (interp e1 r) (interp e2 r))]
    [(list 'sub1 e1)
     (sub1 (interp e1 r))]
    [(list 'zero? e1)
     (zero? (interp e1 r))]
    [(list 'if e1 e2 e3)
     (if (interp e1 r)
         (interp e2 r)
 (interp e3 r))]
    [(list 'λ (list x) e1)
     (λ (v) (interp e1 (cons (cons x v) r)))]
    [(list e1 e2)
     ((interp e1 r) (interp e2 r))]
    [_
     (if (symbol? e)
         (lookup e r)
 e)]))
 
;; Id Env -> Value
(define (lookup x r)
  (match r
    [(cons (cons y v) r)
     (if (eq? x y)
         v
 (lookup x r))]))
 
(interp '(((λ (t)
            ((λ (f) (t (λ (z) ((f f) z))))
             (λ (f) (t (λ (z) ((f f) z))))))
           (λ (tri)
            (λ (n)
             (if (zero? n)
                 0
                 (+ n (tri (sub1 n)))))))
          36)
          '())
 

Now of course this is a Racket program, which we can run. Running it will run the interpreter we defined on the input program, computing the 36th triangular number:

shell

> racket simple-interp.rkt
666

But of course, this is also a Mountebank program! So we can interpret it with our Mountenank interpreter:

shell

> racket -t interp-file.rkt -m simple-interp.rkt
666

And since it’s a Mountebank program, we can also compile it and then running the resulting executable:

shell

> make simple-interp.run
make[1]: Entering directory `/afs/glue.umd.edu/home/glue/d/v/dvanhorn/home/git/www/langs/mountebank'
make[1]: `simple-interp.run' is up to date.
make[1]: Leaving directory `/afs/glue.umd.edu/home/glue/d/v/dvanhorn/home/git/www/langs/mountebank'
> ./simple-interp.run
666

We are moving ever closer to the point where our compiler can compile the source code of itself.

    contents  ← prev  up  next →