diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index d8d6c9b7bc..ae38925c68 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -136,8 +136,6 @@ ARTICLE: "parser-lexer" "The lexer" { $subsection } "A word to test of the end of input has been reached:" { $subsection still-parsing? } -"A word to get the text of the current line:" -{ $subsection line-text } "A word to advance the lexer to the next line:" { $subsection next-line } "Two generic words to override the lexer's token boundary detection:" @@ -222,10 +220,6 @@ HELP: { $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: line-text -{ $values { "lexer" lexer } { "str" string } } -{ $description "Outputs the text of the line being parsed." } ; - HELP: skip { $values { "i" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "n" integer } } { $description "Variant of " { $link find* } " that outputs the length of the sequence instead of " { $link f } " if no elements satisfy the predicate." } ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 6d7ad47843..59d18dc734 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -8,12 +8,17 @@ io.files io.streams.string io.streams.lines vocabs source-files classes hashtables compiler.errors compiler.units ; IN: parser -TUPLE: lexer text line column ; +TUPLE: lexer text line line-text line-length column ; -: ( text -- lexer ) 1 0 lexer construct-boa ; +: next-line ( lexer -- ) + 0 over set-lexer-column + dup lexer-line over lexer-text ?nth over set-lexer-line-text + dup lexer-line-text length over set-lexer-line-length + dup lexer-line 1+ swap set-lexer-line ; -: line-text ( lexer -- str ) - dup lexer-line 1- swap lexer-text ?nth ; +: ( text -- lexer ) + 0 { set-lexer-text set-lexer-line } lexer construct + dup lexer-text empty? [ dup next-line ] unless ; : location ( -- loc ) file get lexer get lexer-line 2dup and @@ -50,18 +55,14 @@ t parser-notes set-global "Note: " write dup print ] when drop ; -: next-line ( lexer -- ) - 0 over set-lexer-column - dup lexer-line 1+ swap set-lexer-line ; - : skip ( i seq ? -- n ) over >r [ swap CHAR: \s eq? xor ] curry find* drop - [ r> drop ] [ r> length ] if* ; inline + [ r> drop ] [ r> length ] if* ; : change-column ( lexer quot -- ) swap - [ dup lexer-column swap line-text rot call ] keep + [ dup lexer-column swap lexer-line-text rot call ] keep set-lexer-column ; inline GENERIC: skip-blank ( lexer -- ) @@ -73,20 +74,20 @@ GENERIC: skip-word ( lexer -- ) M: lexer skip-word ( lexer -- ) [ - 2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if + 2dup nth CHAR: " eq? [ drop 1+ ] [ f skip ] if ] change-column ; : still-parsing? ( lexer -- ? ) dup lexer-line swap lexer-text length <= ; : still-parsing-line? ( lexer -- ? ) - dup lexer-column swap line-text length < ; + dup lexer-column swap lexer-line-length < ; : (parse-token) ( lexer -- str ) [ lexer-column ] keep [ skip-word ] keep [ lexer-column ] keep - line-text subseq ; + lexer-line-text subseq ; : parse-token ( lexer -- str/f ) dup still-parsing? [ @@ -139,9 +140,8 @@ TUPLE: parse-error file line col text ; : ( msg -- error ) file get - lexer get lexer-line - lexer get lexer-column - lexer get line-text + lexer get + { lexer-line lexer-column lexer-line-text } get-slots parse-error construct-boa [ set-delegate ] keep ; @@ -239,22 +239,25 @@ M: no-word summary word-restarts throw-restarts dup word-vocabulary (use+) ; -: check-forward ( str word -- word ) +: check-forward ( str word -- word/f ) dup forward-reference? [ drop - dup use get + use get [ at ] with map [ ] subset [ forward-reference? not ] find nip - [ ] [ no-word ] ?if ] [ nip ] if ; -: search ( str -- word ) - dup use get assoc-stack [ check-forward ] [ no-word ] if* ; +: search ( str -- word/f ) + dup use get assoc-stack check-forward ; : scan-word ( -- word/number/f ) - scan dup [ dup string>number [ ] [ search ] ?if ] when ; + scan dup [ + dup search [ ] [ + dup string>number [ ] [ no-word ] ?if + ] ?if + ] when ; TUPLE: staging-violation word ; diff --git a/extra/multiline/multiline.factor b/extra/multiline/multiline.factor old mode 100644 new mode 100755 index 7f831e5351..9a6d052b60 --- a/extra/multiline/multiline.factor +++ b/extra/multiline/multiline.factor @@ -4,7 +4,7 @@ USING: namespaces parser kernel sequences words quotations math ; IN: multiline : next-line-text ( -- str ) - lexer get dup next-line line-text ; + lexer get dup next-line lexer-line-text ; : (parse-here) ( -- ) next-line-text dup ";" = @@ -19,7 +19,7 @@ IN: multiline parse-here 1quotation define ; parsing : (parse-multiline-string) ( start-index end-text -- end-index ) - lexer get line-text 2dup start + lexer get lexer-line-text 2dup start [ rot dupd >r >r swap subseq % r> r> length + ] [ rot tail % "\n" % 0 lexer get next-line swap (parse-multiline-string)