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))))