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

db4
Doug Coleman 2008-11-06 13:17:54 -06:00
commit dd1b28ba7a
7 changed files with 41 additions and 43 deletions

View File

@ -156,19 +156,30 @@ M: #if emit-node
} cond iterate-next ;
! #dispatch
: trivial-dispatch-branch? ( nodes -- ? )
dup length 1 = [
first dup #call? [
word>> "intrinsic" word-prop not
] [ drop f ] if
] [ drop f ] if ;
: dispatch-branch ( nodes word -- label )
gensym [
[
V{ } clone node-stack set
##prologue
emit-nodes
basic-block get [
##epilogue
##return
end-basic-block
] when
] with-cfg-builder
] keep ;
over trivial-dispatch-branch? [
drop first word>>
] [
gensym [
[
V{ } clone node-stack set
##prologue
emit-nodes
basic-block get [
##epilogue
##return
end-basic-block
] when
] with-cfg-builder
] keep
] if ;
: dispatch-branches ( node -- )
children>> [

View File

@ -39,7 +39,7 @@ HOOK: (wait-to-read) io-backend ( port -- )
M: input-port stream-read1
dup check-disposed
dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ;
dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
: read-step ( count port -- byte-array/f )
dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
@ -105,7 +105,7 @@ TUPLE: output-port < buffered-port ;
M: output-port stream-write1
dup check-disposed
1 over wait-to-write
buffer>> byte>buffer ;
buffer>> byte>buffer ; inline
M: output-port stream-write
dup check-disposed

View File

@ -83,8 +83,6 @@ IN: math.intervals.tests
0 1 (a,b) 1 2 [a,b] interval-union 0 2 (a,b] =
] unit-test
[ f ] [ 0 1 (a,b) f interval-union ] unit-test
[ t ] [
0 1 (a,b) 0 1 [a,b] interval-intersect 0 1 (a,b) =
] unit-test

View File

@ -115,14 +115,10 @@ TUPLE: interval { from read-only } { to read-only } ;
{ [ dup empty-interval eq? ] [ nip ] }
{ [ over empty-interval eq? ] [ drop ] }
[
2dup and [
[ interval>points ] bi@ swapd
[ [ swap endpoint< ] most ]
[ [ swap endpoint> ] most ] 2bi*
<interval>
] [
or
] if
[ interval>points ] bi@ swapd
[ [ swap endpoint< ] most ]
[ [ swap endpoint> ] most ] 2bi*
<interval>
]
} cond ;
@ -133,13 +129,7 @@ TUPLE: interval { from read-only } { to read-only } ;
{
{ [ dup empty-interval eq? ] [ drop ] }
{ [ over empty-interval eq? ] [ nip ] }
[
2dup and [
[ interval>points 2array ] bi@ append points>interval
] [
2drop f
] if
]
[ [ interval>points 2array ] bi@ append points>interval ]
} cond ;
: interval-subset? ( i1 i2 -- ? )
@ -183,7 +173,6 @@ TUPLE: interval { from read-only } { to read-only } ;
: interval-length ( int -- n )
{
{ [ dup empty-interval eq? ] [ drop 0 ] }
{ [ dup not ] [ drop 0 ] }
[ interval>points [ first ] bi@ swap - ]
} cond ;

View File

@ -8,7 +8,7 @@ ERROR: not-in-a-method-error ;
: CREATE-GENERIC ( -- word ) CREATE dup reset-word ;
: create-method-in ( class generic -- method )
create-method f set-word dup save-location ;
create-method dup set-word dup save-location ;
: CREATE-METHOD ( -- method )
scan-word bootstrap-word scan-word create-method-in ;
@ -18,11 +18,11 @@ SYMBOL: current-generic
: with-method-definition ( quot -- parsed )
[
>r
[ "method-class" word-prop current-class set ]
[ "method-generic" word-prop current-generic set ]
[ ] tri
r> call
[
[ "method-class" word-prop current-class set ]
[ "method-generic" word-prop current-generic set ]
[ ] tri
] dip call
] with-scope ; inline
: (M:) ( method def -- )

View File

@ -262,7 +262,7 @@ M: word forget*
] if ;
M: word hashcode*
nip 1 slot { fixnum } declare ;
nip 1 slot { fixnum } declare ; foldable
M: word literalize <wrapper> ;

View File

@ -6,12 +6,12 @@ continuations debugger ;
IN: benchmark
: run-benchmark ( vocab -- result )
[ [ require ] [ [ run ] benchmark ] bi ] curry
[ error. f ] recover ;
[ [ require ] [ [ run ] benchmark ] bi ] curry
[ error. f ] recover ;
: run-benchmarks ( -- assoc )
"benchmark" all-child-vocabs-seq
[ dup run-benchmark ] { } map>assoc ;
"benchmark" all-child-vocabs-seq
[ dup run-benchmark ] { } map>assoc ;
: benchmarks. ( assoc -- )
standard-table-style [