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-filedb4
parent
7b02c23f54
commit
117727d444
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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 } }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
|
|
|
@ -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 } [
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 } "." } ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
"<<" [
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue