Bigloo, Macros and the REPL

I've just spent quite a while trying to make Bigloo do what I want with macros. What I want:

1. To be able to write macros within a module which I can use while compiling code in that module or other modules which import the macro-module.
2. To be able to write macros which are imported into an repl which incorporates the module in which they are written.

Doing this has required a bit of trickery. (The difficulty is that I want the macros at 3 times: 1. When the compiler is processing the module in which they are defined. 2. When the compiler is processing other modules which use them. 3. When the repl is up and running.)

The solution is to write modules with macros like this:

(module with-gensyms
   (eval (export-exports))
   (export (with-gensyms-expander x e)))

(define (with-gensyms-expander x e)
   (match-case x
      ((with-gensyms (?sym) . ?body)
       (e `(let ((,sym (gensym)))
              ,@body) e))
      ((with-gensyms (?sym1 . ?rest) . ?body)
       (e `(let ((,sym1 (gensym)))
              (with-gensyms ,rest ,@body)) e))))

(eval '(define-expander with-gensyms with-gensyms-expander))

And use them in other modules like this:

(module f64vector
   (eval (export-all))
   (import (with-gensyms "with-gensyms.scm")
           (do-macros "do-macros.scm"))
   (load (with-gensyms "with-gensyms.scm")
         (do-macros "do-macros.scm"))
   (type (tvector f64vector (double)))
   (export (f64vector::f64vector . inits)
           (with-f64vectors-expander x e)))

(define (f64vector::f64vector . inits)
   (let* ((n (length inits))
          (v (make-f64vector n 0.0)))
      (let loop ((i 0) (list inits))
         (if (null? list)
             v
             (begin 
                (f64vector-set! v i (car list))
                (loop (+fx i 1) (cdr list)))))))

(define (with-f64vectors-expander x e)
   (match-case x
      ((with-f64vectors ?vecs (<- . ?body))
       (with-gensyms (result n i)
          (e `(let* ((,n (f64vector-length ,(car vecs)))
                     (,result (make-f64vector ,n 0.0)))
                 (do-times (,i ,n)
                    (let ,(map (lambda (sym)
                                  `(,sym (f64vector-ref ,sym ,i)))
                               vecs)
                       (f64vector-set! ,result ,i
                                       (begin ,@body))))
                 ,result) e)))
      ((with-f64vectors ?vecs . ?body)
       (with-gensyms (i n)
          (let* ((vector-syms (map (lambda (sym) (cons sym (gensym))) vecs))
                 (process-body-term
                  (lambda (term)
                     (match-case term
                        ((?result <- . ?body)
                         `(f64vector-set! ,(cdr (assoc result vector-syms))
                                          ,i
                                          (begin ,@body)))
                        (?- term)))))
             (e `(let ((,n (f64vector-length ,(car vecs))))
                    (let ,(map (lambda (sym)
                                  `(,(cdr (assoc sym vector-syms)) ,sym))
                               vecs)
                       (do-times (,i ,n)
                          (let ,(map (lambda (sym)
                                        `(,sym (f64vector-ref ,sym ,i)))
                                     vecs)
                             ,@(map process-body-term body))))) e))))))

(eval '(define-expander with-f64vectors with-f64vectors-expander))

(Note that this module uses two macro-modules---one of which is not listed above---to define a third. I'm sorry for the confusing example, but it's what I have handy.)

How does this work? Here's my understanding:

1. The compiler begins processing the with-gensyms.scm file. The compiler compiles it into with-gensyms.o which contains a module initialization routine that evaluates all the top-level commands in the module whenever the module is initialized---this ensures that the (eval '(define-expander with-gensyms ...)) runs whenever the module is initialized in compiled code (i.e. when running a custom repl).
2. The compiler processes f64vector.scm. It sees the (load (with-gensyms ...)) command in the module header, and interprets the file with-gensyms.scm, installing the with-gensyms macro before processing the code in f64vector.scm. The f64vector.scm file compiles into f64vector.o which contains a module initialization routine which will initialize the with-gensyms module first (because bigloo sees that it is required by a (import (with-gensyms ...)) in the f64vector module header) whenever the f64vector module is required from compiled code (i.e. within the main routine which implements the repl).

Thus, when compiling the code, all the macros are interpreted, but when running the code (i.e. within the repl), the macro-expanders are actually compiled! Any module which needs the macros at compile time should use the (load ...) form in the module header, and any module which wishes to install these macros at run time should use the (import ...) form. Whew! The repl in question can be implemented by

(module repl
   (import (with-gensyms "with-gensyms.scm")
    (do-macros "do-macros.scm")
    (f64vector "f64vector.scm"))
   (main main))

(define (main argv)
   (repl))

It took me a long enough time to figure this out (and I wouldn't have figured it out without some suggestions from jg malecki (see this message and its antecedents---thanks jg) that I thought I should post the explanation here so that other people don't have to go through the same difficulties that I have.

Making Scheme behave like Fortran 95

I just coded up a macro which makes Bigloo scheme behave more like Fortran 95 with respect to vectors. Usage:

(with-vectors (a b c)
   (a <- (+ b c)))
(with-vectors (a b c)
   (<- (+ a b c)))
(with-vectors (a b c)
   (a <- (+ b 2))
   (print "I can insert statements, too.")
   (c <- (+ a b)))

The second form above returns a fresh vector whose elements are the sums of the corresponding elements in a b and c. The length of the new vector is the same as the length of a. In all cases, the number of iterations of the body is the length of a (this isn't quite the right thing to do---that would be to make the number of iterations be the minimum of the lengths of a b and c or to throw an exception if a b and c are not the same length). The macro follows:

(define-expander with-vectors
   (lambda (x e)
      (match-case x
         ((with-vectors ?vecs (<- . ?body))
          (with-gensyms (result n i)
             (e `(let* ((,n (vector-length ,(car vecs)))
                        (,result (make-vector ,n)))
                    (do-times (,i ,n)
                       (let ,(map (lambda (sym) `(,sym (vector-ref ,sym ,i)))
                                  vecs)
                          (vector-set! ,result ,i
                                       (begin ,@body))))
                    ,result) e)))
         ((with-vectors ?vecs . ?body)
          (with-gensyms (i n)
             (let* ((vector-syms (map (lambda (sym) (cons sym (gensym))) vecs))
                    (process-body-term
                     (lambda (term)
                        (match-case term
                           ((?result <- . ?body)
                            `(vector-set! ,(cdr (assoc result vector-syms))
                                          ,i
                                          (begin ,@body)))
                           (?- term)))))
                (e `(let ((,n (vector-length ,(car vecs))))
                       (let ,(map (lambda (sym)
                                     `(,(cdr (assoc sym vector-syms)) ,sym))
                                  vecs)
                          (do-times (,i ,n)
                             (let ,(map (lambda (sym)
                                           `(,sym (vector-ref ,sym ,i)))
                                        vecs)
                                ,@(map process-body-term body))))) e)))))))

It requires a completely obvious (I hope) do-times macro, and also with-gensyms (a lisp favorite):

(define-expander do-times
   (lambda (x e)
      (match-case x
         ((do-times (?i ?n) . ?body)
          (with-gensyms (nn nn-1)
             (e `(let ((,nn ,n))
                    (let ((,nn-1 (-fx ,nn 1)))
                       (do ((,i 0 (+fx ,i 1)))
                           ((=fx ,i ,nn-1) ,@body)
                           ,@body))) e))))))

(define-expander with-gensyms
   (lambda (x e)
      (match-case x
         ((with-gensyms (?sym) . ?body)
          (e `(let ((,sym (gensym)))
                 ,@body) e))
         ((with-gensyms (?sym . ?rest-syms) . ?body)
          (e `(let ((,sym (gensym)))
                 (with-gensyms ,rest-syms ,@body)) e)))))

Nifty, huh? I also have one for my f64vectors (as described in my last post one can make vectors of doubles---the natural behavior from bigloo approximates SRFI 4):

(define-expander with-f64vectors
   (lambda (x e)
      (match-case x
         ((with-f64vectors ?vecs (<- . ?body))
          (with-gensyms (result n i)
             (e `(let* ((,n (f64vector-length ,(car vecs)))
                        (,result (make-f64vector ,n 0.0)))
                    (do-times (,i ,n)
                       (let ,(map (lambda (sym)
                                     `(,sym (f64vector-ref ,sym ,i)))
                                  vecs)
                          (f64vector-set! ,result ,i
                                       (begin ,@body))))
                    ,result) e)))
         ((with-f64vectors ?vecs . ?body)
          (with-gensyms (i n)
             (let* ((vector-syms (map (lambda (sym) (cons sym (gensym))) vecs))
                    (process-body-term
                     (lambda (term)
                        (match-case term
                           ((?result <- . ?body)
                            `(f64vector-set! ,(cdr (assoc result vector-syms))
                                          ,i
                                          (begin ,@body)))
                           (?- term)))))
                (e `(let ((,n (f64vector-length ,(car vecs))))
                       (let ,(map (lambda (sym)
                                     `(,(cdr (assoc sym vector-syms)) ,sym))
                                  vecs)
                          (do-times (,i ,n)
                             (let ,(map (lambda (sym)
                                           `(,sym (f64vector-ref ,sym ,i)))
                                        vecs)
                                ,@(map process-body-term body))))) e)))))))

Typed Vectors in Bigloo

I learned at the beginning of the month how to make a typed vector (also called monomorphic, I think) in Bigloo scheme. I had known that Bigloo would automatically unbox vectors of doubles or integers if it could infer the type of them, but you can't guarantee this. This kept me from using Bigloo for my numerical projects---it's essential that such vectors be unboxed, and I didn't want to leave it up to the type-inferencing engine. However, at the beginning of the month a message came out on the Bigloo mailing list (it's no longer in the archive on gmane, and it came around before the inria archive, so this may be the only place you can find it): the way to make a typed-vector is demonstrated in the following example from Manuel Serrano:

(module foo
   (type (tvector array-of-int (int)))
   (export (foo::array-of-int ::int ::int))
   (main main))

(define (foo len init)
   (make-array-of-int len init))

(define (main x)
   (let ((v::array-of-int (foo 10 20)))
      (print v)
      (array-of-int-set! v 5 6)
      (print (array-of-int-ref v 5))))

Apparently you can also find more examples of this in the recette/vector.scm module in the source for Bigloo.

All the President's Men...

I still remember reading All the President's Men when I was maybe in middle school. My parents were coming of age during that era, and reading the book made me feel like I was equally involved in the scandal. Learning yesterday that Deep Throat has finally come forward brought all that to mind again. I hope someone writes a book about him---it sounds like he is maybe a bit conflicted about his role, and that would make another interesting story.