[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [dev-serveez] guile modules

From: Thien-Thi Nguyen
Subject: Re: [dev-serveez] guile modules
Date: 06 Jun 2002 16:12:54 -0400

stefan <address@hidden> writes:

   (define (svz:init)
     (catch 'misc-error
            (lambda ()
              (if (not (feature? 'serveez))
                    (println "Loading the Module.")
                    (set! svz:handle (dynamic-link "./.libs/"))
                    (dynamic-call "scm_init_serveez" svz:handle)
                  (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).


;;; {internal modules} (experimental)

(define (call-with-ltdl-prefix prefix thunk)
  (let ((cur (or (ltdl-get-search-path) "")))
       (lambda ()
         (let loop ((ls (cond ((list? prefix) prefix)
                              ((string? prefix) (list prefix))
                              (else '()))))
           (or (null? ls)
                 (display (car ls))
                 (display #\:)          ; a friendly character
                 (loop (cdr ls)))))
         (display cur))))
    (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)
   (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)))))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]