Everything Scheme

Planet Scheme Upgrade - Please check that your blog still works on Planet Scheme

2009-06-15T21:23:00.004+02:00

Dear Planet Scheme Bloggers,

The software behind Planet Scheme has gotten a long due upgrade.

After writing your next blog entry, please make sure your blog entry

arrives correctly at the front page of Planet Scheme. (Planet Scheme

updates every 3 hours, so be patient).

Details: Before Planet Scheme used Planet Planet (but despite the

text on its web site, it is no longer maintained). The replacement

software is Planet Venus - which understood the old configuration

and template files with no (known) problems.

Solving a Museum of the evening, I coffee.

2008-11-17T19:23:00.003+01:00

Scheme is thriving in Japan. As proof I offer a link to a Japanese version of Planet Scheme, namely Planet Scheme Japan . I couldn't resist reading the site with a little help from Google Translate, and the translation is at times quite amusing.

Hopefully one of Planet Scheme's Japanese readers can help us get with the real translation of: "Solving a Museum of the evening, I coffee." (Search for "571" in order to find the post on the Japanese site).

Never turn your back on an unused email-account.

2008-07-30T12:49:00.002+02:00

Never turn your back on an unused email-account.

The past month no new blog entries appeared at Planet Scheme. At first I thought the summer was to blame on the lack of blog activity. Today I found out that the web server had run out of disk space. An out of use email-account had received unmentionable amounts of spam. Sigh.

Bloggers: If you discover that your posts are missing on Planet Scheme, please give me a hint by email or by posting a note here.

And now I am off to figure out to impose a limit on mail accounts...

Ikarus - The new Scheme on the Block

2007-12-01T20:35:00.000+01:00

A new Scheme on the Block

Congratulations to Abdulaziz Ghuloum with the release of his new Scheme compiler Ikarus!

Getting traction for a new Scheme implementation have never been easy due to the astonishingly number of existing quality implementations. It would however be surprised not to see Ikarus become one of the usual suspects. The reason for this is not the rather large number of features Ikarus has for a first release, but rather that all the hard parts of a quality implementation already are present.

The work on the compiler has already produced three papers. The first "An Incremental Approach to Compiler Construction" describes in 24 small steps how to implement a compiler capable of running environment-passing interpreter for core Scheme. The idea is to a fully working compiler before and after each step. This implies that the one must write the backend first. At this years ICFP in Freiburg Aziz told me, that Ikarus in fact grew in this way.

The second is "Implicit phasing for R6RS libraries" by Abdulaziz Ghuloum, and R. Kent Dybvig describe the design and implementation of "The portable R6RS library and syntax-case system".

The third "Generation-Friendly Eq Hash Tables" also by Ghuloum and Dybvig describe an implemention of eq hash tables were only objects that actually move during a collection is rehashed.

Native Compilation
Ikarus is a native compiler, which means that it compiles directly to x86 machine code, more specifially the resulting code runs on Intel compatible processors supporting SSE2 extentions. In order words it will run on any reasonable new computer.

The native compilation niche Ikarus joins, includes Chez Scheme, Larceny, and MIT/GNU Scheme.

The drawback of native compilation have so far been that more than one backend were needed to support both PCs and Macs. After Apple switched to Intel processors that problem (for the time being at least) has gone. Ikarus supports the big three: Windows, OS X, and Linux.

Incremental Compilation

Ikarus is an incremental compiler. This means that programs at runtime can use the compiler to compile (an link and run) programs "on-the-fly" without using any external tools. I'll leave it to the curious, to find the intel assembler in the Ikarus source.

A pleasant side-effect of using an incremental compiler is that eval can use the compiler, which means that there are good chances that eval will be both efficient and give results consistent with normal compilation. For non-incremental compilers such as the compile-to-C variety, eval is often implementation via a compile-to-closures approach, which introduces an extra source of bugs.

Not that I ever use eval...

Optimizing Compiler

... there is a fine line between “optimization” and “not being stupid.”
-- R. Kent Dybvig

So what exactly does it mean that Ikarus is an optimizing compiler?

For one it means that the code produced in value-, boolean- and effect-contexts are different. See the paper "Destination-Driven Code Generation" by R. Kent Dybvig, Robert Hieb, Tom Butler.

Machine registers are used to hold function call arguments and local variables. Mapping variables to machine registers in a optimal way is unfortunately a NP-hard problem, but nevertheless efficient algorithms exists that work well in practise. Ikarus uses a version of Chaitin's graph-coloring algorithm.

Needless to say, Ikarus also does constant folding.

As far as I can tell, control flow analysis based optimizations are yet to come.

Modern generational garbage collector

The generational garbage collector was inspired by the paper: Don't Stop the BIBOP: Flexible and Efficient Storage Management for Dynamically-Typed Languages by R. Kent Dybvig, David Eby, and Carl Bruggeman.

R6RS Compliance

The immediate goal for Ikarus to become 100% R6RS compliant. Rapid progress is made to achieve this goal, and as far I can tell, there no potential show-stoppers ahead - it is "just" a matter of implementing "more of the same".

Opinions of R6RS are many, but R6RS compliance means at least two things: a decent module system and documentation for free.

An Introduction to Web Development with PLT Scheme - The Control

2007-08-15T23:51:00.000+02:00

Resume

This is the fourth post in a series of posts on programming web

applications with PLT Scheme. In part one and two the model and view of a small Reddit-like application were discussed. Part three were about the basic operation of the PLT Scheme web-server. Here in part four we will finish the discussion of the controller. Finally I'll explain how to get this code from PLaneT, so you can run it on your own machine.

Don't forget to leave a comment, if you have questions or suggestions.

The Controller

The controller handles user interactions. The concrete actions in our application are:

Viewing the front-page
Up- and down-voting a link
Viewing the page for submitting new links
Submitting a new link

For each action, we'll have a function that invokes the appropriate function in the model, receives data back, and then let the view generate a web-page based on the data. The function handling the viewing of the front-page is simply:

(define (do-front-page)
 (html-front-page 0 1 (page 0)))

The function page is from the model and html-front-page in the view (see earlier posts).

Implementing the controller

An user interaction is sent to the web-server in the form of a request. Given a request, the web-server determines which servlet is to handle the request, and then calls the servlet's start function.

Here we have a choice. Even though the controller conceptually is one entity, a common way to implement controllers is to have separate servlets for each action. In this tutorial however I'll implement the controller as a single servlet, and let it dispatch on the action. The url for the servlet will be:

 http://localhost/servlets/control.scm

The action will be given as a parameter. One way to send the parameter is to include it as part of the link:

 http://localhost/servlets/control.scm?action=submitnew

Another is to let action be a hidden field in a form.

The Start Function

After the receipt of a request the web-server starts the control-servlet by calling the start function with the request in
question. The web-framework provides us with a special form servlet, that allows us to to define the start function simply as:

  (require (planet "web.scm" ("soegaard" "web.plt" 2 0))
(define start
 (servlet
   (dispatch-on-action)))

Here the servlet form evaluates to a function that

receives a request
stores the information in the request in various parameters
evaluates its bodies, the result of the last body must be an x-expr
construct a response based upon the x-expr and the contents of the various response parameters

During development it is mighty convenient to see any errors directly
in the browser. Therefore, let's introduce the form, with-errors-to-browser:

  (define start
 (servlet
   (with-errors-to-browser
     send/finish
     dispatch-on-action))

Dispatching on actions

Any parameters sent as part of the request, are saved as bindings in current-bindings by the servlet-form in start. The dispatch code is therefore very simple:

  (define (dispatch-on-action)
 (with-binding (current-bindings) (action)
   (match action
     ["updown"     (do-updown)]
     ["submitnew"  (do-submit-new)]
     ["submit"     (do-submit)]
     [else         (do-front-page)])))

If the action is missing, the front page is shown.

Submital of new links

The action "submitnew" simply shows a page with a form, where a new url and title can be entered:

  (define (do-submit-new)
 (html-submit-new-page))

Hitting "submit" will POST the data to our servlet, and the action will be "submit". The controller must send the data to the model in order to add the new link. The user should return to the frontpage. One way to achieve this is as follows:

  (define (do-submit)
 (with-binding (current-bindings) (url title)
   (when (and url title)
     (insert-entry title url 10)))
 (do-front-page))

Can you spot a problem?

The problem and its solution

What happens if the user hits the refresh button in their browser? The same data will be posted again. This is often referred to as the "Double Submit problem". The solution is to redirect the browser to the frontpage. If the user now hits refresh, then they'll just get the frontpage again.

  (define (do-submit)
 (with-binding (current-bindings) (url title)
   (when (and url title)
     (insert-entry title url 10)))
 ; to make sure a reload doesn't resubmit, we redirect to the front page
    (current-redirect-temporarily "http://localhost/servlets/control.scm")
 (html-redirect-page "Redirecting to frontpage"))

The redirection is put in place, by setting the parameter current-redirect-temporarily. When the servlet form constructs the reponse it checks whether any redirection parameters are set, if not it produces a normal "200 OK" response; however, if set, it produces a redirection response; e.g., in the case of current-redirect-temporarily, a "302 Found".

Note: You can also use current-redirect-see-other to get a "303 See Other" response.

Note: See
Redirect after Post by Michael Jouravlev for a thorough discussion of the POST-Redirect-GET technique.

Up- and Down-voting

The up- and down-arrows could be simple links, but if they were we would run into a similar problem with refresh. We therefore turn each link into a form, and handle its submital with the POST-Redirect-GET technique as before. The only complication is that big submital buttons aren't pretty; images of arrows are much prettier. This is solved with a little JavaScript (see the post on the view).

  (define (do-updown)
 ; an arrow was clicked
    (with-binding (current-bindings) (entry_id arrowitem)
   (match arrowitem
     ["down" (when entry_id
               (decrease-score entry_id))]
     ["up"   (when entry_id
               (increase-score entry_id))]
     [else
      'do-nothing]))
 ; to make sure a reload doesn't resubmit, we redirect to the front page
    (current-redirect-temporarily (format "http://localhost:~a/servlets/control.scm" port))
 (html-redirect-page "Redirecting to frontpage"))

Downloading the code

To download the code and try it, open DrScheme and enter the following in the interaction window:

  (require (planet "install.scm" ("soegaard" "listit.plt" 1 0)))

Then call install to copy the web-site to a
folder of your choice:

 > (install "c:/tmp/my-listit")
Copying the web-site to c:/tmp/my-listit .
Please wait...
The web-site has now been copied to c:/tmp/my-listit .
To test it, open "launch.scm" in DrScheme and run it.

Have fun!

Leave a comment, if you have questions or suggestions.

Number Theory

2007-08-05T23:27:00.000+02:00

Today I released a collection of number theory functions through PLaneT.

The code began as an experiment. I grabbed a book on number theory from the shelve ("Elementary Number Theory" by Gareth A. Jones and J. Mary Jones) and began illustrating each definition and each theorem with Scheme code. The first half of the source code is thus a well commented mix of definitions, theorems and code.

The second half contains more sophisticated algorithms mostly from the excellent book "Modern Computer Algebra" by Joachim von zur Gathen and Jürgen Gerhard. The algorithms for factorizing large integers come from this book.

Finally there are some definitions of special functions, mostly inspired by the problems of the Euler Project. The revival of the code is due to the Euler Project, which is a collection of small problems of very varying difficulty. The tools I have used to solve the problems (apart from the number theory library) are David Herman's memoize package (don't forget to use memoize* when working with numbers) and the eager comprehensions from srfi 42.

The documentation of the number theory library lists all the available functions.

Please write with bugs, suggestions, and improvements.

Know your implementation

2007-05-02T00:09:00.000+02:00

How well do you know your language implementation? Below you'll see four different implementations of the same function.

Can you predict which version is fastest?

Too easy? Well, then try not only to pick the fastest, but also to rank them according to speed.

You are welcome to leave a comment, if you try the snippets.

The task is simple: we want to append two linked lists. That is, we'll reimplement the builtin function append, although we'll restrict our-selves to two arguments. The four versions are of course not allowed to use the builtin append.

First version: Building the list in reverse

(define (append1 xs ys)
  (append-rev (reverse xs) ys))

(define (append-rev rev-xs ys)
  (cond
    [(null? rev-xs) ys]
    [else           (append-rev (cdr rev-xs) 
                                (cons (car rev-xs) ys))]))

Second version: Naïve recursion

A naïve, non-tail-recursive solution.

(define (append2 xs ys)
  (cond
    [(null? xs) ys]
    [else (let ([result (append2 (cdr xs) ys)])
            (cons (car xs) result))]))

Third version: Continuation passing style

(define (append3 xs ys)
  (define (append3-k xs ys k)
    (cond
      [(null? xs) (k ys)]
      [else (append3-k (cdr xs) ys
                       (lambda (tail) (k (cons (car xs) tail))))]))
  (append3-k xs ys (lambda (x) x)))

Using side-effects

Let's avoid any unnecessary consing.

(define (for-each-reverse! f xs)
(cond
  [(null? xs) 'done]
  [else (for-each-reverse! f (cdr xs))
        (f (car xs))]))

(define (append4 xs ys)
(let ([result ys])
  (for-each-reverse!
    (lambda (x)
      (set! result (cons x result)))
      xs)
  result))

Benchmarking

And now for the bencmarking. Before each timing, I invoke the garbage collector. In this way garbage produced by test one, doesn't affect the timings of test two.

(define (test n)
 (let ([xs (vector->list (make-vector n))])
   (collect-garbage)
   (time (begin (append1 xs xs) 'done))
   (collect-garbage)
   (time (begin (append2 xs xs) 'done))
   (collect-garbage)
   (time (begin (append3 xs xs) 'done))
   (collect-garbage)
   (time (begin (append4 xs xs) 'done))))

(test 100)
(test 1000)
(test 10000)
(test 100000)
(test 1000000)
(test 2000000)

Writing a Spelling Corrector in PLT Scheme

2007-04-29T17:26:00.000+02:00

[Remember to leave a comment: Was this post silly? Enlightning? Old news?]

Introduction

Peter Norvig recently wrote a great piece on How to Write a Spelling Corrector. Since Norvig used Python, Shiro decided to write a version in Gauche Scheme. In the following I'll present a solution in PLT Scheme. But first let's look at string manipulations.

String Manipulations

Scheme offers the usual operations on strings: string concatenation (string-append), referencing a character in a string (string-ref), extracting a substring (substring) and converting characters to strings (string). Compared to other languages code for string manipulations tend to become verbose, unless one "cheats" and uses some sort of utility such as format. [The advantage of this verboseness is that Scheme compilers can generate efficient code.]

As an example consider this expression from Norvig's spelling corrector:

  [word[0:i]+c+word[i:]

Here word[0:i] is the substring from index 0 (inclusive) to index i (exclusive).
The c is a character, and word[i:] is the substring from index i to the end.
The concatenation operator + converts automatically the character c to a string before the strings are concatenated.

A literal translation to Scheme reads as follows:

 (string-append (substring word 0 i) (string c) (substring word i (string-length word)))

Ouch!

A utility is clearly needed. Below follows my shot at one such utility, namely, concat. It allows us to write the expression as:

(concat word 0 i  c  word i _)

A string followed by two numbers is a substring, so word 0 i is short for (substring word 0 i). An underscore is allowed instead of a number either to indicate the beginning or the end. Thus word i _ is short for (substring word i (string-length word)). Finally a character is automatically converted to a string, so c is short for (string c). Not used in the example, but useful in general: A string followed by a single number, like word i, is short for (string-ref word i).

The code for concat is found at the bottom of this post.

The Spelling Corrector

There are two parts of the spelling corrector. The first part reads in correctly spelled words from a corpus, and counts the number of occurences of each word. The second part uses the training data to check whether a given word is known, or if it is incorrectly spelled to find the intended word.

Reading words from a file

We can split a string in words with the help of regexp-split.

 > (regexp-split #rx"[^a-zA-Z]" "foo bar baz")
 ("foo" "bar" "baz")

Taking advantage of the fact that PLT Scheme's regular expression functions work both on strings as well as directly on input ports, we can call regexp-split directly on the port.

; words : port -> list-of-strings
(define (words text)
 (list-ec (: word (regexp-split #rx"[^a-zA-Z]" text))
              (string-downcase (bytes->string/latin-1 word))))

Counting words

Now we'll count how many times each word is seen. We'll use a hash table to hold words and counts.

; train : list-of-strings -> hash-table-from-strings-to-numbers
(define (train features)
 (let ([model (make-hash-table 'equal)])
   (do-ec (: word features)
          (hash-table-put! model word (add1 (hash-table-get model word 1))))
   model))

Let's read in the data from the small corpus, and at the same time define word-count that returns the count of a word, and known? that checks whether a word was seen in the training set.

(define NWORDS (train (words (open-input-file "small.txt"))))

(define (word-count word)
 (hash-table-get NWORDS word 0))

(define (known? word)
 (hash-table-get NWORDS word #f))

The set of strings with edit distance 1

When a word is incorrectly spelled, we want to suggest a "similar" word known to be correctly spelled.

Given a word w, the set of words with edit distance 1 consists of the words, we can generate from w by either deleting one character, or transposing to character, or altering one character, or inserting one character.

Deleting the character with index i from a word is easy with the help of concat:

   (concat word 0 i     word (+ i 1) _)

If n is the length of w, then the set of strings generated by deleting a single character is given by:

 (set-ec string-compare (: i n) (concat word 0 i     word (+ i 1) _))

Here (: i n) makes i run through the numbers 0, 1, ... n-1. For each i the string (concat word 0 i word (+ i 1) _) is calculated, and all strings are collected in a set.

All words with edit distance 1 is given by:

(define (edits1 word)
 (define alphabet (string-ec (: c #\a #\z) c))
 (define n (string-length word))
 (union*
  (set-ec string-compare (: i n)                (concat word 0 i     word (+ i 1) _))
  (set-ec string-compare (: i (- n 1))          (concat word 0 i     word (+ i 1)     word i   word (+ i 2) _))
  (set-ec string-compare (: i n) (: c alphabet) (concat word 0 i  c  word (+ i 1) _))
  (set-ec string-compare (: i n) (: c alphabet) (concat word 0 i  c  word i _))))

(define (union* . sets)
 (foldl union (empty string-compare) sets))

The set of strings with edit distance 2

Given a word w, the set of words with edit distance 2 is the set generated by 2 deletions, transponations, alterations, or insertions. Luckily we have done the hard work in edits1.

(define (edits2 word)
 (set-ec string-compare
         (: e1 (elements (edits1 word)))
         (: e2 (elements (edits1 e1)))
         e2))

There is just one catch. The set is awfully large, so instead, we'll concentrate on correctly spelled (known) words with a edit distance of two:

; known : set-of-strings -> set-of-strings
;   remove the unknown words in words
(define (known words)
 (set-ec string-compare
         (:set w words) (if (known? w)) w))

(define (known-edits2 word)
 (set-ec string-compare
         (:set e1 (edits1 word))
         (:set e2 (edits1 e1))
         (if (known? e2))
         e2))

Maximum

If we have more than one suggestion for an incorrectly spelled word, we want to find the most common of them - that is the one with the largest word count in the training set. Python's max has a nice feature, where given a list of xs, it finds the x that maximizes f(x), for a function f. Here is a Scheme version:

(define (maximum xs key)
 ; return the x with the largest key
 (define max-key -inf.0)
 (define max-x #f)
 (do-ec (: x xs)
        (:let k (key x))
        (if (> k max-key))
        (begin
          (set! max-key k)
          (set! max-x x)))
 max-x)

Correcting a word

To correct a word, we first check whether it is known. We try to find a known word with edit distance 1. If unsuccessful we try to find one with edit distance 2.

(define (correct word)
 (define (falsify s) (if (empty? s) #f s))
 (let ([candidates
        (or (falsify (known (set word)))
            (falsify (known (edits1 word)))
            (falsify (known-edits2 word))
            (falsify (list word)))])
   (maximum (elements candidates) word-count)))

Let's try it:

 > (correct "hose")
 "house"

Last Remarks

Were it not for the concat macro, the function edits1 would have been clumsy. I am not sure concat is the answer. Thanks to macros, one can at least experiment with language extensions in Scheme.

Remember to read Norvig's piece, where he explains the math behind.
[Hmm. Should I turn it into a math exercise for my class?]

Remember to leave a comment: Was this post silly? Enlightning? Old news?]

A Spelling Corrector in PLT Scheme

(require (lib "42.ss" "srfi")
         (lib "67.ss" "srfi")
         (planet "set.scm" ("soegaard" "galore.plt" 2 (= 2))))

; words : port -> list-of-strings
(define (words text)
  (list-ec (: word (regexp-split #rx"[^a-zA-Z]" text))
           (string-downcase (bytes->string/latin-1 word))))

; train : list-of-strings -> hash-table-from-strings-to-numbers
(define (train features)
  (let ([model (make-hash-table 'equal)])
    (do-ec (: word features)
           (hash-table-put! model word (add1 (hash-table-get model word 1))))
    model))

(define file "small.txt")
;(define file "big.txt")
(define NWORDS (train (words (open-input-file file))))

(define (word-count word)
  (hash-table-get NWORDS word 0))

(define (known? word)
  (hash-table-get NWORDS word #f))

(define (known words)
  (set-ec string-compare
          (:set w words) (if (known? w)) w))

(define (concat-it spec)
  (define (underscore? o) (eq? o '_))
  ; spec :: = '()  | ( string num num  . spec ) | (string num _) | |
  (define (subs spec)
    (match spec
      [() '()]
      [((? string? s) (? number? n1) (? number? n2) . spec)
       (cons (substring s n1 n2) (subs spec))]
      [((? string? s) (? number? n1) (? underscore? _) . spec)
       (cons (substring s n1 (string-length s)) (subs spec))]
      [((? string? s) (? underscore? _) (? number? n2) . spec)
       (cons (substring s 0 n2) (subs spec))]
      [((? string? s) (? number? n) . spec)
       (cons (string (string-ref s n)) (subs spec))]
      [((? symbol? s) . spec)
       (cons (symbol->string s) (subs spec))]
      [((? char? c) . spec)
       (cons (string c) (subs spec))]
      [((? string? s) . spec)
       (cons s (subs spec))]
      [else (error)]))
  (apply string-append (subs spec)))

(define-syntax (concat stx)
  (syntax-case stx (_)
    [(string-it spec ...)
     #`(concat-it
        (list #,@(map (lambda (so)
                       (syntax-case so (_)
                         [_ #''_]
                         [else so]))
                     (syntax->list #'(spec ...)))))]))

(define (union* . sets)
  (foldl union (empty string-compare) sets))

(define (edits1 word)
  (define alphabet (string-ec (: c #\a #\z) c))
  (define n (string-length word))
  (union* 
   (set-ec string-compare (: i n)                (concat word 0 i     word (+ i 1) _))
   (set-ec string-compare (: i (- n 1))          (concat word 0 i     word (+ i 1)     word i   word (+ i 2) _))
   (set-ec string-compare (: i n) (: c alphabet) (concat word 0 i  c  word (+ i 1) _))
   (set-ec string-compare (: i n) (: c alphabet) (concat word 0 i  c  word i _))))

(define (edits2 word)
  (set-ec string-compare 
          (: e1 (elements (edits1 word)))
          (: e2 (elements (edits1 e1)))
          e2))

(define (known-edits2 word)
  (set-ec string-compare
          (:set e1 (edits1 word))
          (:set e2 (edits1 e1))
          (if (known? e2))
          e2))

(define (maximum xs key)
  ; return the x with the largest key
  (define max-key -inf.0)
  (define max-x #f)
  (do-ec (: x xs)
         (:let k (key x))
         (if (> k max-key))
         (begin
           (set! max-key k)
           (set! max-x x)))
  max-x)

(define (correct word)
  (define (falsify s) (if (empty? s) #f s))
  (let ([candidates 
         (or (falsify (known (set word)))
             (falsify (known (edits1 word)))
             (falsify (known-edits2 word))
             (falsify (list->set (list word))))])
    (maximum (elements candidates) word-count)))

An Introduction to Web Development with PLT Scheme - An Intermezzo

2007-04-25T19:38:00.000+02:00

Intermezzo

This is the third post in a series programming web applications with PLT Scheme. In part one and two the model and view of a small reddit-like application were discussed. Before turning to the control part of this application, we need to look at the basic operation of the PLT Scheme web server.

Requests and responses - the big picture

What happens when a user clicks on a link to your web-site? The browser sends a request to the web-server. The request holds among other information the protocol version and the uri (uniform resource identifier) of the requested resource. The web-server must now compute a response and send it back.

How the response is computed depends on the requested resource. In the case of static content, the response of the web-server consists of a few headers (including the mime-type of the file) and a verbatim copy of the file.

Servlets

Dynamic content is handled by servlets. A servlet is a small program that given a representation of a request computes a response, which the web-server then sends back. The standard "Hello World"-servlet reads as follows:

(module hello-world mzscheme
 (provide interface-version timeout start)
 (define interface-version 'v1)
 (define timeout +inf.0)

 ; start : request -> response
  (define (start initial-request)
   `(html (head (title "Hello World"))
          (body ([bgcolor "white"])
                (p "Coffee is bliss.")))))

A module based servlet must provide a start function, that given a request computes a response. In this case the response is XHTML represented as an X-expression. If your fancy is classical HTML as strings, you can return a list, whose first element is the mime type as a byte string, and whose second element is a list of strings (or byte strings) with the lines of the document. For more advanced purposes (such as generating incremental responses) one can return a response structure - see the documentation for details.

A little tip: If you place a call to report-errors-to-browser at the beginning of start, then the web server will catch any otherwise uncaught exceptions, generate an error page (with source location information) and send it to the client. This is considerably more convenient than constantly rumaging through log files.

Requests

Back to the request structure. A request structure holds:

the method (get, post, ...)
the uri of the resource
the headers (including cookies)
bindings (from name value pairs either from a posted form or from the query url itself)
the host-ip (in case the same web server instance handles more than one ip)
the client ip
raw data from a post operations

The net collection contains many valuable utilities to deal with uri, headers, cookies etc. I have collected these and other utilities in a little web framework available from PLaneT. It also contains some syntax that hopefully, makes it a bit easier to write servlets. The philosophy is to let the servlet parse the request and store the information in parameters. Similarly parameters hold what will become assembled to a response, when the servlet is finished. For simple servlets, like the one above, nothing much is gained, but more advanced usage patterns like post-redirect-get become much easier to code. The last part of this series will use the framework to implement the control.

Try the PLT Web Server

The PLT Web Server is included in the DrScheme download. If you start "PLT Web Server.exe" (Windows) or "web-server-text" (unix and mac), then the static content will be served from "c:/Programs/PLT/collects/web-server/default-web-root/htdocs" and the servlets are in will be in "...default-web-root/servlets/". A few examples are included.

Fun with macros - extending application to support vector notation

2007-04-24T20:15:00.000+02:00

[Remember to leave a comment: Was this post silly? Enligthning? Old news?]

"Scheme vector notation sucks" - a common complaint often heard amongst children and drunks. They might even be right. The sum of a three element vector is calculated like this:

 (define a (vector 1 2 3))
(+ (vector-ref a 0) (vector-ref a 1) (vector-ref a 2))

It looks like they are right. Can we repair this with some macro magic?

Let's first consider what syntax we want to implement. Maybe something like this:

 (+ a[0] a[1] a[2])

Not bad, but in most Scheme implementations the parentheses () and [] mean the same.
How about

  (+ (a _0)  (a _1)  (a _2))

then? That we can implement. In PLT Scheme the above is parsed as the
application:

  (#%app + (#%app a _0) (#%app a _1) (#%app a _2))

All we need to do now, is to implement a new application, that takes special action
when the second argument begins with an underscore. In the following code underscore-symbol? is a function that checks whether a symbol starts with an underscore, and remove-underscore removes an initial underscore from a symbol.

The code also handles the case where the subscript is an identifier, such as in (v _n).

(define-syntax (my-app stx)
   (syntax-case stx ()
     [(_ expr sub)
      (and (identifier? #'sub)
           (underscore-symbol? (syntax-e #'sub)))
      (let* ([sub (remove-underscore (syntax-e #'sub))]
             [num (string->number (symbol->string sub))])
        (cond
          [(and (number? num) (or (zero? num) (positive? num)))
           (quasisyntax/loc stx
             (vector-ref expr #,(datum->syntax-object #'sub num)))]
          [else
           (quasisyntax/loc stx
             (vector-ref expr #,(datum->syntax-object stx sub)))]))]
     [(_ more ...)
      #'(#%app more ...)]
     [_
      (raise-syntax-error 'my-app "bad syntax, in ~a" stx)]))

Notice the use of quasisyntax/loc instead of plain quasisyntax.
If a user writes (v _4) and v is of size 3, then an error must be signaled.
The culprit is the vector-ref expression, so if plain quasisyntax is used,
DrScheme will color the vector-ref expression red - and the user will think
the macro code is faulty. Using quasisyntax/loc allows us to report errors
to the usage of the macro.

  (quasisyntax/loc stx
     (vector-ref expr #,(datum->syntax-object #'sub num)))

We also need a notation for the case, where the subscript is a general expression.
That's fortunately easy. Add _ to the list of literals of the syntax-case expression, and add this clause:

      [(__ expr _ sub)
      (syntax/loc stx
        (vector-ref expr sub))]

Finally we also need a convenient way to make assignments to vectors. The syntax
(v 2 := 42) is easy to implement. And just in case people forget, we also support (v _2 := 42).
The entire source follows.

Remember to leave a comment: Was this post silly? Enligthning? Old news?

; vector-hack.scm   --  Jens Axel Søgaard
(module vector-hack mzscheme
 (provide (rename my-app #%app ))

 (begin-for-syntax
   (define (underscore-symbol? sym)
     (and (symbol? sym)
          (let ([str (symbol->string sym)])
            (> (string-length str) 0)
            (equal? (string-ref str 0) #\_))))
  
   (define (remove-underscore sym)
     (if (underscore-symbol? sym)
         (let ([str (symbol->string sym)])
           (string->symbol (substring str 1 (string-length str))))
         (error 'remove-underscore "symbol doesn't start with an underscore: ~a" sym))))


 (define-syntax (my-app stx)
   (syntax-case stx (_ :=)
     [(__ expr sub)
      (and (identifier? #'sub)
           (underscore-symbol? (syntax-e #'sub)))
      (let* ([sub (remove-underscore (syntax-e #'sub))]
             [num (string->number (symbol->string sub))])
        (cond
          [(and (number? num) (or (zero? num) (positive? num)))
           (quasisyntax/loc stx
             (vector-ref expr #,(datum->syntax-object #'sub num)))]
          [else
           (quasisyntax/loc stx
             (vector-ref expr #,(datum->syntax-object stx sub)))]))]
     [(__ expr _ sub)
      (syntax/loc stx
        (vector-ref expr sub))]
     [(__ expr sub := value-expr)
      (and (identifier? #'sub)
           (underscore-symbol? (syntax-e #'sub)))
      (let* ([sub (remove-underscore (syntax-e #'sub))]
             [num (string->number (symbol->string sub))])
        (cond
          [(and (number? num) (or (zero? num) (positive? num)))
           (quasisyntax/loc stx
             (vector-set! expr #,(datum->syntax-object #'sub num) value-expr))]
          [else
           (quasisyntax/loc stx
             (vector-set! expr #,(datum->syntax-object stx sub) value-expr))]))]
     [(__ expr sub := value-expr)
      (syntax/loc stx
        (vector-set! expr sub value-expr))]
     [(__ more ...)
      #'(#%app more ...)]
     [__
      (raise-syntax-error 'my-app "bad syntax, in ~a" stx)])))
 
 
  (require vector-hack)
(define v (vector 0 1 2))
(v _0)  ; => 0
 (v _1)  ; => 1
 (v _2)  ; => 2
 ; (my-app v _3)  ; => error, correct syntax location

(define a 1)
(v _a)                    ; => 1
 (+ (v _0) (v _1) (v _2))  ; => 3

v                ; => #(0 1 2)
 (v _0 := 3)      ; #<void>
 v                ; => #(3 1 2)

(v 0 := 42)       ; void
v                 ; => #(42 1 2)

An Introduction to Web Development with PLT Scheme - The View

2007-01-29T23:14:00.000+01:00

Introduction

First of all, thanks for the positive response to part 1 of this introduction. Comments are very welcome.

The goal of this introduction is to write a "Mini Reddit" called "List It!". The first part focused on the model component i.e. the underlying data and how to implement it using an SQLite database. This second part will concentrate on the view component, which presents the data to the user. The third part will be on the controller.

Our user interface consists of two pages: the frontpage shows the list of links with the highest scores and the submission page where a user can enter the name and url of a new entry. To give an impression of where we are headed, here is screenshots of the final result:

In the Model-View-Controller organization, the controller receives a request from the client (user), retrieves data from the model, lets the view construct a web page and the sends a response back to the client. The view thus consists of a series of functions turning data
into web-pages.

Representing XHTML as X-expressions

PLT Scheme supports multiple ways of representing web-pages. One option is to use strings:


"<html><head><title>A Title</title>
<body>A body</body></html>".

Since the structure of the document is lost with this choice, all but the most simple manipulations of the document, becomes harder to program than they should.

Instead we will use X-expressions (S-expressions representing XML) to represent our web-pages. The above example becomes:

  `(html (head (title "A title"))
  (body "A body"))

Besides X-expressions another popular choice in the Scheme world is SXML (if you are into serious XML-manipulations look into SXML and SSAX), which are similar to X-expressions in terms of use.

The beauty of X-expressions is that, since they are normal lists, we can use the builtin functions to manipulate them. Another major convenience is we can use unquote (written as a comma) to insert the result of a Scheme expressions into the X-expression:

   `(body "The result of 1+2 is: " ,(number->string (+ 1 2)))

which, when evaluated, results in

    (body "The result of 1+2 is: " "3").

Attributes are placed right after the tag:

    `(body ((color "white") (bgcolor "black"))
     "Hello world")

The WEB library

To avoid writting boilerplate stuff (charset, stylesheet, content type etc.) each and every time a web page is constructed, we will use the general web framework from PLaneT (the PLT Scheme "CPAN" - note that packages are downloaded automatically if needed).

> (require (planet "html.scm" ("soegaard" "web.plt" 1 0)))
> (html-page #:body `(p "Hello world"))
(html
(head (title "A title")
    (link ((rel "stylesheet") (type "text/css") (href "")))
    (meta ((http-equiv "Content-Type") (content "text/html;charset=UTF-8"))))
(body (h1 "A Header")
    (p "Hello world")))

In the example above, the html-page only received the body, so it used the site wide default arguments for the title, the stylesheet and the "header". Obviously we need to override the defaults for our List It! site:

(override-default current-page-title"List it!")
(override-default current-page-header'(h1 ((class "page_header")) "List it!"))
(override-default current-page-style-sheet "http://localhost/stylesheet.css")

After overriding the defaults we get:

    (html
  (head (title "List it!")
        (link ((rel "stylesheet") (type "text/css")
               (href "http://localhost/stylesheet.css")))
        (meta ((http-equiv "Content-Type")
               (content "text/html;charset=UTF-8"))))
  (body (h1 ((class "page_header")) "List it!")
        (p "Hello world")))

Use the keywords #:title, #:header, #:body, #:style-sheet, and #:style-sheet with html-page, in order not to use the site wide defaults.

The Submit-new-entry page

The funtion html-submit-new-page builds an X-expression representing the submission page. It takes no arguments, since it doesn't rely on data from the model:

(define (html-submit-new-page)
(html-page
#:title  "List it! - submit"
#:header '(h1 "List it!")
#:body
`(div (h2 "Submit a new entry")
   ,(html-form
     "submitnewform" "control.scm"
     (html-input "action" #:value "submit" #:type 'hidden)
     `(table (tr (td "url")   (td ,(html-input "url"   #:type 'text #:value "http://")))
             (tr (td "title") (td ,(html-input "title" #:type 'text #:value "A title"))))
     (html-input "submit" #:value "submit")))))

The submission page consists of a form with two input fields. One for the url and one for the title. The function html-form rececives a name of the form, the action. The default method for submitting is POST, but one can use the keyword argument #:method to choose something else. The function html-input builds an input field. Other types of input fields are: 'image and 'hidden.

Clicking the submit button will post the parameters action, url and title to control.scm.

The Frontpage

The submitted entries are ranked according to their score. The entry with the highest score has rank 1, the next rank 2 and so on. Only a limited number of entries can be showed at a time, so we imagine the entries divided into pages. The function html-front-page below receives three arguments: a page number, the rank of the first entry of the page in question and the list of entries

(define (html-front-page page-number rank-of-first-entry entries)
(html-page
#:body `(div
       ,(html-menu)
       ,(html-list-of-entries page-number rank-of-first-entry entries))))

The function html-menu generates an X-expression for the "menu" on top of the screen The function html-list-of-entries generates an X-expression representing the list of entries.

The menu

The "menu" consists so far of a single menu item "submit-new-link".

(define (html-menu)
`(a ((href "control.scm?action=submitnew")) "submit-new-link"))

The list of entries

The list of entries is received by html-list-of-entries as a list of vectors.

(#4("entry_id" "title" "url" "score")
#4("1" "Everything Scheme" "http://www.scheme.dk/blog/" "42")
#4("3" "PLT Scheme" "http://www.plt-scheme.org" "9")
...)

The first vector holds the column names in the database, and can thus safely be ignored.

(define (html-list-of-entries page-number rank-of-first-entry entries)
`(div ((class "entries"))
   ,@(list-ec
      (if (not (null? entries)))
      (:list entry (index i) (cdr entries))
      (:match #(id header url score) entry)
      `(table ...))))

A DIV of class "entries" is used around the list of entries, so we single them out in the stylesheet. Next we use an eager comprehension list-ec to generate a list of X-expressions, one for each entry. Since we want the result to be of the form (div (class "entries") (table ...) (table ...) ...) and not (div (class "entries") ((table ...) (table ...) ...)) we use unquote-splicing ,@ instead of just unquote.

The eager comprehension first checks to see, whether entries is the empty list - and if so, an empty list of X-expressions is generated.

The clause (list entry (index i) (cdr entries)) iterates over the elements of the list entries (minus the first element), binding entry to each element in turn, also the index variable i counts from 0 and up.

The clause (:match #(id header url score) entry) uses pattern matching to bind the variables id, header, url, and score to the elements of the entry vector.

The final expression `(table ...) can now use the variables to generate the X-expression for the entry in question.

The table is used to position the rank, the up- and down-arrow and the link. I am able to do the same in CSS - but not in all browsers at the same time.

`(table ((class "entry"))
(tr (td ((class "rank")) ,(number->string (+ i rank-of-first-entry)))
 (td ,(let ((form (format "arrowform~a" id)))
        (html-form form "control.scm"
           #:atts '((class "arrows"))
           (html-input "arrowitem"  #:type 'hidden)
           (html-input "entry_id" #:type 'hidden #:value id)
           (html-input "action"   #:type 'hidden #:value "updown")
           `(div ,(html-a-submit form "arrowitem" "up"
                                      (html-icon 'go-up #:class "arrow")))
                 ,(html-a-submit form "arrowitem" "down"
                                      (html-icon 'go-down #:class "arrow")))))
 (td (div (a ((href ,url)) ,header))
     (span ((class "score")) "score: " ,score)))))))

The alert reader will probably wonder, why the form is introduced. Why aren't the arrows two simple links to, say,

control.scm?action=updown&arrowitem=down&entry_id=1 ?

Well, a click at the above url would result in the entry getting a vote. The problem lies in what happens next. If the user now reloads the page, the entry will get an extra vote. Bookingmarking the page will also result in extra votes, when the user returns.

The form-solution sends the parameters "behind the scenes", so that the url becomes control.scm. This obviously solves the bookmarking problem. The reload problem is solved via the Post/Redirect/Get pattern - which I'll discuss in detail in the post on the controller.

The function html-a-submit builds a link that submits the form (it's in the web-framework), it involves a little JavaScript.

(define (html-a-submit formname formitem id text)
`(a ((href ,(string-append
          (format "javascript:document.~a.~a.value='~a';" formname formitem id)
          (format "document.~a.submit();" formname))))
 ,text))

The function html-icon returns an X-expression `(img ...) representing various images. In this tutorial only the up- and down-arrow is supported, but if anyone is interested, I have a version supporting all of Tango (an excellent source of icons).

The Program

;;; view.scm  --  Jens Axel Soegaard

(module view mzscheme
 (provide (all-defined))

 (require (lib "kw.ss")
          (planet "42.ss"    ("soegaard" "srfi.plt"))
          (planet "html.scm" ("soegaard" "web.plt" 1 0))
          (planet "web.scm"  ("soegaard" "web.plt" 1 0)))

 ;;;
  ;;; SITE WIDE DEFAULTS
  ;;;
 
 (override-default current-page-title       "List it!")
 (override-default current-page-header      '(h1 ((class "page_header")) "List it!"))
 (override-default current-page-style-sheet "http://localhost/stylesheet.css")

 ;;;
  ;;; FRONT PAGE(S)
  ;;;
 
 (define (html-front-page page-number rank-of-first-entry entries)
   (html-page
    #:body `(div
             ,(html-menu)
             ,(html-list-of-entries page-number rank-of-first-entry entries))))

 (define (html-menu)
   `(a ((href "control.scm?action=submitnew")) "submit-new-link"))

 (define (html-submit-new-page)
   (html-page
    #:title  "List it! - submit"
    #:header '(h1 "List it!")
    #:body  
    `(div (h2 "Submit a new entry")
          ,(html-form
            "submitnewform" "control.scm"
            (html-input "action" #:value "submit" #:type 'hidden)
            `(table (tr (td "url")   (td ,(html-input "url" #:type 'text #:value "http://")))
                    (tr (td "title") (td ,(html-input "title" #:type 'text #:value "A title"))))
            (html-input "submit" #:value "submit")))))

 (define/kw (html-icon name #:key (class #f))
   (define (icon-absolute-url name)
     (format "/~a.png" name))
   (if class
       `(img ((class ,class) (src ,(icon-absolute-url name))))
       `(img (               (src ,(icon-absolute-url name))))))

 (define (html-list-of-entries page-number rank-of-first-entry entries)
   `(div ((class "entries"))
         ,@(list-ec
            (if (not (null? entries)))
            (:list entry (index i) (cdr entries))
            (:match #(id header url score) entry)
            `(table ((class "entry"))
                    (tr (td ((class "rank")) ,(number->string (+ i rank-of-first-entry)))
                        (td ,(let ((form (format "arrowform~a" id)))
                               (html-form form "control.scm"
                                          #:atts '((class "arrows"))
                                          (html-input "arrowitem"  #:type 'hidden)
                                          (html-input "entry_id" #:type 'hidden #:value id)
                                          (html-input "action"   #:type 'hidden #:value "updown")
                                          `(div ,(html-a-submit form "arrowitem" "up" (html-icon 'go-up #:class "arrow")))
                                          (html-a-submit form "arrowitem" "down" (html-icon 'go-down #:class "arrow")))))
                        (td (div (a ((href ,url)) ,header))
                            (span ((class "score")) "score: " ,score)))))))

 ; html-redirect-page
  ;   a standard text to show, when redirecting
  (define (html-redirect-page body)
   (html-page #:title "Redirecting"
              #:body  body))

 )

An Introduction to Web Development with PLT Scheme

2007-01-20T17:13:00.000+01:00

Introduction

From time to time people ask how to develop for the web with PLT Scheme on the PLT mailing list. The quick answer is "Just as in any other language", but that's not how to get people hooked on Scheme. To write a decent web-application require knowledge of a range of subjects such as HTML, databases, servlets, and web-servers. For some reason there is a lack of tutorials on these subjects, so I have decided to make an attempt at writing, if not a complete tutorial, then an elaborate get-started example.

The example application will be a mini version of Reddit called ListIt. The front page consists of a list of links to interesting articles, users can vote the articles up and down, and submit new articles. The hope is that the example is small enough to be easily understood, but on the other hand large enough to illustrate as many aspects as possible. Please leave comments on the blog: Did the example hit home? Is a paragraph in need of a rewrite? Did I skip something?

Model-View-controller

First things first. How should the program be organized? There is no need to reinvent the wheel, so I have chosen to use the Model-View-Controller architecture, which works just as well for web applications as it does for graphical user interfaces.

In a nutshell the Model-View-Controller architecture works like this: The model holds the data, the view displays data. User interactions goes through the controller in order to keep a separation between the model and the view. (See section 22.3 of HTDP or Wikipedia for more on MVC ).

In our case we will represent the model, the view and the controllers as three separate Scheme modules. The model will use a database to hold the links, the view will consists of functions generating HTML and the controller will the web-servlet that reacts on the user actions.

The Model

Today we will concentrate on the model. Each entry in our database consists of an entry-id , a title to display, an url to the article and a score representing the votes. Since we expect many entries in our database, we will think of them as divided into page. The number of entries in each page is given by the parameter PAGE-LIMIT.

The interface to our model consists of the following functions:

insert-entry: title url score -> entry-id
Insert a new entry into the database.

increase-score : entry-id ->
Increase the score of an existing entry

decrease-score : entry-id ->
Decrease the score of an existing entry

top : natural -> (list (list entry-id title url score))
Return the given number of entries with the highest scores

page : natural -> (list (list entry-id title url score))
Return the list of entries in the given page.

url-in-db? : url -> boolean
Is the url already listed?

These functions are the only ones to be exposed to the controller.

Implementation of the model

To implement these functions we will use an SQLite database. It wouldn't be unreasonable to argue that it would be easier to use a hash-table, but I want to illustrate how to use SQLite.

SQLite is small database engine, which comes in the form of a single self-contained, zero-configuration DLL-file on Windows or a a so-file on other platforms. We will use Jay McCarthy and Noel Welsh's PLT Scheme bindings sqlite.plt . On top of these binding we'll use a S-expression to SQL-string library written by me (it will appear on PLaneT soon - it has been submitted). On Windows you download SQLite by pasting the following into the DrScheme interaction window (the REPL):

(require (planet "download-sqlite.scm"
("soegaard" "sqlite.plt" 1 0))

To use the two SQLite packages, we start our module with

(require
(planet "sqlite.ss" ("jaymccarthy" "sqlite.plt"))
(planet "sqlite.ss" ("soegaard" "sqlite.plt" 1 0)))

Opening the database is simple:

(define db (open (string->path "c:/listit.sb"))) .

At least it will be, after it is created. The following function creates an empty database with a single table "entries":


(define (create-table-entries)
 (exec/ignore
  db
  #<<SQL
CREATE TABLE entries (
  entry_id  INTEGER PRIMARY KEY,
  title     TEXT,
  url       TEXT,
  score     INTEGER )
SQL
  ))

The #<< starts a so called here-string. The function exec/ignore executes an SQL-statement and ignores the result (there is no S-expression syntax for CREATE TABLE yet).

Once we have created the our table, we can begin writing the functions in our interface.
The first is:


(define (insert-entry title url score)
 (insert db (sql (INSERT INTO entries (title url score)
                         VALUES (,title ,url ,score)))))

The macro sql converts an S-expression representation of an SQL-statement into a string, which is then handed to SQLite by insert. The string produced by the sql macro from
(insert-entry "Everything Scheme" "http://www.scheme.dk/blog/" 42)
becomes
"INSERT INTO entries (title, url, score) VALUES ('Everything Scheme', 'http://www.scheme.dk/blog/', '42')".

The remaining functions from the interface are all simple SQL-statements, which can be studied in the full program below.

A loose end: In the source below the parameter current-database is used to hold the database. As a convenience I have with the help of syntax-id-rules defined the identifier db to expand to (current-database). But in order make everything work also as when the database isn't created yet, the actual definition below is a little more involved.

Testing

To test the model, open the "model.scm" in DrScheme. In the "Language" menu use "Choose Language" to choose the "Module" language. Click and "Run" and you are ready to test it:

Welcome to DrScheme, version 369.3-svn10jan2007.
Language: (module ...).
> (insert-entry "Everything Scheme" "http://www.scheme.dk/blog/" 42)
1
> (insert-entry "Reddit" "http://www.reddit.com" 7)
2
> (insert-entry "PLT Scheme" "http://www.plt-scheme.org" 5)
3
> (top 2)
(#4("entry_id" "title" "url" "score")
#4("1" "Everything Scheme" "http://www.scheme.dk/blog/" "42")
#4("2" "Reddit" "http://www.reddit.com" "7"))
> (increase-score 3)
> (increase-score 3)
> (increase-score 3)
> (increase-score 3)
> (top 2)
(#4("entry_id" "title" "url" "score")
#4("1" "Everything Scheme" "http://www.scheme.dk/blog/" "42")
#4("3" "PLT Scheme" "http://www.plt-scheme.org" "9"))
>

The Program

;;; model.scm  -- Jens Axel Søgaard

(module model mzscheme
(provide (all-defined))

(require
 (planet "sqlite.ss" ("jaymccarthy" "sqlite.plt"))
 (planet "sqlite.ss" ("soegaard" "sqlite.plt" 1 0)))

;;; CONFIGURATION

(define PAGE-LIMIT        (make-parameter 50))   ; number of entries on each page
  (define DATABASE-PATH     (string->path "listit.db"))
; initialization of the db happens at the first run, see bottom of this file
  (define current-database  (make-parameter #f))

;;; CONVENIENCE

; define db to be short for (current-database)
  (define-syntax db
  (syntax-id-rules () [db (or (current-database)
                              (let ([d (open DATABASE-PATH)])
                                (current-database d)
                                d))]))

;;; DATABASE CREATION

(define (create-table-entries)
  (exec/ignore
   db
   #<<SQL
 CREATE TABLE entries (
   entry_id  INTEGER PRIMARY KEY,
   title     TEXT,
   url       TEXT,
   score     INTEGER )
SQL
   ))

(define (drop-table-entries)
  (exec/ignore db "DROP TABLE entries"))


;; DATABASE INSERTION AND UPDATES

(define (insert-entry title url score)
  (insert db (sql (INSERT INTO entries (title url score)
                          VALUES (,title ,url ,score)))))

(define (increase-score entry-id)
  (update db (sql (UPDATE entries
                          SET (score = (+ score 1))
                          WHERE (= entry_id ,entry-id)))))

(define (decrease-score entry-id)
  (update db (sql (UPDATE entries
                          SET (score = (- score 1))
                          WHERE (= entry_id ,entry-id)))))


;;; DATABASE RETRIEVAL

(define (top n)
  (select db (sql (SELECT (entry_id title url score)
                          FROM entries
                          ORDER-BY (score DESC)
                          LIMIT ,n))))

(define (page n)
  (select db (sql (SELECT (entry_id title url score)
                          FROM entries
                          ORDER-BY (score DESC)
                          LIMIT ,(PAGE-LIMIT) OFFSET ,(* (PAGE-LIMIT) n)))))

(define (entries-with-url url-str)
  (select db (sql (SELECT (entry_id title url score)
                          FROM entries
                          WHERE ,(format "url='~a'" url-str)))))

(define (url-in-db? url-str)
  (let ([result (entries-with-url db url-str)])
    (if (null? (entries-with-url db url-str))
        #f
        result)))


;;; INITIALIZATION

; on first run, create tables
  (unless (and (file-exists? DATABASE-PATH)
             (table-exists? db "'entries'"))
  (create-table-entries)
  (current-database (make-parameter (open DATABASE-PATH)))))

A self-evaluating evaluator

2006-12-22T12:15:00.000+01:00

December is always a busy month, so the number of blog posts have been low for a while. To make up for it, I have been digging in the archives and found a self-evaluating evaluator. Erann Gat back in 2002 asked the following question in comp.lang.scheme:

The topic of self-generating programs (a program whose output is itself) comes up periodically here, but I've never seen the topic of a self-evaluating program discussed. Of course, meta-circular interpreters are ubiquitous, but the usual metacircular interpreter you find in textbooks typically evaluates a slightly different dialect than it is actually written in.

My question is: what is the shortest meta-circular
interpreter that is actually capable of evaluating itself?

It was quite fun to write a short meta-circular interpreter. The shortness-constraint creates a tension between powerful constructs and easily-implementable constructs, when choosing language features to include in the language. My solution below has the following features:

conditional construct
functions (of one argument)
application
quotation

This set of features is pretty minimal. The requirement that the evaluator must be self-evaluating means, it must be possible to pass the code of the evaluator to the evaluator, so quotation is just the right tool. Note that variable assignment (set!) is missing.

Since only functions of one argument is supported, it is necessary to curry the normal Scheme functions in the initial environment given to the evaluator. This can be seen in the following version of factorial:

; Support code for fak-example
(define (plus a) (lambda (b) (+ a b)))
(define (mult a) (lambda (b) (* a b)))
(define (one? x) (= x 1))
(define (sub1 n) (- n 1))

(define fact '(lambda (f)
               (lambda (n)
                 (cond
                   [(one? n)  1]
                   [#t        ((mult n) ((f f) (sub1 n)))]))))

(define fact-code (list (list fact fact) 5))

The standard definition of factorial is recursive. The chosen languages supports neither recursive bindings nor assignment, so instead we use the same trick, the Y-combinator uses. To calculate factorial of 5, one must write: ((fact fact) 5).

Since the evaluator must be self-evaluating, the definition of the evaluator uses the same trick as the factorial example. To call the evaluator on the factorial program, one writes:

(((jas-eval jas-eval) expression) initial-env)

And if we want to let the evaluator evaluate

(jas-eval (fak 5) initial-env)

we write

 (define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote fac-code)) initial-env))
(((jas-eval jas-eval) expression) initial-env)

After posting version 1 of the evaluator, Joe Marshall asked a very interesting question:

For the sake of curiosity, how much slower is the extra interpretation layer?

Can you go another level deeper?

The timings on my current computer is as follows:


; jas-eval evaluating "(fact 5)"
cpu time: 0 real time: 0 gc time: 0
120
; jas-eval evaluating "(jas-eval (fact 5))"
cpu time: 15 real time: 16 gc time: 0
120
; jas-eval evaluating "(jas-eval (jas-eval (fact 5)))"
cpu time: 922 real time: 954 gc time: 0
120
; jas-eval evaluating "(jas-eval (jas-eval (jas-eval (fact 5))))"
cpu time: 63891 real time: 66109 gc time: 12122
120

Exponential regression reveals the slow down to be 65 per level (R squared is 0.9999).

; Self evaluating evaluator, version 2
; Jens Axel Soegaard, oct 2002

(define first car)
(define second cadr)
(define third caddr)
(define rest cdr)

; Support code for fak-example
(define (plus a) (lambda (b) (+ a b)))
(define (mult a) (lambda (b) (* a b)))
(define (one? x) (= x 1))
(define (sub1 n) (- n 1))

(define fact '(lambda (f)
                (lambda (n)
                  (cond
                    [(one? n)  1]
                    [#t        ((mult n) ((f f) (sub1 n)))]))))

(define fact-code (list (list fact fact) 5))

; Conventions:  n name, v value, r environment, e expression
(define code-jas-eval
  '(lambda (ev)
     (lambda (e)
       (lambda (r)
         (cond
           [(symbol? e)      (r e)]
           [(not (pair? e))  e]
           [(pair? e)        (cond
                               [((ceq? (first e)) 'quote)  (first (rest e))]
                               [((ceq? (first e)) 'cond)
                                (cond
                                  [(((ev ev) (first (second e))) r)  (((ev ev) (second (second e))) r)]
                                  [#t                                (((ev ev) ((ccons 'cond) (rest (rest e)))) r)])]
                               [((ceq? (first e)) 'lambda)              (lambda (x)
                                                                       (((ev ev) (third e))
                                                                        (lambda (n)
                                                                          (cond
                                                                            [((ceq? (first (second e))) n)   x]
                                                                            [#t                           (r n)]))))]
                               [#t                                   ((((ev ev) (first e)) r)
                                                                      (((ev ev) (second e)) r))])])))))

; setup initial environment;
; currying the primitives used in the evaluator
(define (ceq? a)
  (lambda (b)
    (eq? a b)))

(define (ccons a)
  (lambda (b)
    (cons a b)))

(define initial-env eval)

; use Scheme-eval to get jas-eval
(define jas-eval (eval code-jas-eval))
(define initial-env eval)

; use jas-eval to evaluate (fact 5)
(define expression fact-code)
(time (((jas-eval jas-eval) expression) initial-env))

; use jas-eval to evaluate (jas-eval (fact 5) initial-env)
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote fact-code)) initial-env))
;expression
(time (((jas-eval jas-eval) expression) initial-env))

; use jas-eval to evaluate (jas-eval (jas-eval (fact 5) initial-env))
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote fact-code))  initial-env))
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote expression)) initial-env))
;expression
(time (((jas-eval jas-eval) expression) initial-env))


; use jas-eval to evaluate (jas-eval (jas-eval (jas-eval (fact 5) initial-env)))
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote fact-code))  initial-env))
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote expression)) initial-env))
(define expression (list (list (list code-jas-eval code-jas-eval) (list 'quote expression)) initial-env))
;expression
(time (((jas-eval jas-eval) expression) initial-env))

Random Number Generation

2006-12-11T21:31:00.000+01:00

The Scheme Cookbook has a few recipes on random number generation. Why not turn them into a library?

Once upon a time I got bitten by the random number generation bug and did just that. I wrote large parts of the random.plt library available through PLaneT.

"Huh - where exactly?", I hear you say. Well, the library were submitted when PLaneT were in its infancy, so it appears under the 2xx-page. After two major updates since the 200-series no one checks the old libraries (not even the PLT Source Browser), so not surprisingly the random number library is forgotten.

After "porting" (well, I *did* change a single line) it is now available again.

The documentation contains the gory details, so I'll just give a few examples:

> (require (planet "random.ss" ("schematics" "random.plt" 1 0)))

; Good old Gaussian distribution
> (random-gaussian)
0.7386912134436788

; A "stochastic variable"

> (define X (random-source-make-gaussians default-random-source))
> (X)
0.5826066449247809
> (X)
0.7865269446783535

; Other stuff
> (random-gamma 1)
0.013863292728449427

> (random-permutation 5)
#5(3 1 2 4 0)

> (random-chi-square 1)
1.1334523156657883

The source contains an implementation by Sebastian Egner of a very interesting algorithm. It is the generation of random number following a discrete distribution, which surprisingly can be implemented efficiently.

(random-source-make-discretes s w)
given a source s of random bits in the sense of SRFI-27
and a vector w of n >= 1 non-negative real numbers,
this procedure constructs and returns a procedure rand
such that (rand) returns the next integer x in {0..n-1}
from a pseudo random sequence with

Pr{x = k} = w[k] / Sum(w[i] : i)

for all k in {0..n-1}.

Think about it - how would you implement it?

PLT Scheme version 360

2006-11-20T23:03:00.000+01:00

There is now a new release of PLT Scheme in town. Download it from your
local bit-pusher.

To me the most exciting feature is Ryan Culpepper's macro stepper, which will be prove to be an invaluable tool when it comes to understanding and debugging macros.

The release announcement:

PLT Scheme version 360 is now available from

http://download.plt-scheme.org/

DrScheme now has a macro stepper that traces through macro expansion step by step. The graphical display uses colors to illustrate bindings and a side-panel to display additional syntax information.

For additional information and an illustrated introduction, see http://www.ccs.neu.edu/home/ryanc/macro-stepper

PLT Scheme now includes a new "Lazy Scheme" language level, similar to MzScheme (with a few added libraries), but with call-by-need semantics. There is also a "lazy" collection that can be used to mix lazy code with eager code (put the former in a module that uses(lib "lazy.ss" "lazy") as its language module).

New support for prompts and composable continuations, closely resembling Dorai Sitaram's tagged `%' and `fcontrol' operators. The new "control.ss" library provides implementations of many other delimited-continuation operators, including `prompt', `control', `shift', `reset', `spawn', `splitter', and `cupto'. Moreover, these operators all work in a reasonable and useful way with each other, with dynamic-wind', and with continuation marks (which can be used for dynamic variables).

For more information, see Sitaram's papers at http://www.ccs.neu.edu/scheme/pubs/

Regexp support now includes the usual collection of "Perl-compatible" features: numeric quantifiers, backreferences, character classes, Unicode predicates, case-insensitive mode, multi-line mode, lookahead, lookbehind, non-backtracking, and conditionals --- all with improved performance.

Compiler improvements include a lambda-lifting pass and better handling of `call-with-values'.

The "readline" collection is now included. MzScheme cannot load this library by default, since linking to GNU readline would require licensing PLT Scheme under GPL instead of LGPL. However, you can link readline yourself by adding

(when (regexp-match? #rx"xterm" (getenv "TERM"))
(dynamic-require '(lib "rep.ss" "readline") #f))

in your "~/.mzschemerc" to use readline for MzScheme's REPL.

DivaScheme - Structural Editing for DrScheme

2006-10-21T22:20:00.000+02:00

A small team consisting of Romain Legendre, Guillaume Marceau, Danny Yoo, Kathi Fisler and Shriram Krishnamurthi have created a set of alternative keybindings for DrScheme.

DrScheme has always had keybindings that enabled you to work with whole s-expressions. Like Emacs the normal keybindings require a lot of finger gymnastics due to the use of ctrl/alt/shift. Inspired by Vi the DivaScheme bindings are unchorded. Instead of modifier keys, the editor now have two modes: a command/navigation mode and an insert mode. In command mode x is simply bound to cut, where as x in insert mode inserts an x.

DivaScheme has several features that die-hard Emacs-fans will appreciate. For example keyword-completion a la etags from Emacs. The move-by-searching idiom is also supported via the s command.

It is difficult to explain how the keybindings work in practice, bun fortunately Danny Yoo made this little video to introduce DivaScheme:

Read more on the DivaScheme homepage and in the DivaScheme documentation.

Scheme Search gets pattern matching

2006-10-21T01:27:00.000+02:00

This week I had time to work on the search engine again.

From a user view point the most important change is the addition of pattern matching. Until now it was possible to find all documents, where a particular identifier occurs. If on the other hand you were unsure which identifier to search for, you were out of luck. Now you can search for occurrences of identifiers matching a regular expression.

Say you vaguely remember someone using a define- something - struct. A pattern match search for define alone gives 6993 hits. But a search for define-.*-struct gives only 22 hits (the first of which contains define-serializable-struct).

The implementation of the pattern matching search is kept very simple. There are only 150.000 search terms, so the naïve approach of simply matching all terms against the pattern one at a time is fast enough. At least for the moment... After the matching terms have been found, they are looked up in the index and finally the list of documents are ranked.

Under the hood the representation of the lexicon changed from an in-memory hash-table to a disk-based representation. This has two advantages: the web-server uses less memory and the lexicon uses less space on disk (although it resides in-memory, it was read in, when the web-server started). The disadvantage is that searches now requires disk-access. To keep disk access to a minimum, the lexicon is read in blocks of 100 terms, and a few recently used blocks are cached. If there is a need to look up several terms, it is now best to look them up in alphabetical order.

The plan is to use the disk space saved for more indexes. Perhaps an index over the documentation a la the HelpDesk? Unfortunately I haven't got enough disk-space enough to implement "preview" of search results.

In other news Google has released their Google Code Search. It indexes source from Sourceforge, Google Code and other public repositories.

To search for Scheme source add

file:(.scm|.ss|.sch)

to the beginning of your query.

Try the above and search for "srfi" to see the how many Scheme projects they have found.

PLT Scheme Source Search Goes Live

2006-09-25T19:33:00.000+02:00

An alpha version of PLT Scheme Source Search is now live. There is no bells and whistles, but the basic functionality is there. The source of all PLaneT packages and all builtin collections of PLT Scheme are indexed. The results link to the PLT Source Browser.

The PLT Scheme Source Search is the place to turn to, if you have questions like:

Is define or lambda most popular?
Who has the most TODOs in his source?
Are there any profanity?
Where is an example of local-expand?
Where is set! abused?
Is the number 42 more popular than 13?

The development of the search engine is described in these blog posts:

The next step in the project is to implement a disc based lexicon. Right now only the index is disc based, where as the lexicon is an in-memory hash table.

Orange Espresso

2006-08-16T22:44:00.000+02:00

The blog has always needed colors. Today I finally did something about it.

Thanks to the Flickr user Doozzle and his great shot of espresso (pun intended).

Doozzle: Ok, this is a detail of the foam the espresso shot left on a transparent cup. Taken with a soft light slightly above and behind the cup.

Eager Comprehensions for Black Belts - 4. Advanced Generators

2006-08-14T15:37:00.000+02:00

4. Advanced Generators

Local variables

Consider this scenario, where we want to produce a list of the even results of a long computation:


 (list-ec (:list x '(1 2 3 4 5))
          (if (even? (long-computation x)))
          (long-computation x))

The above solution will call long-computation twice with the same value. Introducing a local variable with the :let-generator (:let <vars> <expression>) solves this.


 (list-ec (:list x '(1 2 3 4 5))
          (:let r (long-computation x))
          (if (even? r))
          r)

Parallel loops

The generator (:parallel <generator>*) runs several generators in parallel. It advances its subgenerators in one step.


  (list-ec (:parallel
              (: x '(one two three))
              (: y '(1   2   3)))
           (list x y))             
   ; => ((one 1) (two 2) (three 3))

The (:parallel ...) generator stops, when any of its sub-generators stop.


   (list-ec (:parallel
              (: x '(one two three))
              (: y '(1   2)))
            (list x y))              
   ; => ((one 1) (two 2))

The generator (:while <generator> <expression>) runs the generator <generator> while <expression> return non-#f. This can be used to stop a generator before it is done.


 (list-ec (:while (: i 1 100000)
                  (< i 5))
          i)                      ;=> (1 2 3 4)

Since :while stops the inner generator, it is better to use :while than to use a qualifier to skip all values after a certain point. Compare these timings:


 (time (sum-ec (:while (: i 1 10000000)
                       (< i 100000))
               i))
 ; cpu time: 47 real time: 47 gc time: 0

 #;
 (time (sum-ec (: i 1 10000000)
               (if (< i 100000))
               i))
 ; cpu time: 3672 real time: 3687 gc time: 0

The :while-generator tests the expression before advancing the generator. The :until-generator tests after.


 (list-ec (:until (: i 1 100000)
                  (= i 5))
          i)                     ;=> (1 2 3 4 5)

The simple :do loop

The generator :do is a "do-while"-generator (it runs while the test is true - in contrast the normal Scheme do operator is a "do-until", it runs until the test becomes true).

The simple form is (:do (<lb>*) <ne1?> (<ls>*)). Here <lb>* is zero or more loop bindings, <ne1?>; is the "while" expression and determines whether the loop stops. Finally <ls>* are "loop-steppers", expressions whose evaluation results are bound to the loop variables.

A simple example (:do () #f ()) has no loop variables, and stops immediately, since the "while"-expression is #f.


 (list-ec (:do () #f ())
          1)               ; => ()

In contrast (:do () #t ()) will give an infinite loop.


 (list-ec (:do () #t ())
          1)             ; => loops till ram is exhausted

A loop that counts upwards forever: (:do ((x 0)) #t ((+ x 1))). To test it we put it inside a :while.


 (list-ec (:while (:do ((x 0)) #t ((+ x 1)))
                  (< x 5))
          x)                                 
  ;=> (0 1 2 3 4)

It is however better to use that :do is a "do-while".


(list-ec (:do ((x 0)) (< x 5) ((+ x 1)))
      x)                                  ;=> (0 1 2 3 4)

Updating two variables by repeatedly subtracting the smaller from the larger leads to Euclid's algorithm for calculating the greatest common divisor. The :do-generator makes it easy to store the intermediate steps in the calculation.


 (define (update a b) (if (< a b) a (- a b)))
 (list-ec (:do ((x 8333)
                (y 10897))
               (not (= x y))
               ((update x y)
                (update y x)))
          (list x y))

 ; => ((8333 10897) (8333 2564) (5769 2564) (3205 2564)
 ;     (641 2564) (641 1923) (641 1282))

so the greatest common divisor of 8333 and 10897 is 641.

Just as in a normal do-loop all the step-expressions are evaluated before they are bound to the loop- variables.


 (list-ec (:do ((x 0) (y 1))
               (< x 10)
               (y          ; -> x
                (+ x y)))  ; -> y
            (list x y))

 ; => ((0 1) (1 1) (1 2) (2 3) (3 5) (5 8) (8 13))

If x had been updated before (+ x y) were evaluated the result would have been
((0 1) (1 2) (2 4) (4 8) (8 16)).

The syntax of the simple :do-generator is


 (:do (<lb>*)    ; loop bindings
      <ne1?>     ; "while"-expression
      (<ls>*))   ; loop-step-expression

Lets take a look under the hood. [We'll need that later]

The generator expands to this loop:


(let loop (<lb>*)
  (if <ne1?>
     (let ()
          payload
          (loop <ls>*))))

where payload depends on the enclosing comprehension.

E.g. if the outer comprehension is (list-ec (:do ...) x) then the payload is (set! result (cons x result)).

The :do-generator is the one to turn to, if none of the builtin generators suit your needs. However the simple form turns out to be too simple for some cases.

Consider this attempt to write :list in terms of :do :


 (list-ec (:do ((xs (list 2 3 4))
                (x 1))
               (not (null? xs))
               ((cdr xs)          ; -> xs
                (car xs)))        ; -> x
          x)
 ; => (1 2 3)

The problem here is that 4 is missing from the result list.

The advanced :do loop

This section is for black belts. The advanced :do generator is meant to be used only by people interested in defining their own custom generators - and even then, in most cases a custom generator can be built without the advanced :do generator.

The advanced :do generator is more flexible than the simple, but requires a little time getting used to. It is worth learning though, as we will se a little later.

In fact all the pre-defined generators are defined in terms of the advanced :do-generator. Let us examine how the :list-generator works.

The (cleaned up version of) the expansion of


  (list-ec (: x '(1 2 3 4)) x)

is:


(reverse
  (let ((result '()))
    (let loop ((t '(1 2 3 4)))
      (if (not (null? t))
        (let ((x (car t)))
          (set! result (cons x result))
          (loop (cdr t)))))
    result))

We notice that list-ec sets up a result list, into which elements are consed using (set! result (cons x result)). When the list is returned it is reversed.

The loop itself has

a set of loop-bindings ((t '(1 2 3 4)))
a "while"-expression (not (null? t))
a set of inner bindings ((x (car t)))
a payload from the comprehension (set! result (cons x result))
a set of loop-step-expressions (cdr t)

The advanced :do-generator makes it possible to write loops which has a similar structure.

The syntax of the advanced :do is:


 (:do (let (<ob>*) <oc>*) (<lb>*) <ne1?> (let (<ib>*) <ic>*) <ne2?> (<ls>*))

                                     <ob>*  outer bindings
                                     <oc>*  outer commands
(let loop ((t '(1 2 3 4)))              <lb>*  loop bindings
(if (not (null? t))                   <ne1?>
   (let ((x (car t)))                <ib>*  inner bindings
                                     <ic>*  innner commands
     (set! result (cons x result))   payload from comprehension
     (if #t                          <ne2?>
         (loop (cdr t))))))          <ls>*  loop steps

That is (list-ec (:list x '(1 2 3 4)) x) is equivalent to


 (list-ec (:do (let ())
               ((t '(1 2 3 4)))
               (not (null? t))
               (let ((x (car t))))
               #t
               ((cdr t)))
          x)
 ; => (1 2 3 4)

Consider now the expansion of the general


(:do (let (<ob>*) <oc>*) (<lb>*) <ne1?> (let (<ib>*) <ic>*) <ne2?> (<ls>*))

(let (<ob>*)
<oc>*
(let loop (<lb>*)
 (if <ne1?>
     (let (<ib>*)
       <ic>*
       payload
       (if <ne2?>
           (loop <ls>*) )))))

The outer bindings is used to set up helper variables, before the loop.

The outer commands for once-only side effects before the loop starts.

The loop bindings <lb>* are used for variables updated in the loop.

The before "while"-expression <ne1?> is tested before the payload.

The inner bindings <ib*> is used to set up temporary variables
for use in the loop body.

The inner commands <ic>* is used for side effects which is to be
executed in the loop.

The payload is work to do be done for the comprehension.

The after "while"-expression <ne1?> is tested after the payload.

The loop step expressions determine the next value of the loop
variables.

Lost your breath? Sebastian Egner puts it like this: "The design of :DO is a compromise between how complicated structures can be expressed, while retaining the ability to merge the loops in parallel". The following example will hopefully clear things up. It will later be reused to illustrate how to make a custom generator.

Combinations

The problem of generating all k combinations of the n numbers
0,1,...,n-1 provides a nice example of the advanced :do-generator.
The list of 3,5-combinations are


 (#3(0 1 2) #3(0 1 3) #3(0 1 4) #3(0 2 3) #3(0 2 4) #3(0 3 4)
  #3(1 2 3) #3(1 2 4) #3(1 3 4)
  #3(2 3 4))

The first combination is #(0 1 2) and the last combination is #3(2 3 4).
Given helper funcions first-combination, last-combination?, and
next-combination we can use the advanced :do-generator as follows.


(list-ec (:do (let ((k 3) (n 5)))
           ((c (first-combination k n)))
           c ; first-combination returns #f if k<=0 or k>n
           (let ())
           (not (last-combination? k n c))
           ((next-combination k n c)))
      c)

Here are the helper functions.


(define (vr v i)                  (vector-ref v i))
(define (vs! v i x)               (vector-set! v i x))
(define (incrementable? v i k n)  (< (vr v i) (+ n (- k) i)))

(define (last-combination? k n v) (= (vr v 0) (- n k)))

(define (first-combination k n)
(if (<= 1 k n)
   (vector-ec (: i 0 k) i)
   #f))

(require (lib "43.ss" "srfi")) ; for vector-copy
(define (next-combination k n v)
(last-ec #f ; default, when there is no next combination
        (:let v (vector-copy v))
        ; find the last incrementable index
        (:let i (last-ec #f (:until (: i (- k 1) -1 -1)
                                    (incrementable? v i k n))
                         i))
        (if i)
        ; increment index i and fix indices to the right of i
        (:parallel (: j i k)
                   (: vj (+ (vr v i) 1) n))
        (begin (vs! v j vj))
        ; if all indices is fixed we have a new combination
        (if (= j (- k 1)))
        ; return the new combination
        v))

Eager Comprehensions for Black Belts - 3. Multiple generators (nested loops) and qualifiers (filtering)

2006-08-12T21:47:00.000+02:00

3. Multiple Generators (nested loops) and qualifiers (filtering)

Comprehensions allow multiple generators. Consider:


    (list-ec (: x 2)
             (: y 3)
             (list x y))   ; =>  ((0 0) (0 1) (0 2)
                           ;      (1 0) (1 1) (1 2))

The inner (last) generator spins faster than the outer generator. Since the scope of variables bound by a generator begins after the generator expression, it is possible to refer to variables bound by previous generators.


    (list-ec (: x 3)
             (: y (+ x 1))
             (list x y))     ; => ((0 0)
                             ;     (1 0) (1 1)
                             ;     (2 0) (2 1) (2 2))

At this point we are capable of generating loads of values, but sometimes we want to skip some of them.

Consider the problem of finding small integers such that:

  x^2 + y^2 = z^2 .

A valid strategy is to let x, y and z run from, say, 1 to 100, and skip the triples which doesn't fulfill the equation. To mimic this strategy we will use qualifiers.

The following qualifiers are available for filtering:

  
    (if  <test>)
    (not <test>*)
    (and <test>*
    (or  <test>*)

[Besides the filtering qualifiers all generators, as well as
(begin <sequence>) and (nested <qualifier>*) are also qualifiers.]


    (list-ec (: x 1 100)
             (: y x 100)
             (: z y 100)
             (if (= (+ (* x x) (* y y))
                    (* z z)))
             (list x y z))               ; => ((3 4 5)
                                         ;     (5 12 13)
                                         ;     (6 8 10)
                                         ;     ...
                                         ;     (60 63 87)
                                         ;     (65 72 97))

The common cases (if (not <test>)), (if (and <test>*)), and (if (or <test>*)) are abbreviated by (not <test>), (and <test>*), and (or <test>*).

    
    (list-ec (: x 1 4)
             (: y 1 4)
             (not (= x y))
             (list x y))    ; => ((1 2) (1 3)
                            ;     (2 1) (2 3)
                            ;     (3 1) (3 2))

Eager Comprehensions for Black Belts - 2. Basic Comprehensions

2006-08-09T12:23:00.000+02:00

2. Basic Comprehensions

Comprehensions accumulate the values generated into a result. So far the only comprehension used have been list-ec. There are multiple comprehensions to choose from, when deciding how to accumulate the computed values.

The comprehensions vector-ec and string-ec are analogous to list-ec. The accumulated values of string-ec must all be characters.


 (vector-ec (: i 5)
            i)                    ; => #5(0 1 2 3 4)

 (string-ec (: c '(#\c #\a #\r))
            c)                    ;=> "car"

If the length of the result vector is known ahead of time, one can use vector-of-length-ec, which is more efficient than vector-ec.


   (vector-of-length-ec 3 (: x 3)
                          x)        ; => #3(0 1 2)

Instead of first generating a list of lists, or a list of strings and then applying append or string-append, it is more convenient to use append-ec and string-append-ec.


   (append-ec (: x '((1 2) (3 4 5) (6)))
               x)                          ; => (1 2 3 4 5 6)

   (string-append-ec (: x '("foo" "bar" "qux"))
                     x)                   ; => "foobarqux"

The comprehensions sum-ec, product-ec, min-ec and max-ec work on numbers.

    
    (sum-ec (: x '(1 2 3 4))
            x)                     ;=> 10

    (product-ec (: x '(1 2 3 4))
                x)                 ; => 24

    (min-ec (: x '(1 2 3 4))
             x)                    ; => 1

    (max-ec (: x '(1 2 3 4))
             x)                    ; => 4

For min-ec and max-ec the the generated sequence of values must be non-empty.

There are two boolean comprehensions any?-ec and every?-ec. They test whether at-least-one or all of the computed values were true.

   
    (every?-ec (: x 1 10)
               (even? x))   ; => #f

    (any?-ec (: x 1 10)
             (even? x))     ; => #t

Note: any?-ec and every?-ec (just as their cousins or and and) are "early stopping". As soon as any?-ec encounters a #t it stops. every?-ec stops when a #f is seen.

Eager Comprehensions for Black Belts - 1. Basic Generators

2006-08-08T12:24:00.000+02:00

1. Basic Generators

Range generators

A generator binds a variable (or more) to a sequence of values.

The generator :range is used to generate the values of a numerical range. The simplest form is (:range <vars> <stop>) which generates the values 0, 1, ..., <stop>-1.

    (list-ec (:range i 5)
          i)              ; => (0 1 2 3 4)

The form (:range <vars> <start> <stop>) is used when the
start value is different from 0.

   (list-ec (:range i 3 7)
           i)              ; => (3 4 5 6)

The form (:range <vars> <start> <stop> <step>) allows other step sizes than +1.

   (list-ec (:range i 0 8 2)
          i)              ; => (0 2 4 6)

 (list-ec (:range i 0 9 2)
          i)              ; => (0 2 4 6 8)

The generator stops when <stop> is reached or crossed. This rule also applies when the step size is negative:

   (list-ec (:range i 5 0 -1)
          i)                  ; => (5 4 3 2 1)

Note that :range works for integers only, simple stepping leads to accumulation of rounding errors when using reals. To generate a sequence of reals, use :real-range instead. It calculates the value from the index.

   (list-ec (:real-range i 0 2 0.5)
          i)                       ; => (0.0 0.5 1.0 1.5)

The special generator : which uses the types of its arguments to dispatch to various generators, uses :range and :real-range when given numerical arguments.

   (list-ec (: i 5 0 -1)
          i)             ; => (5 4 3 2 1)

 (list-ec (: i 0 2 0.5)
          i)             ; => (0.0 0.5 1.0 1.5)

The dispatch happens at run time, so : is slightly slower than using :range directly.

[See also :integers and :char-range]

Element generators

A very common use of generators is to run through the elements of a data structure such as a list, a string or a vector.

The simplest form of :list runs through the elements of a list.

   (list-ec (:list x '(1 2 3))
          (* x 2))                        ; (2 4 6)

It is possible to run through more than one list at a time:

   (list-ec (:list x '(1 2) '(3 4) '(5 6))
          (* x 2))                        ; => (2 4 6 8 10 12)

The generators :vector and :string works in the same way, but on vectors and strings.

   (list-ec (:vector x '#(1 2 3))
           x)                            ; => (1 2 3)

 (list-ec (:string x "abc" "def")
          x)                       ; => (#\a #\b #\c #\d #\e #\f)

The dispatching generators uses :list, :vector and :strings, when the type of its arguments are lists, vectors and strings respectively.

   (list-ec (: x '(1 2 3))
          (* x 2))           ; => (2 4 6)

Scope of variables bound by a generator

A variable bound by a generator can be used after the closing parenthesis of the generator expression and extends to the end of the comprehension.

Eager Comprehensions for Black Belts - An SRFI 42 Tutorial

2006-08-08T12:14:00.000+02:00

Eager comprehensions from SRFI-42 provide a convenient notation for writing loops generating a sequence of values, and optionally accumulating the values into a result. Inspired by Peter Seibel's chapter "LOOP for Black Belts" in "Practical Common Lisp" the following is an attempt to show the utility of eager comprehensions.

Eager comprehensions (think: loops) can sequentially bind variables to numbers in a numerical range

sequentially bind variables to elements in a data structure
execute arbitrary Scheme expressions
conditionally perform parts of the loop

An eager comprehension consists normally of 3 components:

a comprehension, that accumulates the result
some generators, that produces sequences of values
an expression that uses the generated values, to
compute a value, the comprehension can accumulate

This sounds worse than it is, so consider the example:


(require (lib "42.ss" "srfi"))
(list-ec (: i 5)
        (* i 2))
; => (0 2 4 6 8)

The generator (: i 5) binds in turn i to 0, 1, 2, 3, and 4.
The expression (* i 2) is evaluated for each binding of i.
The computed values 0, 2, 4, 6 and 8 are accumulated by the comprehension list-ec. The list comprehension list-ec accumulates the computed values into a list.

The master plan is now as follows:

Basic generators
Basic comprehensions
Multiple generators (nested loops) and qualifiers (filtering)
Advanced Generators
Multiple accumulators
Defining custom comprehensions

Expect one post a day.

References:

How to Write an Unhygienic Macro - Introducing an Identifier Into the Lexical Context of a Macro Call

2006-05-31T23:47:00.000+02:00

The standard syntax-rules macro system of R5RS Scheme is hygienic

If a macro transformer inserts a binding for an identifier (variable or keyword), the identifier will in effect be renamed throughout its scope to avoid conflicts with other identifiers.

and referentially transparent

If a macro transformer inserts a free reference to an identifier, the reference refers to the binding that was visible where the transformer was specified, regardless of any local bindings that may surround the use of the macro.

These properties of the macro system make the majority of macros easy to write and understand. In some situations it is nevertheless convenient to break the rules. A classic example is the if-it macro.

Syntax: (if-it test consequent alternative)

Semantics: An if-it expression is evaluated as follows: first, test is evaluated and its result is bound to it. If the result is a true value, then consequent is evaluated and its value(s) is(are) returned. Otherwise is evaluated and its value(s) is(are) returned. In consequent and alternative references to it will be bound to the it inserted by if-it.

Examples:
(if-it 1 it 'bomb) ; => 1
(let ((it 'bomb)) (if-it 1 it it)) ; => 1

It isn't too difficult to write such a macro with the syntax-case macro system. It is however a little tricky to ensure the resulting if-it macro can be used by other macros without knowledge of how if-it is implemented - at least until one discovers the following easy-to-use technique.

  (define-syntax (if-it stx)
  (syntax-case stx ()
    [(if-it e1 e2 e3)
     (with-syntax ([it (syntax-local-introduce
                        (syntax-local-get-shadower #'it))])
       #'(let ([it e1])
           (if it e2 e3)))]))

The solution uses two seldomly used functions namely syntax-local-introduce and syntax-local-get-shadower. The last of these are relatively unknown - a search reveals it is only used four times in total in the PLT code base - therefore a quote from the documentation is in order.

(syntax-local-get-shadower identifier) returns identifier if no binding in the current expansion context shadows identifier, if identifier has no module context, and if the current expansion context is not a module. If a binding of inner-identifier shadows identifier, the result is the same as (syntax-local-get-shadower inner-identifier), except that it has the location and properties of identifier. Otherwise, the result is the same as identifier with its module context (if any) removed and the current module context (if any) added. Thus, the result is an identifier corresponding to the innermost shadowing of identifier in the current context if its shadowed, and a module-contextless version of identifier otherwise.

In short syntax-local-get-shadower allows the macro writer to break referential transparency. The call (syntax-local-get-shadower #'it) will return the identifier to which it is bound at the site of the macro call (and not at the site of definition).

Inserting the result of (syntax-local-get-shadower #'it)directly into the template of if-it won't work as expected though. The macro system is hygienic by default, so the identifier will subjected to renaming and will therefore not bind uses at the call site. Preventing renaming is easy though, just call syntax-local-introduce.

To test that if-it behaves properly when used in the definition of other macros and also works with the module system I used the following tests. The four tests all return #t.

(module mod-if-it mzscheme
 (provide if-it)
 (define-syntax (if-it stx)
   (syntax-case stx ()
     [(if-it e1 e2 e3)
      (with-syntax ([it (syntax-local-introduce
                         (syntax-local-get-shadower #'it))])
        #'(let ([it e1])
            (if it e2 e3)))])))

(module mod-cond-it mzscheme
 (require mod-if-it)
 (provide cond-it)
 (define-syntax (cond-it stx)
   (syntax-case stx (else)
     [(cond-it)
      #'(void)]
     [(cond-it [else e])
      #'e]
     [(cond-it [q1 a1] more ...)
      #'(if-it q1 a1 (cond-it more ...))])))

(require mod-cond-it)

(cond-it
[#t it]
[#t 'nope])

(let ((it 42))
 (cond-it
  [#t it]
  [#t 'nope]))

(let ((if-it 43))
 (let ((it 42))
   (cond-it
    [#t it]
    [#t 'nope])))

(require mod-if-it)

(equal? '((b c) (y z))
        (cond-it
         [(memq 'b '(a b c))
          (let ((it0 it))
            (if-it (memq 'y '(x y z))
                   (list it0 it)
                   'nope0))]
         [#t 'nope1]))