From da7f10804afc99d03aeda9341de0df3e688d0b79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 20:27:09 -0500 Subject: [PATCH] Refactor vocab loader --- core/vocabs/loader/loader-tests.factor | 9 ++++ core/vocabs/loader/loader.factor | 59 ++++++++++++++------------ core/vocabs/vocabs.factor | 20 +++++---- extra/bootstrap/help/help.factor | 7 ++- extra/help/markup/markup.factor | 3 +- extra/tools/vocabs/vocabs.factor | 8 ++-- 6 files changed, 60 insertions(+), 46 deletions(-) diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 514e45f10f..015f54540d 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -78,6 +78,8 @@ IN: vocabs.loader.tests ] with-compilation-unit ] unit-test +[ f ] [ "vocabs.loader.test.b" vocab-files empty? ] unit-test + [ ] [ [ "vocabs.loader.test.b" vocab-files @@ -118,6 +120,13 @@ IN: vocabs.loader.tests [ { "resource:core/kernel/kernel.factor" 1 } ] [ "kernel" vocab where ] unit-test +[ ] [ + [ + "vocabs.loader.test.c" forget-vocab + "vocabs.loader.test.d" forget-vocab + ] with-compilation-unit +] unit-test + [ t ] [ [ "vocabs.loader.test.d" require ] [ :1 ] recover "vocabs.loader.test.d" vocab-source-loaded? diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index fa9ff5b504..96193ef664 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -43,7 +43,7 @@ V{ vocab-roots get swap [ vocab-dir? ] curry find nip ; M: string vocab-root - dup vocab [ vocab-root ] [ find-vocab-root ] ?if ; + vocab dup [ vocab-root ] when ; M: vocab-link vocab-root vocab-link-root ; @@ -66,24 +66,22 @@ SYMBOL: load-help? : load-docs ( vocab -- ) load-help? get [ [ docs-weren't-loaded ] keep - [ vocab-docs-path ?run-file ] keep + [ vocab-docs-path [ ?run-file ] when* ] keep docs-were-loaded ] [ drop ] if ; -: create-vocab-with-root ( vocab-link -- vocab ) - dup vocab-name create-vocab - swap vocab-root over set-vocab-root ; +: create-vocab-with-root ( name root -- vocab ) + swap create-vocab [ set-vocab-root ] keep ; + +: update-root ( vocab -- ) + dup vocab-root + [ drop ] [ dup find-vocab-root swap set-vocab-root ] if ; : reload ( name -- ) [ - f >vocab-link - dup vocab-root [ - dup vocab-source-path resource-exists? [ - create-vocab-with-root - dup load-source - load-docs - ] [ no-vocab ] if - ] [ no-vocab ] if + dup vocab [ + dup update-root dup load-source load-docs + ] [ no-vocab ] ?if ] with-compiler-errors ; : require ( vocab -- ) @@ -100,33 +98,38 @@ SYMBOL: load-help? SYMBOL: blacklist -GENERIC: (load-vocab) ( name -- vocab ) - : add-to-blacklist ( error vocab -- ) vocab-name blacklist get dup [ set-at ] [ 3drop ] if ; +GENERIC: (load-vocab) ( name -- ) + M: vocab (load-vocab) - [ - dup vocab-root [ + dup update-root + + dup vocab-root [ + [ dup vocab-source-loaded? [ dup load-source ] unless dup vocab-docs-loaded? [ dup load-docs ] unless - ] when - ] [ [ swap add-to-blacklist ] keep rethrow ] recover ; + ] [ [ swap add-to-blacklist ] keep rethrow ] recover + ] when drop ; M: string (load-vocab) - [ ".private" ?tail drop reload ] keep vocab ; + ! ".private" ?tail drop + dup find-vocab-root >vocab-link (load-vocab) ; M: vocab-link (load-vocab) - vocab-name (load-vocab) ; + dup vocab-name swap vocab-root dup + [ create-vocab-with-root (load-vocab) ] [ 2drop ] if ; [ - dup vocab-name blacklist get at* [ - rethrow - ] [ - drop - [ dup vocab swap or (load-vocab) ] with-compiler-errors - ] if - + [ + dup vocab-name blacklist get at* [ + rethrow + ] [ + drop + [ (load-vocab) ] with-compiler-errors + ] if + ] with-compiler-errors ] load-vocab-hook set-global : vocab-where ( vocab -- loc ) diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 1a3fecc3fb..9d281c864b 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -15,8 +15,8 @@ source-loaded? docs-loaded? ; M: vocab equal? 2drop f ; : ( name -- vocab ) - H{ } clone t - { set-vocab-name set-vocab-words set-vocab-source-loaded? } + H{ } clone + { set-vocab-name set-vocab-words } \ vocab construct ; GENERIC: vocab ( vocab-spec -- vocab ) @@ -60,9 +60,16 @@ M: f vocab-help ; : create-vocab ( name -- vocab ) dictionary get [ ] cache ; -SYMBOL: load-vocab-hook +TUPLE: no-vocab name ; -: load-vocab ( name -- vocab ) load-vocab-hook get call ; +: no-vocab ( name -- * ) + vocab-name \ no-vocab construct-boa throw ; + +SYMBOL: load-vocab-hook ! ( name -- ) + +: load-vocab ( name -- vocab ) + dup load-vocab-hook get call + dup vocab [ ] [ no-vocab ] ?if ; : vocabs ( -- seq ) dictionary get keys natural-sort ; @@ -115,8 +122,3 @@ UNION: vocab-spec vocab vocab-link ; vocab-name dictionary get delete-at ; M: vocab-spec forget* forget-vocab ; - -TUPLE: no-vocab name ; - -: no-vocab ( name -- * ) - vocab-name \ no-vocab construct-boa throw ; diff --git a/extra/bootstrap/help/help.factor b/extra/bootstrap/help/help.factor index 1680278fad..4326fcf61b 100755 --- a/extra/bootstrap/help/help.factor +++ b/extra/bootstrap/help/help.factor @@ -9,11 +9,10 @@ IN: bootstrap.help t load-help? set-global - [ vocab ] load-vocab-hook [ + [ drop ] load-vocab-hook [ vocabs - [ vocab-root ] subset - [ vocab-source-loaded? ] subset - [ dup vocab-docs-loaded? [ drop ] [ load-docs ] if ] each + [ vocab-docs-loaded? not ] subset + [ load-docs ] each ] with-variable ; load-help diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index 710671857e..7cfe384bde 100755 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -158,7 +158,8 @@ M: f print-element drop ; : $subsection ( element -- ) [ first ($long-link) ] ($subsection) ; -: ($vocab-link) ( text vocab -- ) f >vocab-link write-link ; +: ($vocab-link) ( text vocab -- ) + dup vocab-root >vocab-link write-link ; : $vocab-subsection ( element -- ) [ diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index 675a2e1d6e..82c411cbfb 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -19,16 +19,16 @@ IN: tools.vocabs ] [ drop ] if ; : vocab-tests ( vocab -- tests ) - dup vocab-root [ + dup vocab-root dup [ [ - f >vocab-link dup + >vocab-link dup vocab-tests-file, vocab-tests-dir, ] { } make - ] [ drop f ] if ; + ] [ 2drop f ] if ; : vocab-files ( vocab -- seq ) - f >vocab-link [ + dup find-vocab-root >vocab-link [ dup vocab-source-path [ , ] when* dup vocab-docs-path [ , ] when* vocab-tests %