nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add support for (quote) literal forms in compiler.ss.

This commit is contained in:
Jesse D. McDonald 2010-04-15 23:08:21 -05:00
parent 0b0b352dd6
commit 14b2a1570a
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler.ss
View File

@ -21,7 +21,7 @@
[(cdr) '%cdr] [(cdr) '%cdr]
[(cons) '%cons]) [(cons) '%cons])
(cdr form))] (cdr form))]
[(%bind %if %tail-call %apply %lambda %set! %cons %car %cdr) form] [(%bind %if %tail-call %apply %lambda %set! %cons %car %cdr quote) form]
[else (simplify-funcall form)]) [else (simplify-funcall form)])
(if (eq? form '()) '%nil form))) (if (eq? form '()) '%nil form)))
@ -34,7 +34,7 @@
(cond (cond
[(pair? after) (cons subform after)] [(pair? after) (cons subform after)]
[(or (not (pair? subform)) [(or (not (pair? subform))
(memq (first subform) '(%apply %car %cdr %cons %bind %if))) (memq (first subform) '(%apply %car %cdr %cons %bind %if quote)))
`((set! ,(second form) ,subform))] `((set! ,(second form) ,subform))]
[(and (pair? subform) (eq? (first subform) '%tail-call)) [(and (pair? subform) (eq? (first subform) '%tail-call))
`(,subform)] ; The %set! wouldn't be executed anyway. `(,subform)] ; The %set! wouldn't be executed anyway.
@ -331,6 +331,7 @@
(if (memq old-var (second form)) (if (memq old-var (second form))
form form
`(%bind ,(second form) ,@(map recurse (cddr form))))] `(%bind ,(second form) ,@(map recurse (cddr form))))]
[(quote) form]
[(%if %tail-call %apply %lambda %set! %cons %car %cdr) [(%if %tail-call %apply %lambda %set! %cons %car %cdr)
`(,(first form) ,@(map recurse (cdr form)))] `(,(first form) ,@(map recurse (cdr form)))]
[else (error "Unsimplified form:" form)]) [else (error "Unsimplified form:" form)])
@ -352,7 +353,7 @@
frm frm
(map cons (second form) new-vars))) (map cons (second form) new-vars)))
(cddr form))))] (cddr form))))]
[(%if %tail-call %apply %lambda %set! %cons %car %cdr) form] [(%if %tail-call %apply %lambda %set! %cons %car %cdr quote) form]
[else (error "Unsimplified form:" form)]) [else (error "Unsimplified form:" form)])
form)) form))
@ -370,7 +371,7 @@
(list new-form))) (list new-form)))
(map flatten-binds (cddr form)))]) (map flatten-binds (cddr form)))])
`(%bind ,bound-vars ,@subforms))] `(%bind ,bound-vars ,@subforms))]
[(%if %tail-call %apply %set! %lambda %cons %car %cdr) form] [(%if %tail-call %apply %set! %lambda %cons %car %cdr quote) form]
[else (error "Unsimplified form:" form)]) [else (error "Unsimplified form:" form)])
form)) form))
@ -387,6 +388,7 @@
[(%set!) (if output? [(%set!) (if output?
(cons (second form) (recurse (third form))) (cons (second form) (recurse (third form)))
(recurse (third form)))] (recurse (third form)))]
[(quote) '()]
[(%if %tail-call %apply %lambda %cons %car %cdr) [(%if %tail-call %apply %lambda %cons %car %cdr)
(remove-duplicates (append-map recurse (cdr form)))] (remove-duplicates (append-map recurse (cdr form)))]
[else [else
@ -411,6 +413,7 @@
(let ([ref-vars (remove-duplicates (append-map free-variables (cddr form)))]) (let ([ref-vars (remove-duplicates (append-map free-variables (cddr form)))])
`(%bind ,(filter (lambda (x) (memq x ref-vars)) (second form)) `(%bind ,(filter (lambda (x) (memq x ref-vars)) (second form))
,@(map reduce-variables (cddr form))))] ,@(map reduce-variables (cddr form))))]
[(quote) form]
[(%if %tail-call %apply %set! %lambda %cons %car %cdr) [(%if %tail-call %apply %set! %lambda %cons %car %cdr)
`(,(first form) ,@(map reduce-variables (cdr form)))] `(,(first form) ,@(map reduce-variables (cdr form)))]
[else (error "Unsimplified form:" form)]) [else (error "Unsimplified form:" form)])
@ -433,6 +436,7 @@
(cons subform after))) (cons subform after)))
'() '()
(map reduce-set! (cddr form)))))] (map reduce-set! (cddr form)))))]
[(quote) form]
[(%if %tail-call %apply %set! %lambda %cons %car %cdr) [(%if %tail-call %apply %set! %lambda %cons %car %cdr)
`(,(first form) ,@(map reduce-set! (cdr form)))] `(,(first form) ,@(map reduce-set! (cdr form)))]
[else (error "Unsimplified form:" form)]) [else (error "Unsimplified form:" form)])