Scheme - レジスタ計算機での計算(翻訳系(文面アドレス(フレーム数, 変位数,探索演算)))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著)ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著)Julie Sussman (原著)
Gerald Jay Sussman (原著)和田 英一 (翻訳)

開発環境

• OS X Yosemite - Apple (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の5(レジスタ計算機での計算)、5.5(翻訳系)、5.5.6(文面アドレス)、問題 5.39.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題 5.39.

コード(BBEdit, Emacs)

compile_time_environment.scm

;; -*- coding: utf-8 -*-

(load "./environment.scm")

;; 文面アドレスの選択子、構成子
(define (lexcal-address-frame-number lexcal-address)
  (car lexcal-address))
(define (lexcal-address-displacement-number lexcal-address)
  (cdr lexcal-address))

(define (make-lexcal-address frame-number displacement-number)
  (cons frame-number displacement-number))

(define (lexical-address-lookup lexcal-address env)
  (let ((frame-number (lexcal-address-frame-number lexcal-address))
        (displacement-number
         (lexcal-address-displacement-number lexcal-address)))
    (let ((frame (list-ref env frame-number)))
      (let ((vals (frame-values frame)))
        (let ((val (list-ref vals displacement-number)))
          (if (eq? val '*unassigned*)
              (let ((vars (frame-variables frame)))
                (error "Unbound variable:"
                       (liset-ref vars displacement-number)))
              val))))))

(define (lexcal-address-set! lexcal-address val env)
  (let ((frame-number (lexcal-address-frame-number lexcal-address))
        (displacement-number
         (lexcal-address-displacement-number lexcal-address)))
    (let ((frame (list-ref env frame-number)))
      (let ((vals (frame-values frame)))
        (define (inner vals n)
          (cond ((null? vals)
                 (error "Unbound variable -- LEXCAL-ADDRESS-SET!"))
                ((= n 0)
                 (set-car! vals val))
                (else (inner (cdr vals) (- n 1)))))
        (inner vals displacement-number)))))
        
  

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ gosh compile_time_environment.scm
$