Re: [dev-serveez] guile modules

[Thien-Thi Nguyen]

stefan <address@hidden> writes:

   (define (svz:init)
     (catch 'misc-error
            (lambda ()
              (if (not (feature? 'serveez))
                  (begin
                    (println "Loading the Module.")
                    (set! svz:handle (dynamic-link "./.libs/libsvzguile.so"))
                    (dynamic-call "scm_init_serveez" svz:handle)
                    (svz-boot))
                  (println "Module already registered.")))
            (lambda args #f))
     (println (if (and (dynamic-object? svz:handle) (feature? 'serveez)) 
                  "Module successfully loaded." "Module not found.")))

this approach looks generally useful.  it seems each application that uses
guile (including guile) has similar "private module loading" needs.  the
experimental guile-1.4.2 ice-9/boot-9.scm fragment below could be used to
implement svz:init (w/ some tweaks).

thi


_______________________________________________________
;;; {internal modules} (experimental)
;;;

(define (call-with-ltdl-prefix prefix thunk)
  (let ((cur (or (ltdl-get-search-path) "")))
    (ltdl-set-search-path!
     (with-output-to-string
       (lambda ()
         (let loop ((ls (cond ((list? prefix) prefix)
                              ((string? prefix) (list prefix))
                              (else '()))))
           (or (null? ls)
               (begin
                 (display (car ls))
                 (display #\:)          ; a friendly character
                 (loop (cdr ls)))))
         (display cur))))
    (thunk)
    (ltdl-set-search-path! cur)))

(define (guile-internal-modules-dir)
  (apply format #f
         (let ((iref (lambda (key) (assq-ref %guile-build-info key))))
           ;; check for invocation via pre-inst-guile
           (if (and (getenv "GUILE")
                    (getenv "GUILE_LOAD_PATH")
                    (getenv "LTDL_LIBRARY_PATH")
                    (string=? (car %load-path) (iref 'top_srcdir)))
               `("~A/libguile/.libs" ,(iref 'top_builddir))
               `("~A/~A/modules" ,(iref 'pkglibdir) ,(iref 'guileversion))))))

(define (load-guile-internal-module name)
  (call-with-ltdl-prefix
   (guile-internal-modules-dir)
   (lambda ()
     (format #t "(ltdl-get-search-path) => ~A\n" (ltdl-get-search-path))
     (let* ((init (format #f "scm_init_~A" name))
            (sofile (format #f "lib~A" name))
            (dobj (dynamic-link sofile)))
       (format #t "sofile => ~A\ndobj => ~A\n" sofile dobj)
       (dynamic-call init dobj)))))