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

db4
Eduardo Cavazos 2008-04-20 16:43:25 -05:00
commit f6ec31ef36
44 changed files with 202 additions and 200 deletions

View File

@ -58,16 +58,13 @@ num-types get f <array> builtins set
"alien.accessors" "alien.accessors"
"arrays" "arrays"
"bit-arrays" "bit-arrays"
"bit-vectors"
"byte-arrays" "byte-arrays"
"byte-vectors"
"classes.private" "classes.private"
"classes.tuple" "classes.tuple"
"classes.tuple.private" "classes.tuple.private"
"compiler.units" "compiler.units"
"continuations.private" "continuations.private"
"float-arrays" "float-arrays"
"float-vectors"
"generator" "generator"
"growable" "growable"
"hashtables" "hashtables"
@ -455,54 +452,6 @@ tuple
} }
} define-tuple-class } define-tuple-class
"byte-vector" "byte-vectors" create
tuple
{
{
{ "byte-array" "byte-arrays" }
"underlying"
{ "underlying" "growable" }
{ "set-underlying" "growable" }
} {
{ "array-capacity" "sequences.private" }
"fill"
{ "length" "sequences" }
{ "set-fill" "growable" }
}
} define-tuple-class
"bit-vector" "bit-vectors" create
tuple
{
{
{ "bit-array" "bit-arrays" }
"underlying"
{ "underlying" "growable" }
{ "set-underlying" "growable" }
} {
{ "array-capacity" "sequences.private" }
"fill"
{ "length" "sequences" }
{ "set-fill" "growable" }
}
} define-tuple-class
"float-vector" "float-vectors" create
tuple
{
{
{ "float-array" "float-arrays" }
"underlying"
{ "underlying" "growable" }
{ "set-underlying" "growable" }
} {
{ "array-capacity" "sequences.private" }
"fill"
{ "length" "sequences" }
{ "set-fill" "growable" }
}
} define-tuple-class
"curry" "kernel" create "curry" "kernel" create
tuple tuple
{ {

View File

@ -14,16 +14,13 @@ IN: bootstrap.syntax
";" ";"
"<PRIVATE" "<PRIVATE"
"?{" "?{"
"?V{"
"BIN:" "BIN:"
"B{" "B{"
"BV{"
"C:" "C:"
"CHAR:" "CHAR:"
"DEFER:" "DEFER:"
"ERROR:" "ERROR:"
"F{" "F{"
"FV{"
"FORGET:" "FORGET:"
"GENERIC#" "GENERIC#"
"GENERIC:" "GENERIC:"

View File

@ -1,11 +1,10 @@
! Copyright (C) 2003, 2008 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors USING: arrays byte-arrays bit-arrays generic hashtables io
generic hashtables io assocs kernel math namespaces sequences assocs kernel math namespaces sequences strings sbufs io.styles
strings sbufs io.styles vectors words prettyprint.config vectors words prettyprint.config prettyprint.sections quotations
prettyprint.sections quotations io io.files math.parser effects io io.files math.parser effects classes.tuple
classes.tuple classes.tuple.private classes float-arrays classes.tuple.private classes float-arrays ;
float-vectors ;
IN: prettyprint.backend IN: prettyprint.backend
GENERIC: pprint* ( obj -- ) GENERIC: pprint* ( obj -- )
@ -140,11 +139,8 @@ M: curry pprint-delims drop \ [ \ ] ;
M: compose pprint-delims drop \ [ \ ] ; M: compose pprint-delims drop \ [ \ ] ;
M: array pprint-delims drop \ { \ } ; M: array pprint-delims drop \ { \ } ;
M: byte-array pprint-delims drop \ B{ \ } ; M: byte-array pprint-delims drop \ B{ \ } ;
M: byte-vector pprint-delims drop \ BV{ \ } ;
M: bit-array pprint-delims drop \ ?{ \ } ; M: bit-array pprint-delims drop \ ?{ \ } ;
M: bit-vector pprint-delims drop \ ?V{ \ } ;
M: float-array pprint-delims drop \ F{ \ } ; M: float-array pprint-delims drop \ F{ \ } ;
M: float-vector pprint-delims drop \ FV{ \ } ;
M: vector pprint-delims drop \ V{ \ } ; M: vector pprint-delims drop \ V{ \ } ;
M: hashtable pprint-delims drop \ H{ \ } ; M: hashtable pprint-delims drop \ H{ \ } ;
M: tuple pprint-delims drop \ T{ \ } ; M: tuple pprint-delims drop \ T{ \ } ;
@ -156,9 +152,6 @@ GENERIC: >pprint-sequence ( obj -- seq )
M: object >pprint-sequence ; M: object >pprint-sequence ;
M: vector >pprint-sequence ; M: vector >pprint-sequence ;
M: bit-vector >pprint-sequence ;
M: byte-vector >pprint-sequence ;
M: float-vector >pprint-sequence ;
M: curry >pprint-sequence ; M: curry >pprint-sequence ;
M: compose >pprint-sequence ; M: compose >pprint-sequence ;
M: hashtable >pprint-sequence >alist ; M: hashtable >pprint-sequence >alist ;

View File

@ -76,10 +76,7 @@ ARTICLE: "sequences-reshape" "Reshaping sequences"
{ $subsection reversed } { $subsection reversed }
{ $subsection <reversed> } { $subsection <reversed> }
"Transposing a matrix:" "Transposing a matrix:"
{ $subsection flip } { $subsection flip } ;
"A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:"
{ $subsection column }
{ $subsection <column> } ;
ARTICLE: "sequences-appending" "Appending sequences" ARTICLE: "sequences-appending" "Appending sequences"
{ $subsection append } { $subsection append }
@ -785,23 +782,6 @@ HELP: <slice>
{ <slice> subseq } related-words { <slice> subseq } related-words
HELP: column
{ $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link <column> } "." } ;
HELP: <column> ( seq n -- column )
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } }
{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of" { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
{ $examples
{ $example
"USING: arrays prettyprint sequences ;"
"{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } 0 <column> >array ."
"{ 1 4 7 }"
}
}
{ $notes
"In the same sense that " { $link <reversed> } " is a virtual variant of " { $link reverse } ", " { $link <column> } " is a virtual variant of " { $snippet "swap [ nth ] curry map" } "."
} ;
HELP: repetition HELP: repetition
{ $class-description "A virtual sequence consisting of " { $link repetition-elt } " repeated " { $link repetition-len } " times. Repetitions are created by calling " { $link <repetition> } "." } ; { $class-description "A virtual sequence consisting of " { $link repetition-elt } " repeated " { $link repetition-len } " times. Repetitions are created by calling " { $link <repetition> } "." } ;

View File

@ -224,13 +224,6 @@ unit-test
[ V{ 1 2 3 } ] [ V{ 1 2 3 } ]
[ 3 V{ 1 3 2 } clone [ push-new ] keep ] unit-test [ 3 V{ 1 3 2 } clone [ push-new ] keep ] unit-test
! Columns
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
[ { 1 4 7 } ] [ "seq" get 0 <column> >array ] unit-test
[ ] [ "seq" get 1 <column> [ sq ] change-each ] unit-test
[ { 4 25 64 } ] [ "seq" get 1 <column> >array ] unit-test
! erg's random tester found this one ! erg's random tester found this one
[ SBUF" 12341234" ] [ [ SBUF" 12341234" ] [
9 <sbuf> dup "1234" swap push-all dup dup swap push-all 9 <sbuf> dup "1234" swap push-all dup dup swap push-all

View File

@ -215,18 +215,6 @@ M: slice length dup slice-to swap slice-from - ;
INSTANCE: slice virtual-sequence INSTANCE: slice virtual-sequence
! A column of a matrix
TUPLE: column seq col ;
C: <column> column
M: column virtual-seq column-seq ;
M: column virtual@
dup column-col -rot column-seq nth bounds-check ;
M: column length column-seq length ;
INSTANCE: column virtual-sequence
! One element repeated many times ! One element repeated many times
TUPLE: repetition len elt ; TUPLE: repetition len elt ;
@ -703,5 +691,5 @@ PRIVATE>
: flip ( matrix -- newmatrix ) : flip ( matrix -- newmatrix )
dup empty? [ dup empty? [
dup [ length ] map infimum dup [ length ] map infimum
[ <column> dup like ] with map swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as
] unless ; ] unless ;

View File

@ -150,18 +150,6 @@ ARTICLE: "syntax-byte-arrays" "Byte array syntax"
{ $subsection POSTPONE: B{ } { $subsection POSTPONE: B{ }
"Byte arrays are documented in " { $link "byte-arrays" } "." ; "Byte arrays are documented in " { $link "byte-arrays" } "." ;
ARTICLE: "syntax-bit-vectors" "Bit vector syntax"
{ $subsection POSTPONE: ?V{ }
"Bit vectors are documented in " { $link "bit-vectors" } "." ;
ARTICLE: "syntax-float-vectors" "Float vector syntax"
{ $subsection POSTPONE: FV{ }
"Float vectors are documented in " { $link "float-vectors" } "." ;
ARTICLE: "syntax-byte-vectors" "Byte vector syntax"
{ $subsection POSTPONE: BV{ }
"Byte vectors are documented in " { $link "byte-vectors" } "." ;
ARTICLE: "syntax-pathnames" "Pathname syntax" ARTICLE: "syntax-pathnames" "Pathname syntax"
{ $subsection POSTPONE: P" } { $subsection POSTPONE: P" }
"Pathnames are documented in " { $link "pathnames" } "." ; "Pathnames are documented in " { $link "pathnames" } "." ;
@ -182,9 +170,6 @@ $nl
{ $subsection "syntax-float-arrays" } { $subsection "syntax-float-arrays" }
{ $subsection "syntax-vectors" } { $subsection "syntax-vectors" }
{ $subsection "syntax-sbufs" } { $subsection "syntax-sbufs" }
{ $subsection "syntax-bit-vectors" }
{ $subsection "syntax-byte-vectors" }
{ $subsection "syntax-float-vectors" }
{ $subsection "syntax-hashtables" } { $subsection "syntax-hashtables" }
{ $subsection "syntax-tuples" } { $subsection "syntax-tuples" }
{ $subsection "syntax-pathnames" } ; { $subsection "syntax-pathnames" } ;
@ -291,30 +276,12 @@ HELP: B{
{ $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." } { $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "B{ 1 2 3 }" } } ; { $examples { $code "B{ 1 2 3 }" } } ;
HELP: BV{
{ $syntax "BV{ elements... }" }
{ $values { "elements" "a list of bytes" } }
{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "BV{ 1 2 3 12 }" } } ;
HELP: ?{ HELP: ?{
{ $syntax "?{ elements... }" } { $syntax "?{ elements... }" }
{ $values { "elements" "a list of booleans" } } { $values { "elements" "a list of booleans" } }
{ $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link POSTPONE: } } "." } { $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "?{ t f t }" } } ; { $examples { $code "?{ t f t }" } } ;
HELP: ?V{
{ $syntax "?V{ elements... }" }
{ $values { "elements" "a list of booleans" } }
{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "?V{ t f t }" } } ;
HELP: FV{
{ $syntax "FV{ elements... }" }
{ $values { "elements" "a list of real numbers" } }
{ $description "Marks the beginning of a literal float vector. Literal float vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "FV{ 1.0 2.0 3.0 }" } } ;
HELP: F{ HELP: F{
{ $syntax "F{ elements... }" } { $syntax "F{ elements... }" }
{ $values { "elements" "a list of real numbers" } } { $values { "elements" "a list of real numbers" } }

View File

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays bit-arrays bit-vectors byte-arrays USING: alien arrays bit-arrays byte-arrays
byte-vectors definitions generic hashtables kernel math definitions generic hashtables kernel math
namespaces parser sequences strings sbufs vectors words namespaces parser sequences strings sbufs vectors words
quotations io assocs splitting classes.tuple generic.standard quotations io assocs splitting classes.tuple generic.standard
generic.math classes io.files vocabs float-arrays float-vectors generic.math classes io.files vocabs float-arrays
classes.union classes.mixin classes.predicate classes.singleton classes.union classes.mixin classes.predicate classes.singleton
compiler.units combinators debugger ; compiler.units combinators debugger ;
IN: bootstrap.syntax IN: bootstrap.syntax
@ -79,11 +79,8 @@ IN: bootstrap.syntax
"{" [ \ } [ >array ] parse-literal ] define-syntax "{" [ \ } [ >array ] parse-literal ] define-syntax
"V{" [ \ } [ >vector ] parse-literal ] define-syntax "V{" [ \ } [ >vector ] parse-literal ] define-syntax
"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
"BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
"?{" [ \ } [ >bit-array ] parse-literal ] define-syntax "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
"?V{" [ \ } [ >bit-vector ] parse-literal ] define-syntax
"F{" [ \ } [ >float-array ] parse-literal ] define-syntax "F{" [ \ } [ >float-array ] parse-literal ] define-syntax
"FV{" [ \ } [ >float-vector ] parse-literal ] define-syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
"T{" [ \ } [ >tuple ] parse-literal ] define-syntax "T{" [ \ } [ >tuple ] parse-literal ] define-syntax
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax "W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax

View File

@ -1,4 +1,4 @@
USING: namespaces math sequences splitting kernel ; USING: namespaces math sequences splitting kernel columns ;
IN: benchmark.dispatch2 IN: benchmark.dispatch2
: sequences : sequences

View File

@ -1,5 +1,5 @@
USING: sequences math mirrors splitting kernel namespaces USING: sequences math mirrors splitting kernel namespaces
assocs alien.syntax ; assocs alien.syntax columns ;
IN: benchmark.dispatch3 IN: benchmark.dispatch3
GENERIC: g ( obj -- str ) GENERIC: g ( obj -- str )

View File

@ -19,7 +19,7 @@ IN: benchmark.spectral-norm
pick 0.0 [ pick 0.0 [
swap >r >r 2dup r> (eval-A-times-u) r> + swap >r >r 2dup r> (eval-A-times-u) r> +
] reduce nip ] reduce nip
] F{ } map-as 2nip ; inline ] F{ } map-as { float-array } declare 2nip ; inline
: (eval-At-times-u) ( u i j -- x ) : (eval-At-times-u) ( u i j -- x )
tuck swap eval-A >r swap nth-unsafe r> * ; inline tuck swap eval-A >r swap nth-unsafe r> * ; inline
@ -29,7 +29,7 @@ IN: benchmark.spectral-norm
pick 0.0 [ pick 0.0 [
swap >r >r 2dup r> (eval-At-times-u) r> + swap >r >r 2dup r> (eval-At-times-u) r> +
] reduce nip ] reduce nip
] F{ } map-as 2nip ; inline ] F{ } map-as { float-array } declare 2nip ; inline
: eval-AtA-times-u ( n u -- seq ) : eval-AtA-times-u ( n u -- seq )
dupd eval-A-times-u eval-At-times-u ; inline dupd eval-A-times-u eval-At-times-u ; inline

View File

@ -11,6 +11,8 @@ $nl
"Creating bit vectors:" "Creating bit vectors:"
{ $subsection >bit-vector } { $subsection >bit-vector }
{ $subsection <bit-vector> } { $subsection <bit-vector> }
"Literal syntax:"
{ $subsection POSTPONE: ?V{ }
"If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:" "If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:"
{ $code "?V{ } clone" } ; { $code "?V{ } clone" } ;
@ -31,3 +33,10 @@ HELP: bit-array>vector
{ $values { "bit-array" "an array" } { "length" "a non-negative integer" } { "bit-vector" bit-vector } } { $values { "bit-array" "an array" } { "length" "a non-negative integer" } { "bit-vector" bit-vector } }
{ $description "Creates a new bit vector using the array for underlying storage with the specified initial length." } { $description "Creates a new bit vector using the array for underlying storage with the specified initial length." }
{ $warning "This word is in the " { $vocab-link "bit-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >bit-vector } " instead." } ; { $warning "This word is in the " { $vocab-link "bit-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >bit-vector } " instead." } ;
HELP: ?V{
{ $syntax "?V{ elements... }" }
{ $values { "elements" "a list of booleans" } }
{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "?V{ t f t }" } } ;

View File

@ -1,9 +1,20 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences USING: arrays kernel kernel.private math sequences
sequences.private growable bit-arrays ; sequences.private growable bit-arrays prettyprint.backend
parser ;
IN: bit-vectors IN: bit-vectors
TUPLE: bit-vector underlying fill ;
M: bit-vector underlying underlying>> { bit-array } declare ;
M: bit-vector set-underlying (>>underlying) ;
M: bit-vector length fill>> { array-capacity } declare ;
M: bit-vector set-fill (>>fill) ;
<PRIVATE <PRIVATE
: bit-array>vector ( bit-array length -- bit-vector ) : bit-array>vector ( bit-array length -- bit-vector )
@ -14,7 +25,8 @@ PRIVATE>
: <bit-vector> ( n -- bit-vector ) : <bit-vector> ( n -- bit-vector )
<bit-array> 0 bit-array>vector ; inline <bit-array> 0 bit-array>vector ; inline
: >bit-vector ( seq -- bit-vector ) ?V{ } clone-like ; : >bit-vector ( seq -- bit-vector )
T{ bit-vector f ?{ } 0 } clone-like ;
M: bit-vector like M: bit-vector like
drop dup bit-vector? [ drop dup bit-vector? [
@ -31,3 +43,9 @@ M: bit-vector equal?
M: bit-array new-resizable drop <bit-vector> ; M: bit-array new-resizable drop <bit-vector> ;
INSTANCE: bit-vector growable INSTANCE: bit-vector growable
: ?V \ } [ >bit-vector ] parse-literal ; parsing
M: bit-vector >pprint-sequence ;
M: bit-vector pprint-delims drop \ ?V{ \ } ;

View File

@ -3,7 +3,7 @@ byte-vectors.private combinators ;
IN: byte-vectors IN: byte-vectors
ARTICLE: "byte-vectors" "Byte vectors" ARTICLE: "byte-vectors" "Byte vectors"
"A byte vector is a resizable mutable sequence of unsigned bytes. The literal syntax is covered in " { $link "syntax-byte-vectors" } ". Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary." "A byte vector is a resizable mutable sequence of unsigned bytes. Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."
$nl $nl
"Byte vectors form a class:" "Byte vectors form a class:"
{ $subsection byte-vector } { $subsection byte-vector }
@ -11,6 +11,8 @@ $nl
"Creating byte vectors:" "Creating byte vectors:"
{ $subsection >byte-vector } { $subsection >byte-vector }
{ $subsection <byte-vector> } { $subsection <byte-vector> }
"Literal syntax:"
{ $subsection POSTPONE: BV{ }
"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:" "If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"
{ $code "BV{ } clone" } ; { $code "BV{ } clone" } ;
@ -32,3 +34,9 @@ HELP: byte-array>vector
{ $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } } { $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } }
{ $description "Creates a new byte vector using the array for underlying storage with the specified initial length." } { $description "Creates a new byte vector using the array for underlying storage with the specified initial length." }
{ $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ; { $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ;
HELP: BV{
{ $syntax "BV{ elements... }" }
{ $values { "elements" "a list of bytes" } }
{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "BV{ 1 2 3 12 }" } } ;

View File

@ -1,9 +1,20 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences USING: arrays kernel kernel.private math sequences
sequences.private growable byte-arrays ; sequences.private growable byte-arrays prettyprint.backend
parser accessors ;
IN: byte-vectors IN: byte-vectors
TUPLE: byte-vector underlying fill ;
M: byte-vector underlying underlying>> { byte-array } declare ;
M: byte-vector set-underlying (>>underlying) ;
M: byte-vector length fill>> { array-capacity } declare ;
M: byte-vector set-fill (>>fill) ;
<PRIVATE <PRIVATE
: byte-array>vector ( byte-array length -- byte-vector ) : byte-array>vector ( byte-array length -- byte-vector )
@ -14,7 +25,8 @@ PRIVATE>
: <byte-vector> ( n -- byte-vector ) : <byte-vector> ( n -- byte-vector )
<byte-array> 0 byte-array>vector ; inline <byte-array> 0 byte-array>vector ; inline
: >byte-vector ( seq -- byte-vector ) BV{ } clone-like ; : >byte-vector ( seq -- byte-vector )
T{ byte-vector f B{ } 0 } clone-like ;
M: byte-vector like M: byte-vector like
drop dup byte-vector? [ drop dup byte-vector? [
@ -31,3 +43,9 @@ M: byte-vector equal?
M: byte-array new-resizable drop <byte-vector> ; M: byte-array new-resizable drop <byte-vector> ;
INSTANCE: byte-vector growable INSTANCE: byte-vector growable
: BV{ \ } [ >byte-vector ] parse-literal ; parsing
M: byte-vector >pprint-sequence ;
M: byte-vector pprint-delims drop \ BV{ \ } ;

View File

@ -0,0 +1,2 @@
Slava Pestov
Daniel Ehrenberg

View File

@ -0,0 +1,26 @@
USING: help.markup help.syntax sequences ;
IN: columns
ARTICLE: "columns" "Column sequences"
"A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:"
{ $subsection column }
{ $subsection <column> } ;
HELP: column
{ $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link <column> } "." } ;
HELP: <column> ( seq n -- column )
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } }
{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of" { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
{ $examples
{ $example
"USING: arrays prettyprint sequences ;"
"{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } 0 <column> >array ."
"{ 1 4 7 }"
}
}
{ $notes
"In the same sense that " { $link <reversed> } " is a virtual variant of " { $link reverse } ", " { $link <column> } " is a virtual variant of " { $snippet "swap [ nth ] curry map" } "."
} ;
ABOUT: "columns"

View File

@ -0,0 +1,9 @@
IN: columns.tests
USING: columns sequences kernel namespaces arrays tools.test math ;
! Columns
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
[ { 1 4 7 } ] [ "seq" get 0 <column> >array ] unit-test
[ ] [ "seq" get 1 <column> [ sq ] change-each ] unit-test
[ { 4 25 64 } ] [ "seq" get 1 <column> >array ] unit-test

View File

@ -0,0 +1,15 @@
! Copyright (C) 2005, 2008 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel accessors ;
IN: columns
! A column of a matrix
TUPLE: column seq col ;
C: <column> column
M: column virtual-seq seq>> ;
M: column virtual@ dup col>> -rot seq>> nth bounds-check ;
M: column length seq>> length ;
INSTANCE: column virtual-sequence

View File

@ -0,0 +1 @@
Virtual sequence view of a matrix column

View File

@ -11,6 +11,8 @@ $nl
"Creating float vectors:" "Creating float vectors:"
{ $subsection >float-vector } { $subsection >float-vector }
{ $subsection <float-vector> } { $subsection <float-vector> }
"Literal syntax:"
{ $subsection POSTPONE: FV{ }
"If you don't care about initial capacity, a more elegant way to create a new float vector is to write:" "If you don't care about initial capacity, a more elegant way to create a new float vector is to write:"
{ $code "FV{ } clone" } ; { $code "FV{ } clone" } ;
@ -32,3 +34,9 @@ HELP: float-array>vector
{ $values { "float-array" "an array" } { "length" "a non-negative integer" } { "float-vector" float-vector } } { $values { "float-array" "an array" } { "length" "a non-negative integer" } { "float-vector" float-vector } }
{ $description "Creates a new float vector using the array for underlying storage with the specified initial length." } { $description "Creates a new float vector using the array for underlying storage with the specified initial length." }
{ $warning "This word is in the " { $vocab-link "float-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >float-vector } " instead." } ; { $warning "This word is in the " { $vocab-link "float-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >float-vector } " instead." } ;
HELP: FV{
{ $syntax "FV{ elements... }" }
{ $values { "elements" "a list of real numbers" } }
{ $description "Marks the beginning of a literal float vector. Literal float vectors are terminated by " { $link POSTPONE: } } "." }
{ $examples { $code "FV{ 1.0 2.0 3.0 }" } } ;

View File

@ -1,9 +1,20 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private math sequences USING: arrays kernel kernel.private math sequences
sequences.private growable float-arrays ; sequences.private growable float-arrays prettyprint.backend
parser ;
IN: float-vectors IN: float-vectors
TUPLE: float-vector underlying fill ;
M: float-vector underlying underlying>> { float-array } declare ;
M: float-vector set-underlying (>>underlying) ;
M: float-vector length fill>> { array-capacity } declare ;
M: float-vector set-fill (>>fill) ;
<PRIVATE <PRIVATE
: float-array>vector ( float-array length -- float-vector ) : float-array>vector ( float-array length -- float-vector )
@ -14,7 +25,8 @@ PRIVATE>
: <float-vector> ( n -- float-vector ) : <float-vector> ( n -- float-vector )
0.0 <float-array> 0 float-array>vector ; inline 0.0 <float-array> 0 float-array>vector ; inline
: >float-vector ( seq -- float-vector ) FV{ } clone-like ; : >float-vector ( seq -- float-vector )
T{ float-vector f F{ } 0 } clone-like ;
M: float-vector like M: float-vector like
drop dup float-vector? [ drop dup float-vector? [
@ -31,3 +43,9 @@ M: float-vector equal?
M: float-array new-resizable drop <float-vector> ; M: float-array new-resizable drop <float-vector> ;
INSTANCE: float-vector growable INSTANCE: float-vector growable
: FV{ \ } [ >float-vector ] parse-literal ; parsing
M: float-vector >pprint-sequence ;
M: float-vector pprint-delims drop \ FV{ \ } ;

View File

@ -0,0 +1 @@
collections

View File

@ -145,9 +145,9 @@ ARTICLE: "collections" "Collections"
{ $subsection "vectors" } { $subsection "vectors" }
"Resizable specialized sequences:" "Resizable specialized sequences:"
{ $subsection "sbufs" } { $subsection "sbufs" }
{ $subsection "bit-vectors" } { $vocab-subsection "Bit vectors" "bit-vectors" }
{ $subsection "byte-vectors" } { $vocab-subsection "Byte vectors" "byte-vectors" }
{ $subsection "float-vectors" } { $vocab-subsection "Float vectors" "float-vectors" }
{ $heading "Associative mappings" } { $heading "Associative mappings" }
{ $subsection "assocs" } { $subsection "assocs" }
{ $subsection "namespaces" } { $subsection "namespaces" }

View File

@ -38,7 +38,7 @@ M: predicate word-help* drop \ $predicate ;
\ $error-description swap word-help elements empty? not ; \ $error-description swap word-help elements empty? not ;
: sort-articles ( seq -- newseq ) : sort-articles ( seq -- newseq )
[ dup article-title ] { } map>assoc sort-values 0 <column> ; [ dup article-title ] { } map>assoc sort-values keys ;
: all-errors ( -- seq ) : all-errors ( -- seq )
all-words [ error? ] subset sort-articles ; all-words [ error? ] subset sort-articles ;

View File

@ -1,7 +1,7 @@
! Fast Fourier Transform, copyright (C) 2007 Hans Schmid ! Fast Fourier Transform, copyright (C) 2007 Hans Schmid
! http://dressguardmeister.blogspot.com/2007/01/fft.html ! http://dressguardmeister.blogspot.com/2007/01/fft.html
USING: arrays sequences math math.vectors math.constants USING: arrays sequences math math.vectors math.constants
math.functions kernel splitting ; math.functions kernel splitting columns ;
IN: math.fft IN: math.fft
: n^v ( n v -- w ) [ ^ ] with map ; : n^v ( n v -- w ) [ ^ ] with map ;

View File

@ -1,5 +1,5 @@
! Haar wavelet transform -- http://dmr.ath.cx/gfx/haar/ ! Haar wavelet transform -- http://dmr.ath.cx/gfx/haar/
USING: sequences math kernel splitting ; USING: sequences math kernel splitting columns ;
IN: math.haar IN: math.haar
: averages ( seq -- seq ) : averages ( seq -- seq )

View File

@ -1,6 +1,6 @@
! Based on http://www.ffconsultancy.com/ocaml/sudoku/index.html ! Based on http://www.ffconsultancy.com/ocaml/sudoku/index.html
USING: sequences namespaces kernel math math.parser io USING: sequences namespaces kernel math math.parser io
io.styles combinators ; io.styles combinators columns ;
IN: sudoku IN: sudoku
SYMBOL: solutions SYMBOL: solutions

View File

@ -1,10 +1,13 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: tools.deploy.backend system vocabs.loader kernel ; USING: tools.deploy.backend system vocabs.loader kernel
combinators ;
IN: tools.deploy IN: tools.deploy
: deploy ( vocab -- ) deploy* ; : deploy ( vocab -- ) deploy* ;
os macosx? [ "tools.deploy.macosx" require ] when {
os winnt? [ "tools.deploy.windows" require ] when { [ os macosx? ] [ "tools.deploy.macosx" ] }
os unix? [ "tools.deploy.unix" require ] when { [ os winnt? ] [ "tools.deploy.windows" ] }
{ [ os unix? ] [ "tools.deploy.unix" ] }
} cond require

View File

@ -31,10 +31,14 @@ IN: tools.deploy.macosx
write-plist ; write-plist ;
: create-app-dir ( vocab bundle-name -- vm ) : create-app-dir ( vocab bundle-name -- vm )
dup "Frameworks" copy-bundle-dir [
dup "Resources/English.lproj/MiniFactor.nib" copy-bundle-dir nip
dup "Contents/Resources/" copy-fonts [ "Frameworks" copy-bundle-dir ]
2dup create-app-plist "Contents/MacOS/" append-path "" copy-vm ; [ "Resources/English.lproj/MiniFactor.nib" copy-bundle-dir ]
[ "Contents/Resources/" copy-fonts ] tri
]
[ create-app-plist ]
[ "Contents/MacOS/" append-path "" copy-vm ] 2tri ;
: deploy.app-image ( vocab bundle-name -- str ) : deploy.app-image ( vocab bundle-name -- str )
[ % "/Contents/Resources/" % % ".image" % ] "" make ; [ % "/Contents/Resources/" % % ".image" % ] "" make ;
@ -43,9 +47,8 @@ IN: tools.deploy.macosx
deploy-name get ".app" append ; deploy-name get ".app" append ;
: show-in-finder ( path -- ) : show-in-finder ( path -- )
NSWorkspace [ NSWorkspace -> sharedWorkspace ]
-> sharedWorkspace [ normalize-path [ <NSString> ] [ parent-directory <NSString> ] bi ] bi*
over <NSString> rot parent-directory <NSString>
-> selectFile:inFileViewerRootedAtPath: drop ; -> selectFile:inFileViewerRootedAtPath: drop ;
M: macosx deploy* ( vocab -- ) M: macosx deploy* ( vocab -- )
@ -56,6 +59,6 @@ M: macosx deploy* ( vocab -- )
[ bundle-name create-app-dir ] keep [ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep [ bundle-name deploy.app-image ] keep
namespace make-deploy-image namespace make-deploy-image
bundle-name normalize-path show-in-finder bundle-name show-in-finder
] bind ] bind
] with-directory ; ] with-directory ;

View File

@ -3,21 +3,21 @@
USING: io io.files io.backend kernel namespaces sequences USING: io io.files io.backend kernel namespaces sequences
system tools.deploy.backend tools.deploy.config assocs system tools.deploy.backend tools.deploy.config assocs
hashtables prettyprint ; hashtables prettyprint ;
IN: tools.deploy.linux IN: tools.deploy.unix
: create-app-dir ( vocab bundle-name -- vm )
dup "" copy-fonts
"" copy-vm ;
: bundle-name ( -- str )
deploy-name get ;
M: linux deploy* ( vocab -- ) : create-app-dir ( vocab bundle-name -- vm )
"." resource-path [ dup "" copy-fonts
dup deploy-config [ "" copy-vm ;
[ bundle-name create-app-dir ] keep
[ bundle-name image-name ] keep : bundle-name ( -- str )
namespace make-deploy-image deploy-name get ;
bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
] bind M: unix deploy* ( vocab -- )
] with-directory ; "." resource-path [
dup deploy-config [
[ bundle-name create-app-dir ] keep
[ bundle-name image-name ] keep
namespace make-deploy-image
bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
] bind
] with-directory ;

View File

@ -6,8 +6,7 @@ prettyprint windows.shell32 windows.user32 ;
IN: tools.deploy.windows IN: tools.deploy.windows
: copy-dlls ( bundle-name -- ) : copy-dlls ( bundle-name -- )
{ "freetype6.dll" "zlib1.dll" "factor.dll" } { "resource:freetype6.dll" "resource:zlib1.dll" "resource:factor.dll" }
[ resource-path ] map
swap copy-files-into ; swap copy-files-into ;
: create-exe-dir ( vocab bundle-name -- vm ) : create-exe-dir ( vocab bundle-name -- vm )
@ -21,6 +20,6 @@ M: winnt deploy*
[ deploy-name get create-exe-dir ] keep [ deploy-name get create-exe-dir ] keep
[ deploy-name get image-name ] keep [ deploy-name get image-name ] keep
[ namespace make-deploy-image ] keep [ namespace make-deploy-image ] keep
(normalize-path) open-in-explorer open-in-explorer
] bind ] bind
] with-directory ; ] with-directory ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov. ! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math namespaces sequences words io USING: arrays kernel math namespaces sequences words io
io.streams.string math.vectors ui.gadgets ; io.streams.string math.vectors ui.gadgets columns ;
IN: ui.gadgets.grids IN: ui.gadgets.grids
TUPLE: grid children gap fill? ; TUPLE: grid children gap fill? ;

View File

@ -3,7 +3,7 @@
USING: arrays assocs kernel math models namespaces USING: arrays assocs kernel math models namespaces
sequences words strings system hashtables math.parser sequences words strings system hashtables math.parser
math.vectors classes.tuple classes ui.gadgets boxes math.vectors classes.tuple classes ui.gadgets boxes
calendar alarms symbols combinators sets ; calendar alarms symbols combinators sets columns ;
IN: ui.gestures IN: ui.gestures
: set-gestures ( class hash -- ) "gestures" set-word-prop ; : set-gestures ( class hash -- ) "gestures" set-word-prop ;

View File

@ -1,6 +1,6 @@
USING: alien alien.c-types alien.syntax combinators USING: alien alien.c-types alien.syntax combinators
kernel windows windows.user32 windows.ole32 kernel windows windows.user32 windows.ole32
windows.com windows.com.syntax ; windows.com windows.com.syntax io.files ;
IN: windows.shell32 IN: windows.shell32
: CSIDL_DESKTOP HEX: 00 ; inline : CSIDL_DESKTOP HEX: 00 ; inline
@ -83,7 +83,7 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi
: ShellExecute ShellExecuteW ; inline : ShellExecute ShellExecuteW ; inline
: open-in-explorer ( dir -- ) : open-in-explorer ( dir -- )
f "open" rot f f SW_SHOWNORMAL ShellExecute drop ; f "open" rot (normalize-path) f f SW_SHOWNORMAL ShellExecute drop ;
: shell32-error ( n -- ) : shell32-error ( n -- )
ole32-error ; inline ole32-error ; inline