Planet Scheme

October 31, 2014

Programming Praxis

Belphegor Primes

Belphegor is one of the Seven Princes of Hell, charged with helping people make ingenious inventions and discoveries. Simon Singh gave the name Belphegor’s Prime to the number 1000000000000066600000000000001, which is the Number of the Beast, 666, from the Apocalypse, surrounded on each side by an unlucky 13 zeroes. Generally, Belphegor numbers Bn = (10^(n+3) + 666)*10^(n+1) + 1 have a 1, followed by n zeroes, followed by 666, followed by n zeroes, followed by 1. There are eight known Belphegor primes, with n ∈ {0, 13, 42, 506, 608, 2472, 2623, 28291} (A232448). You can read more about Belphegor primes at Cliff Pickover’s page.

Your task is to write a program that enumerates the Belphegor primes. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

by programmingpraxis at October 31, 2014 09:00 AM

October 29, 2014

Ben Simon

Praise for Siri and a quick (and surprisingly satisfying) mobile version of Eliza

My friend (and famous author!) Christian Cantrell posted a touching story on Google Plus: To Siri, With Love: How One Boy With Autism Became BFF With Apple’s Siri. It's more than worth your time to read. However, a quick take on it is it that Siri has a number of attributes that make it an excellent companion for the author's Autistic Son(for example: Siri doesn't mind talking minutia for hours, and her gentle corrections help teach important social skills).

Besides this being another see, technology can be a force for good in people's lives! article, it got me thinking about chat bots in general. And no discussion of chat bots is complete without a mention of Eliza, Siri's great-great-great-great-great grandmother. Eliza was a "doctor" who could psychoanalyze you using little more than a set of text matching rules. Still, it managed to give the impression of true intelligence.

With Eliza on the brain, I started wondering how tricky it would be to implement an Eliza clone for my phone. Turns out, not tricky at all. Here's what I did.

First, I cheated and grabbed this implementation of Eliza in Scheme. Yes, I should have written my own. Heck one day, I probably will.

Next, I wrote some wrapper functions around that code to make it accept arbitrary string input:

(define random random-integer)

(define (eliza-scrub text)
 (define (valid-char? c)
  (let ((v (char->integer c)))
   (or (equal? c #\space)
       (and (>= v 97) (<= v 122)))))
 (let* ((chars (string->list text))
        (lower (map char-downcase chars))
        (valid (filter valid-char? lower)))
  (apply string valid)))
(define (eliza-it text)
 (let ((input (map string->symbol (explode " " (eliza-scrub text)))))
  (implode " "
           (apply-rule ELIZA-RULES input))))

I then busted out my web-apply framework, and attached this function to the local URL: http://localhost:9000/doc:

   (list server-address: "*"
    port-number: 9000
    eol-encoding: 'cr-lf)
  (web-fn-dispatcher `(("/doc" . (,eliza-it #t)))))

At this point, I could visit the URL in my browser and have a crude discussion with Eliza. But it's hardly the feel I was after. Next up, I turned to Tasker and created this quick Task:

Eliza (40)
A1: Get Voice [ Title:Talk to the Doctor Language ]
A2: If [ %VOICE eq bye ]
  A3: Say [ Text:Good bye ]
A4: Else
  A5: HTTP Get [ Server:Port:http://localhost:9000
                 Attributes:p0=%VOICE output=display ]
  A6: Say [ Text:%HTTPD ]
  A7: Goto [ Type:Action Number Number:1 ]

The magic is in the Tasker action Get Voice. This prompts a user to say something which is then turned into text and stored in %VOICE. The action Say does the reverse, taking arbitrary text and speaking it aloud. Finally, there's the web invocation of http://localhost:9000/doc which actually executes the above Eliza code.

While the above code is more fragile than I'd like (you need to explicitly bind the the eliza-it function to a port and path), it's also surprisingly effective. The whole experience is voice driven and feels remarkably powerful. It definitely brings back the magic of Eliza that had secretaries and staff confiding in it so long ago.

by Ben Simon ( at October 29, 2014 01:25 PM

October 28, 2014

Ben Simon

web-apply - Turn your Android Phone into an itty bitty Scheme app server

Checkout screenshots of my latest "web app" :

Pretty lame, right? Perhaps not, allow to me to explain.

What you're looking at are some interactions with web-apply, a crude framework for binding arbitrary Scheme functions to a web page. Here's how it works. First, you start with any old functions. Here's three toy ones:

(define (string-reverse x)
 (apply string
        (reverse (string->list x)))) 

(define (tip-calc amt)
 (map (lambda (percent)
       (cons percent (exact->inexact (+ amt (* (/ percent 100) amt)))))
      '(10 15 20)))

(define (random-within x y)
 (+ x (random-integer (- y x)))) 

Then you bind these functions to a particular port and path:

   (list server-address: "*"
    port-number: 9000
    eol-encoding: 'cr-lf)
  (web-fn-dispatcher `(("/rev" . (,string-reverse #t))
                       ("/tip" . (,tip-calc number))
                       ("/rand" . (,random-within number number)))))

tcp-service-register! is built into Gambit Scheme and takes care of accepting TCP connections. web-fn-dispatcher implements trivial HTTP handling and allows for interaction with a browser. The framework has one more trick up it's sleeve: you can pass an output parameter to declare how you want the output rendered. By default, a basic HTML page is generated, though you can pass in display or write to output the content using the aptly named Scheme function.

And here's the cool part: this framework was built in, and explicitly runs on Gambit Scheme on Android. So the above bindings effectively turn my cell phone into a resource an arbitrary user can browse to and interact with.

So why bother writing web-apply? I'm glad you asked. Here are three reasons:

  1. web-apply demonstrates just how powerful Gambit Scheme is on Android. Threads and sockets Just Work, including the ability to debug at the REPL. Combined with Droid Edit, you can really get creative and program dang near anything.
  2. If I try hard enough, I can imagine a circumstance where a team of individuals would want quick and dirty access to interact with some code, and web-apply gives you exactly this.
  3. web-apply should play nice with Tasker, as Tasker allows for easy execution of HTTP requests. This should allow you to code a task mainly using Tasker's standard environment, but jump into the Scheme world when it's convenient.

Of course, this should be considered alpha level code. But it's fun alpha level code, so feel free to play around with it.

by Ben Simon ( at October 28, 2014 03:17 PM

Programming Praxis

Number Of Divisors In A Range

We have today an interview question that was posted to the internet by a candidate who didn’t get the job, and wondered what he had done wrong. I’ll paraphrase his question:

The interview question was to find the number of integers between x and y that are divisible by n; you may assume that x, y and n are all positive and that x < y. I know the simple way to solve this is to loop over the range from x to y, like this:

for(int i=x;i<=y;i++) if(i%n ==0) counter++;

but that is very slow when the range is large, for instance x = 0 and y = 3000000000.

There must be some method that lets me reduce the number of iterations and optimize the code. Can someone please help me with that?

Your task is to help the candidate get the job by proposing a better algorithm to solve the problem. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

by programmingpraxis at October 28, 2014 09:00 AM

October 26, 2014

Alaric Snell-Pym

Further progress on Ugarit archival mode

Further to my last post on the matter, I've been working on the basic user interface to accessing archive metadata. As before, let's do an import to an archive tag in a vault. I've made a manifest file with three MP3s in - all data that could be extract from ID3 tags, and I plan […]

by alaric at October 26, 2014 09:16 PM

October 24, 2014

Programming Praxis

Three Farmers

Today’s exercise is a math puzzle from Terence Tao:

Three farmers were selling chickens at the local market. One farmer had 10 chickens to sell, another had 16 chickens to sell, and the last had 26 chickens to sell. In order not to compete with each other, they agreed to all sell their chickens at the same price. But by lunchtime, they decided that sales were not going so well, and they all decided to lower their prices to the same lower price point. By the end of the day, they had sold all their chickens. It turned out that they all collected the same amount of money, $35, from the day’s chicken sales. What was the price of the chickens before lunchtime and after lunchtime?

Your task is to calculate the price of chickens before and after lunch. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

by programmingpraxis at October 24, 2014 09:00 AM

October 23, 2014

Ben Simon

Ancient Laptops and being a Heroic Boyfriend - Text Formatting inspired Stories

You might think a topic like text formatting would be pretty bland. Not so! I have not one, but two stories inspired by the topic. Allow me to share.

I can remember it vividly: I'm 13 years old and working away on my very own laptop. Specifically, a NEC PC-8500, with a whopping 64K (yes kilobytes!) of RAM. I'm typing up an essay for school in the WordStar word processor and having a heck of a time. Specifically, the paragraphs are all askew, with some lines being shorter than others. In the end, I'm left fighting with the computer trying to get the different lines to have somewhat equal length. What a pain.

Looking back, I was running into a fairly classic text formatting problem. Either WordStar had automatic word wrap and I was defeating it by hitting enter at the end of some lines, or it had a manual function to refill paragraphs that I didn't know how to operate. All I know is, this is one of my earliest memories of software appearing to be buggy, but actually performing as designed. Little did I know that I'd pretty much make this fight my life's work by becoming a programmer. Now, on a nearly daily basis I look at software and think "hmmm, it can't possibly be behaving that way...." And yet, it almost always is. And usually it's my fault!

Fast forward from middle school to college for the second story. I'm on Unix Talk with my long-distance girlfriend, and she starts telling me about the arduous task in front of her. She's manually re-formating a massive final lab report. It's taking her forever to adjust each line to the right length. I finally convince her to send me a copy. A minute or two later she receives it back, perfectly formatted. How'd I work this bit magic? Why thanks to the Unix fmt command.

You may be thinking, big deal, you formatted some text. Turns out, it was a big deal. That girlfriend is now my wife of almost 16 17 years. And when I started describing the story a few days ago, she immediately started mentioning details I'd forgotten. That little bit of unix-manship, is probably in the top 10 list of amazing things I've done for my wife. Never underestimate the power of the command line.

In honor of both those stories, I give you a Scheme implementation of fmt. Incidentally, this answers the first part of the Programming-Praxis Challenge, I've still got the second part to complete.


(define (empty? str)
  (= (string-length str) 0))

(define (++ . args)
  (apply string-append
           (lambda (any)
             (cond ((string? any) any)
                   ((number? any) (number->string any))
                   ((char? any) (string any))))

(define (g options key . default)
  (cond ((assoc key options) => cdr)
        (else (if (null? default)
                  (error "Missing default: " key options)
                  (car default)))))
(define (read-token port)
  (let loop ((buffer ""))
    (let ((c (peek-char port)))
      (cond ((eof-object? c)
             (if (empty? buffer)
                 (cons 'eof (read-char port))
                 (cons 'word buffer)))
            ((equal? c #\newline)
             (if (empty? buffer)
                 (cons 'newline (read-char port))
                 (cons 'word buffer)))
            ((equal? c #\space)
             (if (empty? buffer)
                 (begin (read-char port) (loop buffer))
                 (begin (read-char port) (cons 'word buffer))))
              (loop (++ buffer (read-char port))))))))

(define (output line port opts)
  (let* ((width (g opts 'width 60))
         (align (g opts 'align 'left))
         (delta (- width (string-length line))))
    (case align
      ((left) (display line port))
       (display (make-string delta #\space) port)
       (display line port))
       (display (make-string (floor (/ delta 2)) #\space) port)
       (display line port)))
    (newline port)))
(define (handle-word word buffer out width loop opts)
 (let ((line (if (empty? buffer) "" (++ buffer " "))))
   (if (> (string-length (++ line word)) width)
         (output buffer out opts)
         (loop word))
         (loop (++ line word))))))

(define (fmt in out opts)
  (call-with-input-file in
    (lambda (pin)
      (call-with-output-file out
        (lambda (pout)
          (format pin pout opts))))))

(define (format in out opts)
  (let ((width (g opts 'width 60)))
    (let loop ((buffer ""))
      (let ((next (read-token in)))
        (case (car next)
          ((eof) (output buffer out opts))
           (handle-word (cdr next) buffer out width loop opts))
           (let ((peek (read-token in)))
             (case (car peek)
                (output  buffer out opts)
                (newline out)
                (loop ""))
               ((eof) (output buffer out opts))
                (handle-word (cdr peek) buffer out width loop opts))
               (else (error "Unknown peek token:" peek)))))
          (else (error "Unknown token:" next)))))))

(define in "/sdcard/Documents/input.txt")
(define out  "/sdcard/Documents/output.txt")
(define opts '((width . 30)))

(define (range low high)
  (let loop ((i low) (result '()))
    (if (> i high) (reverse result)
        (loop (+ 1 i) (cons i result)))))

(define-macro (repeat qty . body)
    (lambda (i) ,@body) (range 1 ,qty)))

by Ben Simon ( at October 23, 2014 12:48 AM

October 21, 2014

Djac Grant

Learning Lojban 00: An Introduction.

Hello Lojban my old friend, I’ve come to speak with you again.

Long have been noted the benefits of bilingualism;

Why a Conlang? Why Lojban?

Living in the Midwest US, I don’t have very much practical use for knowing

It happens to be structured in such a way, that 1

The Plan?

October 21, 2014 05:00 PM

Greg Hendershott

Why macros?

Yesterday a couple people asked me, “How and why do you use macros in a Lisp like Racket or Clojure?”.

I gave answers like:

  • The compiler can do a search-and-replace on your code.

  • You can make DSLs.

  • They’re an “API for the compiler”.

Although all true, I wasn’t sure I was getting the full idea across.

Worse, one time Peter Seibel was within earshot. Although I don’t know if he heard my explanation, I imagined him biting his tongue and politely remembering the “well, actually” rule. :)

Later I remembered Matthias Felleisen boiling down macros into three main categories:

  1. Binding forms. You can make your own syntax for binding values to identifiers, including function definition forms. You may hear people say, in a Lisp you don’t have to wait for the language designers to add a feature (like lambda for Java?). Using macros you can add it yourself. Binding forms is one example.

  2. Changing order of evaluation. Something like or or if can’t really be a function, because you want it to “short-circuit” — if the first test evaluates to true, don’t evaluate the other test at all.

  3. Abstractions like domain specific langagues (DSLs). You want to provide a special language, which is simpler and/or more task-specific than the full/raw Lisp you’re using. This DSL might be for users of your software, and/or it might be something that you use to help implement parts of your own program.

Every macro is doing one of those three things. Only macros can really do the first two, at all1. Macros let you do the last one more elegantly.

I think the preceding is a better answer. However, maybe it’s still not the best way to get people from zero to sixty on, “Why macros?”.2

Maybe the ideal is a “teachable moment” — facing a problem that macrology would solve.3 That’s also good because you really really really don’t want to use a macro when a normal function would suffice. So the goal isn’t to get people so enthusiastic about macros that they go forth in search of nails to which to apply that new hammer. Macros often aren’t the right approach. But once in a while, they are the bestest approach ever.

  1. A language like Haskell can choose lazy evaluation, and implement if as a function. I’m saying that only a macro can futz with whatever the default evaluation order is, be it eager or lazy. 

  2. Although I wrote a guide called Fear of Macros, it’s (a) specific to Racket macros and (b) much more about the “how” than the “why”. 

  3. Certainly that’s my own optimal learning situation, as opposed to getting answers or solutions before I have the questions or problems. 

by Greg Hendershott at October 21, 2014 01:56 PM

Programming Praxis

Two-Base Palindromes

I wanted to do this exercise as a follow-up to the earlier exercise on generating palindromes, but didn’t get around to it until now.

Your task is to write a program that generates a list of numbers that are palindromes in base 10 and base 8; for instance 149694110 = 55535558. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

by programmingpraxis at October 21, 2014 09:00 AM

October 20, 2014

Djac Grant

Relearning w/ Racket 01: After The First Meetup.

(string-append "rocket" "man")

This past Saturday, I attended my first formal programming related meetup; And … it was pretty darn fun. Even when considering for the past week or-so, I’ve been struggling with getting my sleep schedule back to what many would consider “reasonable” (ie: Not sleeping in to 1–2 pm) and I have been extremely irritable, as well as “out of it”, in reaction to such a grand effort. Too due lack of questions on the assigned material — the original plan for said event didn’t even happen to manifest itself, so the given time was spent with a (very possibly) over ambitious goal of getting a rocket to orbit a planet, inspired directly à la HTDP2e’s prologue (the forementioned assigned material)… Which, while it was a bit over my head conceptually (never taking a physics class in HS, and not yet needing to take one in a college environment) the whole experience of seeing such a thing come together was really a spectacular sight! Generally, the whole thing left a great residual taste in my mouth and I’m very excited for the next meetup. That being said, there were some minor changes made to the course of this “course” and I’ll get into that following…

A Slight Change In Plans.

Really, the biggest thing to note — ended up coming out in the 15 or-so minutes. After some general “bookkeeping”, we decided to cement plans for moving onward; Notably that we are now going to meet every other weekend (on Saturday), from approximately 13:00 to 14:30. This is different from what was stated before, on my part — initially to my understanding, such a thing would have been more of a monthly endeavor… that being said, I’m all for the change. It gives me less wiggle room to slack off and actually force myself to get some real work done in said allotted time. For which, we tentatively have planned to cover sections 1 through 2.4 of Part/Chapter I (which adds up to be about 1/4 of the “Fixed-Size Data” page).

Where’s The Source?

I mentioned above about our, now (as you soon may see) obviously overly-ambitious goal of getting a rocket to try and orbit a planet — within the given hour or-so … well, STL Racket now has a Github repo here, which will eventually contain all of our groupwork — right now it just has “Prologue.rkt” (said orbit attempt) and there’s a few things to note with that, firstly because it has an image included… the actual source file is a bit wonky and should only be opened in Dr.Racket. Secondly, the actual program is bugged out and the rocket’s bath is a bit, er, erratic… in the split second that you execute it, it starts out somewhat promising and quickly falls apart… still, I suspect it may be fun to play with.

Also, I myself have uploaded a repo that I’m going to be updating… here! Though, this is not likely to be nearly as interesting as the groupwork we may be apt to do during said meetup. All I’m going to put in there, is pretty much just the straight examples given from the text and any assignments thereof.

And Onward!

Okay, another two week stretch and I’ll be back with more Racket news of some sort or another; See ya then! .u’i

October 20, 2014 05:00 PM

Ben Simon

Why Macros Matter

Imagine you're a Senior Developer at Big Co and while reviewing Junior Programmer Jimmy's latest set of check-ins you see the following code repeated a handful of times:

  return '$' + 
         new BigDecimal(value).
          setScale(2, BigDecimal.ROUND_HALF_UP).

You pull Jimmy aside and explain that the above should really be packed into a function (or method) rather than being written out long hand. In other words, it should read:


You explain that by doing this Jimmy and the team will gain at least three benefits:

  1. Fewer Bugs. Not only is the function call above shorter, but there's no chance to accidentally forget part of it, or put an erroneous value in place (for example, pass 3 to setScale). And if there was a typo, such as Format.mony, you'd get a clear error message rather than just an oddly formatted value.
  2. Clearer Code. In the original version of the code, the reader has to think in terms of numeric and string operations. If the programmer wasn't familiar with BigDecimal, they might have to open up the docs to see how it's used. In the more compact form, the intention is clear: a value is being prepared for display to a human.
  3. Easier Maintenance. From a maintenance perspective, having the code wrapped up in a single location means that it can be fixed or improved upon with ease. Let's say negative values should be rendered with parenthesis around the value. Making this change to is trivial, do a find a replace throughout a massive code base, no so much.

Finally, you explain to Jimmy that if he ever finds himself copying and pasting code around alarm bells should sound in his head and he should make the appropriate abstraction.

As an aside, the above can be considered a procedural abstraction. Naturally, programmers love them (and for their sanity, need them!). So much so, in fact, that even if a language doesn't provide an official mechanism for creating procedural abstractions (assembly language perhaps? Old school BASIC?), a clever programmer will find a way to simulate them. Sure, this facility may depend on GOTO and global variables, and it may be fragile and error prone, but it will get the job done.

A few weeks later, Jimmy comes bursting into your office. He eagerly explains that he paid attention to what you suggested and has come across a abstraction that the team should adopt. If they do so, thousands of lines of code will be cleaned up. He goes to the whiteboard to explain. Rather than coding like so:

  private int foo;
  public int getFoo() {
    return foo;
  public void setFoo(int _foo) { = _foo;

The team should write:

  property(int, foo);

After all, he explains, you'll get the same 3 benefits as above, though on a larger scale because we use this pattern all over the place.

You're then left with the unfortunate task of explaining to Jimmy that while he's right, it's not so simple. Yes, they should create such an abstraction, but their language of choice (in this case, Java, Circa 2000) doesn't allow for this. That's because what's called for here is a syntatic abstraction rather than a procedural one. In fact, very few languages give you this capability.

Still, programmers are a clever bunch. Just like our Geek Forefathers and Foremothers who made do before reliable procedural abstraction, those lacking syntactic abstraction will find a way. In Java, for example, the above problem may be solved by using the Eclipse to generate the code. In PHP, you could simulate the above using property overloading. And when all else fails, you could run your source code through GNU m4. However, at the end of the day, these methods are all relatively fragile when compared to true syntactic abstractions.

And what language provides such a capability? Why, Scheme does, and the facility goes by the innocuous sounding name macros.

Learn Scheme. Learn Macros. Learn what you've been missing out on.

Thanks to Grant for helping motivate me to write this post.

by Ben Simon ( at October 20, 2014 10:51 AM

October 17, 2014

Programming Praxis


Blackjack is a casino game of chance, played by a player and a dealer. Both player and dealer are initially dealt two cards from a standard 52-card deck. If the player’s initial hand consists of an ace and a ten or face card, the player wins, unless the dealer also has an ace and a ten or face card, in which case the game is a tie. Otherwise, the player draws cards until he decides to stop; if at any time the sum of the pips on the cards (aces count either 1 or 11, face cards count 10) exceeds 21, the player is busted, and loses. Once the player is finished, the dealer draws cards until he has 17 or more pips, or goes bust, at which time the game ends. If neither has gone bust, the hand with the most pips wins. There are many variant rules, but we’ll keep things simple with the rules described above.

Your task is to simulate Blackjack and determine the winning percentage for the player. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

by programmingpraxis at October 17, 2014 09:00 AM

October 16, 2014

Peter Bex

A (mostly) comprehensive guide to calling C from Scheme and vice versa

When you're writing Scheme code in CHICKEN it's sometimes necessary to make a little excursion to C. For example, you're trying to call a C library, you're writing extremely performance-critical code, or you're working on something that's best expressed in C, such as code that requires a lot of bit-twiddling.

This post contains a lot of code, including generated C code. If you get too tired to absorb it, it's probably best to stop reading and pick it up again later.

A basic example of invoking C code from CHICKEN

This is one of CHICKEN's strengths: the ability to quickly drop down to C for a small bit of code, and return its result to Scheme:

(import foreign)

(define ilen
  (foreign-lambda* long ((unsigned-long x))
    "unsigned long y;\n"
    "long n = 0;\n"
    "#ifdef C_SIXTY_FOUR\n"
    "y = x >> 32; if (y != 0) { n += 32; x = y; }\n"
    "y = x >> 16; if (y != 0) { n += 16; x = y; }\n"
    "y = x >>  8; if (y != 0) { n +=  8; x = y; }\n"
    "y = x >>  4; if (y != 0) { n +=  4; x = y; }\n"
    "y = x >>  2; if (y != 0) { n +=  2; x = y; }\n"
    "y = x >>  1; if (y != 0) C_return(n + 2);\n"
    "C_return(n + x);"))

(print "Please enter a number")
(print "The length of your integer in bits is " (ilen (read)))

This example is taken from a wonderful little book called "Hacker's Delight", by Henry S. Warren. It calculates the number of bits required to represent an unsigned integer (its "length"). By the way, this procedure is provided by the numbers egg as integer-length. The algorithm is implementable in Scheme, but at least a direct translation to Scheme is nowhere as readable as it is in C:

(define (ilen x)
  (let ((y 0) (n 0))
       (set! y (arithmetic-shift x -32))
       (unless (zero? y) (set! n (+ n 32)) (set! x y)))
    (set! y (arithmetic-shift x -16))
    (unless (zero? y) (set! n (+ n 16)) (set! x y))
    (set! y (arithmetic-shift x -8))
    (unless (zero? y) (set! n (+ n 8)) (set! x y))
    (set! y (arithmetic-shift x -4))
    (unless (zero? y) (set! n (+ n 4)) (set! x y))
    (set! y (arithmetic-shift x -2))
    (unless (zero? y) (set! n (+ n 2)) (set! x y))
    (set! y (arithmetic-shift x -1))
    (if (not (zero? y)) (+ n 2) (+ n x))))

The performance of the Scheme version is also going to be less than that of the C version. All in all, plenty of good reasons to prefer integration with C. There's no shame in that: most fast languages forego "pure" implementations in favour of C for performance reasons. The only difference is that calling C in other languages is often a bit more work.

Analysing the generated code

In this section we'll unveil the internal magic which makes C so easily integrated with Scheme. You can skip this section if you aren't interested in low-level details.

As you might have noticed, the C code in the example above contains one unfamiliar construct: It uses C_return() to return the result. If you inspect the code generated by CHICKEN after compiling it via csc -k test.scm, you'll see that it inserts some magic to convert the C number to a Scheme object. I've added some annotations and indented for readability:

/* Local macro definition to convert returned long to a Scheme object. */
#define return(x) \
  C_cblock C_r = (C_long_to_num(&C_a,(x))); goto C_ret; C_cblockend

/* Prototype declaring the stub procedure as static, returning a
 * C_word (Scheme object) and passing arguments through registers.
 * It's not strictly necessary in this case.
static C_word C_fcall stub7(C_word C_buf, C_word C_a0) C_regparm;

/* The stub function: it gets passed a buffer in which Scheme objects get
 * allocated (C_buf) and the numbered arguments C_a0, C_a1, ... C_an.
C_regparm static C_word C_fcall stub7(C_word C_buf, C_word C_a0)
  C_word C_r = C_SCHEME_UNDEFINED, /* Return value, mutated by return() macro */
        *C_a=(C_word*)C_buf;     /* Allocation pointer used by return() macro */

  /* Conversion of input argument from Scheme to C */
  unsigned long x = (unsigned long )C_num_to_unsigned_long(C_a0);

  /* Start of our own code from the foreign-lambda* body, as-is */
  unsigned long y;
  long n = 0;
  y = x >> 32; if (y != 0) { n += 32; x = y; }
  y = x >> 16; if (y != 0) { n += 16; x = y; }
  y = x >>  8; if (y != 0) { n +=  8; x = y; }
  y = x >>  4; if (y != 0) { n +=  4; x = y; }
  y = x >>  2; if (y != 0) { n +=  2; x = y; }
  y = x >>  1; if (y != 0) C_return(n + 2);
  C_return(n + x);

C_ret: /* Label for goto in the return() macro */
#undef return
  return C_r; /* Regular C return */

/* chicken.h contains the following: */
#define C_return(x)              return(x)
#define C_cblock                 do{
#define C_cblockend              }while(0)

In the foreign-lambda*, I used C_return for clarity: I could have just used return with parentheses, which will get expanded by the C preprocessor. This is somewhat confusing: return n + x; will result in an error, whereas return(n+x); will do the same as C_return(n+x);.

The return macro calls C_long_to_num, which will construct a Scheme object, which is either a fixnum (small exact integer) or a flonum (floating-point inexact number), depending on the platform and the size of the returned value. Hopefully, in CHICKEN 5 it will be either a fixnum or a bignum - that way, it'll always be an exact integer.

Because these number objects need to get allocated on the stack to integrate with the garbage collector, the calling code needs to set aside enough memory on the stack to fit these objects. That's what the C_buf argument is for: it's a pointer to this area. In CHICKEN, a whole lot of type punning is going on, so it's passed as a regular C_word rather than as a proper pointer, but let's ignore that for now.

The stub function above is used to do the actual work, but in order to integrate it into CHICKEN's calling conventions and garbage collector, an additional wrapper function is generated. It corresponds to the actual Scheme "ilen" procedure, and looks like this:

/* ilen in k197 in k194 in k191 */
static void C_ccall f_201(C_word c, C_word t0, C_word t1, C_word t2)
  C_word tmp /* Unused */; C_word t3; C_word t4; C_word t5;  /* Temporaries */
  C_word ab[6], *a=ab;     /* Memory area set aside on stack for allocation */

  if(c != 3) C_bad_argc_2(c, 3, t0);     /* Check argument count is correct */

  C_check_for_interrupt; /* Check pending POSIX signals, and thread timeout */

  if(!C_stack_probe(&a)) {   /* Stack full?  Then perform GC and try again. */
    C_save_and_reclaim((void*)tr3, (void*)f_201, 3, t0, t1, t2);
  t3 = C_a_i_bytevector(&a,1,C_fix(4));   /* Needed to have a proper object */
  t4 = C_i_foreign_unsigned_integer_argumentp(t2);   /* Check argument type */
  t5 = t1;                          /* The continuation of the call to ilen */
  /* Call stub7 inline, and pass result to continuation: */
  ((C_proc2)(void*)(*((C_word*)t5+1)))(2, t5, stub7(t3, t4));

The comment at the top indicates the name of the Scheme procedure and its location in the CPS-converted Scheme code. The k197 in k194 etc indicate the nesting in the generated continuations, which can sometimes be useful for debugging. These continuations can be seen in the CPS-converted code by compiling with csc -debug 3 test.scm.

Much of the code you might sort-of recognise from the code in my article about the CHICKEN garbage collector: The C_stack_probe() corresponds to that post's fits_on_stack(), and C_save_and_reclaim() combines that post's SCM_save_call() and SCM_minor_GC().

All Scheme procedures get compiled down to C functions which receive their argument count (c), the closure/continuation from which they're invoked (t0), so they can access local closure variables (not used here) and in order to perform a GC and re-invoke the closure. Finally, they receive the continuation of the call (t1) and any procedure arguments (everything after it, here only t2). If a procedure has a variable number of arguments, that will use C's varargs mechanism, which is why passing the argument count to every function is important. If a function is called with too many or too few arguments, this will "just work", even if the arguments are declared in the function prototype like here: The function is invoked correctly, but the stack will contain rubbish instead of the expected arguments. That's why it's important to first check the argument count, and then check whether a GC needs to be performed; otherwise, this rubbish gets saved by save_and_reclaim and the GC will attempt to traverse it as if it contained proper Scheme objects, resulting in segfaults or other nasty business.

The variable t3 will contain the buffer in which the return type is stored. It is wrapped in a byte vector, because this makes it a first-class object understood by the garbage collector. That's not necessary here, but this code is pretty generic and is also used in cases where it is necessary. The C_word ab[6] declaration sets aside enough memory space to hold a flonum or a fixnum, which need at most 4 bytes, plus 2 bytes for the bytevector wrapper. I will explain these details later in a separate post, but let's assume it's OK for now.

The argument type gets checked just before calling the C function. If the argument is not of the correct type, an error is signalled and the function will be aborted. The returned value is simply the input, so t4 will contain the same value as t2. Similarly, t1 gets copied as-is to t5. Finally, the continuation gets cast to the correct procedure type (again: a lot of type punning. I will explain this in another post), and invoked with the correct argument count (2), the continuation closure itself, and the return value of the stub function.

Returning complex Scheme objects from C

I've tried to explain above how the basic C types get converted to Scheme objects, but what if we want to get crazy and allocate Scheme objects in C? A simple foreign-lambda* won't suffice, because the compiler has no way of knowing how large a buffer to allocate, and the C function will return, so we'll lose what's on the stack.

To fix that, we have foreign-safe-lambda*, which will allow us to allocate any object on the stack. Before such a function is invoked, a minor garbage collection is triggered to clean the stack and ensure we have plenty of allocation room. Let's look at a simple example. This program displays the list of available network interfaces on a UNIX-like system:

(import foreign)

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")

(define interfaces
  (foreign-safe-lambda* scheme-object ()
    "C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;\n"
    "struct ifaddrs *ifa, *i;\n"
    "if (getifaddrs(&ifa) != 0)\n"
    "  C_return(C_SCHEME_FALSE);\n"
    "for (i = ifa; i != NULL; i = i->ifa_next) {\n"
    "  len = strlen(i->ifa_name);\n"
    "  a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));\n"
    "  str = C_string(&a, len, i->ifa_name);\n"
    "  lst = C_a_pair(&a, str, lst);\n"

(print "The following interfaces are available: " (interfaces))

This functionality is not available in CHICKEN because it's not very portable (it's not in POSIX), so it's a good example of something you might want to use C for. Please excuse the unSchemely way of error handling by returning #f for now. We'll fix that in the next chapter.

Looking at our definition, the interfaces procedure has no arguments, and it returns a scheme-object. This type indicates to CHICKEN that the returned value is not to be converted but simply used as-is: we'll handle its creation ourselves.

We declare the return value lst, which gets initialised to the empty list, and two temporary variables: len and str, to keep an intermediate string length and to hold the actual CHICKEN string. The variable a is an allocation pointer. Then we have the two variables which hold the start of the linked list of interfaces, ifa, and the current iterator through this list, i.

We retrieve the linked list (if it fails, returning #f), and scan through it until we hit the end. For each entry, we simply check the length of the interface name string, we allocate enough room on the stack to hold a pair and a CHICKEN string of the same length (C_alloc() is really just alloca()). The C_SIZEOF... macros are very convenient to help us calculate the size of an object without having to know its exact representation in memory. We then create the CHICKEN string using C_string, which is put into the allocated space stored in a, and we create a pair which holds the string in the car and the previous list as its cdr.

These allocating C_a_pair and C_string functions accept a pointer to the allocated space (which itself is a pointer). This means they can advance the pointer's value beyond the object, to the next free position. This is quite nice, because it allows us to call several allocating functions in a row, with the same pointer, and at the end the pointer points past the object that was allocated last. Finally, we release the memory used by the linked list and return the constructed list.

Analysing the generated code

Like before, if you're not interested in the details, feel free to skip this section.

The interfaces foreign code itself compiles down to this function:

/* Like before, but no conversion because we "return" a native object: */
#define return(x) C_cblock C_r = (((C_word)(x))); goto C_ret; C_cblockend

/* The prototype _is_ necessary in this case: it declares the function
 * as never returning via C_noret, which maps to __attribute__((noreturn)).
static void C_ccall stub6(C_word C_c, C_word C_self,
                          C_word C_k, C_word C_buf) C_noret;

/* The arguments to the stub function now include the argument count,
 * the closure itself and the continuation in addition to the buffer
 * and arguments (none here).  This is a truly "native" CHICKEN function!
static void C_ccall stub6(C_word C_c, C_word C_self, C_word C_k, C_word C_buf)
        *C_a = (C_word *)C_buf;

  /* Save callback depth; needed if we want to call Scheme functions */
  int C_level = C_save_callback_continuation(&C_a, C_k);

  /* Start of our own code, as-is: */
  struct ifaddrs *ifa, *i;
  C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;

  if (getifaddrs(&ifa) != 0)

  for (i = ifa; i != NULL; i = i->ifa_next) {
    len = strlen(i->ifa_name);
    a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));
    str = C_string(&a, len, i->ifa_name);
    lst = C_a_pair(&a, str, lst);


#undef return

  /* Pop continuation off callback stack. */
  C_k = C_restore_callback_continuation2(C_level);

  C_kontinue(C_k, C_r); /* Pass return value to continuation. */

This is not much different from the foreign-lambda* example, but notice that the arguments are different: this stub looks exactly like the C code generated from an actual Scheme continuation: it gets passed the argument count, its own closure and its continuation. Instead of ending with a regular return from C, it invokes a continuation. This is the crucial difference which integrates our code with the garbage collector: by passing it to the next continuation's C function, the "returned" value is preserved on the stack. In other words, it is allocated directly in the nursery.

Even though the stub is a "native" Scheme procedure, a wrapper is still generated: if the foreign-safe-lambda is defined to accept C arguments, it'll still need to convert from Scheme objects, it needs to check the argument count, and it needs to invoke the GC before the procedure can be called:

/* interfaces in k197 in k194 in k191 */
static void C_ccall f_201(C_word c, C_word t0, C_word t1){
  /* This is the function that corresponds to the Scheme procedure.
   * This is the first stage of the procedure: we invoke the GC with
   * a continuation which will do conversions and call the C stub.
  C_word tmp; C_word t2; C_word t3;
  C_word ab[3], *a = ab;

  /* As before: */
  if (c!=2) C_bad_argc_2(c, 2, t0);


  if (!C_stack_probe(&a)) {

  /* Create the continuation which will be invoked after GC: */
  t2 = (*a = C_CLOSURE_TYPE|2, /* A closure of size two: */
        a[1] = (C_word)f_205,  /* Second stage function of our wrapper, */
	a[2] = t1,             /* and continuation of call to (interfaces). */
	tmp = (C_word)a,       /* Current value of "a" must be stored in t2...*/
	a += 3,                /* ... but "a" itself gets advanced... */
	tmp);                  /* ... luckily tmp holds original value of a. */

  C_trace("test.scm:8: ##sys#gc"); /* Trace call chain */

  /* lf[1] contains the symbol ##sys#gc.  This invokes its procedure. */
  ((C_proc3)C_fast_retrieve_symbol_proc(lf[1]))(3, *((C_word*)lf[1]+1),
                                                t2, C_SCHEME_FALSE);

/* k203 in interfaces in k197 in k194 in k191 */
static void C_ccall f_205(C_word c, C_word t0, C_word t1)
  /* This function gets invoked from the GC triggered by the above function,
   * and is the second stage of our wrapper function.  It is similar to the
   * wrapper from the first example of a regular foreign-lambda.
  C_word tmp; C_word t2; C_word t3; C_word t4;
  /* Enough room for a closure of 2 words (total size 3) and a bytevector
   * of 3 words (total size 4).  This adds up to 7; The missing 1 is to
   * make room for a possible alignment of the bytevector on 32-bit platforms.
  C_word ab[8], *a=ab;


  if (!C_stack_probe(&a)) {
    C_save_and_reclaim((void*)tr2, (void*)f_205, 2, t0, t1);

  t2 = C_a_i_bytevector(&a, 1, C_fix(3)); /* Room for one pair */

  t3 = (*a = C_CLOSURE_TYPE|2, /* Create a closure of size 2: */
        a[1] = (C_word)stub6,  /* Our foreign-safe-lambda stub function, */
	a[2] = ((C_word)li0),  /* and static lambda-info for same (unused). */
	tmp = (C_word)a,       /* Update "a" and return original value, */
	a += 3,                /* exactly like we did in f_201. */
  /* Trace procedure name generated by (gensym). Kind of useless :) */
  C_trace("test.scm:8: g9");

  t4 = t3; /* Compilation artefact; don't worry about it */

  /* Retrieve procedure from closure we just created, and call it,
   * with 3 arguments: itself (t4), the continuation of the call
   * to "interfaces" (t0[2]), and the bytevector buffer (t2).
  ((C_proc3)C_fast_retrieve_proc(t4))(3, t4, ((C_word*)t0)[2], t2);

Our foreign-lambda's wrapper function now consists of two stages. The first stage first creates a continuation for the usual wrapper function. Then it calls the garbage collector to clear the stack, after which this wrapper-continuation is invoked. This wrapper is the second function here, and it corresponds closely to the wrapper function we saw in the ilen example. However, this wrapper constructs a closure around the C stub function instead of simply calling it. This closure is then called: C_fast_retrieve_proc simply extracts the function from the closure object we just created, it is cast to a 3-argument procedure type and invoked with the continuation of the interfaces call site.

You can see how closures are created in CHICKEN. I will explain this in depth in a future blog post, but the basic approach is pretty clever: the whole thing is one big C expression which stores successive words at the free slots in the allocated space a, while ensuring that after the expression a will point at the next free word. The dance with tmp ensures that the whole expression which allocates the closure results in the initial value of a. That initial value was the first free slot before we executed the expression, and afterwards it holds the closure. Don't worry if this confuses you :)

Calling Scheme from C

Now, with the basics out of the way, let's do something funkier: instead of calling C from Scheme, we call Scheme from C! There is a C API for embedding CHICKEN in a larger C program, but that's not what you should use when calling Scheme from C code that was itself called from Scheme.

The "easy" way

Our little interfaces-listing program has one theoretical flaw: the list of interfaces could be very long (or the names could be long), so we may theoretically run out of stack space. So, we should avoid allocating unbounded lists directly on the stack without checking for overflow. Instead, let's pass the allocated objects to a callback procedure which prints the interface, in a "streaming" fashion.

As I explained before, a regular foreign-lambda uses the C stack in the regular way, it doesn't know about continuations or the Cheney on the MTA garbage collection style, and there's no way to call CHICKEN functions from there, because the GC would "collect" away the C function by longjmp()ing past it. However, the foreign-safe-lambda has a special provision for that: it can "lock" the current live data by putting a barrier between this C function and the Scheme code it calls:

(import foreign)

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")

(define interfaces
  (foreign-safe-lambda* scheme-object ((scheme-object receiver))
    "C_word len, str, *a;\n"
    "struct ifaddrs *ifa, *i;\n"
    "if (getifaddrs(&ifa) != 0)\n"
    "  C_return(C_SCHEME_UNDEFINED);\n"
    "for (i = ifa; i != NULL; i = i->ifa_next) {\n"
    "  len = strlen(i->ifa_name);\n"
    "  a = C_alloc(C_SIZEOF_STRING(len));\n"
    "  str = C_string(&a, len, i->ifa_name);\n"
    "  C_save(str);\n"
    "  C_callback(receiver, 1);\n"

(print "The following interfaces are available: ")
(interfaces print)

This will display the interfaces one line at a time, by using CHICKEN's print procedure as the callback.

We won't look at the compiled source code for this implementation, because it is identical to the earlier one, except for the changed foreign-lambda body. The implementation of C_callback() is of interest, but it is a little hairy, so I'll leave it you to explore it yourself.

The basic idea is rather simple, though: it simply calls setjmp() to establish a new garbage collection trampoline. This means that the foreign-lambda will always remain on the stack. The callback is then invoked with a continuation which sets a flag to indicate that the callback has returned normally, in which case its result will be returned to the foreign-lambda. If it didn't return normally, we arrived at the trampoline because a GC was triggered. This means the remembered continuation will be re-invoked, like usual.

However, when the callback did return normally, we can simply return the returned value because the foreign-lambda's stack frame is still available due to the GC barrier we set up.

The C_save macro simply saves the callback's arguments on a special stack which is read by C_do_apply. It is also used by callback_return_continuation: it saves the value and triggers a GC to force the returned value into the heap. That way, we can return it safely to the previous stack frame without it getting clobbered by the next allocation.

A harder way

The above code has another flaw: if the callback raises an exception, the current exception handler will be invoked with the continuation where it was established. However, that might never return to the callback, which means we have a memory leak on our hands!

If the callback doesn't return normally, the foreign-lambda will remain on the stack forever. How do we avoid that little problem? The simplest is of course to wrap the callback's code in handle-exceptions or condition-case. However, that's no fun at all.

Besides, in real-world code we want to avoid the overhead of a GC every single time we invoke a C function, so foreign-safe-lambda is not really suitable for functions that are called in a tight loop. In such cases, there is only one way: to deeply integrate in CHICKEN and write a completely native procedure! Because truly native procedures must call a continuation when they want to pass a result somewhere, we'll have to chop up the functionality into three procedures:

(import foreign)
(use lolevel)     ; For "location"

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")

(define grab-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))
    "if (getifaddrs(ifa) != 0)\n"
    "  *ifa = NULL;\n"))

(define free-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))

(define next-ifa
  (foreign-primitive (((c-pointer (c-pointer "struct ifaddrs")) ifa))
    "C_word len, str, *a;\n"
    "if (*ifa) {\n"
    "  len = strlen((*ifa)->ifa_name);\n"
    "  a = C_alloc(C_SIZEOF_STRING(len));\n"
    "  str = C_string(&a, len, (*ifa)->ifa_name);\n"
    "  *ifa = (*ifa)->ifa_next;\n"
    "  C_kontinue(C_k, str);\n"
    "} else {\n"
    "  C_kontinue(C_k, C_SCHEME_FALSE);\n"

(define (interfaces)
  ;; Use a pointer which the C function mutates.  We could also
  ;; return two values(!) from the "next-ifa" foreign-primitive,
  ;; but that complicates the code flow a little bit more.
  ;; Sorry about the ugliness of this!
  (let-location ((ifa (c-pointer "struct ifaddrs"))
                 (i (c-pointer "struct ifaddrs")))
    (grab-ifa! (location ifa))
    (unless ifa (error "Could not allocate ifaddrs"))
    (set! i ifa)

    (handle-exceptions exn
      (begin (free-ifa! (location ifa))      ; Prevent memory leak, and
             (signal exn))                   ; re-raise the exception
      (let lp ((result '()))
        (cond ((next-ifa (location i)) =>
               (lambda (iface)
                 (lp (cons iface result))))
               (free-ifa! (location ifa))

;; We're once again back to constructing a list!
(print "The following interfaces are available: " (interfaces))

This compiles to something very similar to the code behind a foreign-safe-lambda, but it's obviously going to be a lot bigger due to it being cut up, so I won't duplicate the C code here. Remember, you can always inspect it yourself with csc -k.

Anyway, this is like the foreign-safe-lambda, but without the implicit GC. Also, instead of "returning" the value through C_return() we explicitly call the continuation C_k through the C_kontinue() macro, with the value we want to pass on to the cond. If we wanted to return two values, we could simply use the C_values() macro instead; we're free to do whatever Scheme can do, so we can even return multiple values, as long as the continuation accepts them.

If an exception happens anywhere in this code, we won't get a memory leak due to the stack being blown up. However, like in any C code, we need to free up the memory behind the interface addresses. So we can't really escape our cleanup duty!

You might think that there's one more problem with foreign-primitive: because it doesn't force a GC before calling the C function, there's still no guarantee about how much space you still have on the stack. Luckily, CHICKEN has a C_STACK_RESERVE, which defines how much space that is guaranteed to be left on the stack after each C_demand(). Its value is currently 0x10000 (i.e., 64 KiB), which means you have some headroom to do basic allocations like we do here, but you shouldn't allocate too many huge objects. There are ways around that, but unfortunately not using the "official" FFI (that I'm aware of, anyway). For now we'll stick with the official Scheme API.

The die-hard way: calling Scheme closures from C

So far, we've discussed pretty much only things you can find in the CHICKEN manual's section on the FFI. Let's take a look at how we can do things a little differently, and instead of passing the string or #f to a continuation, we pass the callback as a procedure again, just like we did for the "easy" way:

(import foreign)
(use lolevel)

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")

(define grab-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))
    "if (getifaddrs(ifa) != 0)\n"
    "  *ifa = NULL;\n"))

(define free-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))

(define next-ifa
  (foreign-primitive (((c-pointer (c-pointer "struct ifaddrs")) ifa)
                      (scheme-object more) (scheme-object done))
    "C_word len, str, *a;\n"
    "if (*ifa) {\n"
    "  len = strlen((*ifa)->ifa_name);\n"
    "  a = C_alloc(C_SIZEOF_STRING(len));\n"
    "  str = C_string(&a, len, (*ifa)->ifa_name);\n"
    "  *ifa = (*ifa)->ifa_next;\n"
    "  ((C_proc3)C_fast_retrieve_proc(more))(3, more, C_k, str);\n"
    ;; Alternatively:
    ;; "  C_save(str); \n"
    ;; "  C_do_apply(2, more, C_k); \n"
    ;; Or, if we want to call Scheme's APPLY directly (slower):
    ;; "  C_apply(5, C_SCHEME_UNDEFINED, C_k, more, \n"
    ;; "          str, C_SCHEME_END_OF_LIST); \n"
    "} else {\n"
    "  ((C_proc2)C_fast_retrieve_proc(done))(2, done, C_k);\n"
    ;; Alternatively:
    ;; "  C_do_apply(0, done, C_k); \n"
    ;; Or:
    ;; "  C_apply(4, C_SCHEME_UNDEFINED, C_k, done, C_SCHEME_END_OF_LIST);\n"

(define (interfaces)
  (let-location ((ifa (c-pointer "struct ifaddrs"))
                 (i (c-pointer "struct ifaddrs")))
    (grab-ifa! (location ifa))
    (unless ifa (error "Could not allocate ifaddrs"))
    (set! i ifa)

    (handle-exceptions exn
      (begin (free-ifa! (location ifa))
             (signal exn))
      (let lp ((result '()))
        (next-ifa (location i)
                  (lambda (iface)               ; more
                    (lp (cons iface result)))
                  (lambda ()                    ; done
                    (free-ifa! (location ifa))

(print "The following interfaces are available: " (interfaces))

The magic lies in the expression ((C_proc3)C_fast_retrieve_proc(more))(3, more, C_k, str). We've seen something like it before in generated C code snippets: First, it extracts the C function pointer from the closure object in more. Then, the function pointer is cast to the correct type; C_proc3 refers to a procedure which accepts three arguments. This excludes the argument count, which actually is the first argument in the call. The next argument is the closure itself, which is needed when the closures has local variables it refers to (like result and lp in the example). The argument after the closure is its continuation. We just pass on C_k: the final continuation of both more and done is the continuation of lp, which is also the continuation of next-ifa. Finally, the arguments following the continuation are the values passed as arguments: iface for the more closure.

The done closure is invoked as C_proc2 with only itself and the continuation, but no further arguments. This corresponds to the fact that done is just a thunk.

I've shown two alternative ways to call the closure. The first is to call the closure through the C_do_apply function. This is basically a dispatcher which checks the argument count and uses the correct C_proc<n> cast and then calls it with the arguments, taken from a temporary stack on which C_save places the arguments. The implementation behind it is positively insane, and worth checking out for the sheer madness of it.

The second alternative is to use C_apply, which is the C implementation of Scheme's apply procedure. It's a bit awkward to call from C, because this procedure is a true Scheme procedure. That means it accepts an argument count, itself and its continuation and only then its arguments, which are the closure and the arguments to pass to the closure, with the final argument being a list:

(apply + 1 2 '(3 4)) => 10

In C this would be:

C_apply(6, C_SCHEME_UNDEFINED, C_k, C_closure(&a, 1, C_plus),
        C_fix(1), C_fix(2), C_list2(C_fix(3), C_fix(4)));

It also checks its arguments, so if you pass something that's not a list as its final argument, it raises a nice exception:

(import foreign)
((foreign-primitive ()
   "C_word ab[C_SIZEOF_CLOSURE(1)], *a = ab; \n"
   "C_apply(4, C_SCHEME_UNDEFINED, C_k, "
   "        C_closure(&a, 1, (C_word)C_plus), C_fix(1));"))

This program prints the following when executed:

 Error: (apply) bad argument type: 1
         Call history:
         test.scm:2: g11         <--

And this brings us to our final example, where we go absolutely crazy.

The guru way: Calling Scheme closures you didn't receive

You might have noticed that the error message above appears without us passing the error procedure to +, and if you had wrapped the call in an exception handler it would've called its continuation, without us passing it to the procedure. In some situations you might like to avoid boring the user with passing some procedure to handle some exceptional situation. Let's see if we can do something like that ourselves!

It turns out to be pretty easy:

(import foreign)
(use lolevel)

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")

(define grab-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))
    "if (getifaddrs(ifa) != 0)\n"
    "  *ifa = NULL;\n"))

(define free-ifa!
  (foreign-lambda* void (((c-pointer (c-pointer "struct ifaddrs")) ifa))

(define (show-iface-name x)
  (print x)

(define next-ifa
  (foreign-primitive (((c-pointer (c-pointer "struct ifaddrs")) ifa))
    "C_word len, str, *a, show_sym, show_proc;\n"
    "if (*ifa) {\n"
    "  len = strlen((*ifa)->ifa_name);\n"
    "  a = C_alloc(C_SIZEOF_INTERNED_SYMBOL(15) + C_SIZEOF_STRING(len));\n"
    "  str = C_string(&a, len, (*ifa)->ifa_name);\n"
    "  *ifa = (*ifa)->ifa_next;\n"
    ;; The new bit:
    "  show_sym = C_intern2(&a, C_text(\"show-iface-name\"));\n"
    "  show_proc = C_block_item(show_sym, 0);\n"
    "  ((C_proc3)C_fast_retrieve_proc(show_proc))(3, show_proc, C_k, str);\n"
    "} else {\n"
    "  C_kontinue(C_k, C_SCHEME_FALSE);\n"

(define (interfaces)
  (let-location ((ifa (c-pointer "struct ifaddrs"))
                 (i (c-pointer "struct ifaddrs")))
    (grab-ifa! (location ifa))
    (unless ifa (error "Could not allocate ifaddrs"))
    (set! i ifa)

    (handle-exceptions exn
      (begin (free-ifa! (location ifa))
             (signal exn))
      (let lp ()
        ;; next-ifa now returns true if it printed an interface and is
	;; ready to get the next one, or false if it reached the end.
        (if (next-ifa (location i))
            (free-ifa! (location ifa)))))))

(print "The following interfaces are available: ")

This uses C_intern2 to look up the symbol for "show-iface-name" in the symbol table (or intern it if it didn't exist yet). We store this in show_sym. Then, we look at the symbol's first slot, where the value is stored for the global variable identified by the symbol. The value slot always exists, but if it is undefined, the value is C_SCHEME_UNDEFINED. Anyway, we assume it's defined and we call it like we did in the example before this one: extract the first slot from the closure and call it.

This particular example isn't very useful, but the technique can be used to invoke hook procedures, and in fact the core itself uses it from barf() when it invokes ##sys#error-hook to construct and raise an exception when an error situation occurs in the C runtime.

by Peter Bex at October 16, 2014 07:05 PM

October 15, 2014

Ben Simon

Gotcha of the Day: Creating macros from within Gambit Scheme on Android

One of the most powerful features of Scheme is the ability to create macros. That is, along with the procedural abstractions most languages allow you to create, you can also create syntactical ones (I've got at least one blog post worth of stuff to say about this, so I dare you to ask me more!). While working on a Scheme Challenge on my cell phone, I wanted a quick way to repeat some code. Specifically, something along the lines of:

 (repeat 10
   (display (read-token in)))

(That is, I wanted to read and print the next 10 tokens from the input port in)

This is an easy enough macro to write in syntax-rules so I got to work. I quickly ran into an issue: define-syntax wasn't defined in the Gambit instance I was using. I tried a few other guesses and finally gave up, figuring I'd poke around the manual when I had a chance.

Sure enough, the manual had an explanation: define-macro is available by default, whereas define-syntax requires an add on module. While I'm no fan of define-macro, for my purposes it would work fine. I went ahead and put the following in ex1.scm, the file containing my answer to the exercise I was working on:

(define (range low high)
  (let loop ((i low) (result '()))
    (if (> i high)
        (reverse result)
        (loop (+ 1 i) (cons i result)))))
(define-macro (repeat qty . body)
  `(for-each (lambda (i) ,@body) (range 1 ,qty)))

I then ran my (lex) procedure from the REPL. To my surprise, the file loaded.

I then went to test my code:

(repeat 10 (display i) (newline))

To which the interpreter rudely responded:

*** ERROR IN (stdin)@2.2 -- Unbound variable: repeat

What the heck?

After a couple of more attempts I realized that I could use repeat within ex1.scm, but any attempt to use it from the REPL resulted in an unbound variable. When in doubt, read (or in my case, re-re-read) the manual. Which explains:

The scope of a local macro definition extends from the definition to the end of the body of the surrounding binding construct. Macros defined at the top level of a Scheme module are only visible in that module. To have access to the macro definitions contained in a file, that file must be included using the include special form. Macros which are visible from the REPL are also visible during the compilation of Scheme source files.

(Emphasis added by me)

I updated my (lex) procedure to be defined as:

 (define (lex)
  (include "/sdcard/Documents/ex1.scm"))

And what do you know, it worked! The REPL can now see and use the repeat macro.

In the future, I may mess around with loading the syntax-case facility into Gambit. This actually doesn't look like a particularly hard thing to do, I just know that when I attempted to load this file my phone churned on it for quite a while before returning an error. That makes me think this may be asking for a bit much from my Android. Regardless, define-macro gives me plenty of power, and I'm using it on a small enough scale that its unhygienic nature shouldn't do too much damage (famous last words, right?).

Finally, two other useful bits of info if you're playing around with the Gambit REPL on Android:

1) If you hit run next to the "Start REPL Server" example you can use a program like netcat to connect to the REPL for your laptop. This let me fiddle around with Gambit on my phone while using my laptop's keyboard and display. This is a classic trick, but one that never ceases to amaze me when I use it.

2) If you type ,? at the REPL prompt you'll gain access to a number of debugging commands. I haven't quite figured out the various "REPL levels" yet (that is, what's meant when you have an error and Gambit changes the prompt to 2>). But I now know I can jump to the top level by typing ,t.

by Ben Simon ( at October 15, 2014 11:05 AM