(load "shared/util")
(load "shared/sicp-load-eceval-compiler")
(load "shared/sicp-compiler")

(display "\nex-5.45 - factorial-stack-usage-comparison\n")

;(compile-and-go
; '(begin
;    (define (factorial n)
;      (if (= n 1)
;        1
;        (* (factorial (- n 1)) n)))
;    (factorial 10)))

; a.

; | (factorial 10) | pushes | depth  |
; | -------------- | ------ | ------ |
; | machine        |     18 |     18 |
; | compiled       |     56 |     29 |
; | evaluator      |    310 |     35 |

; | (factorial 20) | pushes | depth  |
; | -------------- | ------ | ------ |
; | machine        |     38 |     38 |
; | compiled       |    116 |     59 |
; | evaluator      |    630 |     65 |

; pushes(compiled/machine) = 3
; depth(compiled/machine) = 1.5

; pushes(evaluator/compiled) = 5.5
; depth(evaluator/compiled) = 1.2

; b. Use special handling for primitive procedures from exercise 5.38.

(display "[done]\n")

(display "\nex-5.46 - fibo-stack-usage-comparison\n")

;(compile-and-go
; '(begin
;    (define (fib n)
;      (if (< n 2)
;          n
;          (+ (fib (- n 1)) (fib (- n 2)))))
;    (fib 10)))

; | (fib 10)       | pushes | depth  |
; | -------------- | ------ | ------ |
; | machine        |    264 |     18 |
; | compiled       |    882 |     29 |
; | evaluator      |   4950 |     53 |

; | (fib 20)       | pushes | depth  |
; | -------------- | ------ | ------ |
; | machine        |  32835 |     38 |
; | compiled       | 109452 |     59 |
; | evaluator      | 612942 |    103 |

(display "[done]\n")

(display "\nex-5.47 - call-interpreted-from-compiled\n")

(define (compile-procedure-call target linkage)
  (let* ((primitive-branch (make-label 'primitive-branch))
         (compiled-branch (make-label 'compiled-branch))
         (interpreted-branch (make-label 'interpreted-branch))
         (after-call (make-label 'after-call))
         (compiled-linkage (if (eq? linkage 'next) after-call linkage))
         (compiled-test-primitive
           (make-instruction-sequence
             '(proc) '()
             `((test (op primitive-procedure?) (reg proc))
               (branch (label ,primitive-branch)))))
         (compiled-test-procedure
           (make-instruction-sequence
             '(proc) '()
             `((test (op compiled-procedure?) (reg proc))
               (branch (label ,compiled-branch)))))
         (compiled-interpreted-branch
           (append-instruction-sequences
             interpreted-branch
             (compile-intp-appl target compiled-linkage)))
         (compiled-compiled-branch
           (append-instruction-sequences
             compiled-branch
             (compile-proc-appl target compiled-linkage)))
         (compiled-primitive-branch
           (append-instruction-sequences
             primitive-branch
             (end-with-linkage
               linkage
               (make-instruction-sequence
                 '(proc argl) (list target)
                 `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))))
      (append-instruction-sequences
        compiled-test-primitive
       (append-instruction-sequences
         compiled-test-procedure
         (parallel-instruction-sequences
           compiled-interpreted-branch
           (parallel-instruction-sequences
             compiled-compiled-branch
             compiled-primitive-branch)))
       after-call)))

(define (compile-intp-appl target linkage)
  (cond ((and (eq? target 'val) (not (eq? linkage 'return)))
         (make-instruction-sequence
           '(proc) all-regs
           `((save continue)
             (assign continue (label ,linkage))
             (save continue)
             (goto (reg compapp)))))
        ((and (not (eq? target 'val)) (not (eq? linkage 'return)))
         (let ((proc-return (make-label 'proc-return)))
           (make-instruction-sequence '(proc) all-regs
            `((save continue)
              (assign continue (label ,proc-return))
              (save continue)
              (goto (reg compapp))
              ,proc-return
              (assign ,target (reg val))
              (goto (label ,linkage))))))
        ((and (eq? target 'val) (eq? linkage 'return))
         (make-instruction-sequence
           '(proc) all-regs
           `((save continue)
             (goto (reg compapp)))))
        (else (error "unsupported target linkage -- COMPILE-INTP-APPL"
                     (list target linkage)))))

(define expression
  '(begin
     (define (f n)
       (g n))
     (define (factorial n)
       (if (= n 1)
         1
         (* (factorial (- n 1)) n)))))

; (compile-to-file expression 'val 'return "f-call-interpreted.scm")
;; Requires compile-to-file from ex-5_3_31-38.scm

; (compile-and-go expression)
;; To test this exercise uncomment the previous line, then:
;; $ mit-scheme
;; 1 ]=> (load "ex-5_45-49")
;; 2 ]=> (define (g n) (* n n n))
;; 3 ]=> (f 3) ; calls interpreted 'g'

(display "[done]\n")

(display "\nex-5.48 - compile-and-run\n")

;; compile-and-go is implemented in sicp-eceval-compiler.scm
; (start-eceval)
;; To test this exercise uncomment the previous line, then:
;; $ mit-scheme
;; 1 ]=> (load "ex-5_45-49")
;; 2 ]=> (compile-and-run (define (f n) (if (= n 1) 1 (* n (f (- n 1))))))
;; 3 ]=> (f 5)

(display "[done]\n")

(display "\nex-5.49 - read-compile-execute-print\n")

; Changing the loop to read-compile-execute requies a single additional line
; within the read-eval-print-loop. If we add a compile-and-run tag to the
; expression eval-dispatch automatically dispatches to the compiler.

; (assign exp (op list) (const compile-and-run) (reg exp))
;; read-compile-execute - ex-5.49
;; Implemented in sicp-eceval-compiler.scm

(display "[done]\n")