factor: FOO: a b FOO: c d works again!

locals-and-roots
Doug Coleman 2016-06-27 22:24:50 -07:00
parent c0223d28f0
commit 47e54698e4
1212 changed files with 22238 additions and 22237 deletions

View File

@ -5,9 +5,9 @@ io.binary io.encodings.binary io.files kernel literals math
namespaces system threads ;
IN: key-logger
CONSTANT: frequency $$[ 1/30 seconds ] ;
CONSTANT: frequency $$[ 1/30 seconds ]
CONSTANT: path "resource:key-log.txt" ;
CONSTANT: path "resource:key-log.txt"
: update-key-caps-state ( -- )
read-keyboard keys>>

View File

@ -6,7 +6,7 @@ sequences strings system ui.operations urls vocabs ;
IN: webbrowser
HOOK: open-file os ( path -- ) ;
HOOK: open-file os ( path -- )
"webbrowser." os name>> append require

View File

@ -1,6 +1,6 @@
USING: kernel locals math math.matrices.simd math.order math.vectors
math.vectors.simd prettyprint sequences typed ;
QUALIFIED-WITH: alien.c-types c ;
QUALIFIED-WITH: alien.c-types c
IN: benchmark.3d-matrix-vector
: v2min ( xy -- xx )

View File

@ -24,7 +24,7 @@ IN: benchmark.ant
0 swap [ dup zero? ] [ 10 /mod swap [ + ] dip ] until drop ;
TUPLE: point x y ;
C: <point> point ;
C: <point> point
! use: alien.c-types
! use: classes.struct

View File

@ -42,7 +42,7 @@ MEMO: 24-from-4 ( a b c d -- ? )
] map-sum
] map-sum ;
CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 }
: backtrack-benchmark ( -- )
words [ reset-memoized ] each

View File

@ -6,7 +6,7 @@ IN: benchmark.binary-trees
TUPLE: tree-node item left right ;
C: <tree-node> tree-node ;
C: <tree-node> tree-node
: bottom-up-tree ( item depth -- tree )
dup 0 > [
@ -18,14 +18,14 @@ C: <tree-node> tree-node ;
drop f f
] if <tree-node> ; inline recursive
GENERIC: item-check ( node -- n ) ;
GENERIC: item-check ( node -- n )
M: tree-node item-check
[ item>> ] [ left>> ] [ right>> ] tri [ item-check ] bi@ - + ;
M: f item-check drop 0 ;
CONSTANT: min-depth 4 ;
CONSTANT: min-depth 4
: stretch-tree ( max-depth -- )
1 + 0 over bottom-up-tree item-check

View File

@ -1,7 +1,7 @@
USING: classes classes.tuple kernel sequences vocabs math ;
IN: benchmark.dispatch1
GENERIC: g ( obj -- obj ) ;
GENERIC: g ( obj -- obj )
TUPLE: x1 ;
M: x1 g ;

View File

@ -4,7 +4,7 @@ specialized-arrays bit-arrays ;
SPECIALIZED-ARRAY: double
IN: benchmark.dispatch3
GENERIC: g ( obj -- str ) ;
GENERIC: g ( obj -- str )
M: assoc g drop "assoc" ;

View File

@ -4,65 +4,65 @@ IN: benchmark.dispatch5
MIXIN: g
TUPLE: x1 ;
INSTANCE: x1 g ;
INSTANCE: x1 g
TUPLE: x2 ;
INSTANCE: x2 g ;
INSTANCE: x2 g
TUPLE: x3 ;
INSTANCE: x3 g ;
INSTANCE: x3 g
TUPLE: x4 ;
INSTANCE: x4 g ;
INSTANCE: x4 g
TUPLE: x5 ;
INSTANCE: x5 g ;
INSTANCE: x5 g
TUPLE: x6 ;
INSTANCE: x6 g ;
INSTANCE: x6 g
TUPLE: x7 ;
INSTANCE: x7 g ;
INSTANCE: x7 g
TUPLE: x8 ;
INSTANCE: x8 g ;
INSTANCE: x8 g
TUPLE: x9 ;
INSTANCE: x9 g ;
INSTANCE: x9 g
TUPLE: x10 ;
INSTANCE: x10 g ;
INSTANCE: x10 g
TUPLE: x11 ;
INSTANCE: x11 g ;
INSTANCE: x11 g
TUPLE: x12 ;
INSTANCE: x12 g ;
INSTANCE: x12 g
TUPLE: x13 ;
INSTANCE: x13 g ;
INSTANCE: x13 g
TUPLE: x14 ;
INSTANCE: x14 g ;
INSTANCE: x14 g
TUPLE: x15 ;
INSTANCE: x15 g ;
INSTANCE: x15 g
TUPLE: x16 ;
INSTANCE: x16 g ;
INSTANCE: x16 g
TUPLE: x17 ;
INSTANCE: x17 g ;
INSTANCE: x17 g
TUPLE: x18 ;
INSTANCE: x18 g ;
INSTANCE: x18 g
TUPLE: x19 ;
INSTANCE: x19 g ;
INSTANCE: x19 g
TUPLE: x20 ;
INSTANCE: x20 g ;
INSTANCE: x20 g
TUPLE: x21 ;
INSTANCE: x21 g ;
INSTANCE: x21 g
TUPLE: x22 ;
INSTANCE: x22 g ;
INSTANCE: x22 g
TUPLE: x23 ;
INSTANCE: x23 g ;
INSTANCE: x23 g
TUPLE: x24 ;
INSTANCE: x24 g ;
INSTANCE: x24 g
TUPLE: x25 ;
INSTANCE: x25 g ;
INSTANCE: x25 g
TUPLE: x26 ;
INSTANCE: x26 g ;
INSTANCE: x26 g
TUPLE: x27 ;
INSTANCE: x27 g ;
INSTANCE: x27 g
TUPLE: x28 ;
INSTANCE: x28 g ;
INSTANCE: x28 g
TUPLE: x29 ;
INSTANCE: x29 g ;
INSTANCE: x29 g
TUPLE: x30 ;
INSTANCE: x30 g ;
INSTANCE: x30 g
: my-classes ( -- seq )
"benchmark.dispatch5" vocab-words [ tuple-class? ] filter ;

View File

@ -2,20 +2,20 @@
USING: assocs benchmark.reverse-complement byte-arrays fry io
io.encodings.ascii io.files locals kernel math sequences
sequences.private specialized-arrays strings typed alien.data ;
QUALIFIED-WITH: alien.c-types c ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:double
IN: benchmark.fasta
CONSTANT: IM 139968 ;
CONSTANT: IA 3877 ;
CONSTANT: IC 29573 ;
CONSTANT: initial-seed 42 ;
CONSTANT: line-length 60 ;
CONSTANT: IM 139968
CONSTANT: IA 3877
CONSTANT: IC 29573
CONSTANT: initial-seed 42
CONSTANT: line-length 60
: next-fasta-random ( seed -- seed n )
IA * IC + IM mod dup IM /f ; inline
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" ;
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
CONSTANT: IUB
{
@ -35,7 +35,7 @@ CONSTANT: IUB
{ char: V 0.02 }
{ char: W 0.02 }
{ char: Y 0.02 }
} ;
}
CONSTANT: homo-sapiens
{
@ -43,7 +43,7 @@ CONSTANT: homo-sapiens
{ char: c 0.1979883004921 }
{ char: g 0.1975473066391 }
{ char: t 0.3015094502008 }
} ;
}
TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
[ keys >byte-array ]

View File

@ -3,7 +3,7 @@ IN: benchmark.fib4
TUPLE: box { i read-only } ;
C: <box> box ;
C: <box> box
: tuple-fib ( m -- n )
dup i>> 1 <= [

View File

@ -3,8 +3,8 @@
USING: kernel math sequences ;
IN: benchmark.flip
CONSTANT: my-generic { { 1 2 3 } V{ 4 5 6 } "ABC" } ;
CONSTANT: my-array { { 1 2 3 } { 4 5 6 } { 7 8 9 } } ;
CONSTANT: my-generic { { 1 2 3 } V{ 4 5 6 } "ABC" }
CONSTANT: my-array { { 1 2 3 } { 4 5 6 } { 7 8 9 } }
: flip-benchmark ( -- )
1,000,000 [ my-generic flip drop ] times

View File

@ -7,7 +7,7 @@ IN: benchmark.hash-sets
CONSTANT: test-sets $$[
{ 10 100 1,000 10,000 50,000 100,000 }
[ iota >hash-set ] map dup append
] ;
]
: do-times ( n quot: ( set1 set2 -- set' ) -- )
$[ 2dup @ drop ] times 2drop ; inline

View File

@ -6,7 +6,7 @@ math.statistics namespaces math.parser combinators arrays
sorting formatting grouping fry ;
IN: benchmark.knucleotide
CONSTANT: knucleotide-in "vocab:benchmark/knucleotide/knucleotide-input.txt" ;
CONSTANT: knucleotide-in "vocab:benchmark/knucleotide/knucleotide-input.txt"
: discard-lines ( -- )
readln

View File

@ -7,8 +7,8 @@ IN: benchmark.mandel.colors
: scale-rgb ( rgba -- n )
[ red>> scale ] [ green>> scale ] [ blue>> scale ] tri 3byte-array ;
CONSTANT: sat 0.85 ;
CONSTANT: val 0.85 ;
CONSTANT: sat 0.85
CONSTANT: val 0.85
: <color-map> ( nb-cols -- map )
[ iota ] keep $[

View File

@ -1,8 +1,8 @@
IN: benchmark.mandel.params
CONSTANT: max-color 360 ;
CONSTANT: zoom-fact 0.8 ;
CONSTANT: width 640 ;
CONSTANT: height 480 ;
CONSTANT: max-iterations 40 ;
CONSTANT: center -0.65 ;
CONSTANT: max-color 360
CONSTANT: zoom-fact 0.8
CONSTANT: width 640
CONSTANT: height 480
CONSTANT: max-iterations 40
CONSTANT: center -0.65

View File

@ -7,7 +7,7 @@ hints classes.struct specialized-arrays io ;
IN: benchmark.nbody-simd
: solar-mass ( -- x ) 4 pi sq * ; inline
CONSTANT: days-per-year 365.24 ;
CONSTANT: days-per-year 365.24
STRUCT: body
{ location double-4 }

View File

@ -8,7 +8,7 @@ SPECIALIZED-ARRAY: double
IN: benchmark.nbody
: solar-mass ( -- x ) 4 pi sq * ; inline
CONSTANT: days-per-year 365.24 ;
CONSTANT: days-per-year 365.24
TUPLE: body
{ location double-array }

View File

@ -2,7 +2,7 @@ USING: kernel literals math.functions math.parser random
sequences ;
IN: benchmark.parse-float
CONSTANT: test-floats $$[ 100,000 random-units ] ;
CONSTANT: test-floats $$[ 100,000 random-units ]
: parse-float-benchmark ( -- )
test-floats [

View File

@ -5,7 +5,7 @@ IN: benchmark.parse-ratio
CONSTANT: test-ratios $$[
200,000 100,000 random-integers
200,000 1,000 random-integers 1 v+n v/
] ;
]
: parse-ratio-benchmark ( -- )
test-ratios [

View File

@ -1,7 +1,7 @@
USING: arrays kernel literals random sequences ;
IN: benchmark.randomize
CONSTANT: data $$[ 10,000,000 iota >array ] ;
CONSTANT: data $$[ 10,000,000 iota >array ]
: randomize-benchmark ( -- )
data randomize drop ;

View File

@ -18,27 +18,27 @@ CONSTANT: light
-0.8017837257372732
0.5345224838248488
0.0
} ;
}
CONSTANT: oversampling 4 ;
CONSTANT: oversampling 4
CONSTANT: levels 3 ;
CONSTANT: levels 3
CONSTANT: size 200 ;
CONSTANT: size 200
: delta ( -- n ) epsilon sqrt ; inline no-compile
TUPLE: ray { orig double-4 read-only } { dir double-4 read-only } ;
C: <ray> ray ;
C: <ray> ray
TUPLE: hit { normal double-4 read-only } { lambda float read-only } ;
C: <hit> hit ;
C: <hit> hit
TUPLE: sphere { center double-4 read-only } { radius float read-only } ;
C: <sphere> sphere ;
C: <sphere> sphere
: sphere-v ( sphere ray -- v ) [ center>> ] [ orig>> ] bi* v- ; inline no-compile
@ -85,7 +85,7 @@ TUPLE: group < sphere { objs array read-only } ;
{ [ dup sphere? ] [ [ [ sphere-n normalize ] keep <hit> nip ] if-ray-sphere ] }
} cond ; inline recursive no-compile
CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. } ;
CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. }
: initial-intersect ( ray scene -- hit )
[ initial-hit ] 2dip intersect-scene ; inline no-compile
@ -122,7 +122,7 @@ CONSTANT: create-offsets
double-4{ 1.0 1.0 -1.0 0.0 }
double-4{ -1.0 1.0 1.0 0.0 }
double-4{ 1.0 1.0 1.0 0.0 }
} ;
}
: create-bound ( c r -- sphere ) 3.0 * <sphere> ;

View File

@ -16,29 +16,29 @@ CONSTANT: light
-0.2672612419124244
-0.8017837257372732
0.5345224838248488
} ;
}
CONSTANT: oversampling 4 ;
CONSTANT: oversampling 4
CONSTANT: levels 3 ;
CONSTANT: levels 3
CONSTANT: size 200 ;
CONSTANT: size 200
: delta ( -- n ) epsilon sqrt ; inline
TUPLE: ray { orig double-array read-only } { dir double-array read-only } ;
C: <ray> ray ;
C: <ray> ray
TUPLE: hit { normal double-array read-only } { lambda float read-only } ;
C: <hit> hit ;
C: <hit> hit
GENERIC: intersect-scene ( hit ray scene -- hit ) ;
GENERIC: intersect-scene ( hit ray scene -- hit )
TUPLE: sphere { center double-array read-only } { radius float read-only } ;
C: <sphere> sphere ;
C: <sphere> sphere
: sphere-v ( sphere ray -- v )
[ center>> ] [ orig>> ] bi* v- ; inline
@ -94,7 +94,7 @@ M: group intersect-scene ( hit ray group -- hit )
HINTS: M\ group intersect-scene { hit ray group } ;
CONSTANT: initial-hit T{ hit f double-array{ 0.0 0.0 0.0 } 1/0. } ;
CONSTANT: initial-hit T{ hit f double-array{ 0.0 0.0 0.0 } 1/0. }
: initial-intersect ( ray scene -- hit )
[ initial-hit ] 2dip intersect-scene ; inline

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io math math.functions math.parser math.vectors
math.vectors.simd sequences specialized-arrays ;
QUALIFIED-WITH: alien.c-types c ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: float-4
IN: benchmark.simd-1

View File

@ -11,7 +11,7 @@ SYMBOL: server-promise
SYMBOL: server
SYMBOL: port
CONSTANT: number-of-requests 1000 ;
CONSTANT: number-of-requests 1000
: server-addr ( -- addr )
"127.0.0.1" port get <inet4> ;

View File

@ -1,8 +1,8 @@
USING: assocs kernel literals math random sequences sorting ;
IN: benchmark.sort
CONSTANT: numbers-to-sort $$[ 300,000 200 random-integers ] ;
CONSTANT: alist-to-sort $$[ 1,000 iota dup zip ] ;
CONSTANT: numbers-to-sort $$[ 300,000 200 random-integers ]
CONSTANT: alist-to-sort $$[ 1,000 iota dup zip ]
: sort-benchmark ( -- )
10 [ numbers-to-sort natural-sort drop ] times

View File

@ -6,7 +6,7 @@ locals formatting ;
IN: benchmark.tcp-echo0
! Max size here is 26 2^ 1 - because array-capacity limits on 32bit platforms
CONSTANT: test-size0 $$[ 23 2^ 1 - ] ;
CONSTANT: test-size0 $$[ 23 2^ 1 - ]
MEMO: test-bytes ( n -- byte-array ) iota >byte-array ;

View File

@ -7,7 +7,7 @@ IN: arrays.shaped
: flat? ( array -- ? ) [ sequence? ] any? not ; inline
GENERIC: array-replace ( object -- shape ) ;
GENERIC: array-replace ( object -- shape )
M: f array-replace ;
@ -21,12 +21,12 @@ M: sequence array-replace
] if ;
TUPLE: uniform-shape shape ;
C: <uniform-shape> uniform-shape ;
C: <uniform-shape> uniform-shape
TUPLE: abnormal-shape shape ;
C: <abnormal-shape> abnormal-shape ;
C: <abnormal-shape> abnormal-shape
GENERIC: wrap-shape ( object -- shape ) ;
GENERIC: wrap-shape ( object -- shape )
M: integer wrap-shape
1array <uniform-shape> ;
@ -38,7 +38,7 @@ M: sequence wrap-shape
<abnormal-shape>
] if ;
GENERIC: shape ( array -- shape ) ;
GENERIC: shape ( array -- shape )
M: sequence shape array-replace wrap-shape ;
@ -49,7 +49,7 @@ ERROR: no-negative-shape-components shape ;
: check-shape-domain ( seq -- seq )
dup [ 0 < ] any? [ no-negative-shape-components ] when ;
GENERIC: shape-capacity ( shape -- n ) ;
GENERIC: shape-capacity ( shape -- n )
M: sequence shape-capacity check-shape-domain product ;
@ -65,7 +65,7 @@ ERROR: underlying-shape-mismatch underlying shape ;
ERROR: no-abnormally-shaped-arrays underlying shape ;
GENERIC: check-underlying-shape ( underlying shape -- underlying shape ) ;
GENERIC: check-underlying-shape ( underlying shape -- underlying shape )
M: abnormal-shape check-underlying-shape
no-abnormally-shaped-arrays ;
@ -105,9 +105,9 @@ M: shaped-array shape shape>> ;
: <col-array> ( underlying shape -- shaped-array )
col-array make-shaped-array ; inline
GENERIC: >shaped-array ( array -- shaped-array ) ;
GENERIC: >row-array ( array -- shaped-array ) ;
GENERIC: >col-array ( array -- shaped-array ) ;
GENERIC: >shaped-array ( array -- shaped-array )
GENERIC: >row-array ( array -- shaped-array )
GENERIC: >col-array ( array -- shaped-array )
M: sequence >shaped-array
[ { } flatten-as ] [ shape ] bi <shaped-array> ;
@ -171,7 +171,7 @@ TUPLE: transposed shaped-array ;
TUPLE: row-traverser shaped-array index ;
GENERIC: next-index ( object -- index ) ;
GENERIC: next-index ( object -- index )
SYNTAX: \ sa{ \ } [ >shaped-array ] parse-literal ;

View File

@ -5,7 +5,7 @@ IN: assoc-heaps
TUPLE: assoc-heap assoc heap ;
C: <assoc-heap> assoc-heap ;
C: <assoc-heap> assoc-heap
: <unique-min-heap> ( -- unique-heap )
H{ } clone <min-heap> <assoc-heap> ;

View File

@ -40,7 +40,7 @@ IN: assocs.extras
[ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep
[ assoc-merge! ] bi@ ;
GENERIC: delete-value-at ( value assoc -- ) ;
GENERIC: delete-value-at ( value assoc -- )
M: assoc delete-value-at
[ value-at* ] keep swap [ delete-at ] [ 2drop ] if ;

View File

@ -43,7 +43,7 @@ M: biassoc clear-assoc
M: biassoc new-assoc
drop [ <hashtable> ] [ <hashtable> ] bi biassoc boa ;
INSTANCE: biassoc assoc ;
INSTANCE: biassoc assoc
: >biassoc ( assoc -- biassoc )
T{ biassoc } assoc-clone-like ;

View File

@ -59,11 +59,11 @@ M: bit-array nth-unsafe
M: bit-array set-nth-unsafe
bit-index [ toggle-bit ] change-nth-unsafe ; inline
GENERIC: clear-bits ( bit-array -- ) ;
GENERIC: clear-bits ( bit-array -- )
M: bit-array clear-bits 0 (set-bits) ; inline
GENERIC: set-bits ( bit-array -- ) ;
GENERIC: set-bits ( bit-array -- )
M: bit-array set-bits -1 (set-bits) ; inline
@ -96,7 +96,7 @@ SYNTAX: \ ?{ \ } [ >bit-array ] parse-literal ;
: bit-array>integer ( bit-array -- n )
underlying>> le> ;
INSTANCE: bit-array sequence ;
INSTANCE: bit-array sequence
M: bit-array pprint-delims drop \ ?{ \ } ;
M: bit-array >pprint-sequence ;

View File

@ -9,7 +9,7 @@ TUPLE: bit-set { table bit-array read-only } ;
: <bit-set> ( capacity -- bit-set )
<bit-array> bit-set boa ; inline
INSTANCE: bit-set set ;
INSTANCE: bit-set set
M: bit-set in?
over integer? [ table>> ?nth ] [ 2drop f ] if ; inline

View File

@ -62,8 +62,8 @@ TUPLE: lsb0-bit-writer < bit-writer ;
: <lsb0-bit-writer> ( -- bs )
lsb0-bit-writer new-bit-writer ;
GENERIC: peek ( n bitstream -- value ) ;
GENERIC: poke ( value n bitstream -- ) ;
GENERIC: peek ( n bitstream -- value )
GENERIC: poke ( value n bitstream -- )
: get-abp ( bitstream -- abp )
[ byte-pos>> 8 * ] [ bit-pos>> + ] bi ; inline

View File

@ -31,7 +31,7 @@ M: cache-assoc clear-assoc
M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
INSTANCE: cache-assoc assoc ;
INSTANCE: cache-assoc assoc
M: cache-assoc dispose* clear-assoc ;

View File

@ -49,14 +49,14 @@ IN: circular.tests
] keep
] unit-test
CONSTANT: test-sequence1 { t f f f } ;
CONSTANT: test-sequence1 { t f f f }
{ V{ 1 2 3 1 } } [
{ 1 2 3 } <circular> V{ } [
[ [ push ] [ length 1 - test-sequence1 nth ] bi ] curry circular-while
] keep
] unit-test
CONSTANT: test-sequence2 { t f t t f f t t t f f f } ;
CONSTANT: test-sequence2 { t f t t f f t t t f f f }
{ V{ 1 2 3 1 2 3 1 2 3 1 2 3 } } [
{ 1 2 3 } <circular> V{ } [
[ [ push ] [ length 1 - test-sequence2 nth ] bi ] curry circular-while

View File

@ -36,7 +36,7 @@ M: circular virtual-exemplar seq>> ; inline
: <circular-string> ( n -- circular )
0 <string> <circular> ; inline
INSTANCE: circular virtual-sequence ;
INSTANCE: circular virtual-sequence
TUPLE: growing-circular < circular { length integer } ;

View File

@ -6,13 +6,13 @@ IN: columns
! A column of a matrix
TUPLE: column seq col ;
C: <column> column ;
C: <column> column
M: column virtual-exemplar seq>> ;
M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ;
M: column length seq>> length ;
INSTANCE: column virtual-sequence ;
INSTANCE: column virtual-sequence
: <flipped> ( seq -- seq' )
dup empty? [ dup first length [ <column> ] with { } map-integers ] unless ;

View File

@ -12,12 +12,12 @@ IN: cursors
MIXIN: cursor
GENERIC: cursor-compatible? ( cursor cursor -- ? ) ;
GENERIC: cursor-valid? ( cursor -- ? ) ;
GENERIC: cursor= ( cursor cursor -- ? ) ;
GENERIC: cursor<= ( cursor cursor -- ? ) ;
GENERIC: cursor>= ( cursor cursor -- ? ) ;
GENERIC: cursor-distance-hint ( cursor cursor -- n ) ;
GENERIC: cursor-compatible? ( cursor cursor -- ? )
GENERIC: cursor-valid? ( cursor -- ? )
GENERIC: cursor= ( cursor cursor -- ? )
GENERIC: cursor<= ( cursor cursor -- ? )
GENERIC: cursor>= ( cursor cursor -- ? )
GENERIC: cursor-distance-hint ( cursor cursor -- n )
M: cursor cursor<= cursor= ; inline
M: cursor cursor>= cursor= ; inline
@ -28,23 +28,23 @@ M: cursor cursor-distance-hint 2drop 0 ; inline
!
MIXIN: forward-cursor
INSTANCE: forward-cursor cursor ;
INSTANCE: forward-cursor cursor
GENERIC: inc-cursor ( cursor -- cursor' ) ;
GENERIC: inc-cursor ( cursor -- cursor' )
MIXIN: bidirectional-cursor
INSTANCE: bidirectional-cursor forward-cursor ;
INSTANCE: bidirectional-cursor forward-cursor
GENERIC: dec-cursor ( cursor -- cursor' ) ;
GENERIC: dec-cursor ( cursor -- cursor' )
MIXIN: random-access-cursor
INSTANCE: random-access-cursor bidirectional-cursor ;
INSTANCE: random-access-cursor bidirectional-cursor
GENERIC#: cursor+ 1 ( cursor n -- cursor' ) ;
GENERIC#: cursor- 1 ( cursor n -- cursor' ) ;
GENERIC: cursor-distance ( cursor cursor -- n ) ;
GENERIC: cursor< ( cursor cursor -- ? ) ;
GENERIC: cursor> ( cursor cursor -- ? ) ;
GENERIC#: cursor+ 1 ( cursor n -- cursor' )
GENERIC#: cursor- 1 ( cursor n -- cursor' )
GENERIC: cursor-distance ( cursor cursor -- n )
GENERIC: cursor< ( cursor cursor -- ? )
GENERIC: cursor> ( cursor cursor -- ? )
M: random-access-cursor inc-cursor 1 cursor+ ; inline
M: random-access-cursor dec-cursor -1 cursor+ ; inline
@ -61,9 +61,9 @@ ERROR: invalid-cursor cursor ;
MIXIN: input-cursor
GENERIC: cursor-key-value ( cursor -- key value ) ;
GENERIC: cursor-key-value ( cursor -- key value )
PRIVATE<
GENERIC: cursor-key-value-unsafe ( cursor -- key value ) ;
GENERIC: cursor-key-value-unsafe ( cursor -- key value )
PRIVATE>
M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline
M: input-cursor cursor-key-value
@ -83,9 +83,9 @@ M: input-cursor cursor-key-value
MIXIN: output-cursor
GENERIC: set-cursor-value ( value cursor -- ) ;
GENERIC: set-cursor-value ( value cursor -- )
PRIVATE<
GENERIC: set-cursor-value-unsafe ( value cursor -- ) ;
GENERIC: set-cursor-value-unsafe ( value cursor -- )
PRIVATE>
M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline
M: output-cursor set-cursor-value
@ -98,28 +98,28 @@ M: output-cursor set-cursor-value
!
MIXIN: stream-cursor
INSTANCE: stream-cursor forward-cursor ;
INSTANCE: stream-cursor forward-cursor
M: stream-cursor cursor-compatible? 2drop f ; inline
M: stream-cursor cursor-valid? drop t ; inline
M: stream-cursor cursor= 2drop f ; inline
MIXIN: infinite-stream-cursor
INSTANCE: infinite-stream-cursor stream-cursor ;
INSTANCE: infinite-stream-cursor stream-cursor
M: infinite-stream-cursor inc-cursor ; inline
MIXIN: finite-stream-cursor
INSTANCE: finite-stream-cursor stream-cursor ;
INSTANCE: finite-stream-cursor stream-cursor
SINGLETON: end-of-stream
GENERIC: cursor-stream-ended? ( cursor -- ? ) ;
GENERIC: cursor-stream-ended? ( cursor -- ? )
M: finite-stream-cursor inc-cursor
dup cursor-stream-ended? [ drop end-of-stream ] when ; inline
INSTANCE: end-of-stream finite-stream-cursor ;
INSTANCE: end-of-stream finite-stream-cursor
M: end-of-stream cursor-compatible? drop finite-stream-cursor? ; inline
M: end-of-stream cursor-valid? drop f ; inline
@ -163,7 +163,7 @@ M: numeric-cursor cursor< [ value>> ] bi@ < ; inline
M: numeric-cursor cursor> [ value>> ] bi@ > ; inline
M: numeric-cursor cursor>= [ value>> ] bi@ >= ; inline
INSTANCE: numeric-cursor input-cursor ;
INSTANCE: numeric-cursor input-cursor
M: numeric-cursor cursor-key-value value>> dup ; inline
@ -173,9 +173,9 @@ M: numeric-cursor cursor-key-value value>> dup ; inline
TUPLE: linear-cursor < numeric-cursor
{ delta read-only } ;
C: <linear-cursor> linear-cursor ;
C: <linear-cursor> linear-cursor
INSTANCE: linear-cursor random-access-cursor ;
INSTANCE: linear-cursor random-access-cursor
M: linear-cursor cursor-compatible?
[ linear-cursor? ] both? ; inline
@ -189,7 +189,7 @@ M: linear-cursor cursor+
M: linear-cursor cursor-
[ [ value>> ] [ delta>> ] bi ] dip [ * - ] keep <linear-cursor> ; inline
GENERIC: up/i ( distance delta -- distance' ) ;
GENERIC: up/i ( distance delta -- distance' )
M: integer up/i [ 1 - + ] keep /i ; inline
M: real up/i / ceiling >integer ; inline
@ -204,9 +204,9 @@ TUPLE: quadratic-cursor < numeric-cursor
{ delta read-only }
{ delta2 read-only } ;
C: <quadratic-cursor> quadratic-cursor ;
C: <quadratic-cursor> quadratic-cursor
INSTANCE: quadratic-cursor bidirectional-cursor ;
INSTANCE: quadratic-cursor bidirectional-cursor
M: quadratic-cursor cursor-compatible?
[ linear-cursor? ] both? ; inline
@ -223,8 +223,8 @@ M: quadratic-cursor dec-cursor
MIXIN: collection
GENERIC: begin-cursor ( collection -- cursor ) ;
GENERIC: end-cursor ( collection -- cursor ) ;
GENERIC: begin-cursor ( collection -- cursor )
GENERIC: end-cursor ( collection -- cursor )
: all ( collection -- begin end )
[ begin-cursor ] [ end-cursor ] bi ; inline
@ -237,14 +237,14 @@ GENERIC: end-cursor ( collection -- cursor ) ;
!
MIXIN: container
INSTANCE: container collection ;
INSTANCE: container collection
: in- ( container quot -- begin end quot' )
all- -in- ; inline
: each ( ... container quot: ( ... x -- ... ) -- ... ) in- -each ; inline
INSTANCE: finite-stream-cursor container ;
INSTANCE: finite-stream-cursor container
M: finite-stream-cursor begin-cursor ; inline
M: finite-stream-cursor end-cursor drop end-of-stream ; inline
@ -256,14 +256,14 @@ M: finite-stream-cursor end-cursor drop end-of-stream ; inline
TUPLE: sequence-cursor
{ seq read-only }
{ n fixnum read-only } ;
C: <sequence-cursor> sequence-cursor ;
C: <sequence-cursor> sequence-cursor
INSTANCE: sequence container ;
INSTANCE: sequence container
M: sequence begin-cursor 0 <sequence-cursor> ; inline
M: sequence end-cursor dup length <sequence-cursor> ; inline
INSTANCE: sequence-cursor random-access-cursor ;
INSTANCE: sequence-cursor random-access-cursor
M: sequence-cursor cursor-compatible?
{
@ -286,12 +286,12 @@ M: sequence-cursor cursor- [ [ seq>> ] [ n>> ] bi ] dip - <sequence-cursor> ; in
M: sequence-cursor cursor-distance ( cursor cursor -- n )
[ n>> ] bi@ - ; inline
INSTANCE: sequence-cursor input-cursor ;
INSTANCE: sequence-cursor input-cursor
M: sequence-cursor cursor-key-value-unsafe [ n>> dup ] [ seq>> ] bi nth-unsafe ; inline
M: sequence-cursor cursor-key-value [ n>> dup ] [ seq>> ] bi nth ; inline
INSTANCE: sequence-cursor output-cursor ;
INSTANCE: sequence-cursor output-cursor
M: sequence-cursor set-cursor-value-unsafe [ n>> ] [ seq>> ] bi set-nth-unsafe ; inline
M: sequence-cursor set-cursor-value [ n>> ] [ seq>> ] bi set-nth ; inline
@ -304,10 +304,10 @@ TUPLE: hash-set-cursor
{ hash-set hash-set read-only }
{ n fixnum read-only } ;
PRIVATE<
C: <hash-set-cursor> hash-set-cursor ;
C: <hash-set-cursor> hash-set-cursor
PRIVATE>
INSTANCE: hash-set-cursor forward-cursor ;
INSTANCE: hash-set-cursor forward-cursor
M: hash-set-cursor cursor-compatible?
{
@ -332,12 +332,12 @@ M: hash-set-cursor inc-cursor ( cursor -- cursor' )
[ hash-set>> dup array>> ] [ n>> 1 + ] bi
(inc-hash-set-cursor) <hash-set-cursor> ; inline
INSTANCE: hash-set-cursor input-cursor ;
INSTANCE: hash-set-cursor input-cursor
M: hash-set-cursor cursor-key-value-unsafe
[ n>> dup ] [ hash-set>> array>> ] bi nth-unsafe ; inline
INSTANCE: hash-set container ;
INSTANCE: hash-set container
M: hash-set begin-cursor
dup array>> 0 (inc-hash-set-cursor) <hash-set-cursor> ; inline
@ -351,16 +351,16 @@ M: hash-set end-cursor
TUPLE: map-cursor
{ from read-only }
{ to read-only } ;
C: <map-cursor> map-cursor ;
C: <map-cursor> map-cursor
INSTANCE: map-cursor forward-cursor ;
INSTANCE: map-cursor forward-cursor
M: map-cursor cursor-compatible? [ from>> ] bi@ cursor-compatible? ; inline
M: map-cursor cursor-valid? [ from>> ] [ to>> ] bi [ cursor-valid? ] both? ; inline
M: map-cursor cursor= [ from>> ] bi@ cursor= ; inline
M: map-cursor inc-cursor [ from>> inc-cursor ] [ to>> inc-cursor ] bi <map-cursor> ; inline
INSTANCE: map-cursor output-cursor ;
INSTANCE: map-cursor output-cursor
M: map-cursor set-cursor-value-unsafe to>> set-cursor-value-unsafe ; inline
M: map-cursor set-cursor-value to>> set-cursor-value ; inline
@ -377,10 +377,10 @@ M: map-cursor set-cursor-value to>> set-cursor-value ; inline
TUPLE: pusher-cursor
{ growable read-only } ;
C: <pusher-cursor> pusher-cursor ;
C: <pusher-cursor> pusher-cursor
INSTANCE: pusher-cursor infinite-stream-cursor ;
INSTANCE: pusher-cursor output-cursor ;
INSTANCE: pusher-cursor infinite-stream-cursor
INSTANCE: pusher-cursor output-cursor
M: pusher-cursor set-cursor-value growable>> push ; inline
@ -391,7 +391,7 @@ M: pusher-cursor set-cursor-value growable>> push ; inline
: new-growable-cursor ( begin end exemplar -- cursor result )
[ swap cursor-distance-hint ] dip new-resizable [ <pusher-cursor> ] keep ; inline
GENERIC#: new-sequence-cursor 1 ( begin end exemplar -- cursor result ) ;
GENERIC#: new-sequence-cursor 1 ( begin end exemplar -- cursor result )
M: random-access-cursor new-sequence-cursor
[ swap cursor-distance ] dip new-sequence [ begin-cursor ] keep ; inline
@ -442,10 +442,10 @@ TUPLE: hashtable-cursor
{ hashtable hashtable read-only }
{ n fixnum read-only } ;
PRIVATE<
C: <hashtable-cursor> hashtable-cursor ;
C: <hashtable-cursor> hashtable-cursor
PRIVATE>
INSTANCE: hashtable-cursor forward-cursor ;
INSTANCE: hashtable-cursor forward-cursor
M: hashtable-cursor cursor-compatible?
{
@ -470,13 +470,13 @@ M: hashtable-cursor inc-cursor ( cursor -- cursor' )
[ hashtable>> dup array>> ] [ n>> 2 + ] bi
(inc-hashtable-cursor) <hashtable-cursor> ; inline
INSTANCE: hashtable-cursor input-cursor ;
INSTANCE: hashtable-cursor input-cursor
M: hashtable-cursor cursor-key-value-unsafe
[ n>> ] [ hashtable>> array>> ] bi
[ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
INSTANCE: hashtable container ;
INSTANCE: hashtable container
M: hashtable begin-cursor
dup array>> 0 (inc-hashtable-cursor) <hashtable-cursor> ; inline
@ -490,9 +490,9 @@ M: hashtable end-cursor
TUPLE: zip-cursor
{ keys read-only }
{ values read-only } ;
C: <zip-cursor> zip-cursor ;
C: <zip-cursor> zip-cursor
INSTANCE: zip-cursor forward-cursor ;
INSTANCE: zip-cursor forward-cursor
M: zip-cursor cursor-compatible? ( cursor cursor -- ? )
{
@ -516,7 +516,7 @@ M: zip-cursor cursor-distance-hint ( cursor cursor -- n )
M: zip-cursor inc-cursor ( cursor -- cursor' )
[ keys>> inc-cursor ] [ values>> inc-cursor ] bi <zip-cursor> ; inline
INSTANCE: zip-cursor input-cursor ;
INSTANCE: zip-cursor input-cursor
M: zip-cursor cursor-key-value
[ keys>> cursor-value-unsafe ] [ values>> cursor-value-unsafe ] bi ; inline
@ -530,7 +530,7 @@ M: zip-cursor cursor-key-value
: 2all- ( a b quot -- begin end quot )
[ 2all ] dip ; inline
ALIAS: -2in- -assoc- ;
ALIAS: -2in- -assoc-
: 2in- ( a b quot -- begin end quot' )
2all- -2in- ; inline

View File

@ -3,17 +3,17 @@
USING: fry kernel sequences ;
IN: deques
GENERIC: push-front* ( obj deque -- node ) ;
GENERIC: push-back* ( obj deque -- node ) ;
GENERIC: peek-front* ( deque -- obj ? ) ;
GENERIC: peek-back* ( deque -- obj ? ) ;
GENERIC: pop-front* ( deque -- ) ;
GENERIC: pop-back* ( deque -- ) ;
GENERIC: delete-node ( node deque -- ) ;
GENERIC: deque-member? ( value deque -- ? ) ;
GENERIC: clear-deque ( deque -- ) ;
GENERIC: node-value ( node -- value ) ;
GENERIC: deque-empty? ( deque -- ? ) ;
GENERIC: push-front* ( obj deque -- node )
GENERIC: push-back* ( obj deque -- node )
GENERIC: peek-front* ( deque -- obj ? )
GENERIC: peek-back* ( deque -- obj ? )
GENERIC: pop-front* ( deque -- )
GENERIC: pop-back* ( deque -- )
GENERIC: delete-node ( node deque -- )
GENERIC: deque-member? ( value deque -- ? )
GENERIC: clear-deque ( deque -- )
GENERIC: node-value ( node -- value )
GENERIC: deque-empty? ( deque -- ? )
ERROR: empty-deque ;

View File

@ -25,7 +25,7 @@ PRIVATE<
PRIVATE>
GENERIC: representative ( a disjoint-set -- p ) ;
GENERIC: representative ( a disjoint-set -- p )
M:: disjoint-set representative ( a disjoint-set -- p )
a disjoint-set parents>> at set: p
@ -51,7 +51,7 @@ PRIVATE>
: <disjoint-set> ( -- disjoint-set )
H{ } clone H{ } clone H{ } clone disjoint-set boa ;
GENERIC: add-atom ( a disjoint-set -- ) ;
GENERIC: add-atom ( a disjoint-set -- )
M: disjoint-set add-atom
[ dupd parents>> set-at ]
@ -61,24 +61,24 @@ M: disjoint-set add-atom
: add-atoms ( seq disjoint-set -- ) $[ _ add-atom ] each ;
GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) ;
GENERIC: disjoint-set-member? ( a disjoint-set -- ? )
M: disjoint-set disjoint-set-member? parents>> key? ;
GENERIC: disjoint-set-members ( disjoint-set -- seq ) ;
GENERIC: disjoint-set-members ( disjoint-set -- seq )
M: disjoint-set disjoint-set-members parents>> keys ;
GENERIC: equiv-set-size ( a disjoint-set -- n ) ;
GENERIC: equiv-set-size ( a disjoint-set -- n )
M: disjoint-set equiv-set-size
[ representative ] keep counts>> at ;
GENERIC: equiv? ( a b disjoint-set -- ? ) ;
GENERIC: equiv? ( a b disjoint-set -- ? )
M: disjoint-set equiv? representatives = ;
GENERIC: equate ( a b disjoint-set -- ) ;
GENERIC: equate ( a b disjoint-set -- )
M:: disjoint-set equate ( a b disjoint-set -- )
a b disjoint-set representatives

View File

@ -211,7 +211,7 @@ PRIVATE>
: push-sorted ( obj dlist -- dlist-node )
dupd [ before? ] with push-before ; inline
INSTANCE: dlist deque ;
INSTANCE: dlist deque
SYNTAX: \ DL{ \ } [ >dlist ] parse-literal ;

View File

@ -16,7 +16,7 @@ IN: documents
TUPLE: edit old-string new-string from old-to new-to ;
C: <edit> edit ;
C: <edit> edit
TUPLE: document < model locs undos redos inside-undo? ;
@ -67,7 +67,7 @@ TUPLE: document < model locs undos redos inside-undo? ;
: last-line# ( document -- line )
value>> length 1 - ;
CONSTANT: doc-start { 0 0 } ;
CONSTANT: doc-start { 0 0 }
: doc-end ( document -- loc )
[ last-line# ] keep line-end ;

View File

@ -4,8 +4,8 @@ USING: arrays combinators documents fry kernel math sequences
accessors unicode combinators.short-circuit ;
IN: documents.elements
GENERIC: prev-elt ( loc document elt -- newloc ) ;
GENERIC: next-elt ( loc document elt -- newloc ) ;
GENERIC: prev-elt ( loc document elt -- newloc )
GENERIC: next-elt ( loc document elt -- newloc )
: prev/next-elt ( loc document elt -- start end )
[ prev-elt ] [ next-elt ] 3bi ;
@ -108,7 +108,7 @@ M: one-line-elt next-elt
TUPLE: page-elt { lines read-only } ;
C: <page-elt> page-elt ;
C: <page-elt> page-elt
M: page-elt prev-elt
nip
@ -119,7 +119,7 @@ M: page-elt next-elt
3dup [ first ] [ last-line# ] [ lines>> ] tri* - >
[ drop nip doc-end ] [ nip lines>> +line ] if ;
CONSTANT: line-elt T{ page-elt f 1 } ;
CONSTANT: line-elt T{ page-elt f 1 }
SINGLETON: doc-elt

View File

@ -4,7 +4,7 @@ IN: env
SINGLETON: env
INSTANCE: env assoc ;
INSTANCE: env assoc
M: env at*
drop os-env dup >boolean ;

View File

@ -26,19 +26,19 @@ MACRO: nclump-map-as ( seq quot exemplar n -- result )
{ } swap nclump-map-as ; inline
TUPLE: head-clumps seq ;
C: <head-clumps> head-clumps ;
C: <head-clumps> head-clumps
M: head-clumps length seq>> length ;
M: head-clumps nth-unsafe seq>> swap 1 + head-slice ;
INSTANCE: head-clumps immutable-sequence ;
INSTANCE: head-clumps immutable-sequence
: head-clump ( seq -- array )
[ <head-clumps> ] [ [ like ] curry map ] bi ;
TUPLE: tail-clumps seq ;
C: <tail-clumps> tail-clumps ;
C: <tail-clumps> tail-clumps
M: tail-clumps length seq>> length ;
M: tail-clumps nth-unsafe seq>> swap tail-slice ;
INSTANCE: tail-clumps immutable-sequence ;
INSTANCE: tail-clumps immutable-sequence
: tail-clump ( seq -- array )
[ <tail-clumps> ] [ [ like ] curry map ] bi ;

View File

@ -1,13 +1,13 @@
USING: hash-sets.identity kernel literals sets tools.test ;
IN: hash-sets.identity.tests
CONSTANT: the-real-slim-shady "marshall mathers" ;
CONSTANT: the-real-slim-shady "marshall mathers"
CONSTANT: will
IHS{
$\ the-real-slim-shady
"marshall mathers"
} ;
}
: please-stand-up ( set obj -- ? )
swap in? ;
@ -21,7 +21,7 @@ CONSTANT: will
[ delete ] [ members ] bi
] unit-test
CONSTANT: same-as-it-ever-was "same as it ever was" ;
CONSTANT: same-as-it-ever-was "same as it ever was"
{ IHS{ $\ same-as-it-ever-was } }
[ HS{ $\ same-as-it-ever-was } IHS{ } set-like ] unit-test

View File

@ -8,7 +8,7 @@ IN: hash-sets.numbers
TUPLE: number-wrapper < wrapped-key ;
C: <number-wrapper> number-wrapper ;
C: <number-wrapper> number-wrapper
M: number-wrapper equal?
over number-wrapper?

View File

@ -8,7 +8,7 @@ IN: hash-sets.sequences
TUPLE: sequence-wrapper < wrapped-key ;
C: <sequence-wrapper> sequence-wrapper ;
C: <sequence-wrapper> sequence-wrapper
M: sequence-wrapper equal?
over sequence-wrapper?

View File

@ -12,7 +12,7 @@ TUPLE: wrapped-key
TUPLE: wrapped-hash-set
{ underlying hash-set read-only } ;
GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) ;
GENERIC: wrap-key ( key wrapped-hash -- wrapped-key )
PRIVATE<
@ -45,6 +45,6 @@ M: wrapped-hash-set members
M: wrapped-hash-set equal?
over wrapped-hash-set? [ [ underlying>> ] same? ] [ 2drop f ] if ;
INSTANCE: wrapped-hash-set set ;
INSTANCE: wrapped-hash-set set
{ "hash-sets.wrapped" "prettyprint" } "hash-sets.wrapped.prettyprint" require-when

View File

@ -9,7 +9,7 @@ IN: hashtables.numbers
TUPLE: number-wrapper < wrapped-key ;
C: <number-wrapper> number-wrapper ;
C: <number-wrapper> number-wrapper
M: number-wrapper equal?
over number-wrapper?

View File

@ -8,7 +8,7 @@ IN: hashtables.sequences
TUPLE: sequence-wrapper < wrapped-key ;
C: <sequence-wrapper> sequence-wrapper ;
C: <sequence-wrapper> sequence-wrapper
M: sequence-wrapper equal?
over sequence-wrapper?

View File

@ -6,13 +6,13 @@ math math.order math.private sequences sequences.private summary
vectors ;
IN: heaps
GENERIC: heap-push* ( value key heap -- entry ) ;
GENERIC: heap-peek ( heap -- value key ) ;
GENERIC: heap-pop* ( heap -- ) ;
GENERIC: heap-pop ( heap -- value key ) ;
GENERIC: heap-delete ( entry heap -- ) ;
GENERIC: heap-empty? ( heap -- ? ) ;
GENERIC: heap-size ( heap -- n ) ;
GENERIC: heap-push* ( value key heap -- entry )
GENERIC: heap-peek ( heap -- value key )
GENERIC: heap-pop* ( heap -- )
GENERIC: heap-pop ( heap -- value key )
GENERIC: heap-delete ( entry heap -- )
GENERIC: heap-empty? ( heap -- ? )
GENERIC: heap-size ( heap -- n )
PRIVATE<
@ -71,7 +71,7 @@ PRIVATE<
[ heap-size [ >>index ] keep ]
[ data>> [ set-nth ] 2keep drop ] bi ; inline
GENERIC: heap-compare ( entry1 entry2 heap -- ? ) ;
GENERIC: heap-compare ( entry1 entry2 heap -- ? )
M: min-heap heap-compare
drop { entry entry } declare [ key>> ] bi@ after? ; inline

View File

@ -8,9 +8,9 @@ TUPLE: interval-map { array array read-only } ;
PRIVATE<
ALIAS: start first-unsafe ;
ALIAS: end second-unsafe ;
ALIAS: value third-unsafe ;
ALIAS: start first-unsafe
ALIAS: end second-unsafe
ALIAS: value third-unsafe
: find-interval ( key interval-map -- interval-node )
array>> [ start <=> ] with search nip ; inline

View File

@ -8,7 +8,7 @@ IN: interval-sets.tests
{ f } [ 2 T{ interval-set } in? ] unit-test
CONSTANT: i1 $$[
{ { 3 4 } } <interval-set> ] ;
{ { 3 4 } } <interval-set> ]
{ f } [ 2 i1 in? ] unit-test
{ t } [ 3 i1 in? ] unit-test
@ -17,7 +17,7 @@ CONSTANT: i1 $$[
CONSTANT: i2 $$[
{ { 3 4 } } <interval-set>
0x10FFFF <interval-not> ] ; ! unicode-max
0x10FFFF <interval-not> ] ! unicode-max
{ t } [ 2 i2 in? ] unit-test
{ f } [ 3 i2 in? ] unit-test
@ -27,7 +27,7 @@ CONSTANT: i2 $$[
CONSTANT: i3 $$[
{ { 2 4 } } <interval-set>
{ { 6 8 } } <interval-set>
<interval-or> ] ;
<interval-or> ]
{ f } [ 1 i3 in? ] unit-test
{ t } [ 2 i3 in? ] unit-test
@ -42,7 +42,7 @@ CONSTANT: i3 $$[
CONSTANT: i4 $$[
{ { 2 4 } } <interval-set>
{ { 6 8 } } <interval-set>
<interval-and> ] ;
<interval-and> ]
{ f } [ 1 i4 in? ] unit-test
{ f } [ 2 i4 in? ] unit-test
@ -57,7 +57,7 @@ CONSTANT: i4 $$[
CONSTANT: i5 $$[
{ { 2 5 } } <interval-set>
{ { 4 8 } } <interval-set>
<interval-or> ] ;
<interval-or> ]
{ f } [ 1 i5 in? ] unit-test
{ t } [ 2 i5 in? ] unit-test
@ -72,7 +72,7 @@ CONSTANT: i5 $$[
CONSTANT: i6 $$[
{ { 2 5 } } <interval-set>
{ { 4 8 } } <interval-set>
<interval-and> ] ;
<interval-and> ]
{ f } [ 1 i6 in? ] unit-test
{ f } [ 2 i6 in? ] unit-test

View File

@ -29,8 +29,8 @@ PRIVATE<
: spec>pairs ( sequence -- intervals )
[ dup number? [ dup 2array ] when ] map ;
ALIAS: start first-unsafe ;
ALIAS: end second-unsafe ;
ALIAS: start first-unsafe
ALIAS: end second-unsafe
: disjoint? ( node1 node2 -- ? )
[ end ] [ start ] bi* < ;

View File

@ -11,43 +11,43 @@ TYPEDEF: void* acl_entry_t ;
TYPEDEF: void* acl_permset_t ;
TYPEDEF: void* acl_flagset_t ;
CONSTANT: KAUTH_GUID_SIZE 16 ;
CONSTANT: KAUTH_GUID_SIZE 16
CONSTANT: ACL_MAX_ENTRIES 128 ;
CONSTANT: ACL_MAX_ENTRIES 128
! acl_entry_id_t
CONSTANT: ACL_FIRST_ENTRY 0 ;
CONSTANT: ACL_NEXT_ENTRY -1 ;
CONSTANT: ACL_LAST_ENTRY -2 ;
CONSTANT: ACL_FIRST_ENTRY 0
CONSTANT: ACL_NEXT_ENTRY -1
CONSTANT: ACL_LAST_ENTRY -2
! acl_type_t Supported:
CONSTANT: ACL_TYPE_EXTENDED 0x00000100 ;
CONSTANT: ACL_TYPE_EXTENDED 0x00000100
! acl_type_t Unsupported:
CONSTANT: ACL_TYPE_ACCESS 0x00000000 ;
CONSTANT: ACL_TYPE_DEFAULT 0x00000001 ;
CONSTANT: ACL_TYPE_AFS 0x00000002 ;
CONSTANT: ACL_TYPE_CODA 0x00000003 ;
CONSTANT: ACL_TYPE_NTFS 0x00000004 ;
CONSTANT: ACL_TYPE_NWFS 0x00000005 ;
CONSTANT: ACL_TYPE_ACCESS 0x00000000
CONSTANT: ACL_TYPE_DEFAULT 0x00000001
CONSTANT: ACL_TYPE_AFS 0x00000002
CONSTANT: ACL_TYPE_CODA 0x00000003
CONSTANT: ACL_TYPE_NTFS 0x00000004
CONSTANT: ACL_TYPE_NWFS 0x00000005
! acl_perm_t
CONSTANT: ACL_READ_DATA 2 ;
CONSTANT: ACL_LIST_DIRECTORY 2 ;
CONSTANT: ACL_WRITE_DATA 4 ;
CONSTANT: ACL_ADD_FILE 4 ;
CONSTANT: ACL_EXECUTE 8 ;
CONSTANT: ACL_SEARCH 8 ;
CONSTANT: ACL_DELETE 16 ;
CONSTANT: ACL_APPEND_DATA 32 ;
CONSTANT: ACL_ADD_SUBDIRECTORY 32 ;
CONSTANT: ACL_DELETE_CHILD 64 ;
CONSTANT: ACL_READ_ATTRIBUTES 128 ;
CONSTANT: ACL_WRITE_ATTRIBUTES 256 ;
CONSTANT: ACL_READ_EXTATTRIBUTES 512 ;
CONSTANT: ACL_WRITE_EXTATTRIBUTES 1024 ;
CONSTANT: ACL_READ_SECURITY 2048 ;
CONSTANT: ACL_WRITE_SECURITY 4096 ;
CONSTANT: ACL_CHANGE_OWNER 8192 ;
CONSTANT: ACL_READ_DATA 2
CONSTANT: ACL_LIST_DIRECTORY 2
CONSTANT: ACL_WRITE_DATA 4
CONSTANT: ACL_ADD_FILE 4
CONSTANT: ACL_EXECUTE 8
CONSTANT: ACL_SEARCH 8
CONSTANT: ACL_DELETE 16
CONSTANT: ACL_APPEND_DATA 32
CONSTANT: ACL_ADD_SUBDIRECTORY 32
CONSTANT: ACL_DELETE_CHILD 64
CONSTANT: ACL_READ_ATTRIBUTES 128
CONSTANT: ACL_WRITE_ATTRIBUTES 256
CONSTANT: ACL_READ_EXTATTRIBUTES 512
CONSTANT: ACL_WRITE_EXTATTRIBUTES 1024
CONSTANT: ACL_READ_SECURITY 2048
CONSTANT: ACL_WRITE_SECURITY 4096
CONSTANT: ACL_CHANGE_OWNER 8192
CONSTANT: acl-perms $${
ACL_READ_DATA ACL_LIST_DIRECTORY ACL_WRITE_DATA ACL_ADD_FILE
@ -55,7 +55,7 @@ CONSTANT: acl-perms $${
ACL_DELETE_CHILD ACL_READ_ATTRIBUTES ACL_WRITE_ATTRIBUTES
ACL_READ_EXTATTRIBUTES ACL_WRITE_EXTATTRIBUTES
ACL_READ_SECURITY ACL_WRITE_SECURITY ACL_CHANGE_OWNER
} ;
}
CONSTANT: acl-perm-names
{
@ -63,16 +63,16 @@ CONSTANT: acl-perm-names
"delete" "append" "add_subdirectory" "delete_child"
"readattr" "writeattr" "readextattr" "writeextattr"
"readsecurity" "writesecurity" "chown"
} ;
}
CONSTANT: acl-file-perm { t f t f t f t t f f t t t t t t t } ;
CONSTANT: acl-dir-perm { f t f t f t t f t t t t t t t t t } ;
CONSTANT: acl-file-perm { t f t f t f t t f f t t t t t t t }
CONSTANT: acl-dir-perm { f t f t f t t f t t t t t t t t t }
! acl_tag_t
TYPEDEF: uint acl_tag_t ;
CONSTANT: ACL_UNDEFINED_TAG 0 ;
CONSTANT: ACL_EXTENDED_ALLOW 1 ;
CONSTANT: ACL_EXTENDED_DENY 2 ;
CONSTANT: ACL_UNDEFINED_TAG 0
CONSTANT: ACL_EXTENDED_ALLOW 1
CONSTANT: ACL_EXTENDED_DENY 2
ERROR: bad-acl-tag-t n ;
@ -82,26 +82,26 @@ ERROR: bad-acl-tag-t n ;
! acl_flag_t
TYPEDEF: int acl_flag_t ;
CONSTANT: ACL_FLAG_DEFER_INHERIT 1 ;
CONSTANT: ACL_ENTRY_INHERITED 16 ;
CONSTANT: ACL_ENTRY_FILE_INHERIT 32 ;
CONSTANT: ACL_ENTRY_DIRECTORY_INHERIT 64 ;
CONSTANT: ACL_ENTRY_LIMIT_INHERIT 128 ;
CONSTANT: ACL_ENTRY_ONLY_INHERIT 256 ;
CONSTANT: ACL_FLAG_DEFER_INHERIT 1
CONSTANT: ACL_ENTRY_INHERITED 16
CONSTANT: ACL_ENTRY_FILE_INHERIT 32
CONSTANT: ACL_ENTRY_DIRECTORY_INHERIT 64
CONSTANT: ACL_ENTRY_LIMIT_INHERIT 128
CONSTANT: ACL_ENTRY_ONLY_INHERIT 256
CONSTANT: acl-flags $${
ACL_ENTRY_FILE_INHERIT
ACL_ENTRY_DIRECTORY_INHERIT
ACL_ENTRY_LIMIT_INHERIT
ACL_ENTRY_ONLY_INHERIT
} ;
}
CONSTANT: acl-flag-names {
"file_inherit"
"directory_inherit"
"limit_inherit"
"only_inherit"
} ;
}
STRUCT: guid_t
{ g_guid { uchar KAUTH_GUID_SIZE } } ;
@ -158,16 +158,16 @@ FUNCTION: int acl_get_tag_type ( acl_entry_t entry_d, acl_tag_t *tag_type_p ) ;
TYPEDEF: uchar[16] uuid_t ;
CONSTANT: ID_TYPE_UID 0 ;
CONSTANT: ID_TYPE_GID 1 ;
CONSTANT: ID_TYPE_SID 3 ;
CONSTANT: ID_TYPE_USERNAME 4 ;
CONSTANT: ID_TYPE_GROUPNAME 5 ;
CONSTANT: ID_TYPE_GSS_EXPORT_NAME 10 ;
CONSTANT: ID_TYPE_X509_DN 11 ;
CONSTANT: ID_TYPE_KERBEROS 12 ;
CONSTANT: ID_TYPE_UID 0
CONSTANT: ID_TYPE_GID 1
CONSTANT: ID_TYPE_SID 3
CONSTANT: ID_TYPE_USERNAME 4
CONSTANT: ID_TYPE_GROUPNAME 5
CONSTANT: ID_TYPE_GSS_EXPORT_NAME 10
CONSTANT: ID_TYPE_X509_DN 11
CONSTANT: ID_TYPE_KERBEROS 12
CONSTANT: NTSID_MAX_AUTHORITIES 16 ;
CONSTANT: NTSID_MAX_AUTHORITIES 16
! FIXME: Supposed to be packed
STRUCT: nt_sid_t

View File

@ -15,16 +15,16 @@ TYPEDEF: SInt32 OSStatus ;
TYPEDEF: UInt32 OptionBits ;
CONSTANT: noErr 0 ;
CONSTANT: noErr 0
CONSTANT: kFSFileOperationDefaultOptions 0x00 ;
CONSTANT: kFSFileOperationOverwrite 0x01 ;
CONSTANT: kFSFileOperationSkipSourcePermissionErrors 0x02 ;
CONSTANT: kFSFileOperationDoNotMoveAcrossVolumes 0x04 ;
CONSTANT: kFSFileOperationSkipPreflight 0x08 ;
CONSTANT: kFSFileOperationDefaultOptions 0x00
CONSTANT: kFSFileOperationOverwrite 0x01
CONSTANT: kFSFileOperationSkipSourcePermissionErrors 0x02
CONSTANT: kFSFileOperationDoNotMoveAcrossVolumes 0x04
CONSTANT: kFSFileOperationSkipPreflight 0x08
CONSTANT: kFSPathMakeRefDefaultOptions 0x00 ;
CONSTANT: kFSPathMakeRefDoNotFollowLeafSymlink 0x01 ;
CONSTANT: kFSPathMakeRefDefaultOptions 0x00
CONSTANT: kFSPathMakeRefDoNotFollowLeafSymlink 0x01
FUNCTION: OSStatus FSMoveObjectToTrashSync (
FSRef* source,

View File

@ -5,7 +5,7 @@ USING: combinators system vocabs ;
IN: io.files.trash
HOOK: send-to-trash os ( path -- ) ;
HOOK: send-to-trash os ( path -- )
{
{ [ os windows? ] [ "io.files.trash.windows" ] }

View File

@ -26,27 +26,27 @@ PACKED-STRUCT: SHFILEOPSTRUCTW
FUNCTION: int SHFileOperationW ( SHFILEOPSTRUCTW* lpFileOp ) ;
CONSTANT: FO_MOVE 0x0001 ;
CONSTANT: FO_COPY 0x0002 ;
CONSTANT: FO_DELETE 0x0003 ;
CONSTANT: FO_RENAME 0x0004 ;
CONSTANT: FO_MOVE 0x0001
CONSTANT: FO_COPY 0x0002
CONSTANT: FO_DELETE 0x0003
CONSTANT: FO_RENAME 0x0004
CONSTANT: FOF_MULTIDESTFILES 0x0001 ;
CONSTANT: FOF_CONFIRMMOUSE 0x0002 ;
CONSTANT: FOF_SILENT 0x0004 ;
CONSTANT: FOF_RENAMEONCOLLISION 0x0008 ;
CONSTANT: FOF_NOCONFIRMATION 0x0010 ;
CONSTANT: FOF_WANTMAPPINGHANDLE 0x0020 ;
CONSTANT: FOF_ALLOWUNDO 0x0040 ;
CONSTANT: FOF_FILESONLY 0x0080 ;
CONSTANT: FOF_SIMPLEPROGRESS 0x0100 ;
CONSTANT: FOF_NOCONFIRMMKDIR 0x0200 ;
CONSTANT: FOF_NOERRORUI 0x0400 ;
CONSTANT: FOF_NOCOPYSECURITYATTRIBS 0x0800 ;
CONSTANT: FOF_NORECURSION 0x1000 ;
CONSTANT: FOF_NO_CONNECTED_ELEMENTS 0x2000 ;
CONSTANT: FOF_WANTNUKEWARNING 0x4000 ;
CONSTANT: FOF_NORECURSEREPARSE 0x8000 ;
CONSTANT: FOF_MULTIDESTFILES 0x0001
CONSTANT: FOF_CONFIRMMOUSE 0x0002
CONSTANT: FOF_SILENT 0x0004
CONSTANT: FOF_RENAMEONCOLLISION 0x0008
CONSTANT: FOF_NOCONFIRMATION 0x0010
CONSTANT: FOF_WANTMAPPINGHANDLE 0x0020
CONSTANT: FOF_ALLOWUNDO 0x0040
CONSTANT: FOF_FILESONLY 0x0080
CONSTANT: FOF_SIMPLEPROGRESS 0x0100
CONSTANT: FOF_NOCONFIRMMKDIR 0x0200
CONSTANT: FOF_NOERRORUI 0x0400
CONSTANT: FOF_NOCOPYSECURITYATTRIBS 0x0800
CONSTANT: FOF_NORECURSION 0x1000
CONSTANT: FOF_NO_CONNECTED_ELEMENTS 0x2000
CONSTANT: FOF_WANTNUKEWARNING 0x4000
CONSTANT: FOF_NORECURSEREPARSE 0x8000
PRIVATE>

View File

@ -4,7 +4,7 @@ USING: alien.c-types alien.syntax assocs classes.struct
io.serial kernel system ;
IN: io.serial.linux.ffi
CONSTANT: NCCS 32 ;
CONSTANT: NCCS 32
TYPEDEF: uchar cc_t ;
TYPEDEF: uint speed_t ;
@ -34,115 +34,115 @@ FUNCTION: void cfmakeraw ( termios* t ) ;
FUNCTION: int cfsetspeed ( termios* t, speed_t s ) ;
! See /usr/include/bits/termios.h
CONSTANT: TCSANOW 0 ;
CONSTANT: TCSADRAIN 1 ;
CONSTANT: TCSAFLUSH 2 ;
CONSTANT: TCSANOW 0
CONSTANT: TCSADRAIN 1
CONSTANT: TCSAFLUSH 2
CONSTANT: TCIFLUSH 0 ;
CONSTANT: TCOFLUSH 1 ;
CONSTANT: TCIOFLUSH 2 ;
CONSTANT: TCIFLUSH 0
CONSTANT: TCOFLUSH 1
CONSTANT: TCIOFLUSH 2
CONSTANT: TCOOFF 0 ;
CONSTANT: TCOON 1 ;
CONSTANT: TCIOFF 2 ;
CONSTANT: TCION 3 ;
CONSTANT: TCOOFF 0
CONSTANT: TCOON 1
CONSTANT: TCIOFF 2
CONSTANT: TCION 3
! iflag
CONSTANT: IGNBRK 0o0000001 ;
CONSTANT: BRKINT 0o0000002 ;
CONSTANT: IGNPAR 0o0000004 ;
CONSTANT: PARMRK 0o0000010 ;
CONSTANT: INPCK 0o0000020 ;
CONSTANT: ISTRIP 0o0000040 ;
CONSTANT: INLCR 0o0000100 ;
CONSTANT: IGNCR 0o0000200 ;
CONSTANT: ICRNL 0o0000400 ;
CONSTANT: IUCLC 0o0001000 ;
CONSTANT: IXON 0o0002000 ;
CONSTANT: IXANY 0o0004000 ;
CONSTANT: IXOFF 0o0010000 ;
CONSTANT: IMAXBEL 0o0020000 ;
CONSTANT: IUTF8 0o0040000 ;
CONSTANT: IGNBRK 0o0000001
CONSTANT: BRKINT 0o0000002
CONSTANT: IGNPAR 0o0000004
CONSTANT: PARMRK 0o0000010
CONSTANT: INPCK 0o0000020
CONSTANT: ISTRIP 0o0000040
CONSTANT: INLCR 0o0000100
CONSTANT: IGNCR 0o0000200
CONSTANT: ICRNL 0o0000400
CONSTANT: IUCLC 0o0001000
CONSTANT: IXON 0o0002000
CONSTANT: IXANY 0o0004000
CONSTANT: IXOFF 0o0010000
CONSTANT: IMAXBEL 0o0020000
CONSTANT: IUTF8 0o0040000
! oflag
CONSTANT: OPOST 0o0000001 ;
CONSTANT: OLCUC 0o0000002 ;
CONSTANT: ONLCR 0o0000004 ;
CONSTANT: OCRNL 0o0000010 ;
CONSTANT: ONOCR 0o0000020 ;
CONSTANT: ONLRET 0o0000040 ;
CONSTANT: OFILL 0o0000100 ;
CONSTANT: OFDEL 0o0000200 ;
CONSTANT: NLDLY 0o0000400 ;
CONSTANT: NL0 0o0000000 ;
CONSTANT: NL1 0o0000400 ;
CONSTANT: CRDLY 0o0003000 ;
CONSTANT: CR0 0o0000000 ;
CONSTANT: CR1 0o0001000 ;
CONSTANT: CR2 0o0002000 ;
CONSTANT: CR3 0o0003000 ;
CONSTANT: TABDLY 0o0014000 ;
CONSTANT: TAB0 0o0000000 ;
CONSTANT: TAB1 0o0004000 ;
CONSTANT: TAB2 0o0010000 ;
CONSTANT: TAB3 0o0014000 ;
CONSTANT: BSDLY 0o0020000 ;
CONSTANT: BS0 0o0000000 ;
CONSTANT: BS1 0o0020000 ;
CONSTANT: FFDLY 0o0100000 ;
CONSTANT: FF0 0o0000000 ;
CONSTANT: FF1 0o0100000 ;
CONSTANT: OPOST 0o0000001
CONSTANT: OLCUC 0o0000002
CONSTANT: ONLCR 0o0000004
CONSTANT: OCRNL 0o0000010
CONSTANT: ONOCR 0o0000020
CONSTANT: ONLRET 0o0000040
CONSTANT: OFILL 0o0000100
CONSTANT: OFDEL 0o0000200
CONSTANT: NLDLY 0o0000400
CONSTANT: NL0 0o0000000
CONSTANT: NL1 0o0000400
CONSTANT: CRDLY 0o0003000
CONSTANT: CR0 0o0000000
CONSTANT: CR1 0o0001000
CONSTANT: CR2 0o0002000
CONSTANT: CR3 0o0003000
CONSTANT: TABDLY 0o0014000
CONSTANT: TAB0 0o0000000
CONSTANT: TAB1 0o0004000
CONSTANT: TAB2 0o0010000
CONSTANT: TAB3 0o0014000
CONSTANT: BSDLY 0o0020000
CONSTANT: BS0 0o0000000
CONSTANT: BS1 0o0020000
CONSTANT: FFDLY 0o0100000
CONSTANT: FF0 0o0000000
CONSTANT: FF1 0o0100000
! cflags
CONSTANT: CSIZE 0o0000060 ;
CONSTANT: CS5 0o0000000 ;
CONSTANT: CS6 0o0000020 ;
CONSTANT: CS7 0o0000040 ;
CONSTANT: CS8 0o0000060 ;
CONSTANT: CSTOPB 0o0000100 ;
CONSTANT: CREAD 0o0000200 ;
CONSTANT: PARENB 0o0000400 ;
CONSTANT: PARODD 0o0001000 ;
CONSTANT: HUPCL 0o0002000 ;
CONSTANT: CLOCAL 0o0004000 ;
CONSTANT: CIBAUD 0o002003600000 ;
CONSTANT: CRTSCTS 0o020000000000 ;
CONSTANT: CSIZE 0o0000060
CONSTANT: CS5 0o0000000
CONSTANT: CS6 0o0000020
CONSTANT: CS7 0o0000040
CONSTANT: CS8 0o0000060
CONSTANT: CSTOPB 0o0000100
CONSTANT: CREAD 0o0000200
CONSTANT: PARENB 0o0000400
CONSTANT: PARODD 0o0001000
CONSTANT: HUPCL 0o0002000
CONSTANT: CLOCAL 0o0004000
CONSTANT: CIBAUD 0o002003600000
CONSTANT: CRTSCTS 0o020000000000
! lflags
CONSTANT: ISIG 0o0000001 ;
CONSTANT: ICANON 0o0000002 ;
CONSTANT: XCASE 0o0000004 ;
CONSTANT: ECHO 0o0000010 ;
CONSTANT: ECHOE 0o0000020 ;
CONSTANT: ECHOK 0o0000040 ;
CONSTANT: ECHONL 0o0000100 ;
CONSTANT: NOFLSH 0o0000200 ;
CONSTANT: TOSTOP 0o0000400 ;
CONSTANT: ECHOCTL 0o0001000 ;
CONSTANT: ECHOPRT 0o0002000 ;
CONSTANT: ECHOKE 0o0004000 ;
CONSTANT: FLUSHO 0o0010000 ;
CONSTANT: PENDIN 0o0040000 ;
CONSTANT: IEXTEN 0o0100000 ;
CONSTANT: ISIG 0o0000001
CONSTANT: ICANON 0o0000002
CONSTANT: XCASE 0o0000004
CONSTANT: ECHO 0o0000010
CONSTANT: ECHOE 0o0000020
CONSTANT: ECHOK 0o0000040
CONSTANT: ECHONL 0o0000100
CONSTANT: NOFLSH 0o0000200
CONSTANT: TOSTOP 0o0000400
CONSTANT: ECHOCTL 0o0001000
CONSTANT: ECHOPRT 0o0002000
CONSTANT: ECHOKE 0o0004000
CONSTANT: FLUSHO 0o0010000
CONSTANT: PENDIN 0o0040000
CONSTANT: IEXTEN 0o0100000
! c_cc characters
CONSTANT: VINTR 0 ;
CONSTANT: VQUIT 1 ;
CONSTANT: VERASE 2 ;
CONSTANT: VKILL 3 ;
CONSTANT: VEOF 4 ;
CONSTANT: VTIME 5 ;
CONSTANT: VMIN 6 ;
CONSTANT: VSWTC 7 ;
CONSTANT: VSTART 8 ;
CONSTANT: VSTOP 9 ;
CONSTANT: VSUSP 10 ;
CONSTANT: VEOL 11 ;
CONSTANT: VREPRINT 12 ;
CONSTANT: VDISCARD 13 ;
CONSTANT: VWERASE 14 ;
CONSTANT: VLNEXT 15 ;
CONSTANT: VEOL2 16 ;
CONSTANT: VINTR 0
CONSTANT: VQUIT 1
CONSTANT: VERASE 2
CONSTANT: VKILL 3
CONSTANT: VEOF 4
CONSTANT: VTIME 5
CONSTANT: VMIN 6
CONSTANT: VSWTC 7
CONSTANT: VSTART 8
CONSTANT: VSTOP 9
CONSTANT: VSUSP 10
CONSTANT: VEOL 11
CONSTANT: VREPRINT 12
CONSTANT: VDISCARD 13
CONSTANT: VWERASE 14
CONSTANT: VLNEXT 15
CONSTANT: VEOL2 16
M: linux lookup-baud ( n -- n )
H{

View File

@ -12,9 +12,9 @@ M: invalid-baud summary ( invalid-baud -- string )
baud>> number>string
"Baud rate " " not supported" surround ;
HOOK: lookup-baud os ( m -- n ) ;
HOOK: open-serial os ( serial -- serial' ) ;
HOOK: default-serial-flags os ( m -- n ) ;
HOOK: lookup-baud os ( m -- n )
HOOK: open-serial os ( serial -- serial' )
HOOK: default-serial-flags os ( m -- n )
M: serial-port dispose* ( serial -- ) stream>> dispose ;
: <serial-port> ( path baud -- obj )

View File

@ -10,7 +10,7 @@ IN: io.streams.256color
PRIVATE<
CONSTANT: intensities { 0x00 0x5F 0x87 0xAF 0xD7 0xFF } ;
CONSTANT: intensities { 0x00 0x5F 0x87 0xAF 0xD7 0xFF }
CONSTANT: 256colors H{
@ -33,7 +33,7 @@ CONSTANT: 256colors H{
{ { 255 0 255 } 13 }
{ { 0 255 255 } 14 }
{ { 255 255 255 } 15 }
} ;
}
! Add the RGB colors
intensities |[ r i |
@ -75,7 +75,7 @@ intensities |[ r i |
TUPLE: 256color stream ;
C: <256color> 256color ;
C: <256color> 256color
M: 256color stream-write1 stream>> stream-write1 ;
M: 256color stream-write stream>> stream-write ;

View File

@ -30,7 +30,7 @@ CONSTANT: colors H{
{ { 255 85 255 } 13 }
{ { 85 255 255 } 14 }
{ { 255 255 255 } 15 }
} ;
}
: color>rgb ( color -- rgb )
[ red>> ] [ green>> ] [ blue>> ] tri
@ -56,7 +56,7 @@ CONSTANT: colors H{
TUPLE: ansi stream ;
C: <ansi> ansi ;
C: <ansi> ansi
M: ansi stream-write1 stream>> stream-write1 ;
M: ansi stream-write stream>> stream-write ;

View File

@ -6,8 +6,8 @@ sequences vectors ;
IN: io.streams.peek
TUPLE: peek-stream stream peeked ;
INSTANCE: peek-stream input-stream ;
INSTANCE: peek-stream output-stream ;
INSTANCE: peek-stream input-stream
INSTANCE: peek-stream output-stream
M: peek-stream dispose stream>> dispose ;

View File

@ -7,7 +7,7 @@ IN: io.streams.random
TUPLE: random-stream ;
C: <random-stream> random-stream ;
C: <random-stream> random-stream
M: random-stream stream-element-type drop +byte+ ;
@ -20,7 +20,7 @@ M: random-stream stream-read-partial-unsafe stream-read-unsafe ;
M: random-stream dispose drop ;
INSTANCE: random-stream input-stream ;
INSTANCE: random-stream input-stream
: random-file ( n path -- )
[ <random-stream> swap limit-stream ]

View File

@ -6,7 +6,7 @@ IN: io.streams.zeros
TUPLE: zero-stream ;
C: <zero-stream> zero-stream ;
C: <zero-stream> zero-stream
M: zero-stream stream-element-type drop +byte+ ;
@ -19,7 +19,7 @@ M: zero-stream stream-read-partial-unsafe stream-read-unsafe ;
M: zero-stream dispose drop ;
INSTANCE: zero-stream input-stream ;
INSTANCE: zero-stream input-stream
PRIVATE<

View File

@ -48,7 +48,7 @@ M: linked-assoc clear-assoc
M: linked-assoc clone
[ assoc>> clone ] [ dlist>> clone ] bi linked-assoc boa ;
INSTANCE: linked-assoc assoc ;
INSTANCE: linked-assoc assoc
: >linked-hash ( assoc -- assoc )
[ <linked-hash> ] dip assoc-union! ;

View File

@ -43,7 +43,7 @@ M: linked-set equal?
: >linked-set ( set -- linked-set )
[ 0 <linked-set> ] dip union! ;
INSTANCE: linked-set set ;
INSTANCE: linked-set set
M: linked-set set-like
drop dup linked-set? [ >linked-set ] unless ;

View File

@ -12,7 +12,7 @@ M: promise nil? force nil? ;
TUPLE: lazy-cons-state { car promise } { cdr promise } ;
C: <lazy-cons-state> lazy-cons-state ;
C: <lazy-cons-state> lazy-cons-state
: lazy-cons ( car cdr -- promise )
[ <promise> ] bi@ <lazy-cons-state>
@ -64,7 +64,7 @@ M: memoized-cons nil?
TUPLE: lazy-map cons quot ;
C: <lazy-map> lazy-map ;
C: <lazy-map> lazy-map
: lmap-lazy ( list quot -- result )
over nil? [ 2drop nil ] [ <lazy-map> <memoized-cons> ] if ;
@ -80,7 +80,7 @@ M: lazy-map nil?
TUPLE: lazy-take n cons ;
C: <lazy-take> lazy-take ;
C: <lazy-take> lazy-take
: ltake ( n list -- result )
over zero? [ 2drop nil ] [ <lazy-take> ] if ;
@ -96,7 +96,7 @@ M: lazy-take nil?
TUPLE: lazy-until cons quot ;
C: <lazy-until> lazy-until ;
C: <lazy-until> lazy-until
: luntil ( list quot: ( elt -- ? ) -- result )
over nil? [ drop ] [ <lazy-until> ] if ;
@ -114,7 +114,7 @@ M: lazy-until nil?
TUPLE: lazy-while cons quot ;
C: <lazy-while> lazy-while ;
C: <lazy-while> lazy-while
: lwhile ( list quot: ( elt -- ? ) -- result )
over nil? [ drop ] [ <lazy-while> ] if ;
@ -130,7 +130,7 @@ M: lazy-while nil?
TUPLE: lazy-filter cons quot ;
C: <lazy-filter> lazy-filter ;
C: <lazy-filter> lazy-filter
: lfilter ( list quot: ( elt -- ? ) -- result )
over nil? [ 2drop nil ] [ <lazy-filter> <memoized-cons> ] if ;
@ -164,7 +164,7 @@ M: lazy-filter nil?
TUPLE: lazy-append list1 list2 ;
C: <lazy-append> lazy-append ;
C: <lazy-append> lazy-append
: lappend-lazy ( list1 list2 -- result )
over nil? [ nip ] [ <lazy-append> ] if ;
@ -196,7 +196,7 @@ M: lazy-from-by nil?
TUPLE: lazy-zip list1 list2 ;
C: <lazy-zip> lazy-zip ;
C: <lazy-zip> lazy-zip
: lzip ( list1 list2 -- result )
2dup [ nil? ] either?
@ -213,7 +213,7 @@ M: lazy-zip nil?
TUPLE: sequence-cons index seq ;
C: <sequence-cons> sequence-cons ;
C: <sequence-cons> sequence-cons
: sequence-tail>list ( index seq -- list )
2dup length >= [
@ -235,7 +235,7 @@ M: sequence >list 0 swap sequence-tail>list ;
TUPLE: lazy-concat car cdr ;
C: <lazy-concat> lazy-concat ;
C: <lazy-concat> lazy-concat
DEFER: lconcat
@ -302,7 +302,7 @@ PRIVATE>
TUPLE: lazy-io stream car cdr quot ;
C: <lazy-io> lazy-io ;
C: <lazy-io> lazy-io
: lcontents ( stream -- result )
f f [ stream-read1 ] <lazy-io> ;
@ -333,17 +333,17 @@ M: lazy-io cdr
M: lazy-io nil?
car nil? ;
INSTANCE: sequence-cons list ;
INSTANCE: memoized-cons list ;
INSTANCE: promise list ;
INSTANCE: lazy-io list ;
INSTANCE: lazy-concat list ;
INSTANCE: lazy-cons-state list ;
INSTANCE: lazy-map list ;
INSTANCE: lazy-take list ;
INSTANCE: lazy-append list ;
INSTANCE: lazy-from-by list ;
INSTANCE: lazy-zip list ;
INSTANCE: lazy-while list ;
INSTANCE: lazy-until list ;
INSTANCE: lazy-filter list ;
INSTANCE: sequence-cons list
INSTANCE: memoized-cons list
INSTANCE: promise list
INSTANCE: lazy-io list
INSTANCE: lazy-concat list
INSTANCE: lazy-cons-state list
INSTANCE: lazy-map list
INSTANCE: lazy-take list
INSTANCE: lazy-append list
INSTANCE: lazy-from-by list
INSTANCE: lazy-zip list
INSTANCE: lazy-while list
INSTANCE: lazy-until list
INSTANCE: lazy-filter list

View File

@ -6,13 +6,13 @@ IN: lists
! List Protocol
MIXIN: list
GENERIC: car ( cons -- car ) ;
GENERIC: cdr ( cons -- cdr ) ;
GENERIC: nil? ( object -- ? ) ;
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
GENERIC: nil? ( object -- ? )
TUPLE: cons-state { car read-only } { cdr read-only } ;
C: cons cons-state ;
C: cons cons-state
M: cons-state car ( cons -- car ) car>> ;
@ -96,9 +96,9 @@ PRIVATE>
: deeplist>array ( list -- array )
[ dup list? [ deeplist>array ] when ] lmap>array ;
INSTANCE: cons-state list ;
INSTANCE: +nil+ list ;
INSTANCE: cons-state list
INSTANCE: +nil+ list
GENERIC: >list ( object -- list ) ;
GENERIC: >list ( object -- list )
M: list >list ;

View File

@ -10,7 +10,7 @@ TUPLE: nibble-array
PRIVATE<
CONSTANT: nibble 0b1111 ;
CONSTANT: nibble 0b1111
: nibbles>bytes ( m -- n ) 1 + 2/ ; inline
@ -69,7 +69,7 @@ M: nibble-array byte-length length nibbles>bytes ;
SYNTAX: \ N{ \ } [ >nibble-array ] parse-literal ;
INSTANCE: nibble-array sequence ;
INSTANCE: nibble-array sequence
M: nibble-array pprint-delims drop \ N{ \ } ;
M: nibble-array >pprint-sequence ;

View File

@ -38,4 +38,4 @@ M: pair delete-at
M: pair >alist
[ hash>> >alist ] [ [ key>> ] [ value>> ] bi 2array ] bi suffix ; inline
INSTANCE: pair assoc ;
INSTANCE: pair assoc

View File

@ -3,11 +3,11 @@
USING: kernel assocs ;
IN: persistent.assocs
GENERIC: new-at ( value key assoc -- assoc' ) ;
GENERIC: new-at ( value key assoc -- assoc' )
M: assoc new-at clone [ set-at ] keep ;
GENERIC: pluck-at ( key assoc -- assoc' ) ;
GENERIC: pluck-at ( key assoc -- assoc' )
M: assoc pluck-at clone [ delete-at ] keep ;

View File

@ -4,6 +4,6 @@ USING: layouts kernel parser math math.bitwise sequences
literals ;
IN: persistent.hashtables.config
CONSTANT: radix-bits $$[ cell 4 = 4 5 ? ] ;
CONSTANT: radix-bits $$[ cell 4 = 4 5 ? ]
: radix-mask ( -- n ) radix-bits on-bits ; foldable
: full-bitmap-mask ( -- n ) radix-bits 2^ on-bits ; inline

View File

@ -11,13 +11,13 @@ TUPLE: leaf-node
{ key read-only }
{ hashcode fixnum read-only } ;
C: <leaf-node> leaf-node ;
C: <leaf-node> leaf-node
TUPLE: collision-node
{ hashcode fixnum read-only }
{ leaves array read-only } ;
C: <collision-node> collision-node ;
C: <collision-node> collision-node
TUPLE: full-node
{ nodes array read-only }
@ -38,13 +38,13 @@ TUPLE: bitmap-node
[ <full-node> nip ]
[ over first hashcode>> bitmap-node boa ] if ;
GENERIC: (entry-at) ( key hashcode node -- entry ) ;
GENERIC: (entry-at) ( key hashcode node -- entry )
GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf ) ;
GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf )
GENERIC: (pluck-at) ( key hashcode node -- node' ) ;
GENERIC: (pluck-at) ( key hashcode node -- node' )
GENERIC: >alist% ( node -- ) ;
GENERIC: >alist% ( node -- )
: >alist-each% ( nodes -- ) [ >alist% ] each ;

View File

@ -3,7 +3,7 @@ IN: persistent.heaps.tests
CONSTANT: test-input
{ { "hello" 3 } { "goodbye" 2 } { "whatever" 5 }
{ "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } ;
{ "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } }
{
{ { "baz" -7 } { "bar" -1 } { "bing" 0 } { "foo" 1 }

View File

@ -10,7 +10,7 @@ TUPLE: empty-heap ;
PREDICATE: singleton-heap < branch
[ left>> ] [ right>> ] bi [ empty-heap? ] both? ;
C: <branch> branch ;
C: <branch> branch
: >branch< ( branch -- value prio left right )
{ [ value>> ] [ prio>> ] [ left>> ] [ right>> ] } cleave ;
PRIVATE>
@ -34,7 +34,7 @@ PRIVATE<
: both-with? ( obj a b quot -- ? )
swap [ with ] dip swap both? ; inline
GENERIC: sift-down ( value prio left right -- heap ) ;
GENERIC: sift-down ( value prio left right -- heap )
: singleton-sift-down ( value prio singleton empty -- heap )
2over prio>> <= [ <branch> ] [
@ -61,11 +61,11 @@ M: branch sift-down ! both arguments are branches
] if ;
PRIVATE>
GENERIC: pheap-peek ( heap -- value prio ) ;
GENERIC: pheap-peek ( heap -- value prio )
M: empty-heap pheap-peek empty-pheap ;
M: branch pheap-peek [ value>> ] [ prio>> ] bi ;
GENERIC: pheap-push ( value prio heap -- newheap ) ;
GENERIC: pheap-push ( value prio heap -- newheap )
M: empty-heap pheap-push
drop <singleton-heap> ;

View File

@ -3,15 +3,15 @@
USING: sequences kernel ;
IN: persistent.sequences
GENERIC: ppush ( val seq -- seq' ) ;
GENERIC: ppush ( val seq -- seq' )
M: sequence ppush swap suffix ;
GENERIC: ppop ( seq -- seq' ) ;
GENERIC: ppop ( seq -- seq' )
M: sequence ppop but-last ;
GENERIC: new-nth ( val i seq -- seq' ) ;
GENERIC: new-nth ( val i seq -- seq' )
M: sequence new-nth clone [ set-nth ] keep ;

View File

@ -22,7 +22,7 @@ M: persistent-vector length count>> ;
PRIVATE<
CONSTANT: node-size 32 ;
CONSTANT: node-size 32
: node-mask ( m -- n ) node-size mod ; inline
@ -187,4 +187,4 @@ M: persistent-vector pprint-delims drop \ PV{ \ } ;
M: persistent-vector >pprint-sequence ;
M: persistent-vector pprint* pprint-object ;
INSTANCE: persistent-vector immutable-sequence ;
INSTANCE: persistent-vector immutable-sequence

View File

@ -179,7 +179,7 @@ PRIVATE>
M: quadtree equal? ( a b -- ? )
over quadtree? [ tree= ] [ 2drop f ] if ;
INSTANCE: quadtree assoc ;
INSTANCE: quadtree assoc
M: quadtree at* ( key assoc -- value/f ? ) at-point ;
M: quadtree assoc-size ( assoc -- n ) quadtree-size ;

View File

@ -5,7 +5,7 @@ IN: search-deques
TUPLE: search-deque assoc deque ;
C: <search-deque> search-deque ;
C: <search-deque> search-deque
M: search-deque deque-empty? deque>> deque-empty? ;
@ -41,4 +41,4 @@ M: search-deque clear-deque
M: search-deque deque-member?
assoc>> key? ;
INSTANCE: search-deque deque ;
INSTANCE: search-deque deque

View File

@ -3,7 +3,7 @@ sequences sequences.private ;
IN: sequences.complex-components
TUPLE: complex-components seq ;
INSTANCE: complex-components sequence ;
INSTANCE: complex-components sequence
: <complex-components> ( sequence -- complex-components )
complex-components boa ; inline

View File

@ -1,6 +1,6 @@
USING: specialized-arrays sequences.complex
kernel sequences tools.test arrays accessors ;
QUALIFIED-WITH: alien.c-types c ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
IN: sequences.complex.tests

View File

@ -3,7 +3,7 @@ sequences sequences.private ;
IN: sequences.complex
TUPLE: complex-sequence seq ;
INSTANCE: complex-sequence sequence ;
INSTANCE: complex-sequence sequence
: <complex-sequence> ( sequence -- complex-sequence )
complex-sequence boa ; inline

View File

@ -9,7 +9,7 @@ MIXIN: cord
TUPLE: generic-cord
{ head read-only } { tail read-only } ; final
INSTANCE: generic-cord cord ;
INSTANCE: generic-cord cord
M: cord length
[ head>> length ] [ tail>> length ] bi + ; inline
@ -20,9 +20,9 @@ M: cord virtual@
2dup head>> length <
[ head>> ] [ [ head>> length - ] [ tail>> ] bi ] if ; inline
INSTANCE: cord virtual-sequence ;
INSTANCE: cord virtual-sequence
GENERIC: cord-append ( seq1 seq2 -- cord ) ;
GENERIC: cord-append ( seq1 seq2 -- cord )
M: object cord-append
generic-cord boa ; inline
@ -35,7 +35,7 @@ WHERE
TUPLE: T-cord
{ head T read-only } { tail T read-only } ; final
INSTANCE: T-cord cord ;
INSTANCE: T-cord cord
M: T cord-append
2dup [ T instance? ] both?

View File

@ -5,7 +5,7 @@ IN: sequences.deep
! All traversal goes in postorder
GENERIC: branch? ( object -- ? ) ;
GENERIC: branch? ( object -- ? )
M: sequence branch? drop t ;
M: integer branch? drop f ;

View File

@ -400,7 +400,7 @@ M: evens length length>> ; inline
M: evens nth-unsafe [ 2 * ] [ seq>> nth-unsafe ] bi* ; inline
INSTANCE: evens immutable-sequence ;
INSTANCE: evens immutable-sequence
TUPLE: odds seq length ;
@ -411,7 +411,7 @@ M: odds length length>> ; inline
M: odds nth-unsafe [ 2 * 1 + ] [ seq>> nth-unsafe ] bi* ; inline
INSTANCE: odds immutable-sequence ;
INSTANCE: odds immutable-sequence
: until-empty ( seq quot -- )
[ dup empty? ] swap until drop ; inline

View File

@ -5,7 +5,7 @@ IN: sequences.frozen
TUPLE: frozen { seq read-only } ;
C: <frozen> frozen ;
C: <frozen> frozen
M: frozen virtual@ seq>> ;
@ -13,6 +13,6 @@ M: frozen virtual-exemplar seq>> ;
M: frozen length seq>> length ;
INSTANCE: frozen virtual-sequence ;
INSTANCE: frozen virtual-sequence
INSTANCE: frozen immutable-sequence ;
INSTANCE: frozen immutable-sequence

View File

@ -3,8 +3,8 @@ USING: accessors fry growable kernel locals math sequences ;
IN: sequences.inserters
TUPLE: offset-growable { underlying read-only } { offset read-only } ;
C: <offset-growable> offset-growable ;
INSTANCE: offset-growable virtual-sequence ;
C: <offset-growable> offset-growable
INSTANCE: offset-growable virtual-sequence
M: offset-growable length
[ underlying>> length ] [ offset>> ] bi - ; inline
M: offset-growable virtual-exemplar
@ -23,9 +23,9 @@ M: inserter length
drop 0 ; inline
TUPLE: appender { underlying read-only } ;
C: <appender> appender ;
C: <appender> appender
INSTANCE: appender inserter ;
INSTANCE: appender inserter
M:: appender new-sequence ( len inserter -- sequence )
inserter underlying>> set: underlying
@ -35,9 +35,9 @@ M:: appender new-sequence ( len inserter -- sequence )
underlying old-length <offset-growable> ; inline
TUPLE: replacer { underlying read-only } ;
C: <replacer> replacer ;
C: <replacer> replacer
INSTANCE: replacer inserter ;
INSTANCE: replacer inserter
M: replacer new-sequence
underlying>> [ set-length ] keep ; inline

View File

@ -5,7 +5,7 @@ sequences.private ;
IN: sequences.merged
TUPLE: merged seqs ;
C: <merged> merged ;
C: <merged> merged
: <2merged> ( seq1 seq2 -- merged ) 2array <merged> ;
: <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ;
@ -28,4 +28,4 @@ M: merged virtual@ ( n seq -- n' seq' )
M: merged virtual-exemplar ( merged -- seq )
seqs>> ?first ; inline
INSTANCE: merged virtual-sequence ;
INSTANCE: merged virtual-sequence

View File

@ -6,15 +6,15 @@ IN: sequences.modified
TUPLE: modified ;
GENERIC: modified-nth ( n seq -- elt ) ;
GENERIC: modified-nth ( n seq -- elt )
M: modified nth modified-nth ;
M: modified nth-unsafe modified-nth ;
GENERIC: modified-set-nth ( elt n seq -- ) ;
GENERIC: modified-set-nth ( elt n seq -- )
M: modified set-nth modified-set-nth ;
M: modified set-nth-unsafe modified-set-nth ;
INSTANCE: modified virtual-sequence ;
INSTANCE: modified virtual-sequence
TUPLE: 1modified < modified seq ;
@ -24,7 +24,7 @@ M: modified set-length seq>> set-length ;
M: 1modified virtual-exemplar seq>> ;
TUPLE: scaled < 1modified c ;
C: <scaled> scaled ;
C: <scaled> scaled
: scale ( seq c -- new-seq )
dupd <scaled> swap like ;
@ -37,7 +37,7 @@ M:: scaled modified-set-nth ( elt n seq -- )
elt seq c>> / n seq seq>> set-nth ;
TUPLE: offset < 1modified n ;
C: <offset> offset ;
C: <offset> offset
: seq-offset ( seq n -- new-seq )
dupd <offset> swap like ;
@ -49,7 +49,7 @@ M:: offset modified-set-nth ( elt n seq -- )
elt seq n>> - n seq seq>> set-nth ;
TUPLE: summed < modified seqs ;
C: <summed> summed ;
C: <summed> summed
M: summed length seqs>> longest length ;

View File

@ -4,7 +4,7 @@ sequences.private ;
IN: sequences.n-based
TUPLE: n-based-assoc seq base ;
C: <n-based-assoc> n-based-assoc ;
C: <n-based-assoc> n-based-assoc
PRIVATE<
@ -15,7 +15,7 @@ PRIVATE<
PRIVATE>
INSTANCE: n-based-assoc assoc ;
INSTANCE: n-based-assoc assoc
M: n-based-assoc at* ( key assoc -- value ? )
n-based@ 2dup bounds-check?
[ nth-unsafe t ] [ 2drop f f ] if ;

View File

@ -8,7 +8,7 @@ TUPLE: product-sequence { sequences array read-only } { lengths array read-only
: <product-sequence> ( sequences -- product-sequence )
>array dup [ length ] map product-sequence boa ;
INSTANCE: product-sequence sequence ;
INSTANCE: product-sequence sequence
M: product-sequence length lengths>> product ;

View File

@ -22,7 +22,7 @@ M: cycles virtual@ ( n seq -- n' seq' ) circular>> ;
M: cycles virtual-exemplar circular>> ;
INSTANCE: cycles virtual-sequence ;
INSTANCE: cycles virtual-sequence
TUPLE: repeats
{ seq sequence read-only }
@ -39,4 +39,4 @@ M: repeats length length>> ;
M: repeats nth-unsafe
[ length>> / ] [ seq>> [ length * >integer ] keep nth ] bi ;
INSTANCE: repeats immutable-sequence ;
INSTANCE: repeats immutable-sequence

View File

@ -7,7 +7,7 @@ TUPLE: rotated
{ seq read-only }
{ n integer read-only } ;
C: <rotated> rotated ;
C: <rotated> rotated
M: rotated length seq>> length ;
@ -20,7 +20,7 @@ M: rotated virtual@
M: rotated virtual-exemplar seq>> ;
INSTANCE: rotated virtual-sequence ;
INSTANCE: rotated virtual-sequence
: all-rotations ( seq -- seq' )
dup length iota [ <rotated> ] with map ;

View File

@ -8,7 +8,7 @@ TUPLE: shifted
{ n integer read-only }
{ fill read-only } ;
C: <shifted> shifted ;
C: <shifted> shifted
M: shifted length underlying>> length ;
@ -24,4 +24,4 @@ M: shifted set-nth-unsafe
[ n>> neg + ] [ underlying>> ] bi
2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ;
INSTANCE: shifted sequence ;
INSTANCE: shifted sequence

View File

@ -22,4 +22,4 @@ M: snipped virtual@
M: snipped virtual-exemplar seq>> ;
INSTANCE: snipped virtual-sequence ;
INSTANCE: snipped virtual-sequence

View File

@ -8,9 +8,9 @@ TUPLE: windowed-sequence
{ sequence sequence read-only }
{ n integer } ;
INSTANCE: windowed-sequence sequence ;
INSTANCE: windowed-sequence sequence
C: <windowed-sequence> windowed-sequence ;
C: <windowed-sequence> windowed-sequence
M: windowed-sequence nth-unsafe
[ 1 + ] dip [ n>> dupd [-] swap ] [ sequence>> ] bi <slice> ; inline

View File

@ -8,7 +8,7 @@ TUPLE: zipped
{ keys sequence read-only }
{ values sequence read-only } ;
C: <zipped> zipped ;
C: <zipped> zipped
M: zipped length
[ keys>> ] [ values>> ] bi min-length ;
@ -16,4 +16,4 @@ M: zipped length
M: zipped nth-unsafe
[ keys>> nth-unsafe ] [ values>> nth-unsafe ] 2bi 2array ;
INSTANCE: zipped immutable-sequence ;
INSTANCE: zipped immutable-sequence

Some files were not shown because too many files have changed in this diff Show More