calendar: change >gmt, >local-time to clone.

[factor.git] / core / vocabs / parser / parser.factor

diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor
index 9cf97f2fd5eb400827c9c4ba5cfae7e10596b677..cec44020512964b0acb6b65607fd96efa5227dd2 100644 (file)
--- a/core/vocabs/parser/parser.factor
+++ b/core/vocabs/parser/parser.factor
@@ -175,6 +175,9 @@ TUPLE: rename word vocab words ;
 : unuse-words ( assoc -- )
     <extra-words> qualified-vocabs remove! drop ;
 
+: with-words ( assoc quot -- )
+    '[ use-words @ ] over '[ _ unuse-words ] finally ; inline
+
 TUPLE: ambiguous-use-error name words ;
 
 : <ambiguous-use-error> ( name words -- error restarts )
@@ -182,17 +185,24 @@ TUPLE: ambiguous-use-error name words ;
 
 <PRIVATE
 
+: (lookup-word) ( words name vocab -- words )
+    words>> (lookup) [ suffix! ] when* ; inline
+
 : (vocab-search) ( name assocs -- words )
-    [ words>> (lookup) ] with map sift ;
+    [ V{ } clone ] 2dip [ (lookup-word) ] with each ;
 
-: (vocab-search-qualified) ( name assocs -- words )
-    [ ":" split1 swap ] dip [ name>> = ] with filter (vocab-search) ;
+: (vocab-search-qualified) ( words name assocs -- words )
+    [ ":" split1 swap ] dip pick [
+        [ name>> = ] with find nip [ (lookup-word) ] with when*
+    ] [
+        3drop
+    ] if ;
 
 : (vocab-search-full) ( name assocs -- words )
-    [ (vocab-search-qualified) ] [ (vocab-search) ] 2bi append ;
+    [ (vocab-search) ] [ (vocab-search-qualified) ] 2bi ;
 
 : vocab-search ( name manifest -- word/f )
-    dupd search-vocabs>> sift (vocab-search-full) dup length {
+    dupd search-vocabs>> (vocab-search-full) dup length {
         { 0 [ 2drop f ] }
         { 1 [ first nip ] }
         [
@@ -264,7 +274,6 @@ PRIVATE>
         [ call ] [
             [ manifest get add-definition-observer call ]
             [ manifest get remove-definition-observer ]
-            [ ]
-            cleanup
+            finally
         ] if-bootstrapping
     ] with-variable ; inline