From 8e55533bfa912a8f082c7ee26ef8d4e8a68ddc2f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 18:19:29 -0500 Subject: [PATCH] Tweak some furnace code to infer and load with almost no warnings --- basis/db/db.factor | 2 +- basis/furnace/actions/actions.factor | 16 ++++++++-------- basis/furnace/auth/login/login.factor | 2 +- basis/furnace/boilerplate/boilerplate.factor | 6 +++--- basis/furnace/referrer/referrer.factor | 6 +++--- basis/furnace/utilities/utilities.factor | 2 +- basis/html/forms/forms.factor | 6 +++--- basis/html/templates/templates.factor | 6 +++--- basis/http/server/static/static-docs.factor | 2 +- basis/http/server/static/static.factor | 10 ++++++---- basis/inverse/inverse.factor | 4 ++-- basis/io/servers/connection/connection.factor | 6 +++--- basis/logging/analysis/analysis.factor | 2 +- basis/logging/logging.factor | 2 +- 14 files changed, 37 insertions(+), 35 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index 96b72b8865..bd523b38e6 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -149,4 +149,4 @@ M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ; t in-transaction [ begin-transaction [ ] [ rollback-transaction ] cleanup commit-transaction - ] with-variable ; + ] with-variable ; inline diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 166d2a88a2..b0814db4dd 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors sequences kernel assocs combinators validators http hashtables namespaces fry continuations locals -io arrays math boxes splitting urls +io arrays math boxes splitting urls call xml.entities http.server http.server.responses @@ -52,10 +52,10 @@ TUPLE: action rest init authorize display validate submit ; '[ _ dup display>> [ { - [ init>> call ] - [ authorize>> call ] + [ init>> call( -- ) ] + [ authorize>> call( -- ) ] [ drop restore-validation-errors ] - [ display>> call ] + [ display>> call( -- response ) ] } cleave ] [ drop <400> ] if ] with-exit-continuation ; @@ -81,9 +81,9 @@ CONSTANT: revalidate-url-key "__u" : handle-post ( action -- response ) '[ _ dup submit>> [ - [ validate>> call ] - [ authorize>> call ] - [ submit>> call ] + [ validate>> call( -- ) ] + [ authorize>> call( -- ) ] + [ submit>> call( -- response ) ] tri ] [ drop <400> ] if ] with-exit-continuation ; diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor index 915ae1c224..9c3d316d03 100644 --- a/basis/furnace/auth/login/login.factor +++ b/basis/furnace/auth/login/login.factor @@ -53,7 +53,7 @@ M: login-realm modify-form ( responder -- ) \ successful-login DEBUG add-input-logging -: logout ( -- ) +: logout ( -- response ) permit-id get [ delete-permit ] when* URL" $realm" end-aside ; diff --git a/basis/furnace/boilerplate/boilerplate.factor b/basis/furnace/boilerplate/boilerplate.factor index 95e93f2ee8..84b29bf831 100644 --- a/basis/furnace/boilerplate/boilerplate.factor +++ b/basis/furnace/boilerplate/boilerplate.factor @@ -1,6 +1,6 @@ -! Copyright (c) 2008 Slava Pestov +! Copyright (c) 2008, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math.order namespaces combinators.short-circuit +USING: accessors kernel math.order namespaces combinators.short-circuit call html.forms html.templates html.templates.chloe @@ -23,7 +23,7 @@ TUPLE: boilerplate < filter-responder template init ; M:: boilerplate call-responder* ( path responder -- ) begin-form path responder call-next-method - responder init>> call + responder init>> call( -- ) dup wrap-boilerplate? [ clone [| body | [ diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor index e5666c2698..acd4563cd6 100644 --- a/basis/furnace/referrer/referrer.factor +++ b/basis/furnace/referrer/referrer.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel http.server http.server.filters -http.server.responses furnace.utilities ; +http.server.responses furnace.utilities call ; IN: furnace.referrer TUPLE: referrer-check < filter-responder quot ; @@ -9,7 +9,7 @@ TUPLE: referrer-check < filter-responder quot ; C: referrer-check M: referrer-check call-responder* - referrer over quot>> call + referrer over quot>> call( referrer -- ? ) [ call-next-method ] [ 2drop 403 "Bad referrer" ] if ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index c0cb7dbced..a43466489c 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -135,4 +135,4 @@ SYMBOL: exit-continuation exit-continuation get continue-with ; : with-exit-continuation ( quot -- value ) - '[ exit-continuation set @ ] callcc1 exit-continuation off ; + '[ exit-continuation set @ ] callcc1 exit-continuation off ; inline diff --git a/basis/html/forms/forms.factor b/basis/html/forms/forms.factor index d5c744beab..4cab87acfa 100644 --- a/basis/html/forms/forms.factor +++ b/basis/html/forms/forms.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2008 Slava Pestov +! Copyright (C) 2008, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors strings namespaces assocs hashtables io +USING: kernel accessors strings namespaces assocs hashtables io call mirrors math fry sequences words continuations xml.entities xml.writer xml.syntax ; IN: html.forms @@ -96,7 +96,7 @@ C: validation-error >hashtable "validators" set-word-prop ; : validate ( value quot -- result ) - [ ] recover ; inline + '[ _ call( value -- validated ) ] [ ] recover ; : validate-value ( name value quot -- ) validate diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor index 4a416e353f..fcb1b28b1a 100644 --- a/basis/html/templates/templates.factor +++ b/basis/html/templates/templates.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel fry io io.encodings.utf8 io.files debugger prettyprint continuations namespaces boxes sequences -arrays strings html io.streams.string assocs +arrays strings html io.streams.string assocs call quotations xml.data xml.writer xml.syntax ; IN: html.templates @@ -12,7 +12,7 @@ GENERIC: call-template* ( template -- ) M: string call-template* write ; -M: callable call-template* call ; +M: callable call-template* call( -- ) ; M: xml call-template* write-xml ; diff --git a/basis/http/server/static/static-docs.factor b/basis/http/server/static/static-docs.factor index bbad56a6f1..b453e7ff10 100644 --- a/basis/http/server/static/static-docs.factor +++ b/basis/http/server/static/static-docs.factor @@ -20,7 +20,7 @@ HELP: enable-fhtml { $side-effects "responder" } ; ARTICLE: "http.server.static.extend" "Hooks for dynamic content" -"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- )" } "." +"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- response )" } "." $nl "A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:" { $subsection enable-fhtml } diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 5d5ad7d2b8..13b9efc86d 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: calendar kernel math math.order math.parser namespaces parser sequences strings assocs hashtables debugger mime.types @@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files io.files.info io.directories io.pathnames io.encodings.binary fry xml.entities destructors urls html xml.syntax html.templates.fhtml http http.server http.server.responses -http.server.redirection xml.writer ; +http.server.redirection xml.writer call ; IN: http.server.static TUPLE: file-responder root hook special allow-listings ; @@ -42,7 +42,9 @@ TUPLE: file-responder root hook special allow-listings ; : serve-static ( filename mime-type -- response ) over modified-since? - [ file-responder get hook>> call ] [ 2drop <304> ] if ; + [ file-responder get hook>> call( filename mime-type -- response ) ] + [ 2drop <304> ] + if ; : serving-path ( filename -- filename ) [ file-responder get root>> trim-tail-separators "/" ] dip @@ -51,7 +53,7 @@ TUPLE: file-responder root hook special allow-listings ; : serve-file ( filename -- response ) dup mime-type dup file-responder get special>> at - [ call ] [ serve-static ] ?if ; + [ call( filename -- response ) ] [ serve-static ] ?if ; \ serve-file NOTICE add-input-logging diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 1006e45e77..9dc79e91b5 100755 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces make vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors splitting -combinators.short-circuit fry words.symbol generalizations ; +combinators.short-circuit fry words.symbol generalizations call ; RENAME: _ fry => __ IN: inverse @@ -122,7 +122,7 @@ M: math-inverse inverse M: pop-inverse inverse [ "pop-length" word-prop cut-slice swap >quotation ] - [ "pop-inverse" word-prop ] bi compose call ; + [ "pop-inverse" word-prop ] bi compose call( -- quot ) ; : (undo) ( revquot -- ) [ unclip-slice inverse % (undo) ] unless-empty ; diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 589a50d2eb..5a3233afa9 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2003, 2008 Slava Pestov. +! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors kernel math math.parser namespaces parser sequences strings prettyprint @@ -7,7 +7,7 @@ fry accessors arrays io io.sockets io.encodings.ascii io.sockets.secure io.files io.streams.duplex io.timeouts io.encodings threads make concurrency.combinators concurrency.semaphores concurrency.flags -combinators.short-circuit ; +combinators.short-circuit call ; IN: io.servers.connection TUPLE: threaded-server @@ -69,7 +69,7 @@ GENERIC: handle-client* ( threaded-server -- ) [ [ remote-address set ] [ local-address set ] bi* ] 2bi ; -M: threaded-server handle-client* handler>> call ; +M: threaded-server handle-client* handler>> call( -- ) ; : handle-client ( client remote local -- ) '[ diff --git a/basis/logging/analysis/analysis.factor b/basis/logging/analysis/analysis.factor index 24810a6c3e..0ba98996b3 100644 --- a/basis/logging/analysis/analysis.factor +++ b/basis/logging/analysis/analysis.factor @@ -41,7 +41,7 @@ SYMBOL: message-histogram [ >alist sort-values ] dip [ [ swapd with-cell pprint-cell ] with-row ] curry assoc-each - ] tabular-output ; + ] tabular-output ; inline : log-entry. ( entry -- ) "====== " write diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index e295960baa..c8413c14fe 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -80,7 +80,7 @@ ERROR: bad-log-message-parameters msg word level ; PRIVATE> : (define-logging) ( word level quot -- ) - [ dup ] 2dip 2curry annotate ; + [ dup ] 2dip 2curry annotate ; inline : call-logging-quot ( quot word level -- quot' ) [ "called" ] 2dip [ log-message ] 3curry prepose ;