From 099ffa1f5e436e1b1a84b87e835639742670ea9c Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-224-36.res.carleton.edu>
Date: Sun, 18 Apr 2010 14:08:21 -0500
Subject: [PATCH] Fixing require-when

---
 core/vocabs/loader/loader.factor | 46 +++++++++++++-------------------
 core/vocabs/vocabs.factor        | 38 +-------------------------
 2 files changed, 20 insertions(+), 64 deletions(-)

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 4e811d8914..b09ba8c2bc 100644
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -66,18 +66,19 @@ DEFER: require
 
 <PRIVATE
 
-: transfer-conditionals ( vocab-name record -- )
-    {
-        [ unloaded>> delete ]
-        [ loaded>> adjoin ]
-        [ swap partly-required get adjoin-at ]
-        [ unloaded>> null? swap '[ _ require ] when ]
-    } 2cleave ;
+SYMBOL: require-when-vocabs
+require-when-vocabs [ HS{ } clone ] initialize
 
-: load-conditional-requires ( vocab-name -- )
-    conditional-requires get
-    [ dupd at members [ transfer-conditionals ] with each ] 
-    [ delete-at ] 2bi ;
+SYMBOL: require-when-table
+require-when-table [ V{ } clone ] initialize
+
+: load-conditional-requires ( vocab -- )
+    vocab-name require-when-vocabs get in? [
+        require-when-table get [
+            [ [ vocab ] all? ] dip
+            '[ _ require ] when
+        ] assoc-each
+    ] when ;
 
 : load-source ( vocab -- )
     dup check-vocab-hook get call( vocab -- )
@@ -87,7 +88,7 @@ DEFER: require
         [ +parsing+ >>source-loaded? ] dip
         [ % ] [ call( -- ) ] if-bootstrapping
         +done+ >>source-loaded?
-        vocab-name load-conditional-requires
+        load-conditional-requires
     ] [ ] [ f >>source-loaded? ] cleanup ;
 
 : load-docs ( vocab -- )
@@ -104,22 +105,13 @@ PRIVATE>
 : require ( vocab -- )
     load-vocab drop ;
 
-<PRIVATE
-
-: adjoin-each-at ( elt seq assoc -- )
-    [ swap ] dip '[ _ swap _ adjoin-at ] each ;
-
-: record-require-when ( then loaded unloaded -- )
-    [ [ fast-set ] bi@ <require-when-record> ] 2keep
-    [ conditional-requires get adjoin-each-at ]
-    [ partly-required get adjoin-each-at ]
-    bi-curry* bi ;
-
-PRIVATE>
-
 : require-when ( if then -- )
-    swap [ vocab ] partition
-    [ drop require ] [ record-require-when ] if-empty ;
+    over [ vocab ] all? [
+        require drop
+    ] [
+        [ drop [ require-when-vocabs get adjoin ] each ]
+        [ 2array require-when-table get push ] 2bi
+    ] if ;
 
 : reload ( name -- )
     dup vocab
diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index db28c9981b..38881673e9 100644
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -83,25 +83,6 @@ ERROR: bad-vocab-name name ;
 : check-vocab-name ( name -- name )
     dup string? [ bad-vocab-name ] unless ;
 
-TUPLE: require-when-record
-    vocab loaded unloaded ;
-
-! These are identified by their vocab
-M: require-when-record equal?
-    over require-when-record?
-    [ [ vocab>> ] bi@ = ] [ 2drop f ] if ;
-
-M: require-when-record hashcode*
-    vocab>> hashcode* ;
-
-C: <require-when-record> require-when-record
-
-SYMBOL: conditional-requires
-conditional-requires [ H{ } clone ] initialize
-
-SYMBOL: partly-required
-partly-required [ H{ } clone ] initialize
-
 : create-vocab ( name -- vocab )
     check-vocab-name
     dictionary get [ <vocab> ] cache
@@ -136,26 +117,9 @@ M: vocab-spec >vocab-link ;
 
 M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
 
-<PRIVATE
-
-: untransfer-conditionals ( vocab-name record -- )
-    {
-        [ loaded>> delete ]
-        [ unloaded>> adjoin ]
-        [ swap conditional-requires get adjoin-at ]
-    } 2cleave ;
-
-: unload-conditional-requires ( vocab-name -- )
-    partly-required get
-    [ dupd at members [ untransfer-conditionals ] with each ] 
-    [ delete-at ] 2bi ;
-
-PRIVATE>
-
 : forget-vocab ( vocab -- )
     [ words forget-all ]
-    [ vocab-name dictionary get delete-at ]
-    [ unload-conditional-requires ] tri
+    [ vocab-name dictionary get delete-at ] bi
     notify-vocab-observers ;
 
 M: vocab-spec forget* forget-vocab ;