Chez Scheme allocation: --program vs --script - scheme

Consider this bit of Chez Scheme code:
(import (chezscheme))
(define (list-enumerate ls val proc)
(let loop ((ls ls) (return? #f) (val val))
(if (or (null? ls)
return?)
val
(call-with-values (lambda () (proc val (car ls)))
(lambda (return? val)
(loop (cdr ls) return? val))))))
(define (list-index ls proc)
(list-enumerate ls
0
(lambda (i elt)
(if (proc elt)
(values #t i)
(values #f (+ i 1))))))
(define n 100000)
(define data (iota n))
(time (list-index data (lambda (elt) (= elt (- n 1)))))
Run it:
~ $ scheme --script ~/scratch/_list-enumerate-allocation-test-chez-a.sps
(time (list-index data ...))
no collections
3 ms elapsed cpu time
4 ms elapsed real time
8 bytes allocated
Wow, it reports that only 8 bytes were allocated.
Let's run it again using the --program option instead of --script:
~ $ scheme --program ~/scratch/_list-enumerate-allocation-test-chez-a.sps
(time (list-index data ...))
no collections
3 ms elapsed cpu time
3 ms elapsed real time
800000 bytes allocated
Yikes, 800000 bytes allocated.
What's up with the difference?
Ed

Here's a note from Kent Dybvig in response:
That's an interesting question.
When run with --script, which uses the REPL semantics, the variables
defined in the script, like list-enumerate and list-index, are mutable,
which inhibits interprocedural optimizations, including inlining. When
run with --program, however, the variables are immutable, which allows
interprocedural optimizations.
In this case, --program allows the compiler to inline list-enumerate into
list-index's body and in turn the lambda expression within list-index's
body into list-enumerate's body. The end result is a conditional
expression within the call-with-values producer expression. This causes
the compiler to create a closure for the consumer, to avoid code
duplication along the then and else branches of the conditional. This
closure is created each time through list-enumerate's loop, resulting in
the extra allocation overhead. That's the way optimizations often go.
Mostly you win, but sometimes you lose. The good news is, on balance, the
benefits outweight he costs, even in your program. I put the call to
list-index in a loop (the modified code is below) and found that that with
--program, the code runs about 30% faster.
Kent
(import (chezscheme))
(define (list-enumerate ls val proc)
(let loop ((ls ls) (return? #f) (val val))
(if (or (null? ls)
return?)
val
(call-with-values (lambda () (proc val (car ls)))
(lambda (return? val)
(loop (cdr ls) return? val))))))
(define (list-index ls proc)
(list-enumerate ls
0
(lambda (i elt)
(if (proc elt)
(values #t i)
(values #f (+ i 1))))))
(define n 100000)
(define data (time (iota n)))
(let ()
(define runalot
(lambda (i thunk)
(let loop ([i i])
(let ([x (thunk)])
(if (fx= i 1)
x
(loop (fx- i 1)))))))
(time
(runalot 1000
(lambda ()
(list-index data (lambda (elt) (= elt (- n 1))))))))

Related

Why might the Scheme `filter` form not process list elements 'in order'?

(filter procedure list) applies procedure to each element of list
and returns a new list containing only the elements for which procedure
returns true.
(R. Kent Dybvig The Scheme Programming Language)
(online)
What may not be apparent from this description is that, while the elements in the returned
list occur in the same order as in list, the order of calls of procedure is not
specified in R6RS. (Racket, however, applies the procedure "to each element from first to last")
A recently active answer
mentions that it requires a filterfunc which works over its argument list
in order. How should one write this function?
An answer with my explanation of the issue is supplied.
What order might a Scheme implementation use, and why? Let's try it (all code run in Chez Scheme REPL):
Display order of applications
> (filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
452301(0 2 4)
>
Why this order?
R6RS implementations must check that list is a proper list
ends with the empty list:
> (filter (lambda (x) (display x) (even? x))
'(0 1 2 . 3)))
Exception in filter: (0 1 2 . 3) is not a proper list
>
no circularity:
> (define xs '(0 1 2 3))
> (set-cdr! (cdddr xs) (cdr xs))
> (filter (lambda (x) (display x) (even? x)) xs)
Exception in filter: (0 1 2 3 1 2 ...) is not a proper list
>
the implementation of filter in Chez Scheme which checks these requirements
while filtering, resulting in the "452301" order of predicate applications,
can be seen here
(lines 589-617: a version is included as a spoiler below as an alternative to scrolling through
the source on github)
What?
The Chez Scheme code uses a "tortoise and hare" algorithm
to detect cycles. Without error checks the code could be:
> (let ([filter
(lambda (pred? ls)
(let f ([fast ls])
(if (pair? fast)
(let ([rest (f (cdr fast))])
(if (pred? (car fast))
(cons (car fast) rest)
rest))
'())))])
(filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
543210(0 2 4)
>
(the identifier fast is used to match the Chez Scheme code: could be ls otherwise)
How can one change this to call pred? "from first to last"?
replace the rest variable with an accumulator (compare the following with 3 above;
the changes are small, but filtered elements are consed to acc,
so it has to be reversed to give the result):
> (let ([filter
(lambda (pred? ls)
(let f ([fast ls] [acc '()])
(if (pair? fast)
(f (cdr fast)
(if (pred? (car fast))
(cons (car fast) acc)
acc))
(reverse acc))))])
(filter (lambda (x) (display x) (even? x))
'(0 1 2 3 4 5)))
012345(0 2 4)
>
So 4 could be used as the required filterfunc. It would be an interesting exercise
to add error checks like the Chez Scheme implementation, which is effectively:
(define (filter pred? ls)
(unless (procedure? pred?)
(error #f "not a procedure" pred?))
(or (let f ((pred? pred?) (fast ls) (slow ls))
(if (pair? fast)
(let ((fast1 (cdr fast)))
(if (pair? fast1)
(and (not (eq? fast1 slow))
(let ((fast2 (cdr fast1)))
(let ((rest (f pred? fast2 (cdr slow))))
(and rest
(if (pred? (car fast))
(if (pred? (car fast1))
(if (eq? rest fast2)
fast
(list* (car fast)
(car fast1) rest))
(cons (car fast) rest))
(if (pred? (car fast1))
(if (eq? rest fast2)
fast1
(cons (car fast1) rest))
rest))))))
(and (null? fast1)
(if (pred? (car fast))
fast
'()))))
(and (null? fast) '())))
(error #f "circular/improper list" ls)))
It involves you should not use mutation of some external variable inside procedure and it supposes the implementation may apply parallelism, for example map-reduce.

Improving an iterative function in scheme

I often struggle writing iterative functions in scheme: it makes writing recursive procedures much simpler. Here is an example of trying to square items in a list using an iterative procedure:
(define square (lambda (x) (* x x)))
(define (square-list items)
(define result nil) ; set result
(define (iter items-remaining)
(if (null? items-remaining)
result
(set! result (cons (car items-remaining) (iter (cdr items-remaining))))))
(iter items))
(square-list '(1 2 3 4 5))
; (4 9 16 25)
My main question about this is:
Is there a way to do this procedure without having to first define the result before the inner procedure? I was trying to make the iterative procedure have the function prototype of define (iter items-remaining answer) but was having a hard time implementing it that way.
And if not, why isn't that possible?
The posted code does not work; but even when fixed up so that it does work, this would not be an idiomatic Scheme solution.
To make the posted code work:
nil must be replaced with '(), since Scheme does not represent the empty list with nil
square must be called on the car of items-remaining
set! should modify result by adding squared numbers to it, not by trying to add the result of a recursive call. This won't work at all here because set! returns unspecified values; but even if it did work, this would not be tail-recursive (i.e., this would not be an iterative process)
The value of result must be returned, and it will have to be reversed first since result is really an accumulator
Here is a fixed-up version:
(define (square-list-0 items)
(define result '()) ; set result
(define (iter items-remaining)
(cond ((null? items-remaining)
result)
(else
(set! result (cons (square (car items-remaining))
result))
(iter (cdr items-remaining)))))
(iter items)
(reverse result))
A better solution would not use mutation, and would not need (define result '()):
(define (square-list-1 xs)
(define (iter xs acc)
(if (null? xs)
(reverse acc)
(iter (cdr xs) (cons (square (car xs)) acc))))
(iter xs '()))
Here an accumulator, acc, is added to the lambda list for the iter procedure. As results are calculated, they are consed onto acc, which means that at the end of this process the first number in acc is based on the last number in xs. So, the accumulator is reversed before it is returned.
Another way to do this, and probably a more idiomatic solution, is to use a named let:
(define (square-list-2 xs)
(let iter ((xs xs)
(acc '()))
(if (null? xs)
(reverse acc)
(iter (cdr xs) (cons (square (car xs)) acc)))))
This is a bit more concise, and it lets you bind arguments to their parameters right at the beginning of the definition of the iter procedure.
All three of the above solutions define iterative processes, and all three give the same results:
> (square-list-0 '(1 2 3 4 5))
(1 4 9 16 25)
> (square-list-1 '(1 2 3 4 5))
(1 4 9 16 25)
> (square-list-2 '(1 2 3 4 5))
(1 4 9 16 25)
Of course, you could just use map:
> (map square '(1 2 3 4 5))
(1 4 9 16 25)

Building accumulator for lazy lists in Racket

I defined a simple lazy list of all integers from zero:
(define integers-from
(lambda (n)
(cons n
(lambda () (integers-from (+ 1 n))))))
(define lz (integers-from 0))
I also coded an accumaltor that gets a lazy list as a parameter
(define lz-lst-accumulate
(lambda (op initial lz)
(if (null? lz)
initial
(cons (op (head lz) initial)
(lambda () (lz-lst-accumulate op (op initial (head lz)) (tail lz)))))))
Does this accumaltor answer the format of lazy lists?
Here is a simple test of the accumulator:
(define acc (lz-lst-accumulate * 1 lz))
(take acc 4)
=> '(1 2 6 24)
take is a helper function that creates a list from the first n elements of a lazy list:
(define head car)
(define tail
(lambda (lz-lst)
((cdr lz-lst)) ))
(define take
(lambda (lz-lst n)
(if (= n 0)
(list)
(cons (car lz-lst)
(take (tail lz-lst) (sub1 n)))) ))
In your lz-lst-accumulate you calculate once (op (head lz) initial) and then also (op initial (head lz)). This is inconsistent; both should be the same and actually calculated only once, since it's the same value:
(define lz-lst-accumulate
(lambda (op initial lz)
(if (lz-lst-empty? lz)
initial
(let ((val (op (head lz) initial)))
(cons val
(lambda () (lz-lst-accumulate op val (tail lz))))))))
It works in your example with numbers only because you use the type-symmetrical operation *. With cons it wouldn't work.
Other than that it's OK. lz-lst-accumulate is usually known as left fold (scanl in Haskell, actually, since you produce the progression of "accumulated" values, foldl f z xs = last (scanl f z xs)).
re: your version of take, it is forcing one too many elements of a stream. Better make it
(define take
(lambda (lz n)
(if (or (<= n 0) (lz-lst-empty? lz))
(list)
(if (= n 1)
(list (car lz)) ; already forced
(cons (car lz)
(take (tail lz) (sub1 n)))))))
so that it only forces as many elements as it has to produce, and not one more (which might be e.g. divergent, like (/ 1 0), invalidating the whole calculation for no reason).
That way, the counter-example in SRFI 41 (of (take 4 (stream-map 1/ (ints-from-by 4 -1)))) will just work (it calculates (1/4 1/3 1/2 1/1) without forcing 1/0, which the usual version of take, like the one you're using, would do).

How is the sicp cons-stream implemented?

I'm working through the streams section of the scip and am stuck on how to define a stream.
The following is my code:
(define (memo-func function)
(let ((already-run? false)
(result false))
(lambda ()
(if (not already-run?)
(begin (set! result (function))
(set! already-run? true)
result)
result))))
(define (delay exp)
(memo-func (lambda () exp)))
(define (force function)
(function))
(define the-empty-stream '())
(define (stream-null? stream) (null? stream))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (cons-stream a b) (cons a (memo-func (lambda () b))))
If I define integers the way that the book descibes:
(define (integers-starting-from n)
(cons-stream n (integers-starting-from (+ n 1))))
(define integers (integers-starting-from 1))
I get a message saying: Aborting!: maximum recursion depth exceeded.
I'm guessing that the delay function is not working but I don't know how to fix it. I am running the MIT scheme on my Mac.
update 1
So now with cons-stream as a macro, the integers can be defined.
But then I've got another error.
(define (stream-take n s)
(cond ((or (stream-null? s)
(= n 0)) the-empty-stream)
(else (cons-stream (stream-car s)
(stream-take (- n 1) (stream-cdr s))))))
(stream-take 10 integers)
;ERROR - Variable reference to a syntactic keyword: cons-stream
update 2
Please ignore update 1 above
cons-stream needs to be a macro in order for your sample code to work correctly. Otherwise the invocation of cons-stream will evaluate all its arguments eagerly.
Try this (not tested):
(define-syntax cons-stream
(syntax-rules ()
((cons-stream a b)
(cons a (memo-func (lambda () b))))))
P.S. Your delay needs to be a macro also, for similar reasons. Then after you fix delay, you can make your cons-stream use delay directly.
You cannot define delay as a function, since prior to calling it, Scheme will evaluate its argument - which is exactly what you're trying to postpone. SICP says this explicitly that delay should be a special form.

programmatic way to stop a function after certain time and debug enclosed variables

A long-run function like infinite loop:
> (define appendInf
(lambda (lst)
(appendInf (cons 1 lst)))
In Chez Scheme, make-engine can achieve the stopping after ticks:
> (define eng
(make-engine
(lambda ()
(appendInf '()))))
While of course with the scope of lst I get error when:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
Exception: variable lst is not bound
If I want to get the value 'lst' in appendInf when the time limit is reached, I use set!:
> (define lst '())
> (define appendInf
(lambda (ls)
(set! lst (cons 1 ls))
(appendInf lst)))
now I can get:
> (eng 50
list
(lambda (new-eng)
(set! eng new-eng)
(length lst)))
8
So for every variable within the function I want to trace, a global variable needs to be added, and one more transforming by adding (set!…).
is this a correct way to handle any enclosed variables?
if yes to 1, in Scheme is there a better way to achieve this?
is there any programming language that can more easily
implement this kind of debugging?
Well. I'm using racket and it has a pretty good debugger and does standard r6rs as well as non-standard racket.
;; macro to do the heavy work
(define-syntax recdb
(syntax-rules ()
((_ thunk fun a1 ...)
(let ((orig-fun fun)(ethunk thunk))
(fluid-let ((fun (lambda args
(if (ethunk)
(apply orig-fun args) ;; set breakpoint on this
(apply orig-fun args)))))
(fun a1 ...))))))
;; a time-thunk generator
(define (period-sec sec)
(let ((time-done (+ sec (current-seconds))))
(lambda ()
(if (< time-done (current-seconds))
(begin
(set! time-done (+ sec (current-seconds)))
#t)
#f))))
;; a round-thunk generator
(define (rounds n)
(let ((rounds-to-go n))
(lambda ()
(if (zero? rounds-to-go)
(begin
(set! rounds-to-go (- n 1))
#t)
(begin
(set! rounds-to-go (- rounds-to-go 1))
#f)))))
;; my never ending procedure
(define (always n)
(always (+ n 1)))
;; one of the ones below to implement
(recdb (rounds 10) always 0))
(recdb (period-sec 1) always 0)
;; functions with auxillary procedures need to have their gut changed for it to work
(define (fib n)
(define (fib-aux n a b)
(if (= n 0)
a
(fib-aux (- n 1) b (+ a b))))
(recdb (period-sec 2) fib-aux n 0 1))
;; trying it
(fib 200000)
Now. Just run the debugger and set breakpoint (right click expression in the macro and choose "Pause at this point") where it's indicated in the code and you have a way to examine the variables every x seconds or x times.
Happy debugging :)

Resources