From 36680369ba23865300dc2dade8c6cedb4e45c334 Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 16 Sep 2006 00:52:13 +0000 Subject: [PATCH] Dataflow UI improvements --- TODO.FACTOR.txt | 6 +- doc/handbook/tools.facts | 6 +- library/compiler/generator/generator.factor | 34 ++-- library/compiler/generator/templates.factor | 5 +- library/compiler/inference/dataflow.factor | 37 ++-- library/compiler/inference/shuffle.factor | 37 ++-- library/compiler/inference/stack.factor | 63 ++++--- .../compiler/optimizer/kill-literals.factor | 6 +- library/compiler/optimizer/optimizer.factor | 8 + library/ui/tools/dataflow.factor | 177 +++++++++--------- library/ui/tools/workspace.factor | 2 +- 11 files changed, 188 insertions(+), 193 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index baabea2b27..96ea3e91a8 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -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: diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts index 91936c9524..df072a3d32 100644 --- a/doc/handbook/tools.facts +++ b/doc/handbook/tools.facts @@ -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" diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 5928bc13ac..57d5cf2031 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -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 ; diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor index 38ce86fe8f..9bcc324465 100644 --- a/library/compiler/generator/templates.factor +++ b/library/compiler/generator/templates.factor @@ -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 diff --git a/library/compiler/inference/dataflow.factor b/library/compiler/inference/dataflow.factor index 98a166192b..d3d71690bd 100644 --- a/library/compiler/inference/dataflow.factor +++ b/library/compiler/inference/dataflow.factor @@ -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 ; : make-node ( param in-d out-d in-r out-r node -- node ) - [ - >r swapd f f f f f f f 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 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 ] [ diff --git a/library/compiler/inference/shuffle.factor b/library/compiler/inference/shuffle.factor index 84f043d870..cd5aa460ef 100644 --- a/library/compiler/inference/shuffle.factor +++ b/library/compiler/inference/shuffle.factor @@ -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-in clone ] keep shuffle-out clone ; diff --git a/library/compiler/inference/stack.factor b/library/compiler/inference/stack.factor index 9b3585b6d2..0e2b10fccc 100644 --- a/library/compiler/inference/stack.factor +++ b/library/compiler/inference/stack.factor @@ -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 ; + dup shuffle-in swap shuffle-out ; : 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 } { } "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 } "infer-effect" set-word-prop diff --git a/library/compiler/optimizer/kill-literals.factor b/library/compiler/optimizer/kill-literals.factor index 6cf9573335..1658f81b0c 100644 --- a/library/compiler/optimizer/kill-literals.factor +++ b/library/compiler/optimizer/kill-literals.factor @@ -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 { } ; diff --git a/library/compiler/optimizer/optimizer.factor b/library/compiler/optimizer/optimizer.factor index 2313642a6d..b7f28ce44e 100644 --- a/library/compiler/optimizer/optimizer.factor +++ b/library/compiler/optimizer/optimizer.factor @@ -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 ; diff --git a/library/ui/tools/dataflow.factor b/library/ui/tools/dataflow.factor index 4990fe2e2e..f86add4bf9 100644 --- a/library/ui/tools/dataflow.factor +++ b/library/ui/tools/dataflow.factor @@ -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 ; -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 over set-gadget-delegate ; + swap 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