use own provide form

homs.scm

;;; higher order modules for guile

(define-syntax-parameter provide ; an "export" for `module' forms
  (lambda (stx)
    (syntax-violation 'provide "provide used outside a module form" stx)))

(define-syntax module
  (lambda (stx)
    (syntax-case stx ()
      ((module (params ...) body ...)
       (with-syntax (((tmp ...) (generate-temporaries #'(params ...))))
         #'(lambda (tmp ...)
             (define fresh (make-fresh-user-module))
             (module-use! fresh (resolve-interface '(guile)))
             (save-module-excursion
              (lambda ()
                (set-current-module fresh)
                (let ((export-alist '()))
                  (syntax-parameterize ((provide (syntax-rules ()
                                                   ((provide foo bar (... ...))
                                                    (set! export-alist
                                                          (append (list
                                                                   (cons 'foo foo)
                                                                   (cons 'bar bar)
                                                                   (... ...))))))))
                    (define params tmp) ...
                    body ...
                    (map (lambda (pair)
                           (let ((var (car pair))
                                 (val (cdr pair)))
                             (module-define! fresh var val)))
                         export-alist)))))
             fresh))))))

;; example module
(define stream-utils
  (module (stream-car stream-cdr)
    (define (stream-drop s n)
      (if (zero? n)
          s
          (stream-drop (stream-cdr s) (- n 1))))
    (define (stream-take s n)
      (if (zero? n)
          '()
          (cons (stream-car s)
                (stream-take (stream-cdr s) (- n 1)))))
    (provide stream-drop stream-take)))

;; first stream implementation
;; Stream a = Stream b (b -> a) (b -> Stream a)

(import (rnrs records syntactic))

(define-record-type stream
  (fields val this next))

(define (stream-car stream)
  ((stream-this stream) (stream-val stream)))

(define (stream-cdr stream)
  ((stream-next stream) (stream-val stream)))

(define (constant-stream k)
  (define (next k)
    (make-stream k identity next))
  (next k))

(define naturals
  (letrec ((next (lambda (current)
                   (make-stream (+ 1 current) identity next))))
    (next -1)))

(define stream-module (stream-utils stream-car stream-cdr))
(define stream-take (module-ref stream-module 'stream-take))

(stream-take naturals 10) ;;(0 1 2 3 4 5 6 7 8 9)


;; second stream implementation
(use-modules ((ice-9 streams)
              #:renamer (symbol-prefix-proc 's:)))

(define naturals2 (s:make-stream (lambda (x)
                                   (cons x (1+ x)))
                                 0))

(define stream-module2 (stream-utils s:stream-car s:stream-cdr))
(define stream-take2 (module-ref stream-module2 'stream-take))

(stream-take2 naturals2 10)