basis/debugger/debugger.factor

   1 ! Copyright (C) 2004, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.strings arrays assocs classes
   4 classes.builtin classes.mixin classes.tuple classes.tuple.parser
   5 combinators combinators.short-circuit compiler.units
   6 continuations definitions destructors effects.parser generic
   7 generic.math generic.parser generic.single grouping io
   8 io.encodings io.styles kernel kernel.private lexer make math
   9 math.order math.parser namespaces parser prettyprint sequences
  10 sequences.private slots source-files.errors strings
  11 strings.parser summary system vocabs vocabs.loader
  12 vocabs.parser words ;
  13 FROM: namespaces => change-global ;
  14 IN: debugger
  15
  16 GENERIC: error-help ( error -- topic )
  17
  18 M: object error-help drop f ;
  19
  20 M: tuple error-help class-of ;
  21
  22 M: source-file-error error-help error>> error-help ;
  23
  24 GENERIC: error. ( error -- )
  25
  26 M: object error. short. ;
  27
  28 M: string error. print ;
  29
  30 : traceback-link. ( continuation -- )
  31     "[" write [ "Traceback" ] dip write-object "]" print ;
  32
  33 : :s ( -- )
  34     error-continuation get data>> stack. ;
  35
  36 : :r ( -- )
  37     error-continuation get retain>> stack. ;
  38
  39 : :c ( -- )
  40     error-continuation get call>> callstack. ;
  41
  42 : :get ( variable -- value )
  43     error-continuation get name>> assoc-stack ;
  44
  45 : :res ( n -- * )
  46     1 - restarts [ nth f ] change-global continue-restart ;
  47
  48 : :1 ( -- * ) 1 :res ;
  49 : :2 ( -- * ) 2 :res ;
  50 : :3 ( -- * ) 3 :res ;
  51
  52 : restart. ( restart n -- )
  53     [
  54         1 + dup 3 <= [ ":" % # "      " % ] [ # " :res  " % ] if
  55         name>> %
  56     ] "" make print ;
  57
  58 : restarts. ( -- )
  59     restarts get [
  60         nl
  61         "The following restarts are available:" print
  62         nl
  63         [ restart. ] each-index
  64     ] unless-empty ;
  65
  66 : print-error ( error -- )
  67     [ error. flush ] curry
  68     [ [ "Error in print-error!" print drop ] with-global ]
  69     recover ;
  70
  71 : :error ( -- )
  72     error get print-error ;
  73
  74 : print-error-and-restarts ( error -- )
  75     print-error
  76     restarts.
  77     nl
  78     "Type :help for debugging help." print flush ;
  79
  80 : try ( quot -- )
  81     [ print-error-and-restarts ] recover ; inline
  82
  83 : expired-error. ( obj -- )
  84     "Object did not survive image save/load: " write third . ;
  85
  86 : io-error. ( error -- )
  87     "I/O error #" write third . ;
  88
  89 : type-check-error. ( obj -- )
  90     "Type check error" print
  91     "Object: " write dup fourth short.
  92     "Object type: " write dup fourth class-of .
  93     "Expected type: " write third type>class . ;
  94
  95 : divide-by-zero-error. ( obj -- )
  96     "Division by zero" print drop ;
  97
  98 HOOK: signal-error. os ( obj -- )
  99
 100 : array-size-error. ( obj -- )
 101     "Invalid array size: " write dup third .
 102     "Maximum: " write fourth 1 - . ;
 103
 104 : c-string-error. ( obj -- )
 105     "Cannot convert to C string: " write third . ;
 106
 107 : ffi-error. ( obj -- )
 108     "FFI error" print drop ;
 109
 110 : undefined-symbol-error. ( obj -- )
 111     "Cannot resolve C library function" print
 112     "Symbol: " write dup third symbol>string print
 113     "Library: " write fourth .
 114     "You are probably missing a library or the library path is wrong." print
 115     "See http://concatenative.org/wiki/view/Factor/Requirements" print ;
 116
 117 : stack-underflow. ( obj name -- )
 118     write " stack underflow" print drop ;
 119
 120 : stack-overflow. ( obj name -- )
 121     write " stack overflow" print drop ;
 122
 123 : datastack-underflow. ( obj -- ) "Data" stack-underflow. ;
 124 : datastack-overflow. ( obj -- ) "Data" stack-overflow. ;
 125 : retainstack-underflow. ( obj -- ) "Retain" stack-underflow. ;
 126 : retainstack-overflow. ( obj -- ) "Retain" stack-overflow. ;
 127 : callstack-underflow. ( obj -- ) "Call" stack-underflow. ;
 128 : callstack-overflow. ( obj -- ) "Call" stack-overflow. ;
 129
 130 : memory-error. ( error -- )
 131     "Memory protection fault at address " write third .h ;
 132
 133 : primitive-error. ( error -- )
 134     "Unimplemented primitive" print drop ;
 135
 136 : fp-trap-error. ( error -- )
 137     "Floating point trap" print drop ;
 138
 139 : interrupt-error. ( error -- )
 140     "Interrupt" print drop ;
 141
 142 PREDICATE: vm-error < array
 143     dup length 2 < [ drop f ] [
 144         {
 145             [ first-unsafe "kernel-error" = ]
 146             [ second-unsafe 0 kernel-error-count 1 - between? ]
 147         } 1&&
 148     ] if ;
 149
 150 : vm-errors ( error -- n errors )
 151     second {
 152         [ expired-error.          ]
 153         [ io-error.               ]
 154         [ primitive-error.        ]
 155         [ type-check-error.       ]
 156         [ divide-by-zero-error.   ]
 157         [ signal-error.           ]
 158         [ array-size-error.       ]
 159         [ c-string-error.         ]
 160         [ ffi-error.              ]
 161         [ undefined-symbol-error. ]
 162         [ datastack-underflow.    ]
 163         [ datastack-overflow.     ]
 164         [ retainstack-underflow.  ]
 165         [ retainstack-overflow.   ]
 166         [ callstack-underflow.    ]
 167         [ callstack-overflow.     ]
 168         [ memory-error.           ]
 169         [ fp-trap-error.          ]
 170         [ interrupt-error.        ]
 171     } ; inline
 172
 173 M: vm-error summary drop "VM error" ;
 174
 175 M: vm-error error. dup vm-errors dispatch ;
 176
 177 M: vm-error error-help vm-errors nth first ;
 178
 179 M: no-method summary
 180     drop "No suitable method" ;
 181
 182 M: no-method error.
 183     "Generic word " write
 184     dup generic>> pprint
 185     " does not define a method for the " write
 186     dup object>> class-of pprint
 187     " class." print
 188     "Dispatching on object: " write object>> short. ;
 189
 190 M: bad-slot-value summary drop "Bad store to specialized slot" ;
 191
 192 M: bad-slot-name summary drop "Bad slot name in object literal" ;
 193
 194 M: no-math-method summary
 195     drop "No suitable arithmetic method" ;
 196
 197 M: no-next-method summary
 198     drop "Executing call-next-method from least-specific method" ;
 199
 200 M: inconsistent-next-method summary
 201     drop "Executing call-next-method with inconsistent parameters" ;
 202
 203 M: check-method-error summary
 204     drop "Invalid parameters for create-method" ;
 205
 206 M: not-a-tuple summary
 207     drop "Not a tuple" ;
 208
 209 M: bad-superclass summary
 210     drop "Tuple classes can only inherit from non-final tuple classes" ;
 211
 212 M: bad-initial-value summary
 213     drop "Incompatible initial value" ;
 214
 215 M: no-cond summary
 216     drop "Fall-through in cond" ;
 217
 218 M: no-case summary
 219     drop "Fall-through in case" ;
 220
 221 M: slice-error summary
 222     drop "Cannot create slice" ;
 223
 224 M: bounds-error summary drop "Sequence index out of bounds" ;
 225
 226 M: groups-error summary drop "Non positive group size" ;
 227
 228 M: condition error. error>> error. ;
 229
 230 M: condition summary error>> summary ;
 231
 232 M: condition error-help error>> error-help ;
 233
 234 M: assert summary drop "Assertion failed" ;
 235
 236 M: assert-sequence summary drop "Assertion failed" ;
 237
 238 M: assert-sequence error.
 239     standard-table-style [
 240         [ "=== Expected:" print expected>> stack. ]
 241         [ "=== Got:" print got>> stack. ] bi
 242     ] tabular-output ;
 243
 244 M: immutable summary drop "Sequence is immutable" ;
 245
 246 M: redefine-error error.
 247     "Re-definition of " write
 248     def>> . ;
 249
 250 M: undefined-word summary
 251     word>> undefined-word?
 252     "Cannot execute a deferred word before it has been defined"
 253     "Cannot execute a word before it has been compiled"
 254     ? ;
 255
 256 M: no-compilation-unit error.
 257     "Attempting to define " write
 258     definition>> pprint
 259     " outside of a compilation unit" print ;
 260
 261 M: no-vocab summary
 262     drop "Vocabulary does not exist" ;
 263
 264 M: encode-error summary drop "Character encoding error" ;
 265
 266 M: decode-error summary drop "Character decoding error" ;
 267
 268 M: bad-create summary drop "Bad parameters to create" ;
 269
 270 M: cannot-be-inline summary drop "This type of word cannot be inlined" ;
 271
 272 M: attempt-all-error summary drop "Nothing to attempt" ;
 273
 274 M: already-disposed summary drop "Attempting to operate on disposed object" ;
 275
 276 M: no-current-vocab-error summary
 277     drop "Not in a vocabulary; IN: form required" ;
 278
 279 M: no-word-error summary
 280     name>>
 281     "No word named “"
 282     "” found in current vocabulary search path" surround ;
 283
 284 M: no-word-error error. summary print ;
 285
 286 M: no-word-in-vocab summary
 287     [ vocab>> ] [ word>> ] bi
 288     [ "No word named “" % % "” found in “" % % "” vocabulary" % ] "" make ;
 289
 290 M: no-word-in-vocab error. summary print ;
 291
 292 M: ambiguous-use-error summary
 293     words>> first name>>
 294     "More than one vocabulary defines a word named “" "”" surround ;
 295
 296 M: ambiguous-use-error error. summary print ;
 297
 298 M: staging-violation summary
 299     drop
 300     "A parsing word cannot be used in the same file it is defined in." ;
 301
 302 M: bad-number summary
 303     drop "Bad number literal" ;
 304
 305 M: duplicate-slot-names summary
 306     drop "Duplicate slot names" ;
 307
 308 M: invalid-slot-name summary
 309     drop "Invalid slot name" ;
 310
 311 M: bad-inheritance summary
 312     drop "Circularity in inheritance chain" ;
 313
 314 M: not-in-a-method-error summary
 315     drop "call-next-method can only be called in a method definition" ;
 316
 317 M: version-control-merge-conflict summary
 318     drop "Version control merge conflict in source code" ;
 319
 320 GENERIC: expected>string ( obj -- str )
 321
 322 M: f expected>string drop "end of input" ;
 323 M: word expected>string name>> ;
 324 M: string expected>string ;
 325
 326 M: unexpected error.
 327     "Expected " write
 328     dup want>> expected>string write
 329     " but got " write
 330     got>> expected>string print ;
 331
 332 M: lexer-error error.
 333     [ lexer-dump ] [ error>> error. ] bi ;
 334
 335 M: lexer-error summary
 336     error>> summary ;
 337
 338 M: lexer-error compute-restarts
 339     error>> compute-restarts ;
 340
 341 M: lexer-error error-help
 342     error>> error-help ;
 343
 344 M: bad-effect summary
 345     drop "Bad stack effect declaration" ;
 346
 347 M: invalid-row-variable summary
 348     drop "Stack effect row variables can only occur as the first input or output" ;
 349
 350 M: row-variable-can't-have-type summary
 351     drop "Stack effect row variables cannot have a declared type" ;
 352
 353 M: bad-escape error.
 354     "Bad escape code: \\" write char>> write nl ;
 355
 356 M: bad-literal-tuple summary drop "Bad literal tuple" ;
 357
 358 M: check-mixin-class-error summary drop "Not a mixin class" ;
 359
 360 M: not-found-in-roots summary
 361     path>> "Cannot resolve vocab: " prepend ;
 362
 363 M: wrong-values summary drop "Quotation's stack effect does not match call site" ;
 364
 365 M: stack-effect-omits-dashes summary drop "Stack effect must contain “--”" ;
 366
 367 { "threads" "debugger" } "debugger.threads" require-when