sicp-4-2-2-an-interpreter-with-lazy-evaluation

#lang racket
(require racket/mpair
         "4-2-2-lazy-repl-program.rkt")

;;;;;;;;;;
;; 4.27 ;;
;;;;;;;;;;

;; The lazy interpreter incremented count once when defining w and once again when
;; evaluating w.  However, further evaluations of w did not increment count.

;; When we define w, my-eval is called on the definition-value, which is not delayed.
;; So the set! in the outermost call to id is executed, and count is incremented to
;; one.  However, the inner call to id, being the argument to a compound procedure,
;; is delayed, and the second set! is not executed during the definition of w.

;; Evaluating w then forces the delayed inner call to id, and the second set!
;; statement is executed, incrementing count to two.  Because of memoization, w will
;; not increment count again.

;; (driver-loop)
;; ;;; L-Eval input:
;; (define count 0)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (id x) (set! count (+ count 1)) x)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 0
;; ;;; L-Eval input:
;; (define w (id (id 10)))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 1
;; ;;; L-Eval input:
;; w
;; ;;; L-Eval value:
;; 10
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 2
;; ;;; L-Eval input:
;; w
;; ;;; L-Eval value:
;; 10
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 2

;;;;;;;;;;
;; 4.28 ;;
;;;;;;;;;;

(define (f g) (g 2)) ; f of g is 'apply g to 2'

;; Since g is the argument to a compound procedure, it gets delayed.  If we did not
;; force procedure operations, we couldn't apply g to 2 in the body.  It would be a
;; thunk containing a procedure but not itself a procedure.

;; WITH MY-EVAL USING ACTUAL-VALUE AS IN THE BOOK:

        ;; [(application? expr) ; the application clause in my-eval
         ;; (my-apply (actual-value (operator expr) env)
                   ;; (operands expr)
                   ;; env)]

;; ;;; L-Eval input:
;; (define (f g) (g 2))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (plus3 x) (+ x 3))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (f plus3)
;; ;;; L-Eval value:
;; 5

;; WITH MY-EVAL CHANGED TO NOT FORCE THE OPERATOR:

        ;; [(application? expr)
         ;; (my-apply (my-eval (operator expr) env)
                   ;; (operands expr)
                   ;; env)]

;; (driver-loop)
;; ;;; L-Eval input:
;; (define (f g) (g 2))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (plus3 x) (+ x 3))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (f plus3)
;; . . Unknown procedure type -- APPLY {thunk plus3 ...

;;;;;;;;;;
;; 4.29 ;;
;;;;;;;;;;

;; Any recursive function with side-effects would run much more slowly without
;; memoization than with memoization, when many loops were called for.

;; WITH MEMOIZATION:

;; Count is incremented once in the evaluation of (square (id 10)).

;; (driver-loop)
;; ;;; L-Eval input:
;; (define count 0)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (id x) (set! count (+ count 1)) x)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (square x) (* x x))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (square (id 10))
;; ;;; L-Eval value:
;; 100
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 1

;; WITHOUT MEMOIZATION:

;; To not memoize, use this definition for force-it:

;; (define (force-it obj)
  ;; (if (thunk? obj)
    ;; (actual-value (thunk-exp obj) (thunk-env obj))
    ;; obj))

;; Count is incremented twice in the evaluation of (square (id 10)).

;; (driver-loop)
;; ;;; L-Eval input:
;; (define count 0)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define count 0)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (id x) (set! count (+ count 1)) x)
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (define (square x) (* x x))
;; ;;; L-Eval value:
;; ok
;; ;;; L-Eval input:
;; (square (id 10))
;; ;;; L-Eval value:
;; 100
;; ;;; L-Eval input:
;; count
;; ;;; L-Eval value:
;; 2

;; (id 10) is evaluated twice in the body of square.  Without memoization, this
;; triggers two executions of the set!.  With memoization, set! is executed only
;; once.

;;;;;;;;;;
;; 4.30 ;;
;;;;;;;;;;

;;;;;;;;
;; A. ;;
;;;;;;;;

;; Add these to the list of primitive procedures to make the example work:

    ;; (list 'displayln displayln)
    ;; (list 'list list)

;; WITH EVAL-SEQUENCE AS IN THE BOOK:

(my-eval
  '(define (for-each proc items)
     (if (empty? items)
       'done
       (begin (proc (car items))
              (for-each proc (cdr items)))))
  the-global-environment)
;; 'ok
(my-eval
  '(for-each (lambda (x) (displayln x)) (list 57 321 88))
  the-global-environment)
;; 57
;; 321
;; 88
;; 'done

;; So the book code does work for this example.  This is because the argument x is
;; passed to the primitive procedure displayln, and primitive procedures always force
;; their arguments.

;;;;;;;;
;; B. ;;
;;;;;;;;

;; WITH EVAL-SEQUENCE AS IN THE BOOK:

(my-eval
  '(define (p1 x)
     (set! x (cons x '(2)))
     x)
  the-global-environment)
;; 'ok
(my-eval
  '(define (p2 x)
     (define (p e)
       e
       x)
     (p (set! x (cons x '(2)))))
  the-global-environment)
;; 'ok
(my-eval '(p1 1) the-global-environment)
;; '(1 2)
(my-eval '(p2 1) the-global-environment)
;; (mcons
 ;; 'thunk
 ;; (mcons
  ;; 1
  ;; (mcons ... ; cut out a huge environment list here

;; WITH CY D. FECT'S VERSION OF EVAL-SEQUENCE:

;; (my-eval
  ;; '(define (p1 x)
     ;; (set! x (cons x '(2)))
     ;; x)
  ;; the-global-environment)
;; ;; 'ok
;; (my-eval
  ;; '(define (p2 x)
     ;; (define (p e)
       ;; e
       ;; x)
     ;; (p (set! x (cons x '(2)))))
  ;; the-global-environment)
;; ;; 'ok
;; (my-eval '(p1 1) the-global-environment)
;; ;; '(1 2)
;; (my-eval '(p2 1) the-global-environment)
;; ;; '(1 2)

;; So Cy's version 'does the right thing' and forces e in the definition of p2, while
;; the book code does not.

;;;;;;;;
;; C. ;;
;;;;;;;;

;; The arguments to the lambda in part a. were already forced by the call to the
;; primitive procedure display.  So pre-forcing them, as Cy wants, would not affect
;; the behavior of the for-each.

;;;;;;;;
;; D. ;;
;;;;;;;;

;; I can see the utility of Cy's approach.  It does the right thing with
;; side-effects, but programs using lazy evaluation should not have side-effects
;; anyway.  I like the book's consistent approach:  if we're going to have a lazy
;; evaluator, then it should be consistently lazy, and not just lazy except in
;; special circumstances.

;;;;;;;;;;
;; 4.31 ;;
;;;;;;;;;;

;; The idea is to make all lambda parameters "typed".  So now a lambda parameter will
;; be a two-element list (<var> <type>) where the type is either 'eager, 'lazy, or
;; 'lazy-memo.  However, the user does not have to specify the 'eager type when
;; defining a procedure.  Parameters are 'eager by default.

;; The make-all-typed procedure will add the 'eager type to regular arguments when
;; constructing a lambda.  So make-all-typed will have to be used everywhere that
;; make-lambda is used in the program.

;; Once all procedure parameters are typed, we need a new procedure selector,
;; procedure-types.

;; Lastly, we change my-apply to use a new function list-of-args, to replace
;; list-of-delayed-args.  list-of-args will take an extra parameter, the types of the
;; arguments, to construct the appropriate list of values and/or thunks.

;; Change define:

(define (definition? expr)
  (tagged-list? expr 'define))
(define (procedure-definition? expr)
  (and (definition? expr)
       (not (symbol? (second expr)))))
(define (definition-variable expr)
  (if (procedure-definition? expr)
    (first (second expr))
    (second expr)))
(define (definition-parameters expr)
  (rest (second expr)))

(define (make-all-typed params)
  (map (lambda (p)(if (symbol? p)
                     (list p 'eager)
                     p))
       params))

(define (definition-value expr)
  (if (procedure-definition? expr)
    (make-lambda (make-all-typed (definition-parameters expr)) ; changed
                 (drop expr 2))
    (third expr)))

;; Change make-lambda to type the parameters:

(define (make-lambda parameters body)
  (cons 'lambda (cons (make-all-typed parameters) body))) ; changed

;; Change thunks, force-it, and delay-it:

(define (thunk-memo? obj) (tagged-list? obj 'thunk-memo))
(define (thunk-no-memo? obj) (tagged-list? obj 'thunk-no-memo))
(define (thunk-exp my-thunk) (mcar (mcdr my-thunk)))
(define (thunk-env my-thunk) (mcar (mcdr (mcdr my-thunk))))

(define (delay-it-memo expr env)
  (mlist 'thunk-memo expr env))
(define (delay-it-no-memo expr env)
  (mlist 'thunk-no-memo expr env))

(define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk))
(define (thunk-value evaluated-thunk) (mcar (mcdr evaluated-thunk)))

(define (force-it obj)
  (cond [(thunk-memo? obj)
         (define result (actual-value (thunk-exp obj) (thunk-env obj)))
         (set-mcar! obj 'evaluated-thunk)
         (set-mcar! (mcdr obj) result)
         (set-mcdr! (mcdr obj) empty)
         result]
        [(evaluated-thunk? obj) (thunk-value obj)]
        [(thunk-no-memo? obj)
         (actual-value (thunk-exp obj) (thunk-env obj))]
        [else obj]))

;; Change procedure selectors:

(define (procedure-parameters p) (map first (second p)))
(define (procedure-types p) (map second (second p)))

;; Now we will change list-of-delayed-args to a new function list-of-args.  The new
;; function list-of-args will take three parameters, arguments, types, and env, and
;; produce the appropriate list of values and/or thunks according to the types of the
;; procedure arguments.

(define (list-of-args exprs types env)
  (cond [(no-operands? exprs)
         empty]
        [else
          (define e (first-operand exprs))
          (define t (first types))
          (define arg (cond [(eq? t 'eager) (actual-value e env)]
                            [(eq? t 'lazy) (delay-it-no-memo e env)]
                            [(eq? t 'lazy-memo) (delay-it-memo e env)]
                            [else (error "Unknown type -- LIST-OF-ARGS" t)]))
          (cons arg (list-of-args (rest-operands exprs)
                                  (rest types)
                                  env))]))

;; Lastly change my-apply to use list-of-args:

(define (my-apply procedure arguments env)
  (cond [(primitive-procedure? procedure)
         (apply-primitive-procedure
           procedure
           (list-of-arg-values arguments env))]
        [(compound-procedure? procedure)
         (eval-sequence
           (procedure-body procedure)
           (extend-environment
             (procedure-parameters procedure)
             (list-of-args arguments
                           (procedure-types procedure)
                           env)
             (procedure-environment procedure)))]
        [else (error "Unknown procedure type -- APPLY" procedure)]))

;; See "4-2-2-optionally-lazy-repl-program.rkt" for the program with some tests at
;; the end of the file.