Factor plugin 0.74

TODO.FACTOR.txt

@@ -56,11 +56,17 @@
 
 + sequences
 
+- dipping nmap
 - generic each some? all? member? memq? all=? top
   index? subseq?
+- index and index* are very slow with lists
+- map, subset, project, append: not tail recursive
 
 + kernel:
 
+- unions containing tuples do not work properly
+- tuples should probably not be sequences
+- need G: combinations
 - method doc strings
 - make-image: use a list not a vector
 - code walker & exceptions
@@ -75,11 +81,6 @@
 - doc comments of generics
 - proper ordering for classes
 
-+ slow data structures:
-
-- vector-map, string-map, seq-each, vector-project: consing
-- map, subset, project, append: not tail recursive
-
 + nice to have libraries:
 
 - regexps

library/arrays.factor

@@ -13,20 +13,13 @@ USING: generic kernel lists math-internals sequences vectors ;
 ! low-level... but be aware that vectors are usually a better
 ! choice.
 
-BUILTIN: array 8 [ 1 length f ] ;
+BUILTIN: array 8  ;
 
-: array-nth ( n array -- obj )
+: array-capacity ( a -- n ) 1 slot ; inline
-    #! Unsafe.
+: array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline
-    swap 2 fixnum+ slot ; inline
+: set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline
-
+: dispatch ( n vtable -- ) 2 slot array-nth call ;
-: set-array-nth ( obj n array -- )
-    #! Unsafe.
-    swap 2 fixnum+ set-slot ; inline
 
+M: array length array-capacity ;
 M: array nth array-nth ;
 M: array set-nth set-array-nth ;
-
-: dispatch ( n vtable -- )
-    #! This word is unsafe since n is not bounds-checked. Do not
-    #! call it directly.
-    2 slot array-nth call ;

library/generic/tuple.factor

@@ -37,7 +37,7 @@ M: object set-delegate 2drop ;
 M: tuple set-delegate 3 set-slot ;
 
 : check-array ( n array -- )
-    length 0 swap between? [
+    array-capacity 0 swap between? [
         "Array index out of bounds" throw
     ] unless ;
 
@@ -169,7 +169,7 @@ UNION: arrayed array tuple ;
 : clone-tuple ( tuple -- tuple )
     #! Make a shallow copy of a tuple, without cloning its
     #! delegate.
-    dup length dup <tuple> [ -rot copy-array ] keep ;
+    dup array-capacity dup <tuple> [ -rot copy-array ] keep ;
 
 M: tuple clone ( tuple -- tuple )
     #! Clone a tuple and its delegate.

library/sequences-epilogue.factor

@@ -17,29 +17,56 @@ UNION: sequence array general-list string sbuf tuple vector ;
 M: object >list ( seq -- list ) dup length 0 rot (>list) ;
 M: general-list >list ( list -- list ) ;
 
-: seq-each ( seq quot -- )
+GENERIC: (seq-each) ( quot seq -- ) inline
-    >r >list r> each ; inline
+
+M: object (seq-each) ( quot seq -- )
+    dup length [
+        3dup >r >r >r swap nth swap call r> r> r>
+    ] repeat 2drop ;
+
+M: general-list (seq-each) ( quot seq -- )
+    swap each ;
+
+: seq-each ( seq quot -- ) swap (seq-each) ; inline
 
 : seq-each-with ( obj seq quot -- )
     swap [ with ] seq-each 2drop ; inline
 
-: length= ( seq seq -- ? ) length swap length number= ;
+GENERIC: (tree-each) ( quot obj -- ) inline
+M: object (tree-each) swap call ;
+M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ;
+M: f (tree-each) swap call ;
+M: sequence (tree-each) [ swap call ] seq-each-with ;
+: tree-each swap (tree-each) ; inline
+: tree-each-with ( obj vector quot -- )
+    swap [ with ] tree-each 2drop ; inline
 
-M: sequence = ( obj seq -- ? )
+: 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ;
-    2dup eq? [
+
-        2drop t
+: (seq-2nmap) ( seq1 seq2 i quot -- elt3 )
+    pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline
+
+: seq-2nmap ( seq1 seq2 quot -- | quot: elt1 elt2 -- elt3 )
+    #! Destructive on seq2.
+    over length [
+        [ >r 3dup r> swap (seq-2nmap) ] keep
+    ] repeat 3drop ; inline
+
+: seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 )
+    >r clone r> over >r seq-2nmap r> ; inline
+
+: index* ( obj i seq -- n )
+    #! The index of the object in the sequence, starting from i.
+    2dup length >= [
+        3drop -1
     ] [
-        over type over type eq? [
+        3dup nth = [ drop nip ] [ >r 1 + r> index* ] ifte
-            2dup length= [
-                swap >list swap >list =
-            ] [
-                2drop f
-            ] ifte
-        ] [
-            2drop f
-        ] ifte
     ] ifte ;
 
+: index ( obj seq -- n )
+    #! The index of the object in the sequence.
+    0 swap index* ;
+
 : push ( element sequence -- )
     #! Push a value on the end of a sequence.
     dup length swap set-nth ;
@@ -58,14 +85,22 @@ M: sequence = ( obj seq -- ? )
 
 : >pop> ( stack -- stack ) dup pop drop ;
 
-GENERIC: (tree-each) ( quot obj -- ) inline
+: length= ( seq seq -- ? ) length swap length number= ;
-M: object (tree-each) swap call ;
+
-M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ;
+M: sequence = ( obj seq -- ? )
-M: f (tree-each) swap call ;
+    2dup eq? [
-M: sequence (tree-each) [ swap call ] seq-each-with ;
+        2drop t
-: tree-each swap (tree-each) ; inline
+    ] [
-: tree-each-with ( obj vector quot -- )
+        over type over type eq? [
-    swap [ with ] tree-each 2drop ; inline
+            2dup length= [
+                swap >list swap >list =
+            ] [
+                2drop f
+            ] ifte
+        ] [
+            2drop f
+        ] ifte
+    ] ifte ;
 
 IN: kernel
 

library/test/vectors.factor

@@ -88,3 +88,6 @@ unit-test
         "x" get clone length
     ] with-scope
 ] unit-test
+
+[ -1 ] [ 5 { } index ] unit-test
+[ 4 ] [ 5 { 1 2 3 4 5 } index ] unit-test