Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

friendlier report for error on module files with the wrong name (issue #624)

Browse source
This commit is contained in:
Alex Shinn 2020-06-15 11:51:32 +09:00
parent aa2a87fbba
commit 4734fc1e40
1 changed files with 42 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
lib/chibi/repl.scm
View file

@ -323,17 +323,49 @@
0 0
(- (string-length mod-file) 4)) (- (string-length mod-file) 4))
".scm"))) ".scm")))
(display "Searched module path " out)
(display (current-module-path) out)
(display " for " out)
(write mod-file out)
(display ".\n" out)
(cond (cond
((find-module-file scm-file) ((find-module-file mod-file)
=> (lambda (file) => (lambda (path)
(display "But found non-module-definition file " out) (let ((defined-mod-name
(write file out) (protect (exn (else #f))
(display ".\nNote module files must end in \".sld\".\n" out))))) (let ((x (call-with-input-file path read)))
(and (pair? x)
(pair? (cdr x))
(eq? 'define-library (car x))
(cadr x))))))
(cond
((not defined-mod-name)
(display "File '" out)
(display path out)
(display "' does not appear to define module " out)
(display mod-name out)
(display ".\n" out))
((equal? defined-mod-name mod-name)
(display "File '" out)
(display path out)
(display "' failed to define module " out)
(display mod-name out)
(display ".\n" out))
(else
(display "Expected file '" out)
(display path out)
(display "' to define module " out)
(display mod-name out)
(display " but found " out)
(display defined-mod-name out)
(display ".\n" out))))))
(else
(display "Searched module path " out)
(display (current-module-path) out)
(display " for " out)
(write mod-file out)
(display ".\n" out)
(cond
((find-module-file scm-file)
=> (lambda (file)
(display "But found non-module-definition file " out)
(write file out)
(display ".\nNote module files must end in \".sld\".\n" out)))))))
))) )))
(define undefined-value (if #f #f)) (define undefined-value (if #f #f))