diff options
| -rw-r--r-- | modules/language/python/guilemod.scm | 56 |
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) |