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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-10-30 22:02:15 -05:00
parent d55a3a3445 c05affdce3
commit 07254fa823
3 changed files with 21 additions and 22 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

2
basis/debugger/debugger.factor
View File

@ -22,7 +22,7 @@ M: source-file-error error-help error>> error-help ;
GENERIC: error. ( error -- ) GENERIC: error. ( error -- )
M: object error. . ; M: object error. short. ;
M: string error. print ; M: string error. print ;

2
core/growable/growable.factor
View File

@ -23,7 +23,7 @@ GENERIC: contract ( len seq -- )
M: growable contract ( len seq -- ) M: growable contract ( len seq -- )
[ length ] keep [ length ] keep
[ [ 0 ] 2dip set-nth-unsafe ] curry [ [ 0 ] 2dip set-nth-unsafe ] curry
(each-integer) ; (each-integer) ; inline
: growable-check ( n seq -- n seq ) : growable-check ( n seq -- n seq )
over 0 < [ bounds-error ] when ; inline over 0 < [ bounds-error ] when ; inline