parser, source-files: you need to bootstrap after this patch.

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
db4
Doug Coleman 2015-07-23 22:00:48 -07:00
parent 7b02c23f54
commit 117727d444
19 changed files with 62 additions and 60 deletions

View File

@ -60,7 +60,7 @@ SYMBOL: command-line
: 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 -- )

View File

@ -10,7 +10,7 @@ IN: help.definitions.tests
"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
@ -23,7 +23,7 @@ IN: help.definitions.tests
"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

View File

@ -23,7 +23,7 @@ SYMBOL: foo
"\"def\" ;"
} "\n" join
[
"testfile" source-file file set
"testfile" path>source-file current-source-file set
eval( -- )
] with-scope
] unit-test

View File

@ -7,7 +7,7 @@ CONSTANT: +listener-input+ "<Listener input>"
: error-location ( error -- string )
[
[ file>> [ % ] [ +listener-input+ % ] if* ]
[ path>> [ % ] [ +listener-input+ % ] if* ]
[ line#>> [ ": " % # ] when* ] bi
] "" make ;

View File

@ -51,7 +51,7 @@ M: link uses
[ { $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 ;

View File

@ -36,7 +36,7 @@ t verbose-tests? set-global
: <test-failure> ( error experiment file line# -- triple )
test-failure new
swap >>line#
swap >>file
swap >>path
swap >>asset
swap >>error
error-continuation get >>continuation ;
@ -46,10 +46,10 @@ t verbose-tests? set-global
<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 ;
@ -92,8 +92,8 @@ MACRO: <experiment> ( word -- quot )
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
@ -114,7 +114,7 @@ SYNTAX: TEST:
: fake-unit-test ( quot -- test-failures )
[
"fake" file set
"fake" current-test-file set
V{ } clone test-failures set
call
test-failures get
@ -123,8 +123,8 @@ SYNTAX: TEST:
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 ;

View File

@ -103,7 +103,7 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
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

View File

@ -87,7 +87,7 @@ IN: ui.tools.operations
} define-operation
: com-reload ( error -- )
file>> run-file ;
path>> run-file ;
[ compiler-error? ] \ com-reload H{
{ +listener+ t }

View File

@ -50,10 +50,10 @@ HELP: remember-definition
{ $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 } }

View File

@ -1,4 +1,4 @@
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

View File

@ -10,7 +10,7 @@ t parser-quiet? set-global
: 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 ;

View File

@ -245,14 +245,14 @@ HELP: parse-fresh
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
@ -261,12 +261,12 @@ 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." } ;

View File

@ -117,7 +117,7 @@ DEFER: foo
"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
@ -134,21 +134,21 @@ DEFER: foo
"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 } [

View File

@ -8,7 +8,7 @@ vectors vocabs vocabs.parser words words.symbol ;
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 -- )
@ -162,13 +162,13 @@ print-use-hook [ [ ] ] initialize
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 ]
@ -202,7 +202,7 @@ print-use-hook [ [ ] ] initialize
fix-class-words ;
: finish-parsing ( lines quot -- )
file get
current-source-file get
[ record-top-level-form ]
[ record-definitions ]
[ record-checksum ]
@ -217,10 +217,10 @@ print-use-hook [ [ ] ] initialize
] 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
@ -230,7 +230,7 @@ print-use-hook [ [ ] ] initialize
drop parse-file
] recover ;
: run-file ( file -- )
: run-file ( path -- )
parse-file call( -- ) ;
: ?run-file ( path -- )

View File

@ -13,9 +13,9 @@ M: object error-line drop f ;
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 ;
@ -23,7 +23,7 @@ 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 } ;
@ -33,7 +33,7 @@ GENERIC: error-type ( error -- type )
new
swap
[ >>asset ]
[ where [ first2 [ >>file ] [ >>line# ] bi* ] when* ] bi
[ where [ first2 [ >>path ] [ >>line# ] bi* ] when* ] bi
swap >>error ; inline
SYMBOL: error-types
@ -83,7 +83,7 @@ SYMBOL: error-observers
: 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 ;

View File

@ -23,18 +23,20 @@ $nl
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" }
}
} ;
@ -52,12 +54,12 @@ HELP: forget-source
{ $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 } "." } ;

View File

@ -9,31 +9,31 @@ IN: source-files
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 ;
@ -53,26 +53,26 @@ M: pathname where string>> 1 2array ;
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

View File

@ -246,7 +246,7 @@ IN: bootstrap.syntax
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
"<<" [

View File

@ -46,7 +46,7 @@ IN: vocabs.loader.tests
[ 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