cond/case

2008-04-11 12:55:57 -05:00 · 2008-04-11 12:55:57 -05:00 · 5fa3bd8c74
parent 91263905d3
commit 5fa3bd8c74
16 changed files with 33 additions and 35 deletions
--- a/extra/bootstrap/random/random.factor
+++ b/extra/bootstrap/random/random.factor
@ -9,6 +9,7 @@ namespaces random ;
    { [ os unix? ] [ "random.unix" require ] }
 } cond

-! [ [ 32 random-bits ] with-secure-random <mersenne-twister> random-generator set-global ]
-[ millis <mersenne-twister> random-generator set-global ]
-"generator.random" add-init-hook
+[
+    [ 32 random-bits ] with-secure-random
+    <mersenne-twister> random-generator set-global
+] "generator.random" add-init-hook
--- a/extra/bunny/model/model.factor
+++ b/extra/bunny/model/model.factor
@ -13,7 +13,7 @@ IN: bunny.model
        numbers {
            { [ dup length 5 = ] [ 3 head pick push ] }
            { [ dup first 3 = ] [ 1 tail over push ] }
-            { [ t ] [ drop ] }
+            [ drop ]
        } cond (parse-model)
    ] when* ;

--- a/extra/cairo/png/png.factor
+++ b/extra/cairo/png/png.factor
@ -10,17 +10,17 @@ TUPLE: png-gadget png ;

 ERROR: cairo-error string ;

-: check-zero
+: check-zero ( n -- n )
    dup zero? [
        "PNG dimension is 0" cairo-error
    ] when ;

 : cairo-png-error ( n -- )
    {
-        { [ dup CAIRO_STATUS_NO_MEMORY = ] [ "Cairo: no memory" cairo-error ] }
-        { [ dup CAIRO_STATUS_FILE_NOT_FOUND = ] [ "Cairo: file not found" cairo-error ] }
-        { [ dup CAIRO_STATUS_READ_ERROR = ] [ "Cairo: read error" cairo-error ] }
-        { [ t ] [ drop ] }
+        { \ CAIRO_STATUS_NO_MEMORY [ "Cairo: no memory" cairo-error ] }
+        { \ CAIRO_STATUS_FILE_NOT_FOUND [ "Cairo: file not found" cairo-error ] }
+        { \ CAIRO_STATUS_READ_ERROR [ "Cairo: read error" cairo-error ] }
+        [ drop ]
    } cond ;

 : <png> ( path -- png )
--- a/extra/calendar/windows/windows.factor
+++ b/extra/calendar/windows/windows.factor
@ -5,12 +5,11 @@ IN: calendar.windows
 M: windows gmt-offset ( -- hours minutes seconds )
    "TIME_ZONE_INFORMATION" <c-object>
    dup GetTimeZoneInformation {
-        { [ dup TIME_ZONE_ID_INVALID = ] [ win32-error-string throw ] }
-        { [ dup [ TIME_ZONE_ID_UNKNOWN = ] [ TIME_ZONE_ID_STANDARD = ] bi or ] [
-            drop TIME_ZONE_INFORMATION-Bias ] }
-        { [ dup TIME_ZONE_ID_DAYLIGHT = ] [
-            drop
+        { \ TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
+        { \ TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
+        { \ TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
+        { \ TIME_ZONE_ID_DAYLIGHT [
            [ TIME_ZONE_INFORMATION-Bias ]
            [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
        ] }
-    } cond neg 60 /mod 0 ;
+    } case neg 60 /mod 0 ;
--- a/extra/cocoa/messages/messages.factor
+++ b/extra/cocoa/messages/messages.factor
@ -154,7 +154,7 @@ H{
        { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
        { [ dup CHAR: { = ] [ drop objc-struct-type ] }
        { [ dup CHAR: [ = ] [ 3drop "void*" ] }
-        { [ t ] [ 2nip 1string objc>alien-types get at ] }
+        [ 2nip 1string objc>alien-types get at ]
    } cond ;

 : parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;
--- a/extra/db/sql/sql-tests.factor
+++ b/extra/db/sql/sql-tests.factor
@ -38,5 +38,3 @@ TUPLE: person name age ;
        { offset 40 }
        { limit 20 }
    } ;
-
-
--- a/extra/db/sql/sql.factor
+++ b/extra/db/sql/sql.factor
@ -55,7 +55,7 @@ TUPLE: no-sql-match ;
        { [ dup number? ] [ number>string sql% ] }
        { [ dup symbol? ] [ unparse sql% ] }
        { [ dup word? ] [ unparse sql% ] }
-        { [ t ] [ T{ no-sql-match } throw ] }
+        [ T{ no-sql-match } throw ]
    } cond ;

 : parse-sql ( obj -- sql in-spec out-spec in out )
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@ -20,7 +20,7 @@ IN: db.sqlite.lib
    {
        { [ dup SQLITE_OK = ] [ drop ] }
        { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
-        { [ t ] [ sqlite-error ] }
+        [ sqlite-error ]
    } cond ;

 : sqlite-open ( filename -- db )
--- a/extra/documents/documents.factor
+++ b/extra/documents/documents.factor
@ -151,14 +151,14 @@ TUPLE: char-elt ;
    -rot {
        { [ over { 0 0 } = ] [ drop ] }
        { [ over second zero? ] [ >r first 1- r> line-end ] }
-        { [ t ] [ pick call ] }
+        [ pick call ]
    } cond nip ; inline

 : (next-char) ( loc document quot -- loc )
    -rot {
        { [ 2dup doc-end = ] [ drop ] }
        { [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
-        { [ t ] [ pick call ] }
+        [ pick call ]
    } cond nip ; inline

 M: char-elt prev-elt
--- a/extra/fry/fry.factor
+++ b/extra/fry/fry.factor
@ -22,11 +22,11 @@ DEFER: (fry)
        drop 1quotation
    ] [
        unclip {
-            { , [ [ curry ] ((fry)) ] }
-            { @ [ [ compose ] ((fry)) ] }
+            { \ , [ [ curry ] ((fry)) ] }
+            { \ @ [ [ compose ] ((fry)) ] }

            ! to avoid confusion, remove if fry goes core
-            { namespaces:, [ [ curry ] ((fry)) ] }
+            { \ namespaces:, [ [ curry ] ((fry)) ] }

            [ swap >r suffix r> (fry) ]
        } case
--- a/extra/hardware-info/hardware-info.factor
+++ b/extra/hardware-info/hardware-info.factor
@ -14,7 +14,7 @@ IN: hardware-info
    { [ os windows? ] [ "hardware-info.windows" ] }
    { [ os linux? ] [ "hardware-info.linux" ] }
    { [ os macosx? ] [ "hardware-info.macosx" ] }
-    { [ t ] [ f ] }
+    [ f ]
 } cond [ require ] when* >>

 : hardware-report. ( -- )
--- a/extra/help/help.factor
+++ b/extra/help/help.factor
@ -139,7 +139,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
    {
        { [ dup empty? ] [ (:help-none) ] }
        { [ dup length 1 = ] [ first help ] }
-        { [ t ] [ (:help-multi) ] }
+        [ (:help-multi) ]
    } cond (:help-debugger) ;

 : remove-article ( name -- )
--- a/extra/html/parser/printer/printer.factor
+++ b/extra/html/parser/printer/printer.factor
@ -92,7 +92,7 @@ M: printer print-tag ( tag -- )
            [ print-closing-named-tag ] }
        { [ dup tag-name string? ]
            [ print-opening-named-tag ] }
-        { [ t ] [ <unknown-tag-error> throw ] }
+        [ <unknown-tag-error> throw ]
    } cond ;

 SYMBOL: tablestack
--- a/extra/http/http.factor
+++ b/extra/http/http.factor
@ -145,10 +145,10 @@ TUPLE: cookie name value path domain expires http-only ;

 : (unparse-cookie) ( key value -- )
    {
-        { [ dup f eq? ] [ 2drop ] }
-        { [ dup t eq? ] [ drop , ] }
-        { [ t ] [ "=" swap 3append , ] }
-    } cond ;
+        { f [ drop ] }
+        { t [ , ] }
+        [ "=" swap 3append , ]
+    } case ;

 : unparse-cookie ( cookie -- strings )
    [
@ -399,7 +399,7 @@ body ;
        { [ dup not ] [ drop ] }
        { [ dup string? ] [ write ] }
        { [ dup callable? ] [ call ] }
-        { [ t ] [ stdio get stream-copy ] }
+        [ stdio get stream-copy ]
    } cond ;

 M: response write-response ( respose -- )
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@ -89,7 +89,7 @@ SYMBOL: form-hook
    {
        { [ over "http://" head? ] [ link>string ] }
        { [ over "/" head? ] [ absolute-redirect ] }
-        { [ t ] [ relative-redirect ] }
+        [ relative-redirect ]
    } cond ;

 : <redirect> ( to query code message -- response )
--- a/extra/http/server/templating/fhtml/fhtml.factor
+++ b/extra/http/server/templating/fhtml/fhtml.factor
@ -26,7 +26,7 @@ M: template-lexer skip-word
        {
            { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
            { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
-            { [ t ] [ f skip ] }
+            [ f skip ]
        } cond
    ] change-lexer-column ;