diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 41f3dbace4..fac7d71870 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -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 diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index a0ea53684b..18e4d627c2 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -283,12 +283,12 @@ num-types 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 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 diff --git a/library/syntax/parse-errors.factor b/library/syntax/parse-errors.factor index 8b89f7a7a5..2222cf4e15 100644 --- a/library/syntax/parse-errors.factor +++ b/library/syntax/parse-errors.factor @@ -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 [ set-delegate ] keep throw ; : with-parser ( quot -- ) [ parse-error ] recover ; diff --git a/library/syntax/parse-words.factor b/library/syntax/parse-words.factor index ee3c172b4a..10d6771304 100644 --- a/library/syntax/parse-words.factor +++ b/library/syntax/parse-words.factor @@ -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 [ diff --git a/library/syntax/parser.factor b/library/syntax/parser.factor index e2065f9634..33cfa5d7f0 100644 --- a/library/syntax/parser.factor +++ b/library/syntax/parser.factor @@ -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. diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index ef4ccc3c3a..8733b10467 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -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 ( -- ) 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 ;