compiler.units: changing definitions-changed to use a set.

db4
John Benediktsson 2013-03-10 09:11:18 -07:00
parent b159995bb4
commit c0c769a7d8
7 changed files with 42 additions and 38 deletions

View File

@ -28,7 +28,7 @@ M: object add-recent-where f ;
drop recent-searches get [ <$link> ] map $list ;
: redisplay-recent-page ( -- )
"help.home" >link dup associate
HS{ } clone "help.home" >link over adjoin
notify-definition-observers ;
: expire ( seq -- )
@ -38,4 +38,4 @@ M: object add-recent-where f ;
: add-recent ( obj -- )
add-recent-where dup
[ get [ adjoin ] [ expire ] bi ] [ 2drop ] if
redisplay-recent-page ;
redisplay-recent-page ;

View File

@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes colors colors.constants
combinators combinators.smart compiler.units definitions
definitions.icons effects fry generic hashtables help.stylesheet
help.topics io io.styles kernel locals make math namespaces
parser present prettyprint prettyprint.stylesheet quotations
see sequences sequences.private sets slots sorting splitting
strings urls vectors vocabs vocabs.loader words words.symbol ;
definitions.icons effects fry generic hash-sets hashtables
help.stylesheet help.topics io io.styles kernel locals make math
namespaces parser present prettyprint prettyprint.stylesheet
quotations see sequences sequences.private sets slots sorting
splitting strings urls vectors vocabs vocabs.loader words
words.symbol ;
FROM: prettyprint.sections => with-pprint ;
FROM: namespaces => set ;
IN: help.markup
@ -301,7 +302,8 @@ PRIVATE>
[ "related" [ words diff ] change-word-prop ] each ;
: notify-related-words ( affected-words -- )
[ dup associate notify-definition-observers ] each ;
fast-set notify-definition-observers ;
PRIVATE>
: related-words ( seq -- )

View File

@ -1,6 +1,6 @@
! (c)2009 Joe Groff bsd license
USING: accessors arrays assocs combinators.short-circuit
compiler.units debugger init io
compiler.units debugger init io sets
io.streams.null kernel namespaces prettyprint sequences
source-files.errors summary tools.crossref
tools.crossref.private tools.errors words ;
@ -67,7 +67,7 @@ SINGLETON: deprecation-observer
] with-null-writer ;
M: deprecation-observer definitions-changed
drop keys [ word? ] filter
drop members [ word? ] filter
dup [ deprecated? ] any? not
[ [ check-deprecations ] each ]
[ drop initialize-deprecation-notes ] if ;

View File

@ -3,12 +3,12 @@
USING: accessors arrays assocs classes combinators
combinators.short-circuit compiler.units debugger fry help
help.apropos help.crossref help.home help.topics help.stylesheet
kernel models sequences ui ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.editors ui.gadgets.glass
ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.viewports
ui.gestures ui.tools.browser.history ui.tools.browser.popups
ui.tools.common vocabs ;
kernel models sequences sets ui ui.commands ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks
ui.gadgets.viewports ui.gestures ui.tools.browser.history
ui.tools.browser.popups ui.tools.common vocabs ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool history scroller search-field popup ;
@ -75,14 +75,14 @@ M: browser-gadget handle-gesture
[ call-next-method ]
} cond ;
: showing-definition? ( defspec assoc -- ? )
: showing-definition? ( defspec set -- ? )
{
[ key? ]
[ [ dup word-link? [ name>> ] when ] dip key? ]
[ [ dup vocab-link? [ lookup-vocab ] when ] dip key? ]
[ in? ]
[ [ dup word-link? [ name>> ] when ] dip in? ]
[ [ dup vocab-link? [ lookup-vocab ] when ] dip in? ]
} 2|| ;
M: browser-gadget definitions-changed ( assoc browser -- )
M: browser-gadget definitions-changed ( set browser -- )
[ model>> value>> swap showing-definition? ] keep
'[ _ [ history-value ] keep set-history-value ] when ;

View File

@ -5,6 +5,7 @@ classes.tuple classes.tuple.private continuations definitions
generic init kernel kernel.private math namespaces sequences
sets source-files.errors vocabs words ;
FROM: namespaces => set ;
FROM: sets => members ;
IN: compiler.units
SYMBOL: old-definitions
@ -84,7 +85,7 @@ M: f process-forgotten-words drop ;
SYMBOL: definition-observers
GENERIC: definitions-changed ( assoc obj -- )
GENERIC: definitions-changed ( set obj -- )
[ V{ } clone definition-observers set-global ]
"compiler.units" add-startup-hook
@ -99,7 +100,7 @@ GENERIC: definitions-changed ( assoc obj -- )
: remove-definition-observer ( obj -- )
definition-observers get remove-eq! drop ;
: notify-definition-observers ( assoc -- )
: notify-definition-observers ( set -- )
definition-observers get
[ definitions-changed ] with each ;
@ -114,18 +115,18 @@ M: object always-bump-effect-counter? drop f ;
<PRIVATE
: changed-vocabs ( assoc -- vocabs )
[ drop word? ] assoc-filter
[ drop vocabulary>> dup [ lookup-vocab ] when dup ] assoc-map ;
: changed-vocabs ( set -- vocabs )
members [ word? ] filter
[ vocabulary>> dup [ lookup-vocab ] when ] map ;
: updated-definitions ( -- assoc )
H{ } clone
forgotten-definitions get assoc-union!
new-definitions get first assoc-union!
new-definitions get second assoc-union!
changed-definitions get assoc-union!
maybe-changed get assoc-union!
dup changed-vocabs assoc-union! ;
: updated-definitions ( -- set )
HS{ } clone
forgotten-definitions get keys over adjoin-all
new-definitions get first keys over adjoin-all
new-definitions get second keys over adjoin-all
changed-definitions get keys over adjoin-all
maybe-changed get keys over adjoin-all
dup changed-vocabs over adjoin-all ;
: process-forgotten-definitions ( -- )
forgotten-definitions get keys
@ -146,7 +147,7 @@ M: object always-bump-effect-counter? drop f ;
] when ;
: notify-observers ( -- )
updated-definitions dup assoc-empty?
updated-definitions dup null?
[ drop ] [ notify-definition-observers notify-error-observers ] if ;
: update-existing? ( defs -- ? )
@ -169,7 +170,8 @@ M: object always-bump-effect-counter? drop f ;
TUPLE: nesting-observer new-words ;
M: nesting-observer definitions-changed new-words>> swap assoc-diff! drop ;
M: nesting-observer definitions-changed
[ members ] dip new-words>> [ delete-at ] curry each ;
: add-nesting-observer ( -- )
new-words get nesting-observer boa

View File

@ -17,7 +17,7 @@ main ;
: record-top-level-form ( quot file -- )
top-level-form<<
[ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
[ ] [ f notify-definition-observers ] if-bootstrapping ;
: record-checksum ( lines source-file -- )
[ crc32 checksum-lines ] dip checksum<< ;

View File

@ -227,7 +227,7 @@ M: vocab update dup name>> lookup-vocab eq? ;
swap [ lookup-vocab ] V{ } map-as >>search-vocabs
qualified-vocabs>> [ update ] filter! drop ;
M: manifest definitions-changed ( assoc manifest -- )
M: manifest definitions-changed
nip update-manifest ;
PRIVATE>