]> gitweb.factorcode.org Git - factor.git/commitdiff
Tweak some furnace code to infer and load with almost no warnings
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 15 Mar 2009 23:19:29 +0000 (18:19 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 15 Mar 2009 23:19:29 +0000 (18:19 -0500)
14 files changed:
basis/db/db.factor
basis/furnace/actions/actions.factor
basis/furnace/auth/login/login.factor
basis/furnace/boilerplate/boilerplate.factor
basis/furnace/referrer/referrer.factor
basis/furnace/utilities/utilities.factor
basis/html/forms/forms.factor
basis/html/templates/templates.factor
basis/http/server/static/static-docs.factor
basis/http/server/static/static.factor
basis/inverse/inverse.factor
basis/io/servers/connection/connection.factor
basis/logging/analysis/analysis.factor
basis/logging/logging.factor

index 96b72b8865a224f563345dbbbe218c4e1bd4f5ae..bd523b38e6d81a887ab9f3db2ce5e9653b50e0c3 100644 (file)
@@ -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
index 166d2a88a2381a5349946ad8afac8284a70e6c0a..b0814db4dd93efc34fdf68d58e814d25759d72aa 100644 (file)
@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.\r
+! Copyright (C) 2008, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: accessors sequences kernel assocs combinators\r
 validators http hashtables namespaces fry continuations locals\r
-io arrays math boxes splitting urls\r
+io arrays math boxes splitting urls call\r
 xml.entities\r
 http.server\r
 http.server.responses\r
@@ -52,10 +52,10 @@ TUPLE: action rest init authorize display validate submit ;
     '[\r
         _ dup display>> [\r
             {\r
-                [ init>> call ]\r
-                [ authorize>> call ]\r
+                [ init>> call( -- ) ]\r
+                [ authorize>> call( -- ) ]\r
                 [ drop restore-validation-errors ]\r
-                [ display>> call ]\r
+                [ display>> call( -- response ) ]\r
             } cleave\r
         ] [ drop <400> ] if\r
     ] with-exit-continuation ;\r
@@ -81,9 +81,9 @@ CONSTANT: revalidate-url-key "__u"
 : handle-post ( action -- response )\r
     '[\r
         _ dup submit>> [\r
-            [ validate>> call ]\r
-            [ authorize>> call ]\r
-            [ submit>> call ]\r
+            [ validate>> call( -- ) ]\r
+            [ authorize>> call( -- ) ]\r
+            [ submit>> call( -- response ) ]\r
             tri\r
         ] [ drop <400> ] if\r
     ] with-exit-continuation ;\r
index 915ae1c2249d57331466daae541d63c61a1d2918..9c3d316d039f3d06173a61b8979658b22de125d6 100644 (file)
@@ -53,7 +53,7 @@ M: login-realm modify-form ( responder -- )
 \r
 \ successful-login DEBUG add-input-logging\r
 \r
-: logout ( -- )\r
+: logout ( -- response )\r
     permit-id get [ delete-permit ] when*\r
     URL" $realm" end-aside ;\r
 \r
index 95e93f2ee8b067be02aa980f57c43b9d61990c7c..84b29bf831f1af0be6bdc1c480ebaab954663f77 100644 (file)
@@ -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 |
             [
index e5666c269849d4e63bdaa6aad7739b6a25e97066..acd4563cd6f07179673d0adbf18b5bb4e7d0f860 100644 (file)
@@ -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> referrer-check
 
 M: referrer-check call-responder*
-    referrer over quot>> call
+    referrer over quot>> call( referrer -- ? )
     [ call-next-method ]
     [ 2drop 403 "Bad referrer" <trivial-response> ] if ;
 
index c0cb7dbced83176a25d1b5063ec4bf8870a19a80..a43466489cb6d3c23bcf8bd6944e444cec9da891 100755 (executable)
@@ -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
index d5c744beab540c65f160e252f314073212879daa..4cab87acfaa9bca720f7a7cc44fe85d567e00b6c 100644 (file)
@@ -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> validation-error
     >hashtable "validators" set-word-prop ;
 
 : validate ( value quot -- result )
-    [ <validation-error> ] recover ; inline
+    '[ _ call( value -- validated ) ] [ <validation-error> ] recover ;
 
 : validate-value ( name value quot -- )
     validate
index 4a416e353fbf58baaa66c7418e84367e6a1a922f..fcb1b28b1ae271500b3304d32fdde3a9effce063 100644 (file)
@@ -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 ;
 
index bbad56a6f1122033318a5fafba26054ed4df3f04..b453e7ff107087541b7ae7b60d79ef8d6ef179e6 100644 (file)
@@ -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 }
index 5d5ad7d2b83419bfe8c3ae7cf99b75ef2c8d8548..13b9efc86d55bd16d54f11a86ded7491be5b190b 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.\r
+! Copyright (C) 2004, 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: calendar kernel math math.order math.parser namespaces\r
 parser sequences strings assocs hashtables debugger mime.types\r
@@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files
 io.files.info io.directories io.pathnames io.encodings.binary\r
 fry xml.entities destructors urls html xml.syntax\r
 html.templates.fhtml http http.server http.server.responses\r
-http.server.redirection xml.writer ;\r
+http.server.redirection xml.writer call ;\r
 IN: http.server.static\r
 \r
 TUPLE: file-responder root hook special allow-listings ;\r
@@ -42,7 +42,9 @@ TUPLE: file-responder root hook special allow-listings ;
 \r
 : serve-static ( filename mime-type -- response )\r
     over modified-since?\r
-    [ file-responder get hook>> call ] [ 2drop <304> ] if ;\r
+    [ file-responder get hook>> call( filename mime-type -- response ) ]\r
+    [ 2drop <304> ]\r
+    if ;\r
 \r
 : serving-path ( filename -- filename )\r
     [ file-responder get root>> trim-tail-separators "/" ] dip\r
@@ -51,7 +53,7 @@ TUPLE: file-responder root hook special allow-listings ;
 : serve-file ( filename -- response )\r
     dup mime-type\r
     dup file-responder get special>> at\r
-    [ call ] [ serve-static ] ?if ;\r
+    [ call( filename -- response ) ] [ serve-static ] ?if ;\r
 \r
 \ serve-file NOTICE add-input-logging\r
 \r
index 1006e45e77c57ee3fa0d473707e3c5f232cf5b48..9dc79e91b5a013376997467bfd08622bfc8785af 100755 (executable)
@@ -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 ;
index 589a50d2ebf58063d4e25f1813150fdf766ea77f..5a3233afa9471d1281fb34f5569f1c303223be7f 100644 (file)
@@ -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 -- )
     '[
index 24810a6c3e0a574b73ce0886e80b64d2acd24c56..0ba98996b3b0099bfdec6541d8f60b9e95947ff6 100644 (file)
@@ -41,7 +41,7 @@ SYMBOL: message-histogram
         [ >alist sort-values <reversed> ] dip [\r
             [ swapd with-cell pprint-cell ] with-row\r
         ] curry assoc-each\r
-    ] tabular-output ;\r
+    ] tabular-output ; inline\r
 \r
 : log-entry. ( entry -- )\r
     "====== " write\r
index e295960baa81f219866017f2e44022624f72dc6a..c8413c14fe7a6b63750c7061b586b38e36d6fe45 100644 (file)
@@ -80,7 +80,7 @@ ERROR: bad-log-message-parameters msg word level ;
 PRIVATE>\r
 \r
 : (define-logging) ( word level quot -- )\r
-    [ dup ] 2dip 2curry annotate ;\r
+    [ dup ] 2dip 2curry annotate ; inline\r
 \r
 : call-logging-quot ( quot word level -- quot' )\r
     [ "called" ] 2dip [ log-message ] 3curry prepose ;\r