1 ! Copyright (C) 2004, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: slots arrays definitions generic hashtables summary io kernel
4 math namespaces make prettyprint prettyprint.config sequences assocs
5 sequences.private strings io.styles io.pathnames vectors words system
6 splitting math.parser classes.mixin classes.tuple continuations
7 continuations.private combinators generic.math classes.builtin classes
8 compiler.units generic.standard generic.single vocabs init
9 kernel.private io.encodings accessors math.order destructors
10 source-files parser classes.tuple.parser effects.parser lexer
11 generic.parser strings.parser vocabs.loader vocabs.parser see
15 GENERIC: error. ( error -- )
16 GENERIC: error-help ( error -- topic )
20 M: object error-help drop f ;
22 M: tuple error-help class ;
24 M: string error. print ;
27 error-continuation get data>> stack. ;
30 error-continuation get retain>> stack. ;
33 error-continuation get call>> callstack. ;
35 : :get ( variable -- value )
36 error-continuation get name>> assoc-stack ;
39 1 - restarts get-global nth f restarts set-global restart ;
41 : :1 ( -- * ) 1 :res ;
42 : :2 ( -- * ) 2 :res ;
43 : :3 ( -- * ) 3 :res ;
45 : restart. ( restart n -- )
47 1 + dup 3 <= [ ":" % # " " % ] [ # " :res " % ] if
54 "The following restarts are available:" print
56 [ restart. ] each-index
59 : print-error ( error -- )
60 [ error. flush ] curry
61 [ global [ "Error in print-error!" print drop ] bind ]
65 error get print-error ;
67 : print-error-and-restarts ( error -- )
71 "Type :help for debugging help." print flush ;
74 [ print-error-and-restarts ] recover ; inline
76 : expired-error. ( obj -- )
77 "Object did not survive image save/load: " write third . ;
79 : io-error. ( error -- )
80 "I/O error #" write third . ;
82 : type-check-error. ( obj -- )
83 "Type check error" print
84 "Object: " write dup fourth short.
85 "Object type: " write dup fourth class .
86 "Expected type: " write third type>class . ;
88 : divide-by-zero-error. ( obj -- )
89 "Division by zero" print drop ;
91 HOOK: signal-error. os ( obj -- )
93 : array-size-error. ( obj -- )
94 "Invalid array size: " write dup third .
95 "Maximum: " write fourth 1 - . ;
97 : c-string-error. ( obj -- )
98 "Cannot convert to C string: " write third . ;
100 : ffi-error. ( obj -- )
101 "FFI error" print drop ;
103 : heap-scan-error. ( obj -- )
104 "Cannot do next-object outside begin/end-scan" print drop ;
106 : undefined-symbol-error. ( obj -- )
107 "The image refers to a library or symbol that was not found at load time"
110 : stack-underflow. ( obj name -- )
111 write " stack underflow" print drop ;
113 : stack-overflow. ( obj name -- )
114 write " stack overflow" print drop ;
116 : datastack-underflow. ( obj -- ) "Data" stack-underflow. ;
117 : datastack-overflow. ( obj -- ) "Data" stack-overflow. ;
118 : retainstack-underflow. ( obj -- ) "Retain" stack-underflow. ;
119 : retainstack-overflow. ( obj -- ) "Retain" stack-overflow. ;
121 : memory-error. ( error -- )
122 "Memory protection fault at address " write third .h ;
124 : primitive-error. ( error -- )
125 "Unimplemented primitive" print drop ;
127 : fp-trap-error. ( error -- )
128 "Floating point trap" print drop ;
130 PREDICATE: vm-error < array
132 { [ dup empty? ] [ drop f ] }
133 { [ dup first "kernel-error" = not ] [ drop f ] }
134 [ second 0 16 between? ]
137 : vm-errors ( error -- n errors )
139 { 0 [ expired-error. ] }
141 { 2 [ primitive-error. ] }
142 { 3 [ type-check-error. ] }
143 { 4 [ divide-by-zero-error. ] }
144 { 5 [ signal-error. ] }
145 { 6 [ array-size-error. ] }
146 { 7 [ c-string-error. ] }
148 { 9 [ heap-scan-error. ] }
149 { 10 [ undefined-symbol-error. ] }
150 { 11 [ datastack-underflow. ] }
151 { 12 [ datastack-overflow. ] }
152 { 13 [ retainstack-underflow. ] }
153 { 14 [ retainstack-overflow. ] }
154 { 15 [ memory-error. ] }
155 { 16 [ fp-trap-error. ] }
158 M: vm-error summary drop "VM error" ;
160 M: vm-error error. dup vm-errors case ;
162 M: vm-error error-help vm-errors at first ;
165 drop "No suitable method" ;
168 "Generic word " write
170 " does not define a method for the " write
171 dup object>> class pprint
173 "Dispatching on object: " write object>> short. ;
175 M: bad-slot-value summary drop "Bad store to specialized slot" ;
177 M: no-math-method summary
178 drop "No suitable arithmetic method" ;
180 M: no-next-method summary
181 drop "Executing call-next-method from least-specific method" ;
183 M: inconsistent-next-method summary
184 drop "Executing call-next-method with inconsistent parameters" ;
186 M: check-method summary
187 drop "Invalid parameters for create-method" ;
189 M: not-a-tuple summary
192 M: bad-superclass summary
193 drop "Tuple classes can only inherit from other tuple classes" ;
195 M: no-initial-value summary
196 drop "Initial value must be provided for slots specialized to this class" ;
198 M: bad-initial-value summary
199 drop "Incompatible initial value" ;
202 drop "Fall-through in cond" ;
205 drop "Fall-through in case" ;
207 M: slice-error summary
208 drop "Cannot create slice" ;
210 M: bounds-error summary drop "Sequence index out of bounds" ;
212 M: condition error. error>> error. ;
214 M: condition summary error>> summary ;
216 M: condition error-help error>> error-help ;
218 M: assert summary drop "Assertion failed" ;
220 M: assert-sequence summary drop "Assertion failed" ;
222 M: assert-sequence error.
223 standard-table-style [
224 [ "=== Expected:" print expected>> stack. ]
225 [ "=== Got:" print got>> stack. ] bi
228 M: immutable summary drop "Sequence is immutable" ;
230 M: redefine-error error.
231 "Re-definition of " write
235 drop "Calling a deferred word before it has been defined" ;
237 M: no-compilation-unit error.
238 "Attempting to define " write
240 " outside of a compilation unit" print ;
243 drop "Vocabulary does not exist" ;
245 M: encode-error summary drop "Character encoding error" ;
247 M: decode-error summary drop "Character decoding error" ;
249 M: bad-create summary drop "Bad parameters to create" ;
251 M: attempt-all-error summary drop "Nothing to attempt" ;
253 M: already-disposed summary drop "Attempting to operate on disposed object" ;
255 M: no-current-vocab summary
256 drop "Not in a vocabulary; IN: form required" ;
258 M: no-word-error summary
261 "'' found in current vocabulary search path" surround ;
263 M: no-word-error error. summary print ;
265 M: no-word-in-vocab summary
266 [ vocab>> ] [ word>> ] bi
267 [ "No word named ``" % % "'' found in ``" % % "'' vocabulary" % ] "" make ;
269 M: no-word-in-vocab error. summary print ;
271 M: ambiguous-use-error summary
273 "More than one vocabulary defines a word named ``" "''" surround ;
275 M: ambiguous-use-error error. summary print ;
277 M: staging-violation summary
279 "A parsing word cannot be used in the same file it is defined in." ;
281 M: bad-number summary
282 drop "Bad number literal" ;
284 M: duplicate-slot-names summary
285 drop "Duplicate slot names" ;
287 M: invalid-slot-name summary
288 drop "Invalid slot name" ;
290 M: not-in-a-method-error summary
291 drop "call-next-method can only be called in a method definition" ;
293 GENERIC: expected>string ( obj -- str )
295 M: f expected>string drop "end of input" ;
296 M: word expected>string name>> ;
297 M: string expected>string ;
301 dup want>> expected>string write
303 got>> expected>string print ;
305 M: lexer-error error.
306 [ lexer-dump ] [ error>> error. ] bi ;
308 M: lexer-error summary
311 M: lexer-error compute-restarts
312 error>> compute-restarts ;
314 M: lexer-error error-help
317 M: bad-effect summary
318 drop "Bad stack effect declaration" ;
320 M: bad-escape summary drop "Bad escape code" ;
322 M: bad-literal-tuple summary drop "Bad literal tuple" ;
324 M: check-mixin-class summary drop "Not a mixin class" ;
326 M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
328 M: wrong-values summary drop "Quotation called with wrong stack effect" ;
331 { [ os windows? ] [ "debugger.windows" require ] }
332 { [ os unix? ] [ "debugger.unix" require ] }