cond/case

db4
Doug Coleman 2008-04-11 12:55:57 -05:00
parent 91263905d3
commit 5fa3bd8c74
16 changed files with 33 additions and 35 deletions

View File

@ -9,6 +9,7 @@ namespaces random ;
{ [ os unix? ] [ "random.unix" require ] } { [ os unix? ] [ "random.unix" require ] }
} cond } cond
! [ [ 32 random-bits ] with-secure-random <mersenne-twister> random-generator set-global ] [
[ millis <mersenne-twister> random-generator set-global ] [ 32 random-bits ] with-secure-random
"generator.random" add-init-hook <mersenne-twister> random-generator set-global
] "generator.random" add-init-hook

View File

@ -13,7 +13,7 @@ IN: bunny.model
numbers { numbers {
{ [ dup length 5 = ] [ 3 head pick push ] } { [ dup length 5 = ] [ 3 head pick push ] }
{ [ dup first 3 = ] [ 1 tail over push ] } { [ dup first 3 = ] [ 1 tail over push ] }
{ [ t ] [ drop ] } [ drop ]
} cond (parse-model) } cond (parse-model)
] when* ; ] when* ;

View File

@ -10,17 +10,17 @@ TUPLE: png-gadget png ;
ERROR: cairo-error string ; ERROR: cairo-error string ;
: check-zero : check-zero ( n -- n )
dup zero? [ dup zero? [
"PNG dimension is 0" cairo-error "PNG dimension is 0" cairo-error
] when ; ] when ;
: cairo-png-error ( n -- ) : cairo-png-error ( n -- )
{ {
{ [ dup CAIRO_STATUS_NO_MEMORY = ] [ "Cairo: no memory" cairo-error ] } { \ CAIRO_STATUS_NO_MEMORY [ "Cairo: no memory" cairo-error ] }
{ [ dup CAIRO_STATUS_FILE_NOT_FOUND = ] [ "Cairo: file not found" cairo-error ] } { \ CAIRO_STATUS_FILE_NOT_FOUND [ "Cairo: file not found" cairo-error ] }
{ [ dup CAIRO_STATUS_READ_ERROR = ] [ "Cairo: read error" cairo-error ] } { \ CAIRO_STATUS_READ_ERROR [ "Cairo: read error" cairo-error ] }
{ [ t ] [ drop ] } [ drop ]
} cond ; } cond ;
: <png> ( path -- png ) : <png> ( path -- png )

View File

@ -5,12 +5,11 @@ IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds ) M: windows gmt-offset ( -- hours minutes seconds )
"TIME_ZONE_INFORMATION" <c-object> "TIME_ZONE_INFORMATION" <c-object>
dup GetTimeZoneInformation { dup GetTimeZoneInformation {
{ [ dup TIME_ZONE_ID_INVALID = ] [ win32-error-string throw ] } { \ TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
{ [ dup [ TIME_ZONE_ID_UNKNOWN = ] [ TIME_ZONE_ID_STANDARD = ] bi or ] [ { \ TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
drop TIME_ZONE_INFORMATION-Bias ] } { \ TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
{ [ dup TIME_ZONE_ID_DAYLIGHT = ] [ { \ TIME_ZONE_ID_DAYLIGHT [
drop
[ TIME_ZONE_INFORMATION-Bias ] [ TIME_ZONE_INFORMATION-Bias ]
[ TIME_ZONE_INFORMATION-DaylightBias ] bi + [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
] } ] }
} cond neg 60 /mod 0 ; } case neg 60 /mod 0 ;

View File

@ -154,7 +154,7 @@ H{
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] } { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] } { [ dup CHAR: { = ] [ drop objc-struct-type ] }
{ [ dup CHAR: [ = ] [ 3drop "void*" ] } { [ dup CHAR: [ = ] [ 3drop "void*" ] }
{ [ t ] [ 2nip 1string objc>alien-types get at ] } [ 2nip 1string objc>alien-types get at ]
} cond ; } cond ;
: parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ; : parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;

View File

@ -38,5 +38,3 @@ TUPLE: person name age ;
{ offset 40 } { offset 40 }
{ limit 20 } { limit 20 }
} ; } ;

View File

@ -55,7 +55,7 @@ TUPLE: no-sql-match ;
{ [ dup number? ] [ number>string sql% ] } { [ dup number? ] [ number>string sql% ] }
{ [ dup symbol? ] [ unparse sql% ] } { [ dup symbol? ] [ unparse sql% ] }
{ [ dup word? ] [ unparse sql% ] } { [ dup word? ] [ unparse sql% ] }
{ [ t ] [ T{ no-sql-match } throw ] } [ T{ no-sql-match } throw ]
} cond ; } cond ;
: parse-sql ( obj -- sql in-spec out-spec in out ) : parse-sql ( obj -- sql in-spec out-spec in out )

View File

@ -20,7 +20,7 @@ IN: db.sqlite.lib
{ {
{ [ dup SQLITE_OK = ] [ drop ] } { [ dup SQLITE_OK = ] [ drop ] }
{ [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] } { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
{ [ t ] [ sqlite-error ] } [ sqlite-error ]
} cond ; } cond ;
: sqlite-open ( filename -- db ) : sqlite-open ( filename -- db )

View File

@ -151,14 +151,14 @@ TUPLE: char-elt ;
-rot { -rot {
{ [ over { 0 0 } = ] [ drop ] } { [ over { 0 0 } = ] [ drop ] }
{ [ over second zero? ] [ >r first 1- r> line-end ] } { [ over second zero? ] [ >r first 1- r> line-end ] }
{ [ t ] [ pick call ] } [ pick call ]
} cond nip ; inline } cond nip ; inline
: (next-char) ( loc document quot -- loc ) : (next-char) ( loc document quot -- loc )
-rot { -rot {
{ [ 2dup doc-end = ] [ drop ] } { [ 2dup doc-end = ] [ drop ] }
{ [ 2dup line-end? ] [ drop first 1+ 0 2array ] } { [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
{ [ t ] [ pick call ] } [ pick call ]
} cond nip ; inline } cond nip ; inline
M: char-elt prev-elt M: char-elt prev-elt

View File

@ -22,11 +22,11 @@ DEFER: (fry)
drop 1quotation drop 1quotation
] [ ] [
unclip { unclip {
{ , [ [ curry ] ((fry)) ] } { \ , [ [ curry ] ((fry)) ] }
{ @ [ [ compose ] ((fry)) ] } { \ @ [ [ compose ] ((fry)) ] }
! to avoid confusion, remove if fry goes core ! to avoid confusion, remove if fry goes core
{ namespaces:, [ [ curry ] ((fry)) ] } { \ namespaces:, [ [ curry ] ((fry)) ] }
[ swap >r suffix r> (fry) ] [ swap >r suffix r> (fry) ]
} case } case

View File

@ -14,7 +14,7 @@ IN: hardware-info
{ [ os windows? ] [ "hardware-info.windows" ] } { [ os windows? ] [ "hardware-info.windows" ] }
{ [ os linux? ] [ "hardware-info.linux" ] } { [ os linux? ] [ "hardware-info.linux" ] }
{ [ os macosx? ] [ "hardware-info.macosx" ] } { [ os macosx? ] [ "hardware-info.macosx" ] }
{ [ t ] [ f ] } [ f ]
} cond [ require ] when* >> } cond [ require ] when* >>
: hardware-report. ( -- ) : hardware-report. ( -- )

View File

@ -139,7 +139,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
{ {
{ [ dup empty? ] [ (:help-none) ] } { [ dup empty? ] [ (:help-none) ] }
{ [ dup length 1 = ] [ first help ] } { [ dup length 1 = ] [ first help ] }
{ [ t ] [ (:help-multi) ] } [ (:help-multi) ]
} cond (:help-debugger) ; } cond (:help-debugger) ;
: remove-article ( name -- ) : remove-article ( name -- )

View File

@ -92,7 +92,7 @@ M: printer print-tag ( tag -- )
[ print-closing-named-tag ] } [ print-closing-named-tag ] }
{ [ dup tag-name string? ] { [ dup tag-name string? ]
[ print-opening-named-tag ] } [ print-opening-named-tag ] }
{ [ t ] [ <unknown-tag-error> throw ] } [ <unknown-tag-error> throw ]
} cond ; } cond ;
SYMBOL: tablestack SYMBOL: tablestack

View File

@ -145,10 +145,10 @@ TUPLE: cookie name value path domain expires http-only ;
: (unparse-cookie) ( key value -- ) : (unparse-cookie) ( key value -- )
{ {
{ [ dup f eq? ] [ 2drop ] } { f [ drop ] }
{ [ dup t eq? ] [ drop , ] } { t [ , ] }
{ [ t ] [ "=" swap 3append , ] } [ "=" swap 3append , ]
} cond ; } case ;
: unparse-cookie ( cookie -- strings ) : unparse-cookie ( cookie -- strings )
[ [
@ -399,7 +399,7 @@ body ;
{ [ dup not ] [ drop ] } { [ dup not ] [ drop ] }
{ [ dup string? ] [ write ] } { [ dup string? ] [ write ] }
{ [ dup callable? ] [ call ] } { [ dup callable? ] [ call ] }
{ [ t ] [ stdio get stream-copy ] } [ stdio get stream-copy ]
} cond ; } cond ;
M: response write-response ( respose -- ) M: response write-response ( respose -- )

View File

@ -89,7 +89,7 @@ SYMBOL: form-hook
{ {
{ [ over "http://" head? ] [ link>string ] } { [ over "http://" head? ] [ link>string ] }
{ [ over "/" head? ] [ absolute-redirect ] } { [ over "/" head? ] [ absolute-redirect ] }
{ [ t ] [ relative-redirect ] } [ relative-redirect ]
} cond ; } cond ;
: <redirect> ( to query code message -- response ) : <redirect> ( to query code message -- response )

View File

@ -26,7 +26,7 @@ M: template-lexer skip-word
{ {
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] } { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] } { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
{ [ t ] [ f skip ] } [ f skip ]
} cond } cond
] change-lexer-column ; ] change-lexer-column ;