summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--modules/language/python/guilemod.scm56
1 files changed, 40 insertions, 16 deletions
diff --git a/modules/language/python/guilemod.scm b/modules/language/python/guilemod.scm
index 9bcfa74..9445d29 100644
--- a/modules/language/python/guilemod.scm
+++ b/modules/language/python/guilemod.scm
@@ -36,22 +36,20 @@
(define-C default-language
(lambda (file)
(define default ((C current-language)))
- (pk file)
- (pk
- (if (C *do-extension-dispatch*)
- (let ((ext (car (reverse (string-split file #\.)))))
- (let lp ((l (C *extension-dispatches*)))
- (if (pair? l)
- (if (member ext (caar l))
- (let ((r (cdar l)))
- (if ((C language?) default)
- (if (eq? ((C language-name) default) r)
- default
- r)
- r))
- (lp (cdr l)))
- default)))
- default))))
+ (if (C *do-extension-dispatch*)
+ (let ((ext (car (reverse (string-split file #\.)))))
+ (let lp ((l (C *extension-dispatches*)))
+ (if (pair? l)
+ (if (member ext (caar l))
+ (let ((r (cdar l)))
+ (if ((C language?) default)
+ (if (eq? ((C language-name) default) r)
+ default
+ r)
+ r))
+ (lp (cdr l)))
+ default)))
+ default)))
(define-exp-C %in-compile (make-fluid #f))
@@ -239,3 +237,29 @@
loc))
(else
(emit port "~A: `format' warning~%" loc)))))))))
+
+
+(define pload
+ (let ((guile-load (@ (guile) primitive-load-path)))
+ (lambda (p . q)
+ (let ((tag (make-prompt-tag)))
+ (call-with-prompt
+ tag
+ (lambda ()
+ (guile-load p (lambda () (abort-to-prompt tag))))
+ (lambda (k)
+ (let lp ((l *extension-dispatches*))
+ (if (pair? l)
+ (let lp2 ((u (caar l)))
+ (if (pair? u)
+ (aif it (%search-load-path
+ (string-append p "." (car u)))
+ (apply guile-load it q)
+ (lp (cdr u)))
+ (lp (cdr l))))
+ (if (pair? q)
+ ((car q))
+ (error (string-append "no code for path " p)))))))))))
+
+
+ (define-set-G primitive-load-path pload)