"Naoaki Iwakiri/Scheme課題memo"の差分

1と2のリビジョン間の差分

Naoaki Iwakiri/Scheme課題memo

Category読み物

Naoaki Iwakiri/Scheme課題memo (最終更新日時 2011-02-07 03:37:25 更新者 Naoaki Iwakiri)

-  ⇤ ← 2011-02-07 01:20:19時点のリビジョン1 → 
  サイズ: 2708
  編集者: Naoaki Iwakiri
  コメント:
+   ← 2011-02-07 01:24:20時点のリビジョン2 → ⇥
  サイズ: 66
  編集者: Naoaki Iwakiri
  コメント:
-削除された箇所はこのように表示されます。
+追加された箇所はこのように表示されます。
 行 3:
-{{{#!scheme
(define (base-eval exp env)
  (define (var-eval exp env)
    (cdr (lookup-var exp env)))
  (define (lambda-eval exp env)
    (if (pair? (cdr exp))
 (cons '*lambda* (cons env (cdr exp)))
 (eval-error 'syntax-error exp)))
  (define (def-eval exp env)
    (define-var! (cadr exp) (if (list? (caddr exp)) (base-eval (caddr exp) env) (caddr exp)) env))
  (define (if-eval exp env)
    (if (base-eval (car (cdr exp)) env)
 (base-eval (car (cdr (cdr exp))) env)
 (base-eval (car (cdr (cdr (cdr exp)))) env)))
  (define (let-eval exp env)
    (let ((alist (cadr exp)))
      (base-eval (cons (cons 'lambda (cons (map car alist) (cddr exp)))
         (map cadr alist))
   env)))
  (define (quote-eval exp env)
    (cadr exp));; really?
  (define (app-eval exp env)
    (let* ((l (map (lambda (exp) (base-eval exp env)) exp))
    (fun (car l))
    (args (cdr l)))
      (base-apply fun args env)))
  (define (base-apply fun args env)
 (define (makeargs list symbols args); make a list like let form's first arg for environment extention
   (cond ((null? symbols) list)
  (#t (makeargs (cons (cons (car symbols) (car args)) list) (cdr symbols) (cdr args)))))
    (cond ((not (pair? fun))
    (eval-error 'non-function fun))
   ((equal? (car fun) '*lambda*)
    (if (= (length (caddr fun)) (length args))
        (begin
   (let ((arglist (makeargs () (caddr fun) args)))
     (let ((newenv (extend-env arglist (cadr fun))))
       ;; newenvを参照して、function内部のシンボル解決するように
       (base-eval (cadddr fun) newenv))))
        (eval-error 'wrong-number-of-args fun)))
   ((equal? (car fun) '*primitive*)
    (if (or (not (number? (cadr fun))) (= (cadr fun) (length args)))
        ((caddr fun) args env)
        (eval-error 'wrong-number-of-args fun)))
   (#t
    (eval-error 'non-function fun))))
  (define (let-eval exp env)
    (let ((alist (cadr exp)))
      (base-eval (cons (cons 'lambda (cons (map car alist) (cddr exp)))
         (map cadr alist))
   env)))
-行 55:
+行 4:
-  (cond ((eof-object? exp) '*exit*)
 ((boolean? exp) exp)
 ((number? exp) exp)
 ((string? exp) exp)
 ((symbol? exp) (var-eval exp env))
 ((null? exp) exp)
 ((not (list? exp)) (eval-error 'syntax-error exp))
 ((equal? (car exp) 'exit) '*exit*)
;;	((equal? (car exp) 'begin
 ((equal? (car exp) 'lambda) (lambda-eval exp env))
 ((equal? (car exp) 'let) (let-eval exp env))
 ((equal? (car exp) 'define) (def-eval exp env))
;;	((equal? (car exp) 'letrec) 
 ((equal? (car exp) 'if) (if-eval exp env))
 ((equal? (car exp) 'quote) (quote-eval exp env))
 (#t (app-eval exp env))))
}}}