Skip to content

Commit 9cfc401

Browse files
dvanhorndvanhorn
committed
Quotation as sugar.
1 parent 0eaf5d7 commit 9cfc401

File tree

3 files changed

+168
-73
lines changed

3 files changed

+168
-73
lines changed

‎www/notes/mug.scrbl‎

Lines changed: 139 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -142,17 +142,8 @@ which will transform extended programs into ``core'' expressions:
142142
[(? symbol? x) x]
143143
[(? imm? i) i]
144144
[`',(? symbol? s) `',s]
145-
[`(box ,e0) `(box ,(desugar e0))]
146-
[`(unbox ,e0) `(unbox ,(desugar e0))]
147-
[`(cons ,e0 ,e1) `(cons ,(desugar e0) ,(desugar e1))]
148-
[`(car ,e0) `(car ,(desugar e0))]
149-
[`(cdr ,e0) `(cdr ,(desugar e0))]
150-
[`(add1 ,e0) `(add1 ,(desugar e0))]
151-
[`(sub1 ,e0) `(sub1 ,(desugar e0))]
152-
[`(zero? ,e0) `(zero? ,(desugar e0))]
153-
[`(empty? ,e0) `(empty? ,(desugar e0))]
145+
[`(,(? prim? p) . ,es) `(,p ,@(map desugar es))]
154146
[`(if ,e0 ,e1 ,e2) `(if ,(desugar e0) ,(desugar e1) ,(desugar e2))]
155-
[`(+ ,e0 ,e1) `(+ ,(desugar e0) ,(desugar e1))]
156147
[`(let ((,x ,e0)) ,e1) `(let ((,x ,(desugar e0))) ,(desugar e1))]
157148
[`(letrec ,bs ,e0)
158149
`(letrec ,(map (λ (b) (list (first b) (desugar (second b)))) bs)
@@ -182,6 +173,12 @@ derived forms, including itself!
182173
]
183174

184175

176+
Derived forms that can be elaborated away by rewriting into more
177+
primitive forms are sometimes called @bold{syntactic sugar} since they
178+
are not fundamental but ``sweeten'' the experience of writing programs
179+
with useful shorthands. We call the elaboration function @racket[desugar]
180+
to indicate that it is eliminating the syntactic sugar.
181+
185182
@section[#:tag-prefix "mug"]{Exceptional behavior}
186183

187184
To see an example of taking the idea of program transformation as a
@@ -667,5 +664,137 @@ Now let's give it a spin:
667664
(run '(if (zero? 0) (raise 1) 2))
668665
]
669666

667+
@section[#:tag-prefix "mug"]{Quotation}
668+
669+
We have seen how to interpret limited uses of @racket[quote], such as
670+
in @racket[(quote ())] and @racket[(quote x)], i.e. the empty list and symbols.
671+
672+
But we've also been using @emph{using} @racket[quote] more generally
673+
where we can write down an arbitrary constant s-expression within a
674+
@racket[quote]:
675+
676+
@ex[
677+
'#t
678+
'5
679+
'(1 2 3)
680+
'(add1 x)
681+
'(car '(1 2 3))
682+
'(((1) 2) 3)
683+
'(1 . 2)
684+
'("asdf" fred ((one)))
685+
]
686+
687+
We can understand the more general @racket[quote] form as a shorthand
688+
for expressions that construct an equivalent list to the one denoted
689+
by the s-expression.
690+
691+
For example,
692+
@itemlist[
693+
694+
@item{@racket['1] is shorthand for @racket[1],}
695+
696+
@item{@racket['(1 . 2)] is shorthand for @racket[(cons '1 '2)], which
697+
is shorthand for @racket[(cons 1 2)],}
698+
699+
@item{@racket['(1 2 3)] is shorthand for @racket[(cons '1 '(2 3))],
700+
which is shorthand for @racket[(cons 1 (cons '2 '(3)))], which is
701+
shorthand for @racket[(cons 1 (cons 2 (cons '3 '())))], which is
702+
shorthand for @racket[(cons 1 (cons 2 (cons 3 '())))],}
703+
704+
@item{@racket['()] is as simple as possible (the empty list),}
705+
706+
@item{@racket['x] is as simple as possible (a symbol), and}
707+
708+
@item{@racket[5] is as simple as possible.}
709+
]
710+
711+
Guided by these examples, we can write a function that transforms the
712+
s-expression inside of a @racket[quote] into an equivalent expression
713+
that only uses @racket[quote] for constructing symbols and the empty
714+
list:
715+
716+
717+
@#reader scribble/comment-reader
718+
(ex
719+
;; S-Expr -> Expr
720+
;; Produce an expression that evaluates to given s-expression, without
721+
;; use of quote (except for symbols and empty list)
722+
(define (quote->expr d)
723+
(match d
724+
[(? boolean?) d]
725+
[(? integer?) d]
726+
[(? string?) d]
727+
[(? char?) d]
728+
[(? symbol?) (list 'quote d)]
729+
[(cons x y) (list 'cons (quote->expr x) (quote->expr y))]
730+
['() ''()]))
731+
732+
733+
(quote->expr 'x)
734+
(quote->expr 5)
735+
(quote->expr "Fred")
736+
(quote->expr '(1 . 2))
737+
(quote->expr '(1 2 3))
738+
(quote->expr '(car '(1 2 3)))
739+
(quote->expr '(((1) 2) 3))
740+
(quote->expr '(1 . 2))
741+
(quote->expr '("asdf" fred ((one))))
742+
)
743+
744+
We can now incorporate this into @racket[desugar] to eliminate uses of
745+
compound-data @racket[quote]:
746+
747+
@#reader scribble/comment-reader
748+
(ex
749+
;; Expr+ -> Expr
750+
(define (desugar e+)
751+
(match e+
752+
[`(begin ,@(list `(define (,fs . ,xss) ,es) ...) ,e)
753+
`(letrec ,(map (λ (f xs e) `(,f (λ ,xs ,(desugar e)))) fs xss es)
754+
,(desugar e))]
755+
[(? symbol? x) x]
756+
[(? imm? i) i]
757+
[`',(? symbol? s) `',s]
758+
[`',d (quote->expr d)]
759+
[`(,(? prim? p) . ,es) `(,p ,@(map desugar es))]
760+
[`(if ,e0 ,e1 ,e2) `(if ,(desugar e0) ,(desugar e1) ,(desugar e2))]
761+
[`(let ((,x ,e0)) ,e1) `(let ((,x ,(desugar e0))) ,(desugar e1))]
762+
[`(letrec ,bs ,e0)
763+
`(letrec ,(map (λ (b) (list (first b) (desugar (second b)))) bs)
764+
,(desugar e0))]
765+
[`(λ ,xs ,e0) `(λ ,xs ,(desugar e0))]
766+
[`(cond . ,_) (desugar (cond->if e+))]
767+
[`(and . ,_) (desugar (and->if e+))]
768+
[`(or . ,_) (desugar (or->if e+))]
769+
[`(,e . ,es) `(,(desugar e) ,@(map desugar es))]))
770+
)
771+
772+
And now we can @racket[desugar] programs such as these:
773+
774+
@ex[
775+
(desugar '(map f '(1 2 3)))
776+
(desugar '(map f '(and 1 2)))
777+
(desugar '(if x '(1 . 2) 3))
778+
]
779+
780+
And our prior interpterter will work just fine on these programs:
781+
782+
@ex[
783+
(interp-env (desugar '(map f '(1 2 3))) `((map ,map) (f ,add1)))
784+
(interp-env (desugar '(map f '(and 1 2))) `((map ,map) (f ,identity)))
785+
(interp-env (desugar '(if x '(1 . 2) 3)) `((x #t)))
786+
]
787+
788+
And:
789+
790+
@ex[
791+
(interp-env (desugar ''(((1) 2) 3)) '())
792+
(interp-env (desugar ''(1 . 2)) '())
793+
(interp-env (desugar ''("asdf" fred ((one)))) '())
794+
]
795+
796+
@section[#:tag-prefix "mug"]{Pattern matching}
797+
798+
670799

671800

‎www/notes/mug/interp-env.rkt‎

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
#lang racket
22
(provide (all-defined-out))
3+
(require (only-in "syntax.rkt" prim?))
34

45
;; type Expr =
56
;; | Integer
@@ -103,14 +104,6 @@
103104
['err 'err]
104105
[v (cons v (interp-env* es r))])]))
105106

106-
;; Any -> Boolean
107-
(define (prim? x)
108-
(and (symbol? x)
109-
(memq x '(add1 sub1 zero? abs - char? boolean? integer? integer->char char->integer
110-
string? box? empty? cons cons? box unbox car cdr string-length
111-
make-string string-ref = < <= char=? boolean=? + eq? gensym symbol?
112-
procedure?))))
113-
114107
;; Any -> Boolean
115108
(define (value? x)
116109
(or (integer? x)

‎www/notes/mug/syntax.rkt‎

Lines changed: 28 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -17,23 +17,13 @@
1717
(match e+
1818
[`(begin ,@(list `(define (,fs . ,xss) ,es) ...) ,e)
1919
`(letrec ,(map (λ (f xs e) `(,f (λ ,xs ,(desugar e)))) fs xss es)
20-
,(desugar e))]
20+
,(desugar e))]
2121
[(? symbol? x) x]
2222
[(? imm? i) i]
2323
[`',(? symbol? s) `',s]
24-
[`',d (desugar (quote->expr d))] ;; quote & quasiquote as expansions
25-
[(list 'quasiquote d) (desugar (quasiquote->expr d))]
26-
[`(box ,e0) `(box ,(desugar e0))]
27-
[`(unbox ,e0) `(unbox ,(desugar e0))]
28-
[`(cons ,e0 ,e1) `(cons ,(desugar e0) ,(desugar e1))]
29-
[`(car ,e0) `(car ,(desugar e0))]
30-
[`(cdr ,e0) `(cdr ,(desugar e0))]
31-
[`(add1 ,e0) `(add1 ,(desugar e0))]
32-
[`(sub1 ,e0) `(sub1 ,(desugar e0))]
33-
[`(zero? ,e0) `(zero? ,(desugar e0))]
34-
[`(empty? ,e0) `(empty? ,(desugar e0))]
24+
[`',d (quote->expr d)]
25+
[`(,(? prim? p) . ,es) `(,p ,@(map desugar es))]
3526
[`(if ,e0 ,e1 ,e2) `(if ,(desugar e0) ,(desugar e1) ,(desugar e2))]
36-
[`(+ ,e0 ,e1) `(+ ,(desugar e0) ,(desugar e1))]
3727
[`(let ((,x ,e0)) ,e1) `(let ((,x ,(desugar e0))) ,(desugar e1))]
3828
[`(letrec ,bs ,e0)
3929
`(letrec ,(map (λ (b) (list (first b) (desugar (second b)))) bs)
@@ -47,19 +37,18 @@
4737

4838
;; S-Expr -> Expr
4939
;; Produce an expression that evaluates to given s-expression, without
50-
;; use of quote (except for symbols)
40+
;; use of quote (except for symbols and empty list)
5141
(define (quote->expr d)
5242
(match d
5343
[(? boolean?) d]
5444
[(? integer?) d]
5545
[(? string?) d]
5646
[(? char?) d]
5747
[(? symbol?) (list 'quote d)]
58-
;[(cons x y) (list 'cons (quote->expr x) (quote->expr y))]
59-
[(cons x y) (list 'cons (list 'quote x) (list 'quote y))]
48+
[(cons x y) (list 'cons (quote->expr x) (quote->expr y))]
6049
['() ''()]))
6150

62-
(define (quasiquote->expr d)
51+
(define (quasiquote->expr d)
6352
(match d
6453
[(? boolean?) d]
6554
[(? integer?) d]
@@ -69,38 +58,41 @@
6958
[(cons 'quasiquote d)
7059
(quasiquote->expr (quasiquote->expr d))]
7160
[(cons 'unquote d) d]
72-
[(cons 'unquote-splicing d) 'ERROR]
61+
[(cons 'unquote-splicing d) 'ERROR]
7362
[(cons x y)
7463
`(append ,(quasiquote->list-expr x)
7564
,(quasiquote->expr y))]
7665
['() ''()]))
7766

78-
(define (quasiquote->list-expr d)
79-
(match d
67+
(define (quasiquote->list-expr d)
68+
(match d
8069
[(? symbol?) (list 'quote d)]
8170
['() ''()]
8271
[(cons 'quasiquote d)
8372
(quasiquote->expr (quasiquote->expr d))]
8473
[(cons 'unquote d) `(list ,d)]
85-
[(cons 'unquote-splicing d) d]
74+
[(cons 'unquote-splicing d) d]
8675
[(cons x y)
8776
`(list (append ,(quasiquote->list-expr x)
8877
,(quasiquote->expr y)))]
8978
[_ `'(,d)]))
9079

80+
;; Expr -> Expr
9181
(define (cond->if c)
9282
(match c
9383
[`(cond (else ,e)) e]
9484
[`(cond (,c ,e) . ,r)
9585
`(if ,c ,e (cond ,@r))]))
9686

87+
;; Expr -> Expr
9788
(define (and->if c)
9889
(match c
9990
[`(and) #t]
10091
[`(and ,e) e]
10192
[`(and ,e . ,r)
10293
`(if ,e (and ,@r) #f)]))
10394

95+
;; Expr -> Expr
10496
(define (or->if c)
10597
(match c
10698
[`(or) #f]
@@ -142,7 +134,7 @@
142134
[else `(append . ,r)])]
143135
[_
144136
`'(,x)]))
145-
137+
146138

147139

148140
;; Any -> Boolean
@@ -157,21 +149,12 @@
157149
(match e
158150
[(? symbol? x) x]
159151
[(? imm? i) i]
160-
[`(box ,e0) `(box ,(label-λ e0))]
161-
[`(unbox ,e0) `(unbox ,(label-λ e0))]
162-
[`(cons ,e0 ,e1) `(cons ,(label-λ e0) ,(label-λ e1))]
163-
[`(car ,e0) `(car ,(label-λ e0))]
164-
[`(cdr ,e0) `(cdr ,(label-λ e0))]
165-
[`(add1 ,e0) `(add1 ,(label-λ e0))]
166-
[`(sub1 ,e0) `(sub1 ,(label-λ e0))]
167-
[`(zero? ,e0) `(zero? ,(label-λ e0))]
168-
[`(empty? ,e0) `(empty? ,(label-λ e0))]
152+
[`(,(? prim? p) . ,es) `(,p ,@(map label-λ es))]
169153
[`(if ,e0 ,e1 ,e2) `(if ,(label-λ e0) ,(label-λ e1) ,(label-λ e2))]
170-
[`(+ ,e0 ,e1) `(+ ,(label-λ e0) ,(label-λ e1))]
171154
[`(let ((,x ,e0)) ,e1) `(let ((,x ,(label-λ e0))) ,(label-λ e1))]
172155
[`(letrec ,bs ,e0) `(letrec ,(map (λ (b) (list (first b) (label-λ (second b)))) bs)
173156
,(label-λ e0))]
174-
[`(λ ,xs ,e0) `(λ ,xs ',(gensym) ,(label-λ e0))]
157+
[`(λ ,xs ,e0) `(λ ,xs ',(gensym) ,(label-λ e0))]
175158
[`(,e . ,es) `(,(label-λ e) ,@(map label-λ es))]))
176159

177160
;; LExpr -> (Listof LExpr)
@@ -180,17 +163,8 @@
180163
(match e
181164
[(? symbol? x) '()]
182165
[(? imm? i) '()]
183-
[`(box ,e0) (λs e0)]
184-
[`(unbox ,e0) (λs e0)]
185-
[`(cons ,e0 ,e1) (append (λs e0) (λs e1))]
186-
[`(car ,e0) (λs e0)]
187-
[`(cdr ,e0) (λs e0)]
188-
[`(add1 ,e0) (λs e0)]
189-
[`(sub1 ,e0) (λs e0)]
190-
[`(zero? ,e0) (λs e0)]
191-
[`(empty? ,e0) (λs e0)]
166+
[`(,(? prim? p) . ,es) (append-map λs es)]
192167
[`(if ,e0 ,e1 ,e2) (append (λs e0) (λs e1) (λs e2))]
193-
[`(+ ,e0 ,e1) (append (λs e0) (λs e1))]
194168
[`(let ((,x ,e0)) ,e1) (append (λs e0) (λs e1))]
195169
[`(letrec ,bs ,e0) (append (apply append (map (compose λs second) bs)) (λs e0))]
196170
[`(λ ,xs ,l ,e0) (cons e (λs e0))]
@@ -202,20 +176,19 @@
202176
(match e
203177
[(? symbol? x) (list x)]
204178
[(? imm? i) '()]
205-
[`(box ,e0) (fvs e0)]
206-
[`(unbox ,e0) (fvs e0)]
207-
[`(cons ,e0 ,e1) (append (fvs e0) (fvs e1))]
208-
[`(car ,e0) (fvs e0)]
209-
[`(cdr ,e0) (fvs e0)]
210-
[`(add1 ,e0) (fvs e0)]
211-
[`(sub1 ,e0) (fvs e0)]
212-
[`(zero? ,e0) (fvs e0)]
213-
[`(empty? ,e0) (fvs e0)]
179+
[`(,(? prim? p) . ,es) (append-map fvs es)]
214180
[`(if ,e0 ,e1 ,e2) (append (fvs e0) (fvs e1) (fvs e2))]
215-
[`(+ ,e0 ,e1) (append (fvs e0) (fvs e1))]
216181
[`(let ((,x ,e0)) ,e1) (append (fvs e0) (remq* (list x) (fvs e1)))]
217182
[`(letrec ,bs ,e0) (remq* (map first bs)
218-
(apply append (fvs e0) (map fvs (map second bs))))]
183+
(apply append (fvs e0) (map fvs (map second bs))))]
219184
[`(λ ,xs ,l ,e0) (remq* xs (fvs e0))]
220-
[`(,e . ,es) (append (fvs e) (apply append (map fvs es)))]))
185+
[`(,e . ,es) (append (fvs e) (apply append (map fvs es)))]))
221186
(remove-duplicates (fvs e)))
187+
188+
;; Any -> Boolean
189+
(define (prim? x)
190+
(and (symbol? x)
191+
(memq x '(add1 sub1 zero? abs - char? boolean? integer? integer->char char->integer
192+
string? box? empty? cons cons? box unbox car cdr string-length
193+
make-string string-ref = < <= char=? boolean=? + eq? gensym symbol?
194+
procedure?))))

0 commit comments

Comments
 (0)