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

bootstrap.image: small speedup

db4
Slava Pestov 2009-10-30 20:53:18 -05:00
parent 3f15e028f7
commit 8d613a8c9a
1 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
basis/bootstrap/image/image.factor
View File

@ -1,14 +1,16 @@
! Copyright (C) 2004, 2009 Slava Pestov. ! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays byte-arrays generic hashtables hashtables.private USING: alien arrays byte-arrays generic hashtables
io io.binary io.files io.encodings.binary io.pathnames kernel hashtables.private io io.binary io.files io.encodings.binary
kernel.private math namespaces make parser prettyprint sequences io.pathnames kernel kernel.private math namespaces make parser
strings sbufs vectors words quotations assocs system layouts splitting prettyprint sequences strings sbufs vectors words quotations
grouping growable classes classes.builtin classes.tuple assocs system layouts splitting grouping growable classes
classes.tuple.private vocabs vocabs.loader source-files definitions classes.builtin classes.tuple classes.tuple.private vocabs
debugger quotations.private combinators math.order math.private vocabs.loader source-files definitions debugger
accessors slots.private generic.single.private compiler.units quotations.private combinators combinators.short-circuit
compiler.constants fry bootstrap.image.syntax ; math.order math.private accessors slots.private
generic.single.private compiler.units compiler.constants fry
bootstrap.image.syntax ;
IN: bootstrap.image IN: bootstrap.image
: arch ( os cpu -- arch ) : arch ( os cpu -- arch )
@ -38,7 +40,7 @@ IN: bootstrap.image
! Object cache; we only consider numbers equal if they have the ! Object cache; we only consider numbers equal if they have the
! same type ! same type
TUPLE: eql-wrapper obj ; TUPLE: eql-wrapper { obj read-only } ;
C: <eql-wrapper> eql-wrapper C: <eql-wrapper> eql-wrapper
@ -47,25 +49,22 @@ M: eql-wrapper hashcode* obj>> hashcode* ;
GENERIC: (eql?) ( obj1 obj2 -- ? ) GENERIC: (eql?) ( obj1 obj2 -- ? )
: eql? ( obj1 obj2 -- ? ) : eql? ( obj1 obj2 -- ? )
[ (eql?) ] [ [ class ] bi@ = ] 2bi and ; { [ [ class ] bi@ = ] [ (eql?) ] } 2&& ;
M: integer (eql?) = ; M: fixnum (eql?) eq? ;
M: float (eql?) M: bignum (eql?) = ;
over float? [ fp-bitwise= ] [ 2drop f ] if ;
M: sequence (eql?) M: float (eql?) fp-bitwise= ;
over sequence? [
2dup [ length ] bi@ = M: sequence (eql?) 2dup [ length ] bi@ = [ [ eql? ] 2all? ] [ 2drop f ] if ;
[ [ eql? ] 2all? ] [ 2drop f ] if
] [ 2drop f ] if ;
M: object (eql?) = ; M: object (eql?) = ;
M: eql-wrapper equal? M: eql-wrapper equal?
over eql-wrapper? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ; over eql-wrapper? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ;
TUPLE: eq-wrapper obj ; TUPLE: eq-wrapper { obj read-only } ;
C: <eq-wrapper> eq-wrapper C: <eq-wrapper> eq-wrapper