;; eceval

(define (tagged-list? exp tag)
  (if (pair? exp)
      (eq? (car exp) tag)
      false))
(define (self-evaluating? exp)
  (cond ((number? exp) true)
        ((string? exp) true)
        (else false)))
(define (variable? exp) (symbol? exp))
(define (quoted? exp)
  (tagged-list? exp 'quote))
(define (text-of-quotation exp) (cadr exp))
(define (assignment? exp)
  (tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-value exp) (caddr exp))
(define (definition? exp)
  (tagged-list? exp 'define))
(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 (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))
(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
  (if (not (null? (cdddr exp)))
      (cadddr exp)
      'false))
(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(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))
(define (true? x)
  (not (eq? x false)))
(define (false? x)
  (eq? x false))
(define (make-procedure parameters body env)
  (list 'procedure parameters body env))
(define (compound-procedure? p)
  (tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
(define (make-frame variables values)
  (cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
  (set-car! frame (cons var (car frame)))
  (set-cdr! frame (cons val (cdr frame))))
(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) base-env)
      (if (< (length vars) (length vals))
          (error "Too many arguments supplied" vars vals)
          (error "Too few arguments supplied" vars vals))))
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (car vals))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))
(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))
(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! var val frame))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame)
          (frame-values frame))))
(define (primitive-procedure? proc)
  (tagged-list? proc 'primitive))
(define (primitive-implementation proc) (cadr proc))
(define apply-in-underlying-scheme apply)

(define (empty-arglist) '())
(define (adjoin-arg arg arglist)
  (append arglist (list arg)))
(define (last-operand? ops)
  (null? (cdr ops)))
(define (user-print object)
  (if (compound-procedure? object)
      (display (list 'compound-procedure
                     (procedure-parameters object)
                     (procedure-body object)
                     '))
      (display object)))
(define primitive-procedures
  (list (list '* *)
        (list '+ +)
        (list '- -)
        (list '/ /)
        (list '< <)
        (list '= =)
        (list '> >)
;;      (list 'apply apply)
        (list 'assoc assoc)
        (list 'atan atan)
        (list 'cadr cadr)
        (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'cos cos)
        (list 'display display)
        (list 'eq? eq?)
        (list 'error error)
;;      (list 'eval eval)
        (list 'list list)
        (list 'log log)
        (list 'max max)
        (list 'min min)
        (list 'newline newline)
        (list 'not not)
        (list 'null? null?)
        (list 'number? number?)
        (list 'pair? pair?)
        (list 'quotient quotient)
        (list 'random random)
        (list 'read read)
        (list 'remainder remainder)
        (list 'round round)
        (list 'runtime runtime)
        (list 'set-car! set-car!)
        (list 'set-cdr! set-cdr!)
        (list 'sin sin)
        (list 'symbol? symbol?)
        (list 'vector-ref vector-ref)
        (list 'vector-set! vector-set!)
        ))
(define (primitive-procedure-names)
  (map car
       primitive-procedures))
(define (primitive-procedure-objects)
  (map (lambda (proc) (list 'primitive (cadr proc)))
       primitive-procedures))
(define (setup-environment)
  (let ((initial-env
         (extend-environment (primitive-procedure-names)
                             (primitive-procedure-objects)
                             the-empty-environment)))
    (define-variable! 'true true initial-env)
    (define-variable! 'false false initial-env)
    initial-env))
(define the-global-environment (setup-environment))
(define (get-global-environment)
  the-global-environment)

(define (apply-primitive-procedure proc args)
  (apply-in-underlying-scheme
   (primitive-implementation proc) args))

(define (prompt-for-input string)
  (newline) (newline) (display string) (newline))

(define (announce-output string)
  (newline) (display string) (newline))

(define (no-more-exps? seq) (null? seq))

(define eceval-operations
  (list 
(list 'adjoin-arg adjoin-arg)
(list 'announce-output announce-output)
(list 'application? application?)
(list 'apply-primitive-procedure apply-primitive-procedure)
(list 'assignment-value assignment-value)
(list 'assignment-variable assignment-variable)
(list 'assignment? assignment?)
(list 'begin-actions begin-actions)
(list 'begin? begin?)
(list 'compiled-procedure? compiled-procedure?)
(list 'compound-procedure? compound-procedure?)
(list 'define-variable! define-variable!)
(list 'definition-value definition-value)
(list 'definition-variable definition-variable)
(list 'definition? definition?)
(list 'empty-arglist empty-arglist)
(list 'extend-environment extend-environment)
(list 'first-exp first-exp)
(list 'first-operand first-operand)
(list 'get-global-environment get-global-environment)
(list 'if-alternative if-alternative)
(list 'if-consequent if-consequent)
(list 'if-predicate if-predicate)
(list 'if? if?)
;(list 'initialize-stack initialize-stack)
(list 'lambda-body lambda-body)
(list 'lambda-parameters lambda-parameters)
(list 'lambda? lambda?)
(list 'last-exp? last-exp?)
(list 'last-operand? last-operand?)
(list 'lookup-variable-value lookup-variable-value)
(list 'make-procedure make-procedure)
(list 'no-more-exps? no-more-exps?)
(list 'no-operands? no-operands?)
(list 'operands operands)
(list 'operator operator)
(list 'primitive-procedure? primitive-procedure?)
;(list 'print-stack-statistics print-stack-statistics)
(list 'procedure-body procedure-body)
(list 'procedure-environment procedure-environment)
(list 'procedure-parameters procedure-parameters)
(list 'prompt-for-input prompt-for-input)
(list 'quoted? quoted?)
(list 'read read)
(list 'rest-exps rest-exps)
(list 'rest-operands rest-operands)
(list 'self-evaluating? self-evaluating?)
(list 'set-variable-value! set-variable-value!)
(list 'text-of-quotation text-of-quotation)
(list 'true? true?)
(list 'user-print user-print)
(list 'variable? variable?)
))

(define eceval
  (make-machine
   '(exp env val proc argl continue unev)
  eceval-operations
  '(
read-eval-print-loop
  (perform (op initialize-stack))
  (perform
   (op prompt-for-input) (const ";;; EC-Eval input:"))
  (assign exp (op read))
  (assign env (op get-global-environment))
  (assign continue (label print-result))
  (goto (label eval-dispatch))

print-result
  (perform (op print-stack-statistics));;スタック統計量出力
  (perform
   (op announce-output) (const ";;; EC-Eval value:"))
  (perform (op user-print) (reg val))
  (goto (label read-eval-print-loop))

eval-dispatch
  (test (op self-evaluating?) (reg exp))
  (branch (label ev-self-eval))
  (test (op variable?) (reg exp))
  (branch (label ev-variable))
  (test (op quoted?) (reg exp))
  (branch (label ev-quoted))
  (test (op assignment?) (reg exp))
  (branch (label ev-assignment))
  (test (op definition?) (reg exp))
  (branch (label ev-definition))
  (test (op if?) (reg exp))
  (branch (label ev-if))
  (test (op lambda?) (reg exp))
  (branch (label ev-lambda))
  (test (op begin?) (reg exp))
  (branch (label ev-begin))
  (test (op application?) (reg exp))
  (branch (label ev-application))
  (goto (label unknown-expression-type))

ev-self-eval
  (assign val (reg exp))
  (goto (reg continue))

ev-variable
  (assign val (op lookup-variable-value) (reg exp) (reg env))
  (goto (reg continue))

ev-quoted
  (assign val (op text-of-quotation) (reg exp))
  (goto (reg continue))

ev-lambda
  (assign unev (op lambda-parameters) (reg exp))
  (assign exp (op lambda-body) (reg exp))
  (assign val (op make-procedure)
              (reg unev) (reg exp) (reg env))
  (goto (reg continue))

ev-application
  (save continue)
  (save env)
  (assign unev (op operands) (reg exp))
  (save unev)
  (assign exp (op operator) (reg exp))
  (assign continue (label ev-appl-did-operator))
  (goto (label eval-dispatch))

ev-appl-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (test (op no-operands?) (reg unev))
  (branch (label apply-dispatch))
  (save proc)

ev-appl-operand-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label ev-appl-last-arg))
  (save env)
  (save unev)
  (assign continue (label ev-appl-accumulate-arg))
  (goto (label eval-dispatch))

ev-appl-accumulate-arg
  (restore unev)
  (restore env)
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (assign unev (op rest-operands) (reg unev))
  (goto (label ev-appl-operand-loop))

ev-appl-last-arg
  (assign continue (label ev-appl-accum-last-arg))
  (goto (label eval-dispatch))
ev-appl-accum-last-arg
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (restore proc)
  (goto (label apply-dispatch))

apply-dispatch
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-apply))
  (test (op compound-procedure?) (reg proc))  
  (branch (label compound-apply))
  (goto (label unknown-procedure-type))

primitive-apply
  (assign val (op apply-primitive-procedure)
              (reg proc)
              (reg argl))
  (restore continue)
  (goto (reg continue))

compound-apply
  (assign unev (op procedure-parameters) (reg proc))
  (assign env (op procedure-environment) (reg proc))
  (assign env (op extend-environment)
              (reg unev) (reg argl) (reg env))
  (assign unev (op procedure-body) (reg proc))
  (goto (label ev-sequence))

ev-begin
  (assign unev (op begin-actions) (reg exp))
  (save continue)
  (goto (label ev-sequence))

;; 末尾再帰 ev-sequence
ev-sequence
  (assign exp (op first-exp) (reg unev))
  (test (op last-exp?) (reg unev))
  (branch (label ev-sequence-last-exp))
  (save unev)
  (save env)
  (assign continue (label ev-sequence-continue))
  (goto (label eval-dispatch))
ev-sequence-continue
  (restore env)
  (restore unev)
  (assign unev (op rest-exps) (reg unev))
  (goto (label ev-sequence))
ev-sequence-last-exp
  (restore continue)
  (goto (label eval-dispatch))

;;末尾再帰なし ev-sequence
;;ev-sequence
;;  (test (op no-more-exps?) (reg unev))
;;  (branch (label ev-sequence-end))
;;  (assign exp (op first-exp) (reg unev))
;;  (save unev)
;;  (save env)
;;  (assign continue (label ev-sequence-continue))
;;  (goto (label eval-dispatch))
;;ev-sequence-continue
;;  (restore env)
;;  (restore unev)
;;  (assign unev (op rest-exps) (reg unev))
;;  (goto (label ev-sequence))
;;ev-sequence-end
;;  (restore continue)
;;  (goto (reg continue))

ev-if
  (save exp)
  (save env)
  (save continue)
  (assign continue (label ev-if-decide))
  (assign exp (op if-predicate) (reg exp))
  (goto (label eval-dispatch))

ev-if-decide
  (restore continue)
  (restore env)
  (restore exp)
  (test (op true?) (reg val))
  (branch (label ev-if-consequent))
ev-if-alternative
  (assign exp (op if-alternative) (reg exp))
  (goto (label eval-dispatch))
ev-if-consequent
  (assign exp (op if-consequent) (reg exp))
  (goto (label eval-dispatch))

ev-assignment
  (assign unev (op assignment-variable) (reg exp))
  (save unev)
  (assign exp (op assignment-value) (reg exp))
  (save env)
  (save continue)
  (assign continue (label ev-assignment-1))
  (goto (label eval-dispatch))
ev-assignment-1
  (restore continue)
  (restore env)
  (restore unev)
  (perform
   (op set-variable-value!) (reg unev) (reg val) (reg env))
  (assign val (const ok))
  (goto (reg continue))

ev-definition
  (assign unev (op definition-variable) (reg exp))
  (save unev)
  (assign exp (op definition-value) (reg exp))
  (save env)
  (save continue)
  (assign continue (label ev-definition-1))
  (goto (label eval-dispatch))
ev-definition-1
  (restore continue)
  (restore env)
  (restore unev)
  (perform
   (op define-variable!) (reg unev) (reg val) (reg env))
  (assign val (const ok))
  (goto (reg continue))

unknown-expression-type
  (assign val (const unknown-expression-type-error))
  (goto (label signal-error))

unknown-procedure-type
  (restore continue)
  (assign val (const unknown-procedure-type-error))
  (goto (label signal-error))

signal-error
  (perform (op user-print) (reg val))
  (goto (label read-eval-print-loop))

   )))

(define the-global-environment (setup-environment))

(start eceval)

;; ここまでの定義ではcond, letはunbound variableのエラーになる．

;condの実装
; 221ページのcondの実装を借りてくる．

(define (cond? exp) (tagged-list? exp 'cond))

(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 (sequence->exp exps)  ;新しく定義
  (cons 'begin exps))

(define (make-if predicate consequence  alternative) ;新しく定義
   (list 'if predicate consequence alternative))

(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)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest))))))

;eceval-operationsに以下を追加

(list 'cond? cond?)         ;;ex5.23
(list 'cond->if cond->if)   ;;ex5.23

;eval-dispatchに以下を追加

  (test (op cond?) (reg exp))     ;;ex5.23
  (branch (label ev-cond))

;以下を追加
ev-cond            ;; ex5.23
  (assign exp (op cond->if) (reg exp))
  (goto (label ev-if))

;letの実装
;問題4.6を借りる

;以下を追加
(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))

(define (let? exp) (tagged-list? exp 'let))

(define (let->combination exp)
  (let ((bindings (cadr exp)) (body (cddr exp)))
   (cons (make-lambda (map car bindings) body)
     (map cadr bindings))))

;eceval-operations に以下を追加

(list 'let? let)            ;;ex5.23
(list 'let->combination let->combination)  ;;ex5.23

;eval-dispatchに以下を追加
 
 (test (op let?) (reg exp))      ;;ex5.23
  (branch (label ev-let))

ev-cond              ;;ex5.24
  (save continue)
  (assign unev (op cond-clauses) (reg exp))
ev-cond-loop
  (test (op null?) (reg unev))
  (branch (label ev-cond-null))
  (assign exp (op first-exp) (reg unev))
  (assign unev (op rest-exps) (reg unev))
  (test (op cond-else-clause?) (reg exp))
  (branch (label ev-cond-else-clause))
  (save exp)
  (save unev)
  (save env)
  (assign continue (label ev-cond-decide))
  (assign exp (op cond-predicate) (reg exp))
  (goto (label eval-dispatch))
ev-cond-decide
  (restore env)
  (restore unev)
  (restore exp)
  (test (op true?) (reg val))
  (branch (label ev-cond-consequent))
  (goto (label ev-cond-loop))
ev-cond-consequent
  (assign unev (op cond-actions) (reg exp))
  (goto (label ev-sequence))
ev-cond-else-clause
  (test (op null?) (reg unev))
  (branch (label ev-cond-else-consequent))
  (assign val (const else-clause-isnt-last))
  (goto (label signal-error))
ev-cond-else-consequent
  (assign unev (op cond-actions) (reg exp))
  (goto (label ev-sequence))
ev-cond-null
  (assign val (const ()))
  (restore continue)
  (goto (reg continue))

;; ev-applicationの変更

ev-application
  (save continue)
  (save env)
  (assign unev (op operands) (reg exp))
  (save unev)
  (assign exp (op operator) (reg exp))
  (assign continue (label ev-app-did-operator))
  (goto (label actual-value))
ev-app-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label list-of-arg-values))
  (test (op compound-procedure?) (reg proc))
  (branch (label list-of-delayed-args))
  (goto (label unknown-procedure-type))
list-of-arg-values
  (test (op no-operands?) (reg unev))
  (branch (label primitive-apply))
  (save proc)
arg-value-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label last-arg-value))
  (save env)
  (save unev)
  (assign continue (label ev-appl-accumulate-arg))
  (goto (label actual-value))
ev-appl-accumulate-arg
  (restore unev)
  (restore env)
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (assign unev (op rest-operands) (reg unev))
  (goto (label arg-value-loop))
last-arg-value
  (assign continue (label ev-appl-accum-last-arg))
  (goto (label actual-value))
ev-appl-accum-last-arg
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (restore proc)
primitive-apply
  (assign val (op apply-primitive-procedure)
              (reg proc) (reg argl))
  (restore continue)
  (goto (reg continue))
list-of-delayed-args
  (test (op no-operands?) (reg unev))
  (branch (label compound-apply))
  (assign exp (op first-operand) (reg unev))
  (assign val (op delay-it) (reg exp) (reg env))
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (assign unev (op rest-operands) (reg unev))
  (goto (label list-of-delayed-args))
compound-apply
  (assign unev (op procedure-parameters) (reg proc))
  (assign env (op procedure-environment) (reg proc))
  (assign env (op extend-environment)
              (reg unev) (reg argl) (reg env))
  (assign unev (op procedure-body) (reg proc))
  (goto (label ev-sequence))

actual-value
  (save continue)
  (assign continue (label eval-end))
  (goto (label eval-dispatch))
eval-end
  (assign exp (reg val))
  (restore continue)
  (goto (label force-it))

force-it
  (test (op thunk?) (reg exp))
  (branch (label eval-thunk))
  (assign val (reg exp))
  (goto (reg continue))
eval-thunk
  (assign env (op thunk-env) (reg exp))
  (assign exp (op thunk-exp) (reg exp))
  (goto (label actual-value))

;; ev-ifも修正する

ev-if
  (save exp)
  (save env)
  (save continue)
  (assign continue (label ev-if-decide))
  (assign exp (op if-predicate) (reg exp))
  (goto (label actual-value))

;; 以下は基本命令として定義

(define (delay-it exp env)
  (list 'thunk exp env))

(define (thunk? obj)
  (tagged-list? obj 'thunk))

(define (thunk-exp thunk) (cadr thunk))

(define (thunk-env thunk) (caddr thunk))

;; eceval-operationsに追加する

(list 'thunk? thunk?)
(list 'thunk-exp thunk-exp)
(list 'thunk-env thunk-env)
(list 'delay-it delay-it)

;; 実行してみる. 
;;;;; EC-Eval input:
;;(define (try a b)
;;  (if (= a 0) 1 b))
;;
;;(total-pushes = 3 maximum-depth = 3)
;;;;; EC-Eval value:
;;ok
;;
;;;;; EC-Eval input:
;;(try 0 (/ 1 0))
;;
;;(total-pushes = 20 maximum-depth = 10)
;;;;; EC-Eval value:
;;1
;;

;;; EC-Eval input:
(define (factorial n)
  (define (iter product counter)
    (if (> counter n)
        product
        (iter (* counter product)
              (+ counter 1))))
  (iter 1 1))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(factorial 1)

(total-pushes = 64 maximum-depth = 10)
;;; EC-Eval value:
1

;;; EC-Eval input:
(factorial 2)

(total-pushes = 99 maximum-depth = 10)
;;; EC-Eval value:
2

;;; EC-Eval input:
(factorial 3)

(total-pushes = 134 maximum-depth = 10)
;;; EC-Eval value:
6

;;; EC-Eval input:
(factorial 4)

(total-pushes = 169 maximum-depth = 10)
;;; EC-Eval value:
24

;;; EC-Eval input:
(factorial 5)

(total-pushes = 204 maximum-depth = 10)
;;; EC-Eval value:
120

 n  total  max
 1    64   10
 2    99   10
 3   134   10
 4   169   10
 5   204   10

;;; EC-Eval input:
(define (factorial n)
  (if (= n 1)
      1
      (* (factorial (- n 1)) n)))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(factorial 1)

(total-pushes = 16 maximum-depth = 8)
;;; EC-Eval value:
1

;;; EC-Eval input:
(factorial 2)

(total-pushes = 48 maximum-depth = 13)
;;; EC-Eval value:
2

;;; EC-Eval input:
(factorial 3)

(total-pushes = 80 maximum-depth = 18)
;;; EC-Eval value:
6

;;; EC-Eval input:
(factorial 4)

(total-pushes = 112 maximum-depth = 23)
;;; EC-Eval value:
24

;;; EC-Eval input:
(factorial 5)

(total-pushes = 144 maximum-depth = 28)
;;; EC-Eval value:
120

 n  total  max
 1    16    8
 2    48   13
 3    89   18
 4   112   23
 5   144   28

;;; EC-Eval input:
(define (factorial n)
  (define (iter product counter)
    (if (> counter n)
        product
        (iter (* counter product)
              (+ counter 1))))
  (iter 1 1))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(factorial 1)

(total-pushes = 70 maximum-depth = 17)
;;; EC-Eval value:
1

;;; EC-Eval input:
(factorial 2)

(total-pushes = 107 maximum-depth = 20)
;;; EC-Eval value:
2

;;; EC-Eval input:
(factorial 3)

(total-pushes = 144 maximum-depth = 23)
;;; EC-Eval value:
6

;;; EC-Eval input:
(factorial 4)

(total-pushes = 181 maximum-depth = 26)
;;; EC-Eval value:
24

;;; EC-Eval input:
(factorial 5)

(total-pushes = 218 maximum-depth = 29)
;;; EC-Eval value:
120

;;; EC-Eval input:
(define (factorial n)
  (if (= n 1)
      1
      (* (factorial (- n 1)) n)))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(factorial 1)

(total-pushes = 18 maximum-depth = 11)
;;; EC-Eval value:
1

;;; EC-Eval input:
(factorial 2)

(total-pushes = 52 maximum-depth = 19)
;;; EC-Eval value:
2

;;; EC-Eval input:
(factorial 3)

(total-pushes = 86 maximum-depth = 27)
;;; EC-Eval value:
6

;;; EC-Eval input:
(factorial 4)

(total-pushes = 120 maximum-depth = 35)
;;; EC-Eval value:
24

;;; EC-Eval input:
(factorial 5)

(total-pushes = 154 maximum-depth = 43)
;;; EC-Eval value:
120

反復版            再帰版
 n  total  max    n  total  max
 1    70   17     1    18   11
 2   107   20     2    52   19
 3   144   23     3    86   27
 4   181   26     4   120   35
 5   218   29     5   154   43

;;; EC-Eval input:
(define (fib n)
  (if (< n 2)
      n
      (+ (fib (- n 1)) (fib (- n 2)))))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(fib 2)

(total-pushes = 72 maximum-depth = 13)
;;; EC-Eval value:
1

;;; EC-Eval input:
(fib 3)

(total-pushes = 128 maximum-depth = 18)
;;; EC-Eval value:
2

;;; EC-Eval input:
(fib 4)

(total-pushes = 240 maximum-depth = 23)
;;; EC-Eval value:
3

;;; EC-Eval input:
(fib 5)

(total-pushes = 408 maximum-depth = 28)
;;; EC-Eval value:
5

;;; EC-Eval input:
(fib 6)

(total-pushes = 688 maximum-depth = 33)
;;; EC-Eval value:
8

;;; EC-Eval input:
(fib 7)

(total-pushes = 1136 maximum-depth = 38)
;;; EC-Eval value:
13

;;; EC-Eval input:
(fib 8)

(total-pushes = 1864 maximum-depth = 43)
;;; EC-Eval value:
21

;;; EC-Eval input:
(fib 9)

(total-pushes = 3040 maximum-depth = 48)
;;; EC-Eval value:
34

;;; EC-Eval input:
(fib 10)

(total-pushes = 4944 maximum-depth = 53)
;;; EC-Eval value:
55

これより
 n fib(n) total  max
 2     1    72   13
 3     2   128   18
 4     3   240   23
 5     5   408   28
 6     8   688   33
 7    13  1136   38
 8    21  1864   43
 9    34  3040   48
10    55  4944   53

k=S(4)-S(3)-S(2)=40

S(n)=a Fib(n+1) + b  と書けるとすると
S(n)=S(n-1) + S(n-2) + k
    =a Fib(n) + b + a Fib(n-1) + b + k
    =a Fib(n+1) + b + (b + k) 
∴ b = -k = -40
   a = 56