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

Split up huge parser vocabulary

db4
Slava Pestov 2008-06-25 03:25:08 -05:00
parent 6c59decaa3
commit 6e0d35e615
61 changed files with 642 additions and 578 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/alien/syntax/syntax.factor
View File

@ -3,7 +3,8 @@
USING: arrays alien alien.c-types alien.structs alien.arrays
alien.strings kernel math namespaces parser sequences words
quotations math.parser splitting grouping effects prettyprint
prettyprint.sections prettyprint.backend assocs combinators ;
prettyprint.sections prettyprint.backend assocs combinators
lexer strings.parser ;
IN: alien.syntax
<PRIVATE

9
core/classes/classes.factor
View File

@ -65,6 +65,15 @@ GENERIC: rank-class ( class -- n )
GENERIC: reset-class ( class -- )
M: class reset-class
{
"class"
"metaclass"
"superclass"
"members"
"participants"
} reset-props ;
M: word reset-class drop ;
GENERIC: implementors ( class/classes -- seq )

3
core/classes/intersection/intersection.factor
View File

@ -27,7 +27,4 @@ M: intersection-class update-class define-intersection-predicate ;
[ drop update-classes ]
2bi ;
M: intersection-class reset-class
{ "class" "metaclass" "participants" } reset-props ;
M: intersection-class rank-class drop 2 ;

2
core/classes/mixin/mixin.factor
View File

@ -7,7 +7,7 @@ IN: classes.mixin
PREDICATE: mixin-class < union-class "mixin" word-prop ;
M: mixin-class reset-class
{ "class" "metaclass" "members" "mixin" } reset-props ;
[ call-next-method ] [ { "mixin" } reset-props ] bi ;
M: mixin-class rank-class drop 3 ;

15
core/classes/parser/parser.factor Normal file
View File

@ -0,0 +1,15 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser words kernel classes compiler.units lexer ;
IN: classes.parser
: save-class-location ( class -- )
location remember-class ;
: create-class-in ( word -- word )
current-vocab create
dup save-class-location
dup predicate-word dup set-word save-location ;
: CREATE-CLASS ( -- word )
scan create-class-in ;

9
core/classes/predicate/predicate.factor
View File

@ -24,11 +24,8 @@ PREDICATE: predicate-class < class
] 3tri ;
M: predicate-class reset-class
{
"class"
"metaclass"
"predicate-definition"
"superclass"
} reset-props ;
[ call-next-method ]
[ { "predicate-definition" } reset-props ]
bi ;
M: predicate-class rank-class drop 1 ;

14
core/classes/tuple/parser/parser-docs.factor Normal file
View File

@ -0,0 +1,14 @@
IN: classes.tuple.parser
USING: strings help.markup help.syntax ;
HELP: invalid-slot-name
{ $values { "name" string } }
{ $description "Throws an " { $link invalid-slot-name } " error." }
{ $error-description "Thrown by " { $link POSTPONE: TUPLE: } " and " { $link POSTPONE: ERROR: } " if a suspect token appears as a slot name." }
{ $notes "The suspect tokens are chosen so that the following code raises this parse error, instead of silently greating a tuple with garbage slots:"
{ $code
"TUPLE: my-mistaken-tuple slot-a slot-b"
""
": some-word ( a b c -- ) ... ;"
}
} ;

50
core/classes/tuple/parser/parser.factor Normal file
View File

@ -0,0 +1,50 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sets namespaces sequences inspector parser
lexer combinators words classes.parser classes.tuple ;
IN: classes.tuple.parser
: shadowed-slots ( superclass slots -- shadowed )
>r all-slot-names r> intersect ;
: check-slot-shadowing ( class superclass slots -- )
shadowed-slots [
[
"Definition of slot ``" %
%
"'' in class ``" %
word-name %
"'' shadows a superclass slot" %
] "" make note.
] with each ;
ERROR: invalid-slot-name name ;
M: invalid-slot-name summary
drop
"Invalid slot name" ;
: (parse-tuple-slots) ( -- )
#! This isn't meant to enforce any kind of policy, just
#! to check for mistakes of this form:
#!
#! TUPLE: blahblah foo bing
#!
#! : ...
scan {
{ [ dup not ] [ unexpected-eof ] }
{ [ dup { ":" "(" "<" } member? ] [ invalid-slot-name ] }
{ [ dup ";" = ] [ drop ] }
[ , (parse-tuple-slots) ]
} cond ;
: parse-tuple-slots ( -- seq )
[ (parse-tuple-slots) ] { } make ;
: parse-tuple-definition ( -- class superclass slots )
CREATE-CLASS
scan {
{ ";" [ tuple f ] }
{ "<" [ scan-word parse-tuple-slots ] }
[ >r tuple parse-tuple-slots r> prefix ]
} case 3dup check-slot-shadowing ;

10
core/classes/tuple/tuple.factor
View File

@ -217,13 +217,9 @@ M: tuple-class reset-class
[ writer-word method forget ] 2bi
] with each
] [
{
"class"
"metaclass"
"superclass"
"layout"
"slots"
} reset-props
[ call-next-method ]
[ { "layout" "slots" } reset-props ]
bi
] bi ;
M: tuple-class rank-class drop 0 ;

3
core/classes/union/union.factor
View File

@ -28,7 +28,4 @@ M: union-class update-class define-union-predicate ;
: define-union-class ( class members -- )
[ (define-union-class) ] [ drop update-classes ] 2bi ;
M: union-class reset-class
{ "class" "metaclass" "members" } reset-props ;
M: union-class rank-class drop 2 ;

8
core/continuations/continuations-docs.factor
View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax kernel kernel.private
continuations.private parser vectors arrays namespaces
assocs words quotations ;
continuations.private vectors arrays namespaces
assocs words quotations lexer ;
IN: continuations
ARTICLE: "errors-restartable" "Restartable errors"
@ -169,8 +169,8 @@ HELP: rethrow
"This word is intended to be used in conjunction with " { $link recover } " to implement error handlers which perform an action and pass the error to the next outermost error handler."
}
{ $examples
"The " { $link with-parser } " catches errors, annotates them with file name and line number information, and rethrows them:"
{ $see with-parser }
"The " { $link with-lexer } " word catches errors, annotates them with the current line and column number, and rethrows them:"
{ $see with-lexer }
} ;
HELP: throw-restarts

20
core/cpu/x86/assembler/assembler.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generator.fixup io.binary kernel
combinators kernel.private math namespaces parser sequences
words system layouts math.order accessors ;
combinators kernel.private math namespaces sequences
words system layouts math.order accessors
cpu.x86.assembler.syntax ;
IN: cpu.x86.assembler
! A postfix assembler for x86 and AMD64.
@ -12,21 +13,6 @@ IN: cpu.x86.assembler
! Beware!
! Register operands -- eg, ECX
<<
: define-register ( name num size -- )
>r >r "cpu.x86.assembler" create dup define-symbol r> r>
>r dupd "register" set-word-prop r>
"register-size" set-word-prop ;
: define-registers ( names size -- )
>r dup length r> [ define-register ] curry 2each ;
: REGISTERS: ( -- )
scan-word ";" parse-tokens swap define-registers ; parsing
>>
REGISTERS: 8 AL CL DL BL ;
REGISTERS: 16 AX CX DX BX SP BP SI DI ;

15
core/cpu/x86/assembler/syntax/syntax.factor Normal file
View File

@ -0,0 +1,15 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words sequences lexer parser ;
IN: cpu.x86.assembler.syntax
: define-register ( name num size -- )
>r >r "cpu.x86.assembler" create dup define-symbol r> r>
>r dupd "register" set-word-prop r>
"register-size" set-word-prop ;
: define-registers ( names size -- )
>r dup length r> [ define-register ] curry 2each ;
: REGISTERS: ( -- )
scan-word ";" parse-tokens swap define-registers ; parsing

9
core/effects/parser/parser-docs.factor Normal file
View File

@ -0,0 +1,9 @@
IN: effects.parser
USING: strings effects help.markup help.syntax ;
HELP: parse-effect
{ $values { "end" string } { "effect" "an instance of " { $link effect } } }
{ $description "Parses a stack effect from the current input line." }
{ $examples "This word is used by " { $link POSTPONE: ( } " and " { $link POSTPONE: (( } " to parse stack effect declarations." }
$parsing-note ;

15
core/effects/parser/parser.factor Normal file
View File

@ -0,0 +1,15 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: lexer sets sequences kernel splitting effects ;
IN: effects.parser
: parse-effect ( end -- effect )
parse-tokens dup { "(" "((" } intersect empty? [
{ "--" } split1 dup [
<effect>
] [
"Stack effect declaration must contain --" throw
] if
] [
"Stack effect declaration must not contain ( or ((" throw
] if ;

33
core/generic/parser/parser.factor Normal file
View File

@ -0,0 +1,33 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel words generic namespaces inspector ;
IN: generic.parser
ERROR: not-in-a-method-error ;
M: not-in-a-method-error summary
drop "call-next-method can only be called in a method definition" ;
: CREATE-GENERIC ( -- word ) CREATE dup reset-word ;
: create-method-in ( class generic -- method )
create-method f set-word dup save-location ;
: CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ;
SYMBOL: current-class
SYMBOL: current-generic
: with-method-definition ( quot -- parsed )
[
>r
[ "method-class" word-prop current-class set ]
[ "method-generic" word-prop current-generic set ]
[ ] tri
r> call
] with-scope ; inline
: (M:) ( method def -- )
CREATE-METHOD [ parse-definition ] with-method-definition ;

114
core/lexer/lexer-docs.factor Normal file
View File

@ -0,0 +1,114 @@
IN: lexer
USING: help.markup help.syntax kernel math sequences strings
words quotations ;
: $parsing-note ( children -- )
drop
"This word should only be called from parsing words."
$notes ;
HELP: lexer
{ $var-description "Stores the current " { $link lexer } " instance." }
{ $class-description "An object for tokenizing parser input. It has the following slots:"
{ $list
{ { $snippet "text" } " - the lines being parsed; an array of strings" }
{ { $snippet "line" } " - the line number being parsed; unlike most indices this is 1-based for friendlier error reporting and integration with text editors" }
{ { $snippet "column" } " - the current column position, zero-based" }
}
"Custom lexing can be implemented by delegating a tuple to an instance of this class and implementing the " { $link skip-word } " and " { $link skip-blank } " generic words." } ;
HELP: <lexer>
{ $values { "text" "a sequence of strings" } { "lexer" lexer } }
{ $description "Creates a new lexer for tokenizing the given sequence of lines." } ;
HELP: next-line
{ $values { "lexer" lexer } }
{ $description "Advances the lexer to the next input line, discarding the remainder of the current line." } ;
HELP: lexer-error
{ $error-description "Thrown when the lexer encounters invalid input. A lexer error wraps an underlying error together with line and column numbers." } ;
HELP: <lexer-error>
{ $values { "msg" "an error" } { "error" lexer-error } }
{ $description "Creates a new " { $link lexer-error } ", filling in the location information from the current " { $link lexer } "." } ;
HELP: skip
{ $values { "i" "a starting index" } { "seq" sequence } { "?" "a boolean" } { "n" integer } }
{ $description "Skips to the first space character (if " { $snippet "boolean" } " is " { $link f } ") or the first non-space character (otherwise)." } ;
HELP: change-lexer-column
{ $values { "lexer" lexer } { "quot" "a quotation with stack effect " { $snippet "( col line -- newcol )" } } }
{ $description "Applies a quotation to the current column and line text to produce a new column, and moves the lexer position." } ;
HELP: skip-blank
{ $values { "lexer" lexer } }
{ $contract "Skips whitespace characters." }
{ $notes "Custom lexers can implement this generic word." } ;
HELP: skip-word
{ $values { "lexer" lexer } }
{ $contract
"Skips until the end of the current token."
$nl
"The default implementation treats a single " { $snippet "\"" } " as a word by itself; otherwise it searches forward until a whitespace character or the end of the line."
}
{ $notes "Custom lexers can implement this generic word." } ;
HELP: still-parsing-line?
{ $values { "lexer" lexer } { "?" "a boolean" } }
{ $description "Outputs " { $link f } " if the end of the current line has been reached, " { $link t } " otherwise." } ;
HELP: parse-token
{ $values { "lexer" lexer } { "str/f" "a " { $link string } " or " { $link f } } }
{ $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace." } ;
HELP: scan
{ $values { "str/f" "a " { $link string } " or " { $link f } } }
{ $description "Reads the next token from the lexer. See " { $link parse-token } " for details." }
$parsing-note ;
HELP: still-parsing?
{ $values { "lexer" lexer } { "?" "a boolean" } }
{ $description "Outputs " { $link f } " if end of input has been reached, " { $link t } " otherwise." } ;
HELP: parse-tokens
{ $values { "end" string } { "seq" "a new sequence of strings" } }
{ $description "Reads a sequence of tokens until the first occurrence of " { $snippet "end" } ". The tokens remain as strings and are not processed in any way." }
{ $examples "This word is used to implement " { $link POSTPONE: USING: } "." }
$parsing-note ;
HELP: unexpected
{ $values { "want" "a " { $link word } " or " { $link f } } { "got" word } }
{ $description "Throws an " { $link unexpected } " error." }
{ $error-description "Thrown by the parser if an unmatched closing delimiter is encountered." }
{ $examples
"Parsing the following snippet will throw this error:"
{ $code "[ 1 2 3 }" }
} ;
HELP: unexpected-eof
{ $values { "word" "a " { $link word } } }
{ $description "Throws an " { $link unexpected } " error indicating the parser was looking for an occurrence of " { $snippet "word" } " but encountered end of file." } ;
HELP: with-lexer
{ $values { "lexer" lexer } { "quot" quotation } }
{ $description "Calls the quotation with the " { $link lexer } " variable set to the given lexer. The quotation can make use of words such as " { $link scan } ". Any errors thrown by the quotation are wrapped in " { $link lexer-error } " instances." } ;
HELP: lexer-factory
{ $var-description "A variable holding a quotation with stack effect " { $snippet "( lines -- lexer )" } ". This quotation is called by the parser to create " { $link lexer } " instances. This variable can be rebound to a quotation which outputs a custom tuple delegating to " { $link lexer } " to customize syntax." } ;
ARTICLE: "parser-lexer" "The lexer"
"A variable that encapsulate internal parser state:"
{ $subsection lexer }
"Creating a default lexer:"
{ $subsection <lexer> }
"A word to test of the end of input has been reached:"
{ $subsection still-parsing? }
"A word to advance the lexer to the next line:"
{ $subsection next-line }
"Two generic words to override the lexer's token boundary detection:"
{ $subsection skip-blank }
{ $subsection skip-word }
"Utility combinator:"
{ $subsection with-lexer } ;

133
core/lexer/lexer.factor Normal file
View File

@ -0,0 +1,133 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors namespaces math words strings
debugger io vectors arrays math.parser combinators inspector
continuations ;
IN: lexer
TUPLE: lexer text line line-text line-length column ;
: next-line ( lexer -- )
dup [ line>> ] [ text>> ] bi ?nth >>line-text
dup line-text>> length >>line-length
[ 1+ ] change-line
0 >>column
drop ;
: new-lexer ( text class -- lexer )
new
0 >>line
swap >>text
dup next-line ; inline
: <lexer> ( text -- lexer )
lexer new-lexer ;
: skip ( i seq ? -- n )
over >r
[ swap CHAR: \s eq? xor ] curry find-from drop
[ r> drop ] [ r> length ] if* ;
: change-lexer-column ( lexer quot -- )
swap
[ dup lexer-column swap lexer-line-text rot call ] keep
set-lexer-column ; inline
GENERIC: skip-blank ( lexer -- )
M: lexer skip-blank ( lexer -- )
[ t skip ] change-lexer-column ;
GENERIC: skip-word ( lexer -- )
M: lexer skip-word ( lexer -- )
[
2dup nth CHAR: " eq? [ drop 1+ ] [ f skip ] if
] change-lexer-column ;
: still-parsing? ( lexer -- ? )
dup lexer-line swap lexer-text length <= ;
: still-parsing-line? ( lexer -- ? )
dup lexer-column swap lexer-line-length < ;
: (parse-token) ( lexer -- str )
[ lexer-column ] keep
[ skip-word ] keep
[ lexer-column ] keep
lexer-line-text subseq ;
: parse-token ( lexer -- str/f )
dup still-parsing? [
dup skip-blank
dup still-parsing-line?
[ (parse-token) ] [ dup next-line parse-token ] if
] [ drop f ] if ;
: scan ( -- str/f ) lexer get parse-token ;
ERROR: unexpected want got ;
GENERIC: expected>string ( obj -- str )
M: f expected>string drop "end of input" ;
M: word expected>string word-name ;
M: string expected>string ;
M: unexpected error.
"Expected " write
dup unexpected-want expected>string write
" but got " write
unexpected-got expected>string print ;
PREDICATE: unexpected-eof < unexpected
unexpected-got not ;
: unexpected-eof ( word -- * ) f unexpected ;
: (parse-tokens) ( accum end -- accum )
scan 2dup = [
2drop
] [
[ pick push (parse-tokens) ] [ unexpected-eof ] if*
] if ;
: parse-tokens ( end -- seq )
100 <vector> swap (parse-tokens) >array ;
TUPLE: lexer-error line column line-text error ;
: <lexer-error> ( msg -- error )
\ lexer-error new
lexer get
[ line>> >>line ]
[ column>> >>column ]
[ line-text>> >>line-text ]
tri
swap >>error ;
: lexer-dump ( error -- )
[ line>> number>string ": " append ]
[ line-text>> dup string? [ drop "" ] unless ]
[ column>> 0 or ] tri
pick length + CHAR: \s <string>
[ write ] [ print ] [ write "^" print ] tri* ;
M: lexer-error error.
[ lexer-dump ] [ error>> error. ] bi ;
M: lexer-error summary
error>> summary ;
M: lexer-error compute-restarts
error>> compute-restarts ;
M: lexer-error error-help
error>> error-help ;
: with-lexer ( lexer quot -- newquot )
[ lexer set ] dip [ <lexer-error> rethrow ] recover ; inline
SYMBOL: lexer-factory
[ <lexer> ] lexer-factory set-global

4
core/listener/listener.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel math math.parser memory
namespaces parser sequences strings io.styles
namespaces parser lexer sequences strings io.styles
vectors words generic system combinators continuations debugger
definitions compiler.units accessors ;
IN: listener
@ -51,7 +51,7 @@ SYMBOL: error-hook
listener-hook get call prompt.
[ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
[
dup parse-error? [
dup lexer-error? [
error-hook get call
] [
rethrow

152
core/parser/parser-docs.factor
View File

@ -1,7 +1,7 @@
USING: help.markup help.syntax kernel sequences words
math strings vectors quotations generic effects classes
vocabs.loader definitions io vocabs source-files
quotations namespaces compiler.units assocs ;
quotations namespaces compiler.units assocs lexer ;
IN: parser
ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
@ -135,25 +135,6 @@ $nl
{ $subsection "defining-words" }
{ $subsection "parsing-tokens" } ;
ARTICLE: "parser-lexer" "The lexer"
"Two variables that encapsulate internal parser state:"
{ $subsection file }
{ $subsection lexer }
"Creating a default lexer:"
{ $subsection <lexer> }
"A word to test of the end of input has been reached:"
{ $subsection still-parsing? }
"A word to advance the lexer to the next line:"
{ $subsection next-line }
"Two generic words to override the lexer's token boundary detection:"
{ $subsection skip-blank }
{ $subsection skip-word }
"A utility used when parsing string literals:"
{ $subsection parse-string }
"The parser can be invoked with a custom lexer:"
{ $subsection (parse-lines) }
{ $subsection with-parser } ;
ARTICLE: "parser-files" "Parsing source files"
"The parser can run source files:"
{ $subsection run-file }
@ -192,25 +173,6 @@ $nl
ABOUT: "parser"
: $parsing-note ( children -- )
drop
"This word should only be called from parsing words."
$notes ;
HELP: lexer
{ $var-description "Stores the current " { $link lexer } " instance." }
{ $class-description "An object for tokenizing parser input. It has the following slots:"
{ $list
{ { $link lexer-text } " - the lines being parsed; an array of strings" }
{ { $link lexer-line } " - the line number being parsed; unlike most indices this is 1-based for friendlier error reporting and integration with text editors" }
{ { $link lexer-column } " - the current column position, zero-based" }
}
"Custom lexing can be implemented by delegating a tuple to an instance of this class and implementing the " { $link skip-word } " and " { $link skip-blank } " generic words." } ;
HELP: <lexer>
{ $values { "text" "a sequence of strings" } { "lexer" lexer } }
{ $description "Creates a new lexer for tokenizing the given sequence of lines." } ;
HELP: location
{ $values { "loc" "a " { $snippet "{ path line# }" } " pair" } }
{ $description "Outputs the current parser location. This value can be passed to " { $link set-where } " or " { $link remember-definition } "." } ;
@ -226,73 +188,9 @@ HELP: parser-notes?
{ $values { "?" "a boolean" } }
{ $description "Tests if the parser will print various notes and warnings. To disable parser notes, either set " { $link parser-notes } " to " { $link f } ", or pass the " { $snippet "-quiet" } " command line switch." } ;
HELP: next-line
{ $values { "lexer" lexer } }
{ $description "Advances the lexer to the next input line, discarding the remainder of the current line." } ;
HELP: parse-error
{ $error-description "Thrown when the parser encounters invalid input. A parse error wraps an underlying error and holds the file being parsed, line number, and column number." } ;
HELP: <parse-error>
{ $values { "msg" "an error" } { "error" parse-error } }
{ $description "Creates a new " { $link parse-error } ", filling in the location information from the current " { $link lexer } "." } ;
HELP: skip
{ $values { "i" "a starting index" } { "seq" sequence } { "?" "a boolean" } { "n" integer } }
{ $description "Skips to the first space character (if " { $snippet "boolean" } " is " { $link f } ") or the first non-space character (otherwise)." } ;
HELP: change-lexer-column
{ $values { "lexer" lexer } { "quot" "a quotation with stack effect " { $snippet "( col line -- newcol )" } } }
{ $description "Applies a quotation to the current column and line text to produce a new column, and moves the lexer position." } ;
HELP: skip-blank
{ $values { "lexer" lexer } }
{ $contract "Skips whitespace characters." }
{ $notes "Custom lexers can implement this generic word." } ;
HELP: skip-word
{ $values { "lexer" lexer } }
{ $contract
"Skips until the end of the current token."
$nl
"The default implementation treats a single " { $snippet "\"" } " as a word by itself; otherwise it searches forward until a whitespace character or the end of the line."
}
{ $notes "Custom lexers can implement this generic word." } ;
HELP: still-parsing-line?
{ $values { "lexer" lexer } { "?" "a boolean" } }
{ $description "Outputs " { $link f } " if the end of the current line has been reached, " { $link t } " otherwise." } ;
HELP: parse-token
{ $values { "lexer" lexer } { "str/f" "a " { $link string } " or " { $link f } } }
{ $description "Reads the next token from the lexer. Tokens are delimited by whitespace, with the exception that " { $snippet "\"" } " is treated like a single token even when not followed by whitespace." } ;
HELP: scan
{ $values { "str/f" "a " { $link string } " or " { $link f } } }
{ $description "Reads the next token from the lexer. See " { $link parse-token } " for details." }
$parsing-note ;
HELP: bad-escape
{ $error-description "Indicates the parser encountered an invalid escape code following a backslash (" { $snippet "\\" } ") in a string literal. See " { $link "escape" } " for a list of valid escape codes." } ;
HELP: bad-number
{ $error-description "Indicates the parser encountered an invalid numeric literal." } ;
HELP: escape
{ $values { "escape" "a single-character escape" } { "ch" "a character" } }
{ $description "Converts from a single-character escape code and the corresponding character." }
{ $examples { $example "USING: kernel parser prettyprint ;" "CHAR: n escape CHAR: \\n = ." "t" } } ;
HELP: parse-string
{ $values { "str" "a new " { $link string } } }
{ $description "Parses the line until a quote (\"), interpreting escape codes along the way." }
{ $errors "Throws an error if the string contains an invalid escape sequence." }
$parsing-note ;
HELP: still-parsing?
{ $values { "lexer" lexer } { "?" "a boolean" } }
{ $description "Outputs " { $link f } " if end of input has been reached, " { $link t } " otherwise." } ;
HELP: use
{ $var-description "A variable holding the current vocabulary search path as a sequence of assocs." } ;
@ -338,12 +236,6 @@ HELP: create-in
{ $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." }
$parsing-note ;
HELP: parse-tokens
{ $values { "end" string } { "seq" "a new sequence of strings" } }
{ $description "Reads a sequence of tokens until the first occurrence of " { $snippet "end" } ". The tokens remain as strings and are not processed in any way." }
{ $examples "This word is used to implement " { $link POSTPONE: USING: } "." }
$parsing-note ;
HELP: CREATE
{ $values { "word" word } }
{ $description "Reads the next token from the line currently being parsed, and creates a word with that name in the current vocabulary." }
@ -369,31 +261,6 @@ HELP: scan-word
{ $errors "Throws an error if the token does not name a word, and does not parse as a number." }
$parsing-note ;
HELP: invalid-slot-name
{ $values { "name" string } }
{ $description "Throws an " { $link invalid-slot-name } " error." }
{ $error-description "Thrown by " { $link POSTPONE: TUPLE: } " and " { $link POSTPONE: ERROR: } " if a suspect token appears as a slot name." }
{ $notes "The suspect tokens are chosen so that the following code raises this parse error, instead of silently greating a tuple with garbage slots:"
{ $code
"TUPLE: my-mistaken-tuple slot-a slot-b"
""
": some-word ( a b c -- ) ... ;"
}
} ;
HELP: unexpected
{ $values { "want" "a " { $link word } " or " { $link f } } { "got" word } }
{ $description "Throws an " { $link unexpected } " error." }
{ $error-description "Thrown by the parser if an unmatched closing delimiter is encountered." }
{ $examples
"Parsing the following snippet will throw this error:"
{ $code "[ 1 2 3 }" }
} ;
HELP: unexpected-eof
{ $values { "word" "a " { $link word } } }
{ $description "Throws an " { $link unexpected } " error indicating the parser was looking for an occurrence of " { $snippet "word" } " but encountered end of file." } ;
HELP: parse-step
{ $values { "accum" vector } { "end" word } { "?" "a boolean" } }
{ $description "Parses a token. If the token is a number or an ordinary word, it is added to the accumulator. If it is a parsing word, calls the parsing word with the accumulator on the stack. Outputs " { $link f } " if " { $snippet "end" } " is encountered, " { $link t } " otherwise." }
@ -417,28 +284,15 @@ HELP: parsed
{ $description "Convenience word for parsing words. It behaves exactly the same as " { $link push } ", except the accumulator remains on the stack." }
$parsing-note ;
HELP: with-parser
{ $values { "lexer" lexer } { "quot" "a quotation with stack effect " { $snippet "( -- accum )" } } { "newquot" "a new " { $link quotation } } }
{ $description "Sets up the parser and calls the quotation. The quotation can make use of parsing words such as " { $link scan } " and " { $link parse-until } ". It must yield a sequence, which is converted to a quotation and output. Any errors thrown by the quotation are wrapped in parse errors." } ;
HELP: (parse-lines)
{ $values { "lexer" lexer } { "quot" "a new " { $link quotation } } }
{ $description "Parses Factor source code using a custom lexer. The vocabulary search path is taken from the current scope." }
{ $errors "Throws a " { $link parse-error } " if the input is malformed." } ;
{ $errors "Throws a " { $link lexer-error } " if the input is malformed." } ;
HELP: parse-lines
{ $values { "lines" "a sequence of strings" } { "quot" "a new " { $link quotation } } }
{ $description "Parses Factor source code which has been tokenized into lines. The vocabulary search path is taken from the current scope." }
{ $errors "Throws a " { $link parse-error } " if the input is malformed." } ;
HELP: lexer-factory
{ $var-description "A variable holding a quotation with stack effect " { $snippet "( lines -- lexer )" } ". This quotation is called by the parser to create " { $link lexer } " instances. This variable can be rebound to a quotation which outputs a custom tuple delegating to " { $link lexer } " to customize syntax." } ;
HELP: parse-effect
{ $values { "end" string } { "effect" "an instance of " { $link effect } } }
{ $description "Parses a stack effect from the current input line." }
{ $examples "This word is used by " { $link POSTPONE: ( } " and " { $link POSTPONE: (( } " to parse stack effect declarations." }
$parsing-note ;
{ $errors "Throws a " { $link lexer-error } " if the input is malformed." } ;
HELP: parse-base
{ $values { "base" "an integer between 2 and 36" } { "parsed" integer } }

6
core/parser/parser-tests.factor
View File

@ -485,3 +485,9 @@ must-fail-with
[ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
[ "DEFER: blah" eval ] [ error>> no-current-vocab? ] must-fail-with
[
"IN: parser.tests : blah ; parsing FORGET: blah" eval
] [
error>> staging-violation?
] must-fail-with

318
core/parser/parser.factor
View File

@ -4,38 +4,17 @@ USING: arrays definitions generic assocs kernel math namespaces
prettyprint sequences strings vectors words quotations inspector
io.styles io combinators sorting splitting math.parser effects
continuations debugger io.files io.streams.string vocabs
io.encodings.utf8 source-files classes classes.tuple hashtables
compiler.errors compiler.units accessors sets ;
io.encodings.utf8 source-files classes hashtables
compiler.errors compiler.units accessors sets lexer ;
IN: parser
TUPLE: lexer text line line-text line-length column ;
: next-line ( lexer -- )
dup [ line>> ] [ text>> ] bi ?nth >>line-text
dup line-text>> length >>line-length
[ 1+ ] change-line
0 >>column
drop ;
: new-lexer ( text class -- lexer )
new
0 >>line
swap >>text
dup next-line ; inline
: <lexer> ( text -- lexer )
lexer new-lexer ;
: location ( -- loc )
file get lexer get lexer-line 2dup and
[ >r source-file-path r> 2array ] [ 2drop f ] if ;
file get lexer get line>> 2dup and
[ >r path>> r> 2array ] [ 2drop f ] if ;
: save-location ( definition -- )
location remember-definition ;
: save-class-location ( class -- )
location remember-class ;
SYMBOL: parser-notes
t parser-notes set-global
@ -43,13 +22,6 @@ t parser-notes set-global
: parser-notes? ( -- ? )
parser-notes get "quiet" get not and ;
: file. ( file -- )
[
source-file-path <pathname> pprint
] [
"<interactive>" write
] if* ":" write ;
: note. ( str -- )
parser-notes? [
file get file.
@ -61,143 +33,9 @@ t parser-notes set-global
"Note: " write dup print
] when drop ;
: skip ( i seq ? -- n )
over >r
[ swap CHAR: \s eq? xor ] curry find-from drop
[ r> drop ] [ r> length ] if* ;
: change-lexer-column ( lexer quot -- )
swap
[ dup lexer-column swap lexer-line-text rot call ] keep
set-lexer-column ; inline
GENERIC: skip-blank ( lexer -- )
M: lexer skip-blank ( lexer -- )
[ t skip ] change-lexer-column ;
GENERIC: skip-word ( lexer -- )
M: lexer skip-word ( lexer -- )
[
2dup nth CHAR: " eq? [ drop 1+ ] [ f skip ] if
] change-lexer-column ;
: still-parsing? ( lexer -- ? )
dup lexer-line swap lexer-text length <= ;
: still-parsing-line? ( lexer -- ? )
dup lexer-column swap lexer-line-length < ;
: (parse-token) ( lexer -- str )
[ lexer-column ] keep
[ skip-word ] keep
[ lexer-column ] keep
lexer-line-text subseq ;
: parse-token ( lexer -- str/f )
dup still-parsing? [
dup skip-blank
dup still-parsing-line?
[ (parse-token) ] [ dup next-line parse-token ] if
] [ drop f ] if ;
: scan ( -- str/f ) lexer get parse-token ;
ERROR: bad-escape ;
M: bad-escape summary drop "Bad escape code" ;
: escape ( escape -- ch )
H{
{ CHAR: a CHAR: \a }
{ CHAR: e CHAR: \e }
{ CHAR: n CHAR: \n }
{ CHAR: r CHAR: \r }
{ CHAR: t CHAR: \t }
{ CHAR: s CHAR: \s }
{ CHAR: \s CHAR: \s }
{ CHAR: 0 CHAR: \0 }
{ CHAR: \\ CHAR: \\ }
{ CHAR: \" CHAR: \" }
} at [ bad-escape ] unless* ;
SYMBOL: name>char-hook
name>char-hook global [
[ "Unicode support not available" throw ] or
] change-at
: unicode-escape ( str -- ch str' )
"{" ?head-slice [
CHAR: } over index cut-slice
>r >string name>char-hook get call r>
rest-slice
] [
6 cut-slice >r hex> r>
] if ;
: next-escape ( str -- ch str' )
"u" ?head-slice [
unicode-escape
] [
unclip-slice escape swap
] if ;
: (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [
>r cut-slice >r % r> rest-slice r>
dup CHAR: " = [
drop slice-from
] [
drop next-escape >r , r> (parse-string)
] if
] [
"Unterminated string" throw
] if ;
: parse-string ( -- str )
lexer get [
[ swap tail-slice (parse-string) ] "" make swap
] change-lexer-column ;
TUPLE: parse-error file line column line-text error ;
: <parse-error> ( msg -- error )
\ parse-error new
file get >>file
lexer get line>> >>line
lexer get column>> >>column
lexer get line-text>> >>line-text
swap >>error ;
: parse-dump ( error -- )
{
[ file>> file. ]
[ line>> number>string print ]
[ line-text>> dup string? [ print ] [ drop ] if ]
[ column>> 0 or CHAR: \s <string> write ]
} cleave
"^" print ;
M: parse-error error.
[ parse-dump ] [ error>> error. ] bi ;
M: parse-error summary
error>> summary ;
M: parse-error compute-restarts
error>> compute-restarts ;
M: parse-error error-help
error>> error-help ;
SYMBOL: use
SYMBOL: in
: word/vocab% ( word -- )
"(" % dup word-vocabulary % " " % word-name % ")" % ;
: (use+) ( vocab -- )
vocab-words use get push ;
@ -216,25 +54,8 @@ SYMBOL: in
: set-in ( name -- )
check-vocab-string dup in set create-vocab (use+) ;
ERROR: unexpected want got ;
PREDICATE: unexpected-eof < unexpected
unexpected-got not ;
M: parsing-word stack-effect drop (( parsed -- parsed )) ;
: unexpected-eof ( word -- * ) f unexpected ;
: (parse-tokens) ( accum end -- accum )
scan 2dup = [
2drop
] [
[ pick push (parse-tokens) ] [ unexpected-eof ] if*
] if ;
: parse-tokens ( end -- seq )
100 <vector> swap (parse-tokens) >array ;
ERROR: no-current-vocab ;
M: no-current-vocab summary ( obj -- )
@ -248,18 +69,8 @@ M: no-current-vocab summary ( obj -- )
: CREATE ( -- word ) scan create-in ;
: CREATE-GENERIC ( -- word ) CREATE dup reset-word ;
: CREATE-WORD ( -- word ) CREATE dup reset-generic ;
: create-class-in ( word -- word )
current-vocab create
dup save-class-location
dup predicate-word dup set-word save-location ;
: CREATE-CLASS ( -- word )
scan create-class-in ;
: word-restarts ( possibilities -- restarts )
natural-sort [
[ "Use the word " swap summary append ] keep
@ -296,62 +107,6 @@ M: no-word-error summary
] ?if
] when ;
: create-method-in ( class generic -- method )
create-method f set-word dup save-location ;
: CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ;
: shadowed-slots ( superclass slots -- shadowed )
>r all-slot-names r> intersect ;
: check-slot-shadowing ( class superclass slots -- )
shadowed-slots [
[
"Definition of slot ``" %
%
"'' in class ``" %
word-name %
"'' shadows a superclass slot" %
] "" make note.
] with each ;
ERROR: invalid-slot-name name ;
M: invalid-slot-name summary
drop
"Invalid slot name" ;
: (parse-tuple-slots) ( -- )
#! This isn't meant to enforce any kind of policy, just
#! to check for mistakes of this form:
#!
#! TUPLE: blahblah foo bing
#!
#! : ...
scan {
{ [ dup not ] [ unexpected-eof ] }
{ [ dup { ":" "(" "<" } member? ] [ invalid-slot-name ] }
{ [ dup ";" = ] [ drop ] }
[ , (parse-tuple-slots) ]
} cond ;
: parse-tuple-slots ( -- seq )
[ (parse-tuple-slots) ] { } make ;
: parse-tuple-definition ( -- class superclass slots )
CREATE-CLASS
scan {
{ ";" [ tuple f ] }
{ "<" [ scan-word parse-tuple-slots ] }
[ >r tuple parse-tuple-slots r> prefix ]
} case 3dup check-slot-shadowing ;
ERROR: not-in-a-method-error ;
M: not-in-a-method-error summary
drop "call-next-method can only be called in a method definition" ;
ERROR: staging-violation word ;
M: staging-violation summary
@ -362,6 +117,10 @@ M: staging-violation summary
dup changed-definitions get key? [ staging-violation ] when
execute ;
: scan-object ( -- object )
scan-word dup parsing-word?
[ V{ } clone swap execute-parsing first ] when ;
: parse-step ( accum end -- accum ? )
scan-word {
{ [ 2dup eq? ] [ 2drop f ] }
@ -379,37 +138,12 @@ M: staging-violation summary
: parsed ( accum obj -- accum ) over push ;
: with-parser ( lexer quot -- newquot )
swap lexer set
[ call >quotation ] [ <parse-error> rethrow ] recover ;
: (parse-lines) ( lexer -- quot )
[ f parse-until ] with-parser ;
SYMBOL: lexer-factory
[ <lexer> ] lexer-factory set-global
[ f parse-until >quotation ] with-lexer ;
: parse-lines ( lines -- quot )
lexer-factory get call (parse-lines) ;
! Parsing word utilities
: parse-effect ( end -- effect )
parse-tokens dup { "(" "((" } intersect empty? [
{ "--" } split1 dup [
<effect>
] [
"Stack effect declaration must contain --" throw
] if
] [
"Stack effect declaration must not contain ( or ((" throw
] if ;
ERROR: bad-number ;
: parse-base ( parsed base -- parsed )
scan swap base> [ bad-number ] unless* parsed ;
: parse-literal ( accum end quot -- accum )
>r parse-until r> call parsed ; inline
@ -418,40 +152,14 @@ ERROR: bad-number ;
: (:) ( -- word def ) CREATE-WORD parse-definition ;
SYMBOL: current-class
SYMBOL: current-generic
: with-method-definition ( quot -- parsed )
[
>r
[ "method-class" word-prop current-class set ]
[ "method-generic" word-prop current-generic set ]
[ ] tri
r> call
] with-scope ; inline
: (M:) ( method def -- )
CREATE-METHOD [ parse-definition ] with-method-definition ;
: scan-object ( -- object )
scan-word dup parsing-word?
[ V{ } clone swap execute first ] when ;
GENERIC: expected>string ( obj -- str )
M: f expected>string drop "end of input" ;
M: word expected>string word-name ;
M: string expected>string ;
M: unexpected error.
"Expected " write
dup unexpected-want expected>string write
" but got " write
unexpected-got expected>string print ;
ERROR: bad-number ;
M: bad-number summary
drop "Bad number literal" ;
: parse-base ( parsed base -- parsed )
scan swap base> [ bad-number ] unless* parsed ;
SYMBOL: bootstrap-syntax
: with-file-vocabs ( quot -- )

27
core/source-files/source-files.factor
View File

@ -75,11 +75,36 @@ M: pathname forget*
SYMBOL: file
TUPLE: source-file-error file error ;
: <source-file-error> ( msg -- error )
\ source-file-error new
file get >>file
swap >>error ;
: file. ( file -- ) path>> <pathname> pprint ;
M: source-file-error error.
"Error while parsing " write
[ file>> file. nl ] [ error>> error. ] bi ;
M: source-file-error summary
error>> summary ;
M: source-file-error compute-restarts
error>> compute-restarts ;
M: source-file-error error-help
error>> error-help ;
: with-source-file ( name quot -- )
#! Should be called from inside with-compilation-unit.
[
swap source-file
dup file set
source-file-definitions old-definitions set
[ ] [ file get rollback-source-file ] cleanup
[
file get rollback-source-file
<source-file-error> rethrow
] recover
] with-scope ; inline

16
core/strings/parser/parser-docs.factor Normal file
View File

@ -0,0 +1,16 @@
USING: help.markup help.syntax strings lexer ;
IN: strings.parser
HELP: bad-escape
{ $error-description "Indicates the parser encountered an invalid escape code following a backslash (" { $snippet "\\" } ") in a string literal. See " { $link "escape" } " for a list of valid escape codes." } ;
HELP: escape
{ $values { "escape" "a single-character escape" } { "ch" "a character" } }
{ $description "Converts from a single-character escape code and the corresponding character." }
{ $examples { $example "USING: kernel parser prettyprint ;" "CHAR: n escape CHAR: \\n = ." "t" } } ;
HELP: parse-string
{ $values { "str" "a new " { $link string } } }
{ $description "Parses the line until a quote (\"), interpreting escape codes along the way." }
{ $errors "Throws an error if the string contains an invalid escape sequence." }
$parsing-note ;

62
core/strings/parser/parser.factor Normal file
View File

@ -0,0 +1,62 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel inspector assocs namespaces splitting sequences
strings math.parser lexer ;
IN: strings.parser
ERROR: bad-escape ;
M: bad-escape summary drop "Bad escape code" ;
: escape ( escape -- ch )
H{
{ CHAR: a CHAR: \a }
{ CHAR: e CHAR: \e }
{ CHAR: n CHAR: \n }
{ CHAR: r CHAR: \r }
{ CHAR: t CHAR: \t }
{ CHAR: s CHAR: \s }
{ CHAR: \s CHAR: \s }
{ CHAR: 0 CHAR: \0 }
{ CHAR: \\ CHAR: \\ }
{ CHAR: \" CHAR: \" }
} at [ bad-escape ] unless* ;
SYMBOL: name>char-hook
name>char-hook global [
[ "Unicode support not available" throw ] or
] change-at
: unicode-escape ( str -- ch str' )
"{" ?head-slice [
CHAR: } over index cut-slice
>r >string name>char-hook get call r>
rest-slice
] [
6 cut-slice >r hex> r>
] if ;
: next-escape ( str -- ch str' )
"u" ?head-slice [
unicode-escape
] [
unclip-slice escape swap
] if ;
: (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [
>r cut-slice >r % r> rest-slice r>
dup CHAR: " = [
drop slice-from
] [
drop next-escape >r , r> (parse-string)
] if
] [
"Unterminated string" throw
] if ;
: parse-string ( -- str )
lexer get [
[ swap tail-slice (parse-string) ] "" make swap
] change-lexer-column ;

15
core/syntax/syntax.factor
View File

@ -1,13 +1,14 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays bit-arrays byte-arrays byte-vectors
definitions generic hashtables kernel math
namespaces parser sequences strings sbufs vectors words
quotations io assocs splitting classes.tuple generic.standard
generic.math classes io.files vocabs float-arrays
classes.union classes.intersection classes.mixin
classes.predicate classes.singleton compiler.units
combinators debugger ;
definitions generic hashtables kernel math namespaces parser
lexer sequences strings strings.parser sbufs vectors
words quotations io assocs splitting classes.tuple
generic.standard generic.math generic.parser classes io.files
vocabs float-arrays classes.parser classes.union
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple.parser compiler.units
combinators debugger effects.parser ;
IN: bootstrap.syntax
! These words are defined as a top-level form, instead of with

2
extra/bitfields/bitfields.factor
View File

@ -1,4 +1,4 @@
USING: parser kernel math sequences namespaces assocs inspector
USING: parser lexer kernel math sequences namespaces assocs inspector
words splitting math.parser arrays sequences.next mirrors
shuffle compiler.units ;
IN: bitfields

2
extra/bootstrap/unicode/unicode.factor
View File

@ -1,4 +1,4 @@
USING: parser kernel namespaces ;
USING: strings.parser kernel namespaces ;
USE: unicode.breaks
USE: unicode.case

3
extra/cocoa/cocoa.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: compiler io kernel cocoa.runtime cocoa.subclassing
cocoa.messages cocoa.types sequences words vocabs parser
core-foundation namespaces assocs hashtables compiler.units ;
core-foundation namespaces assocs hashtables compiler.units
lexer ;
IN: cocoa
: (remember-send) ( selector variable -- )

2
extra/cpu/8080/emulator/emulator.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel math sequences words arrays io io.files namespaces
math.parser assocs quotations parser parser-combinators
math.parser assocs quotations parser lexer parser-combinators
tools.time io.encodings.binary sequences.deep symbols combinators ;
IN: cpu.8080.emulator

4
extra/editors/editors-docs.factor
View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax parser vocabs.loader ;
USING: help.markup help.syntax parser source-files vocabs.loader ;
IN: editors
ARTICLE: "editor" "Editor integration"
@ -35,4 +35,4 @@ HELP: no-edit-hook
{ $error-description "Thrown when " { $link edit } " is called when the " { $link edit-hook } " variable is not set. See " { $link "editor" } "." } ;
HELP: :edit
{ $description "If the most recent error was a " { $link parse-error } " thrown while parsing a source file, opens the source file at the failing line in the default editor using the " { $link edit-hook } ". See " { $link "editor" } "." } ;
{ $description "If the most recent error was a " { $link source-file-error } " thrown while parsing a source file, opens the source file at the failing line in the default editor using the " { $link edit-hook } ". See " { $link "editor" } "." } ;

34
extra/editors/editors.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel namespaces sequences definitions io.files
inspector continuations tools.crossref tools.vocabs
io prettyprint source-files assocs vocabs vocabs.loader
io.backend splitting accessors ;
USING: parser lexer kernel namespaces sequences definitions
io.files inspector continuations tools.crossref tools.vocabs io
prettyprint source-files assocs vocabs vocabs.loader io.backend
splitting accessors ;
IN: editors
TUPLE: no-edit-hook ;
@ -35,21 +35,27 @@ SYMBOL: edit-hook
: edit-vocab ( name -- )
vocab-source-path 1 edit-location ;
GENERIC: find-parse-error ( error -- error' )
GENERIC: error-file ( error -- file )
M: parse-error find-parse-error
dup error>> find-parse-error [ ] [ ] ?if ;
GENERIC: error-line ( error -- line )
M: condition find-parse-error
error>> find-parse-error ;
M: lexer-error error-line line>> ;
M: object find-parse-error
drop f ;
M: source-file-error error-file file>> path>> ;
M: source-file-error error-line error>> error-line ;
M: condition error-file error>> error-file ;
M: condition error-line error>> error-line ;
M: object error-file drop f ;
M: object error-line drop f ;
: :edit ( -- )
error get find-parse-error [
[ file>> path>> ] [ line>> ] bi edit-location
] when* ;
error get [ error-file ] [ error-line ] bi
2dup and [ edit-location ] [ 2drop ] if ;
: edit-each ( seq -- )
[

3
extra/gesture-logger/gesture-logger.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io kernel prettyprint ui ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.theme ui.gestures colors ;
ui.gadgets.scrollers ui.gadgets.theme ui.gestures colors
accessors ;
IN: gesture-logger
TUPLE: gesture-logger stream ;

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

@ -3,7 +3,7 @@ namespaces words sequences classes assocs vocabs kernel arrays
prettyprint.backend kernel.private io generic math system
strings sbufs vectors byte-arrays bit-arrays float-arrays
quotations io.streams.byte-array io.encodings.string
classes.builtin parser ;
classes.builtin parser lexer ;
IN: help.handbook
ARTICLE: "conventions" "Conventions"

2
extra/html/templates/chloe/syntax/syntax.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: html.templates.chloe.syntax
USING: accessors kernel sequences combinators kernel namespaces
classes.tuple assocs splitting words arrays memoize parser
classes.tuple assocs splitting words arrays memoize parser lexer
io io.files io.encodings.utf8 io.streams.string
unicode.case tuple-syntax mirrors fry math urls
multiline xml xml.data xml.writer xml.utilities

6
extra/html/templates/fhtml/fhtml.factor
View File

@ -4,7 +4,7 @@
USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting
accessors assocs fry
parser io io.files io.streams.string io.encodings.utf8
parser lexer io io.files io.streams.string io.encodings.utf8
html.elements
html.templates ;
IN: html.templates.fhtml
@ -55,8 +55,8 @@ DEFER: <% delimiter
: parse-template-lines ( lines -- quot )
<template-lexer> [
V{ } clone lexer get parse-%> f (parse-until)
] with-parser ;
V{ } clone lexer get parse-%> f (parse-until) >quotation
] with-lexer ;
: parse-template ( string -- quot )
[

6
extra/http/http-tests.factor
View File

@ -5,6 +5,12 @@ assocs io.sockets db db.sqlite continuations urls hashtables
accessors ;
IN: http.tests
[ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
[ "text/html" utf8 ] [ "text/html; charset=UTF-8" parse-content-type ] unit-test
[ "application/octet-stream" binary ] [ "application/octet-stream" parse-content-type ] unit-test
: lf>crlf "\n" split "\r\n" join ;
STRING: read-request-test-1

5
extra/http/http.factor
View File

@ -211,7 +211,8 @@ TUPLE: post-data raw content content-type ;
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding )
";" split1 parse-content-type-attributes "charset" swap at ;
";" split1 parse-content-type-attributes "charset" swap at
name>encoding over "text/" head? latin1 binary ? or ;
: read-request ( -- request )
<request>
@ -310,7 +311,7 @@ M: response clone
dup "content-type" header [
parse-content-type
[ >>content-type ]
[ name>encoding binary or >>content-charset ] bi*
[ >>content-charset ] bi*
] when* ;
: read-response ( -- response )

9
extra/io/encodings/8-bit/8-bit-docs.factor
View File

@ -24,20 +24,13 @@ ARTICLE: "io.encodings.8-bit" "8-bit encodings"
{ $subsection koi8-r }
{ $subsection windows-1252 }
{ $subsection ebcdic }
{ $subsection mac-roman }
"Words used in defining these"
{ $subsection 8-bit }
{ $subsection define-8-bit-encoding } ;
{ $subsection mac-roman } ;
ABOUT: "io.encodings.8-bit"
HELP: 8-bit
{ $class-description "Describes an 8-bit encoding, including its name (a symbol) and a table used for encoding and decoding." } ;
HELP: define-8-bit-encoding
{ $values { "name" string } { "stream" "an input stream" } }
{ $description "Creates a new encoding. The stream should be in a similar format to those at " { $url "ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/" } } ;
HELP: latin1
{ $description "This is the ISO-8859-1 encoding, also called Latin-1: Western European. It is an 8-bit superset of ASCII which is the default for a mimetype starting with 'text' and provides the characters necessary for most western European languages." }
{ $see-also "encodings-introduction" } ;

4
extra/locals/locals.factor
View File

@ -4,8 +4,8 @@ USING: kernel namespaces sequences sequences.private assocs math
inference.transforms parser words quotations debugger macros
arrays macros splitting combinators prettyprint.backend
definitions prettyprint hashtables prettyprint.sections sets
sequences.private effects generic compiler.units accessors
locals.backend memoize ;
sequences.private effects effects.parser generic generic.parser
compiler.units accessors locals.backend memoize lexer ;
IN: locals
! Inspired by

2
extra/match/match.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
! Based on pattern matching code from Paul Graham's book 'On Lisp'.
USING: parser kernel words namespaces sequences classes.tuple
USING: parser lexer kernel words namespaces sequences classes.tuple
combinators macros assocs math effects ;
IN: match

2
extra/money/money.factor
View File

@ -1,4 +1,4 @@
USING: io kernel math math.functions math.parser parser
USING: io kernel math math.functions math.parser parser lexer
namespaces sequences splitting grouping combinators
continuations sequences.lib ;
IN: money

2
extra/mortar/mortar.factor
View File

@ -1,5 +1,5 @@
USING: kernel io parser words namespaces quotations arrays assocs sequences
USING: kernel io parser lexer words namespaces quotations arrays assocs sequences
splitting grouping math shuffle ;
IN: mortar

2
extra/multiline/multiline.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces parser kernel sequences words quotations math ;
USING: namespaces parser lexer kernel sequences words quotations math ;
IN: multiline
: next-line-text ( -- str )

2
extra/opengl/gl/extensions/extensions.factor
View File

@ -1,6 +1,6 @@
USING: alien alien.syntax combinators kernel parser sequences
system words namespaces hashtables init math arrays assocs
continuations ;
continuations lexer ;
IN: opengl.gl.extensions
ERROR: unknown-gl-platform ;

2
extra/openssl/libssl/libssl.factor
View File

@ -2,7 +2,7 @@
! Portions copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax combinators kernel system namespaces
assocs parser sequences words quotations math.bitfields ;
assocs parser lexer sequences words quotations math.bitfields ;
IN: openssl.libssl

6
extra/qualified/qualified.factor
View File

@ -1,5 +1,7 @@
USING: kernel sequences assocs hashtables parser vocabs words namespaces
vocabs.loader debugger sets ;
! Copyright (C) 2007, 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences assocs hashtables parser lexer
vocabs words namespaces vocabs.loader debugger sets ;
IN: qualified
: define-qualified ( vocab-name prefix-name -- )

2
extra/regexp/regexp.factor
View File

@ -1,5 +1,5 @@
USING: arrays combinators kernel lists math math.parser
namespaces parser parser-combinators parser-combinators.simple
namespaces parser lexer parser-combinators parser-combinators.simple
promises quotations sequences combinators.lib strings math.order
assocs prettyprint.backend memoize unicode.case unicode.categories ;
USE: io

2
extra/semantic-db/semantic-db.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators combinators.cleave combinators.lib
continuations db db.tuples db.types db.sqlite kernel math
math.parser namespaces parser sets sequences sequences.deep
math.parser namespaces parser lexer sets sequences sequences.deep
sequences.lib strings words destructors ;
IN: semantic-db

2
extra/state-machine/state-machine.factor
View File

@ -1,4 +1,4 @@
USING: kernel parser strings math namespaces sequences words io
USING: kernel parser lexer strings math namespaces sequences words io
arrays quotations debugger kernel.private sequences.private ;
IN: state-machine

3
extra/symbols/symbols.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: parser sequences words kernel classes.singleton ;
USING: parser lexer sequences words kernel classes.singleton
classes.parser ;
IN: symbols
: SYMBOLS:

6
extra/tools/deploy/shaker/shaker.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: qualified io.streams.c init fry namespaces assocs kernel
parser tools.deploy.config vocabs sequences words words.private
memory kernel.private continuations io prettyprint
vocabs.loader debugger system strings sets ;
parser lexer strings.parser tools.deploy.config vocabs sequences
words words.private memory kernel.private continuations io
prettyprint vocabs.loader debugger system strings sets ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes
QUALIFIED: command-line

2
extra/tuple-syntax/tuple-syntax.factor
View File

@ -1,4 +1,4 @@
USING: kernel sequences slots parser words classes
USING: kernel sequences slots parser lexer words classes
slots.private mirrors ;
IN: tuple-syntax

6
extra/ui/tools/interactor/interactor.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators continuations documents
hashtables io io.styles kernel math math.order math.vectors
models namespaces parser prettyprint quotations sequences
models namespaces parser lexer prettyprint quotations sequences
strings threads listener classes.tuple ui.commands ui.gadgets
ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
ui.gestures definitions calendar concurrency.flags
@ -149,7 +149,7 @@ M: interactor dispose drop ;
mark>caret ;
: handle-parse-error ( interactor error -- )
dup parse-error? [ 2dup go-to-error error>> ] when
dup lexer-error? [ 2dup go-to-error error>> ] when
swap find-workspace debugger-popup ;
: try-parse ( lines interactor -- quot/error/f )
@ -157,7 +157,7 @@ M: interactor dispose drop ;
drop parse-lines-interactive
] [
2nip
dup parse-error? [
dup lexer-error? [
dup error>> unexpected-eof? [ drop f ] when
] when
] recover ;

2
extra/unicode/syntax/syntax.factor
View File

@ -1,4 +1,4 @@
USING: unicode.data kernel math sequences parser bit-arrays
USING: unicode.data kernel math sequences parser lexer bit-arrays
namespaces sequences.private arrays quotations assocs
classes.predicate math.order ;
IN: unicode.syntax

16
extra/urls/urls.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel unicode.categories combinators sequences splitting
USING: kernel unicode.categories combinators combinators.lib
sequences splitting
fry namespaces assocs arrays strings io.sockets
io.sockets.secure io.encodings.string io.encodings.utf8
math math.parser accessors mirrors parser
math math.parser accessors mirrors parser strings.parser lexer
prettyprint.backend hashtables present ;
IN: urls
@ -11,12 +12,11 @@ IN: urls
#! In a URL, can this character be used without
#! URL-encoding?
{
{ [ dup letter? ] [ t ] }
{ [ dup LETTER? ] [ t ] }
{ [ dup digit? ] [ t ] }
{ [ dup "/_-." member? ] [ t ] }
[ f ]
} cond nip ; foldable
[ letter? ]
[ LETTER? ]
[ digit? ]
[ "/_-." member? ]
} 1|| ; foldable
<PRIVATE

2
extra/vars/vars.factor
View File

@ -2,7 +2,7 @@
! Thanks to Mackenzie Straight for the idea
USING: kernel parser words namespaces sequences quotations ;
USING: kernel parser lexer words namespaces sequences quotations ;
IN: vars

4
extra/xml/generator/generator.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel xml.data xml.utilities assocs splitting
sequences parser quotations sequences.lib xml.utilities ;
sequences parser lexer quotations sequences.lib xml.utilities ;
IN: xml.generator
: comment, ( string -- ) <comment> , ;
@ -36,7 +36,7 @@ IN: xml.generator
[ \ contained*, parsed ] [
scan-word \ [ =
[ POSTPONE: [ \ tag*, parsed ]
[ "Expected [ missing" <parse-error> throw ] if
[ "Expected [ missing" throw ] if
] if ;
DEFER: >>

2
extra/xml/utilities/utilities.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences words io assocs
quotations strings parser arrays xml.data xml.writer debugger
quotations strings parser lexer arrays xml.data xml.writer debugger
splitting vectors sequences.deep ;
IN: xml.utilities

2
extra/xmode/loader/syntax/syntax.factor
View File

@ -1,6 +1,6 @@
USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
xml.utilities xml assocs kernel combinators sequences
math.parser namespaces parser xmode.utilities regexp io.files ;
math.parser namespaces parser lexer xmode.utilities regexp io.files ;
IN: xmode.loader.syntax
SYMBOL: ignore-case?

2
extra/xmode/utilities/utilities.factor
View File

@ -1,5 +1,5 @@
USING: sequences assocs kernel quotations namespaces xml.data
xml.utilities combinators macros parser words ;
xml.utilities combinators macros parser lexer words ;
IN: xmode.utilities
: implies >r not r> or ; inline