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

add some math.parser hints that slightly improve number parsing performance

db4
Joe Groff 2009-10-26 17:48:05 -05:00
parent 5caa118e40
commit ad18098a4f
2 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/hints/hints.factor
View File

@ -3,8 +3,9 @@
USING: accessors arrays assocs byte-arrays byte-vectors classes USING: accessors arrays assocs byte-arrays byte-vectors classes
combinators definitions effects fry generic generic.single combinators definitions effects fry generic generic.single
generic.standard hashtables io.binary io.streams.string kernel generic.standard hashtables io.binary io.streams.string kernel
kernel.private math math.parser namespaces parser sbufs kernel.private math math.parser math.parser.private namespaces
sequences splitting splitting.private strings vectors words ; parser sbufs sequences splitting splitting.private strings
vectors words ;
IN: hints IN: hints
GENERIC: specializer-predicate ( spec -- quot ) GENERIC: specializer-predicate ( spec -- quot )
@ -133,3 +134,10 @@ SYNTAX: HINTS:
M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-prop M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-prop
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
\ dec>float { string } "specializer" set-word-prop
\ hex>float { string } "specializer" set-word-prop
\ string>integer { string fixnum } "specializer" set-word-prop

6
core/math/parser/parser.factor
View File

@ -66,10 +66,10 @@ SYMBOL: negative?
0 over push B{ } like (string>float) ; 0 over push B{ } like (string>float) ;
: hex>float-parts ( str -- neg? mantissa-str expt ) : hex>float-parts ( str -- neg? mantissa-str expt )
"-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ; "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ; inline
: make-mantissa ( str -- bits ) : make-mantissa ( str -- bits )
16 base> dup log2 52 swap - shift ; 16 base> dup log2 52 swap - shift ; inline
: combine-hex-float-parts ( neg? mantissa expt -- float ) : combine-hex-float-parts ( neg? mantissa expt -- float )
dup 2046 > [ 2drop -1/0. 1/0. ? ] [ dup 2046 > [ 2drop -1/0. 1/0. ? ] [
@ -78,7 +78,7 @@ SYMBOL: negative?
[ 52 2^ 1 - bitand ] [ 52 2^ 1 - bitand ]
[ 52 shift ] tri* bitor bitor [ 52 shift ] tri* bitor bitor
bits>double bits>double
] if ; ] if ; inline
: hex>float ( str -- n/f ) : hex>float ( str -- n/f )
hex>float-parts hex>float-parts