diff --git a/core/flow-chart/flow-chart.factor b/core/flow-chart/flow-chart.factor new file mode 100644 index 0000000000..5b6cb5f4f5 --- /dev/null +++ b/core/flow-chart/flow-chart.factor @@ -0,0 +1,74 @@ +USING: kernel words math inference.dataflow sequences +optimizer.def-use combinators.private namespaces arrays +math.parser assocs prettyprint io strings inference hashtables ; +IN: flow-chart + +GENERIC: flow-chart* ( n word -- value nodes ) + +M: word flow-chart* + 2drop f f ; + +M: compound flow-chart* + word-def swap 1+ [ drop ] map + [ dataflow-with compute-def-use ] keep + first dup used-by prune [ t eq? not ] subset ; + +GENERIC: node-word ( node -- word ) + +M: #call node-word node-param ; + +M: #if node-word drop \ if ; + +M: #dispatch node-word drop \ dispatch ; + +DEFER: flow-chart + +: flow-chart-node ( value node -- ) + [ node-in-d index ] keep + node-word flow-chart , ; + +SYMBOL: pruned + +SYMBOL: nesting + +SYMBOL: max-nesting + +2 max-nesting set + +: flow-chart ( n word -- seq ) + [ + 2dup 2array , + nesting dup inc get max-nesting get > [ + 2drop pruned , + ] [ + flow-chart* dup length 5 > [ + 2drop pruned , + ] [ + [ flow-chart-node ] curry* each + ] if + ] if + ] { } make ; + +: th ( n -- ) + dup number>string write + 100 mod dup 20 > [ 10 mod ] when + H{ { 1 "st" } { 2 "nd" } { 3 "rd" } } at "th" or write ; + +: chart-heading. ( pair -- ) + first2 >r 1+ th " argument to " write r> . ; + +GENERIC# show-chart 1 ( seq n -- ) + +: indent CHAR: \s write ; + +M: sequence show-chart + dup indent + >r unclip chart-heading. r> + 2 + [ show-chart ] curry each ; + +M: word show-chart + dup indent + "... pruned" print ; + +: flow-chart. ( n word -- ) + flow-chart 2 show-chart ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index e9dc4f3e55..a7a112b58a 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -145,7 +145,7 @@ SYMBOL: load-help? : update-roots ( vocabs -- ) [ dup find-vocab-root swap vocab set-vocab-root ] each ; -: to-refresh ( prefix -- seq ) +: to-refresh ( prefix -- modified-sources modified-docs ) child-vocabs dup update-roots dup modified-sources swap modified-docs ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 61a6f706f6..45da3bf1c7 100644 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -1,36 +1,13 @@ USING: io io.launcher io.unix.backend io.nonblocking sequences kernel namespaces math system alien.c-types -debugger continuations combinators.lib threads ; +debugger continuations ; IN: io.unix.launcher ! Search unix first USE: unix -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Factor friendly versions of the exec functions - -: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ; - -: execv* ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ; -: execvp* ( filename argv -- int ) [ malloc-char-string ] [ >argv ] bi* execvp ; - -: execve* ( pathname argv envp -- int ) - [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Wait for a pid to finish without freezing up all the Factor threads. -! Need to find a less kludgy way to do this. - -: wait-for-pid ( pid -- ) - dup "int" WNOHANG waitpid - 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : with-fork ( child parent -- pid ) fork [ zero? -rot if ] keep ; inline