Archive for the ‘Scheme’ Category

One of the problems given to solve in HTDP was to write a program that solved the 8 queens problem, that is, to place 8 queens on a standard chess board so that none of them are attacking each other. I quite enjoyed working through this, and came up with something that used a straight size 64 scheme vector to represent the board which I thought would be reasonably efficient.

First of all, as encouraged by HTDP, there were the functions to manipulate and display the board:

(define-struct board (squares size))

(define (display-board b) …)

(define (coord->index x y n) …)
(define (board-ref b x y) …)

;; Constructors
(define (build-board n f) …)
(define (empty-board n) …)

and then the methods suggested within the book to solve the problem.

I’ve attached the code at the end along with fairly naive translations into Ocaml and C++.

The surprising thing to me though is that vast differences in speed. The Ocaml runs around 15 times faster than the scheme, and the C++ runs around 20 times faster than the Ocaml. Now, to some people, this might suggest that C++ is much faster than Ocaml which in turn is much faster than PLT Scheme. However, the wealth of information around on the net leads me to believe that this is not true. I therefore conclude that I am not very good at writing efficient scheme or efficient Ocaml.

I can see that there are minor algorithmic differences between the code. In particular, the C++ uses out-of-bound data rather than a Some / None type as in the Ocaml. Additionally, the C++ uses simple machine integers to represent the square types. It is difficult to believe that this accounts for the difference though, in which case, what am I doing wrong?

$ time mzscheme -qu queens.ss
cpu time: 1235 real time: 1281 gc time: 453
51886 recursive calls to (placements …)
mzscheme -qu queens.ss 0.00s user 0.00s system 0% cpu 1.468 total

$ ocamlopt -noassert -unsafe -ccopt -O3 -ccopt -fomit-frame-pointer q.ml -o q.exe
$ time ./q.exe
./q.exe 0.00s user 0.00s system 0% cpu 1.000 total

$ time ./a.exe 8 1000 | grep -v Qu
./a.exe 8 1000 0.00s user 0.00s system 0% cpu 4.938 total

mzscheme code

(module queens mzscheme

  (require (lib "42.ss" "srfi"))

  (define-struct board (squares size))

  ;; 28.2.1

  (define (display-board b)
    (printf "~n")
    (let ((s (board-squares b))
          (n (board-size b)))
      (do-ec (: y n)
             (: x n)
               (display (if (= x 0) "(" " "))
               (display (vector-ref s (coord->index x y n)))
               (when (= x 7) (printf ")~n"))))))

  ;; 28.2.2

  (define (coord->index x y n) (+ (* y n) x))

  (define (board-ref b x y)
    (vector-ref (board-squares b) (coord->index x y (board-size b))))

  (define (build-board n f)
    (let ((size (* n n)))
       (vector-of-length-ec size
                            (:range i size)
                            (f (remainder i n) (quotient i n)))

  (define (empty-board n)
    (build-board n (lambda (x y) #f)))

  ;; 28.2.3

  (define-struct posn (x y))

  (define (threatened? queen square)
    (let ((x1 (posn-x queen))
          (y1 (posn-y queen))
          (x2 (posn-x square))
          (y2 (posn-y square)))
      (or (= x1 x2)
          (= y1 y2)
          (= (- x2 x1) (- y2 y1))
          (= (- x1 y2) (- x2 y1)))))

  ;; 28.2.4

  (define init-pos (make-posn 0 0))

  (define (add-queen board p)
    (let ((s (board-size board))
          (qx (posn-x p))
          (qy (posn-y p)))
      (build-board s (lambda (x y)
                       (let ((c (board-ref board x y)))
                         (cond ((and (= x qx) (= y qy)) 'Qu)
                               (c c)
                               ((threatened? p (make-posn x y)) 'At)
                               (else #f)))))))

  (define (invalid-posn? board p)
    (not (eq? (board-ref board (posn-x p) (posn-y p)) #f)))

  (define (next-valid-posn board p)
    (let ((s (board-size board)))
      (let loop ((x (+ 1 (posn-x p)))
                 (y (posn-y p)))
        (cond ((>= x s) (loop 0 (+ y 1)))
              ((>= y s) #f)
              (else (let ((new-p (make-posn x y)))
                      (if (invalid-posn? board new-p)
                          (loop (+ x 1) y)

  (define (display-posn p)
    (if (posn? p)
        (printf "(~a, ~a)~n" (posn-x p) (posn-y p))
        (printf "Not posn~n")))

  (define *count-placements* 0)

  (define (placement board p rem)
    (set! *count-placements* (+ *count-placements* 1))
    (cond ((= rem 0) board)
          ((not p) #f)
          ((invalid-posn? board p) (placement board (next-valid-posn board p) rem))
          (else (let loop ((cur-pos p))
                  (if (not cur-pos) #f
                      (let ((possible-board (placement (add-queen board cur-pos) init-pos (- rem 1))))
                        (if possible-board possible-board
                            (loop (next-valid-posn board cur-pos)))))))))

  (define (solve-for-queens n)
    (set! *count-placements* 0)
    (time (display-board (placement (empty-board n) init-pos n)))
    (printf "~a recursive calls to (placements ...)~n"

  (solve-for-queens 8 )

  (provide (all-defined)))

;; (require "queens.ss")

Ocaml code

type square = Queen | Safe | Attacked;;
type posn = Posn of int * int;;
type board = Board of square array * int;;

let string_of_square = function
  | Queen -> "Qu"
  | Safe -> "#f"
  | Attacked -> "At";;

let index_of_coord x y n = (y*n) + x;;

let coord_of_index i n =
  let y = i / n in (i - y*n, y);;

let board_ref b x y =
  match b with
      Board (squares, size) -> Array.get squares (index_of_coord x y size);;

let print_board board =
  match board with
      None -> print_string "Nonen"
    | Some (Board (_, s) as b) ->
	let b_x = (s - 1) in
	let rec loop x y =
	  if y >= s then ()
	  else if x >= s then loop 0 (y+1)
	  else begin
	    print_string (if x = 0 then "(" else " ");
	    let i = index_of_coord x y s in
	      print_string (string_of_square (board_ref b x y));
	      if x = b_x then print_string ")n";
	      loop (x+1) y
	in loop 0 0;;

let build_board n f =
  Board (Array.init (n * n) f, n);;

let empty_board n =
  build_board n (fun i -> Safe);;

let is_threatened queen square =
  match queen, square with
      (x1, y1), (x2, y2) ->
	x1 == x2 ||
	  y1 == y2 ||
	  (x2 - x1) == (y2 - y1) ||
	  (x1 - y2) == (x2 - y1);;

let add_queen board p =
  match board, p with
      Board (squares, size), (qx, qy)
	-> build_board size (fun i ->
			       let c, qi = (Array.get squares i), index_of_coord qx qy size in
				 if i == qi then Queen
				 else if c != Safe then c
				 else if (is_threatened p (coord_of_index i size)) then Attacked
				 else Safe);;

let is_invalid_posn board p =
  match p with
      None -> true
    | Some (Posn (x, y) as posn) -> board_ref board x y != Safe;;

let next_valid_posn board p =
  match board, p with
      _, None -> None
    | Board (_, size), Some (Posn (x, y)) ->
	let rec loop x y =
	  if x >= size then loop 0 (y+1)
	  else if y >= size then None
	  else let new_posn = Posn (x, y) in
	    if is_invalid_posn board (Some new_posn) then loop (x+1) y
	    else Some new_posn
	in loop (x+1) y;;

let valid_board b =
  match b with
      Some (Board (_, _)) -> true
    | _ -> false;;

let init_pos = Some (Posn (0,0));;

let rec placement board posn rem =
  match board, posn with
      None, _ -> None
    | _, None -> None
    | Some (Board (squares, size) as b), Some (Posn (x, y) as p) ->
	if rem = 0 then board
	else if is_invalid_posn b posn then placement board (next_valid_posn b posn) rem
	else let rec loop curpos =
	  match curpos with
	      None -> None
	    | Some (Posn (x, y)) ->
		let possible_board = (placement
					(Some (add_queen b (x, y)))
					(rem - 1)) in
		  if valid_board possible_board then possible_board
		  else loop (next_valid_posn b curpos)
	in loop posn;;

let do_times f n =
  Printf.printf "n==%dn" n;
  let rec loop n =
    f ();
    if n != 1 then loop (n - 1)
  in loop n;;

let solve_queens n =
  (placement (Some (empty_board n)) init_pos n);;

do_times (fun () -> (solve_queens 8 )) 10;;

print_board (solve_queens 8 );;

C++ code

#include <vector>
#include <string>
#include <iostream>

using namespace std;

namespace Status {
    static const int Qu      = 0;
    static const int Safe    = 1;
    static const int At      = 2;
    static const int Invalid = 3;

    static string mapping[] = { "Qu", "#f", "At", "I" };
    string string_of_square(int i) { return mapping[i]; }

using namespace Status;

typedef std::vector<int> Squares;

struct Posn
    int x_;
    int y_;

    Posn(int x, int y) : x_(x), y_(y) { }
    bool is_invalid() const { return (x_ < 0) && (y_ < 0); }

const Posn init_pos(0, 0);

class Board
    Squares squares_;
    int size_;

    int index_of_coord(int x, int y) const { return y * size_ + x; }

    Board(int size) : squares_((size * size), Safe), size_(size) { }
    int ref(int x, int y) const { return squares_[index_of_coord(x, y)]; }
    int ref(const Posn& p) const { return ref(p.x_, p.y_); }

    void display() const {
        for (int y = 0; y < size_; ++y) {
            for (int x = 0; x < size_; ++x) {
                cout << ((x == 0) ? "(" : " ");
                cout << string_of_square(ref(x, y));
            cout << ")n";

    template<typename T>
    static Board build_board(int size, T f) {
        Board b(size);
        for (int y = 0; y < size; ++y) {
            for (int x = 0; x < size; ++x) {
                b.squares_[b.index_of_coord(x, y)] = f(x, y);

        return b;

    Board add_queen(const Posn& p) const;

    Posn next_valid_posn(const Posn& p) const {
        for (int y = p.y_; y < size_; y++) {
            for (int x = p.x_ + 1; x < size_; x++) {
                if (ref(x, y) == Safe) { return Posn(x, y); }

        return Posn(-1, -1);

    static Board invalid_board() {
        static Board b(1);
        b.squares_[0] = Invalid;
        return b;

    bool is_invalid() const { return squares_[0] == Invalid; }

    static Board placement(const Board& b, const Posn& p, int rem) {
        if (b.is_invalid()) { return b; }
        else if (p.is_invalid()) { return invalid_board(); }
        else if (rem == 0) { return b; }
        else if (b.ref(p) != Safe) {
            return placement(b, b.next_valid_posn(p), rem);
        } else {
            Posn curpos = p;
            while (! curpos.is_invalid()) {
                Board b1 = placement(b.add_queen(curpos), init_pos, rem - 1);

                if (b1.is_invalid()) {
                    curpos = b.next_valid_posn(curpos);
                } else {
                    return b1;
            return invalid_board();

bool is_threatened(int x1, int y1, int x2, int y2)
    return x1 == x2 ||
        y1 == y2 ||
        (x2 - x1) == (y2 - y1) ||
        (x1 - y2) == (x2 - y1);

class add_queen_fobj
    add_queen_fobj(const Board& b, const Posn& p) : b_(b), p_(p) { }

    int operator()(int x2, int y2) {
        int c = b_.ref(x2, y2);
        int x1 = p_.x_;
        int y1 = p_.y_;

        if ((x1 == x2) && (y1 == y2)) { return Qu; }
        else if (c != Safe) { return c; }
        else if (is_threatened(x1, y1, x2, y2)) { return At; }
        else { return Safe; }

    const Board& b_;
    const Posn& p_;

Board Board::add_queen(const Posn& p) const {
    return build_board(size_, add_queen_fobj(*this, p));

void usage(const char* prog)
    cout << "usage: " << prog << " [size] [times]n";

int main(int argc, char* argv[])
    if (argc != 3) { usage(argv[0]); }
    int size = atoi(argv[1]);
    int times = atoi(argv[2]);

    Board b(size);
    Board result(1);
    for (int i = 0; i < times; ++i) {
        result = Board::placement(b, init_pos, 8 );


Read Full Post »

Pattern matching in scheme

I’ve been looking for an excuse for familiarising myself with PLT scheme’s pattern matching library for a while. Finally, I came across an article about implementing a basic Computer Algebra System. The Ocaml source code can be found here. Using the pattern matching library it can be fairly mechanically translated into scheme.

(require (lib "match.ss"))

(define-struct plus (e1 e2))
(define-struct times (e1 e2))
(define-struct divide (e1 e2))

(define MP make-plus)
(define MT make-times)
(define MD make-divide)

(define simplify
   (($ times a ($ plus b c)) (MP (simplify (MT a b)) (simplify (MT a c))))
   (($ divide ($ divide a b) ($ divide c d)) (MD (simplify (MT a d))
                                                 (simplify (MT b c))))
   (e e)))

(define expr->list
   (($ times a b) (list (expr->list a) '* (expr->list b)))
   (($ plus a b) (list (expr->list a) '+ (expr->list b)))
   (($ divide a b) (list (expr->list a) '/ (expr->list b)))
   (e e)))

(define expr (make-times 'x (make-plus 'y 'z)))

(printf "orig: ~a~n" (expr->list expr))
(printf "new: ~a~n" (expr->list (simplify expr)))

(let ((e (MD (MD 'a 'b) (MD 'c 'd))))
  (printf "div: ~a -> ~a~n" (expr->list e) (expr->list (simplify e))))

If I had come across this post a few weeks ago, I probably wouldn’t have even considered the implementation using define-struct. HTDP has certainly improved the way I think about coding scheme now and indeed several of the exercises in the book involve constructing various scheme evaluators that embed a simple CAS like the one above.

The article concludes with the following quote:

“…as you can see, Ocaml’s variant types and pattern matching are a perfect fit for the problems a programmer writing a CAS would face. In fact, few other languages, with the possible exception of Haskell, would have fit this problem as well.”

It seems that with the appropriate extensions, scheme can be a good fit for this type of problem too.

Read Full Post »

Learning to program functionally

A major problem I’ve found with learning scheme in isolation is that it is quite easy to pick up the syntax and then start programming in with a heavy C++ accent. Although this demonstrates the flexibility of scheme, it is not what I’m really after. The question is, how to learn to write in a good style. I can think of a number of possibilities:

  1. Keep writing programs in scheme and hope my style will improve
  2. Read books that specifically teach good scheme style
  3. Read real world code written in scheme

I’ve been inspired to work through some of the exercises in HTDP from various posts I’ve read on Lambda the Ultimate. So far, the book advises a similar approach to designing programs as I have seen before: decide on your data structures before writing the code and define the data structures using (define-struct …). I’ve found it a useful exercise to write functions that convert the data structures into lists that could be evaluated to re-create the original data. Here is an example, more or less from chapter 17.

(define-struct expr (op a1 a2))
(define-struct f-app (name expr))
(define-struct fn (name arg body))

(define f (make-fn 'f 'x (make-expr '+ 3 'x)))
(define i (make-fn 'i 'v (make-expr '+ (make-expr '* 'v 'v) (make-expr '* 'v 'v))))

;;; Convert expressions to lists

(define (add-quote s)
  (string->symbol (string-append "'" (symbol->string s))))

(define (expr->list e)
  (cond ((expr? e) (list 'make-expr
                         (add-quote (expr-op e))
                         (expr->list (expr-a1 e))
                         (expr->list (expr-a2 e))))
        ((f-app? e) (list 'make-f-app
                          (add-quote (f-app-name e))
                          (expr->list (f-app-expr e))))
        ((symbol? e) (add-quote e))
        ((number? e) e)
        (else (raise (format "Error: invalid type ~a" e)))))

(define (fn->list f)
  (list 'make-fn
        (add-quote (fn-name f))
        (add-quote (fn-arg f))
        (expr->list (fn-body f))))

(for-each (lambda (x) (display (format "~a~%" (fn->list x))))
          (list f i))

Read Full Post »

Data Structures in (Mz)Scheme

I sometimes forget how useful the STL is in C++. It provides a good range of data structures that fit the majority of my programming needs. One that I use very frequently is map<T>. Map provides a nice ordered collection which I can insert an element into and delete an element from, in order log(N) time where N is the number of elements. Out of the box, neither Perl, nor R5RS scheme give me the same structure. I’m sure it is available from CPAN for Perl and there are countless examples of implementing similar structures on top of scheme’s wonderful heterogenous trees. However, I’m far to lazy to write my own code that is at such a low level so it was very nice to find the galore library of data structures by Jens Axel Søgaard.

I was curious to do some comparisons in performance between C++ and scheme here so I quickly coded up some tests to insert a million elements into a leftist heap compared to inserting a million elements into a map. Admittedly that isn’t an apples to apples comparison but that isn’t much of a consideration for me!

The C++ code was nice and concise:

#include <map>
#include <string>
#include <iostream>

using namespace std;

string s()
    char buffer[6];

    for (int i = 0; i < 5; ++i) {
        buffer[i] = static_cast<char>((rand() % 26) + 97);
    buffer[5] = 0;

    return string(buffer);

int main()
    cout << s() << endl;
    map<string, int> m;
    for(int i = 0; i < 1000000; ++i) {
        m[s()] = 1;

The scheme was a bit longer but I had tried to do it a different way and I think it is quite elegant too:

(module test-heap mzscheme

  (require (prefix s: (lib "67.ss" "srfi")))
  (require (prefix s: (lib "69.ss" "srfi")))

  (require (prefix heap: "heap.ss"))

  (define (print-ln . args)
    (for-each display args)

  (define compare-fn s:string-compare)

  (define (random-string len)
     (let loop ((i len) (l '()))
       (if (= i 0) l
           (loop (- i 1)
                 (cons (integer->char
                        (+ (random 26) 97)) l))))))

  (define random-string-gen-reset! #f)

  (define random-string-gen
    (let ((max-strings 1000))
      (set! random-string-gen-reset!
            (lambda (max) (set! max-strings max)))
      (lambda (len)
        (if (= max-strings 0) #f
              (set! max-strings (- max-strings 1))
              (random-string len))))))

  (define (populate-heap n)
    (random-string-gen-reset! n)
    (let loop ((h (heap:empty compare-fn))
               (s (random-string 5)))
      (if s (loop (heap:insert s h) (random-string-gen 5)) h)))

  (define (test:performance)
     (random-seed 17)
     (print-ln "Starting...")
     (print-ln (heap:find-min (populate-heap 1000000)))
     (print-ln "Finished!")))

  (provide (all-defined)))

;; (require test-heap)
;; (test:performance)

I always put a couple of lines at the bottom of my scheme modules that are commented out so that I can execute them within emacs and find out if the whole module works. Does anyone else do this?

Initially when testing I benchmarked the C++ at a bit more than 7 seconds and the scheme at around 21 seconds which I thought was pretty good. However, now I come back to it the scheme is taking closer to a minute which I suspect means that somehow it isn’t triggering the new JIT compiler for the 350 series.

Read Full Post »

Portable Scheme

One thing about moving from one scheme implementation to another is that useful functions that were available in the old one are not available or work differently to the new one. For example, in chicken:

(let ((n 1))
  (print "n is [" n "]"))


n is [1]

In mzscheme it prints

print: expects 1 to 2 arguments, given 3: "n is [" 1 "]"

The obvious solution to this is to write a function that performs the appropriate action on all schemes. This can be a simple wrapper on a scheme that provides the function natively. I’ve had to do this before when writing software in C++ that needed to be portable between different OSes but I somehow didn’t expect it with scheme. Probably my experience with the single implementation language, Perl has spoiled me here. Anyway, despite the fact that I haven’t written much scheme, I’m starting to build a small library with these little utility functions. As long as I code to the library, it should make my scheme easier to port to different versions.

(define (chop line)
  (substring line 0 (- (string-length line) 1)))

(define (print-ln . args)
  (for-each display args)

(define (read-lines-from-port p)
  (let ((lines '()))
    (let while ()
      (let ((line (read-line p)))
        (unless (eof-object? line)
          (set! lines (cons line lines))
    (reverse lines)))

(define (read-lines file)
  (let* ((p (open-input-file file))
         (lines (read-lines-from-port p)))
    (close-input-port p)

The next thing to do, is to work out how to put this in a probably mzscheme module so I can simply require it from my scripts. I can’t imagine it will be too difficult.

Read Full Post »

Switching scheme implementations

I’ve had a good run with chicken, but it is time to admit it is not quite ready for my needs. On paper it looks pretty good – there are plenty of libraries, a nice and responsive little community and it runs on Windows and is fairly easy to compile to C. So where is it letting me down?

  • I can’t get some of the libraries to work properly on Windows including
    at least the full numeric tower and srfi-19 (date/time handling).
  • Also on Windows, it doesn’t run properly as an inferior-lisp within
    emacs. I was trying to do some testing of the threading libraries and
    unfortunately it didn’t return the responses asynchronously.
  • It still doesn’t handle white space within pathnames correctly which is
    a problem if, for example, you want to run a binary that lives in
    C:\Program Files.

All of these issues are down to the fact that none of the developers use Windows. Given sufficient time I might be able to fix them, but I guess I’m do not have enough motivation. Anyway, c’est la vie. It is a very nicely done project and I’m very impressed with Felix and co for putting it together, it simply doesn’t suit me.

So what next? I’m quite invested in scheme – I’ve put a fair amount of effort into learning the basics and I enjoy using it. Is there a free scheme implementation that will do what I need on Windows? I think there might be.

Mzscheme is another fairly complete scheme from the PLT family. It is actively developed and has a somewhat larger community than chicken scheme a correspondingly larger set of libraries. It also seems to be Windows friendly and indeed may be Windows-centric which is good. I avoided it originally because compiling to C is not the recommended approach and I have read posts from users that claim it is slower than Python. In fact, on some micro-benchmarks it performed rather well (at least in its JIT-compiled version 352 incarnation). These times are in miliseconds.

Benchmark chicken mzscheme python
binarytrees 18047 14203 117453
fannkuch 21328 44469 Error
fasta 98250 39531 161953
mandelbrot 9359 32954 22172
nbody 12641 27781 42250
nsieve 8093 5985 12984
nsievebits 9781 6656 40781
partialsums 14735 40734 199906
recursive 45969 77734 Error
spectralnorm 222062 No Prog Error

On the downside, a lot of useful functionality is not specified by R5RS and is therefore specific to a particular scheme. Mzscheme has this problem more than most implementations, I think because it is so much bigger. For example, the threading primitives provided are much richer than the fairly spartan srfi-18. Targetting Mzscheme would render my code _very_ non-portable. Let’s hope that I don’t want to switch again any time soon.

Read Full Post »

Chicken is now working reasonably well for me. I’ve had to pull a fairly recent version directly from the source repository and build it with MinGW / MSYS but that went pretty well. I’m mildly concerned that the version I am working with is probably unique.

In the past, I have developed code using stable C++ compilers or stable versions of Perl that millions of other programmers are using. This gives me a nice secure feeling that if there are any bugs in my programs, it will be down to my code and I’ll be able to fix it myself. Using this bleeding edge chicken, I’ll probably have niggling doubts that there could be problems which are down to the compiler and/or third party libraries.

I have installed a number of chicken libraries, or eggs as they are called and they have mostly worked fine. In particular, I was surprised at how smoothly the sqlite3 install went, although I have yet to test the functionality.  Overall, I’m happy with the chicken module system. I’m still having a number of problems with one useful module though – srfi-19, the date/time scheme extension. I’ll need to look into that a bit further.

Read Full Post »

I don’t have Visual C++ installed on my home PC and many of the eggs require a C compiler in order to compile and install them. What would be perfect for me needs would be:

  • An easily installable Chicken Scheme (e.g. using .msi)
  • …that was built using MinGW / MSYS
  • …and can use MinGW / MSYS to build and install new eggs
  • …and has a chicken-setup.exe that “just works” with these tools

The chicken mailing list indicates that there are problems with building the current version from the source repository, failing to include srfi-1 amongst other problems. I’ll try to build it myself once I have reinstalled Windows.

Tools required:

Darcs http://abridgegame.org/darcs
Chicken 2.3
Win32 binary
Latest chicken from darcs repository $ darcs get http://galinha.ucpel.tche.br/chicken
MinGW + MSYS http://www.mingw.org

Originally posted: Saturday, July 08, 2006

Read Full Post »

Hmmm… chicken hangs when trying to do anything useful. This is almost certainly down to my system configuration. I’m trying to use the free Microsoft command-line compiler but the fact that it can’t even compile a simple C++ hello world probably isn’t a good sign (it complains about a missing libcpmt.lib). I think the chicken eggs that I need only require a C compiler so I attempted to press on regardless. http.egg compiled and installed, but trying to run chicken-setup htmlprag hangs at the command:

c:\chicken-2.3\csc -feature compiling-extension -s -R syntax-case -O2 -d0 htmlprag.scm


So, what are my options?

1. Move to PLT Scheme

I’ve heard nothing but good things about PLT Scheme, but one of the attractive things about chicken for me is the efficient compile from scheme to C to binary. It seems that you can do this with PLT, but it isn’t the recommended method.

2. Move to Linux

I know that at least the tool-chain is good on Linux :-) Additionally, my Windows install seems to be on it’s last legs – it is really slow and probably infested with spyware. On the other hand, part of the reason of choosing chicken scheme is to be able to target Windows binaries easily.

3. Buy VC++ 6

I’m not too keen on buying an obsolete compiler, plus I’m a little cheap!

4. Re-build chicken scheme with MINGW / Visual C++ Express

This would fit in with my goals of being able to produce windows binaries while writing scheme. There isn’t too much documentation on the web about how to go about it though. I really don’t like fighting the tool-chain, but at least if it works it should be a one-off.

Originally posted: Thursday, July 06, 2006

Read Full Post »

I wanted to write a small script to load a webpage and do some analysis. Ordinarily I would fire up perl and use LWP with quick and dirty regexes but this is a good opportunity to use one of the interesting languages.

Now, I haven’t learnt a new language properly for around 10 years although I have spent a little of the intervening time looking at scheme textbooks! I installed chicken scheme and quack.el to support editing with emacs. After a quick look at the chicken website I decided I needed the http and htmlprag eggs (chicken libraries). Installing them using chicken-setup was very easy although I discovered it required a C compiler when I tried it on a number of different boxes :-/

Well, first things first. For some webpages need you to represent yourself as a bonafide browser or else you get a “403 forbidden” message (The way you do this using perl LWP is something like $browser->agent(‘Mozilla/5.0′)). I couldn’t see an easy way to do this in the chicken http library. Fortunately it is easy enough to modify the .scm.

http:send-request is the function I want to modify. It begins like this:

(define (http:send-request req . more)
  (let-optionals more ([in #f]
                       [out #f] )
                 (let* ([req (if (string? req)
                                 (http:make-request 'GET req '(("Connection" . "close")))
                                 req) ]

The (req . more) construction isn’t too complicated. It corresponds more or less to this perl:

my ($req, @more) = @_;

However, I wasn’t at all familiar with (let-optionals …). Fortunately, the chicken scheme documentation is excellent and it looks like it maps to the following pseudo-perl.

my $in = shift @more || #f;
my $out = shift @more || #f;

i.e. local parameters are created and assigned to the values of more in turn or have a default value if there are not sufficient values in the @more array. Hmmm… I think that description is much less clear than the one in the chicken documentation.

The next bit makes a http request ‘object’, passing in a list of dotted pairs to use as attributes. As we never override the default values for in and out, we can use ‘more’ to pass in our own attributes. The modified send-request therefore becomes:

(define (http:my-send-request req . more)
  (let* ((in #f)
         (out #f)
         [req (if (string? req)
                  (http:make-request 'GET req (cons '("Connection" . "close") more))

We need to add the new function name to the export list so it is available outside the library:

    http:my-send-request ;; <-- Here
    http:GET http:POST

Then we add a wrapper for my-send-request in the client code to pass in the attributes we want:

(define (send-request-wrapper url)
  (http:my-send-request url
                        '("User-Agent" . "Mozilla/5.0")
                        '("Content-Type" . "application/x-www-form-urlencoded")))

and finally a wrapper to open a url, return the data as a list of lines and close the ports when we have finished with them:

(define (load-url url)
  (define-values (h a i o) (send-request-wrapper url))
  (let ((data (read-lines i)))
    (close-input-port i)
    (close-output-port o)

Whew! That seemed like a fair amount of effort, at least in comparison to Perl/LWP. Hopefully it will get easier as I become more familiar with chicken.

Originally posted: Wednesday, July 05, 2006

Read Full Post »

« Newer Posts


Get every new post delivered to your Inbox.