steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

updating usages of cond/case

db4
Doug Coleman 2008-04-11 12:53:22 -05:00
parent 9348b9b8a7
commit bced4022e5
30 changed files with 71 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/alien/alien-docs.factor
View File

@ -78,7 +78,7 @@ $nl
"<< \"freetype\" {"
" { [ os macosx? ] [ \"libfreetype.6.dylib\" \"cdecl\" add-library ] }"
" { [ os windows? ] [ \"freetype6.dll\" \"cdecl\" add-library ] }"
" { [ t ] [ drop ] }"
" [ drop ]"
"} cond >>"
}
"Note the parse time evaluation with " { $link POSTPONE: << } "." } ;

4
core/alien/compiler/compiler.factor
View File

@ -375,7 +375,7 @@ TUPLE: callback-context ;
return>> {
{ [ dup "void" = ] [ drop [ ] ] }
{ [ dup large-struct? ] [ heap-size [ memcpy ] curry ] }
{ [ t ] [ c-type c-type-prep ] }
[ c-type c-type-prep ]
} cond ;
: wrap-callback-quot ( node -- quot )
@ -390,7 +390,7 @@ TUPLE: callback-context ;
{
{ [ dup abi>> "stdcall" = ] [ alien-stack-frame ] }
{ [ dup return>> large-struct? ] [ drop 4 ] }
{ [ t ] [ drop 0 ] }
[ drop 0 ]
} cond ;
: %callback-return ( node -- )

2
core/alien/syntax/syntax.factor
View File

@ -68,7 +68,7 @@ M: alien pprint*
{
{ [ dup expired? ] [ drop "( alien expired )" text ] }
{ [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
{ [ t ] [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ] }
[ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
} cond ;
M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;

14
core/classes/algebra/algebra.factor
View File

@ -84,7 +84,7 @@ C: <anonymous-complement> anonymous-complement
{ [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }
{ [ dup members ] [ right-union-class< ] }
{ [ over superclass ] [ superclass< ] }
{ [ t ] [ 2drop f ] }
[ 2drop f ]
} cond ;
: anonymous-union-intersect? ( first second -- ? )
@ -104,14 +104,14 @@ C: <anonymous-complement> anonymous-complement
{ [ over tuple eq? ] [ 2drop t ] }
{ [ over builtin-class? ] [ 2drop f ] }
{ [ over tuple-class? ] [ [ class< ] [ swap class< ] 2bi or ] }
{ [ t ] [ swap classes-intersect? ] }
[ swap classes-intersect? ]
} cond ;
: builtin-class-intersect? ( first second -- ? )
{
{ [ 2dup eq? ] [ 2drop t ] }
{ [ over builtin-class? ] [ 2drop f ] }
{ [ t ] [ swap classes-intersect? ] }
[ swap classes-intersect? ]
} cond ;
: (classes-intersect?) ( first second -- ? )
@ -154,7 +154,7 @@ C: <anonymous-complement> anonymous-complement
{ [ over members ] [ left-union-and ] }
{ [ over anonymous-union? ] [ left-anonymous-union-and ] }
{ [ over anonymous-intersection? ] [ left-anonymous-intersection-and ] }
{ [ t ] [ 2array <anonymous-intersection> ] }
[ 2array <anonymous-intersection> ]
} cond ;
: left-anonymous-union-or ( first second -- class )
@ -169,7 +169,7 @@ C: <anonymous-complement> anonymous-complement
{ [ 2dup swap class< ] [ drop ] }
{ [ dup anonymous-union? ] [ right-anonymous-union-or ] }
{ [ over anonymous-union? ] [ left-anonymous-union-or ] }
{ [ t ] [ 2array <anonymous-union> ] }
[ 2array <anonymous-union> ]
} cond ;
: (class-not) ( class -- complement )
@ -177,7 +177,7 @@ C: <anonymous-complement> anonymous-complement
{ [ dup anonymous-complement? ] [ class>> ] }
{ [ dup object eq? ] [ drop null ] }
{ [ dup null eq? ] [ drop object ] }
{ [ t ] [ <anonymous-complement> ] }
[ <anonymous-complement> ]
} cond ;
: largest-class ( seq -- n elt )
@ -205,7 +205,7 @@ C: <anonymous-complement> anonymous-complement
{ [ dup builtin-class? ] [ dup set ] }
{ [ dup members ] [ members [ (flatten-class) ] each ] }
{ [ dup superclass ] [ superclass (flatten-class) ] }
{ [ t ] [ drop ] }
[ drop ]
} cond ;
: flatten-class ( class -- assoc )

2
core/classes/mixin/mixin.factor
View File

@ -49,7 +49,7 @@ M: mixin-instance equal?
{ [ over mixin-instance? not ] [ f ] }
{ [ 2dup [ mixin-instance-class ] bi@ = not ] [ f ] }
{ [ 2dup [ mixin-instance-mixin ] bi@ = not ] [ f ] }
{ [ t ] [ t ] }
[ t ]
} cond 2nip ;
M: mixin-instance hashcode*

4
core/compiler/tests/simple.factor
View File

@ -187,7 +187,7 @@ DEFER: countdown-b
{ [ dup string? ] [ drop "string" ] }
{ [ dup float? ] [ drop "float" ] }
{ [ dup alien? ] [ drop "alien" ] }
{ [ t ] [ drop "neither" ] }
[ drop "neither" ]
} cond
] compile-call
] unit-test
@ -196,7 +196,7 @@ DEFER: countdown-b
[
3 {
{ [ dup fixnum? ] [ ] }
{ [ t ] [ drop t ] }
[ drop t ]
} cond
] compile-call
] unit-test

3
core/cpu/x86/32/32.factor
View File

@ -246,9 +246,8 @@ M: x86.32 %cleanup ( alien-node -- )
} {
[ dup return>> large-struct? ]
[ drop EAX PUSH ]
} {
[ t ] [ drop ]
}
[ drop ]
} cond ;
M: x86.32 %unwind ( n -- ) %epilogue-later RET ;

2
core/cpu/x86/assembler/assembler.factor
View File

@ -189,7 +189,7 @@ UNION: operand register indirect ;
{
{ [ dup register-128? ] [ drop operand-64? ] }
{ [ dup not ] [ drop operand-64? ] }
{ [ t ] [ nip operand-64? ] }
[ nip operand-64? ]
} cond and ;
: rex.r

2
core/debugger/debugger.factor
View File

@ -160,7 +160,7 @@ PREDICATE: kernel-error < array
{
{ [ dup empty? ] [ drop f ] }
{ [ dup first "kernel-error" = not ] [ drop f ] }
{ [ t ] [ second 0 15 between? ] }
[ second 0 15 between? ]
} cond ;
: kernel-errors

2
core/dlists/dlists.factor
View File

@ -126,7 +126,7 @@ PRIVATE>
{
{ [ over front>> over eq? ] [ drop pop-front* ] }
{ [ over back>> over eq? ] [ drop pop-back* ] }
{ [ t ] [ unlink-node dec-length ] }
[ unlink-node dec-length ]
} cond ;
: delete-node-if* ( dlist quot -- obj/f ? )

2
core/effects/effects.factor
View File

@ -20,7 +20,7 @@ TUPLE: effect in out terminated? ;
{ [ dup effect-terminated? ] [ f ] }
{ [ 2dup [ effect-in length ] bi@ > ] [ f ] }
{ [ 2dup [ effect-height ] bi@ = not ] [ f ] }
{ [ t ] [ t ] }
[ t ]
} cond 2nip ;
GENERIC: (stack-picture) ( obj -- str )

4
core/generator/fixup/fixup.factor
View File

@ -40,8 +40,8 @@ M: label fixup*
M: word fixup*
{
{ %prologue-later [ dup [ %prologue ] if-stack-frame ] }
{ %epilogue-later [ dup [ %epilogue ] if-stack-frame ] }
{ \ %prologue-later [ dup [ %prologue ] if-stack-frame ] }
{ \ %epilogue-later [ dup [ %epilogue ] if-stack-frame ] }
} case ;
SYMBOL: relocation-table

2
core/generator/generator.factor
View File

@ -16,7 +16,7 @@ SYMBOL: compiled
{ [ dup compiled get key? ] [ drop ] }
{ [ dup inlined-block? ] [ drop ] }
{ [ dup primitive? ] [ drop ] }
{ [ t ] [ dup compile-queue get set-at ] }
[ dup compile-queue get set-at ]
} cond ;
: maybe-compile ( word -- )

6
core/generator/registers/registers.factor
View File

@ -195,7 +195,7 @@ INSTANCE: constant value
{ [ dup byte-array class< ] [ drop %unbox-byte-array ] }
{ [ dup bit-array class< ] [ drop %unbox-byte-array ] }
{ [ dup float-array class< ] [ drop %unbox-byte-array ] }
{ [ t ] [ drop %unbox-any-c-ptr ] }
[ drop %unbox-any-c-ptr ]
} cond ; inline
: %move-via-temp ( dst src -- )
@ -357,14 +357,14 @@ SYMBOL: fresh-objects
{ [ dup unboxed-c-ptr eq? ] [
over { unboxed-byte-array unboxed-alien } member?
] }
{ [ t ] [ f ] }
[ f ]
} cond 2nip ;
: allocation ( value spec -- reg-class )
{
{ [ dup quotation? ] [ 2drop f ] }
{ [ 2dup compatible? ] [ 2drop f ] }
{ [ t ] [ nip reg-spec>class ] }
[ nip reg-spec>class ]
} cond ;
: alloc-vreg-for ( value spec -- vreg )

2
core/generic/math/math.factor
View File

@ -19,7 +19,7 @@ PREDICATE: math-class < class
{
{ [ dup null class< ] [ drop { -1 -1 } ] }
{ [ dup math-class? ] [ class-types last/first ] }
{ [ t ] [ drop { 100 100 } ] }
[ drop { 100 100 } ]
} cond ;
: math-class-max ( class class -- class )

2
core/generic/standard/engines/predicate/predicate.factor
View File

@ -18,7 +18,7 @@ C: <predicate-dispatch-engine> predicate-dispatch-engine
{ [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
{ [ dup length 1 = ] [ first second { } ] }
{ [ dup keep-going? ] [ 1 tail-slice prune-redundant-predicates ] }
{ [ t ] [ [ first second ] [ 1 tail-slice ] bi ] }
[ [ first second ] [ 1 tail-slice ] bi ]
} cond ;
: sort-methods ( assoc -- assoc' )

4
core/inference/backend/backend.factor
View File

@ -251,7 +251,7 @@ TUPLE: cannot-unify-specials ;
{ [ dup [ curried? ] all? ] [ unify-curries ] }
{ [ dup [ composed? ] all? ] [ unify-composed ] }
{ [ dup [ special? ] contains? ] [ cannot-unify-specials ] }
{ [ t ] [ drop <computed> ] }
[ drop <computed> ]
} cond ;
: unify-stacks ( seq -- stack )
@ -395,7 +395,7 @@ TUPLE: effect-error word effect ;
{ [ dup "infer" word-prop ] [ custom-infer ] }
{ [ dup "no-effect" word-prop ] [ no-effect ] }
{ [ dup "inferred-effect" word-prop ] [ cached-infer ] }
{ [ t ] [ dup infer-word make-call-node ] }
[ dup infer-word make-call-node ]
} cond ;
TUPLE: recursive-declare-error word ;

6
core/io/encodings/utf8/utf8.factor
View File

@ -33,7 +33,7 @@ TUPLE: utf8 ;
{ [ dup -5 shift BIN: 110 number= ] [ double ] }
{ [ dup -4 shift BIN: 1110 number= ] [ triple ] }
{ [ dup -3 shift BIN: 11110 number= ] [ quad ] }
{ [ t ] [ drop replacement-char ] }
[ drop replacement-char ]
} cond ;
: decode-utf8 ( stream -- char/f )
@ -59,12 +59,12 @@ M: utf8 decode-char
2dup -6 shift encoded
encoded
] }
{ [ t ] [
[
2dup -18 shift BIN: 11110000 bitor swap stream-write1
2dup -12 shift encoded
2dup -6 shift encoded
encoded
] }
]
} cond ;
M: utf8 encode-char

27
core/io/files/files.factor
View File

@ -95,7 +95,7 @@ ERROR: no-parent-directory path ;
1 tail left-trim-separators append-path-empty
] }
{ [ dup head..? ] [ drop no-parent-directory ] }
{ [ t ] [ nip ] }
[ nip ]
} cond ;
PRIVATE>
@ -105,7 +105,7 @@ PRIVATE>
{ [ dup "\\\\?\\" head? ] [ t ] }
{ [ dup length 2 < ] [ f ] }
{ [ dup second CHAR: : = ] [ t ] }
{ [ t ] [ f ] }
[ f ]
} cond ;
: absolute-path? ( path -- ? )
@ -114,7 +114,7 @@ PRIVATE>
{ [ dup "resource:" head? ] [ t ] }
{ [ os windows? ] [ windows-absolute-path? ] }
{ [ dup first path-separator? ] [ t ] }
{ [ t ] [ f ] }
[ f ]
} cond nip ;
: append-path ( str1 str2 -- str )
@ -130,10 +130,10 @@ PRIVATE>
{ [ over absolute-path? over first path-separator? and ] [
>r 2 head r> append
] }
{ [ t ] [
[
>r right-trim-separators "/" r>
left-trim-separators 3append
] }
]
} cond ;
: prepend-path ( str1 str2 -- str )
@ -220,10 +220,10 @@ HOOK: make-directory io-backend ( path -- )
{ [ dup root-directory? ] [ ] }
{ [ dup empty? ] [ ] }
{ [ dup exists? ] [ ] }
{ [ t ] [
[
dup parent-directory make-directories
dup make-directory
] }
]
} cond drop ;
! Directory listings
@ -322,9 +322,10 @@ C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
! Home directory
: home ( -- dir )
{
{ [ os winnt? ] [ "USERPROFILE" os-env ] }
{ [ os wince? ] [ "" resource-path ] }
{ [ os unix? ] [ "HOME" os-env ] }
} cond ;
HOOK: home os ( -- dir )
M: winnt home "USERPROFILE" os-env ;
M: wince home "" resource-path ;
M: unix home "HOME" os-env ;

6
core/math/intervals/intervals.factor
View File

@ -103,7 +103,7 @@ C: <interval> interval
2drop over second over second and
[ <interval> ] [ 2drop f ] if
] }
{ [ t ] [ 2drop <interval> ] }
[ 2drop <interval> ]
} cond ;
: interval-intersect ( i1 i2 -- i3 )
@ -202,7 +202,7 @@ SYMBOL: incomparable
{ [ 2dup interval-intersect not ] [ (interval<) ] }
{ [ 2dup left-endpoint-< ] [ f ] }
{ [ 2dup right-endpoint-< ] [ f ] }
{ [ t ] [ incomparable ] }
[ incomparable ]
} cond 2nip ;
: left-endpoint-<= ( i1 i2 -- ? )
@ -215,7 +215,7 @@ SYMBOL: incomparable
{
{ [ 2dup interval-intersect not ] [ (interval<) ] }
{ [ 2dup right-endpoint-<= ] [ t ] }
{ [ t ] [ incomparable ] }
[ incomparable ]
} cond 2nip ;
: interval> ( i1 i2 -- ? )

10
core/math/parser/parser.factor
View File

@ -62,7 +62,7 @@ SYMBOL: negative?
{
{ [ dup empty? ] [ drop f ] }
{ [ f over memq? ] [ drop f ] }
{ [ t ] [ radix get [ < ] curry all? ] }
[ radix get [ < ] curry all? ]
} cond ;
: string>integer ( str -- n/f )
@ -77,7 +77,7 @@ PRIVATE>
{
{ [ CHAR: / over member? ] [ string>ratio ] }
{ [ CHAR: . over member? ] [ string>float ] }
{ [ t ] [ string>integer ] }
[ string>integer ]
} cond
r> [ dup [ neg ] when ] when
] with-radix ;
@ -134,10 +134,8 @@ M: ratio >base
} {
[ CHAR: . over member? ]
[ ]
} {
[ t ]
[ ".0" append ]
}
[ ".0" append ]
} cond ;
M: float >base
@ -145,7 +143,7 @@ M: float >base
{ [ dup 1.0/0.0 = ] [ drop "1.0/0.0" ] }
{ [ dup -1.0/0.0 = ] [ drop "-1.0/0.0" ] }
{ [ dup fp-nan? ] [ drop "0.0/0.0" ] }
{ [ t ] [ float>string fix-float ] }
[ float>string fix-float ]
} cond ;
: number>string ( n -- str ) 10 >base ;

12
core/optimizer/control/control-tests.factor
View File

@ -9,18 +9,18 @@ optimizer ;
{ [ over #label? not ] [ 2drop f ] }
{ [ over #label-word over eq? not ] [ 2drop f ] }
{ [ over #label-loop? not ] [ 2drop f ] }
{ [ t ] [ 2drop t ] }
[ 2drop t ]
} cond
] curry node-exists? ;
: label-is-not-loop? ( node word -- ? )
[
{
{ [ over #label? not ] [ 2drop f ] }
{ [ over #label-word over eq? not ] [ 2drop f ] }
{ [ over #label-loop? ] [ 2drop f ] }
{ [ t ] [ 2drop t ] }
} cond
{ [ over #label? not ] [ f ] }
{ [ over #label-word over eq? not ] [ f ] }
{ [ over #label-loop? ] [ f ] }
[ t ]
} cond 2nip
] curry node-exists? ;
: loop-test-1 ( a -- )

2
core/optimizer/control/control.factor
View File

@ -156,7 +156,7 @@ SYMBOL: potential-loops
{ [ dup null class< ] [ drop f f ] }
{ [ dup \ f class-not class< ] [ drop t t ] }
{ [ dup \ f class< ] [ drop f t ] }
{ [ t ] [ drop f f ] }
[ drop f f ]
} cond
] if ;

8
core/optimizer/inlining/inlining.factor
View File

@ -36,7 +36,7 @@ DEFER: (flat-length)
! not inline
{ [ dup inline? not ] [ drop 1 ] }
! inline
{ [ t ] [ dup dup set word-def (flat-length) ] }
[ dup dup set word-def (flat-length) ]
} cond ;
: (flat-length) ( seq -- n )
@ -45,7 +45,7 @@ DEFER: (flat-length)
{ [ dup quotation? ] [ (flat-length) 1+ ] }
{ [ dup array? ] [ (flat-length) ] }
{ [ dup word? ] [ word-flat-length ] }
{ [ t ] [ drop 1 ] }
[ drop 1 ]
} cond
] map sum ;
@ -94,7 +94,7 @@ DEFER: (flat-length)
dup node-param {
{ [ dup standard-generic? ] [ inline-standard-method ] }
{ [ dup math-generic? ] [ inline-math-method ] }
{ [ t ] [ 2drop t ] }
[ 2drop t ]
} cond ;
! Resolve type checks at compile time where possible
@ -217,5 +217,5 @@ M: #call optimize-node*
{ [ dup optimize-predicate? ] [ optimize-predicate ] }
{ [ dup optimistic-inline? ] [ optimistic-inline ] }
{ [ dup method-body-inline? ] [ optimistic-inline ] }
{ [ t ] [ inline-method ] }
[ inline-method ]
} cond dup not ;

2
core/optimizer/pattern-match/pattern-match.factor
View File

@ -19,7 +19,7 @@ SYMBOL: @
{ [ dup @ eq? ] [ drop match-@ ] }
{ [ dup class? ] [ match-class ] }
{ [ over value? not ] [ 2drop f ] }
{ [ t ] [ swap value-literal = ] }
[ swap value-literal = ]
} cond ;
: node-match? ( node values pattern -- ? )

2
core/optimizer/specializers/specializers.factor
View File

@ -57,7 +57,7 @@ IN: optimizer.specializers
[ dup "specializer" word-prop ]
[ "specializer" word-prop specialize-quot ]
}
{ [ t ] [ drop ] }
[ drop ]
} cond ;
: specialized-length ( specializer -- n )

2
core/parser/parser.factor
View File

@ -324,7 +324,7 @@ M: staging-violation summary
{ [ dup not ] [ drop unexpected-eof t ] }
{ [ dup delimiter? ] [ unexpected t ] }
{ [ dup parsing? ] [ nip execute-parsing t ] }
{ [ t ] [ pick push drop t ] }
[ pick push drop t ]
} cond ;
: (parse-until) ( accum end -- accum )

2
core/prettyprint/prettyprint.factor
View File

@ -107,7 +107,7 @@ SYMBOL: ->
{ [ dup word? not ] [ , ] }
{ [ dup "break?" word-prop ] [ drop ] }
{ [ dup "step-into?" word-prop ] [ remove-step-into ] }
{ [ t ] [ , ] }
[ , ]
} cond
] each
] [ ] make ;

2
core/syntax/syntax.factor
View File

@ -61,7 +61,7 @@ IN: bootstrap.syntax
scan {
{ [ dup length 1 = ] [ first ] }
{ [ "\\" ?head ] [ next-escape drop ] }
{ [ t ] [ name>char-hook get call ] }
[ name>char-hook get call ]
} cond parsed
] define-syntax

2
core/threads/threads.factor
View File

@ -86,7 +86,7 @@ PRIVATE>
{
{ [ run-queue dlist-empty? not ] [ 0 ] }
{ [ sleep-queue heap-empty? ] [ f ] }
{ [ t ] [ sleep-queue heap-peek nip millis [-] ] }
[ sleep-queue heap-peek nip millis [-] ]
} cond ;
<PRIVATE