diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 567a3b8bfd..421a7d2ecd 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -1,14 +1,16 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays byte-arrays generic hashtables hashtables.private -io io.binary io.files io.encodings.binary io.pathnames kernel -kernel.private math namespaces make parser prettyprint sequences -strings sbufs vectors words quotations assocs system layouts splitting -grouping growable classes classes.builtin classes.tuple -classes.tuple.private vocabs vocabs.loader source-files definitions -debugger quotations.private combinators math.order math.private -accessors slots.private generic.single.private compiler.units -compiler.constants fry bootstrap.image.syntax ; +USING: alien arrays byte-arrays generic hashtables +hashtables.private io io.binary io.files io.encodings.binary +io.pathnames kernel kernel.private math namespaces make parser +prettyprint sequences strings sbufs vectors words quotations +assocs system layouts splitting grouping growable classes +classes.builtin classes.tuple classes.tuple.private vocabs +vocabs.loader source-files definitions debugger +quotations.private combinators combinators.short-circuit +math.order math.private accessors slots.private +generic.single.private compiler.units compiler.constants fry +bootstrap.image.syntax ; IN: bootstrap.image : arch ( os cpu -- arch ) @@ -38,7 +40,7 @@ IN: bootstrap.image ! Object cache; we only consider numbers equal if they have the ! same type -TUPLE: eql-wrapper obj ; +TUPLE: eql-wrapper { obj read-only } ; C: eql-wrapper @@ -47,25 +49,22 @@ M: eql-wrapper hashcode* obj>> hashcode* ; GENERIC: (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?) - over float? [ fp-bitwise= ] [ 2drop f ] if ; +M: bignum (eql?) = ; -M: sequence (eql?) - over sequence? [ - 2dup [ length ] bi@ = - [ [ eql? ] 2all? ] [ 2drop f ] if - ] [ 2drop f ] if ; +M: float (eql?) fp-bitwise= ; + +M: sequence (eql?) 2dup [ length ] bi@ = [ [ eql? ] 2all? ] [ 2drop f ] if ; M: object (eql?) = ; M: eql-wrapper equal? over eql-wrapper? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ; -TUPLE: eq-wrapper obj ; +TUPLE: eq-wrapper { obj read-only } ; C: eq-wrapper diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 2920421e6b..690e631e81 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -22,7 +22,7 @@ M: source-file-error error-help error>> error-help ; GENERIC: error. ( error -- ) -M: object error. . ; +M: object error. short. ; M: string error. print ; diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 2ca11e2e24..3d5f16d7f1 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -23,7 +23,7 @@ GENERIC: contract ( len seq -- ) M: growable contract ( len seq -- ) [ length ] keep [ [ 0 ] 2dip set-nth-unsafe ] curry - (each-integer) ; + (each-integer) ; inline : growable-check ( n seq -- n seq ) over 0 < [ bounds-error ] when ; inline