From 27c89d75d46120df04769c3a375a7af2aa626443 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 17 Jun 2008 05:22:33 -0500 Subject: [PATCH] I/O micro-optimizations; 12% improvement on reverse-complement --- core/io/encodings/encodings.factor | 102 ++++++++++-------- core/optimizer/known-words/known-words.factor | 20 ++-- extra/io/encodings/ascii/ascii.factor | 7 +- 3 files changed, 70 insertions(+), 59 deletions(-) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 4a9f90cb32..942476616f 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -28,23 +28,62 @@ ERROR: encode-error ; ! Decoding - f decoder boa ; +>cr drop ; inline + +: cr- f >>cr drop ; inline + : >decoder< ( decoder -- stream encoding ) - [ stream>> ] [ code>> ] bi ; + [ stream>> ] [ code>> ] bi ; inline -: cr+ t swap set-decoder-cr ; inline +: fix-read1 ( stream char -- char ) + over cr>> [ + over cr- + dup CHAR: \n = [ + drop dup stream-read1 + ] when + ] when nip ; inline -: cr- f swap set-decoder-cr ; inline +M: decoder stream-read1 + dup >decoder< decode-char fix-read1 ; + +: fix-read ( stream string -- string ) + over cr>> [ + over cr- + "\n" ?head [ + over stream-read1 [ suffix ] when* + ] when + ] when nip ; inline + +: (read) ( n quot -- n string ) + over 0 [ + [ + >r call dup + [ swap r> set-nth-unsafe f ] [ r> 3drop t ] if + ] 2curry find-integer + ] keep ; inline + +: finish-read ( n string -- string/f ) + { + { [ over 0 = ] [ 2drop f ] } + { [ over not ] [ nip ] } + [ swap head ] + } cond ; inline + +M: decoder stream-read + tuck >decoder< [ decode-char ] 2curry (read) finish-read fix-read ; + +M: decoder stream-read-partial stream-read ; : line-ends/eof ( stream str -- str ) f like swap cr- ; inline : line-ends\r ( stream str -- str ) swap cr+ ; inline : line-ends\n ( stream str -- str ) - over decoder-cr over empty? and + over cr>> over empty? and [ drop dup cr- stream-readln ] [ swap cr- ] if ; inline : handle-readln ( stream str ch -- str ) @@ -52,61 +91,30 @@ M: object f decoder boa ; { f [ line-ends/eof ] } { CHAR: \r [ line-ends\r ] } { CHAR: \n [ line-ends\n ] } - } case ; + } case ; inline -: fix-read ( stream string -- string ) - over decoder-cr [ - over cr- - "\n" ?head [ - over stream-read1 [ suffix ] when* - ] when - ] when nip ; - -: read-loop ( n stream -- string ) - SBUF" " clone [ - [ - >r nip stream-read1 dup - [ r> push f ] [ r> 2drop t ] if - ] 2curry find-integer drop - ] keep "" like f like ; - -M: decoder stream-read - tuck read-loop fix-read ; - -M: decoder stream-read-partial stream-read ; - -: (read-until) ( buf quot -- string/f sep/f ) +: ((read-until)) ( buf quot -- string/f sep/f ) ! quot: -- char stop? dup call [ >r drop "" like r> ] - [ pick push (read-until) ] if ; inline + [ pick push ((read-until)) ] if ; inline -M: decoder stream-read-until +: (read-until) ( seps stream -- string/f sep/f ) SBUF" " clone -rot >decoder< - [ decode-char [ dup rot memq? ] [ drop f t ] if* ] 3curry - (read-until) ; + [ decode-char dup [ dup rot member? ] [ 2drop f t ] if ] 3curry + ((read-until)) ; inline -: fix-read1 ( stream char -- char ) - over decoder-cr [ - over cr- - dup CHAR: \n = [ - drop dup stream-read1 - ] when - ] when nip ; +M: decoder stream-read-until (read-until) ; -M: decoder stream-read1 - dup >decoder< decode-char fix-read1 ; +M: decoder stream-readln "\r\n" over (read-until) handle-readln ; -M: decoder stream-readln ( stream -- str ) - "\r\n" over stream-read-until handle-readln ; - -M: decoder dispose decoder-stream dispose ; +M: decoder dispose stream>> dispose ; ! Encoding M: object encoder boa ; : >encoder< ( encoder -- stream encoding ) - [ stream>> ] [ code>> ] bi ; + [ stream>> ] [ code>> ] bi ; inline M: encoder stream-write1 >encoder< encode-char ; diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index d1dbefe26b..970b69a18a 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -9,7 +9,7 @@ io.streams.string layouts splitting math.intervals math.floats.private classes.tuple classes.tuple.private classes classes.algebra optimizer.def-use optimizer.backend optimizer.pattern-match optimizer.inlining float-arrays -sequences.private combinators ; +sequences.private combinators byte-arrays byte-vectors ; { } [ [ @@ -59,15 +59,19 @@ sequences.private combinators ; node-in-d peek dup value? [ value-literal sequence? ] [ drop f ] if ; -: member-quot ( seq -- newquot ) - [ literalize [ t ] ] { } map>assoc - [ drop f ] suffix [ nip case ] curry ; +: member-quot ( seq predicate -- newquot ) + [ curry [ dup ] prepose [ drop t ] ] curry { } map>assoc + [ drop f ] suffix [ nip cond ] curry ; -: expand-member ( #call -- ) - dup node-in-d peek value-literal member-quot f splice-quot ; +: expand-member ( #call predicate -- ) + >r dup node-in-d peek value-literal r> member-quot f splice-quot ; \ member? { - { [ dup literal-member? ] [ expand-member ] } + { [ dup literal-member? ] [ [ = ] expand-member ] } +} define-optimizers + +\ memq? { + { [ dup literal-member? ] [ [ eq? ] expand-member ] } } define-optimizers ! if the result of eq? is t and the second input is a literal, @@ -97,7 +101,7 @@ sequences.private combinators ; ] each \ push-all -{ { string sbuf } { array vector } } +{ { string sbuf } { array vector } { byte-array byte-vector } } "specializer" set-word-prop \ append diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor index 9ff120c5fa..08dc8d07d9 100755 --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -5,12 +5,11 @@ IN: io.encodings.ascii [ drop replacement-char ] unless ] - [ drop f ] if* ; + nip swap stream-read1 dup + [ tuck > [ drop replacement-char ] unless ] [ 2drop f ] if ; inline PRIVATE> SINGLETON: ascii