generic.standard vocabs init kernel.private io.encodings
accessors math.order destructors source-files parser
classes.tuple.parser effects.parser lexer compiler.errors
-generic.parser strings.parser vocabs.loader vocabs.parser see ;
+generic.parser strings.parser vocabs.loader vocabs.parser see
+source-files.errors ;
IN: debugger
GENERIC: error. ( error -- )
M: invalid-slot-name summary
drop "Invalid slot name" ;
-: file. ( file -- ) path>> <pathname> . ;
-
-M: source-file-error error.
- [ file>> file. ] [ error>> error. ] bi ;
-
M: source-file-error summary
error>> summary ;
M: lexer-error error-help
error>> error-help ;
-M: compiler-error compiler-error. ( error -- )
+M: source-file-error error.
[
[
[
- [ line#>> # ": " % ]
- [ word>> synopsis % ] bi
+ [ file>> [ % ": " % ] when* ]
+ [ line#>> [ # ": " % ] when* ]
+ [ summary % ] tri
] "" make
] [
[
] bi format nl
] [ error>> error. ] bi ;
-M: compiler-error error. compiler-error. ;
+M: compiler-error summary word>> synopsis ;
M: bad-effect summary
drop "Bad stack effect declaration" ;
M: effect-error summary
[
- "Stack effect declaration of the word " %
+ "Stack effect declaration of the word " %
word>> name>> % " is wrong" %
] "" make ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs compiler.errors debugger io kernel sequences
+source-files.errors ;
+IN: tools.errors
+
+#! Tools for source-files.errors. Used by tools.tests and others
+#! for error reporting
+
+: errors. ( errors -- )
+ group-by-source-file sort-errors
+ [
+ [ nl "==== " write print nl ]
+ [ [ nl ] [ error. ] interleave ]
+ bi*
+ ] assoc-each ;
+
+: compiler-errors. ( type -- )
+ errors-of-type errors. ;
+
+: :errors ( -- ) +error+ compiler-errors. ;
+
+: :warnings ( -- ) +warning+ compiler-errors. ;
+
+: :linkage ( -- ) +linkage+ compiler-errors. ;
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make assocs io sequences
-sorting continuations math math.order math.parser accessors
-definitions ;
+continuations math math.parser accessors definitions
+source-files.errors ;
IN: compiler.errors
-SYMBOL: +error+
-SYMBOL: +warning+
-SYMBOL: +linkage+
+SYMBOLS: +error+ +warning+ +linkage+ ;
-TUPLE: compiler-error error word file line# ;
+TUPLE: compiler-error < source-file-error word ;
GENERIC: compiler-error-type ( error -- ? )
M: compiler-error compiler-error-type error>> compiler-error-type ;
-GENERIC: compiler-error. ( error -- )
-
SYMBOL: compiler-errors
compiler-errors [ H{ } clone ] initialize
swap [ [ nip compiler-error-type ] dip eq? ] curry
assoc-filter ;
-: sort-compile-errors ( assoc -- alist )
- [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
-
-: group-by-source-file ( errors -- assoc )
- H{ } clone [ [ push-at ] curry [ nip dup file>> ] prepose assoc-each ] keep ;
-
-: compiler-errors. ( type -- )
- errors-of-type group-by-source-file sort-compile-errors
- [
- [ nl "==== " write print nl ]
- [ [ nl ] [ compiler-error. ] interleave ]
- bi*
- ] assoc-each ;
-
: (compiler-report) ( what type word -- )
over errors-of-type assoc-empty? [ 3drop ] [
[
"semantic warnings" +warning+ "warnings" (compiler-report)
"linkage errors" +linkage+ "linkage" (compiler-report) ;
-: :errors ( -- ) +error+ compiler-errors. ;
-
-: :warnings ( -- ) +warning+ compiler-errors. ;
-
-: :linkage ( -- ) +linkage+ compiler-errors. ;
-
: <compiler-error> ( error word -- compiler-error )
- dup where [ first2 ] [ "<unknown file>" 0 ] if* \ compiler-error boa ;
+ \ compiler-error new
+ swap
+ [ >>word ]
+ [ where [ first2 ] [ "<unknown file>" 0 ] if* [ >>file ] [ >>line# ] bi* ] bi
+ swap >>error ;
: compiler-error ( error word -- )
compiler-errors get-global pick
sequences strings io.files io.pathnames definitions
continuations sorting classes.tuple compiler.units debugger
vocabs vocabs.loader accessors eval combinators lexer
-vocabs.parser words.symbol multiline ;
+vocabs.parser words.symbol multiline source-files.errors ;
IN: parser.tests
\ run-file must-infer
"tools.annotations"
"tools.crossref"
"tools.disassembler"
+ "tools.errors"
"tools.memory"
"tools.profiler"
"tools.test"
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel math.order sorting ;
+IN: source-files.errors
+
+TUPLE: source-file-error error file line# ;
+
+: sort-errors ( assoc -- alist )
+ [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ;
+
+: group-by-source-file ( errors -- assoc )
+ H{ } clone [ [ push-at ] curry [ nip dup file>> ] prepose assoc-each ] keep ;
sequences strings vectors words quotations io io.files
io.pathnames combinators sorting splitting math.parser effects
continuations checksums checksums.crc32 vocabs hashtables graphs
-compiler.units io.encodings.utf8 accessors ;
+compiler.units io.encodings.utf8 accessors source-files.errors ;
IN: source-files
SYMBOL: source-files
SYMBOL: file
-TUPLE: source-file-error error file ;
-
-: <source-file-error> ( msg -- error )
+: wrap-source-file-error ( error -- * )
+ file get rollback-source-file
\ source-file-error new
- file get >>file
- swap >>error ;
+ f >>line#
+ file get path>> >>file
+ swap >>error rethrow ;
: with-source-file ( name quot -- )
#! Should be called from inside with-compilation-unit.
[
- swap source-file
- dup file set
- definitions>> old-definitions set
[
- file get rollback-source-file
- <source-file-error> rethrow
- ] recover
+ source-file
+ [ file set ]
+ [ definitions>> old-definitions set ] bi
+ ] dip
+ [ wrap-source-file-error ] recover
] with-scope ; inline