計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)
開発環境
- OS X Mavericks - 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))の4(超言語的抽象)、4.1(超循環評価器)、4.1.2(式の表現)、導出された式、問題 4.5.を解いてみる。
その他参考書籍
- Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
- プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
問題 4.5.
コード(BBEdit, Emacs)
sample5.scm
#!/usr/bin/env gosh ;; -*- coding: utf-8 -*- (define (eval exp env) (define (self-evaluating? exp) (cond ((number? exp) #t) ((string? exp) #t) (else #f))) (define (variable? exp) (symbol? exp)) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((get (car exp)) ((get (car exp)) exp env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp)))) (define (apply procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type -- APPLY" procedure)))) (define (install-quoted-package) (define (text-of-quotation exp env) (cadr exp)) (put 'quote text-of-quotation)) (define (install-assignment-package) (define (eval-assignment exp env) (set-variable-value! (assignment-variable exp) (eval (assignment-value exp) env) env) 'ok) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (put 'set! eval-assignment)) (define (install-definition-package) (define (eval-definition exp env) (define-variable! (definition-variable exp) (eval (definition-value exp) env) env) 'ok) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define make-lambda (get 'make-lambda)) (put 'define eval-definition)) (define (install-if-package) (define (eval-if exp env) (if (true? (eval (if-predicate exp) env)) (eval (if-consequent exp) env) (eval (if-alternative exp) env))) (define (true? a) (eq? a #t)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) #f)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (put 'make-if make-if) (put 'if eval-if)) (define (install-lambda-package) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons 'lambda (cons parameters body))) (put 'make-lambda make-lambda) (put 'lambda (lambda (exp env) (make-procedure (lambda-parameters exp) (lambda-body exp) env)))) (define (install-begin-package) (define (eval-sequence exps env) (cond ((last-exp? exps) (eval (first-exp exps) env)) (else (eval (first-exp exps) env) (eval-sequence (rest-exps exps) env)))) (define (begin-actions exp) (cdr exp)) (define (last-exp? seq) (null? (cdr seq))) (define (first-exp seq) (car seq)) (define (rest-seq) (cdr seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (make-begin seq) (cons 'begin seq)) (put 'sequence->exp sequence->exp) (put 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env)))) (define (instll-cond-package) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last -- COND->IF" clauses)) (make-if (cond-predicate first) ;; 問題 4.5 拡張構文を使えるようにする (if (eq? (cadr first) '=>) (list (caddr first) (cond-predicate first)) (sequence->exp (cond-actions first))) (expand-clauses rest)))))) (define sequence->exp (get 'sequence->exp)) (define make-if (get 'make-if)) (put 'cond (lambda (exp env) (eval (cond->if exp) env)))) ;; 問題 4.4 (define (install-and-package) (define (eval-and exp env) (if (null? (cdr exp)) #t (eval-sequence (cdr seq) env))) (define (eval-sequence seq env) (cond ((null? (cdr seq)) (if (eval (car seq) env) (car seq) #f)) ((eval (car seq) env) (eval-sequence (cdr seq) env)) (else #f))) (put 'and eval-and)) (define (install-or-package) (define (eval-or exp env) (if (null? (cdr exp)) #f (eval-sequence (cdr seq) env))) (define (eval-sequence seq env) (cond ((null? seq) #f) ((eval (car seq) env) (car seq)) (else (eval-sequence (cdr seq) env)))) (put 'or 'eval-or))
入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))
$ ./sample5.scm $
0 コメント:
コメントを投稿