-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel prettyprint io debugger
-sequences assocs stack-checker.errors summary effects ;
+sequences assocs stack-checker.errors summary effects make ;
IN: stack-checker.errors.prettyprint
M: inference-error summary error>> summary ;
M: inference-error error.
[ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
-M: literal-expected error.
- "Got a computed value where a " write what>> write " was expected" print ;
+M: literal-expected summary
+ [ "Got a computed value where a " % what>> % " was expected" % ] "" make ;
+
+M: literal-expected error. summary print ;
+
+M: unbalanced-branches-error summary
+ drop "Unbalanced branches" ;
M: unbalanced-branches-error error.
- "Unbalanced branches:" print
+ dup summary print
[ quots>> ] [ branches>> [ length <effect> ] { } assoc>map ] bi zip
[ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
drop
"Quotation pops retain stack elements which it did not push" ;
-M: missing-effect error.
- "The word " write
- word>> pprint
- " must declare a stack effect" print ;
+M: missing-effect summary
+ [
+ "The word " %
+ word>> name>> %
+ " must declare a stack effect" %
+ ] "" make ;
-M: effect-error error.
- "Stack effects of the word " write
- [ word>> pprint " do not match." print ]
- [ "Inferred: " write inferred>> . ]
- [ "Declared: " write declared>> . ] tri ;
+M: effect-error summary
+ [
+ "Stack effect declaration of the word " %
+ word>> name>> % " is wrong" %
+ ] "" make ;
M: recursive-quotation-error error.
"The quotation " write
" calls itself." print
"Stack effect inference is undecidable when quotation-level recursion is permitted." print ;
-M: undeclared-recursion-error error.
- "The inline recursive word " write
- word>> pprint
- " must be declared recursive" print ;
+M: undeclared-recursion-error summary
+ drop
+ "Inline recursive words must be declared recursive" ;
-M: diverging-recursion-error error.
- "The recursive word " write
- word>> pprint
- " digs arbitrarily deep into the stack" print ;
+M: diverging-recursion-error summary
+ [
+ "The recursive word " %
+ word>> name>> %
+ " digs arbitrarily deep into the stack" %
+ ] "" make ;
-M: unbalanced-recursion-error error.
- "The recursive word " write
- word>> pprint
- " leaves with the stack having the wrong height" print ;
+M: unbalanced-recursion-error summary
+ [
+ "The recursive word " %
+ word>> name>> %
+ " leaves with the stack having the wrong height" %
+ ] "" make ;
-M: inconsistent-recursive-call-error error.
- "The recursive word " write
- word>> pprint
- " calls itself with a different set of quotation parameters than were input" print ;
+M: inconsistent-recursive-call-error summary
+ [
+ "The recursive word " %
+ word>> name>> %
+ " calls itself with a different set of quotation parameters than were input" %
+ ] "" make ;
-M: unknown-primitive-error error.
+M: unknown-primitive-error summary
drop
- "Cannot determine stack effect statically" print ;
+ "Cannot determine stack effect statically" ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences sorting assocs colors.constants combinators
-combinators.smart compiler.errors compiler.units fonts kernel io.pathnames
-math.parser math.order models models.arrow namespaces summary ui
-ui.commands ui.gadgets ui.gadgets.tables ui.gadgets.tracks
-ui.gestures ui.operations ui.tools.browser ui.tools.common
-ui.gadgets.scrollers ;
+USING: accessors arrays sequences sorting assocs colors.constants
+combinators combinators.smart combinators.short-circuit editors
+compiler.errors compiler.units fonts kernel io.pathnames
+stack-checker.errors math.parser math.order models models.arrow
+models.search debugger namespaces summary locals ui ui.commands
+ui.gadgets ui.gadgets.panes ui.gadgets.tables ui.gadgets.labeled
+ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser
+ui.tools.common ui.gadgets.scrollers ui.tools.inspector
+ui.gadgets.status-bar ui.operations ui.gadgets.buttons
+ui.gadgets.borders ui.images ;
IN: ui.tools.compiler-errors
-TUPLE: error-list-gadget < tool table ;
+TUPLE: error-list-gadget < tool source-file error source-file-table error-table error-display ;
SINGLETON: source-file-renderer
drop [ first2 length number>string 2array ] [ { "All" "" } ] if* ;
M: source-file-renderer row-value
- drop first <pathname> ;
+ drop dup [ first <pathname> ] when ;
M: source-file-renderer column-titles
drop { "File" "Errors" } ;
-: <source-file-table> ( model -- table )
- [ group-by-source-file >alist sort-keys f prefix ] <arrow>
- source-file-renderer <table>
+M: source-file-renderer column-alignment drop { 0 1 } ;
+
+M: source-file-renderer filled-column drop 0 ;
+
+: <source-file-model> ( model -- model' )
+ [ group-by-source-file >alist sort-keys f prefix ] <arrow> ;
+
+:: <source-file-table> ( error-list -- table )
+ error-list model>> <source-file-model>
+ source-file-renderer
+ <table>
[ invoke-primary-operation ] >>action
COLOR: dark-gray >>column-line-color
- { 1 f } >>column-widths
6 >>gap
30 >>min-rows
30 >>max-rows
- 80 >>min-cols
- 80 >>max-cols ;
+ 60 >>min-cols
+ 60 >>max-cols
+ t >>selection-required?
+ error-list source-file>> >>selected-value ;
SINGLETON: error-renderer
+GENERIC: error-icon ( error -- icon )
+
+: <error-icon> ( name -- image-name )
+ "vocab:ui/tools/error-list/icons/" ".tiff" surround <image-name> ;
+
+M: inference-error error-icon
+ type>> {
+ { +error+ [ "compiler-error" ] }
+ { +warning+ [ "compiler-warning" ] }
+ } case <error-icon> ;
+
+M: object error-icon drop "HAI" ;
+
+M: compiler-error error-icon error>> error-icon ;
+
M: error-renderer row-columns
drop [
{
- [ file>> ]
+ [ error-icon ]
[ line#>> number>string ]
[ word>> name>> ]
[ error>> summary ]
} cleave
] output>array ;
+M: error-renderer prototype-row
+ drop [ "compiler-error" <error-icon> "" "" "" ] output>array ;
+
M: error-renderer row-value
drop ;
M: error-renderer column-titles
- drop { "File" "Line" "Word" "Error" } ;
+ drop { "" "Line" "Word" "Error" } ;
+
+M: error-renderer column-alignment drop { 0 1 0 0 } ;
-: <error-table> ( model -- table )
- [ [ [ [ file>> ] [ line#>> ] bi 2array ] compare ] sort ] <arrow>
- error-renderer <table>
+: sort-errors ( seq -- seq' )
+ [ [ [ file>> ] [ line#>> ] bi 2array ] compare ] sort ;
+
+: <error-table-model> ( error-list -- model )
+ [ model>> [ values ] <arrow> ] [ source-file>> ] bi
+ [ swap { [ drop not ] [ [ string>> ] [ file>> ] bi* = ] } 2|| ] <search>
+ [ sort-errors ] <arrow> ;
+
+:: <error-table> ( error-list -- table )
+ error-list <error-table-model>
+ error-renderer
+ <table>
[ invoke-primary-operation ] >>action
COLOR: dark-gray >>column-line-color
6 >>gap
30 >>min-rows
30 >>max-rows
- 80 >>min-cols
- 80 >>max-cols ;
+ 60 >>min-cols
+ 60 >>max-cols
+ t >>selection-required?
+ error-list error>> >>selected-value ;
+
+TUPLE: error-display < track ;
+
+: <error-display> ( error-list -- gadget )
+ vertical error-display new-track
+ add-toolbar
+ swap error>> >>model
+ dup model>> [ print-error ] <pane-control> <scroller> 1 track-add ;
+
+: com-inspect ( error-display -- )
+ model>> value>> inspector ;
+
+: com-help ( error-display -- )
+ model>> value>> error>> error-help-window ;
+
+: com-edit ( error-display -- )
+ model>> value>> edit-error ;
+
+error-display "toolbar" f {
+ { f com-inspect }
+ { f com-help }
+ { f com-edit }
+} define-command-map
-: <error-list-gadget> ( model -- gadget )
+:: <error-list-gadget> ( model -- gadget )
vertical error-list-gadget new-track
- { 3 3 } >>gap
- swap <source-file-table> >>table
- dup table>> <scroller> 1/2 track-add ;
+ model >>model
+ f <model> >>source-file
+ f <model> >>error
+ dup <source-file-table> >>source-file-table
+ dup <error-table> >>error-table
+ dup <error-display> >>error-display
+ :> error-list
+ error-list vertical <track>
+ { 5 5 } >>gap
+ error-list source-file-table>> <scroller> "Source files" <labeled-gadget> 1/4 track-add
+ error-list error-table>> <scroller> "Errors" <labeled-gadget> 1/2 track-add
+ error-list error-display>> "Details" <labeled-gadget> 1/4 track-add
+ { 5 5 } <filled-border> 1 track-add ;
M: error-list-gadget focusable-child*
- table>> ;
+ source-file-table>> ;
: error-list-help ( -- ) "ui-error-list" com-browse ;
: error-list-window ( -- )
compiler-error-model get-global <error-list-gadget>
- "Compiler errors" open-window ;
\ No newline at end of file
+ "Compiler errors" open-status-window ;
\ No newline at end of file
projects / factor.git / commitdiff