lists are sequences; unions bug fix

factor/ExternalFactor.java

@@ -202,7 +202,7 @@ public class ExternalFactor extends DefaultVocabularyLookup
 		String name = (String)info.next().next().car;
 		FactorWord w = super.searchVocabulary(new Cons(vocabulary,null),name);
 		if(w == null)
-			w = new FactorWord(this,vocabulary,name);
+			w = define(vocabulary,name);
 		w.stackEffect = (String)info.next().next().next().car;
 		w.setDefiner(definer);
 		return w;

factor/jedit/FactorBufferProcessor.java

@@ -52,15 +52,18 @@ public abstract class FactorBufferProcessor
 		Cons wordCodeMap = null;
 		while(words != null)
 		{
-			FactorWord word = (FactorWord)words.car;
+			if(words.car instanceof FactorWord)
-			String expr = processWord(word);
+			{
-			buf.append("! ");
+				FactorWord word = (FactorWord)words.car;
-			buf.append(expr);
+				String expr = processWord(word);
-			buf.append('\n');
+				buf.append("! ");
-			if(evalInListener)
+				buf.append(expr);
-				FactorPlugin.evalInListener(view,expr);
+				buf.append('\n');
-			else
+				if(evalInListener)
-				buf.append(FactorPlugin.evalInWire(expr));
+					FactorPlugin.evalInListener(view,expr);
+				else
+					buf.append(FactorPlugin.evalInWire(expr));
+			}
 			words = words.next();
 		}
 		

library/bootstrap/boot-stage3.factor

@@ -111,6 +111,10 @@ os "win32" = [
     "/library/io/win32-server.factor"
 ] pull-in
 
+os "unix" = [
+    "/library/unix/syscalls.factor"
+] pull-in
+
 FORGET: pull-in
 
 "/library/bootstrap/boot-stage4.factor" dup print run-resource

library/compiler/alien.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: assembler compiler errors generic hashtables inference
+USING: assembler compiler errors generic hashtables
-interpreter kernel lists math namespaces parser sequences stdio
+inference interpreter kernel lists math namespaces parser
-strings unparser words ;
+prettyprint sequences stdio strings unparser words ;
 
 ! ! ! WARNING ! ! !
 ! Reloading this file into a running Factor instance on Win32
@@ -43,14 +43,21 @@ M: alien = ( obj obj -- ? )
         2drop f
     ] ifte ;
 
-M: alien unparse ( obj -- str )
+: ALIEN: scan <alien> swons ; parsing
-    [
+
-        "#<" ,
+: LOCAL-ALIEN: "Local aliens are not readable" throw ; parsing
-        dup local-alien? "local-alien" "alien" ? ,
+
-        " @ " ,
+M: alien prettyprint* ( alien -- str )
-        alien-address unparse ,
+    dup local-alien? [
-        ">" ,
+        \ LOCAL-ALIEN:
-    ] make-string ;
+    ] [
+        \ ALIEN:
+    ] ifte word-bl alien-address unparse write ;
+
+M: dll unparse ( obj -- str )
+    [ "DLL\" " , dll-path unparse-string CHAR: " , ] make-string ;
+
+: DLL" skip-blank parse-string dlopen swons ; parsing
 
 : library ( name -- object )
     dup [ "libraries" get hash ] when ;

library/generic/union.factor

@@ -18,7 +18,7 @@ union [
     "members" word-prop [ >r 3dup r> add-method ] each 3drop
 ] "add-method" set-word-prop
 
-union 30 "priority" set-word-prop
+union 55 "priority" set-word-prop
 
 union [ 2drop t ] "class<" set-word-prop
 

library/hashtables.factor

@@ -138,7 +138,7 @@ IN: hashtables
 M: hashtable clone ( hash -- hash )
     dup bucket-count <hashtable>
     over hash-size over set-hash-size [
-        hash-array swap hash-array dup array-capacity copy-array
+        hash-array swap hash-array dup length copy-array
     ] keep ;
 
 : hash-subset? ( subset of -- ? )

library/io/buffer.factor

@@ -29,10 +29,6 @@ C: buffer ( size -- buffer )
     dup buffer-ptr over buffer-pos +
     over buffer-fill rot buffer-pos - memory>string ;
 
-: buffer-first-n ( count buffer -- string )
-    [ dup buffer-fill swap buffer-pos - min ] keep
-    dup buffer-ptr swap buffer-pos + swap memory>string ;
-
 : buffer-reset ( count buffer -- )
     #! Reset the position to 0 and the fill pointer to count.
     [ set-buffer-fill ] keep 0 swap set-buffer-pos ;
@@ -47,6 +43,12 @@ C: buffer ( size -- buffer )
         [ 0 swap set-buffer-fill ] keep
     ] when drop ;
 
+: buffer@ ( buffer -- int ) dup buffer-ptr swap buffer-pos + ;
+
+: buffer-first-n ( count buffer -- string )
+    [ dup buffer-fill swap buffer-pos - min ] keep
+    buffer@ swap memory>string ;
+
 : buffer> ( count buffer -- string )
     [ buffer-first-n ] 2keep buffer-consume ;
 
@@ -81,4 +83,11 @@ C: buffer ( size -- buffer )
     #! Increases the fill pointer by count.
     [ buffer-fill + ] keep set-buffer-fill ;
 
-: buffer@ ( buffer -- int ) dup buffer-ptr swap buffer-pos + ;
+: buffer-end ( buffer -- int ) dup buffer-ptr swap buffer-fill + ;
+
+: buffer-peek ( buffer -- char )
+    buffer@ <alien> 0 alien-unsigned-1 ;
+
+: buffer-set ( string buffer -- )
+    2dup buffer-ptr string>memory
+    >r string-length r> buffer-reset ;

library/kernel.factor

@@ -46,5 +46,5 @@ IN: alien
 
 ! See compiler/alien.factor for the rest; this needs to be here
 ! since primitive stack effects involve alien inputs/outputs.
-BUILTIN: dll   15 ;
+BUILTIN: dll   15 [ 1 "dll-path" f ] ;
 BUILTIN: alien 16 ;

library/lists.factor

@@ -1,10 +1,18 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: lists USING: generic kernel math sequences ;
+IN: lists USING: errors generic kernel math sequences ;
 
 ! Sequence protocol
-M: cons length 0 swap [ drop 1 + ] each ;
+M: general-list length 0 swap [ drop 1 + ] each ;
-M: f length drop 0 ;
+
+M: f nth "List index out of bounds" throw ;
+
+M: cons nth ( n list -- element )
+    >r dup 0 = [
+        drop r> car
+    ] [
+        1 - r> cdr nth
+    ] ifte ;
 
 : 2list ( a b -- [ a b ] )
     unit cons ;
@@ -122,6 +130,8 @@ M: cons = ( obj cons -- ? )
         ] ifte
     ] ifte ;
 
+M: f = ( obj f -- ? ) eq? ;
+
 M: cons hashcode ( cons -- hash ) car hashcode ;
 
 : (count) ( i n -- list )

library/sequences-epilogue.factor

@@ -5,16 +5,17 @@ USING: generic kernel kernel-internals lists math strings
 vectors ;
 
 ! This is loaded once everything else is available.
-UNION: sequence array vector string sbuf tuple ;
+UNION: sequence array general-list string sbuf tuple vector ;
 
-M: object (>list) ( n i seq -- list )
+: (>list) ( n i seq -- list )
     pick pick <= [
         3drop [ ]
     ] [
         2dup nth >r >r 1 + r> (>list) r> swons
     ] ifte ;
 
-M: vector (>list) vector-array (>list) ;
+M: object >list ( seq -- list ) dup length 0 rot (>list) ;
+M: general-list >list ( list -- list ) ;
 
 : seq-each ( seq quot -- )
     >r >list r> each ; inline
@@ -22,14 +23,13 @@ M: vector (>list) vector-array (>list) ;
 : seq-each-with ( obj seq quot -- )
     swap [ with ] seq-each 2drop ; inline
 
-: length= ( seq seq -- ? )
+: length= ( seq seq -- ? ) length swap length number= ;
-    length swap length number= ;
 
 M: sequence = ( obj seq -- ? )
     2dup eq? [
         2drop t
     ] [
-        over sequence? [
+        over type over type eq? [
             2dup length= [
                 swap >list swap >list =
             ] [

library/sequences.factor

@@ -16,6 +16,4 @@ GENERIC: length ( sequence -- n )
 GENERIC: set-length ( n sequence -- )
 GENERIC: nth ( n sequence -- obj )
 GENERIC: set-nth ( value n sequence -- obj )
-
+GENERIC: >list ( seq -- list )
-GENERIC: (>list) ( n i seq -- list )
-: >list ( seq -- list ) dup length 0 rot (>list) ;

library/syntax/parse-syntax.factor

@@ -3,8 +3,8 @@
 
 ! Bootstrapping trick; see doc/bootstrap.txt.
 IN: !syntax
-USING: syntax errors generic hashtables kernel lists
+USING: alien errors generic hashtables kernel lists math
-math namespaces parser strings words vectors unparse ;
+namespaces parser strings syntax unparse vectors words ;
 
 : parsing ( -- )
     #! Mark the most recently defined word to execute at parse
@@ -114,16 +114,16 @@ BUILTIN: f 9 ;  : f f swons ; parsing
         [ next-char swap , ] keep (parse-string)
     ] ifte ;
 
-: parse-string [ "line" get (parse-string) ] make-string ;
+: parse-string ( -- str )
-: "
+    #! Read a string from the input stream, until it is
+    #! terminated by a ".
     "col" [
-         parse-string swap
+        [ "line" get (parse-string) ] make-string swap
-    ] change swons ; parsing
+    ] change ;
 
-: s"
+: " parse-string swons ; parsing
-    "col" [
+
-        "line" get skip-blank parse-string string>sbuf swap
+: SBUF" skip-blank parse-string string>sbuf swons ; parsing
-    ] change swons ; parsing
 
 ! Comments
 : (

library/syntax/unparser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: unparser
-USING: generic kernel lists math memory namespaces parser
+USING: alien generic kernel lists math memory namespaces parser
 sequences sequences stdio strings words ;
 
 GENERIC: unparse ( obj -- str )
@@ -94,7 +94,7 @@ M: string unparse ( str -- str )
     [ CHAR: " , unparse-string CHAR: " , ] make-string ;
 
 M: sbuf unparse ( str -- str )
-    [ "s\" " , unparse-string CHAR: " , ] make-string ;
+    [ "SBUF\" " , unparse-string CHAR: " , ] make-string ;
 
 M: word unparse ( obj -- str ) word-name dup "#<unnamed>" ? ;
 

library/test/generic.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: parser prettyprint stdio ;
+USING: parser prettyprint sequences stdio ;
 
 USE: hashtables
 USE: namespaces
@@ -136,3 +136,9 @@ TUPLE: another-one ;
 GENERIC: stack-underflow
 M: object stack-underflow 2drop ;
 M: word stack-underflow 2drop ;
+
+GENERIC: testing
+M: cons testing 2 ;
+M: f testing 3 ;
+M: sequence testing 4 ;
+[ [ 1 2 ] 2 ] [ [ 1 2 ] testing ] unit-test

library/test/io/buffer.factor

@@ -8,10 +8,6 @@ USING: kernel io-internals test ;
     rot buffer-free
 ] unit-test
 
-: buffer-set ( string buffer -- )
-    2dup buffer-ptr string>memory
-    >r string-length r> buffer-reset ;
-
 [ "hello world" "" ] [
     "hello world" 65536 <buffer> [ buffer-set ] keep
     dup buffer-contents
@@ -32,6 +28,11 @@ USING: kernel io-internals test ;
 
 [ "hello world" ] [
     "hello" 65536 <buffer> [ buffer-set ] keep
-    " world" over buffer-append
+    " world" over >buffer
     dup buffer-contents swap buffer-free
 ] unit-test
+
+[ CHAR: e ] [
+    "hello" 65536 <buffer> [ buffer-set ] keep
+    1 over buffer-consume buffer-peek
+] unit-test

library/unix/io.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: io-internals
-USING: errors kernel math strings ;
+USING: errors kernel math sequences strings ;
 
 : file-mode OCT: 0600 ;
 
@@ -15,16 +15,46 @@ USING: errors kernel math strings ;
     dup io-error ;
 
 : read-step ( fd buffer -- ? )
-    tuck dup buffer@ swap buffer-capacity sys-read
+    tuck dup buffer-end swap buffer-capacity sys-read
-    dup 0 >= [
+    dup 0 >= [ swap n>buffer t ] [ 2drop f ] ifte ;
-        swap buffer-inc-fill t
-    ] [
-        2drop f
-    ] ifte ;
 
 : read-count-step ( sbuf count buffer -- ? )
-    2dup buffer-fill <= [
+    >r over length - r> 2dup buffer-fill <= [
         buffer> swap sbuf-append t
     ] [
         buffer>> nip swap sbuf-append f
     ] ifte ;
+
+: read-line-step ( line buffer -- ? )
+    dup buffer-length 0 = [
+        2drop f
+    ] [
+        dup buffer-peek dup CHAR: \n = [
+            3drop t
+        ] [
+            1 pick buffer-consume pick sbuf-append
+            read-line-step
+        ] ifte
+    ] ifte ;
+
+TUPLE: reader line buffer ready? ;
+
+C: reader ( buffer -- reader )
+    [ set-reader-buffer ] keep ;
+
+: init-reader ( reader -- ) 80 <sbuf> swap set-reader-line ;
+
+: prepare-line ( reader -- ? )
+    dup init-reader
+    dup reader-line over reader-buffer read-line-step
+    [ swap set-reader-ready? ] keep ;
+
+: can-read-line? ( reader -- ? )
+    dup reader-ready? [ drop t ] [ prepare-line ] ifte ;
+
+: reader-eof ( reader -- )
+    dup reader-line dup [
+        length 0 = [ f swap set-reader-line ] when
+    ] [
+        drop
+    ] ifte  t swap set-reader-ready? ;

library/words.factor

@@ -8,6 +8,7 @@ namespaces sequences strings vectors ;
 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 -- )