update existing code to use :> ( ) when possible
Joe Groff
parent
c19912241b
commit
6e1bffb1c5
|
|
@ -333,7 +333,7 @@ M: character-type (<fortran-result>)
|
|||
] if-empty ;
|
||||
|
||||
:: [fortran-invoke] ( [args>args] return library function parameters -- [args>args] quot )
|
||||
return parameters fortran-sig>c-sig :> c-parameters :> c-return
|
||||
return parameters fortran-sig>c-sig :> ( c-return c-parameters )
|
||||
function fortran-name>symbol-name :> c-function
|
||||
[args>args]
|
||||
c-return library c-function c-parameters \ alien-invoke
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ IN: alien.parser
|
|||
type-name current-vocab create :> type-word
|
||||
type-word [ reset-generic ] [ reset-c-type ] bi
|
||||
void* type-word typedef
|
||||
parameters return parse-arglist :> callback-effect :> types
|
||||
parameters return parse-arglist :> ( types callback-effect )
|
||||
type-word callback-effect "callback-effect" set-word-prop
|
||||
type-word lib "callback-library" set-word-prop
|
||||
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@ PRIVATE>
|
|||
M:: lsb0-bit-writer poke ( value n bs -- )
|
||||
value n <widthed> :> widthed
|
||||
widthed
|
||||
bs widthed>> #bits>> 8 swap - split-widthed :> remainder :> byte
|
||||
bs widthed>> #bits>> 8 swap - split-widthed :> ( byte remainder )
|
||||
byte bs widthed>> |widthed :> new-byte
|
||||
new-byte #bits>> 8 = [
|
||||
new-byte bits>> bs bytes>> push
|
||||
|
|
@ -143,7 +143,7 @@ ERROR: not-enough-bits n bit-reader ;
|
|||
neg shift n bits ;
|
||||
|
||||
:: adjust-bits ( n bs -- )
|
||||
n 8 /mod :> #bits :> #bytes
|
||||
n 8 /mod :> ( #bytes #bits )
|
||||
bs [ #bytes + ] change-byte-pos
|
||||
bit-pos>> #bits + dup 8 >= [
|
||||
8 - bs (>>bit-pos)
|
||||
|
|
|
|||
|
|
@ -119,16 +119,16 @@ GENERIC: easter ( obj -- obj' )
|
|||
|
||||
:: easter-month-day ( year -- month day )
|
||||
year 19 mod :> a
|
||||
year 100 /mod :> c :> b
|
||||
b 4 /mod :> e :> d
|
||||
year 100 /mod :> ( b c )
|
||||
b 4 /mod :> ( d e )
|
||||
b 8 + 25 /i :> f
|
||||
b f - 1 + 3 /i :> g
|
||||
19 a * b + d - g - 15 + 30 mod :> h
|
||||
c 4 /mod :> k :> i
|
||||
c 4 /mod :> ( i k )
|
||||
32 2 e * + 2 i * + h - k - 7 mod :> l
|
||||
a 11 h * + 22 l * + 451 /i :> m
|
||||
|
||||
h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
|
||||
h l + 7 m * - 114 + 31 /mod 1 + :> ( month day )
|
||||
month day ;
|
||||
|
||||
M: integer easter ( year -- timestamp )
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ PRIVATE>
|
|||
|
||||
:: hmac-stream ( stream key checksum -- value )
|
||||
checksum initialize-checksum-state :> checksum-state
|
||||
checksum key checksum-state init-key :> Ki :> Ko
|
||||
checksum key checksum-state init-key :> ( Ko Ki )
|
||||
checksum-state Ki add-checksum-bytes
|
||||
stream add-checksum-stream get-checksum
|
||||
checksum initialize-checksum-state
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: classes.struct.bit-accessors
|
|||
[ 2^ 1 - ] bi@ swap bitnot bitand ;
|
||||
|
||||
:: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' )
|
||||
offset 8 /mod :> start-bit :> i
|
||||
offset 8 /mod :> ( i start-bit )
|
||||
start-bit bits + 8 min :> end-bit
|
||||
start-bit end-bit ones-between :> mask
|
||||
end-bit start-bit - :> used-bits
|
||||
|
|
|
|||
|
|
@ -156,18 +156,18 @@ MACRO: if-literals-match ( quots -- )
|
|||
[ [ ^^fill-vector ] [ ^^xor-vector ] bi ] if ;
|
||||
|
||||
:: ((generate-compare-vector)) ( src1 src2 rep {cc,swap} -- dst )
|
||||
{cc,swap} first2 :> swap? :> cc
|
||||
{cc,swap} first2 :> ( cc swap? )
|
||||
swap?
|
||||
[ src2 src1 rep cc ^^compare-vector ]
|
||||
[ src1 src2 rep cc ^^compare-vector ] if ;
|
||||
|
||||
:: (generate-compare-vector) ( src1 src2 rep orig-cc -- dst )
|
||||
rep orig-cc %compare-vector-ccs :> not? :> ccs
|
||||
rep orig-cc %compare-vector-ccs :> ( ccs not? )
|
||||
|
||||
ccs empty?
|
||||
[ rep not? [ ^^fill-vector ] [ ^^zero-vector ] if ]
|
||||
[
|
||||
ccs unclip :> first-cc :> rest-ccs
|
||||
ccs unclip :> ( rest-ccs first-cc )
|
||||
src1 src2 rep first-cc ((generate-compare-vector)) :> first-dst
|
||||
|
||||
rest-ccs first-dst
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ IN: compiler.cfg.intrinsics.slots
|
|||
first class>> immediate class<= not ;
|
||||
|
||||
:: (emit-set-slot) ( infos -- )
|
||||
3inputs :> slot :> obj :> src
|
||||
3inputs :> ( src obj slot )
|
||||
|
||||
slot infos second value-tag ^^tag-offset>slot :> slot
|
||||
|
||||
|
|
@ -54,7 +54,7 @@ IN: compiler.cfg.intrinsics.slots
|
|||
:: (emit-set-slot-imm) ( infos -- )
|
||||
ds-drop
|
||||
|
||||
2inputs :> obj :> src
|
||||
2inputs :> ( src obj )
|
||||
|
||||
infos third literal>> :> slot
|
||||
infos second value-tag :> tag
|
||||
|
|
|
|||
|
|
@ -504,11 +504,11 @@ M: ppc %compare [ (%compare) ] 2dip %boolean ;
|
|||
M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
|
||||
|
||||
M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
|
||||
src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
|
||||
src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
|
||||
dst temp branch1 branch2 (%boolean) ;
|
||||
|
||||
M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
|
||||
src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
|
||||
src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
|
||||
dst temp branch1 branch2 (%boolean) ;
|
||||
|
||||
:: %branch ( label cc -- )
|
||||
|
|
@ -534,11 +534,11 @@ M:: ppc %compare-imm-branch ( label src1 src2 cc -- )
|
|||
branch2 [ label branch2 execute( label -- ) ] when ; inline
|
||||
|
||||
M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
|
||||
src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
|
||||
src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
|
||||
label branch1 branch2 (%branch) ;
|
||||
|
||||
M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
|
||||
src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
|
||||
src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
|
||||
label branch1 branch2 (%branch) ;
|
||||
|
||||
: load-from-frame ( dst n rep -- )
|
||||
|
|
|
|||
|
|
@ -114,8 +114,8 @@ DEFER: (parse-paragraph)
|
|||
|
||||
:: (take-until) ( state delimiter accum -- string/f state' )
|
||||
state empty? [ accum "\n" join f ] [
|
||||
state unclip-slice :> first :> rest
|
||||
first delimiter split1 :> after :> before
|
||||
state unclip-slice :> ( rest first )
|
||||
first delimiter split1 :> ( before after )
|
||||
before accum push
|
||||
after [
|
||||
accum "\n" join
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@ CONSTANT: packet-size 65536
|
|||
[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
|
||||
|
||||
:: do-receive ( port -- packet sockaddr )
|
||||
port addr>> empty-sockaddr/size :> len :> sockaddr
|
||||
port addr>> empty-sockaddr/size :> ( sockaddr len )
|
||||
port handle>> handle-fd ! s
|
||||
receive-buffer get-global ! buf
|
||||
packet-size ! nbytes
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ IN: math.matrices
|
|||
:: rotation-matrix3 ( axis theta -- matrix )
|
||||
theta cos :> c
|
||||
theta sin :> s
|
||||
axis first3 :> z :> y :> x
|
||||
axis first3 :> ( x y z )
|
||||
x sq 1.0 x sq - c * + x y * 1.0 c - * z s * - x z * 1.0 c - * y s * + 3array
|
||||
x y * 1.0 c - * z s * + y sq 1.0 y sq - c * + y z * 1.0 c - * x s * - 3array
|
||||
x z * 1.0 c - * y s * - y z * 1.0 c - * x s * + z sq 1.0 z sq - c * + 3array
|
||||
|
|
@ -25,14 +25,14 @@ IN: math.matrices
|
|||
:: rotation-matrix4 ( axis theta -- matrix )
|
||||
theta cos :> c
|
||||
theta sin :> s
|
||||
axis first3 :> z :> y :> x
|
||||
axis first3 :> ( x y z )
|
||||
x sq 1.0 x sq - c * + x y * 1.0 c - * z s * - x z * 1.0 c - * y s * + 0 4array
|
||||
x y * 1.0 c - * z s * + y sq 1.0 y sq - c * + y z * 1.0 c - * x s * - 0 4array
|
||||
x z * 1.0 c - * y s * - y z * 1.0 c - * x s * + z sq 1.0 z sq - c * + 0 4array
|
||||
{ 0.0 0.0 0.0 1.0 } 4array ;
|
||||
|
||||
:: translation-matrix4 ( offset -- matrix )
|
||||
offset first3 :> z :> y :> x
|
||||
offset first3 :> ( x y z )
|
||||
{
|
||||
{ 1.0 0.0 0.0 x }
|
||||
{ 0.0 1.0 0.0 y }
|
||||
|
|
@ -44,7 +44,7 @@ IN: math.matrices
|
|||
dup number? [ dup dup ] [ first3 ] if ;
|
||||
|
||||
:: scale-matrix3 ( factors -- matrix )
|
||||
factors >scale-factors :> z :> y :> x
|
||||
factors >scale-factors :> ( x y z )
|
||||
{
|
||||
{ x 0.0 0.0 }
|
||||
{ 0.0 y 0.0 }
|
||||
|
|
@ -52,7 +52,7 @@ IN: math.matrices
|
|||
} ;
|
||||
|
||||
:: scale-matrix4 ( factors -- matrix )
|
||||
factors >scale-factors :> z :> y :> x
|
||||
factors >scale-factors :> ( x y z )
|
||||
{
|
||||
{ x 0.0 0.0 0.0 }
|
||||
{ 0.0 y 0.0 0.0 }
|
||||
|
|
@ -64,7 +64,7 @@ IN: math.matrices
|
|||
[ recip ] map scale-matrix4 ;
|
||||
|
||||
:: frustum-matrix4 ( xy-dim near far -- matrix )
|
||||
xy-dim first2 :> y :> x
|
||||
xy-dim first2 :> ( x y )
|
||||
near x /f :> xf
|
||||
near y /f :> yf
|
||||
near far + near far - /f :> zf
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ IN: math.primes.miller-rabin
|
|||
|
||||
:: (miller-rabin) ( n trials -- ? )
|
||||
n 1 - :> n-1
|
||||
n-1 factor-2s :> s :> r
|
||||
n-1 factor-2s :> ( r s )
|
||||
0 :> a!
|
||||
trials [
|
||||
drop
|
||||
|
|
|
|||
|
|
@ -81,8 +81,8 @@ ERROR: bad-vconvert-input value expected-type ;
|
|||
PRIVATE>
|
||||
|
||||
MACRO:: vconvert ( from-type to-type -- )
|
||||
from-type new [ element-type ] [ byte-length ] bi :> from-length :> from-element
|
||||
to-type new [ element-type ] [ byte-length ] bi :> to-length :> to-element
|
||||
from-type new [ element-type ] [ byte-length ] bi :> ( from-element from-length )
|
||||
to-type new [ element-type ] [ byte-length ] bi :> ( to-element to-length )
|
||||
from-element heap-size :> from-size
|
||||
to-element heap-size :> to-size
|
||||
|
||||
|
|
|
|||
|
|
@ -391,8 +391,8 @@ TUPLE: inconsistent-vector-test bool branch ;
|
|||
2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
|
||||
|
||||
:: test-vector-tests ( vector decl -- none? any? all? )
|
||||
vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none
|
||||
vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none
|
||||
vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
|
||||
vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
|
||||
|
||||
bool-none branch-none ?inconsistent
|
||||
bool-any branch-any ?inconsistent
|
||||
|
|
|
|||
|
|
@ -95,8 +95,8 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
#! We use GL_LINE_STRIP with a duplicated first vertex
|
||||
#! instead of GL_LINE_LOOP to work around a bug in Apple's
|
||||
#! X3100 driver.
|
||||
loc first2 :> y :> x
|
||||
dim first2 :> h :> w
|
||||
loc first2 :> ( x y )
|
||||
dim first2 :> ( w h )
|
||||
[
|
||||
x 0.5 + y 0.5 +
|
||||
x w + 0.3 - y 0.5 +
|
||||
|
|
@ -115,8 +115,8 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
rect-vertices (gl-rect) ;
|
||||
|
||||
:: (fill-rect-vertices) ( loc dim -- vertices )
|
||||
loc first2 :> y :> x
|
||||
dim first2 :> h :> w
|
||||
loc first2 :> ( x y )
|
||||
dim first2 :> ( w h )
|
||||
[
|
||||
x y
|
||||
x w + y
|
||||
|
|
|
|||
|
|
@ -278,7 +278,7 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display-
|
|||
] unless ;
|
||||
|
||||
:: tex-image ( image bitmap -- )
|
||||
image image-format :> type :> format :> internal-format
|
||||
image image-format :> ( internal-format format type )
|
||||
GL_TEXTURE_2D 0 internal-format
|
||||
image dim>> adjust-texture-dim first2 0
|
||||
format type bitmap glTexImage2D ;
|
||||
|
|
|
|||
|
|
@ -614,7 +614,7 @@ ERROR: parse-failed input word ;
|
|||
|
||||
SYNTAX: PEG:
|
||||
[let
|
||||
(:) :> effect :> def :> word
|
||||
(:) :> ( word def effect )
|
||||
[
|
||||
[
|
||||
def call compile :> compiled-def
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
|
|||
new-leaf
|
||||
] [
|
||||
idx nodes nth :> n
|
||||
shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
|
||||
shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf )
|
||||
n n' eq? [
|
||||
bitmap-node
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node )
|
|||
|
||||
M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf )
|
||||
hashcode collision-node hashcode>> eq? [
|
||||
key hashcode collision-node find-index :> leaf-node :> idx
|
||||
key hashcode collision-node find-index :> ( idx leaf-node )
|
||||
idx [
|
||||
value leaf-node value>> = [
|
||||
collision-node f
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf
|
|||
hashcode full-node shift>> mask :> idx
|
||||
idx nodes nth-unsafe :> n
|
||||
|
||||
shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n'
|
||||
shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf )
|
||||
n n' eq? [
|
||||
full-node
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ GENERIC: nfa-node ( node -- start-state end-state )
|
|||
epsilon nfa-table get add-transition ;
|
||||
|
||||
M:: star nfa-node ( node -- start end )
|
||||
node term>> nfa-node :> s1 :> s0
|
||||
node term>> nfa-node :> ( s0 s1 )
|
||||
next-state :> s2
|
||||
next-state :> s3
|
||||
s1 s0 epsilon-transition
|
||||
|
|
|
|||
|
|
@ -78,7 +78,8 @@ CONSTANT: homo-sapiens
|
|||
: write-repeat-fasta ( n alu desc id -- )
|
||||
write-description
|
||||
[let
|
||||
0 :> k! :> alu
|
||||
:> alu
|
||||
0 :> k!
|
||||
[| len | k len alu make-repeat-fasta k! ] split-lines
|
||||
] ; inline
|
||||
|
||||
|
|
@ -86,12 +87,7 @@ CONSTANT: homo-sapiens
|
|||
homo-sapiens make-cumulative
|
||||
IUB make-cumulative
|
||||
[let
|
||||
:> homo-sapiens-floats
|
||||
:> homo-sapiens-chars
|
||||
:> IUB-floats
|
||||
:> IUB-chars
|
||||
:> out
|
||||
:> n
|
||||
:> ( n out IUB-chars IUB-floats homo-sapiens-chars homo-sapiens-floats )
|
||||
initial-seed :> seed
|
||||
|
||||
out ascii [
|
||||
|
|
|
|||
|
|
@ -75,8 +75,8 @@ M: decimal before?
|
|||
|
||||
:: D/ ( D1 D2 a -- D3 )
|
||||
D1 D2 guard-decimals 2drop
|
||||
D1 >decimal< :> e1 :> m1
|
||||
D2 >decimal< :> e2 :> m2
|
||||
D1 >decimal< :> ( m1 e1 )
|
||||
D2 >decimal< :> ( m2 e2 )
|
||||
m1 a 10^ *
|
||||
m2 /i
|
||||
|
||||
|
|
|
|||
|
|
@ -332,13 +332,13 @@ DEFER: [bind-uniform-tuple]
|
|||
] [
|
||||
{ [ ] }
|
||||
name "." append 1array
|
||||
] if* :> name-prefixes :> quot-prefixes
|
||||
] if* :> ( quot-prefixes name-prefixes )
|
||||
type all-uniform-tuple-slots :> uniforms
|
||||
|
||||
texture-unit quot-prefixes name-prefixes [| quot-prefix name-prefix |
|
||||
uniforms name-prefix [bind-uniform-tuple]
|
||||
quot-prefix prepend
|
||||
] 2map :> value-cleave :> texture-unit'
|
||||
] 2map :> ( texture-unit' value-cleave )
|
||||
|
||||
texture-unit'
|
||||
value>>-quot { value-cleave 2cleave } append ;
|
||||
|
|
@ -356,7 +356,7 @@ DEFER: [bind-uniform-tuple]
|
|||
} cond ;
|
||||
|
||||
:: [bind-uniform-tuple] ( texture-unit uniforms prefix -- texture-unit' quot )
|
||||
texture-unit uniforms [ prefix [bind-uniform] ] map :> uniforms-cleave :> texture-unit'
|
||||
texture-unit uniforms [ prefix [bind-uniform] ] map :> ( texture-unit' uniforms-cleave )
|
||||
|
||||
texture-unit'
|
||||
{ uniforms-cleave 2cleave } >quotation ;
|
||||
|
|
|
|||
|
|
@ -35,8 +35,8 @@ M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
|
|||
|
||||
:: 2map-columns ( a b quot -- c )
|
||||
[
|
||||
a columns :> a4 :> a3 :> a2 :> a1
|
||||
b columns :> b4 :> b3 :> b2 :> b1
|
||||
a columns :> ( a1 a2 a3 a4 )
|
||||
b columns :> ( b1 b2 b3 b4 )
|
||||
|
||||
a1 b1 quot call
|
||||
a2 b2 quot call
|
||||
|
|
@ -61,8 +61,8 @@ TYPED: n/m4 ( a: float b: matrix4 -- c: matrix4 ) [ n/v ] with map-columns ;
|
|||
|
||||
TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
|
||||
[
|
||||
a columns :> a4 :> a3 :> a2 :> a1
|
||||
b columns :> b4 :> b3 :> b2 :> b1
|
||||
a columns :> ( a1 a2 a3 a4 )
|
||||
b columns :> ( b1 b2 b3 b4 )
|
||||
|
||||
b1 first a1 n*v :> c1a
|
||||
b2 first a1 n*v :> c2a
|
||||
|
|
@ -86,7 +86,7 @@ TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
|
|||
] make-matrix4 ;
|
||||
|
||||
TYPED:: m4.v ( m: matrix4 v: float-4 -- v': float-4 )
|
||||
m columns :> m4 :> m3 :> m2 :> m1
|
||||
m columns :> ( m1 m2 m3 m4 )
|
||||
|
||||
v first m1 n*v
|
||||
v second m2 n*v v+
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ TUPLE: nurbs-curve
|
|||
|
||||
:: (eval-bases) ( curve t interval values order -- values' )
|
||||
order 2 - curve (knot-constants)>> nth :> all-knot-constants
|
||||
interval order interval + all-knot-constants clip-range :> to :> from
|
||||
interval order interval + all-knot-constants clip-range :> ( from to )
|
||||
from to all-knot-constants subseq :> knot-constants
|
||||
values { 0.0 } { 0.0 } surround 2 <clumps> :> bases
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ M: product-sequence nth
|
|||
product@ nths ;
|
||||
|
||||
:: product-each ( sequences quot -- )
|
||||
sequences start-product-iter :> lengths :> ns
|
||||
sequences start-product-iter :> ( ns lengths )
|
||||
lengths [ 0 = ] any? [
|
||||
[ ns lengths end-product-iter? ]
|
||||
[ ns sequences nths quot call ns lengths product-iter ] until
|
||||
|
|
|
|||
|
|
@ -69,12 +69,12 @@ fetched-in parsed-html links processed-in fetched-at ;
|
|||
|
||||
:: fill-spidered-result ( spider spider-result -- )
|
||||
f spider-result url>> spider spidered>> set-at
|
||||
[ spider-result url>> http-get ] benchmark :> fetched-in :> html :> headers
|
||||
[ spider-result url>> http-get ] benchmark :> ( headers html fetched-in )
|
||||
[
|
||||
html parse-html
|
||||
spider currently-spidering>>
|
||||
over find-all-links normalize-hrefs
|
||||
] benchmark :> processed-in :> links :> parsed-html
|
||||
] benchmark :> ( parsed-html links processed-in )
|
||||
spider-result
|
||||
headers >>headers
|
||||
fetched-in >>fetched-in
|
||||
|
|
|
|||
Loading…
Reference in New Issue