Source files and module system cleanup

slava 2006-09-30 03:03:27 +00:00
parent 61d4eeb633
commit 736b2d8bfa
21 changed files with 98 additions and 98 deletions

View File

@ -64,8 +64,6 @@
+ module system: + module system:
- reloading source files manually should update their mod time in the
module system
- convention for main entry point of a module - convention for main entry point of a module
- convention for main help article of a module - convention for main help article of a module
- track a list of assets loaded from each module's file - track a list of assets loaded from each module's file

View File

@ -12,7 +12,7 @@
! Then, start Factor as usual (./f factor.image) and enter these ! Then, start Factor as usual (./f factor.image) and enter these
! at the listener: ! at the listener:
! !
! "/contrib/cairo/load.factor" run-resource ! "contrib/cario" require
! "cairo_simple.factor" run-file ! "cairo_simple.factor" run-file
IN: cairo-simple IN: cairo-simple

View File

@ -12,7 +12,7 @@
! Then, start Factor as usual (./f factor.image) and enter these ! Then, start Factor as usual (./f factor.image) and enter these
! at the listener: ! at the listener:
! !
! "/contrib/cairo/load.factor" run-resource ! "contrib/cario" require
! "cairo_text.factor" run-file ! "cairo_text.factor" run-file
IN: cairo-text IN: cairo-text

View File

@ -1,9 +1,8 @@
IN: scratchpad USING: modules ;
USING: words kernel parser sequences io compiler ;
"/contrib/httpd/load.factor" run-resource REQUIRES: contrib/httpd ;
{ {
"cont-examples" "resource:contrib/httpd/examples/cont-examples.factor"
"cont-numbers-game" "resource:contrib/httpd/examples/cont-numbers-game.factor"
} [ "/contrib/httpd/examples/" swap ".factor" append3 run-resource ] each } run-files

View File

@ -1,5 +1,6 @@
USING: parser words compiler sequences ; USING: parser modules ;
"contrib/x11/examples/lindenmayer/lindenmayer.factor" run-resource {
"contrib/x11/examples/lindenmayer/viewer.factor" run-resource "resource:contrib/x11/examples/lindenmayer/lindenmayer.factor"
"lindenmayer" words [ try-compile ] each "resource:contrib/x11/examples/lindenmayer/viewer.factor"
} run-files

View File

@ -172,8 +172,6 @@ $terpri
ARTICLE: "cookbook-sources" "Source file cookbook" ARTICLE: "cookbook-sources" "Source file cookbook"
"By convention, code is stored in files with the " { $snippet ".factor" } " filename extension. You can load source files using " { $link run-file } ":" "By convention, code is stored in files with the " { $snippet ".factor" } " filename extension. You can load source files using " { $link run-file } ":"
{ $code "\"hello.factor\" run-file" } { $code "\"hello.factor\" run-file" }
"You can load source files from the Factor source code directory using " { $link run-resource } ":"
{ $code "\"/examples/lcd.factor\" run-resource" }
{ $references { $references
{ } { }
"sources" "sources"

View File

@ -47,8 +47,6 @@ $terpri
ARTICLE: "sources" "Source files" ARTICLE: "sources" "Source files"
"The simplest way to distribute a piece of Factor code is in the form of a source file. Source files can be loaded in the listener:" "The simplest way to distribute a piece of Factor code is in the form of a source file. Source files can be loaded in the listener:"
{ $subsection run-file } { $subsection run-file }
"Another way to load a source file is to provide a path relative to the Factor installation directory:"
{ $subsection run-resource }
"Factor tracks which source files definitions were loaded from; see " { $link "definitions" } "." "Factor tracks which source files definitions were loaded from; see " { $link "definitions" } "."
$terpri $terpri
"Details on the Factor source parser itself can be found in " { $link "parser" } "." "Details on the Factor source parser itself can be found in " { $link "parser" } "."

View File

@ -7,7 +7,7 @@ prettyprint sequences vectors words ;
"Bootstrap stage 1..." print flush "Bootstrap stage 1..." print flush
"/library/bootstrap/primitives.factor" run-resource "resource:/library/bootstrap/primitives.factor" run-file
! The [ ] make form creates a boot quotation ! The [ ] make form creates a boot quotation
[ [
@ -20,7 +20,10 @@ prettyprint sequences vectors words ;
"library/compiler/" architecture get append require "library/compiler/" architecture get append require
"doc/handbook" require "doc/handbook" require
[ "/library/bootstrap/boot-stage2.factor" run-resource ] % [
"resource:/library/bootstrap/boot-stage2.factor"
run-file
] %
] [ ] make ] [ ] make
vocabularies get [ vocabularies get [

View File

@ -14,14 +14,14 @@ optimizer parser sequences sequences-internals words ;
cpu "x86" = [ cpu "x86" = [
macosx? macosx?
"/library/compiler/x86/alien-macosx.factor" "resource:/library/compiler/x86/alien-macosx.factor"
"/library/compiler/x86/alien.factor" "resource:/library/compiler/x86/alien.factor"
? run-resource ? run-file
] when ] when
"compile" get [ "compile" get [
windows? [ windows? [
"/library/windows/dlls.factor" run-resource "resource:/library/windows/dlls.factor" run-file
] when ] when
\ number= compile \ number= compile

View File

@ -287,7 +287,7 @@ M: hashtable '
{ {
vocabularies typemap builtins c-types crossref vocabularies typemap builtins c-types crossref
articles parent-graph term-index changed-words articles parent-graph term-index changed-words
modules class<map modules class<map source-files
} [ dup get swap bootstrap-word set ] each } [ dup get swap bootstrap-word set ] each
] make-hash ' ] make-hash '
global-offset fixup ; global-offset fixup ;
@ -327,8 +327,9 @@ M: hashtable '
<file-writer> [ (write-image) ] with-stream ; <file-writer> [ (write-image) ] with-stream ;
: prepare-profile ( arch -- ) : prepare-profile ( arch -- )
"/library/bootstrap/profile-" swap ".factor" append3 "resource:/library/bootstrap/profile-"
run-resource ; swap ".factor" append3
run-file ;
: prepare-image ( arch -- ) : prepare-image ( arch -- )
bootstrapping? on dup architecture set prepare-profile bootstrapping? on dup architecture set prepare-profile
@ -339,7 +340,7 @@ M: hashtable '
parse-hook off parse-hook off
prepare-image prepare-image
begin-image begin-image
"/library/bootstrap/boot-stage1.factor" run-resource "resource:/library/bootstrap/boot-stage1.factor" run-file
end-image end-image
image get image-name write-image image get image-name write-image
] with-scope ; ] with-scope ;

View File

@ -11,11 +11,13 @@ strings vectors words ;
"Creating primitives and basic runtime structures..." print flush "Creating primitives and basic runtime structures..." print flush
H{ } clone c-types set H{ } clone c-types set
"/library/compiler/alien/primitive-types.factor" parse-resource
"resource:/library/compiler/alien/primitive-types.factor" parse-file
! Bring up a bare cross-compiling vocabulary. ! Bring up a bare cross-compiling vocabulary.
"syntax" vocab "syntax" vocab
H{ } clone source-files set
H{ } clone vocabularies set H{ } clone vocabularies set
H{ } clone class<map set H{ } clone class<map set
V{ } clone modules set V{ } clone modules set

View File

@ -29,8 +29,8 @@ strings styles ;
\ resource-path get [ image parent-dir ] unless* \ resource-path get [ image parent-dir ] unless*
swap path+ ; swap path+ ;
: <resource-reader> ( resource -- stream ) : ?resource-path ( path -- path )
resource-path <file-reader> ; "resource:" ?head [ resource-path ] when ;
TUPLE: pathname string ; TUPLE: pathname string ;

View File

@ -51,10 +51,6 @@ HELP: resource-path
{ $values { "resource" "a string" } { "path" "a string" } } { $values { "resource" "a string" } { "path" "a string" } }
{ $description "Resolve a path relative to the Factor source code location. This first checks if the " { $link resource-path } " variable is set to a path, and if not, uses the parent directory of the current image." } ; { $description "Resolve a path relative to the Factor source code location. This first checks if the " { $link resource-path } " variable is set to a path, and if not, uses the parent directory of the current image." } ;
HELP: <resource-reader>
{ $values { "resource" "a string" } { "stream" "an input stream" } }
{ $description "Opens a file relative to the Factor source code location." } ;
HELP: pathname HELP: pathname
{ $class-description "Class of path name presentations. Instances can be used passed to " { $link write-object } " to output a clickable path name." } ; { $class-description "Class of path name presentations. Instances can be used passed to " { $link write-object } " to output a clickable path name." } ;

View File

@ -6,29 +6,18 @@ test words strings arrays math ;
SYMBOL: modules SYMBOL: modules
TUPLE: module name files tests modified ; TUPLE: module name files tests ;
: module-def ( name -- path ) : module-def ( name -- path )
dup ".factor" append dup resource-path exists? "resource:" over ".factor" append3
[ nip ] [ drop "/load.factor" append ] if ; dup ?resource-path exists? [
nip
: record-def-modified ( module hash -- ) ] [
>r module-name module-def drop "resource:" swap "/load.factor" append3
[ resource-path file-modified ] keep ] if ;
r> set-hash ;
: record-modified ( module -- )
dup module-files
[ dup resource-path file-modified ] map>hash
2dup record-def-modified
swap set-module-modified ;
: modified? ( file module -- ? )
dupd module-modified hash
swap resource-path file-modified [ < ] [ drop f ] if* ;
: prefix-paths ( name seq -- newseq ) : prefix-paths ( name seq -- newseq )
[ "/" swap append3 ] map-with ; [ path+ "resource:" swap append ] map-with ;
C: module ( name files tests -- module ) C: module ( name files tests -- module )
[ >r >r over r> prefix-paths r> set-module-tests ] keep [ >r >r over r> prefix-paths r> set-module-tests ] keep
@ -40,16 +29,16 @@ C: module ( name files tests -- module )
: load-module ( name -- ) : load-module ( name -- )
[ [
"Loading module " write dup write "..." print "Loading module " write dup write "..." print
[ dup module-def run-resource ] assert-depth drop [ dup module-def run-file ] assert-depth drop
] no-parse-hook ; ] no-parse-hook ;
: require ( name -- ) : require ( name -- )
dup module [ drop ] [ load-module ] if do-parse-hook ; dup module [ drop ] [ load-module ] if do-parse-hook ;
: run-resources ( seq -- ) : run-files ( seq -- )
[ [
bootstrapping? get bootstrapping? get
[ parse-resource % ] [ run-resource ] ? each [ parse-file % ] [ run-file ] ? each
] no-parse-hook ; ] no-parse-hook ;
: process-files ( seq -- newseq ) : process-files ( seq -- newseq )
@ -66,8 +55,8 @@ C: module ( name files tests -- module )
: provide ( name files tests -- ) : provide ( name files tests -- )
pick remove-module pick remove-module
[ process-files ] 2apply <module> dup record-modified [ process-files ] 2apply <module>
[ module-files run-resources ] keep [ module-files run-files ] keep
add-module ; add-module ;
: test-module ( name -- ) module module-tests run-tests ; : test-module ( name -- ) module module-tests run-tests ;
@ -83,15 +72,11 @@ C: module ( name files tests -- module )
all-module-names natural-sort [ print ] each ; all-module-names natural-sort [ print ] each ;
: reload-module ( module -- ) : reload-module ( module -- )
dup module-name module-def over modified? [ dup module-name module-def source-modified? [
module-name load-module module-name load-module
] [ ] [
dup dup module-files [ swap modified? ] subset-with module-files [ source-modified? ] subset run-files
run-resources
record-modified
] if ; ] if ;
: reload-modules ( -- ) : reload-modules ( -- )
all-modules [ reload-module ] each do-parse-hook ; all-modules [ reload-module ] each do-parse-hook ;
: reset-modified ( -- ) all-modules [ record-modified ] each ;

View File

@ -31,9 +31,9 @@ $terpri
"If this module is already listed in the " { $link modules } " hashtable, this word does nothing. Otherwise, it calls " { $link load-module } "." } "If this module is already listed in the " { $link modules } " hashtable, this word does nothing. Otherwise, it calls " { $link load-module } "." }
{ $notes "Module definitions should use the " { $link POSTPONE: REQUIRES: } " parsing word instead. In the listener, the " { $link require } " word might be more useful since it recompiles new words after loading the module." } ; { $notes "Module definitions should use the " { $link POSTPONE: REQUIRES: } " parsing word instead. In the listener, the " { $link require } " word might be more useful since it recompiles new words after loading the module." } ;
HELP: run-resources HELP: run-files
{ $values { "seq" "a sequence of strings" } } { $values { "seq" "a sequence of strings" } }
{ $description "Load a collection of source files identified by resource paths (see " { $link resource-path } ")." { $description "Load a collection of source files."
$terpri $terpri
"If bootstrapping, this word appends the top-level forms to the currently constructing quotation instead." } ; "If bootstrapping, this word appends the top-level forms to the currently constructing quotation instead." } ;

View File

@ -4,6 +4,33 @@ IN: parser
USING: arrays errors generic hashtables io kernel math USING: arrays errors generic hashtables io kernel math
namespaces sequences words ; namespaces sequences words ;
SYMBOL: source-files
TUPLE: source-file path modified definitions ;
: source-file-modified* ( source-file -- n )
source-file-path ?resource-path
file-modified [ 0 ] unless* ;
: record-modified ( file -- )
dup source-file-modified* swap set-source-file-modified ;
: reset-modified ( -- )
source-files get hash-values [ record-modified ] each ;
C: source-file ( path -- source-file )
[ set-source-file-path ] keep
V{ } clone over set-source-file-definitions
dup record-modified ;
: source-modified? ( file -- ? )
source-files get hash [
dup source-file-modified swap source-file-modified*
[ < ] [ drop f ] if*
] [
t
] if* ;
: file-vocabs ( -- ) : file-vocabs ( -- )
"scratchpad" set-in { "syntax" "scratchpad" } set-use ; "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
@ -36,17 +63,22 @@ SYMBOL: parse-hook
do-parse-hook do-parse-hook
] with-scope ; ] with-scope ;
: parsing-file ( file -- ) "Loading " write print flush ; : parsing-file ( file -- )
"Loading " write print flush ;
: record-file ( file -- )
[ <source-file> ] keep source-files get set-hash ;
: parse-file-restarts ( file -- restarts ) : parse-file-restarts ( file -- restarts )
"Load " swap " again" append3 t 2array 1array ; "Load " swap " again" append3 t 2array 1array ;
: (parse-file) ( file ident -- quot ) : parse-file ( file -- quot )
[ dup parsing-file >r <file-reader> r> parse-stream ] [
[ pick parse-file-restarts condition drop (parse-file) ] dup parsing-file dup record-file
recover ; [ ?resource-path <file-reader> ] keep parse-stream
] [
: parse-file ( file -- quot ) dup (parse-file) ; over parse-file-restarts condition drop parse-file
] recover ;
: run-file ( file -- ) parse-file call ; : run-file ( file -- ) parse-file call ;
@ -58,9 +90,3 @@ SYMBOL: parse-hook
: eval>string ( str -- str ) : eval>string ( str -- str )
[ [ [ eval ] keep ] try drop ] string-out ; [ [ [ eval ] keep ] try drop ] string-out ;
: parse-resource ( path -- quot )
[ resource-path "resource:" ] keep append (parse-file) ;
: run-resource ( file -- )
parse-resource call ;

View File

@ -48,14 +48,3 @@ HELP: run-file
HELP: ?run-file HELP: ?run-file
{ $values { "file" "a path name string" } } { $values { "file" "a path name string" } }
{ $description "Forgiving variant of " { $link run-file } " which does nothing if the file does not exist, and logs errors to the default stream without re-throwing them." } ; { $description "Forgiving variant of " { $link run-file } " which does nothing if the file does not exist, and logs errors to the default stream without re-throwing them." } ;
HELP: parse-resource
{ $values { "path" "a resource name string" } { "quot" "a new quotation" } }
{ $description "Parses a library resource." }
{ $notes "the source file name given to the parser is special for resources and begins with " { $snippet "resource:" } ". This allows words that operate on source files, like " { $link edit } ", to use a different resource path at run time than was used at parse time." }
{ $errors "Throws an I/O error if there was an error reading the resource. Throws a parse error if the input is malformed." } ;
HELP: run-resource
{ $values { "path" "a resource name string" } }
{ $description "Parses and runs a library resource." }
{ $errors "Throws an I/O error if there was an error reading the resource. Throws a parse error if the input is malformed." } ;

View File

@ -55,9 +55,11 @@ USING: arrays io kernel porter-stemmer sequences test ;
[ "hell" ] [ "hell" step5 "" like ] unit-test [ "hell" ] [ "hell" step5 "" like ] unit-test
[ "mate" ] [ "mate" step5 "" like ] unit-test [ "mate" ] [ "mate" step5 "" like ] unit-test
: resource-lines resource-path <file-reader> lines ;
[ { } ] [ [ { } ] [
"/library/test/help/voc.txt" <resource-reader> lines "/library/test/help/voc.txt" resource-lines
[ stem ] map [ stem ] map
"/library/test/help/output.txt" <resource-reader> lines "/library/test/help/output.txt" resource-lines
[ 2array ] 2map [ first2 = not ] subset [ 2array ] 2map [ first2 = not ] subset
] unit-test ] unit-test

View File

@ -1,7 +1,12 @@
IN: temporary IN: temporary
USING: io kernel math parser strings test ; USING: io kernel math parser strings test ;
[ 4 ] [ "/library/test/io/no-trailing-eol.factor" run-resource ] unit-test [ 4 ] [
"resource:/library/test/io/no-trailing-eol.factor" run-file
] unit-test
: <resource-reader> ( resource -- stream )
resource-path <file-reader> ;
: lines-test ( stream -- line1 line2 ) : lines-test ( stream -- line1 line2 )
[ readln readln ] with-stream ; [ readln readln ] with-stream ;

View File

@ -4,9 +4,6 @@ IN: definitions
USING: arrays errors generic hashtables io kernel math USING: arrays errors generic hashtables io kernel math
namespaces parser prettyprint sequences styles words ; namespaces parser prettyprint sequences styles words ;
: ?resource-path ( path -- path )
"resource:" ?head [ resource-path ] when ;
: where ( defspec -- loc ) : where ( defspec -- loc )
where* dup [ first2 >r ?resource-path r> 2array ] when ; where* dup [ first2 >r ?resource-path r> 2array ] when ;

View File

@ -48,7 +48,7 @@ SYMBOL: failures
[ [
"=====> " write dup write "..." print flush "=====> " write dup write "..." print flush
[ [
[ [ run-resource ] with-scope ] keep [ [ run-file ] with-scope ] keep
] assert-depth drop ] assert-depth drop
] test-handler ; ] test-handler ;