diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor
index ad261df7d4..01f9643cdd 100755
--- a/core/definitions/definitions.factor
+++ b/core/definitions/definitions.factor
@@ -43,7 +43,7 @@ M: object uses drop f ;
: xref ( defspec -- ) dup uses crossref get add-vertex ;
-: usage ( defspec -- seq ) crossref get at keys ;
+: usage ( defspec -- seq ) \ f or crossref get at keys ;
GENERIC: redefined* ( defspec -- )
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 4bdd1ae40d..35cc471033 100755
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -102,11 +102,13 @@ M: method-body stack-effect
! Definition protocol
M: method-spec where
- dup first2 method [ method-loc ] [ second where ] ?if ;
+ dup first2 method [ method-word ] [ second ] ?if where ;
-M: method-spec set-where first2 method set-method-loc ;
+M: method-spec set-where
+ first2 method method-word set-where ;
-M: method-spec definer drop \ M: \ ; ;
+M: method-spec definer
+ drop \ M: \ ; ;
M: method-spec definition
first2 method dup [ method-def ] when ;
@@ -114,9 +116,21 @@ M: method-spec definition
: forget-method ( class generic -- )
check-method
[ delete-at* ] with-methods
- [ method-word forget ] [ drop ] if ;
+ [ method-word forget-word ] [ drop ] if ;
-M: method-spec forget* first2 forget-method ;
+M: method-spec forget*
+ first2 forget-method ;
+
+M: method-body definer
+ drop \ M: \ ; ;
+
+M: method-body definition
+ "method" word-prop method-def ;
+
+M: method-body forget*
+ "method" word-prop
+ { method-specializer method-generic } get-slots
+ forget-method ;
: implementors* ( classes -- words )
all-words [
diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index b89f56334b..a0e7e4b909 100755
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -351,13 +351,18 @@ IN: temporary
<< file get parsed >> file set
: ~a ;
- : ~b ~a ;
+
+ DEFER: ~b
+
+ "IN: temporary : ~b ~a ;" <string-reader>
+ "smudgy" parse-stream drop
+
: ~c ;
: ~d ;
- { H{ { ~a ~a } { ~c ~c } { ~d ~d } } H{ } } old-definitions set
+ { H{ { ~a ~a } { ~b ~b } { ~c ~c } { ~d ~d } } H{ } } old-definitions set
- { H{ { ~d ~d } } H{ } } new-definitions set
+ { H{ { ~b ~b } { ~d ~d } } H{ } } new-definitions set
[ V{ ~b } { ~a } { ~a ~c } ] [
smudged-usage
@@ -365,6 +370,24 @@ IN: temporary
] unit-test
] with-scope
+[
+ << file get parsed >> file set
+
+ GENERIC: ~e
+
+ : ~f ~e ;
+
+ : ~g ;
+
+ { H{ { ~e ~e } { ~f ~f } { ~g ~g } } H{ } } old-definitions set
+
+ { H{ { ~g ~g } } H{ } } new-definitions set
+
+ [ V{ } { } { ~e ~f } ]
+ [ smudged-usage natural-sort ]
+ unit-test
+] with-scope
+
[ ] [
"IN: temporary USE: kernel PREDICATE: object foo ( x -- y ) ;" eval
] unit-test
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 9bc02c763d..e2efdd8163 100755
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -439,11 +439,12 @@ SYMBOL: interactive-vocabs
"Warning: the following definitions were removed from sources," print
"but are still referenced from other definitions:" print
nl
- dup stack.
+ dup sorted-definitions.
nl
"The following definitions need to be updated:" print
nl
- over stack.
+ over sorted-definitions.
+ nl
] when 2drop ;
: filter-moved ( assoc -- newassoc )
diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor
index 0cbde2a586..2efc9b4e67 100755
--- a/core/prettyprint/prettyprint.factor
+++ b/core/prettyprint/prettyprint.factor
@@ -174,6 +174,12 @@ M: hook-generic synopsis*
M: method-spec synopsis*
dup definer. [ pprint-word ] each ;
+M: method-body synopsis*
+ dup definer.
+ "method" word-prop dup
+ method-specializer pprint*
+ method-generic pprint* ;
+
M: mixin-instance synopsis*
dup definer.
dup mixin-instance-class pprint-word
@@ -188,6 +194,15 @@ M: pathname synopsis* pprint* ;
[ synopsis* ] with-in
] with-string-writer ;
+: synopsis-alist ( definitions -- alist )
+ [ dup synopsis swap ] { } map>assoc ;
+
+: definitions. ( alist -- )
+ [ write-object nl ] assoc-each ;
+
+: sorted-definitions. ( definitions -- )
+ synopsis-alist sort-keys definitions. ;
+
GENERIC: declarations. ( obj -- )
M: object declarations. drop ;
@@ -253,7 +268,9 @@ M: builtin-class see-class*
natural-sort [ nl see ] each ;
: see-implementors ( class -- seq )
- dup implementors [ 2array ] with map ;
+ dup implementors
+ [ method method-word ] with map
+ natural-sort ;
: see-class ( class -- )
dup class? [
@@ -263,8 +280,9 @@ M: builtin-class see-class*
] when drop ;
: see-methods ( generic -- seq )
- [ "methods" word-prop keys natural-sort ] keep
- [ 2array ] curry map ;
+ "methods" word-prop
+ [ nip method-word ] { } assoc>map
+ natural-sort ;
M: word see
dup see-class
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ee38d30750..7208e05af0 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -310,13 +310,11 @@ M: immutable-sequence clone-like like ;
<PRIVATE
-: iterate-seq >r dup length swap r> ; inline
-
: (each) ( seq quot -- n quot' )
- iterate-seq [ >r nth-unsafe r> call ] 2curry ; inline
+ >r dup length swap [ nth-unsafe ] curry r> compose ; inline
: (collect) ( quot into -- quot' )
- [ >r over slip r> set-nth-unsafe ] 2curry ; inline
+ [ >r keep r> set-nth-unsafe ] 2curry ; inline
: collect ( n quot into -- )
(collect) each-integer ; inline
@@ -415,7 +413,7 @@ PRIVATE>
>r dup length 1- swap r> (monotonic) all? ; inline
: interleave ( seq between quot -- )
- [ (interleave) ] 2curry iterate-seq 2each ; inline
+ [ (interleave) ] 2curry >r dup length swap r> 2each ; inline
: unfold ( pred quot tail -- seq )
V{ } clone [
@@ -695,9 +693,9 @@ PRIVATE>
: sequence-hashcode-step ( oldhash newpart -- newhash )
swap [
- dup -2 fixnum-shift >fixnum swap 5 fixnum-shift >fixnum
+ dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
fixnum+fast fixnum+fast
- ] keep bitxor ; inline
+ ] keep fixnum-bitxor ; inline
: sequence-hashcode ( n seq -- x )
0 -rot [
diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index c7539ad3eb..dd5313383e 100755
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -97,16 +97,8 @@ SYMBOL: file
[ ] [ file get rollback-source-file ] cleanup
] with-scope ; inline
-: smart-usage ( word -- definitions )
- \ f or usage [
- dup method-body? [
- "method" word-prop
- { method-specializer method-generic } get-slots
- 2array
- ] when
- ] map ;
-
: outside-usages ( seq -- usages )
dup [
- over smart-usage [ pathname? not ] subset seq-diff
+ over usage
+ [ dup pathname? not swap where and ] subset seq-diff
] curry { } map>assoc ;
diff --git a/extra/alarms/alarms-docs.factor b/extra/alarms/alarms-docs.factor
index 868f161516..b609878c77 100755
--- a/extra/alarms/alarms-docs.factor
+++ b/extra/alarms/alarms-docs.factor
@@ -14,8 +14,7 @@ HELP: later
HELP: cancel-alarm
{ $values { "alarm" alarm } }
-{ $description "Cancels an alarm." }
-{ $errors "Throws an error if the alarm is not active." } ;
+{ $description "Cancels an alarm. Does nothing if the alarm is not active." } ;
ARTICLE: "alarms" "Alarms"
"Alarms provide a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor
index bbc20ea981..92a7c488ef 100755
--- a/extra/alarms/alarms.factor
+++ b/extra/alarms/alarms.factor
@@ -56,15 +56,13 @@ SYMBOL: alarm-thread
: trigger-alarms ( alarms -- )
now (trigger-alarms) ;
-: next-alarm ( alarms -- ms )
+: next-alarm ( alarms -- timestamp/f )
dup heap-empty?
- [ drop f ]
- [ heap-peek drop alarm-time now timestamp- 1000 * 0 max ]
- if ;
+ [ drop f ] [ heap-peek drop alarm-time ] if ;
: alarm-thread-loop ( -- )
alarms get-global
- dup next-alarm nap drop
+ dup next-alarm nap-until drop
dup trigger-alarms
alarm-thread-loop ;
diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor
index 36529facaa..6b1908afb1 100755
--- a/extra/benchmark/sockets/sockets.factor
+++ b/extra/benchmark/sockets/sockets.factor
@@ -34,10 +34,10 @@ IN: benchmark.sockets
: socket-benchmarks
10 clients
20 clients
- 40 clients
- 80 clients
- 160 clients
- 320 clients
- 640 clients ;
+ 40 clients ;
+ ! 80 clients
+ ! 160 clients
+ ! 320 clients
+ ! 640 clients ;
MAIN: socket-benchmarks
diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor
old mode 100644
new mode 100755
index 7d95c8ce8a..f0c5289dd9
--- a/extra/editors/editors.factor
+++ b/extra/editors/editors.factor
@@ -43,7 +43,7 @@ SYMBOL: edit-hook
: fix ( word -- )
"Fixing " write dup pprint " and all usages..." print nl
- dup smart-usage swap add* [
+ dup usage swap add* [
"Editing " write dup .
"RETURN moves on to the next usage, C+d stops." print
flush
diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor
index 9b7a8a8aa5..11ff697049 100755
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@@ -57,17 +57,9 @@ SYMBOL: validation-errors
] if*
] with map ;
-: expire-sessions ( -- )
- sessions get-global
- [ nip session-last-seen 20 minutes ago <=> 0 > ]
- [ 2drop ] heap-pop-while ;
-
: lookup-session ( hash -- session )
- "furnace-session-id" over at sessions get-global at [
- nip
- ] [
- new-session rot "furnace-session-id" swap set-at
- ] if* ;
+ "furnace-session-id" over at get-session
+ [ ] [ new-session "furnace-session-id" roll set-at ] ?if ;
: quot>query ( seq action -- hash )
>r >array r> "action-params" word-prop
diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
old mode 100644
new mode 100755
index 523598efe7..579e5a607e
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -1,37 +1,48 @@
-USING: assoc-heaps assocs calendar crypto.sha2 heaps
-init kernel math.parser namespaces random ;
+USING: assocs calendar init kernel math.parser
+namespaces random boxes alarms ;
IN: furnace.sessions
SYMBOL: sessions
+: timeout ( -- dt ) 20 minutes ;
+
[
- H{ } clone <min-heap> <assoc-heap>
- sessions set-global
+ H{ } clone sessions set-global
] "furnace.sessions" add-init-hook
: new-session-id ( -- str )
- 4 big-random number>string string>sha-256-string
- dup sessions get-global at [ drop new-session-id ] when ;
+ 4 big-random >hex
+ dup sessions get-global key?
+ [ drop new-session-id ] when ;
-TUPLE: session created last-seen user-agent namespace ;
+TUPLE: session id namespace alarm user-agent ;
-M: session <=> ( session1 session2 -- n )
- [ session-last-seen ] 2apply <=> ;
+: cancel-timeout ( session -- )
+ session-alarm ?box [ cancel-alarm ] [ drop ] if ;
-: <session> ( -- obj )
- now dup H{ } clone
- [ set-session-created set-session-last-seen set-session-namespace ]
- \ session construct ;
+: delete-session ( session -- )
+ sessions get-global delete-at*
+ [ cancel-timeout ] [ drop ] if ;
-: new-session ( -- obj id )
- <session> new-session-id [ sessions get-global set-at ] 2keep ;
+: touch-session ( session -- )
+ dup cancel-timeout
+ dup [ session-id delete-session ] curry timeout later
+ swap session-alarm >box ;
-: get-session ( id -- obj/f )
- sessions get-global at* [ "no session found 1" throw ] unless ;
+: <session> ( id -- session )
+ H{ } clone <box> f session construct-boa ;
-! Delete from the assoc only, the heap will timeout
-: destroy-session ( id -- )
- sessions get-global assoc-heap-assoc delete-at ;
+: new-session ( -- session id )
+ new-session-id [
+ dup <session> [
+ [ sessions get-global set-at ] keep
+ touch-session
+ ] keep
+ ] keep ;
+
+: get-session ( id -- session/f )
+ sessions get-global at*
+ [ dup touch-session ] when ;
: session> ( str -- obj )
session get session-namespace at ;
diff --git a/extra/sequences/next/next.factor b/extra/sequences/next/next.factor
old mode 100644
new mode 100755
index 5483cdff4b..5919fb0701
--- a/extra/sequences/next/next.factor
+++ b/extra/sequences/next/next.factor
@@ -3,6 +3,8 @@ IN: sequences.next
<PRIVATE
+: iterate-seq >r dup length swap r> ; inline
+
: (map-next) ( i seq quot -- )
! this uses O(n) more bounds checks than is really necessary
>r [ >r 1+ r> ?nth ] 2keep nth-unsafe r> call ; inline
diff --git a/extra/smtp/server/server.factor b/extra/smtp/server/server.factor
index eb628156f2..c28ec7745a 100755
--- a/extra/smtp/server/server.factor
+++ b/extra/smtp/server/server.factor
@@ -28,7 +28,7 @@
! Connection closed by foreign host.
USING: combinators kernel prettyprint io io.timeouts io.server
-sequences namespaces io.sockets continuations ;
+sequences namespaces io.sockets continuations calendar ;
IN: smtp.server
SYMBOL: data-mode
diff --git a/extra/tools/crossref/crossref-tests.factor b/extra/tools/crossref/crossref-tests.factor
old mode 100644
new mode 100755
index 657b5fc030..b616766597
--- a/extra/tools/crossref/crossref-tests.factor
+++ b/extra/tools/crossref/crossref-tests.factor
@@ -1,5 +1,5 @@
USING: math kernel sequences io.files tools.crossref tools.test
-parser namespaces source-files ;
+parser namespaces source-files generic definitions ;
IN: temporary
GENERIC: foo
@@ -8,5 +8,5 @@ M: integer foo + ;
"resource:extra/tools/test/foo.factor" run-file
-[ t ] [ { integer foo } \ + smart-usage member? ] unit-test
-[ t ] [ \ foo smart-usage [ pathname? ] contains? ] unit-test
+[ t ] [ integer \ foo method method-word \ + usage member? ] unit-test
+[ t ] [ \ foo usage [ pathname? ] contains? ] unit-test
diff --git a/extra/tools/crossref/crossref.factor b/extra/tools/crossref/crossref.factor
index f6561e9f26..f4515a9ebe 100755
--- a/extra/tools/crossref/crossref.factor
+++ b/extra/tools/crossref/crossref.factor
@@ -6,14 +6,8 @@ generic tools.completion quotations parser inspector
sorting hashtables vocabs parser source-files ;
IN: tools.crossref
-: synopsis-alist ( definitions -- alist )
- [ dup synopsis swap ] { } map>assoc ;
-
-: definitions. ( alist -- )
- [ write-object nl ] assoc-each ;
-
: usage. ( word -- )
- smart-usage synopsis-alist sort-keys definitions. ;
+ usage sorted-definitions. ;
: words-matching ( str -- seq )
all-words [ dup word-name ] { } map>assoc completions ;
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index 978ca295ca..8041db3c77 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -3,8 +3,8 @@
USING: assocs ui.tools.interactor ui.tools.listener
ui.tools.workspace help help.topics io.files io.styles kernel
models namespaces prettyprint quotations sequences sorting
-source-files strings tools.completion tools.crossref tuples
-ui.commands ui.gadgets ui.gadgets.editors
+source-files definitions strings tools.completion tools.crossref
+tuples ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
tools.browser unicode.case calendar ;
@@ -93,7 +93,7 @@ M: live-search pref-dim* drop { 400 200 } ;
"Words in " rot vocab-name append show-titled-popup ;
: show-word-usage ( workspace word -- )
- "" over smart-usage f <definition-search>
+ "" over usage f <definition-search>
"Words and methods using " rot word-name append
show-titled-popup ;
diff --git a/extra/assoc-heaps/assoc-heaps-tests.factor b/unmaintained/assoc-heaps/assoc-heaps-tests.factor
similarity index 100%
rename from extra/assoc-heaps/assoc-heaps-tests.factor
rename to unmaintained/assoc-heaps/assoc-heaps-tests.factor
diff --git a/extra/assoc-heaps/assoc-heaps.factor b/unmaintained/assoc-heaps/assoc-heaps.factor
similarity index 100%
rename from extra/assoc-heaps/assoc-heaps.factor
rename to unmaintained/assoc-heaps/assoc-heaps.factor
diff --git a/extra/assoc-heaps/authors.txt b/unmaintained/assoc-heaps/authors.txt
similarity index 100%
rename from extra/assoc-heaps/authors.txt
rename to unmaintained/assoc-heaps/authors.txt
diff --git a/extra/assoc-heaps/summary.txt b/unmaintained/assoc-heaps/summary.txt
similarity index 100%
rename from extra/assoc-heaps/summary.txt
rename to unmaintained/assoc-heaps/summary.txt