steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Simplify vocab.loader even further

db4
Slava Pestov 2008-03-19 14:39:08 -05:00
parent 3d43c0350e
commit 3591ed402d
10 changed files with 69 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/bootstrap/primitives.factor
View File

@ -30,6 +30,7 @@ crossref off
"syntax" vocab vocab-words bootstrap-syntax set "syntax" vocab vocab-words bootstrap-syntax set
H{ } clone dictionary set H{ } clone dictionary set
H{ } clone changed-words set H{ } clone changed-words set
H{ } clone root-cache set
! Trivial recompile hook. We don't want to touch the code heap ! Trivial recompile hook. We don't want to touch the code heap
! during stage1 bootstrap, it would just waste time. ! during stage1 bootstrap, it would just waste time.

2
core/vocabs/loader/loader-docs.factor
View File

@ -43,8 +43,6 @@ HELP: find-vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } } { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
{ $description "Searches for a vocabulary in the vocabulary roots." } ; { $description "Searches for a vocabulary in the vocabulary roots." } ;
{ vocab-root find-vocab-root } related-words
HELP: no-vocab HELP: no-vocab
{ $values { "name" "a vocabulary name" } } { $values { "name" "a vocabulary name" } }
{ $description "Throws a " { $link no-vocab } "." } { $description "Throws a " { $link no-vocab } "." }

10
core/vocabs/loader/loader-tests.factor
View File

@ -13,15 +13,15 @@ debugger compiler.units tools.vocabs ;
] unit-test ] unit-test
[ T{ vocab-link f "vocabs.loader.test" } ] [ T{ vocab-link f "vocabs.loader.test" } ]
[ "vocabs.loader.test" f >vocab-link ] unit-test [ "vocabs.loader.test" >vocab-link ] unit-test
[ t ] [ t ]
[ "kernel" f >vocab-link "kernel" vocab = ] unit-test [ "kernel" >vocab-link "kernel" vocab = ] unit-test
[ t ] [ [ t ] [
"kernel" vocab-files "kernel" vocab-files
"kernel" vocab vocab-files "kernel" vocab vocab-files
"kernel" f <vocab-link> vocab-files "kernel" <vocab-link> vocab-files
3array all-equal? 3array all-equal?
] unit-test ] unit-test
@ -36,7 +36,7 @@ IN: vocabs.loader.tests
[ { 3 3 3 } ] [ [ { 3 3 3 } ] [
"vocabs.loader.test.2" run "vocabs.loader.test.2" run
"vocabs.loader.test.2" vocab run "vocabs.loader.test.2" vocab run
"vocabs.loader.test.2" f <vocab-link> run "vocabs.loader.test.2" <vocab-link> run
3array 3array
] unit-test ] unit-test
@ -115,7 +115,7 @@ IN: vocabs.loader.tests
[ 3 ] [ "count-me" get-global ] unit-test [ 3 ] [ "count-me" get-global ] unit-test
[ { "resource:core/kernel/kernel.factor" 1 } ] [ { "resource:core/kernel/kernel.factor" 1 } ]
[ "kernel" f <vocab-link> where ] unit-test [ "kernel" <vocab-link> where ] unit-test
[ { "resource:core/kernel/kernel.factor" 1 } ] [ { "resource:core/kernel/kernel.factor" 1 } ]
[ "kernel" vocab where ] unit-test [ "kernel" vocab where ] unit-test

64
core/vocabs/loader/loader.factor
View File

@ -23,15 +23,6 @@ V{
[ >r dup peek r> append add ] when* [ >r dup peek r> append add ] when*
"/" join ; "/" join ;
: vocab-path+ ( vocab path -- newpath )
swap vocab-root dup [ swap path+ ] [ 2drop f ] if ;
: vocab-source-path ( vocab -- path/f )
dup ".factor" vocab-dir+ vocab-path+ ;
: vocab-docs-path ( vocab -- path/f )
dup "-docs.factor" vocab-dir+ vocab-path+ ;
: vocab-dir? ( root name -- ? ) : vocab-dir? ( root name -- ? )
over [ over [
".factor" vocab-dir+ path+ resource-exists? ".factor" vocab-dir+ path+ resource-exists?
@ -39,14 +30,23 @@ V{
2drop f 2drop f
] if ; ] if ;
SYMBOL: root-cache
H{ } clone root-cache set-global
: find-vocab-root ( vocab -- path/f ) : find-vocab-root ( vocab -- path/f )
vocab-roots get swap [ vocab-dir? ] curry find nip ; vocab-name root-cache get [
vocab-roots get swap [ vocab-dir? ] curry find nip
] cache ;
M: string vocab-root : vocab-path+ ( vocab path -- newpath )
vocab dup [ vocab-root ] when ; swap find-vocab-root dup [ swap path+ ] [ 2drop f ] if ;
M: vocab-link vocab-root : vocab-source-path ( vocab -- path/f )
vocab-link-root ; dup ".factor" vocab-dir+ vocab-path+ ;
: vocab-docs-path ( vocab -- path/f )
dup "-docs.factor" vocab-dir+ vocab-path+ ;
SYMBOL: load-help? SYMBOL: load-help?
@ -56,7 +56,7 @@ SYMBOL: load-help?
: load-source ( vocab -- ) : load-source ( vocab -- )
[ source-wasn't-loaded ] keep [ source-wasn't-loaded ] keep
[ vocab-source-path bootstrap-file ] keep [ vocab-source-path [ bootstrap-file ] when* ] keep
source-was-loaded ; source-was-loaded ;
: docs-were-loaded t swap set-vocab-docs-loaded? ; : docs-were-loaded t swap set-vocab-docs-loaded? ;
@ -70,18 +70,9 @@ SYMBOL: load-help?
docs-were-loaded docs-were-loaded
] [ drop ] if ; ] [ drop ] if ;
: 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 -- ) : reload ( name -- )
[ [
dup vocab [ dup vocab [ dup load-source load-docs ] [ no-vocab ] ?if
dup update-root dup load-source load-docs
] [ no-vocab ] ?if
] with-compiler-errors ; ] with-compiler-errors ;
: require ( vocab -- ) : require ( vocab -- )
@ -104,22 +95,17 @@ SYMBOL: blacklist
GENERIC: (load-vocab) ( name -- ) GENERIC: (load-vocab) ( name -- )
M: vocab (load-vocab) M: vocab (load-vocab)
dup update-root [
dup vocab-source-loaded? [ dup load-source ] unless
dup vocab-root [ dup vocab-docs-loaded? [ dup load-docs ] unless
[ drop
dup vocab-source-loaded? [ dup load-source ] unless ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
dup vocab-docs-loaded? [ dup load-docs ] unless
] [ [ swap add-to-blacklist ] keep rethrow ] recover
] when drop ;
M: string (load-vocab)
! ".private" ?tail drop
dup find-vocab-root >vocab-link (load-vocab) ;
M: vocab-link (load-vocab) M: vocab-link (load-vocab)
dup vocab-name swap vocab-root dup vocab-name create-vocab (load-vocab) ;
[ create-vocab-with-root (load-vocab) ] [ 2drop ] if ;
M: string (load-vocab)
create-vocab (load-vocab) ;
[ [
[ [

9
core/vocabs/vocabs-docs.factor
View File

@ -16,7 +16,6 @@ $nl
{ $subsection vocab } { $subsection vocab }
"Accessors for various vocabulary attributes:" "Accessors for various vocabulary attributes:"
{ $subsection vocab-name } { $subsection vocab-name }
{ $subsection vocab-root }
{ $subsection vocab-main } { $subsection vocab-main }
{ $subsection vocab-help } { $subsection vocab-help }
"Looking up existing vocabularies and creating new vocabularies:" "Looking up existing vocabularies and creating new vocabularies:"
@ -50,10 +49,6 @@ HELP: vocab-name
{ $values { "vocab" "a vocabulary specifier" } { "name" string } } { $values { "vocab" "a vocabulary specifier" } { "name" string } }
{ $description "Outputs the name of a vocabulary." } ; { $description "Outputs the name of a vocabulary." } ;
HELP: vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "root" "a pathname string or " { $link f } } }
{ $description "Outputs the vocabulary root where the source code for a vocabulary is located, or " { $link f } " if the vocabulary is not defined in source files." } ;
HELP: vocab-words HELP: vocab-words
{ $values { "vocab" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } } { $values { "vocab" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
{ $description "Outputs the words defined in a vocabulary." } ; { $description "Outputs the words defined in a vocabulary." } ;
@ -101,11 +96,11 @@ HELP: child-vocabs
} ; } ;
HELP: vocab-link HELP: vocab-link
{ $class-description "Instances of this class identify vocabularies which are potentially not loaded. The " { $link vocab-name } " slot is the vocabulary name, and " { $link vocab-root } " is a pathname string identifying the vocabulary root where the sources to this vocabulary are located, or " { $link f } " if the root is not known." { $class-description "Instances of this class identify vocabularies which are potentially not loaded. The " { $link vocab-name } " slot is the vocabulary name."
$nl $nl
"Vocabulary links are created by calling " { $link >vocab-link } "." "Vocabulary links are created by calling " { $link >vocab-link } "."
} ; } ;
HELP: >vocab-link HELP: >vocab-link
{ $values { "name" string } { "root" "a pathname string or " { $link f } } { "vocab" "a vocabulary specifier" } } { $values { "name" string } { "vocab" "a vocabulary specifier" } }
{ $description "If the vocabulary is loaded, outputs the corresponding " { $link vocab } " instance, otherwise creates a new " { $link vocab-link } "." } ; { $description "If the vocabulary is loaded, outputs the corresponding " { $link vocab } " instance, otherwise creates a new " { $link vocab-link } "." } ;

21
core/vocabs/vocabs.factor
View File

@ -92,10 +92,10 @@ SYMBOL: load-vocab-hook ! ( name -- )
: child-vocabs ( vocab -- seq ) : child-vocabs ( vocab -- seq )
vocab-name vocabs [ child-vocab? ] with subset ; vocab-name vocabs [ child-vocab? ] with subset ;
TUPLE: vocab-link name root ; TUPLE: vocab-link name ;
: <vocab-link> ( name root -- vocab-link ) : <vocab-link> ( name -- vocab-link )
[ dup vocab-root ] unless* vocab-link construct-boa ; vocab-link construct-boa ;
M: vocab-link equal? M: vocab-link equal?
over vocab-link? over vocab-link?
@ -106,17 +106,14 @@ M: vocab-link hashcode*
M: vocab-link vocab-name vocab-link-name ; M: vocab-link vocab-name vocab-link-name ;
GENERIC# >vocab-link 1 ( name root -- vocab )
M: vocab >vocab-link drop ;
M: vocab-link >vocab-link drop ;
M: string >vocab-link
over vocab dup [ 2nip ] [ drop <vocab-link> ] if ;
UNION: vocab-spec vocab vocab-link ; UNION: vocab-spec vocab vocab-link ;
GENERIC: >vocab-link ( name -- vocab )
M: vocab-spec >vocab-link ;
M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
: forget-vocab ( vocab -- ) : forget-vocab ( vocab -- )
dup words forget-all dup words forget-all
vocab-name dictionary get delete-at ; vocab-name dictionary get delete-at ;

2
extra/help/markup/markup.factor
View File

@ -159,7 +159,7 @@ M: f print-element drop ;
[ first ($long-link) ] ($subsection) ; [ first ($long-link) ] ($subsection) ;
: ($vocab-link) ( text vocab -- ) : ($vocab-link) ( text vocab -- )
dup vocab-root >vocab-link write-link ; >vocab-link write-link ;
: $vocab-subsection ( element -- ) : $vocab-subsection ( element -- )
[ [

4
extra/tools/deploy/deploy-tests.factor
View File

@ -26,6 +26,10 @@ tools.deploy.backend math sequences io.launcher arrays ;
[ ] [ "hello-ui" shake-and-bake ] unit-test [ ] [ "hello-ui" shake-and-bake ] unit-test
[ "staging.math-compiler-ui-strip.image" ] [
"hello-ui" deploy-config [ staging-image-name ] bind
] unit-test
[ t ] [ [ t ] [
2000000 small-enough? 2000000 small-enough?
] unit-test ] unit-test

2
extra/tools/vocabs/browser/browser.factor
View File

@ -127,7 +127,7 @@ C: <vocab-author> vocab-author
: $describe-vocab ( element -- ) : $describe-vocab ( element -- )
first first
dup describe-children dup describe-children
dup vocab-root over vocab-dir? [ dup find-vocab-root [
dup describe-summary dup describe-summary
dup describe-tags dup describe-tags
dup describe-authors dup describe-authors

48
extra/tools/vocabs/vocabs.factor
View File

@ -6,29 +6,27 @@ memoize inspector sorting splitting combinators source-files
io debugger continuations compiler.errors init io.crc32 ; io debugger continuations compiler.errors init io.crc32 ;
IN: tools.vocabs IN: tools.vocabs
: vocab-tests-file, ( vocab -- ) : vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-path+ dup "-tests.factor" vocab-dir+ vocab-path+ dup
dup resource-exists? [ , ] [ drop ] if ; [ dup resource-exists? [ drop f ] unless ] [ drop f ] if ;
: vocab-tests-dir, ( vocab -- ) : vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" path+ vocab-path+ dup vocab-dir "tests" path+ vocab-path+ dup [
dup resource-exists? [ dup resource-exists? [
dup ?resource-path directory keys dup ?resource-path directory keys
[ ".factor" tail? ] subset [ ".factor" tail? ] subset
[ path+ , ] with each [ path+ ] with map
] [ drop ] if ; ] [ drop f ] if
] [ drop f ] if ;
: vocab-tests ( vocab -- tests ) : vocab-tests ( vocab -- tests )
dup vocab-root dup [ [
[ dup vocab-tests-file [ , ] when*
>vocab-link dup vocab-tests-dir [ % ] when*
vocab-tests-file, ] { } make ;
vocab-tests-dir,
] { } make
] [ 2drop f ] if ;
: vocab-files ( vocab -- seq ) : vocab-files ( vocab -- seq )
dup find-vocab-root >vocab-link [ [
dup vocab-source-path [ , ] when* dup vocab-source-path [ , ] when*
dup vocab-docs-path [ , ] when* dup vocab-docs-path [ , ] when*
vocab-tests % vocab-tests %
@ -53,12 +51,8 @@ IN: tools.vocabs
: modified-docs ( vocabs -- seq ) : modified-docs ( vocabs -- seq )
[ vocab-docs-path ] modified ; [ vocab-docs-path ] modified ;
: update-roots ( vocabs -- )
[ dup find-vocab-root swap vocab set-vocab-root ] each ;
: to-refresh ( prefix -- modified-sources modified-docs ) : to-refresh ( prefix -- modified-sources modified-docs )
child-vocabs child-vocabs
dup update-roots
dup modified-sources swap modified-docs ; dup modified-sources swap modified-docs ;
: vocab-heading. ( vocab -- ) : vocab-heading. ( vocab -- )
@ -180,7 +174,7 @@ M: vocab-link summary vocab-summary ;
: vocabs-in-dir ( root name -- ) : vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [ dupd (all-child-vocabs) [
2dup vocab-dir? [ 2dup swap >vocab-link , ] when 2dup vocab-dir? [ dup >vocab-link , ] when
vocabs-in-dir vocabs-in-dir
] with each ; ] with each ;
@ -233,7 +227,7 @@ MEMO: all-vocabs-seq ( -- seq )
: unrooted-child-vocabs ( prefix -- seq ) : unrooted-child-vocabs ( prefix -- seq )
dup empty? [ CHAR: . add ] unless dup empty? [ CHAR: . add ] unless
vocabs vocabs
[ vocab-root not ] subset [ find-vocab-root not ] subset
[ [
vocab-name swap ?head CHAR: . rot member? not and vocab-name swap ?head CHAR: . rot member? not and
] with subset ] with subset
@ -241,10 +235,9 @@ MEMO: all-vocabs-seq ( -- seq )
: all-child-vocabs ( prefix -- assoc ) : all-child-vocabs ( prefix -- assoc )
vocab-roots get [ vocab-roots get [
over dupd dupd (all-child-vocabs) dup pick (all-child-vocabs) [ >vocab-link ] map
swap [ >vocab-link ] curry map
] { } map>assoc ] { } map>assoc
f rot unrooted-child-vocabs 2array add ; swap unrooted-child-vocabs f swap 2array add ;
: all-child-vocabs-seq ( prefix -- assoc ) : all-child-vocabs-seq ( prefix -- assoc )
vocab-roots get swap [ vocab-roots get swap [
@ -262,6 +255,7 @@ MEMO: all-authors ( -- seq )
all-vocabs-seq [ vocab-authors ] map>set ; all-vocabs-seq [ vocab-authors ] map>set ;
: reset-cache ( -- ) : reset-cache ( -- )
root-cache get-global clear-assoc
\ (vocab-file-contents) reset-memoized \ (vocab-file-contents) reset-memoized
\ all-vocabs-seq reset-memoized \ all-vocabs-seq reset-memoized
\ all-authors reset-memoized \ all-authors reset-memoized