conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Much improved error reporting when a library is not found. 

Example:

> (import (a b c))
Unhandled exception
 Condition components:
   1. &error
   2. &who: expander
   3. &message: "cannot locate library in library-path"
   4. &library-resolution:
       library: (a b c)
       files: ("./a/b/c.ss" "/Users/ikarus/.opt/lib/ikarus/a/b/c.ss")
This commit is contained in:
Abdulaziz Ghuloum 2007-11-19 02:46:45 -05:00
parent ed3641448d
commit 79d529b224
2 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scheme/ikarus.conditions.ss
View File

@ -336,18 +336,21 @@
(display name p))
(let ([v (record-type-field-names rtd)])
(case (vector-length v)
[(0) (newline p)]
[(1)
(display ": " p)
(write ((record-accessor rtd 0) x) p)]
(write ((record-accessor rtd 0) x) p)
(newline p)]
[else
(display ":\n" p)
(let f ([i 0])
(unless (= i (vector-length v))
(display " " p)
(display " " p)
(display (vector-ref v i) p)
(display "=" p)
(display ": " p)
(write ((record-accessor rtd i) x) p)
(f (+ i 1))))]))
(newline p)))
(newline)
(f (+ i 1))))]))))
(define (print-condition x p)
(cond
[(condition? x)

28
scheme/psyntax.library-manager.ss
View File

@ -116,12 +116,28 @@
(make-parameter
(lambda (x)
(let ((str (library-name->file-name x)))
(let f ((ls (library-path)))
(and (pair? ls)
(let ((name (string-append (car ls) str)))
(if (file-exists? name)
name
(f (cdr ls))))))))
(let f ((ls (library-path)) (failed-list '()))
(cond
((null? ls)
(let ()
(define-condition-type &library-resolution &condition
make-library-resolution-condition
library-resolution-condition?
(library condition-library)
(files condition-files))
(raise
(condition
(make-error)
(make-who-condition 'expander)
(make-message-condition
"cannot locate library in library-path")
(make-library-resolution-condition
x (reverse failed-list))))))
(else
(let ((name (string-append (car ls) str)))
(if (file-exists? name)
name
(f (cdr ls) (cons name failed-list)))))))))
(lambda (f)
(if (procedure? f)
f