diff --git a/factor/ExternalFactor.java b/factor/ExternalFactor.java index 2a09a539c1..9c66fcc714 100644 --- a/factor/ExternalFactor.java +++ b/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; diff --git a/factor/jedit/FactorBufferProcessor.java b/factor/jedit/FactorBufferProcessor.java index 348ab0fc8a..9a016a91f8 100644 --- a/factor/jedit/FactorBufferProcessor.java +++ b/factor/jedit/FactorBufferProcessor.java @@ -52,15 +52,18 @@ public abstract class FactorBufferProcessor Cons wordCodeMap = null; while(words != null) { - FactorWord word = (FactorWord)words.car; - String expr = processWord(word); - buf.append("! "); - buf.append(expr); - buf.append('\n'); - if(evalInListener) - FactorPlugin.evalInListener(view,expr); - else - buf.append(FactorPlugin.evalInWire(expr)); + if(words.car instanceof FactorWord) + { + FactorWord word = (FactorWord)words.car; + String expr = processWord(word); + buf.append("! "); + buf.append(expr); + buf.append('\n'); + if(evalInListener) + FactorPlugin.evalInListener(view,expr); + else + buf.append(FactorPlugin.evalInWire(expr)); + } words = words.next(); } diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor index 181c833d73..54cbbc6390 100644 --- a/library/bootstrap/boot-stage3.factor +++ b/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 diff --git a/library/compiler/alien.factor b/library/compiler/alien.factor index efd708f4f5..87e7d483e7 100644 --- a/library/compiler/alien.factor +++ b/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 -interpreter kernel lists math namespaces parser sequences stdio -strings unparser words ; +USING: assembler compiler errors generic hashtables +inference interpreter kernel lists math namespaces parser +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 ) - [ - "#<" , - dup local-alien? "local-alien" "alien" ? , - " @ " , - alien-address unparse , - ">" , - ] make-string ; +: ALIEN: scan swons ; parsing + +: LOCAL-ALIEN: "Local aliens are not readable" throw ; parsing + +M: alien prettyprint* ( alien -- str ) + dup local-alien? [ + \ LOCAL-ALIEN: + ] [ + \ 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 ; diff --git a/library/generic/union.factor b/library/generic/union.factor index 2fa9ba25a6..4560861035 100644 --- a/library/generic/union.factor +++ b/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 diff --git a/library/hashtables.factor b/library/hashtables.factor index 447c42dbe6..53bf540f1f 100644 --- a/library/hashtables.factor +++ b/library/hashtables.factor @@ -138,7 +138,7 @@ IN: hashtables M: hashtable clone ( hash -- hash ) dup bucket-count 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 -- ? ) diff --git a/library/io/buffer.factor b/library/io/buffer.factor index 33c2bffa7a..97fdb27719 100644 --- a/library/io/buffer.factor +++ b/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@ 0 alien-unsigned-1 ; + +: buffer-set ( string buffer -- ) + 2dup buffer-ptr string>memory + >r string-length r> buffer-reset ; diff --git a/library/kernel.factor b/library/kernel.factor index bdaee4209a..a60825d36d 100644 --- a/library/kernel.factor +++ b/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 ; diff --git a/library/lists.factor b/library/lists.factor index 9d5157d042..1618ce0637 100644 --- a/library/lists.factor +++ b/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: f length drop 0 ; +M: general-list length 0 swap [ drop 1 + ] each ; + +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 ) diff --git a/library/sequences-epilogue.factor b/library/sequences-epilogue.factor index e976a16bfd..a0c5c68f1e 100644 --- a/library/sequences-epilogue.factor +++ b/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 swap length number= ; +: length= ( seq seq -- ? ) 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 = ] [ diff --git a/library/sequences.factor b/library/sequences.factor index 59e65535ab..31ffda53f8 100644 --- a/library/sequences.factor +++ b/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) ( n i seq -- list ) -: >list ( seq -- list ) dup length 0 rot (>list) ; +GENERIC: >list ( seq -- list ) diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index 3b4203984b..63578d7b98 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -3,8 +3,8 @@ ! Bootstrapping trick; see doc/bootstrap.txt. IN: !syntax -USING: syntax errors generic hashtables kernel lists -math namespaces parser strings words vectors unparse ; +USING: alien errors generic hashtables kernel lists math +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 - ] change swons ; parsing + [ "line" get (parse-string) ] make-string swap + ] change ; -: s" - "col" [ - "line" get skip-blank parse-string string>sbuf swap - ] change swons ; parsing +: " parse-string swons ; parsing + +: SBUF" skip-blank parse-string string>sbuf swons ; parsing ! Comments : ( diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index 66126a2cc2..8a26dcb228 100644 --- a/library/syntax/unparser.factor +++ b/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 "#" ? ; diff --git a/library/test/generic.factor b/library/test/generic.factor index cf59e812f1..8998e966f1 100644 --- a/library/test/generic.factor +++ b/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 diff --git a/library/test/io/buffer.factor b/library/test/io/buffer.factor index e247ea5aab..c2176c1580 100644 --- a/library/test/io/buffer.factor +++ b/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-set ] keep dup buffer-contents @@ -32,6 +28,11 @@ USING: kernel io-internals test ; [ "hello world" ] [ "hello" 65536 [ buffer-set ] keep - " world" over buffer-append + " world" over >buffer dup buffer-contents swap buffer-free ] unit-test + +[ CHAR: e ] [ + "hello" 65536 [ buffer-set ] keep + 1 over buffer-consume buffer-peek +] unit-test diff --git a/library/unix/io.factor b/library/unix/io.factor index f4f524ad75..8d8cba851a 100644 --- a/library/unix/io.factor +++ b/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 - dup 0 >= [ - swap buffer-inc-fill t - ] [ - 2drop f - ] ifte ; + tuck dup buffer-end swap buffer-capacity sys-read + dup 0 >= [ swap n>buffer 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 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? ; diff --git a/library/words.factor b/library/words.factor index be02890281..cf778d5924 100644 --- a/library/words.factor +++ b/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 -- )