Archive for November 2008
teach scheme, extend source with evals; improvement
Obviously if you have char expressions, such as #\) or #\(, previous code doesn’t work. Improvement:
(define (char-expression? window)
(and (char? (car window))
(char? (cdr window))
(char=? #\\
(car window))
(char=? #\#
(cdr window))))
(define (extend-window c window)
(cons c (car window)))
(define (collect-form input-port)
(letrec ((aux (lambda (ip level seq window)
(let* ((c (read-char input-port))
(new-window (extend-window c window)))
(cond ((and (char=? c #\))
(= level 1)
(not (char-expression? window)))
(reverse (cons c seq)))
((and (char=? c #\()
(not (char-expression? window)))
(aux ip
(+ level 1)
(cons c seq)
new-window))
((and (char=? c #\))
(not (char-expression? window)))
(aux ip
(- level 1)
(cons c seq)
new-window))
(else (aux ip
level
(cons c seq)
new-window)))))))
(let ((c (peek-char input-port)))
(cond ((eof-object? c) '())
((char=? c #\()
(aux input-port 0 '() (cons '() '())))
(else (begin
(read-char input-port)
(collect-form input-port)))))))
This starts to be messy, so I’ll revise it later. Also nasty things can happen when you start using macros in source files : )
teach scheme, extend source with evals
Actually I teach scheme to a student (who is a physicist). Initially I’ve used slideshow from the DrScheme package to generate slides, but this package doesn’t give to much predefined layout. So I switched to my ol’ babe, the Beamer package for LaTeX. I want to write only the source of some scheme code and generate the repl responses (and show it as well after each s-expression). I have these sources as .scm files, I read them and display the output on the standard output. MzScheme doesn’t conform to R5RS in regards of eval. There’s no scheme-report-environment function defined. Anyway my definitions are as follows.
This one goes until the first open paren and reads in a char sequence corresponding to one top level s-expression.
(define (collect-form input-port)
(letrec ((aux (lambda (ip level seq)
(let ((c (read-char input-port)))
(cond ((and (char=? c #\))
(= level 1))
(reverse (cons c seq)))
((char=? c #\()
(aux ip (+ level 1) (cons c seq)))
((char=? c #\))
(aux ip (- level 1) (cons c seq)))
(else (aux ip level (cons c seq))))))))
(let ((c (peek-char input-port)))
(cond ((eof-object? c) '())
((char=? c #\()
(aux input-port 0 '()))
(else (begin
(read-char input-port)
(collect-form input-port)))))))
The next one reads them all as strings from an input port.
(define (read-all-forms ip)
(letrec ((aux (lambda (ip coll)
(let ((form (collect-form ip)))
(if (null? form)
coll
(aux ip (cons (list->string form) coll)))))))
(reverse (aux ip '()))))
This one reads all s-expressions as s-expressions
(define (read-all-sexps ip)
(letrec ((aux (lambda (ip coll)
(let ((c (peek-char ip)))
(cond ((eof-object? c) coll)
((char=? c #\()
(aux ip (cons (read ip) coll)))
(else
(begin
(read-char ip)
(aux ip coll))))))))
(reverse (aux ip '()))))
Finally this gives the desired output.
(define (trafo fn)
(let ((forms (call-with-input-file
fn
(lambda (p)
(read-all-forms p))))
(sexps (call-with-input-file
fn
(lambda (p)
(read-all-sexps p)))))
(let loop ((forms forms) (sexps sexps))
(if (and (null? forms)
(null? sexps))
'()
(begin
(display (car forms))
(newline)
(display "=> ")
(display (eval (car sexps)))
(newline)
(loop (cdr forms) (cdr sexps)))))))
In case you have a .sh file like
afroid-laptop% cat trafo.sh #!/usr/bin/zsh mzscheme -f trafo.scm -e "(begin (trafo \"$1\") (exit))" afroid-laptop%
You can use it as
afroid-laptop% ./trafo.sh test.scm
(define (sum lst)
(if (null? lst)
0
(+ (car lst) (sum (cdr lst)))))
=> #<void>
(sum (list 1 2 3))
=> 6
Future work could be to use mzpp and mztext to do this right with the .tex source in a nicer way.
goto in scheme with call/cc
There are articles about call/cc being the generalization of goto. With goto, one can do unstructured programming. Let’s see the following (unstructured) basic program, and transform it to scheme.
10 I=0 20 PRINT I 30 I=I+1 40 IF I=10 THEN GOTO 60 50 GOTO 20 60 END
To see how call/cc can be used for such purposes please feel free to think about the following snippet
(define thunk-calling-scheme
((call/cc
(lambda (c)
(c (lambda ()
'returning-from-thunk))))))
giving the result of
guile> thunk-calling-scheme returning-from-thunk guile>
With this you can assemble the solution, which is like this:
(define cross-compiled
(lambda ()
(let ((i 0))
((call/cc
(lambda (goto)
(letrec ((L20
(lambda ()
(display i)
(newline)
(set! i (+ i 1))
(if (= i 10)
(goto L60))
(goto L20)))
(L60
(lambda ()
(display "Ok")
(newline))))
(L20))))))))
Can be used as:
guile> (cross-compiled) 0 1 2 3 4 5 6 7 8 9 Ok guile>
non-local exit in scheme with call/cc
(define dot-product
(lambda (l1 l2)
(call/cc
(lambda (probably-the-top-level-continuation)
(let loop ((l1 l1) (l2 l2) (sum 0))
(cond ((and (not (null? l1))
(not (null? l2)))
(loop (cdr l1) (cdr l2) (+ sum (* (car l1) (car l2)))))
((and (null? l1)
(null? l2))
sum)
(else (probably-the-top-level-continuation 'f..k-it))))))))
See previous posts for details.
guile> (dot-product '(1 2) '(-1 5 5)) f..k-it guile> (dot-product '(1 2) '(-1 5)) 9 guile>
What are the pros of this implementation? If you have mostly good parameters, it’s relatively expensive to check the incoming data all the time. This version assumes the data lengths are ok and fails only when it’s necessary.
my understanding of call/cc
Let’s examine the following expression.
(define a
(lambda ()
(+ (+ 3 4) (+ 2 3))))
This is transformed to CPS for example like this:
(define cc-a
(lambda ()
(my-add 2
3
(lambda (result1) ;; continuation of first addition
(my-add 3
4
(lambda (result2)
(my-add result1
result2
(lambda (x) x))))))))
Where my-add is discussed here. Now I’m ready to demonstrate to myself what call/cc can be:
(define my-continuation #f) ;; will contain something like
;; previous (lambda (result1) ...
(define cc-example
(lambda ()
(+ (+ 3 4)
(call/cc
(lambda (continuation)
(set! my-continuation continuation)
(+ 2 3))))))
What do you get if you pass 10 to (lambda (result1) ...? You’ll get 17 instead of 12 right? Let’s have a look:
guile> (my-continuation 10) 17 guile>
Which now makes sense for me.
CPS review of previous post
The my= discussed previously, in real CPS (continuation passing style) is like this:
(define my=
(lambda (a b true false) ;; CPS style signature
(if (= a b) ;; direct body
(true)
(false))))
with this, the revised cc-fib is like
(define cc-fib
(lambda (n after)
(my= n
0
(lambda ()
(after 1))
(lambda ()
(my= n
1
(lambda ()
(after 1))
(lambda ()
(my-dec
n
(lambda (ndec)
(my-dec
ndec
(lambda (nddec)
(cc-fib
nddec
(lambda (nddecf)
(cc-fib
ndec
(lambda (ndecf)
(my-add
nddecf
ndecf
after)))))))))))))))
continuation passing style (yet another example)
; continuation passing style in signatures
; direct bodies
(define my-dec
(lambda (a after)
(after (- a 1))))
(define my=
(lambda (a b after)
(after (= a b))))
(define my-add
(lambda (a b after)
(after (+ a b))))
; fully continuation style fibonacci
; the exponential time complex algorithm
(define cc-fib
(lambda (n after)
(my=
n
0
(lambda (b)
(if b
(after 1)
(my=
n
1
(lambda (b)
(if b
(after 1)
(my-dec
n
(lambda (ndec)
(my-dec
ndec
(lambda (nddec)
(cc-fib
nddec
(lambda (nddecf)
(cc-fib
ndec
(lambda (ndecf)
(my-add
nddecf
ndecf
after)))))))))))))))))
; developing further cc style functions
; on top of previous ones
(define cc-fib-plus2
(lambda (n after)
(cc-fib n
(lambda (fib)
(my-add 2
fib
after)))))
Can be used as
Welcome to DrScheme, version 4.1.1 [3m]. Language: R5RS; memory limit: 128 megabytes. > (cc-fib 5 (lambda (x) x)) 8 > (cc-fib-plus2 5 (lambda (x) x)) 10 >
categorical build systems
At my workplace we have several issues around a build systems for a given project. Everybody just checks out the source and work on it. It compiles, so everything’s fine. There’s no proper clean target/rule. It happens every once in a while that you just make a clean check out and things just stop to work. Hence this post about my effort to formalize expectations.
Let’s put it into category theory. So the category of proper build systems has two objects and several arrows. Some of the arrows are like this:
source control and filesystem - build and clean
There are also arrows representing changes in the source.
Different properties of categories can be explained by saying that a given diagram commutes. These are called commutative diagrams. The meaning is that the taken effect (represented by paths in the graph) depends only on the nodes the path runs between.
So in a category of proper build systems the following diagrams commute:
twice a clean is like one
twice a build is like one
even if I build before I clean should be a single clean
a rebuild should be the same as a clean & build
a clean should leave a clean check out as it is
Also, it follows that
a clean gives me back my clean check out
These rules are too strict but compelling. For me it’s enough if the following commutes:
I can work without cleaning all the time
and again (snus)
As I’ve written to my previous tobacco post, I’ve restarted snus-ing. I ordered four cans of Original Mini Portion by – I was brave – ordinary mail. I used to do it by UPS. It’s quite expensive. Once I’d chosen ordinary mail, was fine. Arrived in three days. Later on I tried it again and arrived in three months. Now I experimenting with this way again. Now this arrived in two days. Good one (one can I ordered). Some sort of new brand.
my little accountant system; my-print ?improvement?
(defun my-print (num)
(multiple-value-bind (i f)
(floor (float (* 0.01
(round num 0.01))))
(format nil
"~12<~:[~*~;~12:D~]~;~>~3<~:[.~*~;~,0$~]~;~>"
(not (= i 0)) i
(or (= i 0)
(not (= f 0))) f)))
