sequence= is now inlined

TODO.FACTOR.txt

@@ -1,6 +1,5 @@
 + 0.84:
 
-- mach_signal not working, right now
 - fix contribs: boids, automata
 - sometimes darcs get fails with the httpd
 - gdb triggers 'mutliple i/o ops on port' error
@@ -20,12 +19,12 @@
 - see if alien calls can be made faster
 - faster sequence= for UI
 - remove literal table
-- generic 'define ( asset def -- )'
 
 ========================================================================
 
 + ui:
 
+- doc front page: document stack effect notation
 - better doc for accumulate, link from tree
 - we have trouble drawing rectangles
 - the UI listener has a shitty design. perhaps it should not call out
@@ -72,6 +71,7 @@
 
 + module system:
 
+- generic 'define ( asset def -- )'
 - track individual method usages
 - C types should be words
   - TYPEDEF: float { ... } { ... } ;   ==> \ float T{ c-type ... } "c-type" swp

library/bootstrap/boot-stage2.factor

@@ -39,6 +39,8 @@ parser sequences sequences-internals words ;
         [
             \ number= compile
             \ + compile
+            \ nth compile
+            \ set-nth compile
             \ = compile
             { "kernel" "sequences" "assembler" } compile-vocabs
 

library/collections/hashtables.factor

@@ -231,9 +231,8 @@ M: hashtable clone ( hash -- hash )
 : hashtable= ( hash hash -- ? )
     2dup subhash? >r swap subhash? r> and ;
 
-M: hashtable = ( obj hash -- ? )
+M: hashtable equal? ( obj hash -- ? )
     {
-        { [ 2dup eq? ] [ 2drop t ] }
         { [ over hashtable? not ] [ 2drop f ] }
         { [ 2dup [ hash-size ] 2apply number= not ] [ 2drop f ] }
         { [ t ] [ hashtable= ] }

library/collections/sequences-epilogue.factor

@@ -127,17 +127,22 @@ M: object like drop ;
 
 : sequence= ( seq seq -- ? )
     2dup [ length ] 2apply tuck number=
-    [ (mismatch) -1 number= ] [ 3drop f ] if ;
+    [ (mismatch) -1 number= ] [ 3drop f ] if ; inline
+
+M: array equal? ( obj seq -- ? )
+    over array? [ sequence= ] [ 2drop f ] if ;
+
+M: quotation equal? ( obj seq -- ? )
+    over quotation? [ sequence= ] [ 2drop f ] if ;
+
+M: sbuf equal? ( obj seq -- ? )
+    over sbuf? [ sequence= ] [ 2drop f ] if ;
+
+M: vector equal? ( obj seq -- ? )
+    over vector? [ sequence= ] [ 2drop f ] if ;
 
 UNION: sequence array string sbuf vector quotation ;
 
-M: sequence = ( obj seq -- ? )
-    2dup eq? [
-        2drop t
-    ] [
-        over type over type eq? [ sequence= ] [ 2drop f ] if
-    ] if ;
-
 M: sequence hashcode ( hash -- n )
     dup empty? [ drop 0 ] [ first hashcode ] if ;
 

library/collections/strings.factor

@@ -4,7 +4,7 @@ IN: strings
 USING: generic kernel kernel-internals math sequences
 sequences-internals ;
 
-M: string = ( obj str -- ? )
+M: string equal? ( obj str -- ? )
     over string? [
         over hashcode over hashcode number=
         [ sequence= ] [ 2drop f ] if

library/compiler/alien/aliens.factor

@@ -8,7 +8,7 @@ sequences ;
 
 UNION: c-ptr byte-array alien ;
 
-M: alien = ( obj obj -- ? )
+M: alien equal? ( obj obj -- ? )
     over alien? [
         2dup [ expired? ] 2apply 2dup or [
             2swap 2drop

library/compiler/inference/dataflow.factor

@@ -12,7 +12,7 @@ TUPLE: node param shuffle
        classes literals history
        successor children ;
 
-M: node = eq? ;
+M: node equal? eq? ;
 
 : make-node ( param in-d out-d in-r out-r node -- node )
     [ >r swapd <shuffle> f f f f f <node> r> set-delegate ] keep ;

library/compiler/inference/shuffle.factor

@@ -17,7 +17,7 @@ C: value ( obj -- value )
 
 M: value hashcode value-uid ;
 
-M: value = eq? ;
+M: value equal? eq? ;
 
 M: integer value-uid ;
 

library/generic/tuple.factor

@@ -80,11 +80,10 @@ TUPLE: check-tuple class ;
 M: tuple clone ( tuple -- tuple )
     (clone) dup delegate clone over set-delegate ;
 
-M: tuple hashcode ( tuple -- n ) class hashcode ;
+M: tuple hashcode ( tuple -- n ) 2 slot hashcode ;
 
-M: tuple = ( obj tuple -- ? )
+M: tuple equal? ( obj tuple -- ? )
-    2dup eq?
+    over tuple? [ tuple= ] [ 2drop f ] if ;
-    [ 2drop t ] [ over tuple? [ tuple= ] [ 2drop f ] if ] if ;
 
 : (delegates) ( obj -- )
     [ dup delegate (delegates) , ] when* ;

library/kernel.factor

@@ -10,8 +10,11 @@ USING: generic kernel-internals math math-internals ;
 GENERIC: hashcode ( obj -- n )
 M: object hashcode drop 0 ;
 
-GENERIC: = ( obj obj -- ? )
+GENERIC: equal? ( obj obj -- ? )
-M: object = eq? ;
+M: object equal? eq? ;
+
+: = ( obj obj -- ? )
+    2dup eq? [ 2drop t ] [ equal? ] if ; inline
 
 GENERIC: <=> ( obj1 obj2 -- n )
 

library/math/complex.factor

@@ -13,7 +13,7 @@ UNION: number real complex ;
 M: real real ;
 M: real imaginary drop 0 ;
 
-M: number = ( n n -- ? ) number= ;
+M: number equal? ( n n -- ? ) number= ;
 
 : rect> ( xr xi -- x )
     over real? over real? and [

library/quotations.factor

@@ -4,7 +4,7 @@ IN: kernel
 USING: arrays generic kernel-internals math namespaces sequences
 sequences-internals words ;
 
-M: wrapper =
+M: wrapper equal?
     over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ;
 
 M: quotation clone (clone) ;

library/ui/freetype/freetype-gl.factor

@@ -25,7 +25,7 @@ SYMBOL: open-fonts
 ! sprites is a vector.
 TUPLE: font ascent descent height handle widths ;
 
-M: font = eq? ;
+M: font equal? eq? ;
 
 : close-font ( font -- ) font-handle FT_Done_Face ;
 

library/ui/gadgets.factor

@@ -50,7 +50,7 @@ pref-dim parent children orientation state
 visible? root? clipped? grafted?
 interior boundary ;
 
-M: gadget = eq? ;
+M: gadget equal? eq? ;
 
 : gadget-child gadget-children first ;