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

Dataflow UI improvements

darcs
slava 2006-09-16 00:52:13 +00:00
parent f45cc8ac98
commit 36680369ba
11 changed files with 188 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO.FACTOR.txt
View File

@ -7,11 +7,6 @@
- links:
- same deal
- UI dataflow visualizer:
- spacing is weird
- #label, #if mess up height
- [ >r + dup r> ] foo broken
- why does + look funny?
- pane output in UI should use less memory
- signal 4 on datastack underflow on mac intel??
- faster I/O
@ -45,6 +40,7 @@
- merge keyboard help with help in some way
- keyboard help: hide commands whose gestures are shadowed
- division by zero may not raise an error -- document this
- the editor should fill up the interior of the scroller completely
+ ui:

6
doc/handbook/tools.facts
View File

@ -93,15 +93,11 @@ ARTICLE: "debugger" "The debugger"
ARTICLE: "inspector" "The inspector"
"The prettyprinter (see " { $link "prettyprint" } ") can turn any object into a source representation. Sometimes this source representation is hard to read for a human, so the inspector provides an alternative tabular view of an object:"
{ $subsection inspect }
"Once running, the inspector spawns a new nested listener with an " { $snippet "inspector" } " prompt. The inspector supports a number of commands:"
"The inspector supports a number of commands which operate on the most recently inspected object:"
{ $subsection inspecting }
{ $subsection go }
{ $subsection up }
{ $subsection bye }
"A one-time inspector-like display can be shown without starting the inspector:"
{ $subsection describe }
"Word for getting very brief descriptions of words and general objects:"
{ $subsection synopsis }
{ $subsection summary } ;
ARTICLE: "memory" "Object memory"

34
library/compiler/generator/generator.factor
View File

@ -178,26 +178,36 @@ M: #push generate-node
[ append ] keep delete-all
] if ;
: phantom-shuffle-inputs ( shuffle -- locs locs )
dup shuffle-in-d length phantom-d get phantom-shuffle-input
swap shuffle-in-r length phantom-r get phantom-shuffle-input ;
: adjust-shuffle ( shuffle -- )
dup shuffle-in-d length neg phantom-d get adjust-phantom
shuffle-in-r length neg phantom-r get adjust-phantom ;
: shuffle-vregs# ( shuffle -- n )
dup shuffle-in-d swap shuffle-in-r additional-vregs ;
shuffle-in length neg phantom-d get adjust-phantom ;
: phantom-shuffle ( shuffle -- )
dup shuffle-vregs# 0 ensure-vregs
[ phantom-shuffle-inputs ] keep
dup shuffle-in 0 additional-vregs 0 ensure-vregs
[
shuffle-in length phantom-d get phantom-shuffle-input
] keep
[ shuffle* ] keep adjust-shuffle
(template-outputs) ;
phantom-d get phantom-append ;
M: #shuffle generate-node
node-shuffle phantom-shuffle iterate-next ;
M: #>r generate-node
drop
1 0 additional-vregs 0 ensure-vregs
1 phantom-d get phantom-shuffle-input
-1 phantom-d get adjust-phantom
phantom-r get phantom-append
iterate-next ;
M: #r> generate-node
drop
0 1 additional-vregs 0 ensure-vregs
1 phantom-r get phantom-shuffle-input
-1 phantom-r get adjust-phantom
phantom-d get phantom-append
iterate-next ;
! #return
M: #return generate-node drop end-basic-block %return f ;

5
library/compiler/generator/templates.factor
View File

@ -206,9 +206,6 @@ SYMBOL: phantom-r
: phantom-append ( seq stack -- )
over length over adjust-phantom swap nappend ;
: (template-outputs) ( seq stack -- )
phantoms swapd phantom-append phantom-append ;
SYMBOL: +input
SYMBOL: +output
SYMBOL: +scratch
@ -273,7 +270,7 @@ SYMBOL: +clobber
alloc-scratch ;
: template-outputs ( -- )
+output get [ get ] map { } (template-outputs) ;
+output get [ get ] map phantom-d get phantom-append ;
: with-template ( quot spec -- )
fix-spec [ template-inputs call template-outputs ] bind

37
library/compiler/inference/dataflow.factor
View File

@ -16,36 +16,18 @@ SYMBOL: meta-r
: pop-r meta-r get pop ;
: peek-r meta-r get peek ;
TUPLE: node param shuffle
d-height r-height
TUPLE: node param
in-d out-d in-r out-r
classes literals history
successor children ;
M: node equal? eq? ;
: d-height ( -- n ) meta-d get length d-in get - ; inline
: r-height ( -- n ) meta-r get length ;
: record-height ( node -- )
d-height over set-node-d-height
r-height swap set-node-r-height ;
: node-shuffle ( node -- shuffle )
dup node-in-d swap node-out-d <shuffle> ;
: make-node ( param in-d out-d in-r out-r node -- node )
[
>r swapd <shuffle> f f f f f f f <node> r>
set-delegate
] keep ;
: node-in-d node-shuffle shuffle-in-d ;
: node-in-r node-shuffle shuffle-in-r ;
: node-out-d node-shuffle shuffle-out-d ;
: node-out-r node-shuffle shuffle-out-r ;
: set-node-in-d node-shuffle set-shuffle-in-d ;
: set-node-in-r node-shuffle set-shuffle-in-r ;
: set-node-out-d node-shuffle set-shuffle-out-d ;
: set-node-out-r node-shuffle set-shuffle-out-r ;
[ >r f f f f f <node> r> set-delegate ] keep ;
: empty-node f { } { } { } { } ;
: param-node { } { } { } { } ;
@ -87,6 +69,14 @@ TUPLE: #shuffle ;
C: #shuffle make-node ;
: #shuffle ( -- node ) empty-node <#shuffle> ;
TUPLE: #>r ;
C: #>r make-node ;
: #>r ( -- node ) empty-node <#>r> ;
TUPLE: #r> ;
C: #r> make-node ;
: #r> ( -- node ) empty-node <#r>> ;
TUPLE: #values ;
C: #values make-node ;
: #values ( -- node ) meta-d-node <#values> ;
@ -130,7 +120,6 @@ SYMBOL: dataflow-graph
SYMBOL: current-node
: node, ( node -- )
dup record-height
dataflow-graph get [
dup current-node [ set-node-successor ] change
] [

37
library/compiler/inference/shuffle.factor
View File

@ -22,35 +22,22 @@ M: integer value-uid ;
M: integer value-recursion drop f ;
TUPLE: shuffle in-d in-r out-d out-r ;
TUPLE: shuffle in out ;
: load-shuffle ( d r shuffle -- )
tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
: split-shuffle ( stack shuffle -- stack1 stack2 )
shuffle-in length swap cut* ;
: shuffled-values ( values -- values )
[ [ namespace hash dup ] keep ? ] map ;
: load-shuffle ( stack shuffle -- )
shuffle-in [ set ] 2each ;
: store-shuffle ( shuffle -- d r )
dup shuffle-out-d shuffled-values
swap shuffle-out-r shuffled-values ;
: shuffled-values ( shuffle -- values )
shuffle-out [ get ] map ;
: shuffle* ( d r shuffle -- d r )
[ [ load-shuffle ] keep store-shuffle ] with-scope ;
: shuffle* ( stack shuffle -- stack )
[ [ load-shuffle ] keep shuffled-values ] with-scope ;
: split-shuffle ( d r shuffle -- d' r' d r )
tuck shuffle-in-r length swap cut*
>r >r shuffle-in-d length swap cut*
r> swap r> ;
: join-shuffle ( d' r' d r -- d r )
swapd append >r append r> ;
: shuffle ( d r shuffle -- newd newr )
[ split-shuffle ] keep shuffle* join-shuffle ;
: shuffle ( stack shuffle -- stack )
[ split-shuffle ] keep shuffle* append ;
M: shuffle clone
[ shuffle-in-d clone ] keep
[ shuffle-in-r clone ] keep
[ shuffle-out-d clone ] keep
shuffle-out-r clone
<shuffle> ;
[ shuffle-in clone ] keep shuffle-out clone <shuffle> ;

63
library/compiler/inference/stack.factor
View File

@ -3,16 +3,13 @@ USING: arrays generic kernel math namespaces
sequences words parser ;
: infer-shuffle-inputs ( shuffle node -- )
>r dup shuffle-in-d length swap shuffle-in-r length r>
node-inputs ;
>r shuffle-in length 0 r> node-inputs ;
: shuffle-stacks ( shuffle -- )
#! Shuffle simulated stacks.
meta-d get meta-r get rot shuffle meta-r set meta-d set ;
meta-d [ swap shuffle ] change ;
: infer-shuffle-outputs ( shuffle node -- )
>r dup shuffle-out-d length swap shuffle-out-r length r>
node-outputs ;
>r shuffle-out length 0 r> node-outputs ;
: infer-shuffle ( shuffle -- )
#shuffle dup node,
@ -21,7 +18,7 @@ sequences words parser ;
infer-shuffle-outputs ;
: shuffle>effect ( shuffle -- effect )
dup shuffle-in-d swap shuffle-out-d <effect> ;
dup shuffle-in swap shuffle-out <effect> ;
: define-shuffle ( word shuffle -- )
[ "shuffle" set-word-prop ] 2keep
@ -29,22 +26,38 @@ sequences words parser ;
[ , \ infer-shuffle , ] [ ] make "infer" set-word-prop ;
{
{ drop T{ shuffle f 1 0 { } { } } }
{ 2drop T{ shuffle f 2 0 { } { } } }
{ 3drop T{ shuffle f 3 0 { } { } } }
{ dup T{ shuffle f 1 0 { 0 0 } { } } }
{ 2dup T{ shuffle f 2 0 { 0 1 0 1 } { } } }
{ 3dup T{ shuffle f 3 0 { 0 1 2 0 1 2 } { } } }
{ rot T{ shuffle f 3 0 { 1 2 0 } { } } }
{ -rot T{ shuffle f 3 0 { 2 0 1 } { } } }
{ dupd T{ shuffle f 2 0 { 0 0 1 } { } } }
{ swapd T{ shuffle f 3 0 { 1 0 2 } { } } }
{ nip T{ shuffle f 2 0 { 1 } { } } }
{ 2nip T{ shuffle f 3 0 { 2 } { } } }
{ tuck T{ shuffle f 2 0 { 1 0 1 } { } } }
{ over T{ shuffle f 2 0 { 0 1 0 } { } } }
{ pick T{ shuffle f 3 0 { 0 1 2 0 } { } } }
{ swap T{ shuffle f 2 0 { 1 0 } { } } }
{ >r T{ shuffle f 1 0 { } { 0 } } }
{ r> T{ shuffle f 0 1 { 0 } { } } }
{ drop T{ shuffle f 1 { } } }
{ 2drop T{ shuffle f 2 { } } }
{ 3drop T{ shuffle f 3 { } } }
{ dup T{ shuffle f 1 { 0 0 } } }
{ 2dup T{ shuffle f 2 { 0 1 0 1 } } }
{ 3dup T{ shuffle f 3 { 0 1 2 0 1 2 } } }
{ rot T{ shuffle f 3 { 1 2 0 } } }
{ -rot T{ shuffle f 3 { 2 0 1 } } }
{ dupd T{ shuffle f 2 { 0 0 1 } } }
{ swapd T{ shuffle f 3 { 1 0 2 } } }
{ nip T{ shuffle f 2 { 1 } } }
{ 2nip T{ shuffle f 3 { 2 } } }
{ tuck T{ shuffle f 2 { 1 0 1 } } }
{ over T{ shuffle f 2 { 0 1 0 } } }
{ pick T{ shuffle f 3 { 0 1 2 0 } } }
{ swap T{ shuffle f 2 { 1 0 } } }
} [ first2 define-shuffle ] each
\ >r [
#>r dup node,
1 0 pick node-inputs
pop-d push-r
0 1 rot node-outputs
] "infer" set-word-prop
\ >r { object } { } <effect> "infer-effect" set-word-prop
\ r> [
#r> dup node,
0 1 pick node-inputs
pop-r push-d
1 0 rot node-outputs
] "infer" set-word-prop
\ r> { } { object } <effect> "infer-effect" set-word-prop

6
library/compiler/optimizer/kill-literals.factor
View File

@ -1,5 +1,5 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel math
namespaces sequences words ;
@ -49,7 +49,7 @@ M: #return live-values*
! nodes that don't use their values directly
UNION: #killable
#push #shuffle #call-label #merge #values #entry ;
#push #shuffle #>r #r> #call-label #merge #values #entry ;
M: #killable live-values* drop { } ;

8
library/compiler/optimizer/optimizer.factor
View File

@ -40,6 +40,14 @@ M: node optimize-node* drop t ;
M: #shuffle optimize-node*
[ node-values empty? ] prune-if ;
! #>r
M: #>r optimize-node*
[ node-in-d empty? ] prune-if ;
! #r>
M: #r> optimize-node*
[ node-in-r empty? ] prune-if ;
! #push
M: #push optimize-node*
[ node-out-d empty? ] prune-if ;

175
library/ui/tools/dataflow.factor
View File

@ -7,10 +7,9 @@ gadgets-labels gadgets-theme gadgets-presentations
gadgets-buttons gadgets-borders gadgets-scrolling
gadgets-frames gadgets-workspace optimizer models ;
: shuffle-in dup shuffle-in-d swap shuffle-in-r append ;
: shuffle-out dup shuffle-out-d swap shuffle-out-r append ;
GENERIC: node>gadget ( height node -- gadget )
! Representation of shuffle nodes
TUPLE: shuffle-gadget value ;
: literal-theme ( shuffle -- )
@ -24,14 +23,17 @@ C: shuffle-gadget ( node -- gadget )
dup delegate>gadget ;
: shuffled-offsets ( shuffle -- seq )
dup shuffle-in swap shuffle-out [ swap index ] map-with ;
dup shuffle-in swap shuffle-out
[ swap index ] map-with ;
: shuffled-endpoints ( w seq seq -- seq )
[ [ 30 * 15 + ] 2apply >r dupd 2array 0 r> 2array 2array ]
2map nip ;
: shuffled-endpoints ( w h seq seq -- seq )
[ [ 30 * 15 + ] map ] 2apply
>r over r> [ - ] map-with >r [ - ] map-with r>
[ 0 swap 2array ] map >r [ 2array ] map-with r>
[ 2array ] 2map ;
: draw-shuffle ( gadget seq seq -- )
>r >r rect-dim first r> r> shuffled-endpoints
>r >r rect-dim first2 r> r> shuffled-endpoints
[ first2 gl-line ] each ;
M: shuffle-gadget draw-gadget*
@ -40,62 +42,60 @@ M: shuffle-gadget draw-gadget*
shuffled-offsets [ length ] keep
draw-shuffle ;
: shuffle-dim ( shuffle -- node )
: node-dim ( n -- dim ) 30 * 10 swap 2array ;
: shuffle-dim ( shuffle -- dim )
dup shuffle-in length swap shuffle-out length max
30 * 10 swap 2array ;
node-dim ;
M: shuffle-gadget pref-dim*
dup delegate pref-dim
swap shuffle-gadget-value shuffle-dim
vmax ;
shuffle-gadget-value shuffle-dim ;
TUPLE: height-gadget value skew ;
M: #shuffle node>gadget nip node-shuffle <shuffle-gadget> ;
C: height-gadget ( value skew -- gadget )
[ set-height-gadget-skew ] keep
! Stack height underneath a node
TUPLE: height-gadget value ;
C: height-gadget ( value -- gadget )
[ set-height-gadget-value ] keep
dup delegate>gadget ;
M: height-gadget pref-dim*
dup height-gadget-value swap height-gadget-skew abs +
30 * 10 swap 2array ;
: height-offsets ( value skew -- seq seq )
[ abs swap [ [ + ] map-with ] keep ] keep
0 < [ swap ] when ;
height-gadget-value node-dim ;
M: height-gadget draw-gadget*
{ 0 0 0 1 } gl-color
dup height-gadget-value over height-gadget-skew
height-offsets draw-shuffle ;
dup height-gadget-value dup draw-shuffle ;
TUPLE: node-gadget value ;
! Calls and pushes
TUPLE: node-gadget value height ;
C: node-gadget ( gadget node -- gadget )
C: node-gadget ( gadget node height -- gadget )
[ set-node-gadget-height ] keep
[ set-node-gadget-value ] keep
swap <default-border> over set-gadget-delegate ;
swap <default-border> over set-gadget-delegate
dup faint-boundary ;
M: node-gadget pref-dim*
dup delegate pref-dim
swap node-gadget-value node-shuffle shuffle-dim
vmax ;
GENERIC: node>gadget ( node -- gadget )
swap dup node-gadget-height [
node-dim
] [
node-gadget-value node-shuffle shuffle-dim
] ?if vmax ;
M: #call node>gadget
nip
[ node-param word-name <label> ] keep
[ <node-gadget> ] keep node-param <object-presentation>
[ f <node-gadget> ] keep node-param <object-presentation>
dup word-theme ;
M: #push node>gadget
[
nip [
>#push< [ literalize unparse ] map " " join <label>
] keep <node-gadget> dup literal-theme ;
M: #shuffle node>gadget node-shuffle <shuffle-gadget> ;
DEFER: dataflow.
] keep f <node-gadget> dup literal-theme ;
! #if #dispatch #label
: <child-nodes> ( seq -- seq )
[ length ] keep
[
@ -103,70 +103,69 @@ DEFER: dataflow.
<object-presentation>
] 2map ;
: default-node-content ( node -- gadget )
dup node-children <child-nodes>
swap class word-name <mono-label> add* make-pile
{ 5 5 } over set-pack-gap ;
M: object node>gadget
nip dup default-node-content swap f <node-gadget> ;
UNION: full-height-node #if #dispatch #label ;
M: full-height-node node>gadget
dup default-node-content swap rot <node-gadget> ;
! Constructing the graphical representation; first we compute
! stack heights
SYMBOL: d-height
: compute-child-heights ( node -- )
node-children dup empty? [
drop
] [
[
dup class word-name <label> ,
dup node-children <child-nodes> %
] { } make make-pile
{ 5 5 } over set-pack-gap
swap <node-gadget> dup faint-boundary ;
[ (compute-heights) d-height get ] { } make drop
] map supremum d-height set
] if ;
: (compute-heights) ( node -- )
[
[ node-d-height ] keep
[ node-r-height ] keep
[ 3array , ] keep
d-height get over 2array ,
dup compute-child-heights
dup node-out-d length over node-in-d length -
d-height [ + ] change
node-successor (compute-heights)
] when* ;
: node-in-d# node-in-d length ;
: node-out-d# node-out-d length ;
: node-in-r# node-in-r length ;
: node-out-r# node-out-r length ;
: normalize-d-height ( seq -- seq )
[ [ dup first swap third node-in-d# - ] map infimum ] keep
[ first3 >r >r swap - r> r> 3array ] map-with ;
: normalize-r-height ( seq -- seq )
[ [ dup second swap third node-in-r# - ] map infimum ] keep
[ first3 >r rot - r> 3array ] map-with ;
: normalize-height ( seq -- seq )
[
[ dup first swap second node-in-d length - ] map infimum
] keep
[ first2 >r swap - r> 2array ] map-with ;
: compute-heights ( nodes -- pairs )
[ (compute-heights) ] { } make
normalize-d-height normalize-r-height ;
[ 0 d-height set (compute-heights) ] { } make
normalize-height ;
: node-r-skew-1 ( node -- n )
dup node-out-d# over node-in-r# [-] swap node-in-d# [-] ;
: node-r-skew-2 ( node -- n )
dup node-in-d# over node-out-r# [-] swap node-out-d# [-] ;
SYMBOL: prev-node
: node-r-skew ( node -- n )
node-r-skew-1 prev-node get [ node-r-skew-2 - ] when* ;
: print-node ( d-height r-height node -- )
[
[
pick 0 <height-gadget> ,
2dup node-in-r# + over node-r-skew <height-gadget> ,
] { } make make-pile ,
[
rot over node-in-d# - 0 <height-gadget> ,
node>gadget ,
0 <height-gadget> ,
] { } make make-pile 1 over set-pack-fill ,
] keep prev-node set ;
! Then we create gadgets for every node
: print-node ( d-height node -- )
dup full-height-node? [
node>gadget
] [
[ node-in-d length - <height-gadget> ] 2keep
node>gadget swap 2array
make-pile 1 over set-pack-fill
] if , ;
: <dataflow-graph> ( node -- gadget )
prev-node off
compute-heights
[ [ first3 print-node ] each ] { } make
make-shelf ;
compute-heights [
dup empty? [ dup first first <height-gadget> , ] unless
[ first2 print-node ] each
] { } make
make-shelf 1 over set-pack-align ;
! The UI tool
TUPLE: dataflow-gadget history search ;
dataflow-gadget {

2
library/ui/tools/workspace.factor
View File

@ -63,7 +63,7 @@ workspace {
{ "Definitions" T{ key-down f f "F3" } [ browser select-tool ] }
{ "Documentation" T{ key-down f f "F4" } [ help-gadget select-tool ] }
{ "Walker" T{ key-down f f "F5" } [ walker-gadget select-tool ] }
{ "Dataflow" T{ key-down f f "F6" } [ walker-gadget select-tool ] }
{ "Dataflow" T{ key-down f f "F6" } [ dataflow-gadget select-tool ] }
}
{