From 4c5fb438a00b4eadc9484dd511311c0c8eed1b8b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 17 Jul 2012 11:00:38 -0700 Subject: [PATCH] graphs: simplify by removing temporary namespace variables. --- core/graphs/graphs-docs.factor | 3 --- core/graphs/graphs.factor | 41 +++++++++++----------------------- 2 files changed, 13 insertions(+), 31 deletions(-) diff --git a/core/graphs/graphs-docs.factor b/core/graphs/graphs-docs.factor index d14ccafdb9..830d864823 100644 --- a/core/graphs/graphs-docs.factor +++ b/core/graphs/graphs-docs.factor @@ -16,9 +16,6 @@ $nl ABOUT: "graphs" -HELP: graph -{ $var-description "Temporary variable used by various graph words." } ; - HELP: add-vertex { $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } } { $description "Adds a vertex to a directed graph, with " { $snippet "edges" } " as the outward edges from the vertex." } diff --git a/core/graphs/graphs.factor b/core/graphs/graphs.factor index fabe2afb4d..12cec9d55b 100644 --- a/core/graphs/graphs.factor +++ b/core/graphs/graphs.factor @@ -3,50 +3,35 @@ USING: assocs kernel namespaces sequences sets ; IN: graphs -SYMBOL: graph - : if-graph ( vertex edges graph quot -- ) - over - [ graph swap with-variable ] - [ 2drop 2drop ] if ; inline + dupd [ 3drop ] if ; inline -: nest ( key -- hash ) - graph get [ drop H{ } clone ] cache ; +: nest ( key graph -- hash ) + [ drop H{ } clone ] cache ; inline : add-vertex ( vertex edges graph -- ) - [ [ dupd nest set-at ] with each ] if-graph ; inline - -: (add-vertex) ( key value vertex -- ) - rot nest set-at ; + [ [ nest dupd set-at ] curry with each ] if-graph ; inline : add-vertex* ( vertex edges graph -- ) [ - swap [ (add-vertex) ] curry assoc-each + swapd [ [ rot ] dip nest set-at ] 2curry assoc-each ] if-graph ; inline : remove-vertex ( vertex edges graph -- ) - [ [ graph get at delete-at ] with each ] if-graph ; inline - -: (remove-vertex) ( key value vertex -- ) - rot graph get at delete-at drop ; + [ [ at delete-at ] curry with each ] if-graph ; inline : remove-vertex* ( vertex edges graph -- ) [ - swap [ (remove-vertex) ] curry assoc-each + swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each ] if-graph ; inline -SYMBOL: previous - -: (closure) ( obj quot: ( elt -- assoc ) -- ) - over previous get key? [ - 2drop +: (closure) ( obj assoc quot: ( elt -- assoc ) -- ) + 2over key? [ + 3drop ] [ - over previous get conjoin - [ call ] keep - [ nip (closure) ] curry assoc-each + 2over conjoin [ dip ] keep + [ [ drop ] 3dip (closure) ] 2curry assoc-each ] if ; inline recursive : closure ( obj quot -- assoc ) - H{ } clone [ - previous [ (closure) ] with-variable - ] keep ; inline + H{ } clone [ swap (closure) ] keep ; inline