fixing matrices; fixing examples
parent
bbb5d90d31
commit
7a3a34d364
|
@ -0,0 +1,50 @@
|
|||
Factor 0.74:
|
||||
------------
|
||||
|
||||
C library interface ported to Linux/PPC and Mac OS X.
|
||||
|
||||
Developer's handbook rewritten to be more up to date and complete.
|
||||
|
||||
Added the sequences vocabulary that unifies code for working with lists,
|
||||
vectors, strings, and string buffers. There are many changes, and most
|
||||
of the old type-specific words such as vector-nth and string-map are
|
||||
gone.
|
||||
|
||||
Added the matrices vocabulary for working with mathematical vectors and
|
||||
matrices.
|
||||
|
||||
Added two words for modular arithmetic in the math vocabulary: mod-inv
|
||||
and ^mod.
|
||||
|
||||
Added HTTP client API supporting GET and POST requests in the
|
||||
http-client vocabulary.
|
||||
|
||||
Removed some inspection words: vocabs. words. usages. Now, just put a
|
||||
space before the . and write vocabs . words . usages .
|
||||
|
||||
Redefining words that are used by compiled words automatically
|
||||
decompiles the compiled words. This fixes the problem of new definitions
|
||||
not taking effect. In a future release, there will be automatic
|
||||
recompilation, rather than decompilation.
|
||||
|
||||
As a result of the previous change, there is now a cross-referencing
|
||||
database, and the usages word lists indirect dependencies and is much
|
||||
faster. The usage word behaves like the old usages, and lists direct
|
||||
dependencies only.
|
||||
|
||||
The dump word in the dump vocabulary prints the memory bytes comprising
|
||||
an object. The dump* word prints the bytes at an arbitrary address.
|
||||
|
||||
New words in words vocabulary for inspecting classes and methods: classes implements.
|
||||
|
||||
The Unix I/O code was rewritten in Factor using the C library interface.
|
||||
Many new features will be added in future releases, such as socket
|
||||
timeouts and Unicode character encodings.
|
||||
|
||||
Lazy lists and parser combinators library in contrib/parser-combinators/
|
||||
(Chris Double).
|
||||
|
||||
Quotations containing \ foo are prettyprinted in that form.
|
||||
|
||||
The watch word now causes annotated words to dump the stack, in addition
|
||||
to printing a log message.
|
|
@ -2,30 +2,31 @@
|
|||
|
||||
- faster layout
|
||||
- faster repaint
|
||||
- implement fcopy
|
||||
- win32 updates
|
||||
- open large listener by default
|
||||
|
||||
- get all-tests to run with -no-compile
|
||||
- scalar * matrix, vector * matrix, matrix * vector need to work
|
||||
- make-matrix is slow and ugly
|
||||
- move 2repeat somewhere else
|
||||
- rotating cube demo
|
||||
- fix infix (dan)
|
||||
|
||||
+ plugin:
|
||||
|
||||
- if external factor is down, don't add tons of random shit to the
|
||||
dictionary
|
||||
- plugin: extra space in stack effects
|
||||
- plugin: type "re" in edit word dialog --> hang
|
||||
- word preview for parsing words
|
||||
|
||||
+ ui:
|
||||
|
||||
- console with presentations
|
||||
- ui browser
|
||||
- auto-updating inspector, mirrors abstraction
|
||||
- word preview for parsing words
|
||||
- mouse enter onto overlapping with interior, but not child, gadget
|
||||
- menu dragging
|
||||
- fix up the min thumb size hack
|
||||
- frame gap
|
||||
- tiled window manager
|
||||
- rotating cube demo
|
||||
|
||||
+ ffi:
|
||||
|
||||
|
@ -44,6 +45,8 @@
|
|||
|
||||
+ compiler:
|
||||
|
||||
- get all-tests to run with -no-compile
|
||||
- fix i/o on generic x86/ppc unix
|
||||
- alien primitives need a more general input type
|
||||
- [ [ dup call ] dup call ] infer hangs
|
||||
- more accurate types for various words
|
||||
|
@ -66,15 +69,16 @@
|
|||
- ensure-capacity: don't be generic
|
||||
- vector's ensure-capacity will crash if not given fixnums!
|
||||
- dipping seq-2nmap, seq-2each
|
||||
- remove seq- prefixes
|
||||
- generic each some? all? member? memq? all=? top
|
||||
index? subseq?
|
||||
- generic each some? all? member? memq? all=? index? subseq? map
|
||||
- index and index* are very slow with lists
|
||||
- list map, subset, project, append: not tail recursive
|
||||
- phase out sbuf-append
|
||||
- decide what to do with index-of
|
||||
- list map, subset: not tail recursive
|
||||
- phase out sbuf-append, index-of, substring
|
||||
- unsafe-sbuf>string
|
||||
- generic subseq
|
||||
- GENERIC: map
|
||||
- list impl same as now
|
||||
- generic parser::scan
|
||||
- array sort
|
||||
|
||||
+ kernel:
|
||||
|
||||
|
@ -92,9 +96,11 @@
|
|||
- generational gc
|
||||
- doc comments of generics
|
||||
- M: object should not inhibit delegation
|
||||
- renumber types appopriately
|
||||
|
||||
+ i/o:
|
||||
|
||||
- faster stream-copy
|
||||
- rename prettyprint to pprint
|
||||
- reading and writing byte arrays
|
||||
- merge unix and win32 io where appropriate
|
||||
|
@ -108,21 +114,21 @@
|
|||
- stream server can hang because of exception handler limitations
|
||||
- better i/o scheduler
|
||||
- add a socket timeout
|
||||
- renumber types appopriately
|
||||
- unify unparse and prettyprint
|
||||
- utf16, utf8 encoding
|
||||
|
||||
+ nice to have libraries:
|
||||
|
||||
- regexps
|
||||
- XML
|
||||
- HTTP client
|
||||
- real Unicode support (strings are already 16 bits and can be extended
|
||||
to 21 if the need arises, but we need full character classification
|
||||
predicates, comparison, case conversion, sorting...)
|
||||
- full Win32 binding
|
||||
- Cairo binding
|
||||
|
||||
+ httpd:
|
||||
+ http:
|
||||
|
||||
- http client post requests
|
||||
- virtual hosts
|
||||
- keep alive
|
||||
|
|
|
@ -1,9 +1,5 @@
|
|||
IN: format
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: strings
|
||||
USE: test
|
||||
USING: kernel math sequences strings test ;
|
||||
|
||||
: decimal-split ( string -- string string )
|
||||
#! Split a string before and after the decimal point.
|
||||
|
@ -11,12 +7,12 @@ USE: test
|
|||
|
||||
: decimal-tail ( count str -- string )
|
||||
#! Given a decimal, trims all but a count of decimal places.
|
||||
[ string-length min ] keep string-head ;
|
||||
[ length min ] keep string-head ;
|
||||
|
||||
: decimal-cat ( before after -- string )
|
||||
#! If after is of zero length, return before, otherwise
|
||||
#! return "before.after".
|
||||
dup string-length 0 = [
|
||||
dup length 0 = [
|
||||
drop
|
||||
] [
|
||||
"." swap cat3
|
||||
|
|
|
@ -1,16 +1,8 @@
|
|||
! A simple IRC client written in Factor.
|
||||
|
||||
IN: irc
|
||||
USE: generic
|
||||
USE: stdio
|
||||
USE: namespaces
|
||||
USE: streams
|
||||
USE: kernel
|
||||
USE: threads
|
||||
USE: lists
|
||||
USE: strings
|
||||
USE: words
|
||||
USE: math
|
||||
USING: kernel lists math namespaces stdio streams strings
|
||||
threads words ;
|
||||
|
||||
SYMBOL: irc-stream
|
||||
SYMBOL: channels
|
||||
|
@ -78,7 +70,7 @@ M: privmsg irc-display ( line -- )
|
|||
channel get [ (msg) ] [ "No channel." print ] ifte* ;
|
||||
|
||||
: talk ( input -- ) "/" ?string-head [ command ] [ say ] ifte ;
|
||||
: talk-loop ( -- ) read [ talk talk-loop ] when* ;
|
||||
: talk-loop ( -- ) read-line [ talk talk-loop ] when* ;
|
||||
|
||||
: irc ( nick server -- )
|
||||
[
|
||||
|
|
|
@ -8,7 +8,7 @@ USING: sequences kernel math stdio strings ;
|
|||
} nth >r 4 * dup 4 + r> substring ;
|
||||
|
||||
: lcd-row ( num row -- )
|
||||
swap [ CHAR: 0 - over lcd-digit write ] string-each drop ;
|
||||
swap [ CHAR: 0 - over lcd-digit write ] seq-each drop ;
|
||||
|
||||
: lcd ( num -- str )
|
||||
3 [ 2dup lcd-row terpri ] repeat drop ;
|
||||
|
|
|
@ -1,20 +1,9 @@
|
|||
USE: random
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: test
|
||||
USE: namespaces
|
||||
|
||||
: nth ( n list -- list[n] )
|
||||
#! nth element of a proper list.
|
||||
#! Supplying n <= 0 pushes the first element of the list.
|
||||
#! Supplying an argument beyond the end of the list raises
|
||||
#! an error.
|
||||
swap [ cdr ] times car ;
|
||||
IN: random
|
||||
USING: kernel lists math namespaces sequences test ;
|
||||
|
||||
: random-element ( list -- random )
|
||||
#! Returns a random element from the given list.
|
||||
dup >r length 1 - 0 swap random-int r> nth ;
|
||||
[ length 1 - 0 swap random-int ] keep nth ;
|
||||
|
||||
: random-boolean ( -- ? ) 0 1 random-int 0 = ;
|
||||
|
||||
|
@ -78,7 +67,7 @@ USE: namespaces
|
|||
[[ 20 f ]]
|
||||
[[ 30 "monkey" ]]
|
||||
[[ 24 1/2 ]]
|
||||
[ 13 | { "Hello" "Banana" } ]
|
||||
[[ 13 { "Hello" "Banana" } ]]
|
||||
] "random-pairs" set
|
||||
|
||||
"random-pairs" get [ cdr ] map "random-values" set
|
||||
|
@ -94,8 +83,4 @@ USE: namespaces
|
|||
"random-pairs" get
|
||||
check-random-subset
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [ -1 [ 1 2 ] nth ] unit-test
|
||||
[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
|
||||
[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
|
||||
] with-scope
|
||||
|
|
|
@ -34,6 +34,7 @@ hashtables ;
|
|||
"/library/collections/hashtables.factor"
|
||||
"/library/collections/namespaces.factor"
|
||||
"/library/collections/sbuf.factor"
|
||||
"/library/math/matrices.factor"
|
||||
"/library/words.factor"
|
||||
"/library/vocabularies.factor"
|
||||
"/library/errors.factor"
|
||||
|
@ -49,6 +50,7 @@ hashtables ;
|
|||
"/library/syntax/parser.factor"
|
||||
"/library/syntax/parse-stream.factor"
|
||||
"/library/syntax/generic.factor"
|
||||
"/library/syntax/math.factor"
|
||||
"/library/syntax/parse-syntax.factor"
|
||||
"/library/alien/aliens.factor"
|
||||
"/library/cli.factor"
|
||||
|
|
|
@ -19,10 +19,6 @@ t [
|
|||
"/library/syntax/unparser.factor"
|
||||
"/library/syntax/prettyprint.factor"
|
||||
|
||||
! This has to be loaded here because it overloads sequence
|
||||
! generics, and we don't want to compile twice.
|
||||
"/library/math/matrices.factor"
|
||||
|
||||
"/library/tools/debugger.factor"
|
||||
"/library/tools/gensym.factor"
|
||||
"/library/tools/interpreter.factor"
|
||||
|
|
|
@ -129,7 +129,8 @@ M: cons hashcode ( cons -- hash ) car hashcode ;
|
|||
#! Return the rest of the list, from the nth index onward.
|
||||
[ cdr ] times ;
|
||||
|
||||
M: general-list nth ( n list -- element ) tail car ;
|
||||
M: cons nth ( n list -- element )
|
||||
over 0 = [ nip car ] [ >r 1 - r> cdr nth ] ifte ;
|
||||
|
||||
: intersection ( list list -- list )
|
||||
#! Make a list of elements that occur in both lists.
|
||||
|
|
|
@ -106,7 +106,7 @@ stdio streams strings unparser http ;
|
|||
TUPLE: html-stream ;
|
||||
|
||||
M: html-stream stream-write-attr ( str style stream -- )
|
||||
wrapper-stream-scope [
|
||||
[
|
||||
[
|
||||
[
|
||||
[
|
||||
|
@ -114,7 +114,7 @@ M: html-stream stream-write-attr ( str style stream -- )
|
|||
] file-link-tag
|
||||
] icon-tag
|
||||
] browser-link-tag
|
||||
] bind ;
|
||||
] with-wrapper ;
|
||||
|
||||
C: html-stream ( stream -- stream )
|
||||
#! Wraps the given stream in an HTML stream. An HTML stream
|
||||
|
|
|
@ -54,12 +54,14 @@ M: sbuf stream-auto-flush drop ;
|
|||
TUPLE: wrapper-stream scope ;
|
||||
|
||||
C: wrapper-stream ( stream -- stream )
|
||||
2dup set-delegate
|
||||
[
|
||||
2dup set-delegate [
|
||||
>r <namespace> [ stdio set ] extend r>
|
||||
set-wrapper-stream-scope
|
||||
] keep ;
|
||||
|
||||
: with-wrapper ( stream quot -- )
|
||||
>r wrapper-stream-scope r> bind ;
|
||||
|
||||
! Combine an input and output stream into one, and flush the
|
||||
! stream more often.
|
||||
TUPLE: duplex-stream in out flush? ;
|
||||
|
|
|
@ -1,48 +1,31 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: matrices
|
||||
USING: errors generic kernel lists math namespaces prettyprint
|
||||
sequences stdio test vectors ;
|
||||
USING: errors generic kernel lists math namespaces sequences
|
||||
vectors ;
|
||||
|
||||
! The major dimension is the number of elements per row.
|
||||
TUPLE: matrix rows cols sequence ;
|
||||
|
||||
! Vector and matrix protocol.
|
||||
GENERIC: v+
|
||||
GENERIC: v-
|
||||
GENERIC: v* ( element-wise multiplication )
|
||||
GENERIC: v. ( interior multiplication )
|
||||
|
||||
: v*n ( vec n -- vec ) swap [ * ] seq-map-with ;
|
||||
|
||||
! On numbers, these operations do the obvious thing
|
||||
M: number v+ ( n n -- n ) + ;
|
||||
M: number v- ( n n -- n ) - ;
|
||||
M: number v* ( n n -- n ) * ;
|
||||
|
||||
M: number v. ( n n -- n )
|
||||
over vector? [ v*n ] [ * ] ifte ;
|
||||
: n*v ( n vec -- vec )
|
||||
#! Multiply a vector by a scalar.
|
||||
[ * ] seq-map-with ;
|
||||
|
||||
! Vector operations
|
||||
DEFER: <row-vector>
|
||||
DEFER: <col-vector>
|
||||
|
||||
M: object v+ ( v v -- v ) [ v+ ] seq-2map ;
|
||||
M: object v- ( v v -- v ) [ v- ] seq-2map ;
|
||||
M: object v* ( v v -- v ) [ v* ] seq-2map ;
|
||||
: v+ ( v v -- v ) [ + ] seq-2map ;
|
||||
: v- ( v v -- v ) [ - ] seq-2map ;
|
||||
: v* ( v v -- v ) [ * ] seq-2map ;
|
||||
|
||||
! Later, this will fixed when seq-2each works properly
|
||||
! M: object v. ( v v -- x ) 0 swap [ * + ] seq-2each ;
|
||||
! : v. ( v v -- x ) 0 swap [ * + ] seq-2each ;
|
||||
: +/ ( seq -- n ) 0 swap [ + ] seq-each ;
|
||||
|
||||
GENERIC: vv. ( obj v -- v )
|
||||
M: number vv. ( v n -- v ) v*n ;
|
||||
M: matrix vv. ( v m -- v )
|
||||
swap <col-vector> v. matrix-sequence ;
|
||||
M: object vv. v* +/ ;
|
||||
M: object v. ( v v -- x ) swap vv. ;
|
||||
: v. ( v v -- x ) v* +/ ;
|
||||
|
||||
! Matrices
|
||||
! The major dimension is the number of elements per row.
|
||||
TUPLE: matrix rows cols sequence ;
|
||||
: >matrix<
|
||||
[ matrix-rows ] keep
|
||||
[ matrix-cols ] keep
|
||||
matrix-sequence ;
|
||||
|
||||
M: matrix clone ( matrix -- matrix )
|
||||
clone-tuple
|
||||
dup matrix-sequence clone over set-matrix-sequence ;
|
||||
|
@ -79,9 +62,8 @@ SYMBOL: matrix-maker
|
|||
2dup <zero-matrix> matrix set
|
||||
[
|
||||
[
|
||||
[
|
||||
swap matrix-maker get call
|
||||
] 2keep matrix get matrix-set
|
||||
[ matrix-maker get call ] 2keep
|
||||
matrix get matrix-set
|
||||
] 2keep
|
||||
] 2repeat
|
||||
matrix get
|
||||
|
@ -103,77 +85,62 @@ M: row length row-matrix matrix-cols ;
|
|||
M: row nth ( n row -- ) >row< swapd matrix-get ;
|
||||
M: row thaw >vector ;
|
||||
|
||||
! A sequence of rows.
|
||||
TUPLE: row-seq matrix ;
|
||||
M: row-seq length row-seq-matrix matrix-rows ;
|
||||
M: row-seq nth row-seq-matrix <row> ;
|
||||
|
||||
! Sequence of elements in a column of a matrix.
|
||||
TUPLE: col index matrix ;
|
||||
: >col< dup col-index swap col-matrix ;
|
||||
M: col length col-matrix matrix-rows ;
|
||||
M: col nth ( n column -- ) >col< swapd matrix-get ;
|
||||
M: col nth ( n column -- ) >col< matrix-get ;
|
||||
M: col thaw >vector ;
|
||||
|
||||
! A sequence of columns.
|
||||
TUPLE: col-seq matrix ;
|
||||
M: col-seq length col-seq-matrix matrix-cols ;
|
||||
M: col-seq nth col-seq-matrix <col> ;
|
||||
|
||||
: +check ( matrix matrix -- matrix matrix )
|
||||
: +check ( matrix matrix -- )
|
||||
#! Check if the two matrices have dimensions compatible
|
||||
#! for being added or subtracted.
|
||||
over matrix-rows over matrix-rows = >r
|
||||
over matrix-cols over matrix-cols = r> and [
|
||||
"Matrix dimensions do not match" throw
|
||||
swap matrix-cols swap matrix-cols = r> and [
|
||||
"Matrix dimensions do not equal" throw
|
||||
] unless ;
|
||||
|
||||
: +dimensions ( matrix -- rows cols )
|
||||
dup matrix-rows swap matrix-cols ;
|
||||
: element-wise ( m m -- v v )
|
||||
2dup +check >r >matrix< r> matrix-sequence ;
|
||||
|
||||
: matrix+/-
|
||||
+check
|
||||
>r dup +dimensions rot r>
|
||||
swap matrix-sequence swap matrix-sequence ;
|
||||
! Matrix operations
|
||||
: m+ ( m m -- m ) element-wise v+ <matrix> ;
|
||||
: m- ( m m -- m ) element-wise v- <matrix> ;
|
||||
|
||||
M: matrix v+ ( m m -- m ) matrix+/- v+ <matrix> ;
|
||||
M: matrix v- ( m m -- m ) matrix+/- v- <matrix> ;
|
||||
M: matrix v* ( m m -- m ) matrix+/- v* <matrix> ;
|
||||
: m* ( m m -- m )
|
||||
#! Multiply two matrices element-wise. This is NOT matrix
|
||||
#! multiplication in the usual mathematical sense. For that,
|
||||
#! see the m. word.
|
||||
element-wise v* <matrix> ;
|
||||
|
||||
: *check ( matrix matrix -- matrix matrix )
|
||||
over matrix-rows over matrix-cols = >r
|
||||
over matrix-cols over matrix-rows = r> and [
|
||||
: *check ( matrix matrix -- )
|
||||
swap matrix-cols swap matrix-rows = [
|
||||
"Matrix dimensions inappropriate for composition" throw
|
||||
] unless ;
|
||||
|
||||
: *dimensions ( m m -- rows cols )
|
||||
swap matrix-rows swap matrix-cols ;
|
||||
|
||||
M: matrix v. ( m1 m2 -- m )
|
||||
2dup *dimensions [
|
||||
( m1 m2 row col )
|
||||
: m. ( m1 m2 -- m )
|
||||
#! Composition of two matrices.
|
||||
2dup *check 2dup *dimensions [
|
||||
( m1 m2 row col -- m1 m2 )
|
||||
>r >r 2dup r> rot <row> r> rot <col> v.
|
||||
] make-matrix 2nip ;
|
||||
|
||||
! Reading and writing matrices
|
||||
: n*m ( n m -- m )
|
||||
#! Multiply a matrix by a scalar.
|
||||
>matrix< >r rot r> n*v <matrix> ;
|
||||
|
||||
: M[ f ; parsing
|
||||
: m.v ( m v -- v )
|
||||
#! Multiply a matrix by a column vector.
|
||||
<col-vector> m. matrix-sequence ;
|
||||
|
||||
: ]M
|
||||
reverse
|
||||
[ dup length swap car length ] keep
|
||||
concat >vector <matrix> swons ; parsing
|
||||
: v.m ( v m -- v )
|
||||
#! Multiply a row vector by a matrix.
|
||||
>r <row-vector> r> m. matrix-sequence ;
|
||||
|
||||
: row-list ( matrix -- list )
|
||||
#! A list of lists, where each sublist is a row of the
|
||||
#! matrix.
|
||||
[ <row-seq> [ >list , ] seq-each ] make-list ;
|
||||
|
||||
: matrix-rows. ( indent list -- indent )
|
||||
uncons >r [ one-line on prettyprint* ] with-scope r>
|
||||
[ over ?prettyprint-newline matrix-rows. ] when* ;
|
||||
|
||||
M: matrix prettyprint* ( indent obj -- indent )
|
||||
\ M[ word. >r <prettyprint r>
|
||||
row-list matrix-rows.
|
||||
bl \ ]M word. prettyprint> ;
|
||||
dup matrix-rows [ swap <row> >list ] project-with ;
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
|
||||
IN: !syntax
|
||||
USING: kernel lists math matrices parser sequences syntax
|
||||
vectors ;
|
||||
|
||||
! Complex numbers
|
||||
: #{ f ; parsing
|
||||
: }# 2unlist swap rect> swons ; parsing
|
||||
|
||||
! Reading integers in other bases
|
||||
: (BASE) ( base -- )
|
||||
#! Reads an integer in a specific base.
|
||||
scan swap base> swons ;
|
||||
|
||||
: HEX: 16 (BASE) ; parsing
|
||||
: DEC: 10 (BASE) ; parsing
|
||||
: OCT: 8 (BASE) ; parsing
|
||||
: BIN: 2 (BASE) ; parsing
|
||||
|
||||
! Matrices
|
||||
: M[ f ; parsing
|
||||
|
||||
: ]M
|
||||
reverse
|
||||
[ dup length swap car length ] keep
|
||||
concat >vector <matrix> swons ; parsing
|
|
@ -52,10 +52,6 @@ BUILTIN: f 9 ; : f f swons ; parsing
|
|||
: << f ; parsing
|
||||
: >> reverse literal-tuple swons ; parsing
|
||||
|
||||
! Complex numbers
|
||||
: #{ f ; parsing
|
||||
: }# 2unlist swap rect> swons ; parsing
|
||||
|
||||
! Do not execute parsing word
|
||||
: POSTPONE: ( -- ) scan-word swons ; parsing
|
||||
|
||||
|
@ -142,14 +138,3 @@ BUILTIN: f 9 ; : f f swons ; parsing
|
|||
: #!
|
||||
#! Documentation comment.
|
||||
until-eol parsed-documentation ; parsing
|
||||
|
||||
! Reading numbers in other bases
|
||||
|
||||
: (BASE) ( base -- )
|
||||
#! Read a number in a specific base.
|
||||
scan swap base> swons ;
|
||||
|
||||
: HEX: 16 (BASE) ; parsing
|
||||
: DEC: 10 (BASE) ; parsing
|
||||
: OCT: 8 (BASE) ; parsing
|
||||
: BIN: 2 (BASE) ; parsing
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2003, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: prettyprint
|
||||
USING: alien errors generic hashtables kernel lists math memory
|
||||
namespaces parser presentation sequences stdio streams strings
|
||||
unparser vectors words ;
|
||||
USING: alien errors generic hashtables kernel lists math
|
||||
matrices memory namespaces parser presentation sequences stdio
|
||||
streams strings unparser vectors words ;
|
||||
|
||||
SYMBOL: prettyprint-limit
|
||||
SYMBOL: one-line
|
||||
|
@ -154,6 +154,15 @@ M: tuple prettyprint* ( indent tuple -- indent )
|
|||
M: alien prettyprint* ( alien -- str )
|
||||
\ ALIEN: word. bl alien-address unparse write ;
|
||||
|
||||
: matrix-rows. ( indent list -- indent )
|
||||
uncons >r [ one-line on prettyprint* ] with-scope r>
|
||||
[ over ?prettyprint-newline matrix-rows. ] when* ;
|
||||
|
||||
M: matrix prettyprint* ( indent obj -- indent )
|
||||
\ M[ word. >r <prettyprint r>
|
||||
row-list matrix-rows.
|
||||
bl \ ]M word. prettyprint> ;
|
||||
|
||||
: prettyprint ( obj -- )
|
||||
[
|
||||
recursion-check off
|
||||
|
|
|
@ -1,6 +1,9 @@
|
|||
IN: temporary
|
||||
USING: kernel lists sequences test ;
|
||||
|
||||
[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
|
||||
[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
|
||||
|
||||
[ [ ] ] [ [ ] [ ] append ] unit-test
|
||||
[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
|
||||
[ [ 2 ] ] [ [ ] [ 2 ] append ] unit-test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: temporary
|
||||
USING: matrices test ;
|
||||
USING: kernel lists matrices namespaces test ;
|
||||
|
||||
[
|
||||
M[ [ 0 ] [ 0 ] [ 0 ] ]M
|
||||
|
@ -34,7 +34,7 @@ USING: matrices test ;
|
|||
[ 0 5 0 ]
|
||||
[ 6 0 0 ] ]M
|
||||
|
||||
v+
|
||||
m+
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
@ -50,19 +50,31 @@ USING: matrices test ;
|
|||
[ 0 -5 0 ]
|
||||
[ -6 0 0 ] ]M
|
||||
|
||||
v-
|
||||
m-
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{ 10 20 30 }
|
||||
] [
|
||||
10 { 1 2 3 } v.
|
||||
10 { 1 2 3 } n*v
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{ 10 20 30 }
|
||||
M[ [ 6 ] ]M
|
||||
] [
|
||||
{ 1 2 3 } 10 v.
|
||||
M[ [ 3 ] ]M M[ [ 2 ] ]M m.
|
||||
] unit-test
|
||||
|
||||
[
|
||||
M[ [ 11 ] ]M
|
||||
] [
|
||||
M[ [ 1 3 ] ]M M[ [ 5 ] [ 2 ] ]M m.
|
||||
] unit-test
|
||||
|
||||
[
|
||||
[ [[ 0 0 ]] [[ 1 0 ]] ]
|
||||
] [
|
||||
[ 2 1 [ 2dup cons , ] 2repeat ] make-list
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
@ -73,5 +85,16 @@ USING: matrices test ;
|
|||
|
||||
{ 3 4 }
|
||||
|
||||
v.
|
||||
m.v
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{ 4 3 }
|
||||
] [
|
||||
M[ [ 0 1 ]
|
||||
[ 1 0 ] ]M
|
||||
|
||||
{ 3 4 }
|
||||
|
||||
m.v
|
||||
] unit-test
|
||||
|
|
|
@ -46,15 +46,15 @@ prettyprint sequences stdio streams strings words ;
|
|||
TUPLE: jedit-stream ;
|
||||
|
||||
M: jedit-stream stream-readln ( stream -- str )
|
||||
wrapper-stream-scope
|
||||
[ CHAR: r write flush read-big-endian-32 read ] bind ;
|
||||
[
|
||||
CHAR: r write flush read-big-endian-32 read
|
||||
] with-wrapper ;
|
||||
|
||||
M: jedit-stream stream-write-attr ( str style stream -- )
|
||||
wrapper-stream-scope [ jedit-write-attr ] bind ;
|
||||
[ jedit-write-attr ] with-wrapper ;
|
||||
|
||||
M: jedit-stream stream-flush ( stream -- )
|
||||
wrapper-stream-scope
|
||||
[ CHAR: f write flush ] bind ;
|
||||
[ CHAR: f write flush ] with-wrapper ;
|
||||
|
||||
C: jedit-stream ( stream -- stream )
|
||||
[ >r <wrapper-stream> r> set-delegate ] keep ;
|
||||
|
|
Loading…
Reference in New Issue