It Seemed Like a Good Idea at the Time Coding, Mostly

20Aug/109

Announcing the UCL Portability Libraries

I spent the last year learning Haskell, and it is a very cool language. That said, I get the feeling that it also gains a gigantic competitive advantage from cabal-install and HackageDB. Package repositories and install tools for languages are not a new thing, but it was Hackage that made me realize how effectively a common package infrastructure can help to raise the popularity of a language.

And here's the thing: to a sufficiently fuzzy approximation, all the R6RS Schemes out there are interchangeable. They all offer a foreign function interface with roughly the same capabilities, they all offer the ability to launch and control subprocesses, and just about anything else can be built up from there. All of the cool things that can be built from these primitives, there is no fundamental reason they can't be portable.

So in April I started working on a set of portability packages, followed by an install tool, followed by a web-based package upload and browsing interface. And now it's all sufficiently done that I feel like I should release it.

So here you go.

Caveats

It supports Ikarus, Larceny, Mosh, Racket, and Ypsilon, at least on my machine.

The install tool could certainly use more features, like a package upgrade ability, code precompilation for the various Schemes, and complex version constraints on packages. The web interface is horrible code, and I'm just happy it seems to work as well as it does.

But what I am proud of are the simple but extensible package format, with myriad available extension points for new features, the simple repository format which allows anyone to start serving up packages if they don't like my offering, and the libraries which allow FFI and process manipulation to operate identically across Schemes.

Similar Projects

This code doesn't exist in a vacuum, and there are other projects whose scope overlaps with mine.

The most noticeable, to me, is Marco Maggi's Nausicaa, a gargantuan library distribution for R6RS Schemes. I regret to say that I have no experience using it, but the sheer number of libraries is impressive. I would like nothing more than to see some of those libraries available through UCL Install at some point.

The only other R6RS package manager that I have heard of is Dorodango. It does not seem to have been officially released yet, and if I understand the documentation correctly, it only supports Ikarus and Ypsilon at this time. It does have an upgrade command, unlike UCL Install at this point.  I envy the awesome choice of name, and I look forward to seeing what the author does with this one in the future.

Finally we come to Snowfort, an older attempt at a Scheme packaging system. I do not believe it is R6RS compatible, as it defines its own module system, and it appears to have no FFI or other portability layers, so I believe packages are limited to pure Scheme code. I would like to look at either manually or automatically porting some of these packages at some point, if the authors are amenable.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , 9 Comments
21Mar/092

Fixing Broken Macros with Eval and Quasiquote

Recently, I found myself needing to deal with a "convenience" macro, which quoted several of its arguments for me before passing them along to the real function.  Unfortunately, only the macro was exported from the library, and I was unable to access the base function.

(define-syntax convenient-function
  (syntax-rules ()
    ((_ arg1 arg2) (much-harder-function 'arg1 'arg2))))

How useful.  To save me a handful of quotes, I lose the ability to programmatically generate my arguments.

As I was loath to reimplement the entire library just to regain that ability, I looked for another solution.  Thankfully, I found one.

(define (much-harder-function arg1 arg2)
  (eval `(convenient-function ,arg1 ,arg2)
        (environment '(convenient-lib))))

As far as I can tell, this circumvents the macro's quoting features entirely to allow me to pass in a dynamically generated symbol.  While it won't work with functions which modify the environment, it worked well in my case, and allowed me to move on to more interesting code.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , , 2 Comments
14Mar/091

SRFI-0 for Detecting Scheme Implementation

I found out earlier today that SRFI-0 can be used to determine the host Scheme in some cases.  Here is the result of my testing, in case someone finds it useful:

No SRFI-0 by default:

  • mzscheme
  • ikarus
  • scheme48

Name exported for cond-expand:

Scheme Name     SRFI-0 Feature Name
CHICKEN chicken
Guile guile
Bigloo bigloo
Gambit gambit
MIT Scheme mit
Gauche gauche
Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , 1 Comment
14Mar/091

Runtime Scheme Detection

I really want my code to be "write once, run anywhere", at least as far as Schemes go.  R6RS library features make strides toward that goal.  Only, there's not many R6RS Schemes.  Since there are a whole lot of R5RS ones, I'd like to include R5RS in the portability fun.

In many cases, enough functionality appears in all major implementations to make some major steps toward portability.  So a while back, I decided to get a few things out of the way (you know, processes, FFI, things like that).

To make simple, portable libraries, we need to find out some details about the Scheme implementation the code is running under.  Unfortunately, there is no standard way to do this.  We could just call a function and see if it worked, but then we throw an error, and there's no standard way to trap those in R5RS.  And even if a function of the given name existed, we still don't know what arguments it takes, because that differs too.

So we're left with some sort of indirect detection method,  guessing the implementation based on a bunch of unrelated tests.

So I gathered a list of as many nonstandardized/undefined behaviours as possible (mainly from this table, and grepping the R5RS spec for the word "undefined").  Then I filtered those differences down to a bunch of tests that won't error out.  Then I took the tests that gave meaningful results, and because I had enough of those to be picky, I took only tests which fit on a single line.

The resulting set of 20 tests generates a sort of "signature" -- a list of twenty boolean values that identifies the host Scheme.

Currently the code works on:

  • MzScheme
  • CHICKEN
  • Guile
  • Bigloo
  • Gambit
  • Ikarus
  • Scheme48
  • MIT Scheme
  • Gauche

This is actually a list of all the implementations I have installed right now, and other implementations can be supported just by adding another line to the signatures list.

On Scheme implementations which provide a compiled and an interpreted mode, only interpreted has been tested (I don't really know how to use a compiled Scheme, so I didn't).  Some Schemes have different behaviour interpreted and compiled, so caution should be used there.

Enough talk, here's the code:

;;;
;;; DETECT
;;;   A set of functions to allow an interpreted Scheme
;;;    program to determine the implementation it is
;;;    running under.
;;;

;;
;; DETECT:SIGNATURE
;;   Assemble a signature for the current
;;   Scheme implementation.
;;
(define (detect:signature)
  (list
    ;; AXCH: exact-sqrt
    (exact? (sqrt 4))
    ;; AXCH: exact-times-zero
    (exact? (* 0 3.1))
    ;; AXCH: exact-div-zero
    (exact? (/ 0 4.7))
    ;; AXCH: exact-rationals
    (exact? (/ 1 3))
    ;; AXCH: case-sensitive
    (eq? 'a 'A)
    ;; AXCH: promises-are-thunks
    (procedure? (delay 3))
    ;; Do strings made from numbers less than 1 omit the 0?
    (string=? ".5" (number->string 0.5))
    ;; AXCH: literal-rationals
    (number? (string->number "1/2"))
    ;; AXCH: literal-complexes
    (number? (string->number "1+i"))
    ;; Is the empty string eqv to itself?
    (eqv? "" "")
    ;; How about the empty vector?
    (eqv? '#() '#())
    ;; A non-empty string?
    (eqv? "a" "a")
    ;; Does SET! have a constant return value?
    (let ((x 0)) (eqv? (set! x 1) (set! x 'asd)))
    ;; Is it equal to other undefined things?
    (eqv? (for-each (lambda (x) #t) '(0 1 2)) (let ((x 123)) (set! x 321)))
    ;; Are negative and positive inexact zero the same?
    (eq? +0.0 -0.0)
    (eqv? +0.0 -0.0)
    (equal? +0.0 -0.0)
    ;; Is the default vector filled with zeroes?
    (equal? (make-vector 5) '#(0 0 0 0 0))
    ;; Is the default vector filled with falses?
    (equal? (make-vector 5) '#(#f #f #f #f #f))
    ;; Vector-fill returns a vector?
    (vector? (vector-fill! (make-vector 1) 0))
    ))

;;
;; DETECT:KNOWN-SIGNATURES
;;   A precalculated list of signatures for all supported
;;    Scheme implementations.
;;
(define detect:known-signatures
'((mzscheme   (#t #t #t #t #f #f #f #t #t #f #f #f #t #t #f #f #f #t #f #t))
  (chicken    (#f #f #f #f #f #f #f #t #f #f #f #f #t #t #f #t #t #f #f #f))
  (guile      (#f #t #f #t #f #f #f #t #t #t #f #f #t #t #f #f #t #f #f #f))
  (bigloo     (#f #f #f #f #f #t #f #f #f #f #f #f #t #t #f #t #t #f #f #f))
  (gambit     (#t #t #t #t #f #f #t #t #t #f #f #f #t #t #f #f #f #t #f #f))
  (ikarus     (#f #f #f #t #f #t #f #t #f #f #f #f #t #f #f #t #t #t #f #f))
  (scheme48   (#f #f #f #t #t #t #f #t #t #t #t #t #t #t #t #t #t #f #f #f))
  (mit-scheme (#t #t #t #t #t #f #t #t #t #f #t #f #f #f #f #t #t #f #t #f))
  (gauche     (#f #f #f #t #f #f #f #t #t #f #f #f #f #f #f #t #t #f #f #f))))

;; DETECT:MATCH-SIGNATURE
;;   Determine the name of the current Scheme implementation
;;    by checking the signature returned by DETECT:SIGNATURE
;;    against a table of known signatures.
(define (detect:match-signature)
  (let ((signature (detect:signature)))
    ; Loop over the DETECT:KNOWN-SIGNATURES list
    (let test ((siglist detect:known-signatures))
      (if (equal? '() siglist)
        ; Return 'UNKNOWN if we're stumped
        'unknown
        (let ((testsig (car siglist)))
          (if (equal? (cadr testsig) signature)
            (car testsig)
            (test (cdr siglist))))))))

;;
;; DETECT:NAME
;; Memoized form of DETECT:MATCH-SIGNATURE
;;
(define detect:name
  (let ((memo #f))
    (lambda ()
      (and (not memo)
           (set! memo (detect:match-signature)))
      memo)))

Obviously, only the memoized DETECT:NAME is meant for general use, since a program generally won't the see the host changing as it runs, and repeatedly calculating the name would be inefficient.  I don't actually have much experience with Scheme, so the DETECT:MATCH-SIGNATURE function could probably be written more efficiently, but it works.

Anyway, I hope that someone finds this to be useful.  I have used it to write the beginnings of a portable process library.  More on that after I get around to polishing it up a bit more.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
15Jan/093

Scheme Load Return Values

Shortly after finishing my previous post, I began to wonder if maybe some of the features I had requested were available already.  I was pleasantly surprised.

Implementations tested were:

Bad news first.  In my hour or so of testing, I was unable to find any way to directly return values from a loaded file in Guile, Gambit, and STklos.

On the other hand, that means that four of the seven implementations that I tested could return values.

MzScheme and MIT Scheme both return the last form, whatever it was.  If the last form was a DEFINE statement, MzScheme returns nothing, and MIT Scheme returns the identifier that was defined.

Bigloo doesn't seem to return anything usable, but it does print the results of intermediate evaluations, and claims to return the result of the last evaluation.  This may indeed be true, but in my testing I was unable to get it to return anything other than the path of the just-loaded file.

Chicken, however, was an unqualified success.  Although it is true that at first it returns nothing from its LOAD function, it provides a brilliant little mechanism to fix that.  The LOAD function, in addition to taking a filename, will also take an optional argument called EVALPROC, which is called repeatedly with each form from the loaded file.  This fact, combined with a little closure magic, ends us up with this:

(define (load-return file)
  (let ((return '()))
    (load file
      (lambda (exp)
        (if (and (list? exp) (eqv? (list-ref exp 0) 'define))
            (begin
          (eval exp)
          (set! return (cons (list-ref exp 1) return)))
                (set! return (cons (eval exp) return)))))
    (reverse return)))

This function calls the LOAD function, but passes it its own evaluation procedure, which will assemble a list of values when called, as well as evaluating each expression.

After seeing the beautiful and elegant way in which Chicken Scheme allows the user to dynamically alter the behaviour of the LOAD function at runtime, I feel like I should alter my recommendation for modifying that behaviour.  Chicken has, I believe, found the best possible way to implement such functionality: have a reasonable default, but allow people to override it if they wish.  Simple, elegant, and powerful: exactly like the language itself.  Bravo, Chicken.

Bravo.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
14Dec/080

A Foreign Function Interface for Ikarus Using SoLoad

A while back I wrote a foreign function server called SoLoad.  It is intended for situations where a regular FFI, for whatever reason, is not available to you, but the permissions necessary to run and communicate with programs are available.

Once this was in place, I proceeded to write some code to take advantage of my program, and provide rudimentary C function capabilities to the Ikarus scheme implementation.  I got most of the code done, implementing portable type conversion functions, an implementation-independent interface to encapsulate the initialization and communication code, and all the little macros necessary to make the FFI easy to use.  It had its bugs, but it worked pretty well.  Well enough, at least, to create a window using SDL, and then close it again.

And then I just sort of forgot.  Somehow, after getting it all to work and provide a basic level of C library integration to Ikarus, I just wandered off and allowed myself to get involved in other projects.

Today, I was looking through my projects folder, and happened to notice the code I had previously forgotten.  Working under the assumption that someone could probably find a use for it, I decided that I would clean it up and post it online.

It required considerably less cleaning that I had expected.

Basic Structure of the Scheme->SoLoad Link

A major design goal in this project was designing it in a way that would allow it to be easily ported to a variety of Scheme implementations and communication channels.  The design I ultimately settled on was as follows:

There is one function, SOLOAD-INIT, which handles essentially all of the necessary setup, communication, and teardown code associated with using SoLoad.  When called, it is passed the path to the SoLoad executable, and calls it.  It then returns a pair, whose CAR is a function to send data to SoLoad and return whatever data SoLoad sends back, and whose CDR is a function that will tell SoLoad to exit and perform any other teardown functions that may be necessary.

Its implementation for Ikarus looks like this:

(import (ikarus))
;;;
;;; soload-init
;;;   Starts an instance of SoLoad
;;;   Returns a cons cell containing two functions:
;;;     car: Send a command to SoLoad, return the output.
;;;     cdr: Kill SoLoad and close all sockets.
;;;
(define (soload-init soload-path)
  ;; Start SoLoad, and bind its input, output, and error ports.
  (let-values ([(pid ip op errp)
                (process soload-path "stdin")])
    ;; Transcode the ports we'll be using.
    (let ([soload-in  (transcoded-port op (native-transcoder))]
          [soload-out (transcoded-port ip (native-transcoder))])
      (cons
       ;; Send commands to SoLoad
       (lambda (command)
         (unless (port-closed? soload-out)       ; Make sure it's open
                 (put-string soload-out command) ; Send the command
                 (newline soload-out)            ; Newline
                 (flush-output-port soload-out)) ; Flush the port
         (unless (port-closed? soload-in)        ; Make sure it's open
                 (get-line soload-in)))          ; Get the output
       ;; Kill SoLoad and close the ports
       (lambda ()
         (unless (port-closed? soload-out)       ; Make sure it's open
                 (put-string soload-out "exit\n"); Tell it to close
                 (flush-output-port soload-out)  ; Flush output
                 (close-port soload-out))        ; Close the port
         (unless (port-closed? soload-in)        ; Make sure it's open
                 (close-port soload-in))         ; Close the port
         (unless (port-closed? errp)             ; Make sure it's open
                 (close-port errp)))))))         ; Close the port

And that concludes the implementation-dependent portion of the interface.  All of the code above this level is (hopefully) completely independent of whatever particular Scheme it is running on.

Type Conversion

The next important part of the Ikarus/SoLoad FFI is the conversion between Scheme native types, and their text-based representation.

This consists of a myriad of small little functions, to escape/unescape strings, convert numbers, and flatten lists into a single string.  They are each easy to implement, and should be entirely portable Scheme code.

All together, they run a little long, but I may as well post them here as well:

;;
;; soload-escape
;;   Escape text so SoLoad will read it properly.
;;
(define (soload-escape text)
  (string-append "\"" text "\""))

;;
;; soload-unescape
;;   Remove the escaping from text that SoLoad returns.
;;
(define (soload-unescape text)
  (list->string
   (reverse
    (cdr
     (reverse
      (cdr
       (string->list text))))))) ; Remove quotation marks

;;
;; native->soload
;;   Converts a native type to a
;;   string representation that can
;;   be passed to SoLoad.
;;
(define (native->soload type value)
  (case type
    [(int float double long short
          uint8 sint8 uint16 sint16
          uint32 sint32 uint64 sint64
          ushort sshort uint sint
          ulong slong char uchar
          schar) (number->string value)]
    [(string char*)  (soload-escape value)]
    [(pointer void*) value]
    [(void) ""]
    [else "0"]))

;;
;; soload->native
;;   Converts a SoLoad string
;;   into a native type.
;;
(define (soload->native type value)
  (case type
    [(int float double long short
          uint8 sint8 uint16 sint16
          uint32 sint32 uint64 sint64
          ushort sshort uint sint
          ulong slong char uchar
          schar) (string->number value)]
    [(string char*)  (soload-unescape value)]
    [(pointer void*) value]
    [(void) #t]
    [else #f]))

(define (list:native->soload types values)
  (if (> (length types) 0)
      (cons
       (native->soload (car types) (car values))
       (list:native->soload (cdr types) (cdr values)))
      '()))

(define (list:soload->native types values)
  (if (> (length types) 0)
      (cons
       (soload->native (car types) (car values))
       (list:soload->native (cdr types) (cdr values)))
      '()))

(define (soload-flatten strings)
  (apply string-append
         (map
          (lambda (element) (string-append " " element))
          strings)))

Wrapping It All Up

These functions technically provide all the functionality required to use SoLoad from within Ikarus, but they lack a little something.  What they need now is to be made easy.  It should be possible to declare a function such that it just works from anywhere in your program, with no need to know that it's calling a helper behind the scenes.

This is possibly the most involved portion of the interface, because it requires individually wrapping every function of SoLoad, and then adding a few macros to neaten things up.  In the end, though, I think it works out well:

(define soload-process #f)
(define soload-path "soload")

(define (soload-set-path path)
  (set! soload-path path))

(define (soload-send command)
  (if (equal? soload-process #f)
      (set! soload-process (soload-init soload-path)))
  ((car soload-process) command))

(define (soload-kill)
  (if (not (equal? soload-process #f))
      (begin
        ((cdr soload-process))
        (set! soload-process #f))))

(define (soload-library path)
  (soload-send (string-append "open " path)))

(define (soload-fn-load library name rtype atypes)
  (soload-send
   (string-append
    "load " library " " name " "
    (symbol->string rtype) " "
    (number->string (length atypes))
    (soload-flatten (map symbol->string atypes)))))

(define (soload-fn-call function rtype atypes args)
  (soload->native rtype
   (soload-send
    (string-append
     "call " function
     (soload-flatten
      (list:native->soload atypes args))))))

(define (soload-import definitions)
  (soload-send (string-append "def " definitions)))

(define (soload-type-define name . types)
  (soload-send
   (string-append "type " name " "
                  (number->string (length types))
                  (soload-flatten (map symbol->string types)))))

(define (soload-type-create name . args)
  (soload-send
   (string-append "new " name " "
                  (soload-flatten (list:native->soload types args)))))

(define (soload-delete name pointer)
  (soload-send (string-append "delete " name " " pointer)))

(define-syntax soload-function
  (syntax-rules ()
    ((_ library name (atypes ...) rtype)
     (let ([function (soload-fn-load library name
                                     'rtype '(atypes ...))])
       (lambda arguments
         (soload-fn-call function 'rtype
                         '(atypes ...) arguments))))
    ((_ library name (atypes ...))
     (soload-function library name (atypes ...) void))
    ((_ library name rtype)
     (soload-function library name () rtype))
    ((_ library name)
     (soload-function library name () void))))

;; Warning! SOLOAD-TYPE does not delete the stuff
;;   that it creates.  It will stick around till
;;   SoLoad is closed.
(define-syntax soload-type
  (syntax-rules ()
    ((_ name types ...)
     (let ([type (soload-type-define name types ...)])
       (lambda arguments
         (soload-send
          (string-append
           "new " name " "
           (soload-flatten
            (list:native->soload '(types ...) arguments)))))))))

Using It

Along with a working executable of SoLoad, this code should be all that is needed to use C libraries from within Ikarus.  I tested it roughly 5 minutes ago, so I'm fairly certain it works.  A working example, assuming all the previous code is in a file called "ikarus-soload.ss", with the soload executable (or a symlink) in the same directory, is as follows:

(load "ikarus-soload.ss")

(soload-set-path "./soload")

;;;
;;; Math Check
;;;   Test the value of sin for progressively closer values of pi.
;;;   Should return numbers moving closer to 0
;;;

;; Import the library
(define libm (soload-library "/lib/libm.so.6"))
;; Import the function
(define s-sin (soload-function libm "sin" (double) double))
;; Do some tests
(newline)
(pretty-print (s-sin 3))
(pretty-print (s-sin 3.1))
(pretty-print (s-sin 3.14))
(pretty-print (s-sin 3.141))

;;;
;;; SDL Test
;;;   Load SDL, create a window, then quit
;;;

;; Load the library
(define lib-sdl
  (soload-library "/usr/lib/libSDL.so"))
;; Load a bunch of functions
(define sdl-init
  (soload-function lib-sdl "SDL_Init" (uint32) int))
(define sdl-quit
  (soload-function lib-sdl "SDL_Quit"))
(define sdl-set-video-mode
  (soload-function lib-sdl "SDL_SetVideoMode" (int int int uint32) pointer))
(define sdl-fill-rect
  (soload-function lib-sdl "SDL_FillRect" (pointer pointer uint32) int))
(define sdl-flip
  (soload-function lib-sdl "SDL_Flip" (pointer) int))
(define sdl-map-rgb
  (soload-function lib-sdl "SDL_MapRGB" (pointer uint8 uint8 uint8) uint32))
;; Declare a type
(define SDL_Rect*
  (soload-type "SDL_Rect" 'sint16 'sint16 'uint16 'uint16))

(sdl-init 0)
(define sdl-surface (sdl-set-video-mode 640 480 16 0))
(sdl-fill-rect sdl-surface (SDL_Rect* 0 0 640 480) 32535)
(sdl-flip sdl-surface)

(sdl-quit)
(soload-kill)

Now that I've taken a break from this for a while, I can see a few areas it could be made more robust.  Next feature: an optional timeout period for SoLoad, so it can close gracefully even if the caller has crashed.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
4Sep/0814

A Scheme Syntax-Rules Primer

Scheme has a wonderfully powerful hygienic macro system.  Unfortunately, explanations on how to use it are few and far between.  R5RS is utterly incomprehensible to anyone who doesn't already have a firm grounding in hygienic macro systems, and TYSiFD's section on macros dates from a time before syntax-rules and hygiene.

So this here is my attempt to share what I've learned over the past few days with regards to syntax-rules macros.  Bear in mind that at the time of writing this, I have known how to use syntax-rules since yesterday, but my knowledge seems to be complete enough to write a working module system, so here's my attempt to pass on what I've learned.

First things first.  You use define-syntax to create a top level binding, and let-syntax bears the same relationship to define-syntax as you'd expect.

;; define-syntax is used to create
;;  a top-level binding of a macro
(define-syntax macro
  <syntax transformer>)

That much is pretty clear from reading R5RS, now we need to figure out how to write the syntax transformer.  There are a few ways to do this, but the best way for beginners is to use syntax-rules, which avoids inadvertent variable capture and other such nasties automatically, and uses a rather elegant pattern matching language.

We'll start by trying to write a simple macro, while. This will just be a standard looping construct that keeps executing over and over until its condition becomes false.  We want its usage to look something like this:

;; A simple while loop
(define x 0)
(while (< x 5)
  (set! x (+ x 1))
  (print x))

So first, we need the define-syntax form.

(define-syntax while
  <syntax transformer>)

Next, we need to write the syntax transformer itself.  This is where syntax-rules comes into play.  Syntax-rules uses pattern matching and text substitution to allow you to make some pretty advanced macros.  It looks like:

(define-syntax while
  (syntax-rules (<keywords>)
    ((<pattern>) <template>)
    ...
    ((<pattern>) <template>)))

I will explain keywords later.  For now, just leave that bit blank.  What we're interested in are those ((<pattern>) <template>) pairs.  Each <pattern> is just that, a pattern of code that will be matched.  In our case, we want to match the pattern:

(while condition body ...)

Where the '...' signifies that body may contain one or more forms. Luckily for us, this is exactly the syntax that syntax-rules wants to see, so we can just plug it in, giving us:

(define-syntax while
  (syntax-rules ()
    ((while condition body ...) <template>)))

So far so good.  Now we just have to fill in the other half, with a suitable <template>

Before we can write the <template>, though, we have to decide what we want the code to end up looking like.  Since this isn't a guide to scheme code in general, I'll just go ahead and say that we want the output to look like:

; Thanks to Alex Shinn for pointing out a mistake
(let loop ()
  (if condition
      (begin
        body ...
        (loop))
      #f))

Got that?  Okay, now we've just got to put this in our syntax-rules macro as a template.  By another startling coincidence, this is exactly what the template code is expected to look like.  We just plug in that code, and our final result is:

(define-syntax while
  (syntax-rules ()
    ((while condition body ...)
     (let loop ()
       (if condition
           (begin
             body ...
             (loop))
           #f)))))

Just plug that into your scheme interpreter, and our while loop from earlier should execute perfectly.

Now let's try to write something a little more complicated.  We want to write a for loop similar to the one that Python has.  This should be a pretty easy task, since it's basically just syntactic sugar for scheme's map function.

Our goal is to be able to write a piece of code taking the form:

(for <element> in <list>
     <body ...>)

And have it expand to:

; Thanks to Alex Shinn for pointing out a mistake
(for-each (lambda (<element>)
       <body ...>) <list>)

Our first try would probably look something like this:

(define-syntax for
  (syntax-rules ()
    ((for element in list body ...)
     (map (lambda (element)
            body ...)
          list))))

This works, but there's one issue with it.  All of the following are valid and work exactly the same:

(for i in '(0 1 2 3 4) (print i))
(for i fnord '(0 1 2 3 4) (print i))
(for i some-other-keyword '(0 1 2 3 4) (print i))

This is not so much of a problem in the case of a for loop, but what if you wanted to add another rule later, so that

(for '(0 1 2 3 4) as i
     (print i))

will also work? The solution to this problem is in that <keywords> argument that we glossed over earlier.  Change the keywords list to include 'in' (and, for good measure, 'as'), and it will allow those symbols, and only those symbols, in places where they are mentioned.  This change leaves us with:

(define-syntax for
  (syntax-rules (in as)
    ((for element in list body ...)
     (map (lambda (element)
            body ...)
          list))
    ((for list as element body ...)
     (map (lambda (element)
            body ...)
          list))

Or, for simplicity (thanks to Dan Prager for pointing this out)

(define-syntax for
  (syntax-rules (in as)
    ((for element in list body ...)
     (map (lambda (element)
            body ...)
          list))
    ((for list as element body ...)
     (for element in list body ...))))

And if we load this code into our scheme interpreter of choice, we should have two fully functional little bits of new syntax.

Hopefully this guide will help shed some light on the arcane subject that is the Scheme macro system, and hopefully I will never have to learn enough about syntax-case to write a tutorial on it.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
30Aug/081

A Minimalistic Module System for Scheme

I like scheme.

I really, really like scheme.

Unfortunately, it seems like a lot of the time the only way to get worthwhile things done in scheme is to abandon the conceptual purity and the elegance, all of the things that make scheme as wonderful as it is.

I figure I'm as good a person as any to try and fix at least a little of that.

The first (second actually, but more about that in the next post) step toward that is some sort of cross-implementation module system. As far as I know, the only such systems in existence so far are SLIB and Snowfort. While both of these are wonderful systems, they overshoot the mark, in my opinion. SLIB aims to be a complete all-singing all-dancing library system, and Snowfort integrates all kinds of package management with the simple act of breaking a program up into modules.

Well, that's the beauty of lisp, isn't it? If you need something, you can just code it yourself.

So I did. The preliminary result is only 19 lines of code, 6 of which are simply a function to build an alist from a key list and a value list. It can also double as a simple object system if you want to use it that way.

Its usage is simple. There are two macros, provide and module. Provide is basically the same as module, but anonymous, so it needs no documentation other than to say that you omit the name.

;;; simple-module-example.scm
;;; Show off the usage of simple-module.scm
;;; By Will Donnelly

;; This program is free software. It comes without any warranty, to
;; the extent permitted by applicable law. You can redistribute it
;; and/or modify it under the terms of the Do What The Fuck You Want
;; To Public License, Version 2, as published by Sam Hocevar. See
;; http://sam.zoy.org/wtfpl/COPYING for more details.

(load "simple-module.scm")

;; (module <name> (<exports> ...) <body> ...)
(module mod-name (foo incr)
  (define foo 37)
  (define i 10)       ; i cannot be accessed directly
  (define (incr)
    (set! i (+ i 1))
    i))
(mod-name 'foo) ; => 37
((mod-name 'incr)) ; => 11
((mod-name 'incr)) ; => 12
((mod-name 'incr)) ; => 13

That's all you have to do to use it. The code inside the module system is about as simple as that too.

;;; simple-module.scm
;;; A minimalistic module system for scheme
;;; By Will Donnelly

;; This program is free software. It comes without any warranty, to
;; the extent permitted by applicable law. You can redistribute it
;; and/or modify it under the terms of the Do What The Fuck You Want
;; To Public License, Version 2, as published by Sam Hocevar. See
;; http://sam.zoy.org/wtfpl/COPYING for more details.

(define (make-alist names values)
  (if (equal? (length names) (length values))
      (if (> (length names) 0)
          (cons (cons (car names) (car values)) (make-alist (cdr names) (cdr values)))
          '())
      #f))

(define-syntax provide
  (syntax-rules ()
    ((_ (exports ...) body ...)
     ((lambda ()
        body ...
        (define export-alist
          (make-alist '(exports ...) (list exports ...)))
        (lambda (symbol)
          (cdr (or (assoc symbol export-alist) '(#f . #f)))))))))

(define-syntax module
  (syntax-rules ()
    ((_ name (exports ...) body ...)
     (define name (provide (exports ...) body ...)))))

Just load that code into your scheme interpreter, and you have a simple module system. That's all there is to it.

Digg This
Reddit This
Stumble Now!
Buzz This
Vote on DZone
Share on Facebook
Bookmark this on Delicious
Kick It on DotNetKicks.com
Shout it
Share on LinkedIn
Bookmark this on Technorati
Post on Twitter
Google Buzz (aka. Google Reader)
Tagged as: , 1 Comment