From d6eb6f2c76a4fd56cd4573625ef77e241b71bc22 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 28 Nov 2016 04:13:58 +0100
Subject: [PATCH] compiler.crossref: better way to store the dependencies on
 words

---
 basis/compiler/crossref/crossref-docs.factor  |  4 ++++
 basis/compiler/crossref/crossref-tests.factor | 23 +++++++++++++++++--
 basis/compiler/crossref/crossref.factor       | 16 ++++++-------
 3 files changed, 32 insertions(+), 11 deletions(-)

diff --git a/basis/compiler/crossref/crossref-docs.factor b/basis/compiler/crossref/crossref-docs.factor
index 3eb9bcb965..6e77350b51 100644
--- a/basis/compiler/crossref/crossref-docs.factor
+++ b/basis/compiler/crossref/crossref-docs.factor
@@ -7,3 +7,7 @@ HELP: compiled-crossref
 HELP: load-dependencies
 { $values { "word" word } { "assoc" assoc } }
 { $description "Creates an assoc where keys are the words the word depends on and values are the dependency type." } ;
+
+HELP: store-dependencies
+{ $values { "word" word } { "assoc" assoc } }
+{ $description "Stores the dependencies in 'assoc' in the word attributes named \"effect-dependencies\", \"conditional-dependencies\" and \"definition-dependencies\"." } ;
diff --git a/basis/compiler/crossref/crossref-tests.factor b/basis/compiler/crossref/crossref-tests.factor
index 693d350aab..954c0b8938 100644
--- a/basis/compiler/crossref/crossref-tests.factor
+++ b/basis/compiler/crossref/crossref-tests.factor
@@ -1,5 +1,5 @@
-USING: compiler.crossref fry kernel namespaces sequences
-stack-checker.dependencies tools.test vocabs words ;
+USING: accessors assocs compiler.crossref fry kernel namespaces
+sequences stack-checker.dependencies tools.test vocabs words ;
 IN: compiler.crossref.tests
 
 ! Dependencies of all words should always be satisfied unless we're
@@ -51,3 +51,22 @@ IN: compiler.crossref.tests
 } [
     { 1 2 } { 3 4 } { 5 6 } join-dependencies
 ] unit-test
+
+! store-dependencies
+: setup-deps ( -- assoc )
+    H{
+        { 20 +definition+ }
+        { 30 +conditional+ }
+        { 40 +effect+ }
+        { 50 +effect+ }
+    } ;
+
+SYMBOL: foo
+{
+    { 20 } { 40 50 } { 30 }
+} [
+    foo [ setup-deps store-dependencies ] keep props>>
+    [ "definition-dependencies" of ]
+    [ "effect-dependencies" of ]
+    [ "conditional-dependencies" of ] tri
+] unit-test
diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor
index 733a978e20..88cfa01830 100644
--- a/basis/compiler/crossref/crossref.factor
+++ b/basis/compiler/crossref/crossref.factor
@@ -43,17 +43,15 @@ generic-call-site-crossref [ H{ } clone ] initialize
 : set-generic-call-sites ( word alist -- )
     concat f like "generic-call-sites" set-word-prop ;
 
-: split-dependencies ( assoc -- effect-deps cond-deps def-deps )
-    [ nip +effect+ eq? ] assoc-partition
-    [ nip +conditional+ eq? ] assoc-partition ;
-
-: (store-dependencies) ( word assoc prop -- )
-    [ keys f like ] dip set-word-prop ;
+: store-dependencies-of-type ( word assoc symbol prop-name -- )
+    [ rot '[ nip _ = ] assoc-filter keys ] dip set-word-prop ;
 
 : store-dependencies ( word assoc -- )
-    split-dependencies
-    "effect-dependencies" "conditional-dependencies" "definition-dependencies"
-    [ (store-dependencies) ] tri-curry@ tri-curry* tri ;
+    {
+        { +effect+ "effect-dependencies" }
+        { +conditional+ "conditional-dependencies" }
+        { +definition+ "definition-dependencies" }
+    } [ store-dependencies-of-type ] 2with assoc-each ;
 
 : add-xref ( word dependencies crossref -- )
     rot '[