(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.

No SRFI-0 by default:

• mzscheme
• ikarus
• scheme48

Name exported for cond-expand:

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.

(define (load path . evalproc)
 (let ((eval (lambda (expr) (eval expr (interaction-environment)))))
   (if (and evalproc              ;; Do some checks on the procedure
            (list? evalproc)
            (> (length evalproc) 0)
            (procedure? (car evalproc)))
        (set! eval (car evalproc)) ;; True
        #f)                        ;; False
   (letrec ((eval-datum (lambda ()
                          (let ((datum (read)))
                            (if (eof-object? datum)
                                path
                                (begin
                                  (eval datum)
                                  (eval-datum)))))))
     (with-input-from-file path eval-datum))))

Some of this code is probably unnecessary, but I felt it better to err on the side of checking too much before using the optional evaluation procedure.  I could also trivially rewrite it to use the more clear DO form, rather than a tail-recursive lambda.  Also, it might be more adviseable to use the standard LOAD function if no special evaluation procedure is given.  I’m torn on that last one.  Whatever.

But anyway, I see now that I really should have given the matter some deeper thought before immediately writing a lengthy proposal to change fundamental language features.  Over the next few days, I intend to work on a Scheme implementation detection library.  If I am successful, the two most important points of my earlier proposal will have been fulfilled, and I will be content.

It’s been a learning experience.

Implementations tested were:

• MzScheme
• Bigloo
• Guile
• Chicken
• Gambit
• MIT Scheme
• STklos

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.

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.

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.

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.