4.1.7 · Запуск вычислителя как программы

Запуск программы в вычислителе с общим окружением

Система eval/apply вычисляет цитированные формы верхнего уровня в одном глобальном окружении и возвращает протокол определений и значений.

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

Что превращает набор процедур вычислителя в программу, способную выполнять последовательность пользовательских форм?

Разделение выполнения хоста Lispex и выражений guest, представленных в виде данных
Диспетчеризация самовычисляющихся значений, переменных, специальных форм и применений
Применение примитивных процедур хоста и представленных составных процедур
Сохранение определений и присваиваний в одном явном глобальном окружении
Наблюдение захвата лексического замыкания при последующих глобальных изменениях
Формирование отчета о полном или усеченном конечном запуске драйвера верхнего уровня
Разделение бюджета форм верхнего уровня и объема работы внутри одной формы

Вычислитель представляет окружения как списки изменяемых кадров. Поиск переменной guest просматривает эти кадры, define изменяет первый кадр, а set! ищет существующее связывание и изменяет эту запись. Форма guest lambda становится записью составной процедуры, содержащей параметры, выражения тела и окружение, в котором вычислялась эта lambda. Процедура apply-procedure либо применяет примитив хоста, либо вычисляет составное тело в новом кадре.

Процедура run-program служит драйвером. Она принимает цитированные формы верхнего уровня, одно явное глобальное окружение и бюджет форм. Каждая завершенная форма добавляет одно значение в transcript, при этом определения и присваивания остаются видимыми для последующих форм. Полный запуск определяет square, make-adder, add-five и base, а add-five сохраняет локальное значение x равным 5 даже после изменения глобальной переменной base. Второй запуск останавливается после пяти форм и сообщает, что четыре формы еще ожидают обработки. Этот бюджет форм не ограничивает рекурсию или работу внутри одной формы, а ограничения выполнения более низкого уровня по-прежнему обеспечивает упакованная среда выполнения браузера.

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

(begin
  (define (tagged-list? expression tag)
    (if (pair? expression)
        (eq? (car expression) tag)
        #f))
  (define (self-evaluating? expression)
    (cond ((number? expression) #t)
          ((string? expression) #t)
          ((boolean? expression) #t)
          (else #f)))
  (define (quoted? expression)
    (tagged-list? expression 'quote))
  (define (assignment? expression)
    (tagged-list? expression 'set!))
  (define (definition? expression)
    (tagged-list? expression 'define))
  (define (if? expression)
    (tagged-list? expression 'if))
  (define (lambda? expression)
    (tagged-list? expression 'lambda))
  (define (begin? expression)
    (tagged-list? expression 'begin))

  (define (text-of-quotation expression) (cadr expression))
  (define (assignment-variable expression) (cadr expression))
  (define (assignment-value expression) (caddr expression))
  (define (definition-variable expression)
    (if (symbol? (cadr expression))
        (cadr expression)
        (car (cadr expression))))
  (define (definition-value expression)
    (if (symbol? (cadr expression))
        (caddr expression)
        (cons 'lambda
              (cons (cdr (cadr expression))
                    (cddr expression)))))
  (define (if-predicate expression) (cadr expression))
  (define (if-consequent expression) (caddr expression))
  (define (if-alternative expression) (cadddr expression))
  (define (lambda-parameters expression) (cadr expression))
  (define (lambda-body expression) (cddr expression))
  (define (begin-actions expression) (cdr expression))
  (define (operator expression) (car expression))
  (define (operands expression) (cdr expression))

  (define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many arguments"))
          ((null? values) (error "too few arguments"))
          (else
           (cons (cons (car variables) (car values))
                 (pair-bindings (cdr variables)
                                (cdr values))))))
  (define (make-frame variables values)
    (cons '*frame* (pair-bindings variables values)))
  (define (first-frame environment) (car environment))
  (define (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values base)
    (cons (make-frame variables values) base))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound variable" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if binding
              (cdr binding)
              (lookup-variable-value variable (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (first-frame environment))
           (binding (assoc variable (frame-bindings frame))))
      (if binding
          (set-cdr! binding value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))
  (define (set-variable-value! variable value environment)
    (if (null? environment)
        (error "unbound assignment" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if binding
              (begin
                (set-cdr! binding value)
                (list 'assigned variable))
              (set-variable-value! variable value (cdr environment))))))

  (define (make-procedure parameters body environment)
    (list 'compound parameters body environment))
  (define (compound-procedure? procedure)
    (tagged-list? procedure 'compound))
  (define (procedure-parameters procedure) (cadr procedure))
  (define (procedure-body procedure) (caddr procedure))
  (define (procedure-environment procedure) (cadddr procedure))

  (define (list-of-values expressions environment)
    (if (null? expressions)
        '()
        (cons (evaluate (car expressions) environment)
              (list-of-values (cdr expressions) environment))))
  (define (eval-sequence expressions environment)
    (if (null? (cdr expressions))
        (evaluate (car expressions) environment)
        (begin
          (evaluate (car expressions) environment)
          (eval-sequence (cdr expressions) environment))))
  (define (eval-if expression environment)
    (if (evaluate (if-predicate expression) environment)
        (evaluate (if-consequent expression) environment)
        (evaluate (if-alternative expression) environment)))
  (define (eval-assignment expression environment)
    (set-variable-value!
      (assignment-variable expression)
      (evaluate (assignment-value expression) environment)
      environment))
  (define (eval-definition expression environment)
    (define-variable!
      (definition-variable expression)
      (evaluate (definition-value expression) environment)
      environment))
  (define (apply-procedure procedure arguments)
    (cond ((procedure? procedure)
           (apply procedure arguments))
          ((compound-procedure? procedure)
           (eval-sequence
             (procedure-body procedure)
             (extend-environment
               (procedure-parameters procedure)
               arguments
               (procedure-environment procedure))))
          (else
           (error "not a guest procedure" procedure))))
  (define (evaluate expression environment)
    (cond ((self-evaluating? expression) expression)
          ((symbol? expression)
           (lookup-variable-value expression environment))
          ((quoted? expression)
           (text-of-quotation expression))
          ((assignment? expression)
           (eval-assignment expression environment))
          ((definition? expression)
           (eval-definition expression environment))
          ((if? expression)
           (eval-if expression environment))
          ((lambda? expression)
           (make-procedure
             (lambda-parameters expression)
             (lambda-body expression)
             environment))
          ((begin? expression)
           (eval-sequence (begin-actions expression) environment))
          ((pair? expression)
           (apply-procedure
             (evaluate (operator expression) environment)
             (list-of-values (operands expression) environment)))
          (else
           (error "unknown guest expression" expression))))

  (define primitive-bindings
    (list (cons '+ +) (cons '- -) (cons '* *) (cons '/ /)
          (cons '= =) (cons '< <) (cons '> >)
          (cons 'cons cons) (cons 'car car) (cons 'cdr cdr)
          (cons 'list list) (cons 'null? null?)
          (cons 'pair? pair?) (cons 'not not)))
  (define (make-global-environment)
    (list (cons '*frame* primitive-bindings)))
  (define (run-program forms environment form-budget)
    (define (loop remaining budget transcript)
      (cond ((null? remaining)
             (list 'complete (reverse transcript) 0))
            ((= budget 0)
             (list 'truncated
                   (reverse transcript)
                   (length remaining)))
            (else
             (loop (cdr remaining)
                   (- budget 1)
                   (cons (evaluate (car remaining) environment)
                         transcript)))))
    (loop forms form-budget '()))

  (define guest-program
    '((define (square x) (* x x))
      (define (make-adder x) (lambda (y) (+ x y)))
      (define add-five (make-adder 5))
      (define base 5)
      (square (+ base 2))
      (add-five 7)
      (set! base 9)
      (if (> base 8) (square base) 0)
      (add-five 1)))
  (list
    (run-program guest-program (make-global-environment) 20)
    (run-program guest-program (make-global-environment) 5)))

(begin
  (define (tagged-list? expression tag)
    (if (pair? expression)
        (eq? (car expression) tag)
        #f))
  (define (self-evaluating? expression)
    (cond ((number? expression) #t)
          ((string? expression) #t)
          ((boolean? expression) #t)
          (else #f)))
  (define (quoted? expression)
    (tagged-list? expression 'quote))
  (define (assignment? expression)
    (tagged-list? expression 'set!))
  (define (definition? expression)
    (tagged-list? expression 'define))
  (define (if? expression)
    (tagged-list? expression 'if))
  (define (lambda? expression)
    (tagged-list? expression 'lambda))
  (define (begin? expression)
    (tagged-list? expression 'begin))

(define (text-of-quotation expression) (cadr expression))
  (define (assignment-variable expression) (cadr expression))
  (define (assignment-value expression) (caddr expression))
  (define (definition-variable expression)
    (if (symbol? (cadr expression))
        (cadr expression)
        (car (cadr expression))))
  (define (definition-value expression)
    (if (symbol? (cadr expression))
        (caddr expression)
        (cons 'lambda
              (cons (cdr (cadr expression))
                    (cddr expression)))))
  (define (if-predicate expression) (cadr expression))
  (define (if-consequent expression) (caddr expression))
  (define (if-alternative expression) (cadddr expression))
  (define (lambda-parameters expression) (cadr expression))
  (define (lambda-body expression) (cddr expression))
  (define (begin-actions expression) (cdr expression))
  (define (operator expression) (car expression))
  (define (operands expression) (cdr expression))

(define (pair-bindings variables values)
    (cond ((and (null? variables) (null? values)) '())
          ((null? variables) (error "too many arguments"))
          ((null? values) (error "too few arguments"))
          (else
           (cons (cons (car variables) (car values))
                 (pair-bindings (cdr variables)
                                (cdr values))))))
  (define (make-frame variables values)
    (cons '*frame* (pair-bindings variables values)))
  (define (first-frame environment) (car environment))
  (define (frame-bindings frame) (cdr frame))
  (define (extend-environment variables values base)
    (cons (make-frame variables values) base))
  (define (lookup-variable-value variable environment)
    (if (null? environment)
        (error "unbound variable" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if binding
              (cdr binding)
              (lookup-variable-value variable (cdr environment))))))
  (define (define-variable! variable value environment)
    (let* ((frame (first-frame environment))
           (binding (assoc variable (frame-bindings frame))))
      (if binding
          (set-cdr! binding value)
          (set-cdr! frame
                    (cons (cons variable value)
                          (frame-bindings frame)))))
    (list 'defined variable))
  (define (set-variable-value! variable value environment)
    (if (null? environment)
        (error "unbound assignment" variable)
        (let ((binding
               (assoc variable
                      (frame-bindings (first-frame environment)))))
          (if binding
              (begin
                (set-cdr! binding value)
                (list 'assigned variable))
              (set-variable-value! variable value (cdr environment))))))

(define (make-procedure parameters body environment)
    (list 'compound parameters body environment))
  (define (compound-procedure? procedure)
    (tagged-list? procedure 'compound))
  (define (procedure-parameters procedure) (cadr procedure))
  (define (procedure-body procedure) (caddr procedure))
  (define (procedure-environment procedure) (cadddr procedure))

(define (list-of-values expressions environment)
    (if (null? expressions)
        '()
        (cons (evaluate (car expressions) environment)
              (list-of-values (cdr expressions) environment))))
  (define (eval-sequence expressions environment)
    (if (null? (cdr expressions))
        (evaluate (car expressions) environment)
        (begin
          (evaluate (car expressions) environment)
          (eval-sequence (cdr expressions) environment))))
  (define (eval-if expression environment)
    (if (evaluate (if-predicate expression) environment)
        (evaluate (if-consequent expression) environment)
        (evaluate (if-alternative expression) environment)))
  (define (eval-assignment expression environment)
    (set-variable-value!
      (assignment-variable expression)
      (evaluate (assignment-value expression) environment)
      environment))
  (define (eval-definition expression environment)
    (define-variable!
      (definition-variable expression)
      (evaluate (definition-value expression) environment)
      environment))
  (define (apply-procedure procedure arguments)
    (cond ((procedure? procedure)
           (apply procedure arguments))
          ((compound-procedure? procedure)
           (eval-sequence
             (procedure-body procedure)
             (extend-environment
               (procedure-parameters procedure)
               arguments
               (procedure-environment procedure))))
          (else
           (error "not a guest procedure" procedure))))
  (define (evaluate expression environment)
    (cond ((self-evaluating? expression) expression)
          ((symbol? expression)
           (lookup-variable-value expression environment))
          ((quoted? expression)
           (text-of-quotation expression))
          ((assignment? expression)
           (eval-assignment expression environment))
          ((definition? expression)
           (eval-definition expression environment))
          ((if? expression)
           (eval-if expression environment))
          ((lambda? expression)
           (make-procedure
             (lambda-parameters expression)
             (lambda-body expression)
             environment))
          ((begin? expression)
           (eval-sequence (begin-actions expression) environment))
          ((pair? expression)
           (apply-procedure
             (evaluate (operator expression) environment)
             (list-of-values (operands expression) environment)))
          (else
           (error "unknown guest expression" expression))))

(define primitive-bindings
    (list (cons '+ +) (cons '- -) (cons '* *) (cons '/ /)
          (cons '= =) (cons '< <) (cons '> >)
          (cons 'cons cons) (cons 'car car) (cons 'cdr cdr)
          (cons 'list list) (cons 'null? null?)
          (cons 'pair? pair?) (cons 'not not)))
  (define (make-global-environment)
    (list (cons '*frame* primitive-bindings)))
  (define (run-program forms environment form-budget)
    (define (loop remaining budget transcript)
      (cond ((null? remaining)
             (list 'complete (reverse transcript) 0))
            ((= budget 0)
             (list 'truncated
                   (reverse transcript)
                   (length remaining)))
            (else
             (loop (cdr remaining)
                   (- budget 1)
                   (cons (evaluate (car remaining) environment)
                         transcript)))))
    (loop forms form-budget '()))

(define guest-program
    '((define (square x) (* x x))
      (define (make-adder x) (lambda (y) (+ x y)))
      (define add-five (make-adder 5))
      (define base 5)
      (square (+ base 2))
      (add-five 7)
      (set! base 9)
      (if (> base 8) (square base) 0)
      (add-five 1)))
  (list
    (run-program guest-program (make-global-environment) 20)
    (run-program guest-program (make-global-environment) 5)))

Примеры

Результат—

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

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

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

Полный запуск возвращает (complete ((defined square) (defined make-adder) (defined add-five) (defined base) 49 12 (assigned base) 81 6) 0). Запуск с бюджетом в пять форм возвращает (truncated ((defined square) (defined make-adder) (defined add-five) (defined base) 49) 4).

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

Отделяйте вызовы хоста, реализующие evaluate и apply-procedure, от выражений guest, сохраненных в guest-program. Проследите за изменением глобального кадра при выполнении define и set!, за новым кадром, создаваемым для каждого составного применения, и за окружением, захваченным add-five. В run-program одна единица бюджета расходуется только после возврата формы верхнего уровня, и этот счетчик не измеряет рекурсивную работу guest внутри этой формы.

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

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

Добавьте определение guest (define (twice procedure value) (procedure (procedure value))) и вычислите (twice add-five 1). Спрогнозируйте новое значение transcript и количество оставшихся форм при сохранении бюджета форм равным 5.

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

Полный запуск применяет add-five дважды, поэтому результат guest равен 11. В запуске с бюджетом в пять форм вставка еще одной формы после существующих определений меняет то, какое выражение станет пятой завершенной формой.

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

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