cleans up some file vs path naming.
file -> current-source-file
file -> current-test-file somewhere else
source-file -> path>source-file
source-file-tuple -> source-file
: run-script ( file -- )
t parser-quiet? [
[ run-file ]
- [ source-file main>> [ execute( -- ) ] when* ] bi
+ [ path>source-file main>> [ execute( -- ) ] when* ] bi
] with-variable ;
: (parse-command-line) ( args -- )
"IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
parse-stream drop
- "foo" source-file definitions>> first cardinality
+ "foo" path>source-file definitions>> first cardinality
] unit-test
[ t ] [ "hello" articles get key? ] unit-test
"IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
parse-stream drop
- "foo" source-file definitions>> first cardinality
+ "foo" path>source-file definitions>> first cardinality
] unit-test
[ t ] [ "hello" articles get key? ] unit-test
"\"def\" ;"
} "\n" join
[
- "testfile" source-file file set
+ "testfile" path>source-file current-source-file set
eval( -- )
] with-scope
] unit-test
: error-location ( error -- string )
[
- [ file>> [ % ] [ +listener-input+ % ] if* ]
+ [ path>> [ % ] [ +listener-input+ % ] if* ]
[ line#>> [ ": " % # ] when* ] bi
] "" make ;
[ { $vocab-link } article-links [ >vocab-link ] map ]
bi append ;
-M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
+M: pathname uses string>> path>source-file top-level-form>> [ uses ] [ { } ] if* ;
! To make UI browser happy
M: object uses drop f ;
: <test-failure> ( error experiment file line# -- triple )
test-failure new
swap >>line#
- swap >>file
+ swap >>path
swap >>asset
swap >>error
error-continuation get >>continuation ;
<test-failure> test-failures get push
notify-error-observers ;
-SYMBOL: file
+SYMBOL: current-test-file
: file-failure ( error -- )
- [ f file get ] keep error-line failure ;
+ [ f current-test-file get ] keep error-line failure ;
:: (unit-test) ( output input -- error ? )
[ { } input with-datastack output assert-sequence= f f ] [ t ] recover ;
word <experiment> :> e
e experiment.
word execute [
- file get [
- e file get line# failure
+ current-test-file get [
+ e current-test-file get line# failure
] [ rethrow ] if
] [ drop ] if ; inline
: fake-unit-test ( quot -- test-failures )
[
- "fake" file set
+ "fake" current-test-file set
V{ } clone test-failures set
call
test-failures get
PRIVATE>
: run-test-file ( path -- )
- dup file [
- test-failures get file get +test-failure+ delete-file-errors
+ dup current-test-file [
+ test-failures get current-test-file get +test-failure+ delete-file-errors
'[ _ run-file ] [ file-failure ] recover
] with-variable ;
sort-keys values ;
: file-matches? ( error pathname/f -- ? )
- [ file>> ] [ dup [ string>> ] when ] bi* = ;
+ [ path>> ] [ dup [ string>> ] when ] bi* = ;
: <error-table-model> ( error-list -- model )
[ model>> ] [ source-file>> ] bi
} define-operation
: com-reload ( error -- )
- file>> run-file ;
+ path>> run-file ;
[ compiler-error? ] \ com-reload H{
{ +listener+ t }
{ $description "Saves the location of a definition and associates this definition with the current source file." } ;
HELP: old-definitions
-{ $var-description "Stores a pair of sets where the members form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
+{ $var-description "Stores a pair of sets where the members form the set of definitions which were defined by " { $link current-source-file } " the most recent time it was loaded." } ;
HELP: new-definitions
-{ $var-description "Stores a pair of sets where the members form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
+{ $var-description "Stores a pair of sets where the members form the set of definitions which were defined so far by the current parsing of " { $link current-source-file } "." } ;
HELP: with-compilation-unit
{ $values { "quot" quotation } }
USING: lexer namespaces parser.notes source-files tools.test ;
IN: parser.notes.tests
-{ } [ f lexer set f file set "Hello world" note. ] unit-test
+{ } [ f lexer set f current-source-file set "Hello world" note. ] unit-test
: note. ( str -- )
parser-quiet? get [
- file get [ path>> write ":" write ] when*
+ current-source-file get [ path>> write ":" write ] when*
lexer get [ line>> number>string write ": " write ] when*
"Note:" print dup print
] unless drop ;
HELP: filter-moved
{ $values { "set1" set } { "set2" set } { "seq" "an sequence of definitions" } }
-{ $description "Removes all definitions from " { $snippet "set2" } " which are in " { $snippet "set1" } " or are no longer present in the current " { $link file } "." } ;
+{ $description "Removes all definitions from " { $snippet "set2" } " which are in " { $snippet "set1" } " or are no longer present in the " { $link current-source-file } "." } ;
HELP: forget-smudged
{ $description "Forgets removed definitions." } ;
HELP: finish-parsing
{ $values { "lines" "the lines of text just parsed" } { "quot" "the quotation just parsed" } }
-{ $description "Records information to the current " { $link file } "." }
+{ $description "Records information to the " { $link current-source-file } "." }
{ $notes "This is one of the factors of " { $link parse-stream } "." } ;
HELP: parse-stream
{ $errors "Throws an I/O error if there was an error reading from the stream. Throws a parse error if the input is malformed." } ;
HELP: parse-file
-{ $values { "file" "a pathname string" } { "quot" quotation } }
+{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Parses the Factor source code stored in a file. The initial vocabulary search path is used." }
{ $errors "Throws an I/O error if there was an error reading from the file. Throws a parse error if the input is malformed." } ;
HELP: run-file
-{ $values { "file" "a pathname string" } }
+{ $values { "path" "a pathname string" } }
{ $description "Parses the Factor source code stored in a file and runs it. The initial vocabulary search path is used." }
{ $errors "Throws an error if loading the file fails, there input is malformed, or if a runtime error occurs while calling the parsed quotation." } ;
"IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
parse-stream drop
- "foo" source-file definitions>> first cardinality
+ "foo" path>source-file definitions>> first cardinality
] unit-test
{ t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
parse-stream drop
- "foo" source-file definitions>> first cardinality
+ "foo" path>source-file definitions>> first cardinality
] unit-test
{ 1 } [
"IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
parse-stream drop
- "bar" source-file definitions>> first cardinality
+ "bar" path>source-file definitions>> first cardinality
] unit-test
{ 2 } [
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
parse-stream drop
- "foo" source-file definitions>> first cardinality
+ "foo" path>source-file definitions>> first cardinality
] unit-test
{ t } [
IN: parser
: location ( -- loc )
- file get lexer get line>> 2dup and
+ current-source-file get lexer get line>> 2dup and
[ [ path>> ] dip 2array ] [ 2drop f ] if ;
: save-location ( definition -- )
auto-used? [ print-use-hook get call( -- ) ] when
] with-file-vocabs ;
-: parsing-file ( file -- )
+: parsing-file ( path -- )
parser-quiet? get [ drop ] [ "Loading " write print flush ] if ;
: filter-moved ( set1 set2 -- seq )
swap diff members [
{
- { [ dup where dup [ first ] when file get path>> = not ] [ f ] }
+ { [ dup where dup [ first ] when current-source-file get path>> = not ] [ f ] }
{ [ dup reader-method? ] [ f ] }
{ [ dup writer-method? ] [ f ] }
[ t ]
fix-class-words ;
: finish-parsing ( lines quot -- )
- file get
+ current-source-file get
[ record-top-level-form ]
[ record-definitions ]
[ record-checksum ]
] with-source-file
] with-compilation-unit ;
-: parse-file-restarts ( file -- restarts )
+: parse-file-restarts ( path -- restarts )
"Load " " again" surround t 2array 1array ;
-: parse-file ( file -- quot )
+: parse-file ( path -- quot )
[
[ parsing-file ] keep
[ utf8 <file-reader> ] keep
drop parse-file
] recover ;
-: run-file ( file -- )
+: run-file ( path -- )
parse-file call( -- ) ;
: ?run-file ( path -- )
M: condition error-file error>> error-file ;
M: condition error-line error>> error-line ;
-TUPLE: source-file-error error asset file line# ;
+TUPLE: source-file-error error asset path line# ;
-M: source-file-error error-file [ error>> error-file ] [ file>> ] bi or ;
+M: source-file-error error-file [ error>> error-file ] [ path>> ] bi or ;
M: source-file-error error-line [ error>> error-line ] [ line#>> ] bi or ;
M: source-file-error compute-restarts error>> compute-restarts ;
[ [ line#>> 0 or ] sort-with ] { } assoc-map-as sort-keys ;
: group-by-source-file ( errors -- assoc )
- H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ;
+ H{ } clone [ [ push-at ] curry [ dup path>> ] prepose each ] keep ;
TUPLE: error-type-holder type word plural icon quot forget-quot { fatal? initial: t } ;
new
swap
[ >>asset ]
- [ where [ first2 [ >>file ] [ >>line# ] bi* ] when* ] bi
+ [ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
swap >>error ; inline
SYMBOL: error-types
: delete-file-errors ( seq file type -- )
[
- [ swap file>> = ] [ swap error-type = ]
+ [ swap path>> = ] [ swap error-type = ]
bi-curry* bi and not
] 2curry filter! drop
notify-error-observers ;
ABOUT: "source-files"
HELP: source-files
-{ $var-description "An assoc mapping pathname strings to " { $link source-file-tuple } " instances, representing loaded source files." } ;
+{ $var-description "An assoc mapping pathname strings to " { $link source-file } " instances, representing loaded source files." } ;
-HELP: source-file
-{ $values { "path" "a pathname string" } { "source-file" source-file-tuple } }
+HELP: path>source-file
+{ $values { "path" "a pathname string" } { "source-file" source-file } }
{ $description "Outputs the source file associated to a path name, creating the source file first if it doesn't exist. Source files are retained in the " { $link source-files } " variable." } ;
-HELP: source-file-tuple
+HELP: source-file
{ $class-description "Instances retain information about loaded source files, and have the following slots:"
{ $list
{ { $slot "path" } " - a pathname string." }
+ { { $slot "top-level-form" } " - a " { $link quotation } " composed of any code not used to define new words and classes" }
{ { $slot "checksum" } " - the CRC32 checksum of the source file's contents at the time it was most recently loaded." }
{ { $slot "definitions" } " - a pair of assocs, containing definitions and classes defined in this source file, respectively" }
+ { { $slot "main" } " - a word that gets called if you " { $link run } " the vocabulary" }
}
} ;
{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
HELP: record-definitions
-{ $values { "file" source-file } }
+{ $values { "source-file" source-file } }
{ $description "Records that all " { $link new-definitions } " were defined in " { $snippet "file" } "." } ;
HELP: rollback-source-file
-{ $values { "file" source-file } }
+{ $values { "source-file" source-file } }
{ $description "Records information to the source file after an incomplete parse which ended with an error." } ;
-HELP: file
+HELP: current-source-file
{ $var-description "Stores the " { $link source-file } " being parsed. The " { $snippet "path" } " of this object comes from the input parameter to " { $link with-source-file } "." } ;
SYMBOL: source-files
-TUPLE: source-file-tuple
+TUPLE: source-file
path
top-level-form
checksum
definitions
main ;
-: record-top-level-form ( quot file -- )
+: record-top-level-form ( quot source-file -- )
top-level-form<<
[ ] [ f notify-definition-observers ] if-bootstrapping ;
: record-checksum ( lines source-file -- )
[ crc32 checksum-lines ] dip checksum<< ;
-: record-definitions ( file -- )
+: record-definitions ( source-file -- )
new-definitions get >>definitions drop ;
: <source-file> ( path -- source-file )
- source-file-tuple new
+ \ source-file new
swap >>path
<definitions> >>definitions ;
ERROR: invalid-source-file-path path ;
-: source-file ( path -- source-file )
+: path>source-file ( path -- source-file )
dup string? [ invalid-source-file-path ] unless
source-files get [ <source-file> ] cache ;
M: pathname forget*
string>> forget-source ;
-: rollback-source-file ( file -- )
+: rollback-source-file ( source-file -- )
[
new-definitions get [ union ] 2map
] change-definitions drop ;
-SYMBOL: file
+SYMBOL: current-source-file
: wrap-source-file-error ( error -- * )
- file get rollback-source-file
+ current-source-file get rollback-source-file
source-file-error new
f >>line#
- file get path>> >>file
+ current-source-file get path>> >>path
swap >>error rethrow ;
: with-source-file ( name quot -- )
#! Should be called from inside with-compilation-unit.
[
[
- source-file
- [ file set ]
+ path>source-file
+ [ current-source-file set ]
[ definitions>> old-definitions set ] bi
] dip
[ wrap-source-file-error ] recover
scan-word
dup ( -- ) check-stack-effect
[ current-vocab main<< ]
- [ file get [ main<< ] [ drop ] if* ] bi
+ [ current-source-file get [ main<< ] [ drop ] if* ] bi
] define-core-syntax
"<<" [
[ t ] [
"resource:core/vocabs/loader/test/a/a.factor"
- source-file definitions>> dup USE: prettyprint .
+ path>source-file definitions>> dup USE: prettyprint .
"v-l-t-a-hello" "vocabs.loader.test.a" lookup-word dup .
swap first in?
] unit-test