blob: ec71cf7e38a219695558d351298625dde754b730 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index c110512f0..83a3b479d 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -132,14 +132,38 @@
(and (false-if-exception (ensure-directory (dirname f)))
f))))
+(define *do-extension-dispatch* #f)
+(define *extension-dispatches* '((("py") . python) (("pl") . prolog)))
+
+(define (default-language file)
+ (define default (current-language))
+ (if *do-extension-dispatch*
+ (let ((ext (car (reverse (string-split file #\.)))))
+ (let lp ((l *extension-dispatches*))
+ (if (pair? l)
+ (if (member ext (caar l))
+ (let ((r (cdar l)))
+ (if (language? default)
+ (if (eq? (language-name default) r)
+ default
+ r)
+ r))
+ (lp (cdr l)))
+ default)))
+ default))
+
+
+(define %in-compile (make-fluid #f))
+
(define* (compile-file file #:key
(output-file #f)
- (from (current-language))
+ (from (default-language file))
(to 'bytecode)
(env (default-environment from))
(opts '())
(canonicalization 'relative))
- (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (with-fluids ((%in-compile #t)
+ (%file-port-name-canonicalization canonicalization))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
file)))
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index 979291c1e..c0d639235 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -34,7 +34,8 @@
warning-type? warning-type-name warning-type-description
warning-type-printer lookup-warning-type
- %warning-types))
+ %warning-types
+ %dont-warn-list))
;;;
@@ -74,6 +75,7 @@
(description warning-type-description)
(printer warning-type-printer))
+(define %dont-warn-list '())
(define %warning-types
;; List of known warning types.
(map (lambda (args)
@@ -112,8 +114,9 @@
(unbound-variable
"report possibly unbound variables"
,(lambda (port loc name)
- (emit port "~A: warning: possibly unbound variable `~A'~%"
- loc name)))
+ (if (not (member name %dont-warn-list))
+ (emit port "~A: warning: possibly unbound variable `~A'~%"
+ loc name))))
(macro-use-before-definition
"report possibly mis-use of macros before they are defined"
|
