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

New benchmarks and UI improvements

db4
Slava Pestov 2008-02-27 19:24:50 -06:00
parent cfa7c3771c
commit 27c9b31288
14 changed files with 100 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/benchmark/crc32/crc32.factor Normal file
View File

@ -0,0 +1,10 @@
USING: io.crc32 io.files kernel math ;
IN: benchmark.crc32
: crc32-primes-list ( -- )
10 [
"extra/math/primes/list/list.factor" resource-path
file-contents crc32 drop
] times ;
MAIN: crc32-primes-list

7
extra/benchmark/md5/md5.factor Normal file
View File

@ -0,0 +1,7 @@
USING: crypto.md5 io.files kernel ;
IN: benchmark.md5
: md5-primes-list ( -- )
"extra/math/primes/list/list.factor" resource-path file>md5 drop ;
MAIN: md5-primes-list

14
extra/benchmark/random/random.factor Normal file
View File

@ -0,0 +1,14 @@
USING: io.files random math.parser io math ;
IN: benchmark.random
: random-numbers-path "random-numbers.txt" temp-file ;
: write-random-numbers ( n -- )
random-numbers-path [
[ 200 random 100 - number>string print ] times
] with-file-writer ;
: random-main ( -- )
1000000 write-random-numbers ;
MAIN: random-main

5
extra/benchmark/sort/sort.factor
View File

@ -1,7 +1,8 @@
USING: kernel sequences sorting random ;
USING: kernel sequences sorting benchmark.random math.parser
io.files ;
IN: benchmark.sort
: sort-benchmark
100000 [ drop 100000 random ] map natural-sort drop ;
random-numbers-path file-lines [ string>number ] map natural-sort drop ;
MAIN: sort-benchmark

5
extra/benchmark/sum-file/sum-file.factor
View File

@ -1,4 +1,5 @@
USING: io io.files math math.parser kernel prettyprint ;
USING: io io.files math math.parser kernel prettyprint
benchmark.random ;
IN: benchmark.sum-file
: sum-file-loop ( n -- n' )
@ -8,6 +9,6 @@ IN: benchmark.sum-file
[ 0 sum-file-loop ] with-file-reader . ;
: sum-file-main ( -- )
home "sum-file-in.txt" path+ sum-file ;
random-numbers-path sum-file ;
MAIN: sum-file-main

1
extra/help/handbook/handbook.factor
View File

@ -199,6 +199,7 @@ ARTICLE: "tools" "Developer tools"
"Debugging tools:"
{ $subsection "tools.annotations" }
{ $subsection "tools.test" }
{ $subsection "tools.threads" }
"Performance tools:"
{ $subsection "tools.memory" }
{ $subsection "profiling" }

17
extra/help/help.factor
View File

@ -122,18 +122,31 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
: (:help-multi)
"This error has multiple delegates:" print
($index) nl ;
($index) nl
"Use \\ ... help to get help about a specific delegate." print ;
: (:help-none)
drop "No help for this error. " print ;
: (:help-debugger)
nl
"Debugger commands:" print
nl
":help - documentation for this error" print
":s - data stack at exception time" print
":r - retain stack at exception time" print
":c - call stack at exception time" print
":edit - jump to source location (parse errors only)" print
":get ( var -- value ) accesses variables at time of the error" print ;
: :help ( -- )
error get delegates [ error-help ] map [ ] subset
{
{ [ dup empty? ] [ (:help-none) ] }
{ [ dup length 1 = ] [ first help ] }
{ [ t ] [ (:help-multi) ] }
} cond ;
} cond (:help-debugger) ;
: remove-article ( name -- )
dup articles get key? [

2
extra/opengl/gl/extensions/extensions.factor
View File

@ -17,7 +17,7 @@ SYMBOL: +gl-function-pointers+
: reset-gl-function-pointers ( -- )
100 <hashtable> +gl-function-pointers+ set-global ;
[ reset-gl-function-pointers ] "opengl.gl init hook" add-init-hook
[ reset-gl-function-pointers ] "opengl.gl" add-init-hook
reset-gl-function-pointers
reset-gl-function-number-counter

17
extra/tools/threads/threads-docs.factor Normal file
View File

@ -0,0 +1,17 @@
IN: tools.threads
USING: help.markup help.syntax threads ;
HELP: threads.
{ $description "Prints a list of running threads and their state. The ``Waiting on'' column displays one of the following:"
{ $list
"``running'' if the thread is the current thread"
"``yield'' if the thread is waiting to run"
{ "the string given to " { $link suspend } " if the thread is suspended" }
}
} ;
ARTICLE: "tools.threads" "Listing threads"
"Printing a list of running threads:"
{ $subsection threads. } ;
ABOUT: "tools.threads"

1
extra/ui/gadgets/buttons/buttons.factor
View File

@ -88,7 +88,6 @@ TUPLE: repeat-button ;
repeat-button H{
{ T{ drag } [ button-clicked ] }
{ T{ button-down } [ button-clicked ] }
} set-gestures
: <repeat-button> ( label quot -- button )

13
extra/ui/tools/listener/listener.factor
View File

@ -40,9 +40,14 @@ M: listener-gadget call-tool* ( input listener -- )
M: listener-gadget tool-scroller
listener-gadget-output find-scroller ;
: wait-for-listener ( listener -- )
#! Wait for the listener to start.
listener-gadget-input interactor-flag wait-for-flag ;
: workspace-busy? ( workspace -- ? )
workspace-listener listener-gadget-input
interactor-busy? ;
workspace-listener
dup wait-for-listener
listener-gadget-input interactor-busy? ;
: get-listener ( -- listener )
[ workspace-busy? not ] get-workspace* workspace-listener ;
@ -134,10 +139,6 @@ M: stack-display tool-scroller
: start-listener-thread ( listener -- )
[ listener-thread ] curry "Listener" spawn drop ;
: wait-for-listener ( listener -- )
#! Wait for the listener to start.
listener-gadget-input interactor-flag wait-for-flag ;
: restart-listener ( listener -- )
#! Returns when listener is ready to receive input.
dup com-end dup clear-output

27
extra/ui/tools/tools.factor
View File

@ -1,15 +1,14 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs debugger ui.tools.workspace
ui.tools.operations ui.tools.browser ui.tools.inspector
ui.tools.listener ui.tools.profiler
ui.tools.operations ui.tools.traceback ui.tools.browser
ui.tools.inspector ui.tools.listener ui.tools.profiler
ui.tools.operations inspector io kernel math models namespaces
prettyprint quotations sequences ui ui.commands ui.gadgets
ui.gadgets.books ui.gadgets.buttons
ui.gadgets.labelled ui.gadgets.scrollers ui.gadgets.tracks
ui.gadgets.worlds ui.gadgets.presentations ui.gestures words
vocabs.loader tools.test ui.gadgets.buttons
ui.gadgets.status-bar mirrors ;
ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
ui.gadgets.presentations ui.gestures words vocabs.loader
tools.test ui.gadgets.buttons ui.gadgets.status-bar mirrors ;
IN: ui.tools
: <workspace-tabs> ( -- tabs )
@ -83,7 +82,13 @@ workspace "workflow" f {
} define-command-map
[
<workspace>
dup "Factor workspace" open-status-window
workspace-listener wait-for-listener
<workspace> "Factor workspace" open-status-window
] workspace-window-hook set-global
: inspect-continuation ( traceback -- )
control-value [ inspect ] curry call-listener ;
traceback-gadget "toolbar" f {
{ T{ key-down f f "v" } variables }
{ T{ key-down f f "n" } inspect-continuation }
} define-command-map

4
extra/ui/tools/traceback/traceback.factor
View File

@ -54,7 +54,3 @@ M: variables-gadget pref-dim* drop { 400 400 } ;
: traceback-window ( continuation -- )
<model> <traceback-gadget> "Traceback" open-window ;
traceback-gadget "toolbar" f {
{ T{ key-down f f "v" } variables }
} define-command-map

9
extra/ui/tools/walker/walker.factor
View File

@ -7,7 +7,7 @@ ui.tools.workspace ui.gestures ui.gadgets.labels ui threads
namespaces tools.walker assocs ;
IN: ui.tools.walker
TUPLE: walker-gadget status continuation thread ;
TUPLE: walker-gadget status continuation thread traceback ;
: walker-command ( walker msg -- )
over walker-gadget-thread thread-registered?
@ -29,6 +29,9 @@ TUPLE: walker-gadget status continuation thread ;
M: walker-gadget ungraft*
dup delegate ungraft* detach walker-command ;
M: walker-gadget focusable-child*
walker-gadget-traceback ;
: walker-state-string ( status thread -- string )
[
"Thread: " %
@ -48,10 +51,10 @@ M: walker-gadget ungraft*
[ walker-state-string ] curry <filter> <label-control> ;
: <walker-gadget> ( status continuation thread -- gadget )
walker-gadget construct-boa [
over <traceback-gadget> walker-gadget construct-boa [
toolbar,
g walker-gadget-status self <thread-status> f track,
g walker-gadget-continuation <traceback-gadget> 1 track,
g walker-gadget-traceback 1 track,
] { 0 1 } build-track ;
: walker-help "ui-walker" help-window ;