From: John Benediktsson Date: Wed, 9 Sep 2020 18:12:50 +0000 (-0700) Subject: core: removing unnecessary method stack effects. X-Git-Tag: 0.99~3099 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=f2deb8282962ad836df9196faa6331e7c82943d5 core: removing unnecessary method stack effects. --- diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index e6f5594e95..6955efbe9c 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -120,7 +120,7 @@ PRIVATE> : of ( assoc key -- value/f ) swap at ; inline -M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) +M: assoc assoc-clone-like [ dup assoc-size ] dip new-assoc [ [ set-at ] with-assoc assoc-each ] keep ; inline @@ -299,7 +299,7 @@ M: enumerated set-at seq>> set-nth ; inline M: enumerated delete-at seq>> remove-nth! drop ; inline -M: enumerated >alist ( enumerated -- alist ) ; inline +M: enumerated >alist ; inline M: enumerated keys seq>> length >array ; inline diff --git a/core/classes/classes.factor b/core/classes/classes.factor index f33d8bbaf7..8401a654a1 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -253,7 +253,7 @@ PRIVATE> M: class metaclass-changed swap class? [ drop ] [ forget-class ] if ; -M: class forget* ( class -- ) +M: class forget* [ call-next-method ] [ forget-class ] bi ; ERROR: not-an-instance obj class ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 86ddf24257..ba0b9c5704 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -93,7 +93,7 @@ PRIVATE> GENERIC: slots>tuple ( seq class -- tuple ) -M: tuple-class slots>tuple ( seq class -- tuple ) +M: tuple-class slots>tuple check-slots pad-slots tuple-layout [ [ tuple-size ] diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index a458ff6fbb..b349108845 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -49,13 +49,13 @@ HOOK: update-call-sites compiler-impl ( class generic -- words ) : changed-call-sites ( class generic -- ) update-call-sites [ changed-definition ] each ; -M: generic update-generic ( class generic -- ) +M: generic update-generic [ changed-call-sites ] [ remake-generic drop ] [ changed-conditionally drop ] 2tri ; -M: sequence update-methods ( class seq -- ) +M: sequence update-methods implementors [ update-generic ] with each ; HOOK: recompile compiler-impl ( words -- alist ) diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 44ddb71c49..f14f5cfecb 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -71,7 +71,7 @@ M: pair effect>string PRIVATE> -M: effect effect>string ( effect -- string ) +M: effect effect>string [ "( " % dup in-var>> var-picture% diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index bc255e72ee..4dec5b9d83 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -39,7 +39,7 @@ SYMBOL: combination HOOK: picker combination ( -- quot ) -M: single-combination next-method-quot* ( class generic combination -- quot ) +M: single-combination next-method-quot* [ 2dup next-method dup [ [ diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 2f7554a762..919e5ef307 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -32,12 +32,12 @@ PRIVATE> GENERIC: contract ( len seq -- ) -M: growable contract ( len seq -- ) +M: growable contract [ length ] keep [ [ 0 ] 2dip set-nth-unsafe ] curry (each-integer) ; inline -M: growable set-length ( n seq -- ) +M: growable set-length bounds-check-head 2dup length < [ 2dup contract @@ -62,13 +62,13 @@ M: growable set-nth ensure set-nth-unsafe ; inline M: growable clone (clone) [ clone ] change-underlying ; inline -M: growable lengthen ( n seq -- ) +M: growable lengthen 2dup length > [ 2dup capacity > [ over new-size over expand ] when 2dup length<< ] when 2drop ; inline -M: growable shorten ( n seq -- ) +M: growable shorten bounds-check-head 2dup length < [ 2dup contract diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 5fef2f1be6..fd945bdf20 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -109,7 +109,7 @@ M: decoder stream-element-type over cr- dup CHAR: \n eq? [ drop (read1) ] [ nip ] if ] [ nip ] if ; inline -M: decoder stream-read1 ( decoder -- ch ) +M: decoder stream-read1 dup (read1) fix-cr ; inline : (read-first) ( n buf decoder -- buf stream encoding n c ) diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 112667575b..254f668c90 100644 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -87,7 +87,7 @@ M: utf16le decode-char [ [ encode-second ] dip stream-write2 ] 2bi ] [ [ h>b/b swap ] dip stream-write2 ] if ; inline -M: utf16be encode-char ( char stream encoding -- ) +M: utf16be encode-char drop char>utf16be ; : char>utf16le ( char stream -- ) @@ -97,7 +97,7 @@ M: utf16be encode-char ( char stream encoding -- ) [ [ encode-second swap ] dip stream-write2 ] 2bi ] [ [ h>b/b ] dip stream-write2 ] if ; inline -M: utf16le encode-char ( char stream encoding -- ) +M: utf16le encode-char drop char>utf16le ; : ascii-char>utf16-byte-array ( off n byte-array string -- ) @@ -155,10 +155,10 @@ CONSTANT: bom-be B{ 0xfe 0xff } bom-be sequence= [ utf16be ] [ missing-bom ] if ] if ; -M: utf16 ( stream utf16 -- decoder ) +M: utf16 drop 2 over stream-read bom>le/be ; -M: utf16 ( stream utf16 -- encoder ) +M: utf16 drop bom-le over stream-write utf16le ; PRIVATE> diff --git a/core/io/files/files.factor b/core/io/files/files.factor index e96dbc8ab5..798d6d7dce 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -80,7 +80,7 @@ HOOK: cd io-backend ( path -- ) HOOK: cwd io-backend ( -- path ) -M: object cwd ( -- path ) "." ; +M: object cwd "." ; PRIVATE> diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index bbd9298dcd..b54b207bca 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -21,7 +21,7 @@ SYMBOL: current-directory HOOK: root-directory? io-backend ( path -- ? ) -M: object root-directory? ( path -- ? ) +M: object root-directory? [ f ] [ [ path-separator? ] all? ] if-empty ; ERROR: no-parent-directory path ; @@ -163,7 +163,7 @@ M: string absolute-path ] if ] if ] if ; -M: object normalize-path ( path -- path' ) +M: object normalize-path absolute-path ; : root-path* ( path -- path' ) @@ -229,4 +229,4 @@ C: pathname M: pathname absolute-path string>> absolute-path ; -M: pathname <=> [ string>> ] compare ; \ No newline at end of file +M: pathname <=> [ string>> ] compare ; diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 6467361a60..c060e50d8f 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -223,7 +223,7 @@ M: bignum (log2) bignum-log2 ; inline : bignum/f ( m n -- f ) [ [ abs ] bi@ /f-abs ] [ [ 0 < ] bi@ xor ] 2bi [ neg ] when ; inline -M: bignum /f ( m n -- f ) { bignum bignum } declare bignum/f ; +M: bignum /f { bignum bignum } declare bignum/f ; CONSTANT: bignum/f-threshold 0x20,0000,0000,0000 diff --git a/core/math/order/order.factor b/core/math/order/order.factor index 5ebe77c459..a07f3a979e 100644 --- a/core/math/order/order.factor +++ b/core/math/order/order.factor @@ -37,15 +37,15 @@ GENERIC: after? ( obj1 obj2 -- ? ) GENERIC: before=? ( obj1 obj2 -- ? ) GENERIC: after=? ( obj1 obj2 -- ? ) -M: object before? ( obj1 obj2 -- ? ) <=> +lt+ eq? ; inline -M: object after? ( obj1 obj2 -- ? ) <=> +gt+ eq? ; inline -M: object before=? ( obj1 obj2 -- ? ) <=> +gt+ eq? not ; inline -M: object after=? ( obj1 obj2 -- ? ) <=> +lt+ eq? not ; inline - -M: real before? ( obj1 obj2 -- ? ) < ; inline -M: real after? ( obj1 obj2 -- ? ) > ; inline -M: real before=? ( obj1 obj2 -- ? ) <= ; inline -M: real after=? ( obj1 obj2 -- ? ) >= ; inline +M: object before? <=> +lt+ eq? ; inline +M: object after? <=> +gt+ eq? ; inline +M: object before=? <=> +gt+ eq? not ; inline +M: object after=? <=> +lt+ eq? not ; inline + +M: real before? < ; inline +M: real after? > ; inline +M: real before=? <= ; inline +M: real after=? >= ; inline GENERIC: min ( obj1 obj2 -- obj ) GENERIC: max ( obj1 obj2 -- obj ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d0b2a7bc42..bb76410c2e 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -53,7 +53,7 @@ ERROR: bounds-error index seq ; GENERIC#: bounds-check? 1 ( n seq -- ? ) -M: integer bounds-check? ( n seq -- ? ) +M: integer bounds-check? dupd length < [ 0 >= ] [ drop f ] if ; inline : bounds-check ( n seq -- n seq ) diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 5afaf618d2..0ec351a5ef 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -72,7 +72,7 @@ ERROR: bad-slot-value value class ; GENERIC: instance-check-quot ( obj -- quot ) -M: class instance-check-quot ( class -- quot ) +M: class instance-check-quot { { [ dup object bootstrap-word eq? ] [ drop [ ] ] } { [ dup "coercer" word-prop ] [ "coercer" word-prop ] } diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index e0b8b12aea..9ca8c15877 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -36,7 +36,7 @@ ERROR: not-found-in-roots path ; : find-root-for ( path -- path/f ) vocab-roots get [ prepend-path exists? ] with find nip ; -M: string vocab-path ( string -- path/f ) +M: string vocab-path dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ; PRIVATE>