From cdcc1012706dd59264b78ee279a8f8970d715759 Mon Sep 17 00:00:00 2001
From: Alex Chapman <chapman.alex@gmail.com>
Date: Sat, 8 Mar 2008 10:05:33 +1100
Subject: [PATCH] digraphs and hooks

---
 extra/digraphs/digraphs.factor |  5 +++++
 extra/hooks/hooks-tests.factor | 14 ++++++++++++++
 extra/hooks/hooks.factor       | 28 ++++++++++++++++++++++++++++
 3 files changed, 47 insertions(+)
 create mode 100644 extra/hooks/hooks-tests.factor
 create mode 100644 extra/hooks/hooks.factor

diff --git a/extra/digraphs/digraphs.factor b/extra/digraphs/digraphs.factor
index 87dc766a29..5c6fa9b2a1 100644
--- a/extra/digraphs/digraphs.factor
+++ b/extra/digraphs/digraphs.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel new-slots sequences vectors ;
 IN: digraphs
 
@@ -43,3 +45,6 @@ DEFER: (topological-sort)
 : topological-sort ( digraph -- seq )
     dup clone V{ } clone spin
     [ drop (topological-sort) ] assoc-each drop reverse ;
+
+: topological-sorted-values ( digraph -- seq )
+    dup topological-sort swap [ at value>> ] curry map ;
diff --git a/extra/hooks/hooks-tests.factor b/extra/hooks/hooks-tests.factor
new file mode 100644
index 0000000000..683109f795
--- /dev/null
+++ b/extra/hooks/hooks-tests.factor
@@ -0,0 +1,14 @@
+USING: hooks kernel tools.test ;
+IN: hooks.tests
+
+SYMBOL: test-hook
+test-hook reset-hook
+: add-test-hook test-hook add-hook ;
+[ ] [ test-hook call-hook ] unit-test
+[ "op called" ] [ "op" [ "op called" ] add-test-hook test-hook call-hook ] unit-test
+[ "first called" "second called" ] [
+    test-hook reset-hook
+    "second op" [ "second called" ] add-test-hook
+    "first op" [ "first called" ] add-test-hook
+    test-hook call-hook
+] unit-test
diff --git a/extra/hooks/hooks.factor b/extra/hooks/hooks.factor
new file mode 100644
index 0000000000..65e310f268
--- /dev/null
+++ b/extra/hooks/hooks.factor
@@ -0,0 +1,28 @@
+! Copyright (C) 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs digraphs kernel namespaces sequences ;
+IN: hooks
+
+: hooks ( -- hooks )
+    \ hooks global [ drop H{ } clone ] cache ;
+
+: hook-graph ( hook -- graph )
+    hooks [ drop <digraph> ] cache ;
+
+: reset-hook ( hook -- )
+    <digraph> swap hooks set-at ;
+
+: add-hook ( key quot hook -- )
+    #! hook should be a symbol. Note that symbols with the same name but
+    #! different vocab are not equal
+    hook-graph add-vertex ; 
+
+: before ( key1 key2 hook -- )
+    hook-graph add-edge ;
+
+: after ( key1 key2 hook -- )
+    swapd before ;
+
+: call-hook ( hook -- )
+    hook-graph topological-sorted-values [ call ] each ;
+