steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'smarter_error_list' of git://factorcode.org/git/factor into smarter_error_list

db4
Slava Pestov 2009-04-12 23:55:08 -05:00
parent 812f1597fa e595576dc3
commit b3cb06cf1f
32 changed files with 187 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/bootstrap/stage2.factor
View File

@ -81,13 +81,11 @@ SYMBOL: bootstrap-time
"none" require
] if
[
load-components
load-components
millis over - core-bootstrap-time set-global
millis over - core-bootstrap-time set-global
run-bootstrap-init
] with-compiler-errors
run-bootstrap-init
f error set-global
f error-continuation set-global

4
basis/compiler/codegen/codegen.factor
View File

@ -380,7 +380,7 @@ TUPLE: no-such-library name ;
M: no-such-library summary
drop "Library not found" ;
M: no-such-library source-file-error-type drop +linkage-error+ ;
M: no-such-library error-type drop +linkage-error+ ;
: no-such-library ( name -- )
\ no-such-library boa
@ -391,7 +391,7 @@ TUPLE: no-such-symbol name ;
M: no-such-symbol summary
drop "Symbol not found" ;
M: no-such-symbol source-file-error-type drop +linkage-error+ ;
M: no-such-symbol error-type drop +linkage-error+ ;
: no-such-symbol ( name -- )
\ no-such-symbol boa

15
basis/compiler/compiler.factor
View File

@ -53,11 +53,18 @@ SYMBOLS: +optimized+ +unoptimized+ ;
f swap compiler-error ;
: ignore-error? ( word error -- ? )
[ [ inline? ] [ macro? ] bi or ]
[ source-file-error-type +compiler-warning+ eq? ] bi* and ;
[
{
[ inline? ]
[ macro? ]
[ "transform-quot" word-prop ]
[ "no-compile" word-prop ]
[ "special" word-prop ]
} 1||
] [ error-type +compiler-warning+ eq? ] bi* and ;
: fail ( word error -- * )
[ 2dup ignore-error? [ 2drop ] [ swap compiler-error ] if ]
[ 2dup ignore-error? [ drop f ] when swap compiler-error ]
[
drop
[ compiled-unxref ]
@ -122,6 +129,8 @@ t compile-dependencies? set-global
: compile-call ( quot -- )
[ dup infer define-temp ] with-compilation-unit execute ;
\ compile-call t "no-compile" set-word-prop
SINGLETON: optimizing-compiler
M: optimizing-compiler recompile ( words -- alist )

4
basis/help/lint/checks/checks.factor
View File

@ -124,11 +124,11 @@ SYMBOL: vocab-articles
: check-class-description ( word element -- )
[ class? not ]
[ { $class-description } swap elements empty? not ] bi* and
[ "A word that is not a class has a $class-description" throw ] when ;
[ "A word that is not a class has a $class-description" simple-lint-error ] when ;
: check-article-title ( article -- )
article-title first LETTER?
[ "Article title must begin with a capital letter" throw ] unless ;
[ "Article title must begin with a capital letter" simple-lint-error ] unless ;
: check-elements ( element -- )
{

4
basis/help/lint/lint-docs.factor
View File

@ -14,6 +14,10 @@ $nl
"To run help lint, use one of the following two words:"
{ $subsection help-lint }
{ $subsection help-lint-all }
"Once a help lint run completes, failures can be listed:"
{ $subsection :lint-failures }
"Help lint failures are also shown in the " { $link "ui.tools.error-list" } "."
$nl
"Help lint performs the following checks:"
{ $list
"ensures examples run and produce stated output"

19
basis/help/lint/lint.factor
View File

@ -3,7 +3,7 @@
USING: assocs continuations fry help help.lint.checks
help.topics io kernel namespaces parser sequences
source-files.errors tools.vocabs vocabs words classes
locals ;
locals tools.errors ;
FROM: help.lint.checks => all-vocabs ;
IN: help.lint
@ -15,11 +15,15 @@ TUPLE: help-lint-error < source-file-error ;
SYMBOL: +help-lint-failure+
+help-lint-failure+
"vocab:ui/tools/error-list/icons/help-lint-error.tiff"
[ lint-failures get values ] define-error-type
T{ error-type
{ type +help-lint-failure+ }
{ word ":lint-failures" }
{ plural "help lint failures" }
{ icon "vocab:ui/tools/error-list/icons/help-lint-error.tiff" }
{ quot [ lint-failures get values ] }
} define-error-type
M: help-lint-error source-file-error-type drop +help-lint-failure+ ;
M: help-lint-error error-type drop +help-lint-failure+ ;
<PRIVATE
@ -66,8 +70,7 @@ PRIVATE>
: check-vocab ( vocab -- )
"Checking " write dup write "..." print
vocab
[ check-about ]
[ vocab check-about ]
[ words [ check-word ] each ]
[ vocab-articles get at [ check-article ] each ]
tri ;
@ -84,6 +87,8 @@ PRIVATE>
: help-lint-all ( -- ) "" help-lint ;
: :lint-failures ( -- ) lint-failures get errors. ;
: unlinked-words ( words -- seq )
all-word-help [ article-parent not ] filter ;

8
basis/listener/listener.factor
View File

@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
namespaces parser lexer sequences strings io.styles
vectors words generic system combinators continuations debugger
definitions compiler.units accessors colors prettyprint fry
sets vocabs.parser ;
sets vocabs.parser source-files.errors ;
IN: listener
GENERIC: stream-read-quot ( stream -- quot/f )
@ -68,6 +68,8 @@ SYMBOL: max-stack-items
10 max-stack-items set-global
SYMBOL: error-summary-hook
<PRIVATE
: title. ( string -- )
@ -105,8 +107,10 @@ SYMBOL: max-stack-items
"( " in get auto-use? get [ " - auto" append ] when " )" 3append
H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
[ error-summary ] error-summary-hook set-global
: listen ( -- )
visible-vars. stacks. prompt.
error-summary-hook get call( -- ) visible-vars. stacks. prompt.
[ read-quot [ [ call-error-hook ] recover ] [ bye ] if* ]
[ dup lexer-error? [ call-error-hook ] [ rethrow ] if ] recover ;

2
basis/memoize/memoize.factor
View File

@ -61,3 +61,5 @@ M: memoized reset-word
: invalidate-memoized ( inputs... word -- )
[ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
\ invalidate-memoized t "no-compile" set-word-prop

2
basis/stack-checker/errors/errors.factor
View File

@ -11,7 +11,7 @@ IN: stack-checker.errors
TUPLE: inference-error error type word ;
M: inference-error source-file-error-type type>> ;
M: inference-error error-type type>> ;
: (inference-error) ( ... class type -- * )
[ boa ] dip

3
basis/stack-checker/known-words/known-words.factor
View File

@ -218,8 +218,7 @@ M: object infer-call*
alien-callback
} [ t "special" set-word-prop ] each
{ call execute dispatch load-locals get-local drop-locals }
[ t "no-compile" set-word-prop ] each
\ clear t "no-compile" set-word-prop
: non-inline-word ( word -- )
dup called-dependency depends-on

20
basis/tools/errors/errors-docs.factor
View File

@ -5,28 +5,20 @@ words quotations io ;
ARTICLE: "compiler-errors" "Compiler warnings and errors"
"After loading a vocabulary, you might see messages like:"
{ $code
":errors - print 2 compiler errors."
":warnings - print 50 compiler warnings."
":errors - print 2 compiler errors"
":warnings - print 50 compiler warnings"
}
"These warnings arise from the compiler's stack effect checker. Warnings are non-fatal conditions -- not all code has a static stack effect, so you try to minimize warnings but understand that in many cases they cannot be eliminated. Errors indicate programming mistakes, such as erroneous stack effect declarations."
$nl
"The precise warning and error conditions are documented in " { $link "inference-errors" } "."
"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "."
$nl
"Words to view warnings and errors:"
{ $subsection :errors }
{ $subsection :warnings }
{ $subsection :errors }
{ $subsection :linkage }
"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
{ $subsection with-compiler-errors } ;
"Compiler warnings and errors are also shown in the " { $link "ui.tools.error-list" } "." ;
HELP: compiler-error
{ $values { "error" "an error" } { "word" word } }
{ $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } ". If not inside a " { $link with-compiler-errors } ", ignores the error." } ;
HELP: with-compiler-errors
{ $values { "quot" quotation } }
{ $description "Calls the quotation and collects any compiler warnings and errors. Compiler warnings and errors are summarized at the end and can be viewed with " { $link :errors } ", " { $link :warnings } ", and " { $link :linkage } "." }
{ $notes "Nested calls to " { $link with-compiler-errors } " are ignored, and only the outermost call collects warnings and errors." } ;
{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
HELP: :errors
{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;

6
basis/tools/test/test-docs.factor
View File

@ -16,7 +16,9 @@ ARTICLE: "tools.test.run" "Running unit tests"
{ $subsection test }
{ $subsection test-all }
"The following word prints failures:"
{ $subsection :failures }
{ $subsection :test-failures }
"Help lint failures are also shown in the " { $link "ui.tools.error-list" } "."
$nl
"Unit test failurs are instances of a class, and are stored in a global variable:"
{ $subsection test-failure }
{ $subsection test-failures } ;
@ -70,5 +72,5 @@ HELP: test
HELP: test-all
{ $description "Runs unit tests for all loaded vocabularies." } ;
HELP: :failures
HELP: :test-failures
{ $description "Prints all pending unit test failures." } ;

17
basis/tools/test/test.factor
View File

@ -13,13 +13,19 @@ TUPLE: test-failure < source-file-error continuation ;
SYMBOL: +test-failure+
M: test-failure source-file-error-type drop +test-failure+ ;
M: test-failure error-type drop +test-failure+ ;
SYMBOL: test-failures
test-failures [ V{ } clone ] initialize
+test-failure+ "vocab:ui/tools/error-list/icons/unit-test-error.tiff" [ test-failures get ] define-error-type
T{ error-type
{ type +test-failure+ }
{ word ":test-failures" }
{ plural "unit test failures" }
{ icon "vocab:ui/tools/error-list/icons/unit-test-error.tiff" }
{ quot [ test-failures get ] }
} define-error-type
<PRIVATE
@ -130,12 +136,9 @@ M: test-failure error. ( error -- )
[ traceback-button. ]
bi ;
: :failures ( -- ) test-failures get errors. ;
: :test-failures ( -- ) test-failures get errors. ;
: test ( prefix -- )
[ child-vocabs [ run-vocab-tests ] each ] with-compiler-errors
test-failures get [
":failures - show " write length pprint " failing tests." print
] unless-empty ;
child-vocabs [ run-vocab-tests ] each ;
: test-all ( -- ) "" test ;

2
basis/tools/vocabs/vocabs.factor
View File

@ -78,7 +78,7 @@ SYMBOL: failures
recover
] each
failures get
] with-compiler-errors ;
] with-scope ;
: source-modified? ( path -- ? )
dup source-files get at [

12
basis/tools/walker/walker.factor
View File

@ -92,6 +92,18 @@ M: object add-breakpoint ;
: (step-into-call-next-method) ( method -- )
next-method-quot (step-into-quot) ;
{
(step-into-quot)
(step-into-dip)
(step-into-2dip)
(step-into-3dip)
(step-into-if)
(step-into-dispatch)
(step-into-execute)
(step-into-continuation)
(step-into-call-next-method)
} [ t "no-compile" set-word-prop ] each
! Messages sent to walker thread
SYMBOL: step
SYMBOL: step-out

2
basis/ui/backend/cocoa/tools/tools.factor
View File

@ -70,7 +70,7 @@ CLASS: {
! Service support; evaluate Factor code from other apps
:: do-service ( pboard error quot -- )
pboard error ?pasteboard-string
dup [ quot call ] when
dup [ quot call( string -- result/f ) ] when
[ pboard set-pasteboard-string ] when* ;
CLASS: {

2
basis/ui/gadgets/presentations/presentations.factor
View File

@ -10,7 +10,7 @@ IN: ui.gadgets.presentations
TUPLE: presentation < button object hook ;
: invoke-presentation ( presentation command -- )
[ [ dup hook>> call ] [ object>> ] bi ] dip
[ [ dup hook>> call( presentation -- ) ] [ object>> ] bi ] dip
invoke-command ;
: invoke-primary ( presentation -- )

4
basis/ui/gadgets/slots/slots.factor
View File

@ -23,14 +23,14 @@ TUPLE: slot-editor < track ref close-hook update-hook text ;
} define-command
: close ( slot-editor -- )
dup close-hook>> call ;
dup close-hook>> call( slot-editor -- ) ;
\ close H{
{ +description+ "Close the slot editor without saving changes." }
} define-command
: close-and-update ( slot-editor -- )
[ update-hook>> call ] [ close ] bi ;
[ update-hook>> call( -- ) ] [ close ] bi ;
: slot-editor-value ( slot-editor -- object )
text>> control-value parse-fresh first ;

2
basis/ui/operations/operations-docs.factor
View File

@ -4,7 +4,7 @@ ui.gestures ;
IN: ui.operations
: $operations ( element -- )
>quotation call
>quotation call( -- obj )
f operations>commands
command-map. ;

4
basis/ui/tools/error-list/error-list-docs.factor
View File

@ -1,8 +1,8 @@
IN: ui.tools.error-list
USING: help.markup help.syntax ;
USING: help.markup help.syntax ui.tools.common ui.commands ;
ARTICLE: "ui.tools.error-list" "UI error list tool"
"The error list tool displays messages generated by tools which process source files and definitions."
"The error list tool displays messages generated by tools which process source files and definitions. To display the error list, press " { $command tool "common" show-error-list } " in any UI tool window."
$nl
"The " { $vocab-link "source-files.errors" } " vocabulary contains backend code used by this tool."
{ $heading "Message icons" }

39
basis/ui/tools/error-list/error-list.factor
View File

@ -4,14 +4,14 @@ USING: accessors arrays sequences sorting assocs colors.constants fry
combinators combinators.smart combinators.short-circuit editors make
memoize compiler.units fonts kernel io.pathnames prettyprint
source-files.errors math.parser init math.order models models.arrow
models.arrow.smart models.search models.mapping debugger namespaces
models.arrow.smart models.search models.mapping models.delay 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.gadgets.packs
ui.gadgets.labels ui.baseline-alignment ui.images
compiler.errors ;
compiler.errors calendar ;
IN: ui.tools.error-list
CONSTANT: source-file-icon
@ -26,7 +26,7 @@ MEMO: error-icon ( type -- image-name )
: <error-toggle> ( -- model gadget )
#! Linkage errors are not shown by default.
error-types [ dup +linkage-error+ eq? not <model> ] { } map>assoc
error-types get keys [ dup +linkage-error+ eq? not <model> ] { } map>assoc
[ [ [ error-icon ] dip ] assoc-map <checkboxes> ]
[ <mapping> ] bi ;
@ -75,7 +75,7 @@ SINGLETON: error-renderer
M: error-renderer row-columns
drop [
{
[ source-file-error-type error-icon ]
[ error-type error-icon ]
[ line#>> number>string ]
[ asset>> unparse-short ]
[ error>> summary ]
@ -142,7 +142,7 @@ error-display "toolbar" f {
[ <toolbar> ] [ error-toggle>> "Show errors:" label-on-left add-gadget ] bi ;
: <error-model> ( visible-errors model -- model' )
[ swap '[ source-file-error-type _ at ] filter ] <smart-arrow> ;
[ swap '[ error-type _ at ] filter ] <smart-arrow> ;
:: <error-list-gadget> ( model -- gadget )
vertical error-list-gadget new-track
@ -173,23 +173,26 @@ error-list-gadget "toolbar" f {
{ T{ key-down f f "F1" } error-list-help }
} define-command-map
SYMBOL: compiler-error-model
SYMBOL: error-list-model
compiler-error-model [ f <model> ] initialize
error-list-model [ f <model> ] initialize
SINGLETON: updater
M: updater definitions-changed
2drop
all-errors
compiler-error-model get-global
set-model ;
M: updater errors-changed
drop f error-list-model get-global set-model ;
[
updater remove-definition-observer
updater add-definition-observer
] "ui.tools.error-list" add-init-hook
[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
: <error-list-model> ( -- model )
error-list-model get-global
1/2 seconds <delay> [ drop all-errors ] <arrow> ;
: error-list-window ( -- )
compiler-error-model get-global <error-list-gadget>
"Errors" open-status-window ;
<error-list-model> <error-list-gadget> "Errors" open-status-window ;
: show-error-list ( -- )
[ error-list-gadget? ] find-window
[ raise-window ] [ error-list-window ] if* ;
\ show-error-list H{ { +nullary+ t } } define-command

17
basis/ui/tools/listener/listener.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar combinators locals
colors.constants combinators.short-circuit compiler.units
help.tips concurrency.flags concurrency.mailboxes continuations
destructors documents documents.elements fry hashtables help
help.markup io io.styles kernel lexer listener math models
source-files.errors colors.constants combinators.short-circuit
compiler.units help.tips concurrency.flags concurrency.mailboxes
continuations destructors documents documents.elements fry hashtables
help help.markup io io.styles kernel lexer listener math models
models.delay models.arrow namespaces parser prettyprint quotations
sequences strings threads tools.vocabs vocabs vocabs.loader
vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets
@ -13,7 +13,7 @@ ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
ui.tools.listener.completion ui.tools.listener.popups
ui.tools.listener.history ;
ui.tools.listener.history ui.tools.error-list ;
IN: ui.tools.listener
! If waiting is t, we're waiting for user input, and invoking
@ -356,10 +356,17 @@ interactor "completion" f {
{ T{ key-down f { C+ } "r" } history-completion-popup }
} define-command-map
: ui-error-summary ( -- )
all-errors empty? [
{ "Press " { $command tool "common" show-error-list } " to view errors." }
print-element nl
] unless ;
: listener-thread ( listener -- )
dup listener-streams [
[ com-browse ] help-hook set
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set
[ ui-error-summary ] error-summary-hook set
tip-of-the-day. nl
listener
] with-streams* ;

1
basis/ui/tools/tools.factor
View File

@ -30,4 +30,5 @@ tool "common" f {
{ T{ key-down f { A+ } "w" } close-window }
{ T{ key-down f { A+ } "q" } com-exit }
{ T{ key-down f f "F2" } refresh-all }
{ T{ key-down f f "F3" } show-error-list }
} define-command-map

2
core/combinators/combinators.factor
View File

@ -86,6 +86,8 @@ ERROR: no-case object ;
] [ callable? ] if
] find nip ;
\ case-find t "no-compile" set-word-prop
: case ( obj assoc -- )
case-find {
{ [ dup array? ] [ nip second call ] }

3
core/compiler/errors/errors-docs.factor
View File

@ -2,7 +2,4 @@ IN: compiler.errors
USING: help.markup help.syntax vocabs.loader words io
quotations words.symbol ;
HELP: compiler-errors
{ $var-description "Global variable holding an assoc mapping words to compiler errors. This variable is set by " { $link with-compiler-errors } "." } ;
ABOUT: "compiler-errors"

60
core/compiler/errors/errors.factor
View File

@ -1,13 +1,11 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make assocs io sequences
continuations math math.parser accessors definitions
source-files.errors ;
USING: accessors source-files.errors kernel namespaces assocs ;
IN: compiler.errors
TUPLE: compiler-error < source-file-error ;
M: compiler-error source-file-error-type error>> source-file-error-type ;
M: compiler-error error-type error>> error-type ;
SYMBOL: compiler-errors
@ -15,34 +13,34 @@ compiler-errors [ H{ } clone ] initialize
SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ;
+compiler-error+ "vocab:ui/tools/error-list/icons/compiler-error.tiff" [ compiler-errors get values ] define-error-type
+compiler-warning+ "vocab:ui/tools/error-list/icons/compiler-warning.tiff" [ f ] define-error-type
+linkage-error+ "vocab:ui/tools/error-list/icons/linkage-error.tiff" [ f ] define-error-type
SYMBOL: with-compiler-errors?
: errors-of-type ( type -- assoc )
compiler-errors get-global
swap [ [ nip source-file-error-type ] dip eq? ] curry
swap [ [ nip error-type ] dip eq? ] curry
assoc-filter ;
: (compiler-report) ( what type word -- )
over errors-of-type assoc-empty? [ 3drop ] [
[
":" %
%
" - print " %
errors-of-type assoc-size #
" " %
%
"." %
] "" make print
] if ;
T{ error-type
{ type +compiler-error+ }
{ word ":errors" }
{ plural "compiler errors" }
{ icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" }
{ quot [ +compiler-error+ errors-of-type values ] }
} define-error-type
: compiler-report ( -- )
"compiler errors" +compiler-error+ "errors" (compiler-report)
"compiler warnings" +compiler-warning+ "warnings" (compiler-report)
"linkage errors" +linkage-error+ "linkage" (compiler-report) ;
T{ error-type
{ type +compiler-warning+ }
{ word ":warnings" }
{ plural "compiler warnings" }
{ icon "vocab:ui/tools/error-list/icons/compiler-warning.tiff" }
{ quot [ +compiler-warning+ errors-of-type values ] }
} define-error-type
T{ error-type
{ type +linkage-error+ }
{ word ":linkage" }
{ plural "linkage errors" }
{ icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" }
{ quot [ +linkage-error+ errors-of-type values ] }
} define-error-type
: <compiler-error> ( error word -- compiler-error )
\ compiler-error <definition-error> ;
@ -50,11 +48,3 @@ SYMBOL: with-compiler-errors?
: compiler-error ( error word -- )
compiler-errors get-global pick
[ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
: with-compiler-errors ( quot -- )
with-compiler-errors? get "quiet" get or [ call ] [
[
with-compiler-errors? on
[ compiler-report ] [ ] cleanup
] with-scope
] if ; inline

2
core/compiler/units/units.factor
View File

@ -62,7 +62,7 @@ GENERIC: definitions-changed ( assoc obj -- )
definition-observers get push ;
: remove-definition-observer ( obj -- )
definition-observers get delete ;
definition-observers get delq ;
: notify-definition-observers ( assoc -- )
definition-observers get

4
core/continuations/continuations.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays vectors kernel kernel.private sequences
namespaces make math splitting sorting quotations assocs
combinators combinators.private accessors ;
combinators combinators.private accessors words ;
IN: continuations
SYMBOL: error
@ -81,6 +81,8 @@ C: <continuation> continuation
[ set-datastack ] dip
set-callstack ;
\ (continue) t "no-compile" set-word-prop
PRIVATE>
: continue-with ( obj continuation -- * )

2
core/generic/generic.factor
View File

@ -33,6 +33,8 @@ M: generic definition drop f ;
GENERIC: effective-method ( generic -- method )
\ effective-method t "no-compile" set-word-prop
: next-method-class ( class generic -- class/f )
order [ class<= ] with filter reverse dup length 1 =
[ drop f ] [ second ] if ;

8
core/parser/parser.factor
View File

@ -281,11 +281,9 @@ print-use-hook [ [ ] ] initialize
: parse-file ( file -- quot )
[
[
[ parsing-file ] keep
[ utf8 <file-reader> ] keep
parse-stream
] with-compiler-errors
[ parsing-file ] keep
[ utf8 <file-reader> ] keep
parse-stream
] [
over parse-file-restarts rethrow-restarts
drop parse-file

47
core/source-files/errors/errors.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math.order sorting sequences definitions
namespaces arrays splitting io math.parser math ;
namespaces arrays splitting io math.parser math init ;
IN: source-files.errors
TUPLE: source-file-error error asset file line# ;
@ -12,7 +12,9 @@ TUPLE: source-file-error error asset file line# ;
: group-by-source-file ( errors -- assoc )
H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;
GENERIC: source-file-error-type ( error -- type )
TUPLE: error-type type word plural icon quot ;
GENERIC: error-type ( error -- type )
: <definition-error> ( error definition class -- source-file-error )
new
@ -26,36 +28,43 @@ GENERIC: source-file-error-type ( error -- type )
: delete-file-errors ( seq file type -- )
[
[ swap file>> = ] [ swap source-file-error-type = ]
[ swap file>> = ] [ swap error-type = ]
bi-curry* bi and not
] 2curry filter-here ;
SYMBOL: source-file-error-types
SYMBOL: error-types
source-file-error-types [ V{ } clone ] initialize
error-types [ V{ } clone ] initialize
: error-types ( -- seq ) source-file-error-types get keys ;
: define-error-type ( type icon quot -- )
2array swap source-file-error-types get set-at ;
: define-error-type ( error-type -- )
dup type>> error-types get set-at ;
: error-icon-path ( type -- icon )
source-file-error-types get at first ;
error-types get at icon>> ;
: error-summary ( -- )
source-file-error-types get [
[ name>> "+" ?head drop "+" ?tail drop ]
[ second call length ] bi*
] assoc-map
error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map
[ nip 0 > ] assoc-filter
[
over
[ ":" write write ]
[ " - print " write number>string write bl ]
[ { { CHAR: - CHAR: \s } } substitute write "s" print ] tri*
[ word>> write ]
[ " - show " write number>string write bl ]
[ plural>> print ] tri*
] assoc-each ;
: all-errors ( -- errors )
source-file-error-types get
[ second second call( -- seq ) ] map
error-types get values
[ quot>> call( -- seq ) ] map
concat ;
GENERIC: errors-changed ( observer -- )
SYMBOL: error-observers
[ V{ } clone error-observers set-global ] "source-files.errors" add-init-hook
: add-error-observer ( observer -- ) error-observers get push ;
: remove-error-observer ( observer -- ) error-observers get delq ;
: notify-error-observers ( -- ) error-observers get [ errors-changed ] each ;

8
core/vocabs/loader/loader.factor
View File

@ -80,11 +80,11 @@ SYMBOL: load-help?
PRIVATE>
: require ( vocab -- )
[ load-vocab drop ] with-compiler-errors ;
load-vocab drop ;
: reload ( name -- )
dup vocab
[ [ [ load-source ] [ load-docs ] bi ] with-compiler-errors ]
[ [ load-source ] [ load-docs ] bi ]
[ require ]
?if ;
@ -125,9 +125,7 @@ PRIVATE>
[
dup vocab-name blacklist get at* [ rethrow ] [
drop dup find-vocab-root
[ [ (load-vocab) ] with-compiler-errors ]
[ dup vocab [ ] [ no-vocab ] ?if ]
if
[ (load-vocab) ] [ dup vocab [ ] [ no-vocab ] ?if ] if
] if
] load-vocab-hook set-global