steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lists are sequences; unions bug fix

cvs
Slava Pestov 2005-04-03 20:55:56 +00:00
parent 5a5f8972ec
commit 4e96d1e5f4
17 changed files with 136 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
factor/ExternalFactor.java
View File

@ -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;

21
factor/jedit/FactorBufferProcessor.java
View File

@ -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();
}

4
library/bootstrap/boot-stage3.factor
View File

@ -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

29
library/compiler/alien.factor
View File

@ -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 <alien> 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 ;

2
library/generic/union.factor
View File

@ -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

2
library/hashtables.factor
View File

@ -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 -- ? )

19
library/io/buffer.factor
View File

@ -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 ;

2
library/kernel.factor
View File

@ -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 ;

16
library/lists.factor
View File

@ -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 )

12
library/sequences-epilogue.factor
View File

@ -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 =
] [

4
library/sequences.factor
View File

@ -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 )

20
library/syntax/parse-syntax.factor
View File

@ -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
: (

4
library/syntax/unparser.factor
View File

@ -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>" ? ;

8
library/test/generic.factor
View File

@ -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

11
library/test/io/buffer.factor
View File

@ -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

46
library/unix/io.factor
View File

@ -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 <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? ;

1
library/words.factor
View File

@ -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 -- )