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
80
81
82
83
84
85
86
87
88
|
#| rep.lang.error-helper -- give hints about what's causing common lisp errors
$Id: error-helper.jl,v 1.2 2001/07/29 00:41:05 jsh Exp $
Copyright (C) 2001 John Harper <jsh@pixelslut.com>
This file is part of librep.
librep is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
librep is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with librep; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|#
(define-structure rep.lang.error-helper
(export error-helper)
(open rep
rep.regexp
rep.data.tables
rep.structures)
;; map error symbols to helper functions
(define helper-table (make-table eq-hash eq))
(define output-stream (make-fluid standard-error))
(define (define-helper name function) (table-set helper-table name function))
(define (helper-ref name) (table-ref helper-table name))
(define (for-each-structure fun)
(fun 'rep (get-structure 'rep))
(structure-walk (lambda (name struct)
(unless (or (not struct)
(eq name 'rep)
(string-match "^%" (symbol-name name)))
(fun name struct)))
(get-structure '%structures)))
(define (output fmt . args)
(write (fluid output-stream) #\()
(apply format (fluid output-stream) fmt args)
(write (fluid output-stream) "\)\n"))
(define (void-value-helper symbol)
(case symbol
((export compound-interface structure-interface)
(output
"You may have the interface clause (`export', etc) of a module declaration
in the wrong position."))
((open access)
(output
"You may have the configuration clause (`open', etc) of a module declaration
in the wrong position."))
(t (let ((structs '()))
(for-each-structure
(lambda (name struct)
(when (structure-exports-p struct symbol)
(setq structs (cons name structs)))))
(cond ((null structs)
(output "You're accessing an undefined variable or function `%s'"
symbol))
((null (cdr structs))
(output
"You probably need to open the module `%s'" (car structs)))
(t (output "You probably need to open one of the modules %s"
(mapconcat (lambda (x)
(format nil "`%s'" x))
(nreverse structs) ", "))))))))
(define-helper 'void-value void-value-helper)
(define (error-helper error-symbol data)
(let ((helper (helper-ref error-symbol)))
(when helper
(apply helper data)))))
|
