2015-03-29

Emulate modular programming

It'll be long to put on reddit (mostly piece of code) and kinda pain in the ass to format code for reddit. So I've decided to write an article as an answer for this: R7RS modular programming struggle..

I'll answer the easier one first. The different behaviour is because the define-library is wrapped by begin. Larceny is using SRFI-78 (a.k.a van Tonder expander) and this expander creates a library at runtime. Thus, when the cond-expand is expanded, the library (dummy) is not created yet. Sagittarius, on the other hand, it creates a library at compile time. Thus, whenever define-library or library is found on the code, then the library is created at that time. So cond-expand can find the (dummy) during expansion. I guess, if you want to make the code work as expected, then removing begin should be enough.

NOTE: On R7RS (or even R6RS), the library definition can not be anywhere in program so the example code itself is not portable. For example, Chibi would raise an error if you write this on its REPL (which I think pretty much inconvenient).

NOTE: Removing begin works only on REPL because van Tonder's expander reads all expression first then expands it. Thus, at compile time there is no library created yet.

It is basically impossible to do the ML like modular programming on R7RS Scheme, if I understood the question correctly. But there is a technique that emulate it. The key is eval. It is easy to see on the code so code first.
;; without SRFI-39
(define-library (peano)
  (import (scheme base) (scheme eval))
  (export one add
          load-peano
          make-peano-impl)
  (begin
    (define-record-type peano-impl (make-peano-impl one add) 
      peano-impl?
      (one peano-impl-one)
      (add peano-impl-add))
    (define global-impl #f)
    (define (load-peano env)
      (let ((impl (eval '(load-peano-impl) env)))
        (set! global-impl impl)))
    (define (one) (peano-impl-one global-impl))
    (define (add a b) ((peano-impl-add global-impl) a b)))
  )


;; peano-numeral.sld
(define-library (peano-numeral)
  (import (scheme base) (peano))
  (export one add load-peano-impl)
  (begin 
    (define (load-peano-impl)
      (make-peano-impl 1 +))))

;; peano-symbol.sld
(define-library (peano-symbol)
  (import (scheme base) (peano))
  (export one add load-peano-impl)
  (begin 
    (define (load-peano-impl)
      (make-peano-impl
       '(s z)
       (lambda (x y)
         (if (eq? 'z x) y
             `(s ,(add (cadr x) y))))))))

(define-library (four)
  (import (scheme base) (peano))
  (export four)
  (begin
    (define (four)
      (let ((two (add (one) (one))))
        (add two two)))))

(import (scheme write) (scheme eval) (four) (peano))
(load-peano (environment '(peano-numeral)))
(four)
;; -> 4

(load-peano (environment '(peano-symbol)))
(four)
;; -> (s (s (s (s z))))
eval can take an environment so we can use that. Specifying which implementation should be used via load-peano by passing library name, and the (peano) sets the actual implementation to the global context. If the implementation supports SRFI-39, then using parameter would make it thread safe.

NOTE: If the implementation supports CL like method dispatch, then this can be much simpler. (Well, using TinyCLOS provides it and it wouldn't be so difficult to make some syntax sugar for that and provide it with R7RS library system. I just don't have motivation since Sagittarius already has it...)

NOTE: Parameter in R7RS doesn't specify when parameter object (or procedure) received one argument. As far as I know, all R7RS implementations behave the same as SRFI-39 but there might be an implementation that doesn't accept it in future.

NOTE: If the implementation supports identifier-syntax which is added on R6RS, then one can be defined like this:
(define-syntax one (identifier-syntax ((peano-impl-one global-impl))))
Then four can be like this:
(define-syntax four
  (identifier-syntax
   ((lambda ()
      (let ((two (add one one)))
 (add two two))))))
So you don't have to write four with parenthesis.

No comments:

Post a Comment