diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d17b366cac..8338e5330d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -16,17 +16,13 @@ - the invalid recursion form case needs to be fixed, for inlines too - graphical module manager tool - see if alien calls can be made faster - -======================================================================== - -+ ui: - -- fix ui listener delay - doc front page: document stack effect notation - better doc for accumulate, link from tree + ++ 0.85: + +- fix ui listener delay - we have trouble drawing rectangles -- the UI listener has a shitty design. perhaps it should not call out - to the real listener. - remaining walker tasks: - integrate walker with listener - handled by walker itself @@ -35,6 +31,32 @@ - error handling is still screwy - continuation handling is also screwy - keyboard commands +- editor: + - only redraw visible lines + - more efficient multi-line inserts + - editor should support stream output protocol +- slider needs to be modelized +- listener tab completion +- track individual method usages +- modularize core +- track module files and modification times, and a list of assets loaded + from that file +- 'changes' word, asks if files changed on disk from loaded modules + should be reloaded -- do this in the right order +- more compact relocation info +- UI dataflow visualizer +- loading the image should not exhaust nursery space +- problem if major gc happens during relocation + - in fact relocation should not cons at all + +======================================================================== + ++ ui: + +- figure out what goes in the .app and what doesn't +- should be possible to drop an image file on the .app to run it +- the UI listener has a shitty design. perhaps it should not call out + to the real listener. - add-gadget, model-changed, set-model should compile - shortcuts: - find a listener @@ -50,9 +72,6 @@ - autoscroll - page up/down - search and replace - - only redraw visible lines - - more efficient multi-line inserts - - editor should support stream output protocol - cocoa: windows are not updated while resizing - grid slows down with 2000 lines - ui uses too much cpu time idling @@ -64,31 +83,22 @@ - horizontal wheel scrolling - polish OS X menu bar code - variable width word wrap -- slider needs to be modelized - structure editor -- listener tab completion +- loading space invaders slows the UI down + module system: - generic 'define ( asset def -- )' -- track individual method usages - C types should be words - TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp - TYPEDEF: float FTFloat ; ==> \ float \ FTFloat "c-type" swp - make typedef aliasing explicit - seeing a C struct word should show its def -- modularize core - TUPLE: module files tests articles article main ; - file out -- track module files and modification times, and a list of assets loaded - from that file -- 'changes' word, asks if files changed on disk from loaded modules - should be reloaded -- do this in the right order + compiler/ffi: -- more compact relocation info -- UI dataflow visualizer - ppc64 backend - we need to optimize [ dup array? [ array? ] [ array? ] if ] - mac intel: struct returns from objc methods @@ -105,10 +115,8 @@ + misc: -- loading the image should not exhaust nursery space -- compiler tests are not as reliable now -- problem if major gc happens during relocation - - in fact relocation should not cons at all +- compiler tests are not as reliable now because of try-compile usage + - we can just do [ t ] [ \ foo compiled? ] unit-test - growable data heap - incremental GC - UDP @@ -124,5 +132,6 @@ [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 ] +- prettier printing of hashtable literals, alists, cond, ... - httpd search tools - remaining HTML issues need fixing diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 718de84151..41612e9952 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -129,13 +129,13 @@ GENERIC: ' ( obj -- ptr ) dup length 1+ emit-fixnum swap emit emit-seq ; -M: bignum ' ( bignum -- tagged ) +M: bignum ' #! This can only emit 0, -1 and 1. bignum-tag bignum-tag [ emit-bignum ] emit-object ; ( Fixnums ) -M: fixnum ' ( n -- tagged ) +M: fixnum ' #! When generating a 32-bit image on a 64-bit system, #! some fixnums should be bignums. dup most-negative-fixnum most-positive-fixnum between? @@ -143,7 +143,7 @@ M: fixnum ' ( n -- tagged ) ( Floats ) -M: float ' ( float -- tagged ) +M: float ' float-tag float-tag [ align-here double>bits emit-64 ] emit-object ; @@ -154,7 +154,7 @@ M: float ' ( float -- tagged ) : t, t t-offset fixup ; -M: f ' ( obj -- ptr ) +M: f ' #! f is #define F RETAG(0,OBJECT_TYPE) drop object-tag ; @@ -183,7 +183,7 @@ M: f ' ( obj -- ptr ) word-tag word-tag [ emit-seq ] emit-object swap objects get set-hash ; -: word-error ( word msg -- ) +: word-error ( word msg -- * ) [ % dup word-vocabulary % " " % word-name % ] "" make throw ; : transfer-word ( word -- word ) @@ -197,11 +197,11 @@ M: f ' ( obj -- ptr ) : fixup-words ( -- ) image get [ dup word? [ fixup-word ] when ] inject ; -M: word ' ( word -- pointer ) ; +M: word ' ; ( Wrappers ) -M: wrapper ' ( wrapper -- pointer ) +M: wrapper ' wrapped ' wrapper-tag wrapper-tag [ emit ] emit-object ; ( Ratios and complexes ) @@ -209,10 +209,10 @@ M: wrapper ' ( wrapper -- pointer ) : emit-pair [ [ emit ] 2apply ] emit-object ; -M: ratio ' ( c -- tagged ) +M: ratio ' >fraction [ ' ] 2apply ratio-tag ratio-tag emit-pair ; -M: complex ' ( c -- tagged ) +M: complex ' >rect [ ' ] 2apply complex-tag complex-tag emit-pair ; ( Strings ) @@ -231,7 +231,7 @@ M: complex ' ( c -- tagged ) pack-string emit-chars ] emit-object ; -M: string ' ( string -- pointer ) +M: string ' #! We pool strings so that each string is only written once #! to the image objects get [ emit-string ] cache ; @@ -249,24 +249,24 @@ M: string ' ( string -- pointer ) dup first transfer-word 0 pick set-nth >tuple ; -M: tuple ' ( tuple -- pointer ) +M: tuple ' transfer-tuple objects get [ tuple>array tuple-type emit-array ] cache ; -M: array ' ( array -- pointer ) +M: array ' array-type emit-array ; -M: quotation ' ( array -- pointer ) +M: quotation ' quotation-type emit-array ; -M: vector ' ( vector -- pointer ) +M: vector ' dup underlying ' swap length vector-type object-tag [ emit-fixnum ( length ) emit ( array ptr ) ] emit-object ; -M: sbuf ' ( sbuf -- pointer ) +M: sbuf ' dup underlying ' swap length sbuf-type object-tag [ emit-fixnum ( length ) @@ -275,7 +275,7 @@ M: sbuf ' ( sbuf -- pointer ) ( Hashes ) -M: hashtable ' ( hashtable -- pointer ) +M: hashtable ' [ hash-array ' ] keep hashtable-type object-tag [ dup hash-count emit-fixnum diff --git a/library/collections/arrays.factor b/library/collections/arrays.factor index 1bfef12b34..15730cd59f 100644 --- a/library/collections/arrays.factor +++ b/library/collections/arrays.factor @@ -21,12 +21,12 @@ M: byte-array clone (clone) ; M: byte-array length array-capacity ; M: byte-array resize resize-array ; -: 1array ( x -- { x } ) 1 swap ; +: 1array ( x -- array ) 1 swap ; -: 2array ( x y -- { x y } ) +: 2array ( x y -- array ) 2 swap [ 0 swap set-array-nth ] keep ; -: 3array ( x y z -- { x y z } ) +: 3array ( x y z -- array ) 3 swap [ 1 swap set-array-nth ] keep [ 0 swap set-array-nth ] keep ; diff --git a/library/collections/growable.factor b/library/collections/growable.factor index 43931b43ef..0bcdbd5354 100644 --- a/library/collections/growable.factor +++ b/library/collections/growable.factor @@ -31,7 +31,7 @@ GENERIC: set-fill TUPLE: bounds-error index seq ; -: bounds-error throw ; +: bounds-error ( n seq -- * ) throw ; : growable-check ( n seq -- n seq ) over 0 < [ bounds-error ] when ; inline diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor index c6d43b33f2..db9a59181f 100644 --- a/library/collections/hashtables.factor +++ b/library/collections/hashtables.factor @@ -30,7 +30,7 @@ TUPLE: tombstone ; : key@ ( key hash -- n ) hash-array 2dup hash@ (key@) ; inline -: if-key ( key hash true false -- | true: index key hash -- ) +: if-key ( key hash true false -- ) | true ( index key hash -- ) >r >r [ key@ ] 2keep pick -1 > r> r> if ; inline : ( n -- array ) @@ -75,10 +75,9 @@ TUPLE: tombstone ; : (set-hash) ( value key hash -- ) 2dup new-key@ swap [ hash-array 2dup array-nth ] keep - ( value key n hash-array old hash ) swap change-size set-nth-pair ; inline -: (each-pair) ( quot array i -- | quot: k v -- ) +: (each-pair) ( quot array i -- ) | quot ( k v -- ) over array-capacity over eq? [ 3drop ] [ @@ -88,10 +87,10 @@ TUPLE: tombstone ; ] 3keep 2 fixnum+fast (each-pair) ] if ; inline -: each-pair ( array quot -- | quot: k v -- ) +: each-pair ( array quot -- ) | quot ( k v -- ) swap 0 (each-pair) ; inline -: (all-pairs?) ( quot array i -- ? | quot: k v -- ? ) +: (all-pairs?) ( quot array i -- ? ) | quot ( k v -- ? ) over array-capacity over eq? [ 3drop t ] [ @@ -106,7 +105,7 @@ TUPLE: tombstone ; ] if ] if ; inline -: all-pairs? ( array quot -- ? | quot: k v -- ? ) +: all-pairs? ( array quot -- ? ) | quot ( k v -- ? ) swap 0 (all-pairs?) ; inline : hash>seq ( i hash -- seq ) @@ -189,17 +188,17 @@ IN: hashtables [ length ] keep [ first2 swap pick (set-hash) ] each ; -: hash-each ( hash quot -- | quot: k v -- ) +: hash-each ( hash quot -- ) | quot ( k v -- ) >r hash-array r> each-pair ; inline -: hash-each-with ( obj hash quot -- | quot: obj k v -- ) +: hash-each-with ( obj hash quot -- ) | quot ( obj k v -- ) swap [ 2swap [ >r -rot r> call ] 2keep ] hash-each 2drop ; inline -: hash-all? ( hash quot -- | quot: k v -- ? ) +: hash-all? ( hash quot -- ) | quot ( k v -- ? ) >r hash-array r> all-pairs? ; inline -: hash-all-with? ( obj hash quot -- | quot: obj k v -- ? ) +: hash-all-with? ( obj hash quot -- ) | quot ( obj k v -- ? ) swap [ 2swap [ >r -rot r> call ] 2keep rot ] hash-all? 2nip ; inline @@ -209,7 +208,7 @@ IN: hashtables >r swap hash* [ r> = ] [ r> 2drop f ] if ] hash-all-with? ; -: hash-subset ( hash quot -- hash | quot: k v -- ? ) +: hash-subset ( hash quot -- hash ) | quot ( k v -- ? ) over hash-size rot [ 2swap [ >r pick pick >r >r call [ @@ -220,18 +219,18 @@ IN: hashtables ] 2keep ] hash-each nip ; inline -: hash-subset-with ( obj hash quot -- hash | quot: obj { k v } -- ? ) +: hash-subset-with ( obj hash quot -- hash ) | quot ( obj pair -- ? ) swap [ 2swap [ >r -rot r> call ] 2keep rot ] hash-subset 2nip ; inline -M: hashtable clone ( hash -- hash ) +M: hashtable clone (clone) dup hash-array clone over set-hash-array ; : hashtable= ( hash hash -- ? ) 2dup subhash? >r swap subhash? r> and ; -M: hashtable equal? ( obj hash -- ? ) +M: hashtable equal? { { [ over hashtable? not ] [ 2drop f ] } { [ 2dup [ hash-size ] 2apply number= not ] [ 2drop f ] } @@ -243,7 +242,7 @@ M: hashtable equal? ( obj hash -- ? ) hashcode >r hashcode -1 shift r> bitxor bitxor ] hash-each ; -M: hashtable hashcode ( hash -- n ) +M: hashtable hashcode dup hash-size 1 number= [ hashtable-hashcode ] [ hash-size ] if ; @@ -293,14 +292,14 @@ IN: hashtables : remove-all ( hash seq -- seq ) [ swap hash-member? not ] subset-with ; -: cache ( key hash quot -- value | quot: key -- value ) +: cache ( key hash quot -- value ) | quot ( key -- value ) pick pick hash [ >r 3drop r> ] [ pick rot >r >r call dup r> r> set-hash ] if* ; inline -: map>hash ( seq quot -- hash | quot: key -- key value ) +: map>hash ( seq quot -- hash ) | quot ( key -- key value ) over length rot [ -rot [ >r call swap r> set-hash ] 2keep ] each nip ; inline diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index ffc04ac792..7d5f3a7e0d 100644 --- a/library/collections/namespaces.factor +++ b/library/collections/namespaces.factor @@ -4,8 +4,8 @@ IN: kernel-internals USING: vectors sequences ; : namestack* ( -- ns ) 3 getenv { vector } declare ; inline -: >n ( namespace -- n:namespace ) namestack* push ; -: n> ( n:namespace -- namespace ) namestack* pop ; +: >n ( namespace -- ) namestack* push ; +: n> ( -- namespace ) namestack* pop ; IN: namespaces USING: arrays hashtables kernel kernel-internals math strings @@ -14,7 +14,7 @@ words ; : namestack ( -- ns ) namestack* clone ; inline : set-namestack ( ns -- ) >vector 3 setenv ; inline : namespace ( -- namespace ) namestack* peek ; -: ndrop ( n:namespace -- ) namestack* pop* ; +: ndrop ( -- ) namestack* pop* ; : global ( -- g ) 4 getenv { hashtable } declare ; inline : get ( variable -- value ) namestack* hash-stack ; : set ( value variable -- ) namespace set-hash ; inline diff --git a/library/collections/queues.factor b/library/collections/queues.factor index 3f8daee367..f8c9f92b77 100644 --- a/library/collections/queues.factor +++ b/library/collections/queues.factor @@ -34,7 +34,7 @@ C: queue ( -- queue ) ; ] if ; TUPLE: empty-queue ; -: empty-queue throw ; +: empty-queue ( -- * ) throw ; : deque ( queue -- obj ) dup queue-empty? [ diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 4287a468d4..3ba4984acf 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -4,13 +4,13 @@ IN: sequences USING: arrays errors generic kernel kernel-internals math sequences-internals strings vectors words ; -: first2 ( { x y } -- x y ) +: first2 ( seq -- x y ) 1 swap bounds-check nip first2-unsafe ; -: first3 ( { x y z } -- x y z ) +: first3 ( seq -- x y z ) 2 swap bounds-check nip first3-unsafe ; -: first4 ( { x y z w } -- x y z w ) +: first4 ( seq -- x y z w ) 3 swap bounds-check nip first4-unsafe ; M: object like drop ; @@ -129,21 +129,21 @@ M: object like drop ; 2dup [ length ] 2apply tuck number= [ (mismatch) -1 number= ] [ 3drop f ] if ; inline -M: array equal? ( obj seq -- ? ) +M: array equal? over array? [ sequence= ] [ 2drop f ] if ; -M: quotation equal? ( obj seq -- ? ) +M: quotation equal? over quotation? [ sequence= ] [ 2drop f ] if ; -M: sbuf equal? ( obj seq -- ? ) +M: sbuf equal? over sbuf? [ sequence= ] [ 2drop f ] if ; -M: vector equal? ( obj seq -- ? ) +M: vector equal? over vector? [ sequence= ] [ 2drop f ] if ; UNION: sequence array string sbuf vector quotation ; -M: sequence hashcode ( hash -- n ) +M: sequence hashcode dup empty? [ drop 0 ] [ first hashcode ] if ; IN: kernel @@ -155,7 +155,7 @@ M: object <=> : depth ( -- n ) datastack length ; TUPLE: no-cond ; -: no-cond throw ; +: no-cond ( -- * ) throw ; : cond ( conditions -- ) [ first call ] find nip dup [ second call ] [ no-cond ] if ; diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index 1242acb5f1..f9ac60aef2 100644 --- a/library/collections/sequences.factor +++ b/library/collections/sequences.factor @@ -6,7 +6,7 @@ USING: errors generic kernel math math-internals strings vectors ; GENERIC: length ( sequence -- n ) GENERIC: set-length ( n sequence -- ) GENERIC: nth ( n sequence -- obj ) -GENERIC: set-nth ( value n sequence -- obj ) +GENERIC: set-nth ( value n sequence -- ) GENERIC: thaw ( seq -- mutable-seq ) GENERIC: like ( seq seq -- seq ) @@ -33,8 +33,8 @@ IN: sequences-internals GENERIC: resize ( n seq -- seq ) ! Unsafe sequence protocol for inner loops -GENERIC: nth-unsafe -GENERIC: set-nth-unsafe +GENERIC: nth-unsafe ( n sequence -- elt ) +GENERIC: set-nth-unsafe ( elt n sequence -- ) M: object nth-unsafe nth ; M: object set-nth-unsafe set-nth ; diff --git a/library/collections/strings.factor b/library/collections/strings.factor index 33d2254706..31eadd22bb 100644 --- a/library/collections/strings.factor +++ b/library/collections/strings.factor @@ -4,7 +4,7 @@ IN: strings USING: generic kernel kernel-internals math sequences sequences-internals ; -M: string equal? ( obj str -- ? ) +M: string equal? over string? [ over hashcode over hashcode number= [ sequence= ] [ 2drop f ] if @@ -66,5 +66,5 @@ UNION: alpha Letter digit ; M: string thaw drop SBUF" " clone ; -M: string like ( seq sbuf -- string ) +M: string like drop dup string? [ >string ] unless ; diff --git a/library/collections/vectors.factor b/library/collections/vectors.factor index 263bcc2cbf..007e4e4824 100644 --- a/library/collections/vectors.factor +++ b/library/collections/vectors.factor @@ -4,17 +4,17 @@ IN: vectors USING: arrays errors generic kernel kernel-internals math math-internals sequences sequences-internals words ; -M: vector set-length ( len vec -- ) +M: vector set-length grow-length ; -M: vector nth-unsafe ( n vec -- obj ) underlying nth-unsafe ; +M: vector nth-unsafe underlying nth-unsafe ; -M: vector nth ( n vec -- obj ) bounds-check nth-unsafe ; +M: vector nth bounds-check nth-unsafe ; -M: vector set-nth-unsafe ( obj n vec -- ) +M: vector set-nth-unsafe underlying set-nth-unsafe ; -M: vector set-nth ( obj n vec -- ) +M: vector set-nth growable-check 2dup ensure set-nth-unsafe ; : >vector ( seq -- vector ) @@ -22,7 +22,7 @@ M: vector set-nth ( obj n vec -- ) M: object thaw drop V{ } clone ; -M: vector clone ( vector -- vector ) clone-growable ; +M: vector clone clone-growable ; M: vector like drop dup vector? [ diff --git a/library/collections/virtual-sequences.factor b/library/collections/virtual-sequences.factor index 5e70727da4..5217ba959b 100644 --- a/library/collections/virtual-sequences.factor +++ b/library/collections/virtual-sequences.factor @@ -8,20 +8,20 @@ TUPLE: reversed seq ; : reversed@ reversed-seq [ length swap - 1- ] keep ; inline -M: reversed length ( seq -- n ) reversed-seq length ; +M: reversed length reversed-seq length ; -M: reversed nth ( n seq -- elt ) reversed@ nth ; +M: reversed nth reversed@ nth ; -M: reversed nth-unsafe ( n seq -- elt ) reversed@ nth-unsafe ; +M: reversed nth-unsafe reversed@ nth-unsafe ; -M: reversed set-nth ( elt n seq -- ) reversed@ set-nth ; +M: reversed set-nth reversed@ set-nth ; -M: reversed set-nth-unsafe ( elt n seq -- ) +M: reversed set-nth-unsafe reversed@ set-nth-unsafe ; -M: reversed like ( seq reversed -- seq ) reversed-seq like ; +M: reversed like reversed-seq like ; -M: reversed thaw ( seq -- seq ) reversed-seq thaw ; +M: reversed thaw reversed-seq thaw ; : reverse ( seq -- seq ) [ ] keep like ; @@ -32,7 +32,7 @@ TUPLE: slice seq from to ; dup slice-from swap slice-seq >r tuck + >r + r> r> ; TUPLE: slice-error reason ; -: slice-error ( str -- ) throw ; +: slice-error ( str -- * ) throw ; : check-slice ( from to seq -- ) pick 0 < [ "start < 0" slice-error ] when @@ -47,20 +47,20 @@ C: slice ( from to seq -- seq ) [ set-slice-to ] keep [ set-slice-from ] keep ; -M: slice length ( range -- n ) +M: slice length dup slice-to swap slice-from - ; : slice@ ( n slice -- n seq ) [ slice-from + ] keep slice-seq ; inline -M: slice nth ( n slice -- obj ) slice@ nth ; +M: slice nth slice@ nth ; -M: slice nth-unsafe ( n slice -- obj ) slice@ nth-unsafe ; +M: slice nth-unsafe slice@ nth-unsafe ; -M: slice set-nth ( obj n slice -- ) slice@ set-nth ; +M: slice set-nth slice@ set-nth ; -M: slice set-nth-unsafe ( n slice -- obj ) slice@ set-nth-unsafe ; +M: slice set-nth-unsafe slice@ set-nth-unsafe ; -M: slice like ( seq slice -- seq ) slice-seq like ; +M: slice like slice-seq like ; -M: slice thaw ( seq -- seq ) slice-seq thaw ; +M: slice thaw slice-seq thaw ; diff --git a/library/compiler/alien/alien-callback.factor b/library/compiler/alien/alien-callback.factor index bee7fb5eab..ac90293718 100644 --- a/library/compiler/alien/alien-callback.factor +++ b/library/compiler/alien/alien-callback.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: alien USING: compiler errors generic hashtables inference inspector -kernel namespaces sequences strings words ; +kernel namespaces sequences strings words parser ; TUPLE: alien-callback return parameters quot xt ; C: alien-callback make-node ; @@ -15,7 +15,7 @@ TUPLE: alien-callback-error ; : callback-bottom ( node -- ) alien-callback-xt [ word-xt ] curry infer-quot ; -\ alien-callback [ [ string object quotation ] [ alien ] ] +\ alien-callback [ string object quotation ] [ alien ] "infer-effect" set-word-prop \ alien-callback [ @@ -55,7 +55,7 @@ TUPLE: alien-callback-error ; %return ] generate-1 ; -M: alien-callback generate-node ( node -- ) +M: alien-callback generate-node end-basic-block compile-gc generate-callback iterate-next ; M: alien-callback stack-reserve* diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor index 156d8cbb24..ba4664623b 100644 --- a/library/compiler/alien/alien-invoke.factor +++ b/library/compiler/alien/alien-invoke.factor @@ -4,7 +4,7 @@ IN: alien USING: arrays assembler compiler compiler errors generic hashtables inference inspector io kernel kernel-internals math namespaces parser -prettyprint sequences strings words ; +prettyprint sequences strings words parser ; TUPLE: alien-invoke library function return parameters ; C: alien-invoke make-node ; @@ -22,7 +22,7 @@ TUPLE: alien-invoke-error library symbol ; : alien-invoke ( ... return library function parameters -- ... ) pick pick throw ; -\ alien-invoke [ [ string object string object ] [ ] ] +\ alien-invoke [ string object string object ] [ ] "infer-effect" set-word-prop \ alien-invoke [ @@ -60,7 +60,7 @@ TUPLE: alien-invoke-error library symbol ; alien-invoke-parameters stack-space %cleanup ] if ; -M: alien-invoke generate-node ( node -- ) +M: alien-invoke generate-node end-basic-block compile-gc dup alien-invoke-parameters objects>registers dup alien-invoke-dlsym %alien-invoke diff --git a/library/compiler/alien/aliens.factor b/library/compiler/alien/aliens.factor index 90507a230d..f67e3a0a26 100644 --- a/library/compiler/alien/aliens.factor +++ b/library/compiler/alien/aliens.factor @@ -8,7 +8,7 @@ sequences ; UNION: c-ptr byte-array alien ; -M: alien equal? ( obj obj -- ? ) +M: alien equal? over alien? [ 2dup [ expired? ] 2apply 2dup or [ 2swap 2drop diff --git a/library/compiler/alien/objc/utilities.factor b/library/compiler/alien/objc/utilities.factor index 66dde73418..1f2dc14526 100644 --- a/library/compiler/alien/objc/utilities.factor +++ b/library/compiler/alien/objc/utilities.factor @@ -119,7 +119,8 @@ H{ } clone objc-methods set-global \ (send) [ pop-literal nip infer-send ] "infer" set-word-prop -\ (send) [ [ object object ] [ ] ] "infer-effect" set-word-prop +\ (send) [ object object ] [ ] +"infer-effect" set-word-prop : send ( ... selector -- ... ) f (send) ; inline diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor index 5a40cb136e..d40c27f43e 100644 --- a/library/compiler/generator/generator.factor +++ b/library/compiler/generator/generator.factor @@ -66,14 +66,14 @@ GENERIC: generate-node ( node -- ) [ [ generate-nodes ] with-node-iterator ] generate-1 ; ! node -M: node generate-node ( node -- next ) drop iterate-next ; +M: node generate-node drop iterate-next ; ! #label : generate-call ( label -- next ) end-basic-block tail-call? [ %jump f ] [ %call iterate-next ] if ; -M: #label generate-node ( node -- next ) +M: #label generate-node dup node-param dup generate-call >r swap node-child generate r> ; @@ -87,7 +87,7 @@ M: #label generate-node ( node -- next ) r> r> end-false-branch resolve-label generate-nodes ] keep resolve-label iterate-next ; -M: #if generate-node ( node -- next ) +M: #if generate-node [ end-basic-block