diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index f48129fbd4..77e4a53f7b 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -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 ; diff --git a/basis/math/ranges/ranges-docs.factor b/basis/math/ranges/ranges-docs.factor index 714fc67c9f..f3c65e51a4 100644 --- a/basis/math/ranges/ranges-docs.factor +++ b/basis/math/ranges/ranges-docs.factor @@ -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 } - { $subsection [a,b] } - { $subsection (a,b] } - { $subsection [a,b) } - { $subsection (a,b) } - { $subsection [0,b] } - { $subsection [1,b] } - { $subsection [0,b) } ; \ No newline at end of file +"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 } +"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" \ No newline at end of file diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index 0c669d2258..68444de85f 100755 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -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" } diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 0efacee294..cc1e056b8b 100755 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -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" } diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 083700493d..065087fa59 100755 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -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" } diff --git a/extra/math/combinatorics/combinatorics-tests.factor b/extra/math/combinatorics/combinatorics-tests.factor index e6a2824433..5ef435a4e0 100644 --- a/extra/math/combinatorics/combinatorics-tests.factor +++ b/extra/math/combinatorics/combinatorics-tests.factor @@ -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 diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor index f7d7b76fa4..6193edfb91 100644 --- a/extra/math/combinatorics/combinatorics.factor +++ b/extra/math/combinatorics/combinatorics.factor @@ -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 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 ) [ diff --git a/extra/serial/authors.txt b/extra/serial/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/serial/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/serial/serial.factor b/extra/serial/serial.factor new file mode 100644 index 0000000000..39a63927da --- /dev/null +++ b/extra/serial/serial.factor @@ -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 diff --git a/extra/serial/summary.txt b/extra/serial/summary.txt new file mode 100644 index 0000000000..5ccd99dbaa --- /dev/null +++ b/extra/serial/summary.txt @@ -0,0 +1 @@ +Serial port library diff --git a/extra/serial/tags.txt b/extra/serial/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/bsd/bsd.factor b/extra/serial/unix/bsd/bsd.factor new file mode 100644 index 0000000000..68aaa03a23 --- /dev/null +++ b/extra/serial/unix/bsd/bsd.factor @@ -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 ; diff --git a/extra/serial/unix/bsd/tags.txt b/extra/serial/unix/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/linux/linux.factor b/extra/serial/unix/linux/linux.factor new file mode 100644 index 0000000000..3ad5088fc8 --- /dev/null +++ b/extra/serial/unix/linux/linux.factor @@ -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 ; diff --git a/extra/serial/unix/linux/tags.txt b/extra/serial/unix/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/tags.txt b/extra/serial/unix/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/termios/bsd/bsd.factor b/extra/serial/unix/termios/bsd/bsd.factor new file mode 100644 index 0000000000..c8f1e8be54 --- /dev/null +++ b/extra/serial/unix/termios/bsd/bsd.factor @@ -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 diff --git a/extra/serial/unix/termios/bsd/tags.txt b/extra/serial/unix/termios/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/termios/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/termios/linux/linux.factor b/extra/serial/unix/termios/linux/linux.factor new file mode 100644 index 0000000000..de9906e2b9 --- /dev/null +++ b/extra/serial/unix/termios/linux/linux.factor @@ -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 diff --git a/extra/serial/unix/termios/linux/tags.txt b/extra/serial/unix/termios/linux/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/termios/linux/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/termios/tags.txt b/extra/serial/unix/termios/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/serial/unix/termios/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/serial/unix/termios/termios.factor b/extra/serial/unix/termios/termios.factor new file mode 100644 index 0000000000..901416d62c --- /dev/null +++ b/extra/serial/unix/termios/termios.factor @@ -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 diff --git a/extra/serial/unix/unix-tests.factor b/extra/serial/unix/unix-tests.factor new file mode 100644 index 0000000000..300cacf83e --- /dev/null +++ b/extra/serial/unix/unix-tests.factor @@ -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 ; diff --git a/extra/serial/unix/unix.factor b/extra/serial/unix/unix.factor new file mode 100644 index 0000000000..6b48c758cc --- /dev/null +++ b/extra/serial/unix/unix.factor @@ -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 ) + init-fd + [ ] [ ] bi ; + +: open-rw ( path -- fd ) O_RDWR file-mode open-file ; +: ( 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" [ 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 ;