parser cleanup
parent
b0e89c4984
commit
98ef77d057
|
@ -1,5 +1,6 @@
|
|||
+ 0.80:
|
||||
|
||||
- make = for sequences more efficient
|
||||
- zero-height gadgets mess up hit testing
|
||||
- does parsing cons excessive amounts of bignums with c-streams
|
||||
- -with combinators are awkward
|
||||
|
|
|
@ -283,12 +283,12 @@ num-types <array> builtins set
|
|||
"fixnum?" "math" create t "inline" set-word-prop
|
||||
"fixnum" "math" create 0 "fixnum?" "math" create { } define-builtin
|
||||
"fixnum" "math" create 0 "math-priority" set-word-prop
|
||||
"fixnum" "math" create ">fixnum" [ "math" ] search unit "coercer" set-word-prop
|
||||
"fixnum" "math" create ">fixnum" "math" lookup unit "coercer" set-word-prop
|
||||
|
||||
"bignum?" "math" create t "inline" set-word-prop
|
||||
"bignum" "math" create 1 "bignum?" "math" create { } define-builtin
|
||||
"bignum" "math" create 1 "math-priority" set-word-prop
|
||||
"bignum" "math" create ">bignum" [ "math" ] search unit "coercer" set-word-prop
|
||||
"bignum" "math" create ">bignum" "math" lookup unit "coercer" set-word-prop
|
||||
|
||||
"cons?" "lists" create t "inline" set-word-prop
|
||||
"cons" "lists" create 2 "cons?" "lists" create
|
||||
|
@ -302,7 +302,7 @@ num-types <array> builtins set
|
|||
"float?" "math" create t "inline" set-word-prop
|
||||
"float" "math" create 5 "float?" "math" create { } define-builtin
|
||||
"float" "math" create 3 "math-priority" set-word-prop
|
||||
"float" "math" create ">float" [ "math" ] search unit "coercer" set-word-prop
|
||||
"float" "math" create ">float" "math" lookup unit "coercer" set-word-prop
|
||||
|
||||
"complex?" "math" create t "inline" set-word-prop
|
||||
"complex" "math" create 6 "complex?" "math" create
|
||||
|
|
|
@ -6,7 +6,7 @@ USING: errors generic kernel namespaces io ;
|
|||
TUPLE: parse-error file line col text ;
|
||||
|
||||
: parse-error ( msg -- )
|
||||
file get line-number get "col" get "line" get
|
||||
file get line-number get column get line-text get
|
||||
<parse-error> [ set-delegate ] keep throw ;
|
||||
|
||||
: with-parser ( quot -- ) [ parse-error ] recover ;
|
||||
|
|
|
@ -26,6 +26,7 @@ SYMBOL: in
|
|||
check-vocab use get push ;
|
||||
|
||||
: set-use ( seq -- )
|
||||
#! Convert to a later so we can push later.
|
||||
[ check-vocab ] map >vector use set ;
|
||||
|
||||
: set-in ( name -- )
|
||||
|
@ -37,12 +38,15 @@ SYMBOL: in
|
|||
SYMBOL: file
|
||||
SYMBOL: line-number
|
||||
|
||||
SYMBOL: line-text
|
||||
SYMBOL: column
|
||||
|
||||
: skip ( i seq quot -- n | quot: elt -- ? )
|
||||
over >r find* drop dup -1 =
|
||||
[ drop r> length ] [ r> drop ] if ; inline
|
||||
|
||||
: skip-blank ( -- )
|
||||
"col" [ "line" get [ blank? not ] skip ] change ;
|
||||
column [ line-text get [ blank? not ] skip ] change ;
|
||||
|
||||
: skip-word ( n line -- n )
|
||||
2dup nth CHAR: " = [ drop 1+ ] [ [ blank? ] skip ] if ;
|
||||
|
@ -52,14 +56,13 @@ SYMBOL: line-number
|
|||
|
||||
: scan ( -- token )
|
||||
skip-blank
|
||||
"col" [ "line" get (scan) dup ] change
|
||||
2dup = [ 2drop f ] [ "line" get subseq ] if ;
|
||||
column [ line-text get (scan) dup ] change
|
||||
2dup = [ 2drop f ] [ line-text get subseq ] if ;
|
||||
|
||||
: save-location ( word -- )
|
||||
#! Remember where this word was defined.
|
||||
dup set-word
|
||||
dup line-number get "line" set-word-prop
|
||||
dup "col" get "col" set-word-prop
|
||||
file get "file" set-word-prop ;
|
||||
|
||||
: create-in in get create dup save-location ;
|
||||
|
@ -80,16 +83,17 @@ global [ string-mode off ] bind
|
|||
|
||||
! Used by parsing words
|
||||
: ch-search ( ch -- index )
|
||||
"col" get "line" get index* ;
|
||||
column get line-text get index* ;
|
||||
|
||||
: (until) ( index -- str )
|
||||
"col" get swap dup 1+ "col" set "line" get subseq ;
|
||||
column [ swap dup 1+ ] change line-text get subseq ;
|
||||
|
||||
: until ( ch -- str )
|
||||
ch-search (until) ;
|
||||
|
||||
: (until-eol) ( -- index )
|
||||
CHAR: \n ch-search dup -1 = [ drop "line" get length ] when ;
|
||||
CHAR: \n ch-search dup -1 =
|
||||
[ drop line-text get length ] when ;
|
||||
|
||||
: until-eol ( -- str )
|
||||
#! This is just a hack to get "eval" to work with multiline
|
||||
|
@ -161,8 +165,8 @@ global [ string-mode off ] bind
|
|||
: parse-string ( -- str )
|
||||
#! Read a string from the input stream, until it is
|
||||
#! terminated by a ".
|
||||
"col" [
|
||||
[ "line" get (parse-string) ] "" make swap
|
||||
column [
|
||||
[ line-text get (parse-string) ] "" make swap
|
||||
] change ;
|
||||
|
||||
global [
|
||||
|
|
|
@ -9,9 +9,9 @@ USING: kernel lists namespaces sequences words ;
|
|||
] when* ;
|
||||
|
||||
: (parse) ( str -- )
|
||||
"line" set 0 "col" set
|
||||
line-text set 0 column set
|
||||
parse-loop
|
||||
"line" off "col" off ;
|
||||
line-text off column off ;
|
||||
|
||||
: parse ( str -- code )
|
||||
#! Parse the string into a parse tree that can be executed.
|
||||
|
|
|
@ -5,7 +5,7 @@ USING: alien arrays generic hashtables io kernel lists math
|
|||
namespaces parser sequences strings styles vectors words ;
|
||||
|
||||
! State
|
||||
SYMBOL: column
|
||||
SYMBOL: position
|
||||
SYMBOL: indent
|
||||
SYMBOL: last-newline
|
||||
SYMBOL: recursion-check
|
||||
|
@ -24,7 +24,7 @@ global [
|
|||
4 tab-size set
|
||||
64 margin set
|
||||
recursion-check off
|
||||
0 column set
|
||||
0 position set
|
||||
0 indent set
|
||||
0 last-newline set
|
||||
1 line-count set
|
||||
|
@ -38,7 +38,7 @@ GENERIC: pprint-section*
|
|||
TUPLE: section start end nl-after? indent ;
|
||||
|
||||
C: section ( length -- section )
|
||||
>r column [ dup rot + dup ] change r>
|
||||
>r position [ dup rot + dup ] change r>
|
||||
[ set-section-end ] keep
|
||||
[ set-section-start ] keep
|
||||
0 over set-section-indent ;
|
||||
|
@ -143,7 +143,7 @@ M: block pprint-section* ( block -- )
|
|||
|
||||
: newline ( -- ) <newline> pprinter get add-section ;
|
||||
|
||||
: end-block ( block -- ) column get swap set-section-end ;
|
||||
: end-block ( block -- ) position get swap set-section-end ;
|
||||
|
||||
: pop-block ( pprinter -- ) pprinter-stack pop drop ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue