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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-08-13 21:33:27 -05:00
parent 5263cc371c 7afa9959f8
commit e033d2e1b7
24 changed files with 358 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/disjoint-sets/disjoint-sets.factor
View File

@ -88,6 +88,14 @@ M:: disjoint-set equate ( a b disjoint-set -- )
disjoint-set link-sets
] if ;
: equate-all-with ( seq a disjoint-set -- )
'[ , , equate ] each ;
: equate-all ( seq disjoint-set -- )
over dup empty? [ 2drop ] [
[ unclip-slice ] dip equate-all-with
] if ;
M: disjoint-set clone
[ parents>> ] [ ranks>> ] [ counts>> ] tri [ clone ] tri@
disjoint-set boa ;

40
basis/math/ranges/ranges-docs.factor
View File

@ -1,21 +1,27 @@
USING: help.syntax help.markup ;
USING: help.syntax help.markup arrays sequences ;
IN: math.ranges
ARTICLE: "ranges" "Ranges"
"A " { $emphasis "range" } " is a virtual sequence with real elements "
"ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } "."
$nl
"Creating ranges:"
{ $subsection <range> }
{ $subsection [a,b] }
{ $subsection (a,b] }
{ $subsection [a,b) }
{ $subsection (a,b) }
{ $subsection [0,b] }
{ $subsection [1,b] }
{ $subsection [0,b) } ;
"A " { $emphasis "range" } " is a virtual sequence with real number elements "
"ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } "."
$nl
"The class of ranges:"
{ $subsection range }
"Creating ranges with integer end-points. The standard mathematical convention is used, where " { $snippet "(" } " or " { $snippet ")" } " denotes that the end-point itself " { $emphasis "is not" } " part of the range; " { $snippet "[" } " or " { $snippet "]" } " denotes that the end-point " { $emphasis "is" } " part of the range:"
{ $subsection [a,b] }
{ $subsection (a,b] }
{ $subsection [a,b) }
{ $subsection (a,b) }
{ $subsection [0,b] }
{ $subsection [1,b] }
{ $subsection [0,b) }
"Creating general ranges:"
{ $subsection <range> }
"Ranges are most frequently used with sequence combinators as a means of iterating over integers. For example,"
{ $code
"3 10 [a,b] [ sqrt ] map"
}
"A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link change-each } "." ;
ABOUT: "ranges"

17
basis/unix/bsd/bsd.factor
View File

@ -7,13 +7,15 @@ IN: unix
: MAXPATHLEN 1024 ; inline
: O_RDONLY HEX: 0000 ; inline
: O_WRONLY HEX: 0001 ; inline
: O_RDWR HEX: 0002 ; inline
: O_APPEND HEX: 0008 ; inline
: O_CREAT HEX: 0200 ; inline
: O_TRUNC HEX: 0400 ; inline
: O_EXCL HEX: 0800 ; inline
: O_RDONLY HEX: 0000 ; inline
: O_WRONLY HEX: 0001 ; inline
: O_RDWR HEX: 0002 ; inline
: O_NONBLOCK HEX: 0004 ; inline
: O_APPEND HEX: 0008 ; inline
: O_CREAT HEX: 0200 ; inline
: O_TRUNC HEX: 0400 ; inline
: O_EXCL HEX: 0800 ; inline
: O_NOCTTY HEX: 20000 ; inline
: SOL_SOCKET HEX: ffff ; inline
: SO_REUSEADDR HEX: 4 ; inline
@ -24,7 +26,6 @@ IN: unix
: F_SETFD 2 ; inline
: F_SETFL 4 ; inline
: FD_CLOEXEC 1 ; inline
: O_NONBLOCK 4 ; inline
C-STRUCT: sockaddr-in
{ "uchar" "len" }

17
basis/unix/linux/linux.factor
View File

@ -7,13 +7,15 @@ USING: alien.syntax ;
: MAXPATHLEN 1024 ; inline
: O_RDONLY HEX: 0000 ; inline
: O_WRONLY HEX: 0001 ; inline
: O_RDWR HEX: 0002 ; inline
: O_CREAT HEX: 0040 ; inline
: O_EXCL HEX: 0080 ; inline
: O_TRUNC HEX: 0200 ; inline
: O_APPEND HEX: 0400 ; inline
: O_RDONLY HEX: 0000 ; inline
: O_WRONLY HEX: 0001 ; inline
: O_RDWR HEX: 0002 ; inline
: O_CREAT HEX: 0040 ; inline
: O_EXCL HEX: 0080 ; inline
: O_NOCTTY HEX: 0100 ; inline
: O_TRUNC HEX: 0200 ; inline
: O_APPEND HEX: 0400 ; inline
: O_NONBLOCK HEX: 0800 ; inline
: SOL_SOCKET 1 ; inline
@ -28,7 +30,6 @@ USING: alien.syntax ;
: FD_CLOEXEC 1 ; inline
: F_SETFL 4 ; inline
: O_NONBLOCK HEX: 800 ; inline
C-STRUCT: addrinfo
{ "int" "flags" }

2
basis/unix/unix.factor
View File

@ -25,6 +25,8 @@ TYPEDEF: uint socklen_t
: NGROUPS_MAX 16 ; inline
: O_NDELAY O_NONBLOCK ; inline
C-STRUCT: group
{ "char*" "gr_name" }
{ "char*" "gr_passwd" }

5
extra/math/combinatorics/combinatorics-tests.factor
View File

@ -13,11 +13,6 @@ IN: math.combinatorics.tests
[ { 0 1 3 2 } ] [ 1 4 permutation-indices ] unit-test
[ { 1 2 0 6 3 5 4 } ] [ 859 7 permutation-indices ] unit-test
[ { "b" "d" } ] [ { "a" "b" "c" "d" } { 1 3 } reorder ] unit-test
[ { "a" "b" "c" "d" } ] [ { "a" "b" "c" "d" } { 0 1 2 3 } reorder ] unit-test
[ { "d" "c" "b" "a" } ] [ { "a" "b" "c" "d" } { 3 2 1 0 } reorder ] unit-test
[ { "d" "a" "b" "c" } ] [ { "a" "b" "c" "d" } { 3 0 1 2 } reorder ] unit-test
[ 1 ] [ 0 factorial ] unit-test
[ 1 ] [ 1 factorial ] unit-test
[ 3628800 ] [ 10 factorial ] unit-test

7
extra/math/combinatorics/combinatorics.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math math.order math.ranges mirrors
namespaces sequences sorting ;
namespaces sequences sequences.lib sorting ;
IN: math.combinatorics
<PRIVATE
@ -27,9 +27,6 @@ IN: math.combinatorics
: permutation-indices ( n seq -- permutation )
length [ factoradic ] dip 0 pad-left >permutation ;
: reorder ( seq indices -- seq )
[ [ over nth , ] each drop ] { } make ;
PRIVATE>
: factorial ( n -- n! )
@ -42,7 +39,7 @@ PRIVATE>
twiddle [ nPk ] keep factorial / ;
: permutation ( n seq -- seq )
tuck permutation-indices reorder ;
tuck permutation-indices nths ;
: all-permutations ( seq -- seq )
[

1
extra/serial/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

23
extra/serial/serial.factor Normal file
View File

@ -0,0 +1,23 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators destructors
kernel math math.bitfields math.parser sequences summary system
vocabs.loader ;
IN: serial
TUPLE: serial stream path baud
termios iflag oflag cflag lflag ;
ERROR: invalid-baud baud ;
M: invalid-baud summary ( invalid-baud -- string )
"Baud rate "
swap baud>> number>string
" not supported" 3append ;
HOOK: lookup-baud os ( m -- n )
HOOK: open-serial os ( serial -- serial' )
M: serial dispose ( serial -- ) stream>> dispose ;
{
{ [ os unix? ] [ "serial.unix" ] }
} cond require

1
extra/serial/summary.txt Normal file
View File

@ -0,0 +1 @@
Serial port library

1
extra/serial/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

11
extra/serial/unix/bsd/bsd.factor Normal file
View File

@ -0,0 +1,11 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences system serial ;
IN: serial.unix
M: bsd lookup-baud ( m -- n )
dup {
0 50 75 110 134 150 200 300 600 1200 1800 2400 4800
7200 9600 14400 19200 28800 38400 57600 76800 115200
230400 460800 921600
} member? [ invalid-baud ] unless ;

1
extra/serial/unix/bsd/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

130
extra/serial/unix/linux/linux.factor Normal file
View File

@ -0,0 +1,130 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs alien.syntax kernel serial system unix ;
IN: serial.unix
: TCSANOW 0 ; inline
: TCSADRAIN 1 ; inline
: TCSAFLUSH 2 ; inline
: TCIFLUSH 0 ; inline
: TCOFLUSH 1 ; inline
: TCIOFLUSH 2 ; inline
: TCOOFF 0 ; inline
: TCOON 1 ; inline
: TCIOFF 2 ; inline
: TCION 3 ; inline
! iflag
: IGNBRK OCT: 0000001 ; inline
: BRKINT OCT: 0000002 ; inline
: IGNPAR OCT: 0000004 ; inline
: PARMRK OCT: 0000010 ; inline
: INPCK OCT: 0000020 ; inline
: ISTRIP OCT: 0000040 ; inline
: INLCR OCT: 0000100 ; inline
: IGNCR OCT: 0000200 ; inline
: ICRNL OCT: 0000400 ; inline
: IUCLC OCT: 0001000 ; inline
: IXON OCT: 0002000 ; inline
: IXANY OCT: 0004000 ; inline
: IXOFF OCT: 0010000 ; inline
: IMAXBEL OCT: 0020000 ; inline
: IUTF8 OCT: 0040000 ; inline
! oflag
: OPOST OCT: 0000001 ; inline
: OLCUC OCT: 0000002 ; inline
: ONLCR OCT: 0000004 ; inline
: OCRNL OCT: 0000010 ; inline
: ONOCR OCT: 0000020 ; inline
: ONLRET OCT: 0000040 ; inline
: OFILL OCT: 0000100 ; inline
: OFDEL OCT: 0000200 ; inline
: NLDLY OCT: 0000400 ; inline
: NL0 OCT: 0000000 ; inline
: NL1 OCT: 0000400 ; inline
: CRDLY OCT: 0003000 ; inline
: CR0 OCT: 0000000 ; inline
: CR1 OCT: 0001000 ; inline
: CR2 OCT: 0002000 ; inline
: CR3 OCT: 0003000 ; inline
: TABDLY OCT: 0014000 ; inline
: TAB0 OCT: 0000000 ; inline
: TAB1 OCT: 0004000 ; inline
: TAB2 OCT: 0010000 ; inline
: TAB3 OCT: 0014000 ; inline
: BSDLY OCT: 0020000 ; inline
: BS0 OCT: 0000000 ; inline
: BS1 OCT: 0020000 ; inline
: FFDLY OCT: 0100000 ; inline
: FF0 OCT: 0000000 ; inline
: FF1 OCT: 0100000 ; inline
! cflags
: CSIZE OCT: 0000060 ; inline
: CS5 OCT: 0000000 ; inline
: CS6 OCT: 0000020 ; inline
: CS7 OCT: 0000040 ; inline
: CS8 OCT: 0000060 ; inline
: CSTOPB OCT: 0000100 ; inline
: CREAD OCT: 0000200 ; inline
: PARENB OCT: 0000400 ; inline
: PARODD OCT: 0001000 ; inline
: HUPCL OCT: 0002000 ; inline
: CLOCAL OCT: 0004000 ; inline
: CIBAUD OCT: 002003600000 ; inline
: CRTSCTS OCT: 020000000000 ; inline
! lflags
: ISIG OCT: 0000001 ; inline
: ICANON OCT: 0000002 ; inline
: XCASE OCT: 0000004 ; inline
: ECHO OCT: 0000010 ; inline
: ECHOE OCT: 0000020 ; inline
: ECHOK OCT: 0000040 ; inline
: ECHONL OCT: 0000100 ; inline
: NOFLSH OCT: 0000200 ; inline
: TOSTOP OCT: 0000400 ; inline
: ECHOCTL OCT: 0001000 ; inline
: ECHOPRT OCT: 0002000 ; inline
: ECHOKE OCT: 0004000 ; inline
: FLUSHO OCT: 0010000 ; inline
: PENDIN OCT: 0040000 ; inline
: IEXTEN OCT: 0100000 ; inline
M: linux lookup-baud ( n -- n )
dup H{
{ 0 OCT: 0000000 }
{ 50 OCT: 0000001 }
{ 75 OCT: 0000002 }
{ 110 OCT: 0000003 }
{ 134 OCT: 0000004 }
{ 150 OCT: 0000005 }
{ 200 OCT: 0000006 }
{ 300 OCT: 0000007 }
{ 600 OCT: 0000010 }
{ 1200 OCT: 0000011 }
{ 1800 OCT: 0000012 }
{ 2400 OCT: 0000013 }
{ 4800 OCT: 0000014 }
{ 9600 OCT: 0000015 }
{ 19200 OCT: 0000016 }
{ 38400 OCT: 0000017 }
{ 57600 OCT: 0010001 }
{ 115200 OCT: 0010002 }
{ 230400 OCT: 0010003 }
{ 460800 OCT: 0010004 }
{ 500000 OCT: 0010005 }
{ 576000 OCT: 0010006 }
{ 921600 OCT: 0010007 }
{ 1000000 OCT: 0010010 }
{ 1152000 OCT: 0010011 }
{ 1500000 OCT: 0010012 }
{ 2000000 OCT: 0010013 }
{ 2500000 OCT: 0010014 }
{ 3000000 OCT: 0010015 }
{ 3500000 OCT: 0010016 }
{ 4000000 OCT: 0010017 }
} at* [ nip ] [ drop invalid-baud ] if ;

1
extra/serial/unix/linux/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

1
extra/serial/unix/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

19
extra/serial/unix/termios/bsd/bsd.factor Normal file
View File

@ -0,0 +1,19 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences system ;
IN: serial.unix.termios
: NCCS 20 ; inline
TYPEDEF: uint tcflag_t
TYPEDEF: uchar cc_t
TYPEDEF: uint speed_t
C-STRUCT: termios
{ "tcflag_t" "iflag" } ! input mode flags
{ "tcflag_t" "oflag" } ! output mode flags
{ "tcflag_t" "cflag" } ! control mode flags
{ "tcflag_t" "lflag" } ! local mode flags
{ { "cc_t" NCCS } "cc" } ! control characters
{ "speed_t" "ispeed" } ! input speed
{ "speed_t" "ospeed" } ; ! output speed

1
extra/serial/unix/termios/bsd/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

20
extra/serial/unix/termios/linux/linux.factor Normal file
View File

@ -0,0 +1,20 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel system unix ;
IN: serial.unix.termios
: NCCS 32 ; inline
TYPEDEF: uchar cc_t
TYPEDEF: uint speed_t
TYPEDEF: uint tcflag_t
C-STRUCT: termios
{ "tcflag_t" "iflag" } ! input mode flags
{ "tcflag_t" "oflag" } ! output mode flags
{ "tcflag_t" "cflag" } ! control mode flags
{ "tcflag_t" "lflag" } ! local mode flags
{ "cc_t" "line" } ! line discipline
{ { "cc_t" NCCS } "cc" } ! control characters
{ "speed_t" "ispeed" } ! input speed
{ "speed_t" "ospeed" } ; ! output speed

1
extra/serial/unix/termios/linux/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

1
extra/serial/unix/termios/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

9
extra/serial/unix/termios/termios.factor Normal file
View File

@ -0,0 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators system vocabs.loader ;
IN: serial.unix.termios
{
{ [ os linux? ] [ "serial.unix.termios.linux" ] }
{ [ os bsd? ] [ "serial.unix.termios.bsd" ] }
} cond require

21
extra/serial/unix/unix-tests.factor Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math.bitfields serial.unix ;
IN: serial.unix
: serial-obj ( -- obj )
serial new
"/dev/ttyS0" >>path
19200 >>baud
{ IGNPAR ICRNL } flags >>iflag
{ } flags >>oflag
{ CS8 CLOCAL CREAD } flags >>cflag
{ ICANON } flags >>lflag ;
: serial-test ( -- serial )
serial-obj
open-serial
dup get-termios >>termios
dup configure-termios
dup tciflush
dup apply-termios ;

63
extra/serial/unix/unix.factor Normal file
View File

@ -0,0 +1,63 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax combinators io.ports
io.streams.duplex io.unix.backend system kernel math math.bitfields
vocabs.loader unix serial serial.unix.termios ;
IN: serial.unix
{
{ [ os linux? ] [ "serial.unix.linux" ] }
{ [ os bsd? ] [ "serial.unix.bsd" ] }
} cond require
FUNCTION: speed_t cfgetispeed ( termios* t ) ;
FUNCTION: speed_t cfgetospeed ( termios* t ) ;
FUNCTION: int cfsetispeed ( termios* t, speed_t s ) ;
FUNCTION: int cfsetospeed ( termios* t, speed_t s ) ;
FUNCTION: int tcgetattr ( int i1, termios* t ) ;
FUNCTION: int tcsetattr ( int i1, int i2, termios* t ) ;
FUNCTION: int tcdrain ( int i1 ) ;
FUNCTION: int tcflow ( int i1, int i2 ) ;
FUNCTION: int tcflush ( int i1, int i2 ) ;
FUNCTION: int tcsendbreak ( int i1, int i2 ) ;
FUNCTION: void cfmakeraw ( termios* t ) ;
FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
: fd>duplex-stream ( fd -- duplex-stream )
<fd> init-fd
[ <input-port> ] [ <output-port> ] bi <duplex-stream> ;
: open-rw ( path -- fd ) O_RDWR file-mode open-file ;
: <file-rw> ( path -- stream ) open-rw fd>duplex-stream ;
M: unix open-serial ( serial -- serial' )
dup
path>> { O_RDWR O_NOCTTY O_NDELAY } flags file-mode open-file
fd>duplex-stream >>stream ;
: serial-fd ( serial -- fd )
stream>> in>> handle>> fd>> ;
: get-termios ( serial -- termios )
serial-fd
"termios" <c-object> [ tcgetattr io-error ] keep ;
: configure-termios ( serial -- )
dup termios>>
{
[ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ]
[ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ]
[
[
[ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
] dip set-termios-cflag
]
[ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ]
} 2cleave ;
: tciflush ( serial -- )
serial-fd TCIFLUSH tcflush io-error ;
: apply-termios ( serial -- )
[ serial-fd TCSANOW ]
[ termios>> ] bi tcsetattr io-error ;