5.5.1 · Структура компилятора

Структура компилятора и контракты инструкций

Диспетчер компилятора и его специализированные процедуры создают записи последовательностей с явными needs, modifications, statements и targets.

Вопрос для размышления

Какие решения компилятора зависят от синтаксиса исходного кода, а какие определяются запрошенным регистром target и соглашением linkage?

Классификация каждой поддерживаемой формы исходного кода перед компиляцией
Передача регистра target и linkage специализированным компиляторам
Представление последовательностей инструкций через needs, modifies и statements
Компоновка последовательностей с сохранением консервативных контрактов регистров
Генерация меток для управления ветвлением
Компиляция тела lambda в сохраненный код процедуры вместо сохранения исходного текста тела

compile отвечает только за диспетчеризацию по синтаксису. Специализированные компиляторы определяют, как самовычисляемое значение, переменная, цитирование, условное выражение, lambda, последовательность или применение попадают в target. Затем end-with-linkage добавляет отсутствие передачи управления, возврат через continue или прямой переход goto по метке. Это отделяет смысл выражения от того, куда должно попасть его значение и что должно произойти дальше.

Последовательности инструкций содержат statements вместе с консервативными наборами needs и modifies. Процедура append-sequences объединяет эти контракты с сохранением порядка. Пример с условным выражением демонстрирует метки и linkage вокруг рекурсивно скомпилированного предиката и ветвей. Компилятор lambda рекурсивно компилирует свое тело и сохраняет полученные данные инструкций в представленной скомпилированной процедуре. Этот учебный набор инструкций моделирует показанную структуру компилятора SICP с универсальной операцией apply-procedure.

Код SICP7,888 из 1,048,576 байт UTF-8

(begin
  (define (tagged-list? expression tag)
    (and (pair? expression) (eq? (car expression) tag)))
  (define (self-evaluating? expression)
    (or (number? expression)
        (string? expression)
        (boolean? expression)))
  (define (quoted? expression) (tagged-list? expression 'quote))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))

  (define (expression-class expression)
    (cond ((self-evaluating? expression) 'self)
          ((symbol? expression) 'variable)
          ((quoted? expression) 'quote)
          ((if? expression) 'if)
          ((lambda? expression) 'lambda)
          ((begin? expression) 'begin)
          ((pair? expression) 'application)
          (else 'unknown)))

  (define (contains? item items)
    (cond ((null? items) #f)
          ((eq? item (car items)) #t)
          (else (contains? item (cdr items)))))
  (define (adjoin item items)
    (if (contains? item items)
        items
        (append items (list item))))
  (define (union left right)
    (if (null? right)
        left
        (union (adjoin (car right) left)
               (cdr right))))
  (define (difference left right)
    (cond ((null? left) '())
          ((contains? (car left) right)
           (difference (cdr left) right))
          (else
           (cons (car left)
                 (difference (cdr left) right)))))

  (define (make-sequence needs modifies statements)
    (list needs modifies statements))
  (define (sequence-needs sequence) (car sequence))
  (define (sequence-modifies sequence) (cadr sequence))
  (define (sequence-statements sequence) (caddr sequence))
  (define empty-sequence (make-sequence '() '() '()))
  (define (append-sequences first second)
    (make-sequence
      (union (sequence-needs first)
             (difference (sequence-needs second)
                         (sequence-modifies first)))
      (union (sequence-modifies first)
             (sequence-modifies second))
      (append (sequence-statements first)
              (sequence-statements second))))

  (define label-counter 0)
  (define (new-label prefix)
    (set! label-counter (+ label-counter 1))
    (list prefix label-counter))
  (define (linkage-sequence linkage)
    (cond ((eq? linkage 'next) empty-sequence)
          ((eq? linkage 'return)
           (make-sequence
             '(continue)
             '()
             '((goto (reg continue)))))
          (else
           (make-sequence
             '()
             '()
             (list (list 'goto
                         (list 'label linkage)))))))
  (define (end-with-linkage sequence linkage)
    (append-sequences sequence
                      (linkage-sequence linkage)))

  (define (compile-self expression target linkage)
    (end-with-linkage
      (make-sequence
        '()
        (list target)
        (list (list 'assign target
                    (list 'const expression))))
      linkage))
  (define (compile-variable expression target linkage)
    (end-with-linkage
      (make-sequence
        '(env)
        (list target)
        (list
          (list 'assign target
                (list 'op
                      'lookup-variable-value
                      (list 'const expression)
                      '(reg env)))))
      linkage))
  (define (compile-quote expression target linkage)
    (compile-self (cadr expression) target linkage))

  (define (compile-operands operands)
    (define (loop remaining result)
      (if (null? remaining)
          result
          (loop
            (cdr remaining)
            (append-sequences
              result
              (append-sequences
                (compile (car remaining) 'val 'next)
                (make-sequence
                  '(argl val)
                  '(argl)
                  '((assign argl
                      (op append-argument
                          (reg argl)
                          (reg val))))))))))
    (loop operands
          (make-sequence
            '()
            '(argl)
            '((assign argl (const ()))))))

  (define (compile-application expression target linkage)
    (end-with-linkage
      (append-sequences
        (compile (car expression) 'proc 'next)
        (append-sequences
          (compile-operands (cdr expression))
          (make-sequence
            '(proc argl)
            (list target)
            (list
              (list 'assign target
                    '(op apply-procedure
                         (reg proc)
                         (reg argl)))))))
      linkage))

  (define (compile-if expression target linkage)
    (let ((alternative-label (new-label 'false-branch))
          (after-label (new-label 'after-if)))
      (end-with-linkage
        (make-sequence
          '(env continue)
          (union (list target) '(val proc argl continue))
          (append
            (sequence-statements
              (compile (cadr expression) 'val 'next))
            (append
              '((test (op false? (reg val))))
              (append
                (list (list 'branch
                            (list 'label alternative-label)))
                (append
                  (sequence-statements
                    (compile (caddr expression)
                             target
                             'next))
                  (append
                    (list
                      (list 'goto (list 'label after-label))
                      (list 'label alternative-label))
                    (append
                      (sequence-statements
                        (compile (cadddr expression)
                                 target
                                 'next))
                      (list (list 'label after-label)))))))))
        linkage)))

  (define (compile-sequence expressions target linkage)
    (cond ((null? expressions) empty-sequence)
          ((null? (cdr expressions))
           (compile (car expressions) target linkage))
          (else
           (append-sequences
             (compile (car expressions) 'val 'next)
             (compile-sequence
               (cdr expressions)
               target
               linkage)))))

  (define (compile-lambda expression target linkage)
    (let ((parameters (cadr expression))
          (body-code
            (compile-sequence (cddr expression)
                              'val
                              'return)))
      (end-with-linkage
        (make-sequence
          '(env)
          (list target)
          (list
            (list 'assign target
                  (list 'op
                        'make-compiled-procedure
                        (list 'const parameters)
                        (list 'const
                              (sequence-statements body-code))
                        '(reg env)))))
        linkage)))

  (define (compile expression target linkage)
    (cond ((self-evaluating? expression)
           (compile-self expression target linkage))
          ((symbol? expression)
           (compile-variable expression target linkage))
          ((quoted? expression)
           (compile-quote expression target linkage))
          ((if? expression)
           (compile-if expression target linkage))
          ((lambda? expression)
           (compile-lambda expression target linkage))
          ((begin? expression)
           (compile-sequence (cdr expression)
                             target
                             linkage))
          ((pair? expression)
           (compile-application expression target linkage))
          (else
           (error "unknown compiler expression" expression))))
  (map expression-class
       '(42
         x
         (quote ok)
         (if x 1 2)
         (lambda (x) (+ x 1))
         (begin 1 2)
         (+ 1 2)))
)

(begin
  (define (tagged-list? expression tag)
    (and (pair? expression) (eq? (car expression) tag)))
  (define (self-evaluating? expression)
    (or (number? expression)
        (string? expression)
        (boolean? expression)))
  (define (quoted? expression) (tagged-list? expression 'quote))
  (define (if? expression) (tagged-list? expression 'if))
  (define (lambda? expression) (tagged-list? expression 'lambda))
  (define (begin? expression) (tagged-list? expression 'begin))

(define (expression-class expression)
    (cond ((self-evaluating? expression) 'self)
          ((symbol? expression) 'variable)
          ((quoted? expression) 'quote)
          ((if? expression) 'if)
          ((lambda? expression) 'lambda)
          ((begin? expression) 'begin)
          ((pair? expression) 'application)
          (else 'unknown)))

(define (contains? item items)
    (cond ((null? items) #f)
          ((eq? item (car items)) #t)
          (else (contains? item (cdr items)))))
  (define (adjoin item items)
    (if (contains? item items)
        items
        (append items (list item))))
  (define (union left right)
    (if (null? right)
        left
        (union (adjoin (car right) left)
               (cdr right))))
  (define (difference left right)
    (cond ((null? left) '())
          ((contains? (car left) right)
           (difference (cdr left) right))
          (else
           (cons (car left)
                 (difference (cdr left) right)))))

(define (make-sequence needs modifies statements)
    (list needs modifies statements))
  (define (sequence-needs sequence) (car sequence))
  (define (sequence-modifies sequence) (cadr sequence))
  (define (sequence-statements sequence) (caddr sequence))
  (define empty-sequence (make-sequence '() '() '()))
  (define (append-sequences first second)
    (make-sequence
      (union (sequence-needs first)
             (difference (sequence-needs second)
                         (sequence-modifies first)))
      (union (sequence-modifies first)
             (sequence-modifies second))
      (append (sequence-statements first)
              (sequence-statements second))))

(define label-counter 0)
  (define (new-label prefix)
    (set! label-counter (+ label-counter 1))
    (list prefix label-counter))
  (define (linkage-sequence linkage)
    (cond ((eq? linkage 'next) empty-sequence)
          ((eq? linkage 'return)
           (make-sequence
             '(continue)
             '()
             '((goto (reg continue)))))
          (else
           (make-sequence
             '()
             '()
             (list (list 'goto
                         (list 'label linkage)))))))
  (define (end-with-linkage sequence linkage)
    (append-sequences sequence
                      (linkage-sequence linkage)))

(define (compile-self expression target linkage)
    (end-with-linkage
      (make-sequence
        '()
        (list target)
        (list (list 'assign target
                    (list 'const expression))))
      linkage))
  (define (compile-variable expression target linkage)
    (end-with-linkage
      (make-sequence
        '(env)
        (list target)
        (list
          (list 'assign target
                (list 'op
                      'lookup-variable-value
                      (list 'const expression)
                      '(reg env)))))
      linkage))
  (define (compile-quote expression target linkage)
    (compile-self (cadr expression) target linkage))

(define (compile-operands operands)
    (define (loop remaining result)
      (if (null? remaining)
          result
          (loop
            (cdr remaining)
            (append-sequences
              result
              (append-sequences
                (compile (car remaining) 'val 'next)
                (make-sequence
                  '(argl val)
                  '(argl)
                  '((assign argl
                      (op append-argument
                          (reg argl)
                          (reg val))))))))))
    (loop operands
          (make-sequence
            '()
            '(argl)
            '((assign argl (const ()))))))

(define (compile-application expression target linkage)
    (end-with-linkage
      (append-sequences
        (compile (car expression) 'proc 'next)
        (append-sequences
          (compile-operands (cdr expression))
          (make-sequence
            '(proc argl)
            (list target)
            (list
              (list 'assign target
                    '(op apply-procedure
                         (reg proc)
                         (reg argl)))))))
      linkage))

(define (compile-if expression target linkage)
    (let ((alternative-label (new-label 'false-branch))
          (after-label (new-label 'after-if)))
      (end-with-linkage
        (make-sequence
          '(env continue)
          (union (list target) '(val proc argl continue))
          (append
            (sequence-statements
              (compile (cadr expression) 'val 'next))
            (append
              '((test (op false? (reg val))))
              (append
                (list (list 'branch
                            (list 'label alternative-label)))
                (append
                  (sequence-statements
                    (compile (caddr expression)
                             target
                             'next))
                  (append
                    (list
                      (list 'goto (list 'label after-label))
                      (list 'label alternative-label))
                    (append
                      (sequence-statements
                        (compile (cadddr expression)
                                 target
                                 'next))
                      (list (list 'label after-label)))))))))
        linkage)))

(define (compile-sequence expressions target linkage)
    (cond ((null? expressions) empty-sequence)
          ((null? (cdr expressions))
           (compile (car expressions) target linkage))
          (else
           (append-sequences
             (compile (car expressions) 'val 'next)
             (compile-sequence
               (cdr expressions)
               target
               linkage)))))

(define (compile-lambda expression target linkage)
    (let ((parameters (cadr expression))
          (body-code
            (compile-sequence (cddr expression)
                              'val
                              'return)))
      (end-with-linkage
        (make-sequence
          '(env)
          (list target)
          (list
            (list 'assign target
                  (list 'op
                        'make-compiled-procedure
                        (list 'const parameters)
                        (list 'const
                              (sequence-statements body-code))
                        '(reg env)))))
        linkage)))

(define (compile expression target linkage)
    (cond ((self-evaluating? expression)
           (compile-self expression target linkage))
          ((symbol? expression)
           (compile-variable expression target linkage))
          ((quoted? expression)
           (compile-quote expression target linkage))
          ((if? expression)
           (compile-if expression target linkage))
          ((lambda? expression)
           (compile-lambda expression target linkage))
          ((begin? expression)
           (compile-sequence (cdr expression)
                             target
                             linkage))
          ((pair? expression)
           (compile-application expression target linkage))
          (else
           (error "unknown compiler expression" expression))))
  (map expression-class
       '(42
         x
         (quote ok)
         (if x 1 2)
         (lambda (x) (+ x 1))
         (begin 1 2)
         (+ 1 2)))
)

Примеры

Результат—

Вывод: —
Значение: —
Диагностика: —

Трасса выполнения0 / 0 событий

Ожидаемый результат

Программа диспетчеризации возвращает (self variable quote if lambda begin application). Компилятор условных выражений возвращает ((env continue) (val proc argl continue) 15 (assign test branch assign assign assign assign assign assign assign goto label assign label goto) 2).

На что обратить внимание в трассе

Во второй программе отделите компиляцию предиката от сгенерированных test и branch. Затем проследите компиляцию оператора в proc, компиляцию операндов в val и argl, метку alternative, метку after-if и финальный возврат через continue. Наборы needs и modifies задают консервативные контракты обращения к регистрам.

Попробуйте сами

Измените программу и сравните результат.

Скомпилируйте форму lambda, содержащую begin и if, с регистром target proc и именованным linkage. Изучите сохраненные инструкции тела отдельно от внешней последовательности создания замыкания.

Показать подсказку

Тело lambda всегда компилируется с расчетом на val и с linkage return. Внешние target и linkage описывают выражение, создающее скомпилированную процедуру.

Завершить этот урок

В этой главе пройдено 0 из 23 урока0%