factor: FOO: a b FOO: c d works again!
parent
c0223d28f0
commit
47e54698e4
|
@ -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>>
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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" ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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 <= [
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 $[
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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> ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 } ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@ IN: env
|
|||
|
||||
SINGLETON: env
|
||||
|
||||
INSTANCE: env assoc ;
|
||||
INSTANCE: env assoc
|
||||
|
||||
M: env at*
|
||||
drop os-env dup >boolean ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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* < ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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" ] }
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -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{
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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<
|
||||
|
||||
|
|
|
@ -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! ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 }
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -22,4 +22,4 @@ M: snipped virtual@
|
|||
|
||||
M: snipped virtual-exemplar seq>> ;
|
||||
|
||||
INSTANCE: snipped virtual-sequence ;
|
||||
INSTANCE: snipped virtual-sequence
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
Loading…
Reference in New Issue