simple-sub in Kernel added by sytse on Thu Aug 6 19:22:24 2020

($define! id ($lambda (x) x))
($define! twice ($lambda (f x) (f (f x))))

($define! object1 ($bindings->environment (x 42) (y id)))
($define! object2 ($bindings->environment (x 17) (y #f)))
($define! pick-an-object
  ($lambda (b)
    ($if b object1 object2)))

($define! produce
  ($lambda (arg)
    ($bindings->environment
      (head arg)
      (tail ($lazy (produce (+ 1 arg)))))))

($define! consume
  ($lambda (strm)
    (+ ($remote-eval head strm)
       (consume (force ($remote-eval tail strm))))))

($define! codata (produce 42))
;; (force res) runs out of stack memory, but the inferencer deduces
;; exact-integer?  Madness!
;; Plus the 'formally valid' result is #e+infinity.
($define! res ($lazy (consume codata)))


;; Definition: this one isn't defined in R⁻¹RK
($define! $bindings->environment
  ($let* ((identity ($lambda (x) x))
          ($quote (unwrap identity))
          ;; R⁻¹RK has $set!, but it is unwieldy for meta-use: naming
          ;; its parameters 'env ptree expr', it evaluates expr but
          ;; not ptree.
          ;;
          ;; Define set! as a version more appropriate for the task at
          ;; hand: '(unwrap set!)' evaluates none, such that 'set!'
          ;; evaluates all.
          (set!
           ($lambda (env name value)
             ;; $set! works fine with its first argument not a symbol,
             ;; but an environment: those self-evaluate.
             ($let ((set-expr (list $set! env name (list $quote value))))
               (eval set-expr env)))))

    ($vau bindings denv
      ($let ((new-env (make-environment)))
        (for-each ($lambda ((name expr))
                    (set! new-env name (eval expr denv)))
                  bindings)
        new-env))))