Add absolute-path to normalize any new root path. E.G. permit ~user

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

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index a9e6fde666efba65e7c5b610be2e4b8f909a6a75..b9cea071a353d00363b407a839467a872dadb377 100644 (file)
--- a/core/vocabs/loader/loader.factor
+++ b/core/vocabs/loader/loader.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2010 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators continuations
-definitions init io io.files io.pathnames kernel make namespaces
+definitions io io.files io.pathnames kernel make namespaces
 parser sequences sets splitting strings vocabs words ;
 IN: vocabs.loader
 
@@ -16,14 +16,13 @@ CONSTANT: default-vocab-roots {
     "resource:work"
 }
 
-[
+STARTUP-HOOK: [
     default-vocab-roots V{ } like vocab-roots set-global
-
     [ drop ] add-vocab-root-hook set-global
-] "vocabs.loader" add-startup-hook
+]
 
 : add-vocab-root ( root -- )
-    trim-tail-separators dup vocab-roots get ?adjoin
+    absolute-path trim-tail-separators dup vocab-roots get ?adjoin
     [ add-vocab-root-hook get-global call( root -- ) ] [ drop ] if ;
 
 SYMBOL: root-cache
@@ -44,15 +43,20 @@ ERROR: not-found-in-roots path ;
     [ drop not-found-in-roots ]
     [ nip ] if ;
 
+! If path exists use it, otherwise try to find a vocab that exists
 M: string vocab-path
-    {
-        { [ dup ?last path-separator? ] [ find-root-for-vocab-pathname ] }
-        { [ dup has-file-extension? ] [
-            [ ensure-parent-directory-is-not-dot find-root-for-vocab-pathname ]
-            [ file-name ] bi append-path
-        ] }
-        [ find-root-for-vocab-pathname ]
-    } cond ;
+    dup find-root-for [
+        prepend-path
+    ] [
+        {
+            { [ dup ?last path-separator? ] [ find-root-for-vocab-pathname ] }
+            { [ dup has-file-extension? ] [
+                [ ensure-parent-directory-is-not-dot find-root-for-vocab-pathname ]
+                [ file-name ] bi append-path
+            ] }
+            [ find-root-for-vocab-pathname ]
+        } cond
+    ] if* ;
 
 PRIVATE>
 
@@ -139,10 +143,9 @@ PRIVATE>
     ] if ;
 
 : reload ( name -- )
-    dup lookup-vocab
-    [ [ load-source ] [ load-docs ] bi ]
-    [ require ]
-    ?if ;
+    dup lookup-vocab [
+        f >>source-loaded? f >>docs-loaded? drop
+    ] when* require ;
 
 : run ( vocab -- )
     dup load-vocab vocab-main [
@@ -153,30 +156,15 @@ PRIVATE>
         "To define one, refer to \\ MAIN: help" print
     ] ?if ;
 
-SYMBOL: errorlist
-
 <PRIVATE
 
-: add-to-errorlist ( error vocab -- )
-    vocab-name errorlist get [ set-at ] [ 2drop ] if* ;
-
-: remove-from-errorlist ( vocab -- )
-    vocab-name errorlist get [ delete-at ] [ drop ] if* ;
-
 GENERIC: (require) ( name -- )
 
 M: vocab (require)
-    [
-        [
-            dup source-loaded?>> +parsing+ eq? [ drop ] [
-                dup source-loaded?>> [ dup load-source ] unless
-                dup docs-loaded?>> [ dup load-docs ] unless
-                drop
-            ] if
-        ] [
-            remove-from-errorlist
-        ] bi
-    ] [ [ swap add-to-errorlist ] keep rethrow ] recover ;
+    dup source-loaded?>> +parsing+ eq? [
+        dup source-loaded?>> [ dup load-source ] unless
+        dup docs-loaded?>> [ dup load-docs ] unless
+    ] unless drop ;
 
 M: vocab-link (require)
     vocab-name (require) ;
@@ -187,18 +175,11 @@ M: string (require)
 
 PRIVATE>
 
-: require-all ( vocabs -- )
-    V{ } clone errorlist [ [ require ] each ] with-variable ;
-
 [
-    dup vocab-name errorlist get at*
-    [ rethrow ]
-    [
-        drop dup find-vocab-root
-        [ (require) ]
-        [ dup lookup-vocab [ drop ] [ no-vocab ] if ]
-        if
-    ] if
+    dup find-vocab-root
+    [ (require) ]
+    [ dup lookup-vocab [ drop ] [ no-vocab ] if ]
+    if
 ] require-hook set-global
 
 M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;