Why is Scheme\Racket so slow?

You and the Sussman go on and on about how powerful and expressive it is, but the only expression I'm making is that of exasperation as I wait a full thirty fucking seconds for this piece of shit language to draw a single 1000*1000 monochrome image onto the screen.

#lang racket
;; 5/2/2015
(require graphics)
(open-graphics)
(define vert 1000) (define horiz 1000) (define rule 30) (define viewport (open-viewport "LOL" horiz vert))
(define (auto seed row)
(if (> row vert) #t
(and ((lambda (src yv)
(let ([draw-pixel (lambda (x y) ((draw-pixel viewport) (make-posn x y)))]
[c (lambda (fun l x) (fun fun l x))])
(c (lambda (fun l x)
(if (empty? l) #t (and (if (= 1 (car l)) (draw-pixel x yv) 0) (fun fun (cdr l) (+ x 1)) ))) src 0))) seed row)
(auto ((lambda (old)
(let ([gen (lambda (x y z) (let ([a (if (= x 0) 0 4)] [b (if (= y 0) 0 2)] [c (if (= z 0) 0 1)])
(if (bitwise-bit-set? rule (bitwise-ior a b c)) 1 0)))]
[r (lambda (m) (if (null? m) '() (append (cdr m) (cons (car m) '()))))])
(map gen old (r old) (r (r old))))) seed) (+ row 1)))))

(auto ((lambda (width pixels)
(let ([c (lambda (fun init end) (fun fun init end))])
(c (lambda (fun init end)
(if (= init end) '() (cons (if (memq init pixels) 1 0) (fun fun (+ init 1) end)))) 0 width))) horiz (cons (/ horiz 2) '())) 0)

(close-viewport viewport)
(close-graphics)

#lang racket/gui

(define size (* 8 100))

(define initial (append (make-list (quotient size 2) #f)
(list #t)
(make-list (- size (quotient size 2) 1) #f)))

(define (rule x y z)
(or (and x (not y) (not z))
(and (not x) y z)
(and (not x) y (not z))
(and (not x) (not y) z)))

(define (step left l)
(if (null? l)
'()
(let ((right (if (null? (cdr l)) #f (cadr l))))
(cons (rule left (car l) right)
(step (car l) (cdr l))))))

(define (to-byte . bits)
(foldr (lambda (x ys) (+ x (* 2 ys))) 0 (map (lambda (bit) (if bit 1 0)) bits)))
(define (to-bytes l tail)
(if (null? l)
tail
(cons (to-byte (car l) (cadr l) (caddr l) (cadddr l)
(cadddr (cdr l)) (cadddr (cddr l)) (cadddr (cdddr l)) (cadddr (cddddr l)))
(to-bytes (cddddr (cddddr l)) tail))))

(define (live initial i)
(if (= i size)
'()
(to-bytes initial (live (step #f initial) (+ i 1)))))

(make-monochrome-bitmap size size (list->bytes (live initial 0)))